feat: safe exponentiation

- Adds configuration option `exponentiation.threshold`
- An expression `b^n` where `b` and `n` are literals is not reduced by
  `whnf`, `simp`, and `isDefEq` if `n > exponentiation.threshold`.

Motivation: prevents system from becoming irresponsive.

TODO: improve support in the kernel. It is using a hard-coded limit
for now.

.github/workflows/actionlint.yml

@@ -15,7 +15,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
     - name: Checkout
-      uses: actions/checkout@v4
+      uses: actions/checkout@v3
     - name: actionlint
       uses: raven-actions/actionlint@v1
       with:

.github/workflows/ci.yml

@@ -9,17 +9,6 @@ on:
   merge_group:
   schedule:
     - cron: '0 7 * * *'  # 8AM CET/11PM PT
-  # for manual re-release of a nightly
-  workflow_dispatch:
-    inputs:
-      action:
-        description: 'Action'
-        required: true
-        default: 'release nightly'
-        type: choice
-        options:
-        - release nightly
-
 
 concurrency:
   group: ${{ github.workflow }}-${{ github.ref }}-${{ github.event_name }}
@@ -52,11 +41,11 @@ jobs:
 
     steps:
       - name: Checkout
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         # don't schedule nightlies on forks
-        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
+        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
       - name: Set Nightly
-        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
+        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
         id: set-nightly
         run: |
           if [[ -n '${{ secrets.PUSH_NIGHTLY_TOKEN }}' ]]; then
@@ -397,7 +386,7 @@ jobs:
           else
             ${{ matrix.tar || 'tar' }} cf - $dir | zstd -T0 --no-progress -o pack/$dir.tar.zst
           fi
-      - uses: actions/upload-artifact@v4
+      - uses: actions/upload-artifact@v3
         if: matrix.release
         with:
           name: build-${{ matrix.name }}
@@ -470,7 +459,7 @@ jobs:
     runs-on: ubuntu-latest
     needs: build
     steps:
-      - uses: actions/download-artifact@v4
+      - uses: actions/download-artifact@v3
         with:
           path: artifacts
       - name: Release
@@ -495,12 +484,12 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           # needed for tagging
           fetch-depth: 0
           token: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
-      - uses: actions/download-artifact@v4
+      - uses: actions/download-artifact@v3
         with:
           path: artifacts
       - name: Prepare Nightly Release

.github/workflows/nix-ci.yml

@@ -50,7 +50,7 @@ jobs:
       NIX_BUILD_ARGS: --print-build-logs --fallback
     steps:
       - name: Checkout
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           # the default is to use a virtual merge commit between the PR and master: just use the PR
           ref: ${{ github.event.pull_request.head.sha }}

.github/workflows/pr-release.yml

@@ -234,7 +234,7 @@ jobs:
       # Checkout the Batteries repository with all branches
       - name: Checkout Batteries repository
         if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           repository: leanprover-community/batteries
           token: ${{ secrets.MATHLIB4_BOT }}
@@ -291,7 +291,7 @@ jobs:
       # Checkout the mathlib4 repository with all branches
       - name: Checkout mathlib4 repository
         if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
         with:
           repository: leanprover-community/mathlib4
           token: ${{ secrets.MATHLIB4_BOT }}
@@ -328,7 +328,7 @@ jobs:
             git switch -c lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} "$BASE"
             echo "leanprover/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}" > lean-toolchain
             git add lean-toolchain
-            sed -i 's,require "leanprover-community" / "batteries" @ ".\+",require "leanprover-community" / "batteries" @ "git#nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
+            sed -i "s/require batteries from git \"https:\/\/github.com\/leanprover-community\/batteries\" @ \".\+\"/require batteries from git \"https:\/\/github.com\/leanprover-community\/batteries\" @ \"nightly-testing-${MOST_RECENT_NIGHTLY}\"/" lakefile.lean
             lake update batteries
             git add lakefile.lean lake-manifest.json
             git commit -m "Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"

.github/workflows/restart-on-label.yml

@@ -20,12 +20,10 @@ jobs:
         gh run view "$run_id"
         echo "Cancelling (just in case)"
         gh run cancel "$run_id" || echo "(failed)"
-        echo "Waiting for 30s"
-        sleep 30
-        gh run view "$run_id"
+        echo "Waiting for 10s"
+        sleep 10
         echo "Rerunning"
         gh run rerun "$run_id"
-        gh run view "$run_id"
       shell: bash
       env:
         head_ref: ${{ github.head_ref }}

.github/workflows/update-stage0.yml

@@ -23,7 +23,7 @@ jobs:
     # This action should push to an otherwise protected branch, so it
     # uses a deploy key with write permissions, as suggested at
     # https://stackoverflow.com/a/76135647/946226
-    - uses: actions/checkout@v4
+    - uses: actions/checkout@v3
       with:
         ssh-key: ${{secrets.STAGE0_SSH_KEY}}
     - run: echo "should_update_stage0=yes" >> "$GITHUB_ENV"

CODEOWNERS

@@ -42,4 +42,4 @@
 /src/Lean/Elab/Tactic/Guard.lean @digama0
 /src/Init/Guard.lean @digama0
 /src/Lean/Server/CodeActions/ @digama0
-/src/Std/ @TwoFX
+

doc/dev/release_checklist.md

@@ -5,8 +5,7 @@ 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/`, then the release notes are not done. (See the section "Writing the release notes".)
+- One week before the planned release, ensure that someone has written the first draft of the release blog post
 - `git checkout releases/v4.6.0`
   (This branch should already exist, from the release candidates.)
 - `git pull`
@@ -14,6 +13,11 @@ We'll use `v4.6.0` as the intended release version as a running example.
   - `set(LEAN_VERSION_MINOR 6)` (for whichever `6` is appropriate)
   - `set(LEAN_VERSION_IS_RELEASE 1)`
   - (both of these should already be in place from the release candidates)
+- In `RELEASES.md`, verify that the `v4.6.0` section has been completed during the release candidate cycle.
+  It should be in bullet point form, with a point for every significant PR,
+  and may have a paragraph describing each major new language feature.
+  It should have a "breaking changes" section calling out changes that are specifically likely
+  to cause problems for downstream users.
 - `git tag v4.6.0`
 - `git push $REMOTE v4.6.0`, where `$REMOTE` is the upstream Lean repository (e.g., `origin`, `upstream`)
 - Now wait, while CI runs.
@@ -24,9 +28,8 @@ We'll use `v4.6.0` as the intended release version as a running example.
     you may want to start on the release candidate checklist now.
 - Go to https://github.com/leanprover/lean4/releases and verify that the `v4.6.0` release appears.
   - Edit the release notes on Github to select the "Set as the latest release".
-  - Follow the instructions in creating a release candidate for the "GitHub release notes" step,
-    now that we have a written `RELEASES.md` section.
-    Do a quick sanity check.
+  - Copy and paste the Github release notes from the previous releases candidate for this version
+    (e.g. `v4.6.0-rc1`), and quickly sanity check.
 - Next, we will move a curated list of downstream repos to the latest stable release.
   - For each of the repositories listed below:
     - Make a PR to `master`/`main` changing the toolchain to `v4.6.0`
@@ -89,10 +92,6 @@ 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`
-- 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`
-    and commit this to `master`.
 - Merge the release announcement PR for the Lean website - it will be deployed automatically
 - Finally, make an announcement!
   This should go in https://leanprover.zulipchat.com/#narrow/stream/113486-announce, with topic `v4.6.0`.
@@ -103,6 +102,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
 
 ## Optimistic(?) time estimates:
 - Initial checks and push the tag: 30 minutes.
+- Note that if `RELEASES.md` has discrepancies this could take longer!
 - Waiting for the release: 60 minutes.
 - Fixing release notes: 10 minutes.
 - Bumping toolchains in downstream repositories, up to creating the Mathlib PR: 30 minutes.
@@ -129,26 +129,29 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
     git checkout nightly-2024-02-29
     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.
+- In `RELEASES.md` remove `(development in progress)` from the `v4.7.0` section header.
+- Our current goal is to have written release notes only about major language features or breaking changes,
+  and to rely on automatically generated release notes for bugfixes and minor changes.
+  - Do not wait on `RELEASES.md` being perfect before creating the `release/v4.7.0` branch. It is essential to choose the nightly which will become the release candidate as early as possible, to avoid confusion.
+  - If there are major changes not reflected in `RELEASES.md` already, you may need to solicit help from the authors.
+  - Minor changes and bug fixes do not need to be documented in `RELEASES.md`: they will be added automatically on the Github release page.
+  - Commit your changes to `RELEASES.md`, and push.
+  - Remember that changes to `RELEASES.md` after you have branched `releases/v4.7.0` should also be cherry-picked back to `master`.
 - 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.
-- (GitHub release notes) Once the release appears at https://github.com/leanprover/lean4/releases/
+- Once the release appears at https://github.com/leanprover/lean4/releases/
   - Edit the release notes on Github to select the "Set as a pre-release box".
-  - If release notes have been written already, copy the section of `RELEASES.md` for this version into the Github release notes
-    and use the title "Changes since v4.6.0 (from RELEASES.md)".
-  - Otherwise, in the "previous tag" dropdown, select `v4.6.0`, and click "Generate release notes".
-    This will add a list of all the commits since the last stable version.
+  - Copy the section of `RELEASES.md` for this version into the Github release notes.
+  - Use the title "Changes since v4.6.0 (from RELEASES.md)"
+  - Then in the "previous tag" dropdown, select `v4.6.0`, and click "Generate release notes".
+  - This will add a list of all the commits since the last stable version.
     - Delete anything already mentioned in the hand-written release notes above.
     - Delete "update stage0" commits, and anything with a completely inscrutable commit message.
     - Briefly rearrange the remaining items by category (e.g. `simp`, `lake`, `bug fixes`),
@@ -174,9 +177,6 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
   - We do this for the same list of repositories as for stable releases, see above.
     As above, there are dependencies between these, and so the process above is iterative.
     It greatly helps if you can merge the `bump/v4.7.0` PRs yourself!
-    It is essential for Mathlib CI that you then create the next `bump/v4.8.0` branch
-    for the next development cycle.
-    Set the `lean-toolchain` file on this branch to same `nightly` you used for this release.
   - For Batteries/Aesop/Mathlib, which maintain a `nightly-testing` branch, make sure there is a tag
     `nightly-testing-2024-02-29` with date corresponding to the nightly used for the release
     (create it if not), and then on the `nightly-testing` branch `git reset --hard master`, and force push.
@@ -187,17 +187,12 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
   Please also make sure that whoever is handling social media knows the release is out.
 - Begin the next development cycle (i.e. for `v4.8.0`) on the Lean repository, by making a PR that:
   - Updates `src/CMakeLists.txt` to say `set(LEAN_VERSION_MINOR 8)`
-  - Replaces the "development in progress" in the `v4.7.0` section of `RELEASES.md` with
-    ```
-    Release candidate, release notes will be copied from `branch releases/v4.7.0` once completed.
-    ```
-    and inserts the following section before that section:
-    ```
-    v4.8.0
-    ----------
-    Development in progress.
-    ```
-  - Removes all the entries from the `./releases_drafts/` folder.
+  - In `RELEASES.md`, update the `v4.7.0` section to say:
+    "Release candidate, release notes will be copied from branch `releases/v4.7.0` once completed."
+    Make sure that whoever is preparing the release notes during this cycle knows that it is their job to do so!
+  - In `RELEASES.md`, update the `v4.8.0` section to say:
+    "Development in progress".
+  - In `RELEASES.md`, verify that the old section `v4.6.0` has the full releases notes from the `releases/v4.6.0` branch.
 
 ## Time estimates:
 Slightly longer than the corresponding steps for a stable release.
@@ -231,18 +226,3 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
 * It is always okay to merge in the following directions:
   `master` -> `bump/v4.7.0` -> `bump/nightly-2024-02-15` -> `nightly-testing`.
   Please remember to push any merges you make to intermediate steps!
-
-# 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:
-
-* 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 be copied to `master`.
-* 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.
-  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`).

doc/int.md

@@ -13,7 +13,7 @@ Recall that nonnegative numerals are considered to be a `Nat` if there are no ty
 
 The operator `/` for `Int` implements integer division.
 ```lean
-#eval -10 / 4 -- -3
+#eval -10 / 4 -- -2
 ```
 
 Similar to `Nat`, the internal representation of `Int` is optimized. Small integers are

src/CMakeLists.txt

@@ -300,11 +300,11 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
     cmake_path(GET ZLIB_LIBRARY PARENT_PATH ZLIB_LIBRARY_PARENT_PATH)
     string(APPEND LEANSHARED_LINKER_FLAGS " -L ${ZLIB_LIBRARY_PARENT_PATH}")
   endif()
-  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lleanrt")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lleanrt")
 elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
-  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lnodefs.js -lleanrt")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lnodefs.js -lleanrt")
 else()
-  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -lStd -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
 endif()
 
 set(LEAN_CXX_STDLIB "-lstdc++" CACHE STRING "C++ stdlib linker flags")
@@ -313,7 +313,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
   set(LEAN_CXX_STDLIB "-lc++")
 endif()
 
-string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
+string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB} -lStd")
 string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
 
 # in local builds, link executables and not just dynlibs against C++ stdlib as well,
@@ -510,13 +510,13 @@ file(RELATIVE_PATH LIB ${LEAN_SOURCE_DIR} ${CMAKE_BINARY_DIR}/lib)
 
 # set up libInit_shared only on Windows; see also stdlib.make.in
 if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
