feat: align List/Array/Vector.flatMap

This PR fixes a bug in the term canonicalizer used in the `grind`
tactic.

.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/",
+                "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",
                 "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
+          sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
         if: matrix.cmultilib
       - name: Cache
         uses: actions/cache@v4

CMakeLists.txt

@@ -18,6 +18,9 @@ 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,6 +33,9 @@ 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"
@@ -44,6 +47,7 @@ Format of the commit message
  - 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:
 
@@ -60,17 +64,21 @@ 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',
-but contains
+kernel. They are implemented in the file 'library/printer.cpp'.
 
-    expr a;
-    ...
-    std::cout << a << "\n";
-    ...
+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";
+...
+```
 
 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,3 +80,10 @@ 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,12 +32,13 @@ following to use `g++`.
 cmake -DCMAKE_CXX_COMPILER=g++ ...
 ```
 
-## Required Packages: CMake, GMP, libuv
+## Required Packages: CMake, GMP, libuv, pkgconf
 
 ```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
+sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
 ```

flake.nix

@@ -28,7 +28,7 @@
           stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
         } ({
           buildInputs = with pkgs; [
-            cmake gmp libuv ccache cadical
+            cmake gmp libuv ccache cadical pkg-config
             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, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
+  stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, 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 ];
+    nativeBuildInputs = [ cmake pkg-config ];
     buildInputs = [ gmp libuv llvmPackages.llvm ];
     # https://github.com/NixOS/nixpkgs/issues/60919
     hardeningDisable = [ "all" ];

script/push_repo_release_tag.py

@@ -0,0 +1,69 @@
+#!/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,6 +22,36 @@ 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 {}
@@ -35,11 +65,20 @@ def get_branch_content(repo_url, branch, file_path, github_token):
             return None
     return None
 
-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 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 is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
     # First get the commit SHA for the tag
@@ -64,23 +103,38 @@ 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()
 
@@ -89,6 +143,47 @@ 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"]
@@ -117,7 +212,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")
+                print(f"  ❌ Tag {toolchain} does not exist. Run `script/push_repo_release_tag.py {extract_org_repo_from_url(url)} {branch} {toolchain}`.")
                 continue
             print(f"  ✅ Tag {toolchain} exists")
 

src/CMakeLists.txt

@@ -295,14 +295,15 @@ 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_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
-  set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
+  set(LIBUV_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
+  set(LIBUV_LDFLAGS "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
 else()
   find_package(LibUV 1.0.0 REQUIRED)
 endif()
-include_directories(${LIBUV_INCLUDE_DIR})
+include_directories(${LIBUV_INCLUDE_DIRS})
 if(NOT LEAN_STANDALONE)
-  string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
+  string(JOIN " " LIBUV_LDFLAGS ${LIBUV_LDFLAGS})
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
 endif()
 
 # Windows SDK (for ICU)

src/Init/Data/Array/Basic.lean

@@ -244,8 +244,7 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
 def range (n : Nat) : Array Nat :=
   ofFn fun (i : Fin n) => i
 
-def singleton (v : α) : Array α :=
-  mkArray 1 v
+@[inline] protected def singleton (v : α) : Array α := #[v]
 
 def back! [Inhabited α] (a : Array α) : α :=
   a[a.size - 1]!
@@ -577,6 +576,12 @@ 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,12 +81,18 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
 
 @[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
 
-@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
+@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
   apply ext'; simp only [toList_append, toList_empty, List.append_nil]
 
-@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
+@[deprecated append_empty (since := "2025-01-13")]
+abbrev append_nil := @append_empty
+
+@[simp] theorem empty_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_array_induction
+  cases L using 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_array_induction
+  cases L using 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_array_induction
+  cases L using 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_array_induction
+  cases xs using 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_array_induction
+  cases xs using 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,6 +38,14 @@ 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
@@ -256,6 +264,11 @@ 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
@@ -1089,9 +1102,21 @@ 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
 
@@ -1100,13 +1125,6 @@ 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⟩
@@ -1189,6 +1207,30 @@ 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]
@@ -1504,11 +1546,596 @@ 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
+  cases bs
+  simp
+
+@[simp] theorem append_eq_toArray_iff {as bs : Array α} {xs : List α} :
+    as ++ bs = xs.toArray ↔ as.toList ++ bs.toList = xs := by
+  cases as
+  cases bs
+  simp
 
 theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
 
-@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
+@[simp] theorem empty_append_fun : ((#[] : Array α) ++ ·) = id := by
+  funext ⟨l⟩
+  simp
+
+@[simp] theorem mem_append {a : α} {s t : Array α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
+  simp only [mem_def, toList_append, List.mem_append]
+
+theorem mem_append_left {a : α} {l₁ : Array α} (l₂ : Array α) (h : a ∈ l₁) : a ∈ l₁ ++ l₂ :=
+  mem_append.2 (Or.inl h)
+
+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₂⟩
+
+/--
+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 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 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
+  cases as; cases bs
+  simp [List.getElem_append]
+
+theorem getElem_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
+    (as ++ bs)[i] = as[i] := by
+  simp only [← getElem_toList]
+  have h' : i < (as.toList ++ bs.toList).length := by rwa [← length_toList, toList_append] at h
+  conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
+  apply List.get_of_eq; rw [toList_append]
+
+theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size ≤ i) :
+    (as ++ bs)[i] = bs[i - as.size]'(Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) := by
+  simp only [← getElem_toList]
+  have h' : i < (as.toList ++ bs.toList).length := by rwa [← length_toList, toList_append] at h
+  conv => rhs; rw [← List.getElem_append_right (h₁ := hle) (h₂ := h')]
+  apply List.get_of_eq; rw [toList_append]
+
+theorem getElem?_append_left {as bs : Array α} {i : Nat} (hn : i < as.size) :
+    (as ++ bs)[i]? = as[i]? := by
+  have hn' : i < (as ++ bs).size := Nat.lt_of_lt_of_le hn <|
+    size_append .. ▸ Nat.le_add_right ..
+  simp_all [getElem?_eq_getElem, getElem_append]
+
+theorem getElem?_append_right {as bs : Array α} {i : Nat} (h : as.size ≤ i) :
+    (as ++ bs)[i]? = bs[i - as.size]? := by
+  cases as
+  cases bs
+  simp at h
+  simp [List.getElem?_append_right, h]
+
+theorem getElem?_append {as bs : Array α} {i : Nat} :
+    (as ++ bs)[i]? = if i < as.size then as[i]? else bs[i - as.size]? := 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₂ : Array α) {l₁ : Array α} {i : Nat} (hi : i < l₁.size) :
+    l₁[i] = (l₁ ++ l₂)[i]'(by simpa using Nat.lt_add_right l₂.size hi) := 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₁ : Array α) {l₂ : Array α} {i : Nat} (hi : i < l₂.size) :
+    l₂[i] = (l₁ ++ l₂)[i + l₁.size]'(by simpa [Nat.add_comm] using Nat.add_lt_add_left hi _) := by
+  rw [getElem_append_right] <;> simp [*, Nat.le_add_left]
+
+theorem getElem_of_append {l l₁ l₂ : Array α} (eq : l = l₁.push a ++ l₂) (h : l₁.size = i) :
+    l[i]'(eq ▸ h ▸ by simp_arith) = a := Option.some.inj <| by
+  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 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, flatMap_toList]
+
+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]
+
+/-! Content below this point has not yet been aligned with `List`. -/
 
 -- This is a duplicate of `List.toArray_toList`.
 -- It's confusing to guess which namespace this theorem should live in,
@@ -2122,96 +2749,6 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : α → α} {j : Nat} :
 
 theorem size_empty : (#[] : Array α).size = 0 := rfl
 
-/-! ### append -/
-
-@[simp] theorem mem_append {a : α} {s t : Array α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
-  simp only [mem_def, toList_append, List.mem_append]
-
-theorem mem_append_left {a : α} {l₁ : Array α} (l₂ : Array α) (h : a ∈ l₁) : a ∈ l₁ ++ l₂ :=
-  mem_append.2 (Or.inl h)
-
-theorem mem_append_right {a : α} (l₁ : Array α) {l₂ : Array α} (h : a ∈ l₂) : a ∈ l₁ ++ l₂ :=
-  mem_append.2 (Or.inr h)
-
-@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
-  simp only [size, toList_append, List.length_append]
-
-theorem empty_append (as : Array α) : #[] ++ as = as := by simp
-
-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
-  cases as; cases bs
-  simp [List.getElem_append]
-
-theorem getElem_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
-    (as ++ bs)[i] = as[i] := by
-  simp only [← getElem_toList]
-  have h' : i < (as.toList ++ bs.toList).length := by rwa [← length_toList, toList_append] at h
-  conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
-  apply List.get_of_eq; rw [toList_append]
-
-theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size ≤ i) :
-    (as ++ bs)[i] = bs[i - as.size]'(Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) := by
-  simp only [← getElem_toList]
-  have h' : i < (as.toList ++ bs.toList).length := by rwa [← length_toList, toList_append] at h
-  conv => rhs; rw [← List.getElem_append_right (h₁ := hle) (h₂ := h')]
-  apply List.get_of_eq; rw [toList_append]
-
-theorem getElem?_append_left {as bs : Array α} {i : Nat} (hn : i < as.size) :
-    (as ++ bs)[i]? = as[i]? := by
-  have hn' : i < (as ++ bs).size := Nat.lt_of_lt_of_le hn <|
-    size_append .. ▸ Nat.le_add_right ..
-  simp_all [getElem?_eq_getElem, getElem_append]
-
-theorem getElem?_append_right {as bs : Array α} {i : Nat} (h : as.size ≤ i) :
-    (as ++ bs)[i]? = bs[i - as.size]? := by
-  cases as
-  cases bs
-  simp at h
-  simp [List.getElem?_append_right, h]
-
-theorem getElem?_append {as bs : Array α} {i : Nat} :
-    (as ++ bs)[i]? = if i < as.size then as[i]? else bs[i - as.size]? := by
-  split <;> rename_i h
-  · exact getElem?_append_left h
-  · exact getElem?_append_right (by simpa using h)
-
-@[simp] theorem toArray_eq_append_iff {xs : List α} {as bs : Array α} :
-    xs.toArray = as ++ bs ↔ xs = as.toList ++ bs.toList := by
-  cases as
-  cases bs
-  simp
-
-@[simp] theorem append_eq_toArray_iff {as bs : Array α} {xs : List α} :
-    as ++ bs = xs.toArray ↔ as.toList ++ bs.toList = xs := by
-  cases as
-  cases bs
-  simp
-
-/-! ### 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
@@ -2228,16 +2765,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_nil]
+  | zero => rw [extract_loop_zero, extract_loop_zero, append_empty]
   | 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, nil_append]
+      rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, empty_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_nil]
+      rw [append_empty]
 
 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
@@ -2593,11 +3130,6 @@ 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]
@@ -2634,8 +3166,6 @@ 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]
@@ -2646,12 +3176,48 @@ theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β
   | nil => simp
   | cons xs xss ih => simp [ih]
 
+/-! ### sum -/
+
+theorem sum_eq_sum_toList [Add α] [Zero α] (as : Array α) : as.sum = as.toList.sum := by
+  cases as
+  simp [Array.sum, List.sum]
+
 /-! ### mkArray -/
 
+theorem eq_mkArray_of_mem {a : α} {l : Array α} (h : ∀ (b) (_ : b ∈ l), b = a) : l = mkArray l.size a := by
+  rcases l with ⟨l⟩
+  have := List.eq_replicate_of_mem (by simpa using h)
+  rw [this]
+  simp
+
+theorem eq_mkArray_iff {a : α} {n} {l : Array α} :
+    l = mkArray n a ↔ l.size = n ∧ ∀ (b) (_ : b ∈ l), b = a := by
+  rcases l with ⟨l⟩
+  simp [← List.eq_replicate_iff, toArray_eq]
+
+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 mem_mkArray (a : α) (n : Nat) : b ∈ mkArray n a ↔ n ≠ 0 ∧ b = a := by
   rw [mkArray, mem_toArray]
   simp
 
+@[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 `Array.map`.
+theorem map_const' (l : Array α) (b : β) : map (fun _ => b) l = mkArray l.size b :=
+  map_const l b
+
+@[simp] theorem sum_mkArray_nat (n : Nat) (a : Nat) : (mkArray n a).sum = n * a := by
+  simp [sum_eq_sum_toList, List.sum_replicate_nat]
+
 /-! ### 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 multiplication `(x * y)` does not overflow. -/
+/-- If `x.toNat + y.toNat < 2^w`, then the addition `(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} (a : List α) (b : α → List β) : List β := flatten (map b a)
+@[inline] def flatMap {α : Type u} {β : Type v} (b : α → List β) (a : 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 (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
+  List.flatMap f (x :: xs) = f x ++ List.flatMap f xs := 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 (as : List α) (f : α → List β) : List β := go as #[] where
+@[inline] def flatMapTR (f : α → List β) (as : 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 α β as f
+  funext α β f as
   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 α := flatMapTR l id
+@[inline] def flattenTR (l : List (List α)) : List α := l.flatMapTR 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,9 +1076,31 @@ 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
 
@@ -1087,14 +1109,6 @@ 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
@@ -1494,6 +1508,34 @@ 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'
@@ -1561,14 +1603,6 @@ 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 :
@@ -1585,8 +1619,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 _ (length t₁) _ <| by
-  let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
+  append_inj h <| @Nat.add_right_cancel _ t₁.length _ <| 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₂ :=
@@ -1614,9 +1648,6 @@ 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
@@ -1642,6 +1673,54 @@ 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
@@ -1691,60 +1770,6 @@ 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
@@ -1873,7 +1898,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∨ ∃ L b, l = concat L b
 
 /-! ### flatten -/
 
-@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
+@[simp] theorem length_flatten (L : List (List α)) : L.flatten.length = (L.map length).sum := by
   induction L with
   | nil => rfl
   | cons =>
@@ -1888,6 +1913,9 @@ 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
 
@@ -1913,7 +1941,8 @@ 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 α)) : map f (flatten L) = flatten (map (map f) L) := by
+@[simp] theorem map_flatten (f : α → β) (L : List (List α)) :
+    (flatten L).map f = (map (map f) L).flatten := by
   induction L <;> simp_all
 
 @[simp] theorem filterMap_flatten (f : α → Option β) (L : List (List α)) :
@@ -1966,6 +1995,26 @@ 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) ∨
@@ -1974,8 +2023,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, 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_iff, 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 =>
@@ -1994,6 +2043,13 @@ 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 α)},
@@ -2014,12 +2070,14 @@ 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 α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
+@[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 length_flatMap (l : List α) (f : α → List β) :
-    length (l.flatMap f) = sum (map (length ∘ f) l) := by
-  rw [List.flatMap, length_flatten, map_map]
+    length (l.flatMap f) = sum (map (fun a => (f a).length) l) := by
+  rw [List.flatMap, length_flatten, map_map, Function.comp_def]
 
 @[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]
@@ -2032,7 +2090,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 β} : List.flatMap l f = [] ↔ ∀ x ∈ l, f x = [] :=
+theorem flatMap_eq_nil_iff {l : List α} {f : α → List β} : l.flatMap 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₂]
 
@@ -2337,6 +2395,9 @@ 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

@@ -46,7 +46,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
 @[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
   cases l <;> simp [Array.isEmpty]
 
-@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
+@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
 
 @[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
   simp only [back!, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
@@ -143,6 +143,9 @@ 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'
@@ -394,4 +397,24 @@ 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, exists_and_left, and_imp]
+      · simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, 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] at h₃
+        simp only [nil_eq, append_eq_nil_iff] at h₃
         obtain ⟨rfl, rfl⟩ := h₃
         simp
     | cons x₂ l₂ =>

src/Init/Data/Option/Lemmas.lean

@@ -208,6 +208,15 @@ 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
@@ -629,6 +638,15 @@ 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,6 +13,12 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
 `(
 namespace $typeName
 
+@[simp] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
+@[simp] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
+@[simp] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
+@[simp] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
+@[simp] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
+@[simp] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := 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
@@ -37,3 +43,31 @@ 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]
+theorem Bool.toBitVec_toUInt8 {b : Bool} :
+    b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
+  cases b <;> simp [toUInt8]
+
+@[simp]
+theorem Bool.toBitVec_toUInt16 {b : Bool} :
+    b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
+  cases b <;> simp [toUInt16]
+
+@[simp]
+theorem Bool.toBitVec_toUInt32 {b : Bool} :
+    b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
+  cases b <;> simp [toUInt32]
+
+@[simp]
+theorem Bool.toBitVec_toUInt64 {b : Bool} :
+    b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
+  cases b <;> simp [toUInt64]
+
+@[simp]
+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/Vector/Basic.lean

@@ -170,6 +170,13 @@ 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,6 +5,7 @@ Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
 -/
 prelude
 import Init.Data.Vector.Basic
+import Init.Data.Array.Attach
 
 /-!
 ## Vectors
@@ -27,6 +28,9 @@ 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
 
@@ -693,6 +697,24 @@ 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] :
@@ -1097,6 +1119,11 @@ 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
 
@@ -1167,6 +1194,406 @@ 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 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 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]
+
 /-! 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) :
@@ -1197,28 +1624,6 @@ 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,3 +11,4 @@ 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,6 +12,9 @@ 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)
 
