feat: add grind configuration options to control case-splitting

This PR adds the following configuration options to `Grind.Config`:
`splitIte`, `splitMatch`, and `splitIndPred`.

doc/dev/release_checklist.md

@@ -5,11 +5,6 @@ See below for the checklist for release candidates.
 
 We'll use `v4.6.0` as the intended release version as a running example.
 
-- One week before the planned release, ensure that
-  (1) someone has written the release notes and
-  (2) someone has written the first draft of the release blog post.
-  If there is any material in `./releases_drafts/` on the `releases/v4.6.0` branch, then the release notes are not done.
-  (See the section "Writing the release notes".)
 - `git checkout releases/v4.6.0`
   (This branch should already exist, from the release candidates.)
 - `git pull`
@@ -81,12 +76,16 @@ We'll use `v4.6.0` as the intended release version as a running example.
       - Toolchain bump PR including updated Lake manifest
       - Create and push the tag
       - There is no `stable` branch; skip this step
+    - [plausible](https://github.com/leanprover-community/plausible)
+      - Toolchain bump PR including updated Lake manifest
+      - Create and push the tag
+      - There is no `stable` branch; skip this step
     - [Mathlib](https://github.com/leanprover-community/mathlib4)
       - Dependencies: `Aesop`, `ProofWidgets4`, `lean4checker`, `Batteries`, `doc-gen4`, `import-graph`
       - Toolchain bump PR notes:
         - In addition to updating the `lean-toolchain` and `lakefile.lean`,
           in `.github/workflows/lean4checker.yml` update the line
-          `git checkout v4.6.0` to the appropriate tag. 
+          `git checkout v4.6.0` to the appropriate tag.
         - Push the PR branch to the main Mathlib repository rather than a fork, or CI may not work reliably
         - Create and push the tag
         - Create a new branch from the tag, push it, and open a pull request against `stable`.
@@ -98,6 +97,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
       - Toolchain bump PR including updated Lake manifest
       - Create and push the tag
       - Merge the tag into `stable`
+- Run `scripts/release_checklist.py v4.6.0` to check that everything is in order.
 - The `v4.6.0` section of `RELEASES.md` is out of sync between
   `releases/v4.6.0` and `master`. This should be reconciled:
   - Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
@@ -139,16 +139,13 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
     git checkout -b releases/v4.7.0
     ```
 - In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
-- We will rely on automatically generated release notes for release candidates,
-  and the written release notes will be used for stable versions only.
-  It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
+- It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
 - In `src/CMakeLists.txt`,
   - verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
   - `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
   - Commit your changes to `src/CMakeLists.txt`, and push.
 - `git tag v4.7.0-rc1`
 - `git push origin v4.7.0-rc1`
-- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
 - Now wait, while CI runs.
   - You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
   - This step can take up to an hour.
@@ -248,15 +245,12 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
 
 # Writing the release notes
 
-We are currently trying a system where release notes are compiled all at once from someone looking through the commit history.
-The exact steps are a work in progress.
-Here is the general idea:
+Release notes are automatically generated from the commit history, using `script/release_notes.py`.
 
-* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
-  The release notes for `v4.6.0` will later be copied to `master` when we begin a new development cycle.
-* There can be material for release notes entries in commit messages.
-* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
+Run this as `script/release_notes.py v4.6.0`, where `v4.6.0` is the *previous* release version. This will generate output
+for all commits since that tag. Note that there is output on both stderr, which should be manually reviewed,
+and on stdout, which should be manually copied to `RELEASES.md`.
+
+There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
   See `./releases_drafts/README.md` for more information.
-* The release notes should be written from a downstream expert user's point of view.
 
-This section will be updated when the next release notes are written (for `v4.10.0`).

releases_drafts/list_lex.md

@@ -1,16 +0,0 @@
-We replace the inductive predicate `List.lt` with an upstreamed version of `List.Lex` from Mathlib.
-(Previously `Lex.lt` was defined in terms of `<`; now it is generalized to take an arbitrary relation.)
-This subtely changes the notion of ordering on `List α`.
-
-`List.lt` was a weaker relation: in particular if `l₁ < l₂`, then
-`a :: l₁ < b :: l₂` may hold according to `List.lt` even if `a` and `b` are merely incomparable
-(either neither `a < b` nor `b < a`), whereas according to `List.Lex` this would require `a = b`.
-
-When `<` is total, in the sense that `¬ · < ·` is antisymmetric, then the two relations coincide.
-
-Mathlib was already overriding the order instances for `List α`,
-so this change should not be noticed by anyone already using Mathlib.
-
-We simultaneously add the boolean valued `List.lex` function, parameterised by a `BEq` typeclass
-and an arbitrary `lt` function. This will support the flexibility previously provided for `List.lt`,
-via a `==` function which is weaker than strict equality.

script/prepare-llvm-linux.sh

@@ -63,8 +63,8 @@ else
 fi
 # use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
 # but do not change sysroot so users can still link against system libs
-echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
-echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
+echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
+echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
 # when not using the above flags, link GMP dynamically/as usual
 echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
 # do not set `LEAN_CC` for tests

script/prepare-llvm-macos.sh

@@ -48,12 +48,11 @@ if [[ -L llvm-host ]]; then
   echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang"
   gcp $GMP/lib/libgmp.a stage1/lib/
   gcp $LIBUV/lib/libuv.a stage1/lib/
-  echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
   echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv'"
 else
   echo -n " -DCMAKE_C_COMPILER=$PWD/llvm-host/bin/clang -DLEANC_OPTS='--sysroot $PWD/stage1 -resource-dir $PWD/stage1/lib/clang/15.0.1 ${EXTRA_FLAGS:-}'"
-  echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
 fi
-echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
+echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
+echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
 # do not set `LEAN_CC` for tests
 echo -n " -DLEAN_TEST_VARS=''"

script/prepare-llvm-mingw.sh

@@ -43,7 +43,7 @@ echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=
 echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
 echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
 echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
-echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
+echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
 # when not using the above flags, link GMP dynamically/as usual. Always link ICU dynamically.
 echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
 # do not set `LEAN_CC` for tests

script/release_checklist.py

@@ -0,0 +1,132 @@
+#!/usr/bin/env python3
+
+import argparse
+import yaml
+import requests
+import base64
+import subprocess
+import sys
+import os
+
+def parse_repos_config(file_path):
+    with open(file_path, "r") as f:
+        return yaml.safe_load(f)["repositories"]
+
+def get_github_token():
+    try:
+        import subprocess
+        result = subprocess.run(['gh', 'auth', 'token'], capture_output=True, text=True)
+        if result.returncode == 0:
+            return result.stdout.strip()
+    except FileNotFoundError:
+        print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
+    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 {}
+    response = requests.get(api_url, headers=headers)
+    if response.status_code == 200:
+        content = response.json().get("content", "")
+        content = content.replace("\n", "")
+        try:
+            return base64.b64decode(content).decode('utf-8').strip()
+        except Exception:
+            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 is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
+    # First get the commit SHA for the tag
+    api_base = repo_url.replace("https://github.com/", "https://api.github.com/repos/")
+    headers = {'Authorization': f'token {github_token}'} if github_token else {}
+
+    # Get tag's commit SHA
+    tag_response = requests.get(f"{api_base}/git/refs/tags/{tag_name}", headers=headers)
+    if tag_response.status_code != 200:
+        return False
+    tag_sha = tag_response.json()['object']['sha']
+
+    # Get commits on stable branch containing this SHA
+    commits_response = requests.get(
+        f"{api_base}/commits?sha={stable_branch}&per_page=100",
+        headers=headers
+    )
+    if commits_response.status_code != 200:
+        return False
+
+    # Check if any commit in stable's history matches our tag's SHA
+    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 main():
+    github_token = get_github_token()
+
+    if len(sys.argv) != 2:
+        print("Usage: python3 release_checklist.py <toolchain>")
+        sys.exit(1)
+
+    toolchain = sys.argv[1]
+
+    with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
+        repos = yaml.safe_load(f)["repositories"]
+
+    for repo in repos:
+        name = repo["name"]
+        url = repo["url"]
+        branch = repo["branch"]
+        check_stable = repo["stable-branch"]
+        check_tag = repo.get("toolchain-tag", True)
+
+        print(f"\nRepository: {name}")
+
+        # Check if branch is on at least the target toolchain
+        lean_toolchain_content = get_branch_content(url, branch, "lean-toolchain", github_token)
+        if lean_toolchain_content is None:
+            print(f"  ❌ No lean-toolchain file found in {branch} branch")
+            continue
+
+        on_target_toolchain = is_version_gte(lean_toolchain_content.strip(), toolchain)
+        if not on_target_toolchain:
+            print(f"  ❌ Not on target toolchain (needs ≥ {toolchain}, but {branch} is on {lean_toolchain_content.strip()})")
+            continue
+        print(f"  ✅ On compatible toolchain (>= {toolchain})")
+
+        # 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")
+                continue
+            print(f"  ✅ Tag {toolchain} exists")
+
+        # Only check merging into stable if stable-branch is true and not a release candidate
+        if check_stable and not is_release_candidate(toolchain):
+            if not is_merged_into_stable(url, toolchain, "stable", github_token):
+                print(f"  ❌ Tag {toolchain} is not merged into stable")
+                continue
+            print(f"  ✅ Tag {toolchain} is merged into stable")
+
+if __name__ == "__main__":
+    main()

script/release_notes.py

@@ -0,0 +1,145 @@
+#!/usr/bin/env python3
+
+import sys
+import re
+import json
+import requests
+import subprocess
+from collections import defaultdict
+from git import Repo
+
+def get_commits_since_tag(repo, tag):
+    try:
+        tag_commit = repo.commit(tag)
+        commits = list(repo.iter_commits(f"{tag_commit.hexsha}..HEAD"))
+        return [
+            (commit.hexsha, commit.message.splitlines()[0], commit.message)
+            for commit in commits
+        ]
+    except Exception as e:
+        sys.stderr.write(f"Error retrieving commits: {e}\n")
+        sys.exit(1)
+
+def check_pr_number(first_line):
+    match = re.search(r"\(\#(\d+)\)$", first_line)
+    if match:
+        return int(match.group(1))
+    return None
+
+def fetch_pr_labels(pr_number):
+    try:
+        # Use gh CLI to fetch PR details
+        result = subprocess.run([
+            "gh", "api", f"repos/leanprover/lean4/pulls/{pr_number}"
+        ], capture_output=True, text=True, check=True)
+        pr_data = result.stdout
+        pr_json = json.loads(pr_data)
+        return [label["name"] for label in pr_json.get("labels", [])]
+    except subprocess.CalledProcessError as e:
+        sys.stderr.write(f"Failed to fetch PR #{pr_number} using gh: {e.stderr}\n")
+        return []
+
+def format_section_title(label):
+    title = label.replace("changelog-", "").capitalize()
+    if title == "Doc":
+        return "Documentation"
+    elif title == "Pp":
+        return "Pretty Printing"
+    return title
+
+def sort_sections_order():
+    return [
+        "Language",
+        "Library",
+        "Compiler",
+        "Pretty Printing",
+        "Documentation",
+        "Server",
+        "Lake",
+        "Other",
+        "Uncategorised"
+    ]
+
+def format_markdown_description(pr_number, description):
+    link = f"[#{pr_number}](https://github.com/leanprover/lean4/pull/{pr_number})"
+    return f"{link} {description}"
+
+def main():
+    if len(sys.argv) != 2:
+        sys.stderr.write("Usage: script.py <git-tag>\n")
+        sys.exit(1)
+
+    tag = sys.argv[1]
+    try:
+        repo = Repo(".")
+    except Exception as e:
+        sys.stderr.write(f"Error opening Git repository: {e}\n")
+        sys.exit(1)
+
+    commits = get_commits_since_tag(repo, tag)
+
+    sys.stderr.write(f"Found {len(commits)} commits since tag {tag}:\n")
+    for commit_hash, first_line, _ in commits:
+        sys.stderr.write(f"- {commit_hash}: {first_line}\n")
+
+    changelog = defaultdict(list)
+
+    for commit_hash, first_line, full_message in commits:
+        # Skip commits with the specific first lines
+        if first_line == "chore: update stage0" or first_line.startswith("chore: CI: bump "):
+            continue
+
+        pr_number = check_pr_number(first_line)
+
+        if not pr_number:
+            sys.stderr.write(f"No PR number found in {first_line}\n")
+            continue
+
+        # Remove the first line from the full_message for further processing
+        body = full_message[len(first_line):].strip()
+
+        paragraphs = body.split('\n\n')
+        second_paragraph = paragraphs[0] if len(paragraphs) > 0 else ""
+
+        labels = fetch_pr_labels(pr_number)
+
+        # Skip entries with the "changelog-no" label
+        if "changelog-no" in labels:
+            continue
+
+        report_errors = first_line.startswith("feat:") or first_line.startswith("fix:")
+
+        if not second_paragraph.startswith("This PR "):
+            if report_errors:
+                sys.stderr.write(f"No PR description found in commit:\n{commit_hash}\n{first_line}\n{body}\n\n")
+                fallback_description = re.sub(r":$", "", first_line.split(" ", 1)[1]).rsplit(" (#", 1)[0]
+                markdown_description = format_markdown_description(pr_number, fallback_description)
+            else:
+                continue
+        else:
+            markdown_description = format_markdown_description(pr_number, second_paragraph.replace("This PR ", ""))
+
+        changelog_labels = [label for label in labels if label.startswith("changelog-")]
+        if len(changelog_labels) > 1:
+            sys.stderr.write(f"Warning: Multiple changelog-* labels found for PR #{pr_number}: {changelog_labels}\n")
+
+        if not changelog_labels:
+            if report_errors:
+                sys.stderr.write(f"Warning: No changelog-* label found for PR #{pr_number}\n")
+            else:
+                continue
+
+        for label in changelog_labels:
+            changelog[label].append((pr_number, markdown_description))
+
+    section_order = sort_sections_order()
+    sorted_changelog = sorted(changelog.items(), key=lambda item: section_order.index(format_section_title(item[0])) if format_section_title(item[0]) in section_order else len(section_order))
+
+    for label, entries in sorted_changelog:
+        section_title = format_section_title(label) if label != "Uncategorised" else "Uncategorised"
+        print(f"## {section_title}\n")
+        for _, entry in sorted(entries, key=lambda x: x[0]):
+            print(f"* {entry}\n")
+
+if __name__ == "__main__":
+    main()

script/release_repos.yml

@@ -0,0 +1,79 @@
+repositories:
+  - name: Batteries
+    url: https://github.com/leanprover-community/batteries
+    toolchain-tag: true
+    stable-branch: true
+    branch: main
+    dependencies: []
+
+  - name: lean4checker
+    url: https://github.com/leanprover/lean4checker
+    toolchain-tag: true
+    stable-branch: true
+    branch: master
+    dependencies: []
+
+  - name: doc-gen4
+    url: https://github.com/leanprover/doc-gen4
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
+  - name: Verso
+    url: https://github.com/leanprover/verso
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
+  - name: ProofWidgets4
+    url: https://github.com/leanprover-community/ProofWidgets4
+    toolchain-tag: false
+    stable-branch: false
+    branch: main
+    dependencies:
+      - Batteries
+
+  - name: Aesop
+    url: https://github.com/leanprover-community/aesop
+    toolchain-tag: true
+    stable-branch: true
+    branch: master
+    dependencies:
+      - Batteries
+
+  - name: import-graph
+    url: https://github.com/leanprover-community/import-graph
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
+  - name: plausible
+    url: https://github.com/leanprover-community/plausible
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
+  - name: Mathlib
+    url: https://github.com/leanprover-community/mathlib4
+    toolchain-tag: true
+    stable-branch: true
+    branch: master
+    dependencies:
+      - Aesop
+      - ProofWidgets4
+      - lean4checker
+      - Batteries
+      - doc-gen4
+      - import-graph
+
+  - name: REPL
+    url: https://github.com/leanprover-community/repl
+    toolchain-tag: true
+    stable-branch: true
+    branch: master
+    dependencies:
+      - Mathlib

src/Init/Data/Array/Lemmas.lean

@@ -36,6 +36,8 @@ namespace Array
 @[simp] theorem mem_toList_iff (a : α) (l : Array α) : a ∈ l.toList ↔ a ∈ l := by
   cases l <;> simp
 
+@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
+
 /-! ### empty -/
 
 @[simp] theorem empty_eq {xs : Array α} : #[] = xs ↔ xs = #[] := by
@@ -1001,52 +1003,7 @@ private theorem beq_of_beq_singleton [BEq α] {a b : α} : #[a] == #[b] → a ==
 
 /-! Content below this point has not yet been aligned with `List`. -/
 
-theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
-
-@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-
--- This is a duplicate of `List.toArray_toList`.
--- It's confusing to guess which namespace this theorem should live in,
--- so we provide both.
-@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
-
-@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
-
-@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
-
-@[deprecated size_toArray (since := "2024-12-11")]
-theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
-
-theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
-    (arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
-  simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
-    List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
-
-/--
-Variant of `foldrM_push` with `h : start = arr.size + 1`
-rather than `(arr.push a).size` as the argument.
--/
-@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α)
-    {start} (h : start = arr.size + 1) :
-    (arr.push a).foldrM f init start = f a init >>= arr.foldrM f := by
-  simp [← foldrM_push, h]
-
-theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) :
-    (arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
-
-/--
-Variant of `foldr_push` with the `h : start = arr.size + 1`
-rather than `(arr.push a).size` as the argument.
--/
-@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) {start}
-    (h : start = arr.size + 1) : (arr.push a).foldr f init start = arr.foldr f (f a init) :=
-  foldrM_push' _ _ _ _ h
-
-/-- A more efficient version of `arr.toList.reverse`. -/
-@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
-
-@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
-  rw [toListRev, ← foldl_toList, ← List.foldr_reverse, List.foldr_cons_nil]
+/-! ### map -/
 
 theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
     arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
@@ -1070,6 +1027,11 @@ where
     induction l generalizing arr <;> simp [*]
   simp [H]
 
+@[simp] theorem _root_.List.map_toArray (f : α → β) (l : List α) :
+    l.toArray.map f = (l.map f).toArray := by
+  apply ext'
+  simp
+
 @[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by
   simp only [← length_toList]
   simp
@@ -1079,6 +1041,128 @@ where
 
 @[simp] theorem map_empty (f : α → β) : map f #[] = #[] := mapM_empty f
 
+@[simp] theorem getElem_map (f : α → β) (a : Array α) (i : Nat) (hi : i < (a.map f).size) :
+    (a.map f)[i] = f (a[i]'(by simpa using hi)) := by
+  cases a
+  simp
+
+@[simp] theorem getElem?_map (f : α → β) (as : Array α) (i : Nat) :
+    (as.map f)[i]? = as[i]?.map f := by
+  simp [getElem?_def]
+
+@[simp] theorem map_id_fun : map (id : α → α) = id := by
+  funext l
+  induction l <;> simp_all
+
+/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
+@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
+
+-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
+theorem map_id (l : Array α) : map (id : α → α) l = l := by
+  cases l <;> simp_all
+
+/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
+-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
+theorem map_id' (l : Array α) : map (fun (a : α) => a) l = l := map_id l
+
+/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
+theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : Array α) : map f l = l := by
+  simp [show f = id from funext h]
+
+theorem map_singleton (f : α → β) (a : α) : map f #[a] = #[f a] := rfl
+
+@[simp] theorem mem_map {f : α → β} {l : Array α} : b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b := by
+  simp only [mem_def, toList_map, List.mem_map]
+
+theorem exists_of_mem_map (h : b ∈ map f l) : ∃ a, a ∈ l ∧ f a = b := mem_map.1 h
+
+theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩
+
+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_inj_left {f g : α → β} : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
+  cases l <;> simp_all
+
+theorem map_congr_left (h : ∀ a ∈ l, f a = g a) : map f l = map g l :=
+  map_inj_left.2 h
+
+theorem map_inj : map f = map g ↔ f = g := by
+  constructor
+  · 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
+
+@[simp] theorem map_map {f : α → β} {g : β → γ} {as : Array α} :
+    (as.map f).map g = as.map (g ∘ f) := by
+  cases as; simp
+
+@[simp] theorem map_push {f : α → β} {as : Array α} {x : α} :
+    (as.push x).map f = (as.map f).push (f x) := by
+  ext
+  · simp
+  · simp only [getElem_map, getElem_push, size_map]
+    split <;> rfl
+
+theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
+    arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
+  rw [mapM_eq_foldlM, ← foldlM_toList, ← List.foldrM_reverse]
+  conv => rhs; rw [← List.reverse_reverse arr.toList]
+  induction arr.toList.reverse with
+  | nil => simp
+  | cons a l ih => simp [ih]
+
+@[simp] theorem toList_mapM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
+    toList <$> arr.mapM f = arr.toList.mapM f := by
+  simp [mapM_eq_mapM_toList]
+
+theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
+    mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
+  unfold mapM.map
+  split <;> rename_i h
+  · simp only [Id.bind_eq]
+    dsimp [foldl, Id.run, foldlM]
+    rw [mapM_map_eq_foldl, dif_pos (by omega), foldlM.loop, dif_pos h]
+    -- Calling `split` here gives a bad goal.
+    have : size as - i = Nat.succ (size as - i - 1) := by omega
+    rw [this]
+    simp [foldl, foldlM, Id.run, Nat.sub_add_eq]
+  · dsimp [foldl, Id.run, foldlM]
+    rw [dif_pos (by omega), foldlM.loop, dif_neg h]
+    rfl
+termination_by as.size - i
+
+theorem map_eq_foldl (as : Array α) (f : α → β) :
+    as.map f = as.foldl (fun r a => r.push (f a)) #[] :=
+  mapM_map_eq_foldl _ _ _
+
+theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
+
+@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
+
+-- This is a duplicate of `List.toArray_toList`.
+-- It's confusing to guess which namespace this theorem should live in,
+-- so we provide both.
+@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
+
+@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
+
+@[deprecated size_toArray (since := "2024-12-11")]
+theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
+
+/-- A more efficient version of `arr.toList.reverse`. -/
+@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
+
+@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
+  rw [toListRev, ← foldl_toList, ← List.foldr_reverse, List.foldr_cons_nil]
+
 @[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp)
 
 @[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) :
@@ -1094,7 +1178,6 @@ theorem foldl_toList_eq_map (l : List α) (acc : Array β) (G : α → β) :
     (l.foldl (fun acc a => acc.push (G a)) acc).toList = acc.toList ++ l.map G := by
   induction l generalizing acc <;> simp [*]
 
-
 /-! # uset -/
 
 attribute [simp] uset
@@ -1270,18 +1353,16 @@ theorem get_set (a : Array α) (i : Nat) (hi : i < a.size) (j : Nat) (hj : j < a
     (h : i ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
   simp only [set, ← getElem_toList, List.getElem_set_ne h]
 
-private theorem fin_cast_val (e : n = n') (i : Fin n) : e ▸ i = ⟨i.1, e ▸ i.2⟩ := by cases e; rfl
-
 theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
     a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
-  simp [swap, fin_cast_val]
+  simp [swap]
 
 @[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
     (a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
 
 theorem getElem?_swap (a : Array α) (i j : Nat) (hi hj) (k : Nat) : (a.swap i j hi hj)[k]? =
     if j = k then some a[i] else if i = k then some a[j] else a[k]? := by
-  simp [swap_def, get?_set, ← getElem_fin_eq_getElem_toList]
+  simp [swap_def, get?_set]
 
 @[simp] theorem swapAt_def (a : Array α) (i : Nat) (v : α) (hi) :
     a.swapAt i v hi = (a[i], a.set i v) := rfl
@@ -1396,6 +1477,90 @@ theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Arra
         true_and, Nat.not_lt] at h
       rw [List.getElem?_eq_none_iff.2 ‹_›, List.getElem?_eq_none_iff.2 (a.toList.length_reverse ▸ ‹_›)]
 
+end Array
+
+open Array
+
+namespace List
+
+@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
+  apply ext'
+  simp only [toList_reverse]
+
+end List
+
+namespace Array
+
+/-! ### foldlM and foldrM -/
+
+theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : Array α) :
+    (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
+  cases l
+  cases l'
+  rw [List.append_toArray]
+  simp
+
+/-- Variant of `foldM_append` with `h : stop = (l ++ l').size`. -/
+@[simp] theorem foldlM_append' [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : Array α)
+    (h : stop = (l ++ l').size) :
+    (l ++ l').foldlM f b 0 stop = l.foldlM f b >>= l'.foldlM f := by
+  subst h
+  rw [foldlM_append]
+
+theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
+    (arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
+  simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
+    List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
+
+/--
+Variant of `foldrM_push` with `h : start = arr.size + 1`
+rather than `(arr.push a).size` as the argument.
+-/
+@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α)
+    {start} (h : start = arr.size + 1) :
+    (arr.push a).foldrM f init start = f a init >>= arr.foldrM f := by
+  simp [← foldrM_push, h]
+
+theorem foldl_eq_foldlM (f : β → α → β) (b) (l : Array α) :
+    l.foldl f b = l.foldlM (m := Id) f b := by
+  cases l
+  simp [List.foldl_eq_foldlM]
+
+theorem foldr_eq_foldrM (f : α → β → β) (b) (l : Array α) :
+    l.foldr f b = l.foldrM (m := Id) f b := by
+  cases l
+  simp [List.foldr_eq_foldrM]
+
+@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : Array α) :
+    Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
+
+@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : Array α) :
+    Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
+
+/-! ### foldl and foldr -/
+
+theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) :
+    (arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
+
+/--
+Variant of `foldr_push` with the `h : start = arr.size + 1`
+rather than `(arr.push a).size` as the argument.
+-/
+@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) {start}
+    (h : start = arr.size + 1) : (arr.push a).foldr f init start = arr.foldr f (f a init) :=
+  foldrM_push' _ _ _ _ h
+
+@[simp] theorem foldl_push_eq_append (l l' : Array α) : l.foldl push l' = l' ++ l := by
+  cases l
+  cases l'
+  simp
+
+@[simp] theorem foldr_flip_push_eq_append (l l' : Array α) :
+    l.foldr (fun x y => push y x) l' = l' ++ l.reverse := by
+  cases l
+  cases l'
+  simp
+
 /-! ### take -/
 
 @[simp] theorem size_take_loop (a : Array α) (n : Nat) : (take.loop n a).size = a.size - n := by
@@ -1508,22 +1673,6 @@ theorem foldr_congr {as bs : Array α} (h₀ : as = bs) {f g : α → β → β}
     as.foldr f a start stop = bs.foldr g b start' stop' := by
   congr
 
-theorem foldl_eq_foldlM (f : β → α → β) (b) (l : Array α) :
-    l.foldl f b = l.foldlM (m := Id) f b := by
-  cases l
-  simp [List.foldl_eq_foldlM]
-
-theorem foldr_eq_foldrM (f : α → β → β) (b) (l : Array α) :
-    l.foldr f b = l.foldrM (m := Id) f b := by
-  cases l
-  simp [List.foldr_eq_foldrM]
-
-@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : Array α) :
-    Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
-
-@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : Array α) :
-    Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
-
 theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : Array β) (init : α₁)
     (H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
   cases l
@@ -1538,45 +1687,13 @@ theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ :
 
 /-! ### map -/
 
-@[simp] theorem mem_map {f : α → β} {l : Array α} : b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b := by
-  simp only [mem_def, toList_map, List.mem_map]
-
-theorem exists_of_mem_map (h : b ∈ map f l) : ∃ a, a ∈ l ∧ f a = b := mem_map.1 h
-
-theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩
-
-theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
-    arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
-  rw [mapM_eq_foldlM, ← foldlM_toList, ← List.foldrM_reverse]
-  conv => rhs; rw [← List.reverse_reverse arr.toList]
-  induction arr.toList.reverse with
-  | nil => simp
-  | cons a l ih => simp [ih]
-
-@[simp] theorem toList_mapM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
-    toList <$> arr.mapM f = arr.toList.mapM f := by
-  simp [mapM_eq_mapM_toList]
-
-theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
-    mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
-  unfold mapM.map
-  split <;> rename_i h
-  · simp only [Id.bind_eq]
-    dsimp [foldl, Id.run, foldlM]
-    rw [mapM_map_eq_foldl, dif_pos (by omega), foldlM.loop, dif_pos h]
-    -- Calling `split` here gives a bad goal.
-    have : size as - i = Nat.succ (size as - i - 1) := by omega
-    rw [this]
-    simp [foldl, foldlM, Id.run, Nat.sub_add_eq]
-  · dsimp [foldl, Id.run, foldlM]
-    rw [dif_pos (by omega), foldlM.loop, dif_neg h]
-    rfl
-termination_by as.size - i
-
-theorem map_eq_foldl (as : Array α) (f : α → β) :
-    as.map f = as.foldl (fun r a => r.push (f a)) #[] :=
-  mapM_map_eq_foldl _ _ _
+@[simp] theorem map_pop {f : α → β} {as : Array α} :
+    as.pop.map f = (as.map f).pop := by
+  ext
+  · simp
+  · simp only [getElem_map, getElem_pop, size_map]
 
+@[deprecated "Use `toList_map` or `List.map_toArray` to characterize `Array.map`." (since := "2025-01-06")]
 theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h0 : motive 0)
     (p : Fin as.size → β → Prop) (hs : ∀ i, motive i.1 → p i (f as[i]) ∧ motive (i+1)) :
     motive as.size ∧
@@ -1604,36 +1721,13 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
         simp only [show j = i by omega]
         exact (hs _ m).1
 
+set_option linter.deprecated false in
+@[deprecated "Use `toList_map` or `List.map_toArray` to characterize `Array.map`." (since := "2025-01-06")]
 theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Prop)
     (hs : ∀ i, p i (f as[i])) :
     ∃ eq : (as.map f).size = as.size, ∀ i h, p ⟨i, h⟩ ((as.map f)[i]) := by
   simpa using map_induction as f (fun _ => True) trivial p (by simp_all)
 
-@[simp] theorem getElem_map (f : α → β) (as : Array α) (i : Nat) (h) :
-    (as.map f)[i] = f (as[i]'(size_map .. ▸ h)) := by
-  have := map_spec as f (fun i b => b = f (as[i]))
-  simp only [implies_true, true_implies] at this
-  obtain ⟨eq, w⟩ := this
-  apply w
-  simp_all
-
-@[simp] theorem getElem?_map (f : α → β) (as : Array α) (i : Nat) :
-    (as.map f)[i]? = as[i]?.map f := by
-  simp [getElem?_def]
-
-@[simp] theorem map_push {f : α → β} {as : Array α} {x : α} :
-    (as.push x).map f = (as.map f).push (f x) := by
-  ext
-  · simp
-  · simp only [getElem_map, getElem_push, size_map]
-    split <;> rfl
-
-@[simp] theorem map_pop {f : α → β} {as : Array α} :
-    as.pop.map f = (as.map f).pop := by
-  ext
-  · simp
-  · simp only [getElem_map, getElem_pop, size_map]
-
 /-! ### modify -/
 
 @[simp] theorem size_modify (a : Array α) (i : Nat) (f : α → α) : (a.modify i f).size = a.size := by
@@ -2120,10 +2214,6 @@ theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
     rw [size_toArray, mapM'_cons, foldlM_toArray]
     simp [ih]
 
-@[simp] theorem map_toArray (f : α → β) (l : List α) : l.toArray.map f = (l.map f).toArray := by
-  apply ext'
-  simp
-
 theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
     l.toArray.uset i a h = (l.set i.toNat a).toArray := by simp
 
@@ -2132,10 +2222,6 @@ theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray
   apply ext'
   simp
 
-@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
-  apply ext'
-  simp
-
 @[simp] theorem modify_toArray (f : α → α) (l : List α) :
     l.toArray.modify i f = (l.modify f i).toArray := by
   apply ext'
@@ -2229,29 +2315,6 @@ namespace Array
 
 /-! ### map -/
 
-@[simp] theorem map_map {f : α → β} {g : β → γ} {as : Array α} :
-    (as.map f).map g = as.map (g ∘ f) := by
-  cases as; simp
-
-@[simp] theorem map_id_fun : map (id : α → α) = id := by
-  funext l
-  induction l <;> simp_all
-
-/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
-@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-
--- This is not a `@[simp]` lemma because `map_id_fun` will apply.
-theorem map_id (as : Array α) : map (id : α → α) as = as := by
-  cases as <;> simp_all
-
-/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
--- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
-theorem map_id' (as : Array α) : map (fun (a : α) => a) as = as := map_id as
-
-/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
-theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (as : Array α) : map f as = as := by
-  simp [show f = id from funext h]
-
 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)

src/Init/Data/BitVec/Lemmas.lean

@@ -785,6 +785,19 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
   unfold allOnes
   simp
 
+@[simp] theorem toInt_allOnes : (allOnes w).toInt = if 0 < w then -1 else 0 := by
+  norm_cast
+  by_cases h : w = 0
+  · subst h
+    simp
+  · have : 1 < 2 ^ w := by simp [h]
+    simp [BitVec.toInt]
+    omega
+
+@[simp] theorem toFin_allOnes : (allOnes w).toFin = Fin.ofNat' (2^w) (2^w - 1) := by
+  ext
+  simp
+
 @[simp] theorem getLsbD_allOnes : (allOnes v).getLsbD i = decide (i < v) := by
   simp [allOnes]
 
@@ -1142,11 +1155,16 @@ theorem getMsb_not {x : BitVec w} :
 /-! ### shiftLeft -/
 
 @[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
-    BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v :=
+    (x <<< n).toNat = x.toNat <<< n % 2^v :=
   BitVec.toNat_ofNat _ _
 
+@[simp] theorem toInt_shiftLeft {x : BitVec w} :
+    (x <<< n).toInt = (x.toNat <<< n : Int).bmod (2^w) := by
+  rw [toInt_eq_toNat_bmod, toNat_shiftLeft, Nat.shiftLeft_eq]
+  simp
+
 @[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) :
-    BitVec.toFin (x <<< n) = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
+    (x <<< n).toFin = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
 
 @[simp]
 theorem shiftLeft_zero (x : BitVec w) : x <<< 0 = x := by
@@ -2377,6 +2395,54 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
         show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
       omega
 
+/-! ### fill -/
+
+@[simp]
+theorem getLsbD_fill {w i : Nat} {v : Bool} :
+    (fill w v).getLsbD i = (v && decide (i < w)) := by
+  by_cases h : v
+  <;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
+
+@[simp]
+theorem getMsbD_fill {w i : Nat} {v : Bool} :
+    (fill w v).getMsbD i = (v && decide (i < w)) := by
+  by_cases h : v
+  <;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
+
+@[simp]
+theorem getElem_fill {w i : Nat} {v : Bool} (h : i < w) :
+    (fill w v)[i] = v := by
+  by_cases h : v
+  <;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
+
+@[simp]
+theorem msb_fill {w : Nat} {v : Bool} :
+    (fill w v).msb = (v && decide (0 < w)) := by
+  simp [BitVec.msb]
+
+theorem fill_eq {w : Nat} {v : Bool} : fill w v = if v = true then allOnes w else 0#w := by
+  by_cases h : v <;> (simp only [h] ; ext ; simp)
+
+@[simp]
+theorem fill_true {w : Nat} : fill w true = allOnes w := by
+  simp [fill_eq]
+
+@[simp]
+theorem fill_false {w : Nat} : fill w false = 0#w := by
+  simp [fill_eq]
+
+@[simp] theorem fill_toNat {w : Nat} {v : Bool} :
+    (fill w v).toNat = if v = true then 2^w - 1 else 0 := by
+  by_cases h : v <;> simp [h]
+
+@[simp] theorem fill_toInt {w : Nat} {v : Bool} :
+    (fill w v).toInt = if v = true && 0 < w then -1 else 0 := by
+  by_cases h : v <;> simp [h]
+
+@[simp] theorem fill_toFin {w : Nat} {v : Bool} :
+    (fill w v).toFin = if v = true then (allOnes w).toFin else Fin.ofNat' (2 ^ w) 0 := by
+  by_cases h : v <;> simp [h]
+
 /-! ### mul -/
 
 theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl

src/Init/Data/Int/DivModLemmas.lean

@@ -534,6 +534,13 @@ theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by
 @[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by
   conv => rhs; rw [← emod_add_ediv a b, add_mul_emod_self_left]
 
+@[simp] theorem emod_sub_emod (m n k : Int) : (m % n - k) % n = (m - k) % n :=
+  Int.emod_add_emod m n (-k)
+
+@[simp] theorem sub_emod_emod (m n k : Int) : (m - n % k) % k = (m - n) % k := by
+  apply (emod_add_cancel_right (n % k)).mp
+  rw [Int.sub_add_cancel, Int.add_emod_emod, Int.sub_add_cancel]
+
 theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by
   apply (emod_add_cancel_right b).mp
   rw [Int.sub_add_cancel, ← Int.add_emod_emod, Int.sub_add_cancel, emod_emod]
@@ -1098,6 +1105,32 @@ theorem bmod_def (x : Int) (m : Nat) : bmod x m =
     (x % m) - m :=
   rfl
 
+theorem bdiv_add_bmod (x : Int) (m : Nat) : m * bdiv x m + bmod x m = x := by
+  unfold bdiv bmod
+  split
+  · simp_all only [Nat.cast_ofNat_Int, Int.mul_zero, emod_zero, Int.zero_add, Int.sub_zero,
+      ite_self]
+  · dsimp only
+    split
+    · exact ediv_add_emod x m
+    · rw [Int.mul_add, Int.mul_one, Int.add_assoc, Int.add_comm m, Int.sub_add_cancel]
+      exact ediv_add_emod x m
+
+theorem bmod_add_bdiv (x : Int) (m : Nat) : bmod x m + m * bdiv x m = x := by
+  rw [Int.add_comm]; exact bdiv_add_bmod x m
+
+theorem bdiv_add_bmod' (x : Int) (m : Nat) : bdiv x m * m + bmod x m = x := by
+  rw [Int.mul_comm]; exact bdiv_add_bmod x m
+
+theorem bmod_add_bdiv' (x : Int) (m : Nat) : bmod x m + bdiv x m * m = x := by
+  rw [Int.add_comm]; exact bdiv_add_bmod' x m
+
+theorem bmod_eq_self_sub_mul_bdiv (x : Int) (m : Nat) : bmod x m = x - m * bdiv x m := by
+  rw [← Int.add_sub_cancel (bmod x m), bmod_add_bdiv]
+
+theorem bmod_eq_self_sub_bdiv_mul (x : Int) (m : Nat) : bmod x m = x - bdiv x m * m := by
+  rw [← Int.add_sub_cancel (bmod x m), bmod_add_bdiv']
+
 theorem bmod_pos (x : Int) (m : Nat) (p : x % m < (m + 1) / 2) : bmod x m = x % m := by
   simp [bmod_def, p]
 

src/Init/Data/List/Lemmas.lean

@@ -757,207 +757,6 @@ theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l
     | nil => simp
     | cons b l₂ => simp [isEqv, ih]
 
-/-! ### foldlM and foldrM -/
-
-@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
-    l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
-
-@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
-    (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
-  induction l generalizing b <;> simp [*]
-
-@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
-    (a :: l).foldrM f b = l.foldrM f b >>= f a := by
-  simp only [foldrM]
-  induction l <;> simp_all
-
-theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
-    l.foldl f b = l.foldlM (m := Id) f b := by
-  induction l generalizing b <;> simp [*, foldl]
-
-theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
-    l.foldr f b = l.foldrM (m := Id) f b := by
-  induction l <;> simp [*, foldr]
-
-@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : List α) :
-    Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
-
-@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : List α) :
-    Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
-
-/-! ### foldl and foldr -/
-
-@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
-  induction l <;> simp [*]
-
-@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
-
-@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
-  induction l generalizing l' <;> simp [*]
-
-theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
-
-@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
-
-theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) :
-    (l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
-  induction l generalizing init <;> simp [*]
-
-theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) :
-    (l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
-  induction l generalizing init <;> simp [*]
-
-theorem foldl_filterMap (f : α → Option β) (g : γ → β → γ) (l : List α) (init : γ) :
-    (l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
-  induction l generalizing init with
-  | nil => rfl
-  | cons a l ih =>
-    simp only [filterMap_cons, foldl_cons]
-    cases f a <;> simp [ih]
-
-theorem foldr_filterMap (f : α → Option β) (g : β → γ → γ) (l : List α) (init : γ) :
-    (l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
-  induction l generalizing init with
-  | nil => rfl
-  | cons a l ih =>
-    simp only [filterMap_cons, foldr_cons]
-    cases f a <;> simp [ih]
-
-theorem foldl_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
-    (h : ∀ x y, f' (g x) (g y) = g (f x y)) :
-    (l.map g).foldl f' (g a) = g (l.foldl f a) := by
-  induction l generalizing a
-  · simp
-  · simp [*, h]
-
-theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
-    (h : ∀ x y, f' (g x) (g y) = g (f x y)) :
-    (l.map g).foldr f' (g a) = g (l.foldr f a) := by
-  induction l generalizing a
-  · simp
-  · simp [*, h]
-
-theorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] :
-    ∀ {l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
-  | [], a₁, a₂ => rfl
-  | a :: l, a₁, a₂ => by
-    simp only [foldl_cons, ha.assoc]
-    rw [foldl_assoc]
-
-theorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] :
-    ∀ {l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
-  | [], a₁, a₂ => rfl
-  | a :: l, a₁, a₂ => by
-    simp only [foldr_cons, ha.assoc]
-    rw [foldr_assoc]
-
-theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁)
-    (H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
-  induction l generalizing init <;> simp [*, H]
-
-theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : α → β₂ → β₂) (l : List α) (init : β₁)
-    (H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
-  induction l <;> simp [*, H]
-
-/--
-Prove a proposition about the result of `List.foldl`,
-by proving it for the initial data,
-and the implication that the operation applied to any element of the list preserves the property.
-
-The motive can take values in `Sort _`, so this may be used to construct data,
-as well as to prove propositions.
--/
-def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α → β) (b : β) (_ : motive b)
-    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op b a)), motive (List.foldl op b l)
-  | [], _, _, hb, _ => hb
-  | hd :: tl, op, b, hb, hl =>
-    foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
-      fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
-
-@[simp] theorem foldlRecOn_nil {motive : β → Sort _} (hb : motive b)
-    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
-    foldlRecOn [] op b hb hl = hb := rfl
-
-@[simp] theorem foldlRecOn_cons {motive : β → Sort _} (hb : motive b)
-    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
-    foldlRecOn (x :: l) op b hb hl =
-      foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
-        (fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
-  rfl
-
-/--
-Prove a proposition about the result of `List.foldr`,
-by proving it for the initial data,
-and the implication that the operation applied to any element of the list preserves the property.
-
-The motive can take values in `Sort _`, so this may be used to construct data,
-as well as to prove propositions.
--/
-def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β → β) (b : β) (_ : motive b)
-    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op a b)), motive (List.foldr op b l)
-  | nil, _, _, hb, _ => hb
-  | x :: l, op, b, hb, hl =>
-    hl (foldr op b l)
-      (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
-
-@[simp] theorem foldrRecOn_nil {motive : β → Sort _} (hb : motive b)
-    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
-    foldrRecOn [] op b hb hl = hb := rfl
-
-@[simp] theorem foldrRecOn_cons {motive : β → Sort _} (hb : motive b)
-    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
-    foldrRecOn (x :: l) op b hb hl =
-      hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
-        x (mem_cons_self x l) :=
-  rfl
-
-/--
-We can prove that two folds over the same list are related (by some arbitrary relation)
-if we know that the initial elements are related and the folding function, for each element of the list,
-preserves the relation.
--/
-theorem foldl_rel {l : List α} {f g : β → α → β} {a b : β} (r : β → β → Prop)
-    (h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f c a) (g c' a)) :
-    r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
-  induction l generalizing a b with
-  | nil => simp_all
-  | cons a l ih =>
-    simp only [foldl_cons]
-    apply ih
-    · simp_all
-    · exact fun a m c c' h => h' _ (by simp_all) _ _ h
-
-/--
-We can prove that two folds over the same list are related (by some arbitrary relation)
-if we know that the initial elements are related and the folding function, for each element of the list,
-preserves the relation.
--/
-theorem foldr_rel {l : List α} {f g : α → β → β} {a b : β} (r : β → β → Prop)
-    (h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f a c) (g a c')) :
-    r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
-  induction l generalizing a b with
-  | nil => simp_all
-  | cons a l ih =>
-    simp only [foldr_cons]
-    apply h'
-    · simp
-    · exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
-
-@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
-    l.foldl (fun x _ => x + a) b = b + a * l.length := by
-  induction l generalizing b with
-  | nil => simp
-  | cons y l ih =>
-    simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
-      Nat.add_comm a]
-
-@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
-    l.foldr (fun _ x => x + a) b = b + a * l.length := by
-  induction l generalizing b with
-  | nil => simp
-  | cons y l ih =>
-    simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
-
 /-! ### getLast -/
 
 theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
@@ -1216,27 +1015,6 @@ theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then n
 
 /-! ### map -/
 
-@[simp] theorem map_id_fun : map (id : α → α) = id := by
-  funext l
-  induction l <;> simp_all
-
-/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
-@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-
--- This is not a `@[simp]` lemma because `map_id_fun` will apply.
-theorem map_id (l : List α) : map (id : α → α) l = l := by
-  induction l <;> simp_all
-
-/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
--- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
-theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
-
-/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
-theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : List α) : map f l = l := by
-  simp [show f = id from funext h]
-
-theorem map_singleton (f : α → β) (a : α) : map f [a] = [f a] := rfl
-
 @[simp] theorem length_map (as : List α) (f : α → β) : (as.map f).length = as.length := by
   induction as with
   | nil => simp [List.map]
@@ -1262,6 +1040,27 @@ theorem get_map (f : α → β) {l i} :
     get (map f l) i = f (get l ⟨i, length_map l f ▸ i.2⟩) := by
   simp
 
+@[simp] theorem map_id_fun : map (id : α → α) = id := by
+  funext l
+  induction l <;> simp_all
+
+/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
+@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
+
+-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
+theorem map_id (l : List α) : map (id : α → α) l = l := by
+  induction l <;> simp_all
+
+/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
+-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
+theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
+
+/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
+theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : List α) : map f l = l := by
+  simp [show f = id from funext h]
+
+theorem map_singleton (f : α → β) (a : α) : map f [a] = [f a] := rfl
+
 @[simp] theorem mem_map {f : α → β} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b
   | [] => by simp
   | _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
@@ -1961,16 +1760,6 @@ theorem set_append {s t : List α} :
     (s ++ t).set i x = s ++ t.set (i - s.length) x := by
   rw [set_append, if_neg (by simp_all)]
 
-@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
-    (l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
-  induction l <;> simp [*]
-
-@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
-    (l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
-
-@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
-    (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
-
 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
   constructor
@@ -2119,14 +1908,6 @@ 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`.
 
-theorem foldl_flatten (f : β → α → β) (b : β) (L : List (List α)) :
-    (flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
-  induction L generalizing b <;> simp_all
-
-theorem foldr_flatten (f : α → β → β) (b : β) (L : List (List α)) :
-    (flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
-  induction L <;> simp_all
-
 @[simp] theorem map_flatten (f : α → β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
   induction L <;> simp_all
 
@@ -2699,10 +2480,114 @@ theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.fla
 @[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
   reverseAux_eq_append ..
 
+@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
+  eq_replicate_iff.2
+    ⟨by rw [length_reverse, length_replicate],
+     fun _ h => eq_of_mem_replicate (mem_reverse.1 h)⟩
+
+
+/-! ### foldlM and foldrM -/
+
+@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
+    (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
+  induction l generalizing b <;> simp [*]
+
+@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
+    (a :: l).foldrM f b = l.foldrM f b >>= f a := by
+  simp only [foldrM]
+  induction l <;> simp_all
+
+theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
+    l.foldl f b = l.foldlM (m := Id) f b := by
+  induction l generalizing b <;> simp [*, foldl]
+
+theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
+    l.foldr f b = l.foldrM (m := Id) f b := by
+  induction l <;> simp [*, foldr]
+
+@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : List α) :
+    Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
+
+@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : List α) :
+    Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
+
+@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
+    l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
+
 @[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) :
     l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
   (foldlM_reverse ..).symm.trans <| by simp
 
+/-! ### foldl and foldr -/
+
+@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
+  induction l <;> simp [*]
+
+@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
+
+@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
+  induction l generalizing l' <;> simp [*]
+
+theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
+
+@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
+
+theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) :
+    (l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
+  induction l generalizing init <;> simp [*]
+
+theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) :
+    (l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
+  induction l generalizing init <;> simp [*]
+
+theorem foldl_filterMap (f : α → Option β) (g : γ → β → γ) (l : List α) (init : γ) :
+    (l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
+  induction l generalizing init with
+  | nil => rfl
+  | cons a l ih =>
+    simp only [filterMap_cons, foldl_cons]
+    cases f a <;> simp [ih]
+
+theorem foldr_filterMap (f : α → Option β) (g : β → γ → γ) (l : List α) (init : γ) :
+    (l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
+  induction l generalizing init with
+  | nil => rfl
+  | cons a l ih =>
+    simp only [filterMap_cons, foldr_cons]
+    cases f a <;> simp [ih]
+
+theorem foldl_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
+    (h : ∀ x y, f' (g x) (g y) = g (f x y)) :
+    (l.map g).foldl f' (g a) = g (l.foldl f a) := by
+  induction l generalizing a
+  · simp
+  · simp [*, h]
+
+theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
+    (h : ∀ x y, f' (g x) (g y) = g (f x y)) :
+    (l.map g).foldr f' (g a) = g (l.foldr f a) := by
+  induction l generalizing a
+  · simp
+  · simp [*, h]
+
+@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
+    (l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
+  induction l <;> simp [*]
+
+@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
+    (l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
+
+@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
+    (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
+
+theorem foldl_flatten (f : β → α → β) (b : β) (L : List (List α)) :
+    (flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
+  induction L generalizing b <;> simp_all
+
+theorem foldr_flatten (f : α → β → β) (b : β) (L : List (List α)) :
+    (flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
+  induction L <;> simp_all
+
 @[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) :
     l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
 
@@ -2716,10 +2601,127 @@ theorem foldl_eq_foldr_reverse (l : List α) (f : β → α → β) (b) :
 theorem foldr_eq_foldl_reverse (l : List α) (f : α → β → β) (b) :
     l.foldr f b = l.reverse.foldl (fun x y => f y x) b := by simp
 
-@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
-  eq_replicate_iff.2
-    ⟨by rw [length_reverse, length_replicate],
-     fun _ h => eq_of_mem_replicate (mem_reverse.1 h)⟩
+theorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] :
+    ∀ {l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
+  | [], a₁, a₂ => rfl
+  | a :: l, a₁, a₂ => by
+    simp only [foldl_cons, ha.assoc]
+    rw [foldl_assoc]
+
+theorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] :
+    ∀ {l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
+  | [], a₁, a₂ => rfl
+  | a :: l, a₁, a₂ => by
+    simp only [foldr_cons, ha.assoc]
+    rw [foldr_assoc]
+
+theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁)
+    (H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
+  induction l generalizing init <;> simp [*, H]
+
+theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : α → β₂ → β₂) (l : List α) (init : β₁)
+    (H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
+  induction l <;> simp [*, H]
+
+/--
+Prove a proposition about the result of `List.foldl`,
+by proving it for the initial data,
+and the implication that the operation applied to any element of the list preserves the property.
+
+The motive can take values in `Sort _`, so this may be used to construct data,
+as well as to prove propositions.
+-/
+def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α → β) (b : β) (_ : motive b)
+    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op b a)), motive (List.foldl op b l)
+  | [], _, _, hb, _ => hb
+  | hd :: tl, op, b, hb, hl =>
+    foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
+      fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
+
+@[simp] theorem foldlRecOn_nil {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
+    foldlRecOn [] op b hb hl = hb := rfl
+
+@[simp] theorem foldlRecOn_cons {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
+    foldlRecOn (x :: l) op b hb hl =
+      foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
+        (fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
+  rfl
+
+/--
+Prove a proposition about the result of `List.foldr`,
+by proving it for the initial data,
+and the implication that the operation applied to any element of the list preserves the property.
+
+The motive can take values in `Sort _`, so this may be used to construct data,
+as well as to prove propositions.
+-/
+def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β → β) (b : β) (_ : motive b)
+    (_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op a b)), motive (List.foldr op b l)
+  | nil, _, _, hb, _ => hb
+  | x :: l, op, b, hb, hl =>
+    hl (foldr op b l)
+      (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
+
+@[simp] theorem foldrRecOn_nil {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
+    foldrRecOn [] op b hb hl = hb := rfl
+
+@[simp] theorem foldrRecOn_cons {motive : β → Sort _} (hb : motive b)
+    (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
+    foldrRecOn (x :: l) op b hb hl =
+      hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
+        x (mem_cons_self x l) :=
+  rfl
+
+/--
+We can prove that two folds over the same list are related (by some arbitrary relation)
+if we know that the initial elements are related and the folding function, for each element of the list,
+preserves the relation.
+-/
+theorem foldl_rel {l : List α} {f g : β → α → β} {a b : β} (r : β → β → Prop)
+    (h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f c a) (g c' a)) :
+    r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
+  induction l generalizing a b with
+  | nil => simp_all
+  | cons a l ih =>
+    simp only [foldl_cons]
+    apply ih
+    · simp_all
+    · exact fun a m c c' h => h' _ (by simp_all) _ _ h
+
+/--
+We can prove that two folds over the same list are related (by some arbitrary relation)
+if we know that the initial elements are related and the folding function, for each element of the list,
+preserves the relation.
+-/
+theorem foldr_rel {l : List α} {f g : α → β → β} {a b : β} (r : β → β → Prop)
+    (h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f a c) (g a c')) :
+    r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
+  induction l generalizing a b with
+  | nil => simp_all
+  | cons a l ih =>
+    simp only [foldr_cons]
+    apply h'
+    · simp
+    · exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
+
+@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
+    l.foldl (fun x _ => x + a) b = b + a * l.length := by
+  induction l generalizing b with
+  | nil => simp
+  | cons y l ih =>
+    simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
+      Nat.add_comm a]
+
+@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
+    l.foldr (fun _ x => x + a) b = b + a * l.length := by
+  induction l generalizing b with
+  | nil => simp
+  | cons y l ih =>
+    simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
+
 
 /-! #### Further results about `getLast` and `getLast?` -/
 

src/Init/Data/List/Perm.lean

@@ -510,4 +510,18 @@ theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
     refine (IH₁ H).trans (IH₂ ((p₁.pairwise_iff ?_).1 H))
     exact fun h h₁ h₂ => h h₂ h₁
 
+theorem perm_insertIdx {α} (x : α) (l : List α) {n} (h : n ≤ l.length) :
+    insertIdx n x l ~ x :: l := by
+  induction l generalizing n with
+  | nil =>
+    cases n with
+    | zero => rfl
+    | succ => cases h
+  | cons _ _ ih =>
+    cases n with
+    | zero => simp [insertIdx]
+    | succ =>
+      simp only [insertIdx, modifyTailIdx]
+      refine .trans (.cons _ (ih (Nat.le_of_succ_le_succ h))) (.swap ..)
+
 end List

src/Init/Data/List/Sort/Lemmas.lean

@@ -253,6 +253,10 @@ theorem merge_perm_append : ∀ {xs ys : List α}, merge xs ys le ~ xs ++ ys
     · exact (merge_perm_append.cons y).trans
         ((Perm.swap x y _).trans (perm_middle.symm.cons x))
 
+theorem Perm.merge (s₁ s₂ : α → α → Bool) (hl : l₁ ~ l₂) (hr : r₁ ~ r₂) :
+    merge l₁ r₁ s₁ ~ merge l₂ r₂ s₂ :=
+  Perm.trans (merge_perm_append ..) <| Perm.trans (Perm.append hl hr) <| Perm.symm (merge_perm_append ..)
+
 /-! ### mergeSort -/
 
 @[simp] theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]

src/Init/Data/Vector/Basic.lean

@@ -136,6 +136,18 @@ This will perform the update destructively provided that the vector has a refere
 @[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
   ⟨v.toArray.set! i x, by simp⟩
 
+@[inline] def foldlM [Monad m] (f : β → α → m β) (b : β) (v : Vector α n) : m β :=
+  v.toArray.foldlM f b
+
+@[inline] def foldrM [Monad m] (f : α → β → m β) (b : β) (v : Vector α n) : m β :=
+  v.toArray.foldrM f b
+
+@[inline] def foldl (f : β → α → β) (b : β) (v : Vector α n) : β :=
+  v.toArray.foldl f b
+
+@[inline] def foldr (f : α → β → β) (b : β) (v : Vector α n) : β :=
+  v.toArray.foldr f b
+
 /-- Append two vectors. -/
 @[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) :=
   ⟨v.toArray ++ w.toArray, by simp⟩

src/Init/Data/Vector/Lemmas.lean

@@ -66,6 +66,18 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
 @[simp] theorem back?_mk (a : Array α) (h : a.size = n) :
     (Vector.mk a h).back? = a.back? := rfl
 
+@[simp] theorem foldlM_mk [Monad m] (f : β → α → m β) (b : β) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).foldlM f b = a.foldlM f b := rfl
+
+@[simp] theorem foldrM_mk [Monad m] (f : α → β → m β) (b : β) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).foldrM f b = a.foldrM f b := rfl
+
+@[simp] theorem foldl_mk (f : β → α → β) (b : β) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).foldl f b = a.foldl f b := rfl
+
+@[simp] theorem foldr_mk (f : α → β → β) (b : β) (a : Array α) (h : a.size = n) :
+    (Vector.mk a h).foldr f b = a.foldr f b := rfl
+
 @[simp] theorem drop_mk (a : Array α) (h : a.size = n) (m) :
     (Vector.mk a h).drop m = Vector.mk (a.extract m a.size) (by simp [h]) := rfl
 
@@ -1025,6 +1037,13 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
 
 /-! Content below this point has not yet been aligned with `List` and `Array`. -/
 
+/-! ### map -/
+
+@[simp] theorem getElem_map (f : α → β) (a : Vector α n) (i : Nat) (hi : i < n) :
+    (a.map f)[i] = f a[i] := by
+  cases a
+  simp
+
 @[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
     (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
   simp [ofFn]
@@ -1088,13 +1107,6 @@ theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h :
   cases a
   simp
 
-/-! ### map -/
-
-@[simp] theorem getElem_map (f : α → β) (a : Vector α n) (i : Nat) (hi : i < n) :
-    (a.map f)[i] = f a[i] := by
-  cases a
-  simp
-
 /-! ### zipWith -/
 
 @[simp] theorem getElem_zipWith (f : α → β → γ) (a : Vector α n) (b : Vector β n) (i : Nat)
@@ -1103,6 +1115,37 @@ theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h :
   cases b
   simp
 
+/-! ### foldlM and foldrM -/
+
+@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l : Vector α n) (l' : Vector α n') :
+    (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
+  cases l
+  cases l'
+  simp
+
+@[simp] theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (l : Vector α n) (a : α) :
+    (l.push a).foldrM f init = f a init >>= l.foldrM f := by
+  cases l
+  simp
+
+theorem foldl_eq_foldlM (f : β → α → β) (b) (l : Vector α n) :
+    l.foldl f b = l.foldlM (m := Id) f b := by
+  cases l
+  simp [Array.foldl_eq_foldlM]
+
+theorem foldr_eq_foldrM (f : α → β → β) (b) (l : Vector α n) :
+    l.foldr f b = l.foldrM (m := Id) f b := by
+  cases l
+  simp [Array.foldr_eq_foldrM]
+
+@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : Vector α n) :
+    Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
+
+@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : Vector α n) :
+    Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
+
+/-! ### foldl and foldr -/
+
 /-! ### take -/
 
 @[simp] theorem take_size (a : Vector α n) : a.take n = a.cast (by simp) := by

src/Init/Grind/Lemmas.lean

@@ -25,6 +25,9 @@ theorem and_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∧ b) = Fals
 theorem eq_true_of_and_eq_true_left {a b : Prop} (h : (a ∧ b) = True) : a = True := by simp_all
 theorem eq_true_of_and_eq_true_right {a b : Prop} (h : (a ∧ b) = True) : b = True := by simp_all
 
+theorem or_of_and_eq_false {a b : Prop} (h : (a ∧ b) = False) : (¬a ∨ ¬b) := by
+  by_cases a <;> by_cases b <;> simp_all
+
 /-! Or -/
 
 theorem or_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a ∨ b) = True := by simp [h]
@@ -35,6 +38,15 @@ theorem or_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∨ b) = a :=
 theorem eq_false_of_or_eq_false_left {a b : Prop} (h : (a ∨ b) = False) : a = False := by simp_all
 theorem eq_false_of_or_eq_false_right {a b : Prop} (h : (a ∨ b) = False) : b = False := by simp_all
 
+/-! Implies -/
+
+theorem imp_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a → b) = True := by simp [h]
+theorem imp_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a → b) = True := by simp [h]
+theorem imp_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a → b) = b := by simp [h]
+
+theorem eq_true_of_imp_eq_false {a b : Prop} (h : (a → b) = False) : a = True := by simp_all
+theorem eq_false_of_imp_eq_false {a b : Prop} (h : (a → b) = False) : b = False := by simp_all
+
 /-! Not -/
 
 theorem not_eq_of_eq_true {a : Prop} (h : a = True) : (Not a) = False := by simp [h]
@@ -61,4 +73,28 @@ theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = Tr
   · intro h'; exact Eq.mp h₂ (h' (of_eq_true h₁))
   · intro h'; intros; exact Eq.mpr h₂ h'
 
+theorem of_forall_eq_false (α : Sort u) (p : α → Prop) (h : (∀ x : α, p x) = False) : ∃ x : α, ¬ p x := by simp_all
+
+/-! dite -/
+
+theorem dite_cond_eq_true' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c → α} {b : ¬ c → α} {r : α} (h₁ : c = True) (h₂ : a (of_eq_true h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
+theorem dite_cond_eq_false' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c → α} {b : ¬ c → α} {r : α} (h₁ : c = False) (h₂ : b (of_eq_false h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
+
+/-! Casts -/
+
+theorem eqRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
+        {motive : (x : α) → a = x → Sort u_1} (v : motive a (Eq.refl a)) {b : α} (h : a = b)
+        : HEq (@Eq.rec α a motive v b h) v := by
+ subst h; rfl
+
+theorem eqRecOn_heq.{u_1, u_2} {α : Sort u_2} {a : α}
+        {motive : (x : α) → a = x → Sort u_1} {b : α} (h : a = b) (v : motive a (Eq.refl a))
+        : HEq (@Eq.recOn α a motive b h v) v := by
+ subst h; rfl
+
+theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
+        {motive : α → Sort u_1} (v : motive a) {b : α} (h : a = b)
+        : HEq (@Eq.ndrec α a motive v b h) v := by
+ subst h; rfl
+
 end Lean.Grind

src/Init/Grind/Norm.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.SimpLemmas
+import Init.PropLemmas
 import Init.Classical
 import Init.ByCases
 
@@ -40,9 +41,10 @@ attribute [grind_norm] not_true
 -- False
 attribute [grind_norm] not_false_eq_true
 
+-- Remark: we disabled the following normalization rule because we want this information when implementing splitting heuristics
 -- Implication as a clause
-@[grind_norm↓] theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
-  by_cases p <;> by_cases q <;> simp [*]
+-- @[grind_norm↓] theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
+--  by_cases p <;> by_cases q <;> simp [*]
 
 -- And
 @[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
@@ -58,13 +60,19 @@ attribute [grind_norm] ite_true ite_false
 @[grind_norm↓] theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
   by_cases p <;> simp [*]
 
+@[grind_norm] theorem ite_true_false {_ : Decidable p} : (ite p True False) = p := by
+  by_cases p <;> simp
+
+@[grind_norm] theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
+  by_cases p <;> simp
+
 -- Forall
 @[grind_norm↓] theorem not_forall (p : α → Prop) : (¬∀ x, p x) = ∃ x, ¬p x := by simp
 attribute [grind_norm] forall_and
 
 -- Exists
 @[grind_norm↓] theorem not_exists (p : α → Prop) : (¬∃ x, p x) = ∀ x, ¬p x := by simp
-attribute [grind_norm] exists_const exists_or
+attribute [grind_norm] exists_const exists_or exists_prop exists_and_left exists_and_right
 
 -- Bool cond
 @[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
@@ -107,4 +115,7 @@ attribute [grind_norm] Nat.le_zero_eq
 -- GT GE
 attribute [grind_norm] GT.gt GE.ge
 
+-- Succ
+attribute [grind_norm] Nat.succ_eq_add_one
+
 end Lean.Grind

src/Init/Grind/Tactics.lean

@@ -6,20 +6,27 @@ Authors: Leonardo de Moura
 prelude
 import Init.Tactics
 
+namespace Lean.Parser.Attr
+
+syntax grindEq     := "="
+syntax grindEqBoth := atomic("_" "=" "_")
+syntax grindEqRhs  := atomic("=" "_")
+syntax grindBwd    := "←"
+syntax grindFwd    := "→"
+
+syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
+
+end Lean.Parser.Attr
+
 namespace Lean.Grind
 /--
 The configuration for `grind`.
-Passed to `grind` using, for example, the `grind (config := { eager := true })` syntax.
+Passed to `grind` using, for example, the `grind (config := { matchEqs := true })` syntax.
 -/
 structure Config where
-  /-- When `eager` is true (default: `false`), `grind` eagerly splits `if-then-else` and `match` expressions during internalization. -/
-  eager : Bool := false
-  /-- Maximum number of branches (i.e., case-splits) in the proof search tree. -/
-  splits : Nat := 100
-  /--
-  Maximum number of E-matching (aka heuristic theorem instantiation)
-  in a proof search tree branch.
-  -/
+  /-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
+  splits : Nat := 5
+  /-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
   ematch : Nat := 5
   /--
   Maximum term generation.
@@ -28,6 +35,16 @@ structure Config where
   gen : Nat := 5
   /-- Maximum number of theorem instances generated using E-matching in a proof search tree branch. -/
   instances : Nat := 1000
+  /-- If `matchEqs` is `true`, `grind` uses `match`-equations as E-matching theorems. -/
+  matchEqs : Bool := true
+  /-- If `splitMatch` is `true`, `grind` performs case-splitting on `match`-expressions during the search. -/
+  splitMatch : Bool := true
+  /-- If `splitIte` is `true`, `grind` performs case-splitting on `if-then-else` expressions during the search. -/
+  splitIte : Bool := true
+  /--
+  If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
+  Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
+  splitIndPred : Bool := true
   deriving Inhabited, BEq
 
 end Lean.Grind
@@ -39,6 +56,6 @@ namespace Lean.Parser.Tactic
 -/
 
 -- TODO: parameters
-syntax (name := grind) "grind" optConfig : tactic
+syntax (name := grind) "grind" optConfig ("on_failure " term)? : tactic
 
 end Lean.Parser.Tactic

src/Init/Grind/Util.lean

@@ -11,7 +11,22 @@ namespace Lean.Grind
 /-- A helper gadget for annotating nested proofs in goals. -/
 def nestedProof (p : Prop) (h : p) : p := h
 
-set_option pp.proofs true
+/--
+Gadget for marking terms that should not be normalized by `grind`s simplifier.
+`grind` uses a simproc to implement this feature.
+We use it when adding instances of `match`-equations to prevent them from being simplified to true.
+-/
+def doNotSimp {α : Sort u} (a : α) : α := a
+
+/-- Gadget for representing offsets `t+k` in patterns. -/
+def offset (a b : Nat) : Nat := a + b
+
+/--
+Gadget for annotating the equalities in `match`-equations conclusions.
+`_origin` is the term used to instantiate the `match`-equation using E-matching.
+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
   subst h; apply HEq.refl

src/Init/Prelude.lean

@@ -4170,6 +4170,16 @@ def withRef [Monad m] [MonadRef m] {α} (ref : Syntax) (x : m α) : m α :=
   let ref := replaceRef ref oldRef
   MonadRef.withRef ref x
 
+/--
+If `ref? = some ref`, run `x : m α` with a modified value for the `ref` by calling `withRef`.
+Otherwise, run `x` directly.
+-/
+@[always_inline, inline]
+def withRef? [Monad m] [MonadRef m] {α} (ref? : Option Syntax) (x : m α) : m α :=
+  match ref? with
+  | some ref => withRef ref x
+  | _        => x
+
 /-- A monad that supports syntax quotations. Syntax quotations (in term
     position) are monadic values that when executed retrieve the current "macro
     scope" from the monad and apply it to every identifier they introduce

src/Init/Tactics.lean

@@ -818,7 +818,7 @@ syntax inductionAlt  := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
 After `with`, there is an optional tactic that runs on all branches, and
 then a list of alternatives.
 -/
-syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
+syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)*)
 
 /--
 Assuming `x` is a variable in the local context with an inductive type,

src/Lean/Data/Json/Printer.lean

@@ -11,6 +11,22 @@ import Init.Data.List.Impl
 namespace Lean
 namespace Json
 
+set_option maxRecDepth 1024 in
+/--
+This table contains for each UTF-8 byte whether we need to escape a string that contains it.
+-/
+private def escapeTable : { xs : ByteArray // xs.size = 256 } :=
+  ⟨ByteArray.mk #[
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+    0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
+  ], by rfl⟩
+
 private def escapeAux (acc : String) (c : Char) : String :=
   -- escape ", \, \n and \r, keep all other characters ≥ 0x20 and render characters < 0x20 with \u
   if c = '"' then -- hack to prevent emacs from regarding the rest of the file as a string: "
@@ -39,8 +55,27 @@ private def escapeAux (acc : String) (c : Char) : String :=
     let d4 := Nat.digitChar (n % 16)
     acc ++ "\\u" |>.push d1 |>.push d2 |>.push d3 |>.push d4
 
+private def needEscape (s : String) : Bool :=
+  go s 0
+where
+  go (s : String) (i : Nat) : Bool :=
+    if h : i < s.utf8ByteSize then
+      let byte := s.getUtf8Byte i h
+      have h1 : byte.toNat < 256 := UInt8.toNat_lt_size byte
+      have h2 : escapeTable.val.size = 256 := escapeTable.property
+      if escapeTable.val.get byte.toNat (Nat.lt_of_lt_of_eq h1 h2.symm) == 0 then
+        go s (i + 1)
+      else
+        true
+    else
+      false
+
 def escape (s : String) (acc : String := "") : String :=
-  s.foldl escapeAux acc
+  -- If we don't have any characters that need to be escaped we can just append right away.
+  if needEscape s then
+    s.foldl escapeAux acc
+  else
+    acc ++ s
 
 def renderString (s : String) (acc : String := "") : String :=
   let acc := acc ++ "\""

src/Lean/Data/Lsp.lean

@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
 -/
 prelude
 import Lean.Data.Lsp.Basic
+import Lean.Data.Lsp.CancelParams
 import Lean.Data.Lsp.Capabilities
 import Lean.Data.Lsp.Client
 import Lean.Data.Lsp.Communication

src/Lean/Data/Lsp/Basic.lean

@@ -6,7 +6,6 @@ Authors: Marc Huisinga, Wojciech Nawrocki
 -/
 prelude
 import Lean.Data.Json
-import Lean.Data.JsonRpc
 
 /-! Defines most of the 'Basic Structures' in the LSP specification
 (https://microsoft.github.io/language-server-protocol/specifications/specification-current/),
@@ -19,10 +18,6 @@ namespace Lsp
 
 open Json
 
-structure CancelParams where
-  id : JsonRpc.RequestID
-  deriving Inhabited, BEq, ToJson, FromJson
-
 abbrev DocumentUri := String
 
 /-- We adopt the convention that zero-based UTF-16 positions as sent by LSP clients

src/Lean/Data/Lsp/CancelParams.lean

@@ -0,0 +1,25 @@
+/-
+Copyright (c) 2020 Marc Huisinga. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Authors: Marc Huisinga, Wojciech Nawrocki
+-/
+prelude
+import Lean.Data.JsonRpc
+
+/-! # Defines `Lean.Lsp.CancelParams`.
+
+This is separate from `Lean.Data.Lsp.Basic` to reduce transitive dependencies.
+-/
+
+namespace Lean
+namespace Lsp
+
+open Json
+
+structure CancelParams where
+  id : JsonRpc.RequestID
+  deriving Inhabited, BEq, ToJson, FromJson
+
+end Lsp
+end Lean

src/Lean/Data/Lsp/Utf16.lean

@@ -6,7 +6,6 @@ Authors: Marc Huisinga, Wojciech Nawrocki
 -/
 prelude
 import Init.Data.String
-import Init.Data.Array
 import Lean.Data.Lsp.Basic
 import Lean.Data.Position
 import Lean.DeclarationRange

src/Lean/Elab/Tactic/BuiltinTactic.lean

@@ -362,9 +362,9 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
   | `(tactic| intro $h:term $hs:term*) => evalTactic (← `(tactic| intro $h:term; intro $hs:term*))
   | _ => throwUnsupportedSyntax
 where
-  introStep (ref : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
+  introStep (ref? : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
     let fvarId ← liftMetaTacticAux fun mvarId => do
-      let (fvarId, mvarId) ← mvarId.intro n
+      let (fvarId, mvarId) ← withRef? ref? <| mvarId.intro n
       pure (fvarId, [mvarId])
     if let some typeStx := typeStx? then
       withMainContext do
@@ -374,9 +374,9 @@ where
         unless (← isDefEqGuarded type fvarType) do
           throwError "type mismatch at `intro {fvar}`{← mkHasTypeButIsExpectedMsg fvarType type}"
         liftMetaTactic fun mvarId => return [← mvarId.replaceLocalDeclDefEq fvarId type]
-    if let some stx := ref then
+    if let some ref := ref? then
       withMainContext do
-        Term.addLocalVarInfo stx (mkFVar fvarId)
+        Term.addLocalVarInfo ref (mkFVar fvarId)
 
 @[builtin_tactic Lean.Parser.Tactic.introMatch] def evalIntroMatch : Tactic := fun stx => do
   let matchAlts := stx[1]

src/Lean/Elab/Tactic/Classical.lean

@@ -24,11 +24,8 @@ def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t :
   finally
     modifyEnv Meta.instanceExtension.popScope
 
-@[builtin_tactic Lean.Parser.Tactic.classical]
-def evalClassical : Tactic := fun stx => do
-  match stx with
-  | `(tactic| classical $tacs:tacticSeq) =>
-     classical <| Elab.Tactic.evalTactic tacs
-  | _ => throwUnsupportedSyntax
+@[builtin_tactic Lean.Parser.Tactic.classical, builtin_incremental]
+def evalClassical : Tactic := fun stx =>
+  classical <| Term.withNarrowedArgTacticReuse (argIdx := 1) Elab.Tactic.evalTactic stx
 
 end Lean.Elab.Tactic

src/Lean/Elab/Tactic/Grind.lean

@@ -26,24 +26,44 @@ def elabGrindPattern : CommandElab := fun stx => do
       let info ← getConstInfo declName
       forallTelescope info.type fun xs _ => do
         let patterns ← terms.getElems.mapM fun term => do
-          let pattern ← instantiateMVars (← elabTerm term none)
-          let pattern ← Grind.unfoldReducible pattern
+          let pattern ← elabTerm term none
+          synthesizeSyntheticMVarsUsingDefault
+          let pattern ← instantiateMVars pattern
+          let pattern ← Grind.preprocessPattern pattern
           return pattern.abstract xs
         Grind.addEMatchTheorem declName xs.size patterns.toList
   | _ => throwUnsupportedSyntax
 
-def grind (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) : MetaM Unit := do
-  let mvarIds ← Grind.main mvarId config mainDeclName
+def grind (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
+  let mvarIds ← Grind.main mvarId config mainDeclName fallback
   unless mvarIds.isEmpty do
     throwError "`grind` failed\n{goalsToMessageData mvarIds}"
 
+private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
+  let some fallback := fallback? | return (pure ())
+  let type := mkApp (mkConst ``Grind.GoalM) (mkConst ``Unit)
+  let value ← withLCtx {} {} do Term.elabTermAndSynthesize fallback type
+  let auxDeclName ← if let .const declName _ := value then
+    pure declName
+  else
+    let auxDeclName ← Term.mkAuxName `_grind_fallback
+    let decl := Declaration.defnDecl {
+      name := auxDeclName
+      levelParams := []
+      type, value, hints := .opaque, safety := .safe
+    }
+    addAndCompile decl
+    pure auxDeclName
+  unsafe evalConst (Grind.GoalM Unit) auxDeclName
+
 @[builtin_tactic Lean.Parser.Tactic.grind] def evalApplyRfl : Tactic := fun stx => do
   match stx with
-  | `(tactic| grind $config:optConfig) =>
+  | `(tactic| grind $config:optConfig $[on_failure $fallback?]?) =>
+    let fallback ← elabFallback fallback?
     logWarningAt stx "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
     let declName := (← Term.getDeclName?).getD `_grind
     let config ← elabGrindConfig config
-    withMainContext do liftMetaFinishingTactic (grind · config declName)
+    withMainContext do liftMetaFinishingTactic (grind · config declName fallback)
   | _ => throwUnsupportedSyntax
 
 end Lean.Elab.Tactic

src/Lean/Elab/Tactic/Induction.lean

@@ -258,11 +258,11 @@ private def saveAltVarsInfo (altMVarId : MVarId) (altStx : Syntax) (fvarIds : Ar
           i := i + 1
 
 open Language in
-def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs : Array Syntax)
+def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs? : Option (Array Syntax))
     (initialInfo : Info)
     (numEqs : Nat := 0) (numGeneralized : Nat := 0) (toClear : Array FVarId := #[])
     (toTag : Array (Ident × FVarId) := #[]) : TacticM Unit := do
-  let hasAlts := altStxs.size > 0
+  let hasAlts := altStxs?.isSome
   if hasAlts then
     -- default to initial state outside of alts
     -- HACK: because this node has the same span as the original tactic,
@@ -274,9 +274,7 @@ def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altS
 where
   -- continuation in the correct info context
   goWithInfo := do
-    let hasAlts := altStxs.size > 0
-
-    if hasAlts then
+    if let some altStxs := altStxs? then
       if let some tacSnap := (← readThe Term.Context).tacSnap? then
         -- incrementality: create a new promise for each alternative, resolve current snapshot to
         -- them, eventually put each of them back in `Context.tacSnap?` in `applyAltStx`
@@ -309,7 +307,8 @@ where
 
   -- continuation in the correct incrementality context
   goWithIncremental (tacSnaps : Array (SnapshotBundle TacticParsedSnapshot)) := do
-    let hasAlts := altStxs.size > 0
+    let hasAlts := altStxs?.isSome
+    let altStxs := altStxs?.getD #[]
     let mut alts := alts
 
     -- initial sanity checks: named cases should be known, wildcards should be last
@@ -343,12 +342,12 @@ where
       let altName := getAltName altStx
       if let some i := alts.findFinIdx? (·.1 == altName) then
         -- cover named alternative
-        applyAltStx tacSnaps altStxIdx altStx alts[i]
+        applyAltStx tacSnaps altStxs altStxIdx altStx alts[i]
         alts := alts.eraseIdx i
       else if !alts.isEmpty && isWildcard altStx then
         -- cover all alternatives
         for alt in alts do
-          applyAltStx tacSnaps altStxIdx altStx alt
+          applyAltStx tacSnaps altStxs altStxIdx altStx alt
         alts := #[]
       else
         throwErrorAt altStx "unused alternative '{altName}'"
@@ -379,7 +378,7 @@ where
         altMVarIds.forM fun mvarId => admitGoal mvarId
 
   /-- Applies syntactic alternative to alternative goal. -/
-  applyAltStx tacSnaps altStxIdx altStx alt := withRef altStx do
+  applyAltStx tacSnaps altStxs altStxIdx altStx alt := withRef altStx do
     let { name := altName, info, mvarId := altMVarId } := alt
     -- also checks for unknown alternatives
     let numFields ← getAltNumFields elimInfo altName
@@ -476,7 +475,7 @@ private def generalizeVars (mvarId : MVarId) (stx : Syntax) (targets : Array Exp
 /--
 Given `inductionAlts` of the form
 ```
-syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
+syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
 ```
 Return an array containing its alternatives.
 -/
@@ -486,21 +485,30 @@ private def getAltsOfInductionAlts (inductionAlts : Syntax) : Array Syntax :=
 /--
 Given `inductionAlts` of the form
 ```
-syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
+syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
 ```
-runs `cont alts` where `alts` is an array containing all `inductionAlt`s while disabling incremental
-reuse if any other syntax changed.
+runs `cont (some alts)` where `alts` is an array containing all `inductionAlt`s while disabling incremental
+reuse if any other syntax changed. If there's no `with` clause, then runs `cont none`.
 -/
 private def withAltsOfOptInductionAlts (optInductionAlts : Syntax)
-    (cont : Array Syntax → TacticM α) : TacticM α :=
+    (cont : Option (Array Syntax) → TacticM α) : TacticM α :=
   Term.withNarrowedTacticReuse (stx := optInductionAlts) (fun optInductionAlts =>
     if optInductionAlts.isNone then
       -- if there are no alternatives, what to compare is irrelevant as there will be no reuse
       (mkNullNode #[], mkNullNode #[])
     else
+      -- if there are no alts, then use the `with` token for `inner` for a ref for messages
+      let altStxs := optInductionAlts[0].getArg 2
+      let inner := if altStxs.getNumArgs > 0 then altStxs else optInductionAlts[0][0]
       -- `with` and tactic applied to all branches must be unchanged for reuse
-      (mkNullNode optInductionAlts[0].getArgs[:2], optInductionAlts[0].getArg 2))
-    (fun alts => cont alts.getArgs)
+      (mkNullNode optInductionAlts[0].getArgs[:2], inner))
+    (fun alts? =>
+      if optInductionAlts.isNone then      -- no `with` clause
+        cont none
+      else if alts?.isOfKind nullKind then -- has alts
+        cont (some alts?.getArgs)
+      else                                 -- has `with` clause, but no alts
+        cont (some #[]))
 
 private def getOptPreTacOfOptInductionAlts (optInductionAlts : Syntax) : Syntax :=
   if optInductionAlts.isNone then mkNullNode else optInductionAlts[0][1]
@@ -518,7 +526,7 @@ private def expandMultiAlt? (alt : Syntax) : Option (Array Syntax) := Id.run do
 /--
 Given `inductionAlts` of the form
 ```
-syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
+syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
 ```
 Return `some inductionAlts'` if one of the alternatives have multiple LHSs, in the new `inductionAlts'`
 all alternatives have a single LHS.
@@ -700,10 +708,10 @@ def evalInduction : Tactic := fun stx =>
         -- unchanged
         -- everything up to the alternatives must be unchanged for reuse
         Term.withNarrowedArgTacticReuse (stx := stx) (argIdx := 4) fun optInductionAlts => do
-        withAltsOfOptInductionAlts optInductionAlts fun alts => do
+        withAltsOfOptInductionAlts optInductionAlts fun alts? => do
           let optPreTac := getOptPreTacOfOptInductionAlts optInductionAlts
           mvarId.assign result.elimApp
-          ElimApp.evalAlts elimInfo result.alts optPreTac alts initInfo (numGeneralized := n) (toClear := targetFVarIds)
+          ElimApp.evalAlts elimInfo result.alts optPreTac alts? initInfo (numGeneralized := n) (toClear := targetFVarIds)
           appendGoals result.others.toList
 where
   checkTargets (targets : Array Expr) : MetaM Unit := do

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

@@ -680,7 +680,7 @@ def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do
 
 /-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This
 `TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via
-the tactic call `aesop (add 50% tactic Lean.Omega.omegaDefault)`. -/
+the tactic call `aesop (add 50% tactic Lean.Elab.Tactic.Omega.omegaDefault)`. -/
 def omegaDefault : TacticM Unit := omegaTactic {}
 
 @[builtin_tactic Lean.Parser.Tactic.omega]

src/Lean/Elab/Tactic/RCases.lean

@@ -507,7 +507,7 @@ partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a
   match pat with
   | `(rintroPat| $pat:rcasesPat) =>
     let pat := (← RCasesPatt.parse pat).typed? ref ty?
-    let (v, g) ← g.intro (pat.name?.getD `_)
+    let (v, g) ← withRef pat.ref <| g.intro (pat.name?.getD `_)
     rcasesCore g fs clears (.fvar v) a pat cont
   | `(rintroPat| ($(pats)* $[: $ty?']?)) =>
     let ref := if pats.size == 1 then pat.raw else .missing

src/Lean/Linter/MissingDocs.lean

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 prelude
+import Lean.Parser.Syntax
 import Lean.Meta.Tactic.Simp.RegisterCommand
 import Lean.Elab.Command
 import Lean.Elab.SetOption

src/Lean/Meta/Tactic/Cases.lean

@@ -33,7 +33,7 @@ private def mkEqAndProof (lhs rhs : Expr) : MetaM (Expr × Expr) := do
   else
     pure (mkApp4 (mkConst ``HEq [u]) lhsType lhs rhsType rhs, mkApp2 (mkConst ``HEq.refl [u]) lhsType lhs)
 
-private partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr → Array Expr → MetaM α) : MetaM α :=
+partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr → Array Expr → MetaM α) : MetaM α :=
   let rec loop (i : Nat) (newEqs : Array Expr) (newRefls : Array Expr) := do
     if i < targets.size then
       let (newEqType, newRefl) ← mkEqAndProof targets[i]! targetsNew[i]!
@@ -66,30 +66,31 @@ structure GeneralizeIndicesSubgoal where
   numEqs         : Nat
 
 /--
-  Similar to `generalizeTargets` but customized for the `casesOn` motive.
-  Given a metavariable `mvarId` representing the
-  ```
-  Ctx, h : I A j, D |- T
-  ```
-  where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
-  and `j` the indices. Generate the goal
-  ```
-  Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
-  ```
-  Remark: `(j == j' -> h == h')` is a "telescopic" equality.
-  Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
-  The result contains the fields
-  - `mvarId`: the new goal
-  - `indicesFVarIds`: `j'` ids
-  - `fvarId`: `h'` id
-  - `numEqs`: number of equations in the target -/
-def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
+Given a metavariable `mvarId` representing the goal
+```
+Ctx |- T
+```
+and an expression `e : I A j`, where `I A j` is an inductive datatype where `A` are parameters,
+and `j` the indices. Generate the goal
+```
+Ctx, j' : J, h' : I A j' |- j == j' -> e == h' -> T
+```
+Remark: `(j == j' -> e == h')` is a "telescopic" equality.
+Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
+The result contains the fields
+- `mvarId`: the new goal
+- `indicesFVarIds`: `j'` ids
+- `fvarId`: `h'` id
+- `numEqs`: number of equations in the target
+
+If `varName?` is not none, it is used to name `h'`.
+-/
+def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := none) : MetaM GeneralizeIndicesSubgoal :=
   mvarId.withContext do
     let lctx       ← getLCtx
     let localInsts ← getLocalInstances
     mvarId.checkNotAssigned `generalizeIndices
-    let fvarDecl ← fvarId.getDecl
-    let type ← whnf fvarDecl.type
+    let type ← whnfD (← inferType e)
     type.withApp fun f args => matchConstInduct f (fun _ => throwTacticEx `generalizeIndices mvarId "inductive type expected") fun val _ => do
       unless val.numIndices > 0 do throwTacticEx `generalizeIndices mvarId "indexed inductive type expected"
       unless args.size == val.numIndices + val.numParams do throwTacticEx `generalizeIndices mvarId "ill-formed inductive datatype"
@@ -98,9 +99,10 @@ def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndi
       let IAType ← inferType IA
       forallTelescopeReducing IAType fun newIndices _ => do
       let newType := mkAppN IA newIndices
-      withLocalDeclD fvarDecl.userName newType fun h' =>
+      let varName ← if let some varName := varName? then pure varName else mkFreshUserName `x
+      withLocalDeclD varName newType fun h' =>
       withNewEqs indices newIndices fun newEqs newRefls => do
-      let (newEqType, newRefl) ← mkEqAndProof fvarDecl.toExpr h'
+      let (newEqType, newRefl) ← mkEqAndProof e h'
       let newRefls := newRefls.push newRefl
       withLocalDeclD `h newEqType fun newEq => do
       let newEqs := newEqs.push newEq
@@ -112,7 +114,7 @@ def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndi
       let auxType ← mkForallFVars newIndices auxType
       let newMVar ← mkFreshExprMVarAt lctx localInsts auxType MetavarKind.syntheticOpaque tag
       /- assign mvarId := newMVar indices h refls -/
-      mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) fvarDecl.toExpr) newRefls)
+      mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) e) newRefls)
       let (indicesFVarIds, newMVarId) ← newMVar.mvarId!.introNP newIndices.size
       let (fvarId, newMVarId) ← newMVarId.intro1P
       return {
@@ -122,6 +124,29 @@ def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndi
         numEqs         := newEqs.size
       }
 
+/--
+Similar to `generalizeTargets` but customized for the `casesOn` motive.
+Given a metavariable `mvarId` representing the
+```
+Ctx, h : I A j, D |- T
+```
+where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
+and `j` the indices. Generate the goal
+```
+Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
+```
+Remark: `(j == j' -> h == h')` is a "telescopic" equality.
+Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
+The result contains the fields
+- `mvarId`: the new goal
+- `indicesFVarIds`: `j'` ids
+- `fvarId`: `h'` id
+- `numEqs`: number of equations in the target -/
+def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
+  mvarId.withContext do
+    let fvarDecl ← fvarId.getDecl
+    generalizeIndices' mvarId fvarDecl.toExpr fvarDecl.userName
+
 structure CasesSubgoal extends InductionSubgoal where
   ctorName : Name
 

src/Lean/Meta/Tactic/Grind.lean

@@ -23,7 +23,7 @@ import Lean.Meta.Tactic.Grind.Parser
 import Lean.Meta.Tactic.Grind.EMatchTheorem
 import Lean.Meta.Tactic.Grind.EMatch
 import Lean.Meta.Tactic.Grind.Main
-
+import Lean.Meta.Tactic.Grind.CasesMatch
 
 namespace Lean
 
@@ -34,10 +34,14 @@ builtin_initialize registerTraceClass `grind.eqc
 builtin_initialize registerTraceClass `grind.internalize
 builtin_initialize registerTraceClass `grind.ematch
 builtin_initialize registerTraceClass `grind.ematch.pattern
+builtin_initialize registerTraceClass `grind.ematch.pattern.search
 builtin_initialize registerTraceClass `grind.ematch.instance
 builtin_initialize registerTraceClass `grind.ematch.instance.assignment
 builtin_initialize registerTraceClass `grind.issues
 builtin_initialize registerTraceClass `grind.simp
+builtin_initialize registerTraceClass `grind.split
+builtin_initialize registerTraceClass `grind.split.candidate
+builtin_initialize registerTraceClass `grind.split.resolved
 
 /-! Trace options for `grind` developers -/
 builtin_initialize registerTraceClass `grind.debug
@@ -47,5 +51,7 @@ builtin_initialize registerTraceClass `grind.debug.proof
 builtin_initialize registerTraceClass `grind.debug.proj
 builtin_initialize registerTraceClass `grind.debug.parent
 builtin_initialize registerTraceClass `grind.debug.final
+builtin_initialize registerTraceClass `grind.debug.forallPropagator
+builtin_initialize registerTraceClass `grind.debug.split
 
 end Lean

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

@@ -22,7 +22,7 @@ to detect when two structurally different atoms are definitionally equal.
 The `grind` tactic, on the other hand, uses congruence closure. Moreover, types, type formers, proofs, and instances
 are considered supporting elements and are not factored into congruence detection.
 
-This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they instances,
+This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they are instances,
 types, or type formers and are the `i`-th arguments of two different `f`-applications. This approach is
 sufficient for the congruence closure procedure used by the `grind` tactic.
 
@@ -111,22 +111,13 @@ unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
   visit e |>.run' mkPtrMap
 where
   visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
-    match e with
-    | .bvar .. => unreachable!
-    -- Recall that `grind` treats `let`, `forall`, and `lambda` as atomic terms.
-    | .letE .. | .forallE .. | .lam ..
-    | .const .. | .lit .. | .mvar .. | .sort .. | .fvar ..
-    -- Recall that the `grind` preprocessor uses the `foldProjs` preprocessing step.
-    | .proj ..
-    -- Recall that the `grind` preprocessor uses the `eraseIrrelevantMData` preprocessing step.
-    | .mdata ..  => return e
-    -- We only visit applications
-    | .app .. =>
-      -- Check whether it is cached
-      if let some r := (← get).find? e then
-        return r
-      e.withApp fun f args => do
-        let e' ← if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
+    unless e.isApp || e.isForall do return e
+    -- Check whether it is cached
+    if let some r := (← get).find? e then
+      return r
+    let e' ← match e with
+      | .app .. => e.withApp fun f args => do
+        if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
           let prop := args[0]!
           let prop' ← visit prop
           if let some r := (← getThe State).proofCanon.find? prop' then
@@ -138,23 +129,28 @@ where
         else
           let pinfos := (← getFunInfo f).paramInfo
           let mut modified := false
-          let mut args := args
-          for i in [:args.size] do
-            let arg := args[i]!
+          let mut args := args.toVector
+          for h : i in [:args.size] do
+            let arg := args[i]
             let arg' ← match (← shouldCanon pinfos i arg) with
             | .canonType  => canonType f i arg
             | .canonInst  => canonInst f i arg
             | .visit      => visit arg
             unless ptrEq arg arg' do
-              args := args.set! i arg'
+              args := args.set i arg'
               modified := true
-          pure <| if modified then mkAppN f args else e
-        modify fun s => s.insert e e'
-        return e'
+          pure <| if modified then mkAppN f args.toArray else e
+      | .forallE _ d b _ =>
+        -- Recall that we have `ForallProp.lean`.
+        let d' ← visit d
+        -- Remark: users may not want to convert `p → q` into `¬p ∨ q`
+        let b' ← if b.hasLooseBVars then pure b else visit b
+        pure <| e.updateForallE! d' b'
+      | _ => unreachable!
+    modify fun s => s.insert e e'
+    return e'
 
-/--
-Canonicalizes nested types, type formers, and instances in `e`.
--/
+/-- Canonicalizes nested types, type formers, and instances in `e`. -/
 def canon (e : Expr) : StateT State MetaM Expr :=
   unsafe canonImpl e
 

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

@@ -11,52 +11,56 @@ namespace Lean.Meta.Grind
 The `grind` tactic includes an auxiliary `cases` tactic that is not intended for direct use by users.
 This method implements it.
 This tactic is automatically applied when introducing local declarations with a type tagged with `[grind_cases]`.
+It is also used for "case-splitting" on terms during the search.
+
 It differs from the user-facing Lean `cases` tactic in the following ways:
 
 - It avoids unnecessary `revert` and `intro` operations.
 
 - It does not introduce new local declarations for each minor premise. Instead, the `grind` tactic preprocessor is responsible for introducing them.
 
-- It assumes that the major premise (i.e., the parameter `fvarId`) is the latest local declaration in the current goal.
-
 - If the major premise type is an indexed family, auxiliary declarations and (heterogeneous) equalities are introduced.
   However, these equalities are not resolved using `unifyEqs`. Instead, the `grind` tactic employs union-find and
   congruence closure to process these auxiliary equalities. This approach avoids applying substitution to propositions
   that have already been internalized by `grind`.
 -/
-def cases (mvarId : MVarId) (fvarId : FVarId) : MetaM (List MVarId) := mvarId.withContext do
+def cases (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
   let tag ← mvarId.getTag
-  let type ← whnf (← fvarId.getType)
+  let type ← whnf (← inferType e)
   let .const declName _ := type.getAppFn | throwInductiveExpected type
   let .inductInfo _ ← getConstInfo declName | throwInductiveExpected type
   let recursorInfo ← mkRecursorInfo (mkCasesOnName declName)
-  let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array Expr) (clearMajor : Bool) : MetaM (List MVarId) := do
-    let recursor ← mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indices
-    let mut recursor := mkApp (mkAppN recursor indices) (mkFVar fvarId)
+  let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array FVarId) : MetaM (List MVarId) := do
+    let indicesExpr := indices.map mkFVar
+    let recursor ← mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indicesExpr
+    let mut recursor := mkApp (mkAppN recursor indicesExpr) (mkFVar fvarId)
     let mut recursorType ← inferType recursor
     let mut mvarIdsNew := #[]
+    let mut idx := 1
     for _ in [:recursorInfo.numMinors] do
       let .forallE _ targetNew recursorTypeNew _ ← whnf recursorType
         | throwTacticEx `grind.cases mvarId "unexpected recursor type"
       recursorType := recursorTypeNew
-      let mvar ← mkFreshExprSyntheticOpaqueMVar targetNew tag
+      let tagNew := if recursorInfo.numMinors > 1 then Name.num tag idx else tag
+      let mvar ← mkFreshExprSyntheticOpaqueMVar targetNew tagNew
       recursor := mkApp recursor mvar
-      let mvarIdNew ← if clearMajor then
-        mvar.mvarId!.clear fvarId
-      else
-        pure mvar.mvarId!
+      let mvarIdNew ← mvar.mvarId!.tryClearMany (indices.push fvarId)
       mvarIdsNew := mvarIdsNew.push mvarIdNew
+      idx := idx + 1
     mvarId.assign recursor
     return mvarIdsNew.toList
   if recursorInfo.numIndices > 0 then
-    let s ← generalizeIndices mvarId fvarId
+    let s ← generalizeIndices' mvarId e
     s.mvarId.withContext do
-      k s.mvarId s.fvarId (s.indicesFVarIds.map mkFVar) (clearMajor := false)
+      k s.mvarId s.fvarId s.indicesFVarIds
+  else if let .fvar fvarId := e then
+    k mvarId fvarId #[]
   else
-    let indices ← getMajorTypeIndices mvarId `grind.cases recursorInfo type
-    k mvarId fvarId indices (clearMajor := true)
+    let mvarId ← mvarId.assert (← mkFreshUserName `x) type e
+    let (fvarId, mvarId) ← mvarId.intro1
+    mvarId.withContext do k mvarId fvarId #[]
 where
   throwInductiveExpected {α} (type : Expr) : MetaM α := do
-    throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {mkFVar fvarId}{indentExpr type}"
+    throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {e}{indentExpr type}"
 
 end Lean.Meta.Grind

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

@@ -0,0 +1,53 @@
+/-
+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.Util
+import Lean.Meta.Tactic.Cases
+import Lean.Meta.Match.MatcherApp
+
+namespace Lean.Meta.Grind
+
+def casesMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
+  let some app ← matchMatcherApp? e
+    | throwTacticEx `grind.casesMatch mvarId m!"`match`-expression expected{indentExpr e}"
+  let (motive, eqRefls) ← mkMotiveAndRefls app
+  let target ← mvarId.getType
+  let mut us := app.matcherLevels
+  if let some i := app.uElimPos? then
+    us := us.set! i (← getLevel target)
+  let splitterName := (← Match.getEquationsFor app.matcherName).splitterName
+  let splitterApp := mkConst splitterName us.toList
+  let splitterApp := mkAppN splitterApp app.params
+  let splitterApp := mkApp splitterApp motive
+  let splitterApp := mkAppN splitterApp app.discrs
+  let (mvars, _, _) ← forallMetaBoundedTelescope (← inferType splitterApp) app.alts.size (kind := .syntheticOpaque)
+  let splitterApp := mkAppN splitterApp mvars
+  let val := mkAppN splitterApp eqRefls
+  mvarId.assign val
+  updateTags mvars
+  return mvars.toList.map (·.mvarId!)
+where
+  mkMotiveAndRefls (app : MatcherApp) : MetaM (Expr × Array Expr) := do
+    let dummy := mkSort 0
+    let aux := mkApp (mkAppN e.getAppFn app.params) dummy
+    forallBoundedTelescope (← inferType aux) app.discrs.size fun xs _ => do
+    withNewEqs app.discrs xs fun eqs eqRefls => do
+      let type ← mvarId.getType
+      let type ← mkForallFVars eqs type
+      let motive ← mkLambdaFVars xs type
+      return (motive, eqRefls)
+
+  updateTags (mvars : Array Expr) : MetaM Unit := do
+    let tag ← mvarId.getTag
+    if mvars.size == 1 then
+      mvars[0]!.mvarId!.setTag tag
+    else
+      let mut idx := 1
+      for mvar in mvars do
+        mvar.mvarId!.setTag (Name.num tag idx)
+        idx := idx + 1
+
+end Lean.Meta.Grind

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

@@ -0,0 +1,71 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Types
+
+namespace Lean.Meta.Grind
+
+/-!
+Combinators for manipulating `GrindTactic`s.
+TODO: a proper tactic language for `grind`.
+-/
+
+def GrindTactic := Goal → GrindM (Option (List Goal))
+
+def GrindTactic.try (x : GrindTactic) : GrindTactic := fun g => do
+  let some gs ← x g | return some [g]
+  return some gs
+
+def applyToAll (x : GrindTactic)  (goals : List Goal) : GrindM (List Goal) := do
+  go goals []
+where
+  go (goals : List Goal) (acc : List Goal) : GrindM (List Goal) := do
+    match goals with
+    | [] => return acc.reverse
+    | goal :: goals => match (← x goal) with
+      | none => go goals (goal :: acc)
+      | some goals' => go goals (goals' ++ acc)
+
+partial def GrindTactic.andThen (x y : GrindTactic) : GrindTactic := fun goal => do
+  let some goals ← x goal | return none
+  applyToAll y goals
+
+instance : AndThen GrindTactic where
+  andThen a b := GrindTactic.andThen a (b ())
+
+partial def GrindTactic.iterate (x : GrindTactic) : GrindTactic := fun goal => do
+  go [goal] []
+where
+  go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
+    match todo with
+    | [] => return result
+    | goal :: todo =>
+      if let some goalsNew ← x goal then
+        go (goalsNew ++ todo) result
+      else
+        go todo (goal :: result)
+
+partial def GrindTactic.orElse (x y : GrindTactic) : GrindTactic := fun goal => do
+  let some goals ← x goal | y goal
+  return goals
+
+instance : OrElse GrindTactic where
+  orElse a b := GrindTactic.andThen a (b ())
+
+def toGrindTactic (f : GoalM Unit) : GrindTactic := fun goal => do
+  let goal ← GoalM.run' goal f
+  if goal.inconsistent then
+    return some []
+  else
+    return some [goal]
+
+def GrindTactic' := Goal → GrindM (List Goal)
+
+def GrindTactic'.toGrindTactic (x : GrindTactic') : GrindTactic := fun goal => do
+  let goals ← x goal
+  return some goals
+
+end Lean.Meta.Grind

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

@@ -41,8 +41,9 @@ This is an auxiliary function performed while merging equivalence classes.
 private def removeParents (root : Expr) : GoalM ParentSet := do
   let parents ← getParentsAndReset root
   for parent in parents do
-    if (← isCongrRoot parent) then
-      trace[grind.debug.parent] "remove: {parent}"
+    -- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
+    if (← pure parent.isApp <&&> isCongrRoot parent) then
+      trace_goal[grind.debug.parent] "remove: {parent}"
       modify fun s => { s with congrTable := s.congrTable.erase { e := parent } }
   return parents
 
@@ -52,8 +53,8 @@ This is an auxiliary function performed while merging equivalence classes.
 -/
 private def reinsertParents (parents : ParentSet) : GoalM Unit := do
   for parent in parents do
-    if (← isCongrRoot parent) then
-      trace[grind.debug.parent] "reinsert: {parent}"
+    if (← pure parent.isApp <&&> isCongrRoot parent) then
+      trace_goal[grind.debug.parent] "reinsert: {parent}"
       addCongrTable parent
 
 /-- Closes the goal when `True` and `False` are in the same equivalence class. -/
@@ -90,9 +91,9 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
   let rhsNode ← getENode rhs
   if isSameExpr lhsNode.root rhsNode.root then
     -- `lhs` and `rhs` are already in the same equivalence class.
-    trace[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
+    trace_goal[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
     return ()
-  trace[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
+  trace_goal[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
   let lhsRoot ← getENode lhsNode.root
   let rhsRoot ← getENode rhsNode.root
   let mut valueInconsistency := false
@@ -117,11 +118,11 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
   unless (← isInconsistent) do
     if valueInconsistency then
       closeGoalWithValuesEq lhsRoot.self rhsRoot.self
-  trace[grind.debug] "after addEqStep, {← ppState}"
+  trace_goal[grind.debug] "after addEqStep, {← ppState}"
   checkInvariants
 where
   go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
-    trace[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
+    trace_goal[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
     /-
     We have the following `target?/proof?`
     `lhs -> ... -> lhsNode.root`
@@ -138,7 +139,7 @@ where
     }
     let parents ← removeParents lhsRoot.self
     updateRoots lhs rhsNode.root
-    trace[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
+    trace_goal[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
     reinsertParents parents
     setENode lhsNode.root { (← getENode lhsRoot.self) with -- We must retrieve `lhsRoot` since it was updated.
       next := rhsRoot.next
@@ -190,17 +191,24 @@ where
     addEqStep lhs rhs proof isHEq
     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
   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
   addEqCore lhs rhs proof true
 
-/--
-Adds a new `fact` justified by the given proof and using the given generation.
--/
+/-- 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
+  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
-  trace[grind.assert] "{fact}"
+  trace_goal[grind.assert] "{fact}"
   if (← isInconsistent) then return ()
   resetNewEqs
   let_expr Not p := fact

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

@@ -9,14 +9,18 @@ import Lean.Meta.Tactic.Grind.Types
 namespace Lean.Meta.Grind
 
 private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit := do
+  -- Remark: we must use `shareCommon` before using `pushEq` and `pushHEq`.
+  -- This is needed because the result type of the injection theorem may allocate
   match_expr eqs with
   | And left right =>
     propagateInjEqs left (.proj ``And 0 proof)
     propagateInjEqs right (.proj ``And 1 proof)
-  | Eq _ lhs rhs    => pushEq lhs rhs proof
-  | HEq _ lhs _ rhs => pushHEq lhs rhs proof
+  | Eq _ lhs rhs    =>
+    pushEq (← shareCommon lhs) (← shareCommon rhs) proof
+  | HEq _ lhs _ rhs =>
+    pushHEq (← shareCommon lhs) (← shareCommon rhs) proof
   | _ =>
-   trace[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
+   trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
    return ()
 
 /--

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

@@ -0,0 +1,35 @@
+/-
+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.Util
+import Init.Simproc
+import Lean.Meta.Tactic.Simp.Simproc
+
+namespace Lean.Meta.Grind
+
+/--
+Returns `Grind.doNotSimp e`.
+Recall that `Grind.doNotSimp` is an identity function, but the following simproc is used to prevent the term `e` from being simplified.
+-/
+def markAsDoNotSimp (e : Expr) : MetaM Expr :=
+  mkAppM ``Grind.doNotSimp #[e]
+
+builtin_dsimproc_decl reduceDoNotSimp (Grind.doNotSimp _) := fun e => do
+  let_expr Grind.doNotSimp _ _ ← e | return .continue
+  return .done e
+
+/-- Adds `reduceDoNotSimp` to `s` -/
+def addDoNotSimp (s : Simprocs) : CoreM Simprocs := do
+  s.add ``reduceDoNotSimp (post := false)
+
+/-- Erases `Grind.doNotSimp` annotations. -/
+def eraseDoNotSimp (e : Expr) : CoreM Expr := do
+  let pre (e : Expr) := do
+    let_expr Grind.doNotSimp _ a := e | return .continue e
+    return .continue a
+  Core.transform e (pre := pre)
+
+end Lean.Meta.Grind

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

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Intro
+import Lean.Meta.Tactic.Grind.DoNotSimp
 
 namespace Lean.Meta.Grind
 namespace EMatch
@@ -15,6 +16,8 @@ namespace EMatch
 inductive Cnstr where
   | /-- Matches pattern `pat` with term `e` -/
     «match» (pat : Expr) (e : Expr)
+  | /-- Matches offset pattern `pat+k` with term `e` -/
+    offset (pat : Expr) (k : Nat) (e : Expr)
   | /-- This constraint is used to encode multi-patterns. -/
     «continue» (pat : Expr)
   deriving Inhabited
@@ -48,6 +51,8 @@ structure Context where
   useMT : Bool := true
   /-- `EMatchTheorem` being processed. -/
   thm   : EMatchTheorem := default
+  /-- Initial application used to start E-matching -/
+  initApp : Expr := default
   deriving Inhabited
 
 /-- State for the E-matching monad -/
@@ -61,6 +66,9 @@ abbrev M := ReaderT Context $ StateRefT State GoalM
 def M.run' (x : M α) : GoalM α :=
   x {} |>.run' {}
 
+@[inline] private abbrev withInitApp (e : Expr) (x : M α) : M α :=
+  withReader (fun ctx => { ctx with initApp := e }) x
+
 /--
 Assigns `bidx := e` in `c`. If `bidx` is already assigned in `c`, we check whether
 `e` and `c.assignment[bidx]` are in the same equivalence class.
@@ -87,6 +95,28 @@ private def eqvFunctions (pFn eFn : Expr) : Bool :=
   (pFn.isFVar && pFn == eFn)
   || (pFn.isConst && eFn.isConstOf pFn.constName!)
 
+/-- Matches a pattern argument. See `matchArgs?`. -/
+private def matchArg? (c : Choice) (pArg : Expr) (eArg : Expr) : OptionT GoalM Choice := do
+  if isPatternDontCare pArg then
+    return c
+  else if pArg.isBVar then
+    assign? c pArg.bvarIdx! eArg
+  else if let some pArg := groundPattern? pArg then
+    guard (← isEqv pArg eArg)
+    return c
+  else if let some (pArg, k) := isOffsetPattern? pArg then
+    assert! Option.isNone <| isOffsetPattern? pArg
+    assert! !isPatternDontCare pArg
+    return { c with cnstrs := .offset pArg k eArg :: c.cnstrs }
+  else
+    return { c with cnstrs := .match pArg eArg :: c.cnstrs }
+
+private def Choice.updateGen (c : Choice) (gen : Nat) : Choice :=
+  { c with gen := Nat.max gen c.gen }
+
+private def pushChoice (c : Choice) : M Unit :=
+  modify fun s => { s with choiceStack := c :: s.choiceStack }
+
 /--
 Matches arguments of pattern `p` with term `e`. Returns `some` if successful,
 and `none` otherwise. It may update `c`s assignment and list of contraints to be
@@ -96,16 +126,8 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
   if !p.isApp then return c -- Done
   let pArg := p.appArg!
   let eArg := e.appArg!
-  let goFn c := matchArgs? c p.appFn! e.appFn!
-  if isPatternDontCare pArg then
-    goFn c
-  else if pArg.isBVar then
-    goFn (← assign? c pArg.bvarIdx! eArg)
-  else if let some pArg := groundPattern? pArg then
-    guard (← isEqv pArg eArg)
-    goFn c
-  else
-    goFn { c with cnstrs := .match pArg eArg :: c.cnstrs }
+  let c ← matchArg? c pArg eArg
+  matchArgs? c p.appFn! e.appFn!
 
 /--
 Matches pattern `p` with term `e` with respect to choice `c`.
@@ -120,15 +142,46 @@ private partial def processMatch (c : Choice) (p : Expr) (e : Expr) : M Unit :=
   let mut curr := e
   repeat
     let n ← getENode curr
-    if n.generation <= maxGeneration
+    -- Remark: we use `<` because the instance generation is the maximum term generation + 1
+    if n.generation < maxGeneration
        -- uses heterogeneous equality or is the root of its congruence class
        && (n.heqProofs || n.isCongrRoot)
        && eqvFunctions pFn curr.getAppFn
        && curr.getAppNumArgs == numArgs then
       if let some c ← matchArgs? c p curr |>.run then
-        let gen := n.generation
-        let c := { c with gen := Nat.max gen c.gen }
-        modify fun s => { s with choiceStack := c :: s.choiceStack }
+        pushChoice (c.updateGen n.generation)
+    curr ← getNext curr
+    if isSameExpr curr e then break
+
+/--
+Matches offset pattern `pArg+k` with term `e` with respect to choice `c`.
+-/
+private partial def processOffset (c : Choice) (pArg : Expr) (k : Nat) (e : Expr) : M Unit := do
+  let maxGeneration ← getMaxGeneration
+  let mut curr := e
+  repeat
+    let n ← getENode curr
+    if n.generation < maxGeneration then
+      if let some (eArg, k') ← isOffset? curr |>.run then
+        if k' < k then
+          let c := c.updateGen n.generation
+          pushChoice { c with cnstrs := .offset pArg (k - k') eArg :: c.cnstrs }
+        else if k' == k then
+          if let some c ← matchArg? c pArg eArg |>.run then
+            pushChoice (c.updateGen n.generation)
+        else if k' > k then
+          let eArg' := mkNatAdd eArg (mkNatLit (k' - k))
+          let eArg' ← shareCommon (← canon eArg')
+          internalize eArg' (n.generation+1)
+          if let some c ← matchArg? c pArg eArg' |>.run then
+            pushChoice (c.updateGen n.generation)
+      else if let some k' ← evalNat curr |>.run then
+        if k' >= k then
+          let eArg' := mkNatLit (k' - k)
+          let eArg' ← shareCommon (← canon eArg')
+          internalize eArg' (n.generation+1)
+          if let some c ← matchArg? c pArg eArg' |>.run then
+            pushChoice (c.updateGen n.generation)
     curr ← getNext curr
     if isSameExpr curr e then break
 
@@ -139,13 +192,26 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
   let maxGeneration ← getMaxGeneration
   for app in apps do
     let n ← getENode app
-    if n.generation <= maxGeneration
+    if n.generation < maxGeneration
        && (n.heqProofs || n.isCongrRoot) then
       if let some c ← matchArgs? c p app |>.run then
         let gen := n.generation
         let c := { c with gen := Nat.max gen c.gen }
         modify fun s => { s with choiceStack := c :: s.choiceStack }
 
+/--
+Helper function for marking parts of `match`-equation theorem as "do-not-simplify"
+`initApp` is the match-expression used to instantiate the `match`-equation.
+-/
+private partial def annotateMatchEqnType (prop : Expr) (initApp : Expr) : M Expr := do
+  if let .forallE n d b bi := prop then
+    withLocalDecl n bi (← markAsDoNotSimp d) fun x => do
+      mkForallFVars #[x] (← annotateMatchEqnType (b.instantiate1 x) initApp)
+  else
+    let_expr f@Eq α lhs rhs := prop | return prop
+    -- See comment at `Grind.EqMatch`
+    return mkApp4 (mkConst ``Grind.EqMatch f.constLevels!) α (← markAsDoNotSimp lhs) rhs initApp
+
 /--
 Stores new theorem instance in the state.
 Recall that new instances are internalized later, after a full round of ematching.
@@ -154,9 +220,11 @@ private def addNewInstance (origin : Origin) (proof : Expr) (generation : Nat) :
   let proof ← instantiateMVars proof
   if grind.debug.proofs.get (← getOptions) then
     check proof
-  let prop ← inferType proof
-  trace[grind.ematch.instance] "{← origin.pp}: {prop}"
-  addTheoremInstance proof prop generation
+  let mut prop ← inferType proof
+  if Match.isMatchEqnTheorem (← getEnv) origin.key then
+    prop ← annotateMatchEqnType prop (← read).initApp
+  trace_goal[grind.ematch.instance] "{← origin.pp}: {prop}"
+  addTheoremInstance proof prop (generation+1)
 
 /--
 After processing a (multi-)pattern, use the choice assignment to instantiate the proof.
@@ -166,36 +234,38 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
   let thm := (← read).thm
   unless (← markTheoremInstance thm.proof c.assignment) do
     return ()
-  trace[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
+  trace_goal[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
   let proof ← thm.getProofWithFreshMVarLevels
   let numParams := thm.numParams
   assert! c.assignment.size == numParams
   let (mvars, bis, _) ← forallMetaBoundedTelescope (← inferType proof) numParams
   if mvars.size != thm.numParams then
-    trace[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
+    trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
     return ()
   -- Apply assignment
   for h : i in [:mvars.size] do
     let v := c.assignment[numParams - i - 1]!
     unless isSameExpr v unassigned do
       let mvarId := mvars[i].mvarId!
-      unless (← isDefEq (← mvarId.getType) (← inferType v) <&&> mvarId.checkedAssign v) do
-        trace[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}"
+      let mvarIdType ← mvarId.getType
+      let vType ← inferType v
+      unless (← isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
+        trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
         return ()
   -- Synthesize instances
   for mvar in mvars, bi in bis do
     if bi.isInstImplicit && !(← mvar.mvarId!.isAssigned) then
       let type ← inferType mvar
       unless (← synthesizeInstance mvar type) do
-        trace[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
+        trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
         return ()
+  let proof := mkAppN proof mvars
   if (← mvars.allM (·.mvarId!.isAssigned)) then
-    addNewInstance thm.origin (mkAppN proof mvars) c.gen
+    addNewInstance thm.origin proof c.gen
   else
-    let proof := mkAppN proof mvars
     let mvars ← mvars.filterM fun mvar => return !(← mvar.mvarId!.isAssigned)
     if let some mvarBad ← mvars.findM? fun mvar => return !(← isProof mvar) then
-      trace[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
+      trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
     let proof ← mkLambdaFVars (binderInfoForMVars := .default) mvars (← instantiateMVars proof)
     addNewInstance thm.origin proof c.gen
 where
@@ -204,16 +274,18 @@ where
     isDefEq x val
 
 /-- Process choice stack until we don't have more choices to be processed. -/
-private partial def processChoices : M Unit := do
-  unless (← get).choiceStack.isEmpty do
+private def processChoices : M Unit := do
+  let maxGeneration ← getMaxGeneration
+  while !(← get).choiceStack.isEmpty do
     checkSystem "ematch"
     if (← checkMaxInstancesExceeded) then return ()
     let c ← modifyGet fun s : State => (s.choiceStack.head!, { s with choiceStack := s.choiceStack.tail! })
-    match c.cnstrs with
-    | [] => instantiateTheorem c
-    | .match p e :: cnstrs => processMatch { c with cnstrs } p e
-    | .continue p :: cnstrs => processContinue { c with cnstrs } p
-    processChoices
+    if c.gen < maxGeneration then
+      match c.cnstrs with
+      | [] => instantiateTheorem c
+      | .match p e :: cnstrs => processMatch { c with cnstrs } p e
+      | .offset p k e :: cnstrs => processOffset { c with cnstrs } p k e
+      | .continue p :: cnstrs => processContinue { c with cnstrs } p
 
 private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
   let some apps := (← getThe Goal).appMap.find? p.toHeadIndex
@@ -227,9 +299,10 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
     let n ← getENode app
     if (n.heqProofs || n.isCongrRoot) &&
        (!useMT || n.mt == gmt) then
-      if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
-        modify fun s => { s with choiceStack := [c] }
-        processChoices
+      withInitApp app do
+        if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
+          modify fun s => { s with choiceStack := [c] }
+          processChoices
 
 def ematchTheorem (thm : EMatchTheorem) : M Unit := do
   if (← checkMaxInstancesExceeded) then return ()
@@ -268,7 +341,7 @@ def ematch : GoalM Unit := do
   let go (thms newThms : PArray EMatchTheorem) : EMatch.M Unit := do
     withReader (fun ctx => { ctx with useMT := true }) <| ematchTheorems thms
     withReader (fun ctx => { ctx with useMT := false }) <| ematchTheorems newThms
-  if (← checkMaxInstancesExceeded) then
+  if (← checkMaxInstancesExceeded <||> checkMaxEmatchExceeded) then
     return ()
   else
     go (← get).thms (← get).newThms |>.run'
@@ -276,17 +349,18 @@ def ematch : GoalM Unit := do
       thms         := s.thms ++ s.newThms
       newThms      := {}
       gmt          := s.gmt + 1
+      numEmatch    := s.numEmatch + 1
     }
 
 /-- Performs one round of E-matching, and assert new instances. -/
-def ematchAndAssert? (goal : Goal) : GrindM (Option (List Goal)) := do
+def ematchAndAssert : GrindTactic := fun goal => do
   let numInstances := goal.numInstances
   let goal ← GoalM.run' goal ematch
   if goal.numInstances == numInstances then
     return none
   assertAll goal
 
-def ematchStar (goal : Goal) : GrindM (List Goal) := do
-  iterate goal ematchAndAssert?
+def ematchStar : GrindTactic :=
+  ematchAndAssert.iterate
 
 end Lean.Meta.Grind

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

@@ -4,15 +4,49 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
+import Init.Grind.Util
+import Init.Grind.Tactics
 import Lean.HeadIndex
 import Lean.PrettyPrinter
 import Lean.Util.FoldConsts
 import Lean.Util.CollectFVars
 import Lean.Meta.Basic
 import Lean.Meta.InferType
+import Lean.Meta.Eqns
+import Lean.Meta.Tactic.Grind.Util
 
 namespace Lean.Meta.Grind
 
+def mkOffsetPattern (pat : Expr) (k : Nat) : Expr :=
+  mkApp2 (mkConst ``Grind.offset) pat (mkRawNatLit k)
+
+private def detectOffsets (pat : Expr) : MetaM Expr := do
+  let pre (e : Expr) := do
+    if e == pat then
+      -- We only consider nested offset patterns
+      return .continue e
+    else match e with
+      | .letE .. | .lam .. | .forallE .. => return .done e
+      | _ =>
+        let some (e, k) ← isOffset? e
+          | return .continue e
+        if k == 0 then return .continue e
+        return .continue <| mkOffsetPattern e k
+  Core.transform pat (pre := pre)
+
+def isOffsetPattern? (pat : Expr) : Option (Expr × Nat) := Id.run do
+  let_expr Grind.offset pat k := pat | none
+  let .lit (.natVal k) := k | none
+  return some (pat, k)
+
+def preprocessPattern (pat : Expr) (normalizePattern := true) : MetaM Expr := do
+  let pat ← instantiateMVars pat
+  let pat ← unfoldReducible pat
+  let pat ← if normalizePattern then normalize pat else pure pat
+  let pat ← detectOffsets pat
+  let pat ← foldProjs pat
+  return pat
+
 inductive Origin where
   /-- A global declaration in the environment. -/
   | decl (declName : Name)
@@ -23,22 +57,28 @@ inductive Origin where
   is the provided grind argument. The `id` is a unique identifier for the call.
   -/
   | stx (id : Name) (ref : Syntax)
-  | other
-  deriving Inhabited, Repr
+  | other (id : Name)
+  deriving Inhabited, Repr, BEq
 
 /-- A unique identifier corresponding to the origin. -/
 def Origin.key : Origin → Name
   | .decl declName => declName
   | .fvar fvarId   => fvarId.name
   | .stx id _      => id
-  | .other         => `other
+  | .other id      => id
 
 def Origin.pp [Monad m] [MonadEnv m] [MonadError m] (o : Origin) : m MessageData := do
   match o with
   | .decl declName => return MessageData.ofConst (← mkConstWithLevelParams declName)
   | .fvar fvarId   => return mkFVar fvarId
   | .stx _ ref     => return ref
-  | .other         => return "[unknown]"
+  | .other id      => return id
+
+instance : BEq Origin where
+  beq a b := a.key == b.key
+
+instance : Hashable Origin where
+  hash a := hash a.key
 
 /-- A theorem for heuristic instantiation based on E-matching. -/
 structure EMatchTheorem where
@@ -56,17 +96,58 @@ structure EMatchTheorem where
   origin      : Origin
   deriving Inhabited
 
-/-- The key is a symbol from `EMatchTheorem.symbols`. -/
-abbrev EMatchTheorems := PHashMap Name (List EMatchTheorem)
+/-- Set of E-matching theorems. -/
+structure EMatchTheorems where
+  /-- The key is a symbol from `EMatchTheorem.symbols`. -/
+  private map : PHashMap Name (List EMatchTheorem) := {}
+  /-- Set of theorem ids that have been inserted using `insert`. -/
+  private origins : PHashSet Origin := {}
+  /-- Theorems that have been marked as erased -/
+  private erased  : PHashSet Origin := {}
+  deriving Inhabited
 
+/--
+Inserts a `thm` with symbols `[s_1, ..., s_n]` to `s`.
+We add `s_1 -> { thm with symbols := [s_2, ..., s_n] }`.
+When `grind` internalizes a term containing symbol `s`, we
+process all theorems `thm` associated with key `s`.
+If their `thm.symbols` is empty, we say they are activated.
+Otherwise, we reinsert into `map`.
+-/
 def EMatchTheorems.insert (s : EMatchTheorems) (thm : EMatchTheorem) : EMatchTheorems := Id.run do
   let .const declName :: syms := thm.symbols
     | unreachable!
   let thm := { thm with symbols := syms }
-  if let some thms := s.find? declName then
-    return PersistentHashMap.insert s declName (thm::thms)
+  let { map, origins, erased } := s
+  let origins := origins.insert thm.origin
+  let erased := erased.erase thm.origin
+  if let some thms := map.find? declName then
+    return { map := map.insert declName (thm::thms), origins, erased }
   else
-    return PersistentHashMap.insert s declName [thm]
+    return { map := map.insert declName [thm], origins, erased }
+
+/-- Returns `true` if `s` contains a theorem with the given origin. -/
+def EMatchTheorems.contains (s : EMatchTheorems) (origin : Origin) : Bool :=
+  s.origins.contains origin
+
+/-- Mark the theorm with the given origin as `erased` -/
+def EMatchTheorems.erase (s : EMatchTheorems) (origin : Origin) : EMatchTheorems :=
+  { s with erased := s.erased.insert origin, origins := s.origins.erase origin }
+
+/-- Returns true if the theorem has been marked as erased. -/
+def EMatchTheorems.isErased (s : EMatchTheorems) (origin : Origin) : Bool :=
+  s.erased.contains origin
+
+/--
+Retrieves theorems from `s` associated with the given symbol. See `EMatchTheorem.insert`.
+The theorems are removed from `s`.
+-/
+@[inline]
+def EMatchTheorems.retrieve? (s : EMatchTheorems) (sym : Name) : Option (List EMatchTheorem × EMatchTheorems) :=
+  if let some thms := s.map.find? sym then
+    some (thms, { s with map := s.map.erase sym })
+  else
+    none
 
 def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr := do
   if thm.proof.isConst && thm.levelParams.isEmpty then
@@ -85,7 +166,7 @@ def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr
 private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTheorem EMatchTheorems ←
   registerSimpleScopedEnvExtension {
     addEntry := EMatchTheorems.insert
-    initial  := .empty
+    initial  := {}
   }
 
 -- TODO: create attribute?
@@ -154,17 +235,19 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
     | _ => none
 
 /--
-Returns a bit-mask `mask` s.t. `mask[i]` is true if the the corresponding argument is
-- a type or type former, or
+Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
+- a type (that is not a proposition) or type former, or
 - a proof, or
 - an instance implicit argument
 
 When `mask[i]`, we say the corresponding argument is a "support" argument.
 -/
-private def getPatternFunMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
+def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
   forallBoundedTelescope (← inferType f) numArgs fun xs _ => do
     xs.mapM fun x => do
-      if (← isTypeFormer x <||> isProof x) then
+      if (← isProp x) then
+        return false
+      else if (← isTypeFormer x <||> isProof x) then
         return true
       else
         return (← x.fvarId!.getDecl).binderInfo matches .instImplicit
@@ -172,16 +255,26 @@ private def getPatternFunMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) :=
 private partial def go (pattern : Expr) (root := false) : M Expr := do
   if root && !pattern.hasLooseBVars then
     throwError "invalid pattern, it does not have pattern variables"
+  if let some (e, k) := isOffsetPattern? pattern then
+    let e ← goArg e (isSupport := false)
+    if e == dontCare then
+      return dontCare
+    else
+      return mkOffsetPattern e k
   let some f := getPatternFn? pattern
-    | throwError "invalid pattern, (non-forbidden) application expected"
+    | throwError "invalid pattern, (non-forbidden) application expected{indentExpr pattern}"
   assert! f.isConst || f.isFVar
   saveSymbol f.toHeadIndex
-  let mut args := pattern.getAppArgs
-  let supportMask ← getPatternFunMask f args.size
-  for i in [:args.size] do
-    let arg := args[i]!
+  let mut args := pattern.getAppArgs.toVector
+  let supportMask ← getPatternSupportMask f args.size
+  for h : i in [:args.size] do
+    let arg := args[i]
     let isSupport := supportMask[i]?.getD false
-    let arg ← if !arg.hasLooseBVars then
+    args := args.set i (← goArg arg isSupport)
+  return mkAppN f args.toArray
+where
+  goArg (arg : Expr) (isSupport : Bool) : M Expr := do
+    if !arg.hasLooseBVars then
       if arg.hasMVar then
         pure dontCare
       else
@@ -200,13 +293,14 @@ private partial def go (pattern : Expr) (root := false) : M Expr := do
           go arg
         else
           pure dontCare
-    args := args.set! i arg
-  return mkAppN f args
 
 def main (patterns : List Expr) : MetaM (List Expr × List HeadIndex × Std.HashSet Nat) := do
   let (patterns, s) ← patterns.mapM go |>.run {}
   return (patterns, s.symbols.toList, s.bvarsFound)
 
+def normalizePattern (e : Expr) : M Expr := do
+  go e
+
 end NormalizePattern
 
 /--
@@ -320,8 +414,8 @@ private def checkCoverage (thmProof : Expr) (numParams : Nat) (bvarsFound : Std.
 Given a theorem with proof `proof` and `numParams` parameters, returns a message
 containing the parameters at positions `paramPos`.
 -/
-private def ppParamsAt (proof : Expr) (numParms : Nat) (paramPos : List Nat) : MetaM MessageData := do
-  forallBoundedTelescope (← inferType proof) numParms fun xs _ => do
+private def ppParamsAt (proof : Expr) (numParams : Nat) (paramPos : List Nat) : MetaM MessageData := do
+  forallBoundedTelescope (← inferType proof) numParams fun xs _ => do
     let mut msg := m!""
     let mut first := true
     for h : i in [:xs.size] do
@@ -331,24 +425,300 @@ private def ppParamsAt (proof : Expr) (numParms : Nat) (paramPos : List Nat) : M
         msg := msg ++ m!"{x} : {← inferType x}"
     addMessageContextFull msg
 
-def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
-  let .thmInfo info ← getConstInfo declName
-    | throwError "`{declName}` is not a theorem, you cannot assign patterns to non-theorems for the `grind` tactic"
-  let us := info.levelParams.map mkLevelParam
-  let proof := mkConst declName us
+/--
+Creates an E-matching theorem for a theorem with proof `proof`, `numParams` parameters, and the given set of patterns.
+Pattern variables are represented using de Bruijn indices.
+-/
+def mkEMatchTheoremCore (origin : Origin) (levelParams : Array Name) (numParams : Nat) (proof : Expr) (patterns : List Expr) : MetaM EMatchTheorem := do
   let (patterns, symbols, bvarFound) ← NormalizePattern.main patterns
-  assert! symbols.all fun s => s matches .const _
-  trace[grind.ematch.pattern] "{declName}: {patterns.map ppPattern}"
+  trace[grind.ematch.pattern] "{MessageData.ofConst proof}: {patterns.map ppPattern}"
   if let .missing pos ← checkCoverage proof numParams bvarFound then
      let pats : MessageData := m!"{patterns.map ppPattern}"
-     throwError "invalid pattern(s) for `{declName}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
-  ematchTheoremsExt.add {
-     proof, patterns, numParams, symbols
-     levelParams := #[]
-     origin      := .decl declName
+     throwError "invalid pattern(s) for `{← origin.pp}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
+  return {
+    proof, patterns, numParams, symbols
+    levelParams, origin
   }
 
+private def getProofFor (declName : Name) : CoreM Expr := do
+  let .thmInfo info ← getConstInfo declName
+    | throwError "`{declName}` is not a theorem"
+  let us := info.levelParams.map mkLevelParam
+  return mkConst declName us
+
+/--
+Creates an E-matching theorem for `declName` with `numParams` parameters, and the given set of patterns.
+Pattern variables are represented using de Bruijn indices.
+-/
+def mkEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM EMatchTheorem := do
+  mkEMatchTheoremCore (.decl declName) #[] numParams (← getProofFor declName) patterns
+
+/--
+Given a theorem with proof `proof` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
+creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
+If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the pattern.
+-/
+def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof : Expr) (normalizePattern : Bool) (useLhs : Bool) : MetaM EMatchTheorem := do
+  let (numParams, patterns) ← forallTelescopeReducing (← inferType proof) fun xs type => do
+    let (lhs, rhs) ← match_expr type with
+      | Eq _ lhs rhs => pure (lhs, rhs)
+      | Iff lhs rhs => pure (lhs, rhs)
+      | HEq _ lhs _ rhs => pure (lhs, rhs)
+      | _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
+    let pat := if useLhs then lhs else rhs
+    let pat ← preprocessPattern pat normalizePattern
+    return (xs.size, [pat.abstract xs])
+  mkEMatchTheoremCore origin levelParams numParams proof patterns
+
+/--
+Given theorem with name `declName` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
+creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
+
+If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the
+pattern.
+-/
+def mkEMatchEqTheorem (declName : Name) (normalizePattern := true) (useLhs : Bool := true) : MetaM EMatchTheorem := do
+  mkEMatchEqTheoremCore (.decl declName) #[] (← getProofFor declName) normalizePattern useLhs
+
+/--
+Adds an E-matching theorem to the environment.
+See `mkEMatchTheorem`.
+-/
+def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
+  ematchTheoremsExt.add (← mkEMatchTheorem declName numParams patterns)
+
+/--
+Adds an E-matching equality theorem to the environment.
+See `mkEMatchEqTheorem`.
+-/
+def addEMatchEqTheorem (declName : Name) : MetaM Unit := do
+  ematchTheoremsExt.add (← mkEMatchEqTheorem declName)
+
+/-- Returns the E-matching theorems registered in the environment. -/
 def getEMatchTheorems : CoreM EMatchTheorems :=
   return ematchTheoremsExt.getState (← getEnv)
 
+private inductive TheoremKind where
+  | eqLhs | eqRhs | eqBoth | fwd | bwd | default
+  deriving Inhabited, BEq
+
+private def TheoremKind.toAttribute : TheoremKind → String
+  | .eqLhs   => "[grind =]"
+  | .eqRhs   => "[grind =_]"
+  | .eqBoth  => "[grind _=_]"
+  | .fwd     => "[grind →]"
+  | .bwd     => "[grind ←]"
+  | .default => "[grind]"
+
+private def TheoremKind.explainFailure : TheoremKind → String
+  | .eqLhs   => "failed to find pattern in the left-hand side of the theorem's conclusion"
+  | .eqRhs   => "failed to find pattern in the right-hand side of the theorem's conclusion"
+  | .eqBoth  => unreachable! -- eqBoth is a macro
+  | .fwd     => "failed to find patterns in the antecedents of the theorem"
+  | .bwd     => "failed to find patterns in the theorem's conclusion"
+  | .default => "failed to find patterns"
+
+/-- Returns the types of `xs` that are propositions. -/
+private def getPropTypes (xs : Array Expr) : MetaM (Array Expr) :=
+  xs.filterMapM fun x => do
+    let type ← inferType x
+    if (← isProp type) then return some type else return none
+
+/-- State for the (pattern) `CollectorM` monad -/
+private structure Collector.State where
+  /-- Pattern found so far. -/
+  patterns  : Array Expr := #[]
+  done      : Bool := false
+
+private structure Collector.Context where
+  proof : Expr
+  xs    : Array Expr
+
+/-- Monad for collecting patterns for a theorem. -/
+private abbrev CollectorM := ReaderT Collector.Context $ StateRefT Collector.State NormalizePattern.M
+
+/-- Similar to `getPatternFn?`, but operates on expressions that do not contain loose de Bruijn variables. -/
+private def isPatternFnCandidate (f : Expr) : CollectorM Bool := do
+  match f with
+  | .const declName _ => return !isForbidden declName
+  | .fvar .. => return !(← read).xs.contains f
+  | _ => return false
+
+private def addNewPattern (p : Expr) : CollectorM Unit := do
+  trace[grind.ematch.pattern.search] "found pattern: {ppPattern p}"
+  let bvarsFound := (← getThe NormalizePattern.State).bvarsFound
+  let done := (← checkCoverage (← read).proof (← read).xs.size bvarsFound) matches .ok
+  if done then
+    trace[grind.ematch.pattern.search] "found full coverage"
+  modify fun s => { s with patterns := s.patterns.push p, done }
+
+private partial def collect (e : Expr) : CollectorM Unit := do
+  if (← get).done then return ()
+  match e with
+  | .app .. =>
+    let f := e.getAppFn
+    if (← isPatternFnCandidate f) then
+      let saved ← getThe NormalizePattern.State
+      try
+        trace[grind.ematch.pattern.search] "candidate: {e}"
+        let p := e.abstract (← read).xs
+        unless p.hasLooseBVars do
+          trace[grind.ematch.pattern.search] "skip, does not contain pattern variables"
+          return ()
+        let p ← NormalizePattern.normalizePattern p
+        if saved.bvarsFound.size < (← getThe NormalizePattern.State).bvarsFound.size then
+          addNewPattern p
+          return ()
+        trace[grind.ematch.pattern.search] "skip, no new variables covered"
+        -- restore state and continue search
+        set saved
+      catch _ =>
+        trace[grind.ematch.pattern.search] "skip, exception during normalization"
+        -- restore state and continue search
+        set saved
+    let args := e.getAppArgs
+    for arg in args, flag in (← NormalizePattern.getPatternSupportMask f args.size) do
+      unless flag do
+        collect arg
+  | .forallE _ d b _ =>
+    if (← pure e.isArrow <&&> isProp d <&&> isProp b) then
+      collect d
+      collect b
+  | _ => return ()
+
+private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option (List Expr × List HeadIndex)) := do
+  let go : CollectorM (Option (List Expr)) := do
+    for place in searchPlaces do
+      let place ← preprocessPattern place
+      collect place
+      if (← get).done then
+        return some ((← get).patterns.toList)
+    return none
+  let (some ps, s) ← go { proof, xs } |>.run' {} |>.run {}
+    | return none
+  return some (ps, s.symbols.toList)
+
+private def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
+  if kind == .eqLhs then
+    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := true))
+  else if kind == .eqRhs then
+    return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := false))
+  let type ← inferType proof
+  forallTelescopeReducing type fun xs type => do
+    let searchPlaces ← match kind with
+      | .fwd =>
+        let ps ← getPropTypes xs
+        if ps.isEmpty then
+          throwError "invalid `grind` forward theorem, theorem `{← origin.pp}` does not have propositional hypotheses"
+        pure ps
+      | .bwd => pure #[type]
+      | .default => pure <| #[type] ++ (← getPropTypes xs)
+      | _ => unreachable!
+    go xs searchPlaces
+where
+  go (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option EMatchTheorem) := do
+    let some (patterns, symbols) ← collectPatterns? proof xs searchPlaces
+      | return none
+    let numParams := xs.size
+    trace[grind.ematch.pattern] "{← origin.pp}: {patterns.map ppPattern}"
+    return some {
+      proof, patterns, numParams, symbols
+      levelParams, origin
+    }
+
+private def getKind (stx : Syntax) : TheoremKind :=
+  if stx[1].isNone then
+    .default
+  else if stx[1][0].getKind == ``Parser.Attr.grindEq then
+    .eqLhs
+  else if stx[1][0].getKind == ``Parser.Attr.grindFwd then
+    .fwd
+  else if stx[1][0].getKind == ``Parser.Attr.grindEqRhs then
+    .eqRhs
+  else if stx[1][0].getKind == ``Parser.Attr.grindEqBoth then
+    .eqBoth
+  else
+    .bwd
+
+private def addGrindEqAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) (useLhs := true) : MetaM Unit := do
+  if (← getConstInfo declName).isTheorem then
+    ematchTheoremsExt.add (← mkEMatchEqTheorem declName (normalizePattern := true) (useLhs := useLhs)) attrKind
+  else if let some eqns ← getEqnsFor? declName then
+    unless useLhs do
+      throwError "`{declName}` is a definition, you must only use the left-hand side for extracting patterns"
+    for eqn in eqns do
+      ematchTheoremsExt.add (← mkEMatchEqTheorem eqn) attrKind
+  else
+    throwError s!"`{thmKind.toAttribute}` attribute can only be applied to equational theorems or function definitions"
+
+private def addGrindAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) : MetaM Unit := do
+  if thmKind == .eqLhs then
+    addGrindEqAttr declName attrKind thmKind (useLhs := true)
+  else if thmKind == .eqRhs then
+    addGrindEqAttr declName attrKind thmKind (useLhs := false)
+  else if thmKind == .eqBoth then
+    addGrindEqAttr declName attrKind thmKind (useLhs := true)
+    addGrindEqAttr declName attrKind thmKind (useLhs := false)
+  else if !(← getConstInfo declName).isTheorem then
+    addGrindEqAttr declName attrKind thmKind
+  else
+    let some thm ← mkEMatchTheoremWithKind? (.decl declName) #[] (← getProofFor declName) thmKind
+      | throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
+    ematchTheoremsExt.add thm attrKind
+
+builtin_initialize
+  registerBuiltinAttribute {
+    name := `grind
+    descr :=
+      "The `[grind]` attribute is used to annotate declarations.\
+      \
+      When applied to an equational theorem, `[grind =]`, `[grind =_]`, or `[grind _=_]`\
+      will mark the theorem for use in heuristic instantiations by the `grind` tactic,
+      using respectively the left-hand side, the right-hand side, or both sides of the theorem.\
+      When applied to a function, `[grind =]` automatically annotates the equational theorems associated with that function.\
+      When applied to a theorem `[grind ←]` will instantiate the theorem whenever it encounters the conclusion of the theorem
+      (that is, it will use the theorem for backwards reasoning).\
+      When applied to a theorem `[grind →]` will instantiate the theorem whenever it encounters sufficiently many of the propositional hypotheses
+      (that is, it will use the theorem for forwards reasoning).\
+      \
+      The attribute `[grind]` by itself will effectively try `[grind ←]` (if the conclusion is sufficient for instantiation) and then `[grind →]`.\
+      \
+      The `grind` tactic utilizes annotated theorems to add instances of matching patterns into the local context during proof search.\
+      For example, if a theorem `@[grind =] theorem foo_idempotent : foo (foo x) = foo x` is annotated,\
+      `grind` will add an instance of this theorem to the local context whenever it encounters the pattern `foo (foo x)`."
+    applicationTime := .afterCompilation
+    add := fun declName stx attrKind => do
+      addGrindAttr declName attrKind (getKind stx) |>.run' {}
+    erase := fun declName => MetaM.run' do
+      /-
+      Remark: consider the following example
+      ```
+      attribute [grind] foo  -- ok
+      attribute [-grind] foo.eqn_2  -- ok
+      attribute [-grind] foo  -- error
+      ```
+      One may argue that the correct behavior should be
+      ```
+      attribute [grind] foo  -- ok
+      attribute [-grind] foo.eqn_2  -- error
+      attribute [-grind] foo  -- ok
+      ```
+      -/
+      let throwErr := throwError "`{declName}` is not marked with the `[grind]` attribute"
+      let info ← getConstInfo declName
+      if !info.isTheorem then
+        if let some eqns ← getEqnsFor? declName then
+           let s := ematchTheoremsExt.getState (← getEnv)
+           unless eqns.all fun eqn => s.contains (.decl eqn) do
+             throwErr
+           modifyEnv fun env => ematchTheoremsExt.modifyState env fun s =>
+             eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
+        else
+          throwErr
+      else
+        unless ematchTheoremsExt.getState (← getEnv) |>.contains (.decl declName) do
+          throwErr
+        modifyEnv fun env => ematchTheoremsExt.modifyState env fun s => s.erase (.decl declName)
+  }
+
 end Lean.Meta.Grind

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

@@ -15,17 +15,52 @@ If `parent` is a projection-application `proj_i c`,
 check whether the root of the equivalence class containing `c` is a constructor-application `ctor ... a_i ...`.
 If so, internalize the term `proj_i (ctor ... a_i ...)` and add the equality `proj_i (ctor ... a_i ...) = a_i`.
 -/
-def propagateForallProp (parent : Expr) : GoalM Unit := do
-  let .forallE n p q bi := parent | return ()
-  unless (← isEqTrue p) do return ()
-  let h₁ ← mkEqTrueProof p
-  let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
-  let r ← simp qh₁
-  let q := mkLambda n bi p q
-  let q' := r.expr
-  internalize q' (← getGeneration parent)
-  let h₂ ← r.getProof
-  let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
-  pushEq parent q' h
+def propagateForallPropUp (e : Expr) : GoalM Unit := do
+  let .forallE n p q bi := e | return ()
+  trace_goal[grind.debug.forallPropagator] "{e}"
+  if !q.hasLooseBVars then
+    propagateImpliesUp p q
+  else
+    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 r ← simp qh₁
+    let q := mkLambda n bi p q
+    let q' := r.expr
+    internalize q' (← getGeneration e)
+    trace_goal[grind.debug.forallPropagator] "q': {q'} for{indentExpr e}"
+    let h₂ ← r.getProof
+    let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
+    pushEq e q' h
+where
+  propagateImpliesUp (a b : Expr) : GoalM Unit := do
+    unless (← alreadyInternalized b) do return ()
+    if (← isEqFalse a) then
+      -- a = False → (a → b) = True
+      pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_false_left) a b (← mkEqFalseProof a)
+    else if (← isEqTrue a) then
+      -- a = True → (a → b) = b
+      pushEq e b <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_left) a b (← mkEqTrueProof a)
+    else if (← isEqTrue b) then
+      -- b = True → (a → b) = True
+      pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_right) a b (← mkEqTrueProof b)
+
+def propagateForallPropDown (e : Expr) : GoalM Unit := do
+  let .forallE n a b bi := e | return ()
+  if (← isEqFalse e) then
+    if b.hasLooseBVars then
+      let α := a
+      let p := b
+      -- `e` is of the form `∀ x : α, p x`
+      -- Add fact `∃ x : α, ¬ p x`
+      let u ← getLevel α
+      let prop := mkApp2 (mkConst ``Exists [u]) α (mkLambda n bi α (mkNot p))
+      let proof := mkApp3 (mkConst ``Grind.of_forall_eq_false [u]) α (mkLambda n bi α p) (← mkEqFalseProof e)
+      addNewFact proof prop (← getGeneration e)
+    else
+      let h ← mkEqFalseProof e
+      pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_imp_eq_false) a b h
+      pushEqFalse b <| mkApp3 (mkConst ``Grind.eq_false_of_imp_eq_false) a b h
 
 end Lean.Meta.Grind

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

@@ -5,7 +5,10 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Grind.Util
+import Init.Grind.Lemmas
 import Lean.Meta.LitValues
+import Lean.Meta.Match.MatcherInfo
+import Lean.Meta.Match.MatchEqsExt
 import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Util
 
@@ -20,15 +23,19 @@ def addCongrTable (e : Expr) : GoalM Unit := do
     let g := e'.getAppFn
     unless isSameExpr f g do
       unless (← hasSameType f g) do
-        trace[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
+        trace_goal[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
         return ()
-    trace[grind.debug.congr] "{e} = {e'}"
+    trace_goal[grind.debug.congr] "{e} = {e'}"
     pushEqHEq e e' congrPlaceholderProof
     let node ← getENode e
     setENode e { node with congr := e' }
   else
     modify fun s => { s with congrTable := s.congrTable.insert { e } }
 
+/--
+Given an application `e` of the form `f a_1 ... a_n`,
+adds entry `f ↦ e` to `appMap`. Recall that `appMap` is a multi-map.
+-/
 private def updateAppMap (e : Expr) : GoalM Unit := do
   let key := e.toHeadIndex
   modify fun s => { s with
@@ -38,6 +45,50 @@ private def updateAppMap (e : Expr) : GoalM Unit := do
       s.appMap.insert key [e]
   }
 
+/-- Inserts `e` into the list of case-split candidates. -/
+private def addSplitCandidate (e : Expr) : GoalM Unit := do
+  trace_goal[grind.split.candidate] "{e}"
+  modify fun s => { s with splitCandidates := e :: s.splitCandidates }
+
+-- TODO: add attribute to make this extensible
+private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
+
+/-- 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 (← getConfig).splitMatch then
+    if (← isMatcherApp e) then
+      if let .reduced _ ← reduceMatcher? e then
+        -- When instantiating `match`-equations, we add `match`-applications that can be reduced,
+        -- and consequently don't need to be splitted.
+        return ()
+      else
+        addSplitCandidate e
+        return ()
+  let .const declName _  := e.getAppFn | return ()
+    if forbiddenSplitTypes.contains declName then return ()
+    -- We should have a mechanism for letting users to select types to case-split.
+    -- Right now, we just consider inductive predicates that are not in the forbidden list
+    if (← getConfig).splitIndPred then
+      if (← isInductivePredicate declName) then
+        addSplitCandidate e
+
+/--
+If `e` is a `cast`-like term (e.g., `cast h a`), add `HEq e a` to the to-do list.
+It could be an E-matching theorem, but we want to ensure it is always applied since
+we want to rely on the fact that `cast h a` and `a` are in the same equivalence class.
+-/
+private def pushCastHEqs (e : Expr) : GoalM Unit := do
+  match_expr e with
+  | f@cast α β h a => pushHEq e a (mkApp4 (mkConst ``cast_heq f.constLevels!) α β h a)
+  | f@Eq.rec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqRec_heq f.constLevels!) α a motive v b h)
+  | f@Eq.ndrec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqNDRec_heq f.constLevels!) α a motive v b h)
+  | f@Eq.recOn α a motive b h v => pushHEq e v (mkApp6 (mkConst ``Grind.eqRecOn_heq f.constLevels!) α a motive b h v)
+  | _ => return ()
+
 mutual
 /-- Internalizes the nested ground terms in the given pattern. -/
 private partial def internalizePattern (pattern : Expr) (generation : Nat) : GoalM Expr := do
@@ -50,51 +101,74 @@ private partial def internalizePattern (pattern : Expr) (generation : Nat) : Goa
   else pattern.withApp fun f args => do
     return mkAppN f (← args.mapM (internalizePattern · generation))
 
+private partial def activateTheorem (thm : EMatchTheorem) (generation : Nat) : GoalM Unit := do
+  -- Recall that we use the proof as part of the key for a set of instances found so far.
+  -- We don't want to use structural equality when comparing keys.
+  let proof ← shareCommon thm.proof
+  let thm := { thm with proof, patterns := (← thm.patterns.mapM (internalizePattern · generation)) }
+  trace_goal[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
+  modify fun s => { s with newThms := s.newThms.push thm }
+
+/--
+If `Config.matchEqs` is set to `true`, and `f` is `match`-auxiliary function,
+adds its equations to `newThms`.
+-/
+private partial def addMatchEqns (f : Expr) (generation : Nat) : GoalM Unit := do
+  if !(← getConfig).matchEqs then return ()
+  let .const declName _ := f | return ()
+  if !(← isMatcher declName) then return ()
+  if (← get).matchEqNames.contains declName then return ()
+  modify fun s => { s with matchEqNames := s.matchEqNames.insert declName }
+  for eqn in (← Match.getEquationsFor declName).eqnNames do
+    -- We disable pattern normalization to prevent the `match`-expression to be reduced.
+    activateTheorem (← mkEMatchEqTheorem eqn (normalizePattern := false)) generation
+
 private partial def activateTheoremPatterns (fName : Name) (generation : Nat) : GoalM Unit := do
-  if let some thms := (← get).thmMap.find? fName then
-    modify fun s => { s with thmMap := s.thmMap.erase fName }
+  if let some (thms, thmMap) := (← get).thmMap.retrieve? fName then
+    modify fun s => { s with thmMap }
     let appMap := (← get).appMap
     for thm in thms do
-      let symbols := thm.symbols.filter fun sym => !appMap.contains sym
-      let thm := { thm with symbols }
-      match symbols with
-      | [] =>
-        -- Recall that we use the proof as part of the key for a set of instances found so far.
-        -- We don't want to use structural equality when comparing keys.
-        let proof ← shareCommon thm.proof
-        let thm := { thm with proof, patterns := (← thm.patterns.mapM (internalizePattern · generation)) }
-        trace[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
-        modify fun s => { s with newThms := s.newThms.push thm }
-      | _ =>
-        trace[grind.ematch] "reinsert `{thm.origin.key}`"
-        modify fun s => { s with thmMap := s.thmMap.insert thm }
+      unless (← get).thmMap.isErased thm.origin do
+        let symbols := thm.symbols.filter fun sym => !appMap.contains sym
+        let thm := { thm with symbols }
+        match symbols with
+        | [] => activateTheorem thm generation
+        | _ =>
+          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
   if (← alreadyInternalized e) then return ()
-  trace[grind.internalize] "{e}"
+  trace_goal[grind.internalize] "{e}"
   match e with
   | .bvar .. => unreachable!
   | .sort .. => return ()
   | .fvar .. | .letE .. | .lam .. =>
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
-  | .forallE _ d _ _ =>
+  | .forallE _ d b _ =>
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
     if (← isProp d <&&> isProp e) then
       internalize d generation
       registerParent e d
+      unless b.hasLooseBVars do
+        internalize b generation
+        registerParent e b
       propagateUp e
   | .lit .. | .const .. =>
     mkENode e generation
   | .mvar ..
   | .mdata ..
   | .proj .. =>
-    trace[grind.issues] "unexpected term during internalization{indentExpr e}"
+    trace_goal[grind.issues] "unexpected term during internalization{indentExpr e}"
     mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
   | .app .. =>
     if (← isLitValue e) then
       -- We do not want to internalize the components of a literal value.
       mkENode e generation
     else e.withApp fun f args => do
+      checkAndAddSplitCandidate e
+      pushCastHEqs e
+      addMatchEqns f generation
       if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
         -- We only internalize the proposition. We can skip the proof because of
         -- proof irrelevance

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

@@ -11,6 +11,7 @@ import Lean.Meta.Tactic.Grind.Types
 import Lean.Meta.Tactic.Grind.Cases
 import Lean.Meta.Tactic.Grind.Injection
 import Lean.Meta.Tactic.Grind.Core
+import Lean.Meta.Tactic.Grind.Combinators
 
 namespace Lean.Meta.Grind
 
@@ -21,7 +22,7 @@ private inductive IntroResult where
   | newLocal (fvarId : FVarId) (goal : Goal)
   deriving Inhabited
 
-private def introNext (goal : Goal) : GrindM IntroResult := do
+private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
   let target ← goal.mvarId.getType
   if target.isArrow then
     goal.mvarId.withContext do
@@ -49,7 +50,7 @@ private def introNext (goal : Goal) : GrindM IntroResult := do
             -- `p` and `p'` are definitionally equal
             goal.mvarId.assign h
             return .newHyp fvarId { goal with mvarId := mvarIdNew }
-  else if target.isLet || target.isForall then
+  else if target.isLet || target.isForall || target.isLetFun then
     let (fvarId, mvarId) ← goal.mvarId.intro1P
     mvarId.withContext do
       let localDecl ← fvarId.getDecl
@@ -58,17 +59,25 @@ private def introNext (goal : Goal) : GrindM IntroResult := do
         let mvarId ← mvarId.assert (← mkFreshUserName localDecl.userName) localDecl.type (mkFVar fvarId)
         return .newDepHyp { goal with mvarId }
       else
-        return .newLocal fvarId { goal with mvarId }
+        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
+          return .newLocal fvarId goal
+        else
+          return .newLocal fvarId goal
   else
     return .done
 
-private def isCasesCandidate (fvarId : FVarId) : MetaM Bool := do
-  let .const declName _ := (← fvarId.getType).getAppFn | return false
+private def isCasesCandidate (type : Expr) : MetaM Bool := do
+  let .const declName _ := type.getAppFn | return false
   isGrindCasesTarget declName
 
 private def applyCases? (goal : Goal) (fvarId : FVarId) : MetaM (Option (List Goal)) := goal.mvarId.withContext do
-  if (← isCasesCandidate fvarId) then
-    let mvarIds ← cases goal.mvarId fvarId
+  if (← isCasesCandidate (← fvarId.getType)) then
+    let mvarIds ← cases goal.mvarId (mkFVar fvarId)
     return mvarIds.map fun mvarId => { goal with mvarId }
   else
     return none
@@ -80,11 +89,11 @@ private def applyInjection? (goal : Goal) (fvarId : FVarId) : MetaM (Option Goal
     return none
 
 /-- Introduce new hypotheses (and apply `by_contra`) until goal is of the form `... ⊢ False` -/
-partial def intros (goal : Goal) (generation : Nat) : GrindM (List Goal) := do
+partial def intros  (generation : Nat) : GrindTactic' := fun goal => do
   let rec go (goal : Goal) : StateRefT (Array Goal) GrindM Unit := do
     if goal.inconsistent then
       return ()
-    match (← introNext goal) with
+    match (← introNext goal generation) with
     | .done =>
       if let some mvarId ← goal.mvarId.byContra? then
         go { goal with mvarId }
@@ -108,32 +117,27 @@ partial def intros (goal : Goal) (generation : Nat) : GrindM (List Goal) := do
   return goals.toList
 
 /-- Asserts a new fact `prop` with proof `proof` to the given `goal`. -/
-def assertAt (goal : Goal) (proof : Expr) (prop : Expr) (generation : Nat) : GrindM (List Goal) := do
-  -- TODO: check whether `prop` may benefit from `intros` or not. If not, we should avoid the `assert`+`intros` step and use `Grind.add`
-  let mvarId ← goal.mvarId.assert (← mkFreshUserName `h) prop proof
-  let goal := { goal with mvarId }
-  intros goal generation
+def assertAt (proof : Expr) (prop : Expr) (generation : Nat) : GrindTactic' := fun goal => do
+  if (← isCasesCandidate prop) then
+    let mvarId ← goal.mvarId.assert (← mkFreshUserName `h) prop proof
+    let goal := { goal with mvarId }
+    intros generation goal
+  else
+    let goal ← GoalM.run' goal do
+      let r ← simp prop
+      let prop' := r.expr
+      let proof' ← mkEqMP (← r.getProof) proof
+      add prop' proof' generation
+    if goal.inconsistent then return [] else return [goal]
 
 /-- Asserts next fact in the `goal` fact queue. -/
-def assertNext? (goal : Goal) : GrindM (Option (List Goal)) := do
+def assertNext : GrindTactic := fun goal => do
   let some (fact, newFacts) := goal.newFacts.dequeue?
     | return none
-  assertAt { goal with newFacts } fact.proof fact.prop fact.generation
-
-partial def iterate (goal : Goal) (f : Goal → GrindM (Option (List Goal))) : GrindM (List Goal) := do
-  go [goal] []
-where
-  go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
-    match todo with
-    | [] => return result
-    | goal :: todo =>
-      if let some goalsNew ← f goal then
-        go (goalsNew ++ todo) result
-      else
-        go todo (goal :: result)
+  assertAt fact.proof fact.prop fact.generation { goal with newFacts }
 
 /-- Asserts all facts in the `goal` fact queue. -/
-partial def assertAll (goal : Goal) : GrindM (List Goal) := do
-  iterate goal assertNext?
+partial def assertAll : GrindTactic :=
+  assertNext.iterate
 
 end Lean.Meta.Grind

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

@@ -85,9 +85,9 @@ private def checkProofs : GoalM Unit := do
       for b in eqc do
         unless isSameExpr a b do
           let p ← mkEqHEqProof a b
-          trace[grind.debug.proofs] "{a} = {b}"
+          trace_goal[grind.debug.proofs] "{a} = {b}"
           check p
-          trace[grind.debug.proofs] "checked: {← inferType p}"
+          trace_goal[grind.debug.proofs] "checked: {← inferType p}"
 
 /--
 Checks basic invariants if `grind.debug` is enabled.

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

@@ -14,35 +14,35 @@ import Lean.Meta.Tactic.Grind.Util
 import Lean.Meta.Tactic.Grind.Inv
 import Lean.Meta.Tactic.Grind.Intro
 import Lean.Meta.Tactic.Grind.EMatch
+import Lean.Meta.Tactic.Grind.Split
+import Lean.Meta.Tactic.Grind.SimpUtil
 
 namespace Lean.Meta.Grind
 
-def mkMethods : CoreM Methods := do
+def mkMethods (fallback : Fallback) : CoreM Methods := do
   let builtinPropagators ← builtinPropagatorsRef.get
   return {
+    fallback
     propagateUp := fun e => do
-     propagateForallProp e
+     propagateForallPropUp e
      let .const declName _ := e.getAppFn | return ()
      propagateProjEq e
      if let some prop := builtinPropagators.up[declName]? then
        prop e
     propagateDown := fun e => do
+     propagateForallPropDown e
      let .const declName _ := e.getAppFn | return ()
      if let some prop := builtinPropagators.down[declName]? then
        prop e
   }
 
-def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) : MetaM α := do
+def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fallback : Fallback) : MetaM α := do
   let scState := ShareCommon.State.mk _
   let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
   let (trueExpr, scState)  := ShareCommon.State.shareCommon scState (mkConst ``True)
