feat: add isExclusiveUnsafe

Avoid potentially expensive `e.replace` if it is not applicable.

.github/workflows/actionlint.yml

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

.github/workflows/ci.yml

@@ -9,6 +9,17 @@ 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 }}
@@ -41,11 +52,11 @@ jobs:
 
     steps:
       - name: Checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         # don't schedule nightlies on forks
-        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
+        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
       - name: Set Nightly
-        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
+        if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
         id: set-nightly
         run: |
           if [[ -n '${{ secrets.PUSH_NIGHTLY_TOKEN }}' ]]; then
@@ -386,7 +397,7 @@ jobs:
           else
             ${{ matrix.tar || 'tar' }} cf - $dir | zstd -T0 --no-progress -o pack/$dir.tar.zst
           fi
-      - uses: actions/upload-artifact@v3
+      - uses: actions/upload-artifact@v4
         if: matrix.release
         with:
           name: build-${{ matrix.name }}
@@ -459,7 +470,7 @@ jobs:
     runs-on: ubuntu-latest
     needs: build
     steps:
-      - uses: actions/download-artifact@v3
+      - uses: actions/download-artifact@v4
         with:
           path: artifacts
       - name: Release
@@ -470,6 +481,11 @@ jobs:
           prerelease: ${{ !startsWith(github.ref, 'refs/tags/v') || contains(github.ref, '-rc') }}
         env:
           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+      - name: Update release.lean-lang.org
+        run: |
+          gh workflow -R leanprover/release-index run update-index.yml
+        env:
+          GITHUB_TOKEN: ${{ secrets.RELEASE_INDEX_TOKEN }}
 
   # This job creates nightly releases during the cron job.
   # It is responsible for creating the tag, and automatically generating a changelog.
@@ -479,12 +495,12 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           # needed for tagging
           fetch-depth: 0
           token: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
-      - uses: actions/download-artifact@v3
+      - uses: actions/download-artifact@v4
         with:
           path: artifacts
       - name: Prepare Nightly Release
@@ -512,3 +528,8 @@ jobs:
           repository: ${{ github.repository_owner }}/lean4-nightly
         env:
           GITHUB_TOKEN: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
+      - name: Update release.lean-lang.org
+        run: |
+          gh workflow -R leanprover/release-index run update-index.yml
+        env:
+          GITHUB_TOKEN: ${{ secrets.RELEASE_INDEX_TOKEN }}

.github/workflows/nix-ci.yml

@@ -50,7 +50,7 @@ jobs:
       NIX_BUILD_ARGS: --print-build-logs --fallback
     steps:
       - name: Checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         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@v3
+        uses: actions/checkout@v4
         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@v3
+        uses: actions/checkout@v4
         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 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
+            sed -i 's,require "leanprover-community" / "batteries" @ ".\+",require "leanprover-community" / "batteries" @ "git#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,10 +20,12 @@ jobs:
         gh run view "$run_id"
         echo "Cancelling (just in case)"
         gh run cancel "$run_id" || echo "(failed)"
-        echo "Waiting for 10s"
-        sleep 10
+        echo "Waiting for 30s"
+        sleep 30
+        gh run view "$run_id"
         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@v3
+    - uses: actions/checkout@v4
       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

RELEASES.md

@@ -8,13 +8,326 @@ This file contains work-in-progress notes for the upcoming release, as well as p
 Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
 of each version.
 
-v4.10.0
+v4.11.0
 ----------
 Development in progress.
 
+v4.10.0
+----------
+Release candidate, release notes will be copied from branch `releases/v4.10.0` once completed.
+
 v4.9.0
 ---------- 