@@ -66,6 +69,12 @@ theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by s
 theorem eq_congr  {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
 theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
 
+/- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
+theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a ∨ b) ∧ (¬b ∨ a) := by
+  by_cases a <;> by_cases b <;> simp_all
+theorem of_eq_eq_false {a b : Prop} (h : (a = b) = False) : (¬a ∨ ¬b) ∧ (b ∨ a) := by
+  by_cases a <;> by_cases b <;> simp_all
+
 /-! Forall -/
 
 theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = True) (h₂ : q (of_eq_true h₁) = q') : (∀ hp : p, q hp) = q' := by

src/Init/Grind/Norm.lean

@@ -46,6 +46,12 @@ attribute [grind_norm] not_false_eq_true
 theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
   by_cases p <;> by_cases q <;> simp [*]
 
+@[grind_norm] theorem true_imp_eq (p : Prop) : (True → p) = p := by simp
+@[grind_norm] theorem false_imp_eq (p : Prop) : (False → p) = True := by simp
+@[grind_norm] theorem imp_true_eq (p : Prop) : (p → True) = True := by simp
+@[grind_norm] theorem imp_false_eq (p : Prop) : (p → False) = ¬p := by simp
+@[grind_norm] theorem imp_self_eq (p : Prop) : (p → p) = True := by simp
+
 -- And
 @[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
   by_cases p <;> by_cases q <;> simp [*]

src/Init/Grind/Offset.lean

@@ -7,159 +7,86 @@ prelude
 import Init.Core
 import Init.Omega
 
-namespace Lean.Grind.Offset
+namespace Lean.Grind
+abbrev isLt (x y : Nat) : Bool := x < y
+abbrev isLE (x y : Nat) : Bool := x ≤ y
 
-abbrev Var := Nat
-abbrev Context := Lean.RArray Nat
+/-! 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
+  omega
+theorem Nat.lo_le (u w v k : Nat) : u + k ≤ w → w ≤ v → u + k ≤ v := by
+  omega
+theorem Nat.lo_lo (u w v k₁ k₂ : Nat) : u + k₁ ≤ w → w + k₂ ≤ v → u + (k₁ + k₂) ≤ v := by
+  omega
+theorem Nat.lo_ro_1 (u w v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ w → w ≤ v + k₂ → u + (k₁ - k₂) ≤ v := by
+  simp [isLt]; omega
+theorem Nat.lo_ro_2 (u w v k₁ k₂ : Nat) : u + k₁ ≤ w → w ≤ v + k₂ → u ≤ v + (k₂ - k₁) := by
+  omega
+theorem Nat.ro_le (u w v k : Nat) : u ≤ w + k → w ≤ v → u ≤ v + k := by
+  omega
+theorem Nat.ro_lo_1 (u w v k₁ k₂ : Nat) : u ≤ w + k₁ → w + k₂ ≤ v → u ≤ v + (k₁ - k₂) := by
+  omega
+theorem Nat.ro_lo_2 (u w v k₁ k₂ : Nat) : isLt k₁ k₂ = true → u ≤ w + k₁ → w + k₂ ≤ v → u + (k₂ - k₁) ≤ v := by
+  simp [isLt]; omega
+theorem Nat.ro_ro (u w v k₁ k₂ : Nat) : u ≤ w + k₁ → w ≤ v + k₂ → u ≤ v + (k₁ + k₂) := by
+  omega
 
-def fixedVar := 100000000 -- Any big number should work here
+/-! 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
+  simp; omega
+theorem Nat.of_lo_eq_false (u v k : Nat) : ((u + k ≤ v) = False) → v ≤ u + (k-1) := by
+  simp; omega
+theorem Nat.of_ro_eq_false (u v k : Nat) : ((u ≤ v + k) = False) → v + (k+1) ≤ u := by
+  simp; omega
 
-def Var.denote (ctx : Context) (v : Var) : Nat :=
-  bif v == fixedVar then 1 else ctx.get v
+/-! 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
+  simp [isLt]; omega
+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
 
-structure Cnstr where
-  x : Var
-  y : Var
-  k : Nat  := 0
-  l : Bool := true
-  deriving Repr, DecidableEq, Inhabited
+/-! 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
 
-def Cnstr.denote (c : Cnstr) (ctx : Context) : Prop :=
-  if c.l then
-    c.x.denote ctx + c.k ≤ c.y.denote ctx
-  else
-    c.x.denote ctx ≤ c.y.denote ctx + c.k
+/-!
+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
 
-def trivialCnstr : Cnstr := { x := 0, y := 0, k := 0, l := true }
+/-!
+Helper theorems for equality propagation
+-/
 
-@[simp] theorem denote_trivial (ctx : Context) : trivialCnstr.denote ctx := by
-  simp [Cnstr.denote, trivialCnstr]
+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
 
-def Cnstr.trans (c₁ c₂ : Cnstr) : Cnstr :=
-  if c₁.y = c₂.x then
-    let { x, k := k₁, l := l₁, .. } := c₁
-    let { y, k := k₂, l := l₂, .. } := c₂
-    match l₁, l₂ with
-    | false, false =>
-      { x, y, k := k₁ + k₂, l := false }
-    | false, true =>
-      if k₁ < k₂ then
-        { x, y, k := k₂ - k₁, l := true }
-      else
-        { x, y, k := k₁ - k₂, l := false }
-    | true, false =>
-      if k₁ < k₂ then
-        { x, y, k := k₂ - k₁, l := false }
-      else
-        { x, y, k := k₁ - k₂, l := true }
-    | true, true =>
-      { x, y, k := k₁ + k₂, l := true }
-  else
-    trivialCnstr
-
-@[simp] theorem Cnstr.denote_trans_easy (ctx : Context) (c₁ c₂ : Cnstr) (h : c₁.y ≠ c₂.x) : (c₁.trans c₂).denote ctx := by
-  simp [*, Cnstr.trans]
-
-@[simp] theorem Cnstr.denote_trans (ctx : Context) (c₁ c₂ : Cnstr) : c₁.denote ctx → c₂.denote ctx → (c₁.trans c₂).denote ctx := by
-  by_cases c₁.y = c₂.x
-  case neg => simp [*]
-  simp [trans, *]
-  let { x, k := k₁, l := l₁, .. } := c₁
-  let { y, k := k₂, l := l₂, .. } := c₂
-  simp_all; split
-  · simp [denote]; omega
-  · split <;> simp [denote] <;> omega
-  · split <;> simp [denote] <;> omega
-  · simp [denote]; omega
-
-def Cnstr.isTrivial (c : Cnstr) : Bool := c.x == c.y && c.k == 0
-
-theorem Cnstr.of_isTrivial (ctx : Context) (c : Cnstr) : c.isTrivial = true → c.denote ctx := by
-  cases c; simp [isTrivial]; intros; simp [*, denote]
-
-def Cnstr.isFalse (c : Cnstr) : Bool := c.x == c.y && c.k != 0 && c.l == true
-
-theorem Cnstr.of_isFalse (ctx : Context) {c : Cnstr} : c.isFalse = true → ¬c.denote ctx := by
-  cases c; simp [isFalse]; intros; simp [*, denote]; omega
-
-def Cnstrs := List Cnstr
-
-def Cnstrs.denoteAnd' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : Prop :=
-  match c₂ with
-  | [] => c₁.denote ctx
-  | c::cs => c₁.denote ctx ∧ Cnstrs.denoteAnd' ctx c cs
-
-theorem Cnstrs.denote'_trans (ctx : Context) (c₁ c : Cnstr) (cs : Cnstrs) : c₁.denote ctx → denoteAnd' ctx c cs → denoteAnd' ctx (c₁.trans c) cs := by
-  induction cs
-  next => simp [denoteAnd', *]; apply Cnstr.denote_trans
-  next c cs ih => simp [denoteAnd']; intros; simp [*]
-
-def Cnstrs.trans' (c₁ : Cnstr) (c₂ : Cnstrs) : Cnstr :=
-  match c₂ with
-  | [] => c₁
-  | c::c₂ => trans' (c₁.trans c) c₂
-
-@[simp] theorem Cnstrs.denote'_trans' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : denoteAnd' ctx c₁ c₂ → (trans' c₁ c₂).denote ctx := by
-  induction c₂ generalizing c₁
-  next => intros; simp_all [trans', denoteAnd']
-  next c cs ih => simp [denoteAnd']; intros; simp [trans']; apply ih; apply denote'_trans <;> assumption
-
-def Cnstrs.denoteAnd (ctx : Context) (c : Cnstrs) : Prop :=
-  match c with
-  | [] => True
-  | c::cs => denoteAnd' ctx c cs
-
-def Cnstrs.trans (c : Cnstrs) : Cnstr :=
-  match c with
-  | []    => trivialCnstr
-  | c::cs => trans' c cs
-
-theorem Cnstrs.of_denoteAnd_trans {ctx : Context} {c : Cnstrs} : c.denoteAnd ctx → c.trans.denote ctx := by
-  cases c <;> simp [*, trans, denoteAnd] <;> intros <;> simp [*]
-
-def Cnstrs.isFalse (c : Cnstrs) : Bool :=
-  c.trans.isFalse
-
-theorem Cnstrs.unsat' (ctx : Context) (c : Cnstrs) : c.isFalse = true → ¬ c.denoteAnd ctx := by
-  simp [isFalse]; intro h₁ h₂
-  have := of_denoteAnd_trans h₂
-  have := Cnstr.of_isFalse ctx h₁
-  contradiction
-
-/-- `denote ctx [c_1, ..., c_n] C` is `c_1.denote ctx → ... → c_n.denote ctx → C` -/
-def Cnstrs.denote (ctx : Context) (cs : Cnstrs) (C : Prop) : Prop :=
-  match cs with
-  | [] => C
-  | c::cs => c.denote ctx → denote ctx cs C
-
-theorem Cnstrs.not_denoteAnd'_eq (ctx : Context) (c : Cnstr) (cs : Cnstrs) (C : Prop) : (denoteAnd' ctx c cs → C) = denote ctx (c::cs) C := by
-  simp [denote]
-  induction cs generalizing c
-  next => simp [denoteAnd', denote]
-  next c' cs ih =>
-    simp [denoteAnd', denote, *]
-
-theorem Cnstrs.not_denoteAnd_eq (ctx : Context) (cs : Cnstrs) (C : Prop) : (denoteAnd ctx cs → C) = denote ctx cs C := by
-  cases cs
-  next => simp [denoteAnd, denote]
-  next c cs => apply not_denoteAnd'_eq
-
-def Cnstr.isImpliedBy (cs : Cnstrs) (c : Cnstr) : Bool :=
-  cs.trans == c
-
-/-! Main theorems used by `grind`. -/
-
-/-- Auxiliary theorem used by `grind` to prove that a system of offset inequalities is unsatisfiable. -/
-theorem Cnstrs.unsat (ctx : Context) (cs : Cnstrs) : cs.isFalse = true → cs.denote ctx False := by
-  intro h
-  rw [← not_denoteAnd_eq]
-  apply unsat'
-  assumption
-
-/-- Auxiliary theorem used by `grind` to prove an implied offset inequality. -/
-theorem Cnstrs.imp (ctx : Context) (cs : Cnstrs) (c : Cnstr) (h : c.isImpliedBy cs = true)  : cs.denote ctx (c.denote ctx) := by
-  rw [← eq_of_beq h]
-  rw [← not_denoteAnd_eq]
-  apply of_denoteAnd_trans
-
-end Lean.Grind.Offset
+end Lean.Grind

src/Init/Grind/PP.lean

@@ -0,0 +1,30 @@
+/-
+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

@@ -25,7 +25,7 @@ Passed to `grind` using, for example, the `grind (config := { matchEqs := true }
 -/
 structure Config where
   /-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
-  splits : Nat := 5
+  splits : Nat := 8
   /-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
   ematch : Nat := 5
   /--

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/Lean/AddDecl.lean

@@ -21,11 +21,6 @@ def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration
   else
     addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
 
-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
     withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do

src/Lean/Compiler/InitAttr.lean

@@ -144,11 +144,7 @@ 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 }
-  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
+  addAndCompile decl
+  IO.ofExcept (setBuiltinInitAttr (← getEnv) name) >>= setEnv
 
 end Lean

src/Lean/Compiler/LCNF/MonoTypes.lean

@@ -74,8 +74,6 @@ 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/Old.lean

@@ -53,18 +53,3 @@ 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,13 +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 KernelException 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 (← getEnv).compileDecl opts decl
+    return compileDeclsOld (← getEnv) opts decls
   match res with
   | Except.ok env => setEnv env
   | Except.error (KernelException.other msg) =>
@@ -533,7 +536,7 @@ def compileDecls (decls : List Name) : CoreM Unit := do
   let opts ← getOptions
   if compiler.enableNew.get opts then
     compileDeclsNew decls
-  match (← getEnv).compileDecls opts decls with
+  match compileDeclsOld (← getEnv) opts decls with
   | Except.ok env   => setEnv env
   | Except.error (KernelException.other msg) =>
     throwError msg

src/Lean/Data/AssocList.lean

@@ -24,7 +24,7 @@ abbrev empty : AssocList α β :=
 
 instance : EmptyCollection (AssocList α β) := ⟨empty⟩
 
-abbrev insert (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
+abbrev insertNew (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
   m.cons k v
 
 def isEmpty : AssocList α β → Bool
@@ -77,6 +77,12 @@ def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β
     | true  => cons a b es
     | false => cons k v (replace a b es)
 
+def insert [BEq α] (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
+  if m.contains k then
+    m.replace k v
+  else
+    m.insertNew k v
+
 def erase [BEq α] (a : α) : AssocList α β → AssocList α β
   | nil         => nil
   | cons k v es => match k == a with

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 Name := do
+private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := 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 Name := do
+  go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
     let resultType ← instantiateMVars resultType
     let resultTypeFn := resultType.cleanupAnnotations.getAppFn
     try
@@ -1497,9 +1497,12 @@ 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
-      unless (← getEnv).contains idNew do
+      if (← getEnv).contains idNew then
+        mkConst idNew
+      else if let some (fvar, []) ← resolveLocalName idNew then
+        return fvar
+      else
         throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
-      return idNew
     catch
       | ex@(.error ..) =>
         match (← unfoldDefinition? resultType) with
@@ -1548,7 +1551,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 ← mkConst (← resolveDotName id expectedType?)
+        let fConst ← 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/Import.lean

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
 -/
 prelude
 import Lean.Parser.Module
-import Lean.Data.Json
+import Lean.Util.Paths
 
 namespace Lean.Elab
 
@@ -42,4 +42,12 @@ 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/Tactic/BVDecide/Frontend/Normalize.lean

@@ -4,342 +4,28 @@ 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.Attr
-import Std.Tactic.BVDecide.Normalize
-import Std.Tactic.BVDecide.Syntax
+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
 
 /-!
-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.
+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.
 -/
 
 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
-  }
-
-/--
-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]
+def passPipeline : PreProcessM (List Pass) := do
+  let mut passPipeline := [rewriteRulesPass]
+  let cfg ← PreProcessM.getConfig
 
   if cfg.acNf then
     passPipeline := passPipeline ++ [acNormalizePass]
@@ -348,18 +34,20 @@ def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
     passPipeline := passPipeline ++ [andFlatteningPass]
 
   if cfg.embeddedConstraintSubst then
-    passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
+    passPipeline := passPipeline ++ [embeddedConstraintPass]
 
   return passPipeline
 
-end Pass
-
 def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
-  withTraceNode `bv (fun _ => return "Normalizing goal") do
-    -- Contradiction proof
+  withTraceNode `bv (fun _ => return "Preprocessing goal") do
+    (go g).run cfg
+where
+  go (g : MVarId) : PreProcessM (Option MVarId) := do
     let some g ← g.falseOrByContra | return none
+
     trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
-    Pass.fixpointPipeline (Pass.passPipeline cfg) g
+    let pipeline ← passPipeline
+    Pass.fixpointPipeline pipeline g
 
 @[builtin_tactic Lean.Parser.Tactic.bvNormalize]
 def evalBVNormalize : Tactic := fun

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

@@ -0,0 +1,39 @@
+/-
+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

@@ -0,0 +1,86 @@
+/-
+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
+
+/--
+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)
+
+
+end Frontend.Normalize
+end Lean.Elab.Tactic.BVDecide

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

@@ -0,0 +1,67 @@
+/-
+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
+
+abbrev PreProcessM : Type → Type := ReaderT BVDecideConfig MetaM
+
+namespace PreProcessM
+
+def getConfig : PreProcessM BVDecideConfig := read
+
+def run (cfg : BVDecideConfig) (x : PreProcessM α) : MetaM α :=
+  ReaderT.run x cfg
+
+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

@@ -0,0 +1,62 @@
+/-
+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
+        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 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

@@ -0,0 +1,47 @@
+/-
+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 ← goal.getNondepPropHyps
+    let ⟨result?, _⟩ ← simpGoal goal
+      (ctx := simpCtx)
+      (simprocs := #[bvSimprocs, sevalSimprocs])
+      (fvarIdsToSimp := hyps)
+    let some (_, newGoal) := result? | return none
+    return newGoal
+
+end Frontend.Normalize
+end Lean.Elab.Tactic.BVDecide

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

@@ -0,0 +1,164 @@
+/-
+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/Grind.lean

@@ -35,9 +35,9 @@ def elabGrindPattern : CommandElab := fun stx => do
   | _ => throwUnsupportedSyntax
 
 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}"
+  let goals ← Grind.main mvarId config mainDeclName fallback
+  unless goals.isEmpty do
+    throwError "`grind` failed\n{← Grind.goalsToMessageData goals}"
 
 private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
   let some fallback := fallback? | return (pure ())

src/Lean/Meta/AppBuilder.lean

@@ -11,14 +11,14 @@ import Lean.Meta.DecLevel
 
 namespace Lean.Meta
 
-/-- Return `id e` -/
+/-- Returns `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`, return
+  Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, returns
   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]
 
-/-- Return `a = b`. -/
+/-- Returns `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
 
-/-- Return `HEq a b`. -/
+/-- Returns `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, return `Eq a b`, otherwise return `HEq a b`.
+  If `a` and `b` have definitionally equal types, returns `Eq a b`, otherwise returns `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
 
-/-- Return a proof of `a = a`. -/
+/-- Returns 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
 
-/-- Return a proof of `HEq a a`. -/
+/-- Returns 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`, return an instance of type `e`. -/
+/-- Given `h : False`, returns 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`, return `a`.
+If `e` is `@Eq.refl α a`, returns `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`, return `α`, `f` and `h`.
+If `e` is `@congrArg α β a b f h`, returns `α`, `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,13 +336,14 @@ private def withAppBuilderTrace [ToMessageData α] [ToMessageData β]
       throw ex
 
 /--
-  Return the application `constName xs`.
+  Returns 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
@@ -465,8 +466,9 @@ 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
@@ -520,11 +522,11 @@ def mkSome (type value : Expr) : MetaM Expr := do
   let u ← getDecLevel type
   return mkApp2 (mkConst ``Option.some [u]) type value
 
-/-- Return `Decidable.decide p` -/
+/-- Returns `Decidable.decide p` -/
 def mkDecide (p : Expr) : MetaM Expr :=
   mkAppOptM ``Decidable.decide #[p, none]
 
-/-- Return a proof for `p : Prop` using `decide p` -/
+/-- Returns 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)
@@ -532,59 +534,75 @@ def mkDecideProof (p : Expr) : MetaM Expr := do
   let h         ← mkExpectedTypeHint h decEqTrue
   mkAppM ``of_decide_eq_true #[h]
 
-/-- Return `a < b` -/
+/-- Returns `a < b` -/
 def mkLt (a b : Expr) : MetaM Expr :=
   mkAppM ``LT.lt #[a, b]
 
-/-- Return `a <= b` -/
+/-- Returns `a <= b` -/
 def mkLe (a b : Expr) : MetaM Expr :=
   mkAppM ``LE.le #[a, b]
 
-/-- Return `Inhabited.default α` -/
+/-- Returns `Inhabited.default α` -/
 def mkDefault (α : Expr) : MetaM Expr :=
   mkAppOptM ``Inhabited.default #[α, none]
 
-/-- Return `@Classical.ofNonempty α _` -/
+/-- Returns `@Classical.ofNonempty α _` -/
 def mkOfNonempty (α : Expr) : MetaM Expr := do
   mkAppOptM ``Classical.ofNonempty #[α, none]
 
-/-- Return `funext h` -/
+/-- Returns `funext h` -/
 def mkFunExt (h : Expr) : MetaM Expr :=
   mkAppM ``funext #[h]
 
-/-- Return `propext h` -/
+/-- Returns `propext h` -/
 def mkPropExt (h : Expr) : MetaM Expr :=
   mkAppM ``propext #[h]
 
-/-- Return `let_congr h₁ h₂` -/
+/-- Returns `let_congr h₁ h₂` -/
 def mkLetCongr (h₁ h₂ : Expr) : MetaM Expr :=
   mkAppM ``let_congr #[h₁, h₂]
 
-/-- Return `let_val_congr b h` -/
+/-- Returns `let_val_congr b h` -/
 def mkLetValCongr (b h : Expr) : MetaM Expr :=
   mkAppM ``let_val_congr #[b, h]
 
-/-- Return `let_body_congr a h` -/
+/-- Returns `let_body_congr a h` -/
 def mkLetBodyCongr (a h : Expr) : MetaM Expr :=
   mkAppM ``let_body_congr #[a, h]
 
-/-- Return `of_eq_true h` -/
-def mkOfEqTrue (h : Expr) : MetaM Expr :=
-  mkAppM ``of_eq_true #[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
 
-/-- Return `eq_true h` -/
-def mkEqTrue (h : Expr) : MetaM Expr :=
-  mkAppM ``eq_true #[h]
+/-- Returns `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` -/
+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
 
 /--
-  Return `eq_false h`
+  Returns `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]
 
 /--
-  Return `eq_false' h`
+  Returns `eq_false' h`
   `h` must have type definitionally equal to `p → False` in the current
   reducibility setting. -/
 def mkEqFalse' (h : Expr) : MetaM Expr :=
@@ -602,7 +620,7 @@ def mkImpDepCongrCtx (h₁ h₂ : Expr) : MetaM Expr :=
 def mkForallCongr (h : Expr) : MetaM Expr :=
   mkAppM ``forall_congr #[h]
 
-/-- Return instance for `[Monad m]` if there is one -/
+/-- Returns instance for `[Monad m]` if there is one -/
 def isMonad? (m : Expr) : MetaM (Option Expr) :=
   try
     let monadType ← mkAppM `Monad #[m]
@@ -613,52 +631,52 @@ def isMonad? (m : Expr) : MetaM (Option Expr) :=
   catch _ =>
     pure none
 
-/-- Return `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
+/-- Returns `(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
 
 /--
-  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.
-  -/
+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.
+-/
 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
 
-/-- Return `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
+/-- Returns `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
 
-/-- Return `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
+/-- Returns `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
 
-/-- Return `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
+/-- Returns `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
 
 /--
-  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.
-  -/
+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.
+-/
 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
 
-/-- Return `a ≤ b`. This method assumes `a` and `b` have the same type. -/
+/-- Returns `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
 
-/-- Return `a < b`. This method assumes `a` and `b` have the same type. -/
+/-- Returns `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`, return a proof for `a ↔ b`. -/
+/-- Given `h : a = b`, returns a proof for `a ↔ b`. -/
 def mkIffOfEq (h : Expr) : MetaM Expr := do
   if h.isAppOfArity ``propext 3 then
     return h.appArg!

src/Lean/Meta/Basic.lean

@@ -1964,15 +1964,22 @@ def sortFVarIds (fvarIds : Array FVarId) : MetaM (Array FVarId) := do
 
 end Methods
 
+/--
+Return `some info` if `declName` is an inductive predicate where `info : InductiveVal`.
+That is, `inductive` type in `Prop`.
+-/
+def isInductivePredicate? (declName : Name) : MetaM (Option InductiveVal) := do
+  match (← getEnv).find? declName with
+  | some (.inductInfo info) =>
+    forallTelescopeReducing info.type fun _ type => do
+      match (← whnfD type) with
+      | .sort u .. => if u == levelZero then return some info else return none
+      | _ => return none
+  | _ => return none
+
 /-- Return `true` if `declName` is an inductive predicate. That is, `inductive` type in `Prop`. -/
 def isInductivePredicate (declName : Name) : MetaM Bool := do
-  match (← getEnv).find? declName with
-  | some (.inductInfo { type := type, ..}) =>
-    forallTelescopeReducing type fun _ type => do
-      match (← whnfD type) with
-      | .sort u .. => return u == levelZero
-      | _ => return false
-  | _ => return false
+  return (← isInductivePredicate? declName).isSome
 
 def isListLevelDefEqAux : List Level → List Level → MetaM Bool
   | [],    []    => return true

src/Lean/Meta/Tactic/FVarSubst.lean

@@ -35,7 +35,7 @@ def insert (s : FVarSubst) (fvarId : FVarId) (v : Expr) : FVarSubst :=
   if s.contains fvarId then s
   else
     let map := s.map.mapVal fun e => e.replaceFVarId fvarId v;
-    { map := map.insert fvarId v }
+    { map := map.insertNew fvarId v }
 
 def erase (s : FVarSubst) (fvarId : FVarId) : FVarSubst :=
   { map := s.map.erase fvarId }

src/Lean/Meta/Tactic/Grind.lean

@@ -24,6 +24,7 @@ import Lean.Meta.Tactic.Grind.EMatchTheorem
 import Lean.Meta.Tactic.Grind.EMatch
 import Lean.Meta.Tactic.Grind.Main
 import Lean.Meta.Tactic.Grind.CasesMatch
+import Lean.Meta.Tactic.Grind.Arith
 
 namespace Lean
 
@@ -42,6 +43,14 @@ builtin_initialize registerTraceClass `grind.simp
 builtin_initialize registerTraceClass `grind.split
 builtin_initialize registerTraceClass `grind.split.candidate
 builtin_initialize registerTraceClass `grind.split.resolved
+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
@@ -54,4 +63,6 @@ builtin_initialize registerTraceClass `grind.debug.final
 builtin_initialize registerTraceClass `grind.debug.forallPropagator
 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
 end Lean

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

@@ -0,0 +1,10 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Arith.Util
+import Lean.Meta.Tactic.Grind.Arith.Types
+import Lean.Meta.Tactic.Grind.Arith.Offset
+import Lean.Meta.Tactic.Grind.Arith.Main

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

@@ -0,0 +1,14 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Arith.Offset
+
+namespace Lean.Meta.Grind.Arith
+
+def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
+  Offset.internalize e parent?
+
+end Lean.Meta.Grind.Arith

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

@@ -0,0 +1,14 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Arith.Offset
+
+namespace Lean.Meta.Grind.Arith
+
+def checkInvariants : GoalM Unit :=
+  Offset.checkInvariants
+
+end Lean.Meta.Grind.Arith

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

@@ -0,0 +1,34 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.PropagatorAttr
+import Lean.Meta.Tactic.Grind.Arith.Offset
+
+namespace Lean.Meta.Grind.Arith
+
+namespace Offset
+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)
+
+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
+
+end Offset
+
+builtin_grind_propagator propagateLE ↓LE.le := fun e => do
+  if (← isEqTrue e) then
+    if let some c ← Offset.isCnstr? e then
+      Offset.assertTrue c (← mkEqTrueProof e)
+  if (← isEqFalse e) then
+    if let some c ← Offset.isCnstr? e then
+      Offset.assertFalse c (← mkEqFalseProof e)
+
+end Lean.Meta.Grind.Arith

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

@@ -0,0 +1,46 @@
+/-
+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

@@ -0,0 +1,335 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Init.Grind.Offset
+import Lean.Meta.Tactic.Grind.Types
+import Lean.Meta.Tactic.Grind.Arith.ProofUtil
+
+namespace Lean.Meta.Grind.Arith.Offset
+/-!
+This module implements a decision procedure for offset constraints of the form:
+```
+x + k ≤ y
+x ≤ y + k
+```
+where `k` is a numeral.
+Each constraint is represented as an edge in a weighted graph.
+The constraint `x + k ≤ y` is represented as a negative edge.
+The shortest path between two nodes in the graph corresponds to an implied inequality.
+When adding a new edge, the state is considered unsatisfiable if the new edge creates a negative cycle.
+An incremental Floyd-Warshall algorithm is used to find the shortest paths between all nodes.
+This module can also handle offset equalities of the form `x + k = y` by representing them with two edges:
+```
+x + k ≤ y
+y ≤ x + k
+```
+The main advantage of this module over a full linear integer arithmetic procedure is
+its ability to efficiently detect all implied equalities and inequalities.
+-/
+
+def get' : GoalM State := do
+  return (← get).arith.offset
+
+@[inline] def modify' (f : State → State) : GoalM Unit := do
+  modify fun s => { s with arith.offset := f s.arith.offset }
+
+def mkNode (expr : Expr) : GoalM NodeId := do
+  if let some nodeId := (← get').nodeMap.find? { expr } then
+    return nodeId
+  let nodeId : NodeId := (← get').nodes.size
+  trace[grind.offset.internalize.term] "{expr} ↦ #{nodeId}"
+  modify' fun s => { s with
+    nodes   := s.nodes.push expr
+    nodeMap := s.nodeMap.insert { expr } nodeId
+    sources := s.sources.push {}
+    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
+  go (← getProof? u v).get!
+where
+  go (p : ProofInfo) : GoalM Expr := do
+    if u == p.w then
+      return p.proof
+    else
+      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)
+
+/-- 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})}"
+  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
+  }
+
+private def setProof (u v : NodeId) (p : ProofInfo) : GoalM Unit := do
+  modify' fun s => { s with
+    proofs := s.proofs.modify u fun es => es.insert v p
+  }
+
+@[inline]
+private def forEachSourceOf (u : NodeId) (f : NodeId → Int → GoalM Unit) : GoalM Unit := do
+  (← get').sources[u]!.forM f
+
+@[inline]
+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
+    if k'+k < 0 then
+      setUnsat u v k p k'
+      return ()
+  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
+    forEachTargetOf v fun j k₂ => do
+      /- Check whether new path: `u -(k)-> v -(k₂)-> j` is shorter -/
+      updateIfShorter u j (k+k₂) v
+    forEachSourceOf u fun i k₁ => do
+      /- Check whether new path: `i -(k₁)-> u -(k)-> v` is shorter -/
+      updateIfShorter i v (k₁+k) u
+      forEachTargetOf v fun j k₂ => do
+        /- 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
+    for (v, k) in es 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]!
+  if c.k == 0 then
+    return mkNatLE u v
+  else if c.k < 0 then
+    return mkNatLE (mkNatAdd u (Lean.toExpr ((-c.k).toNat))) v
+  else
+    return mkNatLE u (mkNatAdd v (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 }
+      trace[grind.debug.offset] "{c}"
+      let p ← mkProofForPath u v
+      trace[grind.debug.offset.proof] "{p} : {← inferType p}"
+      check p
+      unless (← withDefault <| isDefEq (← inferType p) (← Cnstr.toExpr c)) do
+        trace[grind.debug.offset.proof] "failed: {← inferType p} =?= {← Cnstr.toExpr c}"
+        unreachable!
+
+end Lean.Meta.Grind.Arith.Offset

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

@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Init.Grind.Offset
+import Init.Grind.Lemmas
+import Lean.Meta.Tactic.Grind.Types
+
+namespace Lean.Meta.Grind.Arith
+
+/-!
+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
+
+open Lean.Grind in
+/--
+Assume `pi₁` is `{ w := u, k := k₁, proof := p₁ }` and `pi₂` is `{ w := w, k := k₂, proof := p₂ }`
+`p₁` is the proof for edge `u -(k₁) → w` and `p₂` the proof for edge `w -(k₂)-> v`.
+Then, this function returns a proof for edge `u -(k₁+k₂) -> v`.
+-/
+def mkTrans (nodes : PArray Expr) (pi₁ : ProofInfo) (pi₂ : ProofInfo) (v : NodeId) : ProofInfo :=
+  let { w := u, k := k₁, proof := p₁ } := pi₁
+  let { w, k := k₂, proof := p₂ } := pi₂
+  let u := nodes[u]!
+  let w := nodes[w]!
+  let v := nodes[v]!
+  let p := if k₁ == 0 then
+    if k₂ == 0 then
+      -- u ≤ w, w ≤ v
+      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₂
+    else
+      let k₂ := - k₂
+      -- u ≤ w, w + k₂ ≤ v
+      mkApp6 (mkConst ``Nat.le_lo) u w v (toExprN k₂) 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₂
+    else if k₂ < 0 then
+      let k₂ := -k₂
+      mkApp7 (mkConst ``Nat.lo_lo) u w v (toExprN k₁) (toExprN k₂) p₁ p₂
+    else
+      let ke₁ := toExprN k₁
+      let ke₂ := toExprN k₂
+      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₁
+    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₂
+       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₂
+      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]!
+  if c.k == 0 then
+    mkApp3 (mkConst ``Nat.of_le_eq_false) u v h
+  else if c.k == -1 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
+  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
+
+end Offset
+
+end Lean.Meta.Grind.Arith

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

