fix

This PR fixes a bug in the pattern selection in the `grind`.

.github/workflows/ci.yml

@@ -244,21 +244,21 @@ jobs:
                 "check-level": 2,
                 "cross": true,
                 "shell": "bash -euxo pipefail {0}"
-              },
-              {
-                "name": "Web Assembly",
-                "os": "ubuntu-latest",
-                // Build a native 32bit binary in stage0 and use it to compile the oleans and the wasm build
-                "CMAKE_OPTIONS": "-DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX=\"\" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32 -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
-                "wasm": true,
-                "cmultilib": true,
-                "release": true,
-                "check-level": 2,
-                "cross": true,
-                "shell": "bash -euxo pipefail {0}",
-                // Just a few selected tests because wasm is slow
-                "CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
               }
+              // {
+              //   "name": "Web Assembly",
+              //   "os": "ubuntu-latest",
+              //   // Build a native 32bit binary in stage0 and use it to compile the oleans and the wasm build
+              //   "CMAKE_OPTIONS": "-DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX=\"\" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32 -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
+              //   "wasm": true,
+              //   "cmultilib": true,
+              //   "release": true,
+              //   "check-level": 2,
+              //   "cross": true,
+              //   "shell": "bash -euxo pipefail {0}",
+              //   // Just a few selected tests because wasm is slow
+              //   "CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
+              // }
             ];
             console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
             return matrix.filter((job) => level >= job["check-level"])

doc/dev/ffi.md

@@ -49,8 +49,9 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
   is represented by the representation of that parameter's type.
 
   For example, `{ x : α // p }`, the `Subtype` structure of a value of type `α` and an irrelevant proof, is represented by the representation of `α`.
-* `Nat` is represented by `lean_object *`.
-  Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
+  Similarly, the signed integer types `Int8`, ..., `Int64`, `ISize` are also represented by the unsigned C types `uint8_t`, ..., `uint64_t`, `size_t`, respectively, because they have a trivial structure.
+* `Nat` and `Int` are represented by `lean_object *`.
+  Their runtime values is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number or integer (`lean_box`/`lean_unbox`).
 * A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
 * Any other type is represented by `lean_object *`.
   Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.

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`
@@ -42,16 +37,32 @@ We'll use `v4.6.0` as the intended release version as a running example.
     - Create the tag `v4.6.0` from `master`/`main` and push it.
     - Merge the tag `v4.6.0` into the `stable` branch and push it.
   - We do this for the repositories:
-    - [lean4checker](https://github.com/leanprover/lean4checker)
-      - No dependencies
-      - Toolchain bump PR
-      - Create and push the tag
-      - Merge the tag into `stable`
     - [Batteries](https://github.com/leanprover-community/batteries)
       - No dependencies
       - Toolchain bump PR
       - Create and push the tag
       - Merge the tag into `stable`
+    - [lean4checker](https://github.com/leanprover/lean4checker)
+      - No dependencies
+      - Toolchain bump PR
+      - Create and push the tag
+      - Merge the tag into `stable`
+    - [doc-gen4](https://github.com/leanprover/doc-gen4)
+      - Dependencies: exist, but they're not part of the release workflow
+      - Toolchain bump PR including updated Lake manifest
+      - Create and push the tag
+      - There is no `stable` branch; skip this step
+    - [Verso](https://github.com/leanprover/verso)
+      - Dependencies: exist, but they're not part of the release workflow
+      - The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
+      - Toolchain bump PR including updated Lake manifest
+      - Create and push the tag
+      - There is no `stable` branch; skip this step
+    - [Cli](https://github.com/leanprover/lean4-cli)
+      - No dependencies
+      - Toolchain bump PR
+      - Create and push the tag
+      - There is no `stable` branch; skip this step
     - [ProofWidgets4](https://github.com/leanprover-community/ProofWidgets4)
       - Dependencies: `Batteries`
       - Note on versions and branches:
@@ -66,27 +77,20 @@ 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`
-    - [doc-gen4](https://github.com/leanprover/doc-gen4)
-      - Dependencies: exist, but they're not part of the release workflow
-      - Toolchain bump PR including updated Lake manifest
-      - Create and push the tag
-      - There is no `stable` branch; skip this step
-    - [Verso](https://github.com/leanprover/verso)
-      - Dependencies: exist, but they're not part of the release workflow
-      - The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
-      - Toolchain bump PR including updated Lake manifest
-      - Create and push the tag
-      - There is no `stable` branch; skip this step
     - [import-graph](https://github.com/leanprover-community/import-graph)
       - 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 +102,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 +144,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 +250,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,86 @@
+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: Cli
+    url: https://github.com/leanprover/lean4-cli
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
+  - name: ProofWidgets4
+    url: https://github.com/leanprover-community/ProofWidgets4
+    toolchain-tag: false
+    stable-branch: false
+    branch: main
+    dependencies:
+      - Batteries
+
+  - 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.lean

@@ -37,3 +37,4 @@ import Init.MacroTrace
 import Init.Grind
 import Init.While
 import Init.Syntax
+import Init.Internal

src/Init/Conv.lean

@@ -150,6 +150,10 @@ See the `simp` tactic for more information. -/
 syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
   (" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
 
+/-- `simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
+that would be sufficient to close the goal. See the `simp?` tactic for more information. -/
+syntax (name := simpTrace) "simp?" optConfig (discharger)? (&" only")? (simpArgs)? : conv
+
 /--
 `dsimp` is the definitional simplifier in `conv`-mode. It differs from `simp` in that it only
 applies theorems that hold by reflexivity.
@@ -167,6 +171,9 @@ example (a : Nat): (0 + 0) = a - a := by
 syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
   (" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
 
+@[inherit_doc simpTrace]
+syntax (name := dsimpTrace) "dsimp?" optConfig (&" only")? (dsimpArgs)? : conv
+
 /-- `simp_match` simplifies match expressions. For example,
 ```
 match [a, b] with

src/Init/Core.lean

@@ -2116,16 +2116,14 @@ instance : Commutative Or := ⟨fun _ _ => propext or_comm⟩
 instance : Commutative And := ⟨fun _ _ => propext and_comm⟩
 instance : Commutative Iff := ⟨fun _ _ => propext iff_comm⟩
 
-/-- `IsRefl X r` means the binary relation `r` on `X` is reflexive. -/
+/-- `Refl r` means the binary relation `r` is reflexive, that is, `r x x` always holds. -/
 class Refl (r : α → α → Prop) : Prop where
   /-- A reflexive relation satisfies `r a a`. -/
   refl : ∀ a, r a a
 
-/--
-`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
--/
+/-- `Antisymm r` says that `r` is antisymmetric, that is, `r a b → r b a → a = b`. -/
 class Antisymm (r : α → α → Prop) : Prop where
-  /-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
+  /-- An antisymmetric relation `r` satisfies `r a b → r b a → a = b`. -/
   antisymm (a b : α) : r a b → r b a → a = b
 
 @[deprecated Antisymm (since := "2024-10-16"), inherit_doc Antisymm]
@@ -2143,8 +2141,8 @@ class Total (r : α → α → Prop) : Prop where
   /-- A total relation satisfies `r a b ∨ r b a`. -/
   total : ∀ a b, r a b ∨ r b a
 
-/-- `Irrefl X r` means the binary relation `r` on `X` is irreflexive (that is, `r x x` never
-holds). -/
+/-- `Irrefl r` means the binary relation `r` is irreflexive, that is, `r x x` never
+holds. -/
 class Irrefl (r : α → α → Prop) : Prop where
   /-- An irreflexive relation satisfies `¬ r a a`. -/
   irrefl : ∀ a, ¬r a a

src/Init/Data/Array/Basic.lean

@@ -244,8 +244,7 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
 def range (n : Nat) : Array Nat :=
   ofFn fun (i : Fin n) => i
 
-def singleton (v : α) : Array α :=
-  mkArray 1 v
+@[inline] protected def singleton (v : α) : Array α := #[v]
 
 def back! [Inhabited α] (a : Array α) : α :=
   a[a.size - 1]!
@@ -949,13 +948,7 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
 instance instLT [LT α] : LT (Array α) := ⟨fun as bs => as.toList < bs.toList⟩
 instance instLE [LT α] : LE (Array α) := ⟨fun as bs => as.toList ≤ bs.toList⟩
 
-instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLT (Array α) :=
-  inferInstanceAs <| DecidableRel fun (as bs : Array α) => as.toList < bs.toList
-
-instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLE (Array α) :=
-  inferInstanceAs <| DecidableRel fun (as bs : Array α) => as.toList ≤ bs.toList
-
--- See `Init.Data.Array.Lex` for the boolean valued lexicographic comparator.
+-- See `Init.Data.Array.Lex.Basic` for the boolean valued lexicographic comparator.
 
 /-! ## Auxiliary functions used in metaprogramming.
 

src/Init/Data/Array/Lex.lean

@@ -4,27 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Author: Kim Morrison
 -/
 prelude
-import Init.Data.Array.Basic
-import Init.Data.Nat.Lemmas
-import Init.Data.Range
-
-namespace Array
-
-/--
-Lexicographic comparator for arrays.
-
-`lex as bs lt` is true if
-- `bs` is larger than `as` and `as` is pairwise equivalent via `==` to the initial segment of `bs`, or
-- there is an index `i` such that `lt as[i] bs[i]`, and for all `j < i`, `as[j] == bs[j]`.
--/
-def lex [BEq α] (as bs : Array α) (lt : α → α → Bool := by exact (· < ·)) : Bool := Id.run do
-  for h : i in [0 : min as.size bs.size] do
-    -- TODO: `omega` should be able to find this itself.
-    have : i < min as.size bs.size := Membership.get_elem_helper h rfl
-    if lt as[i] bs[i] then
-      return true
-    else if as[i] != bs[i] then
-      return false
-  return as.size < bs.size
-
-end Array
+import Init.Data.Array.Lex.Basic
+import Init.Data.Array.Lex.Lemmas

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

@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Basic
+import Init.Data.Nat.Lemmas
+import Init.Data.Range
+
+namespace Array
+
+/--
+Lexicographic comparator for arrays.
+
+`lex as bs lt` is true if
+- `bs` is larger than `as` and `as` is pairwise equivalent via `==` to the initial segment of `bs`, or
+- there is an index `i` such that `lt as[i] bs[i]`, and for all `j < i`, `as[j] == bs[j]`.
+-/
+def lex [BEq α] (as bs : Array α) (lt : α → α → Bool := by exact (· < ·)) : Bool := Id.run do
+  for h : i in [0 : min as.size bs.size] do
+    -- TODO: `omega` should be able to find this itself.
+    have : i < min as.size bs.size := Membership.get_elem_helper h rfl
+    if lt as[i] bs[i] then
+      return true
+    else if as[i] != bs[i] then
+      return false
+  return as.size < bs.size
+
+end Array

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

@@ -0,0 +1,281 @@
+/-
+Copyright (c) 2024 Lean FRO. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Kim Morrison
+-/
+prelude
+import Init.Data.Array.Lemmas
+import Init.Data.List.Lex
+
+namespace Array
+
+/-! ### Lexicographic ordering -/
+
+@[simp] theorem _root_.List.lt_toArray [LT α] (l₁ l₂ : List α) : l₁.toArray < l₂.toArray ↔ l₁ < l₂ := Iff.rfl
+@[simp] theorem _root_.List.le_toArray [LT α] (l₁ l₂ : List α) : l₁.toArray ≤ l₂.toArray ↔ l₁ ≤ l₂ := Iff.rfl
+
+@[simp] theorem lt_toList [LT α] (l₁ l₂ : Array α) : l₁.toList < l₂.toList ↔ l₁ < l₂ := Iff.rfl
+@[simp] theorem le_toList [LT α] (l₁ l₂ : Array α) : l₁.toList ≤ l₂.toList ↔ l₁ ≤ l₂ := Iff.rfl
+
+protected theorem not_lt_iff_ge [LT α] (l₁ l₂ : List α) : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : List α) :
+    ¬ l₁ ≤ l₂ ↔ l₂ < l₁ :=
+  Decidable.not_not
+
+@[simp] theorem lex_empty [BEq α] {lt : α → α → Bool} (l : Array α) : l.lex #[] lt = false := by
+  simp [lex, Id.run]
+
+@[simp] theorem singleton_lex_singleton [BEq α] {lt : α → α → Bool} : #[a].lex #[b] lt = lt a b := by
+  simp only [lex, List.getElem_toArray, List.getElem_singleton]
+  cases lt a b <;> cases a != b <;> simp [Id.run]
+
+private theorem cons_lex_cons [BEq α] {lt : α → α → Bool} {a b : α} {xs ys : Array α} :
+     (#[a] ++ xs).lex (#[b] ++ ys) lt =
+       (lt a b || a == b && xs.lex ys lt) := by
+  simp only [lex, Id.run]
+  simp only [Std.Range.forIn'_eq_forIn'_range', size_append, size_toArray, List.length_singleton,
+    Nat.add_comm 1]
+  simp [Nat.add_min_add_right, List.range'_succ, getElem_append_left, List.range'_succ_left,
+    getElem_append_right]
+  cases lt a b
+  · rw [bne]
+    cases a == b <;> simp
+  · simp
+
+@[simp] theorem _root_.List.lex_toArray [BEq α] (lt : α → α → Bool) (l₁ l₂ : List α) :
+    l₁.toArray.lex l₂.toArray lt = l₁.lex l₂ lt := by
+  induction l₁ generalizing l₂ with
+  | nil => cases l₂ <;> simp [lex, Id.run]
+  | cons x l₁ ih =>
+    cases l₂ with
+    | nil => simp [lex, Id.run]
+    | cons y l₂ =>
+      rw [List.toArray_cons, List.toArray_cons y, cons_lex_cons, List.lex, ih]
+
+@[simp] theorem lex_toList [BEq α] (lt : α → α → Bool) (l₁ l₂ : Array α) :
+    l₁.toList.lex l₂.toList lt = l₁.lex l₂ lt := by
+  cases l₁ <;> cases l₂ <;> simp
+
+protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] (l : Array α) : ¬ l < l :=
+  List.lt_irrefl l.toList
+
+instance ltIrrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Irrefl (α := Array α) (· < ·) where
+  irrefl := Array.lt_irrefl
+
+@[simp] theorem not_lt_empty [LT α] (l : Array α) : ¬ l < #[] := List.not_lt_nil l.toList
+@[simp] theorem empty_le [LT α] (l : Array α) : #[] ≤ l := List.nil_le l.toList
+
+@[simp] theorem le_empty [LT α] (l : Array α) : l ≤ #[] ↔ l = #[] := by
+  cases l
+  simp
+
+@[simp] theorem empty_lt_push [LT α] (l : Array α) (a : α) : #[] < l.push a := by
+  rcases l with (_ | ⟨x, l⟩) <;> simp
+
+protected theorem le_refl [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] (l : Array α) : l ≤ l :=
+  List.le_refl l.toList
+
+instance [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Refl (· ≤ · : Array α → Array α → Prop) where
+  refl := Array.le_refl
+
+protected theorem lt_trans [LT α]
+    [i₁ : Trans (· < · : α → α → Prop) (· < ·) (· < ·)]
+    {l₁ l₂ l₃ : Array α} (h₁ : l₁ < l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
+  List.lt_trans h₁ h₂
+
+instance [LT α] [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
+    Trans (· < · : Array α → Array α → Prop) (· < ·) (· < ·) where
+  trans h₁ h₂ := Array.lt_trans h₁ h₂
+
+protected theorem lt_of_le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : Array α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
+  List.lt_of_le_of_lt h₁ h₂
+
+protected theorem le_trans [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : Array α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
+  fun h₃ => h₁ (Array.lt_of_le_of_lt h₂ h₃)
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+    Trans (· ≤ · : Array α → Array α → Prop) (· ≤ ·) (· ≤ ·) where
+  trans h₁ h₂ := Array.le_trans h₁ h₂
+
+protected theorem lt_asymm [LT α]
+    [i : Std.Asymm (· < · : α → α → Prop)]
+    {l₁ l₂ : Array α} (h : l₁ < l₂) : ¬ l₂ < l₁ := List.lt_asymm h
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Asymm (· < · : α → α → Prop)] :
+    Std.Asymm (· < · : Array α → Array α → Prop) where
+  asymm _ _ := Array.lt_asymm
+
+protected theorem le_total [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)] (l₁ l₂ : Array α) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
+  List.le_total _ _
+
+@[simp] protected theorem not_lt [LT α]
+    {l₁ l₂ : Array α} : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+
+@[simp] protected theorem not_le [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Array α} : ¬ l₂ ≤ l₁ ↔ l₁ < l₂ := Decidable.not_not
+
+protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : Array α} (h : l₁ < l₂) : l₁ ≤ l₂ :=
+  List.le_of_lt h
+
+protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : Array α} : l₁ ≤ l₂ ↔ l₁ < l₂ ∨ l₁ = l₂ := by
+  simpa using List.le_iff_lt_or_eq (l₁ := l₁.toList) (l₂ := l₂.toList)
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Total (¬ · < · : α → α → Prop)] :
+    Std.Total (· ≤ · : Array α → Array α → Prop) where
+  total := Array.le_total
+
+@[simp] theorem lex_eq_true_iff_lt [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Array α} : lex l₁ l₂ = true ↔ l₁ < l₂ := by
+  cases l₁
+  cases l₂
+  simp
+
+@[simp] theorem lex_eq_false_iff_ge [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Array α} : lex l₁ l₂ = false ↔ l₂ ≤ l₁ := by
+  cases l₁
+  cases l₂
+  simp [List.not_lt_iff_ge]
+
+instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLT (Array α) :=
+  fun l₁ l₂ => decidable_of_iff (lex l₁ l₂ = true) lex_eq_true_iff_lt
+
+instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLE (Array α) :=
+  fun l₁ l₂ => decidable_of_iff (lex l₂ l₁ = false) lex_eq_false_iff_ge
+
+/--
+`l₁` is lexicographically less than `l₂` if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.size`,
+  and `l₁` is shorter than `l₂` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₁[i] < l₂[i]`
+-/
+theorem lex_eq_true_iff_exists [BEq α] (lt : α → α → Bool) :
+    lex l₁ l₂ lt = true ↔
+      (l₁.isEqv (l₂.take l₁.size) (· == ·) ∧ l₁.size < l₂.size) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₁[i] l₂[i]) := by
+  cases l₁
+  cases l₂
+  simp [List.lex_eq_true_iff_exists]
+
+/--
+`l₁` is *not* lexicographically less than `l₂`
+(which you might think of as "`l₂` is lexicographically greater than or equal to `l₁`"") if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₂[i] < l₁[i]`
+
+This formulation requires that `==` and `lt` are compatible in the following senses:
+- `==` is symmetric
+  (we unnecessarily further assume it is transitive, to make use of the existing typeclasses)
+- `lt` is irreflexive with respect to `==` (i.e. if `x == y` then `lt x y = false`
+- `lt` is asymmmetric  (i.e. `lt x y = true → lt y x = false`)
+- `lt` is antisymmetric with respect to `==` (i.e. `lt x y = false → lt y x = false → x == y`)
+-/
+theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : α → α → Bool)
+    (lt_irrefl : ∀ x y, x == y → lt x y = false)
+    (lt_asymm : ∀ x y, lt x y = true → lt y x = false)
+    (lt_antisymm : ∀ x y, lt x y = false → lt y x = false → x == y) :
+    lex l₁ l₂ lt = false ↔
+      (l₂.isEqv (l₁.take l₂.size) (· == ·)) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₂[i] l₁[i]) := by
+  cases l₁
+  cases l₂
+  simp_all [List.lex_eq_false_iff_exists]
+
+protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Array α} :
+    l₁ < l₂ ↔
+      (l₁ = l₂.take l₁.size ∧ l₁.size < l₂.size) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) ∧ l₁[i] < l₂[i]) := by
+  cases l₁
+  cases l₂
+  simp [List.lt_iff_exists]
+
+protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)] {l₁ l₂ : Array α} :
+    l₁ ≤ l₂ ↔
+      (l₁ = l₂.take l₁.size) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) ∧ l₁[i] < l₂[i]) := by
+  cases l₁
+  cases l₂
+  simp [List.le_iff_exists]
+
+theorem append_left_lt [LT α] {l₁ l₂ l₃ : Array α} (h : l₂ < l₃) :
+    l₁ ++ l₂ < l₁ ++ l₃ := by
+  cases l₁
+  cases l₂
+  cases l₃
+  simpa using List.append_left_lt h
+
+theorem append_left_le [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    {l₁ l₂ l₃ : Array α} (h : l₂ ≤ l₃) :
+    l₁ ++ l₂ ≤ l₁ ++ l₃ := by
+  cases l₁
+  cases l₂
+  cases l₃
+  simpa using List.append_left_le h
+
+theorem le_append_left [LT α] [Std.Irrefl (· < · : α → α → Prop)]
+    {l₁ l₂ : Array α} : l₁ ≤ l₁ ++ l₂ := by
+  cases l₁
+  cases l₂
+  simpa using List.le_append_left
+
+protected theorem map_lt [LT α] [LT β]
+    {l₁ l₂ : Array α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ < l₂) :
+    map f l₁ < map f l₂ := by
+  cases l₁
+  cases l₂
+  simpa using List.map_lt w h
+
+protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Irrefl (· < · : β → β → Prop)]
+    [Std.Asymm (· < · : β → β → Prop)]
+    [Std.Antisymm (¬ · < · : β → β → Prop)]
+    {l₁ l₂ : Array α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ ≤ l₂) :
+    map f l₁ ≤ map f l₂ := by
+  cases l₁
+  cases l₂
+  simpa using List.map_le w h
+
+end Array

src/Init/Data/Array/Monadic.lean

@@ -79,8 +79,31 @@ theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β
   rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
   simp [List.foldrM_filter]
 
+/-! ### forM -/
+
+@[congr] theorem forM_congr [Monad m] {as bs : Array α} (w : as = bs)
+    {f : α → m PUnit} :
+    forM f as = forM f bs := by
+  cases as <;> cases bs
+  simp_all
+
+@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Array α) (g : α → β) (f : β → m PUnit) :
+    (l.map g).forM f = l.forM (fun a => f (g a)) := by
+  cases l
+  simp
+
 /-! ### forIn' -/
 