-  let thms ← grindNormExt.getTheorems
-  let simprocs := #[(← grindNormSimprocExt.getSimprocs)]
-  let simp ← Simp.mkContext
-    (config := { arith := true })
-    (simpTheorems := #[thms])
-    (congrTheorems := (← getSimpCongrTheorems))
-  x (← mkMethods).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
+  let simprocs ← Grind.getSimprocs
+  let simp ← Grind.getSimpContext
+  x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
 
 private def mkGoal (mvarId : MVarId) : GrindM Goal := do
   let trueExpr ← getTrueExpr
@@ -60,6 +60,7 @@ private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
   let mvarId ← mvarId.revertAll
   let mvarId ← mvarId.unfoldReducible
   let mvarId ← mvarId.betaReduce
+  appendTagSuffix mvarId `grind
   let goals ← intros (← mkGoal mvarId) (generation := 0)
   goals.forM (·.checkInvariants (expensive := true))
   return goals.filter fun goal => !goal.inconsistent
@@ -69,25 +70,20 @@ def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goa
 
 /-- A very simple strategy -/
 private def simple (goals : List Goal) : GrindM (List Goal) := do
-  all goals ematchStar
+  applyToAll (assertAll >> ematchStar >> (splitNext >> assertAll >> ematchStar).iterate) goals
 
-def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) : MetaM (List MVarId) := do
+def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List MVarId) := do
   let go : GrindM (List MVarId) := do
     let goals ← initCore mvarId
     let goals ← simple goals
+    let goals ← goals.filterMapM fun goal => do
+      if goal.inconsistent then return none
+      let goal ← GoalM.run' goal fallback
+      if goal.inconsistent then return none
+      if (← goal.mvarId.isAssigned) then return none
+      return some goal
     trace[grind.debug.final] "{← ppGoals goals}"
     return goals.map (·.mvarId)
-  go.run mainDeclName config
-
-/-- Helper function for debugging purposes -/
-def preprocessAndProbe (mvarId : MVarId) (mainDeclName : Name) (p : GoalM Unit) : MetaM Unit :=
-  let go : GrindM Unit := do
-    let goals ← initCore mvarId
-    trace[grind.debug.final] "{← ppGoals goals}"
-    goals.forM fun goal =>
-      discard <| GoalM.run' goal p
-    return ()
-  withoutModifyingMCtx do
-    go.run mainDeclName {}
+  go.run mainDeclName config fallback
 
 end Lean.Meta.Grind

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

@@ -24,30 +24,37 @@ where
       let e' := mkApp2 (mkConst ``Lean.Grind.nestedProof) prop e
       modify fun s => s.insert e e'
       return e'
-    else match e with
-      | .bvar .. => unreachable!
-      -- See comments on `Canon.lean` for why we do not visit these cases.
-      | .letE .. | .forallE .. | .lam ..
-      | .const .. | .lit .. | .mvar .. | .sort .. | .fvar .. => return e
-      | .proj _ _ b => return e.updateProj! (← visit b)
-      | .mdata _ b  => return e.updateMData! (← visit b)
-      -- We only visit applications
-      | .app .. =>
-        -- Check whether it is cached
-        if let some r := (← get).find? e then
-          return r
-        e.withApp fun f args => do
-          let mut modified := false
-          let mut args := args
-          for i in [:args.size] do
-            let arg := args[i]!
-            let arg' ← visit arg
-            unless ptrEq arg arg' do
-              args := args.set! i arg'
-              modified := true
-          let e' := if modified then mkAppN f args else e
-          modify fun s => s.insert e e'
-          return e'
+    -- Remark: we have to process `Expr.proj` since we only
+    -- fold projections later during term internalization
+    unless e.isApp || e.isForall || e.isProj do
+      return e
+    -- Check whether it is cached
+    if let some r := (← get).find? e then
+      return r
+    let e' ← match e with
+      | .app .. => e.withApp fun f args => do
+        let mut modified := false
+        let mut args := args
+        for i in [:args.size] do
+          let arg := args[i]!
+          let arg' ← visit arg
+          unless ptrEq arg arg' do
+            args := args.set! i arg'
+            modified := true
+        if modified then
+          pure <| mkAppN f args
+        else
+          pure e
+      | .proj _ _ b =>
+        pure <| e.updateProj! (← visit b)
+      | .forallE _ d b _ =>
+        -- Recall that we have `ForallProp.lean`.
+        let d' ← visit d
+        let b' ← if b.hasLooseBVars then pure b else visit b
+        pure <| e.updateForallE! d' b'
+      | _ => unreachable!
+    modify fun s => s.insert e e'
+    return e'
 
 /--
 Wrap nested proofs `e` with `Lean.Grind.nestedProof`-applications.

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

@@ -30,7 +30,7 @@ def propagateProjEq (parent : Expr) : GoalM Unit := do
     let parentNew ← shareCommon (mkApp parent.appFn! ctor)
     internalize parentNew (← getGeneration parent)
     pure parentNew
-  trace[grind.debug.proj] "{parentNew}"
+  trace_goal[grind.debug.proj] "{parentNew}"
   let idx := info.numParams + info.i
   unless idx < ctor.getAppNumArgs do return ()
   let v := ctor.getArg! idx

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

@@ -7,6 +7,8 @@ prelude
 import Init.Grind
 import Lean.Meta.Tactic.Grind.Proof
 import Lean.Meta.Tactic.Grind.PropagatorAttr
+import Lean.Meta.Tactic.Grind.Simp
+import Lean.Meta.Tactic.Grind.Internalize
 
 namespace Lean.Meta.Grind
 
@@ -97,6 +99,8 @@ builtin_grind_propagator propagateNotUp ↑Not := fun e => do
   else if (← isEqTrue a) then
     -- a = True → (Not a) = False
     pushEqFalse e <| mkApp2 (mkConst ``Lean.Grind.not_eq_of_eq_true) a (← mkEqTrueProof a)
+  else if (← isEqv e a) then
+    closeGoal <| mkApp2 (mkConst ``Lean.Grind.false_of_not_eq_self) a (← mkEqProof e a)
 
 /--
 Propagates truth values downwards for a negation expression `Not a` based on the truth value of `Not a`.
@@ -130,6 +134,13 @@ builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
     let_expr Eq _ a b := e | return ()
     pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
 
+/-- Propagates `EqMatch` downwards -/
+builtin_grind_propagator propagateEqMatchDown ↓Grind.EqMatch := fun e => do
+  if (← isEqTrue e) then
+    let_expr Grind.EqMatch _ a b origin := e | return ()
+    markCaseSplitAsResolved origin
+    pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
+
 /-- Propagates `HEq` downwards -/
 builtin_grind_propagator propagateHEqDown ↓HEq := fun e => do
   if (← isEqTrue e) then
@@ -142,4 +153,32 @@ builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
   if (← isEqv a b) then
     pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkHEqProof a b)
 
+/-- Propagates `ite` upwards -/
+builtin_grind_propagator propagateIte ↑ite := fun e => do
+  let_expr f@ite α c h a b := e | return ()
+  if (← isEqTrue c) then
+    pushEq e a <| mkApp6 (mkConst ``ite_cond_eq_true f.constLevels!) α c h a b (← mkEqTrueProof c)
+  else if (← isEqFalse c) then
+    pushEq e b <| mkApp6 (mkConst ``ite_cond_eq_false f.constLevels!) α c h a b (← mkEqFalseProof c)
+
+/-- Propagates `dite` upwards -/
+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 p ← simp ah₁
+     let r := p.expr
+     let h₂ ← p.getProof
+     internalize r (← getGeneration e)
+     pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_true' f.constLevels!) α c h a b r h₁ h₂
+  else if (← isEqFalse c) then
+     let h₁ ← mkEqFalseProof c
+     let bh₁ := mkApp b (mkApp2 (mkConst ``of_eq_false) c h₁)
+     let p ← simp bh₁
+     let r := p.expr
+     let h₂ ← p.getProof
+     internalize r (← getGeneration e)
+     pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) α c h a b r h₁ h₂
+
 end Lean.Meta.Grind

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

@@ -9,6 +9,7 @@ import Lean.Meta.Tactic.Assert
 import Lean.Meta.Tactic.Simp.Main
 import Lean.Meta.Tactic.Grind.Util
 import Lean.Meta.Tactic.Grind.Types
+import Lean.Meta.Tactic.Grind.DoNotSimp
 import Lean.Meta.Tactic.Grind.MarkNestedProofs
 
 namespace Lean.Meta.Grind
@@ -33,6 +34,7 @@ def simp (e : Expr) : GrindM Simp.Result := do
   let e' ← eraseIrrelevantMData e'
   let e' ← foldProjs e'
   let e' ← normalizeLevels e'
+  let e' ← eraseDoNotSimp e'
   let e' ← canon e'
   let e' ← shareCommon e'
   trace[grind.simp] "{e}\n===>\n{e'}"

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

@@ -0,0 +1,32 @@
+/-
+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.Simp.Simproc
+import Lean.Meta.Tactic.Grind.Simp
+import Lean.Meta.Tactic.Grind.DoNotSimp
+
+namespace Lean.Meta.Grind
+
+/-- Returns the array of simprocs used by `grind`. -/
+protected def getSimprocs : MetaM (Array Simprocs) := do
+  let s ← grindNormSimprocExt.getSimprocs
+  let s ← addDoNotSimp s
+  return #[s, (← Simp.getSEvalSimprocs)]
+
+/-- Returns the simplification context used by `grind`. -/
+protected def getSimpContext : MetaM Simp.Context := do
+  let thms ← grindNormExt.getTheorems
+  Simp.mkContext
+    (config := { arith := true })
+    (simpTheorems := #[thms])
+    (congrTheorems := (← getSimpCongrTheorems))
+
+@[export lean_grind_normalize]
+def normalizeImp (e : Expr) : MetaM Expr := do
+  let (r, _) ← Meta.simp e (← Grind.getSimpContext) (← Grind.getSimprocs)
+  return r.expr
+
+end Lean.Meta.Grind

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

@@ -0,0 +1,126 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Types
+import Lean.Meta.Tactic.Grind.Intro
+import Lean.Meta.Tactic.Grind.Cases
+import Lean.Meta.Tactic.Grind.CasesMatch
+
+namespace Lean.Meta.Grind
+
+inductive CaseSplitStatus where
+  | resolved
+  | notReady
+  | ready
+  deriving Inhabited, BEq
+
+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
+  | _ =>
+    if (← isResolvedCaseSplit e) then
+      trace[grind.debug.split] "split resolved: {e}"
+      return .resolved
+    if (← isMatcherApp e) then
+      return .ready
+    let .const declName .. := e.getAppFn | unreachable!
+    if (← isInductivePredicate declName <&&> isEqTrue e) then
+      return .ready
+    return .notReady
+
+/-- 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 []
+where
+  go (cs : List Expr) (c? : Option Expr) (cs' : List Expr) : GoalM (Option Expr) := do
+    match cs with
+    | [] =>
+      modify fun s => { s with splitCandidates := cs'.reverse }
+      if c?.isSome then
+        -- 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 }
+      return c?
+    | c::cs =>
+    match (← checkCaseSplitStatus c) with
+    | .notReady => go cs c? (c::cs')
+    | .resolved => go cs c? cs'
+    | .ready =>
+    match c? with
+    | none => go cs (some c) cs'
+    | some c' =>
+      if (← getGeneration c) < (← getGeneration c') then
+        go cs (some c) (c'::cs')
+      else
+        go cs c? (c::cs')
+
+/-- Constructs a major premise for the `cases` tactic used by `grind`. -/
+private def mkCasesMajor (c : Expr) : GoalM Expr := do
+  match_expr c with
+  | 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)
+
+/-- Introduces new hypotheses in each goal. -/
+private def introNewHyp (goals : List Goal) (acc : List Goal) (generation : Nat) : GrindM (List Goal) := do
+  match goals with
+  | [] => return acc.reverse
+  | goal::goals => introNewHyp goals ((← intros generation goal) ++ acc) generation
+
+/--
+Selects a case-split from the list of candidates,
+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?
+      | return none
+    let gen ← getGeneration c
+    trace_goal[grind.split] "{c}, generation: {gen}"
+    let mvarIds ← if (← isMatcherApp c) then
+      casesMatch (← get).mvarId c
+    else
+      let major ← mkCasesMajor c
+      cases (← get).mvarId major
+    let goal ← get
+    let goals := mvarIds.map fun mvarId => { goal with mvarId }
+    let goals ← introNewHyp goals [] (gen+1)
+    return some goals
+  return goals?
+
+end Lean.Meta.Grind

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

@@ -29,7 +29,7 @@ def congrPlaceholderProof := mkConst (Name.mkSimple "[congruence]")
 
 /--
 Returns `true` if `e` is `True`, `False`, or a literal value.
-See `LitValues` for supported literals.
+See `Lean.Meta.LitValues` for supported literals.
 -/
 def isInterpreted (e : Expr) : MetaM Bool := do
   if e.isTrue || e.isFalse then return true
@@ -59,16 +59,16 @@ structure CongrTheoremCacheKey where
   f       : Expr
   numArgs : Nat
 
--- We manually define `BEq` because we wannt to use pointer equality.
+-- We manually define `BEq` because we want to use pointer equality.
 instance : BEq CongrTheoremCacheKey where
   beq a b := isSameExpr a.f b.f && a.numArgs == b.numArgs
 
--- We manually define `Hashable` because we wannt to use pointer equality.
+-- We manually define `Hashable` because we want to use pointer equality.
 instance : Hashable CongrTheoremCacheKey where
   hash a := mixHash (unsafe ptrAddrUnsafe a.f).toUInt64 (hash a.numArgs)
 
 /-- State for the `GrindM` monad. -/
-structure CoreState where
+structure State where
   canon      : Canon.State := {}
   /-- `ShareCommon` (aka `Hashconsing`) state. -/
   scState    : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
@@ -83,12 +83,17 @@ structure CoreState where
   simpStats  : Simp.Stats := {}
   trueExpr   : Expr
   falseExpr  : Expr
+  /--
+  Used to generate trace messages of the for `[grind] working on <tag>`,
+  and implement the macro `trace_goal`.
+  -/
+  lastTag    : Name := .anonymous
 
 private opaque MethodsRefPointed : NonemptyType.{0}
 private def MethodsRef : Type := MethodsRefPointed.type
 instance : Nonempty MethodsRef := MethodsRefPointed.property
 
-abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT CoreState MetaM
+abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT State MetaM
 
 /-- Returns the user-defined configuration options -/
 def getConfig : GrindM Grind.Config :=
@@ -123,12 +128,12 @@ def abstractNestedProofs (e : Expr) : GrindM Expr := do
 
 /--
 Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
-been hash-consing. We perform this step before we internalize expressions.
+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 } =>
+  modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
     let (e, scState) := ShareCommon.State.shareCommon scState e
-    (e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats })
+    (e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag })
 
 /--
 Canonicalizes nested types, type formers, and instances in `e`.
@@ -193,7 +198,7 @@ structure ENode where
   interpreted : Bool := false
   /-- `ctor := true` if the head symbol is a constructor application. -/
   ctor : Bool := false
-  /-- `hasLambdas := true` if equivalence class contains lambda expressions. -/
+  /-- `hasLambdas := true` if the equivalence class contains lambda expressions. -/
   hasLambdas : Bool := false
   /--
   If `heqProofs := true`, then some proofs in the equivalence class are based
@@ -207,7 +212,6 @@ structure ENode where
   generation : Nat := 0
   /-- Modification time -/
   mt : Nat := 0
-  -- TODO: see Lean 3 implementation
   deriving Inhabited, Repr
 
 def ENode.isCongrRoot (n : ENode) :=
@@ -375,10 +379,20 @@ structure Goal where
   thmMap       : EMatchTheorems
   /-- Number of theorem instances generated so far -/
   numInstances : Nat := 0
+  /-- Number of E-matching rounds performed in this goal since the last case-split. -/
+  numEmatch    : Nat := 0
   /-- (pre-)instances found so far. It includes instances that failed to be instantiated. -/
   preInstances : PreInstanceSet := {}
   /-- new facts to be processed. -/
   newFacts     : Std.Queue NewFact := ∅
+  /-- `match` auxiliary functions whose equations have already been created and activated. -/
+  matchEqNames : PHashSet Name := {}
+  /-- Case-split candidates. -/
+  splitCandidates : List Expr := []
+  /-- Number of splits performed to get to this goal. -/
+  numSplits : Nat := 0
+  /-- Case-splits that do not have to be performed anymore. -/
+  resolvedSplits : PHashSet ENodeKey := {}
   deriving Inhabited
 
 def Goal.admit (goal : Goal) : MetaM Unit :=
@@ -392,7 +406,24 @@ 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
 
-abbrev Propagator := Expr → GoalM Unit
+def updateLastTag : GoalM Unit := do
+  if (← isTracingEnabledFor `grind) then
+    let currTag ← (← get).mvarId.getTag
+    if currTag != (← getThe Grind.State).lastTag then
+      trace[grind] "working on goal `{currTag}`"
+      modifyThe Grind.State fun s => { s with lastTag := currTag }
+
+/--
+Macro similar to `trace[...]`, but it includes the trace message `trace[grind] "working on <current goal>"`
+if the tag has changed since the last trace message.
+-/
+macro "trace_goal[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
+  let msg ← if s.raw.getKind == interpolatedStrKind then `(m! $(⟨s⟩)) else `(($(⟨s⟩) : MessageData))
+  `(doElem| do
+    let cls := $(quote id.getId.eraseMacroScopes)
+    if (← Lean.isTracingEnabledFor cls) then
+      updateLastTag
+      Lean.addTrace cls $msg)
 
 /--
 A helper function used to mark a theorem instance found by the E-matching module.
@@ -418,6 +449,14 @@ def addTheoremInstance (proof : Expr) (prop : Expr) (generation : Nat) : GoalM U
 def checkMaxInstancesExceeded : GoalM Bool := do
   return (← get).numInstances >= (← getConfig).instances
 
+/-- Returns `true` if the maximum number of case-splits has been reached. -/
+def checkMaxCaseSplit : GoalM Bool := do
+  return (← get).numSplits >= (← getConfig).splits
+
+/-- Returns `true` if the maximum number of E-matching rounds has been reached. -/
+def checkMaxEmatchExceeded : GoalM Bool := do
+  return (← get).numEmatch >= (← getConfig).ematch
+
 /--
 Returns `some n` if `e` has already been "internalized" into the
 Otherwise, returns `none`s.
@@ -637,7 +676,9 @@ def mkEqFalseProof (a : Expr) : GoalM Expr := do
 
 /-- Marks current goal as inconsistent without assigning `mvarId`. -/
 def markAsInconsistent : GoalM Unit := do
-  modify fun s => { s with inconsistent := true }
+  unless (← get).inconsistent do
+    trace[grind] "closed `{← (← get).mvarId.getTag}`"
+    modify fun s => { s with inconsistent := true }
 
 /--
 Closes the current goal using the given proof of `False` and
@@ -677,9 +718,13 @@ def forEachEqc (f : ENode → GoalM Unit) : GoalM Unit := do
     if isSameExpr n.self n.root then
       f n
 
+abbrev Propagator := Expr → GoalM Unit
+abbrev Fallback := GoalM Unit
+
 structure Methods where
   propagateUp   : Propagator := fun _ => return ()
   propagateDown : Propagator := fun _ => return ()
+  fallback      : Fallback := pure ()
   deriving Inhabited
 
 def Methods.toMethodsRef (m : Methods) : MethodsRef :=
@@ -697,6 +742,10 @@ def propagateUp (e : Expr) : GoalM Unit := do
 def propagateDown (e : Expr) : GoalM Unit := do
   (← getMethods).propagateDown e
 
+def applyFallback : GoalM Unit := do
+  let fallback : GoalM Unit := (← getMethods).fallback
+  fallback
+
 /-- Returns expressions in the given expression equivalence class. -/
 partial def getEqc (e : Expr) : GoalM (List Expr) :=
   go e e []
@@ -718,4 +767,17 @@ partial def getEqcs : GoalM (List (List Expr)) := do
       r := (← getEqc node.self) :: r
   return r
 
+/-- Returns `true` if `e` is a case-split that does not need to be performed anymore. -/
+def isResolvedCaseSplit (e : Expr) : GoalM Bool :=
+  return (← get).resolvedSplits.contains { expr := e }
+
+/--
+Mark `e` as a case-split that does not need to be performed anymore.
+Remark: we currently use this feature to disable `match`-case-splits
+-/
+def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
+  unless (← isResolvedCaseSplit e) do
+    trace_goal[grind.split.resolved] "{e}"
+    modify fun s => { s with resolvedSplits := s.resolvedSplits.insert { expr := e } }
+
 end Lean.Meta.Grind

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

@@ -100,12 +100,14 @@ def _root_.Lean.MVarId.clearAuxDecls (mvarId : MVarId) : MetaM MVarId := mvarId.
 /--
 In the `grind` tactic, during `Expr` internalization, we don't expect to find `Expr.mdata`.
 This function ensures `Expr.mdata` is not found during internalization.
-Recall that we do not internalize `Expr.forallE` and `Expr.lam` components.
+Recall that we do not internalize `Expr.lam` children.
+Recall that we still have to process `Expr.forallE` because of `ForallProp.lean`.
+Moreover, we may not want to reduce `p → q` to `¬p ∨ q` when `(p q : Prop)`.
 -/
 def eraseIrrelevantMData (e : Expr) : CoreM Expr := do
   let pre (e : Expr) := do
     match e with
-    | .letE .. | .lam .. | .forallE .. => return .done e
+    | .letE .. | .lam .. => return .done e
     | .mdata _ e => return .continue e
     | _ => return .continue e
   Core.transform e (pre := pre)
@@ -116,11 +118,14 @@ Converts nested `Expr.proj`s into projection applications if possible.
 def foldProjs (e : Expr) : MetaM Expr := do
   let post (e : Expr) := do
     let .proj structName idx s := e | return .done e
-    let some info := getStructureInfo? (← getEnv) structName | return .done e
+    let some info := getStructureInfo? (← getEnv) structName |
+      trace[grind.issues] "found `Expr.proj` but `{structName}` is not marked as structure{indentExpr e}"
+      return .done e
     if h : idx < info.fieldNames.size then
       let fieldName := info.fieldNames[idx]
       return .done (← mkProjection s fieldName)
     else
+      trace[grind.issues] "found `Expr.proj` with invalid field index `{idx}`{indentExpr e}"
       return .done e
   Meta.transform e (post := post)
 
@@ -135,4 +140,11 @@ def normalizeLevels (e : Expr) : CoreM Expr := do
     | _ => return .continue
   Core.transform e (pre := pre)
 
+/--
+Normalizes the given expression using the `grind` simplification theorems and simprocs.
+This function is used for normalzing E-matching patterns. Note that it does not return a proof.
+-/
+@[extern "lean_grind_normalize"] -- forward definition
+opaque normalize (e : Expr) : MetaM Expr
+
 end Lean.Meta.Grind

src/Lean/PrettyPrinter/Delaborator/Builtins.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sebastian Ullrich, Leonardo de Moura, Gabriel Ebner, Mario Carneiro
 -/
 prelude
-import Lean.Parser
 import Lean.PrettyPrinter.Delaborator.Attributes
 import Lean.PrettyPrinter.Delaborator.Basic
 import Lean.PrettyPrinter.Delaborator.SubExpr

src/Lean/Server/Completion.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Marc Huisinga
 -/
 prelude
 import Lean.Server.Completion.CompletionCollectors
+import Std.Data.HashMap
 
 namespace Lean.Server.Completion
 open Lsp

src/Lean/Util/ShareCommon.lean

@@ -5,8 +5,8 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.ShareCommon
-import Std.Data.HashSet
-import Std.Data.HashMap
+import Std.Data.HashSet.Basic
+import Std.Data.HashMap.Basic
 import Lean.Data.PersistentHashMap
 import Lean.Data.PersistentHashSet
 

src/Lean/Util/Trace.lean

@@ -293,13 +293,16 @@ def registerTraceClass (traceClassName : Name) (inherited := false) (ref : Name
   if inherited then
     inheritedTraceOptions.modify (·.insert optionName)
 
-macro "trace[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
-  let msg ← if s.raw.getKind == interpolatedStrKind then `(m! $(⟨s⟩)) else `(($(⟨s⟩) : MessageData))
+def expandTraceMacro (id : Syntax) (s : Syntax) : MacroM (TSyntax `doElem) := do
+  let msg ← if s.getKind == interpolatedStrKind then `(m! $(⟨s⟩)) else `(($(⟨s⟩) : MessageData))
   `(doElem| do
     let cls := $(quote id.getId.eraseMacroScopes)
     if (← Lean.isTracingEnabledFor cls) then
       Lean.addTrace cls $msg)
 
+macro "trace[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
+  expandTraceMacro id s.raw
+
 def bombEmoji := "💥️"
 def checkEmoji := "✅️"
 def crossEmoji := "❌️"

src/Std/Sat/AIG/Basic.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Henrik Böving
 -/
 prelude
-import Std.Data.HashMap
 import Std.Data.HashSet
 
 namespace Std

src/Std/Tactic/BVDecide/LRAT/Internal/Formula/Implementation.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Josh Clune
 -/
 prelude
-import Init.Data.Array
 import Std.Tactic.BVDecide.LRAT.Internal.Formula.Class
 import Std.Tactic.BVDecide.LRAT.Internal.Assignment
 import Std.Sat.CNF.Basic

src/Std/Tactic/BVDecide/Reflect.lean

@@ -156,7 +156,7 @@ theorem or_congr (lhs rhs lhs' rhs' : Bool) (h1 : lhs' = lhs) (h2 : rhs' = rhs)
 
 theorem cond_congr (discr lhs rhs discr' lhs' rhs' : Bool) (h1 : discr' = discr) (h2 : lhs' = lhs)
     (h3 : rhs' = rhs) :
-    (bif discr' = true then lhs' else rhs') = (bif discr = true then lhs else rhs) := by
+    (bif discr' then lhs' else rhs') = (bif discr then lhs else rhs) := by
   simp[*]
 
 theorem false_of_eq_true_of_eq_false (h₁ : x = true) (h₂ : x = false) : False := by

src/Std/Time/DateTime/Timestamp.lean

@@ -5,7 +5,6 @@ Authors: Sofia Rodrigues
 -/
 prelude
 import Std.Time.Internal
-import Init.Data.Int
 import Init.System.IO
 import Std.Time.Time
 import Std.Time.Date

src/Std/Time/Internal/Bounded.lean

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sofia Rodrigues
 -/
 prelude
-import Init.Data.Int
+import Init.Omega
 
 namespace Std
 namespace Time

tests/lean/inductionParse.lean.expected.out

@@ -1 +1,2 @@
-inductionParse.lean:4:18-5:6: error: unexpected identifier; expected '|'
+inductionParse.lean:4:14-4:18: error: alternative 'zero' has not been provided
+inductionParse.lean:4:14-4:18: error: alternative 'succ' has not been provided

tests/lean/interactive/5659.lean

@@ -0,0 +1,13 @@
+/-!
+  # `rintro` and `intro` error message should point to excess arg
+
+  Below, the errors should point to `h` because there is no lambda it binds.
+  The error should not point to `hn`; it would be OKish to underline the whole line. -/
+
+example : (∃ n : Nat, n < 0) → False := by
+  rintro ⟨n, hn⟩ h
+              --^ collectDiagnostics
+
+example : (∃ n : Nat, n < 0) → False := by
+  intro ⟨n, hn⟩ h
+             --^ collectDiagnostics

tests/lean/interactive/5659.lean.expected.out

@@ -0,0 +1,22 @@
+{"version": 1,
+ "uri": "file:///5659.lean",
+ "diagnostics":
+ [{"source": "Lean 4",
+   "severity": 1,
+   "range":
+   {"start": {"line": 7, "character": 17}, "end": {"line": 7, "character": 18}},
+   "message":
+   "tactic 'introN' failed, insufficient number of binders\ncase intro\nn : Nat\nhn : n < 0\n⊢ False",
+   "fullRange":
+   {"start": {"line": 7, "character": 17},
+    "end": {"line": 7, "character": 18}}},
+  {"source": "Lean 4",
+   "severity": 1,
+   "range":
+   {"start": {"line": 11, "character": 16},
+    "end": {"line": 11, "character": 17}},
+   "message":
+   "tactic 'introN' failed, insufficient number of binders\nn : Nat\nhn : n < 0\n⊢ False",
+   "fullRange":
+   {"start": {"line": 11, "character": 16},
+    "end": {"line": 11, "character": 17}}}]}

tests/lean/interactive/incrementalTactic.lean.expected.out

@@ -12,11 +12,12 @@ t 2
  [{"source": "Lean 4",
    "severity": 1,
    "range":
-   {"start": {"line": 4, "character": 4}, "end": {"line": 4, "character": 13}},
+   {"start": {"line": 4, "character": 12}, "end": {"line": 4, "character": 13}},
    "message":
    "tactic 'introN' failed, insufficient number of binders\na n : Nat\n⊢ True",
    "fullRange":
-   {"start": {"line": 4, "character": 4}, "end": {"line": 4, "character": 13}}},
+   {"start": {"line": 4, "character": 12},
+    "end": {"line": 4, "character": 13}}},
   {"source": "Lean 4",
    "severity": 1,
    "range":

tests/lean/run/grind_canon_insts.lean

@@ -1,11 +1,4 @@
-import Lean
-
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let nodes ← filterENodes fun e => return e.self.isAppOf ``HMul.hMul
-    logInfo (nodes.toList.map (·.self))
+import Lean.Meta.Tactic.Grind
 
 set_option grind.debug true
 
@@ -57,26 +50,27 @@ instance : CommMonoid Nat where
 theorem left_comm [CommMonoid α] (a b c : α) : a * (b * c) = b * (a * c) := by
   rw [← Semigroup.mul_assoc, CommMonoid.mul_comm a b, Semigroup.mul_assoc]
 
+open Lean Meta Elab Tactic Grind in
+def fallback : Fallback := do
+  let nodes ← filterENodes fun e => return e.self.isAppOf ``HMul.hMul
+  logInfo (nodes.toList.map (·.self))
+  (← get).mvarId.admit
+
 /--
 info: [b * c, a * (b * c), d * (b * c)]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d : Nat) : b * (a * c) = d * (b * c) → False := by
   rw [left_comm] -- Introduces a new (non-canonical) instance for `Mul Nat`
-  grind_test -- State should have only 3 `*`-applications
-  sorry
+  grind on_failure fallback -- State should have only 3 `*`-applications
 
 
 set_option pp.notation false in
 set_option pp.explicit true in
 /--
 info: [@HMul.hMul Nat Nat Nat (@instHMul Nat instMulNat) b a, @HMul.hMul Nat Nat Nat (@instHMul Nat instMulNat) b d]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d : Nat) : b * a = d * b → False := by
   rw [CommMonoid.mul_comm d b] -- Introduces a new (non-canonical) instance for `Mul Nat`
   -- See target here
@@ -85,5 +79,4 @@ example (a b c d : Nat) : b * a = d * b → False := by
     =
     @HMul.hMul Nat Nat Nat (@instHMul Nat (@Semigroup.toMul Nat (@Monoid.toSemigroup Nat (@CommMonoid.toMonoid Nat instCommMonoidNat)))) b d
     → False
-  grind_test -- State should have only 2 `*`-applications, and they use the same instance
-  sorry
+  grind on_failure fallback -- State should have only 2 `*`-applications, and they use the same instance

tests/lean/run/grind_canon_types.lean

@@ -1,27 +1,22 @@
-import Lean
+import Lean.Meta.Tactic.Grind
 
 def g (s : Type) := s
 def f (a : α) := a
 
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let nodes ← filterENodes fun e => return e.self.isAppOf ``f
-    logInfo (nodes.toList.map (·.self))
-
+open Lean Meta Grind in
+def fallback : Fallback := do
+  let nodes ← filterENodes fun e => return e.self.isAppOf ``f
+  logInfo (nodes.toList.map (·.self))
+  (← get).mvarId.admit
 
 set_option pp.explicit true
 /--
 info: [@f Nat a, @f Nat b]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d : Nat) : @f Nat a = b → @f (g Nat) a = c → @f (g Nat) b = d → a = b → False := by
   -- State should have only two `f`-applications: `@f Nat a`, `@f Nat b`
   -- Note that `@f (g Nat) b` has been canonicalized to `@f Nat b`.
   -- Thus, if `a` and `b` equivalence classes are merged, `grind` can still detect that
   -- `@f Nat a` and `@f Nat b` are equal too.
-  grind_test
-  sorry
+  grind on_failure fallback

tests/lean/run/grind_cases_tac.lean

@@ -0,0 +1,43 @@
+import Lean
+
+open Lean Meta Grind Elab Tactic in
+elab "cases' " e:term : tactic => withMainContext do
+  let e ← elabTerm e none
+  setGoals (← Grind.cases (← getMainGoal) e)
+
+inductive Vec (α : Type u) : Nat → Type u
+  | nil : Vec α 0
+  | cons : α → Vec α n → Vec α (n+1)
+
+def f (v : Vec α n) : Bool :=
+  match v with
+  | .nil => true
+  | .cons .. => false
+
+/--
+info: n : Nat
+v : Vec Nat n
+h : f v ≠ false
+⊢ n + 1 = 0 → HEq (Vec.cons 10 v) Vec.nil → False
+---
+info: n : Nat
+v : Vec Nat n
+h : f v ≠ false
+⊢ ∀ {n_1 : Nat} (a : Nat) (a_1 : Vec Nat n_1), n + 1 = n_1 + 1 → HEq (Vec.cons 10 v) (Vec.cons a a_1) → False
+-/
+#guard_msgs (info) in
+example (v : Vec Nat n) (h : f v ≠ false) : False := by
+  cases' (Vec.cons 10 v)
+  next => trace_state; sorry
+  next => trace_state; sorry
+
+/--
+info: ⊢ False → False
+---
+info: ⊢ True → False
+-/
+#guard_msgs (info) in
+example : False := by
+  cases' (Or.inr (a := False) True.intro)
+  next => trace_state; sorry
+  next => trace_state; sorry

tests/lean/run/grind_cat.lean

@@ -0,0 +1,182 @@
+universe v v₁ v₂ v₃ u u₁ u₂ u₃
+
+namespace CategoryTheory
+
+macro "cat_tac" : tactic => `(tactic| (intros; (try ext); grind))
+
+class Category (obj : Type u) : Type max u (v + 1) where
+  Hom : obj → obj → Type v
+  /-- The identity morphism on an object. -/
+  id : ∀ X : obj, Hom X X
+  /-- Composition of morphisms in a category, written `f ≫ g`. -/
+  comp : ∀ {X Y Z : obj}, (Hom X Y) → (Hom Y Z) → (Hom X Z)
+  /-- Identity morphisms are left identities for composition. -/
+  id_comp : ∀ {X Y : obj} (f : Hom X Y), comp (id X) f = f := by cat_tac
+  /-- Identity morphisms are right identities for composition. -/
+  comp_id : ∀ {X Y : obj} (f : Hom X Y), comp f (id Y) = f := by cat_tac
+  /-- Composition in a category is associative. -/
+  assoc : ∀ {W X Y Z : obj} (f : Hom W X) (g : Hom X Y) (h : Hom Y Z), comp (comp f g) h = comp f (comp g h) := by cat_tac
+
+infixr:10 " ⟶ " => Category.Hom
+scoped notation "𝟙" => Category.id  -- type as \b1
+scoped infixr:80 " ≫ " => Category.comp
+
+attribute [simp] Category.id_comp Category.comp_id Category.assoc
+
+attribute [grind =] Category.id_comp Category.comp_id
+attribute [grind _=_] Category.assoc
+
+structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D] : Type max v₁ v₂ u₁ u₂ where
+  /-- The action of a functor on objects. -/
+  obj : C → D
+  /-- The action of a functor on morphisms. -/
+  map : ∀ {X Y : C}, (X ⟶ Y) → ((obj X) ⟶ (obj Y))
+  /-- A functor preserves identity morphisms. -/
+  map_id : ∀ X : C, map (𝟙 X) = 𝟙 (obj X) := by cat_tac
+  /-- A functor preserves composition. -/
+  map_comp : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = (map f) ≫ (map g) := by cat_tac
+
+attribute [simp] Functor.map_id Functor.map_comp
+
+attribute [grind =] Functor.map_id
+attribute [grind _=_] Functor.map_comp
+
+variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃} [Category.{v₃} E]
+variable {F G H : Functor C D}
+
+namespace Functor
+
+def comp (F : Functor C D) (G : Functor D E) : Functor C E where
+  obj X := G.obj (F.obj X)
+  map f := G.map (F.map f)
+  -- Note `map_id` and `map_comp` are handled by `cat_tac`.
+
+variable {X Y : C} {G : Functor D E}
+
+@[simp, grind =] theorem comp_obj : (F.comp G).obj X = G.obj (F.obj X) := rfl
+@[simp, grind =] theorem comp_map (f : X ⟶ Y) : (F.comp G).map f = G.map (F.map f) := rfl
+
+end Functor
+
+@[ext]
+structure NatTrans [Category.{v₁, u₁} C] [Category.{v₂, u₂} D] (F G : Functor C D) : Type max u₁ v₂ where
+  /-- The component of a natural transformation. -/
+  app : ∀ X : C, F.obj X ⟶ G.obj X
+  /-- The naturality square for a given morphism. -/
+  naturality : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), F.map f ≫ app Y = app X ≫ G.map f := by cat_tac
+
+attribute [simp, grind =] NatTrans.naturality
+
+namespace NatTrans
+
+variable {X : C}
+
+protected def id (F : Functor C D) : NatTrans F F where app X := 𝟙 (F.obj X)
+
+@[simp, grind =] theorem id_app : (NatTrans.id F).app X = 𝟙 (F.obj X) := rfl
+
+protected def vcomp (α : NatTrans F G) (β : NatTrans G H) : NatTrans F H where
+  app X := α.app X ≫ β.app X
+  -- `naturality` is now handled by `grind`; in Mathlib this relies on `@[reassoc]` attributes.
+  -- Manual proof:
+  -- rw [← Category.assoc]
+  -- rw [α.naturality f]
+  -- rw [Category.assoc]
+  -- rw [β.naturality f]
+  -- rw [← Category.assoc]
+
+@[simp, grind =] theorem vcomp_app (α : NatTrans F G) (β : NatTrans G H) (X : C) :
+    (α.vcomp β).app X = α.app X ≫ β.app X := rfl
+
+end NatTrans
+
+instance Functor.category : Category.{max u₁ v₂} (Functor C D) where
+  Hom F G := NatTrans F G
+  id F := NatTrans.id F
+  comp α β := NatTrans.vcomp α β
+  -- Here we're okay: all the proofs are handled by `cat_tac`.
+
+@[simp, grind =]
+theorem id_app (F : Functor C D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl
+
+@[simp, grind _=_]
+theorem comp_app {F G H : Functor C D} (α : F ⟶ G) (β : G ⟶ H) (X : C) :
+    (α ≫ β).app X = α.app X ≫ β.app X := rfl
+
+theorem app_naturality {F G : Functor C (Functor D E)} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) :
+    (F.obj X).map f ≫ (T.app X).app Z = (T.app X).app Y ≫ (G.obj X).map f := by
+  cat_tac
+
+theorem naturality_app {F G : Functor C (Functor D E)} (T : F ⟶ G) (Z : D) {X Y : C} (f : X ⟶ Y) :
+    (F.map f).app Z ≫ (T.app Y).app Z = (T.app X).app Z ≫ (G.map f).app Z := by
+  cat_tac -- this is done manually in Mathlib!
+  -- rw [← comp_app]
+  -- rw [T.naturality f]
+  -- rw [comp_app]
+
+open Category Functor NatTrans
+
+def hcomp {H I : Functor D E} (α : F ⟶ G) (β : H ⟶ I) : F.comp H ⟶ G.comp I where
+  app := fun X : C => β.app (F.obj X) ≫ I.map (α.app X)
+  -- `grind` can now handle `naturality`, while Mathlib does this manually:
+  -- rw [Functor.comp_map, Functor.comp_map, ← assoc, naturality, assoc, ← I.map_comp, naturality,
+  --   map_comp, assoc]
+
+structure Iso {C : Type u} [Category.{v} C] (X Y : C) where
+  hom : X ⟶ Y
+  inv : Y ⟶ X
+  hom_inv_id : hom ≫ inv = 𝟙 X := by cat_tac
+  inv_hom_id : inv ≫ hom = 𝟙 Y := by cat_tac
+
+attribute [grind =] Iso.hom_inv_id Iso.inv_hom_id
+
+/-- Notation for an isomorphism in a category. -/
+infixr:10 " ≅ " => Iso -- type as \cong or \iso
+
+variable {C : Type u} [Category.{v} C] {X Y Z : C}
+
+namespace Iso
+
+@[ext]
+theorem ext ⦃α β : X ≅ Y⦄ (w : α.hom = β.hom) : α = β :=
+  suffices α.inv = β.inv by
+    cases α
+    cases β
+    cases w
+    cases this
+    rfl
+  calc
+    α.inv = α.inv ≫ β.hom ≫ β.inv   := by grind
+    _     = β.inv                    := by grind
+
+
+/-- `LeftInverse g f` means that g is a left inverse to f. That is, `g ∘ f = id`. -/
+def Function.LeftInverse (g : β → α) (f : α → β) : Prop :=
+  ∀ x, g (f x) = x
+
+/-- `RightInverse g f` means that g is a right inverse to f. That is, `f ∘ g = id`. -/
+def Function.RightInverse (g : β → α) (f : α → β) : Prop :=
+  LeftInverse f g
+
+open Function
+
+/-- `α ≃ β` is the type of functions from `α → β` with a two-sided inverse. -/
+structure Equiv (α : Sort _) (β : Sort _) where
+  protected toFun : α → β
+  protected invFun : β → α
+  protected left_inv : LeftInverse invFun toFun
+  protected right_inv : RightInverse invFun toFun
+
+@[inherit_doc]
+infixl:25 " ≃ " => Equiv
+
+attribute [local grind] Function.LeftInverse in
+/-- The bijection `(Z ⟶ X) ≃ (Z ⟶ Y)` induced by `α : X ≅ Y`. -/
+def homToEquiv (α : X ≅ Y) {Z : C} : (Z ⟶ X) ≃ (Z ⟶ Y) where
+  toFun f := f ≫ α.hom
+  invFun g := g ≫ α.inv
+  left_inv := by cat_tac
+  right_inv := sorry
+
+end Iso
+end CategoryTheory