@@ -0,0 +1,66 @@
+/-
+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.Data.PersistentArray
+import Lean.Meta.Tactic.Grind.ENodeKey
+import Lean.Meta.Tactic.Grind.Arith.Util
+
+namespace Lean.Meta.Grind.Arith
+
+namespace Offset
+
+abbrev NodeId := Nat
+
+instance : ToMessageData (Offset.Cnstr NodeId) where
+  toMessageData c := Offset.toMessageData (α := NodeId) (inst := { toMessageData n := m!"#{n}" }) c
+
+/-- Auxiliary structure used for proof extraction.  -/
+structure ProofInfo where
+  w     : NodeId
+  k     : Int
+  proof : Expr
+  deriving Inhabited
+
+/-- 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)) := {}
+  /--
+  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) := {}
+  /--
+  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) := {}
+  /--
+  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) := {}
+  deriving Inhabited
+
+end Offset
+
+/-- State for the arithmetic procedures. -/
+structure State where
+  offset : Offset.State := {}
+  deriving Inhabited
+
+end Lean.Meta.Grind.Arith

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

@@ -0,0 +1,102 @@
+/-
+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.Expr
+import Lean.Message
+
+namespace Lean.Meta.Grind.Arith
+
+/-- Returns `true` if `e` is of the form `Nat` -/
+def isNatType (e : Expr) : Bool :=
+  e.isConstOf ``Nat
+
+/-- Returns `true` if `e` is of the form `@instHAdd Nat instAddNat` -/
+def isInstAddNat (e : Expr) : Bool :=
+  let_expr instHAdd a b := e | false
+  isNatType a && b.isConstOf ``instAddNat
+
+/-- Returns `true` if `e` is `instLENat` -/
+def isInstLENat (e : Expr) : Bool :=
+  e.isConstOf ``instLENat
+
+/--
+Returns `some (a, b)` if `e` is of the form
+```
+@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) a b
+```
+-/
+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
+  let_expr instOfNatNat k := inst | none
+  let .lit (.natVal k) := k | none
+  some k
+
+/-- Returns `some (a, k)` if `e` is of the form `a + k`.  -/
+def isNatOffset? (e : Expr) : Option (Expr × Nat) := Id.run do
+  let some (a, b) := isNatAdd? e | none
+  let some k := isNatNum? b | none
+  some (a, k)
+
+/-- An offset constraint. -/
+structure Offset.Cnstr (α : Type) where
+  u  : α
+  v  : α
+  k  : Int := 0
+  deriving Inhabited
+
+def Offset.Cnstr.neg : Cnstr α → Cnstr α
+  | { u, v, k } => { u := v, v := u, 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}"
+
+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) :=
+  match_expr e with
+  | LE.le _ inst a b => if isInstLENat inst then go a b 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 }
+    else
+      some { u, v }
+
+end Lean.Meta.Grind.Arith

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

@@ -85,6 +85,8 @@ def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : State
       -- 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.debug.canon] "found {e} ===> {c}"
       return c

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

@@ -10,6 +10,7 @@ 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
@@ -86,6 +87,26 @@ 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
@@ -118,7 +139,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, {← ppState}"
+  trace_goal[grind.debug] "after addEqStep, {← (← get).ppState}"
   checkInvariants
 where
   go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
@@ -141,31 +162,32 @@ where
     updateRoots lhs rhsNode.root
     trace_goal[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
     reinsertParents parents
+    propagateEqcDown lhs
     setENode lhsNode.root { (← getENode lhsRoot.self) with -- We must retrieve `lhsRoot` since it was updated.
       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
-    let rec loop (e : Expr) : GoalM Unit := do
-      let n ← getENode e
-      setENode e { n with root := rootNew }
+    traverseEqc lhs fun n =>
+      setENode n.self { n with root := rootNew }
+
+  propagateEqcDown (lhs : Expr) : GoalM Unit := do
+    traverseEqc lhs fun n =>
       unless (← isInconsistent) do
-        propagateDown e
-      if isSameExpr lhs n.next then return ()
-      loop n.next
-    loop lhs
+        propagateDown n.self
 
 /-- Ensures collection of equations to be processed is empty. -/
 private def resetNewEqs : GoalM Unit :=
@@ -192,22 +214,28 @@ where
     processTodo
 
 /-- Adds a new equality `lhs = rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
-def addEq (lhs rhs proof : Expr) : GoalM Unit := do
+private 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. -/
-def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
+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 }
+
 /-- Internalizes `lhs` and `rhs`, and then adds equality `lhs = rhs`. -/
 def addNewEq (lhs rhs proof : Expr) (generation : Nat) : GoalM Unit := do
-  internalize lhs generation
-  internalize rhs generation
+  let eq ← mkEq lhs rhs
+  storeFact eq
+  internalize lhs generation eq
+  internalize rhs generation eq
   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
@@ -217,22 +245,30 @@ def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
 where
   go (p : Expr) (isNeg : Bool) : GoalM Unit := do
     match_expr p with
-    | Eq _ lhs rhs => goEq p lhs rhs isNeg false
-    | HEq _ lhs _ rhs => goEq p lhs rhs isNeg true
-    | _ =>
-      internalize p generation
-      if isNeg then
-        addEq p (← getFalseExpr) (← mkEqFalse proof)
+    | Eq α lhs rhs =>
+      if α.isProp then
+        -- It is morally an iff.
+        -- We do not use the `goEq` optimization because we want to register `p` as a case-split
+        goFact p isNeg
       else
-        addEq p (← getTrueExpr) (← mkEqTrue proof)
+        goEq p lhs rhs isNeg false
+    | HEq _ lhs _ rhs => goEq p lhs rhs isNeg true
+    | _ => goFact p isNeg
+
+  goFact (p : Expr) (isNeg : Bool) : GoalM Unit := do
+    internalize p generation
+    if isNeg then
+      addEq p (← getFalseExpr) (← mkEqFalse proof)
+    else
+      addEq p (← getTrueExpr) (← mkEqTrue proof)
 
   goEq (p : Expr) (lhs rhs : Expr) (isNeg : Bool) (isHEq : Bool) : GoalM Unit := do
     if isNeg then
       internalize p generation
       addEq p (← getFalseExpr) (← mkEqFalse proof)
     else
-      internalize lhs generation
-      internalize rhs generation
+      internalize lhs generation p
+      internalize rhs generation p
       addEqCore lhs rhs proof isHEq
 
 /-- Adds a new hypothesis. -/

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

@@ -170,11 +170,43 @@ private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTh
     initial  := {}
   }
 
+/--
+Symbols with built-in support in `grind` are unsuitable as pattern candidates for E-matching.
+This is because `grind` performs normalization operations and uses specialized data structures
+to implement these symbols, which may interfere with E-matching behavior.
+-/
 -- TODO: create attribute?
 private def forbiddenDeclNames := #[``Eq, ``HEq, ``Iff, ``And, ``Or, ``Not]
 
 private def isForbidden (declName : Name) := forbiddenDeclNames.contains declName
 
+/--
+Auxiliary function to expand a pattern containing forbidden application symbols
+into a multi-pattern.
+
+This function enhances the usability of the `[grind =]` attribute by automatically handling
+forbidden pattern symbols. For example, consider the following theorem tagged with this attribute:
+```
+getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a]
+```
+Here, the selected pattern is `xs.getLast? = some a`, but `Eq` is a forbidden pattern symbol.
+Instead of producing an error, this function converts the pattern into a multi-pattern,
+allowing the attribute to be used conveniently.
+
+The function recursively expands patterns with forbidden symbols by splitting them
+into their sub-components. If the pattern does not contain forbidden symbols,
+it is returned as-is.
+-/
+partial def splitWhileForbidden (pat : Expr) : List Expr :=
+  match_expr pat with
+  | Not p => splitWhileForbidden p
+  | And p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
+  | Or p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
+  | Eq _ lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
+  | Iff lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
+  | HEq _ lhs _ rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
+  | _ => [pat]
+
 private def dontCare := mkConst (Name.mkSimple "[grind_dontcare]")
 
 def mkGroundPattern (e : Expr) : Expr :=
@@ -468,7 +500,8 @@ def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof :
       | _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
     let pat := if useLhs then lhs else rhs
     let pat ← preprocessPattern pat normalizePattern
-    return (xs.size, [pat.abstract xs])
+    let pats := splitWhileForbidden (pat.abstract xs)
+    return (xs.size, pats)
   mkEMatchTheoremCore origin levelParams numParams proof patterns
 
 /--

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

@@ -0,0 +1,30 @@
+/-
+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.Expr
+
+namespace Lean.Meta.Grind
+
+@[inline] def isSameExpr (a b : Expr) : Bool :=
+  -- It is safe to use pointer equality because we hashcons all expressions
+  -- inserted into the E-graph
+  unsafe ptrEq a b
+
+/--
+Key for the `ENodeMap` and `ParentMap` map.
+We use pointer addresses and rely on the fact all internalized expressions
+have been hash-consed, i.e., we have applied `shareCommon`.
+-/
+structure ENodeKey where
+  expr : Expr
+
+instance : Hashable ENodeKey where
+  hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
+
+instance : BEq ENodeKey where
+  beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
+
+end Lean.Meta.Grind

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

@@ -24,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 (mkApp2 (mkConst ``of_eq_true) p h₁)
+    let qh₁ := q.instantiate1 (mkOfEqTrueCore p h₁)
     let r ← simp qh₁
     let q := mkLambda n bi p q
     let q' := r.expr
@@ -65,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 := mkApp2 (mkConst ``of_eq_true) e proof
+  let proof := mkOfEqTrueCore 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

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

@@ -11,6 +11,7 @@ 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.Arith.Internalize
 
 namespace Lean.Meta.Grind
 
@@ -53,12 +54,20 @@ private def addSplitCandidate (e : Expr) : GoalM Unit := do
 -- TODO: add attribute to make this extensible
 private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
 
+/-- Returns `true` if `e` is of the form `@Eq Prop a b` -/
+def isMorallyIff (e : Expr) : Bool :=
+  let_expr Eq α _ _ := e | false
+  α.isProp
+
 /-- Inserts `e` into the list of case-split candidates if applicable. -/
 private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
   unless e.isApp do return ()
   if (← getConfig).splitIte && (e.isIte || e.isDIte) then
     addSplitCandidate e
     return ()
+  if isMorallyIff e then
+    addSplitCandidate e
+    return ()
   if (← getConfig).splitMatch then
     if (← isMatcherApp e) then
       if let .reduced _ ← reduceMatcher? e then
@@ -96,7 +105,7 @@ private partial def internalizePattern (pattern : Expr) (generation : Nat) : Goa
     return pattern
   else if let some e := groundPattern? pattern then
     let e ← shareCommon (← canon (← normalizeLevels (← unfoldReducible e)))
-    internalize e generation
+    internalize e generation none
     return mkGroundPattern e
   else pattern.withApp fun f args => do
     return mkAppN f (← args.mapM (internalizePattern · generation))
@@ -137,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) : GoalM Unit := do
+partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr := none) : GoalM Unit := do
   if (← alreadyInternalized e) then return ()
   trace_goal[grind.internalize] "{e}"
   match e with
@@ -148,10 +157,10 @@ partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
   | .forallE _ d b _ =>
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
     if (← isProp d <&&> isProp e) then
-      internalize d generation
+      internalize d generation e
       registerParent e d
       unless b.hasLooseBVars do
-        internalize b generation
+        internalize b generation e
         registerParent e b
       propagateUp e
   | .lit .. | .const .. =>
@@ -165,6 +174,7 @@ partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
     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
@@ -173,21 +183,22 @@ partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
         -- We only internalize the proposition. We can skip the proof because of
         -- proof irrelevance
         let c := args[0]!
-        internalize c generation
+        internalize c generation e
         registerParent e c
       else
         if let .const fName _ := f then
           activateTheoremPatterns fName generation
         else
-          internalize f generation
+          internalize f generation e
           registerParent e f
         for h : i in [: args.size] do
           let arg := args[i]
-          internalize arg generation
+          internalize arg generation e
           registerParent e arg
       mkENode e generation
       addCongrTable e
       updateAppMap e
+      Arith.internalize e parent?
       propagateUp e
 end
 

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

@@ -25,13 +25,14 @@ private inductive IntroResult where
 private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
   let target ← goal.mvarId.getType
   if target.isArrow then
-    goal.mvarId.withContext do
+    let (r, _) ← GoalM.run goal do
+      let mvarId := (← get).mvarId
       let p := target.bindingDomain!
       if !(← isProp p) then
-        let (fvarId, mvarId) ← goal.mvarId.intro1P
-        return .newLocal fvarId { goal with mvarId }
+        let (fvarId, mvarId) ← mvarId.intro1P
+        return .newLocal fvarId { (← get) with mvarId }
       else
-        let tag ← goal.mvarId.getTag
+        let tag ← mvarId.getTag
         let q := target.bindingBody!
         -- TODO: keep applying simp/eraseIrrelevantMData/canon/shareCommon until no progress
         let r ← simp p
@@ -44,12 +45,13 @@ 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]
-            goal.mvarId.assign hNew
-            return .newHyp fvarId { goal with mvarId := mvarIdNew }
+            mvarId.assign hNew
+            return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
           | none =>
             -- `p` and `p'` are definitionally equal
-            goal.mvarId.assign h
-            return .newHyp fvarId { goal with mvarId := mvarIdNew }
+            mvarId.assign h
+            return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
+    return r
   else if target.isLet || target.isForall || target.isLetFun then
     let (fvarId, mvarId) ← goal.mvarId.intro1P
     mvarId.withContext do
@@ -61,10 +63,11 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
       else
         let goal := { goal with mvarId }
         if target.isLet || target.isLetFun then
-          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
+          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
           return .newLocal fvarId goal
         else
           return .newLocal fvarId goal

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

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Proof
+import Lean.Meta.Tactic.Grind.Arith.Inv
 
 namespace Lean.Meta.Grind
 
@@ -58,9 +59,12 @@ private def checkParents (e : Expr) : GoalM Unit := do
           found := true
           break
       -- Recall that we have support for `Expr.forallE` propagation. See `ForallProp.lean`.
-      if let .forallE _ d _ _ := parent then
+      if let .forallE _ d b _ := parent then
         if (← checkChild d) then
           found := true
+        unless b.hasLooseBVars do
+          if (← checkChild b) then
+            found := true
       unless found do
         assert! (← checkChild parent.getAppFn)
   else
@@ -100,6 +104,7 @@ def checkInvariants (expensive := false) : GoalM Unit := do
         checkEqc node
     if expensive then
       checkPtrEqImpliesStructEq
+    Arith.checkInvariants
   if expensive && grind.debug.proofs.get (← getOptions) then
     checkProofs
 

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

@@ -40,17 +40,20 @@ def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fa
   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 ← Grind.getSimprocs
   let simp ← Grind.getSimpContext
-  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
+  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr, natZExpr }
 
 private def mkGoal (mvarId : MVarId) : GrindM Goal := do
   let trueExpr ← getTrueExpr
   let falseExpr ← getFalseExpr