+@[congr] theorem forIn'_congr [Monad m] {as bs : Array α} (w : as = bs)
+    {b b' : β} (hb : b = b')
+    {f : (a' : α) → a' ∈ as → β → m (ForInStep β)}
+    {g : (a' : α) → a' ∈ bs → β → m (ForInStep β)}
+    (h : ∀ a m b, f a (by simpa [w] using m) b = g a m b) :
+    forIn' as b f = forIn' bs b' g := by
+  cases as <;> cases bs
+  simp only [mk.injEq, mem_toArray, List.forIn'_toArray] at w h ⊢
+  exact List.forIn'_congr w hb h
+
 /--
 We can express a for loop over an array as a fold,
 in which whenever we reach `.done b` we keep that value through the rest of the fold.
@@ -120,6 +143,12 @@ theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   cases l
   simp [List.foldl_map]
 
+@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
+    (l : Array α) (g : α → β) (f : (b : β) → b ∈ l.map g → γ → m (ForInStep γ)) :
+    forIn' (l.map g) init f = forIn' l init fun a h y => f (g a) (mem_map_of_mem g h) y := by
+  cases l
+  simp
+
 /--
 We can express a for loop over an array as a fold,
 in which whenever we reach `.done b` we keep that value through the rest of the fold.
@@ -156,4 +185,10 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   cases l
   simp [List.foldl_map]
 
+@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
+    (l : Array α) (g : α → β) (f : β → γ → m (ForInStep γ)) :
+    forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
+  cases l
+  simp
+
 end Array

src/Init/Data/BitVec/Lemmas.lean

@@ -9,7 +9,9 @@ import Init.Data.Bool
 import Init.Data.BitVec.Basic
 import Init.Data.Fin.Lemmas
 import Init.Data.Nat.Lemmas
+import Init.Data.Nat.Div.Lemmas
 import Init.Data.Nat.Mod
+import Init.Data.Nat.Div.Lemmas
 import Init.Data.Int.Bitwise.Lemmas
 import Init.Data.Int.Pow
 
@@ -98,6 +100,12 @@ theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by
 theorem eq_of_toNat_eq {n} : ∀ {x y : BitVec n}, x.toNat = y.toNat → x = y
   | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
 
+/-- Prove nonequality of bitvectors in terms of nat operations. -/
+theorem toNat_ne_iff_ne {n} {x y : BitVec n} : x.toNat ≠ y.toNat ↔ x ≠ y := by
+  constructor
+  · rintro h rfl; apply h rfl
+  · intro h h_eq; apply h <| eq_of_toNat_eq h_eq
+
 @[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl
 
 @[bv_toNat] theorem toNat_eq {x y : BitVec n} : x = y ↔ x.toNat = y.toNat :=
@@ -442,6 +450,10 @@ theorem toInt_eq_toNat_cond (x : BitVec n) :
         (x.toNat : Int) - (2^n : Nat) :=
   rfl
 
+theorem toInt_eq_toNat_of_lt {x : BitVec n} (h : 2 * x.toNat < 2^n) :
+    x.toInt = x.toNat := by
+  simp [toInt_eq_toNat_cond, h]
+
 theorem msb_eq_false_iff_two_mul_lt {x : BitVec w} : x.msb = false ↔ 2 * x.toNat < 2^w := by
   cases w <;> simp [Nat.pow_succ, Nat.mul_comm _ 2, msb_eq_decide, toNat_of_zero_length]
 
@@ -454,6 +466,9 @@ theorem toInt_eq_msb_cond (x : BitVec w) :
   simp only [BitVec.toInt, ← msb_eq_false_iff_two_mul_lt]
   cases x.msb <;> rfl
 
+theorem toInt_eq_toNat_of_msb {x : BitVec w} (h : x.msb = false) :
+    x.toInt = x.toNat := by
+  simp [toInt_eq_msb_cond, h]
 
 theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) := by
   simp only [toInt_eq_toNat_cond]
@@ -785,6 +800,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 +1170,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
@@ -2282,6 +2315,12 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
 @[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
   simp [Neg.neg, BitVec.neg]
 
+theorem toNat_neg_of_pos {x : BitVec n} (h : 0#n < x) :
+    (- x).toNat = 2^n - x.toNat := by
+  change 0 < x.toNat at h
+  rw [toNat_neg, Nat.mod_eq_of_lt]
+  omega
+
 theorem toInt_neg {x : BitVec w} :
     (-x).toInt = (-x.toInt).bmod (2 ^ w) := by
   rw [← BitVec.zero_sub, toInt_sub]
@@ -2377,6 +2416,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
@@ -2520,13 +2607,13 @@ theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) :
   rw [← udiv_eq]
   simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
 
+@[simp]
+theorem toFin_udiv {x y : BitVec n} : (x / y).toFin = x.toFin / y.toFin := by
+  rfl
+
 @[simp, bv_toNat]
 theorem toNat_udiv {x y : BitVec n} : (x / y).toNat = x.toNat / y.toNat := by
-  rw [udiv_def]
-  by_cases h : y = 0
-  · simp [h]
-  · rw [toNat_ofNat, Nat.mod_eq_of_lt]
-    exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
+  rfl
 
 @[simp]
 theorem zero_udiv {x : BitVec w} : (0#w) / x = 0#w := by
@@ -2562,6 +2649,45 @@ theorem udiv_self {x : BitVec w} :
       ↓reduceIte, toNat_udiv]
     rw [Nat.div_self (by omega), Nat.mod_eq_of_lt (by omega)]
 
+theorem msb_udiv (x y : BitVec w) :
+    (x / y).msb = (x.msb && y == 1#w) := by
+  cases msb_x : x.msb
+  · suffices x.toNat / y.toNat < 2 ^ (w - 1) by simpa [msb_eq_decide]
+    calc
+      x.toNat / y.toNat ≤ x.toNat     := by apply Nat.div_le_self
+                      _ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
+  . rcases w with _|w
+    · contradiction
+    · have : (y == 1#_) = decide (y.toNat = 1) := by
+        simp [(· == ·), toNat_eq]
+      simp only [this, Bool.true_and]
+      match hy : y.toNat with
+      | 0 =>
+        obtain rfl : y = 0#_ := eq_of_toNat_eq hy
+        simp
+      | 1 =>
+        obtain rfl : y = 1#_ := eq_of_toNat_eq (by simp [hy])
+        simpa using msb_x
+      | y + 2 =>
+        suffices x.toNat / (y + 2) < 2 ^ w by
+          simp_all [msb_eq_decide, hy]
+        calc
+          x.toNat / (y + 2)
+            ≤ x.toNat / 2 := by apply Nat.div_add_le_right (by omega)
+          _ < 2 ^ w       := by omega
+
+theorem msb_udiv_eq_false_of {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
+    (x / y).msb = false := by
+  simp [msb_udiv, h]
+
+/--
+If `x` is nonnegative (i.e., does not have its msb set),
+then `x / y` is nonnegative, thus `toInt` and `toNat` coincide.
+-/
+theorem toInt_udiv_of_msb {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
+    (x / y).toInt = x.toNat / y.toNat := by
+  simp [toInt_eq_msb_cond, msb_udiv_eq_false_of h]
+
 /-! ### umod -/
 
 theorem umod_def {x y : BitVec n} :
@@ -2574,6 +2700,10 @@ theorem umod_def {x y : BitVec n} :
 theorem toNat_umod {x y : BitVec n} :
     (x % y).toNat = x.toNat % y.toNat := rfl
 
+@[simp]
+theorem toFin_umod {x y : BitVec w} :
+    (x % y).toFin = x.toFin % y.toFin := rfl
+
 @[simp]
 theorem umod_zero {x : BitVec n} : x % 0#n = x := by
   simp [umod_def]
@@ -2601,6 +2731,55 @@ theorem umod_eq_and {x y : BitVec 1} : x % y = x &&& (~~~y) := by
     rcases hy with rfl | rfl <;>
       rfl
 
+theorem umod_eq_of_lt {x y : BitVec w} (h : x < y) :
+    x % y = x := by
+  apply eq_of_toNat_eq
+  simp [Nat.mod_eq_of_lt h]
+
+@[simp]
+theorem msb_umod {x y : BitVec w} :
+    (x % y).msb = (x.msb && (x < y || y == 0#w)) := by
+  rw [msb_eq_decide, toNat_umod]
+  cases msb_x : x.msb
+  · suffices x.toNat % y.toNat < 2 ^ (w - 1) by simpa
+    calc
+      x.toNat % y.toNat ≤ x.toNat     := by apply Nat.mod_le
+                      _ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
+  . by_cases hy : y = 0
+    · simp_all [msb_eq_decide]
+    · suffices 2 ^ (w - 1) ≤ x.toNat % y.toNat ↔ x < y by simp_all
+      by_cases x_lt_y : x < y
+      . simp_all [Nat.mod_eq_of_lt x_lt_y, msb_eq_decide]
+      · suffices x.toNat % y.toNat < 2 ^ (w - 1) by
+          simpa [x_lt_y]
+        have y_le_x : y.toNat ≤ x.toNat := by
+          simpa using x_lt_y
+        replace hy : y.toNat ≠ 0 :=
+          toNat_ne_iff_ne.mpr hy
+        by_cases msb_y : y.toNat < 2 ^ (w - 1)
+        · have : x.toNat % y.toNat < y.toNat := Nat.mod_lt _ (by omega)
+          omega
+        · rcases w with _|w
+          · contradiction
+          simp only [Nat.add_one_sub_one]
+          replace msb_y : 2 ^ w ≤ y.toNat := by
+            simpa using msb_y
+          have : y.toNat ≤ y.toNat * (x.toNat / y.toNat) := by
+              apply Nat.le_mul_of_pos_right
+              apply Nat.div_pos y_le_x
+              omega
+          have : x.toNat % y.toNat ≤ x.toNat - y.toNat := by
+            rw [Nat.mod_eq_sub]; omega
+          omega
+
+theorem toInt_umod {x y : BitVec w} :
+    (x % y).toInt = (x.toNat % y.toNat : Int).bmod (2 ^ w) := by
+  simp [toInt_eq_toNat_bmod]
+
+theorem toInt_umod_of_msb {x y : BitVec w} (h : x.msb = false) :
+    (x % y).toInt = x.toInt % y.toNat := by
+  simp [toInt_eq_msb_cond, h]
+
 /-! ### smtUDiv -/
 
 theorem smtUDiv_eq (x y : BitVec w) : smtUDiv x y = if y = 0#w then allOnes w else x / y := by
@@ -2757,7 +2936,12 @@ theorem smod_zero {x : BitVec n} : x.smod 0#n = x := by
 
 /-! # Rotate Left -/
 
-/-- rotateLeft is invariant under `mod` by the bitwidth. -/
+/--`rotateLeft` is defined in terms of left and right shifts. -/
+theorem rotateLeft_def {x : BitVec w} {r : Nat} :
+    x.rotateLeft r = (x <<< (r % w)) ||| (x >>> (w - r % w)) := by
+  simp only [rotateLeft, rotateLeftAux]
+
+/-- `rotateLeft` is invariant under `mod` by the bitwidth. -/
 @[simp]
 theorem rotateLeft_mod_eq_rotateLeft {x : BitVec w} {r : Nat} :
     x.rotateLeft (r % w) = x.rotateLeft r := by
@@ -2901,8 +3085,18 @@ theorem msb_rotateLeft {m w : Nat} {x : BitVec w} :
   · simp
     omega
 
+@[simp]
+theorem toNat_rotateLeft {x : BitVec w} {r : Nat} :
+    (x.rotateLeft r).toNat = (x.toNat <<< (r % w)) % (2^w) ||| x.toNat >>> (w - r % w) := by
+  simp only [rotateLeft_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
+
 /-! ## Rotate Right -/
 
+/-- `rotateRight` is defined in terms of left and right shifts. -/
+theorem rotateRight_def {x : BitVec w} {r : Nat} :
+    x.rotateRight r = (x >>> (r % w)) ||| (x <<< (w - r % w)) := by
+  simp only [rotateRight, rotateRightAux]
+
 /--
 Accessing bits in `x.rotateRight r` the range `[0, w-r)` is equal to
 accessing bits `x` in the range `[r, w)`.
@@ -3038,6 +3232,11 @@ theorem msb_rotateRight {r w : Nat} {x : BitVec w} :
     simp [h₁]
   · simp [show w = 0 by omega]
 
+@[simp]
+theorem toNat_rotateRight {x : BitVec w} {r : Nat} :
+    (x.rotateRight r).toNat = (x.toNat >>> (r % w)) ||| x.toNat <<< (w - r % w) % (2^w) := by
+  simp only [rotateRight_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
+
 /- ## twoPow -/
 
 theorem twoPow_eq (w : Nat) (i : Nat) : twoPow w i = 1#w <<< i := by

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.lean

@@ -28,3 +28,4 @@ import Init.Data.List.ToArrayImpl
 import Init.Data.List.MapIdx
 import Init.Data.List.OfFn
 import Init.Data.List.FinRange
+import Init.Data.List.Lex

src/Init/Data/List/Lemmas.lean

@@ -1,7 +1,8 @@
 /-
 Copyright (c) 2014 Parikshit Khanna. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
+Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
+  Kim Morrison
 -/
 prelude
 import Init.Data.Bool
@@ -747,598 +748,15 @@ theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l
     · intro a
       simp
 
-/-! ### Lexicographic ordering -/
+/-! ### isEqv -/
 
-
-theorem lex_irrefl {r : α → α → Prop} (irrefl : ∀ x, ¬r x x) (l : List α) : ¬Lex r l l := by
-  induction l with
-  | nil => nofun
-  | cons a l ih => intro
-    | .rel h => exact irrefl _ h
-    | .cons h => exact ih h
-
-protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] (l : List α) : ¬ l < l :=
-  lex_irrefl Std.Irrefl.irrefl l
-
-instance ltIrrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Irrefl (α := List α) (· < ·) where
-  irrefl := List.lt_irrefl
-
-@[simp] theorem not_lex_nil : ¬Lex r l [] := fun h => nomatch h
-
-@[simp] theorem nil_le [LT α] (l : List α) : [] ≤ l := fun h => nomatch h
-
-@[simp] theorem not_nil_lex_iff : ¬Lex r [] l ↔ l = [] := by
-  constructor
-  · rintro h
-    match l, h with
-    | [], h => rfl
-    | a :: _, h => exact False.elim (h Lex.nil)
-  · rintro rfl
-    exact not_lex_nil
-
-@[simp] theorem le_nil [LT α] (l : List α) : l ≤ [] ↔ l = [] := not_nil_lex_iff
-
-@[simp] theorem nil_lex_cons : Lex r [] (a :: l) := Lex.nil
-
-@[simp] theorem nil_lt_cons [LT α] (a : α) (l : List α) : [] < a :: l := Lex.nil
-
-theorem cons_lex_cons_iff : Lex r (a :: l₁) (b :: l₂) ↔ r a b ∨ a = b ∧ Lex r l₁ l₂ :=
-  ⟨fun | .rel h => .inl h | .cons h => .inr ⟨rfl, h⟩,
-    fun | .inl h => Lex.rel h | .inr ⟨rfl, h⟩ => Lex.cons h⟩
-
-theorem cons_lt_cons_iff [LT α] {a b} {l₁ l₂ : List α} :
-    (a :: l₁) < (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ < l₂ := by
-  dsimp only [instLT, List.lt]
-  simp [cons_lex_cons_iff]
-
-theorem not_cons_lex_cons_iff [DecidableEq α] [DecidableRel r] {a b} {l₁ l₂ : List α} :
-    ¬ Lex r (a :: l₁) (b :: l₂) ↔ (¬ r a b ∧ a ≠ b) ∨ (¬ r a b ∧ ¬ Lex r l₁ l₂) := by
-  rw [cons_lex_cons_iff, not_or, Decidable.not_and_iff_or_not, and_or_left]
-
-theorem cons_le_cons_iff [DecidableEq α] [LT α] [DecidableLT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    {a b} {l₁ l₂ : List α} :
-    (a :: l₁) ≤ (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ ≤ l₂ := by
-  dsimp only [instLE, instLT, List.le, List.lt]
-  simp [not_cons_lex_cons_iff]
-  constructor
-  · rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩)
-    · left
-      apply Decidable.byContradiction
-      intro h₃
-      apply h₂
-      exact i₂.antisymm _ _ h₁ h₃
-    · if h₃ : a < b then
-        exact .inl h₃
-      else
-        right
-        exact ⟨i₂.antisymm _ _ h₃ h₁, h₂⟩
-  · rintro (h | ⟨h₁, h₂⟩)
-    · left
-      exact ⟨i₁.asymm _ _ h, fun w => i₀.irrefl _ (w ▸ h)⟩
-    · right
-      exact ⟨fun w => i₀.irrefl _ (h₁ ▸ w), h₂⟩
-
-theorem not_lt_of_cons_le_cons [DecidableEq α] [LT α] [DecidableLT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    {a b : α} {l₁ l₂ : List α} (h : a :: l₁ ≤ b :: l₂) : ¬ b < a := by
-  rw [cons_le_cons_iff] at h
-  rcases h with h | ⟨rfl, h⟩
-  · exact i₁.asymm _ _ h
-  · exact i₀.irrefl _
-
-theorem le_of_cons_le_cons [DecidableEq α] [LT α] [DecidableLT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    {a} {l₁ l₂ : List α} (h : a :: l₁ ≤ a :: l₂) : l₁ ≤ l₂ := by
-  rw [cons_le_cons_iff] at h
-  rcases h with h | ⟨_, h⟩
-  · exact False.elim (i₀.irrefl _ h)
-  · exact h
-
-protected theorem le_refl [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] (l : List α) : l ≤ l := by
-  induction l with
-  | nil => simp
-  | cons a l ih =>
-    intro
-    | .rel h => exact i₀.irrefl _ h
-    | .cons h₃ => exact ih h₃
-
-instance [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Refl (· ≤ · : List α → List α → Prop) where
-  refl := List.le_refl
-
-theorem lex_trans {r : α → α → Prop} [DecidableRel r]
-    (lt_trans : ∀ {x y z : α}, r x y → r y z → r x z)
-    (h₁ : Lex r l₁ l₂) (h₂ : Lex r l₂ l₃) : Lex r l₁ l₃ := by
-  induction h₁ generalizing l₃ with
-  | nil => let _::_ := l₃; exact List.Lex.nil ..
-  | @rel a l₁ b l₂ ab =>
-    match h₂ with
-    | .rel bc => exact List.Lex.rel (lt_trans ab bc)
-    | .cons ih =>
-      exact List.Lex.rel ab
-  | @cons a l₁ l₂ h₁ ih2 =>
-    match h₂ with
-    | .rel bc =>
-      exact List.Lex.rel bc
-    | .cons ih =>
-      exact List.Lex.cons (ih2 ih)
-
-protected theorem lt_trans [LT α] [DecidableLT α]
-    [i₁ : Trans (· < · : α → α → Prop) (· < ·) (· < ·)]
-    {l₁ l₂ l₃ : List α} (h₁ : l₁ < l₂) (h₂ : l₂ < l₃) : l₁ < l₃ := by
-  simp only [instLT, List.lt] at h₁ h₂ ⊢
-  exact lex_trans (fun h₁ h₂ => i₁.trans h₁ h₂) h₁ h₂
-
-instance [LT α] [DecidableLT α]
-    [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
-    Trans (· < · : List α → List α → Prop) (· < ·) (· < ·) where
-  trans h₁ h₂ := List.lt_trans h₁ h₂
-
-instance [LT α] [DecidableLT α]
-    [Trans (· < · : α → α → Prop) (· < ·) (· < ·)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)] :
-    Trans (· < · : List α → List α → Prop) (· < ·) (· < ·) where
-  trans h₁ h₂ := List.lt_trans h₁ h₂
-
-@[deprecated List.le_antisymm (since := "2024-12-13")]
-protected abbrev lt_antisymm := @List.le_antisymm
-
-protected theorem lt_of_le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
-    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
-    [i₁ : Std.Asymm (· < · : α → α → Prop)]
-    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
-    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
-    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ := by
-  induction h₂ generalizing l₁ with
-  | nil => simp_all
-  | rel hab =>
-    rename_i a b
-    cases l₁ with
-    | nil => simp_all
-    | cons c l₁ =>
-      apply Lex.rel
-      replace h₁ := not_lt_of_cons_le_cons h₁
-      apply Decidable.byContradiction
-      intro h₂
-      have := i₃.trans h₁ h₂
-      contradiction
-  | cons w₃ ih =>
-    rename_i a as bs
-    cases l₁ with
-    | nil => simp_all
-    | cons c l₁ =>
-      have w₄ := not_lt_of_cons_le_cons h₁
-      by_cases w₅ : a = c
-      · subst w₅
-        exact Lex.cons (ih (le_of_cons_le_cons h₁))
-      · exact Lex.rel (Decidable.byContradiction fun w₆ => w₅ (i₂.antisymm _ _ w₄ w₆))
-
-protected theorem le_trans [DecidableEq α] [LT α] [DecidableLT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
-    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
-  fun h₃ => h₁ (List.lt_of_le_of_lt h₂ h₃)
-
-instance [DecidableEq α] [LT α] [DecidableLT α]
-    [Std.Irrefl (· < · : α → α → Prop)]
-    [Std.Asymm (· < · : α → α → Prop)]
-    [Std.Antisymm (¬ · < · : α → α → Prop)]
-    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
-    Trans (· ≤ · : List α → List α → Prop) (· ≤ ·) (· ≤ ·) where
-  trans h₁ h₂ := List.le_trans h₁ h₂
-
-theorem lex_asymm {r : α → α → Prop} [DecidableRel r]
-    (h : ∀ {x y : α}, r x y → ¬ r y x) : ∀ {l₁ l₂ : List α}, Lex r l₁ l₂ → ¬ Lex r l₂ l₁
-  | nil, _, .nil => by simp
-  | x :: l₁, y :: l₂, .rel h₁ =>
-    fun
-    | .rel h₂ => h h₁ h₂
-    | .cons h₂ => h h₁ h₁
-  | x :: l₁, _ :: l₂, .cons h₁ =>
-    fun
-    | .rel h₂ => h h₂ h₂
-    | .cons h₂ => lex_asymm h h₁ h₂
-
-protected theorem lt_asymm [DecidableEq α] [LT α] [DecidableLT α]
-    [i : Std.Asymm (· < · : α → α → Prop)]
-    {l₁ l₂ : List α} (h : l₁ < l₂) : ¬ l₂ < l₁ := lex_asymm (i.asymm _ _) h
-
-instance [DecidableEq α] [LT α] [DecidableLT α]
-    [Std.Asymm (· < · : α → α → Prop)] :
-    Std.Asymm (· < · : List α → List α → Prop) where
-  asymm _ _ := List.lt_asymm
-
-theorem not_lex_total [DecidableEq α] {r : α → α → Prop} [DecidableRel r]
-    (h : ∀ x y : α, ¬ r x y ∨ ¬ r y x) (l₁ l₂ : List α) : ¬ Lex r l₁ l₂ ∨ ¬ Lex r l₂ l₁ := by
-  rw [Decidable.or_iff_not_imp_left, Decidable.not_not]
-  intro w₁ w₂
-  match l₁, l₂, w₁, w₂ with
-  | nil, _ :: _, .nil, w₂ => simp at w₂
-  | x :: _, y :: _, .rel _, .rel _ =>
-    obtain (_ | _) := h x y <;> contradiction
-  | x :: _, _ :: _, .rel _, .cons _ =>
-    obtain (_ | _) := h x x <;> contradiction
-  | x :: _, _ :: _, .cons  _, .rel _ =>
-    obtain (_ | _) := h x x <;> contradiction
-  | _ :: l₁, _ :: l₂, .cons _, .cons _ =>
-    obtain (_ | _) := not_lex_total h l₁ l₂ <;> contradiction
-
-protected theorem le_total [DecidableEq α] [LT α] [DecidableLT α]
-    [i : Std.Total (¬ · < · : α → α → Prop)] {l₁ l₂ : List α} : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
-  not_lex_total i.total l₂ l₁
-
-instance [DecidableEq α] [LT α] [DecidableLT α]
-    [Std.Total (¬ · < · : α → α → Prop)] :
-    Std.Total (· ≤ · : List α → List α → Prop) where
-  total _ _ := List.le_total
-
-theorem lex_eq_decide_lex [DecidableEq α] (lt : α → α → Bool) :
-    lex l₁ l₂ lt = decide (Lex (fun x y => lt x y) l₁ l₂) := by
+@[simp] theorem isEqv_eq [DecidableEq α] {l₁ l₂ : List α} : l₁.isEqv l₂ (· == ·) = (l₁ = l₂) := by
   induction l₁ generalizing l₂ with
-  | nil =>
-    cases l₂ with
-    | nil => simp [lex]
-    | cons b bs => simp [lex]
+  | nil => cases l₂ <;> simp
   | cons a l₁ ih =>
     cases l₂ with
-    | nil => simp [lex]
-    | cons b bs =>
-      simp [lex, ih, cons_lex_cons_iff, Bool.beq_eq_decide_eq]
-
-/-- Variant of `lex_eq_true_iff` using an arbitrary comparator. -/
-@[simp] theorem lex_eq_true_iff_lex [DecidableEq α] (lt : α → α → Bool) :
-    lex l₁ l₂ lt = true ↔ Lex (fun x y => lt x y) l₁ l₂ := by
-  simp [lex_eq_decide_lex]
-
-/-- Variant of `lex_eq_false_iff` using an arbitrary comparator. -/
-@[simp] theorem lex_eq_false_iff_not_lex [DecidableEq α] (lt : α → α → Bool) :
-    lex l₁ l₂ lt = false ↔ ¬ Lex (fun x y => lt x y) l₁ l₂ := by
-  simp [Bool.eq_false_iff, lex_eq_true_iff_lex]
-
-@[simp] theorem lex_eq_true_iff_lt [DecidableEq α] [LT α] [DecidableLT α]
-    {l₁ l₂ : List α} : lex l₁ l₂ = true ↔ l₁ < l₂ := by
-  simp only [lex_eq_true_iff_lex, decide_eq_true_eq]
-  exact Iff.rfl
-
-@[simp] theorem lex_eq_false_iff_ge [DecidableEq α] [LT α] [DecidableLT α]
-    {l₁ l₂ : List α} : lex l₁ l₂ = false ↔ l₂ ≤ l₁ := by
-  simp only [lex_eq_false_iff_not_lex, decide_eq_true_eq]
-  exact Iff.rfl
-
-attribute [local simp] Nat.add_one_lt_add_one_iff in
-/--
-`l₁` is lexicographically less than `l₂` if either
-- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length`,
-  and `l₁` is shorter than `l₂` or
-- there exists an index `i` such that
-  - for all `j < i`, `l₁[j] == l₂[j]` and
-  - `l₁[i] < l₂[i]`
--/
-theorem lex_eq_true_iff_exists [BEq α] (lt : α → α → Bool) :
-    lex l₁ l₂ lt = true ↔
-      (l₁.isEqv (l₂.take l₁.length) (· == ·) ∧ l₁.length < l₂.length) ∨
-        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
-          (∀ j, (hj : j < i) →
-            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₁[i] l₂[i]) := by
-  induction l₁ generalizing l₂ with
-  | nil =>
-    cases l₂ with
-    | nil => simp [lex]
-    | cons b bs => simp [lex]
-  | cons a l₁ ih =>
-    cases l₂ with
-    | nil => simp [lex]
-    | cons b l₂ =>
-      simp only [lex_cons_cons, Bool.or_eq_true, Bool.and_eq_true, ih, isEqv, length_cons]
-      constructor
-      · rintro (hab | ⟨hab, ⟨h₁, h₂⟩ | ⟨i, h₁, h₂, w₁, w₂⟩⟩)
-        · exact .inr ⟨0, by simp [hab]⟩
-        · exact .inl ⟨⟨hab, h₁⟩, by simpa using h₂⟩
-        · refine .inr ⟨i + 1, by simp [h₁],
-            by simp [h₂], ?_, ?_⟩
-          · intro j hj
-            cases j with
-            | zero => simp [hab]
-            | succ j =>
-              simp only [getElem_cons_succ]
-              rw [w₁]
-              simpa using hj
-          · simpa using w₂
-      · rintro (⟨⟨h₁, h₂⟩, h₃⟩ | ⟨i, h₁, h₂, w₁, w₂⟩)
-        · exact .inr ⟨h₁, .inl ⟨h₂, by simpa using h₃⟩⟩
-        · cases i with
-          | zero =>
-            left
-            simpa using w₂
-          | succ i =>
-            right
-            refine ⟨by simpa using w₁ 0 (by simp), ?_⟩
-            right
-            refine ⟨i, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
-            · intro j hj
-              simpa using w₁ (j + 1) (by simpa)
-            · simpa using w₂
-
-attribute [local simp] Nat.add_one_lt_add_one_iff in
-/--
-`l₁` is *not* lexicographically less than `l₂`
-(which you might think of as "`l₂` is lexicographically greater than or equal to `l₁`"") if either
-- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length` or
-- there exists an index `i` such that
-  - for all `j < i`, `l₁[j] == l₂[j]` and
-  - `l₂[i] < l₁[i]`
-
-This formulation requires that `==` and `lt` are compatible in the following senses:
-- `==` is symmetric
-  (we unnecessarily further assume it is transitive, to make use of the existing typeclasses)
-- `lt` is irreflexive with respect to `==` (i.e. if `x == y` then `lt x y = false`
-- `lt` is asymmmetric  (i.e. `lt x y = true → lt y x = false`)
-- `lt` is antisymmetric with respect to `==` (i.e. `lt x y = false → lt y x = false → x == y`)
--/
-theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : α → α → Bool)
-    (lt_irrefl : ∀ x y, x == y → lt x y = false)
-    (lt_asymm : ∀ x y, lt x y = true → lt y x = false)
-    (lt_antisymm : ∀ x y, lt x y = false → lt y x = false → x == y) :
-    lex l₁ l₂ lt = false ↔
-      (l₂.isEqv (l₁.take l₂.length) (· == ·)) ∨
-        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
-          (∀ j, (hj : j < i) →
-            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₂[i] l₁[i]) := by
-  induction l₁ generalizing l₂ with
-  | nil =>
-    cases l₂ with
-    | nil => simp [lex]
-    | cons b bs => simp [lex]
-  | cons a l₁ ih =>
-    cases l₂ with
-    | nil => simp [lex]
-    | cons b l₂ =>
-      simp only [lex_cons_cons, Bool.or_eq_false_iff, Bool.and_eq_false_imp, ih, isEqv,
-        Bool.and_eq_true, length_cons]
-      constructor
-      · rintro ⟨hab, h⟩
-        if eq : b == a then
-          specialize h (BEq.symm eq)
-          obtain (h | ⟨i, h₁, h₂, w₁, w₂⟩) := h
-          · exact .inl ⟨eq, h⟩
-          · refine .inr ⟨i + 1, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
-            · intro j hj
-              cases j with
-              | zero => simpa using BEq.symm eq
-              | succ j =>
-                simp only [getElem_cons_succ]
-                rw [w₁]
-                simpa using hj
-            · simpa using w₂
-        else
-          right
-          have hba : lt b a :=
-            Decidable.byContradiction fun hba => eq (lt_antisymm _ _ (by simpa using hba) hab)
-          exact ⟨0, by simp, by simp, by simpa⟩
-      · rintro (⟨eq, h⟩ | ⟨i, h₁, h₂, w₁, w₂⟩)
-        · exact ⟨lt_irrefl _ _ (BEq.symm eq), fun _ => .inl h⟩
-        · cases i with
-          | zero =>
-            simp at w₂
-            refine ⟨lt_asymm _ _ w₂, ?_⟩
-            intro eq
-            exfalso
-            simp [lt_irrefl _ _ (BEq.symm eq)] at w₂
-          | succ i =>
-            refine ⟨lt_irrefl _ _ (by simpa using w₁ 0 (by simp)), ?_⟩
-            refine fun _ => .inr ⟨i, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
-            · intro j hj
-              simpa using w₁ (j + 1) (by simpa)
-            · simpa using w₂
-
-/-! ### 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]
+    | nil => simp
+    | cons b l₂ => simp [isEqv, ih]
 
 /-! ### getLast -/
 
@@ -1598,27 +1016,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]
@@ -1644,6 +1041,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)]
@@ -1697,6 +1115,10 @@ theorem map_eq_cons_iff' {f : α → β} {l : List α} :
 
 @[deprecated map_eq_cons' (since := "2024-09-05")] abbrev map_eq_cons' := @map_eq_cons_iff'
 
+@[simp] theorem map_eq_singleton_iff {f : α → β} {l : List α} {b : β} :
+    map f l = [b] ↔ ∃ a, l = [a] ∧ f a = b := by
+  simp [map_eq_cons_iff]
+
 theorem map_eq_map_iff : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
   induction l <;> simp
 
@@ -1863,7 +1285,7 @@ theorem map_filter_eq_foldr (f : α → β) (p : α → Bool) (as : List α) :
 @[simp] theorem filter_append {p : α → Bool} :
     ∀ (l₁ l₂ : List α), filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂
   | [], _ => rfl
-  | a :: l₁, l₂ => by simp [filter]; split <;> simp [filter_append l₁]
+  | a :: l₁, l₂ => by simp only [cons_append, filter]; split <;> simp [filter_append l₁]
 
 theorem filter_eq_cons_iff {l} {a} {as} :
     filter p l = a :: as ↔
@@ -2343,16 +1765,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
@@ -2501,14 +1913,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
 
@@ -3081,10 +2485,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]
 
@@ -3098,10 +2606,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/Lex.lean

@@ -0,0 +1,523 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.List.Lemmas
+import Init.Data.List.Nat.TakeDrop
+
+namespace List
+
+/-! ### Lexicographic ordering -/
+
+@[simp] theorem lex_lt [LT α] (l₁ l₂ : List α) : Lex (· < ·) l₁ l₂ ↔ l₁ < l₂ := Iff.rfl
+@[simp] theorem not_lex_lt [LT α] (l₁ l₂ : List α) : ¬ Lex (· < ·) l₁ l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+
+protected theorem not_lt_iff_ge [LT α] (l₁ l₂ : List α) : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : List α) :
+    ¬ l₁ ≤ l₂ ↔ l₂ < l₁ :=
+  Decidable.not_not
+
+theorem lex_irrefl {r : α → α → Prop} (irrefl : ∀ x, ¬r x x) (l : List α) : ¬Lex r l l := by
+  induction l with
+  | nil => nofun
+  | cons a l ih => intro
+    | .rel h => exact irrefl _ h
+    | .cons h => exact ih h
+
+protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] (l : List α) : ¬ l < l :=
+  lex_irrefl Std.Irrefl.irrefl l
+
+instance ltIrrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Irrefl (α := List α) (· < ·) where
+  irrefl := List.lt_irrefl
+
+@[simp] theorem not_lex_nil : ¬Lex r l [] := fun h => nomatch h
+
+@[simp] theorem not_lt_nil [LT α] (l : List α) : ¬ l < [] := fun h => nomatch h
+@[simp] theorem nil_le [LT α] (l : List α) : [] ≤ l := fun h => nomatch h
+
+@[simp] theorem not_nil_lex_iff : ¬Lex r [] l ↔ l = [] := by
+  constructor
+  · rintro h
+    match l, h with
+    | [], h => rfl
+    | a :: _, h => exact False.elim (h Lex.nil)
+  · rintro rfl
+    exact not_lex_nil
+
+@[simp] theorem le_nil [LT α] (l : List α) : l ≤ [] ↔ l = [] := not_nil_lex_iff
+
+@[simp] theorem nil_lex_cons : Lex r [] (a :: l) := Lex.nil
+
+@[simp] theorem nil_lt_cons [LT α] (a : α) (l : List α) : [] < a :: l := Lex.nil
+
+theorem cons_lex_cons_iff : Lex r (a :: l₁) (b :: l₂) ↔ r a b ∨ a = b ∧ Lex r l₁ l₂ :=
+  ⟨fun | .rel h => .inl h | .cons h => .inr ⟨rfl, h⟩,
+    fun | .inl h => Lex.rel h | .inr ⟨rfl, h⟩ => Lex.cons h⟩
+
+theorem cons_lt_cons_iff [LT α] {a b} {l₁ l₂ : List α} :
+    (a :: l₁) < (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ < l₂ := by
+  dsimp only [instLT, List.lt]
+  simp [cons_lex_cons_iff]
+
+@[simp] theorem cons_lt_cons_self [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] {l₁ l₂ : List α} :
+    (a :: l₁) < (a :: l₂) ↔ l₁ < l₂ := by
+  simp [cons_lt_cons_iff, i₀.irrefl]
+
+theorem not_cons_lex_cons_iff [DecidableEq α] [DecidableRel r] {a b} {l₁ l₂ : List α} :
+    ¬ Lex r (a :: l₁) (b :: l₂) ↔ (¬ r a b ∧ a ≠ b) ∨ (¬ r a b ∧ ¬ Lex r l₁ l₂) := by
+  rw [cons_lex_cons_iff, not_or, Decidable.not_and_iff_or_not, and_or_left]
+
+theorem cons_le_cons_iff [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    {a b} {l₁ l₂ : List α} :
+    (a :: l₁) ≤ (b :: l₂) ↔ a < b ∨ a = b ∧ l₁ ≤ l₂ := by
+  dsimp only [instLE, instLT, List.le, List.lt]
+  simp only [not_cons_lex_cons_iff, ne_eq]
+  constructor
+  · rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩)
+    · left
+      apply Decidable.byContradiction
+      intro h₃
+      apply h₂
+      exact i₂.antisymm _ _ h₁ h₃
+    · if h₃ : a < b then
+        exact .inl h₃
+      else
+        right
+        exact ⟨i₂.antisymm _ _ h₃ h₁, h₂⟩
+  · rintro (h | ⟨h₁, h₂⟩)
+    · left
+      exact ⟨i₁.asymm _ _ h, fun w => i₀.irrefl _ (w ▸ h)⟩
+    · right
+      exact ⟨fun w => i₀.irrefl _ (h₁ ▸ w), h₂⟩
+
+theorem not_lt_of_cons_le_cons [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    {a b : α} {l₁ l₂ : List α} (h : a :: l₁ ≤ b :: l₂) : ¬ b < a := by
+  rw [cons_le_cons_iff] at h
+  rcases h with h | ⟨rfl, h⟩
+  · exact i₁.asymm _ _ h
+  · exact i₀.irrefl _
+
+theorem le_of_cons_le_cons [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    {a} {l₁ l₂ : List α} (h : a :: l₁ ≤ a :: l₂) : l₁ ≤ l₂ := by
+  rw [cons_le_cons_iff] at h
+  rcases h with h | ⟨_, h⟩
+  · exact False.elim (i₀.irrefl _ h)
+  · exact h
+
+protected theorem le_refl [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] (l : List α) : l ≤ l := by
+  induction l with
+  | nil => simp
+  | cons a l ih =>
+    intro
+    | .rel h => exact i₀.irrefl _ h
+    | .cons h₃ => exact ih h₃
+
+instance [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Refl (· ≤ · : List α → List α → Prop) where
+  refl := List.le_refl
+
+theorem lex_trans {r : α → α → Prop}
+    (lt_trans : ∀ {x y z : α}, r x y → r y z → r x z)
+    (h₁ : Lex r l₁ l₂) (h₂ : Lex r l₂ l₃) : Lex r l₁ l₃ := by
+  induction h₁ generalizing l₃ with
+  | nil => let _::_ := l₃; exact List.Lex.nil ..
+  | @rel a l₁ b l₂ ab =>
+    match h₂ with
+    | .rel bc => exact List.Lex.rel (lt_trans ab bc)
+    | .cons ih =>
+      exact List.Lex.rel ab
+  | @cons a l₁ l₂ h₁ ih2 =>
+    match h₂ with
+    | .rel bc =>
+      exact List.Lex.rel bc
+    | .cons ih =>
+      exact List.Lex.cons (ih2 ih)
+
+protected theorem lt_trans [LT α]
+    [i₁ : Trans (· < · : α → α → Prop) (· < ·) (· < ·)]
+    {l₁ l₂ l₃ : List α} (h₁ : l₁ < l₂) (h₂ : l₂ < l₃) : l₁ < l₃ := by
+  simp only [instLT, List.lt] at h₁ h₂ ⊢
+  exact lex_trans (fun h₁ h₂ => i₁.trans h₁ h₂) h₁ h₂
+
+instance [LT α] [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
+    Trans (· < · : List α → List α → Prop) (· < ·) (· < ·) where
+  trans h₁ h₂ := List.lt_trans h₁ h₂
+
+@[deprecated List.le_antisymm (since := "2024-12-13")]
+protected abbrev lt_antisymm := @List.le_antisymm
+
+protected theorem lt_of_le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ := by
+  induction h₂ generalizing l₁ with
+  | nil => simp_all
+  | rel hab =>
+    rename_i a b
+    cases l₁ with
+    | nil => simp_all
+    | cons c l₁ =>
+      apply Lex.rel
+      replace h₁ := not_lt_of_cons_le_cons h₁
+      apply Decidable.byContradiction
+      intro h₂
+      have := i₃.trans h₁ h₂
+      contradiction
+  | cons w₃ ih =>
+    rename_i a as bs
+    cases l₁ with
+    | nil => simp_all
+    | cons c l₁ =>
+      have w₄ := not_lt_of_cons_le_cons h₁
+      by_cases w₅ : a = c
+      · subst w₅
+        exact Lex.cons (ih (le_of_cons_le_cons h₁))
+      · exact Lex.rel (Decidable.byContradiction fun w₆ => w₅ (i₂.antisymm _ _ w₄ w₆))
+
+protected theorem le_trans [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : List α} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
+  fun h₃ => h₁ (List.lt_of_le_of_lt h₂ h₃)
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+    Trans (· ≤ · : List α → List α → Prop) (· ≤ ·) (· ≤ ·) where
+  trans h₁ h₂ := List.le_trans h₁ h₂
+
+theorem lex_asymm {r : α → α → Prop}
+    (h : ∀ {x y : α}, r x y → ¬ r y x) : ∀ {l₁ l₂ : List α}, Lex r l₁ l₂ → ¬ Lex r l₂ l₁
+  | nil, _, .nil => by simp
+  | x :: l₁, y :: l₂, .rel h₁ =>
+    fun
+    | .rel h₂ => h h₁ h₂
+    | .cons h₂ => h h₁ h₁
+  | x :: l₁, _ :: l₂, .cons h₁ =>
+    fun
+    | .rel h₂ => h h₂ h₂
+    | .cons h₂ => lex_asymm h h₁ h₂
+
+protected theorem lt_asymm [LT α]
+    [i : Std.Asymm (· < · : α → α → Prop)]
+    {l₁ l₂ : List α} (h : l₁ < l₂) : ¬ l₂ < l₁ := lex_asymm (i.asymm _ _) h
+
+instance [LT α] [Std.Asymm (· < · : α → α → Prop)] :
+    Std.Asymm (· < · : List α → List α → Prop) where
+  asymm _ _ := List.lt_asymm
+
+theorem not_lex_total [DecidableEq α] {r : α → α → Prop} [DecidableRel r]
+    (h : ∀ x y : α, ¬ r x y ∨ ¬ r y x) (l₁ l₂ : List α) : ¬ Lex r l₁ l₂ ∨ ¬ Lex r l₂ l₁ := by
+  rw [Decidable.or_iff_not_imp_left, Decidable.not_not]
+  intro w₁ w₂
+  match l₁, l₂, w₁, w₂ with
+  | nil, _ :: _, .nil, w₂ => simp at w₂
+  | x :: _, y :: _, .rel _, .rel _ =>
+    obtain (_ | _) := h x y <;> contradiction
+  | x :: _, _ :: _, .rel _, .cons _ =>
+    obtain (_ | _) := h x x <;> contradiction
+  | x :: _, _ :: _, .cons  _, .rel _ =>
+    obtain (_ | _) := h x x <;> contradiction
+  | _ :: l₁, _ :: l₂, .cons _, .cons _ =>
+    obtain (_ | _) := not_lex_total h l₁ l₂ <;> contradiction
+
+protected theorem le_total [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)] (l₁ l₂ : List α) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
+  not_lex_total i.total l₂ l₁
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Total (¬ · < · : α → α → Prop)] :
+    Std.Total (· ≤ · : List α → List α → Prop) where
+  total := List.le_total
+
+@[simp] protected theorem not_lt [LT α]
+    {l₁ l₂ : List α} : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+
+@[simp] protected theorem not_le [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : List α} : ¬ l₂ ≤ l₁ ↔ l₁ < l₂ := Decidable.not_not
+
+protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : List α} (h : l₁ < l₂) : l₁ ≤ l₂ := by
+  obtain (h' | h') := List.le_total l₁ l₂
+  · exact h'
+  · exfalso
+    exact h' h
+
+protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : List α} : l₁ ≤ l₂ ↔ l₁ < l₂ ∨ l₁ = l₂ := by
+  constructor
+  · intro h
+    by_cases h' : l₂ ≤ l₁
+    · right
+      apply List.le_antisymm h h'
+    · left
+      exact Decidable.not_not.mp h'
+  · rintro (h | rfl)
+    · exact List.le_of_lt h
+    · exact List.le_refl l₁
+
+theorem lex_eq_decide_lex [DecidableEq α] (lt : α → α → Bool) :
+    lex l₁ l₂ lt = decide (Lex (fun x y => lt x y) l₁ l₂) := by
+  induction l₁ generalizing l₂ with
+  | nil =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b bs => simp [lex]
+  | cons a l₁ ih =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b bs =>
+      simp [lex, ih, cons_lex_cons_iff, Bool.beq_eq_decide_eq]
+
+/-- Variant of `lex_eq_true_iff` using an arbitrary comparator. -/
+@[simp] theorem lex_eq_true_iff_lex [DecidableEq α] (lt : α → α → Bool) :
+    lex l₁ l₂ lt = true ↔ Lex (fun x y => lt x y) l₁ l₂ := by
+  simp [lex_eq_decide_lex]
+
+/-- Variant of `lex_eq_false_iff` using an arbitrary comparator. -/
+@[simp] theorem lex_eq_false_iff_not_lex [DecidableEq α] (lt : α → α → Bool) :
+    lex l₁ l₂ lt = false ↔ ¬ Lex (fun x y => lt x y) l₁ l₂ := by
+  simp [Bool.eq_false_iff, lex_eq_true_iff_lex]
+
+@[simp] theorem lex_eq_true_iff_lt [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : List α} : lex l₁ l₂ = true ↔ l₁ < l₂ := by
+  simp only [lex_eq_true_iff_lex, decide_eq_true_eq]
+  exact Iff.rfl
+
+@[simp] theorem lex_eq_false_iff_ge [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : List α} : lex l₁ l₂ = false ↔ l₂ ≤ l₁ := by
+  simp only [lex_eq_false_iff_not_lex, decide_eq_true_eq]
+  exact Iff.rfl
+
+attribute [local simp] Nat.add_one_lt_add_one_iff in
+/--
+`l₁` is lexicographically less than `l₂` if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length`,
+  and `l₁` is shorter than `l₂` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₁[i] < l₂[i]`
+-/
+theorem lex_eq_true_iff_exists [BEq α] (lt : α → α → Bool) :
+    lex l₁ l₂ lt = true ↔
+      (l₁.isEqv (l₂.take l₁.length) (· == ·) ∧ l₁.length < l₂.length) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₁[i] l₂[i]) := by
+  induction l₁ generalizing l₂ with
+  | nil =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b bs => simp [lex]
+  | cons a l₁ ih =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b l₂ =>
+      simp [lex_cons_cons, Bool.or_eq_true, Bool.and_eq_true, ih, isEqv, length_cons]
+      constructor
+      · rintro (hab | ⟨hab, ⟨h₁, h₂⟩ | ⟨i, h₁, h₂, w₁, w₂⟩⟩)
+        · exact .inr ⟨0, by simp [hab]⟩
+        · exact .inl ⟨⟨hab, h₁⟩, by simpa using h₂⟩
+        · refine .inr ⟨i + 1, by simp [h₁],
+            by simp [h₂], ?_, ?_⟩
+          · intro j hj
+            cases j with
+            | zero => simp [hab]
+            | succ j =>
+              simp only [getElem_cons_succ]
+              rw [w₁]
+              simpa using hj
+          · simpa using w₂
+      · rintro (⟨⟨h₁, h₂⟩, h₃⟩ | ⟨i, h₁, h₂, w₁, w₂⟩)
+        · exact .inr ⟨h₁, .inl ⟨h₂, by simpa using h₃⟩⟩
+        · cases i with
+          | zero =>
+            left
+            simpa using w₂
+          | succ i =>
+            right
+            refine ⟨by simpa using w₁ 0 (by simp), ?_⟩
+            right
+            refine ⟨i, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
+            · intro j hj
+              simpa using w₁ (j + 1) (by simpa)
+            · simpa using w₂
+
+attribute [local simp] Nat.add_one_lt_add_one_iff in
+/--
+`l₁` is *not* lexicographically less than `l₂`
+(which you might think of as "`l₂` is lexicographically greater than or equal to `l₁`"") if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₂[i] < l₁[i]`
+
+This formulation requires that `==` and `lt` are compatible in the following senses:
+- `==` is symmetric
+  (we unnecessarily further assume it is transitive, to make use of the existing typeclasses)
+- `lt` is irreflexive with respect to `==` (i.e. if `x == y` then `lt x y = false`
+- `lt` is asymmmetric  (i.e. `lt x y = true → lt y x = false`)
+- `lt` is antisymmetric with respect to `==` (i.e. `lt x y = false → lt y x = false → x == y`)
+-/
+theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : α → α → Bool)
+    (lt_irrefl : ∀ x y, x == y → lt x y = false)
+    (lt_asymm : ∀ x y, lt x y = true → lt y x = false)
+    (lt_antisymm : ∀ x y, lt x y = false → lt y x = false → x == y) :
+    lex l₁ l₂ lt = false ↔
+      (l₂.isEqv (l₁.take l₂.length) (· == ·)) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) ∧ lt l₂[i] l₁[i]) := by
+  induction l₁ generalizing l₂ with
+  | nil =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b bs => simp [lex]
+  | cons a l₁ ih =>
+    cases l₂ with
+    | nil => simp [lex]
+    | cons b l₂ =>
+      simp [lex_cons_cons, Bool.or_eq_false_iff, Bool.and_eq_false_imp, ih, isEqv,
+        Bool.and_eq_true, length_cons]
+      constructor
+      · rintro ⟨hab, h⟩
+        if eq : b == a then
+          specialize h (BEq.symm eq)
+          obtain (h | ⟨i, h₁, h₂, w₁, w₂⟩) := h
+          · exact .inl ⟨eq, h⟩
+          · refine .inr ⟨i + 1, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
+            · intro j hj
+              cases j with
+              | zero => simpa using BEq.symm eq
+              | succ j =>
+                simp only [getElem_cons_succ]
+                rw [w₁]
+                simpa using hj
+            · simpa using w₂
+        else
+          right
+          have hba : lt b a :=
+            Decidable.byContradiction fun hba => eq (lt_antisymm _ _ (by simpa using hba) hab)
+          exact ⟨0, by simp, by simp, by simpa⟩
+      · rintro (⟨eq, h⟩ | ⟨i, h₁, h₂, w₁, w₂⟩)
+        · exact ⟨lt_irrefl _ _ (BEq.symm eq), fun _ => .inl h⟩
+        · cases i with
+          | zero =>
+            simp at w₂
+            refine ⟨lt_asymm _ _ w₂, ?_⟩
+            intro eq
+            exfalso
+            simp [lt_irrefl _ _ (BEq.symm eq)] at w₂
+          | succ i =>
+            refine ⟨lt_irrefl _ _ (by simpa using w₁ 0 (by simp)), ?_⟩
+            refine fun _ => .inr ⟨i, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
+            · intro j hj
+              simpa using w₁ (j + 1) (by simpa)
+            · simpa using w₂
+
+protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : List α} :
+    l₁ < l₂ ↔
+      (l₁ = l₂.take l₁.length ∧ l₁.length < l₂.length) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) ∧ l₁[i] < l₂[i]) := by
+  rw [← lex_eq_true_iff_lt, lex_eq_true_iff_exists]
+  simp
+
+protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)] {l₁ l₂ : List α} :
+    l₁ ≤ l₂ ↔
+      (l₁ = l₂.take l₁.length) ∨
+        (∃ (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
+          (∀ j, (hj : j < i) →
+            l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) ∧ l₁[i] < l₂[i]) := by
+  rw [← lex_eq_false_iff_ge, lex_eq_false_iff_exists]
+  · simp only [isEqv_eq, beq_iff_eq, decide_eq_true_eq]
+    simp only [eq_comm]
+    conv => lhs; simp +singlePass [exists_comm]
+  · simpa using Std.Irrefl.irrefl
+  · simpa using Std.Asymm.asymm
+  · simpa using Std.Antisymm.antisymm
+
+theorem append_left_lt [LT α] {l₁ l₂ l₃ : List α} (h : l₂ < l₃) :
+    l₁ ++ l₂ < l₁ ++ l₃ := by
+  induction l₁ with
+  | nil => simp [h]
+  | cons a l₁ ih => simp [cons_lt_cons_iff, ih]
+
+theorem append_left_le [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    {l₁ l₂ l₃ : List α} (h : l₂ ≤ l₃) :
+    l₁ ++ l₂ ≤ l₁ ++ l₃ := by
+  induction l₁ with
+  | nil => simp [h]
+  | cons a l₁ ih => simp [cons_le_cons_iff, ih]
+
+theorem le_append_left [LT α] [Std.Irrefl (· < · : α → α → Prop)]
+    {l₁ l₂ : List α} : l₁ ≤ l₁ ++ l₂ := by
+  intro h
+  match l₁, h with
+  | nil, h => simp at h
+  | cons a l₁, h => exact le_append_left (by simpa using h)
+
+theorem IsPrefix.le [LT α] [Std.Irrefl (· < · : α → α → Prop)]
+    {l₁ l₂ : List α} (h : l₁ <+: l₂) : l₁ ≤ l₂ := by
+  rcases h with ⟨_, rfl⟩
+  apply le_append_left
+
+protected theorem map_lt [LT α] [LT β]
+    {l₁ l₂ : List α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ < l₂) :
+    map f l₁ < map f l₂ := by
+  match l₁, l₂, h with
+  | nil, nil, h => simp at h
+  | nil, cons b l₂, h => simp
+  | cons a l₁, nil, h => simp at h
+  | cons a l₁, cons _ l₂, .cons h =>
+    simp [cons_lt_cons_iff, List.map_lt w (by simpa using h)]
+  | cons a l₁, cons b l₂, .rel h =>
+    simp [cons_lt_cons_iff, w, h]
+
+protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Irrefl (· < · : β → β → Prop)]
+    [Std.Asymm (· < · : β → β → Prop)]
+    [Std.Antisymm (¬ · < · : β → β → Prop)]
+    {l₁ l₂ : List α} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ ≤ l₂) :
+    map f l₁ ≤ map f l₂ := by
+  rw [List.le_iff_exists] at h ⊢
+  obtain (h | ⟨i, h₁, h₂, w₁, w₂⟩) := h
+  · left
+    rw [h]
+    simp
+  · right
+    refine ⟨i, by simpa using h₁, by simpa using h₂, ?_, ?_⟩
+    · simp +contextual [w₁]
+    · simpa using w _ _ w₂
+
+end List

src/Init/Data/List/Monadic.lean

@@ -124,7 +124,8 @@ theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β
 
 /-! ### forM -/
 
--- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
+-- We currently use `List.forM` as the simp normal form, rather that `ForM.forM`.
+-- (This should probably be revisited.)
 -- As such we need to replace `List.forM_nil` and `List.forM_cons`:
 
 @[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
@@ -137,6 +138,10 @@ theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β
     (l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
   induction l₁ <;> simp [*]
 
+@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : List α) (g : α → β) (f : β → m PUnit) :
+    (l.map g).forM f = l.forM (fun a => f (g a)) := by
+  induction l <;> simp [*]
+
 /-! ### forIn' -/
 
 theorem forIn'_loop_congr [Monad m] {as bs : List α}
@@ -259,6 +264,11 @@ theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   generalize l.attach = l'
   induction l' generalizing init <;> simp_all
 
+@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
+    (l : List α) (g : α → β) (f : (b : β) → b ∈ l.map g → γ → m (ForInStep γ)) :
+    forIn' (l.map g) init f = forIn' l init fun a h y => f (g a) (mem_map_of_mem g h) y := by
+  induction l generalizing init <;> simp_all
+
 /--
 We can express a for loop over a list as a fold,
 in which whenever we reach `.done b` we keep that value through the rest of the fold.
@@ -307,6 +317,11 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   simp only [forIn_eq_foldlM]
   induction l generalizing init <;> simp_all
 
+@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
+    (l : List α) (g : α → β) (f : β → γ → m (ForInStep γ)) :
+    forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
+  induction l generalizing init <;> simp_all
+
 /-! ### allM -/
 
 theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : List α) :

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/Range.lean

@@ -84,11 +84,15 @@ theorem head?_range' (n : Nat) : (range' s n).head? = if n = 0 then none else so
 @[simp] theorem head_range' (n : Nat) (h) : (range' s n).head h = s := by
   repeat simp_all [head?_range', head_eq_iff_head?_eq_some]
 
-@[simp]
 theorem map_add_range' (a) : ∀ s n step, map (a + ·) (range' s n step) = range' (a + s) n step
   | _, 0, _ => rfl
   | s, n + 1, step => by simp [range', map_add_range' _ (s + step) n step, Nat.add_assoc]
 
+theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1) := by
+  apply ext_getElem
+  · simp
+  · simp [Nat.add_right_comm]
+
 theorem range'_append : ∀ s m n step : Nat,
     range' s m step ++ range' (s + step * m) n step = range' s (n + m) step
   | _, 0, _, _ => rfl

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/List/ToArray.lean

@@ -7,7 +7,7 @@ prelude
 import Init.Data.List.Impl
 import Init.Data.List.Nat.Erase
 import Init.Data.List.Monadic
-import Init.Data.Array.Lex
+import Init.Data.Array.Lex.Basic
 
 /-! ### Lemmas about `List.toArray`.
 
@@ -29,6 +29,11 @@ theorem toArray_inj {a b : List α} (h : a.toArray = b.toArray) : a = b := by
     (a.toArrayAux b).size = b.size + a.length := by
   simp [size]
 
+-- This is not a `@[simp]` lemma because it is pushing `toArray` inwards.
+theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArray := by
+  apply ext'
+  simp
+
 @[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
   apply ext'
   simp
@@ -41,7 +46,7 @@ theorem toArray_inj {a b : List α} (h : a.toArray = b.toArray) : a = b := by
 @[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
   cases l <;> simp [Array.isEmpty]
 
-@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
+@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
 
 @[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
   simp only [back!, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
@@ -112,6 +117,18 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
   subst h
   rw [foldlM_toList]
 
+/-- Variant of `forM_toArray` with a side condition for the `stop` argument. -/
+@[simp] theorem forM_toArray' [Monad m] (l : List α) (f : α → m PUnit) (h : stop = l.toArray.size) :
+    (l.toArray.forM f 0 stop) = l.forM f := by
+  subst h
+  rw [Array.forM]
+  simp only [size_toArray, foldlM_toArray']
+  induction l <;> simp_all
+
+theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
+    (l.toArray.forM f) = l.forM f := by
+  simp
+
 /-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
 @[simp] theorem foldr_toArray' (f : α → β → β) (init : β) (l : List α)
     (h : start = l.toArray.size) :

src/Init/Data/List/Zip.lean

@@ -259,7 +259,7 @@ theorem zip_map (f : α → γ) (g : β → δ) :
   | [], _ => rfl
   | _, [] => by simp only [map, zip_nil_right]
   | _ :: _, _ :: _ => by
-    simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
+    simp only [map, zip_cons_cons, zip_map, Prod.map]; try constructor -- TODO: remove try constructor after update stage0
 
 theorem zip_map_left (f : α → γ) (l₁ : List α) (l₂ : List β) :
     zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]

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

@@ -26,11 +26,11 @@ theorem div_le_iff_le_mul (h : 0 < k) : x / k ≤ y ↔ x ≤ y * k + k - 1 := b
   omega
 
 -- TODO: reprove `div_eq_of_lt_le` in terms of this:
-theorem div_eq_iff (h : 0 < k) : x / k = y ↔ x ≤ y * k + k - 1 ∧ y * k ≤ x := by
+protected theorem div_eq_iff (h : 0 < k) : x / k = y ↔ x ≤ y * k + k - 1 ∧ y * k ≤ x := by
   rw [Nat.eq_iff_le_and_ge, le_div_iff_mul_le h, Nat.div_le_iff_le_mul h]
 
 theorem lt_of_div_eq_zero (h : 0 < k) (h' : x / k = 0) : x < k := by
-  rw [div_eq_iff h] at h'
+  rw [Nat.div_eq_iff h] at h'
   omega
 
 theorem div_eq_zero_iff_lt (h : 0 < k) : x / k = 0 ↔ x < k :=
@@ -49,4 +49,17 @@ theorem lt_div_mul_self (h : 0 < k) (w : k ≤ x) : x - k < x / k * k := by
   have : x % k < k := mod_lt x h
   omega
 
+theorem div_pos (hba : b ≤ a) (hb : 0 < b) : 0 < a / b := by
+  cases b
+  · contradiction
+  · simp [Nat.pos_iff_ne_zero, div_eq_zero_iff_lt, hba]
+
+theorem div_le_div_left (hcb : c ≤ b) (hc : 0 < c) : a / b ≤ a / c :=
+  (Nat.le_div_iff_mul_le hc).2 <|
+    Nat.le_trans (Nat.mul_le_mul_left _ hcb) (Nat.div_mul_le_self a b)
+
+theorem div_add_le_right {z : Nat} (h : 0 < z) (x y : Nat) :
+    x / (y + z) ≤ x / z :=
+  div_le_div_left (Nat.le_add_left z y) h
+
 end Nat

src/Init/Data/Option/Monadic.lean

@@ -10,7 +10,17 @@ import Init.Control.Lawful.Basic
 
 namespace Option
 
-@[congr] theorem forIn'_congr [Monad m] [LawfulMonad m]{as bs : Option α} (w : as = bs)
+@[simp] theorem forM_none [Monad m] (f : α → m PUnit) :
+    none.forM f = pure .unit := rfl
+
+@[simp] theorem forM_some [Monad m] (f : α → m PUnit) (a : α) :
+    (some a).forM f = f a := rfl
+
+@[simp] theorem forM_map [Monad m] [LawfulMonad m] (o : Option α) (g : α → β) (f : β → m PUnit) :
+    (o.map g).forM f = o.forM (fun a => f (g a)) := by
+  cases o <;> simp
+
+@[congr] theorem forIn'_congr [Monad m] [LawfulMonad m] {as bs : Option α} (w : as = bs)
     {b b' : β} (hb : b = b')
     {f : (a' : α) → a' ∈ as → β → m (ForInStep β)}
     {g : (a' : α) → a' ∈ bs → β → m (ForInStep β)}
@@ -48,6 +58,11 @@ theorem forIn'_pure_yield_eq_pelim [Monad m] [LawfulMonad m]
       o.pelim b (fun a h => f a h b) := by
   cases o <;> simp
 
+@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
+    (o : Option α) (g : α → β) (f : (b : β) → b ∈ o.map g → γ → m (ForInStep γ)) :
+    forIn' (o.map g) init f = forIn' o init fun a h y => f (g a) (mem_map_of_mem g h) y := by
+  cases o <;> simp
+
 theorem forIn_eq_elim [Monad m] [LawfulMonad m]
     (o : Option α) (f : (a : α) → β → m (ForInStep β)) (b : β) :
     forIn o b f =
@@ -72,4 +87,9 @@ theorem forIn_pure_yield_eq_elim [Monad m] [LawfulMonad m]
       o.elim b (fun a => f a b) := by
   cases o <;> simp
 
+@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
+    (o : Option α) (g : α → β) (f : β → γ → m (ForInStep γ)) :
+    forIn (o.map g) init f = forIn o init fun a y => f (g a) y := by
+  cases o <;> simp
+
 end Option

src/Init/Data/Range/Basic.lean

@@ -23,7 +23,7 @@ namespace Range
 universe u v
 
 /-- The number of elements in the range. -/
-def size (r : Range) : Nat := (r.stop - r.start + r.step - 1) / r.step
+@[simp] def size (r : Range) : Nat := (r.stop - r.start + r.step - 1) / r.step
 
 @[inline] protected def forIn' [Monad m] (range : Range) (init : β)
     (f : (i : Nat) → i ∈ range → β → m (ForInStep β)) : m β :=

src/Init/Data/Range/Lemmas.lean

@@ -70,7 +70,7 @@ private theorem forIn'_loop_eq_forIn'_range' [Monad m] (r : Std.Range)
       rw [Nat.div_eq_iff] <;> omega
     simp [this]
 
-theorem forIn'_eq_forIn'_range' [Monad m] (r : Std.Range)
+@[simp] theorem forIn'_eq_forIn'_range' [Monad m] (r : Std.Range)
     (init : β) (f : (a : Nat) → a ∈ r → β → m (ForInStep β)) :
     forIn' r init f =
       forIn' (List.range' r.start r.size r.step) init (fun a h => f a (mem_of_mem_range' h)) := by
@@ -78,7 +78,7 @@ theorem forIn'_eq_forIn'_range' [Monad m] (r : Std.Range)
   simp only [size]
   rw [forIn'_loop_eq_forIn'_range']
 
-theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range)
+@[simp] theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range)
     (init : β) (f : Nat → β → m (ForInStep β)) :
     forIn r init f = forIn (List.range' r.start r.size r.step) init f := by
   simp only [forIn, forIn'_eq_forIn'_range']
@@ -96,7 +96,7 @@ private theorem forM_loop_eq_forM_range' [Monad m] (r : Std.Range) (f : Nat →
       rw [Nat.div_eq_iff] <;> omega
     simp [this]
 
-theorem forM_eq_forM_range' [Monad m] (r : Std.Range) (f : Nat → m PUnit) :
+@[simp] theorem forM_eq_forM_range' [Monad m] (r : Std.Range) (f : Nat → m PUnit) :
     forM r f = forM (List.range' r.start r.size r.step) f := by
   simp only [forM, Range.forM, forM_loop_eq_forM_range', size]
 

src/Init/Data/String/Lemmas.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Data.Char.Lemmas
+import Init.Data.List.Lex
 
 namespace String
 
@@ -22,7 +23,7 @@ attribute [local instance] Char.notLTTrans Char.notLTAntisymm Char.notLTTotal
 
 protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
 protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
-protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total
+protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
 protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.data) (bs := b.data) h₁ h₂)
 protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
 protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by

src/Init/Data/UInt/Basic.lean

@@ -159,6 +159,8 @@ def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
 def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.toBitVec <<< (mod b 32).toBitVec⟩
 @[extern "lean_uint32_shift_right"]
 def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
+def UInt32.lt (a b : UInt32) : Prop := a.toBitVec < b.toBitVec
+def UInt32.le (a b : UInt32) : Prop := a.toBitVec ≤ b.toBitVec
 
 instance : Add UInt32       := ⟨UInt32.add⟩
 instance : Sub UInt32       := ⟨UInt32.sub⟩
@@ -169,6 +171,8 @@ set_option linter.deprecated false in
 instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
 
 instance : Div UInt32       := ⟨UInt32.div⟩
+instance : LT UInt32        := ⟨UInt32.lt⟩
+instance : LE UInt32        := ⟨UInt32.le⟩
 
 @[extern "lean_uint32_complement"]
 def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩

src/Init/Data/Vector/Basic.lean

@@ -103,7 +103,7 @@ of bounds.
 @[inline] def head [NeZero n] (v : Vector α n) := v[0]'(Nat.pos_of_neZero n)
 
 /-- Push an element `x` to the end of a vector. -/
-@[inline] def push (x : α) (v : Vector α n)  : Vector α (n + 1) :=
+@[inline] def push (v : Vector α n) (x : α) : Vector α (n + 1) :=
   ⟨v.toArray.push x, by simp⟩
 
 /-- Remove the last element of a vector. -/
@@ -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⟩
@@ -287,12 +299,6 @@ no element of the index matches the given value.
 instance instLT [LT α] : LT (Vector α n) := ⟨fun v w => v.toArray < w.toArray⟩
 instance instLE [LT α] : LE (Vector α n) := ⟨fun v w => v.toArray ≤ w.toArray⟩
 
-instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLT (Vector α n) :=
-  inferInstanceAs <| DecidableRel fun (v w : Vector α n) => v.toArray < w.toArray
-
-instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLE (Vector α n) :=
-  inferInstanceAs <| DecidableRel fun (v w : Vector α n) => v.toArray ≤ w.toArray
-
 /--
 Lexicographic comparator for vectors.
 

src/Init/Data/Vector/Lemmas.lean

@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2024 Shreyas Srinivas. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Shreyas Srinivas, Francois Dorais
+Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
 -/
 prelude
 import Init.Data.Vector.Basic
@@ -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
 
@@ -141,6 +153,14 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
 @[simp] theorem all_mk (p : α → Bool) (a : Array α) (h : a.size = n) :
     (Vector.mk a h).all p = a.all p := rfl
 
+@[simp] theorem eq_mk : v = Vector.mk a h ↔ v.toArray = a := by
+  cases v
+  simp
+
+@[simp] theorem mk_eq : Vector.mk a h = v ↔ a = v.toArray := by
+  cases v
+  simp
+
 /-! ### toArray lemmas -/
 
 @[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) :
@@ -247,7 +267,7 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
 
 @[simp] theorem toArray_mkVector : (mkVector n a).toArray = mkArray n a := rfl
 
-theorem toArray_inj {v w : Vector α n} : v.toArray = w.toArray ↔ v = w := by
+@[simp] theorem toArray_inj {v w : Vector α n} : v.toArray = w.toArray ↔ v = w := by
   cases v
   cases w
   simp
@@ -1016,11 +1036,19 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
       · rintro ⟨a, ha⟩
         simpa using Array.isEqv_self_beq ..
 
-/-! Content below this point has not yet been aligned with `List` and `Array`. -/
+/-! ### isEqv -/
 
-@[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]
+@[simp] theorem isEqv_eq [DecidableEq α] {l₁ l₂ : Vector α n} : l₁.isEqv l₂ (· == ·) = (l₁ = l₂) := by
+  cases l₁
+  cases l₂
+  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
 
 /-- The empty vector maps to the empty vector. -/
 @[simp]
@@ -1028,6 +1056,123 @@ theorem map_empty (f : α → β) : map f #v[] = #v[] := by
   rw [map, mk.injEq]
   exact Array.map_empty f
 
+@[simp] theorem map_push {f : α → β} {as : Vector α n} {x : α} :
+    (as.push x).map f = (as.map f).push (f x) := by
+  cases as
+  simp
+
+@[simp] theorem map_id_fun : map (n := n) (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 (n := n) (fun (a : α) => a) = id := map_id_fun
+
+-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
+theorem map_id (l : Vector α n) : 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 : Vector α n) : 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 : Vector α n) : map f l = l := by
+  simp [show f = id from funext h]
+
+theorem map_singleton (f : α → β) (a : α) : map f #v[a] = #v[f a] := rfl
+
+@[simp] theorem mem_map {f : α → β} {l : Vector α n} : b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b := by
+  cases l
+  simp
+
+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 : Vector α n} {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 [NeZero n] : map (n := n) f = map g ↔ f = g := by
+  constructor
+  · intro h
+    ext a
+    replace h := congrFun h (mkVector n a)
+    simp only [mkVector, map_mk, mk.injEq, Array.map_inj_left, Array.mem_mkArray,  and_imp,
+      forall_eq_apply_imp_iff] at h
+    exact h (NeZero.ne n)
+  · intro h; subst h; rfl
+
+theorem map_eq_push_iff {f : α → β} {l : Vector α (n + 1)} {l₂ : Vector β n} {b : β} :
+    map f l = l₂.push b ↔ ∃ l₁ a, l = l₁.push a ∧ map f l₁ = l₂ ∧ f a = b := by
+  rcases l with ⟨l, h⟩
+  rcases l₂ with ⟨l₂, rfl⟩
+  simp only [map_mk, push_mk, mk.injEq, Array.map_eq_push_iff]
+  constructor
+  · rintro ⟨l₁, a, rfl, rfl, rfl⟩
+    refine ⟨⟨l₁, by simp⟩, a, by simp⟩
+  · rintro ⟨l₁, a, h₁, h₂, rfl⟩
+    refine ⟨l₁.toArray, a, by simp_all⟩
+
+@[simp] theorem map_eq_singleton_iff {f : α → β} {l : Vector α 1} {b : β} :
+    map f l = #v[b] ↔ ∃ a, l = #v[a] ∧ f a = b := by
+  cases l
+  simp
+
+theorem map_eq_map_iff {f g : α → β} {l : Vector α n} :
+    map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
+  cases l <;> simp_all
+
+theorem map_eq_iff {f : α → β} {l : Vector α n} {l' : Vector β n} :
+    map f l = l' ↔ ∀ i (h : i < n), l'[i] = f l[i] := by
+  rcases l with ⟨l, rfl⟩
+  rcases l' with ⟨l', h'⟩
+  simp only [map_mk, eq_mk, Array.map_eq_iff, getElem_mk]
+  constructor
+  · intro w i h
+    simpa [h, h'] using w i
+  · intro w i
+    if h : i < l.size then
+      simpa [h, h'] using w i h
+    else
+      rw [getElem?_neg, getElem?_neg, Option.map_none'] <;> omega
+
+@[simp] theorem map_set {f : α → β} {l : Vector α n} {i : Nat} {h : i < n} {a : α} :
+    (l.set i a).map f = (l.map f).set i (f a) (by simpa using h) := by
+  cases l
+  simp
+
+@[simp] theorem map_setIfInBounds {f : α → β} {l : Vector α n} {i : Nat} {a : α} :
+    (l.setIfInBounds i a).map f = (l.map f).setIfInBounds i (f a) := by
+  cases l
+  simp
+
+@[simp] theorem map_pop {f : α → β} {l : Vector α n} : l.pop.map f = (l.map f).pop := by
+  cases l
+  simp
+
+@[simp] theorem back?_map {f : α → β} {l : Vector α n} : (l.map f).back? = l.back?.map f := by
+  cases l
+  simp
+
+@[simp] theorem map_map {f : α → β} {g : β → γ} {as : Vector α n} :
+    (as.map f).map g = as.map (g ∘ f) := by
+  cases as
+  simp
+
+/-! Content below this point has not yet been aligned with `List` and `Array`. -/
+
+@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
+    (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
+  simp [ofFn]
+
 @[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
   rcases v with ⟨data, rfl⟩
   simp
@@ -1081,13 +1226,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)
@@ -1096,6 +1234,43 @@ 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
+  rcases a with ⟨a, rfl⟩
+  simp
+
 /-! ### swap -/
 
 theorem getElem_swap (a : Vector α n) (i j : Nat) {hi hj} (k : Nat) (hk : k < n) :

src/Init/Data/Vector/Lex.lean

@@ -0,0 +1,254 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+prelude
+import Init.Data.Vector.Basic
+import Init.Data.Vector.Lemmas
+import Init.Data.Array.Lex.Lemmas
+
+namespace Vector
+
+
+/-! ### Lexicographic ordering -/
+
+@[simp] theorem lt_toArray [LT α] (l₁ l₂ : Vector α n) : l₁.toArray < l₂.toArray ↔ l₁ < l₂ := Iff.rfl
+@[simp] theorem le_toArray [LT α] (l₁ l₂ : Vector α n) : l₁.toArray ≤ l₂.toArray ↔ l₁ ≤ l₂ := Iff.rfl
+
+@[simp] theorem lt_toList [LT α] (l₁ l₂ : Vector α n) : l₁.toList < l₂.toList ↔ l₁ < l₂ := Iff.rfl
+@[simp] theorem le_toList [LT α] (l₁ l₂ : Vector α n) : l₁.toList ≤ l₂.toList ↔ l₁ ≤ l₂ := Iff.rfl
+
+protected theorem not_lt_iff_ge [LT α] (l₁ l₂ : Vector α n) : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : Vector α n) :
+    ¬ l₁ ≤ l₂ ↔ l₂ < l₁ :=
+  Decidable.not_not
+
+@[simp] theorem mk_lt_mk [LT α] :
+    Vector.mk (α := α) (n := n) data₁ size₁ < Vector.mk data₂ size₂ ↔ data₁ < data₂ := Iff.rfl
+
+@[simp] theorem mk_le_mk [LT α] :
+    Vector.mk (α := α) (n := n) data₁ size₁ ≤ Vector.mk data₂ size₂ ↔ data₁ ≤ data₂ := Iff.rfl
+
+@[simp] theorem mk_lex_mk [BEq α] (lt : α → α → Bool) {l₁ l₂ : Array α} {n₁ : l₁.size = n} {n₂ : l₂.size = n} :
+    (Vector.mk l₁ n₁).lex (Vector.mk l₂ n₂) lt = l₁.lex l₂ lt := by
+  simp [Vector.lex, Array.lex, n₁, n₂]
+  rfl
+
+@[simp] theorem lex_toArray [BEq α] (lt : α → α → Bool) (l₁ l₂ : Vector α n) :
+    l₁.toArray.lex l₂.toArray lt = l₁.lex l₂ lt := by
+  cases l₁
+  cases l₂
+  simp
+
+@[simp] theorem lex_toList [BEq α] (lt : α → α → Bool) (l₁ l₂ : Vector α n) :
+    l₁.toList.lex l₂.toList lt = l₁.lex l₂ lt := by
+  rcases l₁ with ⟨⟨l₁⟩, n₁⟩
+  rcases l₂ with ⟨⟨l₂⟩, n₂⟩
+  simp
+
+@[simp] theorem lex_empty
+    [BEq α] {lt : α → α → Bool} (l₁ : Vector α 0) : l₁.lex #v[] lt = false := by
+  cases l₁
+  simp_all
+
+@[simp] theorem singleton_lex_singleton [BEq α] {lt : α → α → Bool} : #v[a].lex #v[b] lt = lt a b := by
+  simp only [lex, getElem_mk, List.getElem_toArray, List.getElem_singleton]
+  cases lt a b <;> cases a != b <;> simp [Id.run]
+
+protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] (l : Vector α n) : ¬ l < l :=
+  Array.lt_irrefl l.toArray
+
+instance ltIrrefl [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Irrefl (α := Vector α n) (· < ·) where
+  irrefl := Vector.lt_irrefl
+
+@[simp] theorem not_lt_empty [LT α] (l : Vector α 0) : ¬ l < #v[] := Array.not_lt_empty l.toArray
+@[simp] theorem empty_le [LT α] (l : Vector α 0) : #v[] ≤ l := Array.empty_le l.toArray
+
+@[simp] theorem le_empty [LT α] (l : Vector α 0) : l ≤ #v[] ↔ l = #v[] := by
+  cases l
+  simp
+
+protected theorem le_refl [LT α] [i₀ : Std.Irrefl (· < · : α → α → Prop)] (l : Vector α n) : l ≤ l :=
+  Array.le_refl l.toArray
+
+instance [LT α] [Std.Irrefl (· < · : α → α → Prop)] : Std.Refl (· ≤ · : Vector α n → Vector α n → Prop) where
+  refl := Vector.le_refl
+
+protected theorem lt_trans [LT α]
+    [i₁ : Trans (· < · : α → α → Prop) (· < ·) (· < ·)]
+    {l₁ l₂ l₃ : Vector α n} (h₁ : l₁ < l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
+  Array.lt_trans h₁ h₂
+
+instance [LT α]
+    [Trans (· < · : α → α → Prop) (· < ·) (· < ·)] :
+    Trans (· < · : Vector α n → Vector α n → Prop) (· < ·) (· < ·) where
+  trans h₁ h₂ := Vector.lt_trans h₁ h₂
+
+protected theorem lt_of_le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i₀ : Std.Irrefl (· < · : α → α → Prop)]
+    [i₁ : Std.Asymm (· < · : α → α → Prop)]
+    [i₂ : Std.Antisymm (¬ · < · : α → α → Prop)]
+    [i₃ : Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : Vector α n} (h₁ : l₁ ≤ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
+  Array.lt_of_le_of_lt h₁ h₂
+
+protected theorem le_trans [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)]
+    {l₁ l₂ l₃ : Vector α n} (h₁ : l₁ ≤ l₂) (h₂ : l₂ ≤ l₃) : l₁ ≤ l₃ :=
+  fun h₃ => h₁ (Vector.lt_of_le_of_lt h₂ h₃)
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Trans (¬ · < · : α → α → Prop) (¬ · < ·) (¬ · < ·)] :
+    Trans (· ≤ · : Vector α n → Vector α n → Prop) (· ≤ ·) (· ≤ ·) where
+  trans h₁ h₂ := Vector.le_trans h₁ h₂
+
+protected theorem lt_asymm [LT α]
+    [i : Std.Asymm (· < · : α → α → Prop)]
+    {l₁ l₂ : Vector α n} (h : l₁ < l₂) : ¬ l₂ < l₁ := Array.lt_asymm h
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Asymm (· < · : α → α → Prop)] :
+    Std.Asymm (· < · : Vector α n → Vector α n → Prop) where
+  asymm _ _ := Vector.lt_asymm
+
+protected theorem le_total [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)] (l₁ l₂ : Vector α n) : l₁ ≤ l₂ ∨ l₂ ≤ l₁ :=
+  Array.le_total _ _
+
+instance [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Total (¬ · < · : α → α → Prop)] :
+    Std.Total (· ≤ · : Vector α n → Vector α n → Prop) where
+  total := Vector.le_total
+
+@[simp] protected theorem not_lt [LT α]
+    {l₁ l₂ : Vector α n} : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
+
+@[simp] protected theorem not_le [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Vector α n} : ¬ l₂ ≤ l₁ ↔ l₁ < l₂ := Decidable.not_not
+
+protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
+    [i : Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : Vector α n} (h : l₁ < l₂) : l₁ ≤ l₂ :=
+  Array.le_of_lt h
+
+protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Total (¬ · < · : α → α → Prop)]
+    {l₁ l₂ : Vector α n} : l₁ ≤ l₂ ↔ l₁ < l₂ ∨ l₁ = l₂ := by
+  simpa using Array.le_iff_lt_or_eq (l₁ := l₁.toArray) (l₂ := l₂.toArray)
+
+@[simp] theorem lex_eq_true_iff_lt [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Vector α n} : lex l₁ l₂ = true ↔ l₁ < l₂ := by
+  cases l₁
+  cases l₂
+  simp
+
+@[simp] theorem lex_eq_false_iff_ge [DecidableEq α] [LT α] [DecidableLT α]
+    {l₁ l₂ : Vector α n} : lex l₁ l₂ = false ↔ l₂ ≤ l₁ := by
+  cases l₁
+  cases l₂
+  simp [Array.not_lt_iff_ge]
+
+instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLT (Vector α n) :=
+  fun l₁ l₂ => decidable_of_iff (lex l₁ l₂ = true) lex_eq_true_iff_lt
+
+instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLE (Vector α n) :=
+  fun l₁ l₂ => decidable_of_iff (lex l₂ l₁ = false) lex_eq_false_iff_ge
+
+/--
+`l₁` is lexicographically less than `l₂` if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.size`,
+  and `l₁` is shorter than `l₂` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₁[i] < l₂[i]`
+-/
+theorem lex_eq_true_iff_exists [BEq α] (lt : α → α → Bool) {l₁ l₂ : Vector α n} :
+    lex l₁ l₂ lt = true ↔
+      (∃ (i : Nat) (h : i < n), (∀ j, (hj : j < i) → l₁[j] == l₂[j]) ∧ lt l₁[i] l₂[i]) := by
+  rcases l₁ with ⟨l₁, n₁⟩
+  rcases l₂ with ⟨l₂, n₂⟩
+  simp [Array.lex_eq_true_iff_exists, n₁, n₂]
+
+/--
+`l₁` is *not* lexicographically less than `l₂`
+(which you might think of as "`l₂` is lexicographically greater than or equal to `l₁`"") if either
+- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length` or
+- there exists an index `i` such that
+  - for all `j < i`, `l₁[j] == l₂[j]` and
+  - `l₂[i] < l₁[i]`
+
+This formulation requires that `==` and `lt` are compatible in the following senses:
+- `==` is symmetric
+  (we unnecessarily further assume it is transitive, to make use of the existing typeclasses)
+- `lt` is irreflexive with respect to `==` (i.e. if `x == y` then `lt x y = false`
+- `lt` is asymmmetric  (i.e. `lt x y = true → lt y x = false`)
+- `lt` is antisymmetric with respect to `==` (i.e. `lt x y = false → lt y x = false → x == y`)
+-/
+theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : α → α → Bool)
+    (lt_irrefl : ∀ x y, x == y → lt x y = false)
+    (lt_asymm : ∀ x y, lt x y = true → lt y x = false)
+    (lt_antisymm : ∀ x y, lt x y = false → lt y x = false → x == y)
+    {l₁ l₂ : Vector α n} :
+    lex l₁ l₂ lt = false ↔
+      (l₂.isEqv l₁ (· == ·)) ∨
+        (∃ (i : Nat) (h : i < n),(∀ j, (hj : j < i) → l₁[j] == l₂[j]) ∧ lt l₂[i] l₁[i]) := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, n₂⟩
+  simp_all [Array.lex_eq_false_iff_exists, n₂]
+
+protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Vector α n} :
+    l₁ < l₂ ↔
+      (∃ (i : Nat) (h : i < n), (∀ j, (hj : j < i) → l₁[j] = l₂[j]) ∧ l₁[i] < l₂[i]) := by
+  cases l₁
+  cases l₂
+  simp_all [Array.lt_iff_exists]
+
+protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)] {l₁ l₂ : Vector α n} :
+    l₁ ≤ l₂ ↔
+      (l₁ = l₂) ∨
+        (∃ (i : Nat) (h : i < n), (∀ j, (hj : j < i) → l₁[j] = l₂[j]) ∧ l₁[i] < l₂[i]) := by
+  rcases l₁ with ⟨l₁, rfl⟩
+  rcases l₂ with ⟨l₂, n₂⟩
+  simp [Array.le_iff_exists, ← n₂]
+
+theorem append_left_lt [LT α] {l₁ : Vector α n} {l₂ l₃ : Vector α m} (h : l₂ < l₃) :
+    l₁ ++ l₂ < l₁ ++ l₃ := by
+  simpa using Array.append_left_lt h
+
+theorem append_left_le [DecidableEq α] [LT α] [DecidableLT α]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    {l₁ : Vector α n} {l₂ l₃ : Vector α m} (h : l₂ ≤ l₃) :
+    l₁ ++ l₂ ≤ l₁ ++ l₃ := by
+  simpa using Array.append_left_le h
+
+protected theorem map_lt [LT α] [LT β]
+    {l₁ l₂ : Vector α n} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ < l₂) :
+    map f l₁ < map f l₂ := by
+  simpa using Array.map_lt w h
+
+protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
+    [Std.Irrefl (· < · : α → α → Prop)]
+    [Std.Asymm (· < · : α → α → Prop)]
+    [Std.Antisymm (¬ · < · : α → α → Prop)]
+    [Std.Irrefl (· < · : β → β → Prop)]
+    [Std.Asymm (· < · : β → β → Prop)]
+    [Std.Antisymm (¬ · < · : β → β → Prop)]
+    {l₁ l₂ : Vector α n} {f : α → β} (w : ∀ x y, x < y → f x < f y) (h : l₁ ≤ l₂) :
+    map f l₁ ≤ map f l₂ := by
+  simpa using Array.map_le w h
+
+end Vector

src/Init/Grind.lean

@@ -8,3 +8,6 @@ import Init.Grind.Norm
 import Init.Grind.Tactics
 import Init.Grind.Lemmas
 import Init.Grind.Cases
+import Init.Grind.Propagator
+import Init.Grind.Util
+import Init.Grind.Offset

src/Init/Grind/Lemmas.lean

@@ -5,10 +5,96 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Core
+import Init.SimpLemmas
+import Init.Classical
+import Init.ByCases
+import Init.Grind.Util
 
 namespace Lean.Grind
 
 theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' → q) : p → q :=
   fun hp => h (he.mp hp)
 
+/-! And -/
+
+theorem and_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a ∧ b) = b := by simp [h]
+theorem and_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a ∧ b) = a := by simp [h]
+theorem and_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a ∧ b) = False := by simp [h]
+theorem and_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∧ b) = False := by simp [h]
+
+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]
+theorem or_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a ∨ b) = True := by simp [h]
+theorem or_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a ∨ b) = b := by simp [h]
+theorem or_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∨ b) = a := by simp [h]
+
+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]
+theorem not_eq_of_eq_false {a : Prop} (h : a = False) : (Not a) = True := by simp [h]
+
+theorem eq_false_of_not_eq_true {a : Prop} (h : (Not a) = True) : a = False := by simp_all
+theorem eq_true_of_not_eq_false {a : Prop} (h : (Not a) = False) : a = True := by simp_all
+
+theorem false_of_not_eq_self {a : Prop} (h : (Not a) = a) : False := by
+  by_cases a <;> simp_all
+
+/-! Eq -/
+
+theorem eq_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a = b) = b := by simp [h]
+theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by simp [h]
+
+theorem eq_congr  {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
+theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
+
+/-! Forall -/
+
+theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = True) (h₂ : q (of_eq_true h₁) = q') : (∀ hp : p, q hp) = q' := by
+  apply propext; apply Iff.intro
+  · 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,8 +41,9 @@ 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
+theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
   by_cases p <;> by_cases q <;> simp [*]
 
 -- And
@@ -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/Offset.lean

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

src/Init/Grind/Propagator.lean

@@ -0,0 +1,27 @@
+/-
+Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Init.NotationExtra
+
+namespace Lean.Parser
+
+/-- A user-defined propagator for the `grind` tactic. -/
+-- TODO: not implemented yet
+syntax (docComment)? "grind_propagator " (Tactic.simpPre <|> Tactic.simpPost) ident " (" ident ")" " := " term : command
+
+/-- A builtin propagator for the `grind` tactic. -/
+syntax (docComment)? "builtin_grind_propagator " ident (Tactic.simpPre <|> Tactic.simpPost) ident " := " term : command
+
+/-- Auxiliary attribute for builtin `grind` propagators. -/
+syntax (name := grindPropagatorBuiltinAttr) "builtin_grind_propagator" (Tactic.simpPre <|> Tactic.simpPost) ident : attr
+
+macro_rules
+  | `($[$doc?:docComment]? builtin_grind_propagator $propagatorName:ident $direction $op:ident := $body) => do
+    let propagatorType := `Lean.Meta.Grind.Propagator
+    `($[$doc?:docComment]? def $propagatorName:ident : $(mkIdent propagatorType) := $body
+      attribute [builtin_grind_propagator $direction $op] $propagatorName)
+
+end Lean.Parser

src/Init/Grind/Tactics.lean

@@ -6,20 +6,56 @@ 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
+  /-- 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
   /--
-  When `eager` is true (default: `false`), `grind` eagerly splits `if-then-else` and `match`
-  expressions.
-  -/
-  eager : Bool := false
+  Maximum term generation.
+  The input goal terms have generation 0. When we instantiate a theorem using a term from generation `n`,
+  the new terms have generation `n+1`. Thus, this parameter limits the length of an instantiation chain. -/
+  gen : Nat := 5
+  /-- 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
+
+namespace Lean.Parser.Tactic
+
 /-!
 `grind` tactic and related tactics.
 -/
-end Lean.Grind
+
+-- TODO: parameters
+syntax (name := grind) "grind" optConfig ("on_failure " term)? : tactic
+
+end Lean.Parser.Tactic

src/Init/Grind/Util.lean

@@ -0,0 +1,34 @@
+/-
+Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Init.Core
+
+namespace Lean.Grind
+
+/-- A helper gadget for annotating nested proofs in goals. -/
+def nestedProof (p : Prop) (h : p) : p := h
+
+/--
+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
+
+end Lean.Grind

src/Init/Internal.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+prelude
+import Init.Internal.Order
+
+/-!
+This directory is used for components of the standard library that are either considered
+implementation details or not yet ready for public consumption, and that should be available
+without explicit import (in contrast to `Std.Internal`)
+-/

src/Init/Internal/Order.lean

@@ -0,0 +1,8 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+prelude
+import Init.Internal.Order.Basic
+import Init.Internal.Order.Tactic

src/Init/Internal/Order/Basic.lean

@@ -0,0 +1,693 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+prelude
+
+import Init.ByCases
+import Init.RCases
+
+/-!
+This module contains some basic definitions and results from domain theory, intended to be used as
+the underlying construction of the `partial_fixpoint` feature. It is not meant to be used as a
+general purpose library for domain theory, but can be of interest to users who want to extend
+the `partial_fixpoint` machinery (e.g. mark more functions as monotone or register more monads).
+
+This follows the corresponding
+[Isabelle development](https://isabelle.in.tum.de/library/HOL/HOL/Partial_Function.html), as also
+described in [Alexander Krauss: Recursive Definitions of Monadic Functions](https://www21.in.tum.de/~krauss/papers/mrec.pdf).
+-/
+
+universe u v w
+
+namespace Lean.Order
+
+/--
+A partial order is a reflexive, transitive and antisymmetric relation.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+class PartialOrder (α : Sort u) where
+  /--
+  A “less-or-equal-to” or “approximates” relation.
+
+  This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+  -/
+  rel : α → α → Prop
+  rel_refl : ∀ {x}, rel x x
+  rel_trans : ∀ {x y z}, rel x y → rel y z → rel x z
+  rel_antisymm : ∀ {x y}, rel x y → rel y x → x = y
+
+@[inherit_doc] scoped infix:50 " ⊑ " => PartialOrder.rel
+
+section PartialOrder
+
+variable {α  : Sort u} [PartialOrder α]
+
+theorem PartialOrder.rel_of_eq {x y : α} (h : x = y) : x ⊑ y := by cases h; apply rel_refl
+
+/--
+A chain is a totally ordered set (representing a set as a predicate).
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def chain (c : α → Prop) : Prop := ∀ x y , c x → c y → x ⊑ y ∨ y ⊑ x
+
+end PartialOrder
+
+section CCPO
+
+/--
+A chain-complete partial order (CCPO) is a partial order where every chain a least upper bound.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+class CCPO (α : Sort u) extends PartialOrder α where
+  /--
+  The least upper bound of a chain.
+
+  This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+  -/
+  csup : (α → Prop) → α
+  csup_spec {c : α → Prop} (hc : chain c) : csup c ⊑ x ↔ (∀ y, c y → y ⊑ x)
+
+open PartialOrder CCPO
+
+variable {α  : Sort u} [CCPO α]
+
+theorem csup_le {c : α → Prop} (hchain : chain c) : (∀ y, c y → y ⊑ x) → csup c ⊑ x :=
+  (csup_spec hchain).mpr
+
+theorem le_csup {c : α → Prop} (hchain : chain c) {y : α} (hy : c y) : y ⊑ csup c :=
+  (csup_spec hchain).mp rel_refl y hy
+
+/--
+The bottom element is the least upper bound of the empty chain.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def bot : α := csup (fun _ => False)
+
+scoped notation "⊥" => bot
+
+theorem bot_le (x : α) : ⊥ ⊑ x := by
+  apply csup_le
+  · intro x y hx hy; contradiction
+  · intro x hx; contradiction
+
+end CCPO
+
+section monotone
+
+variable {α : Sort u} [PartialOrder α]
+variable {β : Sort v} [PartialOrder β]
+
+/--
+A function is monotone if if it maps related elements to releated elements.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def monotone (f : α → β) : Prop := ∀ x y, x ⊑ y → f x ⊑ f y
+
+theorem monotone_const (c : β) : monotone (fun (_ : α) => c) :=
+  fun _ _ _ => PartialOrder.rel_refl
+
+theorem monotone_id : monotone (fun (x : α) => x) :=
+  fun _ _ hxy => hxy
+
+theorem monotone_compose
+    {γ : Sort w} [PartialOrder γ]
+    {f : α → β} {g : β → γ}
+    (hf : monotone f) (hg : monotone g) :
+   monotone (fun x => g (f x)) := fun _ _ hxy => hg _ _ (hf _ _ hxy)
+
+end monotone
+
+section admissibility
+
+variable {α : Sort u} [CCPO α]
+
+open PartialOrder CCPO
+
+/--
+A predicate is admissable if it can be transferred from the elements of a chain to the chains least
+upper bound. Such predicates can be used in fixpoint induction.
+
+This definition implies `P ⊥`. Sometimes (e.g. in Isabelle) the empty chain is excluded
+from this definition, and `P ⊥` is a separate condition of the induction predicate.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def admissible (P : α → Prop) :=
+  ∀ (c : α → Prop), chain c → (∀ x, c x → P x) → P (csup c)
+
+theorem admissible_const_true : admissible (fun (_ : α) => True) :=
+  fun _ _ _ => trivial
+
+theorem admissible_and (P Q : α → Prop)
+  (hadm₁ : admissible P) (hadm₂ : admissible Q) : admissible (fun x => P x ∧ Q x) :=
+    fun c hchain h =>
+    ⟨ hadm₁ c hchain fun x hx => (h x hx).1,
+      hadm₂ c hchain fun x hx => (h x hx).2⟩
+
+theorem chain_conj (c P : α → Prop) (hchain : chain c) : chain (fun x => c x ∧ P x) := by
+  intro x y ⟨hcx, _⟩ ⟨hcy, _⟩
+  exact hchain x y hcx hcy
+
+theorem csup_conj (c P : α → Prop) (hchain : chain c) (h : ∀ x, c x → ∃ y, c y ∧ x ⊑ y ∧ P y) :
+    csup c = csup (fun x => c x ∧ P x) := by
+  apply rel_antisymm
+  · apply csup_le hchain
+    intro x hcx
+    obtain ⟨y, hcy, hxy, hPy⟩ := h x hcx
+    apply rel_trans hxy; clear x hcx hxy
+    apply le_csup (chain_conj _ _ hchain) ⟨hcy, hPy⟩
+  · apply csup_le (chain_conj _ _ hchain)
+    intro x ⟨hcx, hPx⟩
+    apply le_csup hchain hcx
+
+theorem admissible_or (P Q : α → Prop)
+  (hadm₁ : admissible P) (hadm₂ : admissible Q) : admissible (fun x => P x ∨ Q x) := by
+  intro c hchain h
+  have : (∀ x, c x → ∃ y, c y ∧ x ⊑ y ∧ P y) ∨ (∀ x, c x → ∃ y, c y ∧ x ⊑ y ∧ Q y) := by
+    open Classical in
+    apply Decidable.or_iff_not_imp_left.mpr
+    intro h'
+    simp only [not_forall, not_imp, not_exists, not_and] at h'
+    obtain ⟨x, hcx, hx⟩ := h'
+    intro y hcy
+    cases hchain x y hcx hcy  with
+    | inl hxy =>
+      refine ⟨y, hcy, rel_refl, ?_⟩
+      cases h y hcy with
+      | inl hPy => exfalso; apply hx y hcy hxy hPy
+      | inr hQy => assumption
+    | inr hyx =>
+      refine ⟨x, hcx, hyx , ?_⟩
+      cases h x hcx with
+      | inl hPx => exfalso; apply hx x hcx rel_refl hPx
+      | inr hQx => assumption
+  cases this with
+  | inl hP =>
+    left
+    rw [csup_conj (h := hP) (hchain := hchain)]
+    apply hadm₁ _ (chain_conj _ _ hchain)
+    intro x ⟨hcx, hPx⟩
+    exact hPx
+  | inr hQ =>
+    right
+    rw [csup_conj (h := hQ) (hchain := hchain)]
+    apply hadm₂ _ (chain_conj _ _ hchain)
+    intro x ⟨hcx, hQx⟩
+    exact hQx
+
+def admissible_pi (P : α → β → Prop)
+  (hadm₁ : ∀ y, admissible (fun x => P x y)) : admissible (fun x => ∀ y, P x y) :=
+    fun c hchain h y => hadm₁ y c hchain fun x hx => h x hx y
+
+end admissibility
+
+section fix
+
+open PartialOrder CCPO
+
+variable {α  : Sort u} [CCPO α]
+
+variable {c : α → Prop} (hchain : chain c)
+
+/--
+The transfinite iteration of a function `f` is a set that is `⊥ ` and is closed under application
+of `f` and `csup`.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+inductive iterates (f : α → α) : α → Prop where
+  | step : iterates f x → iterates f (f x)
+  | sup {c : α → Prop} (hc : chain c) (hi : ∀ x, c x → iterates f x) : iterates f (csup c)
+
+theorem chain_iterates {f : α → α} (hf : monotone f) : chain (iterates f) := by
+  intros x y hx hy
+  induction hx generalizing y
+  case step x hx ih =>
+    induction hy
+    case step y hy _ =>
+      cases ih y hy
+      · left; apply hf; assumption
+      · right; apply hf; assumption
+    case sup c hchain hi ih2 =>
+      show f x ⊑ csup c ∨ csup c ⊑ f x
+      by_cases h : ∃ z, c z ∧ f x ⊑ z
+      · left
+        obtain ⟨z, hz, hfz⟩ := h
+        apply rel_trans hfz
+        apply le_csup hchain hz
+      · right
+        apply csup_le hchain _
+        intro z hz
+        rw [not_exists] at h
+        specialize h z
+        rw [not_and] at h
+        specialize h hz
+        cases ih2 z hz
+        next => contradiction
+        next => assumption
+  case sup c hchain hi ih =>
+    show rel (csup c) y ∨ rel y (csup c)
+    by_cases h : ∃ z, c z ∧ rel y z
+    · right
+      obtain ⟨z, hz, hfz⟩ := h
+      apply rel_trans hfz
+      apply le_csup hchain hz
+    · left
+      apply csup_le hchain _
+      intro z hz
+      rw [not_exists] at h
+      specialize h z
+      rw [not_and] at h
+      specialize h hz
+      cases ih z hz y hy
+      next => assumption
+      next => contradiction
+
+theorem rel_f_of_iterates {f : α → α} (hf : monotone f) {x : α} (hx : iterates f x) : x ⊑ f x := by
+  induction hx
+  case step ih =>
+    apply hf
+    assumption
+  case sup c hchain hi ih =>
+    apply csup_le hchain
+    intro y hy
+    apply rel_trans (ih y hy)
+    apply hf
+    apply le_csup hchain hy
+
+set_option linter.unusedVariables false in
+/--
+The least fixpoint of a monotone function is the least upper bound of its transfinite iteration.
+
+The `monotone f` assumption is not strictly necessarily for the definition, but without this the
+definition is not very meaningful and it simplifies applying theorems like `fix_eq` if every use of
+`fix` already has the monotonicty requirement.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def fix (f : α → α) (hmono : monotone f) := csup (iterates f)
+
+/--
+The main fixpoint theorem for fixedpoints of monotone functions in chain-complete partial orders.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+theorem fix_eq {f : α → α} (hf : monotone f) : fix f hf = f (fix f hf) := by
+  apply rel_antisymm
+  · apply rel_f_of_iterates hf
+    apply iterates.sup (chain_iterates hf)
+    exact fun _ h => h
+  · apply le_csup (chain_iterates hf)
+    apply iterates.step
+    apply iterates.sup (chain_iterates hf)
+    intro y hy
+    exact hy
+
+/--
+The fixpoint induction theme: An admissible predicate holds for a least fixpoint if it is preserved
+by the fixpoint's function.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+theorem fix_induct {f : α → α} (hf : monotone f)
+    (motive : α → Prop) (hadm: admissible motive)
+    (h : ∀ x, motive x → motive (f x)) : motive (fix f hf) := by
+  apply hadm _ (chain_iterates hf)
+  intro x hiterates
+  induction hiterates with
+  | @step x hiter ih => apply h x ih
+  | @sup c hchain hiter ih => apply hadm c hchain ih
+
+end fix
+
+section fun_order
+
+open PartialOrder
+
+variable {α : Sort u}
+variable {β : α → Sort v}
+variable {γ : Sort w}
+
+instance instOrderPi [∀ x, PartialOrder (β x)] : PartialOrder (∀ x, β x) where
+  rel f g := ∀ x, f x ⊑ g x
+  rel_refl _ := rel_refl
+  rel_trans hf hg x := rel_trans (hf x) (hg x)
+  rel_antisymm hf hg := funext (fun x => rel_antisymm (hf x) (hg x))
+
+theorem monotone_of_monotone_apply [PartialOrder γ] [∀ x, PartialOrder (β x)] (f : γ → (∀ x, β x))
+  (h : ∀ y, monotone (fun x => f x y)) : monotone f :=
+  fun x y hxy z => h z x y hxy
+
+theorem monotone_apply [PartialOrder γ] [∀ x, PartialOrder (β x)] (a : α) (f : γ → ∀ x, β x)
+    (h : monotone f) :
+    monotone (fun x => f x a) := fun _ _ hfg => h _ _ hfg a
+
+theorem chain_apply [∀ x, PartialOrder (β x)] {c : (∀ x, β x) → Prop} (hc : chain c) (x : α) :
+    chain (fun y => ∃ f, c f ∧ f x = y) := by
+  intro _ _ ⟨f, hf, hfeq⟩ ⟨g, hg, hgeq⟩
+  subst hfeq; subst hgeq
+  cases hc f g hf hg
+  next h => left; apply h x
+  next h => right; apply h x
+
+def fun_csup [∀ x, CCPO (β x)] (c : (∀ x, β x) → Prop) (x : α) :=
+  CCPO.csup (fun y => ∃ f, c f ∧ f x = y)
+
+instance instCCPOPi [∀ x, CCPO (β x)] : CCPO (∀ x, β x) where
+  csup := fun_csup
+  csup_spec := by
+    intro f c hc
+    constructor
+    next =>
+      intro hf g hg x
+      apply rel_trans _ (hf x); clear hf
+      apply le_csup (chain_apply hc x)
+      exact ⟨g, hg, rfl⟩
+    next =>
+      intro h x
+      apply csup_le (chain_apply hc x)
+      intro y ⟨z, hz, hyz⟩
+      subst y
+      apply h z hz
+
+def admissible_apply [∀ x, CCPO (β x)] (P : ∀ x, β x → Prop) (x : α)
+  (hadm : admissible (P x)) : admissible (fun (f : ∀ x, β x) => P x (f x)) := by
+  intro c hchain h
+  apply hadm _ (chain_apply hchain x)
+  rintro _ ⟨f, hcf, rfl⟩
+  apply h _ hcf
+
+def admissible_pi_apply [∀ x, CCPO (β x)] (P : ∀ x, β x → Prop) (hadm : ∀ x, admissible (P x)) :
+    admissible (fun (f : ∀ x, β x) => ∀ x, P x (f x)) := by
+  apply admissible_pi
+  intro
+  apply admissible_apply
+  apply hadm
+
+end fun_order
+
+section monotone_lemmas
+
+theorem monotone_letFun
+    {α : Sort u} {β : Sort v} {γ : Sort w} [PartialOrder α] [PartialOrder β]
+    (v : γ) (k : α → γ → β)
+    (hmono : ∀ y, monotone (fun x => k x y)) :
+  monotone fun (x : α) => letFun v (k x) := hmono v
+
+theorem monotone_ite
+    {α : Sort u} {β : Sort v} [PartialOrder α] [PartialOrder β]
+    (c : Prop) [Decidable c]
+    (k₁ : α → β) (k₂ : α → β)
+    (hmono₁ : monotone k₁) (hmono₂ : monotone k₂) :
+  monotone fun x => if c then k₁ x else k₂ x := by
+    split
+    · apply hmono₁
+    · apply hmono₂
+
+theorem monotone_dite
+    {α : Sort u} {β : Sort v} [PartialOrder α] [PartialOrder β]
+    (c : Prop) [Decidable c]
+    (k₁ : α → c → β) (k₂ : α → ¬ c → β)
+    (hmono₁ : monotone k₁) (hmono₂ : monotone k₂) :
+  monotone fun x => dite c (k₁ x) (k₂ x) := by
+    split
+    · apply monotone_apply _ _ hmono₁
+    · apply monotone_apply _ _ hmono₂
+
+end monotone_lemmas
+
+section pprod_order
+
+open PartialOrder
+
+variable {α : Sort u}
+variable {β : Sort v}
+variable {γ : Sort w}
+
+instance [PartialOrder α] [PartialOrder β] : PartialOrder (α ×' β) where
+  rel a b := a.1 ⊑ b.1 ∧ a.2 ⊑ b.2
+  rel_refl := ⟨rel_refl, rel_refl⟩
+  rel_trans ha hb := ⟨rel_trans ha.1 hb.1, rel_trans ha.2 hb.2⟩
+  rel_antisymm := fun {a} {b} ha hb => by
+    cases a; cases b;
+    dsimp at *
+    rw [rel_antisymm ha.1 hb.1, rel_antisymm ha.2 hb.2]
+
+theorem monotone_pprod [PartialOrder α] [PartialOrder β] [PartialOrder γ]
+    {f : γ → α} {g : γ → β} (hf : monotone f) (hg : monotone g) :
+    monotone (fun x => PProd.mk (f x) (g x)) :=
+  fun _ _ h12 => ⟨hf _ _ h12, hg _ _ h12⟩
+
+theorem monotone_pprod_fst [PartialOrder α] [PartialOrder β] [PartialOrder γ]
+    {f : γ → α ×' β} (hf : monotone f) : monotone (fun x => (f x).1) :=
+  fun _ _ h12 => (hf _ _ h12).1
+
+theorem monotone_pprod_snd [PartialOrder α] [PartialOrder β] [PartialOrder γ]
+    {f : γ → α ×' β} (hf : monotone f) : monotone (fun x => (f x).2) :=
+  fun _ _ h12 => (hf _ _ h12).2
+
+def chain_pprod_fst [CCPO α] [CCPO β] (c : α ×' β → Prop) : α → Prop := fun a => ∃ b, c ⟨a, b⟩
+def chain_pprod_snd [CCPO α] [CCPO β] (c : α ×' β → Prop) : β → Prop := fun b => ∃ a, c ⟨a, b⟩
+
+theorem chain.pprod_fst [CCPO α] [CCPO β] (c : α ×' β → Prop) (hchain : chain c) :
+    chain (chain_pprod_fst c) := by
+  intro a₁ a₂ ⟨b₁, h₁⟩ ⟨b₂, h₂⟩
+  cases hchain ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h₁ h₂
+  case inl h => left; exact h.1
+  case inr h => right; exact h.1
+
+theorem chain.pprod_snd [CCPO α] [CCPO β] (c : α ×' β → Prop) (hchain : chain c) :
+    chain (chain_pprod_snd c) := by
+  intro b₁ b₂ ⟨a₁, h₁⟩ ⟨a₂, h₂⟩
+  cases hchain ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h₁ h₂
+  case inl h => left; exact h.2
+  case inr h => right; exact h.2
+
+instance [CCPO α] [CCPO β] : CCPO (α ×' β) where
+  csup c := ⟨CCPO.csup (chain_pprod_fst c), CCPO.csup (chain_pprod_snd c)⟩
+  csup_spec := by
+    intro ⟨a, b⟩ c hchain
+    dsimp
+    constructor
+    next =>
+      intro ⟨h₁, h₂⟩ ⟨a', b'⟩ cab
+      constructor <;> dsimp at *
+      · apply rel_trans ?_ h₁
+        apply le_csup hchain.pprod_fst
+        exact ⟨b', cab⟩
+      · apply rel_trans ?_ h₂
+        apply le_csup hchain.pprod_snd
+        exact ⟨a', cab⟩
+    next =>
+      intro h
+      constructor <;> dsimp
+      · apply csup_le hchain.pprod_fst
+        intro a' ⟨b', hcab⟩
+        apply (h _ hcab).1
+      · apply csup_le hchain.pprod_snd
+        intro b' ⟨a', hcab⟩
+        apply (h _ hcab).2
+
+theorem admissible_pprod_fst {α : Sort u} {β : Sort v} [CCPO α] [CCPO β] (P : α → Prop)
+    (hadm : admissible P) : admissible (fun (x : α ×' β) => P x.1) := by
+  intro c hchain h
+  apply hadm _ hchain.pprod_fst
+  intro x ⟨y, hxy⟩
+  apply h ⟨x,y⟩ hxy
+
+theorem admissible_pprod_snd {α : Sort u} {β : Sort v} [CCPO α] [CCPO β] (P : β → Prop)
+    (hadm : admissible P) : admissible (fun (x : α ×' β) => P x.2) := by
+  intro c hchain h
+  apply hadm _ hchain.pprod_snd
+  intro y ⟨x, hxy⟩
+  apply h ⟨x,y⟩ hxy
+
+end pprod_order
+
+section flat_order
+
+variable {α : Sort u}
+
+set_option linter.unusedVariables false in
+/--
+`FlatOrder b` wraps the type `α` with the flat partial order generated by `∀ x, b ⊑ x`.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+def FlatOrder {α : Sort u} (b : α) := α
+
+variable {b : α}
+
+/--
+The flat partial order generated by `∀ x, b ⊑ x`.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+inductive FlatOrder.rel : (x y : FlatOrder b) → Prop where
+  | bot : rel b x
+  | refl : rel x x
+
+instance FlatOrder.instOrder : PartialOrder (FlatOrder b) where
+  rel := rel
+  rel_refl := .refl
+  rel_trans {x y z : α} (hxy : rel x y) (hyz : rel y z) := by
+    cases hxy <;> cases hyz <;> constructor
+  rel_antisymm {x y : α} (hxy : rel x y) (hyz : rel y x) : x = y := by
+    cases hxy <;> cases hyz <;> constructor
+
+open Classical in
+private theorem Classical.some_spec₂ {α : Sort _} {p : α → Prop} {h : ∃ a, p a} (q : α → Prop)
+    (hpq : ∀ a, p a → q a) : q (choose h) := hpq _ <| choose_spec _
+
+noncomputable def flat_csup (c : FlatOrder b → Prop) : FlatOrder b := by
+  by_cases h : ∃ (x : FlatOrder b), c x ∧ x ≠ b
+  · exact Classical.choose h
+  · exact b
+
+noncomputable instance FlatOrder.instCCPO : CCPO (FlatOrder b) where
+  csup := flat_csup
+  csup_spec := by
+    intro x c hc
+    unfold flat_csup
+    split
+    next hex =>
+      apply Classical.some_spec₂ (q := (· ⊑ x ↔ (∀ y, c y → y ⊑ x)))
+      clear hex
+      intro z ⟨hz, hnb⟩
+      constructor
+      · intro h y hy
+        apply PartialOrder.rel_trans _ h; clear h
+        cases hc y z hy hz
+        next => assumption
+        next h =>
+          cases h
+          · contradiction
+          · constructor
+      · intro h
+        cases h z hz
+        · contradiction
+        · constructor
+    next hnotex =>
+      constructor
+      · intro h y hy; clear h
+        suffices y = b by rw [this]; exact rel.bot
+        rw [not_exists] at hnotex
+        specialize hnotex y
+        rw [not_and] at hnotex
+        specialize hnotex hy
+        rw [@Classical.not_not] at hnotex
+        assumption
+      · intro; exact rel.bot
+
+theorem admissible_flatOrder (P : FlatOrder b → Prop) (hnot : P b) : admissible P := by
+  intro c hchain h
+  by_cases h' : ∃ (x : FlatOrder b), c x ∧ x ≠ b
+  · simp [CCPO.csup, flat_csup, h']
+    apply Classical.some_spec₂ (q := (P ·))
+    intro x ⟨hcx, hneb⟩
+    apply h x hcx
+  · simp [CCPO.csup, flat_csup, h', hnot]
+
+end flat_order
+
+section mono_bind
+
+/--
+The class `MonoBind m` indicates that every `m α` has a `PartialOrder`, and that the bind operation
+on `m` is monotone in both arguments with regard to that order.
+
+This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
+-/
+class MonoBind (m : Type u → Type v) [Bind m] [∀ α, PartialOrder (m α)] where
+  bind_mono_left {a₁ a₂ : m α} {f : α → m b} (h : a₁ ⊑ a₂) : a₁ >>= f ⊑ a₂ >>= f
+  bind_mono_right {a : m α} {f₁ f₂ : α → m b} (h : ∀ x, f₁ x ⊑ f₂ x) : a >>= f₁ ⊑ a >>= f₂
+
+theorem monotone_bind
+    (m : Type u → Type v) [Bind m] [∀ α, PartialOrder (m α)] [MonoBind m]
+    {α β : Type u}
+    {γ : Type w} [PartialOrder γ]
+    (f : γ → m α) (g : γ → α → m β)
+    (hmono₁ : monotone f)
+    (hmono₂ : monotone g) :
+    monotone (fun (x : γ) => f x >>= g x) := by
+  intro x₁ x₂ hx₁₂
+  apply PartialOrder.rel_trans
+  · apply MonoBind.bind_mono_left (hmono₁ _ _ hx₁₂)
+  · apply MonoBind.bind_mono_right (fun y => monotone_apply y _ hmono₂ _ _ hx₁₂)
+
+instance : PartialOrder (Option α) := inferInstanceAs (PartialOrder (FlatOrder none))
+noncomputable instance : CCPO (Option α) := inferInstanceAs (CCPO (FlatOrder none))
+noncomputable instance : MonoBind Option where
+  bind_mono_left h := by
+    cases h
+    · exact FlatOrder.rel.bot
+    · exact FlatOrder.rel.refl
+  bind_mono_right h := by
+    cases ‹Option _›
+    · exact FlatOrder.rel.refl
+    · exact h _
+
+theorem admissible_eq_some (P : Prop) (y : α) :
+    admissible (fun (x : Option α) => x = some y → P) := by
+  apply admissible_flatOrder; simp
+
+instance [Monad m] [inst : ∀ α, PartialOrder (m α)] : PartialOrder (ExceptT ε m α) := inst _
+instance [Monad m] [∀ α, PartialOrder (m α)] [inst : ∀ α, CCPO (m α)] : CCPO (ExceptT ε m α) := inst _
+instance [Monad m] [∀ α, PartialOrder (m α)] [∀ α, CCPO (m α)] [MonoBind m] : MonoBind (ExceptT ε m) where
+  bind_mono_left h₁₂ := by
+    apply MonoBind.bind_mono_left (m := m)
+    exact h₁₂
+  bind_mono_right h₁₂ := by
+    apply MonoBind.bind_mono_right (m := m)
+    intro x
+    cases x
+    · apply PartialOrder.rel_refl
+    · apply h₁₂
+
+end mono_bind
+
+namespace Example
+
+def findF (P : Nat → Bool) (rec : Nat → Option Nat) (x : Nat) : Option Nat :=
+  if P x then
+    some x
+  else
+    rec (x + 1)
+
+noncomputable def find (P : Nat → Bool) : Nat → Option Nat := fix (findF P) <| by
+  unfold findF
+  apply monotone_of_monotone_apply
+  intro n
+  split
+  · apply monotone_const
+  · apply monotone_apply
+    apply monotone_id
+
+theorem find_eq : find P = findF P (find P) := fix_eq ..
+
+theorem find_spec : ∀ n m, find P n = some m → n ≤ m ∧ P m := by
+  unfold find
+  refine fix_induct (motive := fun (f : Nat → Option Nat) => ∀ n m, f n = some m → n ≤ m ∧ P m) _ ?hadm ?hstep
+  case hadm =>
+    -- apply admissible_pi_apply does not work well, hard to infer everything
+    exact admissible_pi_apply _ (fun n => admissible_pi _ (fun m => admissible_eq_some _ m))
+  case hstep =>
+    intro f ih n m heq
+    simp only [findF] at heq
+    split at heq
+    · simp_all
+    · obtain ⟨ih1, ih2⟩ := ih _ _ heq
+      constructor
+      · exact Nat.le_trans (Nat.le_add_right _ _ ) ih1
+      · exact ih2
+
+end Example
+
+end Lean.Order

src/Init/Internal/Order/Tactic.lean

@@ -0,0 +1,20 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+
+prelude
+import Init.Notation
+
+namespace Lean.Order
+/--
+`monotonicity` performs one compositional step solving `monotone` goals,
+using lemma tagged with `@[partial_fixpoint_monotone]`.
+
+This tactic is mostly used internally by lean in `partial_fixpoint` definitions, but
+can be useful on its own for debugging or when proving new `@[partial_fixpoint_monotone]` lemmas.
+-/
+scoped syntax (name := monotonicity) "monotonicity" : tactic
+
+end Lean.Order

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/PropLemmas.lean

@@ -362,6 +362,10 @@ theorem exists_prop' {p : Prop} : (∃ _ : α, p) ↔ Nonempty α ∧ p :=
 @[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b :=
   ⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩
 
+@[simp] theorem exists_idem {P : Prop} (f : P → P → Sort _) :
+    (∃ (p₁ : P), ∃ (p₂ : P), f p₁ p₂) ↔ ∃ (p : P), f p p :=
+  ⟨fun ⟨p, _, h⟩ => ⟨p, h⟩, fun ⟨p, h⟩ => ⟨p, p, h⟩⟩
+
 @[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩
 
 theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=

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/Compiler/ExternAttr.lean

@@ -18,6 +18,7 @@ inductive ExternEntry where
   | inline   (backend : Name) (pattern : String)
   | standard (backend : Name) (fn : String)
   | foreign  (backend : Name) (fn : String)
+  deriving BEq, Hashable
 
 /--
 - `@[extern]`
@@ -36,7 +37,7 @@ inductive ExternEntry where
 structure ExternAttrData where
   arity?   : Option Nat := none
   entries  : List ExternEntry
-  deriving Inhabited
+  deriving Inhabited, BEq, Hashable
 
 -- def externEntry := leading_parser optional ident >> optional (nonReservedSymbol "inline ") >> strLit
 -- @[builtin_attr_parser] def extern     := leading_parser nonReservedSymbol "extern " >> optional numLit >> many externEntry

src/Lean/Compiler/LCNF/Basic.lean

@@ -7,6 +7,7 @@ prelude
 import Init.Data.List.BasicAux
 import Lean.Expr
 import Lean.Meta.Instances
+import Lean.Compiler.ExternAttr
 import Lean.Compiler.InlineAttrs
 import Lean.Compiler.Specialize
 import Lean.Compiler.LCNF.Types
@@ -429,6 +430,80 @@ where
     | .cases c => c.alts.forM fun alt => go alt.getCode
     | .unreach .. | .return .. | .jmp .. => return ()
 
+partial def Code.instantiateValueLevelParams (code : Code) (levelParams : List Name) (us : List Level) : Code :=
+  instCode code
+where
+  instLevel (u : Level) :=
+    u.instantiateParams levelParams us
+
+  instExpr (e : Expr) :=
+    e.instantiateLevelParamsNoCache levelParams us
+
+  instParams (ps : Array Param) :=
+    ps.mapMono fun p => p.updateCore (instExpr p.type)
+
+  instAlt (alt : Alt) :=
+    match alt with
+    | .default k => alt.updateCode (instCode k)
+    | .alt _ ps k => alt.updateAlt! (instParams ps) (instCode k)
+
+  instArg (arg : Arg) : Arg :=
+    match arg with
+    | .type e => arg.updateType! (instExpr e)
+    | .fvar .. | .erased => arg
+
+  instLetValue (e : LetValue) : LetValue :=
+    match e with
+    | .const declName vs args => e.updateConst! declName (vs.mapMono instLevel) (args.mapMono instArg)
+    | .fvar fvarId args => e.updateFVar! fvarId (args.mapMono instArg)
+    | .proj .. | .value .. | .erased => e
+
+  instLetDecl (decl : LetDecl) :=
+    decl.updateCore (instExpr decl.type) (instLetValue decl.value)
+
+  instFunDecl (decl : FunDecl) :=
+    decl.updateCore (instExpr decl.type) (instParams decl.params) (instCode decl.value)
+
+  instCode (code : Code) :=
+    match code with
+    | .let decl k => code.updateLet! (instLetDecl decl) (instCode k)
+    | .jp decl k | .fun decl k => code.updateFun! (instFunDecl decl) (instCode k)
+    | .cases c => code.updateCases! (instExpr c.resultType) c.discr (c.alts.mapMono instAlt)
+    | .jmp fvarId args => code.updateJmp! fvarId (args.mapMono instArg)
+    | .return .. => code
+    | .unreach type => code.updateUnreach! (instExpr type)
+
+inductive DeclValue where
+  | code (code : Code)
+  | extern (externAttrData : ExternAttrData)
+  deriving Inhabited, BEq
+
+partial def DeclValue.size : DeclValue → Nat
+  | .code c => c.size
+  | .extern .. => 0
+
+def DeclValue.mapCode (f : Code → Code) : DeclValue → DeclValue :=
+  fun
+    | .code c => .code (f c)
+    | .extern e => .extern e
+
+def DeclValue.mapCodeM [Monad m] (f : Code → m Code) : DeclValue → m DeclValue :=
+  fun v => do
+    match v with
+    | .code c => return .code (← f c)
+    | .extern .. => return v
+
+def DeclValue.forCodeM [Monad m] (f : Code → m Unit) : DeclValue → m Unit :=
+  fun v => do
+    match v with
+    | .code c => f c
+    | .extern .. => return ()
+
+def DeclValue.isCodeAndM [Monad m] (v : DeclValue) (f : Code → m Bool) : m Bool :=
+  match v with
+  | .code c => f c
+  | .extern .. => pure false
+
 /--
 Declaration being processed by the Lean to Lean compiler passes.
 -/
@@ -455,7 +530,7 @@ structure Decl where
   The body of the declaration, usually changes as it progresses
   through compiler passes.
   -/
-  value : Code
+  value : DeclValue
   /--
   We set this flag to true during LCNF conversion. When we receive
   a block of functions to be compiled, we set this flag to `true`
@@ -536,7 +611,9 @@ We use this function to decide whether we should inline a declaration tagged wit
 `[inline_if_reduce]` or not.
 -/
 def Decl.isCasesOnParam? (decl : Decl) : Option Nat :=
-  go decl.value
+  match decl.value with
+  | .code c => go c
+  | .extern .. => none
 where
   go (code : Code) : Option Nat :=
     match code with
@@ -550,49 +627,6 @@ def Decl.instantiateTypeLevelParams (decl : Decl) (us : List Level) : Expr :=
 def Decl.instantiateParamsLevelParams (decl : Decl) (us : List Level) : Array Param :=
   decl.params.mapMono fun param => param.updateCore (param.type.instantiateLevelParamsNoCache decl.levelParams us)
 
-partial def Decl.instantiateValueLevelParams (decl : Decl) (us : List Level) : Code :=
-  instCode decl.value
-where
-  instLevel (u : Level) :=
-    u.instantiateParams decl.levelParams us
-
-  instExpr (e : Expr) :=
-    e.instantiateLevelParamsNoCache decl.levelParams us
-
-  instParams (ps : Array Param) :=
-    ps.mapMono fun p => p.updateCore (instExpr p.type)
-
-  instAlt (alt : Alt) :=
-    match alt with
-    | .default k => alt.updateCode (instCode k)
-    | .alt _ ps k => alt.updateAlt! (instParams ps) (instCode k)
-
-  instArg (arg : Arg) : Arg :=
-    match arg with
-    | .type e => arg.updateType! (instExpr e)
-    | .fvar .. | .erased => arg
-
-  instLetValue (e : LetValue) : LetValue :=
-    match e with
-    | .const declName vs args => e.updateConst! declName (vs.mapMono instLevel) (args.mapMono instArg)
-    | .fvar fvarId args => e.updateFVar! fvarId (args.mapMono instArg)
-    | .proj .. | .value .. | .erased => e
-
-  instLetDecl (decl : LetDecl) :=
-    decl.updateCore (instExpr decl.type) (instLetValue decl.value)
-
-  instFunDecl (decl : FunDecl) :=
-    decl.updateCore (instExpr decl.type) (instParams decl.params) (instCode decl.value)
-
-  instCode (code : Code) :=
-    match code with
-    | .let decl k => code.updateLet! (instLetDecl decl) (instCode k)
-    | .jp decl k | .fun decl k => code.updateFun! (instFunDecl decl) (instCode k)
-    | .cases c => code.updateCases! (instExpr c.resultType) c.discr (c.alts.mapMono instAlt)
-    | .jmp fvarId args => code.updateJmp! fvarId (args.mapMono instArg)
-    | .return .. => code
-    | .unreach type => code.updateUnreach! (instExpr type)
-
 /--
 Return `true` if the arrow type contains an instance implicit argument.
 -/
@@ -693,7 +727,7 @@ where
       visit k
 
   go : StateM NameSet Unit :=
-    decls.forM fun decl => visit decl.value
+    decls.forM (·.value.forCodeM visit)
 
 def instantiateRangeArgs (e : Expr) (beginIdx endIdx : Nat) (args : Array Arg) : Expr :=
   if !e.hasLooseBVars then

src/Lean/Compiler/LCNF/Bind.lean

@@ -123,7 +123,10 @@ def FunDeclCore.etaExpand (decl : FunDecl) : CompilerM FunDecl := do
   decl.update decl.type params value
 
 def Decl.etaExpand (decl : Decl) : CompilerM Decl := do
-  let some (params, value) ← etaExpandCore? decl.type decl.params decl.value | return decl
-  return { decl with params, value }
+  match decl.value with
+  | .code code =>
+    let some (params, newCode) ← etaExpandCore? decl.type decl.params code | return decl
+    return { decl with params, value := .code newCode}
+  | .extern .. => return decl
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/CSE.lean

@@ -102,7 +102,7 @@ end CSE
 Common sub-expression elimination
 -/
 def Decl.cse (decl : Decl) : CompilerM Decl := do
-  let value ← decl.value.cse
+  let value ← decl.value.mapCodeM (·.cse)
   return { decl with value }
 
 def cse (phase : Phase := .base) (occurrence := 0) : Pass :=

src/Lean/Compiler/LCNF/Check.lean

@@ -261,7 +261,7 @@ def run (x : CheckM α) : CompilerM α :=
 end Check
 
 def Decl.check (decl : Decl) : CompilerM Unit := do
-  Check.run do Check.checkFunDeclCore decl.name decl.params decl.type decl.value
+  Check.run do decl.value.forCodeM (Check.checkFunDeclCore decl.name decl.params decl.type)
 
 /--
 Check whether every local declaration in the local context is used in one of given `decls`.
@@ -299,7 +299,7 @@ where
 
   visitDecl (decl : Decl) : StateM FVarIdHashSet Unit := do
     visitParams decl.params
-    visitCode decl.value
+    decl.value.forCodeM visitCode
 
   visitDecls (decls : Array Decl) : StateM FVarIdHashSet Unit :=
     decls.forM visitDecl

src/Lean/Compiler/LCNF/CompilerM.lean

@@ -148,7 +148,7 @@ def eraseCodeDecls (decls : Array CodeDecl) : CompilerM Unit := do
 
 def eraseDecl (decl : Decl) : CompilerM Unit := do
   eraseParams decl.params
-  eraseCode decl.value
+  decl.value.forCodeM eraseCode
 
 abbrev Decl.erase (decl : Decl) : CompilerM Unit :=
   eraseDecl decl

src/Lean/Compiler/LCNF/DeclHash.lean

@@ -38,6 +38,7 @@ end
 instance : Hashable Code where
   hash c := hashCode c
 
+deriving instance Hashable for DeclValue
 deriving instance Hashable for Decl
 
-end Lean.Compiler.LCNF
+end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ElimDead.lean

@@ -95,6 +95,6 @@ def Code.elimDead (code : Code) : CompilerM Code :=
   ElimDead.elimDead code |>.run' {}
 
 def Decl.elimDead (decl : Decl) : CompilerM Decl := do
-  return { decl with value := (← decl.value.elimDead) }
+  return { decl with value := (← decl.value.mapCodeM Code.elimDead) }
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ElimDeadBranches.lean

@@ -513,7 +513,7 @@ def inferStep : InterpM Bool := do
     let currentVal ← getFunVal idx
     withReader (fun ctx => { ctx with currFnIdx := idx }) do
       decl.params.forM fun p => updateVarAssignment p.fvarId .top
-      interpCode decl.value
+      decl.value.forCodeM interpCode
     let newVal ← getFunVal idx
     if currentVal != newVal then
       return true
@@ -538,7 +538,7 @@ Use the information produced by the abstract interpreter to:
 -/
 partial def elimDead (assignment : Assignment) (decl : Decl) : CompilerM Decl := do
   trace[Compiler.elimDeadBranches] s!"Eliminating {decl.name} with {repr (← assignment.toArray |>.mapM (fun (name, val) => do return (toString (← getBinderName name), val)))}"
-  return { decl with value := (← go decl.value) }
+  return { decl with value := (← decl.value.mapCodeM go) }
 where
   go (code : Code) : CompilerM Code := do
     match code with

src/Lean/Compiler/LCNF/FixedParams.lean

@@ -141,8 +141,9 @@ partial def evalApp (declName : Name) (args : Array Arg) : FixParamM Unit := do
       let key := (declName, values)
       unless (← get).visited.contains key do
         modify fun s => { s with visited := s.visited.insert key }
-        let assignment := mkAssignment decl values
-        withReader (fun ctx => { ctx with assignment }) <| evalCode decl.value
+        decl.value.forCodeM fun c =>
+          let assignment := mkAssignment decl values
+          withReader (fun ctx => { ctx with assignment }) <| evalCode c
 
 end
 
@@ -169,8 +170,12 @@ def mkFixedParamsMap (decls : Array Decl) : NameMap (Array Bool) := Id.run do
     let values := mkInitialValues decl.params.size
     let assignment := mkAssignment decl values
     let fixed := Array.mkArray decl.params.size true
-    match evalCode decl.value |>.run { main := decl, decls, assignment } |>.run { fixed } with
-    | .ok _ s | .error _ s => result := result.insert decl.name s.fixed
+    match decl.value with
+    | .code c =>
+      match evalCode c |>.run { main := decl, decls, assignment } |>.run { fixed } with
+      | .ok _ s | .error _ s => result := result.insert decl.name s.fixed
+    | .extern .. =>
+      result := result.insert decl.name fixed
   return result
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/FloatLetIn.lean

@@ -239,7 +239,7 @@ Iterate through `decl`, pushing local declarations that are only used in one
 control flow arm into said arm in order to avoid useless computations.
 -/
 partial def floatLetIn (decl : Decl) : CompilerM Decl := do
-  let newValue ← go decl.value |>.run {}
+  let newValue ← decl.value.mapCodeM go |>.run {}
   return { decl with value := newValue }
 where
   /--

src/Lean/Compiler/LCNF/Internalize.lean

@@ -108,7 +108,7 @@ where
   go (decl : Decl) : InternalizeM Decl := do
     let type ← normExpr decl.type
     let params ← decl.params.mapM internalizeParam
-    let value ← internalizeCode decl.value
+    let value ← decl.value.mapCodeM internalizeCode
     return { decl with type, params, value }
 
 /--

src/Lean/Compiler/LCNF/JoinPoints.lean

@@ -133,7 +133,7 @@ this. This is because otherwise the calls to `myjp` in `f` and `g` would
 produce out of scope join point jumps.
 -/
 partial def find (decl : Decl) : CompilerM FindState := do
-  let (_, candidates) ← go decl.value |>.run none |>.run {} |>.run' {}
+  let (_, candidates) ← decl.value.forCodeM go |>.run none |>.run {} |>.run' {}
   return candidates
 where
   go : Code → FindM Unit
@@ -178,7 +178,7 @@ and all calls to them with `jmp`s.
 partial def replace (decl : Decl) (state : FindState) : CompilerM Decl := do
   let mapper := fun acc cname _ => do return acc.insert cname (← mkFreshJpName)
   let replaceCtx : ReplaceCtx ← state.candidates.foldM (init := .empty) mapper
-  let newValue ← go decl.value |>.run replaceCtx
+  let newValue ← decl.value.mapCodeM go |>.run replaceCtx
   return { decl with value := newValue }
 where
   go (code : Code) : ReplaceM Code := do
@@ -389,7 +389,7 @@ position within the code so we can pull them out as far as possible, hopefully
 enabling new inlining possibilities in the next simplifier run.
 -/
 partial def extend (decl : Decl) : CompilerM Decl := do
-  let newValue ← go decl.value |>.run {} |>.run' {} |>.run' {}
+  let newValue ← decl.value.mapCodeM go |>.run {} |>.run' {} |>.run' {}
   let decl := { decl with value := newValue }
   decl.pullFunDecls
 where
@@ -510,8 +510,8 @@ After we have performed all of these optimizations we can take away the
 code that has as little arguments as possible in the join points.
 -/
 partial def reduce (decl : Decl) : CompilerM Decl := do
-  let (_, analysis) ← goAnalyze decl.value |>.run {} |>.run {} |>.run' {}
-  let newValue ← goReduce decl.value |>.run analysis
+  let (_, analysis) ← decl.value.forCodeM goAnalyze |>.run {} |>.run {} |>.run' {}
+  let newValue ← decl.value.mapCodeM goReduce |>.run analysis
   return { decl with value := newValue }
 where
   goAnalyzeFunDecl (fn : FunDecl) : ReduceAnalysisM Unit := do

src/Lean/Compiler/LCNF/LambdaLifting.lean

@@ -108,9 +108,10 @@ def mkAuxDecl (closure : Array Param) (decl : FunDecl) : LiftM LetDecl := do
 where
   go (nameNew : Name) (safe : Bool) (inlineAttr? : Option InlineAttributeKind) : InternalizeM Decl := do
     let params := (← closure.mapM internalizeParam) ++ (← decl.params.mapM internalizeParam)
-    let value ← internalizeCode decl.value
-    let type ← value.inferType
+    let code ← internalizeCode decl.value
+    let type ← code.inferType
     let type ← mkForallParams params type
+    let value := .code code
     let decl := { name := nameNew, levelParams := [], params, type, value, safe, inlineAttr?, recursive := false : Decl }
     return decl.setLevelParams
 
@@ -149,7 +150,7 @@ mutual
 end
 
 def main (decl : Decl) : LiftM Decl := do
-  let value ← withParams decl.params <| visitCode decl.value
+  let value ← withParams decl.params <| decl.value.mapCodeM visitCode
   return { decl with value }
 
 end LambdaLifting

src/Lean/Compiler/LCNF/Level.lean

@@ -139,6 +139,10 @@ mutual
     | .jmp _ args => visitArgs args
 end
 
+def visitDeclValue : DeclValue → Visitor
+  | .code c => visitCode c
+  | .extern .. => id
+
 end CollectLevelParams
 
 open Lean.CollectLevelParams
@@ -149,7 +153,7 @@ Collect universe level parameters collecting in the type, parameters, and value,
 set `decl.levelParams` with the resulting value.
 -/
 def Decl.setLevelParams (decl : Decl) : Decl :=
-  let levelParams := (visitCode decl.value ∘ visitParams decl.params ∘ visitType decl.type) {} |>.params.toList
+  let levelParams := (visitDeclValue decl.value ∘ visitParams decl.params ∘ visitType decl.type) {} |>.params.toList
   { decl with levelParams }
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/Main.lean

@@ -28,10 +28,10 @@ and `[specialize]` since they can be partially applied.
 -/
 def shouldGenerateCode (declName : Name) : CoreM Bool := do
   if (← isCompIrrelevant |>.run') then return false
+  let env ← getEnv
+  if isExtern env declName then return true
   let some info ← getDeclInfo? declName | return false
   unless info.hasValue (allowOpaque := true) do return false
-  let env ← getEnv
-  if isExtern env declName then return false
   if hasMacroInlineAttribute env declName then return false
   if (← Meta.isMatcher declName) then return false
   if isCasesOnRecursor env declName then return false

src/Lean/Compiler/LCNF/PrettyPrinter.lean

@@ -105,6 +105,11 @@ mutual
         return f!"⊥ : {← ppExpr type}"
       else
         return "⊥"
+
+  partial def ppDeclValue (b : DeclValue) : M Format := do
+    match b with
+    | .code c => ppCode c
+    | .extern .. => return "extern"
 end
 
 def run (x : M α) : CompilerM α :=
@@ -121,7 +126,7 @@ def ppLetValue (e : LetValue) : CompilerM Format :=
 
 def ppDecl (decl : Decl) : CompilerM Format :=
   PP.run do
-    return f!"def {decl.name}{← PP.ppParams decl.params} : {← PP.ppExpr (← PP.getFunType decl.params decl.type)} :={indentD (← PP.ppCode decl.value)}"
+    return f!"def {decl.name}{← PP.ppParams decl.params} : {← PP.ppExpr (← PP.getFunType decl.params decl.type)} :={indentD (← PP.ppDeclValue decl.value)}"
 
 def ppFunDecl (decl : FunDecl) : CompilerM Format :=
   PP.run do

src/Lean/Compiler/LCNF/Probing.lean

@@ -57,7 +57,7 @@ where
     | .cases (cases : CasesCore Code) => cases.alts.forM (go ·.getCode)
     | .jmp .. | .return .. | .unreach .. => return ()
   start (decls : Array Decl) : StateRefT (Array LetValue) CompilerM Unit :=
-    decls.forM (go ·.value)
+    decls.forM (·.value.forCodeM go)
 
 partial def getJps : Probe Decl FunDecl := fun decls => do
   let (_, res) ← start decls |>.run #[]
@@ -72,10 +72,10 @@ where
     | .jmp .. | .return .. | .unreach .. => return ()
 
   start (decls : Array Decl) : StateRefT (Array FunDecl) CompilerM Unit :=
-    decls.forM fun decl => go decl.value
+    decls.forM (·.value.forCodeM go)
 
 partial def filterByLet (f : LetDecl → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let decl k => do if (← f decl) then return true else go k
@@ -84,7 +84,7 @@ where
   | .jmp .. | .return .. | .unreach .. => return false
 
 partial def filterByFun (f : FunDecl → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k | .jp _ k  => go k
@@ -93,7 +93,7 @@ where
   | .jmp .. | .return .. | .unreach .. => return false
 
 partial def filterByJp (f : FunDecl → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k
@@ -103,7 +103,7 @@ where
   | .jmp .. | .return .. | .unreach .. => return false
 
 partial def filterByFunDecl (f : FunDecl → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k
@@ -112,7 +112,7 @@ where
   | .jmp .. | .return .. | .unreach .. => return false
 
 partial def filterByCases (f : Cases → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k
@@ -121,7 +121,7 @@ where
   | .jmp .. | .return .. | .unreach .. => return false
 
 partial def filterByJmp (f : FVarId → Array Arg → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k
@@ -131,7 +131,7 @@ where
   | .return .. | .unreach .. => return false
 
 partial def filterByReturn (f : FVarId → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k
@@ -141,7 +141,7 @@ where
   | .return var  => f var
 
 partial def filterByUnreach (f : Expr → CompilerM Bool) : Probe Decl Decl :=
-  filter (fun decl => go decl.value)
+  filter (·.value.isCodeAndM go)
 where
   go : Code → CompilerM Bool
   | .let _ k => go k

src/Lean/Compiler/LCNF/PullFunDecls.lean

@@ -172,8 +172,8 @@ open PullFunDecls
 Pull local function declarations and join points in the given declaration.
 -/
 def Decl.pullFunDecls (decl : Decl) : CompilerM Decl := do
-  let (value, ps) ← pull decl.value |>.run []
-  let value := attach ps.toArray value
+  let (value, ps) ← decl.value.mapCodeM pull |>.run []
+  let value := value.mapCode (attach ps.toArray)
   return { decl with value }
 
 def pullFunDecls : Pass :=

src/Lean/Compiler/LCNF/PullLetDecls.lean

@@ -96,8 +96,8 @@ open PullLetDecls
 def Decl.pullLetDecls (decl : Decl) (isCandidateFn : LetDecl → FVarIdSet → CompilerM Bool) : CompilerM Decl := do
   PullM.run (isCandidateFn := isCandidateFn) do
     withParams decl.params do
-      let value ← pullDecls decl.value
-      let value ← attachToPull value
+      let value ← decl.value.mapCodeM pullDecls
+      let value ← value.mapCodeM attachToPull
       return { decl with value }
 
 def Decl.pullInstances (decl : Decl) : CompilerM Decl :=

src/Lean/Compiler/LCNF/ReduceArity.lean

@@ -108,7 +108,7 @@ partial def visit (code : Code) : FindUsedM Unit := do
 
 def collectUsedParams (decl : Decl) : CompilerM FVarIdSet := do
   let params := decl.params.foldl (init := {}) fun s p => s.insert p.fvarId
-  let (_, { used, .. }) ← visit decl.value |>.run { decl, params } |>.run {}
+  let (_, { used, .. }) ← decl.value.forCodeM visit |>.run { decl, params } |>.run {}
   return used
 
 end FindUsed
@@ -146,37 +146,40 @@ end ReduceArity
 open FindUsed ReduceArity Internalize
 
 def Decl.reduceArity (decl : Decl) : CompilerM (Array Decl) := do
-  let used ← collectUsedParams decl
-  if used.size == decl.params.size then
-    return #[decl] -- Declarations uses all parameters
-  else
-    trace[Compiler.reduceArity] "{decl.name}, used params: {used.toList.map mkFVar}"
-    let mask   := decl.params.map fun param => used.contains param.fvarId
-    let auxName   := decl.name ++ `_redArg
-    let mkAuxDecl : CompilerM Decl := do
-      let params := decl.params.filter fun param => used.contains param.fvarId
-      let value  ← reduce decl.value |>.run { declName := decl.name, auxDeclName := auxName, paramMask := mask }
-      let type ← value.inferType
-      let type ← mkForallParams params type
-      let auxDecl := { decl with name := auxName, levelParams := [], type, params, value }
-      auxDecl.saveMono
-      return auxDecl
-    let updateDecl : InternalizeM Decl := do
-      let params ← decl.params.mapM internalizeParam
-      let mut args := #[]
-      for used in mask, param in params do
-        if used then
-          args := args.push param.toArg
-      let letDecl ← mkAuxLetDecl (.const auxName [] args)
-      let value := .let letDecl (.return letDecl.fvarId)
-      let decl := { decl with params, value, inlineAttr? := some .inline, recursive := false }
-      decl.saveMono
-      return decl
-    let unusedParams := decl.params.filter fun param => !used.contains param.fvarId
-    let auxDecl ← mkAuxDecl
-    let decl ← updateDecl |>.run' {}
-    eraseParams unusedParams
-    return #[auxDecl, decl]
+  match decl.value with
+  | .code code =>
+    let used ← collectUsedParams decl
+    if used.size == decl.params.size then
+      return #[decl] -- Declarations uses all parameters
+    else
+      trace[Compiler.reduceArity] "{decl.name}, used params: {used.toList.map mkFVar}"
+      let mask   := decl.params.map fun param => used.contains param.fvarId
+      let auxName   := decl.name ++ `_redArg
+      let mkAuxDecl : CompilerM Decl := do
+        let params := decl.params.filter fun param => used.contains param.fvarId
+        let value  ← decl.value.mapCodeM reduce |>.run { declName := decl.name, auxDeclName := auxName, paramMask := mask }
+        let type ← code.inferType
+        let type ← mkForallParams params type
+        let auxDecl := { decl with name := auxName, levelParams := [], type, params, value }
+        auxDecl.saveMono
+        return auxDecl
+      let updateDecl : InternalizeM Decl := do
+        let params ← decl.params.mapM internalizeParam
+        let mut args := #[]
+        for used in mask, param in params do
+          if used then
+            args := args.push param.toArg
+        let letDecl ← mkAuxLetDecl (.const auxName [] args)
+        let value := .code (.let letDecl (.return letDecl.fvarId))
+        let decl := { decl with params, value, inlineAttr? := some .inline, recursive := false }
+        decl.saveMono
+        return decl
+      let unusedParams := decl.params.filter fun param => !used.contains param.fvarId
+      let auxDecl ← mkAuxDecl
+      let decl ← updateDecl |>.run' {}
+      eraseParams unusedParams
+      return #[auxDecl, decl]
+  | .extern .. => return #[decl]
 
 def reduceArity : Pass where
   phase := .mono
@@ -187,4 +190,4 @@ def reduceArity : Pass where
 builtin_initialize
   registerTraceClass `Compiler.reduceArity (inherited := true)
 
-end Lean.Compiler.LCNF
+end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ReduceJpArity.lean

@@ -68,7 +68,7 @@ open ReduceJpArity
 Try to reduce arity of join points
 -/
 def Decl.reduceJpArity (decl : Decl) : CompilerM Decl := do
-  let value ← reduce decl.value |>.run {}
+  let value ← decl.value.mapCodeM reduce |>.run {}
   return { decl with value }
 
 def reduceJpArity (phase := Phase.base) : Pass :=

src/Lean/Compiler/LCNF/Renaming.lean

@@ -55,7 +55,7 @@ def Decl.applyRenaming (decl : Decl) (r : Renaming) : CompilerM Decl := do
     return decl
   else
     let params ← decl.params.mapMonoM (·.applyRenaming r)
-    let value ← decl.value.applyRenaming r
+    let value ← decl.value.mapCodeM (·.applyRenaming r)
     return { decl with params, value }
 
-end Lean.Compiler.LCNF
+end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/Simp.lean

@@ -22,19 +22,20 @@ namespace Lean.Compiler.LCNF
 open Simp
 
 def Decl.simp? (decl : Decl) : SimpM (Option Decl) := do
-  updateFunDeclInfo decl.value
+  let .code code := decl.value | return none
+  updateFunDeclInfo code
   traceM `Compiler.simp.inline.info do return m!"{decl.name}:{Format.nest 2 (← (← get).funDeclInfoMap.format)}"
   traceM `Compiler.simp.step do ppDecl decl
-  let value ← simp decl.value
+  let code ← simp code
   let s ← get
-  let value ← value.applyRenaming s.binderRenaming
-  traceM `Compiler.simp.step.new do return m!"{decl.name} :=\n{← ppCode value}"
-  trace[Compiler.simp.stat] "{decl.name}, size: {value.size}, # visited: {s.visited}, # inline: {s.inline}, # inline local: {s.inlineLocal}"
-  if let some value ← simpJpCases? value then
-    let decl := { decl with value }
+  let code ← code.applyRenaming s.binderRenaming
+  traceM `Compiler.simp.step.new do return m!"{decl.name} :=\n{← ppCode code}"
+  trace[Compiler.simp.stat] "{decl.name}, size: {code.size}, # visited: {s.visited}, # inline: {s.inline}, # inline local: {s.inlineLocal}"
+  if let some code ← simpJpCases? code then
+    let decl := { decl with value := .code code }
     decl.reduceJpArity
   else if (← get).simplified then
-    return some { decl with value }
+    return some { decl with value := .code code }
   else
     return none
 

src/Lean/Compiler/LCNF/Simp/InlineCandidate.lean

@@ -43,6 +43,7 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
     unless (← read).config.inlineDefs do
       return none
     let some decl ← getDecl? declName | return none
+    let .code code := decl.value | return none
     let shouldInline : SimpM Bool := do
       if !decl.inlineIfReduceAttr && decl.recursive then return false
       if mustInline then return true
@@ -63,9 +64,8 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
       if decl.alwaysInlineAttr then return true
       -- TODO: check inlining quota
       if decl.inlineAttr || decl.inlineIfReduceAttr then return true
-      unless decl.noinlineAttr do
-        if (← isSmall decl.value) then return true
-      return false
+      if decl.noinlineAttr then return false
+      isSmall code
     unless (← shouldInline) do return none
     /- check arity -/
     let arity := decl.getArity
@@ -77,7 +77,7 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
       let arg := args[paramIdx]!
       unless (← arg.isConstructorApp) do return none
     let params := decl.instantiateParamsLevelParams us
-    let value := decl.instantiateValueLevelParams us
+    let value := code.instantiateValueLevelParams decl.levelParams us
     let type := decl.instantiateTypeLevelParams us
     incInline
     return some {

src/Lean/Compiler/LCNF/Simp/InlineProj.lean

@@ -69,11 +69,14 @@ where
           visit fvarId projs
       else
         let some decl ← getDecl? declName | failure
-        guard (decl.getArity == args.size)
-        let params := decl.instantiateParamsLevelParams us
-        let code := decl.instantiateValueLevelParams us
-        let code ← betaReduce params code args (mustInline := true)
-        visitCode code projs
+        match decl.value with
+        | .code code =>
+          guard (decl.getArity == args.size)
+          let params := decl.instantiateParamsLevelParams us
+          let code := code.instantiateValueLevelParams decl.levelParams us
+          let code ← betaReduce params code args (mustInline := true)
+          visitCode code projs
+        | .extern .. => failure
 
   visitCode (code : Code) (projs : List Nat) : OptionT (StateRefT (Array CodeDecl) SimpM) FVarId := do
     match code with

src/Lean/Compiler/LCNF/Specialize.lean

@@ -222,6 +222,7 @@ def mkSpecDecl (decl : Decl) (us : List Level) (argMask : Array (Option Arg)) (p
     eraseDecl decl
 where
   go (decl : Decl) (nameNew : Name) : InternalizeM Decl := do
+    let .code code := decl.value | panic! "can only specialize decls with code"
     let mut params ← params.mapM internalizeParam
     let decls ← decls.mapM internalizeCodeDecl
     for param in decl.params, arg in argMask do
@@ -235,11 +236,12 @@ where
     for param in decl.params[argMask.size:] do
       let param := { param with type := param.type.instantiateLevelParamsNoCache decl.levelParams us }
       params := params.push (← internalizeParam param)
-    let value := decl.instantiateValueLevelParams us
-    let value ← internalizeCode value
-    let value := attachCodeDecls decls value
-    let type ← value.inferType
+    let code := code.instantiateValueLevelParams decl.levelParams us
+    let code ← internalizeCode code
+    let code := attachCodeDecls decls code
+    let type ← code.inferType
     let type ← mkForallParams params type
+    let value := .code code
     let safe := decl.safe
     let recursive := decl.recursive
     let decl := { name := nameNew, levelParams := levelParamsNew, params, type, value, safe, recursive, inlineAttr? := none : Decl }
@@ -268,6 +270,7 @@ mutual
     let some paramsInfo ← getSpecParamInfo? declName | return none
     unless (← shouldSpecialize paramsInfo args) do return none
     let some decl ← getDecl? declName | return none
+    let .code _ := decl.value | return none
     trace[Compiler.specialize.candidate] "{e.toExpr}, {paramsInfo}"
     let (argMask, params, decls) ← Collector.collect paramsInfo args
     let keyBody := .const declName us (argMask.filterMap id)
@@ -290,7 +293,7 @@ mutual
       let specDecl ← specDecl.simp {}
       let specDecl ← specDecl.simp { etaPoly := true, inlinePartial := true, implementedBy := true }
       let value ← withReader (fun _ => { declName := specDecl.name }) do
-         withParams specDecl.params <| visitCode specDecl.value
+         withParams specDecl.params <| specDecl.value.mapCodeM visitCode
       let specDecl := { specDecl with value }
       modify fun s => { s with decls := s.decls.push specDecl }
       return some (.const specDecl.name usNew argsNew)
@@ -325,7 +328,7 @@ def main (decl : Decl) : SpecializeM Decl := do
   if (← decl.isTemplateLike) then
     return decl
   else
-    let value ← withParams decl.params <| visitCode decl.value
+    let value ← withParams decl.params <| decl.value.mapCodeM visitCode
     return { decl with value }
 
 end Specialize

src/Lean/Compiler/LCNF/Testing.lean

@@ -235,12 +235,17 @@ Assert that the pass under test produces `Decl`s that do not contain
 `Expr.const constName` in their `Code.let` values anymore.
 -/
 def assertDoesNotContainConstAfter (constName : Name) (msg : String) : TestInstaller :=
-  assertForEachDeclAfterEachOccurrence (fun _ decl => !decl.value.containsConst constName) msg
+  assertForEachDeclAfterEachOccurrence
+    fun _ decl =>
+      match decl.value with
+      | .code c => !c.containsConst constName
+      | .extern .. => true
+    msg
 
 def assertNoFun : TestInstaller :=
   assertAfter do
     for decl in (← getDecls) do
-      decl.value.forM fun
+      decl.value.forCodeM fun
         | .fun .. => throwError "declaration `{decl.name}` contains a local function declaration"
         | _ => return ()
 

src/Lean/Compiler/LCNF/ToDecl.lean

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Meta.Transform
 import Lean.Meta.Match.MatcherInfo
+import Lean.Compiler.ExternAttr
 import Lean.Compiler.ImplementedByAttr
 import Lean.Compiler.LCNF.ToLCNF
 
@@ -96,31 +97,48 @@ The steps for this are roughly:
 def toDecl (declName : Name) : CompilerM Decl := do
   let declName := if let some name := isUnsafeRecName? declName then name else declName
   let some info ← getDeclInfo? declName | throwError "declaration `{declName}` not found"
-  let some value := info.value? (allowOpaque := true) | throwError "declaration `{declName}` does not have a value"
-  let (type, value) ← Meta.MetaM.run' do
-    let type  ← toLCNFType info.type
-    let value ← Meta.lambdaTelescope value fun xs body => do Meta.mkLambdaFVars xs (← Meta.etaExpand body)
-    let value ← replaceUnsafeRecNames value
-    let value ← macroInline value
-    /- Recall that some declarations tagged with `macro_inline` contain matchers. -/
-    let value ← inlineMatchers value
-    /- Recall that `inlineMatchers` may have exposed `ite`s and `dite`s which are tagged as `[macro_inline]`. -/
-    let value ← macroInline value
-    /-
-    Remark: we have disabled the following transformatbion, we will perform it at phase 2, after code specialization.
-    It prevents many optimizations (e.g., "cases-of-ctor").
-    -/
-    -- let value ← applyCasesOnImplementedBy value
-    return (type, value)
-  let value ← toLCNF value
   let safe := !info.isPartial && !info.isUnsafe
   let inlineAttr? := getInlineAttribute? (← getEnv) declName
-  let decl ← if let .fun decl (.return _) := value then
-    eraseFunDecl decl (recursive := false)
-    pure { name := declName, params := decl.params, type, value := decl.value, levelParams := info.levelParams, safe, inlineAttr? : Decl }
+  if let some externAttrData := getExternAttrData? (← getEnv) declName then
+    let paramsFromTypeBinders (expr : Expr) : CompilerM (Array Param) := do
+      let mut params := #[]
+      let mut currentExpr := expr
+      repeat
+        match currentExpr with
+        | .forallE binderName type body _ =>
+          let borrow := isMarkedBorrowed type
+          params := params.push (← mkParam binderName type borrow)
+          currentExpr := body
+        | _ => break
+      return params
+
+    let type ← Meta.MetaM.run' (toLCNFType info.type)
+    let params ← paramsFromTypeBinders type
+    return { name := declName, params, type, value := .extern externAttrData, levelParams := info.levelParams, safe, inlineAttr? }
   else
-    pure { name := declName, params := #[], type, value, levelParams := info.levelParams, safe, inlineAttr? }
-  /- `toLCNF` may eta-reduce simple declarations. -/
-  decl.etaExpand
+    let some value := info.value? (allowOpaque := true) | throwError "declaration `{declName}` does not have a value"
+    let (type, value) ← Meta.MetaM.run' do
+      let type  ← toLCNFType info.type
+      let value ← Meta.lambdaTelescope value fun xs body => do Meta.mkLambdaFVars xs (← Meta.etaExpand body)
+      let value ← replaceUnsafeRecNames value
+      let value ← macroInline value
+      /- Recall that some declarations tagged with `macro_inline` contain matchers. -/
+      let value ← inlineMatchers value
+      /- Recall that `inlineMatchers` may have exposed `ite`s and `dite`s which are tagged as `[macro_inline]`. -/
+      let value ← macroInline value
+      /-
+      Remark: we have disabled the following transformatbion, we will perform it at phase 2, after code specialization.
+      It prevents many optimizations (e.g., "cases-of-ctor").
+      -/
+      -- let value ← applyCasesOnImplementedBy value
+      return (type, value)
+    let code ← toLCNF value
+    let decl ← if let .fun decl (.return _) := code then
+      eraseFunDecl decl (recursive := false)
+      pure { name := declName, params := decl.params, type, value := .code decl.value, levelParams := info.levelParams, safe, inlineAttr? : Decl }
+    else
+      pure { name := declName, params := #[], type, value := .code code, levelParams := info.levelParams, safe, inlineAttr? }
+    /- `toLCNF` may eta-reduce simple declarations. -/
+    decl.etaExpand
 
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ToExpr.lean

@@ -110,7 +110,4 @@ def Code.toExpr (code : Code) (xs : Array FVarId := #[]) : Expr :=
 def FunDeclCore.toExpr (decl : FunDecl) (xs : Array FVarId := #[]) : Expr :=
   run' decl.toExprM xs
 
-def Decl.toExpr (decl : Decl) : Expr :=
-  run do withParams decl.params do mkLambdaM decl.params (← decl.value.toExprM)
-
 end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/ToMono.lean

@@ -143,7 +143,7 @@ where
   go : ToMonoM Decl := do
     let type ← toMonoType decl.type
     let params ← decl.params.mapM (·.toMono)
-    let value ← decl.value.toMono
+    let value ← decl.value.mapCodeM (·.toMono)
     let decl := { decl with type, params, value, levelParams := [] }
     decl.saveMono
     return decl

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/Data/PersistentHashSet.lean

@@ -49,3 +49,8 @@ variable {_ : BEq α} {_ : Hashable α}
 
 @[inline] def fold {β : Type v} (f : β → α → β) (init : β) (s : PersistentHashSet α) : β :=
   Id.run $ s.foldM f init
+
+def toList (s : PersistentHashSet α) : List α :=
+  s.set.toList.map (·.1)
+
+end PersistentHashSet

src/Lean/Elab/Calc.lean

@@ -131,14 +131,18 @@ def throwCalcFailure (steps : Array CalcStepView) (expectedType result : Expr) :
     if ← isDefEqGuarded r er then
       let mut failed := false
       unless ← isDefEqGuarded lhs elhs do
+        let (lhs, elhs) ← addPPExplicitToExposeDiff lhs elhs
+        let (lhsTy, elhsTy) ← addPPExplicitToExposeDiff (← inferType lhs) (← inferType elhs)
         logErrorAt steps[0]!.term m!"\
-          invalid 'calc' step, left-hand side is{indentD m!"{lhs} : {← inferType lhs}"}\n\
-          but is expected to be{indentD m!"{elhs} : {← inferType elhs}"}"
+          invalid 'calc' step, left-hand side is{indentD m!"{lhs} : {lhsTy}"}\n\
+          but is expected to be{indentD m!"{elhs} : {elhsTy}"}"
         failed := true
       unless ← isDefEqGuarded rhs erhs do
+        let (rhs, erhs) ← addPPExplicitToExposeDiff rhs erhs
+        let (rhsTy, erhsTy) ← addPPExplicitToExposeDiff (← inferType rhs) (← inferType erhs)
         logErrorAt steps.back!.term m!"\
-          invalid 'calc' step, right-hand side is{indentD m!"{rhs} : {← inferType rhs}"}\n\
-          but is expected to be{indentD m!"{erhs} : {← inferType erhs}"}"
+          invalid 'calc' step, right-hand side is{indentD m!"{rhs} : {rhsTy}"}\n\
+          but is expected to be{indentD m!"{erhs} : {erhsTy}"}"
         failed := true
       if failed then
         throwAbortTerm

src/Lean/Elab/CheckTactic.lean

@@ -38,6 +38,7 @@ def elabCheckTactic : CommandElab := fun stx => do
       | [next] => do
         let (val, _, _) ← matchCheckGoalType stx (←next.getType)
         if !(← Meta.withReducible <| isDefEq val expTerm) then
+          let (val, expTerm) ← addPPExplicitToExposeDiff val expTerm
           throwErrorAt stx
             m!"Term reduces to{indentExpr val}\nbut is expected to reduce to {indentExpr expTerm}"
       | _ => do

src/Lean/Elab/Deriving.lean

@@ -16,3 +16,4 @@ import Lean.Elab.Deriving.FromToJson
 import Lean.Elab.Deriving.SizeOf
 import Lean.Elab.Deriving.Hashable
 import Lean.Elab.Deriving.Ord
+import Lean.Elab.Deriving.ToExpr

src/Lean/Elab/Deriving/ToExpr.lean

@@ -0,0 +1,237 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kyle Miller
+-/
+prelude
+import Lean.Meta.Transform
+import Lean.Elab.Deriving.Basic
+import Lean.Elab.Deriving.Util
+import Lean.ToLevel
+import Lean.ToExpr
+
+/-!
+# `ToExpr` deriving handler
+
+This module defines a `ToExpr` deriving handler for inductive types.
+It supports mutually inductive types as well.
+
+The `ToExpr` deriving handlers support universe level polymorphism, via the `Lean.ToLevel` class.
+To use `ToExpr` in places where there is universe polymorphism, make sure a `[ToLevel.{u}]` instance is available,
+though be aware that the `ToLevel` mechanism does not support `max` or `imax` expressions.
+
+Implementation note: this deriving handler was initially modeled after the `Repr` deriving handler, but
+1. we need to account for universe levels,
+2. the `ToExpr` class has two fields rather than one, and
+3. we don't handle structures specially.
+-/
+
+namespace Lean.Elab.Deriving.ToExpr
+
+open Lean Elab Parser.Term
+open Meta Command Deriving
+
+/--
+Given `args := #[e₁, e₂, …, eₙ]`, constructs the syntax `Expr.app (… (Expr.app (Expr.app f e₁) e₂) …) eₙ`.
+-/
+def mkAppNTerm (f : Term) (args : Array Term) : MetaM Term :=
+  args.foldlM (fun a b => ``(Expr.app $a $b)) f
+
+/-- Fixes the output of `mkInductiveApp` to explicitly reference universe levels. -/
+def updateIndType (indVal : InductiveVal) (t : Term) : TermElabM Term :=
+  let levels := indVal.levelParams.toArray.map mkIdent
+  match t with
+  | `(@$f $args*) => `(@$f.{$levels,*} $args*)
+  | _ => throwError "(internal error) expecting output of `mkInductiveApp`"
+
+/--
+Creates a term that evaluates to an expression representing the inductive type.
+Uses `toExpr` and `toTypeExpr` for the arguments to the type constructor.
+-/
+def mkToTypeExpr (indVal : InductiveVal) (argNames : Array Name) : TermElabM Term := do
+  let levels ← indVal.levelParams.toArray.mapM (fun u => `(Lean.toLevel.{$(mkIdent u)}))
+  forallTelescopeReducing indVal.type fun xs _ => do
+    let mut args : Array Term := #[]
+    for argName in argNames, x in xs do
+      let a := mkIdent argName
+      if ← Meta.isType x then
+        args := args.push <| ← ``(toTypeExpr $a)
+      else
+        args := args.push <| ← ``(toExpr $a)
+    mkAppNTerm (← ``(Expr.const $(quote indVal.name) [$levels,*])) args
+
+/--
+Creates the body of the `toExpr` function for the `ToExpr` instance, which is a `match` expression
+that calls `toExpr` and `toTypeExpr` to assemble an expression for a given term.
+For recursive inductive types, `auxFunName` refers to the `ToExpr` instance for the current type.
+For mutually recursive types, we rely on the local instances set up by `mkLocalInstanceLetDecls`.
+-/
+def mkToExprBody (header : Header) (indVal : InductiveVal) (auxFunName : Name) (levelInsts : Array Term) :
+    TermElabM Term := do
+  let discrs ← mkDiscrs header indVal
+  let alts ← mkAlts
+  `(match $[$discrs],* with $alts:matchAlt*)
+where
+  /-- Create the `match` cases, one per constructor. -/
+  mkAlts : TermElabM (Array (TSyntax ``matchAlt)) := do
+    let levels ← levelInsts.mapM fun inst => `($(inst).toLevel)
+    let mut alts := #[]
+    for ctorName in indVal.ctors do
+      let ctorInfo ← getConstInfoCtor ctorName
+      let alt ← forallTelescopeReducing ctorInfo.type fun xs _ => do
+        let mut patterns := #[]
+        -- add `_` pattern for indices, before the constructor's pattern
+        for _ in [:indVal.numIndices] do
+          patterns := patterns.push (← `(_))
+        let mut ctorArgs := #[]
+        let mut rhsArgs : Array Term := #[]
+        let mkArg (x : Expr) (a : Term) : TermElabM Term := do
+          if (← inferType x).isAppOf indVal.name then
+            `($(mkIdent auxFunName) $levelInsts* $a)
+          else if ← Meta.isType x then
+            ``(toTypeExpr $a)
+          else
+            ``(toExpr $a)
+        -- add `_` pattern for inductive parameters, which are inaccessible
+        for i in [:ctorInfo.numParams] do
+          let a := mkIdent header.argNames[i]!
+          ctorArgs := ctorArgs.push (← `(_))
+          rhsArgs := rhsArgs.push <| ← mkArg xs[i]! a
+        for i in [:ctorInfo.numFields] do
+          let a := mkIdent (← mkFreshUserName `a)
+          ctorArgs := ctorArgs.push a
+          rhsArgs := rhsArgs.push <| ← mkArg xs[ctorInfo.numParams + i]! a
+        patterns := patterns.push (← `(@$(mkIdent ctorName):ident $ctorArgs:term*))
+        let rhs : Term ← mkAppNTerm (← ``(Expr.const $(quote ctorInfo.name) [$levels,*])) rhsArgs
+        `(matchAltExpr| | $[$patterns:term],* => $rhs)
+      alts := alts.push alt
+    return alts
+
+/--
+For nested and mutually recursive inductive types, we define `partial` instances,
+and the strategy is to have local `ToExpr` instances in scope for the body of each instance.
+This way, each instance can freely use `toExpr` and `toTypeExpr` for each of the types in `ctx`.
+
+This is a modified copy of `Lean.Elab.Deriving.mkLocalInstanceLetDecls`,
+since we need to include the `toTypeExpr` field in the `letDecl`
+Note that, for simplicity, each instance gets its own definition of each others' `toTypeExpr` fields.
+These are very simple fields, so avoiding the duplication is not worth it.
+-/
+def mkLocalInstanceLetDecls (ctx : Deriving.Context) (argNames : Array Name) (levelInsts : Array Term) :
+    TermElabM (Array (TSyntax ``Parser.Term.letDecl)) := do
+  let mut letDecls := #[]
+  for indVal in ctx.typeInfos, auxFunName in ctx.auxFunNames do
+    let currArgNames ← mkInductArgNames indVal
+    let numParams    := indVal.numParams
+    let currIndices  := currArgNames[numParams:]
+    let binders      ← mkImplicitBinders currIndices
+    let argNamesNew  := argNames[:numParams] ++ currIndices
+    let indType      ← mkInductiveApp indVal argNamesNew
+    let instName     ← mkFreshUserName `localinst
+    let toTypeExpr   ← mkToTypeExpr indVal argNames
+    -- Recall that mutually inductive types all use the same universe levels, hence we pass the same ToLevel instances to each aux function.
+    let letDecl      ← `(Parser.Term.letDecl| $(mkIdent instName):ident $binders:implicitBinder* : ToExpr $indType :=
+                          { toExpr     := $(mkIdent auxFunName) $levelInsts*,
+                            toTypeExpr := $toTypeExpr })
+    letDecls := letDecls.push letDecl
+  return letDecls
+
+open TSyntax.Compat in
+/--
+Makes a `toExpr` function for the given inductive type.
+The implementation of each `toExpr` function for a (mutual) inductive type is given as top-level private definitions.
+These are assembled into `ToExpr` instances in `mkInstanceCmds`.
+For mutual/nested inductive types, then each of the types' `ToExpr` instances are provided as local instances,
+to wire together the recursion (necessitating these auxiliary definitions being `partial`).
+-/
+def mkAuxFunction (ctx : Deriving.Context) (i : Nat) : TermElabM Command := do
+  let auxFunName := ctx.auxFunNames[i]!
+  let indVal     := ctx.typeInfos[i]!
+  let header     ← mkHeader ``ToExpr 1 indVal
+  /- We make the `ToLevel` instances be explicit here so that we can pass the instances from the instances to the
+     aux functions. This lets us ensure universe level variables are being lined up,
+     without needing to use `ident.{u₁,…,uₙ}` syntax, which could conditionally be incorrect
+     depending on the ambient CommandElabM scope state.
+     TODO(kmill): deriving handlers should run in a scope with no `universes` or `variables`. -/
+  let (toLevelInsts, levelBinders) := Array.unzip <| ← indVal.levelParams.toArray.mapM fun u => do
+    let inst := mkIdent (← mkFreshUserName `inst)
+    return (inst, ← `(explicitBinderF| ($inst : ToLevel.{$(mkIdent u)})))
+  let mut body ← mkToExprBody header indVal auxFunName toLevelInsts
+  if ctx.usePartial then
+    let letDecls ← mkLocalInstanceLetDecls ctx header.argNames toLevelInsts
+    body ← mkLet letDecls body
+  /- We need to alter the last binder (the one for the "target") to have explicit universe levels
+     so that the `ToLevel` instance arguments can use them. -/
+  let addLevels binder :=
+    match binder with
+    | `(bracketedBinderF| ($a : $ty)) => do `(bracketedBinderF| ($a : $(← updateIndType indVal ty)))
+    | _ => throwError "(internal error) expecting inst binder"
+  let binders := header.binders.pop ++ levelBinders ++ #[← addLevels header.binders.back!]
+  if ctx.usePartial then
+    `(private partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Expr := $body:term)
+  else
+    `(private         def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Expr := $body:term)
+
+/--
+Creates all the auxiliary functions (using `mkAuxFunction`) for the (mutual) inductive type(s).
+Wraps the resulting definition commands in `mutual ... end`.
+-/
+def mkAuxFunctions (ctx : Deriving.Context) : TermElabM Syntax := do
+  let mut auxDefs := #[]
+  for i in [:ctx.typeInfos.size] do
+    auxDefs := auxDefs.push (← mkAuxFunction ctx i)
+  `(mutual $auxDefs:command* end)
+
+open TSyntax.Compat in
+/--
+Assuming all of the auxiliary definitions exist,
+creates all the `instance` commands for the `ToExpr` instances for the (mutual) inductive type(s).
+This is a modified copy of `Lean.Elab.Deriving.mkInstanceCmds` to account for `ToLevel` instances.
+-/
+def mkInstanceCmds (ctx : Deriving.Context) (typeNames : Array Name) :
+    TermElabM (Array Command) := do
+  let mut instances := #[]
+  for indVal in ctx.typeInfos, auxFunName in ctx.auxFunNames do
+    if typeNames.contains indVal.name then
+      let argNames     ← mkInductArgNames indVal
+      let binders      ← mkImplicitBinders argNames
+      let binders      := binders ++ (← mkInstImplicitBinders ``ToExpr indVal argNames)
+      let (toLevelInsts, levelBinders) := Array.unzip <| ← indVal.levelParams.toArray.mapM fun u => do
+        let inst := mkIdent (← mkFreshUserName `inst)
+        return (inst, ← `(instBinderF| [$inst : ToLevel.{$(mkIdent u)}]))
+      let binders      := binders ++ levelBinders
+      let indType      ← updateIndType indVal (← mkInductiveApp indVal argNames)
+      let toTypeExpr   ← mkToTypeExpr indVal argNames
+      let instCmd ← `(instance $binders:implicitBinder* : ToExpr $indType where
+                        toExpr := $(mkIdent auxFunName) $toLevelInsts*
+                        toTypeExpr := $toTypeExpr)
+      instances := instances.push instCmd
+  return instances
+
+/--
+Returns all the commands necessary to construct the `ToExpr` instances.
+-/
+def mkToExprInstanceCmds (declNames : Array Name) : TermElabM (Array Syntax) := do
+  let ctx ← mkContext "toExpr" declNames[0]!
+  let cmds := #[← mkAuxFunctions ctx] ++ (← mkInstanceCmds ctx declNames)
+  trace[Elab.Deriving.toExpr] "\n{cmds}"
+  return cmds
+
+/--
+The main entry point to the `ToExpr` deriving handler.
+-/
+def mkToExprInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
+  if (← declNames.allM isInductive) && declNames.size > 0 then
+    let cmds ← withFreshMacroScope <| liftTermElabM <| mkToExprInstanceCmds declNames
+    -- Enable autoimplicits, used for universe levels.
+    withScope (fun scope => { scope with opts := autoImplicit.set scope.opts true }) do
+      elabCommand (mkNullNode cmds)
+    return true
+  else
+    return false
+
+builtin_initialize
+  registerDerivingHandler ``Lean.ToExpr mkToExprInstanceHandler
+  registerTraceClass `Elab.Deriving.toExpr
+
+end Lean.Elab.Deriving.ToExpr

src/Lean/Elab/Structure.lean

@@ -691,6 +691,9 @@ private def addProjections (r : ElabHeaderResult) (fieldInfos : Array StructFiel
   let env ← getEnv
   let env ← ofExceptKernelException (mkProjections env r.view.declName projNames.toList r.view.isClass)
   setEnv env
+  for fieldInfo in fieldInfos do
+    if fieldInfo.isSubobject then
+      addDeclarationRangesFromSyntax fieldInfo.declName r.view.ref fieldInfo.ref
 
 private def registerStructure (structName : Name) (infos : Array StructFieldInfo) : TermElabM Unit := do
   let fields ← infos.filterMapM fun info => do
@@ -775,14 +778,14 @@ private def setSourceInstImplicit (type : Expr) : Expr :=
 /--
 Creates a projection function to a non-subobject parent.
 -/
-private partial def mkCoercionToCopiedParent (levelParams : List Name) (params : Array Expr) (view : StructView) (source : Expr) (parentStructName : Name) (parentType : Expr) : MetaM StructureParentInfo := do
+private partial def mkCoercionToCopiedParent (levelParams : List Name) (params : Array Expr) (view : StructView) (source : Expr) (parent : StructParentInfo) (parentType : Expr) : MetaM StructureParentInfo := do
   let isProp ← Meta.isProp parentType
   let env ← getEnv
   let structName := view.declName
   let sourceFieldNames := getStructureFieldsFlattened env structName
-  let binfo := if view.isClass && isClass env parentStructName then BinderInfo.instImplicit else BinderInfo.default
+  let binfo := if view.isClass && isClass env parent.structName then BinderInfo.instImplicit else BinderInfo.default
   let mut declType ← instantiateMVars (← mkForallFVars params (← mkForallFVars #[source] parentType))
-  if view.isClass && isClass env parentStructName then
+  if view.isClass && isClass env parent.structName then
     declType := setSourceInstImplicit declType
   declType := declType.inferImplicit params.size true
   let rec copyFields (parentType : Expr) : MetaM Expr := do
@@ -823,7 +826,8 @@ private partial def mkCoercionToCopiedParent (levelParams : List Name) (params :
   -- (Instances will get instance reducibility in `Lean.Elab.Command.addParentInstances`.)
   if !binfo.isInstImplicit && !(← Meta.isProp parentType) then
     setReducibleAttribute declName
-  return { structName := parentStructName, subobject := false, projFn := declName }
+  addDeclarationRangesFromSyntax declName view.ref parent.ref
+  return { structName := parent.structName, subobject := false, projFn := declName }
 
 private def mkRemainingProjections (levelParams : List Name) (params : Array Expr) (view : StructView)
     (parents : Array StructParentInfo) (fieldInfos : Array StructFieldInfo) : TermElabM (Array StructureParentInfo) := do
@@ -844,7 +848,7 @@ private def mkRemainingProjections (levelParams : List Name) (params : Array Exp
           pure { structName := parent.structName, subobject := true, projFn := info.declName }
         else
           let parent_type := (← instantiateMVars parent.type).replace fun e => parentFVarToConst[e]?
-          mkCoercionToCopiedParent levelParams params view source parent.structName parent_type)
+          mkCoercionToCopiedParent levelParams params view source parent parent_type)
       parentInfos := parentInfos.push parentInfo
       if let some fvar := parent.fvar? then
         parentFVarToConst := parentFVarToConst.insert fvar <|

src/Lean/Elab/Tactic.lean

@@ -44,3 +44,5 @@ import Lean.Elab.Tactic.DiscrTreeKey
 import Lean.Elab.Tactic.BVDecide
 import Lean.Elab.Tactic.BoolToPropSimps
 import Lean.Elab.Tactic.Classical
+import Lean.Elab.Tactic.Grind
+import Lean.Elab.Tactic.Monotonicity

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

@@ -82,7 +82,7 @@ instance : ToExpr Gate where
     | .and => mkConst ``Gate.and
     | .xor => mkConst ``Gate.xor
     | .beq => mkConst ``Gate.beq
-    | .imp => mkConst ``Gate.imp
+    | .or => mkConst ``Gate.or
   toTypeExpr := mkConst ``Gate
 
 instance : ToExpr BVPred where

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

@@ -91,7 +91,7 @@ where
     | .and => ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
     | .xor => ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
     | .beq => ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
-    | .imp => ``Std.Tactic.BVDecide.Reflect.Bool.imp_congr
+    | .or => ``Std.Tactic.BVDecide.Reflect.Bool.or_congr
 
 /--
 Construct the reified version of `Bool.not subExpr`.
@@ -136,7 +136,7 @@ def mkIte (discr lhs rhs : ReifiedBVLogical) (discrExpr lhsExpr rhsExpr : Expr)
         lhsEvalExpr lhsProof?
         rhsEvalExpr rhsProof? | return none
     return mkApp9
-      (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.ite_congr)
+      (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.cond_congr)
       discrExpr lhsExpr rhsExpr
       discrEvalExpr lhsEvalExpr rhsEvalExpr
       discrProof lhsProof rhsProof

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

@@ -22,67 +22,70 @@ This function adds the two lemmas:
 - `discrExpr = false → atomExpr = rhsExpr`
 It assumes that `discrExpr`, `lhsExpr` and `rhsExpr` are the expressions corresponding to `discr`,
 `lhs` and `rhs`. Furthermore it assumes that `atomExpr` is of the form
-`if discrExpr = true then lhsExpr else rhsExpr`.
+`bif discrExpr then lhsExpr else rhsExpr`.
 -/
-def addIfLemmas (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
+def addCondLemmas (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
     (discrExpr atomExpr lhsExpr rhsExpr : Expr) : LemmaM Unit := do
-  let some trueLemma ← mkIfTrueLemma discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
+  let some trueLemma ← mkCondTrueLemma discr atom lhs discrExpr atomExpr lhsExpr rhsExpr | return ()
   LemmaM.addLemma trueLemma
-  let some falseLemma ← mkIfFalseLemma discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
+  let some falseLemma ← mkCondFalseLemma discr atom rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
   LemmaM.addLemma falseLemma
 where
-  mkIfTrueLemma (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
-      (discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) :=
-    mkIfLemma true discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr
-
-  mkIfFalseLemma (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
-      (discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) :=
-    mkIfLemma false discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr
-
-  mkIfLemma (discrVal : Bool) (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
+  mkCondTrueLemma (discr : ReifiedBVLogical) (atom lhs : ReifiedBVExpr)
       (discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) := do
-    let resExpr := if discrVal then lhsExpr else rhsExpr
-    let resValExpr := if discrVal then lhs else rhs
-    let lemmaName :=
-      if discrVal then
-        ``Std.Tactic.BVDecide.Reflect.BitVec.if_true
-      else
-        ``Std.Tactic.BVDecide.Reflect.BitVec.if_false
-    let discrValExpr := toExpr discrVal
-    let discrVal ← ReifiedBVLogical.mkBoolConst discrVal
+    let resExpr := lhsExpr
+    let resValExpr := lhs
+    let lemmaName := ``Std.Tactic.BVDecide.Reflect.BitVec.cond_true
 
-    let eqDiscrExpr ← mkAppM ``BEq.beq #[discrExpr, discrValExpr]
-    let eqDiscr ← ReifiedBVLogical.mkGate discr discrVal discrExpr discrValExpr .beq
+
+    let notDiscrExpr := mkApp (mkConst ``Bool.not) discrExpr
+    let notDiscr ← ReifiedBVLogical.mkNot discr discrExpr
 
     let eqBVExpr ← mkAppM ``BEq.beq #[atomExpr, resExpr]
     let some eqBVPred ← ReifiedBVPred.mkBinPred atom resValExpr atomExpr resExpr .eq | return none
     let eqBV ← ReifiedBVLogical.ofPred eqBVPred
 
-    let imp ← ReifiedBVLogical.mkGate eqDiscr eqBV eqDiscrExpr eqBVExpr .imp
+    let imp ← ReifiedBVLogical.mkGate notDiscr eqBV notDiscrExpr eqBVExpr .or
 
     let proof := do
       let evalExpr ← ReifiedBVLogical.mkEvalExpr imp.expr
       let congrProof := (← imp.evalsAtAtoms).getD (ReifiedBVLogical.mkRefl evalExpr)
       let lemmaProof := mkApp4 (mkConst lemmaName) (toExpr lhs.width) discrExpr lhsExpr rhsExpr
 
-      let trueExpr := mkConst ``Bool.true
-      let eqDiscrTrueExpr ← mkEq eqDiscrExpr trueExpr
-      let eqBVExprTrueExpr ← mkEq eqBVExpr trueExpr
-      let impExpr ← mkArrow eqDiscrTrueExpr eqBVExprTrueExpr
-      -- construct a `Decidable` instance for the implication using forall_prop_decidable
-      let decEqDiscrTrue := mkApp2 (mkConst ``instDecidableEqBool) eqDiscrExpr trueExpr
-      let decEqBVExprTrue := mkApp2 (mkConst ``instDecidableEqBool) eqBVExpr trueExpr
-      let impDecidable := mkApp4 (mkConst ``forall_prop_decidable)
-        eqDiscrTrueExpr
-        (.lam .anonymous eqDiscrTrueExpr eqBVExprTrueExpr .default)
-        decEqDiscrTrue
-        (.lam .anonymous eqDiscrTrueExpr decEqBVExprTrue .default)
-
-      let decideImpExpr := mkApp2 (mkConst ``Decidable.decide) impExpr impDecidable
+      -- !discr || (atom == rhs)
+      let impExpr := mkApp2 (mkConst ``Bool.or) notDiscrExpr eqBVExpr
 
       return mkApp4
         (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.lemma_congr)
-        decideImpExpr
+        impExpr
+        evalExpr
+        congrProof
+        lemmaProof
+    return some ⟨imp.bvExpr, proof, imp.expr⟩
+
+  mkCondFalseLemma (discr : ReifiedBVLogical) (atom rhs : ReifiedBVExpr)
+      (discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) := do
+    let resExpr := rhsExpr
+    let resValExpr := rhs
+    let lemmaName := ``Std.Tactic.BVDecide.Reflect.BitVec.cond_false
+
+    let eqBVExpr ← mkAppM ``BEq.beq #[atomExpr, resExpr]
+    let some eqBVPred ← ReifiedBVPred.mkBinPred atom resValExpr atomExpr resExpr .eq | return none
+    let eqBV ← ReifiedBVLogical.ofPred eqBVPred
+
+    let imp ← ReifiedBVLogical.mkGate discr eqBV discrExpr eqBVExpr .or
+
+    let proof := do
+      let evalExpr ← ReifiedBVLogical.mkEvalExpr imp.expr
+      let congrProof := (← imp.evalsAtAtoms).getD (ReifiedBVLogical.mkRefl evalExpr)
+      let lemmaProof := mkApp4 (mkConst lemmaName) (toExpr rhs.width) discrExpr lhsExpr rhsExpr
+
+      -- discr || (atom == rhs)
+      let impExpr := mkApp2 (mkConst ``Bool.or) discrExpr eqBVExpr
+
+      return mkApp4
+        (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.lemma_congr)
+        impExpr
         evalExpr
         congrProof
         lemmaProof