tests/lean/run/grind_congr.lean

@@ -4,53 +4,40 @@ def f (a : Nat) := a + a + a
 def g (a : Nat) := a + a
 
 -- Prints the equivalence class containing a `f` application
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let #[n, _] ← filterENodes fun e => return e.self.isAppOf ``f | unreachable!
-    let eqc ← getEqc n.self
-    logInfo eqc
+open Lean Meta Grind in
+def fallback : Fallback := do
+  let #[n, _] ← filterENodes fun e => return e.self.isAppOf ``f | unreachable!
+  let eqc ← getEqc n.self
+  logInfo eqc
+  (← get).mvarId.admit
 
 set_option grind.debug true
 set_option grind.debug.proofs true
 
 /--
 info: [d, f b, c, f a]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d : Nat) : a = b → f a = c → f b = d → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: [d, f b, c, f a]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d : Nat) : f a = c → f b = d → a = b → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: [d, f (g b), c, f (g a)]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d e : Nat) : f (g a) = c → f (g b) = d → a = e → b = e → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: [d, f (g b), c, f v]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (a b c d e v : Nat) : f v = c → f (g b) = d → a = e → b = e → v = g a → False := by
-  grind_test
-  sorry
+  grind on_failure fallback

tests/lean/run/grind_ematch1.lean