+  let natZeroExpr ← getNatZeroExpr
   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)
 
 private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
   mvarId.ensureProp
@@ -72,8 +75,8 @@ def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goa
 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
+def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List Goal) := do
+  let go : GrindM (List Goal) := do
     let goals ← initCore mvarId
     let goals ← simple goals
     let goals ← goals.filterMapM fun goal => do
@@ -83,7 +86,7 @@ def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallba
       if (← goal.mvarId.isAssigned) then return none
       return some goal
     trace[grind.debug.final] "{← ppGoals goals}"
-    return goals.map (·.mvarId)
+    return goals
   go.run mainDeclName config fallback
 
 end Lean.Meta.Grind

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

@@ -5,62 +5,132 @@ 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 ppENodeRef (e : Expr) : GoalM Format := do
-  let some n ← getENode? e | return "_"
-  return f!"#{n.idx}"
+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
 
 /-- Helper function for pretty printing the state for debugging purposes. -/
-def ppENodeDeclValue (e : Expr) : GoalM Format := do
+private def Goal.ppENodeDeclValue (goal : Goal) (e : Expr) : MetaM MessageData := do
   if e.isApp && !(← isLitValue e) then
     e.withApp fun f args => do
       let r ← if f.isConst then
-        ppExpr f
+        pure m!"{f}"
       else
-        ppENodeRef f
+        goal.ppENodeRef f
       let mut r := r
       for arg in args do
-        r := r ++ " " ++ (← ppENodeRef arg)
+        r := r ++ " " ++ (← goal.ppENodeRef arg)
       return r
   else
     ppExpr e
 
 /-- Helper function for pretty printing the state for debugging purposes. -/
-def ppENodeDecl (e : Expr) : GoalM Format := do
-  let mut r := f!"{← ppENodeRef e} := {← ppENodeDeclValue e}"
-  let n ← getENode e
+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
   unless isSameExpr e n.root do
-    r := r ++ f!" ↦ {← ppENodeRef n.root}"
+    r := r ++ m!" ↦ {← goal.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 ← getTarget? e then
-      r := r ++ f!" ↝ {← ppENodeRef target}"
+    if let some target := goal.getTarget? e then
+      r := r ++ m!" ↝ {← goal.ppENodeRef target}"
   return r
 
 /-- Pretty print goal state for debugging purposes. -/
-def ppState : GoalM Format := do
-  let mut r := f!"Goal:"
-  let nodes ← getENodes
+def Goal.ppState (goal : Goal) : MetaM MessageData := do
+  let mut r := m!"Goal:"
+  let nodes := goal.getENodes
   for node in nodes do
-    r := r ++ "\n" ++ (← ppENodeDecl node.self)
-  let eqcs ← getEqcs
+    r := r ++ "\n" ++ (← goal.ppENodeDecl node.self)
+  let eqcs := goal.getEqcs
   for eqc in eqcs do
     if eqc.length > 1 then
-      r := r ++ "\n" ++ "{" ++ (Format.joinSep (← eqc.mapM ppENodeRef) ", ") ++  "}"
+      r := r ++ "\n" ++ "{" ++ (MessageData.joinSep (← eqc.mapM goal.ppENodeRef) ", ") ++  "}"
   return r
 
-def ppGoals (goals : List Goal) : GrindM Format := do
-  let mut r := f!""
+def ppGoals (goals : List Goal) : MetaM MessageData := do
+  let mut r := m!""
   for goal in goals do
-    let (f, _) ← GoalM.run goal ppState
-    r := r ++ Format.line ++ f
+    let m ← goal.ppState
+    r := r ++ Format.line ++ m
   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 def ppEqcs (goal : Goal) : MetaM (Array MessageData) := do
+   let mut trueEqc?  : Option MessageData := none
+   let mut falseEqc? : Option MessageData := none
+   let mut otherEqcs : Array MessageData := #[]
+   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)) ++  "}")) #[]
+   let mut result := #[]
+   if let some trueEqc := trueEqc? then result := result.push trueEqc
+   if let some falseEqc := falseEqc? then result := result.push falseEqc
+   unless otherEqcs.isEmpty do
+     result := result.push <| .trace { cls := `eqc } "Equivalence classes" otherEqcs
+   return result
+
+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 (goal : Goal) : MetaM MessageData := do
+  let m ← goal.thms.toArray.mapM ppEMatchTheorem
+  let m := m ++ (← goal.newThms.toArray.mapM ppEMatchTheorem)
+  if m.isEmpty then
+    return ""
+  else
+    return .trace { cls := `ematch } "E-matching" m
+
+def ppOffset (goal : Goal) : MetaM MessageData := do
+  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}" #[]
+  return .trace { cls := `offset } "Assignment satisfying offset contraints" ms
+
+def goalToMessageData (goal : Goal) : MetaM MessageData := goal.mvarId.withContext do
+  let mut m : Array MessageData := #[.ofGoal goal.mvarId]
+  m := m.push <| ppExprArray `facts "Asserted facts" goal.facts.toArray `prop
+  m := m ++ (← ppEqcs goal)
+  m := m.push (← ppActiveTheorems goal)
+  m := m.push (← ppOffset goal)
+  addMessageContextFull <| MessageData.joinSep m.toList ""
+
+def goalsToMessageData (goals : List Goal) : MetaM MessageData :=
+  return MessageData.joinSep (← goals.mapM goalToMessageData) m!"\n"
+
 end Lean.Meta.Grind

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

@@ -126,32 +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 <| mkApp2 (mkConst ``eq_true) e (← mkEqProof a b)
+    pushEqTrue e <| mkEqTrueCore 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 <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
+    pushEq a b <| mkOfEqTrueCore 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 <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
+    pushEq a b <| mkOfEqTrueCore 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 <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
+    pushHEq a b <| mkOfEqTrueCore 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 <| mkApp2 (mkConst ``eq_true) e (← mkHEqProof a b)
+    pushEqTrue e <| mkEqTrueCore e (← mkHEqProof a b)
 
 /-- Propagates `ite` upwards -/
 builtin_grind_propagator propagateIte ↑ite := fun e => do
@@ -166,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 (mkApp2 (mkConst ``of_eq_true) c h₁)
+     let ah₁ := mkApp a (mkOfEqTrueCore c h₁)
      let p ← simp ah₁
      let r := p.expr
      let h₂ ← p.getProof

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

@@ -24,7 +24,7 @@ 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) : GrindM Simp.Result := do
+def simp (e : Expr) : GoalM Simp.Result := do
   let e ← instantiateMVars e
   let r ← simpCore e
   let e' := r.expr

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

@@ -14,77 +14,123 @@ namespace Lean.Meta.Grind
 inductive CaseSplitStatus where
   | resolved
   | notReady
-  | ready
+  | ready (numCases : Nat) (isRec := false)
   deriving Inhabited, BEq
 
+/-- Given `c`, the condition of an `if-then-else`, check whether we need to case-split on the `if-then-else` or not -/
+private def checkIteCondStatus (c : Expr) : GoalM CaseSplitStatus := do
+  if (← isEqTrue c <||> isEqFalse c) then
+    return .resolved
+  else
+    return .ready 2
+
+/--
+Given `e` of the form `a ∨ b`, check whether we are ready to case-split on `e`.
+That is, `e` is `True`, but neither `a` nor `b` is `True`."
+-/
+private def checkDisjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
+  if (← isEqTrue e) then
+    if (← isEqTrue a <||> isEqTrue b) then
+      return .resolved
+    else
+      return .ready 2
+  else if (← isEqFalse e) then
+    return .resolved
+  else
+    return .notReady
+
+/--
+Given `e` of the form `a ∧ b`, check whether we are ready to case-split on `e`.
+That is, `e` is `False`, but neither `a` nor `b` is `False`.
+ -/
+private def checkConjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
+  if (← isEqTrue e) then
+    return .resolved
+  else if (← isEqFalse e) then
+    if (← isEqFalse a <||> isEqFalse b) then
+      return .resolved
+    else
+      return .ready 2
+  else
+    return .notReady
+
+/--
+Given `e` of the form `@Eq Prop a b`, check whether we are ready to case-split on `e`.
+There are two cases:
+1- `e` is `True`, but neither both `a` and `b` are `True`, nor both `a` and `b` are `False`.
+2- `e` is `False`, but neither `a` is `True` and `b` is `False`, nor `a` is `False` and `b` is `True`.
+-/
+private def checkIffStatus (e a b : Expr) : GoalM CaseSplitStatus := do
+  if (← isEqTrue e) then
+    if (← (isEqTrue a <&&> isEqTrue b) <||> (isEqFalse a <&&> isEqFalse b)) then
+      return .resolved
+    else
+      return .ready 2
+  else if (← isEqFalse e) then
+    if (← (isEqTrue a <&&> isEqFalse b) <||> (isEqFalse a <&&> isEqTrue b)) then
+      return .resolved
+    else
+      return .ready 2
+  else
+    return .notReady
+
 private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
   match_expr e with
-  | Or a b =>
-    if (← isEqTrue e) then
-      if (← isEqTrue a <||> isEqTrue b) then
-        return .resolved
-      else
-        return .ready
-    else if (← isEqFalse e) then
-      return .resolved
-    else
-      return .notReady
-  | And a b =>
-    if (← isEqTrue e) then
-      return .resolved
-    else if (← isEqFalse e) then
-      if (← isEqFalse a <||> isEqFalse b) then
-        return .resolved
-      else
-        return .ready
-    else
-      return .notReady
-  | ite _ c _ _ _ =>
-    if (← isEqTrue c <||> isEqFalse c) then
-      return .resolved
-    else
-      return .ready
-  | dite _ c _ _ _ =>
-    if (← isEqTrue c <||> isEqFalse c) then
-      return .resolved
-    else
-      return .ready
+  | Or a b => checkDisjunctStatus e a b
+  | And a b => checkConjunctStatus e a b
+  | Eq _ a b => checkIffStatus e a b
+  | ite _ c _ _ _ => checkIteCondStatus c
+  | dite _ c _ _ _ => checkIteCondStatus c
   | _ =>
     if (← isResolvedCaseSplit e) then
       trace[grind.debug.split] "split resolved: {e}"
       return .resolved
-    if (← isMatcherApp e) then
-      return .ready
+    if let some info := isMatcherAppCore? (← getEnv) e then
+      return .ready info.numAlts
     let .const declName .. := e.getAppFn | unreachable!
-    if (← isInductivePredicate declName <&&> isEqTrue e) then
-      return .ready
+    if let some info ← isInductivePredicate? declName then
+      if (← isEqTrue e) then
+        return .ready info.ctors.length info.isRec
     return .notReady
 
+private inductive SplitCandidate where
+  | none
+  | some (c : Expr) (numCases : Nat) (isRec : Bool)
+
 /-- Returns the next case-split to be performed. It uses a very simple heuristic. -/
-private def selectNextSplit? : GoalM (Option Expr) := do
-  if (← isInconsistent) then return none
-  if (← checkMaxCaseSplit) then return none
-  go (← get).splitCandidates none []
+private def selectNextSplit? : GoalM SplitCandidate := do
+  if (← isInconsistent) then return .none
+  if (← checkMaxCaseSplit) then return .none
+  go (← get).splitCandidates .none []
 where
-  go (cs : List Expr) (c? : Option Expr) (cs' : List Expr) : GoalM (Option Expr) := do
+  go (cs : List Expr) (c? : SplitCandidate) (cs' : List Expr) : GoalM SplitCandidate := do
     match cs with
     | [] =>
       modify fun s => { s with splitCandidates := cs'.reverse }
-      if c?.isSome then
+      if let .some _ numCases isRec := c? then
+        let numSplits := (← get).numSplits
+        -- We only increase the number of splits if there is more than one case or it is recursive.
+        let numSplits := if numCases > 1 || isRec then numSplits + 1 else numSplits
         -- Remark: we reset `numEmatch` after each case split.
         -- We should consider other strategies in the future.
-        modify fun s => { s with numSplits := s.numSplits + 1, numEmatch := 0 }
+        modify fun s => { s with numSplits, numEmatch := 0 }
       return c?
     | c::cs =>
     match (← checkCaseSplitStatus c) with
     | .notReady => go cs c? (c::cs')
     | .resolved => go cs c? cs'
-    | .ready =>
+    | .ready numCases isRec =>
     match c? with
-    | none => go cs (some c) cs'
-    | some c' =>
-      if (← getGeneration c) < (← getGeneration c') then
-        go cs (some c) (c'::cs')
+    | .none => go cs (.some c numCases isRec) cs'
+    | .some c' numCases' _ =>
+     let isBetter : GoalM Bool := do
+       if numCases == 1 && !isRec && numCases' > 1 then
+         return true
+       if (← getGeneration c) < (← getGeneration c') then
+         return true
+       return numCases < numCases'
+     if (← isBetter) then
+        go cs (.some c numCases isRec) (c'::cs')
       else
         go cs c? (c::cs')
 
@@ -94,7 +140,12 @@ private def mkCasesMajor (c : Expr) : GoalM Expr := do
   | And a b => return mkApp3 (mkConst ``Grind.or_of_and_eq_false) a b (← mkEqFalseProof c)
   | ite _ c _ _ _ => return mkEM c
   | dite _ c _ _ _ => return mkEM c
-  | _ => return mkApp2 (mkConst ``of_eq_true) c (← mkEqTrueProof c)
+  | Eq _ a b =>
+    if (← isEqTrue c) then
+      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)
 
 /-- Introduces new hypotheses in each goal. -/
 private def introNewHyp (goals : List Goal) (acc : List Goal) (generation : Nat) : GrindM (List Goal) := do
@@ -108,9 +159,10 @@ and returns a new list of goals if successful.
 -/
 def splitNext : GrindTactic := fun goal => do
   let (goals?, _) ← GoalM.run goal do
-    let some c ← selectNextSplit?
+    let .some c numCases isRec ← selectNextSplit?
       | return none
     let gen ← getGeneration c
+    let genNew := if numCases > 1 || isRec then gen+1 else gen
     trace_goal[grind.split] "{c}, generation: {gen}"
     let mvarIds ← if (← isMatcherApp c) then
       casesMatch (← get).mvarId c
@@ -119,7 +171,7 @@ def splitNext : GrindTactic := fun goal => do
       cases (← get).mvarId major
     let goal ← get
     let goals := mvarIds.map fun mvarId => { goal with mvarId }
-    let goals ← introNewHyp goals [] (gen+1)
+    let goals ← introNewHyp goals [] genNew
     return some goals
   return goals?
 

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

@@ -13,17 +13,14 @@ import Lean.Meta.CongrTheorems
 import Lean.Meta.AbstractNestedProofs
 import Lean.Meta.Tactic.Simp.Types
 import Lean.Meta.Tactic.Util
+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
 
 namespace Lean.Meta.Grind
 
-@[inline] def isSameExpr (a b : Expr) : Bool :=
-  -- It is safe to use pointer equality because we hashcons all expressions
-  -- inserted into the E-graph
-  unsafe ptrEq a b
-
 /-- We use this auxiliary constant to mark delayed congruence proofs. -/
 def congrPlaceholderProof := mkConst (Name.mkSimple "[congruence]")
 
@@ -69,7 +66,6 @@ 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. -/
@@ -83,6 +79,7 @@ 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`.
@@ -107,6 +104,10 @@ 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
 
@@ -131,18 +132,9 @@ 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 { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
+  modifyGet fun { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag } =>
     let (e, scState) := ShareCommon.State.shareCommon scState e
-    (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
+    (e, { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag })
 
 /-- Returns `true` if `e` is the internalized `True` expression.  -/
 def isTrueExpr (e : Expr) : GrindM Bool :=
@@ -205,13 +197,19 @@ 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) :=
@@ -224,20 +222,6 @@ structure NewEq where
   proof : Expr
   isHEq : Bool
 
-/--
-Key for the `ENodeMap` and `ParentMap` map.
-We use pointer addresses and rely on the fact all internalized expressions
-have been hash-consed, i.e., we have applied `shareCommon`.
--/
-private structure ENodeKey where
-  expr : Expr
-
-instance : Hashable ENodeKey where
-  hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
-
-instance : BEq ENodeKey where
-  beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
-
 abbrev ENodeMap := PHashMap ENodeKey ENode
 
 /--
@@ -351,6 +335,7 @@ structure NewFact where
 
 structure Goal where
   mvarId       : MVarId
+  canon        : Canon.State := {}
   enodes       : ENodeMap := {}
   parents      : ParentMap := {}
   congrTable   : CongrTable enodes := {}
@@ -368,6 +353,8 @@ structure Goal where
   gmt          : Nat := 0
   /-- Next unique index for creating ENodes -/
   nextIdx      : Nat := 0
+  /-- State of arithmetic procedures -/
+  arith        : Arith.State := {}
   /-- Active theorems that we have performed ematching at least once. -/
   thms         : PArray EMatchTheorem := {}
   /-- Active theorems that we have not performed any round of ematching yet. -/
@@ -395,6 +382,8 @@ structure Goal where
   resolvedSplits : PHashSet ENodeKey := {}
   /-- Next local E-match theorem idx. -/
   nextThmIdx : Nat := 0
+  /-- Asserted facts -/
+  facts      : PArray Expr := {}
   deriving Inhabited
 
 def Goal.admit (goal : Goal) : MetaM Unit :=
@@ -408,6 +397,13 @@ abbrev GoalM := StateRefT Goal GrindM
 @[inline] def GoalM.run' (goal : Goal) (x : GoalM Unit) : GrindM Goal :=
   goal.mvarId.withContext do StateRefT'.run' (x *> get) goal
 
+/-- Canonicalizes nested types, type formers, and instances in `e`. -/
+def canon (e : Expr) : GoalM 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
+
 def updateLastTag : GoalM Unit := do
   if (← isTracingEnabledFor `grind) then
     let currTag ← (← get).mvarId.getTag
@@ -463,15 +459,26 @@ 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).enodes.find? { expr := e }
+  return (← get).getENode? e
+
+def throwNonInternalizedExpr (e : Expr) : CoreM α :=
+  throwError "internal `grind` error, term has not been internalized{indentExpr e}"
 
 /-- Returns node associated with `e`. It assumes `e` has already been internalized. -/
-def getENode (e : Expr) : GoalM ENode := do
-  let some n := (← get).enodes.find? { expr := e }
-    | throwError "internal `grind` error, term has not been internalized{indentExpr e}"
+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
+
 /-- Returns the generation of the given term. Is assumes it has been internalized -/
 def getGeneration (e : Expr) : GoalM Nat :=
   return (← getENode e).generation
@@ -501,30 +508,53 @@ 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 getRoot? (e : Expr) : GoalM (Option Expr) := do
-  let some n ← getENode? e | return none
+def Goal.getRoot? (goal : Goal) (e : Expr) : Option Expr := Id.run do
+  let some n ← goal.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 getRoot (e : Expr) : GoalM Expr :=
-  return (← getENode e).root
+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
 
 /-- 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 getNext (e : Expr) : GoalM Expr :=
-  return (← getENode e).next
+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
 
 /-- Returns `true` if `e` has already been internalized. -/
 def alreadyInternalized (e : Expr) : GoalM Bool :=
   return (← get).enodes.contains { expr := e }
 
-def getTarget? (e : Expr) : GoalM (Option Expr) := do
-  let some n ← getENode? e | return none
+def Goal.getTarget? (goal : Goal) (e : Expr) : Option Expr := Id.run do
+  let some n ← goal.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`.
@@ -622,6 +652,41 @@ 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
@@ -696,11 +761,23 @@ 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
-  -- 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
+  return (← get).getENodes
+
+/-- Executes `f` to each term in the equivalence class containing `e` -/
+@[inline] def traverseEqc (e : Expr) (f : ENode → GoalM Unit) : GoalM Unit := do
+  let mut curr := e
+  repeat
+    let n ← getENode curr
+    f n
+    if isSameExpr n.next e then return ()
+    curr := n.next
 
 def forEachENode (f : ENode → GoalM Unit) : GoalM Unit := do
   let nodes ← getENodes
@@ -714,7 +791,7 @@ def filterENodes (p : ENode → GoalM Bool) : GoalM (Array ENode) := do
       ref.modify (·.push n)
   ref.get
 
-def forEachEqc (f : ENode → GoalM Unit) : GoalM Unit := do
+def forEachEqcRoot (f : ENode → GoalM Unit) : GoalM Unit := do
   let nodes ← getENodes
   for n in nodes do
     if isSameExpr n.self n.root then
@@ -749,26 +826,34 @@ def applyFallback : GoalM Unit := do
   fallback
 
 /-- Returns expressions in the given expression equivalence class. -/
-partial def getEqc (e : Expr) : GoalM (List Expr) :=
+partial def Goal.getEqc (goal : Goal) (e : Expr) : List Expr :=
   go e e []
 where
-  go (first : Expr) (e : Expr) (acc : List Expr) : GoalM (List Expr) := do
-    let next ← getNext e
+  go (first : Expr) (e : Expr) (acc : List Expr) : List Expr := Id.run do
+    let some next ← goal.getNext? e | acc
     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 getEqcs : GoalM (List (List Expr)) := do
-  let mut r := []
-  let nodes ← getENodes
+partial def Goal.getEqcs (goal : Goal) : List (List Expr) := Id.run do
+  let mut r : List (List Expr) := []
+  let nodes ← goal.getENodes
   for node in nodes do
     if isSameExpr node.root node.self then
-      r := (← getEqc node.self) :: r
+      r := goal.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 }

src/Lean/Meta/Tactic/LinearArith/Nat/Simp.lean

@@ -50,18 +50,24 @@ def simpCnstr? (e : Expr) : MetaM (Option (Expr × Expr)) := do
   if let some arg := e.not? then
     let mut eNew?   := none
     let mut thmName := Name.anonymous
-    if arg.isAppOfArity ``LE.le 4 then
-      eNew?   := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
-      thmName := ``Nat.not_le_eq
-    else if arg.isAppOfArity ``GE.ge 4 then
-      eNew?   := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
-      thmName := ``Nat.not_ge_eq
-    else if arg.isAppOfArity ``LT.lt 4 then
-      eNew?   := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
-      thmName := ``Nat.not_lt_eq
-    else if arg.isAppOfArity ``GT.gt 4 then
-      eNew?   := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
-      thmName := ``Nat.not_gt_eq
+    match_expr arg with
+    | LE.le α _ _ _ =>
+      if α.isConstOf ``Nat then
+        eNew?   := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
+        thmName := ``Nat.not_le_eq
+    | GE.ge α _ _ _ =>
+      if α.isConstOf ``Nat then
+        eNew?   := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
+        thmName := ``Nat.not_ge_eq
+    | LT.lt α _ _ _ =>
+      if α.isConstOf ``Nat then
+        eNew?   := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
+        thmName := ``Nat.not_lt_eq
+    | GT.gt α _ _ _ =>
+      if α.isConstOf ``Nat then
+        eNew?   := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
+        thmName := ``Nat.not_gt_eq
+    | _ => pure ()
     if let some eNew := eNew? then
       let h₁ := mkApp2 (mkConst thmName) (arg.getArg! 2) (arg.getArg! 3)
       if let some (eNew', h₂) ← simpCnstrPos? eNew then

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    => .insert map k [v]
-  | some vs => .insert map k (v::vs)
+  | none    => RBMap.insert map k [v]
+  | some vs => RBMap.insert map k (v::vs)
 
 instance : Inhabited (TokenMap α) where
   default := RBMap.empty

src/Lean/ParserCompiler.lean

@@ -103,11 +103,8 @@ partial def compileParserExpr (e : Expr) : MetaM Expr := do
           name := c', levelParams := []
           type := ty, value := value, hints := ReducibilityHints.opaque, safety := DefinitionSafety.safe
         }
-        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'
+        addAndCompile decl
+        modifyEnv (ctx.combinatorAttr.setDeclFor · 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/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 α := .pure (.ok a)
+abbrev RequestTask.pure (a : α) : RequestTask α := Task.pure (.ok a)
 
 instance : MonadLift IO RequestM where
   monadLift x := do

src/Lean/Util/Path.lean

@@ -104,17 +104,26 @@ 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)
-    let mut msg := s!"unknown module prefix '{pkg}'
+    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)}"
 
