chore: minor

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>

.github/workflows/ci.yml

@@ -238,7 +238,7 @@ jobs:
                 "name": "Linux 32bit",
                 "os": "ubuntu-latest",
                 // Use 32bit on stage0 and stage1 to keep oleans compatible
-                "CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DPKG_CONFIG_EXECUTABLE=/usr/bin/i386-linux-gnu-pkg-config",
+                "CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
                 "cmultilib": true,
                 "release": true,
                 "check-level": 2,
@@ -327,7 +327,7 @@ jobs:
         run: |
           sudo dpkg --add-architecture i386
           sudo apt-get update
-          sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
+          sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386
         if: matrix.cmultilib
       - name: Cache
         uses: actions/cache@v4

CMakeLists.txt

@@ -18,9 +18,6 @@ foreach(var ${vars})
     if("${var}" MATCHES "LLVM*")
       list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
     endif()
-    if("${var}" MATCHES "PKG_CONFIG*")
-      list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
-    endif()
   elseif(("${var}" MATCHES "CMAKE_.*") AND NOT ("${var}" MATCHES "CMAKE_BUILD_TYPE") AND NOT ("${var}" MATCHES "CMAKE_HOME_DIRECTORY"))
     list(APPEND PLATFORM_ARGS "-D${var}=${${var}}")
   endif()

doc/dev/commit_convention.md

@@ -33,9 +33,6 @@ Format of the commit message
  - chore (maintain, ex: travis-ci)
  - perf (performance improvement, optimization, ...)
 
-Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
-beginning with "This PR " that will be included in the changelog.
-
 ``<subject>`` has the following constraints:
 
  - use imperative, present tense: "change" not "changed" nor "changes"
@@ -47,7 +44,6 @@ beginning with "This PR " that will be included in the changelog.
  - just as in ``<subject>``, use imperative, present tense
  - includes motivation for the change and contrasts with previous
    behavior
- - If a `changelog-*` label is present, the body must begin with "This PR ".
 
 ``<footer>`` is optional and may contain two items:
 
@@ -64,21 +60,17 @@ Examples
 
 fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
 
-This PR adds declarations `operator<<` for raw printing.
 The actual implementation of these two operators is outside of the
-kernel. They are implemented in the file 'library/printer.cpp'.
-
-We declare them in the kernel to prevent the following problem.
-Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
+kernel. They are implemented in the file 'library/printer.cpp'. We
+declare them in the kernel to prevent the following problem. Suppose
+there is a file 'foo.cpp' that does not include 'library/printer.h',
 but contains
-```cpp
-expr a;
-...
-std::cout << a << "\n";
-...
-```
+
+    expr a;
+    ...
+    std::cout << a << "\n";
+    ...
 
 The compiler does not generate an error message. It silently uses the
 operator bool() to coerce the expression into a Boolean. This produces
 counter-intuitive behavior, and may confuse developers.
-

doc/dev/index.md

@@ -80,10 +80,3 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
 `prelude` keyword. This disables the automated import of `Init`, meaning that
 developers need to figure out their own subset of `Init` to import. This is done
 such that changing files in `Init` doesn't force a full rebuild of `Lean`.
-
-### Testing against Mathlib/Batteries
-You can test a Lean PR against Mathlib and Batteries by rebasing your PR
-on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
-CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
-that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
-See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.

doc/make/osx-10.9.md

@@ -32,13 +32,12 @@ following to use `g++`.
 cmake -DCMAKE_CXX_COMPILER=g++ ...
 ```
 
-## Required Packages: CMake, GMP, libuv, pkgconf
+## Required Packages: CMake, GMP, libuv
 
 ```bash
 brew install cmake
 brew install gmp
 brew install libuv
-brew install pkgconf
 ```
 
 ## Recommended Packages: CCache

doc/make/ubuntu.md

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

flake.nix

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

nix/bootstrap.nix

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

script/push_repo_release_tag.py

@@ -1,69 +0,0 @@
-#!/usr/bin/env python3
-import sys
-import subprocess
-import requests
-
-def main():
-    if len(sys.argv) != 4:
-        print("Usage: ./push_repo_release_tag.py <repo> <branch> <version_tag>")
-        sys.exit(1)
-
-    repo, branch, version_tag = sys.argv[1], sys.argv[2], sys.argv[3]
-
-    if branch not in {"master", "main"}:
-        print(f"Error: Branch '{branch}' is not 'master' or 'main'.")
-        sys.exit(1)
-
-    # Get the `lean-toolchain` file content
-    lean_toolchain_url = f"https://raw.githubusercontent.com/{repo}/{branch}/lean-toolchain"
-    try:
-        response = requests.get(lean_toolchain_url)
-        response.raise_for_status()
-    except requests.exceptions.RequestException as e:
-        print(f"Error fetching 'lean-toolchain' file: {e}")
-        sys.exit(1)
-
-    lean_toolchain_content = response.text.strip()
-    expected_prefix = "leanprover/lean4:"
-    if not lean_toolchain_content.startswith(expected_prefix) or lean_toolchain_content != f"{expected_prefix}{version_tag}":
-        print(f"Error: 'lean-toolchain' content does not match '{expected_prefix}{version_tag}'.")
-        sys.exit(1)
-
-    # Create and push the tag using `gh`
-    try:
-        # Check if the tag already exists
-        list_tags_cmd = ["gh", "api", f"repos/{repo}/git/matching-refs/tags/v4", "--jq", ".[].ref"]
-        list_tags_output = subprocess.run(list_tags_cmd, capture_output=True, text=True)
-
-        if list_tags_output.returncode == 0:
-            existing_tags = list_tags_output.stdout.strip().splitlines()
-            if f"refs/tags/{version_tag}" in existing_tags:
-                print(f"Error: Tag '{version_tag}' already exists.")
-                print("Existing tags starting with 'v4':")
-                for tag in existing_tags:
-                    print(tag.replace("refs/tags/", ""))
-                sys.exit(1)
-
-        # Get the SHA of the branch
-        get_sha_cmd = [
-            "gh", "api", f"repos/{repo}/git/ref/heads/{branch}", "--jq", ".object.sha"
-        ]
-        sha_result = subprocess.run(get_sha_cmd, capture_output=True, text=True, check=True)
-        sha = sha_result.stdout.strip()
-
-        # Create the tag
-        create_tag_cmd = [
-            "gh", "api", f"repos/{repo}/git/refs",
-            "-X", "POST",
-            "-F", f"ref=refs/tags/{version_tag}",
-            "-F", f"sha={sha}"
-        ]
-        subprocess.run(create_tag_cmd, capture_output=True, text=True, check=True)
-
-        print(f"Successfully created and pushed tag '{version_tag}' to {repo}.")
-    except subprocess.CalledProcessError as e:
-        print(f"Error while creating/pushing tag: {e.stderr.strip() if e.stderr else e}")
-        sys.exit(1)
-
-if __name__ == "__main__":
-    main()

script/release_checklist.py

@@ -22,36 +22,6 @@ def get_github_token():
         print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
     return None
 
-def strip_rc_suffix(toolchain):
-    """Remove -rcX suffix from the toolchain."""
-    return toolchain.split("-")[0]
-
-def branch_exists(repo_url, branch, github_token):
-    api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/branches/{branch}"
-    headers = {'Authorization': f'token {github_token}'} if github_token else {}
-    response = requests.get(api_url, headers=headers)
-    return response.status_code == 200
-
-def tag_exists(repo_url, tag_name, github_token):
-    api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
-    headers = {'Authorization': f'token {github_token}'} if github_token else {}
-    response = requests.get(api_url, headers=headers)
-    return response.status_code == 200
-
-def release_page_exists(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)
-    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_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}"
     headers = {'Authorization': f'token {github_token}'} if github_token else {}
@@ -65,20 +35,11 @@ def get_branch_content(repo_url, branch, file_path, github_token):
             return None
     return None
 
-def parse_version(version_str):
-    # Remove 'v' prefix and extract version and release candidate suffix
-    if ':' in version_str:
-        version_str = version_str.split(':')[1]
-    version = version_str.lstrip('v')
-    parts = version.split('-')
-    base_version = tuple(map(int, parts[0].split('.')))
-    rc_part = parts[1] if len(parts) > 1 and parts[1].startswith('rc') else None
-    rc_number = int(rc_part[2:]) if rc_part else float('inf')  # Treat non-rc as higher than rc
-    return base_version + (rc_number,)
-
-def is_version_gte(version1, version2):
-    """Check if version1 >= version2, including proper handling of release candidates."""
-    return parse_version(version1) >= parse_version(version2)
+def tag_exists(repo_url, tag_name, github_token):
+    api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
+    headers = {'Authorization': f'token {github_token}'} if github_token else {}
+    response = requests.get(api_url, headers=headers)
+    return response.status_code == 200
 
 def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
     # First get the commit SHA for the tag
@@ -103,38 +64,23 @@ def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
     stable_commits = [commit['sha'] for commit in commits_response.json()]
     return tag_sha in stable_commits
 
+def parse_version(version_str):
+    # Remove 'v' prefix and split into components
+    # Handle Lean toolchain format (leanprover/lean4:v4.x.y)
+    if ':' in version_str:
+        version_str = version_str.split(':')[1]
+    version = version_str.lstrip('v')
+    # Handle release candidates by removing -rc part for comparison
+    version = version.split('-')[0]
+    return tuple(map(int, version.split('.')))
+
+def is_version_gte(version1, version2):
+    """Check if version1 >= version2"""
+    return parse_version(version1) >= parse_version(version2)
+
 def is_release_candidate(version):
     return "-rc" in version
 
-def check_cmake_version(repo_url, branch, version_major, version_minor, github_token):
-    """Verify the CMake version settings in src/CMakeLists.txt."""
-    cmake_file_path = "src/CMakeLists.txt"
-    content = get_branch_content(repo_url, branch, cmake_file_path, github_token)
-    if content is None:
-        print(f"  ❌ Could not retrieve {cmake_file_path} from {branch}")
-        return False
-
-    expected_lines = [
-        f"set(LEAN_VERSION_MAJOR {version_major})",
-        f"set(LEAN_VERSION_MINOR {version_minor})",
-        f"set(LEAN_VERSION_PATCH 0)",
-        f"set(LEAN_VERSION_IS_RELEASE 1)"
-    ]
-
-    for line in expected_lines:
-        if not any(l.strip().startswith(line) for l in content.splitlines()):
-            print(f"  ❌ Missing or incorrect line in {cmake_file_path}: {line}")
-            return False
-
-    print(f"  ✅ CMake version settings are correct in {cmake_file_path}")
-    return True
-
-def extract_org_repo_from_url(repo_url):
-    """Extract the 'org/repo' part from a GitHub URL."""
-    if repo_url.startswith("https://github.com/"):
-        return repo_url.replace("https://github.com/", "").rstrip("/")
-    return repo_url
-
 def main():
     github_token = get_github_token()
 
@@ -143,47 +89,6 @@ def main():
         sys.exit(1)
 
     toolchain = sys.argv[1]
-    stripped_toolchain = strip_rc_suffix(toolchain)
-    lean_repo_url = "https://github.com/leanprover/lean4"
-
-    # Preliminary checks
-    print("\nPerforming preliminary checks...")
-
-    # Check for branch releases/v4.Y.0
-    version_major, version_minor, _ = map(int, stripped_toolchain.lstrip('v').split('.'))
-    branch_name = f"releases/v{version_major}.{version_minor}.0"
-    if branch_exists(lean_repo_url, branch_name, github_token):
-        print(f"  ✅ Branch {branch_name} exists")
-
-        # Check CMake version settings
-        check_cmake_version(lean_repo_url, branch_name, version_major, version_minor, github_token)
-    else:
-        print(f"  ❌ Branch {branch_name} does not exist")
-
-    # Check for tag v4.X.Y(-rcZ)
-    if tag_exists(lean_repo_url, toolchain, github_token):
-        print(f"  ✅ Tag {toolchain} exists")
-    else:
-        print(f"  ❌ Tag {toolchain} does not exist.")
-
-    # Check for release page
-    if release_page_exists(lean_repo_url, toolchain, github_token):
-        print(f"  ✅ Release page for {toolchain} exists")
-
-        # Check the first line of the release notes
-        release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
-        if release_notes and release_notes.splitlines()[0].strip() == toolchain:
-            print(f"  ✅ Release notes look good.")
-        else:
-            previous_minor_version = version_minor - 1
-            previous_stable_branch = f"releases/v{version_major}.{previous_minor_version}.0"
-            previous_release = f"v{version_major}.{previous_minor_version}.0"
-            print(f"  ❌ Release notes not published. Please run `script/release_notes.py {previous_release}` on branch `{previous_stable_branch}`.")
-    else:
-        print(f"  ❌ Release page for {toolchain} does not exist")
-
-    # Load repositories and perform further checks
-    print("\nChecking repositories...")
 
     with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
         repos = yaml.safe_load(f)["repositories"]
@@ -212,7 +117,7 @@ def main():
         # Only check for tag if toolchain-tag is true
         if check_tag:
             if not tag_exists(url, toolchain, github_token):
-                print(f"  ❌ Tag {toolchain} does not exist. Run `script/push_repo_release_tag.py {extract_org_repo_from_url(url)} {branch} {toolchain}`.")
+                print(f"  ❌ Tag {toolchain} does not exist")
                 continue
             print(f"  ✅ Tag {toolchain} exists")
 

src/CMakeLists.txt

@@ -295,15 +295,14 @@ index 5e8e0166..f3b29134 100644
 	  PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
     BUILD_IN_SOURCE ON
     INSTALL_COMMAND "")
-  set(LIBUV_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
-  set(LIBUV_LDFLAGS "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
+  set(LIBUV_INCLUDE_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
+  set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
 else()
   find_package(LibUV 1.0.0 REQUIRED)
 endif()
-include_directories(${LIBUV_INCLUDE_DIRS})
+include_directories(${LIBUV_INCLUDE_DIR})
 if(NOT LEAN_STANDALONE)
-  string(JOIN " " LIBUV_LDFLAGS ${LIBUV_LDFLAGS})
-  string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
 endif()
 
 # Windows SDK (for ICU)
@@ -699,12 +698,12 @@ else()
 endif()
 
 if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
-  add_custom_target(lake_lib
+  add_custom_target(lake_lib ALL
     WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
     DEPENDS leanshared
     COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Lake
     VERBATIM)
-  add_custom_target(lake_shared
+  add_custom_target(lake_shared ALL
     WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
     DEPENDS lake_lib
     COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make libLake_shared

src/Init/Data/Array/Basic.lean

@@ -576,12 +576,6 @@ def foldl {α : Type u} {β : Type v} (f : β → α → β) (init : β) (as : A
 def foldr {α : Type u} {β : Type v} (f : α → β → β) (init : β) (as : Array α) (start := as.size) (stop := 0) : β :=
   Id.run <| as.foldrM f init start stop
 
-/-- Sum of an array.
-
-`Array.sum #[a, b, c] = a + (b + (c + 0))` -/
-def sum {α} [Add α] [Zero α] : Array α → α :=
-  foldr (· + ·) 0
-
 @[inline]
 def map {α : Type u} {β : Type v} (f : α → β) (as : Array α) : Array β :=
   Id.run <| as.mapM f

src/Init/Data/Array/Bootstrap.lean

@@ -81,18 +81,12 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
 
 @[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
 
-@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
+@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := 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] theorem empty_append (as : Array α) : #[] ++ as = as := by
+@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
   apply ext'; simp only [toList_append, toList_empty, List.nil_append]
 
-@[deprecated empty_append (since := "2025-01-13")]
-abbrev nil_append := @empty_append
-
 @[simp] theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
   apply ext'; simp only [toList_append, List.append_assoc]
 

src/Init/Data/Array/Find.lean

@@ -74,12 +74,12 @@ theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (
 
 theorem getElem?_zero_flatten (L : Array (Array α)) :
     (flatten L)[0]? = L.findSome? fun l => l[0]? := by
-  cases L using array₂_induction
+  cases L using array_array_induction
   simp [← List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
 
 theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
     (L.findSome? fun l => l[0]?).isSome := by
-  cases L using array₂_induction
+  cases L using array_array_induction
   simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
     List.findSome?_isSome_iff, isSome_getElem?]
   simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
@@ -95,7 +95,7 @@ theorem getElem_zero_flatten {L : Array (Array α)} (h) :
 
 theorem back?_flatten {L : Array (Array α)} :
     (flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
-  cases L using array₂_induction
+  cases L using array_array_induction
   simp [List.getLast?_flatten, ← List.map_reverse, List.findSome?_map, Function.comp_def]
 
 theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
@@ -203,7 +203,7 @@ theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h ∈ xs := by
 
 @[simp] theorem find?_flatten (xs : Array (Array α)) (p : α → Bool) :
     xs.flatten.find? p = xs.findSome? (·.find? p) := by
-  cases xs using array₂_induction
+  cases xs using array_array_induction
   simp [List.findSome?_map, Function.comp_def]
 
 theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α → Bool} :
@@ -220,7 +220,7 @@ theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α → Bool} {a : α}
       p a ∧ ∃ (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
         xs = as.push (ys.push a ++ zs) ++ bs ∧
         (∀ a ∈ as, ∀ x ∈ a, !p x) ∧ (∀ x ∈ ys, !p x) := by
-  cases xs using array₂_induction
+  cases xs using array_array_induction
   simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
   simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
   intro w

src/Init/Data/Array/Lemmas.lean

@@ -38,14 +38,6 @@ namespace Array
 
 @[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
 
-theorem eq_toArray : v = List.toArray a ↔ v.toList = a := by
-  cases v
-  simp
-
-theorem toArray_eq : List.toArray a = v ↔ a = v.toList := by
-  cases v
-  simp
-
 /-! ### empty -/
 
 @[simp] theorem empty_eq {xs : Array α} : #[] = xs ↔ xs = #[] := by
@@ -93,7 +85,7 @@ theorem size_eq_one {l : Array α} : l.size = 1 ↔ ∃ a, l = #[a] := by
 
 /-! ### push -/
 
-@[simp] theorem push_ne_empty {a : α} {xs : Array α} : xs.push a ≠ #[] := by
+theorem push_ne_empty {a : α} {xs : Array α} : xs.push a ≠ #[] := by
   cases xs
   simp
 
@@ -174,6 +166,10 @@ theorem mkArray_succ : mkArray (n + 1) a = (mkArray n a).push a := by
   apply toList_inj.1
   simp [List.replicate_succ']
 
+theorem mkArray_inj : mkArray n a = mkArray m b ↔ n = m ∧ (n = 0 ∨ a = b) := by
+  rw [← List.replicate_inj, ← toList_inj]
+  simp
+
 @[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
     (mkArray n v)[i] = v := by simp [← getElem_toList]
 
@@ -260,11 +256,6 @@ theorem getElem?_push {a : Array α} {x} : (a.push x)[i]? = if i = a.size then s
 theorem getElem?_singleton (a : α) (i : Nat) : #[a][i]? = if i = 0 then some a else none := by
   simp [List.getElem?_singleton]
 
-theorem ext_getElem? {l₁ l₂ : Array α} (h : ∀ i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ := by
-  rcases l₁ with ⟨l₁⟩
-  rcases l₂ with ⟨l₂⟩
-  simpa using List.ext_getElem? (by simpa using h)
-
 /-! ### mem -/
 
 theorem not_mem_empty (a : α) : ¬ a ∈ #[] := by simp
@@ -1098,21 +1089,9 @@ theorem forall_mem_map {f : α → β} {l : Array α} {P : β → Prop} :
     (∀ (i) (_ : i ∈ l.map f), P i) ↔ ∀ (j) (_ : j ∈ l), P (f j) := by
   simp
 
-@[simp] theorem map_eq_empty_iff {f : α → β} {l : Array α} : map f l = #[] ↔ l = #[] := by
-  cases l
-  simp
-
-theorem eq_empty_of_map_eq_empty {f : α → β} {l : Array α} (h : map f l = #[]) : l = #[] :=
-  map_eq_empty_iff.mp h
-
 @[simp] theorem map_inj_left {f g : α → β} : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
   cases l <;> simp_all
 
-theorem map_inj_right {f : α → β} (w : ∀ x y, f x = f y → x = y) : map f l = map f l' ↔ l = l' := by
-  cases l
-  cases l'
-  simp [List.map_inj_right w]
-
 theorem map_congr_left (h : ∀ a ∈ l, f a = g a) : map f l = map g l :=
   map_inj_left.2 h
 
@@ -1121,6 +1100,13 @@ theorem map_inj : map f = map g ↔ f = g := by
   · intro h; ext a; replace h := congrFun h #[a]; simpa using h
   · intro h; subst h; rfl
 
+@[simp] theorem map_eq_empty_iff {f : α → β} {l : Array α} : map f l = #[] ↔ l = #[] := by
+  cases l
+  simp
+
+theorem eq_empty_of_map_eq_empty {f : α → β} {l : Array α} (h : map f l = #[]) : l = #[] :=
+  map_eq_empty_iff.mp h
+
 theorem map_eq_push_iff {f : α → β} {l : Array α} {l₂ : Array β} {b : β} :
     map f l = l₂.push b ↔ ∃ l₁ a, l = l₁.push a ∧ map f l₁ = l₂ ∧ f a = b := by
   rcases l with ⟨l⟩
@@ -1203,30 +1189,6 @@ theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
     rfl
 termination_by as.size - i
 
-/--
-Use this as `induction ass using array₂_induction` on a hypothesis of the form `ass : Array (Array α)`.
-The hypothesis `ass` will be replaced with a hypothesis `ass : List (List α)`,
-and former appearances of `ass` in the goal will be replaced with `(ass.map List.toArray).toArray`.
--/
--- We can't use `@[cases_eliminator]` here as
--- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
-theorem array₂_induction (P : Array (Array α) → Prop) (of : ∀ (xss : List (List α)), P (xss.map List.toArray).toArray)
-    (ass : Array (Array α)) : P ass := by
-  specialize of (ass.toList.map toList)
-  simpa [← toList_map, Function.comp_def, map_id] using of
-
-/--
-Use this as `induction ass using array₃_induction` on a hypothesis of the form `ass : Array (Array (Array α))`.
-The hypothesis `ass` will be replaced with a hypothesis `ass : List (List (List α))`,
-and former appearances of `ass` in the goal will be replaced with
-`((ass.map (fun xs => xs.map List.toArray)).map List.toArray).toArray`.
--/
-theorem array₃_induction (P : Array (Array (Array α)) → Prop)
-    (of : ∀ (xss : List (List (List α))), P ((xss.map (fun xs => xs.map List.toArray)).map List.toArray).toArray)
-    (ass : Array (Array (Array α))) : P ass := by
-  specialize of ((ass.toList.map toList).map (fun as => as.map toList))
-  simpa [← toList_map, Function.comp_def, map_id] using of
-
 /-! ### filter -/
 
 @[congr]
@@ -1542,25 +1504,14 @@ theorem filterMap_eq_push_iff {f : α → Option β} {l : Array α} {l' : Array
   · rintro ⟨⟨l₁⟩, a, ⟨l₂⟩, h₁, h₂, h₃, h₄⟩
     refine ⟨l₂.reverse, a, l₁.reverse, by simp_all⟩
 
+/-! Content below this point has not yet been aligned with `List`. -/
+
 /-! ### singleton -/
 
 @[simp] theorem singleton_def (v : α) : Array.singleton v = #[v] := rfl
 
 /-! ### append -/
 
-@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
-  simp only [size, toList_append, List.length_append]
-
-@[simp] theorem append_push {as bs : Array α} {a : α} : as ++ bs.push a = (as ++ bs).push a := by
-  cases as
-  cases bs
-  simp
-
-theorem toArray_append {xs : List α} {ys : Array α} :
-    xs.toArray ++ ys = (xs ++ ys.toList).toArray := by
-  rcases ys with ⟨ys⟩
-  simp
-
 @[simp] theorem toArray_eq_append_iff {xs : List α} {as bs : Array α} :
     xs.toArray = as ++ bs ↔ xs = as.toList ++ bs.toList := by
   cases as
@@ -1588,24 +1539,12 @@ theorem mem_append_left {a : α} {l₁ : Array α} (l₂ : Array α) (h : a ∈
 theorem mem_append_right {a : α} (l₁ : Array α) {l₂ : Array α} (h : a ∈ l₂) : a ∈ l₁ ++ l₂ :=
   mem_append.2 (Or.inr h)
 
-theorem not_mem_append {a : α} {s t : Array α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
-  mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
+@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
+  simp only [size, toList_append, List.length_append]
 
-/--
-See also `eq_push_append_of_mem`, which proves a stronger version
-in which the initial array must not contain the element.
--/
-theorem append_of_mem {a : α} {l : Array α} (h : a ∈ l) : ∃ s t : Array α, l = s.push a ++ t := by
-  obtain ⟨s, t, w⟩ := List.append_of_mem (l := l.toList) (by simpa using h)
-  replace w := congrArg List.toArray w
-  refine ⟨s.toArray, t.toArray, by simp_all⟩
+theorem empty_append (as : Array α) : #[] ++ as = as := by simp
 
-theorem mem_iff_append {a : α} {l : Array α} : a ∈ l ↔ ∃ s t : Array α, l = s.push a ++ t :=
-  ⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
-
-theorem forall_mem_append {p : α → Prop} {l₁ l₂ : Array α} :
-    (∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
-  simp only [mem_append, or_imp, forall_and]
+theorem append_empty (as : Array α) : as ++ #[] = as := by simp
 
 theorem getElem_append {as bs : Array α} (h : i < (as ++ bs).size) :
     (as ++ bs)[i] = if h' : i < as.size then as[i] else bs[i - as.size]'(by simp at h; omega) := by
@@ -1660,630 +1599,6 @@ theorem getElem_of_append {l l₁ l₂ : Array α} (eq : l = l₁.push a ++ l₂
   rw [← getElem?_eq_getElem, eq, getElem?_append_left (by simp; omega), ← h]
   simp
 
-@[simp 1100] theorem append_singleton {a : α} {as : Array α} : as ++ #[a] = as.push a := by
-  cases as
-  simp
-
-theorem append_inj {s₁ s₂ t₁ t₂ : Array α} (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) :
-    s₁ = s₂ ∧ t₁ = t₂ := by
-  rcases s₁ with ⟨s₁⟩
-  rcases s₂ with ⟨s₂⟩
-  rcases t₁ with ⟨t₁⟩
-  rcases t₂ with ⟨t₂⟩
-  simpa using List.append_inj (by simpa using h) (by simpa using hl)
-
-theorem append_inj_right {s₁ s₂ t₁ t₂ : Array α}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) : t₁ = t₂ :=
-  (append_inj h hl).right
-
-theorem append_inj_left {s₁ s₂ t₁ t₂ : Array α}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) : s₁ = s₂ :=
-  (append_inj h hl).left
-
-/-- Variant of `append_inj` instead requiring equality of the sizes of the second arrays. -/
-theorem append_inj' {s₁ s₂ t₁ t₂ : Array α} (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) :
-    s₁ = s₂ ∧ t₁ = t₂ :=
-  append_inj h <| @Nat.add_right_cancel _ t₁.size _ <| by
-    let hap := congrArg size h; simp only [size_append, ← hl] at hap; exact hap
-
-/-- Variant of `append_inj_right` instead requiring equality of the sizes of the second arrays. -/
-theorem append_inj_right' {s₁ s₂ t₁ t₂ : Array α}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) : t₁ = t₂ :=
-  (append_inj' h hl).right
-
-/-- Variant of `append_inj_left` instead requiring equality of the sizes of the second arrays. -/
-theorem append_inj_left' {s₁ s₂ t₁ t₂ : Array α}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) : s₁ = s₂ :=
-  (append_inj' h hl).left
-
-theorem append_right_inj {t₁ t₂ : Array α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
-  ⟨fun h => append_inj_right h rfl, congrArg _⟩
-
-theorem append_left_inj {s₁ s₂ : Array α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
-  ⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩
-
-@[simp] theorem append_left_eq_self {x y : Array α} : x ++ y = y ↔ x = #[] := by
-  rw [← append_left_inj (s₁ := x), empty_append]
-
-@[simp] theorem self_eq_append_left {x y : Array α} : y = x ++ y ↔ x = #[] := by
-  rw [eq_comm, append_left_eq_self]
-
-@[simp] theorem append_right_eq_self {x y : Array α} : x ++ y = x ↔ y = #[] := by
-  rw [← append_right_inj (t₁ := y), append_empty]
-
-@[simp] theorem self_eq_append_right {x y : Array α} : x = x ++ y ↔ y = #[] := by
-  rw [eq_comm, append_right_eq_self]
-
-@[simp] theorem append_eq_empty_iff : p ++ q = #[] ↔ p = #[] ∧ q = #[] := by
-  cases p <;> simp
-
-@[simp] theorem empty_eq_append_iff : #[] = a ++ b ↔ a = #[] ∧ b = #[] := by
-  rw [eq_comm, append_eq_empty_iff]
-
-theorem append_ne_empty_of_left_ne_empty {s : Array α} (h : s ≠ #[]) (t : Array α) :
-    s ++ t ≠ #[] := by
-  simp_all
-
-theorem append_ne_empty_of_right_ne_empty (s : Array α) : t ≠ #[] → s ++ t ≠ #[] := by
-  simp_all
-
-theorem append_eq_push_iff {a b c : Array α} {x : α} :
-    a ++ b = c.push x ↔ (b = #[] ∧ a = c.push x) ∨ (∃ b', b = b'.push x ∧ c = a ++ b') := by
-  rcases a with ⟨a⟩
-  rcases b with ⟨b⟩
-  rcases c with ⟨c⟩
-  simp only [List.append_toArray, List.push_toArray, mk.injEq, List.append_eq_append_iff,
-    toArray_eq_append_iff]
-  constructor
-  · rintro (⟨a', rfl, rfl⟩ | ⟨b', rfl, h⟩)
-    · right; exact ⟨⟨a'⟩, by simp⟩
-    · rw [List.singleton_eq_append_iff] at h
-      obtain (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) := h
-      · right; exact ⟨#[], by simp⟩
-      · left; simp
-  · rintro (⟨rfl, rfl⟩ | ⟨b', h, rfl⟩)
-    · right; exact ⟨[x], by simp⟩
-    · left; refine ⟨b'.toList, ?_⟩
-      replace h := congrArg Array.toList h
-      simp_all
-
-theorem push_eq_append_iff {a b c : Array α} {x : α} :
-    c.push x = a ++ b ↔ (b = #[] ∧ a = c.push x) ∨ (∃ b', b = b'.push x ∧ c = a ++ b') := by
-  rw [eq_comm, append_eq_push_iff]
-
-theorem append_eq_singleton_iff {a b : Array α} {x : α} :
-    a ++ b = #[x] ↔ (a = #[] ∧ b = #[x]) ∨ (a = #[x] ∧ b = #[]) := by
-  rcases a with ⟨a⟩
-  rcases b with ⟨b⟩
-  simp only [List.append_toArray, mk.injEq, List.append_eq_singleton_iff, toArray_eq_append_iff]
-
-theorem singleton_eq_append_iff {a b : Array α} {x : α} :
-    #[x] = a ++ b ↔ (a = #[] ∧ b = #[x]) ∨ (a = #[x] ∧ b = #[]) := by
-  rw [eq_comm, append_eq_singleton_iff]
-
-theorem append_eq_append_iff {a b c d : Array α} :
-    a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
-  rcases a with ⟨a⟩
-  rcases b with ⟨b⟩
-  rcases c with ⟨c⟩
-  rcases d with ⟨d⟩
-  simp only [List.append_toArray, mk.injEq, List.append_eq_append_iff, toArray_eq_append_iff]
-  constructor
-  · rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
-    · left; exact ⟨⟨a'⟩, by simp⟩
-    · right; exact ⟨⟨c'⟩, by simp⟩
-  · rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
-    · left; exact ⟨a'.toList, by simp⟩
-    · right; exact ⟨c'.toList, by simp⟩
-
-theorem set_append {s t : Array α} {i : Nat} {x : α} (h : i < (s ++ t).size) :
-    (s ++ t).set i x =
-      if h' : i < s.size then
-        s.set i x ++ t
-      else
-        s ++ t.set (i - s.size) x (by simp at h; omega) := by
-  rcases s with ⟨s⟩
-  rcases t with ⟨t⟩
-  simp only [List.append_toArray, List.set_toArray, List.set_append]
-  split <;> simp
-
-@[simp] theorem set_append_left {s t : Array α} {i : Nat} {x : α} (h : i < s.size) :
-    (s ++ t).set i x (by simp; omega) = s.set i x ++ t := by
-  simp [set_append, h]
-
-@[simp] theorem set_append_right {s t : Array α} {i : Nat} {x : α}
-    (h' : i < (s ++ t).size) (h : s.size ≤ i) :
-    (s ++ t).set i x = s ++ t.set (i - s.size) x (by simp at h'; omega) := by
-  rw [set_append, dif_neg (by omega)]
-
-theorem setIfInBounds_append {s t : Array α} {i : Nat} {x : α} :
-    (s ++ t).setIfInBounds i x =
-      if i < s.size then
-        s.setIfInBounds i x ++ t
-      else
-        s ++ t.setIfInBounds (i - s.size) x := by
-  rcases s with ⟨s⟩
-  rcases t with ⟨t⟩
-  simp only [List.append_toArray, List.setIfInBounds_toArray, List.set_append]
-  split <;> simp
-
-@[simp] theorem setIfInBounds_append_left {s t : Array α} {i : Nat} {x : α} (h : i < s.size) :
-    (s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
-  simp [setIfInBounds_append, h]
-
-@[simp] theorem setIfInBounds_append_right {s t : Array α} {i : Nat} {x : α} (h : s.size ≤ i) :
-    (s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - s.size) x := by
-  rw [setIfInBounds_append, if_neg (by omega)]
-
-theorem filterMap_eq_append_iff {f : α → Option β} :
-    filterMap f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
-  rcases l with ⟨l⟩
-  rcases L₁ with ⟨L₁⟩
-  rcases L₂ with ⟨L₂⟩
-  simp only [size_toArray, List.filterMap_toArray', List.append_toArray, mk.injEq,
-    List.filterMap_eq_append_iff, toArray_eq_append_iff]
-  constructor
-  · rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
-    exact ⟨⟨l₁⟩, ⟨l₂⟩, by simp⟩
-  · rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
-    exact ⟨l₁, l₂, by simp_all⟩
-
-theorem append_eq_filterMap_iff {f : α → Option β} :
-    L₁ ++ L₂ = filterMap f l ↔
-      ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
-  rw [eq_comm, filterMap_eq_append_iff]
-
-@[simp] theorem map_append (f : α → β) (l₁ l₂ : Array α) :
-    map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
-  cases l₁
-  cases l₂
-  simp
-
-theorem map_eq_append_iff {f : α → β} :
-    map f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
-  rw [← filterMap_eq_map, filterMap_eq_append_iff]
-
-theorem append_eq_map_iff {f : α → β} :
-    L₁ ++ L₂ = map f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
-  rw [eq_comm, map_eq_append_iff]
-
-/-! ### flatten -/
-
-@[simp] theorem flatten_empty : (#[] : Array (Array α)).flatten = #[] := by simp [flatten]; rfl
-
-@[simp] theorem toList_flatten {l : Array (Array α)} :
-    l.flatten.toList = (l.toList.map toList).flatten := by
-  dsimp [flatten]
-  simp only [← foldl_toList]
-  generalize l.toList = l
-  have : ∀ a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
-  exact this #[]
-  induction l with
-  | nil => simp
-  | cons h => induction h.toList <;> simp [*]
-
-@[simp] theorem flatten_map_toArray (l : List (List α)) :
-    (l.toArray.map List.toArray).flatten = l.flatten.toArray := by
-  apply ext'
-  simp [Function.comp_def]
-
-@[simp] theorem flatten_toArray_map (l : List (List α)) :
-    (l.map List.toArray).toArray.flatten = l.flatten.toArray := by
-  rw [← flatten_map_toArray]
-  simp
-
-theorem flatten_toArray (l : List (Array α)) :
-    l.toArray.flatten = (l.map Array.toList).flatten.toArray := by
-  apply ext'
-  simp
-
-@[simp] theorem size_flatten (L : Array (Array α)) : L.flatten.size = (L.map size).sum := by
-  cases L using array₂_induction
-  simp [Function.comp_def]
-
-@[simp] theorem flatten_singleton (l : Array α) : #[l].flatten = l := by simp [flatten]; rfl
-
-theorem mem_flatten : ∀ {L : Array (Array α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
-  simp only [mem_def, toList_flatten, List.mem_flatten, List.mem_map]
-  intro l
-  constructor
-  · rintro ⟨_, ⟨s, m, rfl⟩, h⟩
-    exact ⟨s, m, h⟩
-  · rintro ⟨s, h₁, h₂⟩
-    refine ⟨s.toList, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩
-
-@[simp] theorem flatten_eq_empty_iff {L : Array (Array α)} : L.flatten = #[] ↔ ∀ l ∈ L, l = #[] := by
-  induction L using array₂_induction
-  simp
-
-@[simp] theorem empty_eq_flatten_iff {L : Array (Array α)} : #[] = L.flatten ↔ ∀ l ∈ L, l = #[] := by
-  rw [eq_comm, flatten_eq_empty_iff]
-
-theorem flatten_ne_empty_iff {xs : Array (Array α)} : xs.flatten ≠ #[] ↔ ∃ x, x ∈ xs ∧ x ≠ #[] := by
-  simp
-
-theorem exists_of_mem_flatten : a ∈ flatten L → ∃ l, l ∈ L ∧ a ∈ l := mem_flatten.1
-
-theorem mem_flatten_of_mem (lL : l ∈ L) (al : a ∈ l) : a ∈ flatten L := mem_flatten.2 ⟨l, lL, al⟩
-
-theorem forall_mem_flatten {p : α → Prop} {L : Array (Array α)} :
-    (∀ (x) (_ : x ∈ flatten L), p x) ↔ ∀ (l) (_ : l ∈ L) (x) (_ : x ∈ l), p x := by
-  simp only [mem_flatten, forall_exists_index, and_imp]
-  constructor <;> (intros; solve_by_elim)
-
-theorem flatten_eq_flatMap {L : Array (Array α)} : flatten L = L.flatMap id := by
-  induction L using array₂_induction
-  rw [flatten_toArray_map, List.flatten_eq_flatMap]
-  simp [List.flatMap_map]
-
-@[simp] theorem map_flatten (f : α → β) (L : Array (Array α)) :
-    (flatten L).map f = (map (map f) L).flatten := by
-  induction L using array₂_induction with
-  | of xss =>
-    simp only [flatten_toArray_map, List.map_toArray, List.map_flatten, List.map_map,
-      Function.comp_def]
-    rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
-
-@[simp] theorem filterMap_flatten (f : α → Option β) (L : Array (Array α)) :
-    filterMap f (flatten L) = flatten (map (filterMap f) L) := by
-  induction L using array₂_induction
-  simp only [flatten_toArray_map, size_toArray, List.length_flatten, List.filterMap_toArray',
-    List.filterMap_flatten, List.map_toArray, List.map_map, Function.comp_def]
-  rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
-
-@[simp] theorem filter_flatten (p : α → Bool) (L : Array (Array α)) :
-    filter p (flatten L) = flatten (map (filter p) L) := by
-  induction L using array₂_induction
-  simp only [flatten_toArray_map, size_toArray, List.length_flatten, List.filter_toArray',
-    List.filter_flatten, List.map_toArray, List.map_map, Function.comp_def]
-  rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
-
-theorem flatten_filter_not_isEmpty {L : Array (Array α)} :
-    flatten (L.filter fun l => !l.isEmpty) = L.flatten := by
-  induction L using array₂_induction
-  simp [List.filter_map, Function.comp_def, List.flatten_filter_not_isEmpty]
-
-theorem flatten_filter_ne_empty [DecidablePred fun l : Array α => l ≠ #[]] {L : Array (Array α)} :
-    flatten (L.filter fun l => l ≠ #[]) = L.flatten := by
-  simp only [ne_eq, ← isEmpty_iff, Bool.not_eq_true, Bool.decide_eq_false,
-    flatten_filter_not_isEmpty]
-
-@[simp] theorem flatten_append (L₁ L₂ : Array (Array α)) :
-    flatten (L₁ ++ L₂) = flatten L₁ ++ flatten L₂ := by
-  induction L₁ using array₂_induction
-  induction L₂ using array₂_induction
-  simp [← List.map_append]
-
-theorem flatten_push (L : Array (Array α)) (l : Array α) :
-    flatten (L.push l) = flatten L ++ l := by
-  induction L using array₂_induction
-  rcases l with ⟨l⟩
-  have this : [l.toArray] = [l].map List.toArray := by simp
-  simp only [List.push_toArray, flatten_toArray_map, List.append_toArray]
-  rw [this, ← List.map_append, flatten_toArray_map]
-  simp
-
-theorem flatten_flatten {L : Array (Array (Array α))} : flatten (flatten L) = flatten (map flatten L) := by
-  induction L using array₃_induction with
-  | of xss =>
-    rw [flatten_toArray_map]
-    have : (xss.map (fun xs => xs.map List.toArray)).flatten = xss.flatten.map List.toArray := by
-      induction xss with
-      | nil => simp
-      | cons xs xss ih =>
-        simp only [List.map_cons, List.flatten_cons, ih, List.map_append]
-    rw [this, flatten_toArray_map, List.flatten_flatten, ← List.map_toArray, Array.map_map,
-      ← List.map_toArray, map_map, Function.comp_def]
-    simp only [Function.comp_apply, flatten_toArray_map]
-    rw [List.map_toArray, ← Function.comp_def, ← List.map_map, flatten_toArray_map]
-
-theorem flatten_eq_push_iff {xs : Array (Array α)} {ys : Array α} {y : α} :
-    xs.flatten = ys.push y ↔
-      ∃ (as : Array (Array α)) (bs : Array α) (cs : Array (Array α)),
-        xs = as.push (bs.push y) ++ cs ∧ (∀ l, l ∈ cs → l = #[]) ∧ ys = as.flatten ++ bs := by
-  induction xs using array₂_induction with
-  | of xs =>
-    rcases ys with ⟨ys⟩
-    rw [flatten_toArray_map, List.push_toArray, mk.injEq, List.flatten_eq_append_iff]
-    constructor
-    · rintro (⟨as, bs, rfl, rfl, h⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, h⟩)
-      · rw [List.singleton_eq_flatten_iff] at h
-        obtain ⟨xs, ys, rfl, h₁, h₂⟩ := h
-        exact ⟨((as ++ xs).map List.toArray).toArray, #[], (ys.map List.toArray).toArray, by simp,
-          by simpa using h₂, by rw [flatten_toArray_map]; simpa⟩
-      · rw [List.singleton_eq_append_iff] at h
-        obtain (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩) := h
-        · simp at h₁
-        · simp at h₁ h₂
-          obtain ⟨rfl, rfl⟩ := h₁
-          exact ⟨(as.map List.toArray).toArray, bs.toArray, (ds.map List.toArray).toArray, by simpa⟩
-    · rintro ⟨as, bs, cs, h₁, h₂, h₃⟩
-      replace h₁ := congrArg (List.map Array.toList) (congrArg Array.toList h₁)
-      simp [Function.comp_def] at h₁
-      subst h₁
-      replace h₃ := congrArg Array.toList h₃
-      simp at h₃
-      subst h₃
-      right
-      exact ⟨(as.map Array.toList).toList, bs.toList, y, [], (cs.map Array.toList).toList, by simpa⟩
-
-theorem push_eq_flatten_iff {xs : Array (Array α)} {ys : Array α} {y : α} :
-    ys.push y = xs.flatten ↔
-      ∃ (as : Array (Array α)) (bs : Array α) (cs : Array (Array α)),
-        xs = as.push (bs.push y) ++ cs ∧ (∀ l, l ∈ cs → l = #[]) ∧ ys = as.flatten ++ bs := by
-  rw [eq_comm, flatten_eq_push_iff]
-
--- For now we omit `flatten_eq_append_iff`,
--- because it is not easily obtainable from `List.flatten_eq_append_iff`.
--- theorem flatten_eq_append_iff {xs : Array (Array α)} {ys zs : Array α} :
---     xs.flatten = ys ++ zs ↔
---       (∃ as bs, xs = as ++ bs ∧ ys = as.flatten ∧ zs = bs.flatten) ∨
---         ∃ (as : Array (Array α)) (bs : Array α) (c : α) (cs : Array α) (ds : Array (Array α)),
---           xs = as.push ((bs.push c ++ cs)) ++ ds ∧ ys = as.flatten ++ bs.push c ∧
---           zs = cs ++ ds.flatten := by sorry
-
-
-/-- Two arrays of subarrays are equal iff their flattens coincide, as well as the sizes of the
-subarrays. -/
-theorem eq_iff_flatten_eq {L L' : Array (Array α)} :
-    L = L' ↔ L.flatten = L'.flatten ∧ map size L = map size L' := by
-  cases L using array₂_induction with
-  | of L =>
-    cases L' using array₂_induction with
-    | of L' =>
-      simp [Function.comp_def, ← List.eq_iff_flatten_eq]
-      rw [List.map_inj_right]
-      simp +contextual
-
-/-! ### flatMap -/
-
-theorem flatMap_def (l : Array α) (f : α → Array β) : l.flatMap f = flatten (map f l) := by
-  rcases l with ⟨l⟩
-  simp [flatten_toArray, Function.comp_def, List.flatMap_def]
-
-theorem flatMap_toList (l : Array α) (f : α → List β) :
-    l.toList.flatMap f = (l.flatMap (fun a => (f a).toArray)).toList := by
-  rcases l with ⟨l⟩
-  simp
-
-@[simp] theorem toList_flatMap (l : Array α) (f : α → Array β) :
-    (l.flatMap f).toList = l.toList.flatMap fun a => (f a).toList := by
-  rcases l with ⟨l⟩
-  simp
-
-@[simp] theorem flatMap_id (l : Array (Array α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
-
-@[simp] theorem flatMap_id' (l : Array (Array α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
-
-@[simp]
-theorem size_flatMap (l : Array α) (f : α → Array β) :
-    (l.flatMap f).size = sum (map (fun a => (f a).size) l) := by
-  rcases l with ⟨l⟩
-  simp [Function.comp_def]
-
-@[simp] theorem mem_flatMap {f : α → Array β} {b} {l : Array α} : b ∈ l.flatMap f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
-  simp [flatMap_def, mem_flatten]
-  exact ⟨fun ⟨_, ⟨a, h₁, rfl⟩, h₂⟩ => ⟨a, h₁, h₂⟩, fun ⟨a, h₁, h₂⟩ => ⟨_, ⟨a, h₁, rfl⟩, h₂⟩⟩
-
-theorem exists_of_mem_flatMap {b : β} {l : Array α} {f : α → Array β} :
-    b ∈ l.flatMap f → ∃ a, a ∈ l ∧ b ∈ f a := mem_flatMap.1
-
-theorem mem_flatMap_of_mem {b : β} {l : Array α} {f : α → Array β} {a} (al : a ∈ l) (h : b ∈ f a) :
-    b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
-
-@[simp]
-theorem flatMap_eq_empty_iff {l : Array α} {f : α → Array β} : l.flatMap f = #[] ↔ ∀ x ∈ l, f x = #[] := by
-  rw [flatMap_def, flatten_eq_empty_iff]
-  simp
-
-theorem forall_mem_flatMap {p : β → Prop} {l : Array α} {f : α → Array β} :
-    (∀ (x) (_ : x ∈ l.flatMap f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
-  simp only [mem_flatMap, forall_exists_index, and_imp]
-  constructor <;> (intros; solve_by_elim)
-
-theorem flatMap_singleton (f : α → Array β) (x : α) : #[x].flatMap f = f x := by
-  simp
-
-@[simp] theorem flatMap_singleton' (l : Array α) : (l.flatMap fun x => #[x]) = l := by
-  rcases l with ⟨l⟩
-  simp
-
-@[simp] theorem flatMap_append (xs ys : Array α) (f : α → Array β) :
-    (xs ++ ys).flatMap f = xs.flatMap f ++ ys.flatMap f := by
-  rcases xs with ⟨xs⟩
-  rcases ys with ⟨ys⟩
-  simp
-
-theorem flatMap_assoc {α β} (l : Array α) (f : α → Array β) (g : β → Array γ) :
-    (l.flatMap f).flatMap g = l.flatMap fun x => (f x).flatMap g := by
-  rcases l with ⟨l⟩
-  simp [List.flatMap_assoc, ← toList_flatMap]
-
-theorem map_flatMap (f : β → γ) (g : α → Array β) (l : Array α) :
-     (l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
-  rcases l with ⟨l⟩
-  simp [List.map_flatMap]
-
-theorem flatMap_map (f : α → β) (g : β → Array γ) (l : Array α) :
-    (map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
-  rcases l with ⟨l⟩
-  simp [List.flatMap_map]
-
-theorem map_eq_flatMap {α β} (f : α → β) (l : Array α) : map f l = l.flatMap fun x => #[f x] := by
-  simp only [← map_singleton]
-  rw [← flatMap_singleton' l, map_flatMap, flatMap_singleton']
-
-theorem filterMap_flatMap {β γ} (l : Array α) (g : α → Array β) (f : β → Option γ) :
-    (l.flatMap g).filterMap f = l.flatMap fun a => (g a).filterMap f := by
-  rcases l with ⟨l⟩
-  simp [List.filterMap_flatMap]
-
-theorem filter_flatMap (l : Array α) (g : α → Array β) (f : β → Bool) :
-    (l.flatMap g).filter f = l.flatMap fun a => (g a).filter f := by
-  rcases l with ⟨l⟩
-  simp [List.filter_flatMap]
-
-theorem flatMap_eq_foldl (f : α → Array β) (l : Array α) :
-    l.flatMap f = l.foldl (fun acc a => acc ++ f a) #[] := by
-  rcases l with ⟨l⟩
-  simp only [List.flatMap_toArray, List.flatMap_eq_foldl, size_toArray, List.foldl_toArray']
-  suffices ∀ l', (List.foldl (fun acc a => acc ++ (f a).toList) l' l).toArray =
-      List.foldl (fun acc a => acc ++ f a) l'.toArray l by
-    simpa using this []
-  induction l with
-  | nil => simp
-  | cons a l ih =>
-    intro l'
-    simp [ih ((l' ++ (f a).toList)), toArray_append]
-
-/-! ### mkArray -/
-
-@[simp] theorem mkArray_one : mkArray 1 a = #[a] := rfl
-
-/-- Variant of `mkArray_succ` that prepends `a` at the beginning of the array. -/
-theorem mkArray_succ' : mkArray (n + 1) a = #[a] ++ mkArray n a := by
-  apply Array.ext'
-  simp [List.replicate_succ]
-
-@[simp] theorem mem_mkArray {a b : α} {n} : b ∈ mkArray n a ↔ n ≠ 0 ∧ b = a := by
-  unfold mkArray
-  simp only [mem_toArray, List.mem_replicate]
-
-theorem eq_of_mem_mkArray {a b : α} {n} (h : b ∈ mkArray n a) : b = a := (mem_mkArray.1 h).2
-
-theorem forall_mem_mkArray {p : α → Prop} {a : α} {n} :
-    (∀ b, b ∈ mkArray n a → p b) ↔ n = 0 ∨ p a := by
-  cases n <;> simp [mem_mkArray]
-
-@[simp] theorem mkArray_succ_ne_empty (n : Nat) (a : α) : mkArray (n+1) a ≠ #[] := by
-  simp [mkArray_succ]
-
-@[simp] theorem mkArray_eq_empty_iff {n : Nat} (a : α) : mkArray n a = #[] ↔ n = 0 := by
-  cases n <;> simp
-
-@[simp] theorem getElem?_mkArray_of_lt {n : Nat} {m : Nat} (h : m < n) : (mkArray n a)[m]? = some a := by
-  simp [getElem?_mkArray, h]
-
-@[simp] theorem mkArray_inj : mkArray n a = mkArray m b ↔ n = m ∧ (n = 0 ∨ a = b) := by
-  rw [← toList_inj]
-  simp
-
-theorem eq_mkArray_of_mem {a : α} {l : Array α} (h : ∀ (b) (_ : b ∈ l), b = a) : l = mkArray l.size a := by
-  rw [← toList_inj]
-  simpa using List.eq_replicate_of_mem (by simpa using h)
-
-theorem eq_mkArray_iff {a : α} {n} {l : Array α} :
-    l = mkArray n a ↔ l.size = n ∧ ∀ (b) (_ : b ∈ l), b = a := by
-  rw [← toList_inj]
-  simpa using List.eq_replicate_iff (l := l.toList)
-
-theorem map_eq_mkArray_iff {l : Array α} {f : α → β} {b : β} :
-    l.map f = mkArray l.size b ↔ ∀ x ∈ l, f x = b := by
-  simp [eq_mkArray_iff]
-
-@[simp] theorem map_const (l : Array α) (b : β) : map (Function.const α b) l = mkArray l.size b :=
-  map_eq_mkArray_iff.mpr fun _ _ => rfl
-
-@[simp] theorem map_const_fun (x : β) : map (Function.const α x) = (mkArray ·.size x) := by
-  funext l
-  simp
-
-/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
--- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
-theorem map_const' (l : Array α) (b : β) : map (fun _ => b) l = mkArray l.size b :=
-  map_const l b
-
-@[simp] theorem set_mkArray_self : (mkArray n a).set i a h = mkArray n a := by
-  apply Array.ext'
-  simp
-
-@[simp] theorem setIfInBounds_mkArray_self : (mkArray n a).setIfInBounds i a = mkArray n a := by
-  apply Array.ext'
-  simp
-
-@[simp] theorem mkArray_append_mkArray : mkArray n a ++ mkArray m a = mkArray (n + m) a := by
-  apply Array.ext'
-  simp
-
-theorem append_eq_mkArray_iff {l₁ l₂ : Array α} {a : α} :
-    l₁ ++ l₂ = mkArray n a ↔
-      l₁.size + l₂.size = n ∧ l₁ = mkArray l₁.size a ∧ l₂ = mkArray l₂.size a := by
-  simp [← toList_inj, List.append_eq_replicate_iff]
-
-theorem mkArray_eq_append_iff {l₁ l₂ : Array α} {a : α} :
-    mkArray n a = l₁ ++ l₂ ↔
-      l₁.size + l₂.size = n ∧ l₁ = mkArray l₁.size a ∧ l₂ = mkArray l₂.size a := by
-  rw [eq_comm, append_eq_mkArray_iff]
-
-@[simp] theorem map_mkArray : (mkArray n a).map f = mkArray n (f a) := by
-  apply Array.ext'
-  simp
-
-theorem filter_mkArray (w : stop = n) :
-    (mkArray n a).filter p 0 stop = if p a then mkArray n a else #[] := by
-  apply Array.ext'
-  simp only [w, toList_filter', toList_mkArray, List.filter_replicate]
-  split <;> simp_all
-
-@[simp] theorem filter_mkArray_of_pos (w : stop = n) (h : p a) :
-    (mkArray n a).filter p 0 stop = mkArray n a := by
-  simp [filter_mkArray, h, w]
-
-@[simp] theorem filter_mkArray_of_neg (w : stop = n) (h : ¬ p a) :
-    (mkArray n a).filter p 0 stop = #[] := by
-  simp [filter_mkArray, h, w]
-
-theorem filterMap_mkArray {f : α → Option β} (w : stop = n := by simp) :
-    (mkArray n a).filterMap f 0 stop = match f a with | none => #[] | .some b => mkArray n b := by
-  apply Array.ext'
-  simp only [w, size_mkArray, toList_filterMap', toList_mkArray, List.filterMap_replicate]
-  split <;> simp_all
-
--- This is not a useful `simp` lemma because `b` is unknown.
-theorem filterMap_mkArray_of_some {f : α → Option β} (h : f a = some b) :
-    (mkArray n a).filterMap f = mkArray n b := by
-  simp [filterMap_mkArray, h]
-
-@[simp] theorem filterMap_mkArray_of_isSome {f : α → Option β} (h : (f a).isSome) :
-    (mkArray n a).filterMap f = mkArray n (Option.get _ h) := by
-  match w : f a, h with
-  | some b, _ => simp [filterMap_mkArray, h, w]
-
-@[simp] theorem filterMap_mkArray_of_none {f : α → Option β} (h : f a = none) :
-    (mkArray n a).filterMap f = #[] := by
-  simp [filterMap_mkArray, h]
-
-@[simp] theorem flatten_mkArray_empty : (mkArray n (#[] : Array α)).flatten = #[] := by
-  rw [← toList_inj]
-  simp
-
-@[simp] theorem flatten_mkArray_singleton : (mkArray n #[a]).flatten = mkArray n a := by
-  rw [← toList_inj]
-  simp
-
-@[simp] theorem flatten_mkArray_mkArray : (mkArray n (mkArray m a)).flatten = mkArray (n * m) a := by
-  rw [← toList_inj]
-  simp
-
-theorem flatMap_mkArray {β} (f : α → Array β) : (mkArray n a).flatMap f = (mkArray n (f a)).flatten := by
-  rw [← toList_inj]
-  simp [flatMap_toList, List.flatMap_replicate]
-
-@[simp] theorem isEmpty_replicate : (mkArray n a).isEmpty = decide (n = 0) := by
-  rw [← List.toArray_replicate, List.isEmpty_toArray]
-  simp
-
-@[simp] theorem sum_mkArray_nat (n : Nat) (a : Nat) : (mkArray n a).sum = n * a := by
-  rw [← List.toArray_replicate, List.sum_toArray]
-  simp
-
-/-! Content below this point has not yet been aligned with `List`. -/
-
-/-! ### sum -/
-
-theorem sum_eq_sum_toList [Add α] [Zero α] (as : Array α) : as.toList.sum = as.sum := by
-  cases as
-  simp [Array.sum, List.sum]
 
 -- This is a duplicate of `List.toArray_toList`.
 -- It's confusing to guess which namespace this theorem should live in,
@@ -2897,6 +2212,28 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : α → α} {j : Nat} :
 
 theorem size_empty : (#[] : Array α).size = 0 := rfl
 
+/-! ### flatten -/
+
+@[simp] theorem toList_flatten {l : Array (Array α)} :
+    l.flatten.toList = (l.toList.map toList).flatten := by
+  dsimp [flatten]
+  simp only [← foldl_toList]
+  generalize l.toList = l
+  have : ∀ a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
+  exact this #[]
+  induction l with
+  | nil => simp
+  | cons h => induction h.toList <;> simp [*]
+
+theorem mem_flatten : ∀ {L : Array (Array α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
+  simp only [mem_def, toList_flatten, List.mem_flatten, List.mem_map]
+  intro l
+  constructor
+  · rintro ⟨_, ⟨s, m, rfl⟩, h⟩
+    exact ⟨s, m, h⟩
+  · rintro ⟨s, h₁, h₂⟩
+    refine ⟨s.toList, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩
+
 /-! ### extract -/
 
 theorem extract_loop_zero (as bs : Array α) (start : Nat) : extract.loop as 0 start bs = bs := by
@@ -2913,16 +2250,16 @@ theorem extract_loop_of_ge (as bs : Array α) (size start : Nat) (h : start ≥
 theorem extract_loop_eq_aux (as bs : Array α) (size start : Nat) :
     extract.loop as size start bs = bs ++ extract.loop as size start #[] := by
   induction size using Nat.recAux generalizing start bs with
-  | zero => rw [extract_loop_zero, extract_loop_zero, append_empty]
+  | zero => rw [extract_loop_zero, extract_loop_zero, append_nil]
   | succ size ih =>
     if h : start < as.size then
       rw [extract_loop_succ (h:=h), ih (bs.push _), push_eq_append_singleton]
-      rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, empty_append]
+      rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, nil_append]
       rw [append_assoc]
     else
       rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
       rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
-      rw [append_empty]
+      rw [append_nil]
 
 theorem extract_loop_eq (as bs : Array α) (size start : Nat) (h : start + size ≤ as.size) :
   extract.loop as size start bs = bs ++ as.extract start (start + size) := by
@@ -3278,6 +2615,11 @@ namespace Array
 
 /-! ### map -/
 
+theorem array_array_induction (P : Array (Array α) → Prop) (h : ∀ (xss : List (List α)), P (xss.map List.toArray).toArray)
+    (ass : Array (Array α)) : P ass := by
+  specialize h (ass.toList.map toList)
+  simpa [← toList_map, Function.comp_def, map_id] using h
+
 theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : Array β₁) (init : α) :
     (l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
   cases l; simp [List.foldl_map]
@@ -3314,6 +2656,8 @@ theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β
 
 /-! ### flatten -/
 
+@[simp] theorem flatten_empty : flatten (#[] : Array (Array α)) = #[] := rfl
+
 @[simp] theorem flatten_toArray_map_toArray (xss : List (List α)) :
     (xss.map List.toArray).toArray.flatten = xss.flatten.toArray := by
   simp [flatten]
@@ -3324,6 +2668,12 @@ theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β
   | nil => simp
   | cons xs xss ih => simp [ih]
 
+/-! ### mkArray -/
+
+@[simp] theorem mem_mkArray (a : α) (n : Nat) : b ∈ mkArray n a ↔ n ≠ 0 ∧ b = a := by
+  rw [mkArray, mem_toArray]
+  simp
+
 /-! ### reverse -/
 
 @[simp] theorem mem_reverse {x : α} {as : Array α} : x ∈ as.reverse ↔ x ∈ as := by

src/Init/Data/BitVec/Lemmas.lean

@@ -3539,7 +3539,7 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
 
 /-! ### Non-overflow theorems -/
 
-/-- If `x.toNat + y.toNat < 2^w`, then the addition `(x + y)` does not overflow. -/
+/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
 theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
     (x + y).toNat = x.toNat + y.toNat := by
   rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]

src/Init/Data/List/Basic.lean

@@ -606,11 +606,11 @@ set_option linter.missingDocs false in
 to get a list of lists, and then concatenates them all together.
 * `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
 -/
-@[inline] def flatMap {α : Type u} {β : Type v} (b : α → List β) (a : List α) : List β := flatten (map b a)
+@[inline] def flatMap {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := flatten (map b a)
 
-@[simp] theorem flatMap_nil (f : α → List β) : List.flatMap f [] = [] := by simp [flatten, List.flatMap]
+@[simp] theorem flatMap_nil (f : α → List β) : List.flatMap [] f = [] := by simp [flatten, List.flatMap]
 @[simp] theorem flatMap_cons x xs (f : α → List β) :
-  List.flatMap f (x :: xs) = f x ++ List.flatMap f xs := by simp [flatten, List.flatMap]
+  List.flatMap (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
 
 set_option linter.missingDocs false in
 @[deprecated flatMap (since := "2024-10-16")] abbrev bind := @flatMap

src/Init/Data/List/Impl.lean

@@ -96,14 +96,14 @@ The following operations are given `@[csimp]` replacements below:
 /-! ### flatMap  -/
 
 /-- Tail recursive version of `List.flatMap`. -/
-@[inline] def flatMapTR (f : α → List β) (as : List α) : List β := go as #[] where
+@[inline] def flatMapTR (as : List α) (f : α → List β) : List β := go as #[] where
   /-- Auxiliary for `flatMap`: `flatMap.go f as = acc.toList ++ bind f as` -/
   @[specialize] go : List α → Array β → List β
   | [], acc => acc.toList
   | x::xs, acc => go xs (acc ++ f x)
 
 @[csimp] theorem flatMap_eq_flatMapTR : @List.flatMap = @flatMapTR := by
-  funext α β f as
+  funext α β as f
   let rec go : ∀ as acc, flatMapTR.go f as acc = acc.toList ++ as.flatMap f
     | [], acc => by simp [flatMapTR.go, flatMap]
     | x::xs, acc => by simp [flatMapTR.go, flatMap, go xs]
@@ -112,7 +112,7 @@ The following operations are given `@[csimp]` replacements below:
 /-! ### flatten -/
 
 /-- Tail recursive version of `List.flatten`. -/
-@[inline] def flattenTR (l : List (List α)) : List α := l.flatMapTR id
+@[inline] def flattenTR (l : List (List α)) : List α := flatMapTR l id
 
 @[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
   funext α l; rw [← List.flatMap_id, List.flatMap_eq_flatMapTR]; rfl

src/Init/Data/List/Lemmas.lean

@@ -1076,31 +1076,9 @@ theorem forall_mem_map {f : α → β} {l : List α} {P : β → Prop} :
 
 @[deprecated forall_mem_map (since := "2024-07-25")] abbrev forall_mem_map_iff := @forall_mem_map
 
-@[simp] theorem map_eq_nil_iff {f : α → β} {l : List α} : map f l = [] ↔ l = [] := by
-  constructor <;> exact fun _ => match l with | [] => rfl
-
-@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
-
-theorem eq_nil_of_map_eq_nil {f : α → β} {l : List α} (h : map f l = []) : l = [] :=
-  map_eq_nil_iff.mp h
-
 @[simp] theorem map_inj_left {f g : α → β} : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
   induction l <;> simp_all
 
-theorem map_inj_right {f : α → β} (w : ∀ x y, f x = f y → x = y) : map f l = map f l' ↔ l = l' := by
-  induction l generalizing l' with
-  | nil => simp
-  | cons a l ih =>
-    simp only [map_cons]
-    cases l' with
-    | nil => simp
-    | cons a' l' =>
-      simp only [map_cons, cons.injEq, ih, and_congr_left_iff]
-      intro h
-      constructor
-      · apply w
-      · simp +contextual
-
 theorem map_congr_left (h : ∀ a ∈ l, f a = g a) : map f l = map g l :=
   map_inj_left.2 h
 
@@ -1109,6 +1087,14 @@ theorem map_inj : map f = map g ↔ f = g := by
   · intro h; ext a; replace h := congrFun h [a]; simpa using h
   · intro h; subst h; rfl
 
+@[simp] theorem map_eq_nil_iff {f : α → β} {l : List α} : map f l = [] ↔ l = [] := by
+  constructor <;> exact fun _ => match l with | [] => rfl
+
+@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
+
+theorem eq_nil_of_map_eq_nil {f : α → β} {l : List α} (h : map f l = []) : l = [] :=
+  map_eq_nil_iff.mp h
+
 theorem map_eq_cons_iff {f : α → β} {l : List α} :
     map f l = b :: l₂ ↔ ∃ a l₁, l = a :: l₁ ∧ f a = b ∧ map f l₁ = l₂ := by
   cases l
@@ -1508,34 +1494,6 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
 @[simp] theorem cons_append_fun (a : α) (as : List α) :
     (fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
 
-@[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
-  induction s <;> simp_all [or_assoc]
-
-theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
-  mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
-
-@[deprecated mem_append (since := "2025-01-13")]
-theorem mem_append_eq (a : α) (s t : List α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
-  propext mem_append
-
-@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
-@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
-
-/--
-See also `eq_append_cons_of_mem`, which proves a stronger version
-in which the initial list must not contain the element.
--/
-theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t
-  | .head l => ⟨[], l, rfl⟩
-  | .tail b h => let ⟨s, t, h'⟩ := append_of_mem h; ⟨b::s, t, by rw [h', cons_append]⟩
-
-theorem mem_iff_append {a : α} {l : List α} : a ∈ l ↔ ∃ s t : List α, l = s ++ a :: t :=
-  ⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
-
-theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} :
-    (∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
-  simp only [mem_append, or_imp, forall_and]
-
 theorem getElem_append {l₁ l₂ : List α} (i : Nat) (h : i < (l₁ ++ l₂).length) :
     (l₁ ++ l₂)[i] = if h' : i < l₁.length then l₁[i] else l₂[i - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
   split <;> rename_i h'
@@ -1603,6 +1561,14 @@ theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.lengt
     l.get ⟨i, get_of_append_proof eq h⟩ = a := Option.some.inj <| by
   rw [← get?_eq_get, eq, get?_append_right (h ▸ Nat.le_refl _), h, Nat.sub_self]; rfl
 
+/--
+See also `eq_append_cons_of_mem`, which proves a stronger version
+in which the initial list must not contain the element.
+-/
+theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t
+  | .head l => ⟨[], l, rfl⟩
+  | .tail b h => let ⟨s, t, h'⟩ := append_of_mem h; ⟨b::s, t, by rw [h', cons_append]⟩
+
 @[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
 
 theorem append_inj :
@@ -1619,8 +1585,8 @@ theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = le
 
 /-- Variant of `append_inj` instead requiring equality of the lengths of the second lists. -/
 theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ :=
-  append_inj h <| @Nat.add_right_cancel _ t₁.length _ <| by
-    let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
+  append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
+  let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
 
 /-- Variant of `append_inj_right` instead requiring equality of the lengths of the second lists. -/
 theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
@@ -1648,6 +1614,9 @@ theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s
 @[simp] theorem self_eq_append_right {x y : List α} : x = x ++ y ↔ y = [] := by
   rw [eq_comm, append_right_eq_self]
 
+@[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by
+  cases p <;> simp
+
 theorem getLast_concat {a : α} : ∀ (l : List α), getLast (l ++ [a]) (by simp) = a
   | [] => rfl
   | a::t => by
@@ -1673,54 +1642,6 @@ theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
     (l₁ ++ l₂).get? n = l₁.get? n := by
   simp [getElem?_append_left hn]
 
-@[simp] theorem append_eq_nil_iff : p ++ q = [] ↔ p = [] ∧ q = [] := by
-  cases p <;> simp
-
-@[deprecated append_eq_nil_iff (since := "2025-01-13")] abbrev append_eq_nil := @append_eq_nil_iff
-
-@[simp] theorem nil_eq_append_iff : [] = a ++ b ↔ a = [] ∧ b = [] := by
-  rw [eq_comm, append_eq_nil_iff]
-
-@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
-
-theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
-theorem append_ne_nil_of_right_ne_nil (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
-
-@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
-theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
-@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
-theorem append_ne_nil_of_ne_nil_right (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
-
-theorem append_eq_cons_iff :
-    a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
-  cases a with simp | cons a as => ?_
-  exact ⟨fun h => ⟨as, by simp [h]⟩, fun ⟨a', ⟨aeq, aseq⟩, h⟩ => ⟨aeq, by rw [aseq, h]⟩⟩
-
-@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
-
-theorem cons_eq_append_iff :
-    x :: c = a ++ b ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
-  rw [eq_comm, append_eq_cons_iff]
-
-@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
-
-theorem append_eq_singleton_iff :
-    a ++ b = [x] ↔ (a = [] ∧ b = [x]) ∨ (a = [x] ∧ b = []) := by
-  cases a <;> cases b <;> simp
-
-theorem singleton_eq_append_iff :
-    [x] = a ++ b ↔ (a = [] ∧ b = [x]) ∨ (a = [x] ∧ b = []) := by
-  cases a <;> cases b <;> simp [eq_comm]
-
-theorem append_eq_append_iff {a b c d : List α} :
-    a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
-  induction a generalizing c with
-  | nil => simp_all
-  | cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
-
-@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
-@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
-
 @[simp] theorem head_append_of_ne_nil {l : List α} {w₁} (w₂) :
     head (l ++ l') w₁ = head l w₂ := by
   match l, w₂ with
@@ -1770,6 +1691,60 @@ theorem tail_append {l l' : List α} : (l ++ l').tail = if l.isEmpty then l'.tai
 
 @[deprecated tail_append_of_ne_nil (since := "2024-07-24")] abbrev tail_append_left := @tail_append_of_ne_nil
 
+theorem nil_eq_append_iff : [] = a ++ b ↔ a = [] ∧ b = [] := by
+  rw [eq_comm, append_eq_nil]
+
+@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
+
+theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
+theorem append_ne_nil_of_right_ne_nil (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
+
+@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
+theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
+@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
+theorem append_ne_nil_of_ne_nil_right (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
+
+theorem append_eq_cons_iff :
+    a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
+  cases a with simp | cons a as => ?_
+  exact ⟨fun h => ⟨as, by simp [h]⟩, fun ⟨a', ⟨aeq, aseq⟩, h⟩ => ⟨aeq, by rw [aseq, h]⟩⟩
+
+@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
+
+theorem cons_eq_append_iff :
+    x :: c = a ++ b ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
+  rw [eq_comm, append_eq_cons_iff]
+
+@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
+
+theorem append_eq_append_iff {a b c d : List α} :
+    a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
+  induction a generalizing c with
+  | nil => simp_all
+  | cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
+
+@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
+@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
+
+@[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
+  induction s <;> simp_all [or_assoc]
+
+theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
+  mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
+
+theorem mem_append_eq (a : α) (s t : List α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
+  propext mem_append
+
+@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
+@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
+
+theorem mem_iff_append {a : α} {l : List α} : a ∈ l ↔ ∃ s t : List α, l = s ++ a :: t :=
+  ⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
+
+theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} :
+    (∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
+  simp only [mem_append, or_imp, forall_and]
+
 theorem set_append {s t : List α} :
     (s ++ t).set i x = if i < s.length then s.set i x ++ t else s ++ t.set (i - s.length) x := by
   induction s generalizing i with
@@ -1898,7 +1873,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∨ ∃ L b, l = concat L b
 
 /-! ### flatten -/
 
-@[simp] theorem length_flatten (L : List (List α)) : L.flatten.length = (L.map length).sum := by
+@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
   induction L with
   | nil => rfl
   | cons =>
@@ -1913,9 +1888,6 @@ theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
 @[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] ↔ ∀ l ∈ L, l = [] := by
   induction L <;> simp_all
 
-@[simp] theorem nil_eq_flatten_iff {L : List (List α)} : [] = L.flatten ↔ ∀ l ∈ L, l = [] := by
-  rw [eq_comm, flatten_eq_nil_iff]
-
 theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten ≠ [] ↔ ∃ x, x ∈ xs ∧ x ≠ [] := by
   simp
 
@@ -1941,8 +1913,7 @@ theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun
 -- `getLast?_flatten` is proved later, after the `reverse` section.
 -- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
 
-@[simp] theorem map_flatten (f : α → β) (L : List (List α)) :
-    (flatten L).map f = (map (map f) L).flatten := by
+@[simp] theorem map_flatten (f : α → β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
   induction L <;> simp_all
 
 @[simp] theorem filterMap_flatten (f : α → Option β) (L : List (List α)) :
@@ -1995,26 +1966,6 @@ theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
   · rintro ⟨as, bs, cs, rfl, h₁, rfl⟩
     simp [flatten_eq_nil_iff.mpr h₁]
 
-theorem cons_eq_flatten_iff {xs : List (List α)} {y : α} {ys : List α} :
-    y :: ys = xs.flatten ↔
-      ∃ as bs cs, xs = as ++ (y :: bs) :: cs ∧ (∀ l, l ∈ as → l = []) ∧ ys = bs ++ cs.flatten := by
-  rw [eq_comm, flatten_eq_cons_iff]
-
-theorem flatten_eq_singleton_iff {xs : List (List α)} {y : α} :
-    xs.flatten = [y] ↔ ∃ as bs, xs = as ++ [y] :: bs ∧ (∀ l, l ∈ as → l = []) ∧ (∀ l, l ∈ bs → l = []) := by
-  rw [flatten_eq_cons_iff]
-  constructor
-  · rintro ⟨as, bs, cs, rfl, h₁, h₂⟩
-    simp at h₂
-    obtain ⟨rfl, h₂⟩ := h₂
-    exact ⟨as, cs, by simp, h₁, h₂⟩
-  · rintro ⟨as, bs, rfl, h₁, h₂⟩
-    exact ⟨as, [], bs, rfl, h₁, by simpa⟩
-
-theorem singleton_eq_flatten_iff {xs : List (List α)} {y : α} :
-    [y] = xs.flatten ↔ ∃ as bs, xs = as ++ [y] :: bs ∧ (∀ l, l ∈ as → l = []) ∧ (∀ l, l ∈ bs → l = []) := by
-  rw [eq_comm, flatten_eq_singleton_iff]
-
 theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
     xs.flatten = ys ++ zs ↔
       (∃ as bs, xs = as ++ bs ∧ ys = as.flatten ∧ zs = bs.flatten) ∨
@@ -2023,8 +1974,8 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
   constructor
   · induction xs generalizing ys with
     | nil =>
-      simp only [flatten_nil, nil_eq, append_eq_nil_iff, and_false, cons_append, false_and,
-        exists_const, exists_false, or_false, and_imp, List.cons_ne_nil]
+      simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
+        exists_false, or_false, and_imp, List.cons_ne_nil]
       rintro rfl rfl
       exact ⟨[], [], by simp⟩
     | cons x xs ih =>
@@ -2043,13 +1994,6 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
     · simp
     · simp
 
-theorem append_eq_flatten_iff {xs : List (List α)} {ys zs : List α} :
-    ys ++ zs = xs.flatten ↔
-      (∃ as bs, xs = as ++ bs ∧ ys = as.flatten ∧ zs = bs.flatten) ∨
-        ∃ as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ∧ ys = as.flatten ++ bs ∧
-          zs = c :: cs ++ ds.flatten := by
-  rw [eq_comm, flatten_eq_append_iff]
-
 /-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
 sublists. -/
 theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
@@ -2070,14 +2014,12 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
 
 theorem flatMap_def (l : List α) (f : α → List β) : l.flatMap f = flatten (map f l) := by rfl
 
-@[simp] theorem flatMap_id (l : List (List α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
-
-@[simp] theorem flatMap_id' (l : List (List α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
+@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
 
 @[simp]
 theorem length_flatMap (l : List α) (f : α → List β) :
-    length (l.flatMap f) = sum (map (fun a => (f a).length) l) := by
-  rw [List.flatMap, length_flatten, map_map, Function.comp_def]
+    length (l.flatMap f) = sum (map (length ∘ f) l) := by
+  rw [List.flatMap, length_flatten, map_map]
 
 @[simp] theorem mem_flatMap {f : α → List β} {b} {l : List α} : b ∈ l.flatMap f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
   simp [flatMap_def, mem_flatten]
@@ -2090,7 +2032,7 @@ theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al :
     b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
 
 @[simp]
-theorem flatMap_eq_nil_iff {l : List α} {f : α → List β} : l.flatMap f = [] ↔ ∀ x ∈ l, f x = [] :=
+theorem flatMap_eq_nil_iff {l : List α} {f : α → List β} : List.flatMap l f = [] ↔ ∀ x ∈ l, f x = [] :=
   flatten_eq_nil_iff.trans <| by
     simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
 
@@ -2274,7 +2216,7 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
   · intro i h₁ h₂
     simp [getElem_set]
 
-@[simp] theorem replicate_append_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
+@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
   rw [eq_replicate_iff]
   constructor
   · simp
@@ -2282,9 +2224,6 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
     simp only [mem_append, mem_replicate, ne_eq]
     rintro (⟨-, rfl⟩ | ⟨_, rfl⟩) <;> rfl
 
-@[deprecated replicate_append_replicate (since := "2025-01-16")]
-abbrev append_replicate_replicate := @replicate_append_replicate
-
 theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
     l₁ ++ l₂ = replicate n a ↔
       l₁.length + l₂.length = n ∧ l₁ = replicate l₁.length a ∧ l₂ = replicate l₂.length a := by
@@ -2295,11 +2234,6 @@ theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
 
 @[deprecated append_eq_replicate_iff (since := "2024-09-05")] abbrev append_eq_replicate := @append_eq_replicate_iff
 
-theorem replicate_eq_append_iff {l₁ l₂ : List α} {a : α} :
-    replicate n a = l₁ ++ l₂ ↔
-      l₁.length + l₂.length = n ∧ l₁ = replicate l₁.length a ∧ l₂ = replicate l₂.length a := by
-  rw [eq_comm, append_eq_replicate_iff]
-
 @[simp] theorem map_replicate : (replicate n a).map f = replicate n (f a) := by
   ext1 n
   simp only [getElem?_map, getElem?_replicate]
@@ -2351,7 +2285,7 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
   induction n with
   | zero => simp
   | succ n ih =>
-    simp only [replicate_succ, flatten_cons, ih, replicate_append_replicate, replicate_inj, or_true,
+    simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
       and_true, add_one_mul, Nat.add_comm]
 
 theorem flatMap_replicate {β} (f : α → List β) : (replicate n a).flatMap f = (replicate n (f a)).flatten := by
@@ -2403,9 +2337,6 @@ theorem replicateRecOn {α : Type _} {p : List α → Prop} (m : List α)
     exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
 termination_by m.length
 
-@[simp] theorem sum_replicate_nat (n : Nat) (a : Nat) : (replicate n a).sum = n * a := by
-  induction n <;> simp_all [replicate_succ, Nat.add_mul, Nat.add_comm]
-
 /-! ### reverse -/
 
 @[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by

src/Init/Data/List/ToArray.lean

@@ -143,9 +143,6 @@ 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 [Array.sum, List.sum]
-
 @[simp] theorem append_toArray (l₁ l₂ : List α) :
     l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
   apply ext'
@@ -397,24 +394,4 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
 @[deprecated toArray_replicate (since := "2024-12-13")]
 abbrev _root_.Array.mkArray_eq_toArray_replicate := @toArray_replicate
 
-@[simp] 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
-  simp [Array.flatMap]
-  suffices ∀ cs, List.foldl (fun bs a => bs ++ f a) (f a ++ cs) as =
-      f a ++ List.foldl (fun bs a => bs ++ f a) cs as by
-    erw [empty_append] -- Why doesn't this work via `simp`?
-    simpa using this #[]
-  intro cs
-  induction as generalizing cs <;> simp_all
-
-@[simp] 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
-  | cons a as ih =>
-    apply ext'
-    simp [ih, flatMap_toArray_cons]
-
 end List

src/Init/Data/List/Zip.lean

@@ -203,11 +203,11 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
     cases l₂ with
     | nil =>
       constructor
-      · simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, exists_and_left, and_imp]
+      · simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
         rintro rfl  rfl
         exact ⟨[], x₁ :: l₁, [], by simp⟩
       · rintro ⟨w, x, y, z, h₁, _, h₃, rfl, rfl⟩
-        simp only [nil_eq, append_eq_nil_iff] at h₃
+        simp only [nil_eq, append_eq_nil] at h₃
         obtain ⟨rfl, rfl⟩ := h₃
         simp
     | cons x₂ l₂ =>

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

@@ -711,32 +711,6 @@ theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^
   rw [mod_two_eq_one_iff_testBit_zero, testBit_shiftLeft]
   simp
 
-theorem testBit_mul_two_pow (x i n : Nat) :
-    (x * 2 ^ n).testBit i = (decide (n ≤ i) && x.testBit (i - n)) := by
-  rw [← testBit_shiftLeft, shiftLeft_eq]
-
-theorem bitwise_mul_two_pow (of_false_false : f false false = false := by rfl) :
-    (bitwise f x y) * 2 ^ n = bitwise f (x * 2 ^ n) (y * 2 ^ n) := by
-  apply Nat.eq_of_testBit_eq
-  simp only [testBit_mul_two_pow, testBit_bitwise of_false_false, Bool.if_false_right]
-  intro i
-  by_cases hn : n ≤ i
-  · simp [hn]
-  · simp [hn, of_false_false]
-
-theorem shiftLeft_bitwise_distrib {a b : Nat} (of_false_false : f false false = false := by rfl) :
-    (bitwise f a b) <<< i = bitwise f (a <<< i) (b <<< i) := by
-  simp [shiftLeft_eq, bitwise_mul_two_pow of_false_false]
-
-theorem shiftLeft_and_distrib {a b : Nat} : (a &&& b) <<< i = a <<< i &&& b <<< i :=
-  shiftLeft_bitwise_distrib
-
-theorem shiftLeft_or_distrib {a b : Nat} : (a ||| b) <<< i = a <<< i ||| b <<< i :=
-  shiftLeft_bitwise_distrib
-
-theorem shiftLeft_xor_distrib {a b : Nat} : (a ^^^ b) <<< i = a <<< i ^^^ b <<< i :=
-  shiftLeft_bitwise_distrib
-
 @[simp] theorem decide_shiftRight_mod_two_eq_one :
     decide (x >>> i % 2 = 1) = x.testBit i := by
   simp only [testBit, one_and_eq_mod_two, mod_two_bne_zero]

src/Init/Data/Nat/Lemmas.lean

@@ -622,14 +622,6 @@ protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by
     0 < a * b ↔ 0 < a :=
   ⟨Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h⟩
 
-protected theorem pos_of_lt_mul_left {a b c : Nat} (h : a < b * c) : 0 < c := by
-  replace h : 0 < b * c := by omega
-  exact Nat.pos_of_mul_pos_left h
-
-protected theorem pos_of_lt_mul_right {a b c : Nat} (h : a < b * c) : 0 < b := by
-  replace h : 0 < b * c := by omega
-  exact Nat.pos_of_mul_pos_right h
-
 /-! ### div/mod -/
 
 theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 :=

src/Init/Data/Option/Lemmas.lean

@@ -208,15 +208,6 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
 
 theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..
 
-theorem map_inj_right {f : α → β} {o o' : Option α} (w : ∀ x y, f x = f y → x = y) :
-    o.map f = o'.map f ↔ o = o' := by
-  cases o with
-  | none => cases o' <;> simp
-  | some a =>
-    cases o' with
-    | none => simp
-    | some a' => simpa using ⟨fun h => w _ _ h, fun h => congrArg f h⟩
-
 @[simp] theorem map_if {f : α → β} [Decidable c] :
      (if c then some a else none).map f = if c then some (f a) else none := by
   split <;> rfl
@@ -638,15 +629,6 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → a ∈ o → Option
     · rintro ⟨h, rfl⟩
       rfl
 
-@[simp]
-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) :
-    Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
-  cases o <;> simp
-
 /-! ### pelim -/
 
 @[simp] theorem pelim_none : pelim none b f = b := rfl

src/Init/Data/UInt/Bitwise.lean

@@ -13,17 +13,11 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
 `(
 namespace $typeName
 
-@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
-@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
+@[simp] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
+@[simp] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
+@[simp] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
+@[simp] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
+@[simp] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
 
 @[simp] protected theorem toNat_and (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := by simp [toNat]
 @[simp] protected theorem toNat_or (a b : $typeName) : (a ||| b).toNat = a.toNat ||| b.toNat := by simp [toNat]
@@ -43,31 +37,3 @@ declare_bitwise_uint_theorems UInt16 16
 declare_bitwise_uint_theorems UInt32 32
 declare_bitwise_uint_theorems UInt64 64
 declare_bitwise_uint_theorems USize System.Platform.numBits
-
-@[simp, int_toBitVec]
-theorem Bool.toBitVec_toUInt8 {b : Bool} :
-    b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
-  cases b <;> simp [toUInt8]
-
-@[simp, int_toBitVec]
-theorem Bool.toBitVec_toUInt16 {b : Bool} :
-    b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
-  cases b <;> simp [toUInt16]
-
-@[simp, int_toBitVec]
-theorem Bool.toBitVec_toUInt32 {b : Bool} :
-    b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
-  cases b <;> simp [toUInt32]
-
-@[simp, int_toBitVec]
-theorem Bool.toBitVec_toUInt64 {b : Bool} :
-    b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
-  cases b <;> simp [toUInt64]
-
-@[simp, int_toBitVec]
-theorem Bool.toBitVec_toUSize {b : Bool} :
-    b.toUSize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
-  cases b
-  · simp [toUSize]
-  · apply BitVec.eq_of_toNat_eq
-    simp [toUSize]

src/Init/Data/UInt/Lemmas.lean

@@ -41,9 +41,9 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
     rw [toNat, toBitVec_eq_of_lt h]
 
-  @[int_toBitVec] theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
+  theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
 
-  @[int_toBitVec] theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
+  theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
 
   theorem le_iff_toNat_le {a b : $typeName} : a ≤ b ↔ a.toNat ≤ b.toNat := .rfl
 
@@ -74,11 +74,6 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   protected theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec ↔ a = b :=
     Iff.intro eq_of_toBitVec_eq toBitVec_eq_of_eq
 
-  open $typeName (eq_of_toBitVec_eq toBitVec_eq_of_eq) in
-  @[int_toBitVec]
-  protected theorem eq_iff_toBitVec_eq {a b : $typeName} : a = b ↔ a.toBitVec = b.toBitVec :=
-    Iff.intro toBitVec_eq_of_eq eq_of_toBitVec_eq
-
   open $typeName (eq_of_toBitVec_eq) in
   protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by
     rcases a with ⟨⟨_⟩⟩; rcases b with ⟨⟨_⟩⟩; simp_all [val]
@@ -87,19 +82,10 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   protected theorem val_inj {a b : $typeName} : a.val = b.val ↔ a = b :=
     Iff.intro eq_of_val_eq (congrArg val)
 
-  open $typeName (eq_of_toBitVec_eq) in
-  protected theorem toBitVec_ne_of_ne {a b : $typeName} (h : a ≠ b) : a.toBitVec ≠ b.toBitVec :=
-    fun h' => h (eq_of_toBitVec_eq h')
-
   open $typeName (toBitVec_eq_of_eq) in
   protected theorem ne_of_toBitVec_ne {a b : $typeName} (h : a.toBitVec ≠ b.toBitVec) : a ≠ b :=
     fun h' => absurd (toBitVec_eq_of_eq h') h
 
-  open $typeName (ne_of_toBitVec_ne toBitVec_ne_of_ne) in
-  @[int_toBitVec]
-  protected theorem ne_iff_toBitVec_ne {a b : $typeName} : a ≠ b ↔ a.toBitVec ≠ b.toBitVec :=
-    Iff.intro toBitVec_ne_of_ne ne_of_toBitVec_ne
-
   open $typeName (ne_of_toBitVec_ne) in
   protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := by
     apply ne_of_toBitVec_ne
@@ -173,7 +159,7 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   @[simp]
   theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
 
-  @[simp, int_toBitVec]
+  @[simp]
   theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
 
   @[simp]

src/Init/Data/Vector/Basic.lean

@@ -170,13 +170,6 @@ result is empty. If `stop` is greater than the size of the vector, the size is u
 @[inline] def map (f : α → β) (v : Vector α n) : Vector β n :=
   ⟨v.toArray.map f, by simp⟩
 
-@[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
-  ⟨(v.toArray.map Vector.toArray).flatten,
-    by rcases v; simp_all [Function.comp_def, Array.map_const']⟩
-
-@[inline] def flatMap (v : Vector α n) (f : α → Vector β m) : Vector β (n * m) :=
-  ⟨v.toArray.flatMap fun a => (f a).toArray, by simp [Array.map_const']⟩
-
 /-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
 @[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α → β → φ) : Vector φ n :=
   ⟨Array.zipWith a.toArray b.toArray f, by simp⟩

src/Init/Data/Vector/Lemmas.lean

@@ -5,7 +5,6 @@ Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
 -/
 prelude
 import Init.Data.Vector.Basic
-import Init.Data.Array.Attach
 
 /-!
 ## Vectors
@@ -28,9 +27,6 @@ namespace Vector
 
 theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a := rfl
 
-@[simp] theorem mk_toArray (v : Vector α n) : mk v.toArray v.2 = v := by
-  rfl
-
 @[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) :
     (Vector.mk data size)[i] = data[i] := rfl
 
@@ -475,7 +471,7 @@ theorem singleton_inj : #v[a] = #v[b] ↔ a = b := by
 theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
   simp [mkVector, Array.mkArray_succ]
 
-@[simp] theorem mkVector_inj : mkVector n a = mkVector n b ↔ n = 0 ∨ a = b := by
+theorem mkVector_inj : mkVector n a = mkVector n b ↔ n = 0 ∨ a = b := by
   simp [← toArray_inj, toArray_mkVector, Array.mkArray_inj]
 
 /-! ## L[i] and L[i]? -/
@@ -697,24 +693,6 @@ theorem forall_getElem {l : Vector α n} {p : α → Prop} :
   rcases l with ⟨l, rfl⟩
   simp [Array.forall_getElem]
 
-
-/-! ### cast -/
-
-@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
-    (a.cast h)[i] = a[i] := by
-  cases a
-  simp
-
-@[simp] theorem getElem?_cast {l : Vector α n} {m : Nat} {w : n = m} {i : Nat} :
-    (l.cast w)[i]? = l[i]? := by
-  rcases l with ⟨l, rfl⟩
-  simp
-
-@[simp] theorem mem_cast {a : α} {l : Vector α n} {m : Nat} {w : n = m} :
-    a ∈ l.cast w ↔ a ∈ l := by
-  rcases l with ⟨l, rfl⟩
-  simp
-
 /-! ### Decidability of bounded quantifiers -/
 
 instance {xs : Vector α n} {p : α → Prop} [DecidablePred p] :
@@ -1119,11 +1097,6 @@ theorem forall_mem_map {f : α → β} {l : Vector α n} {P : β → Prop} :
 @[simp] theorem map_inj_left {f g : α → β} : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
   cases l <;> simp_all
 
-theorem map_inj_right {f : α → β} (w : ∀ x y, f x = f y → x = y) : map f l = map f l' ↔ l = l' := by
-  cases l
-  cases l'
-  simp [Array.map_inj_right w]
-
 theorem map_congr_left (h : ∀ a ∈ l, f a = g a) : map f l = map g l :=
   map_inj_left.2 h
 
@@ -1194,558 +1167,6 @@ theorem map_eq_iff {f : α → β} {l : Vector α n} {l' : Vector β n} :
   cases as
   simp
 
-/--
-Use this as `induction ass using vector₂_induction` on a hypothesis of the form `ass : Vector (Vector α n) m`.
-The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array α)`
-along with additional hypotheses `h₁ : ass.size = m` and `h₂ : ∀ xs ∈ ass, xs.size = n`.
-Appearances of the original `ass` in the goal will be replaced with
-`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk xs ⋯)) ⋯`.
--/
--- We can't use `@[cases_eliminator]` here as
--- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
-theorem vector₂_induction (P : Vector (Vector α n) m → Prop)
-    (of : ∀ (xss : Array (Array α)) (h₁ : xss.size = m) (h₂ : ∀ xs ∈ xss, xs.size = n),
-      P (mk (xss.attach.map (fun ⟨xs, m⟩ => mk xs (h₂ xs m))) (by simpa using h₁)))
-    (ass : Vector (Vector α n) m) : P ass := by
-  specialize of (ass.map toArray).toArray (by simp) (by simp)
-  simpa [Array.map_attach, Array.pmap_map] using of
-
-/--
-Use this as `induction ass using vector₃_induction` on a hypothesis of the form `ass : Vector (Vector (Vector α n) m) k`.
-The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array (Array α))`
-along with additional hypotheses `h₁ : ass.size = k`, `h₂ : ∀ xs ∈ ass, xs.size = m`,
-and `h₃ : ∀ xs ∈ ass, ∀ x ∈ xs, x.size = n`.
-Appearances of the original `ass` in the goal will be replaced with
-`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk (xs.attach.map (fun ⟨x, m'⟩ => Vector.mk x ⋯)) ⋯)) ⋯`.
--/
-theorem vector₃_induction (P : Vector (Vector (Vector α n) m) k → Prop)
-    (of : ∀ (xss : Array (Array (Array α))) (h₁ : xss.size = k) (h₂ : ∀ xs ∈ xss, xs.size = m)
-      (h₃ : ∀ xs ∈ xss, ∀ x ∈ xs, x.size = n),
-      P (mk (xss.attach.map (fun ⟨xs, m⟩ =>
-        mk (xs.attach.map (fun ⟨x, m'⟩ =>
-          mk x (h₃ xs m x m'))) (by simpa using h₂ xs m))) (by simpa using h₁)))
-    (ass : Vector (Vector (Vector α n) m) k) : P ass := by
-  specialize of (ass.map (fun as => (as.map toArray).toArray)).toArray (by simp) (by simp) (by simp)
-  simpa [Array.map_attach, Array.pmap_map] using of
-
-/-! ### singleton -/
-
-@[simp] theorem singleton_def (v : α) : Vector.singleton v = #v[v] := rfl
-
-/-! ### append -/
-
-@[simp] theorem append_push {as : Vector α n} {bs : Vector α m} {a : α} :
-    as ++ bs.push a = (as ++ bs).push a := by
-  cases as
-  cases bs
-  simp
-
-theorem singleton_eq_toVector_singleton (a : α) : #v[a] = #[a].toVector := rfl
-
-@[simp] theorem mem_append {a : α} {s : Vector α n} {t : Vector α m} :
-    a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
-  cases s
-  cases t
-  simp
-
-theorem mem_append_left {a : α} {s : Vector α n} {t : Vector α m} (h : a ∈ s) : a ∈ s ++ t :=
-  mem_append.2 (Or.inl h)
-
-theorem mem_append_right {a : α} {s : Vector α n} {t : Vector α m} (h : a ∈ t) : a ∈ s ++ t :=
-  mem_append.2 (Or.inr h)
-
-theorem not_mem_append {a : α} {s : Vector α n} {t : Vector α m} (h₁ : a ∉ s) (h₂ : a ∉ t) :
-    a ∉ s ++ t :=
-  mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
-
-/--
-See also `eq_push_append_of_mem`, which proves a stronger version
-in which the initial array must not contain the element.
--/
-theorem append_of_mem {a : α} {l : Vector α n} (h : a ∈ l) :
-    ∃ (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
-      l = (s.push a ++ t).cast w := by
-  rcases l with ⟨l, rfl⟩
-  obtain ⟨s, t, rfl⟩ := Array.append_of_mem (by simpa using h)
-  refine ⟨_, _, by simp, s.toVector, t.toVector, by simp_all⟩
-
-theorem mem_iff_append {a : α} {l : Vector α n} :
-    a ∈ l ↔ ∃ (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
-      l = (s.push a ++ t).cast w :=
-  ⟨append_of_mem, by rintro ⟨m, k, rfl, s, t, rfl⟩; simp⟩
-
-theorem forall_mem_append {p : α → Prop} {l₁ : Vector α n} {l₂ : Vector α m} :
-    (∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
-  simp only [mem_append, or_imp, forall_and]
-
-theorem empty_append (as : Vector α n) : (#v[] : Vector α 0) ++ as = as.cast (by omega) := by
-  rcases as with ⟨as, rfl⟩
-  simp
-
-theorem append_empty (as : Vector α n) : as ++ (#v[] : Vector α 0) = as := by
-  rw [← toArray_inj, toArray_append, Array.append_empty]
-
-theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
-    (a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
-  rcases a with ⟨a, rfl⟩
-  rcases b with ⟨b, rfl⟩
-  simp [Array.getElem_append, hi]
-
-theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
-    (a ++ b)[i] = a[i] := by simp [getElem_append, hi]
-
-theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n ≤ i) :
-    (a ++ b)[i] = b[i - n] := by
-  rw [getElem_append, dif_neg (by omega)]
-
-theorem getElem?_append_left {as : Vector α n} {bs : Vector α m} {i : Nat} (hn : i < n) :
-    (as ++ bs)[i]? = as[i]? := by
-  have hn' : i < n + m := by omega
-  simp_all [getElem?_eq_getElem, getElem_append]
-
-theorem getElem?_append_right {as : Vector α n} {bs : Vector α m} {i : Nat} (h : n ≤ i) :
-    (as ++ bs)[i]? = bs[i - n]? := by
-  rcases as with ⟨as, rfl⟩
-  rcases bs with ⟨bs, rfl⟩
-  simp [Array.getElem?_append_right, h]
-
-theorem getElem?_append {as : Vector α n} {bs : Vector α m} {i : Nat} :
-    (as ++ bs)[i]? = if i < n then as[i]? else bs[i - n]? := by
-  split <;> rename_i h
-  · exact getElem?_append_left h
-  · exact getElem?_append_right (by simpa using h)
-
-/-- Variant of `getElem_append_left` useful for rewriting from the small array to the big array. -/
-theorem getElem_append_left' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < m) :
-    l₁[i] = (l₁ ++ l₂)[i] := by
-  rw [getElem_append_left] <;> simp
-
-/-- Variant of `getElem_append_right` useful for rewriting from the small array to the big array. -/
-theorem getElem_append_right' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < n) :
-    l₂[i] = (l₁ ++ l₂)[i + m] := by
-  rw [getElem_append_right] <;> simp [*, Nat.le_add_left]
-
-theorem getElem_of_append {l : Vector α n} {l₁ : Vector α m} {l₂ : Vector α k}
-    (w : m + 1 + k = n) (eq : l = (l₁.push a ++ l₂).cast w) :
-    l[m] = a := Option.some.inj <| by
-  rw [← getElem?_eq_getElem, eq, getElem?_cast, getElem?_append_left (by simp)]
-  simp
-
-@[simp 1100] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
-  cases as
-  simp
-
-theorem append_inj {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m} (h : s₁ ++ t₁ = s₂ ++ t₂) :
-    s₁ = s₂ ∧ t₁ = t₂ := by
-  rcases s₁ with ⟨s₁, rfl⟩
-  rcases s₂ with ⟨s₂, hs⟩
-  rcases t₁ with ⟨t₁, rfl⟩
-  rcases t₂ with ⟨t₂, ht⟩
-  simpa using Array.append_inj (by simpa using h) (by omega)
-
-theorem append_inj_right {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) : t₁ = t₂ :=
-  (append_inj h).right
-
-theorem append_inj_left {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
-    (h : s₁ ++ t₁ = s₂ ++ t₂) : s₁ = s₂ :=
-  (append_inj h).left
-
-theorem append_right_inj {t₁ t₂ : Vector α m} (s : Vector α n) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
-  ⟨fun h => append_inj_right h, congrArg _⟩
-
-theorem append_left_inj {s₁ s₂ : Vector α n} (t : Vector α m) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
-  ⟨fun h => append_inj_left h, congrArg (· ++ _)⟩
-
-theorem append_eq_append_iff {a : Vector α n} {b : Vector α m} {c : Vector α k} {d : Vector α l}
-    (w : k + l = n + m) :
-    a ++ b = (c ++ d).cast w ↔
-      if h : n ≤ k then
-        ∃ a' : Vector α (k - n), c = (a ++ a').cast (by omega) ∧ b = (a' ++ d).cast (by omega)
-      else
-        ∃ c' : Vector α (n - k), a = (c ++ c').cast (by omega) ∧ d = (c' ++ b).cast (by omega) := by
-  rcases a with ⟨a, rfl⟩
-  rcases b with ⟨b, rfl⟩
-  rcases c with ⟨c, rfl⟩
-  rcases d with ⟨d, rfl⟩
-  simp only [mk_append_mk, Array.append_eq_append_iff, mk_eq, toArray_cast]
-  constructor
-  · rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
-    · rw [dif_pos (by simp)]
-      exact ⟨a'.toVector.cast (by simp; omega), by simp⟩
-    · split <;> rename_i h
-      · have hc : c'.size = 0 := by simp at h; omega
-        simp at hc
-        exact ⟨#v[].cast (by simp; omega), by simp_all⟩
-      · exact ⟨c'.toVector.cast (by simp; omega), by simp⟩
-  · split <;> rename_i h
-    · rintro ⟨a', hc, rfl⟩
-      left
-      refine ⟨a'.toArray, hc, rfl⟩
-    · rintro ⟨c', ha, rfl⟩
-      right
-      refine ⟨c'.toArray, ha, rfl⟩
-
-theorem set_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n + m) :
-    (s ++ t).set i x =
-      if h' : i < n then
-        s.set i x ++ t
-      else
-        s ++ t.set (i - n) x := by
-  rcases s with ⟨s, rfl⟩
-  rcases t with ⟨t, rfl⟩
-  simp only [mk_append_mk, set_mk, Array.set_append]
-  split <;> simp
-
-@[simp] theorem set_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
-    (s ++ t).set i x = s.set i x ++ t := by
-  simp [set_append, h]
-
-@[simp] theorem set_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
-    (h' : i < n + m) (h : n ≤ i) :
-    (s ++ t).set i x = s ++ t.set (i - n) x := by
-  rw [set_append, dif_neg (by omega)]
-
-theorem setIfInBounds_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} :
-    (s ++ t).setIfInBounds i x =
-      if i < n then
-        s.setIfInBounds i x ++ t
-      else
-        s ++ t.setIfInBounds (i - n) x := by
-  rcases s with ⟨s, rfl⟩
-  rcases t with ⟨t, rfl⟩
-  simp only [mk_append_mk, setIfInBounds_mk, Array.setIfInBounds_append]
-  split <;> simp
-
-@[simp] theorem setIfInBounds_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
-    (s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
-  simp [setIfInBounds_append, h]
-
-@[simp] theorem setIfInBounds_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
-    (h : n ≤ i) :
-    (s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - n) x := by
-  rw [setIfInBounds_append, if_neg (by omega)]
-
-@[simp] theorem map_append (f : α → β) (l₁ : Vector α n) (l₂ : Vector α m) :
-    map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
-  rcases l₁ with ⟨l₁, rfl⟩
-  rcases l₂ with ⟨l₂, rfl⟩
-  simp
-
-theorem map_eq_append_iff {f : α → β} :
-    map f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
-  rcases l with ⟨l, h⟩
-  rcases L₁ with ⟨L₁, rfl⟩
-  rcases L₂ with ⟨L₂, rfl⟩
-  simp only [map_mk, mk_append_mk, eq_mk, Array.map_eq_append_iff, mk_eq, toArray_append,
-    toArray_map]
-  constructor
-  · rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
-    exact ⟨l₁.toVector.cast (by simp), l₂.toVector.cast (by simp), by simp⟩
-  · rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
-    exact ⟨l₁, l₂, by simp_all⟩
-
-theorem append_eq_map_iff {f : α → β} :
-    L₁ ++ L₂ = map f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
-  rw [eq_comm, map_eq_append_iff]
-
-/-! ### flatten -/
-
-@[simp] theorem flatten_mk (L : Array (Vector α n)) (h : L.size = m) :
-    (mk L h).flatten =
-      mk (L.map toArray).flatten (by simp [Function.comp_def, Array.map_const', h]) := by
-  simp [flatten]
-
-@[simp] theorem getElem_flatten (l : Vector (Vector β m) n) (i : Nat) (hi : i < n * m) :
-    l.flatten[i] =
-      haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
-      haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
-      l[i / m][i % m] := by
-  rcases l with ⟨⟨l⟩, rfl⟩
-  simp only [flatten_mk, List.map_toArray, getElem_mk, List.getElem_toArray, Array.flatten_toArray]
-  induction l generalizing i with
-  | nil => simp at hi
-  | cons a l ih =>
-    simp only [List.map_cons, List.map_map, List.flatten_cons]
-    by_cases h : i < m
-    · rw [List.getElem_append_left (by simpa)]
-      have h₁ : i / m = 0 := Nat.div_eq_of_lt h
-      have h₂ : i % m = i := Nat.mod_eq_of_lt h
-      simp [h₁, h₂]
-    · have h₁ : a.toList.length ≤ i := by simp; omega
-      rw [List.getElem_append_right h₁]
-      simp only [Array.length_toList, size_toArray]
-      specialize ih (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₁
-      have h₃ : (i - m) % m = i % m := (Nat.mod_eq_sub_mod h₁).symm
-      simp_all
-
-theorem getElem?_flatten (l : Vector (Vector β m) n) (i : Nat) :
-    l.flatten[i]? =
-      if hi : i < n * m then
-        haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
-        haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
-        some l[i / m][i % m]
-      else
-        none := by
-  simp [getElem?_def]
-
-@[simp] theorem flatten_singleton (l : Vector α n) : #v[l].flatten = l.cast (by simp) := by
-  simp [flatten]
-
-theorem mem_flatten {L : Vector (Vector α n) m} : a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
-  rcases L with ⟨L, rfl⟩
-  simp [Array.mem_flatten]
-  constructor
-  · rintro ⟨_, ⟨l, h₁, rfl⟩, h₂⟩
-    exact ⟨l, h₁, by simpa using h₂⟩
-  · rintro ⟨l, h₁, h₂⟩
-    exact ⟨l.toArray, ⟨l, h₁, rfl⟩, by simpa using h₂⟩
-
-theorem exists_of_mem_flatten : a ∈ flatten L → ∃ l, l ∈ L ∧ a ∈ l := mem_flatten.1
-
-theorem mem_flatten_of_mem (lL : l ∈ L) (al : a ∈ l) : a ∈ flatten L := mem_flatten.2 ⟨l, lL, al⟩
-
-theorem forall_mem_flatten {p : α → Prop} {L : Vector (Vector α n) m} :
-    (∀ (x) (_ : x ∈ flatten L), p x) ↔ ∀ (l) (_ : l ∈ L) (x) (_ : x ∈ l), p x := by
-  simp only [mem_flatten, forall_exists_index, and_imp]
-  constructor <;> (intros; solve_by_elim)
-
-@[simp] theorem map_flatten (f : α → β) (L : Vector (Vector α n) m) :
-    (flatten L).map f = (map (map f) L).flatten := by
-  induction L using vector₂_induction with
-  | of xss h₁ h₂ => simp
-
-@[simp] theorem flatten_append (L₁ : Vector (Vector α n) m₁) (L₂ : Vector (Vector α n) m₂) :
-    flatten (L₁ ++ L₂) = (flatten L₁ ++ flatten L₂).cast (by simp [Nat.add_mul]) := by
-  induction L₁ using vector₂_induction
-  induction L₂ using vector₂_induction
-  simp
-
-theorem flatten_push (L : Vector (Vector α n) m) (l : Vector α n) :
-    flatten (L.push l) = (flatten L ++ l).cast (by simp [Nat.add_mul]) := by
-  induction L using vector₂_induction
-  rcases l with ⟨l⟩
-  simp [Array.flatten_push]
-
-theorem flatten_flatten {L : Vector (Vector (Vector α n) m) k} :
-    flatten (flatten L) = (flatten (map flatten L)).cast (by simp [Nat.mul_assoc]) := by
-  induction L using vector₃_induction with
-  | of xss h₁ h₂ h₃ =>
-    -- simp [Array.flatten_flatten] -- FIXME: `simp` produces a bad proof here!
-    simp [Array.map_attach, Array.flatten_flatten, Array.map_pmap]
-
-/-- Two vectors of constant length vectors are equal iff their flattens coincide. -/
-theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
-    L = L' ↔ L.flatten = L'.flatten := by
-  induction L using vector₂_induction with | of L h₁ h₂ =>
-  induction L' using vector₂_induction with | of L' h₁' h₂' =>
-  simp only [eq_mk, flatten_mk, Array.map_map, Function.comp_apply, Array.map_subtype,
-    Array.unattach_attach, Array.map_id_fun', id_eq]
-  constructor
-  · intro h
-    suffices L = L' by simp_all
-    apply Array.ext_getElem?
-    intro i
-    replace h := congrArg (fun x => x[i]?.map (fun x => x.toArray)) h
-    simpa [Option.map_pmap] using h
-  · intro h
-    have w : L.map Array.size = L'.map Array.size := by
-      ext i h h'
-      · simp_all
-      · simp only [Array.getElem_map]
-        rw [h₂ _ (by simp), h₂' _ (by simp)]
-    have := Array.eq_iff_flatten_eq.mpr ⟨h, w⟩
-    subst this
-    rfl
-
-
-/-! ### flatMap -/
-
-@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α → Vector β n) :
-    (mk l h).flatMap f =
-      mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
-  simp [flatMap]
-
-@[simp] theorem flatMap_toArray (l : Vector α n) (f : α → Vector β m) :
-    l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
-  rcases l with ⟨l, rfl⟩
-  simp
-
-theorem flatMap_def (l : Vector α n) (f : α → Vector β m) : l.flatMap f = flatten (map f l) := by
-  rcases l with ⟨l, rfl⟩
-  simp [Array.flatMap_def, Function.comp_def]
-
-@[simp] theorem getElem_flatMap (l : Vector α n) (f : α → Vector β m) (i : Nat) (hi : i < n * m) :
-    (l.flatMap f)[i] =
-      haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
-      haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
-      (f (l[i / m]))[i % m] := by
-  rw [flatMap_def, getElem_flatten, getElem_map]
-
-theorem getElem?_flatMap (l : Vector α n) (f : α → Vector β m) (i : Nat) :
-    (l.flatMap f)[i]? =
-      if hi : i < n * m then
-        haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
-        haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
-        some ((f (l[i / m]))[i % m])
-      else
-        none := by
-  simp [getElem?_def]
-
-@[simp] theorem flatMap_id (l : Vector (Vector α m) n) : l.flatMap id = l.flatten := by simp [flatMap_def]
-
-@[simp] theorem flatMap_id' (l : Vector (Vector α m) n) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
-
-@[simp] theorem mem_flatMap {f : α → Vector β m} {b} {l : Vector α n} : b ∈ l.flatMap f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
-  simp [flatMap_def, mem_flatten]
-  exact ⟨fun ⟨_, ⟨a, h₁, rfl⟩, h₂⟩ => ⟨a, h₁, h₂⟩, fun ⟨a, h₁, h₂⟩ => ⟨_, ⟨a, h₁, rfl⟩, h₂⟩⟩
-
-theorem exists_of_mem_flatMap {b : β} {l : Vector α n} {f : α → Vector β m} :
-    b ∈ l.flatMap f → ∃ a, a ∈ l ∧ b ∈ f a := mem_flatMap.1
-
-theorem mem_flatMap_of_mem {b : β} {l : Vector α n} {f : α → Vector β m} {a} (al : a ∈ l) (h : b ∈ f a) :
-    b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
-
-theorem forall_mem_flatMap {p : β → Prop} {l : Vector α n} {f : α → Vector β m} :
-    (∀ (x) (_ : x ∈ l.flatMap f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
-  simp only [mem_flatMap, forall_exists_index, and_imp]
-  constructor <;> (intros; solve_by_elim)
-
-theorem flatMap_singleton (f : α → Vector β m) (x : α) : #v[x].flatMap f = (f x).cast (by simp) := by
-  simp [flatMap_def]
-
-@[simp] theorem flatMap_singleton' (l : Vector α n) : (l.flatMap fun x => #v[x]) = l.cast (by simp) := by
-  rcases l with ⟨l, rfl⟩
-  simp
-
-@[simp] theorem flatMap_append (xs ys : Vector α n) (f : α → Vector β m) :
-    (xs ++ ys).flatMap f = (xs.flatMap f ++ ys.flatMap f).cast (by simp [Nat.add_mul]) := by
-  rcases xs with ⟨xs⟩
-  rcases ys with ⟨ys⟩
-  simp [flatMap_def, flatten_append]
-
-theorem flatMap_assoc {α β} (l : Vector α n) (f : α → Vector β m) (g : β → Vector γ k) :
-    (l.flatMap f).flatMap g = (l.flatMap fun x => (f x).flatMap g).cast (by simp [Nat.mul_assoc]) := by
-  rcases l with ⟨l, rfl⟩
-  simp [Array.flatMap_assoc]
-
-theorem map_flatMap (f : β → γ) (g : α → Vector β m) (l : Vector α n) :
-     (l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
-  rcases l with ⟨l, rfl⟩
-  simp [Array.map_flatMap]
-
-theorem flatMap_map (f : α → β) (g : β → Vector γ k) (l : Vector α n) :
-     (map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
-  rcases l with ⟨l, rfl⟩
-  simp [Array.flatMap_map]
-
-theorem map_eq_flatMap {α β} (f : α → β) (l : Vector α n) :
-    map f l = (l.flatMap fun x => #v[f x]).cast (by simp) := by
-  rcases l with ⟨l, rfl⟩
-  simp [Array.map_eq_flatMap]
-
-/-! ### mkVector -/
-
-@[simp] theorem mkVector_one : mkVector 1 a = #v[a] := rfl
-
-/-- Variant of `mkVector_succ` that prepends `a` at the beginning of the vector. -/
-theorem mkVector_succ' : mkVector (n + 1) a = (#v[a] ++ mkVector n a).cast (by omega) := by
-  rw [← toArray_inj]
-  simp [Array.mkArray_succ']
-
-@[simp] theorem mem_mkVector {a b : α} {n} : b ∈ mkVector n a ↔ n ≠ 0 ∧ b = a := by
-  unfold mkVector
-  simp
-
-theorem eq_of_mem_mkVector {a b : α} {n} (h : b ∈ mkVector n a) : b = a := (mem_mkVector.1 h).2
-
-theorem forall_mem_mkVector {p : α → Prop} {a : α} {n} :
-    (∀ b, b ∈ mkVector n a → p b) ↔ n = 0 ∨ p a := by
-  cases n <;> simp [mem_mkVector]
-
-@[simp] theorem getElem_mkVector (a : α) (n i : Nat) (h : i < n) : (mkVector n a)[i] = a := by
-  simp [mkVector]
-
-theorem getElem?_mkVector (a : α) (n i : Nat) : (mkVector n a)[i]? = if i < n then some a else none := by
-  simp [getElem?_def]
-
-@[simp] theorem getElem?_mkVector_of_lt {n : Nat} {m : Nat} (h : m < n) : (mkVector n a)[m]? = some a := by
-  simp [getElem?_mkVector, h]
-
-theorem eq_mkVector_of_mem {a : α} {l : Vector α n} (h : ∀ (b) (_ : b ∈ l), b = a) : l = mkVector n a := by
-  rw [← toArray_inj]
-  simpa using Array.eq_mkArray_of_mem (l := l.toArray) (by simpa using h)
-
-theorem eq_mkVector_iff {a : α} {n} {l : Vector α n} :
-    l = mkVector n a ↔ ∀ (b) (_ : b ∈ l), b = a := by
-  rw [← toArray_inj]
-  simpa using Array.eq_mkArray_iff (l := l.toArray) (n := n)
-
-theorem map_eq_mkVector_iff {l : Vector α n} {f : α → β} {b : β} :
-    l.map f = mkVector n b ↔ ∀ x ∈ l, f x = b := by
-  simp [eq_mkVector_iff]
-
-@[simp] theorem map_const (l : Vector α n) (b : β) : map (Function.const α b) l = mkVector n b :=
-  map_eq_mkVector_iff.mpr fun _ _ => rfl
-
-@[simp] theorem map_const_fun (x : β) : map (n := n) (Function.const α x) = fun _ => mkVector n x := by
-  funext l
-  simp
-
-/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
--- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
-theorem map_const' (l : Vector α n) (b : β) : map (fun _ => b) l = mkVector n b :=
-  map_const l b
-
-@[simp] theorem set_mkVector_self : (mkVector n a).set i a h = mkVector n a := by
-  rw [← toArray_inj]
-  simp
-
-@[simp] theorem setIfInBounds_mkVector_self : (mkVector n a).setIfInBounds i a = mkVector n a := by
-  rw [← toArray_inj]
-  simp
-
-@[simp] theorem mkVector_append_mkVector : mkVector n a ++ mkVector m a = mkVector (n + m) a := by
-  rw [← toArray_inj]
-  simp
-
-theorem append_eq_mkVector_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
-    l₁ ++ l₂ = mkVector (n + m) a ↔ l₁ = mkVector n a ∧ l₂ = mkVector m a := by
-  simp [← toArray_inj, Array.append_eq_mkArray_iff]
-
-theorem mkVector_eq_append_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
-    mkVector (n + m) a = l₁ ++ l₂ ↔ l₁ = mkVector n a ∧ l₂ = mkVector m a := by
-  rw [eq_comm, append_eq_mkVector_iff]
-
-@[simp] theorem map_mkVector : (mkVector n a).map f = mkVector n (f a) := by
-  rw [← toArray_inj]
-  simp
-
-
-@[simp] theorem flatten_mkVector_empty : (mkVector n (#v[] : Vector α 0)).flatten = #v[] := by
-  rw [← toArray_inj]
-  simp
-
-@[simp] theorem flatten_mkVector_singleton : (mkVector n #v[a]).flatten = (mkVector n a).cast (by simp) := by
-  ext i h
-  simp [h]
-
-@[simp] theorem flatten_mkVector_mkVector : (mkVector n (mkVector m a)).flatten = mkVector (n * m) a := by
-  ext i h
-  simp [h]
-
-theorem flatMap_mkArray {β} (f : α → Vector β m) : (mkVector n a).flatMap f = (mkVector n (f a)).flatten := by
-  ext i h
-  simp [h]
-
-@[simp] theorem sum_mkArray_nat (n : Nat) (a : Nat) : (mkVector n a).sum = n * a := by
-  simp [toArray_mkVector]
-
 /-! Content below this point has not yet been aligned with `List` and `Array`. -/
 
 @[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
@@ -1776,6 +1197,28 @@ defeq issues in the implicit size argument.
     subst h
     simp [pop, back, back!, ← Array.eq_push_pop_back!_of_size_ne_zero]
 
+/-! ### append -/
+
+theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
+    (a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
+  rcases a with ⟨a, rfl⟩
+  rcases b with ⟨b, rfl⟩
+  simp [Array.getElem_append, hi]
+
+theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
+    (a ++ b)[i] = a[i] := by simp [getElem_append, hi]
+
+theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n ≤ i) :
+    (a ++ b)[i] = b[i - n] := by
+  rw [getElem_append, dif_neg (by omega)]
+
+/-! ### cast -/
+
+@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
+    (a.cast h)[i] = a[i] := by
+  cases a
+  simp
+
 /-! ### extract -/
 
 @[simp] theorem getElem_extract (a : Vector α n) (start stop) (i : Nat) (hi : i < min stop n - start) :

src/Init/Grind.lean

@@ -11,4 +11,3 @@ import Init.Grind.Cases
 import Init.Grind.Propagator
 import Init.Grind.Util
 import Init.Grind.Offset
-import Init.Grind.PP

src/Init/Grind/Lemmas.lean

@@ -12,9 +12,6 @@ import Init.Grind.Util
 
 namespace Lean.Grind
 
-theorem rfl_true : true = true :=
-  rfl
-
 theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' → q) : p → q :=
   fun hp => h (he.mp hp)
 

src/Init/Grind/Offset.lean

@@ -8,10 +8,8 @@ import Init.Core
 import Init.Omega
 
 namespace Lean.Grind
-abbrev isLt (x y : Nat) : Bool := x < y
-abbrev isLE (x y : Nat) : Bool := x ≤ y
+def isLt (x y : Nat) : Bool := x < y
 
-/-! Theorems for transitivity. -/
 theorem Nat.le_ro (u w v k : Nat) : u ≤ w → w ≤ v + k → u ≤ v + k := by
   omega
 theorem Nat.le_lo (u w v k : Nat) : u ≤ w → w + k ≤ v → u + k ≤ v := by
@@ -33,7 +31,6 @@ theorem Nat.ro_lo_2 (u w v k₁ k₂ : Nat) : isLt k₁ k₂ = true → u ≤ w
 theorem Nat.ro_ro (u w v k₁ k₂ : Nat) : u ≤ w + k₁ → w ≤ v + k₂ → u ≤ v + (k₁ + k₂) := by
   omega
 
-/-! Theorems for negating constraints. -/
 theorem Nat.of_le_eq_false (u v : Nat) : ((u ≤ v) = False) → v + 1 ≤ u := by
   simp; omega
 theorem Nat.of_lo_eq_false_1 (u v : Nat) : ((u + 1 ≤ v) = False) → v ≤ u := by
@@ -43,7 +40,6 @@ theorem Nat.of_lo_eq_false (u v k : Nat) : ((u + k ≤ v) = False) → v ≤ u +
 theorem Nat.of_ro_eq_false (u v k : Nat) : ((u ≤ v + k) = False) → v + (k+1) ≤ u := by
   simp; omega
 
-/-! Theorems for closing a goal. -/
 theorem Nat.unsat_le_lo (u v k : Nat) : isLt 0 k = true → u ≤ v → v + k ≤ u → False := by
   simp [isLt]; omega
 theorem Nat.unsat_lo_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true → u + k₁ ≤ v → v + k₂ ≤ u → False := by
@@ -51,42 +47,4 @@ theorem Nat.unsat_lo_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true → u
 theorem Nat.unsat_lo_ro (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ v → v ≤ u + k₂ → False := by
   simp [isLt]; omega
 
-/-! Theorems for propagating constraints to `True` -/
-theorem Nat.lo_eq_true_of_lo (u v k₁ k₂ : Nat) : isLE k₂ k₁ = true → u + k₁ ≤ v → (u + k₂ ≤ v) = True :=
-  by simp [isLt]; omega
-theorem Nat.le_eq_true_of_lo (u v k : Nat) : u + k ≤ v → (u ≤ v) = True :=
-  by simp; omega
-theorem Nat.le_eq_true_of_le (u v : Nat) : u ≤ v → (u ≤ v) = True :=
-  by simp
-theorem Nat.ro_eq_true_of_lo (u v k₁ k₂ : Nat) : u + k₁ ≤ v → (u ≤ v + k₂) = True :=
-  by simp; omega
-theorem Nat.ro_eq_true_of_le (u v k : Nat) : u ≤ v → (u ≤ v + k) = True :=
-  by simp; omega
-theorem Nat.ro_eq_true_of_ro (u v k₁ k₂ : Nat) : isLE k₁ k₂ = true → u ≤ v + k₁ → (u ≤ v + k₂) = True :=
-  by simp [isLE]; omega
-
-/-!
-Theorems for propagating constraints to `False`.
-They are variants of the theorems for closing a goal.
--/
-theorem Nat.lo_eq_false_of_le (u v k : Nat) : isLt 0 k = true → u ≤ v → (v + k ≤ u) = False := by
- simp [isLt]; omega
-theorem Nat.le_eq_false_of_lo (u v k : Nat) : isLt 0 k = true → u + k ≤ v → (v ≤ u) = False := by
- simp [isLt]; omega
-theorem Nat.lo_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true → u + k₁ ≤ v → (v + k₂ ≤ u) = False := by
-  simp [isLt]; omega
-theorem Nat.ro_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ v → (v ≤ u + k₂) = False := by
-  simp [isLt]; omega
-theorem Nat.lo_eq_false_of_ro (u v k₁ k₂ : Nat) : isLt k₁ k₂ = true → u ≤ v + k₁ → (v + k₂ ≤ u) = False := by
-  simp [isLt]; omega
-
-/-!
-Helper theorems for equality propagation
--/
-
-theorem Nat.le_of_eq_1 (u v : Nat) : u = v → u ≤ v := by omega
-theorem Nat.le_of_eq_2 (u v : Nat) : u = v → v ≤ u := by omega
-theorem Nat.eq_of_le_of_le (u v : Nat) : u ≤ v → v ≤ u → u = v := by omega
-theorem Nat.le_offset (a k : Nat) : k ≤ a + k := by omega
-
 end Lean.Grind

src/Init/Grind/PP.lean

@@ -1,30 +0,0 @@
-/-
-Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
--/
-prelude
-import Init.NotationExtra
-
-namespace Lean.Grind
-/-!
-This is a hackish module for hovering node information in the `grind` tactic state.
--/
-
-inductive NodeDef where
-  | unit
-
-set_option linter.unusedVariables false in
-def node_def (_ : Nat) {α : Sort u} {a : α} : NodeDef := .unit
-
-@[app_unexpander node_def]
-def nodeDefUnexpander : PrettyPrinter.Unexpander := fun stx => do
-  match stx with
-  | `($_ $id:num) => return mkIdent <| Name.mkSimple $ "#" ++ toString id.getNat
-  | _ => throw ()
-
-@[app_unexpander NodeDef]
-def NodeDefUnexpander : PrettyPrinter.Unexpander := fun _ => do
-  return mkIdent <| Name.mkSimple "NodeDef"
-
-end Lean.Grind

src/Init/Grind/Tactics.lean

@@ -14,9 +14,7 @@ syntax grindEqRhs  := atomic("=" "_")
 syntax grindBwd    := "←"
 syntax grindFwd    := "→"
 
-syntax grindThmMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd
-
-syntax (name := grind) "grind" (grindThmMod)? : attr
+syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
 
 end Lean.Parser.Attr
 
@@ -47,12 +45,6 @@ structure Config where
   If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
   Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
   splitIndPred : Bool := true
-  /-- By default, `grind` halts as soon as it encounters a sub-goal where no further progress can be made. -/
-  failures : Nat := 1
-  /-- Maximum number of heartbeats (in thousands) the canonicalizer can spend per definitional equality test. -/
-  canonHeartbeats : Nat := 1000
-  /-- If `ext` is `true`, `grind` uses extensionality theorems available in the environment. -/
-  ext : Bool := true
   deriving Inhabited, BEq
 
 end Lean.Grind
@@ -63,13 +55,7 @@ namespace Lean.Parser.Tactic
 `grind` tactic and related tactics.
 -/
 
-syntax grindErase := "-" ident
-syntax grindLemma := (Attr.grindThmMod)? ident
-syntax grindParam := grindErase <|> grindLemma
-
-syntax (name := grind)
-  "grind" optConfig (&" only")?
-  (" [" withoutPosition(grindParam,*) "]")?
-  ("on_failure " term)? : tactic
+-- TODO: parameters
+syntax (name := grind) "grind" optConfig ("on_failure " term)? : tactic
 
 end Lean.Parser.Tactic

src/Init/Grind/Util.lean

@@ -9,7 +9,7 @@ import Init.Core
 namespace Lean.Grind
 
 /-- A helper gadget for annotating nested proofs in goals. -/
-def nestedProof (p : Prop) {h : p} : p := h
+def nestedProof (p : Prop) (h : p) : p := h
 
 /--
 Gadget for marking terms that should not be normalized by `grind`s simplifier.
@@ -28,7 +28,7 @@ When `EqMatch a b origin` is `True`, we mark `origin` as a resolved case-split.
 -/
 def EqMatch (a b : α) {_origin : α} : Prop := a = b
 
-theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
+theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (nestedProof p hp) (nestedProof q hq) := by
   subst h; apply HEq.refl
 
 end Lean.Grind

src/Init/Prelude.lean

@@ -150,9 +150,6 @@ It can also be written as `()`.
 /-- Marker for information that has been erased by the code generator. -/
 unsafe axiom lcErased : Type
 
-/-- Marker for type dependency that has been erased by the code generator. -/
-unsafe axiom lcAny : Type
-
 /--
 Auxiliary unsafe constant used by the Compiler when erasing proofs from code.
 

src/Lean/AddDecl.lean

@@ -14,57 +14,26 @@ register_builtin_option debug.skipKernelTC : Bool := {
   descr    := "skip kernel type checker. WARNING: setting this option to true may compromise soundness because your proofs will not be checked by the Lean kernel"
 }
 
-/-- Adds given declaration to the environment, respecting `debug.skipKernelTC`. -/
-def Kernel.Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
-    (cancelTk? : Option IO.CancelToken := none) : Except Exception Environment :=
-  if debug.skipKernelTC.get opts then
-    addDeclWithoutChecking env decl
-  else
-    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
-
-private def Environment.addDeclAux (env : Environment) (opts : Options) (decl : Declaration)
-    (cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
-  if debug.skipKernelTC.get opts then
-    addDeclWithoutChecking env decl
-  else
-    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
-
-@[deprecated "use `Lean.addDecl` instead to ensure new namespaces are registered" (since := "2024-12-03")]
 def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
-    (cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
-  Environment.addDeclAux env opts decl cancelTk?
+    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment :=
+  if debug.skipKernelTC.get opts then
+    addDeclWithoutChecking env decl
+  else
+    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
 
-private def isNamespaceName : Name → Bool
-  | .str .anonymous _ => true
-  | .str p _          => isNamespaceName p
-  | _                 => false
-
-private def registerNamePrefixes (env : Environment) (name : Name) : Environment :=
-  match name with
-    | .str _ s =>
-      if s.get 0 == '_' then
-        -- Do not register namespaces that only contain internal declarations.
-        env
-      else
-        go env name
-    | _ => env
-where go env
-  | .str p _ => if isNamespaceName p then go (env.registerNamespace p) p else env
-  | _        => env
+def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
+    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
+  let env ← addDecl env opts decl cancelTk?
+  compileDecl env opts decl
 
 def addDecl (decl : Declaration) : CoreM Unit := do
   profileitM Exception "type checking" (← getOptions) do
-    let mut env ← withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
+    withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
       if !(← MonadLog.hasErrors) && decl.hasSorry then
         logWarning "declaration uses 'sorry'"
-      (← getEnv).addDeclAux (← getOptions) decl (← read).cancelTk? |> ofExceptKernelException
-
-    -- register namespaces for newly added constants; this used to be done by the kernel itself
-    -- but that is incompatible with moving it to a separate task
-    env := decl.getNames.foldl registerNamePrefixes env
-    if let .inductDecl _ _ types _ := decl then
-      env := types.foldl (registerNamePrefixes · <| ·.name ++ `rec) env
-    setEnv env
+      match (← getEnv).addDecl (← getOptions) decl (← read).cancelTk? with
+      | .ok    env => setEnv env
+      | .error ex  => throwKernelException ex
 
 def addAndCompile (decl : Declaration) : CoreM Unit := do
   addDecl decl

src/Lean/Compiler/InitAttr.lean

@@ -144,7 +144,11 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
   let type := mkApp (mkConst `IO) (mkConst `Unit)
   let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
                                      safety := DefinitionSafety.safe }
-  addAndCompile decl
-  IO.ofExcept (setBuiltinInitAttr (← getEnv) name) >>= setEnv
+  match (← getEnv).addAndCompile {} decl with
+  -- TODO: pretty print error
+  | Except.error e => do
+    let msg ← (e.toMessageData {}).toString
+    throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
+  | Except.ok env  => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
 
 end Lean

src/Lean/Compiler/LCNF/MonoTypes.lean

@@ -74,6 +74,8 @@ partial def toMonoType (type : Expr) : CoreM Expr := do
   let type := type.headBeta
   if type.isErased then
     return erasedExpr
+  else if type.isErased then
+    return erasedExpr
   else if isTypeFormerType type then
     return erasedExpr
   else match type with

src/Lean/Compiler/LCNF/ToMono.lean

@@ -150,7 +150,18 @@ where
 
 def toMono : Pass where
   name     := `toMono
-  run      := (·.mapM (·.toMono))
+  run      := fun decls => do
+    let decls ← decls.filterM fun decl => do
+      if hasLocalInst decl.type then
+        /-
+        Declaration is a "template" for the code specialization pass.
+        So, we should delete it before going to next phase.
+        -/
+        decl.erase
+        return false
+      else
+        return true
+    decls.mapM (·.toMono)
   phase    := .base
   phaseOut := .mono
 

src/Lean/Compiler/Old.lean

@@ -53,3 +53,18 @@ def isUnsafeRecName? : Name → Option Name
   | _ => none
 
 end Compiler
+
+namespace Environment
+
+/--
+Compile the given block of mutual declarations.
+Assumes the declarations have already been added to the environment using `addDecl`.
+-/
+@[extern "lean_compile_decls"]
+opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
+
+/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
+def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
+  compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
+
+end Environment

src/Lean/CoreM.lean

@@ -514,19 +514,16 @@ register_builtin_option compiler.enableNew : Bool := {
 @[extern "lean_lcnf_compile_decls"]
 opaque compileDeclsNew (declNames : List Name) : CoreM Unit
 
-@[extern "lean_compile_decls"]
-opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List Name) : Except Kernel.Exception Environment
-
 def compileDecl (decl : Declaration) : CoreM Unit := do
   let opts ← getOptions
   let decls := Compiler.getDeclNamesForCodeGen decl
   if compiler.enableNew.get opts then
     compileDeclsNew decls
   let res ← withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
-    return compileDeclsOld (← getEnv) opts decls
+    return (← getEnv).compileDecl opts decl
   match res with
   | Except.ok env => setEnv env
-  | Except.error (.other msg) =>
+  | Except.error (KernelException.other msg) =>
     checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
     throwError msg
   | Except.error ex =>
@@ -536,9 +533,9 @@ def compileDecls (decls : List Name) : CoreM Unit := do
   let opts ← getOptions
   if compiler.enableNew.get opts then
     compileDeclsNew decls
-  match compileDeclsOld (← getEnv) opts decls with
+  match (← getEnv).compileDecls opts decls with
   | Except.ok env   => setEnv env
-  | Except.error (.other msg) =>
+  | Except.error (KernelException.other msg) =>
     throwError msg
   | Except.error ex =>
     throwKernelException ex

src/Lean/Declaration.lean

@@ -193,19 +193,6 @@ def Declaration.definitionVal! : Declaration → DefinitionVal
   | .defnDecl val => val
   | _ => panic! "Expected a `Declaration.defnDecl`."
 
-/--
-Returns all top-level names to be defined by adding this declaration to the environment. This does
-not include auxiliary definitions such as projections.
--/
-def Declaration.getNames : Declaration → List Name
-  | .axiomDecl val          => [val.name]
-  | .defnDecl val           => [val.name]
-  | .thmDecl val            => [val.name]
-  | .opaqueDecl val         => [val.name]
-  | .quotDecl               => [``Quot, ``Quot.mk, ``Quot.lift, ``Quot.ind]
-  | .mutualDefnDecl defns   => defns.map (·.name)
-  | .inductDecl _ _ types _ => types.map (·.name)
-
 @[specialize] def Declaration.foldExprM {α} {m : Type → Type} [Monad m] (d : Declaration) (f : α → Expr → m α) (a : α) : m α :=
   match d with
   | .quotDecl                                        => pure a
@@ -482,10 +469,6 @@ def isInductive : ConstantInfo → Bool
   | .inductInfo _ => true
   | _             => false
 
-def isDefinition : ConstantInfo → Bool
-  | .defnInfo _ => true
-  | _           => false
-
 def isTheorem : ConstantInfo → Bool
   | .thmInfo _ => true
   | _          => false

src/Lean/Elab/App.lean

@@ -1474,7 +1474,7 @@ where
     | field::fields, false => .fieldName field field.getId.getString! none fIdent :: toLVals fields false
 
 /-- Resolve `(.$id:ident)` using the expected type to infer namespace. -/
-private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
+private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Name := do
   tryPostponeIfNoneOrMVar expectedType?
   let some expectedType := expectedType?
     | throwError "invalid dotted identifier notation, expected type must be known"
@@ -1489,7 +1489,7 @@ where
         withForallBody body k
       else
         k body
-  go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
+  go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Name := do
     let resultType ← instantiateMVars resultType
     let resultTypeFn := resultType.cleanupAnnotations.getAppFn
     try
@@ -1497,12 +1497,9 @@ where
       let .const declName .. := resultTypeFn.cleanupAnnotations
         | throwError "invalid dotted identifier notation, expected type is not of the form (... → C ...) where C is a constant{indentExpr expectedType}"
       let idNew := declName ++ id.getId.eraseMacroScopes
-      if (← getEnv).contains idNew then
-        mkConst idNew
-      else if let some (fvar, []) ← resolveLocalName idNew then
-        return fvar
-      else
+      unless (← getEnv).contains idNew do
         throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
+      return idNew
     catch
       | ex@(.error ..) =>
         match (← unfoldDefinition? resultType) with
@@ -1551,7 +1548,7 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
     | `(_)       => throwError "placeholders '_' cannot be used where a function is expected"
     | `(.$id:ident) =>
         addCompletionInfo <| CompletionInfo.dotId f id.getId (← getLCtx) expectedType?
-        let fConst ← resolveDotName id expectedType?
+        let fConst ← mkConst (← resolveDotName id expectedType?)
         let s ← observing do
           -- Use (force := true) because we want to record the result of .ident resolution even in patterns
           let fConst ← addTermInfo f fConst expectedType? (force := true)

src/Lean/Elab/BuiltinCommand.lean

@@ -124,7 +124,9 @@ private partial def elabChoiceAux (cmds : Array Syntax) (i : Nat) : CommandElabM
   n[1].forArgsM addUnivLevel
 
 @[builtin_command_elab «init_quot»] def elabInitQuot : CommandElab := fun _ => do
-  liftCoreM <| addDecl Declaration.quotDecl
+  match (← getEnv).addDecl (← getOptions) Declaration.quotDecl with
+  | Except.ok env   => setEnv env
+  | Except.error ex => throwError (ex.toMessageData (← getOptions))
 
 @[builtin_command_elab «export»] def elabExport : CommandElab := fun stx => do
   let `(export $ns ($ids*)) := stx | throwUnsupportedSyntax
@@ -292,7 +294,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
     modify fun s => { s with messages := {} };
     pure messages
   let restoreMessages (prevMessages : MessageLog) : CommandElabM Unit := do
-    modify fun s => { s with messages := prevMessages ++ s.messages.errorsToInfos }
+    modify fun s => { s with messages := prevMessages ++ s.messages.errorsToWarnings }
   let prevMessages ← resetMessages
   let succeeded ← try
     x

src/Lean/Elab/Import.lean

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
 -/
 prelude
 import Lean.Parser.Module
-import Lean.Util.Paths
+import Lean.Data.Json
 
 namespace Lean.Elab
 
@@ -42,12 +42,4 @@ def printImports (input : String) (fileName : Option String) : IO Unit := do
     let fname ← findOLean dep.module
     IO.println fname
 
-@[export lean_print_import_srcs]
-def printImportSrcs (input : String) (fileName : Option String) : IO Unit := do
-  let sp ← initSrcSearchPath
-  let (deps, _, _) ← parseImports input fileName
-  for dep in deps do
-    let fname ← findLean sp dep.module
-    IO.println fname
-
 end Lean.Elab

src/Lean/Elab/Structure.lean

@@ -681,7 +681,7 @@ private partial def checkResultingUniversesForFields (fieldInfos : Array StructF
       throwErrorAt info.ref msg
 
 @[extern "lean_mk_projections"]
-private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except Kernel.Exception Environment
+private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except KernelException Environment
 
 private def addProjections (r : ElabHeaderResult) (fieldInfos : Array StructFieldInfo) : TermElabM Unit := do
   if r.type.isProp then

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

@@ -38,9 +38,6 @@ declare_config_elab elabBVDecideConfig Lean.Elab.Tactic.BVDecide.Frontend.BVDeci
 builtin_initialize bvNormalizeExt : Meta.SimpExtension ←
   Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"
 
-builtin_initialize intToBitVecExt : Meta.SimpExtension ←
-  Meta.registerSimpAttr `int_toBitVec "simp theorems used to convert UIntX/IntX statements into BitVec ones"
-
 /-- Builtin `bv_normalize` simprocs. -/
 builtin_initialize builtinBVNormalizeSimprocsRef : IO.Ref Meta.Simp.Simprocs ← IO.mkRef {}
 

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

@@ -4,28 +4,342 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Henrik Böving
 -/
 prelude
+import Lean.Meta.AppBuilder
+import Lean.Meta.Tactic.AC.Main
+import Lean.Elab.Tactic.Simp
 import Lean.Elab.Tactic.FalseOrByContra
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Simproc
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Rewrite
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
+import Lean.Elab.Tactic.BVDecide.Frontend.Attr
+import Std.Tactic.BVDecide.Normalize
+import Std.Tactic.BVDecide.Syntax
 
 /-!
-This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
-It is in essence a (slightly reduced) version of the Bitwuzla preprocessor together with Lean
-specific details.
+This module contains the implementation of `bv_normalize` which is effectively a custom `bv_normalize`
+simp set that is called like this: `simp only [seval, bv_normalize]`. The rules in `bv_normalize`
+fulfill two goals:
+1. Turn all hypothesis involving `Bool` and `BitVec` into the form `x = true` where `x` only consists
+   of a operations on `Bool` and `BitVec`. In particular no `Prop` should be contained. This makes
+   the reflection procedure further down the pipeline much easier to implement.
+2. Apply simplification rules from the Bitwuzla SMT solver.
 -/
 
 namespace Lean.Elab.Tactic.BVDecide
 namespace Frontend.Normalize
 
 open Lean.Meta
+open Std.Tactic.BVDecide.Normalize
 
-def passPipeline : PreProcessM (List Pass) := do
-  let mut passPipeline := [rewriteRulesPass]
-  let cfg ← PreProcessM.getConfig
+builtin_simproc ↓ [bv_normalize] reduceCond (cond _ _ _) := fun e => do
+  let_expr f@cond α c tb eb := e | return .continue
+  let r ← Simp.simp c
+  if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
+    let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) (← r.getProof)
+    return .visit { expr := tb, proof? := pr }
+  else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
+    let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) (← r.getProof)
+    return .visit { expr := eb, proof? := pr }
+  else
+    return .continue
+
+builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
+  let_expr Eq _ lhs rhs := e | return .continue
+  match_expr rhs with
+  | Bool.true => return .continue
+  | _ =>
+    let beqApp ← mkAppM ``BEq.beq #[lhs, rhs]
+    let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
+    let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
+    return .done { expr := new, proof? := some proof }
+
+builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
+  let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
+  let some ⟨w, rhsValue⟩ ← getBitVecValue? rhs | return .continue
+  if rhsValue == -1#w then
+    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
+    return .visit { expr := lhs, proof? := some proof }
+  else
+    return .continue
+
+builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
+  let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
+  let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
+  if lhsValue == -1#w then
+    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
+    return .visit { expr := rhs, proof? := some proof }
+  else
+    return .continue
+
+builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
+  let_expr BitVec.ult _ lhs rhs := e | return .continue
+  let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
+  if lhsValue == -1#w then
+    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
+    return .visit { expr := toExpr Bool.false, proof? := some proof }
+  else
+    return .continue
+
+-- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
+builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
+  let_expr Neg.neg typ _ val := e | return .continue
+  let_expr BitVec widthExpr := typ | return .continue
+  let some w ← getNatValue? widthExpr | return .continue
+  match ← getBitVecValue? val with
+  | some _ => return .continue
+  | none =>
+    let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
+    let expr ← mkAppM ``HAdd.hAdd #[← mkAppM ``Complement.complement #[val], (toExpr 1#w)]
+    return .visit { expr := expr, proof? := some proof }
+
+builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
+  fun e => do
+    let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
+    let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
+    let some ⟨w, exp1Val⟩ ←  getBitVecValue? exp1 | return .continue
+    let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
+    match ← getBitVecValue? exp2 with
+    | some ⟨w', exp2Val⟩ =>
+      if h : w = w' then
+        let newLhs := exp1Val + h ▸ exp2Val
+        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
+        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
+        return .visit { expr := expr, proof? := some proof }
+      else
+        return .continue
+    | none =>
+      let some ⟨w', exp3Val⟩ ← getBitVecValue? exp3 | return .continue
+      if h : w = w' then
+        let newLhs := exp1Val + h ▸ exp3Val
+        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
+        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
+        return .visit { expr := expr, proof? := some proof }
+      else
+        return .continue
+
+builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
+  fun e => do
+    let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
+    let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
+    let some ⟨w, exp3Val⟩ ←  getBitVecValue? exp3 | return .continue
+    let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
+    match ← getBitVecValue? exp1 with
+    | some ⟨w', exp1Val⟩ =>
+      if h : w = w' then
+        let newLhs := exp3Val + h ▸ exp1Val
+        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
+        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
+        return .visit { expr := expr, proof? := some proof }
+      else
+        return .continue
+    | none =>
+      let some ⟨w', exp2Val⟩ ← getBitVecValue? exp2 | return .continue
+      if h : w = w' then
+        let newLhs := exp3Val + h ▸ exp2Val
+        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
+        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
+        return .visit { expr := expr, proof? := some proof }
+      else
+        return .continue
+
+/-- Return a number `k` such that `2^k = n`. -/
+private def Nat.log2Exact (n : Nat) : Option Nat := do
+  guard <| n ≠ 0
+  let k := n.log2
+  guard <| Nat.pow 2 k == n
+  return k
+
+-- Build an expression for `x ^ y`.
+def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
+
+builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
+  let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
+  let some ⟨w, yVal⟩ ← getBitVecValue? y | return .continue
+  let n := yVal.toNat
+  -- BitVec.ofNat w n, where n =def= 2^k
+  let some k := Nat.log2Exact n | return .continue
+  -- check that k < w.
+  if k ≥ w then return .continue
+  let rhs ← mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
+  -- 2^k = n
+  let hk ← mkDecideProof (← mkEq (← mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
+  -- k < w
+  let hlt ← mkDecideProof (← mkLt (mkNatLit k) (mkNatLit w))
+  let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
+    #[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
+  return .done {
+      expr :=  rhs
+      proof? := some proof
+  }
+
+/--
+A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
+the goal fully, indicated by returning `none`.
+-/
+structure Pass where
+  name : Name
+  run : MVarId → MetaM (Option MVarId)
+
+namespace Pass
+
+/--
+Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
+the goal anymore.
+-/
+partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : MetaM (Option MVarId) := do
+  let runPass (goal? : Option MVarId) (pass : Pass) : MetaM (Option MVarId) := do
+    let some goal := goal? | return none
+    withTraceNode `bv (fun _ => return s!"Running pass: {pass.name}") do
+      pass.run goal
+
+  let some newGoal := ← passes.foldlM (init := some goal) runPass | return none
+  if goal != newGoal then
+    trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
+    fixpointPipeline passes newGoal
+  else
+    trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
+    return newGoal
+
+/--
+Responsible for applying the Bitwuzla style rewrite rules.
+-/
+def rewriteRulesPass (maxSteps : Nat) : Pass where
+  name := `rewriteRules
+  run goal := do
+    let bvThms ← bvNormalizeExt.getTheorems
+    let bvSimprocs ← bvNormalizeSimprocExt.getSimprocs
+    let sevalThms ← getSEvalTheorems
+    let sevalSimprocs ← Simp.getSEvalSimprocs
+
+    let simpCtx ← Simp.mkContext
+      (config := { failIfUnchanged := false, zetaDelta := true, maxSteps })
+      (simpTheorems := #[bvThms, sevalThms])
+      (congrTheorems := (← getSimpCongrTheorems))
+
+    let hyps ← goal.getNondepPropHyps
+    let ⟨result?, _⟩ ← simpGoal goal
+      (ctx := simpCtx)
+      (simprocs := #[bvSimprocs, sevalSimprocs])
+      (fvarIdsToSimp := hyps)
+    let some (_, newGoal) := result? | return none
+    return newGoal
+
+/--
+Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
+with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
+in embedded constraint substitution.
+-/
+partial def andFlatteningPass : Pass where
+  name := `andFlattening
+  run goal := do
+    goal.withContext do
+      let hyps ← goal.getNondepPropHyps
+      let mut newHyps := #[]
+      let mut oldHyps := #[]
+      for fvar in hyps do
+        let hyp : Hypothesis := {
+          userName := (← fvar.getDecl).userName
+          type := ← fvar.getType
+          value := mkFVar fvar
+        }
+        let sizeBefore := newHyps.size
+        newHyps ← splitAnds hyp newHyps
+        if newHyps.size > sizeBefore then
+          oldHyps := oldHyps.push fvar
+      if newHyps.size == 0 then
+        return goal
+      else
+        let (_, goal) ← goal.assertHypotheses newHyps
+        -- Given that we collected the hypotheses in the correct order above the invariant is given
+        let goal ← goal.tryClearMany oldHyps
+        return goal
+where
+  splitAnds (hyp : Hypothesis) (hyps : Array Hypothesis) (first : Bool := true) :
+      MetaM (Array Hypothesis) := do
+    match ← trySplit hyp with
+    | some (left, right) =>
+      let hyps ← splitAnds left hyps false
+      splitAnds right hyps false
+    | none =>
+      if first then
+        return hyps
+      else
+        return hyps.push hyp
+
+  trySplit (hyp : Hypothesis) : MetaM (Option (Hypothesis × Hypothesis)) := do
+    let typ := hyp.type
+    let_expr Eq α eqLhs eqRhs := typ | return none
+    let_expr Bool.and lhs rhs := eqLhs | return none
+    let_expr Bool.true := eqRhs | return none
+    let_expr Bool := α | return none
+    let mkEqTrue (lhs : Expr) : Expr :=
+      mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
+    let leftHyp : Hypothesis := {
+      userName := hyp.userName,
+      type := mkEqTrue lhs,
+      value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
+    }
+    let rightHyp : Hypothesis := {
+      userName := hyp.userName,
+      type := mkEqTrue rhs,
+      value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
+    }
+    return some (leftHyp, rightHyp)
+
+/--
+Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
+them to substitute occurences of `x` within other hypotheses. Additionally this drops all
+redundant top level hypotheses.
+-/
+def embeddedConstraintPass (maxSteps : Nat) : Pass where
+  name := `embeddedConstraintSubsitution
+  run goal := do
+    goal.withContext do
+      let hyps ← goal.getNondepPropHyps
+      let mut relevantHyps : SimpTheoremsArray := #[]
+      let mut seen : Std.HashSet Expr := {}
+      let mut duplicates : Array FVarId := #[]
+      for hyp in hyps do
+        let typ ← hyp.getType
+        let_expr Eq α lhs rhs := typ | continue
+        let_expr Bool.true := rhs | continue
+        let_expr Bool := α | continue
+        if seen.contains lhs then
+          -- collect and later remove duplicates on the fly
+          duplicates := duplicates.push hyp
+        else
+          seen := seen.insert lhs
+          let localDecl ← hyp.getDecl
+          let proof  := localDecl.toExpr
+          relevantHyps ← relevantHyps.addTheorem (.fvar hyp) proof
+
+      let goal ← goal.tryClearMany duplicates
+
+      let simpCtx ← Simp.mkContext
+        (config := { failIfUnchanged := false, maxSteps })
+        (simpTheorems := relevantHyps)
+        (congrTheorems := (← getSimpCongrTheorems))
+
+      let ⟨result?, _⟩ ← simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := ← goal.getNondepPropHyps)
+      let some (_, newGoal) := result? | return none
+      return newGoal
+
+/--
+Normalize with respect to Associativity and Commutativity.
+-/
+def acNormalizePass : Pass where
+  name := `ac_nf
+  run goal := do
+    let mut newGoal := goal
+    for hyp in (← goal.getNondepPropHyps) do
+      let result ← Lean.Meta.AC.acNfHypMeta newGoal hyp
+
+      if let .some nextGoal := result then
+        newGoal := nextGoal
+      else
+        return none
+
+    return newGoal
+
+def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
+  let mut passPipeline := [rewriteRulesPass cfg.maxSteps]
 
   if cfg.acNf then
     passPipeline := passPipeline ++ [acNormalizePass]
@@ -34,20 +348,18 @@ def passPipeline : PreProcessM (List Pass) := do
     passPipeline := passPipeline ++ [andFlatteningPass]
 
   if cfg.embeddedConstraintSubst then
-    passPipeline := passPipeline ++ [embeddedConstraintPass]
+    passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
 
   return passPipeline
 
-def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
-  withTraceNode `bv (fun _ => return "Preprocessing goal") do
-    (go g).run cfg g
-where
-  go (g : MVarId) : PreProcessM (Option MVarId) := do
-    let some g ← g.falseOrByContra | return none
+end Pass
 
+def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
+  withTraceNode `bv (fun _ => return "Normalizing goal") do
+    -- Contradiction proof
+    let some g ← g.falseOrByContra | return none
     trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
-    let pipeline ← passPipeline
-    Pass.fixpointPipeline pipeline g
+    Pass.fixpointPipeline (Pass.passPipeline cfg) g
 
 @[builtin_tactic Lean.Parser.Tactic.bvNormalize]
 def evalBVNormalize : Tactic := fun

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

@@ -1,39 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
-import Lean.Meta.Tactic.AC.Main
-
-/-!
-This module contains the implementation of the associativity and commutativity normalisation pass
-in the fixpoint pipeline.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-
-/--
-Normalize with respect to Associativity and Commutativity.
--/
-def acNormalizePass : Pass where
-  name := `ac_nf
-  run' goal := do
-    let mut newGoal := goal
-    for hyp in (← goal.getNondepPropHyps) do
-      let result ← AC.acNfHypMeta newGoal hyp
-
-      if let .some nextGoal := result then
-        newGoal := nextGoal
-      else
-        return none
-
-    return newGoal
-
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

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

@@ -1,99 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Std.Tactic.BVDecide.Normalize.Bool
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
-import Lean.Meta.Tactic.Assert
-
-/-!
-This module contains the implementation of the and flattening pass in the fixpoint pipeline, taking
-hypotheses of the form `h : x && y = true` and splitting them into `h1 : x = true` and
-`h2 : y = true` recursively.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-
-structure AndFlattenState where
-  hypsToDelete : Array FVarId := #[]
-  hypsToAdd : Array Hypothesis := #[]
-  cache : Std.HashSet Expr := {}
-
-/--
-Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
-with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
-in embedded constraint substitution.
--/
-partial def andFlatteningPass : Pass where
-  name := `andFlattening
-  run' goal := do
-    let (_, { hypsToDelete, hypsToAdd, .. }) ← processGoal goal |>.run {}
-    if hypsToAdd.isEmpty then
-      return goal
-    else
-      let (_, goal) ← goal.assertHypotheses hypsToAdd
-      -- Given that we collected the hypotheses in the correct order above the invariant is given
-      let goal ← goal.tryClearMany hypsToDelete
-      return goal
-where
-  processGoal (goal : MVarId) : StateRefT AndFlattenState MetaM Unit := do
-    goal.withContext do
-      let hyps ← goal.getNondepPropHyps
-      hyps.forM processFVar
-
-  processFVar (fvar : FVarId) : StateRefT AndFlattenState MetaM Unit := do
-    let type ← fvar.getType
-    if (← get).cache.contains type then
-      modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
-    else
-      let hyp := {
-        userName := (← fvar.getDecl).userName
-        type := type
-        value := mkFVar fvar
-      }
-      let some (lhs, rhs) ← trySplit hyp | return ()
-      modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
-      splitAnds [lhs, rhs]
-
-  splitAnds (worklist : List Hypothesis) : StateRefT AndFlattenState MetaM Unit := do
-    match worklist with
-    | [] => return ()
-    | hyp :: worklist =>
-      match ← trySplit hyp with
-      | some (left, right) => splitAnds <| left :: right :: worklist
-      | none =>
-        modify (fun s => { s with hypsToAdd := s.hypsToAdd.push hyp })
-        splitAnds worklist
-
-  trySplit (hyp : Hypothesis) :
-      StateRefT AndFlattenState MetaM (Option (Hypothesis × Hypothesis)) := do
-    let typ := hyp.type
-    if (← get).cache.contains typ then
-      return none
-    else
-      modify (fun s => { s with cache := s.cache.insert typ })
-      let_expr Eq _ eqLhs eqRhs := typ | return none
-      let_expr Bool.and lhs rhs := eqLhs | return none
-      let_expr Bool.true := eqRhs | return none
-      let mkEqTrue (lhs : Expr) : Expr :=
-        mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
-      let leftHyp : Hypothesis := {
-        userName := hyp.userName,
-        type := mkEqTrue lhs,
-        value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
-      }
-      let rightHyp : Hypothesis := {
-        userName := hyp.userName,
-        type := mkEqTrue rhs,
-        value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
-      }
-      return some (leftHyp, rightHyp)
-
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

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

@@ -1,86 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Lean.Meta.Basic
-import Lean.Elab.Tactic.BVDecide.Frontend.Attr
-
-/-!
-This module contains the basic preprocessing pipeline framework for `bv_normalize`.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-
-structure PreProcessState where
-  /--
-  Contains `FVarId` that we already know are in `bv_normalize` simp normal form and thus don't
-  need to be processed again when we visit the next time.
-  -/
-  rewriteCache : Std.HashSet FVarId := {}
-
-abbrev PreProcessM : Type → Type := ReaderT BVDecideConfig <| StateRefT PreProcessState MetaM
-
-namespace PreProcessM
-
-def getConfig : PreProcessM BVDecideConfig := read
-
-@[inline]
-def checkRewritten (fvar : FVarId) : PreProcessM Bool := do
-  let val := (← get).rewriteCache.contains fvar
-  trace[Meta.Tactic.bv] m!"{mkFVar fvar} was already rewritten? {val}"
-  return val
-
-@[inline]
-def rewriteFinished (fvar : FVarId) : PreProcessM Unit := do
-  trace[Meta.Tactic.bv] m!"Adding {mkFVar fvar} to the rewritten set"
-  modify (fun s => { s with rewriteCache := s.rewriteCache.insert fvar })
-
-def run (cfg : BVDecideConfig) (goal : MVarId) (x : PreProcessM α) : MetaM α := do
-  let hyps ← goal.getNondepPropHyps
-  ReaderT.run x cfg |>.run' { rewriteCache := Std.HashSet.empty hyps.size }
-
-end PreProcessM
-
-/--
-A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
-the goal fully, indicated by returning `none`.
--/
-structure Pass where
-  name : Name
-  run' : MVarId → PreProcessM (Option MVarId)
-
-namespace Pass
-
-def run (pass : Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
-  withTraceNode `bv (fun _ => return m!"Running pass: {pass.name} on\n{goal}") do
-    pass.run' goal
-
-/--
-Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
-the goal anymore.
--/
-partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
-  let mut newGoal := goal
-  for pass in passes do
-    if let some nextGoal ← pass.run newGoal then
-      newGoal := nextGoal
-    else
-      trace[Meta.Tactic.bv] "Fixpoint iteration solved the goal"
-      return none
-
-  if goal != newGoal then
-    trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
-    fixpointPipeline passes newGoal
-  else
-    trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
-    return newGoal
-
-end Pass
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

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

@@ -1,62 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Std.Tactic.BVDecide.Normalize.Bool
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
-import Lean.Meta.Tactic.Simp
-
-/-!
-This module contains the implementation of the embedded constraint substitution pass in the fixpoint
-pipeline, substituting hypotheses of the form `h : x = true` in other hypotheses.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-
-/--
-Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
-them to substitute occurences of `x` within other hypotheses. Additionally this drops all
-redundant top level hypotheses.
--/
-def embeddedConstraintPass : Pass where
-  name := `embeddedConstraintSubsitution
-  run' goal := do
-    goal.withContext do
-      let hyps ← goal.getNondepPropHyps
-      let mut relevantHyps : SimpTheoremsArray := #[]
-      let mut seen : Std.HashSet Expr := {}
-      let mut duplicates : Array FVarId := #[]
-      for hyp in hyps do
-        let typ ← hyp.getType
-        let_expr Eq _ lhs rhs := typ | continue
-        let_expr Bool.true := rhs | continue
-        if seen.contains lhs then
-          duplicates := duplicates.push hyp
-        else
-          seen := seen.insert lhs
-          let localDecl ← hyp.getDecl
-          let proof := localDecl.toExpr
-          relevantHyps ← relevantHyps.addTheorem (.fvar hyp) proof
-
-      let goal ← goal.tryClearMany duplicates
-
-      if relevantHyps.isEmpty then
-        return goal
-
-      let cfg ← PreProcessM.getConfig
-      let simpCtx ← Simp.mkContext
-        (config := { failIfUnchanged := false, maxSteps := cfg.maxSteps })
-        (simpTheorems := relevantHyps)
-        (congrTheorems := (← getSimpCongrTheorems))
-      let ⟨result?, _⟩ ← simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := ← goal.getNondepPropHyps)
-      let some (_, newGoal) := result? | return none
-      return newGoal
-
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

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

@@ -1,61 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Lean.Elab.Tactic.Simp
-import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
-import Lean.Elab.Tactic.BVDecide.Frontend.Attr
-
-/-!
-This module contains the implementation of the rewriting pass in the fixpoint pipeline, applying
-rules from the `bv_normalize` simp set.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-
-/--
-Responsible for applying the Bitwuzla style rewrite rules.
--/
-def rewriteRulesPass : Pass where
-  name := `rewriteRules
-  run' goal := do
-    let bvThms ← bvNormalizeExt.getTheorems
-    let bvSimprocs ← bvNormalizeSimprocExt.getSimprocs
-    let sevalThms ← getSEvalTheorems
-    let sevalSimprocs ← Simp.getSEvalSimprocs
-    let cfg ← PreProcessM.getConfig
-
-    let simpCtx ← Simp.mkContext
-      (config := { failIfUnchanged := false, zetaDelta := true, maxSteps := cfg.maxSteps })
-      (simpTheorems := #[bvThms, sevalThms])
-      (congrTheorems := (← getSimpCongrTheorems))
-
-    let hyps ← getHyps goal
-    if hyps.isEmpty then
-      return goal
-    else
-      let ⟨result?, _⟩ ← simpGoal goal
-        (ctx := simpCtx)
-        (simprocs := #[bvSimprocs, sevalSimprocs])
-        (fvarIdsToSimp := hyps)
-
-      let some (_, newGoal) := result? | return none
-      newGoal.withContext do
-        (← newGoal.getNondepPropHyps).forM PreProcessM.rewriteFinished
-      return newGoal
-where
-  getHyps (goal : MVarId) : PreProcessM (Array FVarId) := do
-    goal.withContext do
-      let mut hyps ← goal.getNondepPropHyps
-      let filter hyp := do
-        return !(← PreProcessM.checkRewritten hyp)
-      hyps.filterM filter
-
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

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

@@ -1,164 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Henrik Böving
--/
-prelude
-import Std.Tactic.BVDecide.Normalize
-import Std.Tactic.BVDecide.Syntax
-import Lean.Elab.Tactic.Simp
-import Lean.Elab.Tactic.BVDecide.Frontend.Attr
-
-/-!
-This module contains implementations of simprocs used in the `bv_normalize` simp set.
--/
-
-namespace Lean.Elab.Tactic.BVDecide
-namespace Frontend.Normalize
-
-open Lean.Meta
-open Std.Tactic.BVDecide.Normalize
-
-builtin_simproc ↓ [bv_normalize] reduceCond (cond _ _ _) := fun e => do
-  let_expr f@cond α c tb eb := e | return .continue
-  let r ← Simp.simp c
-  if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
-    let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) (← r.getProof)
-    return .visit { expr := tb, proof? := pr }
-  else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
-    let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) (← r.getProof)
-    return .visit { expr := eb, proof? := pr }
-  else
-    return .continue
-
-builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
-  let_expr Eq _ lhs rhs := e | return .continue
-  match_expr rhs with
-  | Bool.true => return .continue
-  | _ =>
-    let beqApp ← mkAppM ``BEq.beq #[lhs, rhs]
-    let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
-    let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
-    return .done { expr := new, proof? := some proof }
-
-builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
-  let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
-  let some ⟨w, rhsValue⟩ ← getBitVecValue? rhs | return .continue
-  if rhsValue == -1#w then
-    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
-    return .visit { expr := lhs, proof? := some proof }
-  else
-    return .continue
-
-builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
-  let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
-  let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
-  if lhsValue == -1#w then
-    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
-    return .visit { expr := rhs, proof? := some proof }
-  else
-    return .continue
-
-builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
-  let_expr BitVec.ult _ lhs rhs := e | return .continue
-  let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
-  if lhsValue == -1#w then
-    let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
-    return .visit { expr := toExpr Bool.false, proof? := some proof }
-  else
-    return .continue
-
--- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
-builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
-  let_expr Neg.neg typ _ val := e | return .continue
-  let_expr BitVec widthExpr := typ | return .continue
-  let some w ← getNatValue? widthExpr | return .continue
-  match ← getBitVecValue? val with
-  | some _ => return .continue
-  | none =>
-    let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
-    let expr ← mkAppM ``HAdd.hAdd #[← mkAppM ``Complement.complement #[val], (toExpr 1#w)]
-    return .visit { expr := expr, proof? := some proof }
-
-builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
-  fun e => do
-    let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
-    let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
-    let some ⟨w, exp1Val⟩ ←  getBitVecValue? exp1 | return .continue
-    let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
-    match ← getBitVecValue? exp2 with
-    | some ⟨w', exp2Val⟩ =>
-      if h : w = w' then
-        let newLhs := exp1Val + h ▸ exp2Val
-        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
-        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
-        return .visit { expr := expr, proof? := some proof }
-      else
-        return .continue
-    | none =>
-      let some ⟨w', exp3Val⟩ ← getBitVecValue? exp3 | return .continue
-      if h : w = w' then
-        let newLhs := exp1Val + h ▸ exp3Val
-        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
-        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
-        return .visit { expr := expr, proof? := some proof }
-      else
-        return .continue
-
-builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
-  fun e => do
-    let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
-    let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
-    let some ⟨w, exp3Val⟩ ←  getBitVecValue? exp3 | return .continue
-    let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
-    match ← getBitVecValue? exp1 with
-    | some ⟨w', exp1Val⟩ =>
-      if h : w = w' then
-        let newLhs := exp3Val + h ▸ exp1Val
-        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
-        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
-        return .visit { expr := expr, proof? := some proof }
-      else
-        return .continue
-    | none =>
-      let some ⟨w', exp2Val⟩ ← getBitVecValue? exp2 | return .continue
-      if h : w = w' then
-        let newLhs := exp3Val + h ▸ exp2Val
-        let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
-        let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
-        return .visit { expr := expr, proof? := some proof }
-      else
-        return .continue
-
-/-- Return a number `k` such that `2^k = n`. -/
-private def Nat.log2Exact (n : Nat) : Option Nat := do
-  guard <| n ≠ 0
-  let k := n.log2
-  guard <| Nat.pow 2 k == n
-  return k
-
--- Build an expression for `x ^ y`.
-def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
-
-builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
-  let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
-  let some ⟨w, yVal⟩ ← getBitVecValue? y | return .continue
-  let n := yVal.toNat
-  -- BitVec.ofNat w n, where n =def= 2^k
-  let some k := Nat.log2Exact n | return .continue
-  -- check that k < w.
-  if k ≥ w then return .continue
-  let rhs ← mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
-  -- 2^k = n
-  let hk ← mkDecideProof (← mkEq (← mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
-  -- k < w
-  let hlt ← mkDecideProof (← mkLt (mkNatLit k) (mkNatLit w))
-  let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
-    #[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
-  return .done {
-      expr :=  rhs
-      proof? := some proof
-  }
-
-end Frontend.Normalize
-end Lean.Elab.Tactic.BVDecide

src/Lean/Elab/Tactic/Ext.lean

@@ -5,7 +5,6 @@ Authors: Gabriel Ebner, Mario Carneiro
 -/
 prelude
 import Init.Ext
-import Lean.Meta.Tactic.Ext
 import Lean.Elab.DeclarationRange
 import Lean.Elab.Tactic.RCases
 import Lean.Elab.Tactic.Repeat
@@ -175,8 +174,65 @@ def realizeExtIffTheorem (extName : Name) : Elab.Command.CommandElabM Name := do
 ### Attribute
 -/
 
-abbrev extExtension := Meta.Ext.extExtension
-abbrev getExtTheorems := Meta.Ext.getExtTheorems
+/-- Information about an extensionality theorem, stored in the environment extension. -/
+structure ExtTheorem where
+  /-- Declaration name of the extensionality theorem. -/
+  declName : Name
+  /-- Priority of the extensionality theorem. -/
+  priority : Nat
+  /--
+  Key in the discrimination tree,
+  for the type in which the extensionality theorem holds.
+  -/
+  keys : Array DiscrTree.Key
+  deriving Inhabited, Repr, BEq, Hashable
+
+/-- The state of the `ext` extension environment -/
+structure ExtTheorems where
+  /-- The tree of `ext` extensions. -/
+  tree   : DiscrTree ExtTheorem := {}
+  /-- Erased `ext`s via `attribute [-ext]`. -/
+  erased  : PHashSet Name := {}
+  deriving Inhabited
+
+/-- The environment extension to track `@[ext]` theorems. -/
+builtin_initialize extExtension :
+    SimpleScopedEnvExtension ExtTheorem ExtTheorems ←
+  registerSimpleScopedEnvExtension {
+    addEntry := fun { tree, erased } thm =>
+      { tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName }
+    initial := {}
+  }
+
+/-- Gets the list of `@[ext]` theorems corresponding to the key `ty`,
+ordered from high priority to low. -/
+@[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
+  let extTheorems := extExtension.getState (← getEnv)
+  let arr ← extTheorems.tree.getMatch ty
+  let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
+  -- Using insertion sort because it is stable and the list of matches should be mostly sorted.
+  -- Most ext theorems have default priority.
+  return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse
+
+/--
+Erases a name marked `ext` by adding it to the state's `erased` field and
+removing it from the state's list of `Entry`s.
+
+This is triggered by `attribute [-ext] name`.
+-/
+def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
+ { d with erased := d.erased.insert declName }
+
+/--
+Erases a name marked as a `ext` attribute.
+Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
+found somewhere in the state's tree, and is not erased.
+-/
+def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
+    m ExtTheorems := do
+  unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do
+    throwError "'{declName}' does not have [ext] attribute"
+  return d.eraseCore declName
 
 builtin_initialize registerBuiltinAttribute {
   name := `ext

src/Lean/Elab/Tactic/Grind.lean

@@ -34,69 +34,10 @@ def elabGrindPattern : CommandElab := fun stx => do
         Grind.addEMatchTheorem declName xs.size patterns.toList
   | _ => throwUnsupportedSyntax
 
-open Command Term in
-@[builtin_command_elab Lean.Parser.Command.initGrindNorm]
-def elabInitGrindNorm : CommandElab := fun stx =>
-  match stx with
-  | `(init_grind_norm $pre:ident* | $post*) =>
-    Command.liftTermElabM do
-      let pre ← pre.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
-      let post ← post.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
-      Grind.registerNormTheorems pre post
-  | _ => throwUnsupportedSyntax
-
-def elabGrindParams (params : Grind.Params) (ps :  TSyntaxArray ``Parser.Tactic.grindParam) : MetaM Grind.Params := do
-  let mut params := params
-  for p in ps do
-    match p with
-    | `(Parser.Tactic.grindParam| - $id:ident) =>
-      let declName ← realizeGlobalConstNoOverloadWithInfo id
-      if (← isInductivePredicate declName) then
-        throwErrorAt p "NIY"
-      else
-        params := { params with ematch := (← params.ematch.eraseDecl declName) }
-    | `(Parser.Tactic.grindParam| $[$mod?:grindThmMod]? $id:ident) =>
-      let declName ← realizeGlobalConstNoOverloadWithInfo id
-      let kind ← if let some mod := mod? then Grind.getTheoremKindCore mod else pure .default
-      if (← isInductivePredicate declName) then
-        throwErrorAt p "NIY"
-      else
-        let info ← getConstInfo declName
-        match info with
-        | .thmInfo _ =>
-          if kind == .eqBoth then
-            params := { params with extra := params.extra.push (← Grind.mkEMatchTheoremForDecl declName .eqLhs) }
-            params := { params with extra := params.extra.push (← Grind.mkEMatchTheoremForDecl declName .eqRhs) }
-          else
-            params := { params with extra := params.extra.push (← Grind.mkEMatchTheoremForDecl declName kind) }
-        | .defnInfo _ =>
-          if (← isReducible declName) then
-            throwErrorAt p "`{declName}` is a reducible definition, `grind` automatically unfolds them"
-          if kind != .eqLhs && kind != .default then
-            throwErrorAt p "invalid `grind` parameter, `{declName}` is a definition, the only acceptable (and redundant) modifier is '='"
-          let some thms ← Grind.mkEMatchEqTheoremsForDef? declName
-            | throwErrorAt p "failed to genereate equation theorems for `{declName}`"
-          params := { params with extra := params.extra ++ thms.toPArray' }
-        | _ =>
-          throwErrorAt p "invalid `grind` parameter, `{declName}` is not a theorem, definition, or inductive type"
-    | _ => throwError "unexpected `grind` parameter{indentD p}"
-  return params
-
-def mkGrindParams (config : Grind.Config) (only : Bool) (ps :  TSyntaxArray ``Parser.Tactic.grindParam) : MetaM Grind.Params := do
-  let params ← Grind.mkParams config
-  let ematch ← if only then pure {} else Grind.getEMatchTheorems
-  let params := { params with ematch }
-  elabGrindParams params ps
-
-def grind
-    (mvarId : MVarId) (config : Grind.Config)
-    (only : Bool)
-    (ps   :  TSyntaxArray ``Parser.Tactic.grindParam)
-    (mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
-  let params ← mkGrindParams config only ps
-  let goals ← Grind.main mvarId params mainDeclName fallback
-  unless goals.isEmpty do
-    throwError "`grind` failed\n{← Grind.goalsToMessageData goals config}"
+def grind (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
+  let mvarIds ← Grind.main mvarId config mainDeclName fallback
+  unless mvarIds.isEmpty do
+    throwError "`grind` failed\n{goalsToMessageData mvarIds}"
 
 private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
   let some fallback := fallback? | return (pure ())
@@ -115,16 +56,14 @@ private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit
     pure auxDeclName
   unsafe evalConst (Grind.GoalM Unit) auxDeclName
 
-@[builtin_tactic Lean.Parser.Tactic.grind] def evalGrind : Tactic := fun stx => do
+@[builtin_tactic Lean.Parser.Tactic.grind] def evalApplyRfl : Tactic := fun stx => do
   match stx with
-  | `(tactic| grind $config:optConfig $[only%$only]?  $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
+  | `(tactic| grind $config:optConfig $[on_failure $fallback?]?) =>
     let fallback ← elabFallback fallback?
-    let only := only.isSome
-    let params := if let some params := params then params.getElems else #[]
     logWarningAt stx "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
     let declName := (← Term.getDeclName?).getD `_grind
     let config ← elabGrindConfig config
-    withMainContext do liftMetaFinishingTactic (grind · config only params declName fallback)
+    withMainContext do liftMetaFinishingTactic (grind · config declName fallback)
   | _ => throwUnsupportedSyntax
 
 end Lean.Elab.Tactic

src/Lean/Environment.lean

@@ -88,6 +88,11 @@ structure EnvironmentHeader where
   -/
   trustLevel   : UInt32       := 0
   /--
+  `quotInit = true` if the command `init_quot` has already been executed for the environment, and
+  `Quot` declarations have been added to the environment.
+  -/
+  quotInit     : Bool         := false
+  /--
   Name of the module being compiled.
   -/
   mainModule   : Name         := default
@@ -101,15 +106,6 @@ structure EnvironmentHeader where
   moduleData   : Array ModuleData := #[]
   deriving Nonempty
 
-namespace Kernel
-
-structure Diagnostics where
-  /-- Number of times each declaration has been unfolded by the kernel. -/
-  unfoldCounter : PHashMap Name Nat := {}
-  /-- If `enabled = true`, kernel records declarations that have been unfolded. -/
-  enabled : Bool := false
-  deriving Inhabited
-
 /--
 An environment stores declarations provided by the user. The kernel
 currently supports different kinds of declarations such as definitions, theorems,
@@ -125,33 +121,10 @@ declared by users are stored in an environment extension. Users can declare new
 using meta-programming.
 -/
 structure Environment where
-  /--
-  The constructor of `Environment` is private to protect against modification that bypasses the
-  kernel.
-  -/
+  /-- The constructor of `Environment` is private to protect against modification
+  that bypasses the kernel. -/
   private mk ::
   /--
-  Mapping from constant name to `ConstantInfo`. It contains all constants (definitions, theorems,
-  axioms, etc) that have been already type checked by the kernel.
-  -/
-  constants   : ConstMap
-  /--
-  `quotInit = true` if the command `init_quot` has already been executed for the environment, and
-  `Quot` declarations have been added to the environment. When the flag is set, the type checker can
-  assume that the `Quot` declarations in the environment have indeed been added by the kernel and
-  not by the user.
-  -/
-  quotInit    : Bool := false
-  /--
-  Diagnostic information collected during kernel execution.
-
-  Remark: We store kernel diagnostic information in an environment field to simplify the interface
-  with the kernel implemented in C/C++. Thus, we can only track declarations in methods, such as
-  `addDecl`, which return a new environment. `Kernel.isDefEq` and `Kernel.whnf` do not update the
-  statistics. We claim this is ok since these methods are mainly used for debugging.
-  -/
-  diagnostics : Diagnostics := {}
-  /--
   Mapping from constant name to module (index) where constant has been declared.
   Recall that a Lean file has a header where previously compiled modules can be imported.
   Each imported module has a unique `ModuleIdx`.
@@ -161,23 +134,96 @@ structure Environment where
   the field `constants`. These auxiliary constants are invisible to the Lean kernel and elaborator.
   Only the code generator uses them.
   -/
-  const2ModIdx            : Std.HashMap Name ModuleIdx
+  const2ModIdx : Std.HashMap Name ModuleIdx
+  /--
+  Mapping from constant name to `ConstantInfo`. It contains all constants (definitions, theorems, axioms, etc)
+  that have been already type checked by the kernel.
+  -/
+  constants    : ConstMap
   /--
   Environment extensions. It also includes user-defined extensions.
   -/
-  private extensions      : Array EnvExtensionState
+  extensions   : Array EnvExtensionState
   /--
   Constant names to be saved in the field `extraConstNames` at `ModuleData`.
   It contains auxiliary declaration names created by the code generator which are not in `constants`.
   When importing modules, we want to insert them at `const2ModIdx`.
   -/
-  private extraConstNames : NameSet
-  /-- The header contains additional information that is set at import time. -/
-  header                  : EnvironmentHeader := {}
-deriving Nonempty
+  extraConstNames : NameSet
+  /-- The header contains additional information that is not updated often. -/
+  header       : EnvironmentHeader := {}
+  deriving Nonempty
 
-/-- Exceptions that can be raised by the kernel when type checking new declarations. -/
-inductive Exception where
+namespace Environment
+
+private def addAux (env : Environment) (cinfo : ConstantInfo) : Environment :=
+  { env with constants := env.constants.insert cinfo.name cinfo }
+
+/--
+Save an extra constant name that is used to populate `const2ModIdx` when we import
+.olean files. We use this feature to save in which module an auxiliary declaration
+created by the code generator has been created.
+-/
+def addExtraName (env : Environment) (name : Name) : Environment :=
+  if env.constants.contains name then
+    env
+  else
+    { env with extraConstNames := env.extraConstNames.insert name }
+
+@[export lean_environment_find]
+def find? (env : Environment) (n : Name) : Option ConstantInfo :=
+  /- It is safe to use `find'` because we never overwrite imported declarations. -/
+  env.constants.find?' n
+
+def contains (env : Environment) (n : Name) : Bool :=
+  env.constants.contains n
+
+def imports (env : Environment) : Array Import :=
+  env.header.imports
+
+def allImportedModuleNames (env : Environment) : Array Name :=
+  env.header.moduleNames
+
+@[export lean_environment_set_main_module]
+def setMainModule (env : Environment) (m : Name) : Environment :=
+  { env with header := { env.header with mainModule := m } }
+
+@[export lean_environment_main_module]
+def mainModule (env : Environment) : Name :=
+  env.header.mainModule
+
+@[export lean_environment_mark_quot_init]
+private def markQuotInit (env : Environment) : Environment :=
+  { env with header := { env.header with quotInit := true } }
+
+@[export lean_environment_quot_init]
+private def isQuotInit (env : Environment) : Bool :=
+  env.header.quotInit
+
+@[export lean_environment_trust_level]
+private def getTrustLevel (env : Environment) : UInt32 :=
+  env.header.trustLevel
+
+def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
+  env.const2ModIdx[declName]?
+
+def isConstructor (env : Environment) (declName : Name) : Bool :=
+  match env.find? declName with
+  | some (.ctorInfo _) => true
+  | _                  => false
+
+def isSafeDefinition (env : Environment) (declName : Name) : Bool :=
+  match env.find? declName with
+  | some (.defnInfo { safety := .safe, .. }) => true
+  | _ => false
+
+def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
+  env.header.moduleNames.findIdx? (· == moduleName)
+
+end Environment
+
+/-- Exceptions that can be raised by the Kernel when type checking new declarations. -/
+inductive KernelException where
   | unknownConstant  (env : Environment) (name : Name)
   | alreadyDeclared  (env : Environment) (name : Name)
   | declTypeMismatch (env : Environment) (decl : Declaration) (givenType : Expr)
@@ -198,166 +244,21 @@ inductive Exception where
 
 namespace Environment
 
-@[export lean_environment_find]
-def find? (env : Environment) (n : Name) : Option ConstantInfo :=
-  /- It is safe to use `find'` because we never overwrite imported declarations. -/
-  env.constants.find?' n
-
-@[export lean_environment_mark_quot_init]
-private def markQuotInit (env : Environment) : Environment :=
-  { env with quotInit := true }
-
-@[export lean_environment_quot_init]
-private def isQuotInit (env : Environment) : Bool :=
-  env.quotInit
-
-/-- Type check given declaration and add it to the environment -/
+/--
+Type check given declaration and add it to the environment
+-/
 @[extern "lean_add_decl"]
 opaque addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
-  (cancelTk? : @& Option IO.CancelToken) : Except Exception Environment
+  (cancelTk? : @& Option IO.CancelToken) : Except KernelException Environment
 
 /--
 Add declaration to kernel without type checking it.
-
 **WARNING** This function is meant for temporarily working around kernel performance issues.
 It compromises soundness because, for example, a buggy tactic may produce an invalid proof,
 and the kernel will not catch it if the new option is set to true.
 -/
 @[extern "lean_add_decl_without_checking"]
-opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except Exception Environment
-
-@[export lean_environment_add]
-private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
-  { env with constants := env.constants.insert cinfo.name cinfo }
-
-@[export lean_kernel_diag_is_enabled]
-def Diagnostics.isEnabled (d : Diagnostics) : Bool :=
-  d.enabled
-
-/-- Enables/disables kernel diagnostics. -/
-def enableDiag (env : Environment) (flag : Bool) : Environment :=
-  { env with diagnostics.enabled := flag }
-
-def isDiagnosticsEnabled (env : Environment) : Bool :=
-  env.diagnostics.enabled
-
-def resetDiag (env : Environment) : Environment :=
-  { env with diagnostics.unfoldCounter := {} }
-
-@[export lean_kernel_record_unfold]
-def Diagnostics.recordUnfold (d : Diagnostics) (declName : Name) : Diagnostics :=
-  if d.enabled then
-    let cNew := if let some c := d.unfoldCounter.find? declName then c + 1 else 1
-    { d with unfoldCounter := d.unfoldCounter.insert declName cNew }
-  else
-    d
-
-@[export lean_kernel_get_diag]
-def getDiagnostics (env : Environment) : Diagnostics :=
-  env.diagnostics
-
-@[export lean_kernel_set_diag]
-def setDiagnostics (env : Environment) (diag : Diagnostics) : Environment :=
-  { env with diagnostics := diag}
-
-end Kernel.Environment
-
-@[deprecated Kernel.Exception (since := "2024-12-12")]
-abbrev KernelException := Kernel.Exception
-
-/--
-Elaboration-specific extension of `Kernel.Environment` that adds tracking of asynchronously
-elaborated declarations.
--/
-structure Environment where
-  /-
-  Like with `Kernel.Environment`, this constructor is private to protect consistency of the
-  environment, though there are no soundness concerns in this case given that it is used purely for
-  elaboration.
-  -/
-  private mk ::
-  private base : Kernel.Environment
-  -- TODO: async data
-deriving Nonempty
-
-namespace Environment
-
-@[export lean_elab_environment_of_kernel_env]
-def ofKernelEnv (env : Kernel.Environment) : Environment :=
-  { base := env }
-
-@[export lean_elab_environment_to_kernel_env]
-def toKernelEnv (env : Environment) : Kernel.Environment :=
-  env.base
-
-/-- Type check given declaration and add it to the environment. -/
-@[extern "lean_elab_add_decl"]
-opaque addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
-  (cancelTk? : @& Option IO.CancelToken) : Except Kernel.Exception Environment
-
-@[inherit_doc Kernel.Environment.addDeclWithoutChecking, extern "lean_elab_add_decl_without_checking"]
-opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except Kernel.Exception Environment
-
-@[inherit_doc Kernel.Environment.constants]
-def constants (env : Environment) : ConstMap :=
-  env.toKernelEnv.constants
-
-@[inherit_doc Kernel.Environment.const2ModIdx]
-def const2ModIdx (env : Environment) : Std.HashMap Name ModuleIdx :=
-  env.toKernelEnv.const2ModIdx
-
-@[export lean_elab_environment_add]
-private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
-  { env with base := env.base.add cinfo }
-
-/--
-Save an extra constant name that is used to populate `const2ModIdx` when we import
-.olean files. We use this feature to save in which module an auxiliary declaration
-created by the code generator has been created.
--/
-def addExtraName (env : Environment) (name : Name) : Environment :=
-  if env.constants.contains name then
-    env
-  else
-    { env with base.extraConstNames := env.base.extraConstNames.insert name }
-
-def find? (env : Environment) (n : Name) : Option ConstantInfo :=
-  /- It is safe to use `find'` because we never overwrite imported declarations. -/
-  env.constants.find?' n
-
-def contains (env : Environment) (n : Name) : Bool :=
-  env.constants.contains n
-
-def header (env : Environment) : EnvironmentHeader :=
-  env.base.header
-
-def imports (env : Environment) : Array Import :=
-  env.header.imports
-
-def allImportedModuleNames (env : Environment) : Array Name :=
-  env.header.moduleNames
-
-def setMainModule (env : Environment) (m : Name) : Environment :=
-  { env with base.header.mainModule := m }
-
-def mainModule (env : Environment) : Name :=
-  env.header.mainModule
-
-def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
-  env.base.const2ModIdx[declName]?
-
-def isConstructor (env : Environment) (declName : Name) : Bool :=
-  match env.find? declName with
-  | some (.ctorInfo _) => true
-  | _                  => false
-
-def isSafeDefinition (env : Environment) (declName : Name) : Bool :=
-  match env.find? declName with
-  | some (.defnInfo { safety := .safe, .. }) => true
-  | _ => false
-
-def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
-  env.header.moduleNames.findIdx? (· == moduleName)
+opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except KernelException Environment
 
 end Environment
 
@@ -484,20 +385,20 @@ opaque EnvExtensionInterfaceImp : EnvExtensionInterface
 def EnvExtension (σ : Type) : Type := EnvExtensionInterfaceImp.ext σ
 
 private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
-  let exts ← EnvExtensionInterfaceImp.ensureExtensionsSize env.base.extensions
-  return { env with base.extensions := exts }
+  let exts ← EnvExtensionInterfaceImp.ensureExtensionsSize env.extensions
+  return { env with extensions := exts }
 
 namespace EnvExtension
 instance {σ} [s : Inhabited σ] : Inhabited (EnvExtension σ) := EnvExtensionInterfaceImp.inhabitedExt s
 
 def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment :=
-  { env with base.extensions := EnvExtensionInterfaceImp.setState ext env.base.extensions s }
+  { env with extensions := EnvExtensionInterfaceImp.setState ext env.extensions s }
 
 def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σ → σ) : Environment :=
-  { env with base.extensions := EnvExtensionInterfaceImp.modifyState ext env.base.extensions f }
+  { env with extensions := EnvExtensionInterfaceImp.modifyState ext env.extensions f }
 
 def getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment) : σ :=
-  EnvExtensionInterfaceImp.getState ext env.base.extensions
+  EnvExtensionInterfaceImp.getState ext env.extensions
 
 end EnvExtension
 
@@ -517,13 +418,11 @@ def mkEmptyEnvironment (trustLevel : UInt32 := 0) : IO Environment := do
   if initializing then throw (IO.userError "environment objects cannot be created during initialization")
   let exts ← mkInitialExtensionStates
   pure {
-    base := {
-      const2ModIdx    := {}
-      constants       := {}
-      header          := { trustLevel }
-      extraConstNames := {}
-      extensions      := exts
-    }
+    const2ModIdx    := {}
+    constants       := {}
+    header          := { trustLevel := trustLevel }
+    extraConstNames := {}
+    extensions      := exts
   }
 
 structure PersistentEnvExtensionState (α : Type) (σ : Type) where
@@ -811,7 +710,7 @@ def mkModuleData (env : Environment) : IO ModuleData := do
   let constants  := env.constants.foldStage2 (fun cs _ c => cs.push c) #[]
   return {
     imports         := env.header.imports
-    extraConstNames := env.base.extraConstNames.toArray
+    extraConstNames := env.extraConstNames.toArray
     constNames, constants, entries
   }
 
@@ -974,17 +873,17 @@ def finalizeImport (s : ImportState) (imports : Array Import) (opts : Options) (
   let constants : ConstMap := SMap.fromHashMap constantMap false
   let exts ← mkInitialExtensionStates
   let mut env : Environment := {
-    base := {
-      const2ModIdx, constants
-      quotInit        := !imports.isEmpty -- We assume `core.lean` initializes quotient module
-      extraConstNames := {}
-      extensions      := exts
-      header     := {
-        trustLevel, imports
-        regions      := s.regions
-        moduleNames  := s.moduleNames
-        moduleData   := s.moduleData
-      }
+    const2ModIdx    := const2ModIdx
+    constants       := constants
+    extraConstNames := {}
+    extensions      := exts
+    header          := {
+      quotInit     := !imports.isEmpty -- We assume `core.lean` initializes quotient module
+      trustLevel   := trustLevel
+      imports      := imports
+      regions      := s.regions
+      moduleNames  := s.moduleNames
+      moduleData   := s.moduleData
     }
   }
   env ← setImportedEntries env s.moduleData
@@ -1047,21 +946,54 @@ builtin_initialize namespacesExt : SimplePersistentEnvExtension Name NameSSet
     addEntryFn      := fun s n => s.insert n
   }
 
-@[inherit_doc Kernel.Environment.enableDiag]
-def Kernel.enableDiag (env : Lean.Environment) (flag : Bool) : Lean.Environment :=
-  { env with base := env.base.enableDiag flag }
+structure Kernel.Diagnostics where
+  /-- Number of times each declaration has been unfolded by the kernel. -/
+  unfoldCounter : PHashMap Name Nat := {}
+  /-- If `enabled = true`, kernel records declarations that have been unfolded. -/
+  enabled : Bool := false
+  deriving Inhabited
 
-def Kernel.isDiagnosticsEnabled (env : Lean.Environment) : Bool :=
-  env.base.isDiagnosticsEnabled
+/--
+Extension for storting diagnostic information.
 
-def Kernel.resetDiag (env : Lean.Environment) : Lean.Environment :=
-  { env with base := env.base.resetDiag }
+Remark: We store kernel diagnostic information in an environment extension to simplify
+the interface with the kernel implemented in C/C++. Thus, we can only track
+declarations in methods, such as `addDecl`, which return a new environment.
+`Kernel.isDefEq` and `Kernel.whnf` do not update the statistics. We claim
+this is ok since these methods are mainly used for debugging.
+-/
+builtin_initialize diagExt : EnvExtension Kernel.Diagnostics ←
+  registerEnvExtension (pure {})
 
-def Kernel.getDiagnostics (env : Lean.Environment) : Diagnostics :=
-  env.base.diagnostics
+@[export lean_kernel_diag_is_enabled]
+def Kernel.Diagnostics.isEnabled (d : Diagnostics) : Bool :=
+  d.enabled
 
-def Kernel.setDiagnostics (env : Lean.Environment) (diag : Diagnostics) : Lean.Environment :=
-  { env with base := env.base.setDiagnostics diag }
+/-- Enables/disables kernel diagnostics. -/
+def Kernel.enableDiag (env : Environment) (flag : Bool) : Environment :=
+  diagExt.modifyState env fun s => { s with enabled := flag }
+
+def Kernel.isDiagnosticsEnabled (env : Environment) : Bool :=
+  diagExt.getState env |>.enabled
+
+def Kernel.resetDiag (env : Environment) : Environment :=
+  diagExt.modifyState env fun s => { s with unfoldCounter := {} }
+
+@[export lean_kernel_record_unfold]
+def Kernel.Diagnostics.recordUnfold (d : Diagnostics) (declName : Name) : Diagnostics :=
+  if d.enabled then
+    let cNew := if let some c := d.unfoldCounter.find? declName then c + 1 else 1
+    { d with unfoldCounter := d.unfoldCounter.insert declName cNew }
+  else
+    d
+
+@[export lean_kernel_get_diag]
+def Kernel.getDiagnostics (env : Environment) : Diagnostics :=
+  diagExt.getState env
+
+@[export lean_kernel_set_diag]
+def Kernel.setDiagnostics (env : Environment) (diag : Diagnostics) : Environment :=
+  diagExt.setState env diag
 
 namespace Environment
 
@@ -1077,9 +1009,27 @@ def isNamespace (env : Environment) (n : Name) : Bool :=
 def getNamespaceSet (env : Environment) : NameSSet :=
   namespacesExt.getState env
 
-@[export lean_elab_environment_update_base_after_kernel_add]
-private def updateBaseAfterKernelAdd (env : Environment) (base : Kernel.Environment) : Environment :=
-  { env with base }
+private def isNamespaceName : Name → Bool
+  | .str .anonymous _ => true
+  | .str p _          => isNamespaceName p
+  | _                 => false
+
+private def registerNamePrefixes : Environment → Name → Environment
+  | env, .str p _ => if isNamespaceName p then registerNamePrefixes (registerNamespace env p) p else env
+  | env, _        => env
+
+@[export lean_environment_add]
+private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
+  let name := cinfo.name
+  let env := match name with
+    | .str _ s =>
+      if s.get 0 == '_' then
+        -- Do not register namespaces that only contain internal declarations.
+        env
+      else
+        registerNamePrefixes env name
+    | _ => env
+  env.addAux cinfo
 
 @[export lean_display_stats]
 def displayStats (env : Environment) : IO Unit := do
@@ -1089,7 +1039,7 @@ def displayStats (env : Environment) : IO Unit := do
   IO.println ("number of memory-mapped modules:       " ++ toString (env.header.regions.filter (·.isMemoryMapped) |>.size));
   IO.println ("number of buckets for imported consts: " ++ toString env.constants.numBuckets);
   IO.println ("trust level:                           " ++ toString env.header.trustLevel);
-  IO.println ("number of extensions:                  " ++ toString env.base.extensions.size);
+  IO.println ("number of extensions:                  " ++ toString env.extensions.size);
   pExtDescrs.forM fun extDescr => do
     IO.println ("extension '" ++ toString extDescr.name ++ "'")
     let s := extDescr.toEnvExtension.getState env
@@ -1135,33 +1085,27 @@ namespace Kernel
 
 /--
   Kernel isDefEq predicate. We use it mainly for debugging purposes.
-  Recall that the kernel type checker does not support metavariables.
+  Recall that the Kernel type checker does not support metavariables.
   When implementing automation, consider using the `MetaM` methods. -/
--- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
--- `Kernel.Environment` base variant
 @[extern "lean_kernel_is_def_eq"]
-opaque isDefEq (env : Lean.Environment) (lctx : LocalContext) (a b : Expr) : Except Kernel.Exception Bool
+opaque isDefEq (env : Environment) (lctx : LocalContext) (a b : Expr) : Except KernelException Bool
 
-def isDefEqGuarded (env : Lean.Environment) (lctx : LocalContext) (a b : Expr) : Bool :=
+def isDefEqGuarded (env : Environment) (lctx : LocalContext) (a b : Expr) : Bool :=
   if let .ok result := isDefEq env lctx a b then result else false
 
 /--
   Kernel WHNF function. We use it mainly for debugging purposes.
-  Recall that the kernel type checker does not support metavariables.
+  Recall that the Kernel type checker does not support metavariables.
   When implementing automation, consider using the `MetaM` methods. -/
--- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
--- `Kernel.Environment` base variant
 @[extern "lean_kernel_whnf"]
-opaque whnf (env : Lean.Environment) (lctx : LocalContext) (a : Expr) : Except Kernel.Exception Expr
+opaque whnf (env : Environment) (lctx : LocalContext) (a : Expr) : Except KernelException Expr
 
 /--
   Kernel typecheck function. We use it mainly for debugging purposes.
   Recall that the Kernel type checker does not support metavariables.
   When implementing automation, consider using the `MetaM` methods. -/
--- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
--- `Kernel.Environment` base variant
 @[extern "lean_kernel_check"]
-opaque check (env : Lean.Environment) (lctx : LocalContext) (a : Expr) : Except Kernel.Exception Expr
+opaque check (env : Environment) (lctx : LocalContext) (a : Expr) : Except KernelException Expr
 
 end Kernel
 

src/Lean/Exception.lean

@@ -89,11 +89,11 @@ def ofExcept [Monad m] [MonadError m] [ToMessageData ε] (x : Except ε α) : m
 /--
 Throw an error exception for the given kernel exception.
 -/
-def throwKernelException [Monad m] [MonadError m] [MonadOptions m] (ex : Kernel.Exception) : m α := do
+def throwKernelException [Monad m] [MonadError m] [MonadOptions m] (ex : KernelException) : m α := do
   Lean.throwError <| ex.toMessageData (← getOptions)
 
 /-- Lift from `Except KernelException` to `m` when `m` can throw kernel exceptions. -/
-def ofExceptKernelException [Monad m] [MonadError m] [MonadOptions m] (x : Except Kernel.Exception α) : m α :=
+def ofExceptKernelException [Monad m] [MonadError m] [MonadOptions m] (x : Except KernelException α) : m α :=
   match x with
   | .ok a    => return a
   | .error e => throwKernelException e

src/Lean/Expr.lean

@@ -639,7 +639,7 @@ def mkFVar (fvarId : FVarId) : Expr :=
 /--
 `.mvar mvarId` is now the preferred form.
 This function is seldom used, metavariables are often created using functions such
-as `mkFreshExprMVar` at `MetaM`.
+as `mkFresheExprMVar` at `MetaM`.
 -/
 def mkMVar (mvarId : MVarId) : Expr :=
   .mvar mvarId

src/Lean/Message.lean

@@ -448,9 +448,6 @@ def markAllReported (log : MessageLog) : MessageLog :=
 def errorsToWarnings (log : MessageLog) : MessageLog :=
   { unreported := log.unreported.map (fun m => match m.severity with | MessageSeverity.error => { m with severity := MessageSeverity.warning } | _ => m) }
 
-def errorsToInfos (log : MessageLog) : MessageLog :=
-  { unreported := log.unreported.map (fun m => match m.severity with | MessageSeverity.error => { m with severity := MessageSeverity.information } | _ => m) }
-
 def getInfoMessages (log : MessageLog) : MessageLog :=
   { unreported := log.unreported.filter fun m => match m.severity with | MessageSeverity.information => true | _ => false }
 
@@ -540,12 +537,12 @@ macro_rules
 def toMessageList (msgs : Array MessageData) : MessageData :=
   indentD (MessageData.joinSep msgs.toList m!"\n\n")
 
-namespace Kernel.Exception
+namespace KernelException
 
 private def mkCtx (env : Environment) (lctx : LocalContext) (opts : Options) (msg : MessageData) : MessageData :=
-  MessageData.withContext { env := .ofKernelEnv env, mctx := {}, lctx := lctx, opts := opts } msg
+  MessageData.withContext { env := env, mctx := {}, lctx := lctx, opts := opts } msg
 
-def toMessageData (e : Kernel.Exception) (opts : Options) : MessageData :=
+def toMessageData (e : KernelException) (opts : Options) : MessageData :=
   match e with
   | unknownConstant env constName       => mkCtx env {} opts m!"(kernel) unknown constant '{constName}'"
   | alreadyDeclared env constName       => mkCtx env {} opts m!"(kernel) constant has already been declared '{.ofConstName constName true}'"
@@ -573,5 +570,5 @@ def toMessageData (e : Kernel.Exception) (opts : Options) : MessageData :=
   | deepRecursion                       => "(kernel) deep recursion detected"
   | interrupted                         => "(kernel) interrupted"
 
-end Kernel.Exception
+end KernelException
 end Lean

src/Lean/Meta/AppBuilder.lean

@@ -11,14 +11,14 @@ import Lean.Meta.DecLevel
 
 namespace Lean.Meta
 
-/-- Returns `id e` -/
+/-- Return `id e` -/
 def mkId (e : Expr) : MetaM Expr := do
   let type ← inferType e
   let u    ← getLevel type
   return mkApp2 (mkConst ``id [u]) type e
 
 /--
-  Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, returns
+  Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, return
   term `@id expectedType e`. -/
 def mkExpectedTypeHint (e : Expr) (expectedType : Expr) : MetaM Expr := do
   let u ← getLevel expectedType
@@ -38,13 +38,13 @@ def mkLetFun (x : Expr) (v : Expr) (e : Expr) : MetaM Expr := do
   let u2 ← getLevel ety
   return mkAppN (.const ``letFun [u1, u2]) #[α, β, v, f]
 
-/-- Returns `a = b`. -/
+/-- Return `a = b`. -/
 def mkEq (a b : Expr) : MetaM Expr := do
   let aType ← inferType a
   let u ← getLevel aType
   return mkApp3 (mkConst ``Eq [u]) aType a b
 
-/-- Returns `HEq a b`. -/
+/-- Return `HEq a b`. -/
 def mkHEq (a b : Expr) : MetaM Expr := do
   let aType ← inferType a
   let bType ← inferType b
@@ -52,7 +52,7 @@ def mkHEq (a b : Expr) : MetaM Expr := do
   return mkApp4 (mkConst ``HEq [u]) aType a bType b
 
 /--
-  If `a` and `b` have definitionally equal types, returns `Eq a b`, otherwise returns `HEq a b`.
+  If `a` and `b` have definitionally equal types, return `Eq a b`, otherwise return `HEq a b`.
 -/
 def mkEqHEq (a b : Expr) : MetaM Expr := do
   let aType ← inferType a
@@ -63,25 +63,25 @@ def mkEqHEq (a b : Expr) : MetaM Expr := do
   else
     return mkApp4 (mkConst ``HEq [u]) aType a bType b
 
-/-- Returns a proof of `a = a`. -/
+/-- Return a proof of `a = a`. -/
 def mkEqRefl (a : Expr) : MetaM Expr := do
   let aType ← inferType a
   let u ← getLevel aType
   return mkApp2 (mkConst ``Eq.refl [u]) aType a
 
-/-- Returns a proof of `HEq a a`. -/
+/-- Return a proof of `HEq a a`. -/
 def mkHEqRefl (a : Expr) : MetaM Expr := do
   let aType ← inferType a
   let u ← getLevel aType
   return mkApp2 (mkConst ``HEq.refl [u]) aType a
 
-/-- Given `hp : P` and `nhp : Not P`, returns an instance of type `e`. -/
+/-- Given `hp : P` and `nhp : Not P` returns an instance of type `e`. -/
 def mkAbsurd (e : Expr) (hp hnp : Expr) : MetaM Expr := do
   let p ← inferType hp
   let u ← getLevel e
   return mkApp4 (mkConst ``absurd [u]) p e hp hnp
 
-/-- Given `h : False`, returns an instance of type `e`. -/
+/-- Given `h : False`, return an instance of type `e`. -/
 def mkFalseElim (e : Expr) (h : Expr) : MetaM Expr := do
   let u ← getLevel e
   return mkApp2 (mkConst ``False.elim [u]) e h
@@ -108,7 +108,7 @@ def mkEqSymm (h : Expr) : MetaM Expr := do
       return mkApp4 (mkConst ``Eq.symm [u]) α a b h
     | none => throwAppBuilderException ``Eq.symm ("equality proof expected" ++ hasTypeMsg h hType)
 
-/-- Given `h₁ : a = b` and `h₂ : b = c`, returns a proof of `a = c`. -/
+/-- Given `h₁ : a = b` and `h₂ : b = c` returns a proof of `a = c`. -/
 def mkEqTrans (h₁ h₂ : Expr) : MetaM Expr := do
   if h₁.isAppOf ``Eq.refl then
     return h₂
@@ -185,7 +185,7 @@ def mkHEqOfEq (h : Expr) : MetaM Expr := do
   return mkApp4 (mkConst ``heq_of_eq [u]) α a b h
 
 /--
-If `e` is `@Eq.refl α a`, returns `a`.
+If `e` is `@Eq.refl α a`, return `a`.
 -/
 def isRefl? (e : Expr) : Option Expr := do
   if e.isAppOfArity ``Eq.refl 2 then
@@ -194,7 +194,7 @@ def isRefl? (e : Expr) : Option Expr := do
     none
 
 /--
-If `e` is `@congrArg α β a b f h`, returns `α`, `f` and `h`.
+If `e` is `@congrArg α β a b f h`, return `α`, `f` and `h`.
 Also works if `e` can be turned into such an application (e.g. `congrFun`).
 -/
 def congrArg? (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
@@ -336,14 +336,13 @@ private def withAppBuilderTrace [ToMessageData α] [ToMessageData β]
       throw ex
 
 /--
-  Returns the application `constName xs`.
+  Return the application `constName xs`.
   It tries to fill the implicit arguments before the last element in `xs`.
 
   Remark:
   ``mkAppM `arbitrary #[α]`` returns `@arbitrary.{u} α` without synthesizing
   the implicit argument occurring after `α`.
-  Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]``,
-  returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
+  Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]`` returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
 -/
 def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := do
   withAppBuilderTrace constName xs do withNewMCtxDepth do
@@ -466,9 +465,8 @@ def mkPure (monad : Expr) (e : Expr) : MetaM Expr :=
   mkAppOptM ``Pure.pure #[monad, none, none, e]
 
 /--
-`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
-Remark: `fieldName` may be a subfield of `s`.
--/
+  `mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
+  Remark: `fieldName` may be a subfield of `s`. -/
 partial def mkProjection (s : Expr) (fieldName : Name) : MetaM Expr := do
   let type ← inferType s
   let type ← whnf type
@@ -522,11 +520,11 @@ def mkSome (type value : Expr) : MetaM Expr := do
   let u ← getDecLevel type
   return mkApp2 (mkConst ``Option.some [u]) type value
 
-/-- Returns `Decidable.decide p` -/
+/-- Return `Decidable.decide p` -/
 def mkDecide (p : Expr) : MetaM Expr :=
   mkAppOptM ``Decidable.decide #[p, none]
 
-/-- Returns a proof for `p : Prop` using `decide p` -/
+/-- Return a proof for `p : Prop` using `decide p` -/
 def mkDecideProof (p : Expr) : MetaM Expr := do
   let decP      ← mkDecide p
   let decEqTrue ← mkEq decP (mkConst ``Bool.true)
@@ -534,75 +532,63 @@ def mkDecideProof (p : Expr) : MetaM Expr := do
   let h         ← mkExpectedTypeHint h decEqTrue
   mkAppM ``of_decide_eq_true #[h]
 
-/-- Returns `a < b` -/
+/-- Return `a < b` -/
 def mkLt (a b : Expr) : MetaM Expr :=
   mkAppM ``LT.lt #[a, b]
 
-/-- Returns `a <= b` -/
+/-- Return `a <= b` -/
 def mkLe (a b : Expr) : MetaM Expr :=
   mkAppM ``LE.le #[a, b]
 
-/-- Returns `Inhabited.default α` -/
+/-- Return `Inhabited.default α` -/
 def mkDefault (α : Expr) : MetaM Expr :=
   mkAppOptM ``Inhabited.default #[α, none]
 
-/-- Returns `@Classical.ofNonempty α _` -/
+/-- Return `@Classical.ofNonempty α _` -/
 def mkOfNonempty (α : Expr) : MetaM Expr := do
   mkAppOptM ``Classical.ofNonempty #[α, none]
 
-/-- Returns `funext h` -/
+/-- Return `funext h` -/
 def mkFunExt (h : Expr) : MetaM Expr :=
   mkAppM ``funext #[h]
 
-/-- Returns `propext h` -/
+/-- Return `propext h` -/
 def mkPropExt (h : Expr) : MetaM Expr :=
   mkAppM ``propext #[h]
 
-/-- Returns `let_congr h₁ h₂` -/
+/-- Return `let_congr h₁ h₂` -/
 def mkLetCongr (h₁ h₂ : Expr) : MetaM Expr :=
   mkAppM ``let_congr #[h₁, h₂]
 
-/-- Returns `let_val_congr b h` -/
+/-- Return `let_val_congr b h` -/
 def mkLetValCongr (b h : Expr) : MetaM Expr :=
   mkAppM ``let_val_congr #[b, h]
 
-/-- Returns `let_body_congr a h` -/
+/-- Return `let_body_congr a h` -/
 def mkLetBodyCongr (a h : Expr) : MetaM Expr :=
   mkAppM ``let_body_congr #[a, h]
 
-/-- Returns `@of_eq_true p h` -/
-def mkOfEqTrueCore (p : Expr) (h : Expr) : Expr :=
-  match_expr h with
-  | eq_true _ h => h
-  | _ => mkApp2 (mkConst ``of_eq_true) p h
-
-/-- Returns `of_eq_true h` -/
+/-- Return `of_eq_true h` -/
 def mkOfEqTrue (h : Expr) : MetaM Expr := do
   match_expr h with
   | eq_true _ h => return h
   | _ => mkAppM ``of_eq_true #[h]
 
-/-- Returns `eq_true h` -/
-def mkEqTrueCore (p : Expr) (h : Expr) : Expr :=
-  match_expr h with
-  | of_eq_true _ h => h
-  | _ => mkApp2 (mkConst ``eq_true) p h
-
-/-- Returns `eq_true h` -/
+/-- Return `eq_true h` -/
 def mkEqTrue (h : Expr) : MetaM Expr := do
   match_expr h with
   | of_eq_true _ h => return h
   | _ => return mkApp2 (mkConst ``eq_true) (← inferType h) h
 
 /--
-  Returns `eq_false h`
+  Return `eq_false h`
   `h` must have type definitionally equal to `¬ p` in the current
   reducibility setting. -/
 def mkEqFalse (h : Expr) : MetaM Expr :=
   mkAppM ``eq_false #[h]
 
 /--
-  Returns `eq_false' h`
+  Return `eq_false' h`
   `h` must have type definitionally equal to `p → False` in the current
   reducibility setting. -/
 def mkEqFalse' (h : Expr) : MetaM Expr :=
@@ -620,7 +606,7 @@ def mkImpDepCongrCtx (h₁ h₂ : Expr) : MetaM Expr :=
 def mkForallCongr (h : Expr) : MetaM Expr :=
   mkAppM ``forall_congr #[h]
 
-/-- Returns instance for `[Monad m]` if there is one -/
+/-- Return instance for `[Monad m]` if there is one -/
 def isMonad? (m : Expr) : MetaM (Option Expr) :=
   try
     let monadType ← mkAppM `Monad #[m]
@@ -631,52 +617,52 @@ def isMonad? (m : Expr) : MetaM (Option Expr) :=
   catch _ =>
     pure none
 
-/-- Returns `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
+/-- Return `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
 def mkNumeral (type : Expr) (n : Nat) : MetaM Expr := do
   let u ← getDecLevel type
   let inst ← synthInstance (mkApp2 (mkConst ``OfNat [u]) type (mkRawNatLit n))
   return mkApp3 (mkConst ``OfNat.ofNat [u]) type (mkRawNatLit n) inst
 
 /--
-Returns `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
-This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
-Examples of supported classes: `HAdd`, `HSub`, `HMul`.
-We use heterogeneous operators to ensure we have a uniform representation.
--/
+  Return `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
+  This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
+  Examples of supported classes: `HAdd`, `HSub`, `HMul`.
+  We use heterogeneous operators to ensure we have a uniform representation.
+  -/
 private def mkBinaryOp (className : Name) (opName : Name) (a b : Expr) : MetaM Expr := do
   let aType ← inferType a
   let u ← getDecLevel aType
   let inst ← synthInstance (mkApp3 (mkConst className [u, u, u]) aType aType aType)
   return mkApp6 (mkConst opName [u, u, u]) aType aType aType inst a b
 
-/-- Returns `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
+/-- Return `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
 def mkAdd (a b : Expr) : MetaM Expr := mkBinaryOp ``HAdd ``HAdd.hAdd a b
 
-/-- Returns `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
+/-- Return `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
 def mkSub (a b : Expr) : MetaM Expr := mkBinaryOp ``HSub ``HSub.hSub a b
 
-/-- Returns `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
+/-- Return `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
 def mkMul (a b : Expr) : MetaM Expr := mkBinaryOp ``HMul ``HMul.hMul a b
 
 /--
-Returns `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
-This method assumes `a` and `b` have the same type.
-Examples of supported classes: `LE` and `LT`.
-We use heterogeneous operators to ensure we have a uniform representation.
--/
+  Return `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
+  This method assumes `a` and `b` have the same type.
+  Examples of supported classes: `LE` and `LT`.
+  We use heterogeneous operators to ensure we have a uniform representation.
+  -/
 private def mkBinaryRel (className : Name) (rName : Name) (a b : Expr) : MetaM Expr := do
   let aType ← inferType a
   let u ← getDecLevel aType
   let inst ← synthInstance (mkApp (mkConst className [u]) aType)
   return mkApp4 (mkConst rName [u]) aType inst a b
 
-/-- Returns `a ≤ b`. This method assumes `a` and `b` have the same type. -/
+/-- Return `a ≤ b`. This method assumes `a` and `b` have the same type. -/
 def mkLE (a b : Expr) : MetaM Expr := mkBinaryRel ``LE ``LE.le a b
 
-/-- Returns `a < b`. This method assumes `a` and `b` have the same type. -/
+/-- Return `a < b`. This method assumes `a` and `b` have the same type. -/
 def mkLT (a b : Expr) : MetaM Expr := mkBinaryRel ``LT ``LT.lt a b
 
-/-- Given `h : a = b`, returns a proof for `a ↔ b`. -/
+/-- Given `h : a = b`, return a proof for `a ↔ b`. -/
 def mkIffOfEq (h : Expr) : MetaM Expr := do
   if h.isAppOfArity ``propext 3 then
     return h.appArg!

src/Lean/Meta/Constructions/CasesOn.lean

@@ -9,13 +9,13 @@ import Lean.Meta.Basic
 
 namespace Lean
 
-@[extern "lean_mk_cases_on"] opaque mkCasesOnImp (env : Kernel.Environment) (declName : @& Name) : Except Kernel.Exception Declaration
+@[extern "lean_mk_cases_on"] opaque mkCasesOnImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
 
 open Meta
 
 def mkCasesOn (declName : Name) : MetaM Unit := do
   let name := mkCasesOnName declName
-  let decl ← ofExceptKernelException (mkCasesOnImp (← getEnv).toKernelEnv declName)
+  let decl ← ofExceptKernelException (mkCasesOnImp (← getEnv) declName)
   addDecl decl
   setReducibleAttribute name
   modifyEnv fun env => markAuxRecursor env name

src/Lean/Meta/Constructions/NoConfusion.lean

@@ -10,8 +10,8 @@ import Lean.Meta.CompletionName
 
 namespace Lean
 
-@[extern "lean_mk_no_confusion_type"] opaque mkNoConfusionTypeCoreImp (env : Environment) (declName : @& Name) : Except Kernel.Exception Declaration
-@[extern "lean_mk_no_confusion"] opaque mkNoConfusionCoreImp (env : Environment) (declName : @& Name) : Except Kernel.Exception Declaration
+@[extern "lean_mk_no_confusion_type"] opaque mkNoConfusionTypeCoreImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
+@[extern "lean_mk_no_confusion"] opaque mkNoConfusionCoreImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
 
 open Meta
 

src/Lean/Meta/Diagnostics.lean

@@ -72,12 +72,12 @@ def mkDiagSynthPendingFailure (failures : PHashMap Expr MessageData) : MetaM Dia
 /--
 We use below that this returns `m` unchanged if `s.isEmpty`
 -/
-def appendSection (m : Array MessageData) (cls : Name) (header : String) (s : DiagSummary) (resultSummary := true) : Array MessageData :=
+def appendSection (m : MessageData) (cls : Name) (header : String) (s : DiagSummary) (resultSummary := true) : MessageData :=
   if s.isEmpty then
     m
   else
     let header := if resultSummary then s!"{header} (max: {s.max}, num: {s.data.size}):" else header
-    m.push <| .trace { cls } header s.data
+    m ++ .trace { cls } header s.data
 
 def reportDiag : MetaM Unit := do
   if (← isDiagnosticsEnabled) then
@@ -89,7 +89,7 @@ def reportDiag : MetaM Unit := do
     let inst ← mkDiagSummaryForUsedInstances
     let synthPending ← mkDiagSynthPendingFailure (← get).diag.synthPendingFailures
     let unfoldKernel ← mkDiagSummary `kernel (Kernel.getDiagnostics (← getEnv)).unfoldCounter
-    let m := #[]
+    let m := MessageData.nil
     let m := appendSection m `reduction "unfolded declarations" unfoldDefault
     let m := appendSection m `reduction "unfolded instances" unfoldInstance
     let m := appendSection m `reduction "unfolded reducible declarations" unfoldReducible
@@ -99,8 +99,8 @@ def reportDiag : MetaM Unit := do
               synthPending (resultSummary := false)
     let m := appendSection m `def_eq "heuristic for solving `f a =?= f b`" heu
     let m := appendSection m `kernel "unfolded declarations" unfoldKernel
-    unless m.isEmpty do
-      let m := m.push "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
-      logInfo <| .trace { cls := `diag, collapsed := false } "Diagnostics" m
+    unless m matches .nil do
+      let m := m ++ "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
+      logInfo m
 
 end Lean.Meta

src/Lean/Meta/Tactic.lean

@@ -41,4 +41,3 @@ import Lean.Meta.Tactic.FunInd
 import Lean.Meta.Tactic.Rfl
 import Lean.Meta.Tactic.Rewrites
 import Lean.Meta.Tactic.Grind
-import Lean.Meta.Tactic.Ext

src/Lean/Meta/Tactic/Ext.lean

@@ -1,76 +0,0 @@
-/-
-Copyright (c) 2021 Gabriel Ebner. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Gabriel Ebner, Mario Carneiro
--/
-prelude
-import Init.Data.Array.InsertionSort
-import Lean.Meta.DiscrTree
-
-namespace Lean.Meta.Ext
-
-/-!
-### Environment extension for `ext` theorems
--/
-
-/-- Information about an extensionality theorem, stored in the environment extension. -/
-structure ExtTheorem where
-  /-- Declaration name of the extensionality theorem. -/
-  declName : Name
-  /-- Priority of the extensionality theorem. -/
-  priority : Nat
-  /--
-  Key in the discrimination tree,
-  for the type in which the extensionality theorem holds.
-  -/
-  keys : Array DiscrTree.Key
-  deriving Inhabited, Repr, BEq, Hashable
-
-/-- The state of the `ext` extension environment -/
-structure ExtTheorems where
-  /-- The tree of `ext` extensions. -/
-  tree   : DiscrTree ExtTheorem := {}
-  /-- Erased `ext`s via `attribute [-ext]`. -/
-  erased  : PHashSet Name := {}
-  deriving Inhabited
-
-/-- The environment extension to track `@[ext]` theorems. -/
-builtin_initialize extExtension :
-    SimpleScopedEnvExtension ExtTheorem ExtTheorems ←
-  registerSimpleScopedEnvExtension {
-    addEntry := fun { tree, erased } thm =>
-      { tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName }
-    initial := {}
-  }
-
-/-- Gets the list of `@[ext]` theorems corresponding to the key `ty`,
-ordered from high priority to low. -/
-@[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
-  let extTheorems := extExtension.getState (← getEnv)
-  let arr ← extTheorems.tree.getMatch ty
-  let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
-  -- Using insertion sort because it is stable and the list of matches should be mostly sorted.
-  -- Most ext theorems have default priority.
-  return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse
-
-/--
-Erases a name marked `ext` by adding it to the state's `erased` field and
-removing it from the state's list of `Entry`s.
-
-This is triggered by `attribute [-ext] name`.
--/
-def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
- { d with erased := d.erased.insert declName }
-
-/--
-Erases a name marked as a `ext` attribute.
-Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
-found somewhere in the state's tree, and is not erased.
--/
-def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
-    m ExtTheorems := do
-  unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do
-    throwError "'{declName}' does not have [ext] attribute"
-  return d.eraseCore declName
-
-end Lean.Meta.Ext

src/Lean/Meta/Tactic/Grind.lean

@@ -25,7 +25,6 @@ import Lean.Meta.Tactic.Grind.EMatch
 import Lean.Meta.Tactic.Grind.Main
 import Lean.Meta.Tactic.Grind.CasesMatch
 import Lean.Meta.Tactic.Grind.Arith
-import Lean.Meta.Tactic.Grind.Ext
 
 namespace Lean
 
@@ -39,7 +38,6 @@ builtin_initialize registerTraceClass `grind.ematch.pattern
 builtin_initialize registerTraceClass `grind.ematch.pattern.search
 builtin_initialize registerTraceClass `grind.ematch.instance
 builtin_initialize registerTraceClass `grind.ematch.instance.assignment
-builtin_initialize registerTraceClass `grind.eqResolution
 builtin_initialize registerTraceClass `grind.issues
 builtin_initialize registerTraceClass `grind.simp
 builtin_initialize registerTraceClass `grind.split
@@ -49,10 +47,6 @@ builtin_initialize registerTraceClass `grind.offset
 builtin_initialize registerTraceClass `grind.offset.dist
 builtin_initialize registerTraceClass `grind.offset.internalize
 builtin_initialize registerTraceClass `grind.offset.internalize.term (inherited := true)
-builtin_initialize registerTraceClass `grind.offset.propagate
-builtin_initialize registerTraceClass `grind.offset.eq
-builtin_initialize registerTraceClass `grind.offset.eq.to (inherited := true)
-builtin_initialize registerTraceClass `grind.offset.eq.from (inherited := true)
 
 /-! Trace options for `grind` developers -/
 builtin_initialize registerTraceClass `grind.debug
@@ -67,6 +61,4 @@ builtin_initialize registerTraceClass `grind.debug.split
 builtin_initialize registerTraceClass `grind.debug.canon
 builtin_initialize registerTraceClass `grind.debug.offset
 builtin_initialize registerTraceClass `grind.debug.offset.proof
-builtin_initialize registerTraceClass `grind.debug.ematch.pattern
-
 end Lean

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

@@ -8,7 +8,26 @@ import Lean.Meta.Tactic.Grind.Arith.Offset
 
 namespace Lean.Meta.Grind.Arith
 
-def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
-  Offset.internalize e parent?
+namespace Offset
+
+def internalizeTerm (_e : Expr) (_a : Expr) (_k : Nat) : GoalM Unit := do
+  -- TODO
+  return ()
+
+def internalizeCnstr (e : Expr) : GoalM Unit := do
+  let some c := isNatOffsetCnstr? e | return ()
+  let c := { c with
+    a := (← mkNode c.a)
+    b := (← mkNode c.b)
+  }
+  trace[grind.offset.internalize] "{e} ↦ {c}"
+  modify' fun s => { s with
+    cnstrs := s.cnstrs.insert { expr := e } c
+  }
+
+end Offset
+
+def internalize (e : Expr) : GoalM Unit := do
+  Offset.internalizeCnstr e
 
 end Lean.Meta.Grind.Arith

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

@@ -14,12 +14,12 @@ def isCnstr? (e : Expr) : GoalM (Option (Cnstr NodeId)) :=
   return (← get).arith.offset.cnstrs.find? { expr := e }
 
 def assertTrue (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
-  addEdge c.u c.v c.k (← mkOfEqTrue p)
+  addEdge c.a c.b c.k (← mkOfEqTrue p)
 
 def assertFalse (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
   let p := mkOfNegEqFalse (← get').nodes c p
   let c := c.neg
-  addEdge c.u c.v c.k p
+  addEdge c.a c.b c.k p
 
 end Offset
 

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

@@ -1,46 +0,0 @@
-/-
-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.Basic
-import Lean.Meta.Tactic.Grind.Types
-import Lean.Meta.Tactic.Grind.Util
-
-namespace Lean.Meta.Grind.Arith.Offset
-/-- Construct a model that statisfies all offset constraints -/
-def mkModel (goal : Goal) : MetaM (Array (Expr × Nat)) := do
-  let s := goal.arith.offset
-  let nodes := s.nodes
-  let mut pre : Array (Option Int) := mkArray nodes.size none
-  for u in [:nodes.size] do
-    let val? := s.sources[u]!.foldl (init := @none Int) fun val? v k => Id.run do
-      let some va := pre[v]! | return val?
-      let val' := va - k
-      let some val := val? | return val'
-      if val' > val then return val' else val?
-    let val? := s.targets[u]!.foldl (init := val?) fun val? v k => Id.run do
-      let some va := pre[v]! | return val?
-      let val' := va + k
-      let some val := val? | return val'
-      if val' < val then return val' else val?
-    let val := val?.getD 0
-    pre := pre.set! u (some val)
-  let min := pre.foldl (init := 0) fun min val? => Id.run do
-    let some val := val? | return min
-    if val < min then val else min
-  let mut r := {}
-  for u in [:nodes.size] do
-    let some val := pre[u]! | unreachable!
-    let val := (val - min).toNat
-    let e := nodes[u]!
-    /-
-    We should not include the assignment for auxiliary offset terms since
-    they do not provide any additional information.
-    -/
-    if (isNatOffset? e).isNone && isNatNum? e != some 0 then
-      r := r.push (e, val)
-  return r
-
-end Lean.Meta.Grind.Arith.Offset

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

@@ -48,28 +48,15 @@ def mkNode (expr : Expr) : GoalM NodeId := do
     targets := s.targets.push {}
     proofs  := s.proofs.push {}
   }
-  markAsOffsetTerm expr
   return nodeId
 
-private def getExpr (u : NodeId) : GoalM Expr := do
-  return (← get').nodes[u]!
-
 private def getDist? (u v : NodeId) : GoalM (Option Int) := do
   return (← get').targets[u]!.find? v
 
 private def getProof? (u v : NodeId) : GoalM (Option ProofInfo) := do
   return (← get').proofs[u]!.find? v
 
-private def getNodeId (e : Expr) : GoalM NodeId := do
-  let some nodeId := (← get').nodeMap.find? { expr := e }
-    | throwError "internal `grind` error, term has not been internalized by offset module{indentExpr e}"
-  return nodeId
-
-/--
-Returns a proof for `u + k ≤ v` (or `u ≤ v + k`) where `k` is the
-shortest path between `u` and `v`.
--/
-private partial def mkProofForPath (u v : NodeId) : GoalM Expr := do
+partial def extractProof (u v : NodeId) : GoalM Expr := do
   go (← getProof? u v).get!
 where
   go (p : ProofInfo) : GoalM Expr := do
@@ -79,21 +66,29 @@ where
       let p' := (← getProof? u p.w).get!
       go (mkTrans (← get').nodes p' p v)
 
-/--
-Given a new edge edge `u --(kuv)--> v` justified by proof `huv` s.t.
-it creates a negative cycle with the existing path `v --{kvu}-->* u`, i.e., `kuv + kvu < 0`,
-this function closes the current goal by constructing a proof of `False`.
--/
 private def setUnsat (u v : NodeId) (kuv : Int) (huv : Expr) (kvu : Int) : GoalM Unit := do
   assert! kuv + kvu < 0
-  let hvu ← mkProofForPath v u
-  let u ← getExpr u
-  let v ← getExpr v
-  closeGoal (mkUnsatProof u v kuv huv kvu hvu)
+  let hvu ← extractProof v u
+  let u := (← get').nodes[u]!
+  let v := (← get').nodes[v]!
+  if kuv == 0 then
+    assert! kvu < 0
+    closeGoal (mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) u v (toExpr (-kvu).toNat) rfl_true huv hvu)
+  else if kvu == 0 then
+    assert! kuv < 0
+    closeGoal (mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) v u (toExpr (-kuv).toNat) rfl_true hvu huv)
+  else if kuv < 0 then
+    if kvu > 0 then
+      closeGoal (mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) u v (toExpr (-kuv).toNat) (toExpr kvu.toNat) rfl_true huv hvu)
+    else
+      assert! kvu < 0
+      closeGoal (mkApp7 (mkConst ``Grind.Nat.unsat_lo_lo) u v (toExpr (-kuv).toNat) (toExpr (-kvu).toNat) rfl_true huv hvu)
+  else
+    assert! kuv > 0 && kvu < 0
+    closeGoal (mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) v u (toExpr (-kvu).toNat) (toExpr kuv.toNat) rfl_true hvu huv)
 
-/-- Sets the new shortest distance `k` between nodes `u` and `v`. -/
 private def setDist (u v : NodeId) (k : Int) : GoalM Unit := do
-  trace[grind.offset.dist] "{({ u, v, k : Cnstr NodeId})}"
+  trace[grind.offset.dist] "{({ a := u, b := v, k : Cnstr NodeId})}"
   modify' fun s => { s with
     targets := s.targets.modify u fun es => es.insert v k
     sources := s.sources.modify v fun es => es.insert u k
@@ -112,92 +107,17 @@ private def forEachSourceOf (u : NodeId) (f : NodeId → Int → GoalM Unit) : G
 private def forEachTargetOf (u : NodeId) (f : NodeId → Int → GoalM Unit) : GoalM Unit := do
   (← get').targets[u]!.forM f
 
-/-- Returns `true` if `k` is smaller than the shortest distance between `u` and `v` -/
 private def isShorter (u v : NodeId) (k : Int) : GoalM Bool := do
   if let some k' ← getDist? u v then
     return k < k'
   else
     return true
 
-/--
-Tries to assign `e` to `True`, which is represented by constraint `c` (from `u` to `v`), using the
-path `u --(k)--> v`.
--/
-private def propagateTrue (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
-  if k ≤ c.k then
-    trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = True"
-    let kuv ← mkProofForPath u v
-    let u ← getExpr u
-    let v ← getExpr v
-    pushEqTrue e <| mkPropagateEqTrueProof u v k kuv c.k
-    return true
-  return false
-
-/--
-Tries to assign `e` to `False`, which is represented by constraint `c` (from `v` to `u`), using the
-path `u --(k)--> v`.
--/
-private def propagateFalse (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
-  if k + c.k < 0 then
-    trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = False"
-    let kuv ← mkProofForPath u v
-    let u ← getExpr u
-    let v ← getExpr v
-    pushEqFalse e <| mkPropagateEqFalseProof u v k kuv c.k
-  return false
-
-/--
-Auxiliary function for implementing `propagateAll`.
-Traverses the constraints `c` (representing an expression `e`) s.t.
-`c.u = u` and `c.v = v`, it removes `c` from the list of constraints
-associated with `(u, v)` IF
-- `e` is already assigned, or
-- `f c e` returns true
--/
-@[inline]
-private def updateCnstrsOf (u v : NodeId) (f : Cnstr NodeId → Expr → GoalM Bool) : GoalM Unit := do
-  if let some cs := (← get').cnstrsOf.find? (u, v) then
-    let cs' ← cs.filterM fun (c, e) => do
-      if (← isEqTrue e <||> isEqFalse e) then
-        return false -- constraint was already assigned
-      else
-        return !(← f c e)
-    modify' fun s => { s with cnstrsOf := s.cnstrsOf.insert (u, v) cs' }
-
-/-- Equality propagation. -/
-private def propagateEq (u v : NodeId) (k : Int) : GoalM Unit := do
-  if k != 0 then return ()
-  let some k' ← getDist? v u | return ()
-  if k' != 0 then return ()
-  let ue ← getExpr u
-  let ve ← getExpr v
-  if (← isEqv ue ve) then return ()
-  let huv ← mkProofForPath u v
-  let hvu ← mkProofForPath v u
-  trace[grind.offset.eq.from] "{ue}, {ve}"
-  pushEq ue ve <| mkApp4 (mkConst ``Grind.Nat.eq_of_le_of_le) ue ve huv hvu
-
-/-- Performs constraint propagation. -/
-private def propagateAll (u v : NodeId) (k : Int) : GoalM Unit := do
-  updateCnstrsOf u v fun c e => return !(← propagateTrue u v k c e)
-  updateCnstrsOf v u fun c e => return !(← propagateFalse u v k c e)
-  propagateEq u v k
-
-/--
-If `isShorter u v k`, updates the shortest distance between `u` and `v`.
-`w` is the penultimate node in the path from `u` to `v`.
--/
 private def updateIfShorter (u v : NodeId) (k : Int) (w : NodeId) : GoalM Unit := do
   if (← isShorter u v k) then
     setDist u v k
     setProof u v (← getProof? w v).get!
-    propagateAll u v k
 
-/--
-Adds an edge `u --(k) --> v` justified by the proof term `p`, and then
-if no negative cycle was created, updates the shortest distance of affected
-node pairs.
--/
 def addEdge (u : NodeId) (v : NodeId) (k : Int) (p : Expr) : GoalM Unit := do
   if (← isInconsistent) then return ()
   if let some k' ← getDist? v u then
@@ -207,7 +127,6 @@ def addEdge (u : NodeId) (v : NodeId) (k : Int) (p : Expr) : GoalM Unit := do
   if (← isShorter u v k) then
     setDist u v k
     setProof u v { w := u, k, proof := p }
-    propagateAll u v k
     update
 where
   update : GoalM Unit := do
@@ -221,88 +140,6 @@ where
         /- Check whether new path: `i -(k₁)-> u -(k)-> v -(k₂) -> j` is shorter -/
         updateIfShorter i j (k₁+k+k₂) v
 
-private def internalizeCnstr (e : Expr) (c : Cnstr Expr) : GoalM Unit := do
-  let u ← mkNode c.u
-  let v ← mkNode c.v
-  let c := { c with u, v }
-  if let some k ← getDist? u v then
-    if (← propagateTrue u v k c e) then
-      return ()
-  if let some k ← getDist? v u then
-    if (← propagateFalse v u k c e) then
-      return ()
-  trace[grind.offset.internalize] "{e} ↦ {c}"
-  modify' fun s => { s with
-    cnstrs   := s.cnstrs.insert { expr := e } c
-    cnstrsOf :=
-      let cs := if let some cs := s.cnstrsOf.find? (u, v) then (c, e) :: cs else [(c, e)]
-      s.cnstrsOf.insert (u, v) cs
-  }
-
-private def getZeroNode : GoalM NodeId := do
-  mkNode (← getNatZeroExpr)
-
-/-- Internalize `e` of the form `b + k` -/
-private def internalizeTerm (e : Expr) (b : Expr) (k : Nat) : GoalM Unit := do
-  -- `e` is of the form `b + k`
-  let u ← mkNode e
-  let v ← mkNode b
-  -- `u = v + k`. So, we add edges for `u ≤ v + k` and `v + k ≤ u`.
-  let h := mkApp (mkConst ``Nat.le_refl) e
-  addEdge u v k h
-  addEdge v u (-k) h
-  -- `0 + k ≤ u`
-  let z ← getZeroNode
-  addEdge z u (-k) <| mkApp2 (mkConst ``Grind.Nat.le_offset) b (toExpr k)
-
-/--
-Returns `true`, if `parent?` is relevant for internalization.
-For example, we do not want to internalize an offset term that
-is the child of an addition. This kind of term will be processed by the
-more general linear arithmetic module.
--/
-private def isRelevantParent (parent? : Option Expr) : GoalM Bool := do
-  let some parent := parent? | return false
-  let z ← getNatZeroExpr
-  return !isNatAdd parent && (isNatOffsetCnstr? parent z).isNone
-
-private def isEqParent (parent? : Option Expr) : Bool := Id.run do
-  let some parent := parent? | return false
-  return parent.isEq
-
-def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
-  let z ← getNatZeroExpr
-  if let some c := isNatOffsetCnstr? e z then
-    internalizeCnstr e c
-  else if (← isRelevantParent parent?) then
-    if let some (b, k) := isNatOffset? e then
-      internalizeTerm e b k
-    else if let some k := isNatNum? e then
-      -- core module has support for detecting equality between literals
-      unless isEqParent parent? do
-        internalizeTerm e z k
-
-@[export lean_process_new_offset_eq]
-def processNewOffsetEqImpl (a b : Expr) : GoalM Unit := do
-  unless isSameExpr a b do
-    trace[grind.offset.eq.to] "{a}, {b}"
-    let u ← getNodeId a
-    let v ← getNodeId b
-    let h ← mkEqProof a b
-    addEdge u v 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
-    addEdge v u 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
-
-@[export lean_process_new_offset_eq_lit]
-def processNewOffsetEqLitImpl (a b : Expr) : GoalM Unit := do
-  unless isSameExpr a b do
-    trace[grind.offset.eq.to] "{a}, {b}"
-    let some k := isNatNum? b | unreachable!
-    let u ← getNodeId a
-    let z ← mkNode (← getNatZeroExpr)
-    let h ← mkEqProof a b
-    addEdge u z k <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
-    addEdge z u (-k) <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
-
 def traceDists : GoalM Unit := do
   let s ← get'
   for u in [:s.targets.size], es in s.targets.toArray do
@@ -310,22 +147,23 @@ def traceDists : GoalM Unit := do
       trace[grind.offset.dist] "#{u} -({k})-> #{v}"
 
 def Cnstr.toExpr (c : Cnstr NodeId) : GoalM Expr := do
-  let u := (← get').nodes[c.u]!
-  let v := (← get').nodes[c.v]!
+  let a := (← get').nodes[c.a]!
+  let b := (← get').nodes[c.b]!
+  let mk := if c.le then mkNatLE else mkNatEq
   if c.k == 0 then
-    return mkNatLE u v
+    return mk a b
   else if c.k < 0 then
-    return mkNatLE (mkNatAdd u (Lean.toExpr ((-c.k).toNat))) v
+    return mk (mkNatAdd a (Lean.toExpr ((-c.k).toNat))) b
   else
-    return mkNatLE u (mkNatAdd v (Lean.toExpr c.k.toNat))
+    return mk a (mkNatAdd b (Lean.toExpr c.k.toNat))
 
 def checkInvariants : GoalM Unit := do
   let s ← get'
   for u in [:s.targets.size], es in s.targets.toArray do
     for (v, k) in es do
-      let c : Cnstr NodeId := { u, v, k }
+      let c : Cnstr NodeId := { a := u, b := v, k }
       trace[grind.debug.offset] "{c}"
-      let p ← mkProofForPath u v
+      let p ← extractProof u v
       trace[grind.debug.offset.proof] "{p} : {← inferType p}"
       check p
       unless (← withDefault <| isDefEq (← inferType p) (← Cnstr.toExpr c)) do

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

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Grind.Offset
-import Init.Grind.Lemmas
 import Lean.Meta.Tactic.Grind.Types
 
 namespace Lean.Meta.Grind.Arith
@@ -16,12 +15,8 @@ Helper functions for constructing proof terms in the arithmetic procedures.
 
 namespace Offset
 
-/-- Returns a proof for `true = true` -/
-def rfl_true : Expr := mkConst ``Grind.rfl_true
-
-private def toExprN (n : Int) :=
-  assert! n >= 0
-  toExpr n.toNat
+/-- `Eq.refl true` -/
+def rfl_true : Expr := mkApp2 (mkConst ``Eq.refl [levelOne]) (mkConst ``Bool) (mkConst ``Bool.true)
 
 open Lean.Grind in
 /--
@@ -41,127 +36,53 @@ def mkTrans (nodes : PArray Expr) (pi₁ : ProofInfo) (pi₂ : ProofInfo) (v : N
       mkApp5 (mkConst ``Nat.le_trans) u w v p₁ p₂
     else if k₂ > 0 then
       -- u ≤ v, w ≤ v + k₂
-      mkApp6 (mkConst ``Nat.le_ro) u w v (toExprN k₂) p₁ p₂
+      mkApp6 (mkConst ``Nat.le_ro) u w v (toExpr k₂.toNat) p₁ p₂
     else
       let k₂ := - k₂
       -- u ≤ w, w + k₂ ≤ v
-      mkApp6 (mkConst ``Nat.le_lo) u w v (toExprN k₂) p₁ p₂
+      mkApp6 (mkConst ``Nat.le_lo) u w v (toExpr k₂.toNat) p₁ p₂
   else if k₁ < 0 then
     let k₁ := -k₁
     if k₂ == 0 then
-      mkApp6 (mkConst ``Nat.lo_le) u w v (toExprN k₁) p₁ p₂
+      mkApp6 (mkConst ``Nat.lo_le) u w v (toExpr k₁.toNat) p₁ p₂
     else if k₂ < 0 then
       let k₂ := -k₂
-      mkApp7 (mkConst ``Nat.lo_lo) u w v (toExprN k₁) (toExprN k₂) p₁ p₂
+      mkApp7 (mkConst ``Nat.lo_lo) u w v (toExpr k₁.toNat) (toExpr k₂.toNat) p₁ p₂
     else
-      let ke₁ := toExprN k₁
-      let ke₂ := toExprN k₂
+      let ke₁ := toExpr k₁.toNat
+      let ke₂ := toExpr k₂.toNat
       if k₁ > k₂ then
         mkApp8 (mkConst ``Nat.lo_ro_1) u w v ke₁ ke₂ rfl_true p₁ p₂
       else
         mkApp7 (mkConst ``Nat.lo_ro_2) u w v ke₁ ke₂ p₁ p₂
   else
-    let ke₁ := toExprN k₁
+    let ke₁ := toExpr k₁.toNat
     if k₂ == 0 then
       mkApp6 (mkConst ``Nat.ro_le) u w v ke₁ p₁ p₂
     else if k₂ < 0 then
       let k₂  := -k₂
-      let ke₂ := toExprN k₂
+      let ke₂ := toExpr k₂.toNat
        if k₂ > k₁ then
          mkApp8 (mkConst ``Nat.ro_lo_2) u w v ke₁ ke₂ rfl_true p₁ p₂
        else
          mkApp7 (mkConst ``Nat.ro_lo_1) u w v ke₁ ke₂ p₁ p₂
     else
-      let ke₂ := toExprN k₂
+      let ke₂ := toExpr k₂.toNat
       mkApp7 (mkConst ``Nat.ro_ro) u w v ke₁ ke₂ p₁ p₂
   { w := pi₁.w, k := k₁+k₂, proof := p }
 
 open Lean.Grind in
 def mkOfNegEqFalse (nodes : PArray Expr) (c : Cnstr NodeId) (h : Expr) : Expr :=
-  let u := nodes[c.u]!
-  let v := nodes[c.v]!
+  let u := nodes[c.a]!
+  let v := nodes[c.b]!
   if c.k == 0 then
     mkApp3 (mkConst ``Nat.of_le_eq_false) u v h
-  else if c.k == -1 then
+  else if c.k == -1 && c.le then
     mkApp3 (mkConst ``Nat.of_lo_eq_false_1) u v h
   else if c.k < 0 then
-    mkApp4 (mkConst ``Nat.of_lo_eq_false) u v (toExprN (-c.k)) h
+    mkApp4 (mkConst ``Nat.of_lo_eq_false) u v (toExpr (-c.k).toNat) h
   else
-    mkApp4 (mkConst ``Nat.of_ro_eq_false) u v (toExprN c.k) h
-
-/--
-Returns a proof of `False` using a negative cycle composed of
-- `u --(kuv)--> v` with proof `huv`
-- `v --(kvu)--> u` with proof `hvu`
--/
-def mkUnsatProof (u v : Expr) (kuv : Int) (huv : Expr) (kvu : Int) (hvu : Expr) : Expr :=
-  if kuv == 0 then
-    assert! kvu < 0
-    mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) u v (toExprN (-kvu)) rfl_true huv hvu
-  else if kvu == 0 then
-    mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) v u (toExprN (-kuv)) rfl_true hvu huv
-  else if kuv < 0 then
-    if kvu > 0 then
-      mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) u v (toExprN (-kuv)) (toExprN kvu) rfl_true huv hvu
-    else
-      assert! kvu < 0
-      mkApp7 (mkConst ``Grind.Nat.unsat_lo_lo) u v (toExprN (-kuv)) (toExprN (-kvu)) rfl_true huv hvu
-  else
-    assert! kuv > 0 && kvu < 0
-    mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) v u (toExprN (-kvu)) (toExprN kuv) rfl_true hvu huv
-
-/--
-Given a path `u --(kuv)--> v` justified by proof `huv`,
-construct a proof of `e = True` where `e` is a term corresponding to the edgen `u --(k') --> v`
-s.t. `k ≤ k'`
--/
-def mkPropagateEqTrueProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
-  if k == 0 then
-    if k' == 0 then
-      mkApp3 (mkConst ``Grind.Nat.le_eq_true_of_le) u v huv
-    else
-      assert! k' > 0
-      mkApp4 (mkConst ``Grind.Nat.ro_eq_true_of_le) u v (toExprN k') huv
-  else if k < 0 then
-    let k := -k
-    if k' == 0 then
-      mkApp4 (mkConst ``Grind.Nat.le_eq_true_of_lo) u v (toExprN k) huv
-    else if k' < 0 then
-      let k' := -k'
-      mkApp6 (mkConst ``Grind.Nat.lo_eq_true_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
-    else
-      assert! k' > 0
-      mkApp5 (mkConst ``Grind.Nat.ro_eq_true_of_lo) u v (toExprN k) (toExprN k') huv
-  else
-    assert! k > 0
-    assert! k' > 0
-    mkApp6 (mkConst ``Grind.Nat.ro_eq_true_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
-
-/--
-Given a path `u --(kuv)--> v` justified by proof `huv`,
-construct a proof of `e = False` where `e` is a term corresponding to the edgen `v --(k') --> u`
-s.t. `k+k' < 0`
--/
-def mkPropagateEqFalseProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
-  if k == 0 then
-    assert! k' < 0
-    let k' := -k'
-    mkApp5 (mkConst ``Grind.Nat.lo_eq_false_of_le) u v (toExprN k') rfl_true huv
-  else if k < 0 then
-    let k := -k
-    if k' == 0 then
-      mkApp5 (mkConst ``Grind.Nat.le_eq_false_of_lo) u v (toExprN k) rfl_true huv
-    else if k' < 0 then
-      let k' := -k'
-      mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
-    else
-      assert! k' > 0
-      mkApp6 (mkConst ``Grind.Nat.ro_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
-  else
-    assert! k > 0
-    assert! k' < 0
-    let k' := -k'
-    mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
+    mkApp4 (mkConst ``Nat.of_ro_eq_false) u v (toExpr c.k.toNat) h
 
 end Offset
 

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

@@ -26,34 +26,26 @@ structure ProofInfo where
 
 /-- State of the constraint offset procedure. -/
 structure State where
-  /-- Mapping from `NodeId` to the `Expr` represented by the node. -/
-  nodes    : PArray Expr := {}
-  /-- Mapping from `Expr` to a node representing it. -/
-  nodeMap  : PHashMap ENodeKey NodeId := {}
-  /-- Mapping from `Expr` representing inequalites to constraints. -/
-  cnstrs   : PHashMap ENodeKey (Cnstr NodeId) := {}
-  /--
-  Mapping from pairs `(u, v)` to a list of offset constraints on `u` and `v`.
-  We use this mapping to implement exhaustive constraint propagation.
-  -/
-  cnstrsOf : PHashMap (NodeId × NodeId) (List (Cnstr NodeId × Expr)) := {}
+  nodes   : PArray Expr := {}
+  nodeMap : PHashMap ENodeKey NodeId := {}
+  cnstrs  : PHashMap ENodeKey (Cnstr NodeId) := {}
   /--
   For each node with id `u`, `sources[u]` contains
   pairs `(v, k)` s.t. there is a path from `v` to `u` with weight `k`.
   -/
-  sources  : PArray (AssocList NodeId Int) := {}
+  sources : PArray (AssocList NodeId Int) := {}
   /--
   For each node with id `u`, `targets[u]` contains
   pairs `(v, k)` s.t. there is a path from `u` to `v` with weight `k`.
   -/
-  targets  : PArray (AssocList NodeId Int) := {}
+  targets : PArray (AssocList NodeId Int) := {}
   /--
   Proof reconstruction information. For each node with id `u`, `proofs[u]` contains
   pairs `(v, { w, proof })` s.t. there is a path from `u` to `v`, and
   `w` is the penultimate node in the path, and `proof` is the justification for
   the last edge.
   -/
-  proofs   : PArray (AssocList NodeId ProofInfo) := {}
+  proofs  : PArray (AssocList NodeId ProofInfo) := {}
   deriving Inhabited
 
 end Offset

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

@@ -32,16 +32,6 @@ def isNatAdd? (e : Expr) : Option (Expr × Expr) :=
   let_expr HAdd.hAdd _ _ _ i a b := e | none
   if isInstAddNat i then some (a, b) else none
 
-/--
-Returns `true` if `e` is of the form
-```
-@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) _ _
-```
--/
-def isNatAdd (e : Expr) : Bool :=
-  let_expr HAdd.hAdd _ _ _ i _ _ := e | false
-  isInstAddNat i
-
 /-- Returns `some k` if `e` `@OfNat.ofNat Nat _ (instOfNatNat k)` -/
 def isNatNum? (e : Expr) : Option Nat := Id.run do
   let_expr OfNat.ofNat _ _ inst := e | none
@@ -57,46 +47,43 @@ def isNatOffset? (e : Expr) : Option (Expr × Nat) := Id.run do
 
 /-- An offset constraint. -/
 structure Offset.Cnstr (α : Type) where
-  u  : α
-  v  : α
+  a  : α
+  b  : α
   k  : Int := 0
+  le : Bool := true
   deriving Inhabited
 
 def Offset.Cnstr.neg : Cnstr α → Cnstr α
-  | { u, v, k } => { u := v, v := u, k := -k - 1 }
+  | { a, b, k, le } => { a := b, b := a, le, k := -k - 1 }
 
 example (c : Offset.Cnstr α) : c.neg.neg = c := by
   cases c; simp [Offset.Cnstr.neg]; omega
 
 def Offset.toMessageData [inst : ToMessageData α] (c : Offset.Cnstr α) : MessageData :=
-  match c.k with
-  | .ofNat 0   => m!"{c.u} ≤ {c.v}"
-  | .ofNat k   => m!"{c.u} ≤ {c.v} + {k}"
-  | .negSucc k => m!"{c.u} + {k + 1} ≤ {c.v}"
+  match c.k, c.le with
+  | .ofNat 0,   true  => m!"{c.a} ≤ {c.b}"
+  | .ofNat 0,   false => m!"{c.a} = {c.b}"
+  | .ofNat k,   true  => m!"{c.a} ≤ {c.b} + {k}"
+  | .ofNat k,   false => m!"{c.a} = {c.b} + {k}"
+  | .negSucc k, true  => m!"{c.a} + {k + 1} ≤ {c.b}"
+  | .negSucc k, false => m!"{c.a} + {k + 1} = {c.b}"
 
 instance : ToMessageData (Offset.Cnstr Expr) where
   toMessageData c := Offset.toMessageData c
 
-/--
-Returns `some cnstr` if `e` is offset constraint.
-Remark: `z` is `0` numeral. It is an extra argument because we
-want to be able to provide the one that has already been internalized.
--/
-def isNatOffsetCnstr? (e : Expr) (z : Expr) : Option (Offset.Cnstr Expr) :=
+/-- Returns `some cnstr` if `e` is offset constraint. -/
+def isNatOffsetCnstr? (e : Expr) : Option (Offset.Cnstr Expr) :=
   match_expr e with
-  | LE.le _ inst a b => if isInstLENat inst then go a b else none
+  | LE.le _ inst a b => if isInstLENat inst then go a b true else none
+  | Eq α a b => if isNatType α then go a b false else none
   | _ => none
 where
-  go (u v : Expr) :=
-    if let some (u, k) := isNatOffset? u then
-      some { u, k := - k, v }
-    else if let some (v, k) := isNatOffset? v then
-      some { u, v, k }
-    else if let some k := isNatNum? u then
-      some { u := z, v, k := - k }
-    else if let some k := isNatNum? v then
-      some { u, v := z, k }
+  go (a b : Expr) (le : Bool) :=
+    if let some (a, k) := isNatOffset? a then
+      some { a, k := - k, b, le }
+    else if let some (b, k) := isNatOffset? b then
+      some { a, b, k := k, le }
     else
-      some { u, v }
+      some { a, b, le }
 
 end Lean.Meta.Grind.Arith

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

@@ -10,7 +10,6 @@ import Lean.Meta.FunInfo
 import Lean.Util.FVarSubset
 import Lean.Util.PtrSet
 import Lean.Util.FVarSubset
-import Lean.Meta.Tactic.Grind.Types
 
 namespace Lean.Meta.Grind
 namespace Canon
@@ -41,37 +40,42 @@ additions will still use structurally different (and definitionally different) i
 Furthermore, `grind` will not be able to infer that  `HEq (a + a) (b + b)` even if we add the assumptions `n = m` and `HEq a b`.
 -/
 
-@[inline] private def get' : GoalM State :=
-  return (← get).canon
+structure State where
+  argMap     : PHashMap (Expr × Nat) (List Expr) := {}
+  canon      : PHashMap Expr Expr := {}
+  proofCanon : PHashMap Expr Expr := {}
+  deriving Inhabited
 
-@[inline] private def modify' (f : State → State) : GoalM Unit :=
-  modify fun s => { s with canon := f s.canon }
+inductive CanonElemKind where
+  | /--
+    Type class instances are canonicalized using `TransparencyMode.instances`.
+    -/
+    instance
+  | /--
+    Types and Type formers are canonicalized using `TransparencyMode.default`.
+    Remark: propositions are just visited. We do not invoke `canonElemCore` for them.
+    -/
+    type
+  | /--
+    Implicit arguments that are not types, type formers, or instances, are canonicalized
+    using `TransparencyMode.reducible`
+    -/
+    implicit
+  deriving BEq
 
-/--
-Helper function for `canonElemCore`. It tries `isDefEq a b` with default transparency, but using
-at most `canonHeartbeats` heartbeats. It reports an issue if the threshold is reached.
-Remark: `parent` is use only to report an issue
--/
-private def isDefEqBounded (a b : Expr) (parent : Expr) : GoalM Bool := do
-  withCurrHeartbeats do
-  let config ← getConfig
-  tryCatchRuntimeEx
-    (withTheReader Core.Context (fun ctx => { ctx with maxHeartbeats := config.canonHeartbeats }) do
-      withDefault <| isDefEq a b)
-    fun ex => do
-      if ex.isRuntime then
-        let curr := (← getConfig).canonHeartbeats
-        reportIssue m!"failed to show that{indentExpr a}\nis definitionally equal to{indentExpr b}\nwhile canonicalizing{indentExpr parent}\nusing `{curr}*1000` heartbeats, `(canonHeartbeats := {curr})`"
-        return false
-      else
-        throw ex
+def CanonElemKind.explain : CanonElemKind → String
+  | .instance => "type class instances"
+  | .type => "types (or type formers)"
+  | .implicit => "implicit arguments (which are not type class instances or types)"
 
 /--
 Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
-If `useIsDefEqBounded` is `true`, we try `isDefEqBounded` before returning false
+
+Thus, if diagnostics are enabled, we also re-check them using `TransparencyMode.default`. If the result is different
+we report to the user.
 -/
-def canonElemCore (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBounded : Bool) : GoalM Expr := do
-  let s ← get'
+def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : StateT State MetaM Expr := do
+  let s ← get
   if let some c := s.canon.find? e then
     return c
   let key := (f, i)
@@ -81,23 +85,20 @@ def canonElemCore (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBou
       -- We used to check `c.fvarsSubset e` because it is not
       -- in general safe to replace `e` with `c` if `c` has more free variables than `e`.
       -- However, we don't revert previously canonicalized elements in the `grind` tactic.
-      -- Moreover, we store the canonicalizer state in the `Goal` because we case-split
-      -- and different locals are added in different branches.
-      modify' fun s => { s with canon := s.canon.insert e c }
-      trace[grind.debugn.canon] "found {e} ===> {c}"
+      modify fun s => { s with canon := s.canon.insert e c }
+      trace[grind.debug.canon] "found {e} ===> {c}"
       return c
-    if useIsDefEqBounded then
-      if (← isDefEqBounded e c parent) then
-        modify' fun s => { s with canon := s.canon.insert e c }
-        trace[grind.debugn.canon] "found using `isDefEqBounded`: {e} ===> {c}"
-        return c
+    if kind != .type then
+      if (← isTracingEnabledFor `grind.issues <&&> (withDefault <| isDefEq e c)) then
+        -- TODO: consider storing this information in some structure that can be browsed later.
+        trace[grind.issues] "the following {kind.explain} are definitionally equal with `default` transparency but not with a more restrictive transparency{indentExpr e}\nand{indentExpr c}"
   trace[grind.debug.canon] "({f}, {i}) ↦ {e}"
-  modify' fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
+  modify fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
   return e
 
-abbrev canonType (parent f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore parent f i e (useIsDefEqBounded := false)
-abbrev canonInst (parent f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore parent f i e (useIsDefEqBounded := true)
-abbrev canonImplicit (parent f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore parent f i e (useIsDefEqBounded := true)
+abbrev canonType (f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore f i e .type
+abbrev canonInst (f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore f i e .instance
+abbrev canonImplicit (f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore f i e .implicit
 
 /--
 Return type for the `shouldCanon` function.
@@ -145,10 +146,10 @@ def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Should
   else
     return .visit
 
-unsafe def canonImpl (e : Expr) : GoalM Expr := do
+unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
   visit e |>.run' mkPtrMap
 where
-  visit (e : Expr) : StateRefT (PtrMap Expr Expr) GoalM Expr := do
+  visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
     unless e.isApp || e.isForall do return e
     -- Check whether it is cached
     if let some r := (← get).find? e then
@@ -158,11 +159,11 @@ where
         if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
           let prop := args[0]!
           let prop' ← visit prop
-          if let some r := (← get').proofCanon.find? prop' then
+          if let some r := (← getThe State).proofCanon.find? prop' then
             pure r
           else
             let e' := if ptrEq prop prop' then e else mkAppN f (args.set! 0 prop')
-            modify' fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
+            modifyThe State fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
             pure e'
         else
           let pinfos := (← getFunInfo f).paramInfo
@@ -172,9 +173,9 @@ where
             let arg := args[i]
             trace[grind.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
             let arg' ← match (← shouldCanon pinfos i arg) with
-            | .canonType  => canonType e f i arg
-            | .canonInst  => canonInst e f i arg
-            | .canonImplicit => canonImplicit e f i (← visit arg)
+            | .canonType  => canonType f i arg
+            | .canonInst  => canonInst f i arg
+            | .canonImplicit => canonImplicit f i (← visit arg)
             | .visit      => visit arg
             unless ptrEq arg arg' do
               args := args.set i arg'
@@ -190,11 +191,11 @@ where
     modify fun s => s.insert e e'
     return e'
 
+/-- Canonicalizes nested types, type formers, and instances in `e`. -/
+def canon (e : Expr) : StateT State MetaM Expr := do
+  trace[grind.debug.canon] "{e}"
+  unsafe canonImpl e
+
 end Canon
 
-/-- Canonicalizes nested types, type formers, and instances in `e`. -/
-def canon (e : Expr) : GoalM Expr := do
-  trace[grind.debug.canon] "{e}"
-  unsafe Canon.canonImpl e
-
 end Lean.Meta.Grind

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

@@ -10,7 +10,6 @@ import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Inv
 import Lean.Meta.Tactic.Grind.PP
 import Lean.Meta.Tactic.Grind.Ctor
-import Lean.Meta.Tactic.Grind.Util
 import Lean.Meta.Tactic.Grind.Internalize
 
 namespace Lean.Meta.Grind
@@ -87,26 +86,6 @@ private partial def updateMT (root : Expr) : GoalM Unit := do
       setENode parent { node with mt := gmt }
       updateMT parent
 
-/--
-Helper function for combining `ENode.offset?` fields and propagating an equality
-to the offset constraint module.
--/
-private def propagateOffsetEq (rhsRoot lhsRoot : ENode) : GoalM Unit := do
-  match lhsRoot.offset? with
-  | some lhsOffset =>
-    if let some rhsOffset := rhsRoot.offset? then
-      Arith.processNewOffsetEq lhsOffset rhsOffset
-    else if isNatNum rhsRoot.self then
-      Arith.processNewOffsetEqLit 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 }
-  | none =>
-    if isNatNum lhsRoot.self then
-    if let some rhsOffset := rhsRoot.offset? then
-      Arith.processNewOffsetEqLit rhsOffset lhsRoot.self
-
 private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit := do
   let lhsNode ← getENode lhs
   let rhsNode ← getENode rhs
@@ -139,7 +118,7 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
   unless (← isInconsistent) do
     if valueInconsistency then
       closeGoalWithValuesEq lhsRoot.self rhsRoot.self
-  trace_goal[grind.debug] "after addEqStep, {← (← get).ppState}"
+  trace_goal[grind.debug] "after addEqStep, {← ppState}"
   checkInvariants
 where
   go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
@@ -167,18 +146,17 @@ where
       next := rhsRoot.next
     }
     setENode rhsNode.root { rhsRoot with
-      next       := lhsRoot.next
-      size       := rhsRoot.size + lhsRoot.size
+      next := lhsRoot.next
+      size := rhsRoot.size + lhsRoot.size
       hasLambdas := rhsRoot.hasLambdas || lhsRoot.hasLambdas
       heqProofs  := isHEq || rhsRoot.heqProofs || lhsRoot.heqProofs
     }
     copyParentsTo parents rhsNode.root
-    unless (← isInconsistent) do
-      updateMT rhsRoot.self
-    propagateOffsetEq rhsRoot lhsRoot
     unless (← isInconsistent) do
       for parent in parents do
         propagateUp parent
+    unless (← isInconsistent) do
+      updateMT rhsRoot.self
 
   updateRoots (lhs : Expr) (rootNew : Expr) : GoalM Unit := do
     traverseEqc lhs fun n =>
@@ -214,28 +192,22 @@ where
     processTodo
 
 /-- Adds a new equality `lhs = rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
-private def addEq (lhs rhs proof : Expr) : GoalM Unit := do
+def addEq (lhs rhs proof : Expr) : GoalM Unit := do
   addEqCore lhs rhs proof false
 
-/-- Adds a new heterogeneous equality `HEq lhs rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
-private def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
-  addEqCore lhs rhs proof true
 
-/-- Save asserted facts for pretty printing goal. -/
-private def storeFact (fact : Expr) : GoalM Unit := do
-  modify fun s => { s with facts := s.facts.push fact }
+/-- Adds a new heterogeneous equality `HEq lhs rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
+def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
+  addEqCore lhs rhs proof true
 
 /-- Internalizes `lhs` and `rhs`, and then adds equality `lhs = rhs`. -/
 def addNewEq (lhs rhs proof : Expr) (generation : Nat) : GoalM Unit := do
-  let eq ← mkEq lhs rhs
-  storeFact eq
-  internalize lhs generation eq
-  internalize rhs generation eq
+  internalize lhs generation
+  internalize rhs generation
   addEq lhs rhs proof
 
 /-- Adds a new `fact` justified by the given proof and using the given generation. -/
 def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
-  storeFact fact
   trace_goal[grind.assert] "{fact}"
   if (← isInconsistent) then return ()
   resetNewEqs
@@ -267,8 +239,8 @@ where
       internalize p generation
       addEq p (← getFalseExpr) (← mkEqFalse proof)
     else
-      internalize lhs generation p
-      internalize rhs generation p
+      internalize lhs generation
+      internalize rhs generation
       addEqCore lhs rhs proof isHEq
 
 /-- Adds a new hypothesis. -/

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

@@ -20,7 +20,7 @@ private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit :=
   | HEq _ lhs _ rhs =>
     pushHEq (← shareCommon lhs) (← shareCommon rhs) proof
   | _ =>
-   reportIssue m!"unexpected injectivity theorem result type{indentExpr eqs}"
+   trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
    return ()
 
 /--

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

@@ -129,16 +129,6 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
   let c ← matchArg? c pArg eArg
   matchArgs? c p.appFn! e.appFn!
 
-/-- Similar to `matchArgs?` but if `p` has fewer arguments than `e`, we match `p` with a prefix of `e`. -/
-private partial def matchArgsPrefix? (c : Choice) (p : Expr) (e : Expr) : OptionT GoalM Choice := do
-  let pn := p.getAppNumArgs
-  let en := e.getAppNumArgs
-  guard (pn <= en)
-  if pn == en then
-    matchArgs? c p e
-  else
-    matchArgs? c p (e.getAppPrefix pn)
-
 /--
 Matches pattern `p` with term `e` with respect to choice `c`.
 We traverse the equivalence class of `e` looking for applications compatible with `p`.
@@ -204,7 +194,7 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
     let n ← getENode app
     if n.generation < maxGeneration
        && (n.heqProofs || n.isCongrRoot) then
-      if let some c ← matchArgsPrefix? c p app |>.run then
+      if let some c ← matchArgs? c p app |>.run then
         let gen := n.generation
         let c := { c with gen := Nat.max gen c.gen }
         modify fun s => { s with choiceStack := c :: s.choiceStack }
@@ -250,7 +240,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
   assert! c.assignment.size == numParams
   let (mvars, bis, _) ← forallMetaBoundedTelescope (← inferType proof) numParams
   if mvars.size != thm.numParams then
-    reportIssue m!"unexpected number of parameters at {← thm.origin.pp}"
+    trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
     return ()
   -- Apply assignment
   for h : i in [:mvars.size] do
@@ -260,14 +250,14 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
       let mvarIdType ← mvarId.getType
       let vType ← inferType v
       unless (← isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
-        reportIssue m!"type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
+        trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
         return ()
   -- Synthesize instances
   for mvar in mvars, bi in bis do
     if bi.isInstImplicit && !(← mvar.mvarId!.isAssigned) then
       let type ← inferType mvar
-      unless (← synthesizeInstanceAndAssign mvar type) do
-        reportIssue m!"failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
+      unless (← synthesizeInstance mvar type) do
+        trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
         return ()
   let proof := mkAppN proof mvars
   if (← mvars.allM (·.mvarId!.isAssigned)) then
@@ -275,9 +265,13 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
   else
     let mvars ← mvars.filterM fun mvar => return !(← mvar.mvarId!.isAssigned)
     if let some mvarBad ← mvars.findM? fun mvar => return !(← isProof mvar) then
-      reportIssue m!"failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
+      trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
     let proof ← mkLambdaFVars (binderInfoForMVars := .default) mvars (← instantiateMVars proof)
     addNewInstance thm.origin proof c.gen
+where
+  synthesizeInstance (x type : Expr) : MetaM Bool := do
+    let .some val ← trySynthInstance type | return false
+    isDefEq x val
 
 /-- Process choice stack until we don't have more choices to be processed. -/
 private def processChoices : M Unit := do
@@ -306,7 +300,7 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
     if (n.heqProofs || n.isCongrRoot) &&
        (!useMT || n.mt == gmt) then
       withInitApp app do
-        if let some c ← matchArgsPrefix? { cnstrs, assignment, gen := n.generation } p app |>.run then
+        if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
           modify fun s => { s with choiceStack := [c] }
           processChoices
 
@@ -366,4 +360,7 @@ def ematchAndAssert : GrindTactic := fun goal => do
     return none
   assertAll goal
 
+def ematchStar : GrindTactic :=
+  ematchAndAssert.iterate
+
 end Lean.Meta.Grind

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

@@ -269,36 +269,19 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
 
 /--
 Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
-- a type (that is not a proposition) or type former (which has forward dependencies) or
+- a type (that is not a proposition) or type former, or
 - a proof, or
 - an instance implicit argument
 
 When `mask[i]`, we say the corresponding argument is a "support" argument.
 -/
 def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
-  let pinfos := (← getFunInfoNArgs f numArgs).paramInfo
   forallBoundedTelescope (← inferType f) numArgs fun xs _ => do
-    xs.mapIdxM fun idx x => do
+    xs.mapM fun x => do
       if (← isProp x) then
         return false
-      else if (← isProof x) then
+      else if (← isTypeFormer x <||> isProof x) then
         return true
-      else if (← isTypeFormer x) then
-        if h : idx < pinfos.size then
-          /-
-          We originally wanted to ignore types and type formers in `grind` and treat them as supporting elements.
-          Thus, we would always return `true`. However, we changed our heuristic because of the following example:
-          ```
-          example {α} (f : α → Type) (a : α) (h : ∀ x, Nonempty (f x)) : Nonempty (f a) := by
-            grind
-          ```
-          In this example, we are reasoning about types. Therefore, we adjusted the heuristic as follows:
-          a type or type former is considered a supporting element only if it has forward dependencies.
-          Note that this is not the case for `Nonempty`.
-          -/
-          return pinfos[idx].hasFwdDeps
-        else
-          return true
       else
         return (← x.fvarId!.getDecl).binderInfo matches .instImplicit
 
@@ -516,9 +499,7 @@ def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof :
       | HEq _ lhs _ rhs => pure (lhs, rhs)
       | _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
     let pat := if useLhs then lhs else rhs
-    trace[grind.debug.ematch.pattern] "mkEMatchEqTheoremCore: origin: {← origin.pp}, pat: {pat}, useLhs: {useLhs}"
     let pat ← preprocessPattern pat normalizePattern
-    trace[grind.debug.ematch.pattern] "mkEMatchEqTheoremCore: after preprocessing: {pat}, {← normalize pat}"
     let pats := splitWhileForbidden (pat.abstract xs)
     return (xs.size, pats)
   mkEMatchTheoremCore origin levelParams numParams proof patterns
@@ -553,7 +534,7 @@ def getEMatchTheorems : CoreM EMatchTheorems :=
 
 inductive TheoremKind where
   | eqLhs | eqRhs | eqBoth | fwd | bwd | default
-  deriving Inhabited, BEq, Repr
+  deriving Inhabited, BEq
 
 private def TheoremKind.toAttribute : TheoremKind → String
   | .eqLhs   => "[grind =]"
@@ -653,9 +634,9 @@ private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Ar
 
 def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
   if kind == .eqLhs then
-    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := true) (useLhs := true))
+    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := true))
   else if kind == .eqRhs then
-    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := true) (useLhs := false))
+    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := false))
   let type ← inferType proof
   forallTelescopeReducing type fun xs type => do
     let searchPlaces ← match kind with
@@ -679,40 +660,28 @@ where
       levelParams, origin
     }
 
-/-- Return theorem kind for `stx` of the form `Attr.grindThmMod` -/
-def getTheoremKindCore (stx : Syntax) : CoreM TheoremKind := do
-  match stx with
-  | `(Parser.Attr.grindThmMod| =) => return .eqLhs
-  | `(Parser.Attr.grindThmMod| →) => return .fwd
-  | `(Parser.Attr.grindThmMod| ←) => return .bwd
-  | `(Parser.Attr.grindThmMod| =_) => return .eqRhs
-  | `(Parser.Attr.grindThmMod| _=_) => return .eqBoth
-  | _ => throwError "unexpected `grind` theorem kind: `{stx}`"
-
-/-- Return theorem kind for `stx` of the form `(Attr.grindThmMod)?` -/
-def getTheoremKindFromOpt (stx : Syntax) : CoreM TheoremKind := do
+private def getKind (stx : Syntax) : TheoremKind :=
   if stx[1].isNone then
-    return .default
+    .default
+  else if stx[1][0].getKind == ``Parser.Attr.grindEq then
+    .eqLhs
+  else if stx[1][0].getKind == ``Parser.Attr.grindFwd then
+    .fwd
+  else if stx[1][0].getKind == ``Parser.Attr.grindEqRhs then
+    .eqRhs
+  else if stx[1][0].getKind == ``Parser.Attr.grindEqBoth then
+    .eqBoth
   else
-    getTheoremKindCore stx[1][0]
-
-def mkEMatchTheoremForDecl (declName : Name) (thmKind : TheoremKind) : MetaM EMatchTheorem := do
-  let some thm ← mkEMatchTheoremWithKind? (.decl declName) #[] (← getProofFor declName) thmKind
-    | throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
-  return thm
-
-def mkEMatchEqTheoremsForDef? (declName : Name) : MetaM (Option (Array EMatchTheorem)) := do
-  let some eqns ← getEqnsFor? declName | return none
-  eqns.mapM fun eqn => do
-    mkEMatchEqTheorem eqn (normalizePattern := true)
+    .bwd
 
 private def addGrindEqAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) (useLhs := true) : MetaM Unit := do
   if (← getConstInfo declName).isTheorem then
     ematchTheoremsExt.add (← mkEMatchEqTheorem declName (normalizePattern := true) (useLhs := useLhs)) attrKind
-  else if let some thms ← mkEMatchEqTheoremsForDef? declName then
+  else if let some eqns ← getEqnsFor? declName then
     unless useLhs do
       throwError "`{declName}` is a definition, you must only use the left-hand side for extracting patterns"
-    thms.forM (ematchTheoremsExt.add · attrKind)
+    for eqn in eqns do
+      ematchTheoremsExt.add (← mkEMatchEqTheorem eqn) attrKind
   else
     throwError s!"`{thmKind.toAttribute}` attribute can only be applied to equational theorems or function definitions"
 
@@ -727,26 +696,10 @@ private def addGrindAttr (declName : Name) (attrKind : AttributeKind) (thmKind :
   else if !(← getConstInfo declName).isTheorem then
     addGrindEqAttr declName attrKind thmKind
   else
-    let thm ← mkEMatchTheoremForDecl declName thmKind
+    let some thm ← mkEMatchTheoremWithKind? (.decl declName) #[] (← getProofFor declName) thmKind
+      | throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
     ematchTheoremsExt.add thm attrKind
 
-def EMatchTheorems.eraseDecl (s : EMatchTheorems) (declName : Name) : MetaM EMatchTheorems := do
-  let throwErr {α} : MetaM α :=
-    throwError "`{declName}` is not marked with the `[grind]` attribute"
-  let info ← getConstInfo declName
-  if !info.isTheorem then
-    if let some eqns ← getEqnsFor? declName then
-       let s := ematchTheoremsExt.getState (← getEnv)
-       unless eqns.all fun eqn => s.contains (.decl eqn) do
-         throwErr
-       return eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
-    else
-      throwErr
-  else
-    unless ematchTheoremsExt.getState (← getEnv) |>.contains (.decl declName) do
-      throwErr
-    return s.erase <| .decl declName
-
 builtin_initialize
   registerBuiltinAttribute {
     name := `grind
@@ -769,7 +722,7 @@ builtin_initialize
       `grind` will add an instance of this theorem to the local context whenever it encounters the pattern `foo (foo x)`."
     applicationTime := .afterCompilation
     add := fun declName stx attrKind => do
-      addGrindAttr declName attrKind (← getTheoremKindFromOpt stx) |>.run' {}
+      addGrindAttr declName attrKind (getKind stx) |>.run' {}
     erase := fun declName => MetaM.run' do
       /-
       Remark: consider the following example
@@ -785,9 +738,21 @@ builtin_initialize
       attribute [-grind] foo  -- ok
       ```
       -/
-      let s := ematchTheoremsExt.getState (← getEnv)
-      let s ← s.eraseDecl declName
-      modifyEnv fun env => ematchTheoremsExt.modifyState env fun _ => s
+      let throwErr := throwError "`{declName}` is not marked with the `[grind]` attribute"
+      let info ← getConstInfo declName
+      if !info.isTheorem then
+        if let some eqns ← getEqnsFor? declName then
+           let s := ematchTheoremsExt.getState (← getEnv)
+           unless eqns.all fun eqn => s.contains (.decl eqn) do
+             throwErr
+           modifyEnv fun env => ematchTheoremsExt.modifyState env fun s =>
+             eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
+        else
+          throwErr
+      else
+        unless ematchTheoremsExt.getState (← getEnv) |>.contains (.decl declName) do
+          throwErr
+        modifyEnv fun env => ematchTheoremsExt.modifyState env fun s => s.erase (.decl declName)
   }
 
 end Lean.Meta.Grind

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

@@ -1,47 +0,0 @@
-/-
-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.AppBuilder
-
-namespace Lean.Meta.Grind
-/-! A basic "equality resolution" procedure. -/
-
-private def eqResCore (prop proof : Expr) : MetaM (Option (Expr × Expr)) := withNewMCtxDepth do
-  let (ms, _, type) ← forallMetaTelescopeReducing prop
-  if ms.isEmpty then return none
-  let mut progress := false
-  for m in ms do
-    let type ← inferType m
-    let_expr Eq _ lhs rhs ← type
-      | pure ()
-    if (← isDefEq lhs rhs) then
-      unless (← m.mvarId!.checkedAssign (← mkEqRefl lhs)) do
-        return none
-      progress := true
-  unless progress do
-    return none
-  if (← ms.anyM fun m => m.mvarId!.isDelayedAssigned) then
-    return none
-  let prop' ← instantiateMVars type
-  let proof' ← instantiateMVars (mkAppN proof ms)
-  let ms ← ms.filterM fun m => return !(← m.mvarId!.isAssigned)
-  let prop' ← mkForallFVars ms prop' (binderInfoForMVars := .default)
-  let proof' ← mkLambdaFVars ms proof'
-  return some (prop', proof')
-
-/--
-A basic "equality resolution" procedure: Given a proposition `prop` with a proof `proof`, it attempts to resolve equality hypotheses using `isDefEq`. For example, it reduces `∀ x y, f x = f (g y y) → g x y = y` to `∀ y, g (g y y) y = y`, and `∀ (x : Nat), f x ≠ f a` to `False`.
-If successful, the result is a pair `(prop', proof)`, where `prop'` is the simplified proposition,
-and `proof : prop → prop'`
--/
-def eqResolution (prop : Expr) : MetaM (Option (Expr × Expr)) :=
-  withLocalDeclD `h prop fun h => do
-    let some (prop', proof') ← eqResCore prop h
-      | return none
-    let proof' ← mkLambdaFVars #[h] proof'
-    return some (prop', proof')
-
-end Lean.Meta.Grind

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

@@ -1,40 +0,0 @@
-/-
-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.Types
-
-namespace Lean.Meta.Grind
-/-! Extensionality theorems support. -/
-
-def instantiateExtTheorem (thm : Ext.ExtTheorem) (e : Expr) : GoalM Unit := withNewMCtxDepth do
-  unless (← getGeneration e) < (← getMaxGeneration) do return ()
-  let c ← mkConstWithFreshMVarLevels thm.declName
-  let (mvars, bis, type) ← withDefault <| forallMetaTelescopeReducing (← inferType c)
-  unless (← isDefEq e type) do
-    reportIssue m!"failed to apply extensionality theorem `{thm.declName}` for {indentExpr e}\nis not definitionally equal to{indentExpr type}"
-    return ()
-  -- Instantiate type class instances
-  for mvar in mvars, bi in bis do
-    if bi.isInstImplicit && !(← mvar.mvarId!.isAssigned) then
-      let type ← inferType mvar
-      unless (← synthesizeInstanceAndAssign mvar type) do
-        reportIssue m!"failed to synthesize instance when instantiating extensionality theorem `{thm.declName}` for {indentExpr e}"
-        return ()
-  -- Remark: `proof c mvars` has type `e`
-  let proof ← instantiateMVars (mkAppN c mvars)
-  -- `e` is equal to `False`
-  let eEqFalse ← mkEqFalseProof e
-  -- So, we use `Eq.mp` to build a `proof` of `False`
-  let proof ← mkEqMP eEqFalse proof
-  let mvars ← mvars.filterM fun mvar => return !(← mvar.mvarId!.isAssigned)
-  let proof' ← instantiateMVars (← mkLambdaFVars mvars proof)
-  let prop' ← inferType proof'
-  if proof'.hasMVar || prop'.hasMVar then
-    reportIssue m!"failed to apply extensionality theorem `{thm.declName}` for {indentExpr e}\nresulting terms contain metavariables"
-    return ()
-  addNewFact proof' prop' ((← getGeneration e) + 1)
-
-end Lean.Meta.Grind

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

@@ -8,7 +8,6 @@ import Init.Grind.Lemmas
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Internalize
 import Lean.Meta.Tactic.Grind.Simp
-import Lean.Meta.Tactic.Grind.EqResolution
 
 namespace Lean.Meta.Grind
 /--
@@ -25,7 +24,7 @@ def propagateForallPropUp (e : Expr) : GoalM Unit := do
     unless (← isEqTrue p) do return
     trace_goal[grind.debug.forallPropagator] "isEqTrue, {e}"
     let h₁ ← mkEqTrueProof p
-    let qh₁ := q.instantiate1 (mkOfEqTrueCore p h₁)
+    let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
     let r ← simp qh₁
     let q := mkLambda n bi p q
     let q' := r.expr
@@ -66,7 +65,7 @@ private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
   else
     let idx ← modifyGet fun s => (s.nextThmIdx, { s with nextThmIdx := s.nextThmIdx + 1 })
     pure <| .local ((`local).appendIndexAfter idx)
-  let proof := mkOfEqTrueCore e proof
+  let proof := mkApp2 (mkConst ``of_eq_true) e proof
   let size := (← get).newThms.size
   let gen ← getGeneration e
   -- TODO: we should have a flag for collecting all unary patterns in a local theorem
@@ -78,7 +77,7 @@ private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
     if let some thm ← mkEMatchTheoremWithKind'? origin proof .default then
       activateTheorem thm gen
   if (← get).newThms.size == size then
-    reportIssue m!"failed to create E-match local theorem for{indentExpr e}"
+    trace[grind.issues] "failed to create E-match local theorem for{indentExpr e}"
 
 def propagateForallPropDown (e : Expr) : GoalM Unit := do
   let .forallE n a b bi := e | return ()
@@ -97,13 +96,7 @@ def propagateForallPropDown (e : Expr) : GoalM Unit := do
       pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_imp_eq_false) a b h
       pushEqFalse b <| mkApp3 (mkConst ``Grind.eq_false_of_imp_eq_false) a b h
   else if (← isEqTrue e) then
-    if let some (e', h') ← eqResolution e then
-      trace[grind.eqResolution] "{e}, {e'}"
-      let h := mkOfEqTrueCore e (← mkEqTrueProof e)
-      let h' := mkApp h' h
-      addNewFact h' e' (← getGeneration e)
-    else
-      if b.hasLooseBVars then
-        addLocalEMatchTheorems e
+    if b.hasLooseBVars then
+      addLocalEMatchTheorems e
 
 end Lean.Meta.Grind

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

@@ -11,7 +11,6 @@ import Lean.Meta.Match.MatcherInfo
 import Lean.Meta.Match.MatchEqsExt
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Util
-import Lean.Meta.Tactic.Grind.Canon
 import Lean.Meta.Tactic.Grind.Arith.Internalize
 
 namespace Lean.Meta.Grind
@@ -25,7 +24,7 @@ def addCongrTable (e : Expr) : GoalM Unit := do
     let g := e'.getAppFn
     unless isSameExpr f g do
       unless (← hasSameType f g) do
-        reportIssue m!"found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
+        trace_goal[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
         return ()
     trace_goal[grind.debug.congr] "{e} = {e'}"
     pushEqHEq e e' congrPlaceholderProof
@@ -99,17 +98,14 @@ private def pushCastHEqs (e : Expr) : GoalM Unit := do
   | f@Eq.recOn α a motive b h v => pushHEq e v (mkApp6 (mkConst ``Grind.eqRecOn_heq f.constLevels!) α a motive b h v)
   | _ => return ()
 
-private def preprocessGroundPattern (e : Expr) : GoalM Expr := do
-  shareCommon (← canon (← normalizeLevels (← unfoldReducible e)))
-
 mutual
 /-- Internalizes the nested ground terms in the given pattern. -/
 private partial def internalizePattern (pattern : Expr) (generation : Nat) : GoalM Expr := do
   if pattern.isBVar || isPatternDontCare pattern then
     return pattern
   else if let some e := groundPattern? pattern then
-    let e ← preprocessGroundPattern e
-    internalize e generation none
+    let e ← shareCommon (← canon (← normalizeLevels (← unfoldReducible e)))
+    internalize e generation
     return mkGroundPattern e
   else pattern.withApp fun f args => do
     return mkAppN f (← args.mapM (internalizePattern · generation))
@@ -150,7 +146,7 @@ private partial def activateTheoremPatterns (fName : Name) (generation : Nat) :
           trace_goal[grind.ematch] "reinsert `{thm.origin.key}`"
           modify fun s => { s with thmMap := s.thmMap.insert thm }
 
-partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr := none) : GoalM Unit := do
+partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
   if (← alreadyInternalized e) then return ()
   trace_goal[grind.internalize] "{e}"
   match e with
@@ -161,10 +157,10 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
   | .forallE _ d b _ =>
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
     if (← isProp d <&&> isProp e) then
-      internalize d generation e
+      internalize d generation
       registerParent e d
       unless b.hasLooseBVars do
-        internalize b generation e
+        internalize b generation
         registerParent e b
       propagateUp e
   | .lit .. | .const .. =>
@@ -172,13 +168,12 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
   | .mvar ..
   | .mdata ..
   | .proj .. =>
-    reportIssue m!"unexpected kernel projection term during internalization{indentExpr e}\n`grind` uses a pre-processing step that folds them as projection applications, the pre-processor should have failed to fold this term"
+    trace_goal[grind.issues] "unexpected term during internalization{indentExpr e}"
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
   | .app .. =>
     if (← isLitValue e) then
       -- We do not want to internalize the components of a literal value.
       mkENode e generation
-      Arith.internalize e parent?
     else e.withApp fun f args => do
       checkAndAddSplitCandidate e
       pushCastHEqs e
@@ -187,22 +182,22 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
         -- We only internalize the proposition. We can skip the proof because of
         -- proof irrelevance
         let c := args[0]!
-        internalize c generation e
+        internalize c generation
         registerParent e c
       else
         if let .const fName _ := f then
           activateTheoremPatterns fName generation
         else
-          internalize f generation e
+          internalize f generation
           registerParent e f
         for h : i in [: args.size] do
           let arg := args[i]
-          internalize arg generation e
+          internalize arg generation
           registerParent e arg
       mkENode e generation
       addCongrTable e
       updateAppMap e
-      Arith.internalize e parent?
+      Arith.internalize e
       propagateUp e
 end
 

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

@@ -25,14 +25,13 @@ private inductive IntroResult where
 private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
   let target ← goal.mvarId.getType
   if target.isArrow then
-    let (r, _) ← GoalM.run goal do
-      let mvarId := (← get).mvarId
+    goal.mvarId.withContext do
       let p := target.bindingDomain!
       if !(← isProp p) then
-        let (fvarId, mvarId) ← mvarId.intro1P
-        return .newLocal fvarId { (← get) with mvarId }
+        let (fvarId, mvarId) ← goal.mvarId.intro1P
+        return .newLocal fvarId { goal with mvarId }
       else
-        let tag ← mvarId.getTag
+        let tag ← goal.mvarId.getTag
         let q := target.bindingBody!
         -- TODO: keep applying simp/eraseIrrelevantMData/canon/shareCommon until no progress
         let r ← simp p
@@ -45,13 +44,12 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
           match r.proof? with
           | some he =>
             let hNew := mkAppN (mkConst ``Lean.Grind.intro_with_eq) #[p, r.expr, q, he, h]
-            mvarId.assign hNew
-            return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
+            goal.mvarId.assign hNew
+            return .newHyp fvarId { goal with mvarId := mvarIdNew }
           | none =>
             -- `p` and `p'` are definitionally equal
-            mvarId.assign h
-            return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
-    return r
+            goal.mvarId.assign h
+            return .newHyp fvarId { goal with mvarId := mvarIdNew }
   else if target.isLet || target.isForall || target.isLetFun then
     let (fvarId, mvarId) ← goal.mvarId.intro1P
     mvarId.withContext do
@@ -63,11 +61,10 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
       else
         let goal := { goal with mvarId }
         if target.isLet || target.isLetFun then
-          let goal ← GoalM.run' goal do
-            let v := (← fvarId.getDecl).value
-            let r ← simp v
-            let x ← shareCommon (mkFVar fvarId)
-            addNewEq x r.expr (← r.getProof) generation
+          let v := (← fvarId.getDecl).value
+          let r ← simp v
+          let x ← shareCommon (mkFVar fvarId)
+          let goal ← GoalM.run' goal <| addNewEq x r.expr (← r.getProof) generation
           return .newLocal fvarId goal
         else
           return .newLocal fvarId goal

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

@@ -15,24 +15,10 @@ import Lean.Meta.Tactic.Grind.Inv
 import Lean.Meta.Tactic.Grind.Intro
 import Lean.Meta.Tactic.Grind.EMatch
 import Lean.Meta.Tactic.Grind.Split
-import Lean.Meta.Tactic.Grind.Solve
 import Lean.Meta.Tactic.Grind.SimpUtil
 
 namespace Lean.Meta.Grind
 
-structure Params where
-  config    : Grind.Config
-  ematch    : EMatchTheorems := {}
-  extra     : PArray EMatchTheorem := {}
-  norm      : Simp.Context
-  normProcs : Array Simprocs
-  -- TODO: inductives to split
-
-def mkParams (config : Grind.Config) : MetaM Params := do
-  let norm ← Grind.getSimpContext
-  let normProcs ← Grind.getSimprocs
-  return { config, norm, normProcs }
-
 def mkMethods (fallback : Fallback) : CoreM Methods := do
   let builtinPropagators ← builtinPropagatorsRef.get
   return {
@@ -50,29 +36,23 @@ def mkMethods (fallback : Fallback) : CoreM Methods := do
        prop e
   }
 
-def GrindM.run (x : GrindM α) (mainDeclName : Name) (params : Params) (fallback : Fallback) : MetaM α := do
+def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fallback : Fallback) : MetaM α := do
   let scState := ShareCommon.State.mk _
   let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
   let (trueExpr, scState)  := ShareCommon.State.shareCommon scState (mkConst ``True)
-  let (natZExpr, scState)  := ShareCommon.State.shareCommon scState (mkNatLit 0)
-  let simprocs := params.normProcs
-  let simp := params.norm
-  let config := params.config
-  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr, natZExpr }
+  let simprocs ← Grind.getSimprocs
+  let simp ← Grind.getSimpContext
+  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
 
-private def mkGoal (mvarId : MVarId) (params : Params) : GrindM Goal := do
+private def mkGoal (mvarId : MVarId) : GrindM Goal := do
   let trueExpr ← getTrueExpr
   let falseExpr ← getFalseExpr
-  let natZeroExpr ← getNatZeroExpr
-  let thmMap := params.ematch
+  let thmMap ← getEMatchTheorems
   GoalM.run' { mvarId, thmMap } do
     mkENodeCore falseExpr (interpreted := true) (ctor := false) (generation := 0)
     mkENodeCore trueExpr (interpreted := true) (ctor := false) (generation := 0)
-    mkENodeCore natZeroExpr (interpreted := true) (ctor := false) (generation := 0)
-    for thm in params.extra do
-      activateTheorem thm 0
 
-private def initCore (mvarId : MVarId) (params : Params) : GrindM (List Goal) := do
+private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
   mvarId.ensureProp
   -- TODO: abstract metavars
   mvarId.ensureNoMVar
@@ -81,14 +61,21 @@ private def initCore (mvarId : MVarId) (params : Params) : GrindM (List Goal) :=
   let mvarId ← mvarId.unfoldReducible
   let mvarId ← mvarId.betaReduce
   appendTagSuffix mvarId `grind
-  let goals ← intros (← mkGoal mvarId params) (generation := 0)
+  let goals ← intros (← mkGoal mvarId) (generation := 0)
   goals.forM (·.checkInvariants (expensive := true))
   return goals.filter fun goal => !goal.inconsistent
 
-def main (mvarId : MVarId) (params : Params) (mainDeclName : Name) (fallback : Fallback) : MetaM (List Goal) := do
-  let go : GrindM (List Goal) := do
-    let goals ← initCore mvarId params
-    let goals ← solve goals
+def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goal) := do
+  goals.foldlM (init := []) fun acc goal => return acc ++ (← f goal)
+
+/-- A very simple strategy -/
+private def simple (goals : List Goal) : GrindM (List Goal) := do
+  applyToAll (assertAll >> ematchStar >> (splitNext >> assertAll >> ematchStar).iterate) goals
+
+def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List MVarId) := do
+  let go : GrindM (List MVarId) := do
+    let goals ← initCore mvarId
+    let goals ← simple goals
     let goals ← goals.filterMapM fun goal => do
       if goal.inconsistent then return none
       let goal ← GoalM.run' goal fallback
@@ -96,7 +83,7 @@ def main (mvarId : MVarId) (params : Params) (mainDeclName : Name) (fallback : F
       if (← goal.mvarId.isAssigned) then return none
       return some goal
     trace[grind.debug.final] "{← ppGoals goals}"
-    return goals
-  go.run mainDeclName params fallback
+    return goals.map (·.mvarId)
+  go.run mainDeclName config fallback
 
 end Lean.Meta.Grind

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

@@ -5,162 +5,62 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Grind.Util
-import Init.Grind.PP
 import Lean.Meta.Tactic.Grind.Types
-import Lean.Meta.Tactic.Grind.Arith.Model
 
 namespace Lean.Meta.Grind
 
 /-- Helper function for pretty printing the state for debugging purposes. -/
-def Goal.ppENodeRef (goal : Goal) (e : Expr) : MetaM MessageData := do
-  let some n := goal.getENode? e | return "_"
-  let type ← inferType e
-  let u ← getLevel type
-  let d := mkApp3 (mkConst ``Grind.node_def [u]) (toExpr n.idx) type e
-  return m!"{d}"
-
-@[inherit_doc Goal.ppENodeRef]
-def ppENodeRef (e : Expr) : GoalM MessageData := do
-  (← get).ppENodeRef e
+def ppENodeRef (e : Expr) : GoalM Format := do
+  let some n ← getENode? e | return "_"
+  return f!"#{n.idx}"
 
 /-- Helper function for pretty printing the state for debugging purposes. -/
-private def Goal.ppENodeDeclValue (goal : Goal) (e : Expr) : MetaM MessageData := do
+def ppENodeDeclValue (e : Expr) : GoalM Format := do
   if e.isApp && !(← isLitValue e) then
     e.withApp fun f args => do
       let r ← if f.isConst then
-        pure m!"{f}"
+        ppExpr f
       else
-        goal.ppENodeRef f
+        ppENodeRef f
       let mut r := r
       for arg in args do
-        r := r ++ " " ++ (← goal.ppENodeRef arg)
+        r := r ++ " " ++ (← ppENodeRef arg)
       return r
   else
     ppExpr e
 
 /-- Helper function for pretty printing the state for debugging purposes. -/
-private def Goal.ppENodeDecl (goal : Goal) (e : Expr) : MetaM MessageData := do
-  let mut r := m!"{← goal.ppENodeRef e} := {← goal.ppENodeDeclValue e}"
-  let n ← goal.getENode e
+def ppENodeDecl (e : Expr) : GoalM Format := do
+  let mut r := f!"{← ppENodeRef e} := {← ppENodeDeclValue e}"
+  let n ← getENode e
   unless isSameExpr e n.root do
-    r := r ++ m!" ↦ {← goal.ppENodeRef n.root}"
+    r := r ++ f!" ↦ {← ppENodeRef n.root}"
   if n.interpreted then
     r := r ++ ", [val]"
   if n.ctor then
     r := r ++ ", [ctor]"
   if grind.debug.get (← getOptions) then
-    if let some target := goal.getTarget? e then
-      r := r ++ m!" ↝ {← goal.ppENodeRef target}"
+    if let some target ← getTarget? e then
+      r := r ++ f!" ↝ {← ppENodeRef target}"
   return r
 
 /-- Pretty print goal state for debugging purposes. -/
-def Goal.ppState (goal : Goal) : MetaM MessageData := do
-  let mut r := m!"Goal:"
-  let nodes := goal.getENodes
+def ppState : GoalM Format := do
+  let mut r := f!"Goal:"
+  let nodes ← getENodes
   for node in nodes do
-    r := r ++ "\n" ++ (← goal.ppENodeDecl node.self)
-  let eqcs := goal.getEqcs
+    r := r ++ "\n" ++ (← ppENodeDecl node.self)
+  let eqcs ← getEqcs
   for eqc in eqcs do
     if eqc.length > 1 then
-      r := r ++ "\n" ++ "{" ++ (MessageData.joinSep (← eqc.mapM goal.ppENodeRef) ", ") ++  "}"
+      r := r ++ "\n" ++ "{" ++ (Format.joinSep (← eqc.mapM ppENodeRef) ", ") ++  "}"
   return r
 
-def ppGoals (goals : List Goal) : MetaM MessageData := do
-  let mut r := m!""
+def ppGoals (goals : List Goal) : GrindM Format := do
+  let mut r := f!""
   for goal in goals do
-    let m ← goal.ppState
-    r := r ++ Format.line ++ m
+    let (f, _) ← GoalM.run goal ppState
+    r := r ++ Format.line ++ f
   return r
 
-private def ppExprArray (cls : Name) (header : String) (es : Array Expr) (clsElem : Name := Name.mkSimple "_") : MessageData :=
-  let es := es.map fun e => .trace { cls := clsElem} m!"{e}" #[]
-  .trace { cls } header es
-
-private abbrev M := ReaderT Goal (StateT (Array MessageData) MetaM)
-
-private def pushMsg (m : MessageData) : M Unit :=
-  modify fun s => s.push m
-
-private def ppEqcs : M Unit := do
-   let mut trueEqc?  : Option MessageData := none
-   let mut falseEqc? : Option MessageData := none
-   let mut otherEqcs : Array MessageData := #[]
-   let goal ← read
-   for eqc in goal.getEqcs do
-     if Option.isSome <| eqc.find? (·.isTrue) then
-       let eqc := eqc.filter fun e => !e.isTrue
-       unless eqc.isEmpty do
-         trueEqc? := ppExprArray `eqc "True propositions" eqc.toArray `prop
-     else if Option.isSome <| eqc.find? (·.isFalse) then
-       let eqc := eqc.filter fun e => !e.isFalse
-       unless eqc.isEmpty do
-         falseEqc? := ppExprArray `eqc "False propositions" eqc.toArray `prop
-     else if let e :: _ :: _ := eqc then
-       -- We may want to add a flag to pretty print equivalence classes of nested proofs
-       unless (← isProof e) do
-         otherEqcs := otherEqcs.push <| .trace { cls := `eqc } (.group ("{" ++ (MessageData.joinSep (eqc.map toMessageData) ("," ++ Format.line)) ++  "}")) #[]
-   if let some trueEqc := trueEqc? then pushMsg trueEqc
-   if let some falseEqc := falseEqc? then pushMsg falseEqc
-   unless otherEqcs.isEmpty do
-     pushMsg <| .trace { cls := `eqc } "Equivalence classes" otherEqcs
-
-private def ppEMatchTheorem (thm : EMatchTheorem) : MetaM MessageData := do
-  let m := m!"{← thm.origin.pp}:\n{← inferType thm.proof}\npatterns: {thm.patterns.map ppPattern}"
-  return .trace { cls := `thm } m #[]
-
-private def ppActiveTheorems : M Unit := do
-  let goal ← read
-  let m ← goal.thms.toArray.mapM fun thm => ppEMatchTheorem thm
-  let m := m ++ (← goal.newThms.toArray.mapM fun thm => ppEMatchTheorem thm)
-  unless m.isEmpty do
-    pushMsg <| .trace { cls := `ematch } "E-matching" m
-
-private def ppOffset : M Unit := do
-  let goal ← read
-  let s := goal.arith.offset
-  let nodes := s.nodes
-  if nodes.isEmpty then return ()
-  let model ← Arith.Offset.mkModel goal
-  let mut ms := #[]
-  for (e, val) in model do
-    ms := ms.push <| .trace { cls := `assign } m!"{e} := {val}" #[]
-  pushMsg <| .trace { cls := `offset } "Assignment satisfying offset contraints" ms
-
-private def ppIssues : M Unit := do
-  let issues := (← read).issues
-  unless issues.isEmpty do
-    pushMsg <| .trace { cls := `issues } "Issues" issues.reverse.toArray
-
-private def ppThresholds (c : Grind.Config) : M Unit := do
-  let goal ← read
-  let maxGen := goal.enodes.foldl (init := 0) fun g _ n => Nat.max g n.generation
-  let mut msgs := #[]
-  if goal.numInstances ≥ c.instances  then
-    msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of instances generated by E-matching has been reached, threshold: `(instances := {c.instances})`" #[]
-  if goal.numEmatch ≥ c.ematch  then
-    msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of E-matching rounds has been reached, threshold: `(ematch := {c.ematch})`" #[]
-  if goal.numSplits ≥ c.splits then
-    msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of case-splits has been reached, threshold: `(splits := {c.splits})`" #[]
-  if maxGen ≥ c.gen then
-    msgs := msgs.push <| .trace { cls := `limit } m!"maximum term generation has been reached, threshold: `(gen := {c.gen})`" #[]
-  unless msgs.isEmpty do
-    pushMsg <| .trace { cls := `limits } "Thresholds reached" msgs
-
-def goalToMessageData (goal : Goal) (config : Grind.Config) : MetaM MessageData := goal.mvarId.withContext do
-  let (_, m) ← go goal |>.run #[]
-  let gm := MessageData.trace { cls := `grind, collapsed := false } "Diagnostics" m
-  let r := m!"{.ofGoal goal.mvarId}\n{gm}"
-  addMessageContextFull r
-where
-  go : M Unit := do
-    pushMsg <| ppExprArray `facts "Asserted facts" goal.facts.toArray `prop
-    ppEqcs
-    ppActiveTheorems
-    ppOffset
-    ppThresholds config
-    ppIssues
-
-def goalsToMessageData (goals : List Goal) (config : Grind.Config) : MetaM MessageData :=
-  return MessageData.joinSep (← goals.mapM (goalToMessageData · config)) m!"\n"
-
 end Lean.Meta.Grind

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

@@ -12,8 +12,4 @@ Builtin parsers for `grind` related commands
 -/
 @[builtin_command_parser] def grindPattern := leading_parser
   "grind_pattern " >>  ident >> darrow >> sepBy1 termParser ","
-
-@[builtin_command_parser] def initGrindNorm := leading_parser
-  "init_grind_norm " >> many ident >> "| " >> many ident
-
 end Lean.Parser.Command

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

@@ -8,7 +8,6 @@ import Init.Grind
 import Lean.Meta.Tactic.Grind.Proof
 import Lean.Meta.Tactic.Grind.PropagatorAttr
 import Lean.Meta.Tactic.Grind.Simp
-import Lean.Meta.Tactic.Grind.Ext
 import Lean.Meta.Tactic.Grind.Internalize
 
 namespace Lean.Meta.Grind
@@ -127,45 +126,32 @@ builtin_grind_propagator propagateEqUp ↑Eq := fun e => do
   else if (← isEqTrue b) then
     pushEq e a <| mkApp3 (mkConst ``Lean.Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
   else if (← isEqv a b) then
-    pushEqTrue e <| mkEqTrueCore e (← mkEqProof a b)
+    pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkEqProof a b)
 
 /-- Propagates `Eq` downwards -/
 builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
   if (← isEqTrue e) then
     let_expr Eq _ a b := e | return ()
-    pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
-  else if (← isEqFalse e) then
-    let_expr Eq α lhs rhs := e | return ()
-    let thms ← getExtTheorems α
-    if !thms.isEmpty then
-      /-
-      Heuristic for lists: If `lhs` or `rhs` are contructors we do not apply extensionality theorems.
-      For example, we don't want to apply the extensionality theorem to things like `xs ≠ []`.
-      TODO: polish this hackish heuristic later.
-      -/
-      if α.isAppOf ``List && ((← getRootENode lhs).ctor || (← getRootENode rhs).ctor) then
-        return ()
-      for thm in (← getExtTheorems α) do
-        instantiateExtTheorem thm e
+    pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
 
 /-- Propagates `EqMatch` downwards -/
 builtin_grind_propagator propagateEqMatchDown ↓Grind.EqMatch := fun e => do
   if (← isEqTrue e) then
     let_expr Grind.EqMatch _ a b origin := e | return ()
     markCaseSplitAsResolved origin
-    pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
+    pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
 
 /-- Propagates `HEq` downwards -/
 builtin_grind_propagator propagateHEqDown ↓HEq := fun e => do
   if (← isEqTrue e) then
     let_expr HEq _ a _ b := e | return ()
-    pushHEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
+    pushHEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
 
 /-- Propagates `HEq` upwards -/
 builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
   let_expr HEq _ a _ b := e | return ()
   if (← isEqv a b) then
-    pushEqTrue e <| mkEqTrueCore e (← mkHEqProof a b)
+    pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkHEqProof a b)
 
 /-- Propagates `ite` upwards -/
 builtin_grind_propagator propagateIte ↑ite := fun e => do
@@ -180,7 +166,7 @@ builtin_grind_propagator propagateDIte ↑dite := fun e => do
   let_expr f@dite α c h a b := e | return ()
   if (← isEqTrue c) then
      let h₁ ← mkEqTrueProof c
-     let ah₁ := mkApp a (mkOfEqTrueCore c h₁)
+     let ah₁ := mkApp a (mkApp2 (mkConst ``of_eq_true) c h₁)
      let p ← simp ah₁
      let r := p.expr
      let h₂ ← p.getProof

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

@@ -11,7 +11,6 @@ import Lean.Meta.Tactic.Grind.Util
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.DoNotSimp
 import Lean.Meta.Tactic.Grind.MarkNestedProofs
-import Lean.Meta.Tactic.Grind.Canon
 
 namespace Lean.Meta.Grind
 /-- Simplifies the given expression using the `grind` simprocs and normalization theorems. -/
@@ -25,13 +24,13 @@ def simpCore (e : Expr) : GrindM Simp.Result := do
 Simplifies `e` using `grind` normalization theorems and simprocs,
 and then applies several other preprocessing steps.
 -/
-def simp (e : Expr) : GoalM Simp.Result := do
+def simp (e : Expr) : GrindM Simp.Result := do
   let e ← instantiateMVars e
   let r ← simpCore e
   let e' := r.expr
-  let e' ← unfoldReducible e'
   let e' ← abstractNestedProofs e'
   let e' ← markNestedProofs e'
+  let e' ← unfoldReducible e'
   let e' ← eraseIrrelevantMData e'
   let e' ← foldProjs e'
   let e' ← normalizeLevels e'

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

@@ -7,41 +7,14 @@ prelude
 import Lean.Meta.Tactic.Simp.Simproc
 import Lean.Meta.Tactic.Grind.Simp
 import Lean.Meta.Tactic.Grind.DoNotSimp
-import Lean.Meta.Tactic.Simp.BuiltinSimprocs.List
 
 namespace Lean.Meta.Grind
 
-builtin_initialize normExt : SimpExtension ← mkSimpExt
-
-def registerNormTheorems (preDeclNames : Array Name) (postDeclNames : Array Name) : MetaM Unit := do
-  let thms ← normExt.getTheorems
-  unless thms.lemmaNames.isEmpty do
-    throwError "`grind` normalization theorems have already been initialized"
-  for declName in preDeclNames do
-    addSimpTheorem normExt declName (post := false) (inv := false) .global (eval_prio default)
-  for declName in postDeclNames do
-    addSimpTheorem normExt declName (post := true) (inv := false) .global (eval_prio default)
-
 /-- Returns the array of simprocs used by `grind`. -/
 protected def getSimprocs : MetaM (Array Simprocs) := do
   let s ← grindNormSimprocExt.getSimprocs
   let s ← addDoNotSimp s
-  let e ← Simp.getSEvalSimprocs
-  /-
-  We don't want to apply `List.reduceReplicate` as a normalization operation in
-  `grind`. Consider the following example:
-  ```
-  example (ys : List α) : n = 0 → List.replicate n ys = [] := by
-    grind only [List.replicate]
-  ```
-  The E-matching module generates the following instance for `List.replicate.eq_1`
-  ```
-  List.replicate 0 [] = []
-  ```
-  We don't want it to be simplified to `[] = []`.
-  -/
-  let e := e.erase ``List.reduceReplicate
-  return #[s, e]
+  return #[s, (← Simp.getSEvalSimprocs)]
 
 /-- Returns the simplification context used by `grind`. -/
 protected def getSimpContext : MetaM Simp.Context := do

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

@@ -1,92 +0,0 @@
-/-
-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.Combinators
-import Lean.Meta.Tactic.Grind.Split
-import Lean.Meta.Tactic.Grind.EMatch
-
-namespace Lean.Meta.Grind
-
-namespace Solve
-
-structure State where
-  todo     : List Goal
-  failures : List Goal := []
-  stop     : Bool := false
-
-private abbrev M := StateRefT State GrindM
-
-def getNext? : M (Option Goal) := do
-  let goal::todo := (← get).todo | return none
-  modify fun s => { s with todo }
-  return some goal
-
-def pushGoal (goal : Goal) : M Unit :=
-  modify fun s => { s with todo := goal :: s.todo }
-
-def pushGoals (goals : List Goal) : M Unit :=
-  modify fun s => { s with todo := goals ++ s.todo }
-
-def pushFailure (goal : Goal) : M Unit := do
-  modify fun s => { s with failures := goal :: s.failures }
-  if (← get).failures.length ≥ (← getConfig).failures then
-    modify fun s => { s with stop := true }
-
-@[inline] def stepGuard (x : Goal → M Bool) (goal : Goal) : M Bool := do
-  try
-    x goal
-  catch ex =>
-    if ex.isMaxHeartbeat || ex.isMaxRecDepth then
-      let goal ← goal.reportIssue ex.toMessageData
-      pushFailure goal
-      return true
-    else
-      throw ex
-
-def applyTac (x : GrindTactic) (goal : Goal) : M Bool := do
-  let go (goal : Goal) : M Bool := do
-    let some goals ← x goal | return false
-    pushGoals goals
-    return true
-  stepGuard go goal
-
-def tryAssertNext : Goal → M Bool := applyTac assertNext
-
-def tryEmatch : Goal → M Bool := applyTac ematchAndAssert
-
-def trySplit : Goal → M Bool := applyTac splitNext
-
-def maxNumFailuresReached : M Bool := do
-  return (← get).failures.length ≥ (← getConfig).failures
-
-partial def main : M Unit := do
-  repeat do
-    if (← get).stop then
-      return ()
-    let some goal ← getNext? |
-      return ()
-    if goal.inconsistent then
-      continue
-    if (← tryAssertNext goal) then
-      continue
-    if (← tryEmatch goal) then
-      continue
-    if (← trySplit goal) then
-      continue
-    pushFailure goal
-
-end Solve
-
-/--
-Try to solve/close the given goals, and returns the ones that could not be solved.
--/
-def solve (goals : List Goal) : GrindM (List Goal) := do
-  let (_, s) ← Solve.main.run { todo := goals }
-  let todo ← s.todo.mapM fun goal => do
-    goal.reportIssue m!"this goal was not fully processed due to previous failures, threshold: `(failures := {(← getConfig).failures})`"
-  return s.failures.reverse ++ todo
-
-end Lean.Meta.Grind

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

@@ -74,14 +74,6 @@ private def checkIffStatus (e a b : Expr) : GoalM CaseSplitStatus := do
   else
     return .notReady
 
-/-- Returns `true` is `c` is congruent to a case-split that was already performed. -/
-private def isCongrToPrevSplit (c : Expr) : GoalM Bool := do
-  (← get).resolvedSplits.foldM (init := false) fun flag { expr := c' } => do
-    if flag then
-      return true
-    else
-      return isCongruent (← get).enodes c c'
-
 private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
   match_expr e with
   | Or a b => checkDisjunctStatus e a b
@@ -93,8 +85,6 @@ private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
     if (← isResolvedCaseSplit e) then
       trace[grind.debug.split] "split resolved: {e}"
       return .resolved
-    if (← isCongrToPrevSplit e) then
-      return .resolved
     if let some info := isMatcherAppCore? (← getEnv) e then
       return .ready info.numAlts
     let .const declName .. := e.getAppFn | unreachable!
@@ -155,7 +145,7 @@ private def mkCasesMajor (c : Expr) : GoalM Expr := do
       return mkApp3 (mkConst ``Grind.of_eq_eq_true) a b (← mkEqTrueProof c)
     else
       return mkApp3 (mkConst ``Grind.of_eq_eq_false) a b (← mkEqFalseProof c)
-  | _ => return mkOfEqTrueCore c (← mkEqTrueProof c)
+  | _ => return mkApp2 (mkConst ``of_eq_true) c (← mkEqTrueProof c)
 
 /-- Introduces new hypotheses in each goal. -/
 private def introNewHyp (goals : List Goal) (acc : List Goal) (generation : Nat) : GrindM (List Goal) := do
@@ -173,7 +163,6 @@ def splitNext : GrindTactic := fun goal => do
       | return none
     let gen ← getGeneration c
     let genNew := if numCases > 1 || isRec then gen+1 else gen
-    markCaseSplitAsResolved c
     trace_goal[grind.split] "{c}, generation: {gen}"
     let mvarIds ← if (← isMatcherApp c) then
       casesMatch (← get).mvarId c

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

@@ -13,8 +13,8 @@ import Lean.Meta.CongrTheorems
 import Lean.Meta.AbstractNestedProofs
 import Lean.Meta.Tactic.Simp.Types
 import Lean.Meta.Tactic.Util
-import Lean.Meta.Tactic.Ext
 import Lean.Meta.Tactic.Grind.ENodeKey
+import Lean.Meta.Tactic.Grind.Canon
 import Lean.Meta.Tactic.Grind.Attr
 import Lean.Meta.Tactic.Grind.Arith.Types
 import Lean.Meta.Tactic.Grind.EMatchTheorem
@@ -66,6 +66,7 @@ instance : Hashable CongrTheoremCacheKey where
 
 /-- State for the `GrindM` monad. -/
 structure State where
+  canon      : Canon.State := {}
   /-- `ShareCommon` (aka `Hashconsing`) state. -/
   scState    : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
   /-- Next index for creating auxiliary theorems. -/
@@ -79,7 +80,6 @@ structure State where
   simpStats  : Simp.Stats := {}
   trueExpr   : Expr
   falseExpr  : Expr
-  natZExpr   : Expr
   /--
   Used to generate trace messages of the for `[grind] working on <tag>`,
   and implement the macro `trace_goal`.
@@ -104,10 +104,6 @@ def getTrueExpr : GrindM Expr := do
 def getFalseExpr : GrindM Expr := do
   return (← get).falseExpr
 
-/-- Returns the internalized `0 : Nat` numeral.  -/
-def getNatZeroExpr : GrindM Expr := do
-  return (← get).natZExpr
-
 def getMainDeclName : GrindM Name :=
   return (← readThe Context).mainDeclName
 
@@ -132,9 +128,18 @@ Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
 been hash-consed. We perform this step before we internalize expressions.
 -/
 def shareCommon (e : Expr) : GrindM Expr := do
-  modifyGet fun { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag } =>
+  modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
     let (e, scState) := ShareCommon.State.shareCommon scState e
-    (e, { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag })
+    (e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag })
+
+/--
+Canonicalizes nested types, type formers, and instances in `e`.
+-/
+def canon (e : Expr) : GrindM Expr := do
+  let canonS ← modifyGet fun s => (s.canon, { s with canon := {} })
+  let (e, canonS) ← Canon.canon e |>.run canonS
+  modify fun s => { s with canon := canonS }
+  return e
 
 /-- Returns `true` if `e` is the internalized `True` expression.  -/
 def isTrueExpr (e : Expr) : GrindM Bool :=
@@ -197,19 +202,13 @@ structure ENode where
   on heterogeneous equality.
   -/
   heqProofs : Bool := false
-  /-- Unique index used for pretty printing and debugging purposes. -/
+  /--
+  Unique index used for pretty printing and debugging purposes.
+  -/
   idx : Nat := 0
-  /-- The generation in which this enode was created. -/
   generation : Nat := 0
   /-- Modification time -/
   mt : Nat := 0
-  /--
-  The `offset?` field is used to propagate equalities from the `grind` congruence closure module
-  to the offset constraints module. When `grind` merges two equivalence classes, and both have
-  an associated `offset?` set to `some e`, the equality is propagated. This field is
-  assigned during the internalization of offset terms.
-  -/
-  offset? : Option Expr := none
   deriving Inhabited, Repr
 
 def ENode.isCongrRoot (n : ENode) :=
@@ -333,16 +332,8 @@ structure NewFact where
   generation : Nat
   deriving Inhabited
 
-/-- Canonicalizer state. See `Canon.lean` for additional details. -/
-structure Canon.State where
-  argMap     : PHashMap (Expr × Nat) (List Expr) := {}
-  canon      : PHashMap Expr Expr := {}
-  proofCanon : PHashMap Expr Expr := {}
-  deriving Inhabited
-
 structure Goal where
   mvarId       : MVarId
-  canon        : Canon.State := {}
   enodes       : ENodeMap := {}
   parents      : ParentMap := {}
   congrTable   : CongrTable enodes := {}
@@ -385,19 +376,10 @@ structure Goal where
   splitCandidates : List Expr := []
   /-- Number of splits performed to get to this goal. -/
   numSplits : Nat := 0
-  /-- Case-splits that have already been performed, or that do not have to be performed anymore. -/
+  /-- Case-splits that do not have to be performed anymore. -/
   resolvedSplits : PHashSet ENodeKey := {}
   /-- Next local E-match theorem idx. -/
   nextThmIdx : Nat := 0
-  /-- Asserted facts -/
-  facts      : PArray Expr := {}
-  /--
-  Issues found during the proof search in this goal. This issues are reported to
-  users when `grind` fails.
-  -/
-  issues     : List MessageData := []
-  /-- Cached extensionality theorems for types. -/
-  extThms    : PHashMap ENodeKey (Array Ext.ExtTheorem) := {}
   deriving Inhabited
 
 def Goal.admit (goal : Goal) : MetaM Unit :=
@@ -418,20 +400,6 @@ def updateLastTag : GoalM Unit := do
       trace[grind] "working on goal `{currTag}`"
       modifyThe Grind.State fun s => { s with lastTag := currTag }
 
-def Goal.reportIssue (goal : Goal) (msg : MessageData) : MetaM Goal := do
-  let msg ← addMessageContext msg
-  let goal := { goal with issues := .trace { cls := `issue } msg #[] :: goal.issues }
-  /-
-  We also add a trace message because we may want to know when
-  an issue happened relative to other trace messages.
-  -/
-  trace[grind.issues] msg
-  return goal
-
-def reportIssue (msg : MessageData) : GoalM Unit := do
-  let goal ← (← get).reportIssue msg
-  set goal
-
 /--
 Macro similar to `trace[...]`, but it includes the trace message `trace[grind] "working on <current goal>"`
 if the tag has changed since the last trace message.
@@ -480,25 +448,14 @@ def checkMaxEmatchExceeded : GoalM Bool := do
 Returns `some n` if `e` has already been "internalized" into the
 Otherwise, returns `none`s.
 -/
-def Goal.getENode? (goal : Goal) (e : Expr) : Option ENode :=
-  goal.enodes.find? { expr := e }
-
-@[inline, inherit_doc Goal.getENode?]
 def getENode? (e : Expr) : GoalM (Option ENode) :=
-  return (← get).getENode? e
-
-def throwNonInternalizedExpr (e : Expr) : CoreM α :=
-  throwError "internal `grind` error, term has not been internalized{indentExpr e}"
+  return (← get).enodes.find? { expr := e }
 
 /-- Returns node associated with `e`. It assumes `e` has already been internalized. -/
-def Goal.getENode (goal : Goal) (e : Expr) : CoreM ENode := do
-  let some n := goal.enodes.find? { expr := e }
-    | throwNonInternalizedExpr e
-  return n
-
-@[inline, inherit_doc Goal.getENode]
 def getENode (e : Expr) : GoalM ENode := do
-  (← get).getENode e
+  let some n := (← get).enodes.find? { expr := e }
+    | throwError "internal `grind` error, term has not been internalized{indentExpr e}"
+  return n
 
 /-- Returns the generation of the given term. Is assumes it has been internalized -/
 def getGeneration (e : Expr) : GoalM Nat :=
@@ -529,53 +486,30 @@ def isRoot (e : Expr) : GoalM Bool := do
   return isSameExpr n.root e
 
 /-- Returns the root element in the equivalence class of `e` IF `e` has been internalized. -/
-def Goal.getRoot? (goal : Goal) (e : Expr) : Option Expr := Id.run do
-  let some n ← goal.getENode? e | return none
+def getRoot? (e : Expr) : GoalM (Option Expr) := do
+  let some n ← getENode? e | return none
   return some n.root
 
-@[inline, inherit_doc Goal.getRoot?]
-def getRoot? (e : Expr) : GoalM (Option Expr) := do
-  return (← get).getRoot? e
-
 /-- Returns the root element in the equivalence class of `e`. -/
-def Goal.getRoot (goal : Goal) (e : Expr) : CoreM Expr :=
-  return (← goal.getENode e).root
-
-@[inline, inherit_doc Goal.getRoot]
-def getRoot (e : Expr) : GoalM Expr := do
-  (← get).getRoot e
+def getRoot (e : Expr) : GoalM Expr :=
+  return (← getENode e).root
 
 /-- Returns the root enode in the equivalence class of `e`. -/
 def getRootENode (e : Expr) : GoalM ENode := do
   getENode (← getRoot e)
 
-/--
-Returns the next element in the equivalence class of `e`
-if `e` has been internalized in the given goal.
--/
-def Goal.getNext? (goal : Goal) (e : Expr) : Option Expr := Id.run do
-  let some n ← goal.getENode? e | return none
-  return some n.next
-
 /-- Returns the next element in the equivalence class of `e`. -/
-def Goal.getNext (goal : Goal) (e : Expr) : CoreM Expr :=
-  return (← goal.getENode e).next
-
-@[inline, inherit_doc Goal.getRoot]
-def getNext (e : Expr) : GoalM Expr := do
-  (← get).getNext e
+def getNext (e : Expr) : GoalM Expr :=
+  return (← getENode e).next
 
 /-- Returns `true` if `e` has already been internalized. -/
 def alreadyInternalized (e : Expr) : GoalM Bool :=
   return (← get).enodes.contains { expr := e }
 
-def Goal.getTarget? (goal : Goal) (e : Expr) : Option Expr := Id.run do
-  let some n ← goal.getENode? e | return none
+def getTarget? (e : Expr) : GoalM (Option Expr) := do
+  let some n ← getENode? e | return none
   return n.target?
 
-@[inline] def getTarget? (e : Expr) : GoalM (Option Expr) := do
-  return (← get).getTarget? e
-
 /--
 If `isHEq` is `false`, it pushes `lhs = rhs` with `proof` to `newEqs`.
 Otherwise, it pushes `HEq lhs rhs`.
@@ -673,41 +607,6 @@ def mkENode (e : Expr) (generation : Nat) : GoalM Unit := do
   let interpreted ← isInterpreted e
   mkENodeCore e interpreted ctor generation
 
-/--
-Notify the offset constraint module that `a = b` where
-`a` and `b` are terms that have been internalized by this module.
--/
-@[extern "lean_process_new_offset_eq"] -- forward definition
-opaque Arith.processNewOffsetEq (a b : Expr) : GoalM Unit
-
-/--
-Notify the offset constraint module that `a = k` where
-`a` is term that has been internalized by this module,
-and `k` is a numeral.
--/
-@[extern "lean_process_new_offset_eq_lit"] -- forward definition
-opaque Arith.processNewOffsetEqLit (a k : Expr) : GoalM Unit
-
-/-- Returns `true` if `e` is a numeral and has type `Nat`. -/
-def isNatNum (e : Expr) : Bool := Id.run do
-  let_expr OfNat.ofNat _ _ inst := e | false
-  let_expr instOfNatNat _ := inst | false
-  true
-
-/--
-Marks `e` as a term of interest to the offset constraint module.
-If the root of `e`s equivalence class has already a term of interest,
-a new equality is propagated to the offset module.
--/
-def markAsOffsetTerm (e : Expr) : GoalM Unit := do
-  let root ← getRootENode e
-  if let some e' := root.offset? then
-    Arith.processNewOffsetEq e e'
-  else if isNatNum root.self && !isSameExpr e root.self then
-    Arith.processNewOffsetEqLit e root.self
-  else
-    setENode root.self { root with offset? := some e }
-
 /-- Returns `true` is `e` is the root of its congruence class. -/
 def isCongrRoot (e : Expr) : GoalM Bool := do
   return (← getENode e).isCongrRoot
@@ -782,14 +681,11 @@ def closeGoal (falseProof : Expr) : GoalM Unit := do
     else
       mvarId.assign (← mkFalseElim target falseProof)
 
-def Goal.getENodes (goal : Goal) : Array ENode :=
-  -- We must sort because we are using pointer addresses as keys in `enodes`
-  let nodes := goal.enodes.toArray.map (·.2)
-  nodes.qsort fun a b => a.idx < b.idx
-
 /-- Returns all enodes in the goal -/
 def getENodes : GoalM (Array ENode) := do
-  return (← get).getENodes
+  -- We must sort because we are using pointer addresses as keys in `enodes`
+  let nodes := (← get).enodes.toArray.map (·.2)
+  return nodes.qsort fun a b => a.idx < b.idx
 
 /-- Executes `f` to each term in the equivalence class containing `e` -/
 @[inline] def traverseEqc (e : Expr) (f : ENode → GoalM Unit) : GoalM Unit := do
@@ -847,67 +743,37 @@ def applyFallback : GoalM Unit := do
   fallback
 
 /-- Returns expressions in the given expression equivalence class. -/
-partial def Goal.getEqc (goal : Goal) (e : Expr) : List Expr :=
+partial def getEqc (e : Expr) : GoalM (List Expr) :=
   go e e []
 where
-  go (first : Expr) (e : Expr) (acc : List Expr) : List Expr := Id.run do
-    let some next ← goal.getNext? e | acc
+  go (first : Expr) (e : Expr) (acc : List Expr) : GoalM (List Expr) := do
+    let next ← getNext e
     let acc := e :: acc
     if isSameExpr first next then
       return acc
     else
       go first next acc
 
-@[inline, inherit_doc Goal.getEqc]
-partial def getEqc (e : Expr) : GoalM (List Expr) :=
-  return (← get).getEqc e
-
 /-- Returns all equivalence classes in the current goal. -/
-partial def Goal.getEqcs (goal : Goal) : List (List Expr) := Id.run do
-  let mut r : List (List Expr) := []
-  let nodes ← goal.getENodes
+partial def getEqcs : GoalM (List (List Expr)) := do
+  let mut r := []
+  let nodes ← getENodes
   for node in nodes do
     if isSameExpr node.root node.self then
-      r := goal.getEqc node.self :: r
+      r := (← getEqc node.self) :: r
   return r
 
-@[inline, inherit_doc Goal.getEqcs]
-def getEqcs : GoalM (List (List Expr)) :=
-  return (← get).getEqcs
-
 /-- Returns `true` if `e` is a case-split that does not need to be performed anymore. -/
 def isResolvedCaseSplit (e : Expr) : GoalM Bool :=
   return (← get).resolvedSplits.contains { expr := e }
 
 /--
 Mark `e` as a case-split that does not need to be performed anymore.
-Remark: we currently use this feature to disable `match`-case-splits.
-Remark: we also use this feature to record the case-splits that have already been performed.
+Remark: we currently use this feature to disable `match`-case-splits
 -/
 def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
   unless (← isResolvedCaseSplit e) do
     trace_goal[grind.split.resolved] "{e}"
     modify fun s => { s with resolvedSplits := s.resolvedSplits.insert { expr := e } }
 
-/--
-Returns extensionality theorems for the given type if available.
-If `Config.ext` is `false`, the result is `#[]`.
--/
-def getExtTheorems (type : Expr) : GoalM (Array Ext.ExtTheorem) := do
-  unless (← getConfig).ext do return #[]
-  if let some thms := (← get).extThms.find? { expr := type } then
-    return thms
-  else
-    let thms ← Ext.getExtTheorems type
-    modify fun s => { s with extThms := s.extThms.insert { expr := type } thms }
-    return thms
-
-/--
-Helper function for instantiating a type class `type`, and
-then using the result to perform `isDefEq x val`.
--/
-def synthesizeInstanceAndAssign (x type : Expr) : MetaM Bool := do
-  let .some val ← trySynthInstance type | return false
-  isDefEq x val
-
 end Lean.Meta.Grind

src/Lean/Meta/Tactic/Simp/Diagnostics.lean

@@ -52,12 +52,12 @@ def reportDiag (diag : Simp.Diagnostics) : MetaM Unit := do
     let congr ← mkDiagSummary `simp diag.congrThmCounter
     let thmsWithBadKeys ← mkTheoremsWithBadKeySummary diag.thmsWithBadKeys
     unless used.isEmpty && tried.isEmpty && congr.isEmpty && thmsWithBadKeys.isEmpty do
-      let m := #[]
+      let m := MessageData.nil
       let m := appendSection m `simp "used theorems" used
       let m := appendSection m `simp "tried theorems" tried
       let m := appendSection m `simp "tried congruence theorems" congr
       let m := appendSection m `simp "theorems with bad keys" thmsWithBadKeys (resultSummary := false)
-      let m := m.push <| "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
-      logInfo <| .trace { cls := `simp, collapsed := false } "Diagnostics" m
+      let m := m ++ "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
+      logInfo m
 
 end Lean.Meta.Simp

src/Lean/Parser/Basic.lean

@@ -1583,8 +1583,8 @@ namespace TokenMap
 
 def insert (map : TokenMap α) (k : Name) (v : α) : TokenMap α :=
   match map.find? k with
-  | none    => RBMap.insert map k [v]
-  | some vs => RBMap.insert map k (v::vs)
+  | none    => .insert map k [v]
+  | some vs => .insert map k (v::vs)
 
 instance : Inhabited (TokenMap α) where
   default := RBMap.empty

src/Lean/ParserCompiler.lean

@@ -103,8 +103,11 @@ partial def compileParserExpr (e : Expr) : MetaM Expr := do
           name := c', levelParams := []
           type := ty, value := value, hints := ReducibilityHints.opaque, safety := DefinitionSafety.safe
         }
-        addAndCompile decl
-        modifyEnv (ctx.combinatorAttr.setDeclFor · c c')
+        let env ← getEnv
+        let env ← match env.addAndCompile {} decl with
+          | Except.ok    env => pure env
+          | Except.error kex => do throwError (← (kex.toMessageData {}).toString)
+        setEnv <| ctx.combinatorAttr.setDeclFor env c c'
         if cinfo.type.isConst then
           if let some kind ← parserNodeKind? cinfo.value! then
             -- If the parser is parameter-less and produces a node of kind `kind`,

src/Lean/Replay.lean

@@ -49,13 +49,15 @@ def isTodo (name : Name) : M Bool := do
   else
     return false
 
-/-- Use the current `Environment` to throw a `Kernel.Exception`. -/
-def throwKernelException (ex : Kernel.Exception) : M Unit := do
-  throw <| .userError <| (← ex.toMessageData {} |>.toString)
+/-- Use the current `Environment` to throw a `KernelException`. -/
+def throwKernelException (ex : KernelException) : M Unit := do
+    let ctx := { fileName := "", options := ({} : KVMap), fileMap := default }
+    let state := { env := (← get).env }
+    Prod.fst <$> (Lean.Core.CoreM.toIO · ctx state) do Lean.throwKernelException ex
 
-/-- Add a declaration, possibly throwing a `Kernel.Exception`. -/
+/-- Add a declaration, possibly throwing a `KernelException`. -/
 def addDecl (d : Declaration) : M Unit := do
-  match (← get).env.addDeclCore 0 d (cancelTk? := none) with
+  match (← get).env.addDecl {} d with
   | .ok env => modify fun s => { s with env := env }
   | .error ex => throwKernelException ex
 

src/Lean/Server/Requests.lean

@@ -97,7 +97,7 @@ abbrev RequestT m := ReaderT RequestContext <| ExceptT RequestError m
 /-- Workers execute request handlers in this monad. -/
 abbrev RequestM := ReaderT RequestContext <| EIO RequestError
 
-abbrev RequestTask.pure (a : α) : RequestTask α := Task.pure (.ok a)
+abbrev RequestTask.pure (a : α) : RequestTask α := .pure (.ok a)
 
 instance : MonadLift IO RequestM where
   monadLift x := do

src/Lean/Util/Path.lean

@@ -104,26 +104,17 @@ def initSearchPath (leanSysroot : FilePath) (sp : SearchPath := ∅) : IO Unit :
 private def initSearchPathInternal : IO Unit := do
   initSearchPath (← getBuildDir)
 
-/-- Find the compiled `.olean` of a module in the `LEAN_PATH` search path. -/
 partial def findOLean (mod : Name) : IO FilePath := do
   let sp ← searchPathRef.get
   if let some fname ← sp.findWithExt "olean" mod then
     return fname
   else
     let pkg := FilePath.mk <| mod.getRoot.toString (escape := false)
-    throw <| IO.userError s!"unknown module prefix '{pkg}'\n\n\
-      No directory '{pkg}' or file '{pkg}.olean' in the search path entries:\n\
-      {"\n".intercalate <| sp.map (·.toString)}"
+    let mut msg := s!"unknown module prefix '{pkg}'
 
-/-- Find the `.lean` source of a module in a `LEAN_SRC_PATH` search path. -/
-partial def findLean (sp : SearchPath) (mod : Name) : IO FilePath := do
-  if let some fname ← sp.findWithExt "lean" mod then
-    return fname
-  else
-    let pkg := FilePath.mk <| mod.getRoot.toString (escape := false)
-    throw <| IO.userError s!"unknown module prefix '{pkg}'\n\n\
-      No directory '{pkg}' or file '{pkg}.lean' in the search path entries:\n\
-      {"\n".intercalate <| sp.map (·.toString)}"
+No directory '{pkg}' or file '{pkg}.olean' in the search path entries:
+{"\n".intercalate <| sp.map (·.toString)}"
+    throw <| IO.userError msg
 
 /-- Infer module name of source file name. -/
 @[export lean_module_name_of_file]

src/Lean/Widget/InteractiveDiagnostic.lean

@@ -207,9 +207,7 @@ partial def msgToInteractive (msgData : MessageData) (hasWidgets : Bool) (indent
         | .widget wi alt =>
           return .tag (.widget wi (← fmtToTT alt col)) default
         | .trace cls msg collapsed children => do
-          -- absolute column = request-level indentation (e.g. from nested lazy trace request) +
-          -- offset inside `fmt`
-          let col := indent + col
+          let col := col + tt.stripTags.length - 2
           let children ←
             match children with
               | .lazy children => pure <| .lazy ⟨{indent := col+2, children := children.map .mk}⟩