@@ -1,5 +1,6 @@
 set_option trace.grind.ematch.pattern true
-grind_pattern Array.size_set => Array.set a i v h
+
+attribute [grind =] Array.size_set
 
 set_option grind.debug true
 
@@ -21,12 +22,10 @@ example (as bs : Array α) (v : α)
 
 set_option trace.grind.ematch.instance true
 
-grind_pattern Array.get_set_eq  => a.set i v h
-grind_pattern Array.get_set_ne => (a.set i v hi)[j]
+attribute [grind =] Array.get_set_ne
 
 /--
-info: [grind.ematch.instance] Array.get_set_eq: (as.set i v ⋯)[i] = v
-[grind.ematch.instance] Array.size_set: (as.set i v ⋯).size = as.size
+info: [grind.ematch.instance] Array.size_set: (as.set i v ⋯).size = as.size
 [grind.ematch.instance] Array.get_set_ne: ∀ (hj : j < as.size), i ≠ j → (as.set i v ⋯)[j] = as[j]
 -/
 #guard_msgs (info) in
@@ -69,3 +68,151 @@ info: [grind.ematch.instance] Rtrans: R a d → R d e → R a e
 #guard_msgs (info) in
 example : R a b → R b c → R c d → R d e → R a d := by
   grind
+
+
+namespace using_grind_fwd
+
+opaque S : Nat → Nat → Prop
+
+/--
+error: `@[grind →] theorem using_grind_fwd.StransBad` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
+-/
+#guard_msgs (error) in
+@[grind→] theorem StransBad (a b c d : Nat) : S a b ∨ R a b → S b c → S a c ∧ S b d := sorry
+
+
+set_option trace.grind.ematch.pattern.search true in
+/--
+info: [grind.ematch.pattern.search] candidate: S a b
+[grind.ematch.pattern.search] found pattern: S #4 #3
+[grind.ematch.pattern.search] candidate: R a b
+[grind.ematch.pattern.search] skip, no new variables covered
+[grind.ematch.pattern.search] candidate: S b c
+[grind.ematch.pattern.search] found pattern: S #3 #2
+[grind.ematch.pattern.search] found full coverage
+[grind.ematch.pattern] Strans: [S #4 #3, S #3 #2]
+-/
+#guard_msgs (info) in
+@[grind→] theorem Strans (a b c : Nat) : S a b ∨ R a b → S b c → S a c := sorry
+
+/--
+info: [grind.ematch.instance] Strans: S a b ∨ R a b → S b c → S a c
+-/
+#guard_msgs (info) in
+example : S a b → S b c → S a c := by
+  grind
+
+end using_grind_fwd
+
+namespace using_grind_bwd
+
+opaque P : Nat → Prop
+opaque Q : Nat → Prop
+opaque f : Nat → Nat → Nat
+
+/--
+info: [grind.ematch.pattern] pqf: [P (f #2 #1)]
+-/
+#guard_msgs (info) in
+@[grind←] theorem pqf : Q x → P (f x y) := sorry
+
+/--
+info: [grind.ematch.instance] pqf: Q a → P (f a b)
+-/
+#guard_msgs (info) in
+example : Q 0 → Q 1 → Q 2 → Q 3 → ¬ P (f a b) → a = 1 → False := by
+  grind
+
+end using_grind_bwd
+
+namespace using_grind_fwd2
+
+opaque P : Nat → Prop
+opaque Q : Nat → Prop
+opaque f : Nat → Nat → Nat
+
+/--
+error: `@[grind →] theorem using_grind_fwd2.pqfBad` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
+-/
+#guard_msgs (error) in
+@[grind→] theorem pqfBad : Q x → P (f x y) := sorry
+
+/--
+info: [grind.ematch.pattern] pqf: [Q #1]
+-/
+#guard_msgs (info) in
+@[grind→] theorem pqf : Q x → P (f x x) := sorry
+
+/--
+info: [grind.ematch.instance] pqf: Q 3 → P (f 3 3)
+[grind.ematch.instance] pqf: Q 2 → P (f 2 2)
+[grind.ematch.instance] pqf: Q 1 → P (f 1 1)
+[grind.ematch.instance] pqf: Q 0 → P (f 0 0)
+-/
+#guard_msgs (info) in
+example : Q 0 → Q 1 → Q 2 → Q 3 → ¬ P (f a a) → a = 1 → False := by
+  grind
+
+end using_grind_fwd2
+
+namespace using_grind_mixed
+
+opaque P : Nat → Nat → Prop
+opaque Q : Nat → Nat → Prop
+
+/--
+error: `@[grind →] theorem using_grind_mixed.pqBad1` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
+-/
+#guard_msgs (error) in
+@[grind→] theorem pqBad1 : P x y → Q x z := sorry
+
+/--
+error: `@[grind ←] theorem using_grind_mixed.pqBad2` failed to find patterns in the theorem's conclusion, consider using different options or the `grind_pattern` command
+-/
+#guard_msgs (error) in
+@[grind←] theorem pqBad2 : P x y → Q x z := sorry
+
+
+/--
+info: [grind.ematch.pattern] pqBad: [Q #3 #1, P #3 #2]
+-/
+#guard_msgs (info) in
+@[grind] theorem pqBad : P x y → Q x z := sorry
+
+example : P a b → Q a c := by
+  grind
+
+end using_grind_mixed
+
+
+namespace using_grind_rhs
+
+opaque f : Nat → Nat
+opaque g : Nat → Nat → Nat
+
+/--
+info: [grind.ematch.pattern] fq: [g #0 (f #0)]
+-/
+#guard_msgs (info) in
+@[grind =_]
+theorem fq : f x = g x (f x) := sorry
+
+end using_grind_rhs
+
+namespace using_grind_lhs_rhs
+
+opaque f : Nat → Nat
+opaque g : Nat → Nat → Nat
+
+/--
+info: [grind.ematch.pattern] fq: [f #0]
+[grind.ematch.pattern] fq: [g #0 (g #0 #0)]
+-/
+#guard_msgs (info) in
+@[grind _=_]
+theorem fq : f x = g x (g x x) := sorry
+
+end using_grind_lhs_rhs
+
+-- the following should still work
+#check _=_

tests/lean/run/grind_ematch2.lean

@@ -1,6 +1,4 @@
-grind_pattern Array.size_set => Array.set a i v h
-grind_pattern Array.get_set_eq  => a.set i v h
-grind_pattern Array.get_set_ne => (a.set i v hi)[j]
+attribute [grind =] Array.size_set Array.get_set_eq Array.get_set_ne
 
 set_option grind.debug true
 set_option trace.grind.ematch.pattern true
@@ -41,3 +39,54 @@ example (as bs cs : Array α) (v₁ v₂ : α)
         (h₆ : j < as.size)
         : cs[j] = as[j] := by
   grind
+
+example (as bs cs ds : Array α) (v₁ v₂ v₃ : α)
+        (i₁ i₂ i₃ j : Nat)
+        (h₁ : i₁ < as.size)
+        (h₂ : as.set i₁ v₁ = bs)
+        (h₃ : i₂ < bs.size)
+        (h₃ : bs.set i₂ v₂ = cs)
+        (h₄ : i₃ < cs.size)
+        (h₅ : ds = cs.set i₃ v₃)
+        (h₆ : j ≠ i₁ ∧ j ≠ i₂ ∧ i₃ ≠ j)
+        (h₇ : j < ds.size)
+        (h₈ : j < as.size)
+        : ds[j] = as[j] := by
+  grind
+
+opaque f (a b : α) : α := a
+@[grind =] theorem fx : f x (f x x) = x := sorry
+
+/--
+info: [grind.ematch.instance] fx: f a (f a a) = a
+-/
+#guard_msgs (info) in
+example : a = b₁ → c = f b₁ b₂ → f a c ≠ a → a = b₂ → False := by
+  grind
+
+
+namespace pattern_normalization
+opaque g : Nat → Nat
+@[grind_norm] theorem gthm : g x = x := sorry
+opaque f : Nat → Nat → Nat
+theorem fthm : f (g x) x = x := sorry
+-- The following pattern should be normalized by `grind`. Otherwise, we will not find any instance during E-matching.
+/--
+info: [grind.ematch.pattern] fthm: [f #0 #0]
+-/
+#guard_msgs (info) in
+grind_pattern fthm => f (g x) x
+
+/--
+info: [grind.assert] f x y = b
+[grind.assert] y = x
+[grind.assert] ¬b = x
+[grind.ematch.instance] fthm: f (g y) y = y
+[grind.assert] f y y = y
+-/
+#guard_msgs (info) in
+set_option trace.grind.assert true in
+example : f (g x) y = b → y = x → b = x := by
+  grind
+
+end pattern_normalization

tests/lean/run/grind_eq.lean

@@ -0,0 +1,78 @@
+opaque g : Nat → Nat
+
+set_option trace.Meta.debug true
+
+@[grind] def f (a : Nat) :=
+  match a with
+  | 0 => 10
+  | x+1 => g (f x)
+
+set_option grind.debug true
+set_option grind.debug.proofs true
+
+set_option trace.grind.ematch.instance true
+set_option trace.grind.assert true
+
+/--
+info: [grind.assert] f (y + 1) = a
+[grind.assert] ¬a = g (f y)
+[grind.ematch.instance] f.eq_2: f y.succ = g (f y)
+[grind.assert] f (y + 1) = g (f y)
+-/
+#guard_msgs (info) in
+example : f (y + 1) = a → a = g (f y):= by
+  grind
+
+@[grind] def app (xs ys : List α) :=
+  match xs with
+  | [] => ys
+  | x::xs => x :: app xs ys
+
+/--
+info: [grind.assert] app [1, 2] ys = xs
+[grind.assert] ¬xs = 1 :: 2 :: ys
+[grind.ematch.instance] app.eq_2: app [1, 2] ys = 1 :: app [2] ys
+[grind.assert] app [1, 2] ys = 1 :: app [2] ys
+[grind.ematch.instance] app.eq_2: app [2] ys = 2 :: app [] ys
+[grind.assert] app [2] ys = 2 :: app [] ys
+[grind.ematch.instance] app.eq_1: app [] ys = ys
+[grind.assert] app [] ys = ys
+-/
+#guard_msgs (info) in
+example : app [1, 2] ys = xs → xs = 1::2::ys := by
+  grind
+
+opaque p : Nat → Nat → Prop
+opaque q : Nat → Prop
+
+@[grind =] theorem pq : p x x ↔ q x := by sorry
+
+/--
+info: [grind.assert] p a a
+[grind.assert] ¬q a
+[grind.ematch.instance] pq: p a a ↔ q a
+[grind.assert] p a a = q a
+-/
+#guard_msgs (info) in
+example : p a a → q a := by
+  grind
+
+opaque appV (xs : Vector α n) (ys : Vector α m) : Vector α (n + m) :=
+  Vector.append xs ys
+
+@[grind =]
+theorem appV_assoc (a : Vector α n) (b : Vector α m) (c : Vector α n') :
+        HEq (appV a (appV b c)) (appV (appV a b) c) := sorry
+
+/--
+info: [grind.assert] x1 = appV a b
+[grind.assert] x2 = appV x1 c
+[grind.assert] x3 = appV b c
+[grind.assert] x4 = appV a x3
+[grind.assert] ¬HEq x2 x4
+[grind.ematch.instance] appV_assoc: HEq (appV a (appV b c)) (appV (appV a b) c)
+[grind.assert] HEq (appV a (appV b c)) (appV (appV a b) c)
+-/
+#guard_msgs (info) in
+example : x1 = appV a b → x2 = appV x1 c → x3 = appV b c → x4 = appV a x3 → HEq x2 x4 := by
+  grind

tests/lean/run/grind_erase_attr.lean

@@ -0,0 +1,83 @@
+opaque f : Nat → Nat
+
+@[grind] theorem fthm : f (f x) = f x := sorry
+
+theorem fthm' : f (f x) = x := sorry
+
+/--
+error: `fthm'` is not marked with the `[grind]` attribute
+-/
+#guard_msgs in
+attribute [-grind] fthm'
+
+set_option trace.grind.assert true
+
+/--
+info: [grind.assert] ¬f (f (f a)) = f a
+[grind.assert] f (f (f a)) = f (f a)
+[grind.assert] f (f a) = f a
+-/
+#guard_msgs (info) in
+example : f (f (f a)) = f a := by
+  grind
+
+attribute [-grind] fthm
+
+/--
+error: `grind` failed
+case grind
+a : Nat
+x✝ : ¬f (f (f a)) = f a
+⊢ False
+---
+info: [grind.assert] ¬f (f (f a)) = f a
+-/
+#guard_msgs (info, error) in
+example : f (f (f a)) = f a := by
+  grind
+
+/--
+error: `fthm` is not marked with the `[grind]` attribute
+-/
+#guard_msgs in
+attribute [-grind] fthm
+
+attribute [grind] fthm
+
+example : f (f (f a)) = f a := by
+  grind
+
+def g (x : Nat) :=
+  match x with
+  | 0 => 1
+  | x+1 => 2 * g x
+
+attribute [grind] g
+
+example : g a = b → a = 0 → b = 1 := by
+  grind
+
+attribute [-grind] g
+
+/--
+error: `grind` failed
+case grind
+a b : Nat
+a✝¹ : g a = b
+a✝ : a = 0
+x✝ : ¬b = 1
+⊢ False
+---
+info: [grind.assert] g a = b
+[grind.assert] a = 0
+[grind.assert] ¬b = 1
+-/
+#guard_msgs (info, error) in
+example : g a = b → a = 0 → b = 1 := by
+  grind
+
+/--
+error: `g` is not marked with the `[grind]` attribute
+-/
+#guard_msgs in
+attribute [-grind] g

tests/lean/run/grind_implies.lean

@@ -0,0 +1,87 @@
+set_option trace.grind.eqc true
+set_option trace.grind.internalize true
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.eqc] (p → q) = True
+[grind.eqc] p = True
+[grind.eqc] (p → q) = q
+[grind.eqc] q = False
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) → p → q := by
+  grind
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.eqc] (p → q) = True
+[grind.eqc] q = False
+[grind.eqc] p = True
+[grind.eqc] (p → q) = q
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) → ¬q → ¬p := by
+  grind
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.internalize] r
+[grind.eqc] (p → q) = r
+[grind.eqc] p = False
+[grind.eqc] (p → q) = True
+[grind.eqc] r = False
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) = r → ¬p → r := by
+  grind
+
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.internalize] r
+[grind.eqc] (p → q) = r
+[grind.eqc] q = True
+[grind.eqc] (p → q) = True
+[grind.eqc] r = False
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) = r → q → r := by
+  grind
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.internalize] r
+[grind.eqc] (p → q) = r
+[grind.eqc] q = False
+[grind.eqc] r = True
+[grind.eqc] p = True
+[grind.eqc] (p → q) = q
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) = r → ¬q → r → ¬p := by
+  grind
+
+/--
+info: [grind.internalize] p → q
+[grind.internalize] p
+[grind.internalize] q
+[grind.internalize] r
+[grind.eqc] (p → q) = r
+[grind.eqc] q = False
+[grind.eqc] r = False
+[grind.eqc] p = True
+[grind.eqc] p = False
+-/
+#guard_msgs (info) in
+example (p q : Prop) : (p → q) = r → ¬q → ¬r → p := by
+  grind