-No directory '{pkg}' or file '{pkg}.olean' in the search path entries:
-{"\n".intercalate <| sp.map (·.toString)}"
-    throw <| IO.userError msg
+/-- 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)}"
 
 /-- Infer module name of source file name. -/
 @[export lean_module_name_of_file]

src/Lean/Widget/InteractiveDiagnostic.lean

@@ -207,7 +207,9 @@ 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
-          let col := col + tt.stripTags.length - 2
+          -- absolute column = request-level indentation (e.g. from nested lazy trace request) +
+          -- offset inside `fmt`
+          let col := indent + col
           let children ←
             match children with
               | .lazy children => pure <| .lazy ⟨{indent := col+2, children := children.map .mk}⟩

src/Std/Data/DHashMap/Basic.lean

@@ -251,34 +251,27 @@ instance [BEq α] [Hashable α] : ForIn m (DHashMap α β) ((a : α) × β a) wh
 Modifies in place the value associated with a given key.
 
 This function ensures that the value is used linearly.
-It is currently implemented in terms of `get?`, `erase`, and `insert`,
-but will later become a primitive operation.
-(It is provided already to help avoid non-linear code.)
 -/
 @[inline] def modify [LawfulBEq α] (m : DHashMap α β) (a : α) (f : β a → β a) : DHashMap α β :=
-  match m.get? a with
-  | none => m
-  | some b => m.erase a |>.insert a (f b)
+  ⟨Raw₀.modify ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.modify₀ m.2⟩
+
+@[inline, inherit_doc DHashMap.modify] def Const.modify {β : Type v} (m : DHashMap α (fun _ => β))
+    (a : α) (f : β → β) : DHashMap α (fun _ => β) :=
+  ⟨Raw₀.Const.modify ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.constModify₀ m.2⟩
 
 /--
 Modifies in place the value associated with a given key,
 allowing creating new values and deleting values via an `Option` valued replacement function.
 
 This function ensures that the value is used linearly.
-It is currently implemented in terms of `get?`, `erase`, and `insert`,
-but will later become a primitive operation.
-(It is provided already to help avoid non-linear code.)
 -/
-@[inline] def alter [LawfulBEq α] (m : DHashMap α β) (a : α) (f : Option (β a) → Option (β a)) : DHashMap α β :=
-  match m.get? a with
-  | none =>
-    match f none with
-    | none => m
-    | some b => m.insert a b
-  | some b =>
-    match f (some b) with
-    | none => m.erase a
-    | some b => m.erase a |>.insert a b
+@[inline] def alter [LawfulBEq α] (m : DHashMap α β)
+    (a : α) (f : Option (β a) → Option (β a)) : DHashMap α β :=
+  ⟨Raw₀.alter ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.alter₀ m.2⟩
+
+@[inline, inherit_doc DHashMap.alter] def Const.alter {β : Type v}
+    (m : DHashMap α (fun _ => β)) (a : α) (f : Option β → Option β) : DHashMap α (fun _ => β) :=
+  ⟨Raw₀.Const.alter ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.constAlter₀ m.2⟩
 
 @[inline, inherit_doc Raw.insertMany] def insertMany {ρ : Type w}
     [ForIn Id ρ ((a : α) × β a)] (m : DHashMap α β) (l : ρ) : DHashMap α β :=

src/Std/Data/DHashMap/Internal/AssocList/Basic.lean

@@ -169,6 +169,63 @@ def erase [BEq α] (a : α) : AssocList α β → AssocList α β
   | nil => nil
   | cons k v l => bif k == a then l else cons k v (l.erase a)
 