-  set(INIT_SHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libInit.a.export ${CMAKE_BINARY_DIR}/lib/temp/libStd.a.export ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a -Wl,--no-whole-archive -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libInit_shared.dll.a")
+  set(INIT_SHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libInit.a.export ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a -Wl,--no-whole-archive -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libInit_shared.dll.a")
 endif()
 
 if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
   set(LEANSHARED_LINKER_FLAGS "-Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libInit.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libStd.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libLean.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libleancpp.a ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
 elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
-  set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libLean.a.export -lleancpp -Wl,--no-whole-archive -lInit_shared -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
+  set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libStd.a.export ${CMAKE_BINARY_DIR}/lib/temp/libLean.a.export -lleancpp -Wl,--no-whole-archive -lInit_shared -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
 else()
   set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit -lStd -lLean -lleancpp -Wl,--no-whole-archive ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
 endif()

src/Init/Control/Lawful/Instances.lean

@@ -188,13 +188,13 @@ theorem ext {x y : StateT σ m α} (h : ∀ s, x.run s = y.run s) : x = y :=
 
 @[simp] theorem run_lift {α σ : Type u} [Monad m] (x : m α) (s : σ) : (StateT.lift x : StateT σ m α).run s = x >>= fun a => pure (a, s) := rfl
 
-theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f : α → StateT σ m β) (s : σ) : (StateT.lift x >>= f).run s = x >>= fun a => (f a).run s := by
+@[simp] theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f : α → StateT σ m β) (s : σ) : (StateT.lift x >>= f).run s = x >>= fun a => (f a).run s := by
   simp [StateT.lift, StateT.run, bind, StateT.bind]
 
 @[simp] theorem run_monadLift {α σ : Type u} [Monad m] [MonadLiftT n m] (x : n α) (s : σ) : (monadLift x : StateT σ m α).run s = (monadLift x : m α) >>= fun a => pure (a, s) := rfl
 
-@[simp] theorem run_monadMap [MonadFunctor n m] (f : {β : Type u} → n β → n β) (x : StateT σ m α) (s : σ) :
-    (monadMap @f x : StateT σ m α).run s = monadMap @f (x.run s) := rfl
+@[simp] theorem run_monadMap [Monad m] [MonadFunctor n m] (f : {β : Type u} → n β → n β) (x : StateT σ m α) (s : σ)
+    : (monadMap @f x : StateT σ m α).run s = monadMap @f (x.run s) := rfl
 
 @[simp] theorem run_seq {α β σ : Type u} [Monad m] [LawfulMonad m] (f : StateT σ m (α → β)) (x : StateT σ m α) (s : σ) : (f <*> x).run s = (f.run s >>= fun fs => (fun (p : α × σ) => (fs.1 p.1, p.2)) <$> x.run fs.2) := by
   show (f >>= fun g => g <$> x).run s = _

src/Init/Control/StateRef.lean

@@ -64,5 +64,5 @@ end StateRefT'
 instance (ω σ : Type) (m : Type → Type) : MonadControl m (StateRefT' ω σ m) :=
   inferInstanceAs (MonadControl m (ReaderT _ _))
 
-instance {m : Type → Type} {ω σ : Type} [MonadFinally m] : MonadFinally (StateRefT' ω σ m) :=
+instance {m : Type → Type} {ω σ : Type} [MonadFinally m] [Monad m] : MonadFinally (StateRefT' ω σ m) :=
   inferInstanceAs (MonadFinally (ReaderT _ _))

src/Init/Core.lean

@@ -1089,18 +1089,15 @@ def InvImage {α : Sort u} {β : Sort v} (r : β → β → Prop) (f : α → β
   fun a₁ a₂ => r (f a₁) (f a₂)
 
 /--
-The transitive closure `TransGen r` of a relation `r` is the smallest relation which is
-transitive and contains `r`. `TransGen r a z` if and only if there exists a sequence
+The transitive closure `r⁺` of a relation `r` is the smallest relation which is
+transitive and contains `r`. `r⁺ a z` if and only if there exists a sequence
 `a r b r ... r z` of length at least 1 connecting `a` to `z`.
 -/
-inductive Relation.TransGen {α : Sort u} (r : α → α → Prop) : α → α → Prop
-  /-- If `r a b` then `TransGen r a b`. This is the base case of the transitive closure. -/
-  | single {a b} : r a b → TransGen r a b
+inductive TC {α : Sort u} (r : α → α → Prop) : α → α → Prop where
+  /-- If `r a b` then `r⁺ a b`. This is the base case of the transitive closure. -/
+  | base  : ∀ a b, r a b → TC r a b
   /-- The transitive closure is transitive. -/
-  | tail {a b c} : TransGen r a b → r b c → TransGen r a c
-
-/-- Deprecated synonym for `Relation.TransGen`. -/
-@[deprecated Relation.TransGen (since := "2024-07-16")] abbrev TC := @Relation.TransGen
+  | trans : ∀ a b c, TC r a b → TC r b c → TC r a c
 
 /-! # Subtype -/
 
@@ -1365,9 +1362,6 @@ theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_fa
 theorem of_iff_true    (h : a ↔ True) : a := h.mpr trivial
 theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h trivial
 
-theorem eq_iff_true_of_subsingleton [Subsingleton α] (x y : α) : x = y ↔ True :=
-  iff_true_intro (Subsingleton.elim ..)
-
 theorem not_of_iff_false : (p ↔ False) → ¬p := Iff.mp
 theorem iff_false_intro (h : ¬a) : a ↔ False := iff_of_false h id
 
@@ -1873,7 +1867,7 @@ instance : Subsingleton (Squash α) where
 /--
 `Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
 -/
-class Antisymm {α : Sort u} (r : α → α → Prop) : Prop where
+class Antisymm {α : Sort u} (r : α → α → Prop) where
   /-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
   antisymm {a b : α} : r a b → r b a → a = b
 

src/Init/Data.lean

@@ -35,4 +35,3 @@ import Init.Data.Queue
 import Init.Data.Channel
 import Init.Data.Cast
 import Init.Data.Sum
-import Init.Data.BEq

src/Init/Data/Array.lean

@@ -13,4 +13,3 @@ import Init.Data.Array.Mem
 import Init.Data.Array.Attach
 import Init.Data.Array.BasicAux
 import Init.Data.Array.Lemmas
-import Init.Data.Array.TakeDrop

src/Init/Data/Array/Lemmas.lean

@@ -51,7 +51,7 @@ theorem foldlM_eq_foldlM_data.aux [Monad m]
     simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H]
     rw (config := {occs := .pos [2]}) [← List.get_drop_eq_drop _ _ ‹_›]
     rfl
-  · rw [List.drop_of_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
+  · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
 
 theorem foldlM_eq_foldlM_data [Monad m]
     (f : β → α → m β) (init : β) (arr : Array α) :
@@ -141,7 +141,7 @@ where
     · rw [← List.get_drop_eq_drop _ i ‹_›]
       simp only [aux (i + 1), map_eq_pure_bind, data_length, List.foldlM_cons, bind_assoc, pure_bind]
       rfl
-    · rw [List.drop_of_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
+    · rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
   termination_by arr.size - i
   decreasing_by decreasing_trivial_pre_omega
 

src/Init/Data/Array/Mem.lean

@@ -23,7 +23,7 @@ theorem sizeOf_lt_of_mem [SizeOf α] {as : Array α} (h : a ∈ as) : sizeOf a <
   cases as with | _ as =>
   exact Nat.lt_trans (List.sizeOf_lt_of_mem h.val) (by simp_arith)
 
-theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
+@[simp] theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
   cases as with | _ as =>
   exact Nat.lt_trans (List.sizeOf_get ..) (by simp_arith)
 

src/Init/Data/Array/TakeDrop.lean

@@ -1,17 +0,0 @@
-/-
-Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus Himmel
--/
-prelude
-import Init.Data.Array.Lemmas
-import Init.Data.List.TakeDrop
-
-namespace Array
-
-theorem exists_of_uset (self : Array α) (i d h) :
-    ∃ l₁ l₂, self.data = l₁ ++ self[i] :: l₂ ∧ List.length l₁ = i.toNat ∧
-      (self.uset i d h).data = l₁ ++ d :: l₂ := by
-  simpa [Array.getElem_eq_data_getElem] using List.exists_of_set _
-
-end Array

src/Init/Data/BEq.lean

@@ -1,60 +0,0 @@
-/-
-Copyright (c) 2022 Mario Carneiro. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro, Markus Himmel
--/
-prelude
-import Init.Data.Bool
-
-set_option linter.missingDocs true
-
-/-- `PartialEquivBEq α` says that the `BEq` implementation is a
-partial equivalence relation, that is:
-* it is symmetric: `a == b → b == a`
-* it is transitive: `a == b → b == c → a == c`.
--/
-class PartialEquivBEq (α) [BEq α] : Prop where
-  /-- Symmetry for `BEq`. If `a == b` then `b == a`. -/
-  symm : (a : α) == b → b == a
-  /-- Transitivity for `BEq`. If `a == b` and `b == c` then `a == c`. -/
-  trans : (a : α) == b → b == c → a == c
-
-/-- `ReflBEq α` says that the `BEq` implementation is reflexive. -/
-class ReflBEq (α) [BEq α] : Prop where
-  /-- Reflexivity for `BEq`. -/
-  refl : (a : α) == a
-
-/-- `EquivBEq` says that the `BEq` implementation is an equivalence relation. -/
-class EquivBEq (α) [BEq α] extends PartialEquivBEq α, ReflBEq α : Prop
-
-@[simp]
-theorem BEq.refl [BEq α] [ReflBEq α] {a : α} : a == a :=
-  ReflBEq.refl
-
-theorem beq_of_eq [BEq α] [ReflBEq α] {a b : α} : a = b → a == b
-  | rfl => BEq.refl
-
-theorem BEq.symm [BEq α] [PartialEquivBEq α] {a b : α} : a == b → b == a :=
-  PartialEquivBEq.symm
-
-theorem BEq.comm [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = (b == a) :=
-  Bool.eq_iff_iff.2 ⟨BEq.symm, BEq.symm⟩
-
-theorem BEq.symm_false [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = false → (b == a) = false :=
-  BEq.comm (α := α) ▸ id
-
-theorem BEq.trans [BEq α] [PartialEquivBEq α] {a b c : α} : a == b → b == c → a == c :=
-  PartialEquivBEq.trans
-
-theorem BEq.neq_of_neq_of_beq [BEq α] [PartialEquivBEq α] {a b c : α} :
-    (a == b) = false → b == c → (a == c) = false :=
-  fun h₁ h₂ => Bool.eq_false_iff.2 fun h₃ => Bool.eq_false_iff.1 h₁ (BEq.trans h₃ (BEq.symm h₂))
-
-theorem BEq.neq_of_beq_of_neq [BEq α] [PartialEquivBEq α] {a b c : α} :
-    a == b → (b == c) = false → (a == c) = false :=
-  fun h₁ h₂ => Bool.eq_false_iff.2 fun h₃ => Bool.eq_false_iff.1 h₂ (BEq.trans (BEq.symm h₁) h₃)
-
-instance (priority := low) [BEq α] [LawfulBEq α] : EquivBEq α where
-  refl := LawfulBEq.rfl
-  symm h := (beq_iff_eq _ _).2 <| Eq.symm <| (beq_iff_eq _ _).1 h
-  trans hab hbc := (beq_iff_eq _ _).2 <| ((beq_iff_eq _ _).1 hab).trans <| (beq_iff_eq _ _).1 hbc

src/Init/Data/BitVec/Bitblast.lean

@@ -159,21 +159,6 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
 theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by
   rw [← add_not_self x, BitVec.add_comm, add_sub_cancel]
 
-/-- Addition of bitvectors is the same as bitwise or, if bitwise and is zero. -/
-theorem add_eq_or_of_and_eq_zero {w : Nat} (x y : BitVec w)
-    (h : x &&& y = 0#w) : x + y = x ||| y := by
-  rw [add_eq_adc, adc, iunfoldr_replace (fun _ => false) (x ||| y)]
-  · rfl
-  · simp only [adcb, atLeastTwo, Bool.and_false, Bool.or_false, bne_false, getLsb_or,
-    Prod.mk.injEq, and_eq_false_imp]
-    intros i
-    replace h : (x &&& y).getLsb i = (0#w).getLsb i := by rw [h]
-    simp only [getLsb_and, getLsb_zero, and_eq_false_imp] at h
-    constructor
-    · intros hx
-      simp_all [hx]
-    · by_cases hx : x.getLsb i <;> simp_all [hx]
-
 /-! ### Negation -/
 
 theorem bit_not_testBit (x : BitVec w) (i : Fin w) :
@@ -250,80 +235,4 @@ theorem sle_eq_carry (x y : BitVec w) :
     x.sle y = !((x.msb == y.msb).xor (carry w y (~~~x) true)) := by
   rw [sle_eq_not_slt, slt_eq_not_carry, beq_comm]
 
-/-! ### mul recurrence for bitblasting -/
-
-/--
-A recurrence that describes multiplication as repeated addition.
-Is useful for bitblasting multiplication.
--/
-def mulRec (l r : BitVec w) (s : Nat) : BitVec w :=
-  let cur := if r.getLsb s then (l <<< s) else 0
-  match s with
-  | 0 => cur
-  | s + 1 => mulRec l r s + cur
-
-theorem mulRec_zero_eq (l r : BitVec w) :
-    mulRec l r 0 = if r.getLsb 0 then l else 0 := by
-  simp [mulRec]
-
-theorem mulRec_succ_eq (l r : BitVec w) (s : Nat) :
-    mulRec l r (s + 1) = mulRec l r s + if r.getLsb (s + 1) then (l <<< (s + 1)) else 0 := rfl
-
-/--
-Recurrence lemma: truncating to `i+1` bits and then zero extending to `w`
-equals truncating upto `i` bits `[0..i-1]`, and then adding the `i`th bit of `x`.
--/
-theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w) (i : Nat) :
-    zeroExtend w (x.truncate (i + 1)) =
-      zeroExtend w (x.truncate i) + (x &&& twoPow w i) := by
-  rw [add_eq_or_of_and_eq_zero]
-  · ext k
-    simp only [getLsb_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsb_or, getLsb_and]
-    by_cases hik : i = k
-    · subst hik
-      simp
-    · simp only [getLsb_twoPow, hik, decide_False, Bool.and_false, Bool.or_false]
-      by_cases hik' : k < (i + 1)
-      · have hik'' : k < i := by omega
-        simp [hik', hik'']
-      · have hik'' : ¬ (k < i) := by omega
-        simp [hik', hik'']
-  · ext k
-    simp
-    omega
-
-/--
-Recurrence lemma: multiplying `l` with the first `s` bits of `r` is the
-same as truncating `r` to `s` bits, then zero extending to the original length,
-and performing the multplication. -/
-theorem mulRec_eq_mul_signExtend_truncate (l r : BitVec w) (s : Nat) :
-    mulRec l r s = l * ((r.truncate (s + 1)).zeroExtend w) := by
-  induction s
-  case zero =>
-    simp only [mulRec_zero_eq, ofNat_eq_ofNat, Nat.reduceAdd]
-    by_cases r.getLsb 0
-    case pos hr =>
-      simp only [hr, ↓reduceIte, truncate, zeroExtend_one_eq_ofBool_getLsb_zero,
-        hr, ofBool_true, ofNat_eq_ofNat]
-      rw [zeroExtend_ofNat_one_eq_ofNat_one_of_lt (by omega)]
-      simp
-    case neg hr =>
-      simp [hr, zeroExtend_one_eq_ofBool_getLsb_zero]
-  case succ s' hs =>
-    rw [mulRec_succ_eq, hs]
-    have heq :
-      (if r.getLsb (s' + 1) = true then l <<< (s' + 1) else 0) =
-        (l * (r &&& (BitVec.twoPow w (s' + 1)))) := by
-      simp only [ofNat_eq_ofNat, and_twoPow_eq]
-      by_cases hr : r.getLsb (s' + 1) <;> simp [hr]
-    rw [heq, ← BitVec.mul_add, ← zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow]
-
-theorem getLsb_mul (x y : BitVec w) (i : Nat) :
-    (x * y).getLsb i = (mulRec x y w).getLsb i := by
-  simp only [mulRec_eq_mul_signExtend_truncate]
-  rw [truncate, ← truncate_eq_zeroExtend, ← truncate_eq_zeroExtend,
-    truncate_truncate_of_le]
-  · simp
-  · omega
-
 end BitVec

src/Init/Data/BitVec/Lemmas.lean

@@ -110,8 +110,8 @@ theorem eq_of_getMsb_eq {x y : BitVec w}
 theorem of_length_zero {x : BitVec 0} : x = 0#0 := by ext; simp
 
 @[simp] theorem toNat_zero_length (x : BitVec 0) : x.toNat = 0 := by simp [of_length_zero]
-theorem getLsb_zero_length (x : BitVec 0) : x.getLsb i = false := by simp
-theorem getMsb_zero_length (x : BitVec 0) : x.getMsb i = false := by simp
+@[simp] theorem getLsb_zero_length (x : BitVec 0) : x.getLsb i = false := by simp [of_length_zero]
+@[simp] theorem getMsb_zero_length (x : BitVec 0) : x.getMsb i = false := by simp [of_length_zero]
 @[simp] theorem msb_zero_length (x : BitVec 0) : x.msb = false := by simp [BitVec.msb, of_length_zero]
 
 theorem eq_of_toFin_eq : ∀ {x y : BitVec w}, x.toFin = y.toFin → x = y
@@ -163,13 +163,6 @@ theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial
 private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m ≤ n) : x < 2 ^ n :=
   Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_of_le_right (by trivial : 0 < 2) le)
 
-@[simp]
-theorem getLsb_ofBool (b : Bool) (i : Nat) : (BitVec.ofBool b).getLsb i = ((i = 0) && b) := by
-  rcases b with rfl | rfl
-  · simp [ofBool]
-  · simp only [ofBool, ofNat_eq_ofNat, cond_true, getLsb_ofNat, Bool.and_true]
-    by_cases hi : i = 0 <;> simp [hi] <;> omega
-
 /-! ### msb -/
 
 @[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsb]
@@ -293,9 +286,6 @@ theorem toInt_ofNat {n : Nat} (x : Nat) :
 
 /-! ### zeroExtend and truncate -/
 
-theorem truncate_eq_zeroExtend {v : Nat} {x : BitVec w} :
-  truncate v x = zeroExtend v x := rfl
-
 @[simp, bv_toNat] theorem toNat_zeroExtend' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
     (zeroExtend' p x).toNat = x.toNat := by
   unfold zeroExtend'
@@ -329,7 +319,7 @@ theorem zeroExtend'_eq {x : BitVec w} (h : w ≤ v) : x.zeroExtend' h = x.zeroEx
   apply eq_of_toNat_eq
   simp [toNat_zeroExtend]
 
-theorem truncate_eq (x : BitVec n) : truncate n x = x := zeroExtend_eq x
+@[simp] theorem truncate_eq (x : BitVec n) : truncate n x = x := zeroExtend_eq x
 
 @[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : BitVec.ofNat m x.toNat = truncate m x := by
   apply eq_of_toNat_eq
@@ -383,7 +373,7 @@ theorem nat_eq_toNat (x : BitVec w) (y : Nat)
   all_goals (first | apply getLsb_ge | apply Eq.symm; apply getLsb_ge)
     <;> omega
 
-theorem getLsb_truncate (m : Nat) (x : BitVec n) (i : Nat) :
+@[simp] theorem getLsb_truncate (m : Nat) (x : BitVec n) (i : Nat) :
     getLsb (truncate m x) i = (decide (i < m) && getLsb x i) :=
   getLsb_zeroExtend m x i
 
@@ -402,12 +392,6 @@ theorem msb_truncate (x : BitVec w) : (x.truncate (k + 1)).msb = x.getLsb k := b
     (x.truncate l).truncate k = x.truncate k :=
   zeroExtend_zeroExtend_of_le x h
 
-/--Truncating by the bitwidth has no effect. -/
-@[simp]
-theorem truncate_eq_self {x : BitVec w} : x.truncate w = x := by
-  ext i
-  simp [getLsb_zeroExtend]
-
 @[simp] theorem truncate_cast {h : w = v} : (cast h x).truncate k = x.truncate k := by
   apply eq_of_getLsb_eq
   simp
@@ -420,22 +404,6 @@ theorem msb_zeroExtend (x : BitVec w) : (x.zeroExtend v).msb = (decide (0 < v) &
 theorem msb_zeroExtend' (x : BitVec w) (h : w ≤ v) : (x.zeroExtend' h).msb = (decide (0 < v) && x.getLsb (v - 1)) := by
   rw [zeroExtend'_eq, msb_zeroExtend]
 
-/-- zero extending a bitvector to width 1 equals the boolean of the lsb. -/
-theorem zeroExtend_one_eq_ofBool_getLsb_zero (x : BitVec w) :
-    x.zeroExtend 1 = BitVec.ofBool (x.getLsb 0) := by
-  ext i
-  simp [getLsb_zeroExtend, Fin.fin_one_eq_zero i]
-
-/-- Zero extending `1#v` to `1#w` equals `1#w` when `v > 0`. -/
-theorem zeroExtend_ofNat_one_eq_ofNat_one_of_lt {v w : Nat} (hv : 0 < v) :
-    (BitVec.ofNat v 1).zeroExtend w = BitVec.ofNat w 1 := by
-  ext ⟨i, hilt⟩
-  simp only [getLsb_zeroExtend, hilt, decide_True, getLsb_ofNat, Bool.true_and,
-    Bool.and_iff_right_iff_imp, decide_eq_true_eq]
-  intros hi₁
-  have hv := Nat.testBit_one_eq_true_iff_self_eq_zero.mp hi₁
-  omega
-
 /-! ## extractLsb -/
 
 @[simp]
@@ -608,7 +576,7 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
   ext
   simp_all [lt_of_getLsb]
 
-@[simp] theorem xor_cast {x y : BitVec w} (h : w = w') : cast h x ^^^ cast h y = cast h (x ^^^ y) := by
+@[simp] theorem xor_cast {x y : BitVec w} (h : w = w') : cast h x &&& cast h y = cast h (x &&& y) := by
   ext
   simp_all [lt_of_getLsb]
 
@@ -621,11 +589,6 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
 @[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) :
     BitVec.toFin (x <<< n) = Fin.ofNat' (x.toNat <<< n) (Nat.two_pow_pos w) := rfl
 
-@[simp]
-theorem shiftLeft_zero_eq (x : BitVec w) : x <<< 0 = x := by
-  apply eq_of_toNat_eq
-  simp
-
 @[simp] theorem getLsb_shiftLeft (x : BitVec m) (n) :
     getLsb (x <<< n) i = (decide (i < m) && !decide (i < n) && getLsb x (i - n)) := by
   rw [← testBit_toNat, getLsb]
@@ -1181,18 +1144,6 @@ instance : Std.Associative (fun (x y : BitVec w) => x * y) := ⟨BitVec.mul_asso
 instance : Std.LawfulCommIdentity (fun (x y : BitVec w) => x * y) (1#w) where
   right_id := BitVec.mul_one
 
-@[simp]
-theorem BitVec.mul_zero {x : BitVec w} : x * 0#w = 0#w := by
-  apply eq_of_toNat_eq
-  simp [toNat_mul]
-
-theorem BitVec.mul_add {x y z : BitVec w} :
-    x * (y + z) = x * y + x * z := by
-  apply eq_of_toNat_eq
-  simp only [toNat_mul, toNat_add, Nat.add_mod_mod, Nat.mod_add_mod]
-  rw [Nat.mul_mod, Nat.mod_mod (y.toNat + z.toNat),
-    ← Nat.mul_mod, Nat.mul_add]
-
 @[simp, bv_toNat] theorem toInt_mul (x y : BitVec w) :
   (x * y).toInt = (x.toInt * y.toInt).bmod (2^w) := by
   simp [toInt_eq_toNat_bmod]
@@ -1437,7 +1388,7 @@ theorem toNat_twoPow (w : Nat) (i : Nat) : (twoPow w i).toNat = 2^i % 2^w := by
 @[simp]
 theorem getLsb_twoPow (i j : Nat) : (twoPow w i).getLsb j = ((i < w) && (i = j)) := by
   rcases w with rfl | w
-  · simp
+  · simp; omega
   · simp only [twoPow, getLsb_shiftLeft, getLsb_ofNat]
     by_cases hj : j < i
     · simp only [hj, decide_True, Bool.not_true, Bool.and_false, Bool.false_and, Bool.false_eq,
@@ -1471,37 +1422,4 @@ theorem mul_twoPow_eq_shiftLeft (x : BitVec w) (i : Nat) :
       apply Nat.pow_dvd_pow 2 (by omega)
     simp [Nat.mul_mod, hpow]
 
-/- ### zeroExtend, truncate, and bitwise operations -/
-
-/--
-When the `(i+1)`th bit of `x` is false,
-keeping the lower `(i + 1)` bits of `x` equals keeping the lower `i` bits.
--/
-theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsb_false
-  {x : BitVec w} {i : Nat} (hx : x.getLsb i = false) :
-    zeroExtend w (x.truncate (i + 1)) =
-      zeroExtend w (x.truncate i) := by
-  ext k
-  simp only [getLsb_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsb_or, getLsb_and]
-  by_cases hik : i = k
-  · subst hik
-    simp [hx]
-  · by_cases hik' : k < i + 1 <;> simp [hik'] <;> omega
-
-/--
-When the `(i+1)`th bit of `x` is true,
-keeping the lower `(i + 1)` bits of `x` equalsk eeping the lower `i` bits
-and then performing bitwise-or with `twoPow i = (1 << i)`,
--/
-theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsb_true
-    {x : BitVec w} {i : Nat} (hx : x.getLsb i = true) :
-    zeroExtend w (x.truncate (i + 1)) =
-      zeroExtend w (x.truncate i) ||| (twoPow w i) := by
-  ext k
-  simp only [getLsb_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsb_or, getLsb_and]
-  by_cases hik : i = k
-  · subst hik
-    simp [hx]
-  · by_cases hik' : k < i + 1 <;> simp [hik, hik'] <;> omega
-
 end BitVec

src/Init/Data/Bool.lean

@@ -52,8 +52,8 @@ theorem eq_iff_iff {a b : Bool} : a = b ↔ (a ↔ b) := by cases b <;> simp
 
 @[simp] theorem decide_eq_true  {b : Bool} [Decidable (b = true)]  : decide (b = true)  =  b := by cases b <;> simp
 @[simp] theorem decide_eq_false {b : Bool} [Decidable (b = false)] : decide (b = false) = !b := by cases b <;> simp
-theorem decide_true_eq  {b : Bool} [Decidable (true = b)]  : decide (true  = b) =  b := by cases b <;> simp
-theorem decide_false_eq {b : Bool} [Decidable (false = b)] : decide (false = b) = !b := by cases b <;> simp
+@[simp] theorem decide_true_eq  {b : Bool} [Decidable (true = b)]  : decide (true  = b) =  b := by cases b <;> simp
+@[simp] theorem decide_false_eq {b : Bool} [Decidable (false = b)] : decide (false = b) = !b := by cases b <;> simp
 
 /-! ### and -/
 
@@ -163,7 +163,7 @@ Consider the term: `¬((b && c) = true)`:
 -/
 @[simp] theorem and_eq_false_imp : ∀ (x y : Bool), (x && y) = false ↔ (x = true → y = false) := by decide
 
-theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by simp
+@[simp] theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by decide
 
 @[simp] theorem or_eq_false_iff : ∀ (x y : Bool), (x || y) = false ↔ x = false ∧ y = false := by decide
 
@@ -187,9 +187,11 @@ in false_eq and true_eq.
 
 @[simp] theorem true_beq  : ∀b, (true  == b) =  b := by decide
 @[simp] theorem false_beq : ∀b, (false == b) = !b := by decide
+@[simp] theorem beq_true  : ∀b, (b == true)  =  b := by decide
 instance : Std.LawfulIdentity (· == ·) true where
   left_id := true_beq
   right_id := beq_true
+@[simp] theorem beq_false : ∀b, (b == false) = !b := by decide
 
 @[simp] theorem true_bne  : ∀(b : Bool), (true  != b) = !b := by decide
 @[simp] theorem false_bne : ∀(b : Bool), (false != b) =  b := by decide
@@ -351,7 +353,7 @@ theorem and_or_inj_left_iff :
 /-! ## toNat -/
 
 /-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/
-def toNat (b : Bool) : Nat := cond b 1 0
+def toNat (b:Bool) : Nat := cond b 1 0
 
 @[simp] theorem toNat_false : false.toNat = 0 := rfl
 
@@ -494,16 +496,6 @@ protected theorem cond_false {α : Type u} {a b : α} : cond false a b = b := co
 @[simp] theorem cond_true_same  : ∀(c b : Bool), cond c c b = (c || b) := by decide
 @[simp] theorem cond_false_same : ∀(c b : Bool), cond c b c = (c && b) := by decide
 
-theorem cond_pos {b : Bool} {a a' : α} (h : b = true) : (bif b then a else a') = a := by
-  rw [h, cond_true]
-
-theorem cond_neg {b : Bool} {a a' : α} (h : b = false) : (bif b then a else a') = a' := by
-  rw [h, cond_false]
-
-theorem apply_cond (f : α → β) {b : Bool} {a a' : α} :
-    f (bif b then a else a') = bif b then f a else f a' := by
-  cases b <;> simp
-
 /-# decidability -/
 
 protected theorem decide_coe (b : Bool) [Decidable (b = true)] : decide (b = true) = b := decide_eq_true

src/Init/Data/Char/Lemmas.lean

@@ -31,9 +31,11 @@ theorem utf8Size_eq (c : Char) : c.utf8Size = 1 ∨ c.utf8Size = 2 ∨ c.utf8Siz
   rw [Char.ofNat, dif_pos]
   rfl
 
-@[ext] protected theorem ext : {a b : Char} → a.val = b.val → a = b
+@[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b
   | ⟨_,_⟩, ⟨_,_⟩, rfl => rfl
 
+theorem Char.ext_iff {x y : Char} : x = y ↔ x.val = y.val := ⟨congrArg _, Char.ext⟩
+
 end Char
 
 @[deprecated Char.utf8Size (since := "2024-06-04")] abbrev String.csize := Char.utf8Size

src/Init/Data/Fin/Bitwise.lean

@@ -1,15 +0,0 @@
-/-
-Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus Himmel
--/
-prelude
-import Init.Data.Nat.Bitwise
-import Init.Data.Fin.Basic
-
-namespace Fin
-
-@[simp] theorem and_val (a b : Fin n) : (a &&& b).val = a.val &&& b.val :=
-  Nat.mod_eq_of_lt (Nat.lt_of_le_of_lt Nat.and_le_left a.isLt)
-
-end Fin

src/Init/Data/Fin/Lemmas.lean

@@ -37,7 +37,9 @@ theorem pos_iff_nonempty {n : Nat} : 0 < n ↔ Nonempty (Fin n) :=
 
 @[simp] protected theorem eta (a : Fin n) (h : a < n) : (⟨a, h⟩ : Fin n) = a := rfl
 
-@[ext] protected theorem ext {a b : Fin n} (h : (a : Nat) = b) : a = b := eq_of_val_eq h
+@[ext] theorem ext {a b : Fin n} (h : (a : Nat) = b) : a = b := eq_of_val_eq h
+
+theorem ext_iff {a b : Fin n} : a = b ↔ a.1 = b.1 := val_inj.symm
 
 theorem val_ne_iff {a b : Fin n} : a.1 ≠ b.1 ↔ a ≠ b := not_congr val_inj
 
@@ -45,12 +47,12 @@ theorem forall_iff {p : Fin n → Prop} : (∀ i, p i) ↔ ∀ i h, p ⟨i, h⟩
   ⟨fun h i hi => h ⟨i, hi⟩, fun h ⟨i, hi⟩ => h i hi⟩
 
 protected theorem mk.inj_iff {n a b : Nat} {ha : a < n} {hb : b < n} :
-    (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := Fin.ext_iff
+    (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := ext_iff
 
 theorem val_mk {m n : Nat} (h : m < n) : (⟨m, h⟩ : Fin n).val = m := rfl
 
 theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} :
-    a = ⟨k, hk⟩ ↔ (a : Nat) = k := Fin.ext_iff
+    a = ⟨k, hk⟩ ↔ (a : Nat) = k := ext_iff
 
 theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
 
@@ -143,7 +145,7 @@ theorem eq_succ_of_ne_zero {n : Nat} {i : Fin (n + 1)} (hi : i ≠ 0) : ∃ j :
 
 @[simp] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl
 
-@[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := Fin.ext <| by
+@[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := ext <| by
   rw [val_rev, val_rev, ← Nat.sub_sub, Nat.sub_sub_self (by exact i.2), Nat.add_sub_cancel]
 
 @[simp] theorem rev_le_rev {i j : Fin n} : rev i ≤ rev j ↔ j ≤ i := by
@@ -169,12 +171,12 @@ theorem le_last (i : Fin (n + 1)) : i ≤ last n := Nat.le_of_lt_succ i.is_lt
 theorem last_pos : (0 : Fin (n + 2)) < last (n + 1) := Nat.succ_pos _
 
 theorem eq_last_of_not_lt {i : Fin (n + 1)} (h : ¬(i : Nat) < n) : i = last n :=
-  Fin.ext <| Nat.le_antisymm (le_last i) (Nat.not_lt.1 h)
+  ext <| Nat.le_antisymm (le_last i) (Nat.not_lt.1 h)
 
 theorem val_lt_last {i : Fin (n + 1)} : i ≠ last n → (i : Nat) < n :=
   Decidable.not_imp_comm.1 eq_last_of_not_lt
 
-@[simp] theorem rev_last (n : Nat) : rev (last n) = 0 := Fin.ext <| by simp
+@[simp] theorem rev_last (n : Nat) : rev (last n) = 0 := ext <| by simp
 
 @[simp] theorem rev_zero (n : Nat) : rev 0 = last n := by
   rw [← rev_rev (last _), rev_last]
@@ -242,11 +244,11 @@ theorem zero_ne_one : (0 : Fin (n + 2)) ≠ 1 := Fin.ne_of_lt one_pos
 @[simp] theorem succ_lt_succ_iff {a b : Fin n} : a.succ < b.succ ↔ a < b := Nat.succ_lt_succ_iff
 
 @[simp] theorem succ_inj {a b : Fin n} : a.succ = b.succ ↔ a = b := by
-  refine ⟨fun h => Fin.ext ?_, congrArg _⟩
+  refine ⟨fun h => ext ?_, congrArg _⟩
   apply Nat.le_antisymm <;> exact succ_le_succ_iff.1 (h ▸ Nat.le_refl _)
 
 theorem succ_ne_zero {n} : ∀ k : Fin n, Fin.succ k ≠ 0
-  | ⟨k, _⟩, heq => Nat.succ_ne_zero k <| congrArg Fin.val heq
+  | ⟨k, _⟩, heq => Nat.succ_ne_zero k <| ext_iff.1 heq
 
 @[simp] theorem succ_zero_eq_one : Fin.succ (0 : Fin (n + 1)) = 1 := rfl
 
@@ -265,7 +267,7 @@ theorem one_lt_succ_succ (a : Fin n) : (1 : Fin (n + 2)) < a.succ.succ := by
   rw [← succ_zero_eq_one, succ_lt_succ_iff]; exact succ_pos a
 
 @[simp] theorem add_one_lt_iff {n : Nat} {k : Fin (n + 2)} : k + 1 < k ↔ k = last _ := by
-  simp only [lt_def, val_add, val_last, Fin.ext_iff]
+  simp only [lt_def, val_add, val_last, ext_iff]
   let ⟨k, hk⟩ := k
   match Nat.eq_or_lt_of_le (Nat.le_of_lt_succ hk) with
   | .inl h => cases h; simp [Nat.succ_pos]
@@ -283,7 +285,7 @@ theorem one_lt_succ_succ (a : Fin n) : (1 : Fin (n + 2)) < a.succ.succ := by
     split <;> simp [*, (Nat.succ_ne_zero _).symm, Nat.ne_of_gt (Nat.lt_succ_self _)]
 
 @[simp] theorem last_le_iff {n : Nat} {k : Fin (n + 1)} : last n ≤ k ↔ k = last n := by
-  rw [Fin.ext_iff, Nat.le_antisymm_iff, le_def, and_iff_right (by apply le_last)]
+  rw [ext_iff, Nat.le_antisymm_iff, le_def, and_iff_right (by apply le_last)]
 
 @[simp] theorem lt_add_one_iff {n : Nat} {k : Fin (n + 1)} : k < k + 1 ↔ k < last n := by
   rw [← Decidable.not_iff_not]; simp
@@ -304,10 +306,10 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
 @[simp] theorem castLE_mk (i n m : Nat) (hn : i < n) (h : n ≤ m) :
     castLE h ⟨i, hn⟩ = ⟨i, Nat.lt_of_lt_of_le hn h⟩ := rfl
 
-@[simp] theorem castLE_zero {n m : Nat} (h : n.succ ≤ m.succ) : castLE h 0 = 0 := by simp [Fin.ext_iff]
+@[simp] theorem castLE_zero {n m : Nat} (h : n.succ ≤ m.succ) : castLE h 0 = 0 := by simp [ext_iff]
 
 @[simp] theorem castLE_succ {m n : Nat} (h : m + 1 ≤ n + 1) (i : Fin m) :
-    castLE h i.succ = (castLE (Nat.succ_le_succ_iff.mp h) i).succ := by simp [Fin.ext_iff]
+    castLE h i.succ = (castLE (Nat.succ_le_succ_iff.mp h) i).succ := by simp [ext_iff]
 
 @[simp] theorem castLE_castLE {k m n} (km : k ≤ m) (mn : m ≤ n) (i : Fin k) :
     Fin.castLE mn (Fin.castLE km i) = Fin.castLE (Nat.le_trans km mn) i :=
@@ -320,7 +322,7 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
 @[simp] theorem coe_cast (h : n = m) (i : Fin n) : (cast h i : Nat) = i := rfl
 
 @[simp] theorem cast_last {n' : Nat} {h : n + 1 = n' + 1} : cast h (last n) = last n' :=
-  Fin.ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h])
+  ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h])
 
 @[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h ⟨i, hn⟩ = ⟨i, h ▸ hn⟩ := rfl
 
@@ -346,7 +348,7 @@ theorem castAdd_lt {m : Nat} (n : Nat) (i : Fin m) : (castAdd n i : Nat) < m :=
 
 /-- For rewriting in the reverse direction, see `Fin.cast_castAdd_left`. -/
 theorem castAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) :
-    castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := Fin.ext rfl
+    castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := ext rfl
 
 theorem cast_castAdd_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
     cast h (castAdd m i) = castAdd m (cast (Nat.add_right_cancel h) i) := rfl
@@ -395,7 +397,7 @@ theorem castSucc_lt_iff_succ_le {n : Nat} {i : Fin n} {j : Fin (n + 1)} :
 @[simp] theorem castSucc_lt_castSucc_iff {a b : Fin n} :
     Fin.castSucc a < Fin.castSucc b ↔ a < b := .rfl
 
-theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b ↔ a = b := by simp [Fin.ext_iff]
+theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b ↔ a = b := by simp [ext_iff]
 
 theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt
 
@@ -407,7 +409,7 @@ theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt
 theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < castSucc i := by
   simpa [lt_def] using h
 
-@[simp] theorem castSucc_eq_zero_iff (a : Fin (n + 1)) : castSucc a = 0 ↔ a = 0 := by simp [Fin.ext_iff]
+@[simp] theorem castSucc_eq_zero_iff (a : Fin (n + 1)) : castSucc a = 0 ↔ a = 0 := by simp [ext_iff]
 
 theorem castSucc_ne_zero_iff (a : Fin (n + 1)) : castSucc a ≠ 0 ↔ a ≠ 0 :=
   not_congr <| castSucc_eq_zero_iff a
@@ -419,7 +421,7 @@ theorem castSucc_fin_succ (n : Nat) (j : Fin n) :
 theorem coeSucc_eq_succ {a : Fin n} : castSucc a + 1 = a.succ := by
   cases n
   · exact a.elim0
-  · simp [Fin.ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)]
+  · simp [ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)]
 
 theorem lt_succ {a : Fin n} : castSucc a < a.succ := by
   rw [castSucc, lt_def, coe_castAdd, val_succ]; exact Nat.lt_succ_self a.val
@@ -452,7 +454,7 @@ theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
 
 @[simp] theorem cast_addNat_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) :
     cast h (addNat i m') = addNat i m :=
-  Fin.ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _)
+  ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _)
 
 @[simp] theorem coe_natAdd (n : Nat) {m : Nat} (i : Fin m) : (natAdd n i : Nat) = n + i := rfl
 
@@ -472,7 +474,7 @@ theorem cast_natAdd_right {n n' m : Nat} (i : Fin n') (h : m + n' = m + n) :
 
 @[simp] theorem cast_natAdd_left {n m m' : Nat} (i : Fin n) (h : m' + n = m + n) :
     cast h (natAdd m' i) = natAdd m i :=
-  Fin.ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _)
+  ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _)
 
 theorem castAdd_natAdd (p m : Nat) {n : Nat} (i : Fin n) :
     castAdd p (natAdd m i) = cast (Nat.add_assoc ..).symm (natAdd m (castAdd p i)) := rfl
@@ -482,27 +484,27 @@ theorem natAdd_castAdd (p m : Nat) {n : Nat} (i : Fin n) :
 
 theorem natAdd_natAdd (m n : Nat) {p : Nat} (i : Fin p) :
     natAdd m (natAdd n i) = cast (Nat.add_assoc ..) (natAdd (m + n) i) :=
-  Fin.ext <| (Nat.add_assoc ..).symm
+  ext <| (Nat.add_assoc ..).symm
 
 @[simp]
 theorem cast_natAdd_zero {n n' : Nat} (i : Fin n) (h : 0 + n = n') :
     cast h (natAdd 0 i) = cast ((Nat.zero_add _).symm.trans h) i :=
-  Fin.ext <| Nat.zero_add _
+  ext <| Nat.zero_add _
 
 @[simp]
 theorem cast_natAdd (n : Nat) {m : Nat} (i : Fin m) :
-    cast (Nat.add_comm ..) (natAdd n i) = addNat i n := Fin.ext <| Nat.add_comm ..
+    cast (Nat.add_comm ..) (natAdd n i) = addNat i n := ext <| Nat.add_comm ..
 
 @[simp]
 theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) :
-    cast (Nat.add_comm ..) (addNat i m) = natAdd m i := Fin.ext <| Nat.add_comm ..
+    cast (Nat.add_comm ..) (addNat i m) = natAdd m i := ext <| Nat.add_comm ..
 
 @[simp] theorem natAdd_last {m n : Nat} : natAdd n (last m) = last (n + m) := rfl
 
 theorem natAdd_castSucc {m n : Nat} {i : Fin m} : natAdd n (castSucc i) = castSucc (natAdd n i) :=
   rfl
 
-theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := Fin.ext <| by
+theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := ext <| by
   rw [val_rev, coe_castAdd, coe_addNat, val_rev, Nat.sub_add_comm (Nat.succ_le_of_lt k.is_lt)]
 
 theorem rev_addNat (k : Fin n) (m : Nat) : rev (addNat k m) = castAdd m (rev k) := by
@@ -532,7 +534,7 @@ theorem pred_eq_iff_eq_succ {n : Nat} (i : Fin (n + 1)) (hi : i ≠ 0) (j : Fin
 theorem pred_mk_succ (i : Nat) (h : i < n + 1) :
     Fin.pred ⟨i + 1, Nat.add_lt_add_right h 1⟩ (ne_of_val_ne (Nat.ne_of_gt (mk_succ_pos i h))) =
       ⟨i, h⟩ := by
-  simp only [Fin.ext_iff, coe_pred, Nat.add_sub_cancel]
+  simp only [ext_iff, coe_pred, Nat.add_sub_cancel]
 
 @[simp] theorem pred_mk_succ' (i : Nat) (h₁ : i + 1 < n + 1 + 1) (h₂) :
     Fin.pred ⟨i + 1, h₁⟩ h₂ = ⟨i, Nat.lt_of_succ_lt_succ h₁⟩ := pred_mk_succ i _
@@ -552,14 +554,14 @@ theorem pred_mk {n : Nat} (i : Nat) (h : i < n + 1) (w) : Fin.pred ⟨i, h⟩ w
     ∀ {a b : Fin (n + 1)} {ha : a ≠ 0} {hb : b ≠ 0}, a.pred ha = b.pred hb ↔ a = b
   | ⟨0, _⟩, _, ha, _ => by simp only [mk_zero, ne_eq, not_true] at ha
   | ⟨i + 1, _⟩, ⟨0, _⟩, _, hb => by simp only [mk_zero, ne_eq, not_true] at hb
-  | ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, ha, hb => by simp [Fin.ext_iff, Nat.succ.injEq]
+  | ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, ha, hb => by simp [ext_iff, Nat.succ.injEq]
 
 @[simp] theorem pred_one {n : Nat} :
     Fin.pred (1 : Fin (n + 2)) (Ne.symm (Fin.ne_of_lt one_pos)) = 0 := rfl
 
 theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
     pred (i + 1) (Fin.ne_of_gt (add_one_pos _ (lt_def.2 h))) = castLT i h := by
-  rw [Fin.ext_iff, coe_pred, coe_castLT, val_add, val_one, Nat.mod_eq_of_lt, Nat.add_sub_cancel]
+  rw [ext_iff, coe_pred, coe_castLT, val_add, val_one, Nat.mod_eq_of_lt, Nat.add_sub_cancel]
   exact Nat.add_lt_add_right h 1
 
 @[simp] theorem coe_subNat (i : Fin (n + m)) (h : m ≤ i) : (i.subNat m h : Nat) = i - m := rfl
@@ -571,10 +573,10 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
     pred (castSucc i.succ) (Fin.ne_of_gt (castSucc_pos i.succ_pos)) = castSucc i := rfl
 
 @[simp] theorem addNat_subNat {i : Fin (n + m)} (h : m ≤ i) : addNat (subNat m i h) m = i :=
-  Fin.ext <| Nat.sub_add_cancel h
+  ext <| Nat.sub_add_cancel h
 
 @[simp] theorem subNat_addNat (i : Fin n) (m : Nat) (h : m ≤ addNat i m := le_coe_addNat m i) :
-    subNat m (addNat i m) h = i := Fin.ext <| Nat.add_sub_cancel i m
+    subNat m (addNat i m) h = i := ext <| Nat.add_sub_cancel i m
 
 @[simp] theorem natAdd_subNat_cast {i : Fin (n + m)} (h : n ≤ i) :
     natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [← cast_addNat]; rfl
@@ -784,9 +786,6 @@ theorem coe_sub_iff_le {a b : Fin n} : (↑(a - b) : Nat) = a - b ↔ b ≤ a :=
     rw [Nat.mod_eq_of_lt]
     all_goals omega
 
-theorem sub_val_of_le {a b : Fin n} : b ≤ a → (a - b).val = a.val - b.val :=
-  coe_sub_iff_le.2
-
 theorem coe_sub_iff_lt {a b : Fin n} : (↑(a - b) : Nat) = n + a - b ↔ a < b := by
   rw [sub_def, lt_def]
   dsimp only
@@ -808,10 +807,10 @@ theorem coe_mul {n : Nat} : ∀ a b : Fin n, ((a * b : Fin n) : Nat) = a * b % n
 protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by
   match n with
   | 0 => exact Subsingleton.elim (α := Fin 1) ..
-  | n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
+  | n+1 => simp [ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
 
 protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
-  Fin.ext <| by rw [mul_def, mul_def, Nat.mul_comm]
+  ext <| by rw [mul_def, mul_def, Nat.mul_comm]
 instance : Std.Commutative (α := Fin n) (· * ·) := ⟨Fin.mul_comm⟩
 
 protected theorem mul_assoc (a b c : Fin n) : a * b * c = a * (b * c) := by
@@ -827,9 +826,9 @@ instance : Std.LawfulIdentity (α := Fin (n + 1)) (· * ·) 1 where
   left_id := Fin.one_mul
   right_id := Fin.mul_one
 
-protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [Fin.ext_iff, mul_def]
+protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [ext_iff, mul_def]
 
 protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by
-  simp [Fin.ext_iff, mul_def]
+  simp [ext_iff, mul_def]
 
 end Fin

src/Init/Data/Float.lean

@@ -101,13 +101,13 @@ Returns an undefined value if `x` is not finite.
 instance : ToString Float where
   toString := Float.toString
 
-@[extern "lean_uint64_to_float"] opaque UInt64.toFloat (n : UInt64) : Float
-
 instance : Repr Float where
-  reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
+  reprPrec n _ := Float.toString n
 
 instance : ReprAtom Float  := ⟨⟩
 
+@[extern "lean_uint64_to_float"] opaque UInt64.toFloat (n : UInt64) : Float
+
 @[extern "sin"] opaque Float.sin : Float → Float
 @[extern "cos"] opaque Float.cos : Float → Float
 @[extern "tan"] opaque Float.tan : Float → Float

src/Init/Data/Hashable.lean

@@ -62,16 +62,3 @@ instance (P : Prop) : Hashable P where
 /-- An opaque (low-level) hash operation used to implement hashing for pointers. -/
 @[always_inline, inline] def hash64 (u : UInt64) : UInt64 :=
   mixHash u 11
-
-/-- `LawfulHashable α` says that the `BEq α` and `Hashable α` instances on `α` are compatible, i.e.,
-that `a == b` implies `hash a = hash b`. This is automatic if the `BEq` instance is lawful.
--/
-class LawfulHashable (α : Type u) [BEq α] [Hashable α] where
-  /-- If `a == b`, then `hash a = hash b`. -/
-  hash_eq (a b : α) : a == b → hash a = hash b
-
-theorem hash_eq [BEq α] [Hashable α] [LawfulHashable α] {a b : α} : a == b → hash a = hash b :=
-  LawfulHashable.hash_eq a b
-
-instance (priority := low) [BEq α] [Hashable α] [LawfulBEq α] : LawfulHashable α where
-  hash_eq _ _ h := eq_of_beq h ▸ rfl

src/Init/Data/List/Basic.lean

@@ -22,7 +22,7 @@ along with `@[csimp]` lemmas,
 
 In `Init.Data.List.Lemmas` we develop the full API for these functions.
 
-Recall that `length`, `get`, `set`, `foldl`, and `concat` have already been defined in `Init.Prelude`.
+Recall that `length`, `get`, `set`, `fold`, and `concat` have already been defined in `Init.Prelude`.
 
 The operations are organized as follow:
 * Equality: `beq`, `isEqv`.
@@ -32,8 +32,8 @@ The operations are organized as follow:
 * List membership: `isEmpty`, `elem`, `contains`, `mem` (and the `∈` notation),
   and decidability for predicates quantifying over membership in a `List`.
 * Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
-  `isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `Subset`, `Sublist`, `rotateLeft` and `rotateRight`.
-* Manipulating elements: `replace`, `insert`, `erase`, `eraseP`, `eraseIdx`, `find?`, `findSome?`, and `lookup`.
+  `isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `rotateLeft` and `rotateRight`.
+* Manipulating elements: `replace`, `insert`, `erase`, `eraseIdx`, `find?`, `findSome?`, and `lookup`.
 * Logic: `any`, `all`, `or`, and `and`.
 * Zippers: `zipWith`, `zip`, `zipWithAll`, and `unzip`.
 * Ranges and enumeration: `range`, `iota`, `enumFrom`, and `enum`.
@@ -88,7 +88,7 @@ namespace List
 
 /-! ### concat -/
 
-@[simp high] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
+@[simp] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
   induction as with
   | nil => rfl
   | cons _ xs ih => simp [concat, ih]
@@ -817,8 +817,6 @@ def dropLast {α} : List α → List α
 @[simp] theorem dropLast_cons₂ :
     (x::y::zs).dropLast = x :: (y::zs).dropLast := rfl
 
--- Later this can be proved by `simp` via `[List.length_dropLast, List.length_cons, Nat.add_sub_cancel]`,
--- but we need this while bootstrapping `Array`.
 @[simp] theorem length_dropLast_cons (a : α) (as : List α) : (a :: as).dropLast.length = as.length := by
   match as with
   | []       => rfl
@@ -866,40 +864,6 @@ def isSuffixOf [BEq α] (l₁ l₂ : List α) : Bool :=
 def isSuffixOf? [BEq α] (l₁ l₂ : List α) : Option (List α) :=
   Option.map List.reverse <| isPrefixOf? l₁.reverse l₂.reverse
 
-/-! ### Subset -/
-
-/--
-`l₁ ⊆ l₂` means that every element of `l₁` is also an element of `l₂`, ignoring multiplicity.
--/
-protected def Subset (l₁ l₂ : List α) := ∀ ⦃a : α⦄, a ∈ l₁ → a ∈ l₂
-
-instance : HasSubset (List α) := ⟨List.Subset⟩
-
-instance [DecidableEq α] : DecidableRel (Subset : List α → List α → Prop) :=
-  fun _ _ => decidableBAll _ _
-
-/-! ### Sublist and isSublist -/
-
-/-- `l₁ <+ l₂`, or `Sublist l₁ l₂`, says that `l₁` is a (non-contiguous) subsequence of `l₂`. -/
-inductive Sublist {α} : List α → List α → Prop
-  /-- the base case: `[]` is a sublist of `[]` -/
-  | slnil : Sublist [] []
-  /-- If `l₁` is a subsequence of `l₂`, then it is also a subsequence of `a :: l₂`. -/
-  | cons a : Sublist l₁ l₂ → Sublist l₁ (a :: l₂)
-  /-- If `l₁` is a subsequence of `l₂`, then `a :: l₁` is a subsequence of `a :: l₂`. -/
-  | cons₂ a : Sublist l₁ l₂ → Sublist (a :: l₁) (a :: l₂)
-
-@[inherit_doc] scoped infixl:50 " <+ " => Sublist
-
-/-- True if the first list is a potentially non-contiguous sub-sequence of the second list. -/
-def isSublist [BEq α] : List α → List α → Bool
-  | [], _ => true
-  | _, [] => false
-  | l₁@(hd₁::tl₁), hd₂::tl₂ =>
-    if hd₁ == hd₂
-    then tl₁.isSublist tl₂
-    else l₁.isSublist tl₂
-
 /-! ### rotateLeft -/
 
 /--
@@ -942,55 +906,6 @@ def rotateRight (xs : List α) (n : Nat := 1) : List α :=
 
 @[simp] theorem rotateRight_nil : ([] : List α).rotateRight n = [] := rfl
 
-/-! ## Pairwise, Nodup -/
-
-section Pairwise
-
-variable (R : α → α → Prop)
-
-/--
-`Pairwise R l` means that all the elements with earlier indexes are
-`R`-related to all the elements with later indexes.
-```
-Pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3
-```
-For example if `R = (·≠·)` then it asserts `l` has no duplicates,
-and if `R = (·<·)` then it asserts that `l` is (strictly) sorted.
--/
-inductive Pairwise : List α → Prop
-  /-- All elements of the empty list are vacuously pairwise related. -/
-  | nil : Pairwise []
-  /-- `a :: l` is `Pairwise R` if `a` `R`-relates to every element of `l`,
-  and `l` is `Pairwise R`. -/
-  | cons : ∀ {a : α} {l : List α}, (∀ a', a' ∈ l → R a a') → Pairwise l → Pairwise (a :: l)
-
-attribute [simp] Pairwise.nil
-
-variable {R}
-
-@[simp] theorem pairwise_cons : Pairwise R (a::l) ↔ (∀ a', a' ∈ l → R a a') ∧ Pairwise R l :=
-  ⟨fun | .cons h₁ h₂ => ⟨h₁, h₂⟩, fun ⟨h₁, h₂⟩ => h₂.cons h₁⟩
-
-instance instDecidablePairwise [DecidableRel R] :
-    (l : List α) → Decidable (Pairwise R l)
-  | [] => isTrue .nil
-  | hd :: tl =>
-    match instDecidablePairwise tl with
-    | isTrue ht =>
-      match decidableBAll (R hd) tl with
-      | isFalse hf => isFalse fun hf' => hf (pairwise_cons.1 hf').1
-      | isTrue ht' => isTrue <| pairwise_cons.mpr (And.intro ht' ht)
-    | isFalse hf => isFalse fun | .cons _ ih => hf ih
-
-end Pairwise
-
-/-- `Nodup l` means that `l` has no duplicates, that is, any element appears at most
-  once in the List. It is defined as `Pairwise (≠)`. -/
-def Nodup : List α → Prop := Pairwise (· ≠ ·)
-
-instance nodupDecidable [DecidableEq α] : ∀ l : List α, Decidable (Nodup l) :=
-  instDecidablePairwise
-
 /-! ## Manipulating elements -/
 
 /-! ### replace -/
@@ -1036,11 +951,6 @@ theorem erase_cons [BEq α] (a b : α) (l : List α) :
     (b :: l).erase a = if b == a then l else b :: l.erase a := by
   simp only [List.erase]; split <;> simp_all
 
-/-- `eraseP p l` removes the first element of `l` satisfying the predicate `p`. -/
-def eraseP (p : α → Bool) : List α → List α
-  | [] => []
-  | a :: l => bif p a then l else a :: eraseP p l
-
 /-! ### eraseIdx -/
 
 /--

src/Init/Data/List/Impl.lean

@@ -295,24 +295,6 @@ theorem replicateTR_loop_eq : ∀ n, replicateTR.loop a n acc = replicate n a ++
     · rw [IH] <;> simp_all
     · simp
 
-/-- Tail-recursive version of `eraseP`. -/
-@[inline] def erasePTR (p : α → Bool) (l : List α) : List α := go l #[] where
-  /-- Auxiliary for `erasePTR`: `erasePTR.go p l xs acc = acc.toList ++ eraseP p xs`,
-  unless `xs` does not contain any elements satisfying `p`, where it returns `l`. -/
-  @[specialize] go : List α → Array α → List α
-  | [], _ => l
-  | a :: l, acc => bif p a then acc.toListAppend l else go l (acc.push a)
-
-@[csimp] theorem eraseP_eq_erasePTR : @eraseP = @erasePTR := by
-  funext α p l; simp [erasePTR]
-  let rec go (acc) : ∀ xs, l = acc.data ++ xs →
-    erasePTR.go p l xs acc = acc.data ++ xs.eraseP p
-  | [] => fun h => by simp [erasePTR.go, eraseP, h]
-  | x::xs => by
-    simp [erasePTR.go, eraseP]; cases p x <;> simp
-    · intro h; rw [go _ xs]; {simp}; simp [h]
-  exact (go #[] _ rfl).symm
-
 /-! ### eraseIdx -/
 
 /-- Tail recursive version of `List.eraseIdx`. -/

src/Init/Data/List/TakeDrop.lean

@@ -120,43 +120,6 @@ theorem get?_take_eq_if {l : List α} {n m : Nat} :
     (l.take n).get? m = if m < n then l.get? m else none := by
   simp [getElem?_take_eq_if]
 
-theorem head?_take {l : List α} {n : Nat} :
-    (l.take n).head? = if n = 0 then none else l.head? := by
-  simp [head?_eq_getElem?, getElem?_take_eq_if]
-  split
-  · rw [if_neg (by omega)]
-  · rw [if_pos (by omega)]
-
-theorem head_take {l : List α} {n : Nat} (h : l.take n ≠ []) :
-    (l.take n).head h = l.head (by simp_all) := by
-  apply Option.some_inj.1
-  rw [← head?_eq_head, ← head?_eq_head, head?_take, if_neg]
-  simp_all
-
-theorem getLast?_take {l : List α} : (l.take n).getLast? = if n = 0 then none else l[n - 1]?.or l.getLast? := by
-  rw [getLast?_eq_getElem?, getElem?_take_eq_if, length_take]
-  split
-  · rw [if_neg (by omega)]
-    rw [Nat.min_def]
-    split
-    · rw [getElem?_eq_getElem (by omega)]
-      simp
-    · rw [← getLast?_eq_getElem?, getElem?_eq_none (by omega)]
-      simp
-  · rw [if_pos]
-    omega
-
-theorem getLast_take {l : List α} (h : l.take n ≠ []) :
-    (l.take n).getLast h = l[n - 1]?.getD (l.getLast (by simp_all)) := by
-  rw [getLast_eq_getElem, getElem_take']
-  simp [length_take, Nat.min_def]
-  simp at h
-  split
-  · rw [getElem?_eq_getElem (by omega)]
-    simp
-  · rw [getElem?_eq_none (by omega), getLast_eq_getElem]
-    simp
-
 @[simp]
 theorem take_eq_take :
     ∀ {l : List α} {m n : Nat}, l.take m = l.take n ↔ min m l.length = min n l.length
@@ -282,31 +245,6 @@ theorem getElem?_drop (L : List α) (i j : Nat) : (L.drop i)[j]? = L[i + j]? :=
 theorem get?_drop (L : List α) (i j : Nat) : get? (L.drop i) j = get? L (i + j) := by
   simp
 
-theorem head?_drop (l : List α) (n : Nat) :
-    (l.drop n).head? = l[n]? := by
-  rw [head?_eq_getElem?, getElem?_drop, Nat.add_zero]
-
-theorem head_drop {l : List α} {n : Nat} (h : l.drop n ≠ []) :
-    (l.drop n).head h = l[n]'(by simp_all) := by
-  have w : n < l.length := length_lt_of_drop_ne_nil h
-  simpa [head?_eq_head, getElem?_eq_getElem, h, w] using head?_drop l n
-
-theorem getLast?_drop {l : List α} : (l.drop n).getLast? = if l.length ≤ n then none else l.getLast? := by
-  rw [getLast?_eq_getElem?, getElem?_drop]
-  rw [length_drop]
-  split
-  · rw [getElem?_eq_none (by omega)]
-  · rw [getLast?_eq_getElem?]
-    congr
-    omega
-
-theorem getLast_drop {l : List α} (h : l.drop n ≠ []) :
-    (l.drop n).getLast h = l.getLast (ne_nil_of_length_pos (by simp at h; omega)) := by
-  simp only [ne_eq, drop_eq_nil_iff_le] at h
-  apply Option.some_inj.1
-  simp only [← getLast?_eq_getLast, getLast?_drop, ite_eq_right_iff]
-  omega
-
 theorem set_eq_take_append_cons_drop {l : List α} {n : Nat} {a : α} :
     l.set n a = if n < l.length then l.take n ++ a :: l.drop (n + 1) else l := by
   split <;> rename_i h
@@ -334,15 +272,6 @@ theorem set_eq_take_append_cons_drop {l : List α} {n : Nat} {a : α} :
   · rw [set_eq_of_length_le]
     omega
 
-theorem exists_of_set {n : Nat} {a' : α} {l : List α} (h : n < l.length) :
-    ∃ l₁ l₂, l = l₁ ++ l[n] :: l₂ ∧ l₁.length = n ∧ l.set n a' = l₁ ++ a' :: l₂ := by
-  refine ⟨l.take n, l.drop (n + 1), ⟨by simp, ⟨length_take_of_le (Nat.le_of_lt h), ?_⟩⟩⟩
-  simp [set_eq_take_append_cons_drop, h]
-
-theorem drop_set_of_lt (a : α) {n m : Nat} (l : List α)
-    (hnm : n < m) : drop m (l.set n a) = l.drop m :=
-  ext_getElem? fun k => by simpa only [getElem?_drop] using getElem?_set_ne (by omega)
-
 theorem drop_take : ∀ (m n : Nat) (l : List α), drop n (take m l) = take (m - n) (drop n l)
   | 0, _, _ => by simp
   | _, 0, _ => by simp
@@ -445,29 +374,6 @@ theorem minimum?_eq_some_iff' {xs : List Nat} :
     (min_eq_or := fun _ _ => by omega)
     (le_min_iff := fun _ _ _ => by omega)
 
--- This could be generalized,
--- but will first require further work on order typeclasses in the core repository.
-theorem minimum?_cons' {a : Nat} {l : List Nat} :
-    (a :: l).minimum? = some (match l.minimum? with
-    | none => a
-    | some m => min a m) := by
-  rw [minimum?_eq_some_iff']
-  split <;> rename_i h m
-  · simp_all
-  · rw [minimum?_eq_some_iff'] at m
-    obtain ⟨m, le⟩ := m
-    rw [Nat.min_def]
-    constructor
-    · split
-      · exact mem_cons_self a l
-      · exact mem_cons_of_mem a m
-    · intro b m
-      cases List.mem_cons.1 m with
-      | inl => split <;> omega
-      | inr h =>
-        specialize le b h
-        split <;> omega
-
 /-! ### maximum? -/
 
 -- A specialization of `maximum?_eq_some_iff` to Nat.
@@ -478,27 +384,4 @@ theorem maximum?_eq_some_iff' {xs : List Nat} :
     (max_eq_or := fun _ _ => by omega)
     (max_le_iff := fun _ _ _ => by omega)
 
--- This could be generalized,
--- but will first require further work on order typeclasses in the core repository.
-theorem maximum?_cons' {a : Nat} {l : List Nat} :
-    (a :: l).maximum? = some (match l.maximum? with
-    | none => a
-    | some m => max a m) := by
-  rw [maximum?_eq_some_iff']
-  split <;> rename_i h m
-  · simp_all
-  · rw [maximum?_eq_some_iff'] at m
-    obtain ⟨m, le⟩ := m
-    rw [Nat.max_def]
-    constructor
-    · split
-      · exact mem_cons_of_mem a m
-      · exact mem_cons_self a l
-    · intro b m
-      cases List.mem_cons.1 m with
-      | inl => split <;> omega
-      | inr h =>
-        specialize le b h
-        split <;> omega
-
 end List

src/Init/Data/Nat/Basic.lean

@@ -100,7 +100,6 @@ def blt (a b : Nat) : Bool :=
   ble a.succ b
 
 attribute [simp] Nat.zero_le
-attribute [simp] Nat.not_lt_zero
 
 /-! # Helper "packing" theorems -/
 
@@ -125,8 +124,13 @@ instance : LawfulBEq Nat where
   eq_of_beq h := Nat.eq_of_beq_eq_true h
   rfl := by simp [BEq.beq]
 
-theorem beq_eq_true_eq (a b : Nat) : ((a == b) = true) = (a = b) := by simp
-theorem not_beq_eq_true_eq (a b : Nat) : ((!(a == b)) = true) = ¬(a = b) := by simp
+@[simp] theorem beq_eq_true_eq (a b : Nat) : ((a == b) = true) = (a = b) := propext <| Iff.intro eq_of_beq (fun h => by subst h; apply LawfulBEq.rfl)
+@[simp] theorem not_beq_eq_true_eq (a b : Nat) : ((!(a == b)) = true) = ¬(a = b) :=
+  propext <| Iff.intro
+    (fun h₁ h₂ => by subst h₂; rw [LawfulBEq.rfl] at h₁; contradiction)
+    (fun h =>
+      have : ¬ ((a == b) = true) := fun h' => absurd (eq_of_beq h') h
+      by simp [this])
 
 /-! # Nat.add theorems -/
 
@@ -351,7 +355,7 @@ protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_po
 
 theorem lt.base (n : Nat) : n < succ n := Nat.le_refl (succ n)
 
-theorem lt_succ_self (n : Nat) : n < succ n := lt.base n
+@[simp] theorem lt_succ_self (n : Nat) : n < succ n := lt.base n
 
 @[simp] protected theorem lt_add_one (n : Nat) : n < n + 1 := lt.base n
 
@@ -634,10 +638,6 @@ theorem succ_lt_succ_iff : succ a < succ b ↔ a < b := ⟨lt_of_succ_lt_succ, s
 
 theorem add_one_inj : a + 1 = b + 1 ↔ a = b := succ_inj'
 
-theorem ne_add_one (n : Nat) : n ≠ n + 1 := fun h => by cases h
-
-theorem add_one_ne (n : Nat) : n + 1 ≠ n := fun h => by cases h
-
 theorem add_one_le_add_one_iff : a + 1 ≤ b + 1 ↔ a ≤ b := succ_le_succ_iff
 
 theorem add_one_lt_add_one_iff : a + 1 < b + 1 ↔ a < b := succ_lt_succ_iff
@@ -705,7 +705,8 @@ protected theorem one_ne_zero : 1 ≠ (0 : Nat) :=
 protected theorem zero_ne_one : 0 ≠ (1 : Nat) :=
   fun h => Nat.noConfusion h
 
-theorem succ_ne_zero (n : Nat) : succ n ≠ 0 := by simp
+@[simp] theorem succ_ne_zero (n : Nat) : succ n ≠ 0 :=
+  fun h => Nat.noConfusion h
 
 /-! # mul + order -/
 
@@ -813,14 +814,8 @@ theorem sub_one_lt_of_lt {n m : Nat} (h : m < n) : n - 1 < n :=
 
 /-! # pred theorems -/
 
-protected theorem pred_zero : pred 0 = 0 := rfl
-protected theorem pred_succ (n : Nat) : pred n.succ = n := rfl
-
-@[simp] protected theorem zero_sub_one : 0 - 1 = 0 := rfl
-@[simp] protected theorem add_one_sub_one (n : Nat) : n + 1 - 1 = n := rfl
-
-theorem sub_one_eq_self (n : Nat) : n - 1 = n ↔ n = 0 := by cases n <;> simp [ne_add_one]
-theorem eq_self_sub_one (n : Nat) : n = n - 1 ↔ n = 0 := by cases n <;> simp [add_one_ne]
+@[simp] protected theorem pred_zero : pred 0 = 0 := rfl
+@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n := rfl
 
 theorem succ_pred {a : Nat} (h : a ≠ 0) : a.pred.succ = a := by
   induction a with

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

@@ -86,7 +86,7 @@ noncomputable def div2Induction {motive : Nat → Sort u}
 @[simp] theorem testBit_zero (x : Nat) : testBit x 0 = decide (x % 2 = 1) := by
   cases mod_two_eq_zero_or_one x with | _ p => simp [testBit, p]
 
-theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
+@[simp] theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
   unfold testBit
   simp [shiftRight_succ_inside]
 
@@ -504,27 +504,3 @@ theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^
 
 @[simp] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by
   simp [testBit, ←shiftRight_add]
-
-/-! ### le -/
-
-theorem le_of_testBit {n m : Nat} (h : ∀ i, n.testBit i = true → m.testBit i = true) : n ≤ m := by
-  induction n using div2Induction generalizing m
-  next n ih =>
-  have : n / 2 ≤ m / 2 := by
-    rcases n with (_|n)
-    · simp
-    · exact ih (Nat.succ_pos _) fun i => by simpa using h (i + 1)
-  rw [← div_add_mod n 2, ← div_add_mod m 2]
-  cases hn : n.testBit 0
-  · have hn2 : n % 2 = 0 := by simp at hn; omega
-    rw [hn2]
-    omega
-  · have hn2 : n % 2 = 1 := by simpa using hn
-    have hm2 : m % 2 = 1 := by simpa using h _ hn
-    omega
-
-theorem and_le_left {n m : Nat} : n &&& m ≤ n :=
-  le_of_testBit (by simpa using fun i x _ => x)
-
-theorem and_le_right {n m : Nat} : n &&& m ≤ m :=
-  le_of_testBit (by simp)

src/Init/Data/Nat/Lemmas.lean

@@ -115,6 +115,8 @@ protected theorem add_sub_cancel_right (n m : Nat) : (n + m) - m = n := Nat.add_
 
 theorem succ_sub_one (n) : succ n - 1 = n := rfl
 
+protected theorem add_one_sub_one (n : Nat) : (n + 1) - 1 = n := rfl
+
 protected theorem one_add_sub_one (n : Nat) : (1 + n) - 1 = n := Nat.add_sub_cancel_left 1 _
 
 protected theorem sub_sub_self {n m : Nat} (h : m ≤ n) : n - (n - m) = m :=

src/Init/Data/Option/Basic.lean

@@ -19,7 +19,6 @@ def getM [Alternative m] : Option α → m α
   | some a   => pure a
 
 @[deprecated getM (since := "2024-04-17")]
--- `[Monad m]` is not needed here.
 def toMonad [Monad m] [Alternative m] : Option α → m α := getM
 
 /-- Returns `true` on `some x` and `false` on `none`. -/
@@ -27,7 +26,7 @@ def toMonad [Monad m] [Alternative m] : Option α → m α := getM
   | some _ => true
   | none   => false
 
-@[deprecated isSome (since := "2024-04-17"), inline] def toBool : Option α → Bool := isSome
+@[deprecated isSome, inline] def toBool : Option α → Bool := isSome
 
 /-- Returns `true` on `none` and `false` on `some x`. -/
 @[inline] def isNone : Option α → Bool
@@ -81,9 +80,7 @@ theorem map_id : (Option.map id : Option α → Option α) = id :=
   | none   => false
 
 /--
-Implementation of `OrElse`'s `<|>` syntax for `Option`. If the first argument is `some a`, returns
-`some a`, otherwise evaluates and returns the second argument. See also `or` for a version that is
-strict in the second argument.
+Implementation of `OrElse`'s `<|>` syntax for `Option`.
 -/
 @[always_inline, macro_inline] protected def orElse : Option α → (Unit → Option α) → Option α
   | some a, _ => some a
@@ -92,12 +89,6 @@ strict in the second argument.
 instance : OrElse (Option α) where
   orElse := Option.orElse
 
-/-- If the first argument is `some a`, returns `some a`, otherwise returns the second argument.
-This is similar to `<|>`/`orElse`, but it is strict in the second argument. -/
-@[always_inline, macro_inline] def or : Option α → Option α → Option α
-  | some a, _ => some a
-  | none,   b => b
-
 @[inline] protected def lt (r : α → α → Prop) : Option α → Option α → Prop
   | none, some _     => True
   | some x,   some y => r x y

src/Init/Data/Option/Lemmas.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 prelude
-import Init.Data.Option.BasicAux
 import Init.Data.Option.Instances
 import Init.Classical
 import Init.Ext
@@ -42,21 +41,6 @@ theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.get
 theorem getD_eq_iff {o : Option α} {a b} : o.getD a = b ↔ (o = some b ∨ o = none ∧ a = b) := by
   cases o <;> simp
 
-@[simp] theorem get!_none [Inhabited α] : (none : Option α).get! = default := rfl
-
-@[simp] theorem get!_some [Inhabited α] {a : α} : (some a).get! = a := rfl
-
-theorem get_eq_get! [Inhabited α] : (o : Option α) → {h : o.isSome} → o.get h = o.get!
-  | some _, _ => rfl
-
-theorem get_eq_getD {fallback : α} : (o : Option α) → {h : o.isSome} → o.get h = o.getD fallback
-  | some _, _ => rfl
-
-theorem some_get! [Inhabited α] : (o : Option α) → o.isSome → some (o.get!) = o
-  | some _, _ => rfl
-
-theorem get!_eq_getD_default [Inhabited α] (o : Option α) : o.get! = o.getD default := rfl
-
 theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b :=
   some.inj <| ha ▸ hb
 
@@ -82,7 +66,7 @@ theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> sim
   cases a <;> simp
 
 theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by
-  cases o <;> simp
+  cases o <;> simp; nofun
 
 theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h)
   | some _, _ => rfl
@@ -161,12 +145,6 @@ theorem map_eq_some : f <$> x = some b ↔ ∃ a, x = some a ∧ f a = b := map_
 @[simp] theorem map_eq_none' : x.map f = none ↔ x = none := by
   cases x <;> simp only [map_none', map_some', eq_self_iff_true]
 
-theorem isSome_map {x : Option α} : (f <$> x).isSome = x.isSome := by
-  cases x <;> simp
-
-@[simp] theorem isSome_map' {x : Option α} : (x.map f).isSome = x.isSome := by
-  cases x <;> simp
-
 theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none'
 
 theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
@@ -190,9 +168,6 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
 
 theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..
 
-@[simp] theorem filter_none (p : α → Bool) : none.filter p = none := rfl
-theorem filter_some : Option.filter p (some a) = if p a then some a else none := rfl
-
 theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
     x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
 
@@ -261,46 +236,3 @@ end
 @[simp] theorem toList_some (a : α) : (a : Option α).toList = [a] := rfl
 
 @[simp] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
-
-@[simp] theorem or_some : (some a).or o = some a := rfl
-@[simp] theorem none_or : none.or o = o := rfl
-
-theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
-  cases o <;> rfl
-
-@[simp] theorem isSome_or : (or o o').isSome = (o.isSome || o'.isSome) := by
-  cases o <;> rfl
-
-@[simp] theorem isNone_or : (or o o').isNone = (o.isNone && o'.isNone) := by
-  cases o <;> rfl
-
-@[simp] theorem or_eq_none : or o o' = none ↔ o = none ∧ o' = none := by
-  cases o <;> simp
-
-theorem or_eq_some : or o o' = some a ↔ o = some a ∨ (o = none ∧ o' = some a) := by
-  cases o <;> simp
-
-theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
-  cases o₁ <;> cases o₂ <;> rfl
-instance : Std.Associative (or (α := α)) := ⟨@or_assoc _⟩
-
-@[simp]
-theorem or_none : or o none = o := by
-  cases o <;> rfl
-instance : Std.LawfulIdentity (or (α := α)) none where
-  left_id := @none_or _
-  right_id := @or_none _
-
-@[simp]
-theorem or_self : or o o = o := by
-  cases o <;> rfl
-instance : Std.IdempotentOp (or (α := α)) := ⟨@or_self _⟩
-
-theorem or_eq_orElse : or o o' = o.orElse (fun _ => o') := by
-  cases o <;> rfl
-
-theorem map_or : f <$> or o o' = (f <$> o).or (f <$> o') := by
-  cases o <;> rfl
-
-theorem map_or' : (or o o').map f = (o.map f).or (o'.map f) := by
-  cases o <;> rfl

src/Init/Data/Repr.lean

@@ -230,7 +230,7 @@ protected def Int.repr : Int → String
     | negSucc m => "-" ++ Nat.repr (succ m)
 
 instance : Repr Int where
-  reprPrec i prec := if i < 0 then Repr.addAppParen i.repr prec else i.repr
+  reprPrec i _ := i.repr
 
 def hexDigitRepr (n : Nat) : String :=
   String.singleton <| Nat.digitChar n

src/Init/Data/UInt.lean

@@ -7,4 +7,3 @@ prelude
 import Init.Data.UInt.Basic
 import Init.Data.UInt.Log2
 import Init.Data.UInt.Lemmas
-import Init.Data.UInt.Bitwise

src/Init/Data/UInt/Bitwise.lean

@@ -1,24 +0,0 @@
-/-
-Copyright (c) 2024 Lean FRO, LLC. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus Himmel
--/
-prelude
-import Init.Data.UInt.Basic
-import Init.Data.Fin.Bitwise
-
-set_option hygiene false in
-macro "declare_bitwise_uint_theorems" typeName:ident : command =>
-`(
-namespace $typeName
-
-@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := Fin.and_val ..
-
-end $typeName
-)
-
-declare_bitwise_uint_theorems UInt8
-declare_bitwise_uint_theorems UInt16
-declare_bitwise_uint_theorems UInt32
-declare_bitwise_uint_theorems UInt64
-declare_bitwise_uint_theorems USize

src/Init/Data/UInt/Lemmas.lean

@@ -26,8 +26,6 @@ theorem add_def (a b : $typeName) : a + b = ⟨a.val + b.val⟩ := rfl
   | ⟨_, _⟩ => rfl
 theorem val_eq_of_lt {a : Nat} : a < size → ((ofNat a).val : Nat) = a :=
   Nat.mod_eq_of_lt
-theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
-  rw [toNat, val_eq_of_lt h]
 
 theorem le_def {a b : $typeName} : a ≤ b ↔ a.1 ≤ b.1 := .rfl
 theorem lt_def {a b : $typeName} : a < b ↔ a.1 < b.1 := .rfl
@@ -50,7 +48,6 @@ protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := ne_of_val_
 @[simp] protected theorem zero_toNat : (0 : $typeName).toNat = 0 := Nat.zero_mod _
 @[simp] protected theorem mod_toNat (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := Fin.mod_val ..
 @[simp] protected theorem div_toNat (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := Fin.div_val ..
-@[simp] protected theorem sub_toNat_of_le (a b : $typeName) : b ≤ a → (a - b).toNat = a.toNat - b.toNat := Fin.sub_val_of_le
 @[simp] protected theorem modn_toNat (a : $typeName) (b : Nat) : (a.modn b).toNat = a.toNat % b := Fin.modn_val ..
 protected theorem modn_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % m) < m
   | ⟨u⟩, h => Fin.modn_lt u h
@@ -58,8 +55,6 @@ open $typeName (modn_lt) in
 protected theorem mod_lt (a b : $typeName) (h : 0 < b) : a % b < b := modn_lt _ (by simp [lt_def] at h; exact h)
 protected theorem toNat.inj : ∀ {a b : $typeName}, a.toNat = b.toNat → a = b
   | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
-protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.1.2
-@[simp] protected theorem ofNat_one : ofNat 1 = 1 := rfl
 
 end $typeName
 )

src/Init/Ext.lean

@@ -10,39 +10,58 @@ import Init.RCases
 
 namespace Lean
 namespace Parser.Attr
+/-- Registers an extensionality theorem.
 
-/--
-The flag `(iff := false)` prevents `ext` from generating an `ext_iff` lemma.
--/
-syntax extIff := atomic("(" &"iff" " := " &"false" ")")
+* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers
+  them for the `ext` tactic.
 
-/--
-The flag `(flat := false)` causes `ext` to not flatten parents' fields when generating an `ext` lemma.
--/
-syntax extFlat := atomic("(" &"flat" " := " &"false" ")")
+* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic.
 
-/--
-Registers an extensionality theorem.
-
-* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic, and it generates an "`ext_iff`" theorem.
-  The name of the theorem is from adding the suffix `_iff` to the theorem name.
-
-* When `@[ext]` is applied to a structure, it generates an `.ext` theorem and applies the `@[ext]` attribute to it.
-  The result is an `.ext` and an `.ext_iff` theorem with the `.ext` theorem registered for the `ext` tactic.
-
-* An optional natural number argument, e.g. `@[ext 9000]`, specifies a priority for the `ext` lemma.
-  Higher-priority lemmas are chosen first, and the default is `1000`.
-
-* The flag `@[ext (iff := false)]` disables generating an `ext_iff` theorem.
+* An optional natural number argument, e.g. `@[ext 9000]`, specifies a priority for the lemma. Higher-priority lemmas are chosen first, and the default is `1000`.
 
 * The flag `@[ext (flat := false)]` causes generated structure extensionality theorems to show inherited fields based on their representation,
   rather than flattening the parents' fields into the lemma's equality hypotheses.
--/
-syntax (name := ext) "ext" (ppSpace extIff)? (ppSpace extFlat)? (ppSpace prio)? : attr
+  structures in the generated extensionality theorems. -/
+syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr
 end Parser.Attr
 
 -- TODO: rename this namespace?
+-- Remark: `ext` has scoped syntax, Mathlib may depend on the actual namespace name.
 namespace Elab.Tactic.Ext
+/--
+Creates the type of the extensionality theorem for the given structure,
+elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
+-/
+scoped syntax (name := extType) "ext_type% " term:max ppSpace ident : term
+
+/--
+Creates the type of the iff-variant of the extensionality theorem for the given structure,
+elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
+-/
+scoped syntax (name := extIffType) "ext_iff_type% " term:max ppSpace ident : term
+
+/--
+`declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`.
+
+These theorems state that two expressions with the structure type are equal if their fields are equal.
+-/
+syntax (name := declareExtTheoremFor) "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command
+
+macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do
+  let flat := f.getD (mkIdent `true)
+  let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes
+  let name ← match names.filter (·.2.isEmpty) with
+    | [] => Macro.throwError s!"unknown constant {struct.getId}"
+    | [(name, _)] => pure name
+    | _ => Macro.throwError s!"ambiguous name {struct.getId}"
+  let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext"
+  let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff"
+  `(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident :=
+      fun {..} {..} => by intros; subst_eqs; rfl
+    protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident :=
+      fun {..} {..} =>
+        ⟨fun h => by cases h; and_intros <;> rfl,
+         fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩)
 
 /--
 Applies extensionality lemmas that are registered with the `@[ext]` attribute.
@@ -77,8 +96,19 @@ macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic =>
 end Elab.Tactic.Ext
 end Lean
 
-attribute [ext] Prod PProd Sigma PSigma
 attribute [ext] funext propext Subtype.eq
 
+@[ext] theorem Prod.ext : {x y : Prod α β} → x.fst = y.fst → x.snd = y.snd → x = y
+  | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl
+
+@[ext] theorem PProd.ext : {x y : PProd α β} → x.fst = y.fst → x.snd = y.snd → x = y
+  | ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl
+
+@[ext] theorem Sigma.ext : {x y : Sigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y
+  | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl
+
+@[ext] theorem PSigma.ext : {x y : PSigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y
+  | ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl
+
 @[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
 protected theorem Unit.ext (x y : Unit) : x = y := rfl

src/Init/GetElem.lean

@@ -118,14 +118,6 @@ instance (priority := low) [GetElem coll idx elem valid] [∀ xs i, Decidable (v
     GetElem? coll idx elem valid where
   getElem? xs i := decidableGetElem? xs i
 
-theorem getElem_congr_coll [GetElem coll idx elem valid] {c d : coll} {i : idx} {h : valid c i}
-    (h' : c = d) : c[i] = d[i]'(h' ▸ h) := by
-  cases h'; rfl
-
-theorem getElem_congr [GetElem coll idx elem valid] {c : coll} {i j : idx} {h : valid c i}
-    (h' : i = j) : c[i] = c[j]'(h' ▸ h) := by
-  cases h'; rfl
-
 class LawfulGetElem (cont : Type u) (idx : Type v) (elem : outParam (Type w))
    (dom : outParam (cont → idx → Prop)) [ge : GetElem? cont idx elem dom] : Prop where
 
@@ -179,9 +171,11 @@ instance [GetElem? cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
 @[simp] theorem getElem_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
     a[i] = a[i.1] := rfl
 
-@[simp] theorem getElem?_fin [h : GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) : a[i]? = a[i.1]? := by rfl
+@[simp] theorem getElem?_fin [h : GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n)
+    [Decidable (Dom a i)] : a[i]? = a[i.1]? := by rfl
 
-@[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Inhabited Elem] : a[i]! = a[i.1]! := rfl
+@[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n)
+    [Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl
 
 macro_rules
   | `(tactic| get_elem_tactic_trivial) => `(tactic| apply Fin.val_lt_of_le; get_elem_tactic_trivial; done)
@@ -196,12 +190,12 @@ instance : GetElem (List α) Nat α fun as i => i < as.length where
 @[simp] theorem getElem_cons_zero (a : α) (as : List α) (h : 0 < (a :: as).length) : getElem (a :: as) 0 h = a := by
   rfl
 
-@[deprecated (since := "2024-06-12")] abbrev cons_getElem_zero := @getElem_cons_zero
+@[deprecated (since := "2024-6-12")] abbrev cons_getElem_zero := @getElem_cons_zero
 
 @[simp] theorem getElem_cons_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
   rfl
 
-@[deprecated (since := "2024-06-12")] abbrev cons_getElem_succ := @getElem_cons_succ
+@[deprecated (since := "2024-6-12")] abbrev cons_getElem_succ := @getElem_cons_succ
 
 theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
   match as, i with

src/Init/MetaTypes.lean

@@ -219,13 +219,13 @@ structure Config where
   -/
   index             : Bool := true
   /--
-  When `true` (default: `true`), `simp` will **not** create a proof for a rewriting rule associated
+  When `true` (default: `false`), `simp` will **not** create a proof for a rewriting rule associated
   with an `rfl`-theorem.
   Rewriting rules are provided by users by annotating theorems with the attribute `@[simp]`.
   If the proof of the theorem is just `rfl` (reflexivity), and `implicitDefEqProofs := true`, `simp`
   will **not** create a proof term which is an application of the annotated theorem.
   -/
-  implicitDefEqProofs : Bool := true
+  implicitDefEqProofs : Bool := false
   deriving Inhabited, BEq
 
 -- Configuration object for `simp_all`

src/Init/Notation.lean

@@ -267,7 +267,6 @@ syntax (name := rawNatLit) "nat_lit " num : term
 
 @[inherit_doc] infixr:90 " ∘ "  => Function.comp
 @[inherit_doc] infixr:35 " × "  => Prod
-@[inherit_doc] infixr:35 " ×' " => PProd
 
 @[inherit_doc] infix:50  " ∣ " => Dvd.dvd
 @[inherit_doc] infixl:55 " ||| " => HOr.hOr
@@ -704,28 +703,6 @@ syntax (name := checkSimp) "#check_simp " term "~>" term : command
 -/
 syntax (name := checkSimpFailure) "#check_simp " term "!~>" : command
 
-/--
-`#discr_tree_key  t` prints the discrimination tree keys for a term `t` (or, if it is a single identifier, the type of that constant).
-It uses the default configuration for generating keys.
-
-For example,
-```
-#discr_tree_key (∀ {a n : Nat}, bar a (OfNat.ofNat n))
--- bar _ (@OfNat.ofNat Nat _ _)
-
-#discr_tree_simp_key Nat.add_assoc
--- @HAdd.hAdd Nat Nat Nat _ (@HAdd.hAdd Nat Nat Nat _ _ _) _
-```
-
-`#discr_tree_simp_key` is similar to `#discr_tree_key`, but treats the underlying type
-as one of a simp lemma, i.e. transforms it into an equality and produces the key of the
-left-hand side.
--/
-syntax (name := discrTreeKeyCmd) "#discr_tree_key " term : command
-
-@[inherit_doc discrTreeKeyCmd]
-syntax (name := discrTreeSimpKeyCmd) "#discr_tree_simp_key" term : command
-
 /--
 The `seal foo` command ensures that the definition of `foo` is sealed, meaning it is marked as `[irreducible]`.
 This command is particularly useful in contexts where you want to prevent the reduction of `foo` in proofs.

src/Init/Omega/LinearCombo.lean

@@ -38,10 +38,6 @@ theorem ext {a b : LinearCombo} (w₁ : a.const = b.const) (w₂ : a.coeffs = b.
   subst w₁; subst w₂
   congr
 
-/-- Check if a linear combination is an atom, i.e. the constant term is zero and there is exactly one nonzero coefficient, which is one. -/
-def isAtom (a : LinearCombo) : Bool :=
-  a.const == 0 && (a.coeffs.filter (· == 1)).length == 1 && a.coeffs.all fun c => c == 0 || c == 1
-
 /--
 Evaluate a linear combination `⟨r, [c_1, …, c_k]⟩` at values `[v_1, …, v_k]` to obtain
 `r + (c_1 * x_1 + (c_2 * x_2 + ... (c_k * x_k + 0))))`.

src/Init/Prelude.lean

@@ -488,9 +488,9 @@ attribute [unbox] Prod
 
 /--
 Similar to `Prod`, but `α` and `β` can be propositions.
-You can use `α ×' β` as notation for `PProd α β`.
 We use this type internally to automatically generate the `brecOn` recursor.
 -/
+@[pp_using_anonymous_constructor]
 structure PProd (α : Sort u) (β : Sort v) where
   /-- The first projection out of a pair. if `p : PProd α β` then `p.1 : α`. -/
   fst : α
@@ -3172,8 +3172,8 @@ class MonadStateOf (σ : semiOutParam (Type u)) (m : Type u → Type v) where
 export MonadStateOf (set)
 
 /--
-Like `get`, but with `σ` explicit. This is useful if a monad supports
-`MonadStateOf` for multiple different types `σ`.
+Like `withReader`, but with `ρ` explicit. This is useful if a monad supports
+`MonadWithReaderOf` for multiple different types `ρ`.
 -/
 abbrev getThe (σ : Type u) {m : Type u → Type v} [MonadStateOf σ m] : m σ :=
   MonadStateOf.get

src/Init/PropLemmas.lean

@@ -253,9 +253,6 @@ end forall_congr
 
 @[simp] theorem not_exists : (¬∃ x, p x) ↔ ∀ x, ¬p x := exists_imp
 
-theorem forall_not_of_not_exists (h : ¬∃ x, p x) : ∀ x, ¬p x := not_exists.mp h
-theorem not_exists_of_forall_not (h : ∀ x, ¬p x) : ¬∃ x, p x := not_exists.mpr h
-
 theorem forall_and : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
   ⟨fun h => ⟨fun x => (h x).1, fun x => (h x).2⟩, fun ⟨h₁, h₂⟩ x => ⟨h₁ x, h₂ x⟩⟩
 
@@ -295,8 +292,6 @@ theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x,
 
 @[simp] theorem exists_eq_left' : (∃ a, a' = a ∧ p a) ↔ p a' := by simp [@eq_comm _ a']
 
-@[simp] theorem exists_eq_right' : (∃ a, p a ∧ a' = a) ↔ p a' := by simp [@eq_comm _ a']
-
 @[simp] theorem forall_eq_or_imp : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a := by
   simp only [or_imp, forall_and, forall_eq]
 
@@ -309,11 +304,6 @@ theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x,
 @[simp] theorem exists_eq_right_right' : (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' := by
   simp [@eq_comm _ a']
 
-@[simp] theorem exists_or_eq_left (y : α) (p : α → Prop) : ∃ x : α, x = y ∨ p x := ⟨y, .inl rfl⟩
-@[simp] theorem exists_or_eq_right (y : α) (p : α → Prop) : ∃ x : α, p x ∨ x = y := ⟨y, .inr rfl⟩
-@[simp] theorem exists_or_eq_left' (y : α) (p : α → Prop) : ∃ x : α, y = x ∨ p x := ⟨y, .inl rfl⟩
-@[simp] theorem exists_or_eq_right' (y : α) (p : α → Prop) : ∃ x : α, p x ∨ y = x := ⟨y, .inr rfl⟩
-
 @[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b :=
   ⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩
 
@@ -378,6 +368,9 @@ else isTrue fun h2 => absurd h2 h
 
 theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) ↔ p := by simp
 
+@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ↔ ¬p :=
+  ⟨of_decide_eq_false, decide_eq_false⟩
+
 @[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} :
     decide p = decide q ↔ (p ↔ q) :=
   ⟨fun h => by rw [← decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]⟩

src/Init/ShareCommon.lean

@@ -102,11 +102,3 @@ instance ShareCommonT.monadShareCommon [Monad m] : MonadShareCommon (ShareCommon
 
 @[inline] def ShareCommonT.run [Monad m] (x : ShareCommonT σ m α) : m α := x.run' default
 @[inline] def ShareCommonM.run (x : ShareCommonM σ α) : α := ShareCommonT.run x
-
-/--
-A more restrictive but efficient max sharing primitive.
-
-Remark: it optimizes the number of RC operations, and the strategy for caching results.
--/
-@[extern "lean_sharecommon_quick"]
-def ShareCommon.shareCommon' (a : α) : α := a

src/Init/SimpLemmas.lean

@@ -129,7 +129,6 @@ instance : Std.LawfulIdentity Or False where
 @[simp] theorem iff_false (p : Prop) : (p ↔ False) = ¬p := propext ⟨(·.1), (⟨·, False.elim⟩)⟩
 @[simp] theorem false_iff (p : Prop) : (False ↔ p) = ¬p := propext ⟨(·.2), (⟨False.elim, ·⟩)⟩
 @[simp] theorem false_implies (p : Prop) : (False → p) = True := eq_true False.elim
-@[simp] theorem forall_false (p : False → Prop) : (∀ h : False, p h) = True := eq_true (False.elim ·)
 @[simp] theorem implies_true (α : Sort u) : (α → True) = True := eq_true fun _ => trivial
 @[simp] theorem true_implies (p : Prop) : (True → p) = p := propext ⟨(· trivial), (fun _ => ·)⟩
 @[simp] theorem not_false_eq_true : (¬ False) = True := eq_true False.elim
@@ -229,22 +228,25 @@ instance : Std.Associative (· || ·) := ⟨Bool.or_assoc⟩
 @[simp] theorem Bool.not_not (b : Bool) : (!!b) = b := by cases b <;> rfl
 @[simp] theorem Bool.not_true  : (!true) = false := by decide
 @[simp] theorem Bool.not_false : (!false) = true := by decide
-@[simp] theorem beq_true  (b : Bool) : (b == true)  =  b := by cases b <;> rfl
-@[simp] theorem beq_false (b : Bool) : (b == false) = !b := by cases b <;> rfl
+@[simp] theorem Bool.not_beq_true  (b : Bool) : (!(b == true)) = (b == false) := by cases b <;> rfl
+@[simp] theorem Bool.not_beq_false (b : Bool) : (!(b == false)) = (b == true) := by cases b <;> rfl
 @[simp] theorem Bool.not_eq_true'  (b : Bool) : ((!b) = true) = (b = false) := by cases b <;> simp
 @[simp] theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by cases b <;> simp
 
+@[simp] theorem Bool.beq_to_eq (a b : Bool) :
+  (a == b) = (a = b) := by cases a <;> cases b <;> decide
+@[simp] theorem Bool.not_beq_to_not_eq (a b : Bool) :
+  (!(a == b)) = ¬(a = b) := by cases a <;> cases b <;> decide
+
 @[simp] theorem Bool.not_eq_true (b : Bool) : (¬(b = true)) = (b = false) := by cases b <;> decide
 @[simp] theorem Bool.not_eq_false (b : Bool) : (¬(b = false)) = (b = true) := by cases b <;> decide
 
 @[simp] theorem decide_eq_true_eq [Decidable p] : (decide p = true) = p :=
   propext <| Iff.intro of_decide_eq_true decide_eq_true
-@[simp] theorem decide_eq_false_iff_not {_ : Decidable p} : (decide p = false) ↔ ¬p :=
-  ⟨of_decide_eq_false, decide_eq_false⟩
-
 @[simp] theorem decide_not [g : Decidable p] [h : Decidable (Not p)] : decide (Not p) = !(decide p) := by
   cases g <;> (rename_i gp; simp [gp]; rfl)
-@[simp] theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by simp
+@[simp] theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by
+  cases h <;> (rename_i hp; simp [decide, hp])
 
 @[simp] theorem heq_eq_eq (a b : α) : HEq a b = (a = b) := propext <| Iff.intro eq_of_heq heq_of_eq
 
@@ -252,10 +254,10 @@ instance : Std.Associative (· || ·) := ⟨Bool.or_assoc⟩
 @[simp] theorem cond_false (a b : α) : cond false a b = b := rfl
 
 @[simp] theorem beq_self_eq_true [BEq α] [LawfulBEq α] (a : α) : (a == a) = true := LawfulBEq.rfl
-theorem beq_self_eq_true' [DecidableEq α] (a : α) : (a == a) = true := by simp
+@[simp] theorem beq_self_eq_true' [DecidableEq α] (a : α) : (a == a) = true := by simp [BEq.beq]
 
 @[simp] theorem bne_self_eq_false [BEq α] [LawfulBEq α] (a : α) : (a != a) = false := by simp [bne]
-theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp
+@[simp] theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp [bne]
 
 @[simp] theorem decide_False : decide False = false := rfl
 @[simp] theorem decide_True  : decide True  = true := rfl
@@ -281,10 +283,7 @@ These will both normalize to `a = b` with the first via `bne_eq_false_iff_eq`.
   rw [bne, ← beq_iff_eq a b]
   cases a == b <;> decide
 
-theorem Bool.beq_to_eq (a b : Bool) : (a == b) = (a = b) := by simp
-theorem Bool.not_beq_to_not_eq (a b : Bool) : (!(a == b)) = ¬(a = b) := by simp
-
-/- # Nat -/
+/-# Nat -/
 
 @[simp] theorem Nat.le_zero_eq (a : Nat) : (a ≤ 0) = (a = 0) :=
   propext ⟨fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by rw [h]; decide⟩

src/Init/System/IO.lean

@@ -712,17 +712,8 @@ structure Child (cfg : StdioConfig) where
 
 @[extern "lean_io_process_spawn"] opaque spawn (args : SpawnArgs) : IO (Child args.toStdioConfig)
 
-/--
-Block until the child process has exited and return its exit code.
--/
 @[extern "lean_io_process_child_wait"] opaque Child.wait {cfg : @& StdioConfig} : @& Child cfg → IO UInt32
 
-/--
-Check whether the child has exited yet. If it hasn't return none, otherwise its exit code.
--/
-@[extern "lean_io_process_child_try_wait"] opaque Child.tryWait {cfg : @& StdioConfig} : @& Child cfg →
-    IO (Option UInt32)
-
 /-- Terminates the child process using the SIGTERM signal or a platform analogue.
     If the process was started using `SpawnArgs.setsid`, terminates the entire process group instead. -/
 @[extern "lean_io_process_child_kill"] opaque Child.kill {cfg : @& StdioConfig} : @& Child cfg → IO Unit
@@ -823,10 +814,6 @@ def set (tk : CancelToken) : BaseIO Unit :=
 def isSet (tk : CancelToken) : BaseIO Bool :=
   tk.ref.get
 
--- separate definition as otherwise no unboxed version is generated
-@[export lean_io_cancel_token_is_set]
-private def isSetExport := @isSet
-
 end CancelToken
 
 namespace FS

src/Init/Util.lean

@@ -45,13 +45,6 @@ def dbgSleep {α : Type u} (ms : UInt32) (f : Unit → α) : α := f ()
 @[extern "lean_ptr_addr"]
 unsafe opaque ptrAddrUnsafe {α : Type u} (a : @& α) : USize
 
-/--
-Returns `true` if `a` is an exclusive object.
-We say an object is exclusive if it is single-threaded and its reference counter is 1.
--/
-@[extern "lean_is_exclusive_obj"]
-unsafe opaque isExclusiveUnsafe {α : Type u} (a : @& α) : Bool
-
 set_option linter.unusedVariables.funArgs false in
 @[inline] unsafe def withPtrAddrUnsafe {α : Type u} {β : Type v} (a : α) (k : USize → β) (h : ∀ u₁ u₂, k u₁ = k u₂) : β :=
   k (ptrAddrUnsafe a)

src/Init/WF.lean

@@ -148,26 +148,22 @@ end InvImage
   wf  := InvImage.wf f h.wf
 
 -- The transitive closure of a well-founded relation is well-founded
-open Relation
+namespace TC
+variable {α : Sort u} {r : α → α → Prop}
 
-theorem Acc.transGen (h : Acc r a) : Acc (TransGen r) a := by
-  induction h with
-  | intro x _ H =>
-    refine Acc.intro x fun y hy ↦ ?_
-    cases hy with
-    | single hyx =>
-      exact H y hyx
-    | tail hyz hzx =>
-      exact (H _ hzx).inv hyz
+theorem accessible {z : α} (ac : Acc r z) : Acc (TC r) z := by
+  induction ac with
+  | intro x acx ih =>
+    apply Acc.intro x
+    intro y rel
+    induction rel with
+    | base a b rab => exact ih a rab
+    | trans a b c rab _ _ ih₂ => apply Acc.inv (ih₂ acx ih) rab
 
-theorem acc_transGen_iff : Acc (TransGen r) a ↔ Acc r a :=
-  ⟨Subrelation.accessible TransGen.single, Acc.transGen⟩
+theorem wf (h : WellFounded r) : WellFounded (TC r) :=
+  ⟨fun a => accessible (apply h a)⟩
+end TC
 
-theorem WellFounded.transGen (h : WellFounded r) : WellFounded (TransGen r) :=
-  ⟨fun a ↦ (h.apply a).transGen⟩
-
-@[deprecated Acc.transGen (since := "2024-07-16")] abbrev TC.accessible := @Acc.transGen
-@[deprecated WellFounded.transGen (since := "2024-07-16")] abbrev TC.wf := @WellFounded.transGen
 namespace Nat
 
 -- less-than is well-founded
@@ -292,7 +288,7 @@ instance [ha : WellFoundedRelation α] [hb : WellFoundedRelation β] : WellFound
   lex ha hb
 
 -- relational product is a Subrelation of the Lex
-theorem RProdSubLex (a : α × β) (b : α × β) (h : RProd ra rb a b) : Prod.Lex ra rb a b := by
+def RProdSubLex (a : α × β) (b : α × β) (h : RProd ra rb a b) : Prod.Lex ra rb a b := by
   cases h with
   | intro h₁ h₂ => exact Prod.Lex.left _ _ h₁
 
@@ -324,7 +320,7 @@ section
 variable {α : Sort u} {β : α → Sort v}
 variable {r  : α → α → Prop} {s : ∀ (a : α), β a → β a → Prop}
 
-theorem lexAccessible {a} (aca : Acc r a) (acb : (a : α) → WellFounded (s a)) (b : β a) : Acc (Lex r s) ⟨a, b⟩ := by
+def lexAccessible {a} (aca : Acc r a) (acb : (a : α) → WellFounded (s a)) (b : β a) : Acc (Lex r s) ⟨a, b⟩ := by
   induction aca with
   | intro xa _ iha =>
     induction (WellFounded.apply (acb xa) b) with

src/Lean/AddDecl.lean

@@ -14,16 +14,14 @@ register_builtin_option debug.skipKernelTC : Bool := {
   descr    := "skip kernel type checker. WARNING: setting this option to true may compromise soundness because your proofs will not be checked by the Lean kernel"
 }
 
-def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
-    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment :=
+def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment :=
   if debug.skipKernelTC.get opts then
     addDeclWithoutChecking env decl
   else
-    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
+    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl
 
-def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
-    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
-  let env ← addDecl env opts decl cancelTk?
+def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment := do
+  let env ← addDecl env opts decl
   compileDecl env opts decl
 
 def addDecl (decl : Declaration) : CoreM Unit := do
@@ -31,7 +29,7 @@ def addDecl (decl : Declaration) : CoreM Unit := do
     withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
       if !(← MonadLog.hasErrors) && decl.hasSorry then
         logWarning "declaration uses 'sorry'"
-      match (← getEnv).addDecl (← getOptions) decl (← read).cancelTk? with
+      match (← getEnv).addDecl (← getOptions) decl with
       | .ok    env => setEnv env
       | .error ex  => throwKernelException ex
 

src/Lean/AuxRecursor.lean

@@ -37,7 +37,7 @@ def isAuxRecursor (env : Environment) (declName : Name) : Bool :=
 
 def isAuxRecursorWithSuffix (env : Environment) (declName : Name) (suffix : String) : Bool :=
   match declName with
-  | .str _ s => (s == suffix || s.startsWith s!"{suffix}_") && isAuxRecursor env declName
+  | .str _ s => s == suffix && isAuxRecursor env declName
   | _ => false
 
 def isCasesOnRecursor (env : Environment) (declName : Name) : Bool :=

src/Lean/Compiler/IR/EmitC.lean

@@ -94,7 +94,7 @@ def emitCInitName (n : Name) : M Unit :=
 def shouldExport (n : Name) : Bool :=
   -- HACK: exclude symbols very unlikely to be used by the interpreter or other consumers of
   -- libleanshared to avoid Windows symbol limit
-  !(`Lean.Compiler.LCNF).isPrefixOf n && !(`Lean.IR).isPrefixOf n && !(`Lean.Server).isPrefixOf n
+  !(`Lean.Compiler.LCNF).isPrefixOf n
 
 def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M Unit := do
   let ps := decl.params

src/Lean/Compiler/LCNF/Main.lean

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Compiler.Options
-import Lean.Compiler.ExternAttr
 import Lean.Compiler.LCNF.PassManager
 import Lean.Compiler.LCNF.Passes
 import Lean.Compiler.LCNF.PrettyPrinter

src/Lean/Compiler/LCNF/PrettyPrinter.lean

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
-import Lean.PrettyPrinter.Delaborator.Options
+import Lean.PrettyPrinter
 import Lean.Compiler.LCNF.CompilerM
 import Lean.Compiler.LCNF.Internalize
 

src/Lean/Data/RBMap.lean

@@ -80,10 +80,6 @@ protected def max : RBNode α β → Option (Sigma (fun k => β k))
 def singleton (k : α) (v : β k) : RBNode α β :=
   node red leaf k v leaf
 
-def isSingleton : RBNode α β → Bool
-  | node _ leaf _ _ leaf => true
-  | _ => false
-
 -- the first half of Okasaki's `balance`, concerning red-red sequences in the left child
 @[inline] def balance1 : RBNode α β → (a : α) → β a → RBNode α β → RBNode α β
   | node red (node red a kx vx b) ky vy c, kz, vz, d
@@ -273,9 +269,6 @@ variable {α : Type u} {β : Type v} {σ : Type w} {cmp : α → α → Ordering
 def depth (f : Nat → Nat → Nat) (t : RBMap α β cmp) : Nat :=
   t.val.depth f
 
-def isSingleton (t : RBMap α β cmp) : Bool :=
-  t.val.isSingleton
-
 @[inline] def fold (f : σ → α → β → σ) : (init : σ) → RBMap α β cmp → σ
   | b, ⟨t, _⟩ => t.fold f b
 

src/Lean/Data/SMap.lean

@@ -87,11 +87,6 @@ def switch (m : SMap α β) : SMap α β :=
 @[inline] def foldStage2 {σ : Type w} (f : σ → α → β → σ) (s : σ) (m : SMap α β) : σ :=
   m.map₂.foldl f s
 
-/-- Monadic fold over a staged map. -/
-def foldM {m : Type w → Type w} [Monad m]
-    (f : σ → α → β → m σ) (init : σ) (map : SMap α β) : m σ := do
-  map.map₂.foldlM f (← map.map₁.foldM f init)
-
 def fold {σ : Type w} (f : σ → α → β → σ) (init : σ) (m : SMap α β) : σ :=
   m.map₂.foldl f $ m.map₁.fold f init
 

src/Lean/Declaration.lean

@@ -239,10 +239,6 @@ structure InductiveVal extends ConstantVal where
   all : List Name
   /-- List of the names of the constructors for this inductive datatype. -/
   ctors : List Name
-  /-- Number of auxillary data types produced from nested occurrences.
-  An inductive definition `T` is nested when there is a constructor with an argument `x : F T`,
-   where `F : Type → Type` is some suitably behaved (ie strictly positive) function (Eg `Array T`, `List T`, `T × T`, ...).  -/
-  numNested : Nat
   /-- `true` when recursive (that is, the inductive type appears as an argument in a constructor). -/
   isRec : Bool
   /-- Whether the definition is flagged as unsafe. -/
@@ -261,12 +257,14 @@ structure InductiveVal extends ConstantVal where
   Section 2.2, Definition 3
   -/
   isReflexive : Bool
-
+  /-- An inductive definition `T` is nested when there is a constructor with an argument `x : F T`,
+   where `F : Type → Type` is some suitably behaved (ie strictly positive) function (Eg `Array T`, `List T`, `T × T`, ...). -/
+  isNested : Bool
   deriving Inhabited
 
 @[export lean_mk_inductive_val]
 def mkInductiveValEx (name : Name) (levelParams : List Name) (type : Expr) (numParams numIndices : Nat)
-    (all ctors : List Name) (numNested : Nat) (isRec isUnsafe isReflexive : Bool) : InductiveVal := {
+    (all ctors : List Name) (isRec isUnsafe isReflexive isNested : Bool) : InductiveVal := {
   name := name
   levelParams := levelParams
   type := type
@@ -274,19 +272,18 @@ def mkInductiveValEx (name : Name) (levelParams : List Name) (type : Expr) (numP
   numIndices := numIndices
   all := all
   ctors := ctors
-  numNested := numNested
   isRec := isRec
   isUnsafe := isUnsafe
   isReflexive := isReflexive
+  isNested := isNested
 }
 
 @[export lean_inductive_val_is_rec] def InductiveVal.isRecEx (v : InductiveVal) : Bool := v.isRec
 @[export lean_inductive_val_is_unsafe] def InductiveVal.isUnsafeEx (v : InductiveVal) : Bool := v.isUnsafe
 @[export lean_inductive_val_is_reflexive] def InductiveVal.isReflexiveEx (v : InductiveVal) : Bool := v.isReflexive
+@[export lean_inductive_val_is_nested] def InductiveVal.isNestedEx (v : InductiveVal) : Bool := v.isNested
 
 def InductiveVal.numCtors (v : InductiveVal) : Nat := v.ctors.length
-def InductiveVal.isNested (v : InductiveVal) : Bool := v.numNested > 0
-def InductiveVal.numTypeFormers (v : InductiveVal) : Nat := v.all.length + v.numNested
 
 structure ConstructorVal extends ConstantVal where
   /-- Inductive type this constructor is a member of -/

src/Lean/Elab/App.lean

@@ -742,10 +742,7 @@ def mkMotive (discrs : Array Expr) (expectedType : Expr): MetaM Expr := do
     let motiveBody ← kabstract motive discr
     /- We use `transform (usedLetOnly := true)` to eliminate unnecessary let-expressions. -/
     let discrType ← transform (usedLetOnly := true) (← instantiateMVars (← inferType discr))
-    let motive := Lean.mkLambda (← mkFreshBinderName) BinderInfo.default discrType motiveBody
-    unless (← isTypeCorrect motive) do
-      throwError "failed to elaborate eliminator, motive is not type correct:{indentD motive}"
-    return motive
+    return Lean.mkLambda (← mkFreshBinderName) BinderInfo.default discrType motiveBody
 
 /-- If the eliminator is over-applied, we "revert" the extra arguments. -/
 def revertArgs (args : List Arg) (f : Expr) (expectedType : Expr) : TermElabM (Expr × Expr) :=
@@ -1295,7 +1292,6 @@ private partial def elabAppFnId (fIdent : Syntax) (fExplicitUnivs : List Level)
     funLVals.foldlM (init := acc) fun acc (f, fIdent, fields) => do
       let lvals' := toLVals fields (first := true)
       let s ← observing do
-        checkDeprecated fIdent f
         let f ← addTermInfo fIdent f expectedType?
         let e ← elabAppLVals f (lvals' ++ lvals) namedArgs args expectedType? explicit ellipsis
         if overloaded then ensureHasType expectedType? e else return e
@@ -1428,27 +1424,8 @@ private def getSuccesses (candidates : Array (TermElabResult Expr)) : TermElabM
           return false
       return true
     | _ => return false
-  if r₂.size == 0 then
-    return r₁
-  if r₂.size == 1 then
-    return r₂
-  /-
-  If there are still more than one solution, discard solutions that have pending metavariables.
-  We added this extra filter to address regressions introduced after fixing
-  `isDefEqStuckEx` behavior at `ExprDefEq.lean`.
-  -/
-  let r₂ ← candidates.filterM fun
-    | .ok _ s => do
-      try
-        s.restore
-        synthesizeSyntheticMVars (postpone := .no)
-        return true
-      catch _ =>
-        return false
-    | _ => return false
-  if r₂.size == 0 then
-    return r₁
-  return r₂
+  if r₂.size == 0 then return r₁ else return r₂
+
 /--
   Throw an error message that describes why each possible interpretation for the overloaded notation and symbols did not work.
   We use a nested error message to aggregate the exceptions produced by each failure.

src/Lean/Elab/Binders.lean

@@ -8,7 +8,7 @@ import Lean.Elab.Quotation.Precheck
 import Lean.Elab.Term
 import Lean.Elab.BindersUtil
 import Lean.Elab.SyntheticMVars
-import Lean.Elab.PreDefinition.TerminationHint
+import Lean.Elab.PreDefinition.WF.TerminationHint
 
 namespace Lean.Elab.Term
 open Meta

src/Lean/Elab/BuiltinCommand.lean

@@ -11,6 +11,7 @@ import Lean.Elab.Eval
 import Lean.Elab.Command
 import Lean.Elab.Open
 import Lean.Elab.SetOption
+import Lean.PrettyPrinter
 
 namespace Lean.Elab.Command
 

src/Lean/Elab/BuiltinNotation.lean

@@ -205,7 +205,7 @@ private def elabTParserMacroAux (prec lhsPrec e : Term) : TermElabM Syntax := do
   | _                                        => Macro.throwUnsupported
 
 @[builtin_term_elab «sorry»] def elabSorry : TermElab := fun stx expectedType? => do
-  let stxNew ← `(@sorryAx _ false) -- Remark: we use `@` to ensure `sorryAx` will not consume auto params
+  let stxNew ← `(@sorryAx _ false) -- Remark: we use `@` to ensure `sorryAx` will not consume auot params
   withMacroExpansion stx stxNew <| elabTerm stxNew expectedType?
 
 /-- Return syntax `Prod.mk elems[0] (Prod.mk elems[1] ... (Prod.mk elems[elems.size - 2] elems[elems.size - 1])))` -/
@@ -220,31 +220,6 @@ partial def mkPairs (elems : Array Term) : MacroM Term :=
       pure acc
   loop (elems.size - 1) elems.back
 
-/-- Return syntax `PProd.mk elems[0] (PProd.mk elems[1] ... (PProd.mk elems[elems.size - 2] elems[elems.size - 1])))` -/
-partial def mkPPairs (elems : Array Term) : MacroM Term :=
-  let rec loop (i : Nat) (acc : Term) := do
-    if i > 0 then
-      let i    := i - 1
-      let elem := elems[i]!
-      let acc ← `(PProd.mk $elem $acc)
-      loop i acc
-    else
-      pure acc
-  loop (elems.size - 1) elems.back
-
-/-- Return syntax `MProd.mk elems[0] (MProd.mk elems[1] ... (MProd.mk elems[elems.size - 2] elems[elems.size - 1])))` -/
-partial def mkMPairs (elems : Array Term) : MacroM Term :=
-  let rec loop (i : Nat) (acc : Term) := do
-    if i > 0 then
-      let i    := i - 1
-      let elem := elems[i]!
-      let acc ← `(MProd.mk $elem $acc)
-      loop i acc
-    else
-      pure acc
-  loop (elems.size - 1) elems.back
-
-
 open Parser in
 partial def hasCDot : Syntax → Bool
   | Syntax.node _ k args =>

src/Lean/Elab/BuiltinTerm.lean

@@ -316,7 +316,9 @@ private def mkSilentAnnotationIfHole (e : Expr) : TermElabM Expr := do
           return false
     return true
   if canClear then
-    withErasedFVars #[fvarId] do elabTerm body expectedType?
+    let lctx := (← getLCtx).erase fvarId
+    let localInsts := (← getLocalInstances).filter (·.fvar.fvarId! != fvarId)
+    withLCtx lctx localInsts do elabTerm body expectedType?
   else
     elabTerm body expectedType?
 
@@ -362,7 +364,4 @@ private opaque evalFilePath (stx : Syntax) : TermElabM System.FilePath
     mkStrLit <$> IO.FS.readFile path
   | _, _ => throwUnsupportedSyntax
 
-@[builtin_term_elab Lean.Parser.Term.namedPattern] def elabNamedPatternErr : TermElab := fun stx _ =>
-  throwError "`<identifier>@<term>` is a named pattern and can only be used in pattern matching contexts{indentD stx}"
-
 end Lean.Elab.Term

src/Lean/Elab/ComputedFields.lean

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Gabriel Ebner
 -/
 prelude
-import Lean.Meta.Constructions.CasesOn
+import Lean.Meta.Constructions
 import Lean.Compiler.ImplementedByAttr
 import Lean.Elab.PreDefinition.WF.Eqns
 

src/Lean/Elab/LetRec.lean

@@ -22,7 +22,7 @@ structure LetRecDeclView where
   type          : Expr
   mvar          : Expr -- auxiliary metavariable used to lift the 'let rec'
   valStx        : Syntax
-  termination   : TerminationHints
+  termination   : WF.TerminationHints
 
 structure LetRecView where
   decls     : Array LetRecDeclView
@@ -65,7 +65,7 @@ private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
         pure decl[4]
       else
         liftMacroM <| expandMatchAltsIntoMatch decl decl[3]
-      let termination ← elabTerminationHints ⟨attrDeclStx[3]⟩
+      let termination ← WF.elabTerminationHints ⟨attrDeclStx[3]⟩
       decls := decls.push {
         ref := declId, attrs, shortDeclName, declName,
         binderIds, type, mvar, valStx, termination

src/Lean/Elab/Match.lean

@@ -672,7 +672,8 @@ partial def main (patternVarDecls : Array PatternVarDecl) (ps : Array Expr) (mat
         throwError "invalid patterns, `{mkFVar explicit}` is an explicit pattern variable, but it only occurs in positions that are inaccessible to pattern matching{indentD (MessageData.joinSep (ps.toList.map (MessageData.ofExpr .)) m!"\n\n")}"
   let packed ← pack patternVars ps matchType
   trace[Elab.match] "packed: {packed}"
-  withErasedFVars explicitPatternVars do
+  let lctx := explicitPatternVars.foldl (init := (← getLCtx)) fun lctx d => lctx.erase d
+  withTheReader Meta.Context (fun ctx => { ctx with lctx := lctx }) do
     check packed
     unpack packed fun patternVars patterns matchType => do
       let localDecls ← patternVars.mapM fun x => x.fvarId!.getDecl

src/Lean/Elab/MutualDef.lean

@@ -14,7 +14,7 @@ import Lean.Elab.Match
 import Lean.Elab.DefView
 import Lean.Elab.Deriving.Basic
 import Lean.Elab.PreDefinition.Main
-import Lean.Elab.PreDefinition.TerminationHint
+import Lean.Elab.PreDefinition.WF.TerminationHint
 import Lean.Elab.DeclarationRange
 
 namespace Lean.Elab
@@ -167,9 +167,14 @@ private def elabHeaders (views : Array DefView)
         else
           reuseBody := false
 
-      let mut (newHeader, newState) ← withRestoreOrSaveFull reusableResult? none do
-        withReuseContext view.headerRef do
+      let mut (newHeader, newState) ← withRestoreOrSaveFull reusableResult? do
+        withRef view.headerRef do
+        addDeclarationRanges declName view.ref  -- NOTE: this should be the full `ref`
         applyAttributesAt declName view.modifiers.attrs .beforeElaboration
+        -- do not hide header errors on partial body syntax as these two elaboration parts are
+        -- sufficiently independent
+        withTheReader Core.Context ({ · with suppressElabErrors :=
+          view.headerRef.hasMissing && !Command.showPartialSyntaxErrors.get (← getOptions) }) do
         withDeclName declName <| withAutoBoundImplicit <| withLevelNames levelNames <|
           elabBindersEx view.binders.getArgs fun xs => do
             let refForElabFunType := view.value
@@ -315,11 +320,11 @@ private def declValToTerm (declVal : Syntax) : MacroM Syntax := withRef declVal
     Macro.throwErrorAt declVal "unexpected declaration body"
 
 /-- Elaborates the termination hints in a `declVal` syntax. -/
-private def declValToTerminationHint (declVal : Syntax) : TermElabM TerminationHints :=
+private def declValToTerminationHint (declVal : Syntax) : TermElabM WF.TerminationHints :=
   if declVal.isOfKind ``Parser.Command.declValSimple then
-    elabTerminationHints ⟨declVal[2]⟩
+    WF.elabTerminationHints ⟨declVal[2]⟩
   else if declVal.isOfKind ``Parser.Command.declValEqns then
-    elabTerminationHints ⟨declVal[0][1]⟩
+    WF.elabTerminationHints ⟨declVal[0][1]⟩
   else
     return .none
 
@@ -332,10 +337,14 @@ private def elabFunValues (headers : Array DefViewElabHeader) : TermElabM (Array
         -- elaboration
         if let some old := old.val.get then
           snap.new.resolve <| some old
+          -- also make sure to reuse tactic snapshots if present so that body reuse does not lead to
+          -- missed tactic reuse on further changes
+          if let some tacSnap := header.tacSnap? then
+            if let some oldTacSnap := tacSnap.old? then
+              tacSnap.new.resolve oldTacSnap.val.get
           reusableResult? := some (old.value, old.state)
 
-    let (val, state) ← withRestoreOrSaveFull reusableResult? header.tacSnap? do
-      withReuseContext header.value do
+    let (val, state) ← withRestoreOrSaveFull reusableResult? do
       withDeclName header.declName <| withLevelNames header.levelNames do
       let valStx ← liftMacroM <| declValToTerm header.value
       forallBoundedTelescope header.type header.numParams fun xs type => do
@@ -728,26 +737,12 @@ def insertReplacementForLetRecs (r : Replacement) (letRecClosures : List LetRecC
   letRecClosures.foldl (init := r) fun r c =>
     r.insert c.toLift.fvarId c.closed
 
-def isApplicable (r : Replacement) (e : Expr) : Bool :=
-  Option.isSome <| e.findExt? fun e =>
-    if e.hasFVar then
-      match e with
-      | .fvar fvarId => if r.contains fvarId then .found else .done
-      | _ => .visit
-    else
-      .done
-
 def Replacement.apply (r : Replacement) (e : Expr) : Expr :=
-  -- Remark: if `r` is not a singlenton, then declaration is using `mutual` or `let rec`,
-  -- and there is a big chance `isApplicable r e` is true.
-  if r.isSingleton && !isApplicable r e then
-    e
-  else
-    e.replace fun e => match e with
-      | .fvar fvarId => match r.find? fvarId with
-        | some c => some c
-        | _      => none
-      | _ => none
+  e.replace fun e => match e with
+    | .fvar fvarId => match r.find? fvarId with
+      | some c => some c
+      | _      => none
+    | _ => none
 
 def pushMain (preDefs : Array PreDefinition) (sectionVars : Array Expr) (mainHeaders : Array DefViewElabHeader) (mainVals : Array Expr)
     : TermElabM (Array PreDefinition) :=
@@ -937,18 +932,12 @@ where
             trace[Elab.definition] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
           let preDefs ← withLevelNames allUserLevelNames <| levelMVarToParamPreDecls preDefs
           let preDefs ← instantiateMVarsAtPreDecls preDefs
-          let preDefs ← shareCommonPreDefs preDefs
           let preDefs ← fixLevelParams preDefs scopeLevelNames allUserLevelNames
           for preDef in preDefs do
             trace[Elab.definition] "after eraseAuxDiscr, {preDef.declName} : {preDef.type} :=\n{preDef.value}"
           checkForHiddenUnivLevels allUserLevelNames preDefs
           addPreDefinitions preDefs
           processDeriving headers
-      for view in views, header in headers do
-        -- NOTE: this should be the full `ref`, and thus needs to be done after any snapshotting
-        -- that depends only on a part of the ref
-        addDeclarationRanges header.declName view.ref
-
 
   processDeriving (headers : Array DefViewElabHeader) := do
     for header in headers, view in views do

src/Lean/Elab/PreDefinition/Basic.lean

@@ -4,14 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
 prelude
-import Init.ShareCommon
 import Lean.Compiler.NoncomputableAttr
 import Lean.Util.CollectLevelParams
 import Lean.Meta.AbstractNestedProofs
 import Lean.Meta.ForEachExpr
 import Lean.Elab.RecAppSyntax
 import Lean.Elab.DefView
-import Lean.Elab.PreDefinition.TerminationHint
+import Lean.Elab.PreDefinition.WF.TerminationHint
 
 namespace Lean.Elab
 open Meta
@@ -30,7 +29,7 @@ structure PreDefinition where
   declName    : Name
   type        : Expr
   value       : Expr
-  termination : TerminationHints
+  termination : WF.TerminationHints
   deriving Inhabited
 
 def PreDefinition.filterAttrs (preDef : PreDefinition) (p : Attribute → Bool) : PreDefinition :=
@@ -54,20 +53,18 @@ private def getLevelParamsPreDecls (preDefs : Array PreDefinition) (scopeLevelNa
   | Except.ok levelParams => pure levelParams
 
 def fixLevelParams (preDefs : Array PreDefinition) (scopeLevelNames allUserLevelNames : List Name) : TermElabM (Array PreDefinition) := do
-  profileitM Exception s!"fix level params" (← getOptions) do
-    withTraceNode `Elab.def.fixLevelParams (fun _ => return m!"fix level params") do
-      -- We used to use `shareCommon` here, but is was a bottleneck
-      let levelParams ← getLevelParamsPreDecls preDefs scopeLevelNames allUserLevelNames
-      let us := levelParams.map mkLevelParam
-      let fixExpr (e : Expr) : Expr :=
-        e.replace fun c => match c with
-          | Expr.const declName _ => if preDefs.any fun preDef => preDef.declName == declName then some $ Lean.mkConst declName us else none
-          | _ => none
-      return preDefs.map fun preDef =>
-        { preDef with
-          type        := fixExpr preDef.type,
-          value       := fixExpr preDef.value,
-          levelParams := levelParams }
+  -- We used to use `shareCommon` here, but is was a bottleneck
+  let levelParams ← getLevelParamsPreDecls preDefs scopeLevelNames allUserLevelNames
+  let us := levelParams.map mkLevelParam
+  let fixExpr (e : Expr) : Expr :=
+    e.replace fun c => match c with
+      | Expr.const declName _ => if preDefs.any fun preDef => preDef.declName == declName then some $ Lean.mkConst declName us else none
+      | _ => none
+  return preDefs.map fun preDef =>
+    { preDef with
+      type        := fixExpr preDef.type,
+      value       := fixExpr preDef.value,
+      levelParams := levelParams }
 
 def applyAttributesOf (preDefs : Array PreDefinition) (applicationTime : AttributeApplicationTime) : TermElabM Unit := do
   for preDef in preDefs do
@@ -186,44 +183,16 @@ def addAndCompilePartialRec (preDefs : Array PreDefinition) : TermElabM Unit :=
             | _ => none
           modifiers := {} }
 
-private def containsRecFn (recFnNames : Array Name) (e : Expr) : Bool :=
-  (e.find? fun e => e.isConst && recFnNames.contains e.constName!).isSome
+private def containsRecFn (recFnName : Name) (e : Expr) : Bool :=
+  (e.find? fun e => e.isConstOf recFnName).isSome
 
-def ensureNoRecFn (recFnNames : Array Name) (e : Expr) : MetaM Unit := do
-  if containsRecFn recFnNames e then
+def ensureNoRecFn (recFnName : Name) (e : Expr) : MetaM Expr := do
+  if containsRecFn recFnName e then
     Meta.forEachExpr e fun e => do
-      if e.getAppFn.isConst && recFnNames.contains e.getAppFn.constName! then
+      if e.isAppOf recFnName then
         throwError "unexpected occurrence of recursive application{indentExpr e}"
-
-/--
-Checks that all codomains have the same level, throws an error otherwise.
--/
-def checkCodomainsLevel (preDefs : Array PreDefinition) : MetaM Unit := do
-  if preDefs.size = 1 then return
-  let arities ← preDefs.mapM fun preDef =>
-    lambdaTelescope preDef.value fun xs _ => return xs.size
-  forallBoundedTelescope preDefs[0]!.type arities[0]!  fun _ type₀ => do
-    let u₀ ← getLevel type₀
-    for i in [1:preDefs.size] do
-      forallBoundedTelescope preDefs[i]!.type arities[i]! fun _ typeᵢ =>
-      unless ← isLevelDefEq u₀ (← getLevel typeᵢ) do
-        withOptions (fun o => pp.sanitizeNames.set o false) do
-          throwError m!"invalid mutual definition, result types must be in the same universe " ++
-            m!"level, resulting type " ++
-            m!"for `{preDefs[0]!.declName}` is{indentExpr type₀} : {← inferType type₀}\n" ++
-            m!"and for `{preDefs[i]!.declName}` is{indentExpr typeᵢ} : {← inferType typeᵢ}"
-
-def shareCommonPreDefs (preDefs : Array PreDefinition) : CoreM (Array PreDefinition) := do
-  profileitM Exception "share common exprs" (← getOptions) do
-    withTraceNode `Elab.def.maxSharing (fun _ => return m!"share common exprs") do
-      let mut es := #[]
-      for preDef in preDefs do
-        es := es.push preDef.type |>.push preDef.value
-      es := ShareCommon.shareCommon' es
-      let mut result := #[]
-      for h : i in [:preDefs.size] do
-        let preDef := preDefs[i]
-        result := result.push { preDef with type := es[2*i]!, value := es[2*i+1]! }
-      return result
+    pure e
+  else
+    pure e
 
 end Lean.Elab

src/Lean/Elab/PreDefinition/Eqns.lean

@@ -333,7 +333,7 @@ def tryContradiction (mvarId : MVarId) : MetaM Bool := do
 partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Unit := do
   let some eqs ← getEqnsFor? declName | throwError "failed to generate equations for '{declName}'"
   let tryEqns (mvarId : MVarId) : MetaM Bool :=
-    eqs.anyM fun eq => commitWhen do checkpointDefEq (mayPostpone := false) do
+    eqs.anyM fun eq => commitWhen do
       try
         let subgoals ← mvarId.apply (← mkConstWithFreshMVarLevels eq)
         subgoals.allM fun subgoal => do

src/Lean/Elab/PreDefinition/Main.lean

@@ -95,128 +95,65 @@ def ensureFunIndReservedNamesAvailable (preDefs : Array PreDefinition) : MetaM U
     withRef preDef.ref <| ensureReservedNameAvailable preDef.declName "induct"
   withRef preDefs[0]!.ref <| ensureReservedNameAvailable preDefs[0]!.declName "mutual_induct"
 
-
-/--
-Checks consistency of a clique of TerminationHints:
-
-* If not all have a hint, the hints are ignored (log error)
-* If one has `structural`, check that all have it, (else throw error)
-* A `structural` shold not have a `decreasing_by` (else log error)
-
--/
-def checkTerminationByHints (preDefs : Array PreDefinition) : CoreM Unit := do
-  let some preDefWith := preDefs.find? (·.termination.terminationBy?.isSome) | return
-  let preDefsWithout := preDefs.filter (·.termination.terminationBy?.isNone)
-  let structural :=
-    preDefWith.termination.terminationBy? matches some {structural := true, ..}
-  for preDef in preDefs do
-    if let .some termBy := preDef.termination.terminationBy? then
-      if !structural && !preDefsWithout.isEmpty then
-        let m := MessageData.andList (preDefsWithout.toList.map (m!"{·.declName}"))
-        let doOrDoes := if preDefsWithout.size = 1 then "does" else "do"
-        logErrorAt termBy.ref (m!"Incomplete set of `termination_by` annotations:\n"++
-          m!"This function is mutually with {m}, which {doOrDoes} not have " ++
-          m!"a `termination_by` clause.\n" ++
-          m!"The present clause is ignored.")
-
-      if structural && ! termBy.structural then
-        throwErrorAt termBy.ref (m!"Invalid `termination_by`; this function is mutually " ++
-          m!"recursive with {preDefWith.declName}, which is marked as `termination_by " ++
-          m!"structural` so this one also needs to be marked `structural`.")
-      if ! structural && termBy.structural then
-        throwErrorAt termBy.ref (m!"Invalid `termination_by`; this function is mutually " ++
-          m!"recursive with {preDefWith.declName}, which is not marked as `structural` " ++
-          m!"so this one cannot be `structural` either.")
-      if termBy.structural then
-        if let .some decr := preDef.termination.decreasingBy? then
-          logErrorAt decr.ref (m!"Invalid `decreasing_by`; this function is marked as " ++
-            m!"structurally recursive, so no explicit termination proof is needed.")
-
-/--
-Elaborates the `TerminationHint` in the clique to `TerminationArguments`
--/
-def elabTerminationByHints (preDefs : Array PreDefinition) : TermElabM (Array (Option TerminationArgument)) := do
-  preDefs.mapM fun preDef => do
-    let arity ← lambdaTelescope preDef.value fun xs _ => pure xs.size
-    let hints := preDef.termination
-    hints.terminationBy?.mapM
-      (TerminationArgument.elab preDef.declName preDef.type arity hints.extraParams ·)
-
-def shouldUseStructural (preDefs : Array PreDefinition) : Bool :=
-  preDefs.any fun preDef =>
-    preDef.termination.terminationBy? matches some {structural := true, ..}
-
-def shouldUseWF (preDefs : Array PreDefinition) : Bool :=
-  preDefs.any fun preDef =>
-    preDef.termination.terminationBy? matches some {structural := false, ..} ||
-    preDef.termination.decreasingBy?.isSome
-
-
 def addPreDefinitions (preDefs : Array PreDefinition) : TermElabM Unit := withLCtx {} {} do
-  profileitM Exception "process pre-definitions" (← getOptions) do
-    withTraceNode `Elab.def.processPreDef (fun _ => return m!"process pre-definitions") do
+  for preDef in preDefs do
+    trace[Elab.definition.body] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
+  let preDefs ← preDefs.mapM ensureNoUnassignedMVarsAtPreDef
+  let preDefs ← betaReduceLetRecApps preDefs
+  let cliques := partitionPreDefs preDefs
+  for preDefs in cliques do
+    trace[Elab.definition.scc] "{preDefs.map (·.declName)}"
+    if preDefs.size == 1 && isNonRecursive preDefs[0]! then
+      /-
+      We must erase `recApp` annotations even when `preDef` is not recursive
+      because it may use another recursive declaration in the same mutual block.
+      See issue #2321
+      -/
+      let preDef ← eraseRecAppSyntax preDefs[0]!
+      ensureEqnReservedNamesAvailable preDef.declName
+      if preDef.modifiers.isNoncomputable then
+        addNonRec preDef
+      else
+        addAndCompileNonRec preDef
+      preDef.termination.ensureNone "not recursive"
+    else if preDefs.any (·.modifiers.isUnsafe) then
+      addAndCompileUnsafe preDefs
+      preDefs.forM (·.termination.ensureNone "unsafe")
+    else if preDefs.any (·.modifiers.isPartial) then
       for preDef in preDefs do
-        trace[Elab.definition.body] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
-      let preDefs ← preDefs.mapM ensureNoUnassignedMVarsAtPreDef
-      let preDefs ← betaReduceLetRecApps preDefs
-      let cliques := partitionPreDefs preDefs
-      for preDefs in cliques do
-        trace[Elab.definition.scc] "{preDefs.map (·.declName)}"
-        if preDefs.size == 1 && isNonRecursive preDefs[0]! then
-          /-
-          We must erase `recApp` annotations even when `preDef` is not recursive
-          because it may use another recursive declaration in the same mutual block.
-          See issue #2321
-          -/
-          let preDef ← eraseRecAppSyntax preDefs[0]!
-          ensureEqnReservedNamesAvailable preDef.declName
-          if preDef.modifiers.isNoncomputable then
-            addNonRec preDef
-          else
-            addAndCompileNonRec preDef
-          preDef.termination.ensureNone "not recursive"
-        else if preDefs.any (·.modifiers.isUnsafe) then
-          addAndCompileUnsafe preDefs
-          preDefs.forM (·.termination.ensureNone "unsafe")
-        else if preDefs.any (·.modifiers.isPartial) then
-          for preDef in preDefs do
-            if preDef.modifiers.isPartial && !(← whnfD preDef.type).isForall then
-              withRef preDef.ref <| throwError "invalid use of 'partial', '{preDef.declName}' is not a function{indentExpr preDef.type}"
-          addAndCompilePartial preDefs
-          preDefs.forM (·.termination.ensureNone "partial")
+        if preDef.modifiers.isPartial && !(← whnfD preDef.type).isForall then
+          withRef preDef.ref <| throwError "invalid use of 'partial', '{preDef.declName}' is not a function{indentExpr preDef.type}"
+      addAndCompilePartial preDefs
+      preDefs.forM (·.termination.ensureNone "partial")
+    else
+      ensureFunIndReservedNamesAvailable preDefs
+      try
+        let hasHints := preDefs.any fun preDef => preDef.termination.isNotNone
+        if hasHints then
+          wfRecursion preDefs
         else
-          ensureFunIndReservedNamesAvailable preDefs
-          try
-            checkCodomainsLevel preDefs
-            checkTerminationByHints preDefs
-            let termArg?s ← elabTerminationByHints preDefs
-            if shouldUseStructural preDefs then
-              structuralRecursion preDefs termArg?s
-            else if shouldUseWF preDefs then
-              wfRecursion preDefs termArg?s
-            else
-              withRef (preDefs[0]!.ref) <| mapError
-                (orelseMergeErrors
-                  (structuralRecursion preDefs termArg?s)
-                  (wfRecursion preDefs termArg?s))
-                (fun msg =>
-                  let preDefMsgs := preDefs.toList.map (MessageData.ofExpr $ mkConst ·.declName)
-                  m!"fail to show termination for{indentD (MessageData.joinSep preDefMsgs Format.line)}\nwith errors\n{msg}")
-          catch ex =>
-            logException ex
-            let s ← saveState
+          withRef (preDefs[0]!.ref) <| mapError
+            (orelseMergeErrors
+              (structuralRecursion preDefs)
+              (wfRecursion preDefs))
+            (fun msg =>
+              let preDefMsgs := preDefs.toList.map (MessageData.ofExpr $ mkConst ·.declName)
+              m!"fail to show termination for{indentD (MessageData.joinSep preDefMsgs Format.line)}\nwith errors\n{msg}")
+      catch ex =>
+        logException ex
+        let s ← saveState
+        try
+          if preDefs.all fun preDef => preDef.kind == DefKind.def || preDefs.all fun preDef => preDef.kind == DefKind.abbrev then
+            -- try to add as partial definition
             try
-              if preDefs.all fun preDef => preDef.kind == DefKind.def || preDefs.all fun preDef => preDef.kind == DefKind.abbrev then
-                -- try to add as partial definition
-                try
-                  addAndCompilePartial preDefs (useSorry := true)
-                catch _ =>
-                  -- Compilation failed try again just as axiom
-                  s.restore
-                  addAsAxioms preDefs
-              else if preDefs.all fun preDef => preDef.kind == DefKind.theorem then
-                addAsAxioms preDefs
-            catch _ => s.restore
+              addAndCompilePartial preDefs (useSorry := true)
+            catch _ =>
+              -- Compilation failed try again just as axiom
+              s.restore
+              addAsAxioms preDefs
+          else if preDefs.all fun preDef => preDef.kind == DefKind.theorem then
+            addAsAxioms preDefs
+        catch _ => s.restore
 
 builtin_initialize
   registerTraceClass `Elab.definition.body

src/Lean/Elab/PreDefinition/Structural/BRecOn.lean

@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, Joachim Breitner
+Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Util.HasConstCache
@@ -9,8 +9,6 @@ import Lean.Meta.Match.MatcherApp.Transform
 import Lean.Elab.RecAppSyntax
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Structural.Basic
-import Lean.Elab.PreDefinition.Structural.FunPacker
-import Lean.Elab.PreDefinition.Structural.RecArgInfo
 
 namespace Lean.Elab.Structural
 open Meta
@@ -18,80 +16,48 @@ open Meta
 private def throwToBelowFailed : MetaM α :=
   throwError "toBelow failed"
 
-partial def searchPProd (e : Expr) (F : Expr) (k : Expr → Expr → MetaM α) : MetaM α := do
-  match (← whnf e) with
-  | .app (.app (.const `PProd _) d1) d2 =>
-        (do searchPProd d1 (← mkAppM ``PProd.fst #[F]) k)
-    <|> (do searchPProd d2 (← mkAppM `PProd.snd #[F]) k)
-  | .app (.app (.const `And _) d1) d2 =>
-        (do searchPProd d1 (← mkAppM `And.left #[F]) k)
-    <|> (do searchPProd d2 (← mkAppM `And.right #[F]) k)
-  | .const `PUnit _
-  | .const `True _ => throwToBelowFailed
-  | _ => k e F
-
 /-- See `toBelow` -/
 private partial def toBelowAux (C : Expr) (belowDict : Expr) (arg : Expr) (F : Expr) : MetaM Expr := do
-  trace[Elab.definition.structural] "belowDict start:{indentExpr belowDict}\narg:{indentExpr arg}"
-  -- First search through the PProd packing of the different `brecOn` motives
-  searchPProd belowDict F fun belowDict F => do
-    trace[Elab.definition.structural] "belowDict step 1:{indentExpr belowDict}"
-    -- Then instantiate parameters of a reflexive type, if needed
-    forallTelescopeReducing belowDict fun xs belowDict => do
-      let arg ← zetaReduce arg
-      let argArgs := arg.getAppArgs
-      unless argArgs.size >= xs.size do throwToBelowFailed
-      let n := argArgs.size
-      let argTailArgs := argArgs.extract (n - xs.size) n
-      let belowDict := belowDict.replaceFVars xs argTailArgs
-      -- And again search through the PProd packing due to multiple functions recursing on the
-      -- same inductive data type
-      -- (We could use the funIdx and the `positions` array to replace this search with more
-      -- targeted indexing.)
-      searchPProd belowDict (mkAppN F argTailArgs) fun belowDict F => do
-        trace[Elab.definition.structural] "belowDict step 2:{indentExpr belowDict}"
-        match belowDict with
-        | .app belowDictFun belowDictArg =>
-          unless belowDictFun.getAppFn == C do throwToBelowFailed
-          unless ← isDefEq belowDictArg arg do throwToBelowFailed
-          pure F
-        | _ =>
-          trace[Elab.definition.structural] "belowDict not an app:{indentExpr belowDict}"
-          throwToBelowFailed
+  let belowDict ← whnf belowDict
+  trace[Elab.definition.structural] "belowDict: {belowDict}, arg: {arg}"
+  match belowDict with
+  | .app (.app (.const `PProd _) d1) d2 =>
+    (do toBelowAux C d1 arg (← mkAppM `PProd.fst #[F]))
+    <|>
+    (do toBelowAux C d2 arg (← mkAppM `PProd.snd #[F]))
+  | .app (.app (.const `And _) d1) d2 =>
+    (do toBelowAux C d1 arg (← mkAppM `And.left #[F]))
+    <|>
+    (do toBelowAux C d2 arg (← mkAppM `And.right #[F]))
+  | _ => forallTelescopeReducing belowDict fun xs belowDict => do
+    let arg ← zetaReduce arg
+    let argArgs := arg.getAppArgs
+    unless argArgs.size >= xs.size do throwToBelowFailed
+    let n := argArgs.size
+    let argTailArgs := argArgs.extract (n - xs.size) n
+    let belowDict := belowDict.replaceFVars xs argTailArgs
+    match belowDict with
+    | .app belowDictFun belowDictArg =>
+      unless belowDictFun.getAppFn == C do throwToBelowFailed
+      unless ← isDefEq belowDictArg arg do throwToBelowFailed
+      pure (mkAppN F argTailArgs)
+    | _ => throwToBelowFailed
 
 /-- See `toBelow` -/
-private def withBelowDict [Inhabited α] (below : Expr) (numIndParams : Nat)
-    (positions : Positions) (k : Array Expr → Expr → MetaM α) : MetaM α := do
-  let numTypeFormers := positions.size
+private def withBelowDict (below : Expr) (numIndParams : Nat) (k : Expr → Expr → MetaM α) : MetaM α := do
   let belowType ← inferType below
   trace[Elab.definition.structural] "belowType: {belowType}"
-  unless (← isTypeCorrect below) do
-    trace[Elab.definition.structural] "not type correct!"
   belowType.withApp fun f args => do
-    unless numIndParams + numTypeFormers < args.size do
-      trace[Elab.definition.structural] "unexpected 'below' type{indentExpr belowType}"
-      throwToBelowFailed
-    let params := args[:numIndParams]
-    let finalArgs := args[numIndParams+numTypeFormers:]
-    let pre := mkAppN f params
-    let motiveTypes ← inferArgumentTypesN numTypeFormers pre
-    let numMotives : Nat := positions.numIndices
-    trace[Elab.definition.structural] "numMotives: {numMotives}"
-    let mut CTypes := Array.mkArray numMotives (.sort 37) -- dummy value
-    for poss in positions, motiveType in motiveTypes do
-      for pos in poss do
-        CTypes := CTypes.set! pos motiveType
-    let CDecls : Array (Name × (Array Expr → MetaM Expr)) ← CTypes.mapM fun t => do
-        return ((← mkFreshUserName `C), fun _ => pure t)
-    withLocalDeclsD CDecls fun Cs => do
-      -- We have to pack these canary motives like we packed the real motives
-      let packedCs ← positions.mapMwith packMotives motiveTypes Cs
-      let belowDict := mkAppN pre packedCs
-      let belowDict := mkAppN belowDict finalArgs
-      trace[Elab.definition.structural] "initial belowDict for {Cs}:{indentExpr belowDict}"
-      unless (← isTypeCorrect belowDict) do
-        trace[Elab.definition.structural] "not type correct!"
-      k Cs belowDict
+    let motivePos := numIndParams + 1
+    unless motivePos < args.size do throwError "unexpected 'below' type{indentExpr belowType}"
+    let pre := mkAppN f (args.extract 0 numIndParams)
+    let preType ← inferType pre
+    forallBoundedTelescope preType (some 1) fun x _ => do
+      let motiveType ← inferType x[0]!
+      withLocalDeclD (← mkFreshUserName `C) motiveType fun C =>
+        let belowDict := mkApp pre C
+        let belowDict := mkAppN belowDict (args.extract (numIndParams + 1) args.size)
+        k C belowDict
 
 /--
   `below` is a free variable with type of the form `I.below indParams motive indices major`,
@@ -113,16 +79,14 @@ private def withBelowDict [Inhabited α] (below : Expr) (numIndParams : Nat)
   We search this dictionary using the auxiliary function `toBelowAux`.
   The dictionary is built using the `PProd` (`And` for inductive predicates).
   We keep searching it until we find `C recArg`, where `C` is the auxiliary fresh variable created at `withBelowDict`.  -/
-private partial def toBelow (below : Expr) (numIndParams : Nat) (positions : Positions) (fnIndex : Nat) (recArg : Expr) : MetaM Expr := do
-  withBelowDict below numIndParams positions fun Cs belowDict =>
-    toBelowAux Cs[fnIndex]! belowDict recArg below
+private partial def toBelow (below : Expr) (numIndParams : Nat) (recArg : Expr) : MetaM Expr := do
+  withBelowDict below numIndParams fun C belowDict =>
+    toBelowAux C belowDict recArg below
 
-private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions : Positions)
-    (below : Expr) (e : Expr) : M Expr :=
-  let recFnNames := recArgInfos.map (·.fnName)
-  let containsRecFn (e : Expr) : StateRefT (HasConstCache recFnNames) M Bool :=
+private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
+  let containsRecFn (e : Expr) : StateRefT (HasConstCache recFnName) M Bool :=
     modifyGet (·.contains e)
-  let rec loop (below : Expr) (e : Expr) : StateRefT (HasConstCache recFnNames) M Expr := do
+  let rec loop (below : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) M Expr := do
     if !(← containsRecFn e) then
       return e
     match e with
@@ -142,26 +106,32 @@ private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions :
         return mkMData d (← loop below b)
     | Expr.proj n i e => return mkProj n i (← loop below e)
     | Expr.app _ _ =>
-      let processApp (e : Expr) : StateRefT (HasConstCache recFnNames) M Expr :=
+      let processApp (e : Expr) : StateRefT (HasConstCache recFnName) M Expr :=
         e.withApp fun f args => do
-          if let .some fnIdx := recArgInfos.findIdx? (f.isConstOf ·.fnName) then
-            let recArgInfo := recArgInfos[fnIdx]!
-            let some recArg := args[recArgInfo.recArgPos]?
-              | throwError "insufficient number of parameters at recursive application {indentExpr e}"
+          if f.isConstOf recFnName then
+            let numFixed  := recArgInfo.fixedParams.size
+            let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
+            if recArgPos >= args.size then
+              throwError "insufficient number of parameters at recursive application {indentExpr e}"
+            let recArg := args[recArgPos]!
             -- For reflexive type, we may have nested recursive applications in recArg
             let recArg ← loop below recArg
-            let f ←
-              try toBelow below recArgInfo.indGroupInst.params.size positions fnIdx recArg
-              catch _ => throwError "failed to eliminate recursive application{indentExpr e}"
-            -- We don't pass the fixed parameters, the indices and the major arg to `f`, only the rest
-            let (_, fArgs) := recArgInfo.pickIndicesMajor args[recArgInfo.numFixed:]
-            let fArgs ← fArgs.mapM (replaceRecApps recArgInfos positions below ·)
+            let f ← try toBelow below recArgInfo.indParams.size recArg catch  _ => throwError "failed to eliminate recursive application{indentExpr e}"
+            -- Recall that the fixed parameters are not in the scope of the `brecOn`. So, we skip them.
+            let argsNonFixed := args.extract numFixed args.size
+            -- The function `f` does not explicitly take `recArg` and its indices as arguments. So, we skip them too.
+            let mut fArgs := #[]
+            for i in [:argsNonFixed.size] do
+              if recArgInfo.pos != i && !recArgInfo.indicesPos.contains i then
+                let arg := argsNonFixed[i]!
+                let arg ← replaceRecApps recFnName recArgInfo below arg
+                fArgs := fArgs.push arg
             return mkAppN f fArgs
           else
             return mkAppN (← loop below f) (← args.mapM (loop below))
       match (← matchMatcherApp? (alsoCasesOn := true) e) with
       | some matcherApp =>
-        if recArgInfos.all (fun recArgInfo => !recArgHasLooseBVarsAt recArgInfo.fnName recArgInfo.recArgPos e) then
+        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
           processApp e
         else
           /- Here is an example we currently do not handle
@@ -183,9 +153,9 @@ private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions :
           trace[Elab.definition.structural] "below before matcherApp.addArg: {below} : {← inferType below}"
           if let some matcherApp ← matcherApp.addArg? below then
             let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
-              lambdaBoundedTelescope alt numParams fun xs altBody => do
+              lambdaTelescope alt fun xs altBody => do
                 trace[Elab.definition.structural] "altNumParams: {numParams}, xs: {xs}"
-                unless xs.size = numParams do
+                unless xs.size >= numParams do
                   throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
                 let belowForAlt := xs[numParams - 1]!
                 mkLambdaFVars xs (← loop belowForAlt altBody)
@@ -193,108 +163,49 @@ private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions :
           else
             processApp e
       | none => processApp e
-    | e =>
-      ensureNoRecFn recFnNames e
-      pure e
+    | e => ensureNoRecFn recFnName e
   loop below e |>.run' {}
 
-/--
-Calculates the `.brecOn` motive corresponding to one structural recursive function.
-The `value` is the function with (only) the fixed parameters moved into the context.
--/
-def mkBRecOnMotive (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
-  lambdaTelescope value fun xs value => do
-    let type  := (← inferType value).headBeta
-    let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
-    let motive ← mkForallFVars otherArgs type
-    mkLambdaFVars indexMajorArgs motive
-
-/--
-Calculates the `.brecOn` functional argument corresponding to one structural recursive function.
-The `value` is the function with (only) the fixed parameters moved into the context,
-The `type` is the expected type of the argument.
-The `recArgInfos` is used to transform the body of the function to replace recursive calls with
-uses of the `below` induction hypothesis.
--/
-def mkBRecOnF (recArgInfos : Array RecArgInfo) (positions : Positions)
-    (recArgInfo : RecArgInfo) (value : Expr) (FType : Expr) : M Expr := do
-  lambdaTelescope value fun xs value => do
-    let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
-    let FType ← instantiateForall FType indexMajorArgs
+def mkBRecOn (recFnName : Name) (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
+  trace[Elab.definition.structural] "mkBRecOn: {value}"
+  let type  := (← inferType value).headBeta
+  let major := recArgInfo.ys[recArgInfo.pos]!
+  let otherArgs := recArgInfo.ys.filter fun y => y != major && !recArgInfo.indIndices.contains y
+  trace[Elab.definition.structural] "fixedParams: {recArgInfo.fixedParams}, otherArgs: {otherArgs}"
+  let motive ← mkForallFVars otherArgs type
+  let mut brecOnUniv ← getLevel motive
+  trace[Elab.definition.structural] "brecOn univ: {brecOnUniv}"
+  let useBInductionOn := recArgInfo.reflexive && brecOnUniv == levelZero
+  if recArgInfo.reflexive && brecOnUniv != levelZero then
+    brecOnUniv ← decLevel brecOnUniv
+  let motive ← mkLambdaFVars (recArgInfo.indIndices.push major) motive
+  trace[Elab.definition.structural] "brecOn motive: {motive}"
+  let brecOn :=
+    if useBInductionOn then
+      Lean.mkConst (mkBInductionOnName recArgInfo.indName) recArgInfo.indLevels
+    else
+      Lean.mkConst (mkBRecOnName recArgInfo.indName) (brecOnUniv :: recArgInfo.indLevels)
+  let brecOn := mkAppN brecOn recArgInfo.indParams
+  let brecOn := mkApp brecOn motive
+  let brecOn := mkAppN brecOn recArgInfo.indIndices
+  let brecOn := mkApp brecOn major
+  check brecOn
+  let brecOnType ← inferType brecOn
+  trace[Elab.definition.structural] "brecOn     {brecOn}"
+  trace[Elab.definition.structural] "brecOnType {brecOnType}"
+  forallBoundedTelescope brecOnType (some 1) fun F _ => do
+    let F := F[0]!
+    let FType ← inferType F
+    trace[Elab.definition.structural] "FType: {FType}"
+    let FType ← instantiateForall FType recArgInfo.indIndices
+    let FType ← instantiateForall FType #[major]
     forallBoundedTelescope FType (some 1) fun below _ => do
       -- TODO: `below` user name is `f`, and it will make a global `f` to be pretty printed as `_root_.f` in error messages.
       -- We should add an option to `forallBoundedTelescope` to ensure fresh names are used.
       let below := below[0]!
-      let valueNew   ← replaceRecApps recArgInfos positions below value
-      mkLambdaFVars (indexMajorArgs ++ #[below] ++ otherArgs) valueNew
-
-/--
-Given the `motives`, figures out whether to use `.brecOn` or `.binductionOn`, pass
-the right universe levels, the parameters, and the motives.
-It was already checked earlier in `checkCodomainsLevel` that the functions live in the same universe.
--/
-def mkBRecOnConst (recArgInfos : Array RecArgInfo) (positions : Positions)
-   (motives : Array Expr) : MetaM (Nat → Expr) := do
-  let indGroup := recArgInfos[0]!.indGroupInst
-  let motive := motives[0]!
-  let brecOnUniv ← lambdaTelescope motive fun _ type => getLevel type
-  let indInfo ← getConstInfoInduct indGroup.all[0]!
-  let useBInductionOn := indInfo.isReflexive && brecOnUniv == levelZero
-  let brecOnUniv ←
-    if indInfo.isReflexive && brecOnUniv != levelZero then
-      decLevel brecOnUniv
-    else
-      pure brecOnUniv
-  let brecOnCons := fun idx => indGroup.brecOn useBInductionOn brecOnUniv idx
-  -- Pick one as a prototype
-  let brecOnAux := brecOnCons 0
-  -- Infer the type of the packed motive arguments
-  let packedMotiveTypes ← inferArgumentTypesN indGroup.numMotives brecOnAux
-  let packedMotives ← positions.mapMwith packMotives packedMotiveTypes motives
-
-  return fun n => mkAppN (brecOnCons n) packedMotives
-
-/--
-Given the `recArgInfos` and the `motives`, infer the types of the `F` arguments to the `.brecOn`
-combinators. This assumes that all `.brecOn` functions of a mutual inductive have the same structure.
-
-It also undoes the permutation and packing done by `packMotives`
--/
-def inferBRecOnFTypes (recArgInfos : Array RecArgInfo) (positions : Positions)
-    (brecOnConst : Nat → Expr) : MetaM (Array Expr) := do
-  let numTypeFormers := positions.size
-  let recArgInfo := recArgInfos[0]! -- pick an arbitrary one
-  let brecOn := brecOnConst 0
-  check brecOn
-  let brecOnType ← inferType brecOn
-  -- Skip the indices and major argument
-  let packedFTypes ← forallBoundedTelescope brecOnType (some (recArgInfo.indicesPos.size + 1)) fun _ brecOnType =>
-    -- And return the types of of the next arguments
-    arrowDomainsN numTypeFormers brecOnType
-
-  let mut FTypes := Array.mkArray positions.numIndices (Expr.sort 0)
-  for packedFType in packedFTypes, poss in positions do
-    for pos in poss do
-      FTypes := FTypes.set! pos packedFType
-  return FTypes
-
-/--
-Completes the `.brecOn` for the given function.
-The `value` is the function with (only) the fixed parameters moved into the context.
--/
-def mkBrecOnApp (positions : Positions) (fnIdx : Nat) (brecOnConst : Nat → Expr)
-    (FArgs : Array Expr) (recArgInfo : RecArgInfo) (value : Expr) : MetaM Expr := do
-  lambdaTelescope value fun ys _value => do
-    let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor ys
-    let brecOn := brecOnConst recArgInfo.indIdx
-    let brecOn := mkAppN brecOn indexMajorArgs
-    let packedFTypes ← inferArgumentTypesN positions.size brecOn
-    let packedFArgs ← positions.mapMwith packFArgs packedFTypes FArgs
-    let brecOn := mkAppN brecOn packedFArgs
-    let some poss := positions.find? (·.contains fnIdx)
-      | throwError "mkBrecOnApp: Could not find {fnIdx} in {positions}"
-    let brecOn ← if poss.size = 1 then pure brecOn else
-      mkPProdProjN (poss.getIdx? fnIdx).get! brecOn
-    mkLambdaFVars ys (mkAppN brecOn otherArgs)
+      let valueNew     ← replaceRecApps recFnName recArgInfo below value
+      let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
+      let brecOn       := mkApp brecOn Farg
+      return mkAppN brecOn otherArgs
 
 end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/Basic.lean

@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, Joachim Breitner
+Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Meta.Basic
@@ -9,6 +9,31 @@ import Lean.Meta.ForEachExpr
 
 namespace Lean.Elab.Structural
 
+structure RecArgInfo where
+  /-- `fixedParams ++ ys` are the arguments of the function we are trying to justify termination using structural recursion. -/
+  fixedParams : Array Expr
+  /-- recursion arguments -/
+  ys          : Array Expr
+  /-- position in `ys` of the argument we are recursing on -/
+  pos         : Nat
+  /-- position in `ys` of the inductive datatype indices we are recursing on -/
+  indicesPos  : Array Nat
+  /-- inductive datatype name of the argument we are recursing on -/
+  indName     : Name
+  /-- inductive datatype universe levels of the argument we are recursing on -/
+  indLevels   : List Level
+  /-- inductive datatype parameters of the argument we are recursing on -/
+  indParams   : Array Expr
+  /-- inductive datatype indices of the argument we are recursing on, it is equal to `indicesPos.map fun i => ys.get! i` -/
+  indIndices  : Array Expr
+  /-- true if we are recursing over a reflexive inductive datatype -/
+  reflexive   : Bool
+  /-- true if the type is an inductive predicate -/
+  indPred     : Bool
+
+def RecArgInfo.recArgPos (info : RecArgInfo) : Nat :=
+  info.fixedParams.size + info.pos
+
 structure State where
   /-- As part of the inductive predicates case, we keep adding more and more discriminants from the
      local context and build up a bigger matcher application until we reach a fixed point.
@@ -39,55 +64,4 @@ def recArgHasLooseBVarsAt (recFnName : Name) (recArgPos : Nat) (e : Expr) : Bool
      e.isAppOf recFnName && e.getAppNumArgs > recArgPos && (e.getArg! recArgPos).hasLooseBVars
   app?.isSome
 
-
-/--
-Lets say we have `n` mutually recursive functions whose recursive arguments are from a group
-of `m` mutually inductive data types. This mapping does not have to be one-to-one: for one type
-there can be zero, one or more functions. We use the logic in the `FunPacker` modules to combine
-the bodies (and motives) of multiple such functions.
-
-Therefore we have to take the `n` functions, group them by their recursive argument's type,
-and for each such type, keep track of the order of the functions.
-
-We represent these positions as an `Array (Array Nat)`. We have that
-
-* `positions.size = indInfo.numTypeFormers`
-* `positions.flatten` is a permutation of `[0:n]`, so each of the `n` functions has exactly one
-  position, and each position refers to one of the `n` functions.
-* if `k ∈ positions[i]` then the recursive argument of function `k` is has type `indInfo.all[i]`
-  (or corresponding nested inductive type)
-
--/
-abbrev Positions := Array (Array Nat)
-
-/--
-The number of indices in the array.
--/
-def Positions.numIndices (positions : Positions) : Nat :=
-    positions.foldl (fun s poss => s + poss.size) 0
-
-/--
-Groups the `xs` by their `f` value, and puts these groups into the order given by `ys`.
--/
-def Positions.groupAndSort {α β} [Inhabited α] [DecidableEq β]
-    (f : α → β) (xs : Array α) (ys : Array β) : Positions :=
-  let positions := ys.map fun y => (Array.range xs.size).filter fun i => f xs[i]! = y
-  -- Sanity check: is this really a grouped permutation of all the indices?
-  assert! Array.range xs.size == positions.flatten.qsort Nat.blt
-  positions
-
-/--
-Let `positions.size = ys.size` and `positions.numIndices = xs.size`. Maps `f` over each `y` in `ys`,
-also passing in those elements `xs` that belong to that are those elements of `xs` that belong to
-`y` according to `positions`.
--/
-def Positions.mapMwith {α β m} [Monad m] [Inhabited β] (f : α → Array β → m γ)
-    (positions : Positions) (ys : Array α) (xs : Array β) : m (Array γ) := do
-  assert! positions.size = ys.size
-  assert! positions.numIndices = xs.size
-  (Array.zip ys positions).mapM fun ⟨y, poss⟩ => f y (poss.map (xs[·]!))
-
 end Lean.Elab.Structural
-
-builtin_initialize
-  Lean.registerTraceClass `Elab.definition.structural

src/Lean/Elab/PreDefinition/Structural/Eqns.lean

@@ -19,9 +19,7 @@ open Eqns
 namespace Structural
 
 structure EqnInfo extends EqnInfoCore where
-  recArgPos : Nat
-  declNames : Array Name
-  numFixed  : Nat
+  recArgPos   : Nat
   deriving Inhabited
 
 private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
@@ -64,12 +62,12 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
     let us := info.levelParams.map mkLevelParam
     let target ← mkEq (mkAppN (Lean.mkConst info.declName us) xs) body
     let goal ← mkFreshExprSyntheticOpaqueMVar target
-    mkEqnTypes (tryRefl := true) info.declNames goal.mvarId!
+    mkEqnTypes (tryRefl := true) #[info.declName] goal.mvarId!
   let baseName := info.declName
   let mut thmNames := #[]
   for i in [: eqnTypes.size] do
     let type := eqnTypes[i]!
-    trace[Elab.definition.structural.eqns] "eqnType {i}: {type}"
+    trace[Elab.definition.structural.eqns] "{eqnTypes[i]!}"
     let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
     thmNames := thmNames.push name
     let value ← mkProof info.declName type
@@ -82,11 +80,9 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
 
 builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
 
-def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat)
-    (numFixed : Nat) : CoreM Unit := do
+def registerEqnsInfo (preDef : PreDefinition) (recArgPos : Nat) : CoreM Unit := do
   ensureEqnReservedNamesAvailable preDef.declName
-  modifyEnv fun env => eqnInfoExt.insert env preDef.declName
-    { preDef with recArgPos, declNames, numFixed }
+  modifyEnv fun env => eqnInfoExt.insert env preDef.declName { preDef with recArgPos }
 
 def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
   if let some info := eqnInfoExt.find? (← getEnv) declName then

src/Lean/Elab/PreDefinition/Structural/FindRecArg.lean

@@ -1,34 +1,14 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, Joachim Breitner
+Authors: Leonardo de Moura
 -/
 prelude
-import Lean.Elab.PreDefinition.TerminationArgument
 import Lean.Elab.PreDefinition.Structural.Basic
-import Lean.Elab.PreDefinition.Structural.RecArgInfo
 
 namespace Lean.Elab.Structural
 open Meta
 
-def prettyParam (xs : Array Expr) (i : Nat) : MetaM MessageData := do
-  let x := xs[i]!
-  let n ← x.fvarId!.getUserName
-  addMessageContextFull <| if n.hasMacroScopes then m!"#{i+1}" else m!"{x}"
-
-def prettyRecArg (xs : Array Expr) (value : Expr) (recArgInfo : RecArgInfo) : MetaM MessageData := do
-  lambdaTelescope value fun ys _ => prettyParam (xs ++ ys) recArgInfo.recArgPos
-
-def prettyParameterSet (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
-    (recArgInfos : Array RecArgInfo) : MetaM MessageData := do
-  if fnNames.size = 1 then
-    return m!"parameter " ++ (← prettyRecArg xs values[0]! recArgInfos[0]!)
-  else
-    let mut l := #[]
-    for fnName in fnNames, value in values, recArgInfo in recArgInfos do
-      l := l.push m!"{(← prettyRecArg xs value recArgInfo)} of {fnName}"
-    return m!"parameters " ++ .andList l.toList
-
 private def getIndexMinPos (xs : Array Expr) (indices : Array Expr) : Nat := Id.run do
   let mut minPos := xs.size
   for index in indices do
@@ -49,16 +29,20 @@ private def hasBadIndexDep? (ys : Array Expr) (indices : Array Expr) : MetaM (Op
 -- Inductive datatype parameters cannot depend on ys
 private def hasBadParamDep? (ys : Array Expr) (indParams : Array Expr) : MetaM (Option (Expr × Expr)) := do
   for p in indParams do
+    let pType ← inferType p
     for y in ys do
-      if ← dependsOn p y.fvarId! then
+      if ← dependsOn pType y.fvarId! then
         return some (p, y)
   return none
 
 /--
-Assemble the `RecArgInfo` for the `i`th parameter in the parameter list `xs`. This performs
+Pass to `k` the `RecArgInfo` for the `i`th parameter in the parameter list `xs`. This performs
 various sanity checks on the argument (is it even an inductive type etc).
+Also wraps all errors in a common “argument cannot be used” header
 -/
-def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) : MetaM RecArgInfo := do
+def withRecArgInfo (numFixed : Nat) (xs : Array Expr) (i : Nat) (k : RecArgInfo → M α) : M α := do
+  mapError
+    (f := fun msg => m!"argument #{i+1} cannot be used for structural recursion{indentD msg}") do
   if h : i < xs.size then
     if i < numFixed then
       throwError "it is unchanged in the recursive calls"
@@ -69,213 +53,80 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
     let xType ← whnfD localDecl.type
     matchConstInduct xType.getAppFn (fun _ => throwError "its type is not an inductive") fun indInfo us => do
     if !(← hasConst (mkBRecOnName indInfo.name)) then
-      throwError "its type {indInfo.name} does not have a recursor"
+      throwError "its type does not have a recursor"
     else if indInfo.isReflexive && !(← hasConst (mkBInductionOnName indInfo.name)) && !(← isInductivePredicate indInfo.name) then
-      throwError "its type {indInfo.name} is a reflexive inductive, but {mkBInductionOnName indInfo.name} does not exist and it is not an inductive predicate"
+      throwError "its type is a reflexive inductive, but {mkBInductionOnName indInfo.name} does not exist and it is not an inductive predicate"
     else
-      let indArgs    : Array Expr := xType.getAppArgs
-      let indParams  : Array Expr := indArgs[0:indInfo.numParams]
-      let indIndices : Array Expr := indArgs[indInfo.numParams:]
+      let indArgs    := xType.getAppArgs
+      let indParams  := indArgs.extract 0 indInfo.numParams
+      let indIndices := indArgs.extract indInfo.numParams indArgs.size
       if !indIndices.all Expr.isFVar then
-        throwError "its type {indInfo.name} is an inductive family and indices are not variables{indentExpr xType}"
+        throwError "its type is an inductive family and indices are not variables{indentExpr xType}"
       else if !indIndices.allDiff then
-        throwError " its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
+        throwError " its type is an inductive family and indices are not pairwise distinct{indentExpr xType}"
       else
         let indexMinPos := getIndexMinPos xs indIndices
         let numFixed    := if indexMinPos < numFixed then indexMinPos else numFixed
-        let ys          := xs[numFixed:]
+        let fixedParams := xs.extract 0 numFixed
+        let ys          := xs.extract numFixed xs.size
         match (← hasBadIndexDep? ys indIndices) with
         | some (index, y) =>
-          throwError "its type {indInfo.name} is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
+          throwError "its type is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
         | none =>
           match (← hasBadParamDep? ys indParams) with
           | some (indParam, y) =>
-            throwError "its type is an inductive datatype{indentExpr xType}\nand the datatype parameter{indentExpr indParam}\ndepends on the function parameter{indentExpr y}\nwhich does not come before the varying parameters and before the indices of the recursion parameter."
+            throwError "its type is an inductive datatype{indentExpr xType}\nand parameter{indentExpr indParam}\ndepends on{indentExpr y}"
           | none =>
-            let indAll := indInfo.all.toArray
-            let .some indIdx := indAll.indexOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
-            let indicesPos := indIndices.map fun index => match xs.indexOf? index with | some i => i.val | none => unreachable!
-            let indGroupInst := {
-              IndGroupInfo.ofInductiveVal indInfo with
-              levels := us
-              params := indParams }
-            return { fnName       := fnName
-                     numFixed     := numFixed
-                     recArgPos    := i
-                     indicesPos   := indicesPos
-                     indGroupInst := indGroupInst
-                     indIdx       := indIdx }
+            let indicesPos := indIndices.map fun index => match ys.indexOf? index with | some i => i.val | none => unreachable!
+            k { fixedParams := fixedParams
+                ys          := ys
+                pos         := i - fixedParams.size
+                indicesPos  := indicesPos
+                indName     := indInfo.name
+                indLevels   := us
+                indParams   := indParams
+                indIndices  := indIndices
+                reflexive   := indInfo.isReflexive
+                indPred     := ←isInductivePredicate indInfo.name }
     else
       throwError "the index #{i+1} exceeds {xs.size}, the number of parameters"
 
 /--
-Collects the `RecArgInfos` for one function, and returns a report for why the others were not
-considered.
+  Try to find an argument that is structurally smaller in every recursive application.
+  We use this argument to justify termination using the auxiliary `brecOn` construction.
 
-The `xs` are the fixed parameters, `value` the body with the fixed prefix instantiated.
-
-Takes the optional user annotations into account (`termArg?`). If this is given and the argument
-is unsuitable, throw an error.
+  We give preference for arguments that are *not* indices of inductive types of other arguments.
+  See issue #837 for an example where we can show termination using the index of an inductive family, but
+  we don't get the desired definitional equalities.
 -/
-def getRecArgInfos (fnName : Name) (xs : Array Expr) (value : Expr)
-    (termArg? : Option TerminationArgument) : MetaM (Array RecArgInfo × MessageData) := do
-  lambdaTelescope value fun ys _ => do
-    if let .some termArg := termArg? then
-      -- User explictly asked to use a certain argument, so throw errors eagerly
-      let recArgInfo ← withRef termArg.ref do
-        mapError (f := (m!"cannot use specified parameter for structural recursion:{indentD ·}")) do
-          getRecArgInfo fnName xs.size (xs ++ ys) (← termArg.structuralArg)
-      return (#[recArgInfo], m!"")
-    else
-      let mut recArgInfos := #[]
-      let mut report : MessageData := m!""
-      -- No `termination_by`, so try all, and remember the errors
-      for idx in [:xs.size + ys.size] do
-        try
-          let recArgInfo ← getRecArgInfo fnName xs.size (xs ++ ys) idx
-          recArgInfos := recArgInfos.push recArgInfo
-        catch e =>
-          report := report ++ (m!"Not considering parameter {← prettyParam (xs ++ ys) idx} of {fnName}:" ++
-            indentD e.toMessageData) ++ "\n"
-      trace[Elab.definition.structural] "getRecArgInfos report: {report}"
-      return (recArgInfos, report)
-
-
-/--
-Reorders the `RecArgInfos` of one function to put arguments that are indices of other arguments
-last.
-See issue #837 for an example where we can show termination using the index of an inductive family, but
-we don't get the desired definitional equalities.
--/
-def nonIndicesFirst (recArgInfos : Array RecArgInfo) : Array RecArgInfo := Id.run do
-  let mut indicesPos : HashSet Nat := {}
-  for recArgInfo in recArgInfos do
-    for pos in recArgInfo.indicesPos do
-      indicesPos := indicesPos.insert pos
-  let (indices,nonIndices) := recArgInfos.partition (indicesPos.contains ·.recArgPos)
-  return nonIndices ++ indices
-
-private def dedup [Monad m] (eq : α → α → m Bool) (xs : Array α) : m (Array α) := do
-  let mut ret := #[]
+partial def findRecArg (numFixed : Nat) (xs : Array Expr) (k : RecArgInfo → M α) : M α := do
+  /- Collect arguments that are indices. See comment above. -/
+  let indicesRef : IO.Ref (Array Nat) ← IO.mkRef {}
   for x in xs do
-    unless (← ret.anyM (eq · x)) do
-      ret := ret.push x
-  return ret
-
-/--
-Given the `RecArgInfo`s of all the recursive functions, find the inductive groups to consider.
--/
-def inductiveGroups (recArgInfos : Array RecArgInfo) : MetaM (Array IndGroupInst) :=
-  dedup IndGroupInst.isDefEq (recArgInfos.map (·.indGroupInst))
-
-/--
-Filters the `recArgInfos` by those that describe an argument that's part of the recursive inductive
-group `group`.
-
-Because of nested inductives this function has the ability to change the `recArgInfo`.
-Consider
-```
-inductive Tree where | node : List Tree → Tree
-```
-then when we look for arguments whose type is part of the group `Tree`, we want to also consider
-the argument of type `List Tree`, even though that argument’s `RecArgInfo` refers to initially to
-`List`.
--/
-def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
-    (recArgInfos : Array RecArgInfo) : MetaM (Array RecArgInfo) := do
-
-  let nestedTypeFormers ← group.nestedTypeFormers
-
-  recArgInfos.filterMapM fun recArgInfo => do
-    -- Is this argument from the same mutual group of inductives?
-    if (← group.isDefEq recArgInfo.indGroupInst) then
-      return (.some recArgInfo)
-
-    -- Can this argument be understood as the auxillary type former of a nested inductive?
-    if nestedTypeFormers.isEmpty then return .none
-    lambdaTelescope value fun ys _ => do
-      let x := (xs++ys)[recArgInfo.recArgPos]!
-      for nestedTypeFormer in nestedTypeFormers, indIdx in [group.all.size : group.numMotives] do
-        let xType ← whnfD (← inferType x)
-        let (indIndices, _, type) ← forallMetaTelescope nestedTypeFormer
-        if (← isDefEqGuarded type xType) then
-          let indIndices ← indIndices.mapM instantiateMVars
-          if !indIndices.all Expr.isFVar then
-            -- throwError "indices are not variables{indentExpr xType}"
-            continue
-          if !indIndices.allDiff then
-            -- throwError "indices are not pairwise distinct{indentExpr xType}"
-            continue
-          -- TODO: Do we have to worry about the indices ending up in the fixed prefix here?
-          if let some (_index, _y) ← hasBadIndexDep? ys indIndices then
-            -- throwError "its type {indInfo.name} is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
-            continue
-          let indicesPos := indIndices.map fun index => match (xs++ys).indexOf? index with | some i => i.val | none => unreachable!
-          return .some
-            { fnName       := recArgInfo.fnName
-              numFixed     := recArgInfo.numFixed
-              recArgPos    := recArgInfo.recArgPos
-              indicesPos   := indicesPos
-              indGroupInst := group
-              indIdx       := indIdx }
-      return .none
-
-def maxCombinationSize : Nat := 10
-
-def allCombinations (xss : Array (Array α)) : Option (Array (Array α)) :=
-  if xss.foldl (· * ·.size) 1 > maxCombinationSize then
-    none
-  else
-    let rec go i acc : Array (Array α):=
-      if h : i < xss.size then
-        xss[i].concatMap fun x => go (i + 1) (acc.push x)
-      else
-        #[acc]
-    some (go 0 #[])
-
-
-def tryAllArgs (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
-   (termArg?s : Array (Option TerminationArgument)) (k : Array RecArgInfo → M α) : M α := do
-  let mut report := m!""
-  -- Gather information on all possible recursive arguments
-  let mut recArgInfoss := #[]
-  for fnName in fnNames, value in values, termArg? in termArg?s do
-    let (recArgInfos, thisReport) ← getRecArgInfos fnName xs value termArg?
-    report := report ++ thisReport
-    recArgInfoss := recArgInfoss.push recArgInfos
-  -- Put non-indices first
-  recArgInfoss := recArgInfoss.map nonIndicesFirst
-  trace[Elab.definition.structural] "recArgInfoss: {recArgInfoss.map (·.map (·.recArgPos))}"
-  -- Inductive groups to consider
-  let groups ← inductiveGroups recArgInfoss.flatten
-  trace[Elab.definition.structural] "inductive groups: {groups}"
-  if groups.isEmpty then
-    report := report ++ "no parameters suitable for structural recursion"
-  -- Consider each group
-  for group in groups do
-    -- Select those RecArgInfos that are compatible with this inductive group
-    let mut recArgInfoss' := #[]
-    for value in values, recArgInfos in recArgInfoss do
-      recArgInfoss' := recArgInfoss'.push (← argsInGroup group xs value recArgInfos)
-    if let some idx := recArgInfoss'.findIdx? (·.isEmpty) then
-      report := report ++ m!"Skipping arguments of type {group}, as {fnNames[idx]!} has no compatible argument.\n"
-      continue
-    if let some combs := allCombinations recArgInfoss' then
-      for comb in combs do
-        try
-          -- TODO: Here we used to save and restore the state. But should the `try`-`catch`
-          -- not suffice?
-          let r ← k comb
-          trace[Elab.definition.structural] "tryAllArgs report:\n{report}"
-          return r
-        catch e =>
-          let m ← prettyParameterSet fnNames xs values comb
-          report := report ++ m!"Cannot use {m}:{indentD e.toMessageData}\n"
-    else
-          report := report ++ m!"Too many possible combinations of parameters of type {group} (or " ++
-            m!"please indicate the recursive argument explicitly using `termination_by structural`).\n"
-  report := m!"failed to infer structural recursion:\n" ++ report
-  trace[Elab.definition.structural] "tryAllArgs:\n{report}"
-  throwError report
+    let xType ← inferType x
+    /- Traverse all sub-expressions in the type of `x` -/
+    forEachExpr xType fun e =>
+      /- If `e` is an inductive family, we store in `indicesRef` all variables in `xs` that occur in "index positions". -/
+      matchConstInduct e.getAppFn (fun _ => pure ()) fun info _ => do
+        if info.numIndices > 0 && info.numParams + info.numIndices == e.getAppNumArgs then
+          for arg in e.getAppArgs[info.numParams:] do
+            forEachExpr arg fun e => do
+              if let .some idx := xs.getIdx? e then
+                indicesRef.modify fun indices => indices.push idx
+  let indices ← indicesRef.get
+  let nonIndices := (Array.range xs.size).filter (fun i => !(indices.contains i))
+  let mut errors : Array MessageData := Array.mkArray xs.size m!""
+  let saveState ← get -- backtrack the state for each argument
+  for i in id (nonIndices ++ indices) do
+    let x := xs[i]!
+    trace[Elab.definition.structural] "findRecArg x: {x}"
+    try
+      set saveState
+      return (← withRecArgInfo numFixed xs i k)
+    catch e => errors := errors.set! i e.toMessageData
+  throwError
+    errors.foldl
+      (init := m!"structural recursion cannot be used:")
+      (f := (· ++ Format.line ++ Format.line ++ .))
 
 end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/FunPacker.lean

@@ -1,126 +0,0 @@
-/-
-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 Lean.Meta.InferType
-
-/-!
-This module contains the logic that packs the motives and FArgs of multiple functions into one,
-to allow structural mutual recursion where the number of functions is not exactly the same
-as the number of inductive data types in the mutual inductive group.
-
-The private helper functions related to `PProd` here should at some point be moved to their own
-module, so that they can be used elsewhere (e.g. `FunInd`), and possibly unified with the similar
-constructions for well-founded recursion (see `ArgsPacker` module).
--/
-
-namespace Lean.Elab.Structural
-open Meta
-
-private def mkPUnit : Level → Expr
-  | .zero => .const ``True []
-  | lvl   => .const ``PUnit [lvl]
-
-private def mkPProd (e1 e2 : Expr) : MetaM Expr := do
-  let lvl1 ← getLevel e1
-  let lvl2 ← getLevel e2
-  if lvl1 matches .zero && lvl2 matches .zero then
-    return mkApp2 (.const `And []) e1 e2
-  else
-    return mkApp2 (.const ``PProd [lvl1, lvl2]) e1 e2
-
-private def mkNProd (lvl : Level) (es : Array Expr) : MetaM Expr :=
-  es.foldrM (init := mkPUnit lvl) mkPProd
-
-private def mkPUnitMk : Level → Expr
-  | .zero => .const ``True.intro []
-  | lvl   => .const ``PUnit.unit [lvl]
-
-private def mkPProdMk (e1 e2 : Expr) : MetaM Expr := do
-  let t1 ← inferType e1
-  let t2 ← inferType e2
-  let lvl1 ← getLevel t1
-  let lvl2 ← getLevel t2
-  if lvl1 matches .zero && lvl2 matches .zero then
-    return mkApp4 (.const ``And.intro []) t1 t2 e1 e2
-  else
-    return mkApp4 (.const ``PProd.mk [lvl1, lvl2]) t1 t2 e1 e2
-
-private def mkNProdMk (lvl : Level) (es : Array Expr) : MetaM Expr :=
-  es.foldrM (init := mkPUnitMk lvl) mkPProdMk
-
-/-- `PProd.fst` or `And.left` (as projections) -/
-private def mkPProdFst (e : Expr) : MetaM Expr := do
-  let t ← whnf (← inferType e)
-  match_expr t with
-  | PProd _ _ => return .proj ``PProd 0 e
-  | And _ _ =>   return .proj ``And 0 e
-  | _ => throwError "Cannot project .1 out of{indentExpr e}\nof type{indentExpr t}"
-
-/-- `PProd.snd` or `And.right` (as projections) -/
-private def mkPProdSnd (e : Expr) : MetaM Expr := do
-  let t ← whnf (← inferType e)
-  match_expr t with
-  | PProd _ _ => return .proj ``PProd 1 e
-  | And _ _ =>   return .proj ``And 1 e
-  | _ => throwError "Cannot project .2 out of{indentExpr e}\nof type{indentExpr t}"
-
-/-- Given a proof of `P₁ ∧ … ∧ Pᵢ ∧ … ∧ Pₙ ∧ True`, return the proof of `Pᵢ` -/
-def mkPProdProjN (i : Nat) (e : Expr) : MetaM Expr := do
-  let mut value := e
-  for _ in [:i] do
-      value ← mkPProdSnd value
-  value ← mkPProdFst value
-  return value
-
-/--
-Combines motives from different functions that recurse on the same parameter type into a single
-function returning a `PProd` type.
-
-For example
-```
-packMotives (Nat → Sort u) #[(fun (n : Nat) => Nat), (fun (n : Nat) => Fin n -> Fin n )]
-```
-will return
-```
-fun (n : Nat) (PProd Nat (Fin n → Fin n))
-```
-
-It is the identity if `motives.size = 1`.
-
-It returns a dummy motive `(xs : ) → PUnit` or `(xs : … ) → True` if no motive is given.
-(this is the reason we need the expected type in the `motiveType` parameter).
-
--/
-def packMotives (motiveType : Expr) (motives : Array Expr) : MetaM Expr := do
-  if motives.size = 1 then
-    return motives[0]!
-  trace[Elab.definition.structural] "packing Motives\nexpected: {motiveType}\nmotives: {motives}"
-  forallTelescope motiveType fun xs sort => do
-    unless sort.isSort do
-      throwError "packMotives: Unexpected motiveType {motiveType}"
-    -- NB: Use beta, not instantiateLambda; when constructing the belowDict below
-    -- we pass `C`, a plain FVar, here
-    let motives := motives.map (·.beta xs)
-    let packedMotives ← mkNProd sort.sortLevel! motives
-    mkLambdaFVars xs packedMotives
-
-/--
-Combines the F-args from different functions that recurse on the same parameter type into a single
-function returning a `PProd` value. See `packMotives`
-
-It is the identity if `motives.size = 1`.
--/
-def packFArgs (FArgType : Expr) (FArgs : Array Expr) : MetaM Expr := do
-  if FArgs.size = 1 then
-    return FArgs[0]!
-  forallTelescope FArgType fun xs body => do
-    let lvl ← getLevel body
-    let FArgs := FArgs.map (·.beta xs)
-    let packedFArgs ← mkNProdMk lvl FArgs
-    mkLambdaFVars xs packedFArgs
-
-
-end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/IndGroupInfo.lean

@@ -1,106 +0,0 @@
-/-
-Copyright (c) 2024 Lean FRO. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Joachim Breitner
--/
-prelude
-import Lean.Meta.InferType
-
-/-!
-This module contains the types
-* `IndGroupInfo`, a variant of `InductiveVal` with information that
-   applies to a whole group of mutual inductives and
-* `IndGroupInst` which extends `IndGroupInfo` with levels and parameters
-   to indicate a instantiation of the group.
-
-One purpose of this abstraction is to make it clear when a fuction operates on a group as
-a whole, rather than a specific inductive within the group.
--/
-
-namespace Lean.Elab.Structural
-open Lean Meta
-
-/--
-A mutually inductive group, identified by the `all` array of the `InductiveVal` of its
-constituents.
--/
-structure IndGroupInfo where
-  all       : Array Name
-  numNested : Nat
-deriving BEq, Inhabited
-
-def IndGroupInfo.ofInductiveVal (indInfo : InductiveVal) : IndGroupInfo where
-  all       := indInfo.all.toArray
-  numNested := indInfo.numNested
-
-def IndGroupInfo.numMotives (group : IndGroupInfo) : Nat :=
-  group.all.size + group.numNested
-
-/--
-An instance of an mutually inductive group of inductives, identified by the `all` array
-and the level and expressions parameters.
-
-For example this distinguishes between `List α` and `List β` so that we will not even attempt
-mutual structural recursion on such incompatible types.
--/
-structure IndGroupInst extends IndGroupInfo where
-  levels    : List Level
-  params    : Array Expr
-deriving Inhabited
-
-def IndGroupInst.toMessageData (igi : IndGroupInst) : MessageData :=
-  mkAppN (.const igi.all[0]! igi.levels) igi.params
-
-instance : ToMessageData IndGroupInst where
-  toMessageData := IndGroupInst.toMessageData
-
-def IndGroupInst.isDefEq (igi1 igi2 : IndGroupInst) : MetaM Bool := do
-  unless igi1.toIndGroupInfo == igi2.toIndGroupInfo do return false
-  unless igi1.levels.length = igi2.levels.length do return false
-  unless (igi1.levels.zip igi2.levels).all (fun (l₁, l₂) => Level.isEquiv l₁ l₂) do return false
-  unless igi1.params.size = igi2.params.size do return false
-  unless (← (igi1.params.zip igi2.params).allM (fun (e₁, e₂) => Meta.isDefEqGuarded e₁ e₂)) do return false
-  return true
-
-/-- Instantiates the right `.brecOn` or `.bInductionOn` for the given type former index,
-including universe parameters and fixed prefix.  -/
-def IndGroupInst.brecOn (group : IndGroupInst) (ind : Bool) (lvl : Level) (idx : Nat) : Expr :=
-  let e := if let .some n := group.all[idx]? then
-      if ind then .const (mkBInductionOnName n) group.levels
-      else        .const (mkBRecOnName n)      (lvl :: group.levels)
-    else
-      let n := group.all[0]!
-      let j := idx - group.all.size + 1
-      if ind then .const (mkBInductionOnName n |>.appendIndexAfter j) group.levels
-      else        .const (mkBRecOnName n |>.appendIndexAfter j)       (lvl :: group.levels)
-  mkAppN e group.params
-
-/--
-Figures out the nested type formers of an inductive group, with parameters instantiated
-and indices still forall-abstracted.
-
-For example given a nested inductive
-```
-inductive Tree α where | node : α → Vector (Tree α) n → Tree α
-```
-(where `n` is an index of `Vector`) and the instantiation `Tree Int` it will return
-```
-#[(n : Nat) → Vector (Tree Int) n]
-```
-
--/
-def IndGroupInst.nestedTypeFormers (igi : IndGroupInst) : MetaM (Array Expr) := do
-  if igi.numNested = 0 then return #[]
-  -- We extract this information from the motives of the recursor
-  let recName := mkRecName igi.all[0]!
-  let recInfo ← getConstInfoRec recName
-  assert! recInfo.numMotives = igi.numMotives
-  let aux := mkAppN (.const recName (0 :: igi.levels)) igi.params
-  let motives ← inferArgumentTypesN recInfo.numMotives aux
-  let auxMotives : Array Expr := motives[igi.all.size:]
-  auxMotives.mapM fun motive =>
-    forallTelescopeReducing motive fun xs _ => do
-      assert! xs.size > 0
-      mkForallFVars xs.pop (← inferType xs.back)
-
-end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/IndPred.lean

@@ -7,12 +7,11 @@ prelude
 import Lean.Meta.IndPredBelow
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Structural.Basic
-import Lean.Elab.PreDefinition.Structural.RecArgInfo
 
 namespace Lean.Elab.Structural
 open Meta
 
-private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (motive : Expr) (e : Expr) : M Expr := do
+private partial def replaceIndPredRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (motive : Expr) (e : Expr) : M Expr := do
   let maxDepth := IndPredBelow.maxBackwardChainingDepth.get (← getOptions)
   let rec loop (e : Expr) : M Expr := do
     match e with
@@ -34,7 +33,7 @@ private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (motive : Ex
     | Expr.app _ _ =>
       let processApp (e : Expr) : M Expr := do
         e.withApp fun f args => do
-          if f.isConstOf recArgInfo.fnName then
+          if f.isConstOf recFnName then
             let ty ← inferType e
             let main ← mkFreshExprSyntheticOpaqueMVar ty
             if (← IndPredBelow.backwardsChaining main.mvarId! maxDepth) then
@@ -45,7 +44,7 @@ private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (motive : Ex
             return mkAppN (← loop f) (← args.mapM loop)
       match (← matchMatcherApp? e) with
       | some matcherApp =>
-        if !recArgHasLooseBVarsAt recArgInfo.fnName recArgInfo.recArgPos e then
+        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
           processApp e
         else
           trace[Elab.definition.structural] "matcherApp before adding below transformation:\n{matcherApp.toExpr}"
@@ -64,48 +63,42 @@ private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (motive : Ex
             trace[Elab.definition.structural] "modified matcher:\n{newApp}"
             processApp newApp
       | none => processApp e
-    | e =>
-      ensureNoRecFn #[recArgInfo.fnName] e
-      pure e
+    | e => ensureNoRecFn recFnName e
   loop e
 
-/--
-Transform the body of a recursive function into a non-recursive one.
-
-The `value` is the function with (only) the fixed parameters instantiated.
--/
-def mkIndPredBRecOn (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
-  lambdaTelescope value fun ys value => do
-    let type  := (← inferType value).headBeta
-    let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor ys
-    trace[Elab.definition.structural] "numFixed: {recArgInfo.numFixed}, indexMajorArgs: {indexMajorArgs}, otherArgs: {otherArgs}"
-    let motive ← mkForallFVars otherArgs type
-    let motive ← mkLambdaFVars indexMajorArgs motive
-    trace[Elab.definition.structural] "brecOn motive: {motive}"
-    let brecOn := Lean.mkConst (mkBRecOnName recArgInfo.indName!) recArgInfo.indGroupInst.levels
-    let brecOn := mkAppN brecOn recArgInfo.indGroupInst.params
-    let brecOn := mkApp brecOn motive
-    let brecOn := mkAppN brecOn indexMajorArgs
-    check brecOn
-    let brecOnType ← inferType brecOn
-    trace[Elab.definition.structural] "brecOn     {brecOn}"
-    trace[Elab.definition.structural] "brecOnType {brecOnType}"
-    -- we need to close the telescope here, because the local context is used:
-    -- The root cause was, that this copied code puts an ih : FType into the
-    -- local context and later, when we use the local context to build the recursive
-    -- call, it uses this ih. But that ih doesn't exist in the actual brecOn call.
-    -- That's why it must go.
-    let FType ← forallBoundedTelescope brecOnType (some 1) fun F _ => do
-      let F := F[0]!
-      let FType ← inferType F
-      trace[Elab.definition.structural] "FType: {FType}"
-      instantiateForall FType indexMajorArgs
-    forallBoundedTelescope FType (some 1) fun below _ => do
-      let below := below[0]!
-      let valueNew     ← replaceIndPredRecApps recArgInfo motive value
-      let Farg         ← mkLambdaFVars (indexMajorArgs ++ #[below] ++ otherArgs) valueNew
-      let brecOn       := mkApp brecOn Farg
-      let brecOn       := mkAppN brecOn otherArgs
-      mkLambdaFVars ys brecOn
+def mkIndPredBRecOn (recFnName : Name) (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
+  let type  := (← inferType value).headBeta
+  let major := recArgInfo.ys[recArgInfo.pos]!
+  let otherArgs := recArgInfo.ys.filter fun y => y != major && !recArgInfo.indIndices.contains y
+  trace[Elab.definition.structural] "fixedParams: {recArgInfo.fixedParams}, otherArgs: {otherArgs}"
+  let motive ← mkForallFVars otherArgs type
+  let motive ← mkLambdaFVars (recArgInfo.indIndices.push major) motive
+  trace[Elab.definition.structural] "brecOn motive: {motive}"
+  let brecOn := Lean.mkConst (mkBRecOnName recArgInfo.indName) recArgInfo.indLevels
+  let brecOn := mkAppN brecOn recArgInfo.indParams
+  let brecOn := mkApp brecOn motive
+  let brecOn := mkAppN brecOn recArgInfo.indIndices
+  let brecOn := mkApp brecOn major
+  check brecOn
+  let brecOnType ← inferType brecOn
+  trace[Elab.definition.structural] "brecOn     {brecOn}"
+  trace[Elab.definition.structural] "brecOnType {brecOnType}"
+  -- we need to close the telescope here, because the local context is used:
+  -- The root cause was, that this copied code puts an ih : FType into the
+  -- local context and later, when we use the local context to build the recursive
+  -- call, it uses this ih. But that ih doesn't exist in the actual brecOn call.
+  -- That's why it must go.
+  let FType ← forallBoundedTelescope brecOnType (some 1) fun F _ => do
+    let F := F[0]!
+    let FType ← inferType F
+    trace[Elab.definition.structural] "FType: {FType}"
+    let FType ← instantiateForall FType recArgInfo.indIndices
+    instantiateForall FType #[major]
+  forallBoundedTelescope FType (some 1) fun below _ => do
+    let below := below[0]!
+    let valueNew     ← replaceIndPredRecApps recFnName recArgInfo motive value
+    let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
+    let brecOn       := mkApp brecOn Farg
+    return mkAppN brecOn otherArgs
 
 end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/Main.lean

@@ -1,10 +1,9 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, Joachim Breitner
+Authors: Leonardo de Moura
 -/
 prelude
-import Lean.Elab.PreDefinition.TerminationArgument
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.Structural.FindRecArg
 import Lean.Elab.PreDefinition.Structural.Preprocess
@@ -12,7 +11,6 @@ import Lean.Elab.PreDefinition.Structural.BRecOn
 import Lean.Elab.PreDefinition.Structural.IndPred
 import Lean.Elab.PreDefinition.Structural.Eqns
 import Lean.Elab.PreDefinition.Structural.SmartUnfolding
-import Lean.Meta.Tactic.TryThis
 
 namespace Lean.Elab
 namespace Structural
@@ -59,129 +57,39 @@ private def getFixedPrefix (declName : Name) (xs : Array Expr) (value : Expr) :
       return true
   numFixedRef.get
 
-partial def withCommonTelescope (preDefs : Array PreDefinition) (k : Array Expr → Array Expr → M α) : M α :=
-  go #[] (preDefs.map (·.value))
-where
-  go (fvars : Array Expr) (vals : Array Expr) : M α := do
-    if !(vals.all fun val => val.isLambda) then
-      k fvars vals
-    else if !(← vals.allM fun val => return val.bindingName! == vals[0]!.bindingName! && val.binderInfo == vals[0]!.binderInfo && (← isDefEq val.bindingDomain! vals[0]!.bindingDomain!)) then
-      k fvars vals
-    else
-      withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
-        go (fvars.push x) (vals.map fun val => val.bindingBody!.instantiate1 x)
+private def elimRecursion (preDef : PreDefinition) : M (Nat × PreDefinition) := do
+  trace[Elab.definition.structural] "{preDef.declName} := {preDef.value}"
+  withoutModifyingEnv do lambdaTelescope preDef.value fun xs value => do
+    addAsAxiom preDef
+    let value ← preprocess value preDef.declName
+    trace[Elab.definition.structural] "{preDef.declName} {xs} :=\n{value}"
+    let numFixed ← getFixedPrefix preDef.declName xs value
+    trace[Elab.definition.structural] "numFixed: {numFixed}"
+    findRecArg numFixed xs fun recArgInfo => do
+      let valueNew ← if recArgInfo.indPred then
+        mkIndPredBRecOn preDef.declName recArgInfo value
+      else
+        mkBRecOn preDef.declName recArgInfo value
+      let valueNew ← mkLambdaFVars xs valueNew
+      trace[Elab.definition.structural] "result: {valueNew}"
+      -- Recursive applications may still occur in expressions that were not visited by replaceRecApps (e.g., in types)
+      let valueNew ← ensureNoRecFn preDef.declName valueNew
+      let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
+      return (recArgPos, { preDef with value := valueNew })
 
-def getMutualFixedPrefix (preDefs : Array PreDefinition) : M Nat :=
-  withCommonTelescope preDefs fun xs vals => do
-    let resultRef ← IO.mkRef xs.size
-    for val in vals do
-      if (← resultRef.get) == 0 then return 0
-      forEachExpr' val fun e => do
-        if preDefs.any fun preDef => e.isAppOf preDef.declName then
-          let args := e.getAppArgs
-          resultRef.modify (min args.size ·)
-          for arg in args, x in xs do
-            if !(← withoutProofIrrelevance <| withReducible <| isDefEq arg x) then
-              -- We continue searching if e's arguments are not a prefix of `xs`
-              return true
-          return false
-        else
-          return true
-    resultRef.get
-
-private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr)
-    (recArgInfos : Array RecArgInfo) : M (Array PreDefinition) := do
-  let values ← preDefs.mapM (instantiateLambda ·.value xs)
-  let indInfo ← getConstInfoInduct recArgInfos[0]!.indGroupInst.all[0]!
-  if ← isInductivePredicate indInfo.name then
-    -- Here we branch off to the IndPred construction, but only for non-mutual functions
-    unless preDefs.size = 1 do
-      throwError "structural mutual recursion over inductive predicates is not supported"
-    trace[Elab.definition.structural] "Using mkIndPred construction"
-    let preDef := preDefs[0]!
-    let recArgInfo := recArgInfos[0]!
-    let value := values[0]!
-    let valueNew ← mkIndPredBRecOn recArgInfo value
-    let valueNew ← mkLambdaFVars xs valueNew
-    trace[Elab.definition.structural] "Nonrecursive value:{indentExpr valueNew}"
-    check valueNew
-    return #[{ preDef with value := valueNew }]
-
-  -- Sort the (indices of the) definitions by their position in indInfo.all
-  let positions : Positions := .groupAndSort (·.indIdx) recArgInfos (Array.range indInfo.numTypeFormers)
-  trace[Elab.definition.structural] "positions: {positions}"
-
-  -- Construct the common `.brecOn` arguments
-  let motives ← (Array.zip recArgInfos values).mapM fun (r, v) => mkBRecOnMotive r v
-  trace[Elab.definition.structural] "motives: {motives}"
-  let brecOnConst ← mkBRecOnConst recArgInfos positions motives
-  let FTypes ← inferBRecOnFTypes recArgInfos positions brecOnConst
-  trace[Elab.definition.structural] "FTypes: {FTypes}"
-  let FArgs ← (recArgInfos.zip  (values.zip FTypes)).mapM fun (r, (v, t)) =>
-    mkBRecOnF recArgInfos positions r v t
-  trace[Elab.definition.structural] "FArgs: {FArgs}"
-  -- Assemble the individual `.brecOn` applications
-  let valuesNew ← (Array.zip recArgInfos values).mapIdxM fun i (r, v) =>
-    mkBrecOnApp positions i brecOnConst FArgs r v
-  -- Abstract over the fixed prefixed
-  let valuesNew ← valuesNew.mapM (mkLambdaFVars xs ·)
-  return (Array.zip preDefs valuesNew).map fun ⟨preDef, valueNew⟩ => { preDef with value := valueNew }
-
-private def inferRecArgPos (preDefs : Array PreDefinition) (termArg?s : Array (Option TerminationArgument)) :
-    M (Array Nat × (Array PreDefinition) × Nat) := do
-  withoutModifyingEnv do
-    preDefs.forM (addAsAxiom ·)
-    let fnNames := preDefs.map (·.declName)
-    let preDefs ← preDefs.mapM fun preDef =>
-      return { preDef with value := (← preprocess preDef.value fnNames) }
-
-    -- The syntactically fixed arguments
-    let maxNumFixed ← getMutualFixedPrefix preDefs
-
-    lambdaBoundedTelescope preDefs[0]!.value maxNumFixed fun xs _ => do
-      assert! xs.size = maxNumFixed
-      let values ← preDefs.mapM (instantiateLambda ·.value xs)
-
-      tryAllArgs fnNames xs values termArg?s fun recArgInfos => do
-        let recArgPoss := recArgInfos.map (·.recArgPos)
-        trace[Elab.definition.structural] "Trying argument set {recArgPoss}"
-        let numFixed := recArgInfos.foldl (·.min ·.numFixed) maxNumFixed
-        if numFixed < maxNumFixed then
-          trace[Elab.definition.structural] "Reduced numFixed from {maxNumFixed} to {numFixed}"
-        -- We may have decreased the number of arguments we consider fixed, so update
-        -- the recArgInfos, remove the extra arguments from local environment, and recalculate value
-        let recArgInfos := recArgInfos.map ({· with numFixed := numFixed })
-        withErasedFVars (xs.extract numFixed xs.size |>.map (·.fvarId!)) do
-          let xs := xs[:numFixed]
-          let preDefs' ← elimMutualRecursion preDefs xs recArgInfos
-          return (recArgPoss, preDefs', numFixed)
-
-def reportTermArg (preDef : PreDefinition) (recArgPos : Nat) : MetaM Unit := do
-  if let some ref := preDef.termination.terminationBy?? then
-    let fn ← lambdaTelescope preDef.value fun xs _ => mkLambdaFVars xs xs[recArgPos]!
-    let termArg : TerminationArgument:= {ref := .missing, structural := true, fn}
-    let arity ← lambdaTelescope preDef.value fun xs _ => pure xs.size
-    let stx ← termArg.delab arity (extraParams := preDef.termination.extraParams)
-    Tactic.TryThis.addSuggestion ref stx
-
-
-def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Option TerminationArgument)) : TermElabM Unit := do
-  let names := preDefs.map (·.declName)
-  let ((recArgPoss, preDefsNonRec, numFixed), state) ← run <| inferRecArgPos preDefs termArg?s
-  for recArgPos in recArgPoss, preDef in preDefs do
-    reportTermArg preDef recArgPos
-  state.addMatchers.forM liftM
-  preDefsNonRec.forM fun preDefNonRec => do
+def structuralRecursion (preDefs : Array PreDefinition) : TermElabM Unit :=
+  if preDefs.size != 1 then
+    throwError "structural recursion does not handle mutually recursive functions"
+  else do
+    let ((recArgPos, preDefNonRec), state) ← run <| elimRecursion preDefs[0]!
     let preDefNonRec ← eraseRecAppSyntax preDefNonRec
-    -- state.addMatchers.forM liftM
-    mapError (f := (m!"structural recursion failed, produced type incorrect term{indentD ·}")) do
-      -- We create the `_unsafe_rec` before we abstract nested proofs.
-      -- Reason: the nested proofs may be referring to the _unsafe_rec.
-      addNonRec preDefNonRec (applyAttrAfterCompilation := false) (all := names.toList)
-  let preDefs ← preDefs.mapM (eraseRecAppSyntax ·)
-  addAndCompilePartialRec preDefs
-  for preDef in preDefs, recArgPos in recArgPoss do
-    let mut preDef := preDef
+    let mut preDef ← eraseRecAppSyntax preDefs[0]!
+    state.addMatchers.forM liftM
+    mapError (addNonRec preDefNonRec (applyAttrAfterCompilation := false)) fun msg =>
+      m!"structural recursion failed, produced type incorrect term{indentD msg}"
+    -- We create the `_unsafe_rec` before we abstract nested proofs.
+    -- Reason: the nested proofs may be referring to the _unsafe_rec.
+    addAndCompilePartialRec #[preDef]
     unless preDef.kind.isTheorem do
       unless (← isProp preDef.type) do
         preDef ← abstractNestedProofs preDef
@@ -190,11 +98,13 @@ def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Opti
         for theorems and definitions that are propositions.
         See issue #2327
         -/
-        registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos numFixed
+        registerEqnsInfo preDef recArgPos
     addSmartUnfoldingDef preDef recArgPos
     markAsRecursive preDef.declName
-  applyAttributesOf preDefsNonRec AttributeApplicationTime.afterCompilation
+    applyAttributesOf #[preDefNonRec] AttributeApplicationTime.afterCompilation
 
+builtin_initialize
+  registerTraceClass `Elab.definition.structural
 
 end Structural
 

src/Lean/Elab/PreDefinition/Structural/Preprocess.lean

@@ -10,9 +10,9 @@ import Lean.Elab.RecAppSyntax
 namespace Lean.Elab.Structural
 open Meta
 
-private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
+private def shouldBetaReduce (e : Expr) (recFnName : Name) : Bool :=
   if e.isHeadBetaTarget then
-    e.getAppFn.find? (fun e => e.isConst && recFnNames.contains e.constName!) |>.isSome
+    e.getAppFn.find? (·.isConstOf recFnName) |>.isSome
   else
     false
 
@@ -35,10 +35,10 @@ Preprocesses the expessions to improve the effectiveness of `elimRecursion`.
     | i+1 => (f x) i
   ```
 -/
-def preprocess (e : Expr) (recFnNames : Array Name) : CoreM Expr :=
+def preprocess (e : Expr) (recFnName : Name) : CoreM Expr :=
   Core.transform e
     (pre := fun e =>
-      if shouldBetaReduce e recFnNames then
+      if shouldBetaReduce e recFnName then
         return .visit e.headBeta
       else
         return .continue)

src/Lean/Elab/PreDefinition/Structural/RecArgInfo.lean

@@ -1,60 +0,0 @@
-/-
-Copyright (c) 2021 Microsoft Corporation. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, Joachim Breitner
--/
-prelude
-import Lean.Meta.Basic
-import Lean.Meta.ForEachExpr
-import Lean.Elab.PreDefinition.Structural.IndGroupInfo
-
-namespace Lean.Elab.Structural
-
-
-/--
-Information about the argument of interest of a structurally recursive function.
-
-The `Expr`s in this data structure expect the `fixedParams` to be in scope, but not the other
-parameters of the function. This ensures that this data structure makes sense in the other functions
-of a mutually recursive group.
--/
-structure RecArgInfo where
-  /-- the name of the recursive function -/
-  fnName       : Name
-  /-- the fixed prefix of arguments of the function we are trying to justify termination using structural recursion. -/
-  numFixed     : Nat
-  /-- position of the argument (counted including fixed prefix) we are recursing on -/
-  recArgPos    : Nat
-  /-- position of the indices (counted including fixed prefix) of the inductive datatype indices we are recursing on -/
-  indicesPos   : Array Nat
-  /-- The inductive group (with parameters) of the argument's type -/
-  indGroupInst : IndGroupInst
-  /--
-  index of the inductive datatype of the argument we are recursing on.
-  If `< indAll.all`, a normal data type, else an auxillary data type due to nested recursion
-  -/
-  indIdx       : Nat
-deriving Inhabited
-
-/--
-If `xs` are the parameters of the functions (excluding fixed prefix), partitions them
-into indices and major arguments, and other parameters.
--/
-def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array Expr × Array Expr) := Id.run do
-  let mut indexMajorArgs := #[]
-  let mut otherArgs := #[]
-  for h : i in [:xs.size] do
-    let j := i + info.numFixed
-    if j = info.recArgPos || info.indicesPos.contains j then
-      indexMajorArgs := indexMajorArgs.push xs[i]
-    else
-      otherArgs := otherArgs.push xs[i]
-  return (indexMajorArgs, otherArgs)
-
-/--
-Name of the recursive data type. Assumes that it is not one of the auxillary ones.
--/
-def RecArgInfo.indName! (info : RecArgInfo) : Name :=
-  info.indGroupInst.all[info.indIdx]!
-
-end Lean.Elab.Structural

src/Lean/Elab/PreDefinition/Structural/SmartUnfolding.lean

@@ -47,13 +47,17 @@ where
         else
           let mut altsNew := #[]
           for alt in matcherApp.alts, numParams in matcherApp.altNumParams do
-            let altNew ← lambdaBoundedTelescope alt numParams fun xs altBody => do
-              unless xs.size = numParams do
+            let altNew ← lambdaTelescope alt fun xs altBody => do
+              unless xs.size >= numParams do
                 throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
               let altBody ← visit altBody
               let containsSUnfoldMatch := Option.isSome <| altBody.find? fun e => smartUnfoldingMatch? e |>.isSome
-              let altBody := if !containsSUnfoldMatch then markSmartUnfoldingMatchAlt altBody else altBody
-              mkLambdaFVars xs altBody
+              if !containsSUnfoldMatch then
+                let altBody ← mkLambdaFVars xs[numParams:xs.size] altBody
+                let altBody := markSmartUnfoldingMatchAlt altBody
+                mkLambdaFVars xs[0:numParams] altBody
+              else
+                mkLambdaFVars xs altBody
             altsNew := altsNew.push altNew
           return markSmartUnfoldingMatch { matcherApp with alts := altsNew }.toExpr
       | _ => processApp e

src/Lean/Elab/PreDefinition/WF/Fix.lean

@@ -37,7 +37,7 @@ private partial def replaceRecApps (recFnName : Name) (fixedPrefixSize : Nat) (F
   trace[Elab.definition.wf] "{F} : {← inferType F}"
   loop F e |>.run' {}
 where
-  processRec (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
+  processRec (F : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) TermElabM Expr := do
     if e.getAppNumArgs < fixedPrefixSize + 1 then
       loop F (← etaExpand e)
     else
@@ -47,16 +47,16 @@ where
       let r := mkApp r (← mkDecreasingProof decreasingProp)
       return mkAppN r (← args[fixedPrefixSize+1:].toArray.mapM (loop F))
 
-  processApp (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
+  processApp (F : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) TermElabM Expr := do
     if e.isAppOf recFnName then
       processRec F e
     else
       e.withApp fun f args => return mkAppN (← loop F f) (← args.mapM (loop F))
 
-  containsRecFn (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Bool := do
+  containsRecFn (e : Expr) : StateRefT (HasConstCache recFnName) TermElabM Bool := do
     modifyGet (·.contains e)
 
-  loop (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
+  loop (F : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) TermElabM Expr := do
     if !(← containsRecFn e) then
       return e
     match e with
@@ -81,8 +81,8 @@ where
       | some matcherApp =>
         if let some matcherApp ← matcherApp.addArg? F then
           let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
-            lambdaBoundedTelescope alt numParams fun xs altBody => do
-              unless xs.size = numParams do
+            lambdaTelescope alt fun xs altBody => do
+              unless xs.size >= numParams do
                 throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
               let FAlt := xs[numParams - 1]!
               mkLambdaFVars xs (← loop FAlt altBody)
@@ -90,9 +90,7 @@ where
         else
           processApp F e
       | none => processApp F e
-    | e =>
-      ensureNoRecFn #[recFnName] e
-      pure e
+    | e => ensureNoRecFn recFnName e
 
 /-- Refine `F` over `PSum.casesOn` -/
 private partial def processSumCasesOn (x F val : Expr) (k : (x : Expr) → (F : Expr) → (val : Expr) → TermElabM Expr) : TermElabM Expr := do
@@ -105,11 +103,12 @@ private partial def processSumCasesOn (x F val : Expr) (k : (x : Expr) → (F :
       let type ← mkArrow (FDecl.type.replaceFVar x xs[0]!) type
       return (← mkLambdaFVars xs type, ← getLevel type)
     let mkMinorNew (ctorName : Name) (minor : Expr) : TermElabM Expr :=
-      lambdaBoundedTelescope minor 1 fun xs body => do
+      lambdaTelescope minor fun xs body => do
         let xNew := xs[0]!
+        let valNew ← mkLambdaFVars xs[1:] body
         let FTypeNew := FDecl.type.replaceFVar x (← mkAppOptM ctorName #[α, β, xNew])
         withLocalDeclD FDecl.userName FTypeNew fun FNew => do
-          mkLambdaFVars #[xNew, FNew] (← processSumCasesOn xNew FNew body k)
+          mkLambdaFVars #[xNew, FNew] (← processSumCasesOn xNew FNew valNew k)
     let minorLeft ← mkMinorNew ``PSum.inl args[4]!
     let minorRight ← mkMinorNew ``PSum.inr args[5]!
     let result := mkAppN (mkConst ``PSum.casesOn [u, (← getLevel α), (← getLevel β)]) #[α, β, motiveNew, x, minorLeft, minorRight, F]

src/Lean/Elab/PreDefinition/WF/GuessLex.lean

@@ -14,7 +14,7 @@ import Lean.Elab.Quotation
 import Lean.Elab.RecAppSyntax
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Structural.Basic
-import Lean.Elab.PreDefinition.TerminationArgument
+import Lean.Elab.PreDefinition.WF.TerminationArgument
 import Lean.Data.Array
 
 
@@ -128,10 +128,10 @@ structure Measure extends TerminationArgument where
   natFn : Expr
 deriving Inhabited
 
-/-- String description of this measure -/
+/-- String desription of this measure -/
 def Measure.toString (measure : Measure) : MetaM String := do
-  lambdaTelescope measure.fn fun _xs e => do
-    -- This is a bit slopping if `measure.fn` takes more parameters than the `PreDefinition`
+  lambdaTelescope measure.fn fun xs e => do
+    let e ← mkLambdaFVars xs[measure.arity:] e -- undo overshooting
     return (← ppExpr e).pretty
 
 /--
@@ -187,12 +187,13 @@ def simpleMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
             if  ← mayOmitSizeOf is_mutual xs[fixedPrefixSize:] x
             then mkLambdaFVars xs x
             else pure natFn
-          ret := ret.push { ref := .missing, structural := false, fn, natFn }
+          let extraParams := preDef.termination.extraParams
+          ret := ret.push { ref := .missing, fn, natFn, arity := xs.size, extraParams }
         return ret
 
 /-- Internal monad used by `withRecApps` -/
 abbrev M (recFnName : Name) (α β : Type) : Type :=
-  StateRefT (Array α) (StateRefT (HasConstCache #[recFnName]) MetaM) β
+  StateRefT (Array α) (StateRefT (HasConstCache recFnName) MetaM) β
 
 /--
 Traverses the given expression `e`, and invokes the continuation `k`
@@ -223,7 +224,7 @@ where
         loop param f
 
   containsRecFn (e : Expr) : M recFnName α Bool := do
-    modifyGetThe (HasConstCache #[recFnName]) (·.contains e)
+    modifyGetThe (HasConstCache recFnName) (·.contains e)
 
   loop (param : Expr) (e : Expr) : M recFnName α Unit := do
     if !(← containsRecFn e) then
@@ -256,7 +257,8 @@ where
           matcherApp.discrs.forM (loop param)
           (Array.zip matcherApp.alts (Array.zip matcherApp.altNumParams altParams)).forM
             fun (alt, altNumParam, altParam) =>
-              lambdaBoundedTelescope altParam altNumParam fun xs altParam => do
+              lambdaTelescope altParam fun xs altParam => do
+                -- TODO: Use boundedLambdaTelescope
                 unless altNumParam = xs.size do
                   throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
                 let altBody := alt.beta xs
@@ -266,7 +268,7 @@ where
           processApp param e
       | none => processApp param e
     | e => do
-      ensureNoRecFn #[recFnName] e
+      let _ ← ensureNoRecFn recFnName e
 
 /--
 A `SavedLocalContext` captures the state and local context of a `MetaM`, to be continued later.
@@ -341,8 +343,9 @@ call site.
 def collectRecCalls (unaryPreDef : PreDefinition) (fixedPrefixSize : Nat)
     (argsPacker : ArgsPacker) : MetaM (Array RecCallWithContext) := withoutModifyingState do
   addAsAxiom unaryPreDef
-  lambdaBoundedTelescope unaryPreDef.value (fixedPrefixSize + 1) fun xs body => do
+  lambdaTelescope unaryPreDef.value fun xs body => do
     unless xs.size == fixedPrefixSize + 1 do
+      -- Maybe cleaner to have lambdaBoundedTelescope?
       throwError "Unexpected number of lambdas in unary pre-definition"
     let ys := xs[:fixedPrefixSize]
     let param := xs[fixedPrefixSize]!
@@ -367,7 +370,8 @@ def isNatCmp (e : Expr) : Option (Expr × Expr) :=
 def complexMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
     (userVarNamess : Array (Array Name)) (recCalls : Array RecCallWithContext) :
     MetaM (Array (Array Measure)) := do
-  preDefs.mapIdxM fun funIdx _preDef => do
+  preDefs.mapIdxM fun funIdx preDef => do
+    let arity ← lambdaTelescope preDef.value fun xs _ => pure xs.size
     let mut measures := #[]
     for rc in recCalls do
       -- Only look at calls from the current function
@@ -394,7 +398,8 @@ def complexMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
               let fn ← mkLambdaFVars rc.params body
               -- Avoid duplicates
               unless ← measures.anyM (isDefEq ·.fn fn) do
-                measures := measures.push { ref := .missing, structural := false,  fn, natFn := fn }
+                let extraParams := preDef.termination.extraParams
+                measures := measures.push { ref := .missing, fn, natFn := fn, arity, extraParams }
         return measures
     return measures
 
@@ -746,20 +751,18 @@ def toTerminationArguments (preDefs : Array PreDefinition) (fixedPrefixSize : Na
           | .args taIdxs => measures[taIdxs[funIdx]!]!.fn.beta xs
           | .func funIdx' => mkNatLit <| if funIdx' == funIdx then 1 else 0
         let fn ← mkLambdaFVars xs (← mkProdElem args)
-        return { ref := .missing, structural := false, fn}
+        let extraParams := preDef.termination.extraParams
+        return { ref := .missing, arity := xs.size, extraParams, fn}
 
 /--
 Shows the inferred termination argument to the user, and implements `termination_by?`
 -/
 def reportTermArgs (preDefs : Array PreDefinition) (termArgs : TerminationArguments) : MetaM Unit := do
   for preDef in preDefs, termArg in termArgs do
-    let stx := do
-      let arity ← lambdaTelescope preDef.value fun xs _ => pure xs.size
-      termArg.delab arity (extraParams := preDef.termination.extraParams)
     if showInferredTerminationBy.get (← getOptions) then
-      logInfoAt preDef.ref m!"Inferred termination argument:\n{← stx}"
+      logInfoAt preDef.ref m!"Inferred termination argument:\n{← termArg.delab}"
     if let some ref := preDef.termination.terminationBy?? then
-      Tactic.TryThis.addSuggestion ref (← stx)
+      Tactic.TryThis.addSuggestion ref (← termArg.delab)
 
 end GuessLex
 open GuessLex

src/Lean/Elab/PreDefinition/WF/Main.lean

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Elab.PreDefinition.Basic
-import Lean.Elab.PreDefinition.TerminationArgument
+import Lean.Elab.PreDefinition.WF.TerminationArgument
 import Lean.Elab.PreDefinition.WF.PackMutual
 import Lean.Elab.PreDefinition.WF.Preprocess
 import Lean.Elab.PreDefinition.WF.Rel
@@ -86,8 +86,7 @@ def varyingVarNames (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Ar
     let xs : Array Expr := xs[fixedPrefixSize:]
     xs.mapM (·.fvarId!.getUserName)
 
-def wfRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Option TerminationArgument)) : TermElabM Unit := do
-  let termArgs? := termArg?s.sequenceMap id -- Either all or none, checked by `elabTerminationByHints`
+def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
   let preDefs ← preDefs.mapM fun preDef =>
     return { preDef with value := (← preprocess preDef.value) }
   let (fixedPrefixSize, argsPacker, unaryPreDef) ← withoutModifyingEnv do
@@ -101,9 +100,21 @@ def wfRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Option Termi
     return (fixedPrefixSize, argsPacker, ← packMutual fixedPrefixSize argsPacker preDefsDIte)
 
   let wf : TerminationArguments ← do
-    if let some tas := termArgs? then pure tas else
-    -- No termination_by here, so use GuessLex to infer one
-    guessLex preDefs unaryPreDef fixedPrefixSize argsPacker
+    let (preDefsWith, preDefsWithout) := preDefs.partition (·.termination.terminationBy?.isSome)
+    if preDefsWith.isEmpty then
+      -- No termination_by anywhere, so guess one
+      guessLex preDefs unaryPreDef fixedPrefixSize argsPacker
+    else if preDefsWithout.isEmpty then
+      preDefsWith.mapIdxM fun funIdx predef => do
+        let arity := fixedPrefixSize + argsPacker.varNamess[funIdx]!.size
+        let hints := predef.termination
+        TerminationArgument.elab predef.declName predef.type arity hints.extraParams hints.terminationBy?.get!
+    else
+      -- Some have, some do not, so report errors
+      preDefsWithout.forM fun preDef => do
+        logErrorAt preDef.ref (m!"Missing `termination_by`; this function is mutually " ++
+          m!"recursive with {preDefsWith[0]!.declName}, which has a `termination_by` clause.")
+      return
 
   let preDefNonRec ← forallBoundedTelescope unaryPreDef.type fixedPrefixSize fun prefixArgs type => do
     let type ← whnfForall type

src/Lean/Elab/PreDefinition/WF/PackMutual.lean

@@ -10,6 +10,23 @@ import Lean.Elab.PreDefinition.Basic
 namespace Lean.Elab.WF
 open Meta
 
+
+/--
+Checks that all codomians have the same level, throws an error otherwise.
+-/
+private def checkCodomainsLevel (fixedPrefixSize : Nat) (arities : Array Nat)
+    (preDefs : Array PreDefinition) : MetaM Unit := do
+  forallBoundedTelescope preDefs[0]!.type  (fixedPrefixSize + arities[0]!)  fun _ type₀ => do
+    let u₀ ← getLevel type₀
+    for i in [1:preDefs.size] do
+      forallBoundedTelescope preDefs[i]!.type  (fixedPrefixSize + arities[i]!) fun _ typeᵢ =>
+      unless ← isLevelDefEq u₀ (← getLevel typeᵢ) do
+        withOptions (fun o => pp.sanitizeNames.set o false) do
+          throwError m!"invalid mutual definition, result types must be in the same universe " ++
+            m!"level, resulting type " ++
+            m!"for `{preDefs[0]!.declName}` is{indentExpr type₀} : {← inferType type₀}\n" ++
+            m!"and for `{preDefs[i]!.declName}` is{indentExpr typeᵢ} : {← inferType typeᵢ}"
+
 /--
   Pass the first `n` arguments of `e` to the continuation, and apply the result to the
   remaining arguments. If `e` does not have enough arguments, it is eta-expanded as needed.
@@ -58,6 +75,8 @@ def packMutual (fixedPrefix : Nat) (argsPacker : ArgsPacker) (preDefs : Array Pr
   if let #[1] := arities then return preDefs[0]!
   let newFn := if argsPacker.numFuncs > 1 then preDefs[0]!.declName ++ `_mutual
                                           else preDefs[0]!.declName ++ `_unary
+
+  checkCodomainsLevel fixedPrefix argsPacker.arities preDefs
   -- Bring the fixed Prefix into scope
   forallBoundedTelescope preDefs[0]!.type (some fixedPrefix) fun ys _ => do
     let types ← preDefs.mapM (instantiateForall ·.type ys)

src/Lean/Elab/PreDefinition/WF/Rel.lean

@@ -9,7 +9,7 @@ import Lean.Meta.Tactic.Cases
 import Lean.Meta.Tactic.Rename
 import Lean.Elab.SyntheticMVars
 import Lean.Elab.PreDefinition.Basic
-import Lean.Elab.PreDefinition.TerminationArgument
+import Lean.Elab.PreDefinition.WF.TerminationArgument
 import Lean.Meta.ArgsPacker
 
 namespace Lean.Elab.WF

src/Lean/Elab/PreDefinition/WF/TerminationArgument.lean

@@ -9,19 +9,17 @@ import Lean.Parser.Term
 import Lean.Elab.Term
 import Lean.Elab.Binders
 import Lean.Elab.SyntheticMVars
-import Lean.Elab.PreDefinition.TerminationHint
-import Lean.PrettyPrinter.Delaborator.Basic
+import Lean.Elab.PreDefinition.WF.TerminationHint
+import Lean.PrettyPrinter.Delaborator
 
 /-!
-This module contains
-* the data type `TerminationArgument`, the elaborated form of a `TerminationBy` clause,
-* the `TerminationArguments` type for a clique, and
-* elaboration and deelaboration functions.
+This module contains the data type `TerminationArgument`, the elaborated form of a `TerminationBy`
+clause, the `TerminationArguments` type for a clique and the elaboration functions.
 -/
 
 set_option autoImplicit false
 
-namespace Lean.Elab
+namespace Lean.Elab.WF
 
 open Lean Meta Elab Term
 
@@ -31,12 +29,11 @@ Elaborated form for a `termination_by` clause.
 The `fn` has the same (value) arity as the recursive functions (stored in
 `arity`), and maps its arguments (including fixed prefix, in unpacked form) to
 the termination argument.
-
-If `structural := Bool`, then the `fn` is a lambda picking out exactly one argument.
 -/
 structure TerminationArgument where
   ref : Syntax
-  structural : Bool
+  arity : Nat
+  extraParams : Nat
   fn : Expr
 deriving Inhabited
 
@@ -47,6 +44,9 @@ abbrev TerminationArguments := Array TerminationArgument
 Elaborates a `TerminationBy` to an `TerminationArgument`.
 
 * `type` is the full type of the original recursive function, including fixed prefix.
+* `arity` is the value arity of the recursive function; the termination argument cannot take more.
+* `extraParams` is the the number of parameters the function has after the colon; together with
+  `arity` indicates how many parameters of the function are before the colon and thus in scope.
 * `hint : TerminationBy` is the syntactic `TerminationBy`.
 -/
 def TerminationArgument.elab (funName : Name) (type : Expr) (arity extraParams : Nat)
@@ -69,43 +69,22 @@ def TerminationArgument.elab (funName : Name) (type : Expr) (arity extraParams :
       elabFunBinders hint.vars (some type') fun xs type' => do
         -- Elaborate the body in this local environment
         let body ← Lean.Elab.Term.withSynthesize <| elabTermEnsuringType hint.body none
-
-        -- Structural recursion: The body has to be a single parameter, whose index we return
-        if hint.structural then unless (ys ++ xs).contains body do
-          let params := MessageData.andList ((ys ++ xs).toList.map (m!"'{·}'"))
-          throwErrorAt hint.ref m!"The termination argument of a structurally recursive " ++
-            m!"function must be one of the parameters {params}, but{indentExpr body}\nisn't " ++
-            m!"one of these."
-
         -- Now abstract also over the remaining extra parameters
         forallBoundedTelescope type'.get! (extraParams - hint.vars.size) fun zs _ => do
           mkLambdaFVars (ys ++ xs ++ zs) body
+  -- logInfo m!"elabTermValue: {r}"
   check r
-  pure { ref := hint.ref, structural := hint.structural, fn := r}
+  pure { ref := hint.ref, arity, extraParams, fn := r}
   where
     parameters : Nat → MessageData
     | 1 => "one parameter"
     | n => m!"{n} parameters"
 
-def TerminationArgument.structuralArg (termArg : TerminationArgument) : MetaM Nat := do
-  assert! termArg.structural
-  lambdaTelescope termArg.fn fun ys e => do
-    let .some idx := ys.indexOf? e
-      | panic! "TerminationArgument.structuralArg: body not one of the parameters"
-    return idx
-
-
 open PrettyPrinter Delaborator SubExpr Parser.Termination Parser.Term in
-/--
-Delaborates a `TerminationArgument` back to a `TerminationHint`, e.g. for `termination_by?`.
-
-This needs extra information:
-* `arity` is the value arity of the recursive function
-* `extraParams` indicates how many of the functions arguments are bound “after the colon”.
--/
-def TerminationArgument.delab (arity : Nat) (extraParams : Nat) (termArg : TerminationArgument) : MetaM (TSyntax ``terminationBy) := do
-  lambdaBoundedTelescope termArg.fn (arity - extraParams) fun _ys e => do
-    pure (← delabCore e (delab := go extraParams #[])).1
+def TerminationArgument.delab (termArg : TerminationArgument) : MetaM (TSyntax ``terminationBy) := do
+  lambdaTelescope termArg.fn fun ys e => do
+    let e ← mkLambdaFVars ys[termArg.arity - termArg.extraParams:] e -- undo overshooting by lambdaTelescope
+    pure (← delabCore e (delab := go termArg.extraParams #[])).1
   where
     go : Nat → TSyntaxArray `ident → DelabM (TSyntax ``terminationBy)
     | 0, vars => do
@@ -115,23 +94,15 @@ def TerminationArgument.delab (arity : Nat) (extraParams : Nat) (termArg : Termi
       -- any variable not mentioned syntatically (it may appear in the `Expr`, so do not just use
       -- `e.bindingBody!.hasLooseBVar`) should be delaborated as a hole.
       let vars  : TSyntaxArray [`ident, `Lean.Parser.Term.hole] :=
-        Array.map (fun (i : Ident) => if stxBody.raw.hasIdent i.getId then i else hole) vars
+        Array.map (fun (i : Ident) => if hasIdent i.getId stxBody then i else hole) vars
       -- drop trailing underscores
       let mut vars := vars
       while ! vars.isEmpty && vars.back.raw.isOfKind ``hole do vars := vars.pop
-      if termArg.structural then
-        if vars.isEmpty then
-          `(terminationBy|termination_by structural $stxBody)
-        else
-          `(terminationBy|termination_by structural $vars* => $stxBody)
+      if vars.isEmpty then
+        `(terminationBy|termination_by $stxBody)
       else
-        if vars.isEmpty then
-          `(terminationBy|termination_by $stxBody)
-        else
-          `(terminationBy|termination_by $vars* => $stxBody)
+        `(terminationBy|termination_by $vars* => $stxBody)
     | i+1, vars => do
       let e ← getExpr
       unless e.isLambda do return ← go 0 vars -- should not happen
       withBindingBodyUnusedName fun n => go i (vars.push ⟨n⟩)
-
-end Lean.Elab

src/Lean/Elab/PreDefinition/WF/TerminationHint.lean

@@ -8,23 +8,22 @@ import Lean.Parser.Term
 
 set_option autoImplicit false
 
-namespace Lean.Elab
+namespace Lean.Elab.WF
 
 /-! # Support for `termination_by` notation -/
 
 /-- A single `termination_by` clause -/
 structure TerminationBy where
-  ref          : Syntax
-  structural : Bool
-  vars         : TSyntaxArray [`ident, ``Lean.Parser.Term.hole]
-  body         : Term
+  ref       : Syntax
+  vars      : TSyntaxArray [`ident, ``Lean.Parser.Term.hole]
+  body      : Term
   /--
   If `synthetic := true`, then this `termination_by` clause was
   generated by `GuessLex`, and `vars` refers to *all* parameters
   of the function, not just the “extra parameters”.
   Cf. Lean.Elab.WF.unpackUnary
   -/
-  synthetic    : Bool := false
+  synthetic : Bool := false
   deriving Inhabited
 
 /-- A single `decreasing_by` clause -/
@@ -33,8 +32,7 @@ structure DecreasingBy where
   tactic    : TSyntax ``Lean.Parser.Tactic.tacticSeq
   deriving Inhabited
 
-/--
-The termination annotations for a single function.
+/-- The termination annotations for a single function.
 For `decreasing_by`, we store the whole `decreasing_by tacticSeq` expression, as this
 is what `Term.runTactic` expects.
  -/
@@ -43,8 +41,7 @@ structure TerminationHints where
   terminationBy?? : Option Syntax
   terminationBy? : Option TerminationBy
   decreasingBy?  : Option DecreasingBy
-  /--
-  Here we record the number of parameters past the `:`. It is set by
+  /-- Here we record the number of parameters past the `:`. It is set by
   `TerminationHints.rememberExtraParams` and used as folows:
 
   * When we guess the termination argument in `GuessLex` and want to print it in surface-syntax
@@ -58,7 +55,7 @@ structure TerminationHints where
 def TerminationHints.none : TerminationHints := ⟨.missing, .none, .none, .none, 0⟩
 
 /-- Logs warnings when the `TerminationHints` are present.  -/
-def TerminationHints.ensureNone (hints : TerminationHints) (reason : String) : CoreM Unit := do
+def TerminationHints.ensureNone (hints : TerminationHints) (reason : String): CoreM Unit := do
   match hints.terminationBy??, hints.terminationBy?, hints.decreasingBy? with
   | .none, .none, .none => pure ()
   | .none, .none, .some dec_by =>
@@ -117,12 +114,10 @@ def elabTerminationHints {m} [Monad m] [MonadError m] (stx : TSyntax ``suffix) :
       | _ => pure none
       else pure none
     let terminationBy? : Option TerminationBy ← if let some t := t? then match t with
-      | `(terminationBy|termination_by $[structural%$s]? => $_body) =>
+      | `(terminationBy|termination_by => $_body) =>
         throwErrorAt t "no extra parameters bounds, please omit the `=>`"
-      | `(terminationBy|termination_by $[structural%$s]? $vars* => $body) =>
-        pure (some {ref := t, structural := s.isSome, vars, body})
-      | `(terminationBy|termination_by $[structural%$s]? $body:term) =>
-        pure (some {ref := t, structural := s.isSome, vars := #[], body})
+      | `(terminationBy|termination_by $vars* => $body) => pure (some {ref := t, vars, body})
+      | `(terminationBy|termination_by $body:term) => pure (some {ref := t, vars := #[], body})
       | `(terminationBy?|termination_by?) => pure none
       | _ => throwErrorAt t "unexpected `termination_by` syntax"
       else pure none
@@ -132,4 +127,4 @@ def elabTerminationHints {m} [Monad m] [MonadError m] (stx : TSyntax ``suffix) :
     return { ref := stx, terminationBy??, terminationBy?, decreasingBy?, extraParams := 0 }
   | _ => throwErrorAt stx s!"Unexpected Termination.suffix syntax: {stx} of kind {stx.raw.getKind}"
 
-end Lean.Elab
+end Lean.Elab.WF

src/Lean/Elab/Tactic.lean

@@ -40,4 +40,3 @@ import Lean.Elab.Tactic.LibrarySearch
 import Lean.Elab.Tactic.ShowTerm
 import Lean.Elab.Tactic.Rfl
 import Lean.Elab.Tactic.Rewrites
-import Lean.Elab.Tactic.DiscrTreeKey

src/Lean/Elab/Tactic/Basic.lean

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Sebastian Ullrich
 -/
 prelude
-import Lean.Meta.Tactic.Util
 import Lean.Elab.Term
 
 namespace Lean.Elab
@@ -97,15 +96,14 @@ def SavedState.restore (b : SavedState) (restoreInfo := false) : TacticM Unit :=
   b.term.restore restoreInfo
   set b.tactic
 
-@[specialize, inherit_doc Term.withRestoreOrSaveFull]
-def withRestoreOrSaveFull (reusableResult? : Option (α × SavedState))
-    (tacSnap? : Option (Language.SnapshotBundle Tactic.TacticParsedSnapshot)) (act : TacticM α) :
+@[specialize, inherit_doc Core.withRestoreOrSaveFull]
+def withRestoreOrSaveFull (reusableResult? : Option (α × SavedState)) (act : TacticM α) :
     TacticM (α × SavedState) := do
   if let some (_, state) := reusableResult? then
     set state.tactic
   let reusableResult? := reusableResult?.map (fun (val, state) => (val, state.term))
   let (a, term) ← controlAt TermElabM fun runInBase => do
-    Term.withRestoreOrSaveFull reusableResult? tacSnap? <| runInBase act
+    Term.withRestoreOrSaveFull reusableResult? <| runInBase act
   return (a, { term, tactic := (← get) })
 
 protected def getCurrMacroScope : TacticM MacroScope := do pure (← readThe Core.Context).currMacroScope
@@ -399,19 +397,12 @@ def ensureHasNoMVars (e : Expr) : TacticM Unit := do
   if e.hasExprMVar then
     throwError "tactic failed, resulting expression contains metavariables{indentExpr e}"
 
-/--
-Closes main goal using the given expression.
-If `checkUnassigned == true`, then `val` must not contain unassigned metavariables.
-Returns `true` if `val` was successfully used to close the goal.
--/
-def closeMainGoal (tacName : Name) (val : Expr) (checkUnassigned := true): TacticM Unit := do
+/-- Close main goal using the given expression. If `checkUnassigned == true`, then `val` must not contain unassigned metavariables. -/
+def closeMainGoal (val : Expr) (checkUnassigned := true): TacticM Unit := do
   if checkUnassigned then
     ensureHasNoMVars val
-  let mvarId ← getMainGoal
-  if (← mvarId.checkedAssign val) then
-    replaceMainGoal []
-  else
-    throwTacticEx tacName mvarId m!"attempting to close the goal using{indentExpr val}\nthis is often due occurs-check failure"
+  (← getMainGoal).assign val
+  replaceMainGoal []
 
 @[inline] def liftMetaMAtMain (x : MVarId → MetaM α) : TacticM α := do
   withMainContext do x (← getMainGoal)

src/Lean/Elab/Tactic/BuiltinTactic.lean

@@ -90,10 +90,10 @@ where
               {
                 range? := stxs |>.getRange?
                 task := next.result }]
-            let (_, state) ← withRestoreOrSaveFull reusableResult?
-                -- set up nested reuse; `evalTactic` will check for `isIncrementalElab`
-                (tacSnap? := some { old? := oldInner?, new := inner }) do
-              Term.withReuseContext tac do
+            let (_, state) ← withRestoreOrSaveFull reusableResult? do
+              -- set up nested reuse; `evalTactic` will check for `isIncrementalElab`
+              withTheReader Term.Context ({ · with
+                  tacSnap? := some { old? := oldInner?, new := inner } }) do
                 evalTactic tac
             finished.resolve { state? := state }
 

src/Lean/Elab/Tactic/DiscrTreeKey.lean

@@ -1,65 +0,0 @@
-/-
-Copyright (c) 2024 Matthew Robert Ballard. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Tomas Skrivan, Matthew Robert Ballard
--/
-prelude
-import Init.Tactics
-import Lean.Elab.Command
-import Lean.Meta.Tactic.Simp.SimpTheorems
-
-namespace Lean.Elab.Tactic.DiscrTreeKey
-
-open Lean.Meta DiscrTree
-open Lean.Elab.Tactic
-open Lean.Elab.Command
-
-private def mkKey (e : Expr) (simp : Bool) : MetaM (Array Key) := do
-  let (_, _, type) ← withReducible <| forallMetaTelescopeReducing e
-  let type ← whnfR type
-  if simp then
-    if let some (_, lhs, _) := type.eq? then
-      mkPath lhs simpDtConfig
-    else if let some (lhs, _) := type.iff? then
-      mkPath lhs simpDtConfig
-    else if let some (_, lhs, _) := type.ne? then
-      mkPath lhs simpDtConfig
-    else if let some p := type.not? then
-      match p.eq? with
-      | some (_, lhs, _) =>
-        mkPath lhs simpDtConfig
-      | _ => mkPath p simpDtConfig
-    else
-      mkPath type simpDtConfig
-  else
-    mkPath type {}
-
-private def getType (t : TSyntax `term) : TermElabM Expr := do
-  if let `($id:ident) := t then
-    if let some ldecl := (← getLCtx).findFromUserName? id.getId then
-      return ldecl.type
-    else
-      let info ← getConstInfo (← realizeGlobalConstNoOverloadWithInfo id)
-      return info.type
-  else
-    Term.elabTerm t none
-
-@[builtin_command_elab Lean.Parser.discrTreeKeyCmd]
-def evalDiscrTreeKeyCmd : CommandElab := fun stx => do
-  Command.liftTermElabM <| do
-    match stx with
-    | `(command| #discr_tree_key $t:term) => do
-      let type ← getType t
-      logInfo (← keysAsPattern <| ← mkKey type false)
-    | _                        => Elab.throwUnsupportedSyntax
-
-@[builtin_command_elab Lean.Parser.discrTreeSimpKeyCmd]
-def evalDiscrTreeSimpKeyCmd : CommandElab := fun stx => do
-  Command.liftTermElabM <| do
-    match stx with
-    | `(command| #discr_tree_simp_key $t:term) => do
-      let type ← getType t
-      logInfo (← keysAsPattern <| ← mkKey type true)
-    | _                        => Elab.throwUnsupportedSyntax
-
-end Lean.Elab.Tactic.DiscrTreeKey

src/Lean/Elab/Tactic/ElabTerm.lean

@@ -56,9 +56,9 @@ def elabTermEnsuringType (stx : Syntax) (expectedType? : Option Expr) (mayPostpo
     return e
 
 /-- Try to close main goal using `x target`, where `target` is the type of the main goal.  -/
-def closeMainGoalUsing (tacName : Name) (x : Expr → TacticM Expr) (checkUnassigned := true) : TacticM Unit :=
+def closeMainGoalUsing (x : Expr → TacticM Expr) (checkUnassigned := true) : TacticM Unit :=
   withMainContext do
-    closeMainGoal (tacName := tacName) (checkUnassigned := checkUnassigned) (← x (← getMainTarget))
+    closeMainGoal (checkUnassigned := checkUnassigned) (← x (← getMainTarget))
 
 def logUnassignedAndAbort (mvarIds : Array MVarId) : TacticM Unit := do
    if (← Term.logUnassignedUsingErrorInfos mvarIds) then
@@ -68,14 +68,13 @@ def filterOldMVars (mvarIds : Array MVarId) (mvarCounterSaved : Nat) : MetaM (Ar
   let mctx ← getMCtx
   return mvarIds.filter fun mvarId => (mctx.getDecl mvarId |>.index) >= mvarCounterSaved
 
-@[builtin_tactic «exact»] def evalExact : Tactic := fun stx => do
+@[builtin_tactic «exact»] def evalExact : Tactic := fun stx =>
   match stx with
-  | `(tactic| exact $e) =>
-    closeMainGoalUsing `exact (checkUnassigned := false) fun type => do
-      let mvarCounterSaved := (← getMCtx).mvarCounter
-      let r ← elabTermEnsuringType e type
-      logUnassignedAndAbort (← filterOldMVars (← getMVars r) mvarCounterSaved)
-      return r
+  | `(tactic| exact $e) => closeMainGoalUsing (checkUnassigned := false) fun type => do
+    let mvarCounterSaved := (← getMCtx).mvarCounter
+    let r ← elabTermEnsuringType e type
+    logUnassignedAndAbort (← filterOldMVars (← getMVars r) mvarCounterSaved)
+    return r
   | _ => throwUnsupportedSyntax
 
 def sortMVarIdArrayByIndex [MonadMCtx m] [Monad m] (mvarIds : Array MVarId) : m (Array MVarId) := do
@@ -360,8 +359,8 @@ def elabAsFVar (stx : Syntax) (userName? : Option Name := none) : TacticM FVarId
   | _ => throwUnsupportedSyntax
 
 /--
-Make sure `expectedType` does not contain free and metavariables.
-It applies zeta and zetaDelta-reduction to eliminate let-free-vars.
+   Make sure `expectedType` does not contain free and metavariables.
+   It applies zeta and zetaDelta-reduction to eliminate let-free-vars.
 -/
 private def preprocessPropToDecide (expectedType : Expr) : TermElabM Expr := do
   let mut expectedType ← instantiateMVars expectedType
@@ -371,95 +370,31 @@ private def preprocessPropToDecide (expectedType : Expr) : TermElabM Expr := do
     throwError "expected type must not contain free or meta variables{indentExpr expectedType}"
   return expectedType
 
-/--
-Given the decidable instance `inst`, reduces it and returns a decidable instance expression
-in whnf that can be regarded as the reason for the failure of `inst` to fully reduce.
--/
-private partial def blameDecideReductionFailure (inst : Expr) : MetaM Expr := do
-  let inst ← whnf inst
-  -- If it's the Decidable recursor, then blame the major premise.
-  if inst.isAppOfArity ``Decidable.rec 5 then
-    return ← blameDecideReductionFailure inst.appArg!
-  -- If it is a matcher, look for a discriminant that's a Decidable instance to blame.
-  if let .const c _ := inst.getAppFn then
-    if let some info ← getMatcherInfo? c then
-      if inst.getAppNumArgs == info.arity then
-        let args := inst.getAppArgs
-        for i in [0:info.numDiscrs] do
-          let inst' := args[info.numParams + 1 + i]!
-          if (← Meta.isClass? (← inferType inst')) == ``Decidable then
-            let inst'' ← whnf inst'
-            if !(inst''.isAppOf ``isTrue || inst''.isAppOf ``isFalse) then
-              return ← blameDecideReductionFailure inst''
-  return inst
-
 @[builtin_tactic Lean.Parser.Tactic.decide] def evalDecide : Tactic := fun _ =>
-  closeMainGoalUsing `decide fun expectedType => do
+  closeMainGoalUsing fun expectedType => do
     let expectedType ← preprocessPropToDecide expectedType
     let d ← mkDecide expectedType
     let d ← instantiateMVars d
     -- Get instance from `d`
     let s := d.appArg!
-    -- Reduce the instance rather than `d` itself for diagnostics purposes.
-    let r ← withAtLeastTransparency .default <| whnf s
-    if r.isAppOf ``isTrue then
-      -- Success!
-      -- While we have a proof from reduction, we do not embed it in the proof term,
-      -- and instead we let the kernel recompute it during type checking from the following more efficient term.
-      let rflPrf ← mkEqRefl (toExpr true)
-      return mkApp3 (Lean.mkConst ``of_decide_eq_true) expectedType s rflPrf
-    else
-      -- Diagnose the failure, lazily so that there is no performance impact if `decide` isn't being used interactively.
-      throwError MessageData.ofLazyM (es := #[expectedType]) do
-        if r.isAppOf ``isFalse then
-          return m!"\
-          tactic 'decide' proved that the proposition\
-          {indentExpr expectedType}\n\
-          is false"
-        -- Re-reduce the instance and collect diagnostics, to get all unfolded Decidable instances
-        let (reason, unfoldedInsts) ← withoutModifyingState <| withOptions (fun opt => diagnostics.set opt true) do
-          modifyDiag (fun _ => {})
-          let reason ← withAtLeastTransparency .default <| blameDecideReductionFailure s
-          let unfolded := (← get).diag.unfoldCounter.foldl (init := #[]) fun cs n _ => cs.push n
-          let unfoldedInsts ← unfolded |>.qsort Name.lt |>.filterMapM fun n => do
-            let e ← mkConstWithLevelParams n
-            if (← Meta.isClass? (← inferType e)) == ``Decidable then
-              return m!"'{MessageData.ofConst e}'"
-            else
-              return none
-          return (reason, unfoldedInsts)
-        let stuckMsg :=
-          if unfoldedInsts.isEmpty then
-            m!"Reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
-          else
-            let instances := if unfoldedInsts.size == 1 then "instance" else "instances"
-            m!"After unfolding the {instances} {MessageData.andList unfoldedInsts.toList}, \
-            reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
-        let hint :=
-          if reason.isAppOf ``Eq.rec then
-            m!"\n\n\
-            Hint: Reduction got stuck on '▸' ({MessageData.ofConstName ``Eq.rec}), \
-            which suggests that one of the '{MessageData.ofConstName ``Decidable}' instances is defined using tactics such as 'rw' or 'simp'. \
-            To avoid tactics, make use of functions such as \
-            '{MessageData.ofConstName ``inferInstanceAs}' or '{MessageData.ofConstName ``decidable_of_decidable_of_iff}' \
-            to alter a proposition."
-          else if reason.isAppOf ``Classical.choice then
-            m!"\n\n\
-            Hint: Reduction got stuck on '{MessageData.ofConstName ``Classical.choice}', \
-            which indicates that a '{MessageData.ofConstName ``Decidable}' instance \
-            is defined using classical reasoning, proving an instance exists rather than giving a concrete construction. \
-            The 'decide' tactic works by evaluating a decision procedure via reduction, and it cannot make progress with such instances. \
-            This can occur due to the 'opened scoped Classical' command, which enables the instance \
-            '{MessageData.ofConstName ``Classical.propDecidable}'."
-          else
-            MessageData.nil
-        return m!"\
-          tactic 'decide' failed for proposition\
-          {indentExpr expectedType}\n\
-          since its '{MessageData.ofConstName ``Decidable}' instance\
-          {indentExpr s}\n\
-          did not reduce to '{MessageData.ofConstName ``isTrue}' or '{MessageData.ofConstName ``isFalse}'.\n\n\
-          {stuckMsg}{hint}"
+    -- Reduce the instance rather than `d` itself, since that gives a nicer error message on failure.
+    let r ← withDefault <| whnf s
+    if r.isAppOf ``isFalse then
+      throwError "\
+        tactic 'decide' proved that the proposition\
+        {indentExpr expectedType}\n\
+        is false"
+    unless r.isAppOf ``isTrue do
+      throwError "\
+        tactic 'decide' failed for proposition\
+        {indentExpr expectedType}\n\
+        since its 'Decidable' instance reduced to\
+        {indentExpr r}\n\
+        rather than to the 'isTrue' constructor."
+    -- While we have a proof from reduction, we do not embed it in the proof term,
+    -- but rather we let the kernel recompute it during type checking from a more efficient term.
+    let rflPrf ← mkEqRefl (toExpr true)
+    return mkApp3 (Lean.mkConst ``of_decide_eq_true) expectedType s rflPrf
 
 private def mkNativeAuxDecl (baseName : Name) (type value : Expr) : TermElabM Name := do
   let auxName ← Term.mkAuxName baseName
@@ -473,7 +408,7 @@ private def mkNativeAuxDecl (baseName : Name) (type value : Expr) : TermElabM Na
   pure auxName
 
 @[builtin_tactic Lean.Parser.Tactic.nativeDecide] def evalNativeDecide : Tactic := fun _ =>
-  closeMainGoalUsing `nativeDecide fun expectedType => do
+  closeMainGoalUsing fun expectedType => do
     let expectedType ← preprocessPropToDecide expectedType
     let d ← mkDecide expectedType
     let auxDeclName ← mkNativeAuxDecl `_nativeDecide (Lean.mkConst `Bool) d

src/Lean/Elab/Tactic/Ext.lean

@@ -5,179 +5,14 @@ Authors: Gabriel Ebner, Mario Carneiro
 -/
 prelude
 import Init.Ext
-import Lean.Elab.DeclarationRange
 import Lean.Elab.Tactic.RCases
 import Lean.Elab.Tactic.Repeat
 import Lean.Elab.Tactic.BuiltinTactic
 import Lean.Elab.Command
 import Lean.Linter.Util
 
-/-!
-# Implementation of the `@[ext]` attribute
--/
-
 namespace Lean.Elab.Tactic.Ext
 open Meta Term
-
-/-!
-### Meta code for creating ext theorems
--/
-
-/--
-Constructs the hypotheses for the structure extensionality theorem that
-states that two structures are equal if their fields are equal.
-
-Calls the continuation `k` with the list of parameters to the structure,
-two structure variables `x` and `y`, and a list of pairs `(field, ty)`
-where each `ty` is of the form `x.field = y.field` or `HEq x.field y.field`.
-
-If `flat` parses to `true`, any fields inherited from parent structures
-are treated as fields of the given structure type.
-If it is `false`, then the behind-the-scenes encoding of inherited fields
-is visible in the extensionality lemma.
--/
-def withExtHyps (struct : Name) (flat : Bool)
-    (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do
-  unless isStructure (← getEnv) struct do throwError "not a structure: {struct}"
-  let structC ← mkConstWithLevelParams struct
-  forallTelescope (← inferType structC) fun params _ => do
-  withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do
-  withLocalDecl `x .implicit (mkAppN structC params) fun x => do
-  withLocalDecl `y .implicit (mkAppN structC params) fun y => do
-    let mut hyps := #[]
-    let fields ← if flat then
-      pure <| getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false)
-    else
-      pure <| getStructureFields (← getEnv) struct
-    for field in fields do
-      let x_f ← mkProjection x field
-      let y_f ← mkProjection y field
-      unless ← isProof x_f do
-        hyps := hyps.push (field, ← mkEqHEq x_f y_f)
-    k params x y hyps
-
-/--
-Creates the type of the extensionality theorem for the given structure,
-returning `∀ {x y : Struct}, x.1 = y.1 → x.2 = y.2 → x = y`, for example.
--/
-def mkExtType (structName : Name) (flat : Bool) : MetaM Expr := withLCtx {} {} do
-  withExtHyps structName flat fun params x y hyps => do
-    let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty => .forallE f h ty .default
-    mkForallFVars (params |>.push x |>.push y) ty
-
-/--
-Derives the type of the `iff` form of an ext theorem.
--/
-def mkExtIffType (extThmName : Name) : MetaM Expr := withLCtx {} {} do
-  forallTelescopeReducing (← getConstInfo extThmName).type fun args ty => do
-    let failNotEq := throwError "expecting a theorem proving x = y, but instead it proves{indentD ty}"
-    let some (_, x, y) := ty.eq? | failNotEq
-    let some xIdx := args.findIdx? (· == x) | failNotEq
-    let some yIdx := args.findIdx? (· == y) | failNotEq
-    unless xIdx + 1 == yIdx do
-      throwError "expecting {x} and {y} to be consecutive arguments"
-    let startIdx := yIdx + 1
-    let toRevert := args[startIdx:].toArray
-    let fvars ← toRevert.foldlM (init := {}) (fun st e => return collectFVars st (← inferType e))
-    for fvar in toRevert do
-      unless ← Meta.isProof fvar do
-        throwError "argument {fvar} is not a proof, which is not supported for arguments after {x} and {y}"
-      if fvars.fvarSet.contains fvar.fvarId! then
-        throwError "argument {fvar} is depended upon, which is not supported for arguments after {x} and {y}"
-    let conj := mkAndN (← toRevert.mapM (inferType ·)).toList
-    -- Make everything implicit except for inst implicits
-    let mut newBis := #[]
-    for fvar in args[0:startIdx] do
-      if (← fvar.fvarId!.getBinderInfo) matches .default | .strictImplicit then
-        newBis := newBis.push (fvar.fvarId!, .implicit)
-    withNewBinderInfos newBis do
-      mkForallFVars args[:startIdx] <| mkIff ty conj
-
-/--
-Ensures that the given structure has an ext theorem, without validating any pre-existing theorems.
-Returns the name of the ext theorem.
-
-See `Lean.Elab.Tactic.Ext.withExtHyps` for an explanation of the `flat` argument.
--/
-def realizeExtTheorem (structName : Name) (flat : Bool) : Elab.Command.CommandElabM Name := do
-  unless isStructure (← getEnv) structName do
-    throwError "'{structName}' is not a structure"
-  let extName := structName.mkStr "ext"
-  unless (← getEnv).contains extName do
-    try
-      Elab.Command.liftTermElabM <| withoutErrToSorry <| withDeclName extName do
-        let type ← mkExtType structName flat
-        let pf ← withSynthesize do
-          let indVal ← getConstInfoInduct structName
-          let params := Array.mkArray indVal.numParams (← `(_))
-          Elab.Term.elabTermEnsuringType (expectedType? := type) (implicitLambda := false)
-            -- introduce the params, do cases on 'x' and 'y', and then substitute each equation
-            (← `(by intro $params* {..} {..}; intros; subst_eqs; rfl))
-        let pf ← instantiateMVars pf
-        if pf.hasMVar then throwError "(internal error) synthesized ext proof contains metavariables{indentD pf}"
-        let info ← getConstInfo structName
-        addDecl <| Declaration.thmDecl {
-          name := extName
-          type
-          value := pf
-          levelParams := info.levelParams
-        }
-        modifyEnv fun env => addProtected env extName
-        Lean.addDeclarationRanges extName {
-          range := ← getDeclarationRange (← getRef)
-          selectionRange := ← getDeclarationRange (← getRef) }
-    catch e =>
-      throwError m!"\
-        Failed to generate an 'ext' theorem for '{MessageData.ofConstName structName}': {e.toMessageData}"
-  return extName
-
-/--
-Given an 'ext' theorem, ensures that there is an iff version of the theorem (if possible),
-without validating any pre-existing theorems.
-Returns the name of the 'ext_iff' theorem.
--/
-def realizeExtIffTheorem (extName : Name) : Elab.Command.CommandElabM Name := do
-  let extIffName : Name :=
-    match extName with
-    | .str n s => .str n (s ++ "_iff")
-    | _ => .str extName "ext_iff"
-  unless (← getEnv).contains extIffName do
-    try
-      let info ← getConstInfo extName
-      Elab.Command.liftTermElabM <| withoutErrToSorry <| withDeclName extIffName do
-        let type ← mkExtIffType extName
-        let pf ← withSynthesize do
-          Elab.Term.elabTermEnsuringType (expectedType? := type) <| ← `(by
-            intros
-            refine ⟨?_, ?_⟩
-            · intro h; cases h; and_intros <;> (intros; first | rfl | simp | fail "Failed to prove converse of ext theorem")
-            · intro; (repeat cases ‹_ ∧ _›); apply $(mkCIdent extName) <;> assumption)
-        let pf ← instantiateMVars pf
-        if pf.hasMVar then throwError "(internal error) synthesized ext_iff proof contains metavariables{indentD pf}"
-        addDecl <| Declaration.thmDecl {
-          name := extIffName
-          type
-          value := pf
-          levelParams := info.levelParams
-        }
-        -- Only declarations in a namespace can be protected:
-        unless extIffName.isAtomic do
-          modifyEnv fun env => addProtected env extIffName
-        Lean.addDeclarationRanges extIffName {
-          range := ← getDeclarationRange (← getRef)
-          selectionRange := ← getDeclarationRange (← getRef) }
-    catch e =>
-      throwError m!"\
-        Failed to generate an 'ext_iff' theorem from '{MessageData.ofConstName extName}': {e.toMessageData}\n\
-        \n\
-        Try '@[ext (iff := false)]' to prevent generating an 'ext_iff' theorem."
-  return extIffName
-
-
-/-!
-### Attribute
--/
-
 /-- Information about an extensionality theorem, stored in the environment extension. -/
 structure ExtTheorem where
   /-- Declaration name of the extensionality theorem. -/
@@ -231,9 +66,9 @@ def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
  { d with erased := d.erased.insert declName }
 
 /--
-Erases a name marked as a `ext` attribute.
-Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
-found somewhere in the state's tree, and is not erased.
+  Erases a name marked as a `ext` attribute.
+  Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
+  found somewhere in the state's tree, and is not erased.
 -/
 def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
     m ExtTheorems := do
@@ -244,40 +79,97 @@ def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Nam
 builtin_initialize registerBuiltinAttribute {
   name := `ext
   descr := "Marks a theorem as an extensionality theorem"
-  add := fun declName stx kind => MetaM.run' do
-    let `(attr| ext $[(iff := false%$iffFalse?)]? $[(flat := false%$flatFalse?)]? $(prio)?) := stx
-      | throwError "invalid syntax for 'ext' attribute"
-    let iff := iffFalse?.isNone
-    let flat := flatFalse?.isNone
-    let mut declName := declName
+  add := fun declName stx kind => do
+    let `(attr| ext $[(flat := $f)]? $(prio)?) := stx
+      | throwError "unexpected @[ext] attribute {stx}"
     if isStructure (← getEnv) declName then
-      declName ← liftCommandElabM <| withRef stx <| realizeExtTheorem declName flat
-    else if let some stx := flatFalse? then
-      throwErrorAt stx "unexpected 'flat' configuration on @[ext] theorem"
-    -- Validate and add theorem to environment extension
-    let declTy := (← getConstInfo declName).type
-    let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy
-    let failNotEq := throwError "\
-      @[ext] attribute only applies to structures and to theorems proving 'x = y' where 'x' and 'y' are variables, \
-      but this theorem proves{indentD declTy}"
-    let some (ty, lhs, rhs) := declTy.eq? | failNotEq
-    unless lhs.isMVar && rhs.isMVar do failNotEq
-    let keys ← withReducible <| DiscrTree.mkPath ty extExt.config
-    let priority ← liftCommandElabM <| Elab.liftMacroM do evalPrio (prio.getD (← `(prio| default)))
-    extExtension.add {declName, keys, priority} kind
-    -- Realize iff theorem
-    if iff then
-      discard <| liftCommandElabM <| withRef stx <| realizeExtIffTheorem declName
+      liftCommandElabM <| Elab.Command.elabCommand <|
+        ← `(declare_ext_theorems_for $[(flat := $f)]? $(mkCIdentFrom stx declName) $[$prio]?)
+    else MetaM.run' do
+      if let some flat := f then
+        throwErrorAt flat "unexpected 'flat' config on @[ext] theorem"
+      let declTy := (← getConstInfo declName).type
+      let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy
+      let failNotEq := throwError
+        "@[ext] attribute only applies to structures or theorems proving x = y, got {declTy}"
+      let some (ty, lhs, rhs) := declTy.eq? | failNotEq
+      unless lhs.isMVar && rhs.isMVar do failNotEq
+      let keys ← withReducible <| DiscrTree.mkPath ty extExt.config
+      let priority ← liftCommandElabM do Elab.liftMacroM do
+        evalPrio (prio.getD (← `(prio| default)))
+      extExtension.add {declName, keys, priority} kind
   erase := fun declName => do
     let s := extExtension.getState (← getEnv)
     let s ← s.erase declName
     modifyEnv fun env => extExtension.modifyState env fun _ => s
 }
 
+/--
+Constructs the hypotheses for the structure extensionality theorem that
+states that two structures are equal if their fields are equal.
 
-/-!
-### Implementation of `ext` tactic
+Calls the continuation `k` with the list of parameters to the structure,
+two structure variables `x` and `y`, and a list of pairs `(field, ty)`
+where `ty` is `x.field = y.field` or `HEq x.field y.field`.
+
+If `flat` parses to `true`, any fields inherited from parent structures
+are treated fields of the given structure type.
+If it is `false`, then the behind-the-scenes encoding of inherited fields
+is visible in the extensionality lemma.
 -/
+-- TODO: this is probably the wrong place to have this function
+def withExtHyps (struct : Name) (flat : Term)
+    (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do
+  let flat ← match flat with
+  | `(true) => pure true
+  | `(false) => pure false
+  | _ => throwErrorAt flat "expected 'true' or 'false'"
+  unless isStructure (← getEnv) struct do throwError "not a structure: {struct}"
+  let structC ← mkConstWithLevelParams struct
+  forallTelescope (← inferType structC) fun params _ => do
+  withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do
+  withLocalDeclD `x (mkAppN structC params) fun x => do
+  withLocalDeclD `y (mkAppN structC params) fun y => do
+    let mut hyps := #[]
+    let fields ← if flat then
+      pure <| getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false)
+    else
+      pure <| getStructureFields (← getEnv) struct
+    for field in fields do
+      let x_f ← mkProjection x field
+      let y_f ← mkProjection y field
+      if ← isProof x_f then
+        pure ()
+      else if ← isDefEq (← inferType x_f) (← inferType y_f) then
+        hyps := hyps.push (field, ← mkEq x_f y_f)
+      else
+        hyps := hyps.push (field, ← mkHEq x_f y_f)
+    k params x y hyps
+
+/--
+Creates the type of the extensionality theorem for the given structure,
+elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
+-/
+@[builtin_term_elab extType] def elabExtType : TermElab := fun stx _ => do
+  match stx with
+  | `(ext_type%  $flat:term $struct:ident) => do
+    withExtHyps (← realizeGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do
+      let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty =>
+        mkForall f BinderInfo.default h ty
+      mkForallFVars (params |>.push x |>.push y) ty
+  | _ => throwUnsupportedSyntax
+
+/--
+Creates the type of the iff-variant of the extensionality theorem for the given structure,
+elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
+-/
+@[builtin_term_elab extIffType] def elabExtIffType : TermElab := fun stx _ => do
+  match stx with
+  | `(ext_iff_type% $flat:term $struct:ident) => do
+    withExtHyps (← realizeGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do
+      mkForallFVars (params |>.push x |>.push y) <|
+        mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList
+  | _ => throwUnsupportedSyntax
 
 /-- Apply a single extensionality theorem to `goal`. -/
 def applyExtTheoremAt (goal : MVarId) : MetaM (List MVarId) := goal.withContext do

src/Lean/Elab/Tactic/Induction.lean

@@ -564,7 +564,7 @@ def getInductiveValFromMajor (major : Expr) : TacticM InductiveVal :=
 
 /--
 Elaborates the term in the `using` clause. We want to allow parameters to be instantiated
-(e.g. `using foo (p := …)`), but preserve other parameters, like the motives, as parameters,
+(e.g. `using foo (p := …)`), but preserve other paramters, like the motives, as parameters,
 without turning them into MVars. So this uses `abstractMVars` at the end. This is inspired by
 `Lean.Elab.Tactic.addSimpTheorem`.
 

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

@@ -254,17 +254,7 @@ where
     | _ => match n.getAppFnArgs with
     | (``Nat.succ, #[n]) => rewrite e (.app (.const ``Int.ofNat_succ []) n)
     | (``HAdd.hAdd, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_add []) a b)
-    | (``HMul.hMul, #[_, _, _, _, a, b]) =>
-      -- Don't push the cast into a multiplication unless it produces a non-trivial linear combination.
-      let r? ← commitWhen do
-        let (lc, prf, r) ← rewrite e (mkApp2 (.const ``Int.ofNat_mul []) a b)
-        if lc.isAtom then
-          pure (none, false)
-        else
-          pure (some (lc, prf, r), true)
-      match r? with
-      | some r => pure r
-      | none => mkAtomLinearCombo e
+    | (``HMul.hMul, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_mul []) a b)
     | (``HDiv.hDiv, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_ediv []) a b)
     | (``OfNat.ofNat, #[_, n, _]) => rewrite e (.app (.const ``Int.natCast_ofNat []) n)
     | (``HMod.hMod, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_emod []) a b)
@@ -588,14 +578,9 @@ where
         names := names.push "(masked)"
     return names
 
-  -- We sort the constraints; otherwise the order is dependent on details of the hashing
-  -- and this can cause test suite output churn
   prettyConstraints (names : Array String) (constraints : HashMap Coeffs Fact) : String :=
     constraints.toList
-      |>.toArray
-      |>.qsort (·.1 < ·.1)
       |>.map (fun ⟨coeffs, ⟨_, cst, _⟩⟩ => "  " ++ prettyConstraint (prettyCoeffs names coeffs) cst)
-      |>.toList
       |> "\n".intercalate
 
   prettyConstraint (e : String) : Constraint → String

src/Lean/Elab/Tactic/Simp.lean

@@ -347,7 +347,7 @@ def mkSimpOnly (stx : Syntax) (usedSimps : Simp.UsedSimps) : MetaM Syntax := do
       if env.contains declName
          && (inv || !simpOnlyBuiltins.contains declName)
          && !Match.isMatchEqnTheorem env declName then
-        let decl : Term ← `($(mkIdent (← unresolveNameGlobalAvoidingLocals declName)):ident)
+        let decl : Term ← `($(mkIdent (← unresolveNameGlobal declName)):ident)
         let arg ← match post, inv with
           | true,  true  => `(Parser.Tactic.simpLemma| ← $decl:term)
           | true,  false => `(Parser.Tactic.simpLemma| $decl:term)

src/Lean/Elab/Term.lean

@@ -12,7 +12,7 @@ import Lean.Linter.Deprecated
 import Lean.Elab.Config
 import Lean.Elab.Level
 import Lean.Elab.DeclModifiers
-import Lean.Elab.PreDefinition.TerminationHint
+import Lean.Elab.PreDefinition.WF.TerminationHint
 import Lean.Language.Basic
 
 namespace Lean.Elab
@@ -108,7 +108,7 @@ structure LetRecToLift where
   type           : Expr
   val            : Expr
   mvarId         : MVarId
-  termination    : TerminationHints
+  termination    : WF.TerminationHints
   deriving Inhabited
 
 /--
@@ -327,72 +327,35 @@ def SavedState.restore (s : SavedState) (restoreInfo : Bool := false) : TermElab
   unless restoreInfo do
     setInfoState infoState
 
-/--
-Like `Meta.withRestoreOrSaveFull` for `TermElabM`, but also takes a `tacSnap?` that
-* when running `act`, is set as `Context.tacSnap?`
-* otherwise (i.e. on restore) is used to update the new snapshot promise to the old task's
-  value.
-This extra restore step is necessary because while `reusableResult?` can be used to replay any
-effects on `State`, `Context.tacSnap?` is not part of it but changed via an `IO` side effect, so
-it needs to be replayed separately.
-
-We use an explicit parameter instead of accessing `Context.tacSnap?` directly because this prevents
-`withRestoreOrSaveFull` and `withReader` from being used in the wrong order.
--/
-@[specialize]
-def withRestoreOrSaveFull (reusableResult? : Option (α × SavedState))
-    (tacSnap? : Option (Language.SnapshotBundle Tactic.TacticParsedSnapshot)) (act : TermElabM α) :
+@[specialize, inherit_doc Core.withRestoreOrSaveFull]
+def withRestoreOrSaveFull (reusableResult? : Option (α × SavedState)) (act : TermElabM α) :
     TermElabM (α × SavedState) := do
   if let some (_, state) := reusableResult? then
     set state.elab
-    if let some snap := tacSnap? then
-      let some old := snap.old?
-        | throwError "withRestoreOrSaveFull: expected old snapshot in `tacSnap?`"
-      snap.new.resolve old.val.get
-
   let reusableResult? := reusableResult?.map (fun (val, state) => (val, state.meta))
-  let (a, meta) ← withReader ({ · with tacSnap? }) do
-    controlAt MetaM fun runInBase => do
-      Meta.withRestoreOrSaveFull reusableResult? <| runInBase act
+  let (a, meta) ← controlAt MetaM fun runInBase => do
+    Meta.withRestoreOrSaveFull reusableResult? <| runInBase act
   return (a, { meta, «elab» := (← get) })
 
 instance : MonadBacktrack SavedState TermElabM where
   saveState      := Term.saveState
   restoreState b := b.restore
 
-/--
-Incremental elaboration helper. Avoids leakage of data from outside syntax via the monadic context
-when running `act` on `stx` by
-* setting `stx` as the `ref` and
-* deactivating `suppressElabErrors` if `stx` is `missing`-free, which also helps with not hiding
-  useful errors in this part of the input. Note that if `stx` has `missing`, this should always be
-  true for the outer syntax as well, so taking the old value of `suppressElabErrors` into account
-  should not introduce data leakage.
-
-This combinator should always be used when narrowing reuse to a syntax subtree, usually (in the case
-of tactics, to be generalized) via `withNarrowed(Arg)TacticReuse`.
--/
-def withReuseContext [Monad m] [MonadWithReaderOf Core.Context m] (stx : Syntax) (act : m α) :
-    m α := do
-  withTheReader Core.Context (fun ctx => { ctx with
-      ref := stx
-      suppressElabErrors := ctx.suppressElabErrors && stx.hasMissing }) act
-
 /--
 Manages reuse information for nested tactics by `split`ting given syntax into an outer and inner
 part. `act` is then run on the inner part but with reuse information adjusted as following:
 * If the old (from `tacSnap?`'s `SyntaxGuarded.stx`) and new (from `stx`) outer syntax are not
   identical according to `Syntax.eqWithInfo`, reuse is disabled.
 * Otherwise, the old syntax as stored in `tacSnap?` is updated to the old *inner* syntax.
-* In any case, `withReuseContext` is used on the new inner syntax to further prepare the monadic
-  context.
+* In any case, we also use `withRef` on the inner syntax to avoid leakage of the outer syntax into
+  `act` via this route.
 
 For any tactic that participates in reuse, `withNarrowedTacticReuse` should be applied to the
 tactic's syntax and `act` should be used to do recursive tactic evaluation of nested parts.
 -/
-def withNarrowedTacticReuse [Monad m] [MonadWithReaderOf Core.Context m]
-    [MonadWithReaderOf Context m] [MonadOptions m] (split : Syntax → Syntax × Syntax)
-    (act : Syntax → m α) (stx : Syntax) : m α := do
+def withNarrowedTacticReuse [Monad m] [MonadWithReaderOf Context m]
+    [MonadOptions m] [MonadRef m] (split : Syntax → Syntax × Syntax) (act : Syntax → m α)
+    (stx : Syntax) : m α := do
   let (outer, inner) := split stx
   let opts ← getOptions
   withTheReader Term.Context (fun ctx => { ctx with tacSnap? := ctx.tacSnap?.map fun tacSnap =>
@@ -402,7 +365,8 @@ def withNarrowedTacticReuse [Monad m] [MonadWithReaderOf Core.Context m]
       return { old with stx := oldInner }
     }
   }) do
-    withReuseContext inner (act inner)
+    withRef inner do
+      act inner
 
 /--
 A variant of `withNarrowedTacticReuse` that uses `stx[argIdx]` as the inner syntax and all `stx`
@@ -413,8 +377,8 @@ NOTE: child nodes after `argIdx` are not tested (which would almost always disab
 necessarily shifted by changes at `argIdx`) so it must be ensured that the result of `arg` does not
 depend on them (i.e. they should not be inspected beforehand).
 -/
-def withNarrowedArgTacticReuse [Monad m] [MonadWithReaderOf Core.Context m] [MonadWithReaderOf Context m]
-    [MonadOptions m] (argIdx : Nat) (act : Syntax → m α) (stx : Syntax) : m α :=
+def withNarrowedArgTacticReuse [Monad m] [MonadWithReaderOf Context m]
+    [MonadOptions m] [MonadRef m] (argIdx : Nat) (act : Syntax → m α) (stx : Syntax) : m α :=
   withNarrowedTacticReuse (fun stx => (mkNullNode stx.getArgs[:argIdx], stx[argIdx])) act stx
 
 /--
@@ -1827,13 +1791,9 @@ def isLetRecAuxMVar (mvarId : MVarId) : TermElabM Bool := do
 /--
   Create an `Expr.const` using the given name and explicit levels.
   Remark: fresh universe metavariables are created if the constant has more universe
-  parameters than `explicitLevels`.
-
-  If `checkDeprecated := true`, then `Linter.checkDeprecated` is invoked.
--/
-def mkConst (constName : Name) (explicitLevels : List Level := []) (checkDeprecated := true) : TermElabM Expr := do
-  if checkDeprecated then
-    Linter.checkDeprecated constName
+  parameters than `explicitLevels`. -/
+def mkConst (constName : Name) (explicitLevels : List Level := []) : TermElabM Expr := do
+  Linter.checkDeprecated constName -- TODO: check is occurring too early if there are multiple alternatives. Fix if it is not ok in practice
   let cinfo ← getConstInfo constName
   if explicitLevels.length > cinfo.levelParams.length then
     throwError "too many explicit universe levels for '{constName}'"
@@ -1842,21 +1802,10 @@ def mkConst (constName : Name) (explicitLevels : List Level := []) (checkDepreca
     let us ← mkFreshLevelMVars numMissingLevels
     return Lean.mkConst constName (explicitLevels ++ us)
 
-def checkDeprecated (ref : Syntax) (e : Expr) : TermElabM Unit := do
-  if let .const declName _ := e.getAppFn then
-    withRef ref do Linter.checkDeprecated declName
-
 private def mkConsts (candidates : List (Name × List String)) (explicitLevels : List Level) : TermElabM (List (Expr × List String)) := do
   candidates.foldlM (init := []) fun result (declName, projs) => do
     -- TODO: better support for `mkConst` failure. We may want to cache the failures, and report them if all candidates fail.
-    /-
-    We disable `checkDeprecated` here because there may be many overloaded symbols.
-    Note that, this method and `resolveName` and `resolveName'` return a list of pairs instead of a list of `TermElabResult`s.
-    We perform the `checkDeprecated` test at `resolveId?` and `elabAppFnId`.
-    At `elabAppFnId`, we perform the check when converting the list returned by `resolveName'` into a list of
-    `TermElabResult`s.
-    -/
-    let const ← mkConst declName explicitLevels (checkDeprecated := false)
+    let const ← mkConst declName explicitLevels
     return (const, projs) :: result
 
 def resolveName (stx : Syntax) (n : Name) (preresolved : List Syntax.Preresolved) (explicitLevels : List Level) (expectedType? : Option Expr := none) : TermElabM (List (Expr × List String)) := do
@@ -1910,11 +1859,11 @@ def resolveId? (stx : Syntax) (kind := "term") (withInfo := false) : TermElabM (
     | []  => return none
     | [f] =>
       let f ← if withInfo then addTermInfo stx f else pure f
-      checkDeprecated stx f
       return some f
     | _   => throwError "ambiguous {kind}, use fully qualified name, possible interpretations {fs}"
   | _ => throwError "identifier expected"
 
+
 def TermElabM.run (x : TermElabM α) (ctx : Context := {}) (s : State := {}) : MetaM (α × State) :=
   withConfig setElabConfig (x ctx |>.run s)