tests/lean/run/grind_many_eqs.lean

@@ -1,4 +1,4 @@
-import Lean
+import Lean.Meta.Tactic.Grind
 
 def f (a : Nat) := a + a + a
 def g (a : Nat) := a + a
@@ -8,27 +8,23 @@ def h (n : Nat) : Prop :=
   | n+1 => f (n+1) = f n ∧ g (2*n + 1) = g (2*n) ∧ h n
 
 -- Prints the equivalence class containing a `f` application
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" n:num : tactic => withMainContext do
-  let n := n.getNat
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let f0 ← Grind.shareCommon (mkApp (mkConst ``f) (mkNatLit 0))
-    -- The `f 0` equivalence class contains `n+1` elements
-    assert! (← getEqc f0).length == n + 1
-    forEachENode fun node => do
-      if node.self.isAppOf ``g then
-        -- Any equivalence class containing a `g`-application contains 2 elements
-        assert! (← getEqc (← getRoot node.self)).length == 2
+open Lean Meta Grind in
+def fallback (n : Nat) : Fallback := do
+  let f0 ← Grind.shareCommon (mkApp (mkConst ``f) (mkNatLit 0))
+  -- The `f 0` equivalence class contains `n+1` elements
+  assert! (← getEqc f0).length == n + 1
+  forEachENode fun node => do
+    if node.self.isAppOf ``g then
+      -- Any equivalence class containing a `g`-application contains 2 elements
+      assert! (← getEqc (← getRoot node.self)).length == 2
+  (← get).mvarId.admit
 
 set_option grind.debug true in
 example : h 5 → False := by
   simp [h]