+/-- Internal implementation detail of the hash map -/
+def modify [BEq α] [LawfulBEq α] (a : α) (f : β a → β a) :
+    AssocList α β → AssocList α β
+  | nil => nil
+  | cons k v l =>
+    if h : k == a then
+      have h' : k = a := eq_of_beq h
+      let b := f (cast (congrArg β h') v)
+      cons a b l
+    else
+      cons k v (modify a f l)
+
+/-- Internal implementation detail of the hash map -/
+def alter [BEq α] [LawfulBEq α] (a : α) (f : Option (β a) → Option (β a)) :
+    AssocList α β → AssocList α β
+  | nil => match f none with
+    | none => nil
+    | some b => cons a b nil
+  | cons k v l =>
+    if h : k == a then
+      have h' : k = a := eq_of_beq h
+      match f (some (cast (congrArg β h') v)) with
+      | none => l
+      | some b => cons a b l
+    else
+      let tail := alter a f l
+      cons k v tail
+
+namespace Const
+
+/-- Internal implementation detail of the hash map -/
+def modify [BEq α] {β : Type v} (a : α) (f : β → β) :
+    AssocList α (fun _ => β) → AssocList α (fun _ => β)
+  | nil => nil
+  | cons k v l =>
+    if k == a then
+      cons a (f v) l
+    else
+      cons k v (modify a f l)
+
+/-- Internal implementation detail of the hash map -/
+def alter [BEq α] {β : Type v} (a : α) (f : Option β → Option β) :
+    AssocList α (fun _ => β) → AssocList α (fun _ => β)
+  | nil => match f none with
+    | none => nil
+    | some b => AssocList.cons a b nil
+  | cons k v l =>
+    if k == a then
+      match f v with
+      | none => l
+      | some b => cons a b l
+    else
+      let tail := alter a f l
+      cons k v tail
+
+end Const
+
 /-- Internal implementation detail of the hash map -/
 @[inline] def filterMap (f : (a : α) → β a → Option (γ a)) :
     AssocList α β → AssocList α γ :=

src/Std/Data/DHashMap/Internal/AssocList/Lemmas.lean

@@ -199,6 +199,45 @@ theorem toList_filter {f : (a : α) → β a → Bool} {l : AssocList α β} :
     · exact (ih _).trans (by simpa using perm_middle.symm)
     · exact ih _
 
+theorem toList_alter [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
+    {l : AssocList α β} :
+    Perm (l.alter a f).toList (alterKey a f l.toList) := by
+  induction l
+  · simp only [alter, toList_nil, alterKey_nil]
+    split <;> simp_all
+  · rw [toList]
+    refine Perm.trans ?_ alterKey_cons_perm.symm
+    rw [alter]
+    split <;> (try split) <;> simp_all
+
+theorem modify_eq_alter [BEq α] [LawfulBEq α] {a : α} {f : β a → β a} {l : AssocList α β} :
+    modify a f l = alter a (·.map f) l := by
+  induction l
+  · rfl
+  · next ih => simp only [modify, beq_iff_eq, alter, Option.map_some', ih]
+
+namespace Const
+
+variable {β : Type v}
+
+theorem toList_alter [BEq α] [EquivBEq α] {a : α} {f : Option β → Option β}
+    {l : AssocList α (fun _ => β)} : Perm (alter a f l).toList (Const.alterKey a f l.toList) := by
+  induction l
+  · simp only [alter, toList_nil, alterKey_nil]
+    split <;> simp_all
+  · rw [toList]
+    refine Perm.trans ?_ Const.alterKey_cons_perm.symm
+    rw [alter]
+    split <;> (try split) <;> simp_all
+
+theorem modify_eq_alter [BEq α] [EquivBEq α] {a : α} {f : β → β} {l : AssocList α (fun _ => β)} :
+    modify a f l = alter a (·.map f) l := by
+  induction l
+  · rfl
+  · next ih => simp only [modify, beq_iff_eq, alter, Option.map_some', ih]
+
+end Const
+
 theorem foldl_apply {l : AssocList α β} {acc : List δ} (f : (a : α) → β a → δ) :
     l.foldl (fun acc k v => f k v :: acc) acc =
       (l.toList.map (fun p => f p.1 p.2)).reverse ++ acc := by

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

@@ -226,6 +226,72 @@ where
     let buckets' := buckets.uset i (AssocList.cons a b bkt) h
     expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
 
+/-- Internal implementation detail of the hash map -/
+@[inline] def modify [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α) (f : β a → β a) :
+    Raw₀ α β :=
+  let ⟨⟨size, buckets⟩, hm⟩ := m
+  let size' := size
+  let ⟨i, hi⟩ := mkIdx buckets.size hm (hash a)
+  let bucket := buckets[i]
+  if bucket.contains a then
+    let buckets := buckets.uset i .nil hi
+    let bucket := bucket.modify a f
+    ⟨⟨size, buckets.uset i bucket (by simpa [buckets])⟩, (by simpa [buckets])⟩
+  else
+    m
+
+/-- Internal implementation detail of the hash map -/
+@[inline] def Const.modify [BEq α] {β : Type v} [Hashable α] (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : β → β) : Raw₀ α (fun _ => β) :=
+  let ⟨⟨size, buckets⟩, hm⟩ := m
+  let size' := size
+  let ⟨i, hi⟩ := mkIdx buckets.size hm (hash a)
+  let bucket := buckets[i]
+  if bucket.contains a then
+    let buckets := buckets.uset i .nil hi
+    let bucket := AssocList.Const.modify a f bucket
+    ⟨⟨size, buckets.uset i bucket (by simpa [buckets])⟩, (by simpa [buckets])⟩
+  else
+    m
+
+/-- Internal implementation detail of the hash map -/
+@[inline] def alter [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
+    (f : Option (β a) → Option (β a)) : Raw₀ α β :=
+  let ⟨⟨size, buckets⟩, hm⟩ := m
+  let ⟨i, h⟩ := mkIdx buckets.size hm (hash a)
+  let bkt := buckets[i]
+  if bkt.contains a then
+    let buckets' := buckets.uset i .nil h
+    let bkt' := bkt.alter a f
+    let size' := if bkt'.contains a then size else size - 1
+    ⟨⟨size', buckets'.uset i bkt' (by simpa [buckets'])⟩, by simpa [buckets']⟩
+  else
+    match f none with
+    | none => m
+    | some b =>
+      let size'    := size + 1
+      let buckets' := buckets.uset i (.cons a b bkt) h
+      expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
+
+/-- Internal implementation detail of the hash map -/
+@[inline] def Const.alter [BEq α] [Hashable α] {β : Type v} (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : Option β → Option β) : Raw₀ α (fun _ => β) :=
+  let ⟨⟨size, buckets⟩, hm⟩ := m
+  let ⟨i, h⟩ := mkIdx buckets.size hm (hash a)
+  let bkt := buckets[i]
+  if bkt.contains a then
+    let buckets' := buckets.uset i .nil h
+    let bkt' := AssocList.Const.alter a f bkt
+    let size' := if bkt'.contains a then size else size - 1
+    ⟨⟨size', buckets'.uset i bkt' (by simpa [buckets'])⟩, by simpa [buckets']⟩
+  else
+    match f none with
+    | none => m
+    | some b =>
+      let size'    := size + 1
+      let buckets' := buckets.uset i (.cons a b bkt) h
+      expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
+
 /-- Internal implementation detail of the hash map -/
 @[inline] def containsThenInsert [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) (b : β a) :
     Bool × Raw₀ α β :=

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

@@ -775,6 +775,7 @@ def eraseKey [BEq α] (k : α) : List ((a : α) × β a) → List ((a : α) ×
   | ⟨k', v'⟩ :: l => bif k' == k then l else ⟨k', v'⟩ :: eraseKey k l
 
 @[simp] theorem eraseKey_nil [BEq α] {k : α} : eraseKey k ([] : List ((a : α) × β a)) = [] := rfl
+
 theorem eraseKey_cons [BEq α] {l : List ((a : α) × β a)} {k k' : α} {v' : β k'} :
     eraseKey k (⟨k', v'⟩ :: l) = bif k' == k then l else ⟨k', v'⟩ :: eraseKey k l := rfl
 
@@ -849,10 +850,10 @@ theorem isEmpty_eraseKey [BEq α] {l : List ((a : α) × β a)} {k : α} :
 theorem keys_eq_map (l : List ((a : α) × β a)) : keys l = l.map (·.1) := by
   induction l using assoc_induction <;> simp_all
 
-theorem length_keys_eq_length (l : List ((a : α) × β a)) : (keys l).length = l.length := by 
+theorem length_keys_eq_length (l : List ((a : α) × β a)) : (keys l).length = l.length := by
   induction l using assoc_induction <;> simp_all
 
-theorem isEmpty_keys_eq_isEmpty (l : List ((a : α) × β a)) : (keys l).isEmpty = l.isEmpty := by 
+theorem isEmpty_keys_eq_isEmpty (l : List ((a : α) × β a)) : (keys l).isEmpty = l.isEmpty := by
   induction l using assoc_induction <;> simp_all
 
 theorem containsKey_eq_keys_contains [BEq α] [PartialEquivBEq α] {l : List ((a : α) × β a)}
@@ -968,8 +969,25 @@ def insertEntry [BEq α]  (k : α) (v : β k) (l : List ((a : α) × β a)) : Li
 
 @[simp]
 theorem insertEntry_nil [BEq α] {k : α} {v : β k} :
-    insertEntry k v ([] : List ((a : α) × β a)) = [⟨k, v⟩] := by
-  simp [insertEntry]
+    insertEntry k v ([] : List ((a : α) × β a)) = [⟨k, v⟩] :=
+  by simp [insertEntry]
+
+theorem insertEntry_cons_of_false [BEq α] {l : List ((a : α) × β a)} {k k' : α} {v : β k}
+    {v' : β k'} (h : (k' == k) = false) :
+    Perm (insertEntry k v (⟨k', v'⟩ :: l)) (⟨k', v'⟩ :: insertEntry k v l) := by
+  simp only [insertEntry, containsKey_cons, h, Bool.false_or, cond_eq_if]
+  split
+  · rw [replaceEntry_cons_of_false h]
+  · apply Perm.swap
+
+theorem insertEntry_cons_of_beq [BEq α] {l : List ((a : α) × β a)} {k k' : α} {v : β k} {v' : β k'}
+    (h : k' == k) : insertEntry k v (⟨k', v'⟩ :: l) = ⟨k, v⟩ :: l := by
+  simp_all only [insertEntry, containsKey_cons, Bool.true_or, cond_true, replaceEntry_cons_of_true]
+
+@[simp]
+theorem insertEntry_cons_self [BEq α] [ReflBEq α] {l : List ((a : α) × β a)} {k : α} {v : β k} :
+    insertEntry k v (⟨k, v⟩ :: l) = ⟨k, v⟩ :: l :=
+  insertEntry_cons_of_beq BEq.refl
 
 theorem insertEntry_of_containsKey [BEq α] {l : List ((a : α) × β a)} {k : α} {v : β k}
     (h : containsKey k l) : insertEntry k v l = replaceEntry k v l := by
@@ -1827,4 +1845,324 @@ theorem eraseKey_append_of_containsKey_right_eq_false [BEq α] {l l' : List ((a
     · rw [cond_false, cond_false, ih, List.cons_append]
     · rw [cond_true, cond_true]
 
+/-- Internal implementation detail of the hash map -/
+def alterKey [BEq α] [LawfulBEq α] (k : α) (f : Option (β k) → Option (β k))
+    (l : List ((a : α) × β a)) : List ((a : α) × β a) :=
+  match f (getValueCast? k l) with
+  | none => eraseKey k l
+  | some v => insertEntry k v l
+
+theorem length_alterKey [BEq α] [LawfulBEq α] {k : α} {f : Option (β k) → Option (β k)}
+    {l : List ((a : α) × β a)} : (alterKey k f l).length =
+    if h : containsKey k l then
+      if f (getValueCast k l h) |>.isSome then l.length else l.length - 1
+    else
+      if f none |>.isSome then l.length + 1 else l.length := by
+  rw [alterKey]
+  cases h : getValueCast? k l <;> split <;> simp_all [length_eraseKey, length_insertEntry,
+    containsKey_eq_isSome_getValueCast?, ← getValueCast?_eq_some_getValueCast]
+
+theorem alterKey_cons_perm [BEq α] [LawfulBEq α] {k : α} {f : Option (β k) → Option (β k)}
+    {k' : α} {v' : β k'} {l : List ((a : α) × β a)} :
+      Perm (alterKey k f (⟨k', v'⟩ :: l)) (if hk : k' == k then
+        match f (some (cast (congrArg β (eq_of_beq hk)) v')) with
+          | none => l
+          | some v => ⟨k, v⟩ :: l
+        else
+          ⟨k', v'⟩ :: alterKey k f l) := by
+  rw [alterKey]
+  by_cases hk' : k' == k
+  · simp only [hk', ↓reduceDIte]
+    rw [getValueCast?_cons_of_true hk', eraseKey_cons_of_beq hk']
+    simp [insertEntry_cons_of_beq hk']
+  · simp only [hk', Bool.false_eq_true, ↓reduceDIte]
+    rw [Bool.not_eq_true] at hk'
+    rw [getValueCast?_cons_of_false hk', eraseKey_cons_of_false hk', alterKey]
+    split
+    · rfl
+    · simp [insertEntry_cons_of_false hk']
+
+theorem alterKey_of_perm [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
+    {l l' : List ((a : α) × β a)} (hl : DistinctKeys l) (hp : Perm l l') :
+    Perm (alterKey a f l) (alterKey a f l') := by
+  simp only [alterKey, getValueCast?_of_perm hl hp]
+  split
+  · exact eraseKey_of_perm hl hp
+  · exact insertEntry_of_perm hl hp
+
+theorem alterKey_append_of_containsKey_right_eq_false [BEq α] [LawfulBEq α] {a : α}
+    {f : Option (β a) → Option (β a)} {l l' : List ((a : α) × β a)}
+    (hc : containsKey a l' = false) : alterKey a f (l ++ l') = alterKey a f l ++ l' := by
+  simp only [alterKey, getValueCast?_append_of_containsKey_eq_false hc,
+    eraseKey_append_of_containsKey_right_eq_false hc, insertEntry_append_of_not_contains_right hc]
+  split <;> rfl
+
+@[simp]
+theorem alterKey_nil [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)} :
+    alterKey a f [] = match f none with
+    | none => []
+    | some b => [⟨a, b⟩] := rfl
+
+theorem containsKey_alterKey_self [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
+    {l : List ((a : α) × β a)} (hl : DistinctKeys l) :
+    containsKey a (alterKey a f l) = (f (getValueCast? a l)).isSome := by
+  match l with
+  | [] =>
+    simp only [getValueCast?_nil, Bool.coe_iff_coe, alterKey_nil]
+    split <;> { rename_i heq; simp [heq] }
+  | x :: xs =>
+    simp only [alterKey, Bool.coe_iff_coe]
+    split
+    · next heq =>
+      simp only [hl, heq, Option.isSome_none, containsKey_eraseKey_self]
+    · next heq =>
+      simp only [containsKey_insertEntry, heq, beq_self_eq_true, Bool.true_or, Option.isSome_some]
+
+theorem DistinctKeys.alterKey [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
+    {l : List ((a : α) × β a)} (hl : DistinctKeys l) : DistinctKeys (alterKey a f l) := by
+  dsimp only [List.alterKey]
+  split
+  · exact DistinctKeys.eraseKey hl
+  · exact DistinctKeys.insertEntry hl
+
+/-- Internal implementation detail of the hash map -/
+def modifyKey [BEq α] [LawfulBEq α] (k : α) (f : β k → β k)
+    (l : List ((a : α) × β a)) : List ((a : α) × β a) :=
+  match getValueCast? k l with
+  | none => l
+  | some v => replaceEntry k (f v) l
+
+theorem modifyKey_eq_alterKey [BEq α] [LawfulBEq α] (k : α) (f : β k → β k)
+    (l : List ((a : α) × β a)) : modifyKey k f l = alterKey k (·.map f) l := by
+  rw [modifyKey, alterKey, Option.map.eq_def]
+  split <;> next h =>
+    simp [h, insertEntry, containsKey_eq_isSome_getValueCast?, eraseKey_of_containsKey_eq_false]
+
+theorem mem_replaceEntry_of_key_ne [BEq α] [LawfulBEq α] {a : α} {b : β a}
+    {l : List ((a : α) × β a)} (p : (a : α) × β a) (hne : p.1 ≠ a) :
+    p ∈ replaceEntry a b l ↔ p ∈ l := by
+  induction l
+  · simp only [replaceEntry_nil]
+  · next ih =>
+    simp only [replaceEntry, cond_eq_if]
+    split
+    · next h =>
+      simp only [beq_iff_eq] at h
+      simp only [List.mem_cons, Sigma.ext_iff, h]
+      apply Iff.intro <;> exact fun
+      | Or.inr y => Or.inr y
+      | Or.inl y => hne y.1 |> False.elim
+    · simp only [List.mem_cons, ih]
+
+theorem mem_insertEntry_of_key_ne [BEq α] [LawfulBEq α] {a : α} {b : β a}
+    {l : List ((a : α) × β a)} (p : (a : α) × β a)
+    (hne : p.1 ≠ a) : p ∈ insertEntry a b l ↔ p ∈ l := by
+  simp only [insertEntry, cond_eq_if]
+  split
+  · exact mem_replaceEntry_of_key_ne p hne
+  · simp only [List.mem_cons, or_iff_right_iff_imp, Sigma.ext_iff]
+    exact fun x => hne x.1 |> False.elim
+
+theorem mem_eraseKey_of_key_ne [BEq α] [LawfulBEq α] {a : α}
+    {l : List ((a : α) × β a)} (p : (a : α) × β a) (hne : p.1 ≠ a) : p ∈ eraseKey a l ↔ p ∈ l := by
+  induction l
+  · simp only [eraseKey_nil]
+  · next ih =>
+    simp only [eraseKey, List.mem_cons]
+    rw [cond_eq_if]
+    split
+    · next h =>
+      rw [iff_or_self, Sigma.ext_iff]
+      exact fun x => (beq_iff_eq.mp h ▸ hne) x.1 |> False.elim
+    · next h =>
+      simp only [List.mem_cons, ih]
+
+theorem mem_alterKey_of_key_ne [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
+    {l : List ((a : α) × β a)} (p : (a : α) × β a) (hne : p.1 ≠ a) :
+    p ∈ alterKey a f l ↔ p ∈ l := by
+  rw [alterKey]
+  split <;> simp only [mem_eraseKey_of_key_ne p hne, mem_insertEntry_of_key_ne p hne]
+
+theorem length_modifyKey [BEq α] [LawfulBEq α] (k : α) (f : β k → β k)
+    (l : List ((a : α) × β a)) : (modifyKey k f l).length = l.length := by
+  induction l
+  · rfl
+  · next ih =>
+    simp only [modifyKey]
+    split <;> next h => simp only [length_replaceEntry, List.length_cons]
+
+theorem containsKey_modifyKey_self [BEq α] [LawfulBEq α] (k : α) (f : β k → β k)
+    (l : List ((a : α) × β a)) : containsKey k (modifyKey k f l) = containsKey k l := by
+  induction l
+  · simp only [modifyKey, getValueCast?_nil, eraseKey_nil, containsKey_nil, Bool.false_eq_true]
+  · simp only [modifyKey, Bool.coe_iff_coe]
+    split
+    · rfl
+    · rw [containsKey_replaceEntry]
+
+namespace Const
+
+variable {β : Type v}
+
+/-- Internal implementation detail of the hash map -/
+def alterKey [BEq α] (k : α) (f : Option β → Option β)
+    (l : List ((_ : α) × β)) : List ((_ : α) × β) :=
+  match f (getValue? k l) with
+  | none => eraseKey k l
+  | some v => insertEntry k v l
+
+theorem length_alterKey [BEq α] [EquivBEq α] {k : α} {f : Option β → Option β}
+    {l : List ((_ : α) × β)} : (alterKey k f l).length =
+      if h : containsKey k l then
+        if f (some (getValue k l h)) |>.isSome then l.length else l.length - 1
+      else
+        if f none |>.isSome then l.length + 1 else l.length := by
+  rw [alterKey]
+  cases h : getValue? k l <;> split <;> simp_all [length_eraseKey, length_insertEntry,
+    containsKey_eq_isSome_getValue?, ← getValue?_eq_some_getValue, -getValue?_eq_none]
+
+theorem alterKey_cons_perm [BEq α] [EquivBEq α] {k : α} {f : Option β → Option β}
+    {k' : α} {v' : β} {l : List ((_ : α) × β)} :
+      Perm (alterKey k f (⟨k', v'⟩ :: l)) (if k' == k then
+        match f (some v') with
+          | none => l
+          | some v => ⟨k, v⟩ :: l
+        else
+          ⟨k', v'⟩ :: alterKey k f l) := by
+  rw [alterKey]
+  by_cases hk' : k' == k
+  · simp only [hk', ↓reduceDIte]
+    rw [getValue?_cons_of_true hk', eraseKey_cons_of_beq hk']
+    simp [insertEntry_cons_of_beq hk']
+  · simp only [hk', Bool.false_eq_true, ↓reduceDIte]
+    rw [Bool.not_eq_true] at hk'
+    rw [getValue?_cons_of_false hk', eraseKey_cons_of_false hk', alterKey]
+    split
+    · rfl
+    · simp [insertEntry_cons_of_false hk']
+
+theorem alterKey_of_perm [BEq α] [EquivBEq α] {a : α} {f : Option β → Option β}
+    {l l' : List ((_ : α) × β)} (hl : DistinctKeys l) (hp : Perm l l') :
+    Perm (alterKey a f l) (alterKey a f l') := by
+  simp only [alterKey, getValue?_of_perm hl hp]
+  split
+  · exact eraseKey_of_perm hl hp
+  · exact insertEntry_of_perm hl hp
+
+theorem alterKey_append_of_containsKey_right_eq_false [BEq α] [EquivBEq α] {a : α}
+    {f : Option β → Option β} {l l' : List ((_ : α) × β)}
+    (hc : containsKey a l' = false) : alterKey a f (l ++ l') = alterKey a f l ++ l' := by
+  simp only [alterKey, getValue?_append_of_containsKey_eq_false hc,
+    eraseKey_append_of_containsKey_right_eq_false hc, insertEntry_append_of_not_contains_right hc]
+  split <;> rfl
+
+@[simp]
+theorem alterKey_nil [BEq α] [EquivBEq α] {a : α} {f : Option β → Option β} :
+    alterKey a f [] = match f none with
+    | none => []
+    | some b => [⟨a, b⟩] := rfl
+
+theorem containsKey_alterKey_self [BEq α] [EquivBEq α] {a : α} {f : Option β → Option β}
+    {l : List ((_ : α) × β)} (hl : DistinctKeys l) :
+    containsKey a (alterKey a f l) ↔ (f (getValue? a l)).isSome := by
+  match l with
+  | [] =>
+    simp only [getValue?_nil, Bool.coe_iff_coe, alterKey_nil]
+    split <;> { rename_i heq; simp [heq] }
+  | x :: xs =>
+    simp only [alterKey, Bool.coe_iff_coe]
+    split
+    · next heq =>
+      simp only [hl, heq, Option.isSome_none, containsKey_eraseKey_self]
+    · next heq =>
+      simp only [containsKey_insertEntry, BEq.refl, Bool.true_or, heq, Option.isSome_some]
+
+theorem mem_replaceEntry_of_key_not_beq [BEq α] [EquivBEq α] {a : α} {b : β}
+    {l : List ((_ : α) × β)} (p : (_ : α) × β) (hne : (p.1 == a) = false) :
+    p ∈ replaceEntry a b l ↔ p ∈ l := by
+  induction l
+  · simp only [replaceEntry_nil]
+  · next ih =>
+    simp only [replaceEntry, cond_eq_if]
+    split
+    · next h =>
+      simp only [List.mem_cons, Sigma.ext_iff]
+      apply Iff.intro <;> exact fun
+      | Or.inr y => Or.inr y
+      | Or.inl y => by simp_all only [BEq.refl, Bool.true_eq_false]
+    · simp only [List.mem_cons, ih]
+
+theorem mem_insertEntry_of_key_ne [BEq α] [EquivBEq α] {a : α} {b : β}
+    {l : List ((_ : α) × β)} (p : (_ : α) × β)
+    (hne : (p.1 == a) = false) : p ∈ insertEntry a b l ↔ p ∈ l := by
+  simp only [insertEntry, cond_eq_if]
+  split
+  · exact mem_replaceEntry_of_key_not_beq p hne
+  · simp only [List.mem_cons, or_iff_right_iff_imp, Sigma.ext_iff]
+    rw [← Bool.not_eq_true] at hne
+    exact fun x => hne (beq_of_eq x.1) |> False.elim
+
+theorem mem_eraseKey_of_key_ne [BEq α] [EquivBEq α] {a : α}
+    {l : List ((_ : α) × β)} (p : (_ : α) × β) (hne : (p.1 == a) = false) :
+    p ∈ eraseKey a l ↔ p ∈ l := by
+  induction l
+  · simp only [eraseKey_nil]
+  · next ih =>
+    simp only [eraseKey, List.mem_cons]
+    rw [cond_eq_if]
+    split
+    · next h =>
+      rw [iff_or_self, Sigma.ext_iff]
+      intro ⟨h₁, h₂⟩
+      rw [h₁, h] at hne
+      contradiction
+    · next h =>
+      simp only [List.mem_cons, ih]
+
+theorem mem_alterKey_of_key_not_beq {β : Type v} [BEq α] [EquivBEq α] {a : α}
+    {f : Option β → Option β} {l : List ((_ : α) × β)} (p : (_ : α) × β)
+    (hne : (p.1 == a) = false) : p ∈ alterKey a f l ↔ p ∈ l := by
+  rw [alterKey]
+  split <;> simp only [mem_eraseKey_of_key_ne p hne, mem_insertEntry_of_key_ne p hne]
+
+/-- Internal implementation detail of the hash map -/
+def modifyKey [BEq α] [EquivBEq α] (k : α) (f : β → β)
+    (l : List ((_ : α) × β)) : List ((_ : α) × β) :=
+  match getValue? k l with
+  | none => l
+  | some v => replaceEntry k (f v) l
+
+theorem modifyKey_eq_alterKey [BEq α] [EquivBEq α] (k : α) (f : β → β)
+    (l : List ((_ : α) × β)) : modifyKey k f l = alterKey k (·.map f) l := by
+  rw [modifyKey, alterKey, Option.map.eq_def]
+  split <;> next h =>
+    simp [h, insertEntry, containsKey_eq_isSome_getValue?, eraseKey_of_containsKey_eq_false]
+
+theorem length_modifyKey [BEq α] [EquivBEq α] (k : α) (f : β → β)
+    (l : List ((_ : α) × β)) : (modifyKey k f l).length = l.length := by
+  induction l
+  · rfl
+  · next ih =>
+    simp only [modifyKey]
+    split <;> next h => simp only [length_replaceEntry, List.length_cons]
+
+theorem containsKey_modifyKey_self [BEq α] [EquivBEq α] (k : α) (f : β → β)
+    (l : List ((_ : α) × β)) : containsKey k (modifyKey k f l) = containsKey k l := by
+  induction l
+  · simp only [modifyKey, getValue?_nil, eraseKey_nil, containsKey_nil, Bool.false_eq_true]
+  · simp only [modifyKey, Bool.coe_iff_coe]
+    split
+    · rfl
+    · rw [containsKey_replaceEntry]
+
+end Const
+
+theorem DistinctKeys.constAlterKey {β : Type v} [BEq α] [EquivBEq α] {a : α}
+    {f : Option β → Option β} {l : List ((_ : α) × β)} (hl : DistinctKeys l) :
+    DistinctKeys (List.Const.alterKey a f l) := by
+  dsimp only [List.Const.alterKey]
+  split
+  · exact DistinctKeys.eraseKey hl
+  · exact DistinctKeys.insertEntry hl
+
 end List

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

@@ -41,6 +41,11 @@ def bucket [Hashable α] (self : Array (AssocList α β)) (h : 0 < self.size) (k
   let ⟨i, h⟩ := mkIdx self.size h (hash k)
   self[i]
 
+theorem bucket_eq {α : Type u} {β : α → Type v} [Hashable α] (self : Array (AssocList α β))
+  (h : 0 < self.size) (k : α) : bucket self h k =
+    haveI := mkIdx self.size h (hash k) |>.2
+    self[mkIdx self.size h (hash k) |>.1] := rfl
+
 /-- Internal implementation detail of the hash map -/
 def updateBucket [Hashable α] (self : Array (AssocList α β)) (h : 0 < self.size) (k : α)
     (f : AssocList α β → AssocList α β) : Array (AssocList α β) :=
@@ -79,6 +84,13 @@ theorem size_withComputedSize {self : Array (AssocList α β)} :
 theorem buckets_withComputedSize {self : Array (AssocList α β)} :
     (withComputedSize self).buckets = self := rfl
 
+@[simp]
+theorem bucket_updateBucket [Hashable α] (self : Array (AssocList α β)) (h : 0 < self.size) (k : α)
+    (f : AssocList α β → AssocList α β) :
+    bucket (updateBucket self h k f) (by simpa using h) k = f (bucket self h k) := by
+  unfold bucket updateBucket mkIdx
+  simp
+
 theorem exists_bucket_of_uset [BEq α] [Hashable α]
   (self : Array (AssocList α β)) (i : USize) (hi : i.toNat < self.size) (d : AssocList α β) :
     ∃ l, Perm (toListModel self) (self[i.toNat].toList ++ l) ∧
@@ -165,13 +177,14 @@ theorem apply_bucket_with_proof {γ : α → Type w} [BEq α] [Hashable α] [Par
 /-- This is the general theorem to show that modification operations are correct. -/
 theorem toListModel_updateBucket [BEq α] [Hashable α] [PartialEquivBEq α] [LawfulHashable α]
     {m : Raw₀ α β} (hm : Raw.WFImp m.1) {a : α} {f : AssocList α β → AssocList α β}
-    {g : List ((a : α) × β a) → List ((a : α) × β a)} (hfg : ∀ {l}, (f l).toList = g l.toList)
+    {g : List ((a : α) × β a) → List ((a : α) × β a)} (hfg : ∀ {l}, Perm (f l).toList (g l.toList))
     (hg₁ : ∀ {l l'}, DistinctKeys l → Perm l l' → Perm (g l) (g l'))
     (hg₂ : ∀ {l l'}, containsKey a l' = false → g (l ++ l') = g l ++ l') :
     Perm (toListModel (updateBucket m.1.buckets m.2 a f)) (g (toListModel m.1.2)) := by
   obtain ⟨l, h₁, h₂, h₃⟩ := exists_bucket_of_update m.1.buckets m.2 a f
   refine h₂.trans (Perm.trans ?_ (hg₁ hm.distinct h₁).symm)
-  rw [hfg, hg₂]
+  refine Perm.append_right l hfg |>.trans ?_
+  rw [hg₂]
   exact h₃ hm.buckets_hash_self _ rfl
 
 /-- This is the general theorem to show that mapping operations (like `map` and `filter`) are
@@ -310,6 +323,49 @@ def eraseₘaux [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) : Raw₀ α
 def eraseₘ [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) : Raw₀ α β :=
   if m.containsₘ a then m.eraseₘaux a else m
 
+/-- Internal implementation detail of the hash map -/
+def alterₘ [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
+    (f : Option (β a) → Option (β a)) : Raw₀ α β :=
+  if h : m.containsₘ a then
+    let buckets' := updateBucket m.1.buckets m.2 a (fun l => l.alter a f)
+    let size' :=
+      if Raw₀.containsₘ ⟨withComputedSize buckets', by simpa [buckets'] using m.2⟩ a
+      then m.1.size else m.1.size - 1
+    ⟨⟨size', buckets'⟩, by simpa [buckets'] using m.2⟩
+  else
+    match f none with
+    | none => m
+    | some b => Raw₀.expandIfNecessary (m.consₘ a b)
+
+/-- Internal implementation detail of the hash map -/
+def modifyₘ [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α) (f : β a → β a) : Raw₀ α β :=
+  m.alterₘ a (·.map f)
+
+namespace Const
+
+variable {β : Type v}
+
+/-- Internal implementation detail of the hash map -/
+def alterₘ [BEq α] [Hashable α] (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : Option β → Option β) : Raw₀ α (fun _ => β) :=
+  if h : m.containsₘ a then
+    let buckets' := updateBucket m.1.buckets m.2 a (fun l => AssocList.Const.alter a f l)
+    let size' :=
+      if Raw₀.containsₘ ⟨withComputedSize buckets', by simpa [buckets'] using m.2⟩ a
+      then m.1.size else m.1.size - 1
+    ⟨⟨size', buckets'⟩, by simpa [buckets'] using m.2⟩
+  else
+    match f none with
+    | none => m
+    | some b => Raw₀.expandIfNecessary (m.consₘ a b)
+
+/-- Internal implementation detail of the hash map -/
+def modifyₘ [BEq α] [Hashable α] (m : Raw₀ α (fun _ => β)) (a : α) (f : β → β) :
+    Raw₀ α (fun _ => β) :=
+  alterₘ m a (fun option => option.map f)
+
+end Const
+
 /-- Internal implementation detail of the hash map -/
 def filterMapₘ (m : Raw₀ α β) (f : (a : α) → β a → Option (δ a)) : Raw₀ α δ :=
   ⟨withComputedSize (updateAllBuckets m.1.buckets fun l => l.filterMap f), by simpa using m.2⟩
@@ -391,6 +447,64 @@ theorem insert_eq_insertₘ [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) (
     simp only [Array.uset, Array.ugetElem_eq_getElem]
   · rfl
 
+theorem alter_eq_alterₘ [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
+    (f : Option (β a) → Option (β a)) : m.alter a f = m.alterₘ a f := by
+    dsimp only [alter, alterₘ, containsₘ, ← bucket_eq]
+    split
+    · congr 2
+      · simp only [withComputedSize, bucket_updateBucket]
+      · simp only [Array.uset, bucket, Array.ugetElem_eq_getElem, Array.set_set, updateBucket]
+    · congr
+
+theorem modify_eq_alter [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
+    (f : β a → β a) : m.modify a f = m.alter a (·.map f) := by
+  rw [modify, alter]
+  split
+  · dsimp
+    split
+    · next h =>
+      simp only [AssocList.contains_eq] at h
+      simp only [AssocList.modify_eq_alter, Array.set_set, AssocList.contains_eq,
+        containsKey_of_perm AssocList.toList_alter, ← modifyKey_eq_alterKey,
+        containsKey_modifyKey_self, h, ↓reduceIte]
+    · rfl
+
+theorem modify_eq_modifyₘ [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
+    (f : β a → β a) : m.modify a f = m.modifyₘ a f := by
+  rw [modify_eq_alter, alter_eq_alterₘ, modifyₘ]
+
+namespace Const
+
+variable {β : Type v}
+
+theorem alter_eq_alterₘ [BEq α] [Hashable α] [EquivBEq α] (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : Option β → Option β) : Const.alter m a f = Const.alterₘ m a f := by
+    dsimp only [alter, alterₘ, containsₘ, ← bucket_eq]
+    split
+    · congr 2
+      · simp only [withComputedSize, bucket_updateBucket]
+      · simp only [Array.uset, bucket, Array.ugetElem_eq_getElem, Array.set_set, updateBucket]
+    · congr
+
+theorem modify_eq_alter [BEq α] [Hashable α] [EquivBEq α] (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : β → β) : Const.modify m a f = Const.alter m a (·.map f) := by
+  rw [modify, alter]
+  split
+  · dsimp
+    split
+    · next h =>
+      simp only [AssocList.contains_eq] at h
+      simp only [AssocList.Const.modify_eq_alter, Array.set_set, AssocList.contains_eq,
+        containsKey_of_perm AssocList.Const.toList_alter, ← Const.modifyKey_eq_alterKey,
+        Const.containsKey_modifyKey_self, h, ↓reduceIte]
+    · rfl
+
+theorem modify_eq_modifyₘ [BEq α] [Hashable α] [EquivBEq α] (m : Raw₀ α (fun _ => β)) (a : α)
+    (f : β → β) : Const.modify m a f = Const.modifyₘ m a f := by
+  rw [modify_eq_alter, alter_eq_alterₘ, modifyₘ]
+
+end Const
+
 theorem containsThenInsert_eq_insertₘ [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) (b : β a) :
     (m.containsThenInsert a b).2 = m.insertₘ a b := by
   rw [containsThenInsert, insertₘ, containsₘ, bucket]

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

@@ -240,6 +240,12 @@ theorem toListModel_expandIfNecessary [BEq α] [Hashable α] [PartialEquivBEq α
   · dsimp
     exact toListModel_expand
 
+@[simp]
+theorem size_expandIfNecessary [BEq α] [Hashable α] {m : Raw₀ α β} :
+    (expandIfNecessary m).val.size = m.val.size := by
+  rw [expandIfNecessary]
+  split <;> rfl
+
 theorem wfImp_expandIfNecessary [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
     (h : Raw.WFImp m.1) : Raw.WFImp (expandIfNecessary m).1 := by
   rw [Raw₀.expandIfNecessary]
@@ -402,7 +408,7 @@ end
 theorem toListModel_replaceₘ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
    (h : Raw.WFImp m.1) (a : α) (b : β a) :
   Perm (toListModel (m.replaceₘ a b).1.buckets) (replaceEntry a b (toListModel m.1.2)) :=
-  toListModel_updateBucket h AssocList.toList_replace List.replaceEntry_of_perm
+  toListModel_updateBucket h (.of_eq AssocList.toList_replace) List.replaceEntry_of_perm
     List.replaceEntry_append_of_containsKey_right_eq_false
 
 theorem isHashSelf_replaceₘ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
@@ -422,7 +428,7 @@ theorem wfImp_replaceₘ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α
 theorem toListModel_consₘ [BEq α] [Hashable α] [PartialEquivBEq α] [LawfulHashable α]
     (m : Raw₀ α β) (h : Raw.WFImp m.1) (a : α) (b : β a) :
     Perm (toListModel (m.consₘ a b).1.buckets) (⟨a, b⟩ :: (toListModel m.1.2)) :=
-  toListModel_updateBucket h rfl (fun _ => Perm.cons _) (fun _ => cons_append _ _ _)
+  toListModel_updateBucket h .rfl (fun _ => Perm.cons _) (fun _ => cons_append _ _ _)
 
 theorem isHashSelf_consₘ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
     (h : Raw.WFImp m.1) (a : α) (b : β a) : IsHashSelf (m.consₘ a b).1.buckets := by
@@ -479,6 +485,225 @@ theorem wfImp_insert [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] {m
   rw [insert_eq_insertₘ]
   exact wfImp_insertₘ h
 
+/-! # `alter` -/
+
+theorem toListModel_updateBucket_alter [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β}
+    (h : Raw.WFImp m.1) {a : α} {f : Option (β a) → Option (β a)} :
+    Perm (toListModel (updateBucket m.1.buckets m.2 a (AssocList.alter a f)))
+      (alterKey a f (toListModel m.1.buckets)) := by
+  exact toListModel_updateBucket h AssocList.toList_alter List.alterKey_of_perm
+    List.alterKey_append_of_containsKey_right_eq_false
+
+theorem isHashSelf_updateBucket_alter [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β}
+    (h : Raw.WFImp m.1) {a : α} {f : Option (β a) → Option (β a)} :
+    IsHashSelf (updateBucket m.1.buckets m.2 a (AssocList.alter a f)) := by
+  apply h.buckets_hash_self.updateBucket (fun l p hp => ?_)
+  rw [AssocList.toList_alter.mem_iff] at hp
+  by_cases h : p.fst = a
+  · exact .inr <| congrArg hash h
+  · rw [mem_alterKey_of_key_ne _ h] at hp
+    exact .inl <| containsKey_of_mem hp
+
+theorem wfImp_updateBucket_alter [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β}
+    (h : Raw.WFImp m.1) {a : α} {f : Option (β a) → Option (β a)} :
+    Raw.WFImp (withComputedSize <| updateBucket m.1.buckets m.2 a (AssocList.alter a f)) where
+  buckets_hash_self := isHashSelf_updateBucket_alter h
+  size_eq := by rw [size_withComputedSize, computeSize_eq, buckets_withComputedSize]
+  distinct := DistinctKeys.perm (toListModel_updateBucket_alter h) h.distinct.alterKey
+
+theorem isHashSelf_alterₘ [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (h : Raw.WFImp m.1)
+    (a : α) (f : Option (β a) → Option (β a)) : IsHashSelf (m.alterₘ a f).1.buckets := by
+  dsimp only [alterₘ, withComputedSize]
+  split
+  · exact isHashSelf_updateBucket_alter h
+  · next hc =>
+    split
+    · exact h.buckets_hash_self
+    · refine (wfImp_expandIfNecessary _ (wfImp_consₘ _ h _ _ ?_)).buckets_hash_self
+      exact Bool.not_eq_true _ ▸ hc
+
+theorem toListModel_alterₘ [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} (h : Raw.WFImp m.1)
+    {a : α} {f : Option (β a) → Option (β a)} :
+    Perm (toListModel (m.alterₘ a f).1.2) (alterKey a f (toListModel m.1.2)) := by
+  rw [alterₘ]
+  split
+  · exact toListModel_updateBucket_alter h
+  · next hc =>
+    rw [Bool.not_eq_true, containsₘ_eq_containsKey h] at hc
+    rw [alterKey, getValueCast?_eq_none hc]
+    split
+    · next hn =>
+      simp only [hn]
+      rw [eraseKey_of_containsKey_eq_false]
+      exact hc
+    · next hs =>
+      simp only [hs]
+      refine Perm.trans (toListModel_expandIfNecessary _) ?_
+      refine Perm.trans (toListModel_consₘ m h _ _) ?_
+      rw [insertEntry_of_containsKey_eq_false]
+      exact hc
+
+theorem toListModel_alter [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} (h : Raw.WFImp m.1)
+    {a : α} {f : Option (β a) → Option (β a)} :
+    Perm (toListModel (m.alter a f).1.2) (alterKey a f (toListModel m.1.2)) := by
+  rw [alter_eq_alterₘ]
+  exact toListModel_alterₘ h
+
+theorem wfImp_alterₘ [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} (h : Raw.WFImp m.1) {a : α}
+    {f : Option (β a) → Option (β a)} : Raw.WFImp (m.alterₘ a f).1 where
+  buckets_hash_self := isHashSelf_alterₘ m h a f
+  distinct := DistinctKeys.perm (toListModel_alterₘ h) h.distinct.alterKey
+  size_eq := by
+    rw [← Perm.length_eq (toListModel_alterₘ h).symm, alterₘ]
+    split
+    · next h₁ =>
+      rw [containsₘ_eq_containsKey h] at h₁
+      simp only [length_alterKey, h.size_eq, dif_pos h₁]
+      rw [containsₘ_eq_containsKey (by apply wfImp_updateBucket_alter h)]
+      simp only [buckets_withComputedSize]
+      simp only [containsKey_of_perm <| toListModel_updateBucket_alter h]
+      rw [← getValueCast?_eq_some_getValueCast h₁]
+      conv => lhs; congr; rw [containsKey_alterKey_self h.distinct]
+    · next h₁ =>
+      rw [containsₘ_eq_containsKey h] at h₁
+      rw [alterKey]
+      rw [getValueCast?_eq_none <| Bool.not_eq_true _ ▸ h₁]
+      split
+      · next heq =>
+        rw [heq, h.size_eq, length_eraseKey, if_neg h₁]
+      · next heq =>
+        rw [heq, size_expandIfNecessary, consₘ, length_insertEntry, if_neg h₁, h.size_eq]
+
+theorem wfImp_alter [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β}
+    (h : Raw.WFImp m.1) {a : α} {f : Option (β a) → Option (β a)} : Raw.WFImp (m.alter a f).1 := by
+  rw [alter_eq_alterₘ]
+  exact wfImp_alterₘ h
+
+namespace Const
+
+variable {β : Type v}
+
+theorem toListModel_updateBucket_alter [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
+    {m : Raw₀ α (fun _ => β)} (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} :
+    Perm (toListModel (updateBucket m.1.buckets m.2 a (AssocList.Const.alter a f)))
+      (Const.alterKey a f (toListModel m.1.buckets)) := by
+  exact toListModel_updateBucket h AssocList.Const.toList_alter List.Const.alterKey_of_perm
+    List.Const.alterKey_append_of_containsKey_right_eq_false
+
+theorem isHashSelf_updateBucket_alter [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α]
+    {m : Raw₀ α (fun _ => β)} (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} :
+    IsHashSelf (updateBucket m.1.buckets m.2 a (AssocList.Const.alter a f)) := by
+  apply h.buckets_hash_self.updateBucket (fun l p hp => ?_)
+  rw [AssocList.Const.toList_alter.mem_iff] at hp
+  by_cases h : p.fst == a
+  · exact .inr <| hash_eq h
+  · rw [Bool.not_eq_true] at h
+    rw [Const.mem_alterKey_of_key_not_beq _ h] at hp
+    exact .inl <| containsKey_of_mem hp
+
+theorem wfImp_updateBucket_alter [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α]
+    {m : Raw₀ α (fun _ => β)} (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} :
+    Raw.WFImp (withComputedSize <| updateBucket m.1.buckets m.2 a (AssocList.Const.alter a f)) where
+  buckets_hash_self := isHashSelf_updateBucket_alter h
+  size_eq := by rw [size_withComputedSize, computeSize_eq]; rfl
+  distinct := DistinctKeys.perm (toListModel_updateBucket_alter h) h.distinct.constAlterKey
+
+theorem isHashSelf_alterₘ [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α]
+    (m : Raw₀ α (fun _ => β)) (h : Raw.WFImp m.1) (a : α) (f : Option β → Option β) :
+  IsHashSelf (Const.alterₘ m a f).1.buckets := by
+  dsimp only [alterₘ, withComputedSize]
+  split
+  · exact isHashSelf_updateBucket_alter h
+  · next hc =>
+    split
+    · exact h.buckets_hash_self
+    · refine (wfImp_expandIfNecessary _ (wfImp_consₘ _ h _ _ ?_)).buckets_hash_self
+      exact Bool.not_eq_true _ ▸ hc
+
+theorem toListModel_alterₘ [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α]
+    {m : Raw₀ α (fun _ => β)} (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} :
+    Perm (toListModel (Const.alterₘ m a f).1.2) (Const.alterKey a f (toListModel m.1.2)) := by
+  rw [Const.alterₘ]
+  split
+  · exact toListModel_updateBucket_alter h
+  · next hc =>
+    rw [Bool.not_eq_true, containsₘ_eq_containsKey h] at hc
+    rw [Const.alterKey, getValue?_eq_none.mpr hc]
+    split
+    · next hn =>
+      simp only [hn]
+      rw [eraseKey_of_containsKey_eq_false]
+      exact hc
+    · next hs =>
+      simp only [hs]
+      refine Perm.trans (toListModel_expandIfNecessary _) ?_
+      refine Perm.trans (toListModel_consₘ m h _ _) ?_
+      rw [insertEntry_of_containsKey_eq_false]
+      exact hc
+
+theorem wfImp_alterₘ [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α] {m : Raw₀ α (fun _ => β)}
+    (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} : Raw.WFImp (Const.alterₘ m a f).1 where
+  buckets_hash_self := isHashSelf_alterₘ m h a f
+  distinct := DistinctKeys.perm (toListModel_alterₘ h) h.distinct.constAlterKey
+  size_eq := by
+    rw [← Perm.length_eq (toListModel_alterₘ h).symm, alterₘ]
+    split
+    · next h₁ =>
+      rw [containsₘ_eq_containsKey h] at h₁
+      simp only [Const.length_alterKey, h.size_eq, dif_pos h₁]
+      rw [containsₘ_eq_containsKey (by apply wfImp_updateBucket_alter h)]
+      simp only [buckets_withComputedSize]
+      simp only [containsKey_of_perm <| toListModel_updateBucket_alter h]
+      rw [← getValue?_eq_some_getValue h₁]
+      conv => lhs; congr; rw [Const.containsKey_alterKey_self h.distinct]
+    · next h₁ =>
+      rw [containsₘ_eq_containsKey h] at h₁
+      rw [Const.alterKey]
+      rw [getValue?_eq_none.mpr <| Bool.not_eq_true _ ▸ h₁]
+      split
+      · next heq =>
+        rw [heq, h.size_eq, length_eraseKey, if_neg h₁]
+      · next heq =>
+        rw [heq, size_expandIfNecessary, consₘ, length_insertEntry, if_neg h₁, h.size_eq]
+
+theorem wfImp_alter [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α] {m : Raw₀ α (fun _ => β)}
+    (h : Raw.WFImp m.1) {a : α} {f : Option β → Option β} : Raw.WFImp (Const.alter m a f).1 := by
+  rw [Const.alter_eq_alterₘ]
+  exact wfImp_alterₘ h
+
+end Const
+
+/-! # `modify` -/
+
+theorem toListModel_modify [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} (h : Raw.WFImp m.1)
+    {a : α} {f : β a → β a} :
+    Perm (toListModel (m.modify a f).1.2) (modifyKey a f (toListModel m.1.2)) := by
+  rw [modify_eq_alter, modifyKey_eq_alterKey]
+  exact toListModel_alter h
+
+theorem wfImp_modifyₘ [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β}
+    (h : Raw.WFImp m.1) {a : α} {f : β a → β a} : Raw.WFImp (m.modifyₘ a f).1 := wfImp_alterₘ h
+
+theorem wfImp_modify [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} (h : Raw.WFImp m.1) {a : α}
+    {f : β a → β a} : Raw.WFImp (m.modify a f).1 := by
+  rw [modify_eq_modifyₘ]
+  exact wfImp_alterₘ h
+
+namespace Const
+
+variable {β : Type v}
+
+theorem wfImp_modifyₘ [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α] {m : Raw₀ α (fun _ => β)}
+    (h : Raw.WFImp m.1) {a : α} {f : β → β} : Raw.WFImp (Const.modifyₘ m a f).1 :=
+  Const.wfImp_alterₘ h
+
+theorem wfImp_modify [BEq α] [EquivBEq α] [Hashable α] [LawfulHashable α] {m : Raw₀ α (fun _ => β)}
+    (h : Raw.WFImp m.1) {a : α} {f : β → β} : Raw.WFImp (Const.modify m a f).1 := by
+  rw [Const.modify_eq_modifyₘ]
+  exact wfImp_alterₘ h
+
+end Const
+
 /-! # `containsThenInsert` -/
 
 theorem toListModel_containsThenInsert [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
@@ -574,7 +799,7 @@ theorem Const.wfImp_getThenInsertIfNew? {β : Type v} [BEq α] [Hashable α] [Eq
 theorem toListModel_eraseₘaux [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
     (a : α) (h : Raw.WFImp m.1) :
     Perm (toListModel (m.eraseₘaux a).1.buckets) (eraseKey a (toListModel m.1.buckets)) :=
-  toListModel_updateBucket h AssocList.toList_erase List.eraseKey_of_perm
+  toListModel_updateBucket h (.of_eq AssocList.toList_erase) List.eraseKey_of_perm
     List.eraseKey_append_of_containsKey_right_eq_false
 
 theorem isHashSelf_eraseₘaux [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] (m : Raw₀ α β)
@@ -747,6 +972,10 @@ theorem WF.out [BEq α] [Hashable α] [i₁ : EquivBEq α] [i₂ : LawfulHashabl
   · next h => exact Raw₀.wfImp_getThenInsertIfNew? (by apply h)
   · next h => exact Raw₀.wfImp_filter (by apply h)
   · next h => exact Raw₀.Const.wfImp_getThenInsertIfNew? (by apply h)
+  · next h => exact Raw₀.wfImp_modify (by apply h)
+  · next h => exact Raw₀.Const.wfImp_modify (by apply h)
+  · next h => exact Raw₀.wfImp_alter (by apply h)
+  · next h => exact Raw₀.Const.wfImp_alter (by apply h)
 
 end Raw
 
@@ -762,8 +991,8 @@ theorem Const.wfImp_insertMany {β : Type v} [BEq α] [Hashable α] [EquivBEq α
     {l : ρ} (h : Raw.WFImp m.1) : Raw.WFImp (Const.insertMany m l).1.1 :=
   Raw.WF.out ((Const.insertMany m l).2 _ Raw.WF.insert₀ (.wf m.2 h))
 
-theorem Const.wfImp_insertManyIfNewUnit [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] {ρ : Type w}
-    [ForIn Id ρ α] {m : Raw₀ α (fun _ => Unit)} {l : ρ} (h : Raw.WFImp m.1) :
+theorem Const.wfImp_insertManyIfNewUnit [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
+    {ρ : Type w} [ForIn Id ρ α] {m : Raw₀ α (fun _ => Unit)} {l : ρ} (h : Raw.WFImp m.1) :
     Raw.WFImp (Const.insertManyIfNewUnit m l).1.1 :=
   Raw.WF.out ((Const.insertManyIfNewUnit m l).2 _ Raw.WF.insertIfNew₀ (.wf m.2 h))
 

src/Std/Data/DHashMap/Raw.lean

@@ -509,6 +509,18 @@ inductive WF : {α : Type u} → {β : α → Type v} → [BEq α] → [Hashable
   /-- Internal implementation detail of the hash map -/
   | constGetThenInsertIfNew?₀ {α β} [BEq α] [Hashable α] {m : Raw α (fun _ => β)} {h a b} :
       WF m → WF (Raw₀.Const.getThenInsertIfNew? ⟨m, h⟩ a b).2.1
+  /-- Internal implementation detail of the hash map -/
+  | modify₀ {α β} [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} {h a} {f : β a → β a} :
+      WF m → WF (Raw₀.modify ⟨m, h⟩ a f).1
+  /-- Internal implementation detail of the hash map -/
+  | constModify₀ {α} {β : Type v} [BEq α] [Hashable α] {m : Raw α (fun _ => β)} {h a} {f : β → β} :
+      WF m → WF (Raw₀.Const.modify ⟨m, h⟩ a f).1
+  /-- Internal implementation detail of the hash map -/
+  | alter₀ {α β} [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} {h a}
+      {f : Option (β a) → Option (β a)} : WF m → WF (Raw₀.alter ⟨m, h⟩ a f).1
+  /-- Internal implementation detail of the hash map -/
+  | constAlter₀ {α} {β : Type v} [BEq α] [Hashable α] {m : Raw α (fun _ => β)} {h a}
+      {f : Option β → Option β} : WF m → WF (Raw₀.Const.alter ⟨m, h⟩ a f).1
 
 /-- Internal implementation detail of the hash map -/
 theorem WF.size_buckets_pos [BEq α] [Hashable α] (m : Raw α β) : WF m → 0 < m.buckets.size
@@ -522,6 +534,10 @@ theorem WF.size_buckets_pos [BEq α] [Hashable α] (m : Raw α β) : WF m → 0
   | getThenInsertIfNew?₀ _ => (Raw₀.getThenInsertIfNew? ⟨_, _⟩ _ _).2.2
   | filter₀ _ => (Raw₀.filter _ ⟨_, _⟩).2
   | constGetThenInsertIfNew?₀ _ => (Raw₀.Const.getThenInsertIfNew? ⟨_, _⟩ _ _).2.2
+  | modify₀ _ => (Raw₀.modify _ _ _).2
+  | constModify₀ _ => (Raw₀.Const.modify _ _ _).2
+  | alter₀ _ => (Raw₀.alter _ _ _).2
+  | constAlter₀ _ => (Raw₀.Const.alter _ _ _).2
 
 @[simp] theorem WF.empty [BEq α] [Hashable α] {c : Nat} : (Raw.empty c : Raw α β).WF :=
   .empty₀

src/Std/Data/HashMap/Basic.lean

@@ -245,21 +245,13 @@ instance [BEq α] [Hashable α] {m : Type w → Type w} : ForIn m (HashMap α β
     Array β :=
   m.inner.valuesArray
 
-@[inline, inherit_doc DHashMap.modify] def modify (m : HashMap α β) (a : α) (f : β → β) : HashMap α β :=
-  match m.get? a with
-  | none => m
-  | some b => m.erase a |>.insert a (f b)
+@[inline, inherit_doc DHashMap.modify] def modify (m : HashMap α β) (a : α) (f : β → β) :
+    HashMap α β :=
+  ⟨DHashMap.Const.modify m.inner a f⟩
 
-@[inline, inherit_doc DHashMap.alter] def alter (m : HashMap α β) (a : α) (f : Option β → Option β) : HashMap α β :=
-  match m.get? a with
-  | none =>
-    match f none with
-    | none => m
-    | some b => m.insert a b
-  | some b =>
-    match f (some b) with
-    | none => m.erase a
-    | some b => m.erase a |>.insert a b
+@[inline, inherit_doc DHashMap.alter] def alter (m : HashMap α β) (a : α)
+    (f : Option β → Option β) : HashMap α β :=
+  ⟨DHashMap.Const.alter m.inner a f⟩
 
 @[inline, inherit_doc DHashMap.Const.insertMany] def insertMany {ρ : Type w}
     [ForIn Id ρ (α × β)] (m : HashMap α β) (l : ρ) : HashMap α β :=

src/Std/Internal.lean

@@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Henrik Böving
 -/
 prelude
+import Std.Internal.Async
 import Std.Internal.Parsec
+import Std.Internal.UV
 
 /-!
 This directory is used for components of the standard library that are either considered

src/Std/Internal/Async.lean

@@ -0,0 +1,8 @@
+/-
+Copyright (c) 2024 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.Internal.Async.Basic
+import Std.Internal.Async.Timer

src/Std/Internal/Async/Basic.lean

@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Henrik Böving
+-/
+prelude
+import Init.Core
+import Init.System.IO
+import Init.System.Promise
+
+namespace Std
+namespace Internal
+namespace IO
+namespace Async
+
+/--
+A `Task` that may resolve to a value or an `IO.Error`.
+-/
+def AsyncTask (α : Type u) : Type u := Task (Except IO.Error α)
+
+namespace AsyncTask
+
+/--
+Construct an `AsyncTask` that is already resolved with value `x`.
+-/
+@[inline]
+protected def pure (x : α) : AsyncTask α := Task.pure <| .ok x
+
+instance : Pure AsyncTask where
+  pure := AsyncTask.pure
+
+/--
+Create a new `AsyncTask` that will run after `x` has finished.
+If `x`:
+- errors, return an `AsyncTask` that resolves to the error.
+- succeeds, run `f` on the result of `x` and return the `AsyncTask` produced by `f`.
+-/
+@[inline]
+protected def bind (x : AsyncTask α) (f : α → AsyncTask β) : AsyncTask β :=
+  Task.bind x fun r =>
+    match r with
+    | .ok a => f a
+    | .error e => Task.pure <| .error e
+
+/--
+Create a new `AsyncTask` that will run after `x` has finished.
+If `x`:
+- errors, return an `AsyncTask` that reolves to the error.
+- succeeds, return an `AsyncTask` that resolves to `f x`.
+-/
+@[inline]
+def map (f : α → β) (x : AsyncTask α) : AsyncTask β :=
+  Task.map (x := x) fun r =>
+    match r with
+    | .ok a => .ok (f a)
+    | .error e => .error e
+
+/--
+Similar to `bind`, however `f` has access to the `IO` monad. If `f` throws an error, the returned
+`AsyncTask` resolves to that error.
+-/
+@[inline]
+def bindIO (x : AsyncTask α) (f : α → IO (AsyncTask β)) : BaseIO (AsyncTask β) :=
+  IO.bindTask x fun r =>
+    match r with
+    | .ok a => f a
+    | .error e => .error e
+
+/--
+Similar to `bind`, however `f` has access to the `IO` monad. If `f` throws an error, the returned
+`AsyncTask` resolves to that error.
+-/
+@[inline]
+def mapIO (f : α → IO β) (x : AsyncTask α) : BaseIO (AsyncTask β) :=
+  IO.mapTask (t := x) fun r =>
+    match r with
+    | .ok a => f a
+    | .error e => .error e
+
+/--
+Block until the `AsyncTask` in `x` finishes.
+-/
+def block (x : AsyncTask α) : IO α := do
+  let res := x.get
+  match res with
+  | .ok a => return a
+  | .error e => .error e
+
+/--
+Create an `AsyncTask` that resolves to the value of `x`.
+-/
+@[inline]
+def ofPromise (x : IO.Promise (Except IO.Error α)) : AsyncTask α :=
+  x.result
+
+/--
+Create an `AsyncTask` that resolves to the value of `x`.
+-/
+@[inline]
+def ofPurePromise (x : IO.Promise α) : AsyncTask α :=
+  x.result.map pure
+
+/--
+Obtain the `IO.TaskState` of `x`.
+-/
+@[inline]
+def getState (x : AsyncTask α) : BaseIO IO.TaskState :=
+  IO.getTaskState x
+
+end AsyncTask
+
+end Async
+end IO
+end Internal
+end Std

src/Std/Internal/Async/Timer.lean

@@ -0,0 +1,139 @@
+/-
+Copyright (c) 2024 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.Time
+import Std.Internal.UV
+import Std.Internal.Async.Basic
+
+
+namespace Std
+namespace Internal
+namespace IO
+namespace Async
+
+/--
+`Sleep` can be used to sleep for some duration once.
+The underlying timer has millisecond resolution.
+-/
+structure Sleep where
+  private ofNative ::
+    native : Internal.UV.Timer
+
+namespace Sleep
+
+/--
+Set up a `Sleep` that waits for `duration` milliseconds.
+This function only initializes but does not yet start the timer.
+-/
+@[inline]
+def mk (duration : Std.Time.Millisecond.Offset) : IO Sleep := do
+  let native ← Internal.UV.Timer.mk duration.toInt.toNat.toUInt64 false
+  return ofNative native
+
+/--
+If:
+- `s` is not yet running start it and return an `AsyncTask` that will resolve once the previously
+   configured `duration` has run out.
+- `s` is already or not anymore running return the same `AsyncTask` as the first call to `wait`.
+-/
+@[inline]
+def wait (s : Sleep) : IO (AsyncTask Unit) := do
+  let promise ← s.native.next
+  return .ofPurePromise promise
+
+/--
+If:
+- `s` is still running the timer restarts counting from now and finishes after `duration`
+  milliseconds.
+- `s` is not yet or not anymore running this is a no-op.
+-/
+@[inline]
+def reset (s : Sleep) : IO Unit :=
+  s.native.reset
+
+/--
+If:
+- `s` is still running this stops `s` without resolving any remaining `AsyncTask`s that were created
+  through `wait`. Note that if another `AsyncTask` is binding on any of these it is going hang
+  forever without further intervention.
+- `s` is not yet or not anymore running this is a no-op.
+-/
+@[inline]
+def stop (s : Sleep) : IO Unit :=
+  s.native.stop
+
+end Sleep
+
+/--
+Return an `AsyncTask` that resolves after `duration`.
+-/
+def sleep (duration : Std.Time.Millisecond.Offset) : IO (AsyncTask Unit) := do
+  let sleeper ← Sleep.mk duration
+  sleeper.wait
+
+/--
+`Interval` can be used to repeatedly wait for some duration like a clock.
+The underlying timer has millisecond resolution.
+-/
+structure Interval where
+  private ofNative ::
+    native : Internal.UV.Timer
+
+
+namespace Interval
+
+/--
+Setup up an `Interval` that waits for `duration` milliseconds.
+This function only initializes but does not yet start the timer.
+-/
+@[inline]
+def mk (duration : Std.Time.Millisecond.Offset) (_ : 0 < duration := by decide) : IO Interval := do
+  let native ← Internal.UV.Timer.mk duration.toInt.toNat.toUInt64 true
+  return ofNative native
+
+/--
+If:
+- `i` is not yet running start it and return an `AsyncTask` that resolves right away as the 0th
+  multiple of `duration` has elapsed.
+- `i` is already running and:
+  - the tick from the last call of `i` has not yet finished return the same `AsyncTask` as the last
+    call
+  - the tick frrom the last call of `i` has finished return a new `AsyncTask` that waits for the
+    closest next tick from the time of calling this function.
+- `i` is not running aymore this is a no-op.
+-/
+@[inline]
+def tick (i : Interval) : IO (AsyncTask Unit) := do
+  let promise ← i.native.next
+  return .ofPurePromise promise
+
+/--
+If:
+- `Interval.tick` was called on `i` before the timer restarts counting from now and the next tick
+   happens in `duration`.
+- `i` is not yet or not anymore running this is a no-op.
+-/
+@[inline]
+def reset (i : Interval) : IO Unit :=
+  i.native.reset
+
+/--
+If:
+- `i` is still running this stops `i` without resolving any remaing `AsyncTask` that were created
+  through `tick`. Note that if another `AsyncTask` is binding on any of these it is going hang
+  forever without further intervention.
+- `i` is not yet or not anymore running this is a no-op.
+-/
+@[inline]
+def stop (i : Interval) : IO Unit :=
+  i.native.stop
+
+end Interval
+
+end Async
+end IO
+end Internal
+end Std

src/Std/Internal/UV.lean

@@ -0,0 +1,119 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sofia Rodrigues
+-/
+prelude
+import Init.System.IO
+import Init.System.Promise
+
+namespace Std
+namespace Internal
+namespace UV
+
+namespace Loop
+
+/--
+Options for configuring the event loop behavior.
+-/
+structure Loop.Options where
+  /--
+  Accumulate the amount of idle time the event loop spends in the event provider.
+  -/
+  accumulateIdleTime : Bool := False
+
+  /--
+  Block a SIGPROF signal when polling for new events. It's commonly used for unnecessary wakeups
+  when using a sampling profiler.
+  -/
+  blockSigProfSignal : Bool := False
+
+/--
+Configures the event loop with the specified options.
+-/
+@[extern "lean_uv_event_loop_configure"]
+opaque configure (options : Loop.Options) : BaseIO Unit
+
+/--
+Checks if the event loop is still active and processing events.
+-/
+@[extern "lean_uv_event_loop_alive"]
+opaque alive : BaseIO Bool
+
+end Loop
+
+private opaque TimerImpl : NonemptyType.{0}
+
+/--
+`Timer`s are used to generate `IO.Promise`s that resolve after some time.
+
+A `Timer` can be in one of 3 states:
+- Right after construction it's initial.
+- While it is ticking it's running.
+- If it has stopped for some reason it's finished.
+
+This together with whether it was set up as `repeating` with `Timer.new` determines the behavior
+of all functions on `Timer`s.
+-/
+def Timer : Type := TimerImpl.type
+
+instance : Nonempty Timer := TimerImpl.property
+
+namespace Timer
+
+/--
+This creates a `Timer` in the initial state and doesn't run it yet.
+- If `repeating` is `false` this constructs a timer that resolves once after `durationMs`
+  milliseconds, counting from when it's run.
+- If `repeating` is `true` this constructs a timer that resolves after multiples of `durationMs`
+  milliseconds, counting from when it's run. Note that this includes the 0th multiple right after
+  starting the timer. Furthermore a repeating timer will only be freed after `Timer.stop` is called.
+-/
+@[extern "lean_uv_timer_mk"]
+opaque mk (timeout : UInt64) (repeating : Bool) : IO Timer
+
+/--
+This function has different behavior depending on the state and configuration of the `Timer`:
+- if `repeating` is `false` and:
+  - it is initial, run it and return a new `IO.Promise` that is set to resolve once `durationMs`
+    milliseconds have elapsed. After this `IO.Promise` is resolved the `Timer` is finished.
+  - it is running or finished, return the same `IO.Promise` that the first call to `next` returned.
+- if `repeating` is `true` and:
+  - it is initial, run it and return a new `IO.Promise` that resolves right away
+    (as it is the 0th multiple of `durationMs`).
+  - it is running, check whether the last returned `IO.Promise` is already resolved:
+     - If it is, return a new `IO.Promise` that resolves upon finishing the next cycle
+     - If it is not, return the last `IO.Promise`
+     This ensures that the returned `IO.Promise` resolves at the next repetition of the timer.
+  - if it is finished, return the last `IO.Promise` created by `next`. Notably this could be one
+    that never resolves if the timer was stopped before fulfilling the last one.
+-/
+@[extern "lean_uv_timer_next"]
+opaque next (timer : @& Timer) : IO (IO.Promise Unit)
+
+/--
+This function has different behavior depending on the state and configuration of the `Timer`:
+- If it is initial or finished this is a no-op.
+- If it is running and `repeating` is `false` this will delay the resolution of the timer until
+  `durationMs` milliseconds after the call of this function.
+- Delay the resolution of the next tick of the timer until `durationMs` milliseconds after the
+  call of this function, then continue normal ticking behavior from there.
+-/
+@[extern "lean_uv_timer_reset"]
+opaque reset (timer : @& Timer) : IO Unit
+
+/--
+This function has different behavior depending on the state of the `Timer`:
+- If it is initial or finished this is a no-op.
+- If it is running the execution of the timer is stopped and it is put into the finished state.
+  Note that if the last `IO.Promise` generated by `next` is unresolved and being waited
+  on this creates a memory leak and the waiting task is not going to be awoken anymore.
+-/
+@[extern "lean_uv_timer_stop"]
+opaque stop (timer : @& Timer) : IO Unit
+
+end Timer
+
+end UV
+end Internal
+end Std

src/Std/Tactic/BVDecide/Normalize/BitVec.lean

@@ -22,13 +22,20 @@ section Reduce
 attribute [bv_normalize] BitVec.sub_toAdd
 
 @[bv_normalize]
-theorem BitVec.le_ult (x y : BitVec w) : (x ≤ y) = ¬(y < x) := by
-  simp only [(· ≤ ·), (· < ·)]
-  simp
+theorem BitVec.le_ult (x y : BitVec w) : (x ≤ y) ↔ ((!y.ult x) = true) := by
+  have : x ≤ y ↔ (x.ule y = true) := by
+    simp [BitVec.le_def, BitVec.ule]
+  rw [this, BitVec.ule_eq_not_ult]
+
 attribute [bv_normalize] BitVec.ule_eq_not_ult
 
-attribute [bv_normalize] gt_iff_lt
-attribute [bv_normalize] ge_iff_le
+@[bv_normalize]
+theorem BitVec.gt_ult (x y : BitVec w) : x > y ↔ (y.ult x = true) := by
+  simp [BitVec.lt_ult]
+
+@[bv_normalize]
+theorem BitVec.ge_ule (x y : BitVec w) : x ≥ y ↔ ((!x.ult y) = true) := by
+  simp [BitVec.le_ult]
 
 @[bv_normalize]
 theorem BitVec.truncate_eq_zeroExtend (x : BitVec w) : x.truncate n = x.zeroExtend n := by
@@ -36,8 +43,16 @@ theorem BitVec.truncate_eq_zeroExtend (x : BitVec w) : x.truncate n = x.zeroExte
 
 attribute [bv_normalize] BitVec.extractLsb
 attribute [bv_normalize] BitVec.msb_eq_getLsbD_last
-attribute [bv_normalize] BitVec.slt_eq_ult
-attribute [bv_normalize] BitVec.sle_eq_not_slt
+
+@[bv_normalize]
+theorem BitVec.slt_eq_ult (x y : BitVec w) :
+    x.slt y = ((!x.getLsbD (w - 1) == y.getLsbD (w - 1)) ^^ x.ult y) := by
+  simp [_root_.BitVec.slt_eq_ult, BitVec.msb_eq_getLsbD_last, Bool.bne_to_beq]
+
+@[bv_normalize]
+theorem BitVec.sle_eq_ult (x y : BitVec w) :
+    x.sle y = !((!x.getLsbD (w - 1) == y.getLsbD (w - 1)) ^^ y.ult x) := by
+  rw [BitVec.sle_eq_not_slt, BitVec.slt_eq_ult, Bool.beq_comm]
 
 attribute [bv_normalize] BitVec.ofNat_eq_ofNat
 
@@ -46,42 +61,40 @@ theorem BitVec.ofNatLt_reduce (n : Nat) (h) : BitVec.ofNatLt n h = BitVec.ofNat
   simp [BitVec.ofNatLt, BitVec.ofNat, Fin.ofNat', Nat.mod_eq_of_lt h]
 
 @[bv_normalize]
-theorem BitVec.ofBool_eq_if (b : Bool) : BitVec.ofBool b = if b then 1#1 else 0#1 := by
+theorem BitVec.ofBool_eq_if (b : Bool) : BitVec.ofBool b = bif b then 1#1 else 0#1 := by
   revert b
   decide
 
 @[bv_normalize]
 theorem BitVec.sdiv_udiv (x y : BitVec w) :
     x.sdiv y =
-      if x.msb then
-        if y.msb then
+      bif x.getLsbD (w - 1) then
+        bif y.getLsbD (w - 1) then
           (-x) / (-y)
         else
           -((-x) / y)
       else
-        if y.msb then
+        bif y.getLsbD (w - 1) then
           -(x / (-y))
         else
           x / y := by
-  rw [BitVec.sdiv_eq]
+  rw [BitVec.sdiv_eq, ← BitVec.msb_eq_getLsbD_last, ← BitVec.msb_eq_getLsbD_last]
   cases x.msb <;> cases y.msb <;> simp
 
 @[bv_normalize]
 theorem BitVec.smod_umod (x y : BitVec w) :
     x.smod y =
-      if x.msb then
-        if y.msb then
-          - ((- x).umod (- y))
+      bif x.getLsbD (w - 1) then
+        bif y.getLsbD (w - 1) then
+          - ((- x) % (- y))
         else
-          let u := (- x).umod y
-          (if u = 0#w then u else y - u)
+          (bif (- x) % y == 0#w then (- x) % y else y - (- x) % y)
       else
-        if y.msb then
-          let u := x.umod (- y)
-          (if u = 0#w then u else u + y)
+        bif y.getLsbD (w - 1) then
+          (bif x % (- y) == 0#w then x % (- y) else x % (- y) + y)
         else
           x.umod y := by
-  rw [BitVec.smod_eq]
+  rw [BitVec.smod_eq, ← BitVec.msb_eq_getLsbD_last, ← BitVec.msb_eq_getLsbD_last]
   cases x.msb <;> cases y.msb <;> simp
 
 attribute [bv_normalize] BitVec.smtUDiv_eq
@@ -89,36 +102,39 @@ attribute [bv_normalize] BitVec.smtUDiv_eq
 @[bv_normalize]
 theorem BitVec.smtSDiv_smtUDiv (x y : BitVec w) :
     x.smtSDiv y =
-      if x.msb then
-        if y.msb then
+      bif x.getLsbD (w - 1) then
+        bif y.getLsbD (w - 1) then
           (-x).smtUDiv (-y)
         else
           -((-x).smtUDiv y)
       else
-        if y.msb then
+        bif y.getLsbD (w - 1) then
           -(x.smtUDiv (-y))
         else
           x.smtUDiv y := by
-  rw [BitVec.smtSDiv_eq]
+  rw [BitVec.smtSDiv_eq, ← BitVec.msb_eq_getLsbD_last, ← BitVec.msb_eq_getLsbD_last]
   cases x.msb <;> cases y.msb <;> simp
 
 @[bv_normalize]
 theorem BitVec.srem_umod (x y : BitVec w) :
     x.srem y =
-      if x.msb then
-        if y.msb then
+      bif x.getLsbD (w - 1) then
+        bif y.getLsbD (w - 1) then
           -((-x) % (-y))
         else
           -((-x) % y)
       else
-        if y.msb then
+        bif y.getLsbD (w - 1) then
           x % (-y)
         else
           x % y := by
-  rw [BitVec.srem_eq]
+  rw [BitVec.srem_eq, ← BitVec.msb_eq_getLsbD_last, ← BitVec.msb_eq_getLsbD_last]
   cases x.msb <;> cases y.msb <;> simp
 
-attribute [bv_normalize] BitVec.abs_eq
+@[bv_normalize]
+theorem BitVec.abs_eq (x : BitVec w) : x.abs = bif x.getLsbD (w - 1) then -x else x := by
+  simp [_root_.BitVec.abs_eq, BitVec.msb_eq_getLsbD_last]
+
 attribute [bv_normalize] BitVec.twoPow_eq
 
 @[bv_normalize]
@@ -268,7 +284,7 @@ theorem BitVec.zero_lt_iff_zero_neq (a : BitVec w) : (0#w < a) ↔ (a ≠ 0#w) :
     omega
 
 @[bv_normalize]
-theorem BitVec.zero_ult' (a : BitVec w) : (BitVec.ult 0#w a) = (a != 0#w) := by
+theorem BitVec.zero_ult' (a : BitVec w) : (BitVec.ult 0#w a) = (!a == 0#w) := by
   have := BitVec.zero_lt_iff_zero_neq a
   rw [BitVec.lt_ult] at this
   match h:BitVec.ult 0#w a with
@@ -284,7 +300,7 @@ theorem BitVec.max_ult (a : BitVec w) : ¬ ((-1#w) < a) := by
     · omega
     · apply Nat.sub_one_lt_of_le (Nat.pow_pos (by omega)) (Nat.le_refl ..)
 
-@[bv_normalize]
+-- used in simproc because of -1#w normalisation
 theorem BitVec.max_ult' (a : BitVec w) : (BitVec.ult (-1#w) a) = false := by
   have := BitVec.max_ult a
   rw [BitVec.lt_ult] at this

src/Std/Tactic/BVDecide/Normalize/Bool.lean

@@ -20,9 +20,10 @@ attribute [bv_normalize] Bool.and_true
 attribute [bv_normalize] Bool.true_and
 attribute [bv_normalize] Bool.and_false
 attribute [bv_normalize] Bool.false_and
-attribute [bv_normalize] beq_self_eq_true'
 attribute [bv_normalize] Bool.true_beq
+attribute [bv_normalize] beq_true
 attribute [bv_normalize] Bool.false_beq
+attribute [bv_normalize] beq_false
 attribute [bv_normalize] Bool.beq_not_self
 attribute [bv_normalize] Bool.not_beq_self
 attribute [bv_normalize] Bool.beq_self_left
@@ -40,10 +41,7 @@ attribute [bv_normalize] Bool.xor_not_self
 attribute [bv_normalize] Bool.not_not
 attribute [bv_normalize] Bool.and_self_left
 attribute [bv_normalize] Bool.and_self_right
-attribute [bv_normalize] eq_self
 attribute [bv_normalize] Bool.cond_self
-attribute [bv_normalize] cond_false
-attribute [bv_normalize] cond_true
 attribute [bv_normalize] Bool.cond_not
 
 @[bv_normalize]

src/Std/Tactic/BVDecide/Normalize/Canonicalize.lean

@@ -32,10 +32,6 @@ theorem BitVec.bne_to_beq (a b : BitVec w) : (a != b) = (!(a == b)) := by
 theorem Bool.bne_to_beq (a b : Bool) : (a != b) = (!(a == b)) := by
   simp [bne]
 
-@[bv_normalize]
-theorem Bool.eq_false_to_beq (a : Bool) : (a = false) = ((!a) = true) := by
-  simp
-
 @[bv_normalize]
 theorem Bool.neg_to_not (a : Bool) : (¬a) = ((!a) = true) := by
   simp
@@ -72,8 +68,8 @@ theorem Bool.decide_eq_true (a : Bool) : (decide (a = true)) = a := by
   simp
 
 @[bv_normalize]
-theorem Bool.eq_true_eq_true_eq (x y : Bool) : ((x = true) = (y = true)) = (x = y) :=
-  by simp
+theorem Bool.eq_true_eq_true_eq (x y : Bool) : ((x = true) = (y = true)) ↔ ((x == y) = true) := by
+  simp
 
 attribute [bv_normalize] BitVec.getLsbD_cast
 attribute [bv_normalize] BitVec.testBit_toNat

src/Std/Tactic/BVDecide/Normalize/Equal.lean

@@ -14,10 +14,7 @@ This module contains the equality simplifying part of the `bv_normalize` simp se
 namespace Std.Tactic.BVDecide
 namespace Frontend.Normalize
 
-attribute [bv_normalize] beq_true
-attribute [bv_normalize] Bool.true_beq
-attribute [bv_normalize] beq_false
-attribute [bv_normalize] Bool.false_beq
+attribute [bv_normalize] eq_self
 attribute [bv_normalize] beq_self_eq_true
 attribute [bv_normalize] beq_self_eq_true'
 

src/Std/Time/Date/Unit/Month.lean

@@ -73,7 +73,7 @@ Creates an `Offset` from a natural number.
 -/
 @[inline]
 def ofNat (data : Nat) : Offset :=
-  .ofNat data
+  Int.ofNat data
 
 /--
 Creates an `Offset` from an integer.