-Release candidate, release notes will be copied from branch `releases/v4.9.0` once completed.
+
+### Language features, tactics, and metaprograms
+
+* **Definition transparency**
+  * [#4053](https://github.com/leanprover/lean4/pull/4053) adds the `seal` and `unseal` commands, which make definitions locally be irreducible or semireducible.
+  * [#4061](https://github.com/leanprover/lean4/pull/4061) marks functions defined by well-founded recursion with `@[irreducible]` by default,
+    which should prevent the expensive and often unfruitful unfolding of such definitions (see breaking changes below).
+* **Incrementality**
+  * [#3940](https://github.com/leanprover/lean4/pull/3940) extends incremental elaboration into various steps inside of declarations:
+    definition headers, bodies, and tactics.
+    ![Recording 2024-05-10](https://github.com/leanprover/lean4/assets/109126/c9d67b6f-c131-4bc3-a0de-7d63eaf1bfc9).
+  * [250994](https://github.com/leanprover/lean4/commit/250994166ce036ab8644e459129f51ea79c1c2d2)
+    and [67338b](https://github.com/leanprover/lean4/commit/67338bac2333fa39a8656e8f90574784e4c23d3d)
+    add `@[incremental]` attribute to mark an elaborator as supporting incremental elaboration.
+  * [#4259](https://github.com/leanprover/lean4/pull/4259) improves resilience by ensuring incremental commands and tactics are reached only in supported ways.
+  * [#4268](https://github.com/leanprover/lean4/pull/4268) adds special handling for `:= by` so that stray tokens in tactic blocks do not inhibit incrementality.
+  * [#4308](https://github.com/leanprover/lean4/pull/4308) adds incremental `have` tactic.
+  * [#4340](https://github.com/leanprover/lean4/pull/4340) fixes incorrect info tree reuse.
+  * [#4364](https://github.com/leanprover/lean4/pull/4364) adds incrementality for careful command macros such as `set_option in theorem`, `theorem foo.bar`, and `lemma`.
+  * [#4395](https://github.com/leanprover/lean4/pull/4395) adds conservative fix for whitespace handling to avoid incremental reuse leading to goals in front of the text cursor being shown.
+  * [#4407](https://github.com/leanprover/lean4/pull/4407) fixes non-incremental commands in macros blocking further incremental reporting.
+  * [#4436](https://github.com/leanprover/lean4/pull/4436) fixes incremental reporting when there are nested tactics in terms.
+* **Functional induction**
+  * [#4135](https://github.com/leanprover/lean4/pull/4135) ensures that the names used for functional induction are reserved.
+  * [#4327](https://github.com/leanprover/lean4/pull/4327) adds support for structural recursion on reflexive types.
+    For example,
+    ```lean4
+    inductive Many (α : Type u) where
+      | none : Many α
+      | more : α → (Unit → Many α) → Many α
+
+    def Many.map {α β : Type u} (f : α → β) : Many α → Many β
+      | .none => .none
+      | .more x xs => .more (f x) (fun _ => (xs ()).map f)
+
+    #check Many.map.induct
+    /-
+    Many.map.induct {α β : Type u} (f : α → β) (motive : Many α → Prop)
+      (case1 : motive Many.none)
+      (case2 : ∀ (x : α) (xs : Unit → Many α), motive (xs ()) → motive (Many.more x xs)) :
+      ∀ (a : Many α), motive a
+    -/
+    ```
+* [#3903](https://github.com/leanprover/lean4/pull/3903) makes the Lean frontend normalize all line endings to LF before processing.
+  This lets Lean be insensitive to CRLF vs LF line endings, improving the cross-platform experience and making Lake hashes be faithful to what Lean processes.
+* [#4130](https://github.com/leanprover/lean4/pull/4130) makes the tactic framework be able to recover from runtime errors (for example, deterministic timeouts or maximum recursion depth errors).
+* `split` tactic
+  * [#4211](https://github.com/leanprover/lean4/pull/4211) fixes `split at h` when `h` has forward dependencies.
+  * [#4349](https://github.com/leanprover/lean4/pull/4349) allows `split` for `if`-expressions to work on non-propositional goals.
+* `apply` tactic
+  * [#3929](https://github.com/leanprover/lean4/pull/3929) makes error message for `apply` show implicit arguments in unification errors as needed.
+    Modifies `MessageData` type (see breaking changes below).
+* `cases` tactic
+  * [#4224](https://github.com/leanprover/lean4/pull/4224) adds support for unification of offsets such as `x + 20000 = 20001` in `cases` tactic.
+* `omega` tactic
+  * [#4073](https://github.com/leanprover/lean4/pull/4073) lets `omega` fall back to using classical `Decidable` instances when setting up contradiction proofs.
+  * [#4141](https://github.com/leanprover/lean4/pull/4141) and [#4184](https://github.com/leanprover/lean4/pull/4184) fix bugs.
+  * [#4264](https://github.com/leanprover/lean4/pull/4264) improves `omega` error message if no facts found in local context.
+  * [#4358](https://github.com/leanprover/lean4/pull/4358) improves expression matching in `omega` by using `match_expr`.
+* `simp` tactic
+  * [#4176](https://github.com/leanprover/lean4/pull/4176) makes names of erased lemmas clickable.
+  * [#4208](https://github.com/leanprover/lean4/pull/4208) adds a pretty printer for discrimination tree keys.
+  * [#4202](https://github.com/leanprover/lean4/pull/4202) adds `Simp.Config.index` configuration option,
+    which controls whether to use the full discrimination tree when selecting candidate simp lemmas.
+    When `index := false`, only the head function is taken into account, like in Lean 3.
+    This feature can help users diagnose tricky simp failures or issues in code from libraries
+    developed using Lean 3 and then ported to Lean 4.
+    
+    In the following example, it will report that `foo` is a problematic theorem.
+    ```lean
+    opaque f : Nat → Nat → Nat
+
+    @[simp] theorem foo : f x (x, y).2 = y := by sorry
+
+    example : f a b ≤ b := by
+      set_option diagnostics true in
+      simp (config := { index := false })
+    /-
+    [simp] theorems with bad keys
+      foo, key: f _ (@Prod.mk ℕ ℕ _ _).2
+    -/
+    ```
+    With the information above, users can annotate theorems such as `foo` using `no_index` for problematic subterms. Example:
+    ```lean
+    opaque f : Nat → Nat → Nat
+
+    @[simp] theorem foo : f x (no_index (x, y).2) = y := by sorry
+    
+    example : f a b ≤ b := by
+      simp -- `foo` is still applied with `index := true`
+    ```
+  * [#4274](https://github.com/leanprover/lean4/pull/4274) prevents internal `match` equational theorems from appearing in simp trace.
+  * [#4177](https://github.com/leanprover/lean4/pull/4177) and [#4359](https://github.com/leanprover/lean4/pull/4359) make `simp` continue even if a simp lemma does not elaborate, if the tactic state is in recovery mode.
+  * [#4341](https://github.com/leanprover/lean4/pull/4341) fixes panic when applying `@[simp]` to malformed theorem syntax.
+  * [#4345](https://github.com/leanprover/lean4/pull/4345) fixes `simp` so that it does not use the forward version of a user-specified backward theorem.
+  * [#4352](https://github.com/leanprover/lean4/pull/4352) adds missing `dsimp` simplifications for fixed parameters of generated congruence theorems.
+  * [#4362](https://github.com/leanprover/lean4/pull/4362) improves trace messages for `simp` so that constants are hoverable.
+* **Elaboration**
+  * [#4046](https://github.com/leanprover/lean4/pull/4046) makes subst notation (`he ▸ h`) try rewriting in both directions even when there is no expected type available.
+  * [#3328](https://github.com/leanprover/lean4/pull/3328) adds support for identifiers in autoparams (for example, `rfl` in `(h : x = y := by exact rfl)`).
+  * [#4096](https://github.com/leanprover/lean4/pull/4096) changes how the type in `let` and `have` is elaborated, requiring that any tactics in the type be evaluated before proceeding, improving performance.
+  * [#4215](https://github.com/leanprover/lean4/pull/4215) ensures the expression tree elaborator commits to the computed "max type" for the entire arithmetic expression.
+  * [#4267](https://github.com/leanprover/lean4/pull/4267) cases signature elaboration errors to show even if there are parse errors in the body.
+  * [#4368](https://github.com/leanprover/lean4/pull/4368) improves error messages when numeric literals fail to synthesize an `OfNat` instance,
+    including special messages warning when the expected type of the numeral can be a proposition.
+* **Metaprogramming**
+  * [#4167](https://github.com/leanprover/lean4/pull/4167) adds `Lean.MVarId.revertAll` to revert all free variables.
+  * [#4169](https://github.com/leanprover/lean4/pull/4169) adds `Lean.MVarId.ensureNoMVar` to ensure the goal's target contains no expression metavariables.
+  * [#4180](https://github.com/leanprover/lean4/pull/4180) adds `cleanupAnnotations` parameter to `forallTelescope` methods.
+  * [#4307](https://github.com/leanprover/lean4/pull/4307) adds support for parser aliases in syntax quotations.
+* Work toward implementing `grind` tactic
+  * [0a515e](https://github.com/leanprover/lean4/commit/0a515e2ec939519dafb4b99daa81d6bf3c411404)
+    and [#4164](https://github.com/leanprover/lean4/pull/4164)
+    add `grind_norm` and `grind_norm_proc` attributes and `@[grind_norm]` theorems.
+  * [#4170](https://github.com/leanprover/lean4/pull/4170), [#4221](https://github.com/leanprover/lean4/pull/4221),
+    and [#4249](https://github.com/leanprover/lean4/pull/4249) create `grind` preprocessor and core module.
+  * [#4235](https://github.com/leanprover/lean4/pull/4235) and [d6709e](https://github.com/leanprover/lean4/commit/d6709eb1576c5d40fc80462637dc041f970e4d9f)
+    add special `cases` tactic to `grind` along with `@[grind_cases]` attribute to mark types that this `cases` tactic should automatically apply to.
+  * [#4243](https://github.com/leanprover/lean4/pull/4243) adds special `injection?` tactic to `grind`.
+* **Other fixes or improvements**
+  * [#4065](https://github.com/leanprover/lean4/pull/4065) fixes a bug in the `Nat.reduceLeDiff` simproc.
+  * [#3969](https://github.com/leanprover/lean4/pull/3969) makes deprecation warnings activate even for generalized field notation ("dot notation").
+  * [#4132](https://github.com/leanprover/lean4/pull/4132) fixes the `sorry` term so that it does not activate the implicit lambda feature
+  * [9803c5](https://github.com/leanprover/lean4/commit/9803c5dd63dc993628287d5f998525e74af03839)
+    and [47c8e3](https://github.com/leanprover/lean4/commit/47c8e340d65b01f4d9f011686e3dda0d4bb30a20)
+    move `cdot` and `calc` parsers to `Lean` namespace.
+  * [#4252](https://github.com/leanprover/lean4/pull/4252) fixes the `case` tactic so that it is usable in macros by having it erase macro scopes from the tag.
+  * [26b671](https://github.com/leanprover/lean4/commit/26b67184222e75529e1b166db050aaebee323d2d)
+    and [cc33c3](https://github.com/leanprover/lean4/commit/cc33c39cb022d8a3166b1e89677c78835ead1fc7)
+    extract `haveId` syntax.
+  * [#4335](https://github.com/leanprover/lean4/pull/4335) fixes bugs in partial `calc` tactic when there is mdata or metavariables.
+  * [#4329](https://github.com/leanprover/lean4/pull/4329) makes `termination_by?` report unused each unused parameter as `_`.
+* **Docs:** [#4238](https://github.com/leanprover/lean4/pull/4238), [#4294](https://github.com/leanprover/lean4/pull/4294),
+  [#4338](https://github.com/leanprover/lean4/pull/4338).
+
+### Language server, widgets, and IDE extensions
+* [#4066](https://github.com/leanprover/lean4/pull/4066) fixes features like "Find References" when browsing core Lean sources.
+* [#4254](https://github.com/leanprover/lean4/pull/4254) allows embedding user widgets in structured messages.
+  Companion PR is [vscode-lean4#449](https://github.com/leanprover/vscode-lean4/pull/449).
+* [#4445](https://github.com/leanprover/lean4/pull/4445) makes watchdog more resilient against badly behaving clients.
+
+### Library
+* [#4059](https://github.com/leanprover/lean4/pull/4059) upstreams many `List` and `Array` operations and theorems from Batteries.
+* [#4055](https://github.com/leanprover/lean4/pull/4055) removes the unused `Inhabited` instance for `Subtype`.
+* [#3967](https://github.com/leanprover/lean4/pull/3967) adds dates in existing `@[deprecated]` attributes.
+* [#4231](https://github.com/leanprover/lean4/pull/4231) adds boilerplate `Char`, `UInt`, and `Fin` theorems.
+* [#4205](https://github.com/leanprover/lean4/pull/4205) fixes the `MonadStore` type classes to use `semiOutParam`.
+* [#4350](https://github.com/leanprover/lean4/pull/4350) renames `IsLawfulSingleton` to `LawfulSingleton`.
+* `Nat`
+  * [#4094](https://github.com/leanprover/lean4/pull/4094) swaps `Nat.zero_or` and `Nat.or_zero`.
+  * [#4098](https://github.com/leanprover/lean4/pull/4098) and [#4145](https://github.com/leanprover/lean4/pull/4145)
+    change the definition of `Nat.mod` so that `n % (m + n)` reduces when `n` is literal without relying on well-founded recursion,
+    which becomes irreducible by default in [#4061](https://github.com/leanprover/lean4/pull/4061).
+  * [#4188](https://github.com/leanprover/lean4/pull/4188) redefines `Nat.testBit` to be more performant.
+  * Theorems: [#4199](https://github.com/leanprover/lean4/pull/4199).
+* `Array`
+  * [#4074](https://github.com/leanprover/lean4/pull/4074) improves the functional induction principle `Array.feraseIdx.induct`.
+* `List`
+  * [#4172](https://github.com/leanprover/lean4/pull/4172) removes `@[simp]` from `List.length_pos`.
+* `Option`
+  * [#4037](https://github.com/leanprover/lean4/pull/4037) adds theorems to simplify `Option`-valued dependent if-then-else.
+  * [#4314](https://github.com/leanprover/lean4/pull/4314) removes `@[simp]` from `Option.bind_eq_some`.
+* `BitVec`
+  * Theorems: [#3920](https://github.com/leanprover/lean4/pull/3920), [#4095](https://github.com/leanprover/lean4/pull/4095),
+    [#4075](https://github.com/leanprover/lean4/pull/4075), [#4148](https://github.com/leanprover/lean4/pull/4148),
+    [#4165](https://github.com/leanprover/lean4/pull/4165), [#4178](https://github.com/leanprover/lean4/pull/4178),
+    [#4200](https://github.com/leanprover/lean4/pull/4200), [#4201](https://github.com/leanprover/lean4/pull/4201),
+    [#4298](https://github.com/leanprover/lean4/pull/4298), [#4299](https://github.com/leanprover/lean4/pull/4299),
+    [#4257](https://github.com/leanprover/lean4/pull/4257), [#4179](https://github.com/leanprover/lean4/pull/4179),
+    [#4321](https://github.com/leanprover/lean4/pull/4321), [#4187](https://github.com/leanprover/lean4/pull/4187).
+  * [#4193](https://github.com/leanprover/lean4/pull/4193) adds simprocs for reducing `x >>> i` and `x <<< i` where `i` is a bitvector literal.
+  * [#4194](https://github.com/leanprover/lean4/pull/4194) adds simprocs for reducing `(x <<< i) <<< j` and `(x >>> i) >>> j` where `i` and `j` are natural number literals.
+  * [#4229](https://github.com/leanprover/lean4/pull/4229) redefines `rotateLeft`/`rotateRight` to use modulo reduction of shift offset.
+  * [0d3051](https://github.com/leanprover/lean4/commit/0d30517dca094a07bcb462252f718e713b93ffba) makes `<num>#<term>` bitvector literal notation global.
+* `Char`/`String`
+  * [#4143](https://github.com/leanprover/lean4/pull/4143) modifies `String.substrEq` to avoid linter warnings in downstream code.
+  * [#4233](https://github.com/leanprover/lean4/pull/4233) adds simprocs for `Char` and `String` inequalities.
+  * [#4348](https://github.com/leanprover/lean4/pull/4348) upstreams Mathlib lemmas.
+  * [#4354](https://github.com/leanprover/lean4/pull/4354) upstreams basic `String` lemmas.
+* `HashMap`
+  * [#4248](https://github.com/leanprover/lean4/pull/4248) fixes implicitness of typeclass arguments in `HashMap.ofList`.
+* `IO`
+  * [#4036](https://github.com/leanprover/lean4/pull/4036) adds `IO.Process.getCurrentDir` and `IO.Process.setCurrentDir` for adjusting the current process's working directory.
+* **Cleanup:** [#4077](https://github.com/leanprover/lean4/pull/4077), [#4189](https://github.com/leanprover/lean4/pull/4189),
+  [#4304](https://github.com/leanprover/lean4/pull/4304).
+* **Docs:** [#4001](https://github.com/leanprover/lean4/pull/4001), [#4166](https://github.com/leanprover/lean4/pull/4166),
+  [#4332](https://github.com/leanprover/lean4/pull/4332).
+
+### Lean internals
+* **Defeq and WHNF algorithms**
+  * [#4029](https://github.com/leanprover/lean4/pull/4029) remove unnecessary `checkpointDefEq`
+  * [#4206](https://github.com/leanprover/lean4/pull/4206) fixes `isReadOnlyOrSyntheticOpaque` to respect metavariable depth.
+  * [#4217](https://github.com/leanprover/lean4/pull/4217) fixes missing occurs check for delayed assignments.
+* **Definition transparency**
+  * [#4052](https://github.com/leanprover/lean4/pull/4052) adds validation to application of `@[reducible]`/`@[semireducible]`/`@[irreducible]` attributes (with `local`/`scoped` modifiers as well).
+    Setting `set_option allowUnsafeReductibility true` turns this validation off.
+* **Inductive types**
+  * [#3591](https://github.com/leanprover/lean4/pull/3591) fixes a bug where indices could be incorrectly promoted to parameters.
+  * [#3398](https://github.com/leanprover/lean4/pull/3398) fixes a bug in the injectivity theorem generator.
+  * [#4342](https://github.com/leanprover/lean4/pull/4342) fixes elaboration of mutual inductives with instance parameters.
+* **Diagnostics and profiling**
+  * [#3986](https://github.com/leanprover/lean4/pull/3986) adds option `trace.profiler.useHeartbeats` to switch `trace.profiler.threshold` to being in terms of heartbeats instead of milliseconds.
+  * [#4082](https://github.com/leanprover/lean4/pull/4082) makes `set_option diagnostics true` report kernel diagnostic information.
+* **Typeclass resolution**
+  * [#4119](https://github.com/leanprover/lean4/pull/4119) fixes multiple issues with TC caching interacting with `synthPendingDepth`, adds `maxSynthPendingDepth` option with default value `1`.
+  * [#4210](https://github.com/leanprover/lean4/pull/4210) ensures local instance cache does not contain multiple copies of the same instance.
+  * [#4216](https://github.com/leanprover/lean4/pull/4216) fix handling of metavariables, to avoid needing to set the option `backward.synthInstance.canonInstances` to `false`.
+* **Other fixes or improvements**
+  * [#4080](https://github.com/leanprover/lean4/pull/4080) fixes propagation of state for `Lean.Elab.Command.liftCoreM` and `Lean.Elab.Command.liftTermElabM`.
+  * [#3944](https://github.com/leanprover/lean4/pull/3944) makes the `Repr` deriving handler be consistent between `structure` and `inductive` for how types and proofs are erased.
+  * [#4113](https://github.com/leanprover/lean4/pull/4113) propagates `maxHeartbeats` to kernel to control "(kernel) deterministic timeout" error.
+  * [#4125](https://github.com/leanprover/lean4/pull/4125) reverts [#3970](https://github.com/leanprover/lean4/pull/3970) (monadic generalization of `FindExpr`).
+  * [#4128](https://github.com/leanprover/lean4/pull/4128) catches stack overflow in auto-bound implicits feature.
+  * [#4129](https://github.com/leanprover/lean4/pull/4129) adds `tryCatchRuntimeEx` combinator to replace `catchRuntimeEx` reader state.
+  * [#4155](https://github.com/leanprover/lean4/pull/4155) simplifies the expression canonicalizer.
+  * [#4151](https://github.com/leanprover/lean4/pull/4151) and [#4369](https://github.com/leanprover/lean4/pull/4369)
+    add many missing trace classes.
+  * [#4185](https://github.com/leanprover/lean4/pull/4185) makes congruence theorem generators clean up type annotations of argument types.
+  * [#4192](https://github.com/leanprover/lean4/pull/4192) fixes restoration of infotrees when auto-bound implicit feature is activated,
+    fixing a pretty printing error in hovers and strengthening the unused variable linter.
+  * [dfb496](https://github.com/leanprover/lean4/commit/dfb496a27123c3864571aec72f6278e2dad1cecf) fixes `declareBuiltin` to allow it to be called multiple times per declaration.
+  * Cleanup: [#4112](https://github.com/leanprover/lean4/pull/4112), [#4126](https://github.com/leanprover/lean4/pull/4126), [#4091](https://github.com/leanprover/lean4/pull/4091), [#4139](https://github.com/leanprover/lean4/pull/4139), [#4153](https://github.com/leanprover/lean4/pull/4153).
+  * Tests: [030406](https://github.com/leanprover/lean4/commit/03040618b8f9b35b7b757858483e57340900cdc4), [#4133](https://github.com/leanprover/lean4/pull/4133).
+
+### Compiler, runtime, and FFI
+* [#4100](https://github.com/leanprover/lean4/pull/4100) improves reset/reuse algorithm; it now runs a second pass relaxing the constraint that reused memory cells must only be for the exact same constructor.
+* [#2903](https://github.com/leanprover/lean4/pull/2903) fixes segfault in old compiler from mishandling `noConfusion` applications.
+* [#4311](https://github.com/leanprover/lean4/pull/4311) fixes bug in constant folding.
+* [#3915](https://github.com/leanprover/lean4/pull/3915) documents the runtime memory layout for inductive types.
+
+### Lake
+* [#4057](https://github.com/leanprover/lean4/pull/4057) adds support for docstrings on `require` commands.
+* [#4088](https://github.com/leanprover/lean4/pull/4088) improves hovers for `family_def` and `library_data` commands.
+* [#4147](https://github.com/leanprover/lean4/pull/4147) adds default `README.md` to package templates
+* [#4261](https://github.com/leanprover/lean4/pull/4261) extends `lake test` help page, adds help page for `lake check-test`,
+  adds `lake lint` and tag `@[lint_driver]`, adds support for specifying test and lint drivers from dependencies,
+  adds `testDriverArgs` and `lintDriverArgs` options, adds support for library test drivers,
+  makes `lake check-test` and `lake check-lint` only load the package without dependencies.
+* [#4270](https://github.com/leanprover/lean4/pull/4270) adds `lake pack` and `lake unpack` for packing and unpacking Lake build artifacts from an archive.
+* [#4083](https://github.com/leanprover/lean4/pull/4083)
+  Switches the manifest format to use `major.minor.patch` semantic
+  versions. Major version increments indicate breaking changes (e.g., new
+  required fields and semantic changes to existing fields). Minor version
+  increments (after `0.x`) indicate backwards-compatible extensions (e.g.,
+  adding optional fields, removing fields). This change is backwards
+  compatible. Lake will still successfully read old manifests with numeric
+  versions. It will treat the numeric version `N` as semantic version
+  `0.N.0`. Lake will also accept manifest versions with `-` suffixes
+  (e.g., `x.y.z-foo`) and then ignore the suffix.
+* [#4273](https://github.com/leanprover/lean4/pull/4273) adds a lift from `JobM` to `FetchM` for backwards compatibility reasons.
+* [#4351](https://github.com/leanprover/lean4/pull/4351) fixes `LogIO`-to-`CliM`-lifting performance issues.
+* [#4343](https://github.com/leanprover/lean4/pull/4343) make Lake store the dependency trace for a build in
+  the cached build long and then verifies that it matches the trace of the current build before replaying the log.
+* [#4402](https://github.com/leanprover/lean4/pull/4402) moves the cached log into the trace file (no more `.log.json`).
+  This means logs are no longer cached on fatal errors and this ensures that an out-of-date log is not associated with an up-to-date trace.
+  Separately, `.hash` file generation was changed to be more reliable as well.
+  The `.hash` files are deleted as part of the build and always regenerate with `--rehash`.
+* **Other fixes or improvements**
+  * [#4056](https://github.com/leanprover/lean4/pull/4056) cleans up tests
+  * [#4244](https://github.com/leanprover/lean4/pull/4244) fixes `noRelease` test when Lean repo is tagged
+  * [#4346](https://github.com/leanprover/lean4/pull/4346) improves `tests/serve`
+  * [#4356](https://github.com/leanprover/lean4/pull/4356) adds build log path to the warning for a missing or invalid build log.
+
+### DevOps
+* [#3984](https://github.com/leanprover/lean4/pull/3984) adds a script (`script/rebase-stage0.sh`) for `git rebase -i` that automatically updates each stage0.
+* [#4108](https://github.com/leanprover/lean4/pull/4108) finishes renamings from transition to Std to Batteries.
+* [#4109](https://github.com/leanprover/lean4/pull/4109) adjusts the Github bug template to mention testing using [live.lean-lang.org](https://live.lean-lang.org).
+* [#4136](https://github.com/leanprover/lean4/pull/4136) makes CI rerun only when `full-ci` label is added or removed.
+* [#4175](https://github.com/leanprover/lean4/pull/4175) and [72b345](https://github.com/leanprover/lean4/commit/72b345c621a9a06d3a5a656da2b793a5eea5f168)
+  switch to using `#guard_msgs` to run tests as much as possible.
+* [#3125](https://github.com/leanprover/lean4/pull/3125) explains the Lean4 `pygments` lexer.
+* [#4247](https://github.com/leanprover/lean4/pull/4247) sets up a procedure for preparing release notes.
+* [#4032](https://github.com/leanprover/lean4/pull/4032) modernizes build instructions and workflows.
+* [#4255](https://github.com/leanprover/lean4/pull/4255) moves some expensive checks from merge queue to releases.
+* [#4265](https://github.com/leanprover/lean4/pull/4265) adds aarch64 macOS as native compilation target for CI.
+* [f05a82](https://github.com/leanprover/lean4/commit/f05a82799a01569edeb5e2594cd7d56282320f9e) restores macOS aarch64 install suffix in CI
+* [#4317](https://github.com/leanprover/lean4/pull/4317) updates build instructions for macOS.
+* [#4333](https://github.com/leanprover/lean4/pull/4333) adjusts workflow to update Batteries in manifest when creating `lean-pr-testing-NNNN` Mathlib branches.
+* [#4355](https://github.com/leanprover/lean4/pull/4355) simplifies `lean4checker` step of release checklist.
+* [#4361](https://github.com/leanprover/lean4/pull/4361) adds installing elan to `pr-release` CI step.
+
+### Breaking changes
+While most changes could be considered to be a breaking change, this section makes special note of API changes.
+
+* `Nat.zero_or` and `Nat.or_zero` have been swapped ([#4094](https://github.com/leanprover/lean4/pull/4094)).
+* `IsLawfulSingleton` is now `LawfulSingleton` ([#4350](https://github.com/leanprover/lean4/pull/4350)).
+* `BitVec.rotateLeft` and `BitVec.rotateRight` now take the shift modulo the bitwidth ([#4229](https://github.com/leanprover/lean4/pull/4229)).
+* These are no longer simp lemmas:
+  `List.length_pos` ([#4172](https://github.com/leanprover/lean4/pull/4172)),
+  `Option.bind_eq_some` ([#4314](https://github.com/leanprover/lean4/pull/4314)).
+* Types in `let` and `have` (both the expressions and tactics) may fail to elaborate due to new restrictions on what sorts of elaboration problems may be postponed ([#4096](https://github.com/leanprover/lean4/pull/4096)).
+  In particular, tactics embedded in the type will no longer make use of the type of `value` in expressions such as `let x : type := value; body`.
+* Now functions defined by well-founded recursion are marked with `@[irreducible]` by default ([#4061](https://github.com/leanprover/lean4/pull/4061)).
+  Existing proofs that hold by definitional equality (e.g. `rfl`) can be
+  rewritten to explictly unfold the function definition (using `simp`,
+  `unfold`, `rw`), or the recursive function can be temporarily made
+  semireducible (using `unseal f in` before the command), or the function
+  definition itself can be marked as `@[semireducible]` to get the previous
+  behavior.
+* Due to [#3929](https://github.com/leanprover/lean4/pull/3929):
+  * The `MessageData.ofPPFormat` constructor has been removed.
+    Its functionality has been split into two:
+
+    - for lazy structured messages, please use `MessageData.lazy`;
+    - for embedding `Format` or `FormatWithInfos`, use `MessageData.ofFormatWithInfos`.
+
+    An example migration can be found in [#3929](https://github.com/leanprover/lean4/pull/3929/files#diff-5910592ab7452a0e1b2616c62d22202d2291a9ebb463145f198685aed6299867L109).
+
+  * The `MessageData.ofFormat` constructor has been turned into a function.
+    If you need to inspect `MessageData`, you can pattern-match on `MessageData.ofFormatWithInfos`.
 
 v4.8.0
 ---------

doc/dev/release_checklist.md

@@ -5,7 +5,8 @@ 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 someone has written the first draft of the release blog post
+- 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".)
 - `git checkout releases/v4.6.0`
   (This branch should already exist, from the release candidates.)
 - `git pull`
@@ -13,13 +14,6 @@ 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)
-- It is possible that the `v4.6.0` section of `RELEASES.md` is out of sync between
-  `releases/v4.6.0` and `master`. This should be reconciled:
-  - Run `git diff master RELEASES.md`.
-  - You should expect to see additons on `master` in the `v4.7.0-rc1` section; ignore these.
-    (i.e. the new release notes for the upcoming release candidate).
-  - Reconcile discrepancies in the `v4.6.0` section,
-    usually via copy and paste and a commit to `releases/v4.6.0`.
 - `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.
@@ -30,8 +24,9 @@ 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".
-  - 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.
+  - 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.
 - 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`
@@ -94,6 +89,10 @@ 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`.
@@ -104,7 +103,6 @@ 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.
@@ -131,29 +129,26 @@ 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` 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 `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 `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.
-- Once the release appears at https://github.com/leanprover/lean4/releases/
+- (GitHub release notes) 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".
-  - 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.
+  - 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.
     - 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`),
@@ -179,6 +174,9 @@ 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.
@@ -189,8 +187,17 @@ 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)`
-  - Removes `(in development)` from the section heading in `RELEASES.md` for `v4.7.0`,
-    and creates a new `v4.8.0 (in development)` section heading.
+  - 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.
 
 ## Time estimates:
 Slightly longer than the corresponding steps for a stable release.
@@ -224,3 +231,18 @@ 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`).

nix/bootstrap.nix

@@ -125,8 +125,10 @@ rec {
       leanshared = runCommand "leanshared" { buildInputs = [ stdenv.cc ]; libName = "libleanshared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
         mkdir $out
         LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared ${lib.optionalString stdenv.isLinux "-Wl,-Bsymbolic"} \
-          ${if stdenv.isDarwin then "-Wl,-force_load,${Init.staticLib}/libInit.a -Wl,-force_load,${Lean.staticLib}/libStd.a -Wl,-force_load,${Lean.staticLib}/libLean.a -Wl,-force_load,${leancpp}/lib/lean/libleancpp.a ${leancpp}/lib/libleanrt_initial-exec.a -lc++"
-            else "-Wl,--whole-archive -lInit -lStd -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++"} -lm ${stdlibLinkFlags} \
+          ${if stdenv.isDarwin
+            then "-Wl,-force_load,${Init.staticLib}/libInit.a -Wl,-force_load,${Std.staticLib}/libStd.a -Wl,-force_load,${Lean.staticLib}/libLean.a -Wl,-force_load,${leancpp}/lib/lean/libleancpp.a ${leancpp}/lib/libleanrt_initial-exec.a -lc++"
+            else "-Wl,--whole-archive -lInit -lStd -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++"} \
+          -lm ${stdlibLinkFlags} \
           $(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
           -o $out/$libName
       '';

nix/buildLeanPackage.nix

@@ -224,7 +224,8 @@ with builtins; let
   allLinkFlags = lib.foldr (shared: acc: acc ++ [ "-L${shared}" "-l${shared.linkName or shared.name}" ]) linkFlags allNativeSharedLibs;
 
   objects   = mapAttrs (_: m: m.obj) mods';
-  staticLib = runCommand "${name}-lib" { buildInputs = [ stdenv.cc.bintools.bintools ]; } ''
+  bintools = if stdenv.isDarwin then darwin.cctools else stdenv.cc.bintools.bintools;
+  staticLib = runCommand "${name}-lib" { buildInputs = [ bintools ]; } ''
     mkdir -p $out
     ar Trcs $out/lib${libName}.a ${lib.concatStringsSep " " (map (drv: "${drv}/${drv.oPath}") (attrValues objects))};
   '';

src/CMakeLists.txt

@@ -9,7 +9,7 @@ endif()
 include(ExternalProject)
 project(LEAN CXX C)
 set(LEAN_VERSION_MAJOR 4)
-set(LEAN_VERSION_MINOR 10)
+set(LEAN_VERSION_MINOR 11)
 set(LEAN_VERSION_PATCH 0)
 set(LEAN_VERSION_IS_RELEASE 0)  # This number is 1 in the release revision, and 0 otherwise.
 set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
@@ -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 -lLean -lleanrt")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lleanrt")
 elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
-  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lnodefs.js -lleanrt")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lnodefs.js -lleanrt")
 else()
-  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
+  string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -lStd -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} -lStd")
+string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
 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}/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}/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")
 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/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")
+  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")
 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
 
-@[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
+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 [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_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_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] [Monad m] : MonadFinally (StateRefT' ω σ m) :=
+instance {m : Type → Type} {ω σ : Type} [MonadFinally m] : MonadFinally (StateRefT' ω σ m) :=
   inferInstanceAs (MonadFinally (ReaderT _ _))

src/Init/Core.lean

@@ -1089,15 +1089,18 @@ def InvImage {α : Sort u} {β : Sort v} (r : β → β → Prop) (f : α → β
   fun a₁ a₂ => r (f a₁) (f a₂)
 
 /--
-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
+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
 `a r b r ... r z` of length at least 1 connecting `a` to `z`.
 -/
-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
+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
   /-- The transitive closure is transitive. -/
-  | trans : ∀ a b c, TC r a b → TC r b c → TC r a c
+  | 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
 
 /-! # Subtype -/
 
@@ -1362,6 +1365,9 @@ 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
 
@@ -1867,7 +1873,7 @@ instance : Subsingleton (Squash α) where
 /--
 `Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
 -/
-class Antisymm {α : Sort u} (r : α → α → Prop) where
+class Antisymm {α : Sort u} (r : α → α → Prop) : 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,3 +35,4 @@ 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

@@ -10,5 +10,7 @@ import Init.Data.Array.BinSearch
 import Init.Data.Array.InsertionSort
 import Init.Data.Array.DecidableEq
 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/Attach.lean

@@ -0,0 +1,29 @@
+/-
+Copyright (c) 2021 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner, Mario Carneiro
+-/
+prelude
+import Init.Data.Array.Mem
+import Init.Data.List.Attach
+
+namespace Array
+
+/--
+Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
+`Array {x // P x}` is the same as the input `Array α`.
+-/
+@[inline] private unsafe def attachWithImpl
+    (xs : Array α) (P : α → Prop) (_ : ∀ x ∈ xs, P x) : Array {x // P x} := unsafeCast xs
+
+/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `xs` to produce a new array
+  with the same elements but in the type `{x // P x}`. -/
+@[implemented_by attachWithImpl] def attachWith
+    (xs : Array α) (P : α → Prop) (H : ∀ x ∈ xs, P x) : Array {x // P x} :=
+  ⟨xs.data.attachWith P fun x h => H x (Array.Mem.mk h)⟩
+
+/-- `O(1)`. "Attach" the proof that the elements of `xs` are in `xs` to produce a new array
+  with the same elements but in the type `{x // x ∈ xs}`. -/
+@[inline] def attach (xs : Array α) : Array {x // x ∈ xs} := xs.attachWith _ fun _ => id
+
+end Array

src/Init/Data/Array/Basic.lean

@@ -60,8 +60,6 @@ def uget (a : @& Array α) (i : USize) (h : i.toNat < a.size) : α :=
 instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
   getElem xs i h := xs.uget i h
 
-instance : LawfulGetElem (Array α) USize α fun xs i => i.toNat < xs.size where
-
 def back [Inhabited α] (a : Array α) : α :=
   a.get! (a.size - 1)
 

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_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
+  · rw [List.drop_of_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_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
+    · rw [List.drop_of_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
   termination_by arr.size - i
   decreasing_by decreasing_trivial_pre_omega
 
@@ -220,7 +220,7 @@ theorem getElem?_len_le (a : Array α) {i : Nat} (h : a.size ≤ i) : a[i]? = no
 theorem getD_get? (a : Array α) (i : Nat) (d : α) :
   Option.getD a[i]? d = if p : i < a.size then a[i]'p else d := by
   if h : i < a.size then
-    simp [setD, h, getElem?]
+    simp [setD, h, getElem?_def]
   else
     have p : i ≥ a.size := Nat.le_of_not_gt h
     simp [setD, getElem?_len_le _ p, h]
@@ -383,18 +383,18 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el
   | Or.inl g =>
     have h1 : i < a.size + 1 := by omega
     have h2 : i ≠ a.size := by omega
-    simp [getElem?, size_push, g, h1, h2, get_push_lt]
+    simp [getElem?_def, size_push, g, h1, h2, get_push_lt]
   | Or.inr (Or.inl heq) =>
     simp [heq, getElem?_pos, get_push_eq]
   | Or.inr (Or.inr g) =>
-    simp only [getElem?, size_push]
+    simp only [getElem?_def, size_push]
     have h1 : ¬ (i < a.size) := by omega
     have h2 : ¬ (i < a.size + 1) := by omega
     have h3 : i ≠ a.size := by omega
     simp [h1, h2, h3]
 
 @[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by
-  simp only [getElem?, Nat.lt_irrefl, dite_false]
+  simp only [getElem?_def, Nat.lt_irrefl, dite_false]
 
 @[simp] theorem data_set (a : Array α) (i v) : (a.set i v).data = a.data.set i.1 v := rfl
 

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)
 
-@[simp] theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
+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/Subarray.lean

@@ -47,8 +47,6 @@ def get (s : Subarray α) (i : Fin s.size) : α :=
 instance : GetElem (Subarray α) Nat α fun xs i => i < xs.size where
   getElem xs i h := xs.get ⟨i, h⟩
 
-instance : LawfulGetElem (Subarray α) Nat α fun xs i => i < xs.size where
-
 @[inline] def getD (s : Subarray α) (i : Nat) (v₀ : α) : α :=
   if h : i < s.size then s.get ⟨i, h⟩ else v₀
 

src/Init/Data/Array/TakeDrop.lean

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

@@ -0,0 +1,60 @@
+/-
+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,6 +159,21 @@ 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) :
@@ -235,4 +250,80 @@ 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]
-@[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]
+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 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,6 +163,13 @@ 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]
@@ -286,6 +293,9 @@ 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'
@@ -319,7 +329,7 @@ theorem zeroExtend'_eq {x : BitVec w} (h : w ≤ v) : x.zeroExtend' h = x.zeroEx
   apply eq_of_toNat_eq
   simp [toNat_zeroExtend]
 
-@[simp] theorem truncate_eq (x : BitVec n) : truncate n x = x := zeroExtend_eq x
+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
@@ -373,7 +383,7 @@ theorem nat_eq_toNat (x : BitVec w) (y : Nat)
   all_goals (first | apply getLsb_ge | apply Eq.symm; apply getLsb_ge)
     <;> omega
 
-@[simp] theorem getLsb_truncate (m : Nat) (x : BitVec n) (i : Nat) :
+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
 
@@ -392,6 +402,12 @@ 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
@@ -404,6 +420,22 @@ 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]
@@ -576,7 +608,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]
 
@@ -589,6 +621,11 @@ 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]
@@ -1043,8 +1080,16 @@ theorem ofInt_add {n} (x y : Int) : BitVec.ofInt n (x + y) =
 
 theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toNat) := by rfl
 
-@[simp, bv_toNat] theorem toNat_sub {n} (x y : BitVec n) :
-  (x - y).toNat = (((2^n - y.toNat) + x.toNat) % 2^n) := rfl
+@[simp] theorem toNat_sub {n} (x y : BitVec n) :
+    (x - y).toNat = (((2^n - y.toNat) + x.toNat) % 2^n) := rfl
+
+-- We prefer this lemma to `toNat_sub` for the `bv_toNat` simp set.
+-- For reasons we don't yet understand, unfolding via `toNat_sub` sometimes
+-- results in `omega` generating proof terms that are very slow in the kernel.
+@[bv_toNat] theorem toNat_sub' {n} (x y : BitVec n) :
+    (x - y).toNat = ((x.toNat + (2^n - y.toNat)) % 2^n) := by
+  rw [toNat_sub, Nat.add_comm]
+
 @[simp] theorem toFin_sub (x y : BitVec n) : (x - y).toFin = toFin x - toFin y := rfl
 
 @[simp] theorem ofFin_sub (x : Fin (2^n)) (y : BitVec n) : .ofFin x - y = .ofFin (x - y.toFin) :=
@@ -1136,6 +1181,18 @@ 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]
@@ -1380,7 +1437,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; omega
+  · simp
   · 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,
@@ -1414,4 +1471,37 @@ 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
-@[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
+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
 
 /-! ### 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
 
-@[simp] theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by decide
+theorem or_eq_true_iff : ∀ (x y : Bool), (x || y) = true ↔ x = true ∨ y = true := by simp
 
 @[simp] theorem or_eq_false_iff : ∀ (x y : Bool), (x || y) = false ↔ x = false ∧ y = false := by decide
 
@@ -187,11 +187,9 @@ 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
@@ -353,7 +351,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
 
@@ -496,6 +494,16 @@ 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/ByteArray/Basic.lean

@@ -52,13 +52,9 @@ def get : (a : @& ByteArray) → (@& Fin a.size) → UInt8
 instance : GetElem ByteArray Nat UInt8 fun xs i => i < xs.size where
   getElem xs i h := xs.get ⟨i, h⟩
 
-instance : LawfulGetElem ByteArray Nat UInt8 fun xs i => i < xs.size where
-
 instance : GetElem ByteArray USize UInt8 fun xs i => i.val < xs.size where
   getElem xs i h := xs.uget i h
 
-instance : LawfulGetElem ByteArray USize UInt8 fun xs i => i.val < xs.size where
-
 @[extern "lean_byte_array_set"]
 def set! : ByteArray → (@& Nat) → UInt8 → ByteArray
   | ⟨bs⟩, i, b => ⟨bs.set! i b⟩
@@ -96,20 +92,24 @@ protected def append (a : ByteArray) (b : ByteArray) : ByteArray :=
 
 instance : Append ByteArray := ⟨ByteArray.append⟩
 
-partial def toList (bs : ByteArray) : List UInt8 :=
+def toList (bs : ByteArray) : List UInt8 :=
   let rec loop (i : Nat) (r : List UInt8) :=
     if i < bs.size then
       loop (i+1) (bs.get! i :: r)
     else
       r.reverse
+    termination_by bs.size - i
+    decreasing_by decreasing_trivial_pre_omega
   loop 0 []
 
-@[inline] partial def findIdx? (a : ByteArray) (p : UInt8 → Bool) (start := 0) : Option Nat :=
+@[inline] def findIdx? (a : ByteArray) (p : UInt8 → Bool) (start := 0) : Option Nat :=
   let rec @[specialize] loop (i : Nat) :=
     if i < a.size then
       if p (a.get! i) then some i else loop (i+1)
     else
       none
+    termination_by a.size - i
+    decreasing_by decreasing_trivial_pre_omega
   loop start
 
 /--

src/Init/Data/Char/Lemmas.lean

@@ -31,11 +31,9 @@ theorem utf8Size_eq (c : Char) : c.utf8Size = 1 ∨ c.utf8Size = 2 ∨ c.utf8Siz
   rw [Char.ofNat, dif_pos]
   rfl
 
-@[ext] theorem Char.ext : {a b : Char} → a.val = b.val → a = b
+@[ext] protected theorem 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

@@ -0,0 +1,15 @@
+/-
+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,9 +37,7 @@ 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] 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
+@[ext] protected theorem ext {a b : Fin n} (h : (a : Nat) = b) : a = b := eq_of_val_eq h
 
 theorem val_ne_iff {a b : Fin n} : a.1 ≠ b.1 ↔ a ≠ b := not_congr val_inj
 
@@ -47,12 +45,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 := ext_iff
+    (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := Fin.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 := ext_iff
+    a = ⟨k, hk⟩ ↔ (a : Nat) = k := Fin.ext_iff
 
 theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
 
@@ -145,7 +143,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 := ext <| by
+@[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := Fin.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
@@ -171,12 +169,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 :=
-  ext <| Nat.le_antisymm (le_last i) (Nat.not_lt.1 h)
+  Fin.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 := ext <| by simp
+@[simp] theorem rev_last (n : Nat) : rev (last n) = 0 := Fin.ext <| by simp
 
 @[simp] theorem rev_zero (n : Nat) : rev 0 = last n := by
   rw [← rev_rev (last _), rev_last]
@@ -244,11 +242,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 => ext ?_, congrArg _⟩
+  refine ⟨fun h => Fin.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 <| ext_iff.1 heq
+  | ⟨k, _⟩, heq => Nat.succ_ne_zero k <| congrArg Fin.val heq
 
 @[simp] theorem succ_zero_eq_one : Fin.succ (0 : Fin (n + 1)) = 1 := rfl
 
@@ -267,7 +265,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, ext_iff]
+  simp only [lt_def, val_add, val_last, Fin.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]
@@ -285,7 +283,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 [ext_iff, Nat.le_antisymm_iff, le_def, and_iff_right (by apply le_last)]
+  rw [Fin.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
@@ -306,10 +304,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 [ext_iff]
+@[simp] theorem castLE_zero {n m : Nat} (h : n.succ ≤ m.succ) : castLE h 0 = 0 := by simp [Fin.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 [ext_iff]
+    castLE h i.succ = (castLE (Nat.succ_le_succ_iff.mp h) i).succ := by simp [Fin.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 :=
@@ -322,7 +320,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' :=
-  ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h])
+  Fin.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
 
@@ -348,7 +346,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) := ext rfl
+    castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := Fin.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
@@ -397,7 +395,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 [ext_iff]
+theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b ↔ a = b := by simp [Fin.ext_iff]
 
 theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt
 
@@ -409,7 +407,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 [ext_iff]
+@[simp] theorem castSucc_eq_zero_iff (a : Fin (n + 1)) : castSucc a = 0 ↔ a = 0 := by simp [Fin.ext_iff]
 
 theorem castSucc_ne_zero_iff (a : Fin (n + 1)) : castSucc a ≠ 0 ↔ a ≠ 0 :=
   not_congr <| castSucc_eq_zero_iff a
@@ -421,7 +419,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 [ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)]
+  · simp [Fin.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
@@ -454,7 +452,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 :=
-  ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _)
+  Fin.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
 
@@ -474,7 +472,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 :=
-  ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _)
+  Fin.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
@@ -484,27 +482,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) :=
-  ext <| (Nat.add_assoc ..).symm
+  Fin.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 :=
-  ext <| Nat.zero_add _
+  Fin.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 := ext <| Nat.add_comm ..
+    cast (Nat.add_comm ..) (natAdd n i) = addNat i n := Fin.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 := ext <| Nat.add_comm ..
+    cast (Nat.add_comm ..) (addNat i m) = natAdd m i := Fin.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 := ext <| by
+theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := Fin.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
@@ -534,7 +532,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 [ext_iff, coe_pred, Nat.add_sub_cancel]
+  simp only [Fin.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 _
@@ -554,14 +552,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 [ext_iff, Nat.succ.injEq]
+  | ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, ha, hb => by simp [Fin.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 [ext_iff, coe_pred, coe_castLT, val_add, val_one, Nat.mod_eq_of_lt, Nat.add_sub_cancel]
+  rw [Fin.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
@@ -573,10 +571,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 :=
-  ext <| Nat.sub_add_cancel h
+  Fin.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 := ext <| Nat.add_sub_cancel i m
+    subNat m (addNat i m) h = i := Fin.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
@@ -786,6 +784,9 @@ 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
@@ -807,10 +808,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 [ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
+  | n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
 
 protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
-  ext <| by rw [mul_def, mul_def, Nat.mul_comm]
+  Fin.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
@@ -826,9 +827,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 [ext_iff, mul_def]
+protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [Fin.ext_iff, mul_def]
 
 protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by
-  simp [ext_iff, mul_def]
+  simp [Fin.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 _ := Float.toString n
+  reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else 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/FloatArray/Basic.lean

@@ -58,13 +58,9 @@ def get? (ds : FloatArray) (i : Nat) : Option Float :=
 instance : GetElem FloatArray Nat Float fun xs i => i < xs.size where
   getElem xs i h := xs.get ⟨i, h⟩
 
-instance : LawfulGetElem FloatArray Nat Float fun xs i => i < xs.size where
-
 instance : GetElem FloatArray USize Float fun xs i => i.val < xs.size where
   getElem xs i h := xs.uget i h
 
-instance : LawfulGetElem FloatArray USize Float fun xs i => i.val < xs.size where
-
 @[extern "lean_float_array_uset"]
 def uset : (a : FloatArray) → (i : USize) → Float → i.toNat < a.size → FloatArray
   | ⟨ds⟩, i, v, h => ⟨ds.uset i v h⟩

src/Init/Data/Hashable.lean

@@ -62,3 +62,16 @@ 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.lean

@@ -8,6 +8,7 @@ import Init.Data.List.Basic
 import Init.Data.List.BasicAux
 import Init.Data.List.Control
 import Init.Data.List.Lemmas
+import Init.Data.List.Attach
 import Init.Data.List.Impl
 import Init.Data.List.TakeDrop
 import Init.Data.List.Notation

src/Init/Data/List/Attach.lean

@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2023 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+prelude
+import Init.Data.List.Lemmas
+
+namespace List
+
+/-- `O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on
+  `a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l`
+  but is defined only when all members of `l` satisfy `P`, using the proof
+  to apply `f`. -/
+@[simp] def pmap {P : α → Prop} (f : ∀ a, P a → β) : ∀ l : List α, (H : ∀ a ∈ l, P a) → List β
+  | [], _ => []
+  | a :: l, H => f a (forall_mem_cons.1 H).1 :: pmap f l (forall_mem_cons.1 H).2
+
+/--
+Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
+`List {x // P x}` is the same as the input `List α`.
+(Someday, the compiler might do this optimization automatically, but until then...)
+-/
+@[inline] private unsafe def attachWithImpl
+    (l : List α) (P : α → Prop) (_ : ∀ x ∈ l, P x) : List {x // P x} := unsafeCast l
+
+/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `l` to produce a new list
+  with the same elements but in the type `{x // P x}`. -/
+@[implemented_by attachWithImpl] def attachWith
+    (l : List α) (P : α → Prop) (H : ∀ x ∈ l, P x) : List {x // P x} := pmap Subtype.mk l H
+
+/-- `O(1)`. "Attach" the proof that the elements of `l` are in `l` to produce a new list
+  with the same elements but in the type `{x // x ∈ l}`. -/
+@[inline] def attach (l : List α) : List {x // x ∈ l} := attachWith l _ fun _ => id
+
+/-- Implementation of `pmap` using the zero-copy version of `attach`. -/
+@[inline] private def pmapImpl {P : α → Prop} (f : ∀ a, P a → β) (l : List α) (H : ∀ a ∈ l, P a) :
+    List β := (l.attachWith _ H).map fun ⟨x, h'⟩ => f x h'
+
+@[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by
+  funext α β p f L h'
+  let rec go : ∀ L' (hL' : ∀ ⦃x⦄, x ∈ L' → p x),
+      pmap f L' hL' = map (fun ⟨x, hx⟩ => f x hx) (pmap Subtype.mk L' hL')
+  | nil, hL' => rfl
+  | cons _ L', hL' => congrArg _ <| go L' fun _ hx => hL' (.tail _ hx)
+  exact go L h'

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`, `fold`, and `concat` have already been defined in `Init.Prelude`.
+Recall that `length`, `get`, `set`, `foldl`, 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?`, `rotateLeft` and `rotateRight`.
-* Manipulating elements: `replace`, `insert`, `erase`, `eraseIdx`, `find?`, `findSome?`, and `lookup`.
+  `isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `Subset`, `Sublist`, `rotateLeft` and `rotateRight`.
+* Manipulating elements: `replace`, `insert`, `erase`, `eraseP`, `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] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
+@[simp high] 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,6 +817,8 @@ 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
@@ -864,6 +866,40 @@ 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 -/
 
 /--
@@ -906,6 +942,55 @@ 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 -/
@@ -951,6 +1036,11 @@ 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,6 +295,24 @@ 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,6 +120,43 @@ 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
@@ -245,6 +282,31 @@ 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
@@ -272,6 +334,15 @@ 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
@@ -374,6 +445,29 @@ 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.
@@ -384,4 +478,27 @@ 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,6 +100,7 @@ def blt (a b : Nat) : Bool :=
   ble a.succ b
 
 attribute [simp] Nat.zero_le
+attribute [simp] Nat.not_lt_zero
 
 /-! # Helper "packing" theorems -/
 
@@ -124,13 +125,8 @@ instance : LawfulBEq Nat where
   eq_of_beq h := Nat.eq_of_beq_eq_true h
   rfl := by simp [BEq.beq]
 
-@[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])
+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
 
 /-! # Nat.add theorems -/
 
@@ -355,7 +351,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)
 
-@[simp] theorem lt_succ_self (n : Nat) : n < succ n := lt.base n
+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
 
@@ -638,6 +634,10 @@ 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,8 +705,7 @@ protected theorem one_ne_zero : 1 ≠ (0 : Nat) :=
 protected theorem zero_ne_one : 0 ≠ (1 : Nat) :=
   fun h => Nat.noConfusion h
 
-@[simp] theorem succ_ne_zero (n : Nat) : succ n ≠ 0 :=
-  fun h => Nat.noConfusion h
+theorem succ_ne_zero (n : Nat) : succ n ≠ 0 := by simp
 
 /-! # mul + order -/
 
@@ -814,8 +813,14 @@ theorem sub_one_lt_of_lt {n m : Nat} (h : m < n) : n - 1 < n :=
 
 /-! # pred theorems -/
 
-@[simp] protected theorem pred_zero : pred 0 = 0 := rfl
-@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n := rfl
+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]
 
 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]
 
-@[simp] theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
+theorem testBit_succ (x i : Nat) : testBit x (succ i) = testBit (x/2) i := by
   unfold testBit
   simp [shiftRight_succ_inside]
 
@@ -504,3 +504,27 @@ 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,8 +115,6 @@ 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,6 +19,7 @@ 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`. -/
@@ -26,7 +27,7 @@ def toMonad [Monad m] [Alternative m] : Option α → m α := getM
   | some _ => true
   | none   => false
 
-@[deprecated isSome, inline] def toBool : Option α → Bool := isSome
+@[deprecated isSome (since := "2024-04-17"), inline] def toBool : Option α → Bool := isSome
 
 /-- Returns `true` on `none` and `false` on `some x`. -/
 @[inline] def isNone : Option α → Bool
@@ -80,7 +81,9 @@ theorem map_id : (Option.map id : Option α → Option α) = id :=
   | none   => false
 
 /--
-Implementation of `OrElse`'s `<|>` syntax for `Option`.
+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.
 -/
 @[always_inline, macro_inline] protected def orElse : Option α → (Unit → Option α) → Option α
   | some a, _ => some a
@@ -89,6 +92,12 @@ Implementation of `OrElse`'s `<|>` syntax for `Option`.
 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,6 +4,7 @@ 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
@@ -41,6 +42,21 @@ 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
 
@@ -66,7 +82,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; nofun
+  cases o <;> simp
 
 theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h)
   | some _, _ => rfl
@@ -145,6 +161,12 @@ 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
@@ -168,6 +190,9 @@ 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
 
@@ -236,3 +261,46 @@ 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 _ := i.repr
+  reprPrec i prec := if i < 0 then Repr.addAppParen i.repr prec else i.repr
 
 def hexDigitRepr (n : Nat) : String :=
   String.singleton <| Nat.digitChar n

src/Init/Data/UInt.lean

@@ -7,3 +7,4 @@ 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

@@ -0,0 +1,24 @@
+/-
+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,6 +26,8 @@ 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
@@ -48,6 +50,7 @@ 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
@@ -55,6 +58,8 @@ 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,58 +10,38 @@ 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" ")")
+
+/--
+The flag `(flat := false)` causes `ext` to not flatten parents' fields when generating an `ext` lemma.
+-/
+syntax extFlat := atomic("(" &"flat" " := " &"false" ")")
+
+/--
+Registers an extensionality theorem.
 
 * When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers
   them for the `ext` tactic.
 
-* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic.
+* 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.
 
 * 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 (iff := false)]` prevents it from generating an `ext_iff` theorem.
+
 * 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.
-  structures in the generated extensionality theorems. -/
-syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr
+-/
+syntax (name := ext) "ext" (ppSpace extIff)? (ppSpace extFlat)? (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.
@@ -96,19 +76,8 @@ 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

@@ -7,22 +7,57 @@ prelude
 import Init.Util
 
 @[never_extract]
-private def outOfBounds [Inhabited α] : α :=
+def outOfBounds [Inhabited α] : α :=
   panic! "index out of bounds"
 
-/--
-The class `GetElem coll idx elem valid` implements the `xs[i]` notation.
-Given `xs[i]` with `xs : coll` and `i : idx`, Lean looks for an instance of
-`GetElem coll idx elem valid` and uses this to infer the type of return
-value `elem` and side conditions `valid` required to ensure `xs[i]` yields
-a valid value of type `elem`.
+theorem outOfBounds_eq_default [Inhabited α] : (outOfBounds : α) = default := rfl
+
+/--
+The classes `GetElem` and `GetElem?` implement lookup notation,
+specifically `xs[i]`, `xs[i]?`, `xs[i]!`, and `xs[i]'p`.
+
+Both classes are indexed by types `coll`, `idx`, and `elem` which are
+the collection, the index, and the element types.
+A single collection may support lookups with multiple index
+types. The relation `valid` determines when the index is guaranteed to be
+valid; lookups of valid indices are guaranteed not to fail.
+
+For example, an instance for arrays looks like
+`GetElem (Array α) Nat α (fun xs i => i < xs.size)`. In other words, given an
+array `xs` and a natural number `i`, `xs[i]` will return an `α` when `valid xs i`
+holds, which is true when `i` is less than the size of the array. `Array`
+additionally supports indexing with `USize` instead of `Nat`.
+In either case, because the bounds are checked at compile time,
+no runtime check is required.
+
+Given `xs[i]` with `xs : coll` and `i : idx`, Lean looks for an instance of
+`GetElem coll idx elem valid` and uses this to infer the type of the return
+value `elem` and side condition `valid` required to ensure `xs[i]` yields
+a valid value of type `elem`. The tactic `get_elem_tactic` is
+invoked to prove validity automatically. The `xs[i]'p` notation uses the
+proof `p` to satisfy the validity condition.
+If the proof `p` is long, it is often easier to place the
+proof in the context using `have`, because `get_elem_tactic` tries
+`assumption`.
 
-For example, the instance for arrays looks like
-`GetElem (Array α) Nat α (fun xs i => i < xs.size)`.
 
 The proof side-condition `valid xs i` is automatically dispatched by the
-`get_elem_tactic` tactic, which can be extended by adding more clauses to
-`get_elem_tactic_trivial`.
+`get_elem_tactic` tactic; this tactic can be extended by adding more clauses to
+`get_elem_tactic_trivial` using `macro_rules`.
+
+`xs[i]?` and `xs[i]!` do not impose a proof obligation; the former returns
+an `Option elem`, with `none` signalling that the value isn't present, and
+the latter returns `elem` but panics if the value isn't there, returning
+`default : elem` based on the `Inhabited elem` instance.
+These are provided by the `GetElem?` class, for which there is a default instance
+generated from a `GetElem` class as long as `valid xs i` is always decidable.
+
+Important instances include:
+  * `arr[i] : α` where `arr : Array α` and `i : Nat` or `i : USize`: does array
+    indexing with no runtime bounds check and a proof side goal `i < arr.size`.
+  * `l[i] : α` where `l : List α` and `i : Nat`: index into a list, with proof
+    side goal `i < l.length`.
+
 -/
 class GetElem (coll : Type u) (idx : Type v) (elem : outParam (Type w))
               (valid : outParam (coll → idx → Prop)) where
@@ -30,33 +65,10 @@ class GetElem (coll : Type u) (idx : Type v) (elem : outParam (Type w))
   The syntax `arr[i]` gets the `i`'th element of the collection `arr`. If there
   are proof side conditions to the application, they will be automatically
   inferred by the `get_elem_tactic` tactic.
-
-  The actual behavior of this class is type-dependent, but here are some
-  important implementations:
-  * `arr[i] : α` where `arr : Array α` and `i : Nat` or `i : USize`: does array
-    indexing with no bounds check and a proof side goal `i < arr.size`.
-  * `l[i] : α` where `l : List α` and `i : Nat`: index into a list, with proof
-    side goal `i < l.length`.
-  * `stx[i] : Syntax` where `stx : Syntax` and `i : Nat`: get a syntax argument,
-    no side goal (returns `.missing` out of range)
-
-  There are other variations on this syntax:
-  * `arr[i]!` is syntax for `getElem! arr i` which should panic and return
-    `default : α` if the index is not valid.
-  * `arr[i]?` is syntax for `getElem?` which should return `none` if the index
-    is not valid.
-  * `arr[i]'h` is syntax for `getElem arr i h` with `h` an explicit proof the
-    index is valid.
   -/
   getElem (xs : coll) (i : idx) (h : valid xs i) : elem
 
-  getElem? (xs : coll) (i : idx) [Decidable (valid xs i)] : Option elem :=
-    if h : _ then some (getElem xs i h) else none
-
-  getElem! [Inhabited elem] (xs : coll) (i : idx) [Decidable (valid xs i)] : elem :=
-    match getElem? xs i with | some e => e | none => outOfBounds
-
-export GetElem (getElem getElem! getElem?)
+export GetElem (getElem)
 
 @[inherit_doc getElem]
 syntax:max term noWs "[" withoutPosition(term) "]" : term
@@ -66,6 +78,30 @@ macro_rules | `($x[$i]) => `(getElem $x $i (by get_elem_tactic))
 syntax term noWs "[" withoutPosition(term) "]'" term:max : term
 macro_rules | `($x[$i]'$h) => `(getElem $x $i $h)
 
+/-- Helper function for implementation of `GetElem?.getElem?`. -/
+abbrev decidableGetElem? [GetElem coll idx elem valid] (xs : coll) (i : idx) [Decidable (valid xs i)] :
+    Option elem :=
+  if h : valid xs i then some xs[i] else none
+
+@[inherit_doc GetElem]
+class GetElem? (coll : Type u) (idx : Type v) (elem : outParam (Type w))
+    (valid : outParam (coll → idx → Prop)) extends GetElem coll idx elem valid where
+  /--
+  The syntax `arr[i]?` gets the `i`'th element of the collection `arr`,
+  if it is present (and wraps it in `some`), and otherwise returns `none`.
+  -/
+  getElem? : coll → idx → Option elem
+
+  /--
+  The syntax `arr[i]!` gets the `i`'th element of the collection `arr`,
+  if it is present, and otherwise panics at runtime and returns the `default` term
+  from `Inhabited elem`.
+  -/
+  getElem! [Inhabited elem] (xs : coll) (i : idx) : elem :=
+    match getElem? xs i with | some e => e | none => outOfBounds
+
+export GetElem? (getElem? getElem!)
+
 /--
 The syntax `arr[i]?` gets the `i`'th element of the collection `arr` or
 returns `none` if `i` is out of bounds.
@@ -78,32 +114,51 @@ panics `i` is out of bounds.
 -/
 macro:max x:term noWs "[" i:term "]" noWs "!" : term => `(getElem! $x $i)
 
+instance (priority := low) [GetElem coll idx elem valid] [∀ xs i, Decidable (valid xs i)] :
+    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
+   (dom : outParam (cont → idx → Prop)) [ge : GetElem? cont idx elem dom] : Prop where
 
   getElem?_def (c : cont) (i : idx) [Decidable (dom c i)] :
-    c[i]? = if h : dom c i then some (c[i]'h) else none := by intros; eq_refl
-  getElem!_def [Inhabited elem] (c : cont) (i : idx) [Decidable (dom c i)] :
-    c[i]! = match c[i]? with | some e => e | none => default := by intros; eq_refl
+      c[i]? = if h : dom c i then some (c[i]'h) else none := by
+    intros
+    try simp only [getElem?] <;> congr
+  getElem!_def [Inhabited elem] (c : cont) (i : idx) :
+      c[i]! = match c[i]? with | some e => e | none => default := by
+    intros
+    simp only [getElem!, getElem?, outOfBounds_eq_default]
 
 export LawfulGetElem (getElem?_def getElem!_def)
 
-theorem getElem?_pos [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
+instance (priority := low) [GetElem coll idx elem valid] [∀ xs i, Decidable (valid xs i)] :
+    LawfulGetElem coll idx elem valid where
+
+theorem getElem?_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     (c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] : c[i]? = some (c[i]'h) := by
   rw [getElem?_def]
   exact dif_pos h
 
-theorem getElem?_neg [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
+theorem getElem?_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     (c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]? = none := by
   rw [getElem?_def]
   exact dif_neg h
 
-theorem getElem!_pos [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
+theorem getElem!_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     [Inhabited elem] (c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] :
     c[i]! = c[i]'h := by
   simp only [getElem!_def, getElem?_def, h]
 
-theorem getElem!_neg [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
+theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
     [Inhabited elem] (c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]! = default := by
   simp only [getElem!_def, getElem?_def, h]
 
@@ -111,23 +166,22 @@ namespace Fin
 
 instance instGetElemFinVal [GetElem cont Nat elem dom] : GetElem cont (Fin n) elem fun xs i => dom xs i where
   getElem xs i h := getElem xs i.1 h
+
+instance instGetElem?FinVal [GetElem? cont Nat elem dom] : GetElem? cont (Fin n) elem fun xs i => dom xs i where
   getElem? xs i := getElem? xs i.val
   getElem! xs i := getElem! xs i.val
 
-instance [GetElem cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
+instance [GetElem? cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
       LawfulGetElem cont (Fin n) elem fun xs i => dom xs i where
-
   getElem?_def _c _i _d := h.getElem?_def ..
-  getElem!_def _c _i _d := h.getElem!_def ..
+  getElem!_def _c _i := h.getElem!_def ..
 
-@[simp] theorem getElem_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
+@[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)
-    [Decidable (Dom a i)] : a[i]? = a[i.1]? := by 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 [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n)
-    [Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl
+@[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [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)
@@ -139,17 +193,15 @@ namespace List
 instance : GetElem (List α) Nat α fun as i => i < as.length where
   getElem as i h := as.get ⟨i, h⟩
 
-instance : LawfulGetElem (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-6-12")] abbrev cons_getElem_zero := @getElem_cons_zero
+@[deprecated (since := "2024-06-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-6-12")] abbrev cons_getElem_succ := @getElem_cons_succ
+@[deprecated (since := "2024-06-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
@@ -163,8 +215,6 @@ namespace Array
 instance : GetElem (Array α) Nat α fun xs i => i < xs.size where
   getElem xs i h := xs.get ⟨i, h⟩
 
-instance : LawfulGetElem (Array α) Nat α fun xs i => i < xs.size where
-
 end Array
 
 namespace Lean.Syntax
@@ -172,6 +222,4 @@ namespace Lean.Syntax
 instance : GetElem Syntax Nat Syntax fun _ _ => True where
   getElem stx i _ := stx.getArg i
 
-instance : LawfulGetElem Syntax Nat Syntax fun _ _ => True where
-
 end Lean.Syntax

src/Init/MetaTypes.lean

@@ -218,6 +218,14 @@ structure Config where
   to find candidate `simp` theorems. It approximates Lean 3 `simp` behavior.
   -/
   index             : Bool := true
+  /--
+  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 := false
   deriving Inhabited, BEq
 
 -- Configuration object for `simp_all`

src/Init/Notation.lean

@@ -267,6 +267,7 @@ 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
@@ -703,6 +704,28 @@ 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,6 +38,10 @@ 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 `withReader`, but with `ρ` explicit. This is useful if a monad supports
-`MonadWithReaderOf` for multiple different types `ρ`.
+Like `get`, but with `σ` explicit. This is useful if a monad supports
+`MonadStateOf` for multiple different types `σ`.
 -/
 abbrev getThe (σ : Type u) {m : Type u → Type v} [MonadStateOf σ m] : m σ :=
   MonadStateOf.get

src/Init/PropLemmas.lean

@@ -253,6 +253,9 @@ 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⟩⟩
 
@@ -292,6 +295,8 @@ 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]
 
@@ -368,9 +373,6 @@ 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,3 +102,11 @@ 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,6 +129,7 @@ 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
@@ -228,25 +229,22 @@ 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 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 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_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
-  cases h <;> (rename_i hp; simp [decide, hp])
+@[simp] theorem not_decide_eq_true [h : Decidable p] : ((!decide p) = true) = ¬ p := by simp
 
 @[simp] theorem heq_eq_eq (a b : α) : HEq a b = (a = b) := propext <| Iff.intro eq_of_heq heq_of_eq
 
@@ -254,10 +252,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
-@[simp] theorem beq_self_eq_true' [DecidableEq α] (a : α) : (a == a) = true := by simp [BEq.beq]
+theorem beq_self_eq_true' [DecidableEq α] (a : α) : (a == a) = true := by simp
 
 @[simp] theorem bne_self_eq_false [BEq α] [LawfulBEq α] (a : α) : (a != a) = false := by simp [bne]
-@[simp] theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp [bne]
+theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp
 
 @[simp] theorem decide_False : decide False = false := rfl
 @[simp] theorem decide_True  : decide True  = true := rfl
@@ -283,7 +281,10 @@ 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
 
-/-# Nat -/
+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 -/
 
 @[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,8 +712,17 @@ 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
@@ -814,6 +823,10 @@ 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,6 +45,13 @@ 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,22 +148,26 @@ end InvImage
   wf  := InvImage.wf f h.wf
 
 -- The transitive closure of a well-founded relation is well-founded
-namespace TC
-variable {α : Sort u} {r : α → α → Prop}
+open Relation
 
-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 (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 wf (h : WellFounded r) : WellFounded (TC r) :=
-  ⟨fun a => accessible (apply h a)⟩
-end TC
+theorem acc_transGen_iff : Acc (TransGen r) a ↔ Acc r a :=
+  ⟨Subrelation.accessible TransGen.single, Acc.transGen⟩
 
+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
@@ -288,7 +292,7 @@ instance [ha : WellFoundedRelation α] [hb : WellFoundedRelation β] : WellFound
   lex ha hb
 
 -- relational product is a Subrelation of the Lex
-def RProdSubLex (a : α × β) (b : α × β) (h : RProd ra rb a b) : Prod.Lex ra rb a b := by
+theorem 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₁
 
@@ -320,7 +324,7 @@ section
 variable {α : Sort u} {β : α → Sort v}
 variable {r  : α → α → Prop} {s : ∀ (a : α), β a → β a → Prop}
 
-def lexAccessible {a} (aca : Acc r a) (acb : (a : α) → WellFounded (s a)) (b : β a) : Acc (Lex r s) ⟨a, b⟩ := by
+theorem 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

@@ -8,11 +8,22 @@ import Lean.CoreM
 
 namespace Lean
 
-def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment :=
-  addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl
+register_builtin_option debug.skipKernelTC : Bool := {
+  defValue := false
+  group    := "debug"
+  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.addAndCompile (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment := do
-  let env ← addDecl env opts decl
+def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
+    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment :=
+  if debug.skipKernelTC.get opts then
+    addDeclWithoutChecking env decl
+  else
+    addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
+
+def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
+    (cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
+  let env ← addDecl env opts decl cancelTk?
   compileDecl env opts decl
 
 def addDecl (decl : Declaration) : CoreM Unit := do
@@ -20,7 +31,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 with
+      match (← getEnv).addDecl (← getOptions) decl (← read).cancelTk? with
       | .ok    env => setEnv env
       | .error ex  => throwKernelException ex
 

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.Compiler.LCNF).isPrefixOf n && !(`Lean.IR).isPrefixOf n && !(`Lean.Server).isPrefixOf n
 
 def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M Unit := do
   let ps := decl.params

src/Lean/Compiler/LCNF/Main.lean

@@ -5,6 +5,7 @@ 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
+import Lean.PrettyPrinter.Delaborator.Options
 import Lean.Compiler.LCNF.CompilerM
 import Lean.Compiler.LCNF.Internalize
 

src/Lean/CoreM.lean

@@ -211,12 +211,12 @@ instance : MonadTrace CoreM where
 
 structure SavedState extends State where
   /-- Number of heartbeats passed inside `withRestoreOrSaveFull`, not used otherwise. -/
-  passedHearbeats : Nat
+  passedHeartbeats : Nat
 deriving Nonempty
 
 def saveState : CoreM SavedState := do
   let s ← get
-  return { toState := s, passedHearbeats := 0 }
+  return { toState := s, passedHeartbeats := 0 }
 
 /--
 Incremental reuse primitive: if `reusableResult?` is `none`, runs `act` and returns its result
@@ -236,14 +236,14 @@ itself after calling `act` as well as by reuse-handling code such as the one sup
     (act : CoreM α) : CoreM (α × SavedState) := do
   if let some (val, state) := reusableResult? then
     set state.toState
-    IO.addHeartbeats state.passedHearbeats.toUInt64
+    IO.addHeartbeats state.passedHeartbeats.toUInt64
     return (val, state)
 
   let startHeartbeats ← IO.getNumHeartbeats
   let a ← act
   let s ← get
   let stopHeartbeats ← IO.getNumHeartbeats
-  return (a, { toState := s, passedHearbeats := stopHeartbeats - startHeartbeats })
+  return (a, { toState := s, passedHeartbeats := stopHeartbeats - startHeartbeats })
 
 /-- Restore backtrackable parts of the state. -/
 def SavedState.restore (b : SavedState) : CoreM Unit :=
@@ -472,23 +472,30 @@ def Exception.isInterrupt : Exception → Bool
 
 /--
 Custom `try-catch` for all monads based on `CoreM`. We usually don't want to catch "runtime
-exceptions" these monads, but on `CommandElabM`. See issues #2775 and #2744 as well as
-`MonadAlwaysExcept`. Also, we never want to catch interrupt exceptions inside the elaborator.
+exceptions" these monads, but on `CommandElabM` or, in specific cases, using `tryCatchRuntimeEx`.
+See issues #2775 and #2744 as well as `MonadAlwaysExcept`. Also, we never want to catch interrupt
+exceptions inside the elaborator.
 -/
 @[inline] protected def Core.tryCatch (x : CoreM α) (h : Exception → CoreM α) : CoreM α := do
   try
     x
   catch ex =>
     if ex.isInterrupt || ex.isRuntime then
-
-      throw ex -- We should use `tryCatchRuntimeEx` for catching runtime exceptions
+      throw ex
     else
       h ex
 
+/--
+A variant of `tryCatch` that also catches runtime exception (see also `tryCatch` documentation).
+Like `tryCatch`, this function does not catch interrupt exceptions, which are not considered runtime
+exceptions.
+-/
 @[inline] protected def Core.tryCatchRuntimeEx (x : CoreM α) (h : Exception → CoreM α) : CoreM α := do
   try
     x
   catch ex =>
+    if ex.isInterrupt then
+      throw ex
     h ex
 
 instance : MonadExceptOf Exception CoreM where
@@ -512,4 +519,16 @@ instance : MonadRuntimeException CoreM where
 @[inline] def mapCoreM [MonadControlT CoreM m] [Monad m] (f : forall {α}, CoreM α → CoreM α) {α} (x : m α) : m α :=
   controlAt CoreM fun runInBase => f <| runInBase x
 
+/--
+Returns `true` if the given message kind has not been reported in the message log,
+and then mark it as reported. Otherwise, returns `false`.
+We use this API to ensure we don't report the same kind of warning multiple times.
+-/
+def reportMessageKind (kind : Name) : CoreM Bool := do
+  if (← get).messages.reportedKinds.contains kind then
+    return false
+  else
+    modify fun s => { s with messages.reportedKinds := s.messages.reportedKinds.insert kind }
+    return true
+
 end Lean

src/Lean/Data/HashMap.lean

@@ -223,8 +223,6 @@ def insertIfNew (m : HashMap α β) (a : α) (b : β) : HashMap α β × Option
 instance : GetElem (HashMap α β) α (Option β) fun _ _ => True where
   getElem m k _ := m.find? k
 
-instance : LawfulGetElem (HashMap α β) α (Option β) fun _ _ => True where
-
 @[inline] def contains (m : HashMap α β) (a : α) : Bool :=
   match m with
   | ⟨ m, _ ⟩ => m.contains a

src/Lean/Data/PersistentArray.lean

@@ -72,8 +72,6 @@ def get! [Inhabited α] (t : PersistentArray α) (i : Nat) : α :=
 instance [Inhabited α] : GetElem (PersistentArray α) Nat α fun as i => i < as.size where
   getElem xs i _ := xs.get! i
 
-instance [Inhabited α] : LawfulGetElem (PersistentArray α) Nat α fun as i => i < as.size where
-
 partial def setAux : PersistentArrayNode α → USize → USize → α → PersistentArrayNode α
   | node cs, i, shift, a =>
     let j     := div2Shift i shift

src/Lean/Data/PersistentHashMap.lean

@@ -161,8 +161,6 @@ def find? {_ : BEq α} {_ : Hashable α} : PersistentHashMap α β → α → Op
 instance {_ : BEq α} {_ : Hashable α} : GetElem (PersistentHashMap α β) α (Option β) fun _ _ => True where
   getElem m i _ := m.find? i
 
-instance {_ : BEq α} {_ : Hashable α} : LawfulGetElem (PersistentHashMap α β) α (Option β) fun _ _ => True where
-
 @[inline] def findD {_ : BEq α} {_ : Hashable α} (m : PersistentHashMap α β) (a : α) (b₀ : β) : β :=
   (m.find? a).getD b₀
 

src/Lean/Data/RBMap.lean

@@ -80,6 +80,10 @@ 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
@@ -269,6 +273,9 @@ 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,6 +87,11 @@ 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,6 +239,10 @@ 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. -/
@@ -257,14 +261,12 @@ 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) (isRec isUnsafe isReflexive isNested : Bool) : InductiveVal := {
+    (all ctors : List Name) (numNested : Nat) (isRec isUnsafe isReflexive : Bool) : InductiveVal := {
   name := name
   levelParams := levelParams
   type := type
@@ -272,18 +274,19 @@ 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

@@ -1292,6 +1292,7 @@ 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
@@ -1424,8 +1425,27 @@ private def getSuccesses (candidates : Array (TermElabResult Expr)) : TermElabM
           return false
       return true
     | _ => return false
-  if r₂.size == 0 then return r₁ else return r₂
-
+  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₂
 /--
   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.WF.TerminationHint
+import Lean.Elab.PreDefinition.TerminationHint
 
 namespace Lean.Elab.Term
 open Meta

src/Lean/Elab/BuiltinCommand.lean

@@ -11,7 +11,6 @@ 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 auot params
+  let stxNew ← `(@sorryAx _ false) -- Remark: we use `@` to ensure `sorryAx` will not consume auto 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,6 +220,31 @@ 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

@@ -157,9 +157,19 @@ private def mkTacticMVar (type : Expr) (tacticCode : Syntax) : TermElabM Expr :=
   registerSyntheticMVar ref mvarId <| SyntheticMVarKind.tactic tacticCode (← saveContext)
   return mvar
 
+register_builtin_option debug.byAsSorry : Bool := {
+  defValue := false
+  group    := "debug"
+  descr    := "replace `by ..` blocks with `sorry` IF the expected type is a proposition"
+}
+
 @[builtin_term_elab byTactic] def elabByTactic : TermElab := fun stx expectedType? => do
   match expectedType? with
-  | some expectedType => mkTacticMVar expectedType stx
+  | some expectedType =>
+    if ← pure (debug.byAsSorry.get (← getOptions)) <&&> isProp expectedType then
+      mkSorry expectedType false
+    else
+      mkTacticMVar expectedType stx
   | none =>
     tryPostpone
     throwError ("invalid 'by' tactic, expected type has not been provided")
@@ -306,9 +316,7 @@ private def mkSilentAnnotationIfHole (e : Expr) : TermElabM Expr := do
           return false
     return true
   if canClear then
-    let lctx := (← getLCtx).erase fvarId
-    let localInsts := (← getLocalInstances).filter (·.fvar.fvarId! != fvarId)
-    withLCtx lctx localInsts do elabTerm body expectedType?
+    withErasedFVars #[fvarId] do elabTerm body expectedType?
   else
     elabTerm body expectedType?
 

src/Lean/Elab/Command.lean

@@ -81,7 +81,10 @@ Remark: see comment at TermElabM
 @[always_inline]
 instance : Monad CommandElabM := let i := inferInstanceAs (Monad CommandElabM); { pure := i.pure, bind := i.bind }
 
-/-- Like `Core.tryCatch` but do catch runtime exceptions. -/
+/--
+Like `Core.tryCatchRuntimeEx`; runtime errors are generally used to abort term elaboration, so we do
+want to catch and process them at the command level.
+-/
 @[inline] protected def tryCatch (x : CommandElabM α) (h : Exception → CommandElabM α) :
     CommandElabM α := do
   try

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
+import Lean.Meta.Constructions.CasesOn
 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   : WF.TerminationHints
+  termination   : TerminationHints
 
 structure LetRecView where
   decls     : Array LetRecDeclView
@@ -30,20 +30,24 @@ structure LetRecView where
 
 /-  group ("let " >> nonReservedSymbol "rec ") >> sepBy1 (group (optional «attributes» >> letDecl)) ", " >> "; " >> termParser -/
 private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
-  let decls ← letRec[1][0].getSepArgs.mapM fun (attrDeclStx : Syntax) => do
+  let mut decls : Array LetRecDeclView := #[]
+  for attrDeclStx in letRec[1][0].getSepArgs do
     let docStr? ← expandOptDocComment? attrDeclStx[0]
     let attrOptStx := attrDeclStx[1]
     let attrs ← if attrOptStx.isNone then pure #[] else elabDeclAttrs attrOptStx[0]
     let decl := attrDeclStx[2][0]
     if decl.isOfKind `Lean.Parser.Term.letPatDecl then
       throwErrorAt decl "patterns are not allowed in 'let rec' expressions"
-    else if decl.isOfKind `Lean.Parser.Term.letIdDecl || decl.isOfKind `Lean.Parser.Term.letEqnsDecl then
+    else if decl.isOfKind ``Lean.Parser.Term.letIdDecl || decl.isOfKind ``Lean.Parser.Term.letEqnsDecl then
       let declId := decl[0]
       unless declId.isIdent do
         throwErrorAt declId "'let rec' expressions must be named"
       let shortDeclName := declId.getId
       let currDeclName? ← getDeclName?
       let declName := currDeclName?.getD Name.anonymous ++ shortDeclName
+      if decls.any fun decl => decl.declName == declName then
+        withRef declId do
+          throwError "'{declName}' has already been declared"
       checkNotAlreadyDeclared declName
       applyAttributesAt declName attrs AttributeApplicationTime.beforeElaboration
       addDocString' declName docStr?
@@ -61,9 +65,11 @@ private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
         pure decl[4]
       else
         liftMacroM <| expandMatchAltsIntoMatch decl decl[3]
-      let termination ← WF.elabTerminationHints ⟨attrDeclStx[3]⟩
-      pure { ref := declId, attrs, shortDeclName, declName, binderIds, type, mvar, valStx,
-             termination : LetRecDeclView }
+      let termination ← elabTerminationHints ⟨attrDeclStx[3]⟩
+      decls := decls.push {
+        ref := declId, attrs, shortDeclName, declName,
+        binderIds, type, mvar, valStx, termination
+      }
     else
       throwUnsupportedSyntax
   return { decls, body := letRec[3] }

src/Lean/Elab/Match.lean

@@ -672,8 +672,7 @@ 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}"
-  let lctx := explicitPatternVars.foldl (init := (← getLCtx)) fun lctx d => lctx.erase d
-  withTheReader Meta.Context (fun ctx => { ctx with lctx := lctx }) do
+  withErasedFVars explicitPatternVars 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.WF.TerminationHint
+import Lean.Elab.PreDefinition.TerminationHint
 import Lean.Elab.DeclarationRange
 
 namespace Lean.Elab
@@ -167,14 +167,9 @@ private def elabHeaders (views : Array DefView)
         else
           reuseBody := false
 
-      let mut (newHeader, newState) ← withRestoreOrSaveFull reusableResult? do
-        withRef view.headerRef do
-        addDeclarationRanges declName view.ref  -- NOTE: this should be the full `ref`
+      let mut (newHeader, newState) ← withRestoreOrSaveFull reusableResult? none do
+        withReuseContext view.headerRef do
         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
@@ -320,11 +315,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 WF.TerminationHints :=
+private def declValToTerminationHint (declVal : Syntax) : TermElabM TerminationHints :=
   if declVal.isOfKind ``Parser.Command.declValSimple then
-    WF.elabTerminationHints ⟨declVal[2]⟩
+    elabTerminationHints ⟨declVal[2]⟩
   else if declVal.isOfKind ``Parser.Command.declValEqns then
-    WF.elabTerminationHints ⟨declVal[0][1]⟩
+    elabTerminationHints ⟨declVal[0][1]⟩
   else
     return .none
 
@@ -337,14 +332,10 @@ 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? do
+    let (val, state) ← withRestoreOrSaveFull reusableResult? header.tacSnap? do
+      withReuseContext header.value do
       withDeclName header.declName <| withLevelNames header.levelNames do
       let valStx ← liftMacroM <| declValToTerm header.value
       forallBoundedTelescope header.type header.numParams fun xs type => do
@@ -737,12 +728,26 @@ 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 :=
-  e.replace fun e => match e with
-    | .fvar fvarId => match r.find? fvarId with
-      | some c => some c
-      | _      => none
-    | _ => none
+  -- 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
 
 def pushMain (preDefs : Array PreDefinition) (sectionVars : Array Expr) (mainHeaders : Array DefViewElabHeader) (mainVals : Array Expr)
     : TermElabM (Array PreDefinition) :=
@@ -846,10 +851,7 @@ private def levelMVarToParamHeaders (views : Array DefView) (headers : Array Def
   let rec process : StateRefT Nat TermElabM (Array DefViewElabHeader) := do
     let mut newHeaders := #[]
     for view in views, header in headers do
-      -- Remark: we should consider using `pure view.kind.isTheorem <||> isProp header.type`, and
-      -- also handle definitions. We used the following approach because it is less disruptive to Mathlib.
-      -- Moreover, the type of most definitions are not propositions anyway.
-      if ← pure view.kind.isTheorem <||> (pure view.kind.isExample <&&> isProp header.type) then
+      if ← pure view.kind.isTheorem <||> isProp header.type then
         newHeaders ←
           withLevelNames header.levelNames do
             return newHeaders.push { header with type := (← levelMVarToParam header.type), levelNames := (← getLevelNames) }
@@ -935,12 +937,18 @@ 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,13 +4,14 @@ 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.WF.TerminationHint
+import Lean.Elab.PreDefinition.TerminationHint
 
 namespace Lean.Elab
 open Meta
@@ -29,7 +30,7 @@ structure PreDefinition where
   declName    : Name
   type        : Expr
   value       : Expr
-  termination : WF.TerminationHints
+  termination : TerminationHints
   deriving Inhabited
 
 def PreDefinition.filterAttrs (preDef : PreDefinition) (p : Attribute → Bool) : PreDefinition :=
@@ -53,18 +54,20 @@ 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
-  -- 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 }
+  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 }
 
 def applyAttributesOf (preDefs : Array PreDefinition) (applicationTime : AttributeApplicationTime) : TermElabM Unit := do
   for preDef in preDefs do
@@ -183,16 +186,44 @@ def addAndCompilePartialRec (preDefs : Array PreDefinition) : TermElabM Unit :=
             | _ => none
           modifiers := {} }
 
-private def containsRecFn (recFnName : Name) (e : Expr) : Bool :=
-  (e.find? fun e => e.isConstOf recFnName).isSome
+private def containsRecFn (recFnNames : Array Name) (e : Expr) : Bool :=
+  (e.find? fun e => e.isConst && recFnNames.contains e.constName!).isSome
 
-def ensureNoRecFn (recFnName : Name) (e : Expr) : MetaM Expr := do
-  if containsRecFn recFnName e then
+def ensureNoRecFn (recFnNames : Array Name) (e : Expr) : MetaM Unit := do
+  if containsRecFn recFnNames e then
     Meta.forEachExpr e fun e => do
-      if e.isAppOf recFnName then
+      if e.getAppFn.isConst && recFnNames.contains e.getAppFn.constName! then
         throwError "unexpected occurrence of recursive application{indentExpr e}"
-    pure e
-  else
-    pure 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
 
 end Lean.Elab

src/Lean/Elab/PreDefinition/Main.lean

@@ -95,65 +95,128 @@ def ensureFunIndReservedNamesAvailable (preDefs : Array PreDefinition) : MetaM U
     withRef preDef.ref <| ensureReservedNameAvailable preDef.declName "induct"
   withRef preDefs[0]!.ref <| ensureReservedNameAvailable preDefs[0]!.declName "mutual_induct"
 
-def addPreDefinitions (preDefs : Array PreDefinition) : TermElabM Unit := withLCtx {} {} do
+
+/--
+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
-    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
+    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
-        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
+        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")
         else
-          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
+          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
             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
+              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
 
 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
+Authors: Leonardo de Moura, Joachim Breitner
 -/
 prelude
 import Lean.Util.HasConstCache
@@ -9,6 +9,8 @@ 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
@@ -16,48 +18,80 @@ open Meta
 private def throwToBelowFailed : MetaM α :=
   throwError "toBelow failed"
 
-/-- See `toBelow` -/
-private partial def toBelowAux (C : Expr) (belowDict : Expr) (arg : Expr) (F : Expr) : MetaM Expr := do
-  let belowDict ← whnf belowDict
-  trace[Elab.definition.structural] "belowDict: {belowDict}, arg: {arg}"
-  match belowDict with
+partial def searchPProd (e : Expr) (F : Expr) (k : Expr → Expr → MetaM α) : MetaM α := do
+  match (← whnf e) 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]))
+        (do searchPProd d1 (← mkAppM ``PProd.fst #[F]) k)
+    <|> (do searchPProd d2 (← mkAppM `PProd.snd #[F]) k)
   | .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
+        (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 def withBelowDict (below : Expr) (numIndParams : Nat) (k : Expr → Expr → MetaM α) : MetaM α := do
+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
+
+/-- See `toBelow` -/
+private def withBelowDict [Inhabited α] (below : Expr) (numIndParams : Nat)
+    (positions : Positions) (k : Array Expr → Expr → MetaM α) : MetaM α := do
+  let numTypeFormers := positions.size
   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
-    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
+    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
 
 /--
   `below` is a free variable with type of the form `I.below indParams motive indices major`,
@@ -79,14 +113,16 @@ private def withBelowDict (below : Expr) (numIndParams : Nat) (k : Expr → Expr
   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) (recArg : Expr) : MetaM Expr := do
-  withBelowDict below numIndParams fun C belowDict =>
-    toBelowAux C belowDict recArg below
+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 replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
-  let containsRecFn (e : Expr) : StateRefT (HasConstCache recFnName) M Bool :=
+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 :=
     modifyGet (·.contains e)
-  let rec loop (below : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) M Expr := do
+  let rec loop (below : Expr) (e : Expr) : StateRefT (HasConstCache recFnNames) M Expr := do
     if !(← containsRecFn e) then
       return e
     match e with
@@ -106,32 +142,26 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
         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 recFnName) M Expr :=
+      let processApp (e : Expr) : StateRefT (HasConstCache recFnNames) M Expr :=
         e.withApp fun f args => do
-          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]!
+          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}"
             -- For reflexive type, we may have nested recursive applications in recArg
             let recArg ← loop below recArg
-            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
+            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 ·)
             return mkAppN f fArgs
           else
             return mkAppN (← loop below f) (← args.mapM (loop below))
       match (← matchMatcherApp? (alsoCasesOn := true) e) with
       | some matcherApp =>
-        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
+        if recArgInfos.all (fun recArgInfo => !recArgHasLooseBVarsAt recArgInfo.fnName recArgInfo.recArgPos e) then
           processApp e
         else
           /- Here is an example we currently do not handle
@@ -153,9 +183,9 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
           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) =>
-              lambdaTelescope alt fun xs altBody => do
+              lambdaBoundedTelescope alt numParams 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)
@@ -163,49 +193,119 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
           else
             processApp e
       | none => processApp e
-    | e => ensureNoRecFn recFnName e
+    | e =>
+      ensureNoRecFn recFnNames e
+      pure e
   loop below e |>.run' {}
 
-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]
+/--
+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
     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 recFnName recArgInfo below value
-      let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
-      let brecOn       := mkApp brecOn Farg
-      return mkAppN brecOn otherArgs
+      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  =>
+    let brecOn :=
+      if let .some n := indGroup.all[idx]? then
+        if useBInductionOn then .const (mkBInductionOnName n) indGroup.levels
+        else                    .const (mkBRecOnName n) (brecOnUniv :: indGroup.levels)
+      else
+        let n := indGroup.all[0]!
+        let j := idx - indGroup.all.size + 1
+        if useBInductionOn then .const (mkBInductionOnName n |>.appendIndexAfter j) indGroup.levels
+        else                    .const (mkBRecOnName n |>.appendIndexAfter j) (brecOnUniv :: indGroup.levels)
+    mkAppN brecOn indGroup.params
+
+  -- 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)
 
 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
+Authors: Leonardo de Moura, Joachim Breitner
 -/
 prelude
 import Lean.Meta.Basic
@@ -9,31 +9,6 @@ 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.
@@ -64,4 +39,55 @@ 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,7 +19,8 @@ open Eqns
 namespace Structural
 
 structure EqnInfo extends EqnInfoCore where
-  recArgPos   : Nat
+  recArgPos : Nat
+  declNames : Array Name
   deriving Inhabited
 
 private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
@@ -62,12 +63,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.declName] goal.mvarId!
+    mkEqnTypes (tryRefl := true) info.declNames goal.mvarId!
   let baseName := info.declName
   let mut thmNames := #[]
   for i in [: eqnTypes.size] do
     let type := eqnTypes[i]!
-    trace[Elab.definition.structural.eqns] "{eqnTypes[i]!}"
+    trace[Elab.definition.structural.eqns] "eqnType {i}: {type}"
     let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
     thmNames := thmNames.push name
     let value ← mkProof info.declName type
@@ -80,9 +81,9 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
 
 builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
 
-def registerEqnsInfo (preDef : PreDefinition) (recArgPos : Nat) : CoreM Unit := do
+def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat) : CoreM Unit := do
   ensureEqnReservedNamesAvailable preDef.declName
-  modifyEnv fun env => eqnInfoExt.insert env preDef.declName { preDef with recArgPos }
+  modifyEnv fun env => eqnInfoExt.insert env preDef.declName { preDef with recArgPos, declNames }
 
 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,14 +1,34 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
+Authors: Leonardo de Moura, Joachim Breitner
 -/
 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
@@ -29,114 +49,233 @@ 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 pType y.fvarId! then
+      if ← dependsOn p y.fvarId! then
         return some (p, y)
   return none
 
-private def throwStructuralFailed : MetaM α :=
-  throwError "structural recursion cannot be used"
-
-private def orelse' (x y : M α) : M α := do
-  let saveState ← get
-  orelseMergeErrors x (do set saveState; y)
+/--
+Assemble 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).
+-/
+def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) : MetaM RecArgInfo := do
+  if h : i < xs.size then
+    if i < numFixed then
+      throwError "it is unchanged in the recursive calls"
+    let x := xs[i]
+    let localDecl ← getFVarLocalDecl x
+    if localDecl.isLet then
+      throwError "it is a let-binding"
+    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"
+    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"
+    else
+      let indArgs    : Array Expr := xType.getAppArgs
+      let indParams  : Array Expr := indArgs[0:indInfo.numParams]
+      let indIndices : Array Expr := indArgs[indInfo.numParams:]
+      if !indIndices.all Expr.isFVar then
+        throwError "its type {indInfo.name} 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}"
+      else
+        let indexMinPos := getIndexMinPos xs indIndices
+        let numFixed    := if indexMinPos < numFixed then indexMinPos else numFixed
+        let ys          := xs[numFixed:]
+        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}"
+        | 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."
+          | 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 }
+    else
+      throwError "the index #{i+1} exceeds {xs.size}, the number of parameters"
 
 /--
-  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.
+Collects the `RecArgInfos` for one function, and returns a report for why the others were not
+considered.
 
-  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.
+The `xs` are the fixed parameters, `value` the body with the fixed prefix instantiated.
 
-  We perform two passes. In the first-pass, we only consider arguments that are not indices.
-  In the second pass, we consider them.
-
-  TODO: explore whether there are better solutions, and whether there are other ways to break the heuristic used
-  for creating the smart unfolding auxiliary definition.
+Takes the optional user annotations into account (`termArg?`). If this is given and the argument
+is unsuitable, throw an error.
 -/
-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 FVarIdSet ← IO.mkRef {}
-  for x in xs do
-    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 e.isFVar && xs.any (· == e) then
-                indicesRef.modify fun indices => indices.insert e.fvarId!
-  let indices ← indicesRef.get
-  /- We perform two passes. See comment above. -/
-  let rec go (i : Nat) (firstPass : Bool) : M α := do
-    if h : i < xs.size then
-      let x := xs.get ⟨i, h⟩
-      trace[Elab.definition.structural] "findRecArg x: {x}, firstPass: {firstPass}"
-      let localDecl ← getFVarLocalDecl x
-      if localDecl.isLet then
-        throwStructuralFailed
-      else if firstPass == indices.contains localDecl.fvarId then
-        go (i+1) firstPass
-      else
-        let xType ← whnfD localDecl.type
-        matchConstInduct xType.getAppFn (fun _ => go (i+1) firstPass) fun indInfo us => do
-        if !(← hasConst (mkBRecOnName indInfo.name)) then
-          go (i+1) firstPass
-        else if indInfo.isReflexive && !(← hasConst (mkBInductionOnName indInfo.name)) && !(← isInductivePredicate indInfo.name) then
-          go (i+1) firstPass
-        else
-          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
-            orelse'
-              (throwError "argument #{i+1} was not used because its type is an inductive family and indices are not variables{indentExpr xType}")
-              (go (i+1) firstPass)
-          else if !indIndices.allDiff then
-            orelse'
-              (throwError "argument #{i+1} was not used because its type is an inductive family and indices are not pairwise distinct{indentExpr xType}")
-              (go (i+1) firstPass)
-          else
-            let indexMinPos := getIndexMinPos xs indIndices
-            let numFixed    := if indexMinPos < numFixed then indexMinPos else numFixed
-            let fixedParams := xs.extract 0 numFixed
-            let ys          := xs.extract numFixed xs.size
-            match (← hasBadIndexDep? ys indIndices) with
-            | some (index, y) =>
-              orelse'
-                (throwError "argument #{i+1} was not used because its type is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}")
-                (go (i+1) firstPass)
-            | none =>
-              match (← hasBadParamDep? ys indParams) with
-              | some (indParam, y) =>
-                orelse'
-                  (throwError "argument #{i+1} was not used because its type is an inductive datatype{indentExpr xType}\nand parameter{indentExpr indParam}\ndepends on{indentExpr y}")
-                  (go (i+1) firstPass)
-              | none =>
-                let indicesPos := indIndices.map fun index => match ys.indexOf? index with | some i => i.val | none => unreachable!
-                orelse'
-                  (mapError
-                    (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 })
-                    (fun msg => m!"argument #{i+1} was not used for structural recursion{indentD msg}"))
-                  (go (i+1) firstPass)
-    else if firstPass then
-      go (i := numFixed) (firstPass := false)
+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
-      throwStructuralFailed
+      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)
 
-  go (i := numFixed) (firstPass := true)
+
+/--
+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 := #[]
+  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
 
 end Lean.Elab.Structural

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

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

@@ -0,0 +1,93 @@
+/-
+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
+
+/--
+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,11 +7,12 @@ 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 (recFnName : Name) (recArgInfo : RecArgInfo) (motive : Expr) (e : Expr) : M Expr := do
+private partial def replaceIndPredRecApps (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
@@ -33,7 +34,7 @@ private partial def replaceIndPredRecApps (recFnName : Name) (recArgInfo : RecAr
     | Expr.app _ _ =>
       let processApp (e : Expr) : M Expr := do
         e.withApp fun f args => do
-          if f.isConstOf recFnName then
+          if f.isConstOf recArgInfo.fnName then
             let ty ← inferType e
             let main ← mkFreshExprSyntheticOpaqueMVar ty
             if (← IndPredBelow.backwardsChaining main.mvarId! maxDepth) then
@@ -44,7 +45,7 @@ private partial def replaceIndPredRecApps (recFnName : Name) (recArgInfo : RecAr
             return mkAppN (← loop f) (← args.mapM loop)
       match (← matchMatcherApp? e) with
       | some matcherApp =>
-        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
+        if !recArgHasLooseBVarsAt recArgInfo.fnName recArgInfo.recArgPos e then
           processApp e
         else
           trace[Elab.definition.structural] "matcherApp before adding below transformation:\n{matcherApp.toExpr}"
@@ -63,42 +64,48 @@ private partial def replaceIndPredRecApps (recFnName : Name) (recArgInfo : RecAr
             trace[Elab.definition.structural] "modified matcher:\n{newApp}"
             processApp newApp
       | none => processApp e
-    | e => ensureNoRecFn recFnName e
+    | e =>
+      ensureNoRecFn #[recArgInfo.fnName] e
+      pure e
   loop e
 
-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
+/--
+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
 
 end Lean.Elab.Structural

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

@@ -1,9 +1,10 @@
 /-
 Copyright (c) 2021 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
+Authors: Leonardo de Moura, Joachim Breitner
 -/
 prelude
+import Lean.Elab.PreDefinition.TerminationArgument
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.Structural.FindRecArg
 import Lean.Elab.PreDefinition.Structural.Preprocess
@@ -11,6 +12,7 @@ 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
@@ -57,40 +59,129 @@ private def getFixedPrefix (declName : Name) (xs : Array Expr) (value : Expr) :
       return true
   numFixedRef.get
 
-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
-      -- when (recArgInfo.indName == `Nat) throwStructuralFailed -- HACK to skip Nat argument
-      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 })
+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)
 
-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]!
+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) := 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')
+
+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), 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
     let preDefNonRec ← eraseRecAppSyntax preDefNonRec
-    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]
+    -- 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
     unless preDef.kind.isTheorem do
       unless (← isProp preDef.type) do
         preDef ← abstractNestedProofs preDef
@@ -99,13 +190,11 @@ def structuralRecursion (preDefs : Array PreDefinition) : TermElabM Unit :=
         for theorems and definitions that are propositions.
         See issue #2327
         -/
-        registerEqnsInfo preDef recArgPos
+        registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos
     addSmartUnfoldingDef preDef recArgPos
     markAsRecursive preDef.declName
-    applyAttributesOf #[preDefNonRec] AttributeApplicationTime.afterCompilation
+  applyAttributesOf preDefsNonRec 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) (recFnName : Name) : Bool :=
+private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
   if e.isHeadBetaTarget then
-    e.getAppFn.find? (·.isConstOf recFnName) |>.isSome
+    e.getAppFn.find? (fun e => e.isConst && recFnNames.contains e.constName!) |>.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) (recFnName : Name) : CoreM Expr :=
+def preprocess (e : Expr) (recFnNames : Array Name) : CoreM Expr :=
   Core.transform e
     (pre := fun e =>
-      if shouldBetaReduce e recFnName then
+      if shouldBetaReduce e recFnNames then
         return .visit e.headBeta
       else
         return .continue)

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

@@ -0,0 +1,60 @@
+/-
+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,17 +47,13 @@ where
         else
           let mut altsNew := #[]
           for alt in matcherApp.alts, numParams in matcherApp.altNumParams do
-            let altNew ← lambdaTelescope alt fun xs altBody => do
-              unless xs.size >= numParams do
+            let altNew ← lambdaBoundedTelescope alt numParams 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
-              if !containsSUnfoldMatch then
-                let altBody ← mkLambdaFVars xs[numParams:xs.size] altBody
-                let altBody := markSmartUnfoldingMatchAlt altBody
-                mkLambdaFVars xs[0:numParams] altBody
-              else
-                mkLambdaFVars xs altBody
+              let altBody := if !containsSUnfoldMatch then markSmartUnfoldingMatchAlt altBody else altBody
+              mkLambdaFVars xs altBody
             altsNew := altsNew.push altNew
           return markSmartUnfoldingMatch { matcherApp with alts := altsNew }.toExpr
       | _ => processApp e

src/Lean/Elab/PreDefinition/TerminationArgument.lean

@@ -9,17 +9,19 @@ import Lean.Parser.Term
 import Lean.Elab.Term
 import Lean.Elab.Binders
 import Lean.Elab.SyntheticMVars
-import Lean.Elab.PreDefinition.WF.TerminationHint
-import Lean.PrettyPrinter.Delaborator
+import Lean.Elab.PreDefinition.TerminationHint
+import Lean.PrettyPrinter.Delaborator.Basic
 
 /-!
-This module contains the data type `TerminationArgument`, the elaborated form of a `TerminationBy`
-clause, the `TerminationArguments` type for a clique and the elaboration functions.
+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.
 -/
 
 set_option autoImplicit false
 
-namespace Lean.Elab.WF
+namespace Lean.Elab
 
 open Lean Meta Elab Term
 
@@ -29,11 +31,12 @@ 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
-  arity : Nat
-  extraParams : Nat
+  structural : Bool
   fn : Expr
 deriving Inhabited
 
@@ -44,9 +47,6 @@ 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,22 +69,43 @@ 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, arity, extraParams, fn := r}
+  pure { ref := hint.ref, structural := hint.structural, fn := r}
   where
     parameters : Nat → MessageData
     | 1 => "one parameter"
     | n => m!"{n} parameters"
 
-open PrettyPrinter Delaborator SubExpr Parser.Termination Parser.Term in
-def TerminationArgument.delab (termArg : TerminationArgument) : MetaM (TSyntax ``terminationBy) := do
+def TerminationArgument.structuralArg (termArg : TerminationArgument) : MetaM Nat := do
+  assert! termArg.structural
   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
+    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
   where
     go : Nat → TSyntaxArray `ident → DelabM (TSyntax ``terminationBy)
     | 0, vars => do
@@ -94,15 +115,23 @@ def TerminationArgument.delab (termArg : TerminationArgument) : MetaM (TSyntax `
       -- 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 hasIdent i.getId stxBody then i else hole) vars
+        Array.map (fun (i : Ident) => if stxBody.raw.hasIdent i.getId 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 vars.isEmpty then
-        `(terminationBy|termination_by $stxBody)
+      if termArg.structural then
+        if vars.isEmpty then
+          `(terminationBy|termination_by structural $stxBody)
+        else
+          `(terminationBy|termination_by structural $vars* => $stxBody)
       else
-        `(terminationBy|termination_by $vars* => $stxBody)
+        if vars.isEmpty then
+          `(terminationBy|termination_by $stxBody)
+        else
+          `(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/TerminationHint.lean

@@ -8,22 +8,23 @@ import Lean.Parser.Term
 
 set_option autoImplicit false
 
-namespace Lean.Elab.WF
+namespace Lean.Elab
 
 /-! # Support for `termination_by` notation -/
 
 /-- A single `termination_by` clause -/
 structure TerminationBy where
-  ref       : Syntax
-  vars      : TSyntaxArray [`ident, ``Lean.Parser.Term.hole]
-  body      : Term
+  ref          : Syntax
+  structural : Bool
+  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 -/
@@ -32,7 +33,8 @@ 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.
  -/
@@ -41,7 +43,8 @@ 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
@@ -55,7 +58,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 =>
@@ -114,10 +117,12 @@ 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 => $_body) =>
+      | `(terminationBy|termination_by $[structural%$s]? => $_body) =>
         throwErrorAt t "no extra parameters bounds, please omit the `=>`"
-      | `(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 $[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?) => pure none
       | _ => throwErrorAt t "unexpected `termination_by` syntax"
       else pure none
@@ -127,4 +132,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.WF
+end Lean.Elab

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) =>
-            lambdaTelescope alt fun xs altBody => do
-              unless xs.size >= numParams do
+            lambdaBoundedTelescope alt numParams 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,7 +90,9 @@ where
         else
           processApp F e
       | none => processApp F e
-    | e => ensureNoRecFn recFnName e
+    | e =>
+      ensureNoRecFn #[recFnName] e
+      pure 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
@@ -103,12 +105,11 @@ 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 :=
-      lambdaTelescope minor fun xs body => do
+      lambdaBoundedTelescope minor 1 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 valNew k)
+          mkLambdaFVars #[xNew, FNew] (← processSumCasesOn xNew FNew body 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.WF.TerminationArgument
+import Lean.Elab.PreDefinition.TerminationArgument
 import Lean.Data.Array
 
 
@@ -128,10 +128,10 @@ structure Measure extends TerminationArgument where
   natFn : Expr
 deriving Inhabited
 
-/-- String desription of this measure -/
+/-- String description of this measure -/
 def Measure.toString (measure : Measure) : MetaM String := do
-  lambdaTelescope measure.fn fun xs e => do
-    let e ← mkLambdaFVars xs[measure.arity:] e -- undo overshooting
+  lambdaTelescope measure.fn fun _xs e => do
+    -- This is a bit slopping if `measure.fn` takes more parameters than the `PreDefinition`
     return (← ppExpr e).pretty
 
 /--
@@ -187,13 +187,12 @@ def simpleMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
             if  ← mayOmitSizeOf is_mutual xs[fixedPrefixSize:] x
             then mkLambdaFVars xs x
             else pure natFn
-          let extraParams := preDef.termination.extraParams
-          ret := ret.push { ref := .missing, fn, natFn, arity := xs.size, extraParams }
+          ret := ret.push { ref := .missing, structural := false, fn, natFn }
         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`
@@ -224,7 +223,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
@@ -257,8 +256,7 @@ where
           matcherApp.discrs.forM (loop param)
           (Array.zip matcherApp.alts (Array.zip matcherApp.altNumParams altParams)).forM
             fun (alt, altNumParam, altParam) =>
-              lambdaTelescope altParam fun xs altParam => do
-                -- TODO: Use boundedLambdaTelescope
+              lambdaBoundedTelescope altParam altNumParam fun xs altParam => do
                 unless altNumParam = xs.size do
                   throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
                 let altBody := alt.beta xs
@@ -268,7 +266,7 @@ where
           processApp param e
       | none => processApp param e
     | e => do
-      let _ ← ensureNoRecFn recFnName e
+      ensureNoRecFn #[recFnName] e
 
 /--
 A `SavedLocalContext` captures the state and local context of a `MetaM`, to be continued later.
@@ -343,9 +341,8 @@ call site.
 def collectRecCalls (unaryPreDef : PreDefinition) (fixedPrefixSize : Nat)
     (argsPacker : ArgsPacker) : MetaM (Array RecCallWithContext) := withoutModifyingState do
   addAsAxiom unaryPreDef
-  lambdaTelescope unaryPreDef.value fun xs body => do
+  lambdaBoundedTelescope unaryPreDef.value (fixedPrefixSize + 1) 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]!
@@ -370,8 +367,7 @@ 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
-    let arity ← lambdaTelescope preDef.value fun xs _ => pure xs.size
+  preDefs.mapIdxM fun funIdx _preDef => do
     let mut measures := #[]
     for rc in recCalls do
       -- Only look at calls from the current function
@@ -398,8 +394,7 @@ def complexMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
               let fn ← mkLambdaFVars rc.params body
               -- Avoid duplicates
               unless ← measures.anyM (isDefEq ·.fn fn) do
-                let extraParams := preDef.termination.extraParams
-                measures := measures.push { ref := .missing, fn, natFn := fn, arity, extraParams }
+                measures := measures.push { ref := .missing, structural := false,  fn, natFn := fn }
         return measures
     return measures
 
@@ -751,18 +746,20 @@ 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)
-        let extraParams := preDef.termination.extraParams
-        return { ref := .missing, arity := xs.size, extraParams, fn}
+        return { ref := .missing, structural := false, 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{← termArg.delab}"
+      logInfoAt preDef.ref m!"Inferred termination argument:\n{← stx}"
     if let some ref := preDef.termination.terminationBy?? then
-      Tactic.TryThis.addSuggestion ref (← termArg.delab)
+      Tactic.TryThis.addSuggestion ref (← stx)
 
 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.WF.TerminationArgument
+import Lean.Elab.PreDefinition.TerminationArgument
 import Lean.Elab.PreDefinition.WF.PackMutual
 import Lean.Elab.PreDefinition.WF.Preprocess
 import Lean.Elab.PreDefinition.WF.Rel
@@ -86,7 +86,8 @@ def varyingVarNames (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Ar
     let xs : Array Expr := xs[fixedPrefixSize:]
     xs.mapM (·.fvarId!.getUserName)
 
-def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
+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`
   let preDefs ← preDefs.mapM fun preDef =>
     return { preDef with value := (← preprocess preDef.value) }
   let (fixedPrefixSize, argsPacker, unaryPreDef) ← withoutModifyingEnv do
@@ -100,21 +101,9 @@ def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
     return (fixedPrefixSize, argsPacker, ← packMutual fixedPrefixSize argsPacker preDefsDIte)
 
   let wf : TerminationArguments ← do
-    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
+    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 preDefNonRec ← forallBoundedTelescope unaryPreDef.type fixedPrefixSize fun prefixArgs type => do
     let type ← whnfForall type