-  grind_test 5
-  sorry
+  grind on_failure fallback 5
 
 set_option maxRecDepth 2048
 example : h 100 → False := by
   simp [h]
-  grind_test 100
-  sorry
+  grind on_failure fallback 100

tests/lean/run/grind_match1.lean

@@ -0,0 +1,67 @@
+def g (xs : List α) (ys : List α) :=
+  match xs, ys with
+  | [], _         => ys
+  | _::_::_, [ ]  => []
+  | x::xs,   ys   => x :: g xs ys
+
+attribute [simp] g
+
+set_option trace.grind.assert true
+set_option trace.grind.split.candidate true
+set_option trace.grind.split.resolved true
+
+/--
+info: [grind.assert] (match as, bs with
+      | [], x => bs
+      | head :: head_1 :: tail, [] => []
+      | x :: xs, ys => x :: g xs ys) =
+      d
+[grind.split.candidate] match as, bs with
+    | [], x => bs
+    | head :: head_1 :: tail, [] => []
+    | x :: xs, ys => x :: g xs ys
+[grind.assert] bs = []
+[grind.assert] a₁ :: f 0 = as
+[grind.assert] f 0 = a₂ :: f 1
+[grind.assert] ¬d = []
+[grind.assert] Lean.Grind.EqMatch
+      (match a₁ :: a₂ :: f 1, [] with
+      | [], x => bs
+      | head :: head_1 :: tail, [] => []
+      | x :: xs, ys => x :: g xs ys)
+      []
+[grind.split.resolved] match as, bs with
+    | [], x => bs
+    | head :: head_1 :: tail, [] => []
+    | x :: xs, ys => x :: g xs ys
+-/
+#guard_msgs (info) in
+example (f : Nat → List Nat) : g as bs = d → bs = [] → a₁ :: f 0 = as → f 0 = a₂ :: f 1 → d = [] := by
+  unfold g
+  grind
+
+
+example : g as bs = d → as = [] → d = bs := by
+  unfold g
+  grind
+
+def f (x : List α) : Bool :=
+  match x with
+  | [] => true
+  | _::_ => false
+
+example : f a = b → a = [] → b = true := by
+  unfold f
+  grind
+
+def f' (x : List Nat) : Bool :=
+  match x with
+  | [] => true
+  | _::_ => false
+
+attribute [simp] f'
+#check f'.match_1.eq_1
+
+example : f' a = b → a = [] → b = true := by
+  unfold f'
+  grind

tests/lean/run/grind_match2.lean

@@ -0,0 +1,33 @@
+def g (a : α) (as : List α) : List α :=
+  match as with
+  | [] => [a]
+  | b::bs => a::a::b::bs
+
+set_option trace.grind true in
+set_option trace.grind.assert true in
+example : ¬ (g a as).isEmpty := by
+  unfold List.isEmpty
+  unfold g
+  grind
+
+def h (as : List Nat) :=
+  match as with
+  | []      => 1
+  | [_]     => 2
+  | _::_::_ => 3
+
+/--
+info: [grind] closed `grind.1`
+[grind] closed `grind.2`
+[grind] closed `grind.3`
+-/
+#guard_msgs (info) in
+set_option trace.grind true in
+example : h as ≠ 0 := by
+  unfold h
+  grind
+
+example : h as ≠ 0 := by
+  unfold h
+  fail_if_success grind (splitMatch := false)
+  sorry

tests/lean/run/grind_nested_proofs.lean

@@ -1,16 +1,15 @@
-import Lean
+import Lean.Meta.Tactic.Grind
 
 def f (α : Type) [Add α] (a : α) := a + a + a
 
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let nodes ← filterENodes fun e => return e.self.isAppOf ``Lean.Grind.nestedProof
-    logInfo (nodes.toList.map (·.self))
-    let nodes ← filterENodes fun e => return e.self.isAppOf ``GetElem.getElem
-    let [_, n, _] := nodes.toList | unreachable!
-    logInfo (← getEqc n.self)
+open Lean Meta Grind in
+def fallback : Fallback := do
+  let nodes ← filterENodes fun e => return e.self.isAppOf ``Lean.Grind.nestedProof
+  logInfo (nodes.toList.map (·.self))
+  let nodes ← filterENodes fun e => return e.self.isAppOf ``GetElem.getElem
+  let [_, n, _] := nodes.toList | unreachable!
+  logInfo (← getEqc n.self)
+  (← get).mvarId.admit
 
 set_option grind.debug true
 set_option grind.debug.proofs true
@@ -32,13 +31,8 @@ warning: declaration uses 'sorry'
 -/
 -- #guard_msgs in
 
-set_option trace.Meta.debug true
-
 example (i j : Nat) (a b : Array Nat) (h1 : j < a.size) (h : j < b.size) (h2 : i ≤ j) : a[i] < a[j] + b[j] → i = j → a = b → False := by
-  grind_test
-  sorry
-
-#exit
+  grind on_failure fallback
 
 /--
 info: [Lean.Grind.nestedProof (i < a.toList.length) (_example.proof_1 i j a b h1 h2),
@@ -46,10 +40,7 @@ info: [Lean.Grind.nestedProof (i < a.toList.length) (_example.proof_1 i j a b h1
  Lean.Grind.nestedProof (j < b.toList.length) h]
 ---
 info: [a[i], a[j]]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (i j : Nat) (a b : Array Nat) (h1 : j < a.size) (h : j < b.size) (h2 : i ≤ j) : a[i] < a[j] + b[j] → i = j → False := by
-  grind_test
-  sorry
+  grind on_failure fallback

tests/lean/run/grind_norm_levels.lean

@@ -1,21 +1,17 @@
-import Lean
+import Lean.Meta.Tactic.Grind
 
 def g {α : Sort u} (a : α) := a
 
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let nodes ← filterENodes fun e => return e.self.isAppOf ``g
-    logInfo (nodes.toList.map (·.self))
+open Lean Meta Grind in
+def fallback : Fallback := do
+  let nodes ← filterENodes fun e => return e.self.isAppOf ``g
+  logInfo (nodes.toList.map (·.self))
+  (← get).mvarId.admit
 
 -- `grind` final state must contain only two `g`-applications
 /--
 info: [g (a, b), g (g (a, b))]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example {β : Type v} {α : Type u} (a c : α) (b d : β) : g.{max u v + 1} (a, b) = (c, d) → g (g.{max (u+1) (v+1)} (a, b)) = (c, d) → False := by
-  grind_test
-  sorry
+  grind on_failure fallback

tests/lean/run/grind_offset.lean

@@ -0,0 +1,154 @@
+opaque g : Nat → Nat
+
+@[simp] def f (a : Nat) :=
+  match a with
+  | 0 => 10
+  | x+1 => g (f x)
+
+set_option trace.grind.ematch.pattern true
+set_option trace.grind.ematch.instance true
+set_option trace.grind.assert true
+
+/--
+info: [grind.ematch.pattern] f.eq_2: [f (Lean.Grind.offset #0 (1))]
+-/
+#guard_msgs in
+grind_pattern f.eq_2 => f (x + 1)
+
+
+/--
+info: [grind.assert] f (y + 1) = a
+[grind.assert] ¬a = g (f y)
+[grind.ematch.instance] f.eq_2: f y.succ = g (f y)
+[grind.assert] f (y + 1) = g (f y)
+-/
+#guard_msgs (info) in
+example : f (y + 1) = a → a = g (f y):= by
+  grind
+
+/--
+info: [grind.assert] f 1 = a
+[grind.assert] ¬a = g (f 0)
+[grind.ematch.instance] f.eq_2: f (Nat.succ 0) = g (f 0)
+[grind.assert] f 1 = g (f 0)
+-/
+#guard_msgs (info) in
+example : f 1 = a → a = g (f 0) := by
+  grind
+
+/--
+info: [grind.assert] f 10 = a
+[grind.assert] ¬a = g (f 9)
+[grind.ematch.instance] f.eq_2: f (Nat.succ 8) = g (f 8)
+[grind.ematch.instance] f.eq_2: f (Nat.succ 9) = g (f 9)
+[grind.assert] f 9 = g (f 8)
+[grind.assert] f 10 = g (f 9)
+-/
+#guard_msgs (info) in
+example : f 10 = a → a = g (f 9) := by
+  grind
+
+/--
+info: [grind.assert] f (c + 2) = a
+[grind.assert] ¬a = g (g (f c))
+[grind.ematch.instance] f.eq_2: f (c + 1).succ = g (f (c + 1))
+[grind.assert] f (c + 2) = g (f (c + 1))
+[grind.ematch.instance] f.eq_2: f c.succ = g (f c)
+[grind.assert] f (c + 1) = g (f c)
+-/
+#guard_msgs (info) in
+example : f (c + 2) = a → a = g (g (f c)) := by
+  grind
+
+@[simp] def foo (a : Nat) :=
+  match a with
+  | 0 => 10
+  | 1 => 10
+  | a+2 => g (foo a)
+
+/--
+info: [grind.ematch.pattern] foo.eq_3: [foo (Lean.Grind.offset #0 (2))]
+-/
+#guard_msgs in
+grind_pattern foo.eq_3 => foo (a_2 + 2)
+
+-- The instance is correctly found in the following example.
+-- TODO: to complete the proof, we need linear arithmetic support to prove that `b + 2 = c + 1`.
+/--
+info: [grind.assert] foo (c + 1) = a
+[grind.assert] c = b + 1
+[grind.assert] ¬a = g (foo b)
+[grind.ematch.instance] foo.eq_3: foo b.succ.succ = g (foo b)
+[grind.assert] foo (b + 2) = g (foo b)
+-/
+#guard_msgs (info) in
+example : foo (c + 1) = a → c = b + 1 → a = g (foo b) := by
+  fail_if_success grind
+  sorry
+
+set_option trace.grind.assert false
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → a = b := by
+  fail_if_success grind (ematch := 2)
+  sorry
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
+[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
+[grind.ematch.instance] f.eq_2: f (x + 95).succ = g (f (x + 95))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → a = b := by
+  fail_if_success grind (ematch := 5)
+  sorry
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
+[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → a = b := by
+  fail_if_success grind (ematch := 100) (instances := 4)
+  sorry
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (y + 9).succ = g (f (y + 9))
+[grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+[grind.ematch.instance] f.eq_2: f (y + 8).succ = g (f (y + 8))
+[grind.ematch.instance] f.eq_2: f (y + 7).succ = g (f (y + 7))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → f (y + 10) = c → a = b := by
+  fail_if_success grind (ematch := 100) (instances := 5)
+  sorry
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → a = b := by
+  fail_if_success grind (gen := 2)
+  sorry
+
+/--
+info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
+[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
+[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
+[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
+[grind.ematch.instance] f.eq_2: f (x + 95).succ = g (f (x + 95))
+-/
+#guard_msgs (info) in
+example : f (x + 100) = a → a = b := by
+  fail_if_success grind (gen := 5)
+  sorry

tests/lean/run/grind_pattern1.lean

@@ -20,7 +20,7 @@ grind_pattern List.mem_concat_self => a ∈ xs ++ [a]
 def foo (x : Nat) := x + x
 
 /--
-error: `foo` is not a theorem, you cannot assign patterns to non-theorems for the `grind` tactic
+error: `foo` is not a theorem
 -/
 #guard_msgs in
 grind_pattern foo => x + x
@@ -112,3 +112,10 @@ grind_pattern hThm1 => plus a c
 /-- info: [grind.ematch.pattern] hThm1: [plus #2 #1, plus #2 #3] -/
 #guard_msgs in
 grind_pattern hThm1 => plus a c, plus a b
+
+/--
+error: invalid pattern, (non-forbidden) application expected
+  #4 ∧ #3
+-/
+#guard_msgs in
+grind_pattern And.imp_left => a ∧ b

tests/lean/run/grind_pattern_proj.lean

@@ -0,0 +1,47 @@
+universe v v₁ v₂ u u₁ u₂
+
+namespace CategoryTheory
+
+class Quiver (V : Type u) where
+  Hom : V → V → Sort v
+
+infixr:10 " ⟶ " => Quiver.Hom
+
+class CategoryStruct (obj : Type u) extends Quiver.{v + 1} obj : Type max u (v + 1) where
+  /-- The identity morphism on an object. -/
+  id : ∀ X : obj, Hom X X
+  /-- Composition of morphisms in a category, written `f ≫ g`. -/
+  comp : ∀ {X Y Z : obj}, (X ⟶ Y) → (Y ⟶ Z) → (X ⟶ Z)
+
+notation "𝟙" => CategoryStruct.id  -- type as \b1
+
+infixr:80 " ≫ " => CategoryStruct.comp -- type as \gg
+
+class Category (obj : Type u) extends CategoryStruct.{v} obj : Type max u (v + 1) where
+  id_comp : ∀ {X Y : obj} (f : X ⟶ Y), 𝟙 X ≫ f = f
+  comp_id : ∀ {X Y : obj} (f : X ⟶ Y), f ≫ 𝟙 Y = f
+  assoc : ∀ {W X Y Z : obj} (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z), (f ≫ g) ≫ h = f ≫ g ≫ h
+
+structure Prefunctor (V : Type u₁) [Quiver.{v₁} V] (W : Type u₂) [Quiver.{v₂} W] where
+  obj : V → W
+  map : ∀ {X Y : V}, (X ⟶ Y) → (obj X ⟶ obj Y)
+
+structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D]
+    extends Prefunctor C D : Type max v₁ v₂ u₁ u₂ where
+  map_id : ∀ X : C, map (𝟙 X) = 𝟙 (obj X)
+  map_comp : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g
+
+
+set_option trace.grind.ematch.pattern true
+
+/--
+info: [grind.ematch.pattern] Functor.map_id: [@Prefunctor.map #5 ? #3 ? (@Functor.toPrefunctor ? #4 ? #2 #1) #0 #0 (@CategoryStruct.id ? ? #0)]
+-/
+#guard_msgs in
+grind_pattern Functor.map_id => self.map (𝟙 X)
+
+/--
+info: [grind.ematch.pattern] Functor.map_comp: [@Prefunctor.map #9 ? #7 ? (@Functor.toPrefunctor ? #8 ? #6 #5) #4 #2 (@CategoryStruct.comp ? ? #4 #3 #2 #1 #0)]
+-/
+#guard_msgs in
+grind_pattern Functor.map_comp => self.map (f ≫ g)

tests/lean/run/grind_pre.lean

@@ -5,6 +5,7 @@ set_option grind.debug.proofs true
 
 /--
 error: `grind` failed
+case grind.1.2
 a b c : Bool
 p q : Prop
 left✝ : a = true
@@ -12,6 +13,8 @@ right✝ : b = true ∨ c = true
 left : p
 right : q
 x✝ : b = false ∨ a = false
+h✝ : b = false
+h : c = true
 ⊢ False
 -/
 #guard_msgs (error) in
@@ -21,6 +24,7 @@ theorem ex (h : (f a && (b || f (f c))) = true) (h' : p ∧ q) : b && a := by
 open Lean.Grind.Eager in
 /--
 error: `grind` failed
+case grind.2.1
 a b c : Bool
 p q : Prop
 left✝ : a = true
@@ -38,6 +42,7 @@ def g (i : Nat) (j : Nat) (_ : i > j := by omega) := i + j
 
 /--
 error: `grind` failed
+case grind
 i j : Nat
 h : j + 1 < i + 1
 h✝ : j + 1 ≤ i
@@ -54,6 +59,7 @@ structure Point where
 
 /--
 error: `grind` failed
+case grind
 a₁ : Point
 a₂ : Nat
 a₃ : Int
@@ -80,6 +86,7 @@ example (p : Prop) (a b c : Nat) : p → a = 0 → a = b → h a = h c → a = c
 set_option trace.grind.debug.proof true
 /--
 error: `grind` failed
+case grind
 α : Type
 a : α
 p q r : Prop

tests/lean/run/grind_propagate_connectives.lean

@@ -1,18 +1,16 @@
-import Lean
+import Lean.Meta.Tactic.Grind
 
--- Prints the equivalence class containing a `f` application
-open Lean Meta Elab Tactic Grind in
-elab "grind_test" : tactic => withMainContext do
-  let declName := (← Term.getDeclName?).getD `_main
-  Meta.Grind.preprocessAndProbe (← getMainGoal) declName do
-    let trueExprs := (← filterENodes fun e => return e.self.isFVar && (← isEqTrue e.self)).toList.map (·.self)
-    let falseExprs := (← filterENodes fun e => return e.self.isFVar && (← isEqFalse e.self)).toList.map (·.self)
-    logInfo m!"true:  {trueExprs}"
-    logInfo m!"false: {falseExprs}"
-    forEachEqc fun n => do
-      unless (← isProp n.self) || (← isType n.self) || n.size == 1 do
-        let eqc ← getEqc n.self
-        logInfo eqc
+open Lean Meta Grind in
+def fallback : Fallback := do
+  let trueExprs := (← filterENodes fun e => return e.self.isFVar && (← isEqTrue e.self)).toList.map (·.self)
+  let falseExprs := (← filterENodes fun e => return e.self.isFVar && (← isEqFalse e.self)).toList.map (·.self)
+  logInfo m!"true:  {trueExprs}"
+  logInfo m!"false: {falseExprs}"
+  forEachEqc fun n => do
+    unless (← isProp n.self) || (← isType n.self) || n.size == 1 do
+      let eqc ← getEqc n.self
+      logInfo eqc
+  (← get).mvarId.admit
 
 set_option grind.debug true
 set_option grind.debug.proofs true
@@ -21,73 +19,57 @@ set_option grind.debug.proofs true
 info: true:  [q, w]
 ---
 info: false: [p, r]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example : (p ∨ (q ∧ ¬r ∧ w)) → ¬p → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
+
 
 /--
 info: true:  [r]
 ---
 info: false: [p, q]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example : (p ∨ q ∨ r) → (p ∨ ¬q) → ¬p → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
+
 
 /--
 info: true:  [r]
 ---
 info: false: [p₁, q]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example : ((p₁ ∧ p₂) ∨ q ∨ r) → (p₁ ∨ ¬q) → p₁ = False → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: true:  [r]
 ---
 info: false: [p₂, q]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example : ((p₁ ∧ p₂) ∨ q ∨ r) → ((p₂ ∧ p₁) ∨ ¬q) → p₂ = False → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: true:  [q, r]
 ---
 info: false: [p]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (p q r : Prop) : p ∨ (q ↔ r) → p = False → q → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: true:  [r]
 ---
 info: false: [p, s]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (p q r : Prop) : p ∨ ¬(s ∨ (p ↔ r)) → p = False → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
 info: true:  [p]
@@ -95,35 +77,32 @@ info: true:  [p]
 info: false: []
 ---
 info: [a, b]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (p : Prop) (a : Vector Nat 5) (b : Vector Nat 6) : (p → HEq a b) → p → False := by
-  grind_test
-  sorry
-
+  grind on_failure fallback
 
 /--
 info: true:  [p, q]
 ---
 info: false: [r]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (p q r : Prop) : p ∨ (q ↔ r) → q → ¬r → False := by
-  grind_test
-  sorry
+  grind on_failure fallback
 
 /--
+info: hello world
+---
 info: true:  [p, q]
 ---
 info: false: [r]
----
-warning: declaration uses 'sorry'
 -/
-#guard_msgs in
+#guard_msgs (info) in
 example (p q r : Prop) : p ∨ (q ↔ r) → ¬r → q → False := by
-  grind_test
-  sorry
+  grind on_failure do
+    Lean.logInfo "hello world"
+    fallback
+
+example (a b : Nat) : (a = b) = (b = a) := by
+  grind

tests/lean/run/grind_shelf.lean

@@ -0,0 +1,30 @@
+class One (α : Type u) where
+  one : α
+
+instance (priority := 300) One.toOfNat1 {α} [One α] : OfNat α (nat_lit 1) where
+  ofNat := ‹One α›.1
+
+class Shelf (α : Type u) where
+  act : α → α → α
+  self_distrib : ∀ {x y z : α}, act x (act y z) = act (act x y) (act x z)
+
+class UnitalShelf (α : Type u) extends Shelf α, One α where
+  one_act : ∀ a : α, act 1 a = a
+  act_one : ∀ a : α, act a 1 = a
+
+infixr:65 " ◃ " => Shelf.act
+
+-- Mathlib proof from UnitalShelf.act_act_self_eq
+example {S} [UnitalShelf S] (x y : S) : (x ◃ y) ◃ x = x ◃ y := by
+  have h : (x ◃ y) ◃ x = (x ◃ y) ◃ (x ◃ 1) := by rw [UnitalShelf.act_one]
+  rw [h, ← Shelf.self_distrib, UnitalShelf.act_one]
+
+attribute [grind =] UnitalShelf.one_act UnitalShelf.act_one
+
+-- We actually want the reverse direction of `Shelf.self_distrib`, so don't use the `grind_eq` attribute.
+grind_pattern Shelf.self_distrib => self.act (self.act x y) (self.act x z)
+
+-- Proof using `grind`:
+example {S} [UnitalShelf S] (x y : S) : (x ◃ y) ◃ x = x ◃ y := by
+  have h : (x ◃ y) ◃ x = (x ◃ y) ◃ (x ◃ 1) := by grind
+  grind

tests/lean/run/grind_split.lean

@@ -0,0 +1,63 @@
+set_option trace.grind.split true
+set_option trace.grind.eqc true
+example (p q : Prop) : p ∨ q → p ∨ ¬q → ¬p ∨ q → ¬p ∨ ¬q → False := by
+  grind
+
+opaque R : Nat → Prop
+
+/--
+info: [grind] working on goal `grind`
+[grind.eqc] (if p then a else b) = c
+[grind.eqc] R a = True
+[grind.eqc] R b = True
+[grind.eqc] R c = False
+[grind.split] if p then a else b, generation: 0
+[grind] working on goal `grind.1`
+[grind.eqc] p = True
+[grind.eqc] (if p then a else b) = a
+[grind.eqc] R a = R c
+[grind] closed `grind.1`
+[grind] working on goal `grind.2`
+[grind.eqc] p = False
+[grind.eqc] (if p then a else b) = b
+[grind.eqc] R b = R c
+[grind] closed `grind.2`
+-/
+#guard_msgs (info) in
+set_option trace.grind true in
+example (p : Prop) [Decidable p] (a b c : Nat) : (if p then a else b) = c → R a → R b → R c := by
+  grind
+
+example (p : Prop) [Decidable p] (a b c : Nat) : (if p then a else b) = c → R a → R b → R c := by
+  fail_if_success grind (splitIte := false)
+  sorry
+
+namespace grind_test_induct_pred
+
+inductive Expr where
+  | nat  : Nat → Expr
+  | plus : Expr → Expr → Expr
+  | bool : Bool → Expr
+  | and  : Expr → Expr → Expr
+  deriving DecidableEq
+
+inductive Ty where
+  | nat
+  | bool
+  deriving DecidableEq
+
+inductive HasType : Expr → Ty → Prop
+  | nat  : HasType (.nat v) .nat
+  | plus : HasType a .nat → HasType b .nat → HasType (.plus a b) .nat
+  | bool : HasType (.bool v) .bool
+  | and  : HasType a .bool → HasType b .bool → HasType (.and a b) .bool
+
+set_option trace.grind true
+theorem HasType.det (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
+  grind
+
+theorem HasType.det' (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
+  fail_if_success grind (splitIndPred := false)
+  sorry
+
+end grind_test_induct_pred

tests/lean/run/grind_t1.lean

@@ -83,3 +83,93 @@ info: [grind.debug.proj] { a := b, b := v₁, c := v₂ }.a
 set_option trace.grind.debug.proj true in
 example (a b d e : Nat) (x y z : Boo Nat) (f : Nat → Boo Nat) : (f d).1 ≠ a → f d = ⟨b, v₁, v₂⟩ → x.1 = e → y.1 = e → z.1 = e → f d = x → f d = y → f d = z → b = a → False := by
   grind
+
+example (f : Nat → Nat) (a b c : Nat) : f (if a = b then x else y) = z → a = c → c = b → f x = z := by
+  grind
+
+example (f : Nat → Nat) (a b c : Nat) : f (if a = b then x else y) = z → a = c → b ≠ c → f y = z := by
+  grind
+
+namespace dite_propagator_test
+
+opaque R : Nat → Nat → Prop
+opaque f (a : Nat) (b : Nat) (_ : R a b) : Nat
+opaque g (a : Nat) (b : Nat) (_ : ¬ R a b) : Nat
+open Classical
+
+example (foo : Nat → Nat)
+        (_ : foo (if h : R a c then f a c h else g a c h) = x)
+        (_ : R a b)
+        (_ : c = b) : foo (f a c (by grind)) = x := by
+  grind
+
+example (foo : Nat → Nat)
+        (_ : foo (if h : R a c then f a c h else g a c h) = x)
+        (_ : ¬ R a b)
+        (_ : c = b)
+        : foo (g a c (by grind)) = x := by
+  grind
+
+end dite_propagator_test
+
+/--
+info: [grind.eqc] x = 2 * a
+[grind.eqc] y = x
+[grind.eqc] (y = 2 * a) = False
+[grind.eqc] (y = 2 * a) = True
+-/
+#guard_msgs (info) in
+set_option trace.grind.eqc true in
+example (a : Nat) : let x := a + a; y = x → y = a + a := by
+  grind
+
+/--
+info: [grind.eqc] x = 2 * a
+[grind.eqc] y = x
+[grind.eqc] (y = 2 * a) = False
+[grind.eqc] (y = 2 * a) = True
+-/
+#guard_msgs (info) in
+set_option trace.grind.eqc true in
+example (a : Nat) : let_fun x := a + a; y = x → y = a + a := by
+  grind
+
+example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
+        (h₁ : α = β)
+        (h₂ : cast h₁ a₁ = b₁)
+        (h₃ : a₁ = a₂)
+        (h₄ : b₁ = b₂)
+        : HEq a₂ b₂ := by
+  grind
+
+example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
+        (h₁ : α = β)
+        (h₂ : h₁ ▸ a₁ = b₁)
+        (h₃ : a₁ = a₂)
+        (h₄ : b₁ = b₂)
+        : HEq a₂ b₂ := by
+  grind
+
+example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
+        (h₁ : α = β)
+        (h₂ : Eq.recOn h₁ a₁ = b₁)
+        (h₃ : a₁ = a₂)
+        (h₄ : b₁ = b₂)
+        : HEq a₂ b₂ := by
+  grind
+
+example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
+        (h₁ : α = β)
+        (h₂ : Eq.ndrec (motive := id) a₁ h₁ = b₁)
+        (h₃ : a₁ = a₂)
+        (h₄ : b₁ = b₂)
+        : HEq a₂ b₂ := by
+  grind
+
+example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
+        (h₁ : α = β)
+        (h₂ : Eq.rec (motive := fun x _ => x) a₁ h₁ = b₁)
+        (h₃ : a₁ = a₂)
+        (h₄ : b₁ = b₂)
+        : HEq a₂ b₂ := by
+  grind