Compare commits

..

1 Commits

Author SHA1 Message Date
Kim Morrison
d11293a731 feat: maximum?_eq_some_iff' 2024-06-24 21:44:42 +10:00
815 changed files with 2688 additions and 19745 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -8,326 +8,13 @@ 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.11.0
v4.10.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
----------
### 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`.
Release candidate, release notes will be copied from branch `releases/v4.9.0` once completed.
v4.8.0
---------

View File

@@ -5,8 +5,7 @@ See below for the checklist for release candidates.
We'll use `v4.6.0` as the intended release version as a running example.
- One week before the planned release, ensure that (1) someone has written the release notes and (2) someone has written the first draft of the release blog post.
If there is any material in `./releases_drafts/`, then the release notes are not done. (See the section "Writing the release notes".)
- One week before the planned release, ensure that someone has written the first draft of the release blog post
- `git checkout releases/v4.6.0`
(This branch should already exist, from the release candidates.)
- `git pull`
@@ -14,6 +13,13 @@ 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.
@@ -24,9 +30,8 @@ We'll use `v4.6.0` as the intended release version as a running example.
you may want to start on the release candidate checklist now.
- Go to https://github.com/leanprover/lean4/releases and verify that the `v4.6.0` release appears.
- Edit the release notes on Github to select the "Set as the latest release".
- Follow the instructions in creating a release candidate for the "GitHub release notes" step,
now that we have a written `RELEASES.md` section.
Do a quick sanity check.
- Copy and paste the Github release notes from the previous releases candidate for this version
(e.g. `v4.6.0-rc1`), and quickly sanity check.
- Next, we will move a curated list of downstream repos to the latest stable release.
- For each of the repositories listed below:
- Make a PR to `master`/`main` changing the toolchain to `v4.6.0`
@@ -89,10 +94,6 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- The `v4.6.0` section of `RELEASES.md` is out of sync between
`releases/v4.6.0` and `master`. This should be reconciled:
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
and commit this to `master`.
- Merge the release announcement PR for the Lean website - it will be deployed automatically
- Finally, make an announcement!
This should go in https://leanprover.zulipchat.com/#narrow/stream/113486-announce, with topic `v4.6.0`.
@@ -103,6 +104,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
## Optimistic(?) time estimates:
- Initial checks and push the tag: 30 minutes.
- Note that if `RELEASES.md` has discrepancies this could take longer!
- Waiting for the release: 60 minutes.
- Fixing release notes: 10 minutes.
- Bumping toolchains in downstream repositories, up to creating the Mathlib PR: 30 minutes.
@@ -129,26 +131,29 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
git checkout nightly-2024-02-29
git checkout -b releases/v4.7.0
```
- In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
- We will rely on automatically generated release notes for release candidates,
and the written release notes will be used for stable versions only.
It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
- In `RELEASES.md` remove `(development in progress)` from the `v4.7.0` section header.
- Our current goal is to have written release notes only about major language features or breaking changes,
and to rely on automatically generated release notes for bugfixes and minor changes.
- Do not wait on `RELEASES.md` being perfect before creating the `release/v4.7.0` branch. It is essential to choose the nightly which will become the release candidate as early as possible, to avoid confusion.
- If there are major changes not reflected in `RELEASES.md` already, you may need to solicit help from the authors.
- Minor changes and bug fixes do not need to be documented in `RELEASES.md`: they will be added automatically on the Github release page.
- Commit your changes to `RELEASES.md`, and push.
- Remember that changes to `RELEASES.md` after you have branched `releases/v4.7.0` should also be cherry-picked back to `master`.
- In `src/CMakeLists.txt`,
- verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
- `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
- Commit your changes to `src/CMakeLists.txt`, and push.
- `git tag v4.7.0-rc1`
- `git push origin v4.7.0-rc1`
- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
- Now wait, while CI runs.
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
- This step can take up to an hour.
- (GitHub release notes) Once the release appears at https://github.com/leanprover/lean4/releases/
- Once the release appears at https://github.com/leanprover/lean4/releases/
- Edit the release notes on Github to select the "Set as a pre-release box".
- If release notes have been written already, copy the section of `RELEASES.md` for this version into the Github release notes
and use the title "Changes since v4.6.0 (from RELEASES.md)".
- Otherwise, in the "previous tag" dropdown, select `v4.6.0`, and click "Generate release notes".
This will add a list of all the commits since the last stable version.
- Copy the section of `RELEASES.md` for this version into the Github release notes.
- Use the title "Changes since v4.6.0 (from RELEASES.md)"
- Then in the "previous tag" dropdown, select `v4.6.0`, and click "Generate release notes".
- This will add a list of all the commits since the last stable version.
- Delete anything already mentioned in the hand-written release notes above.
- Delete "update stage0" commits, and anything with a completely inscrutable commit message.
- Briefly rearrange the remaining items by category (e.g. `simp`, `lake`, `bug fixes`),
@@ -174,9 +179,6 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
- We do this for the same list of repositories as for stable releases, see above.
As above, there are dependencies between these, and so the process above is iterative.
It greatly helps if you can merge the `bump/v4.7.0` PRs yourself!
It is essential for Mathlib CI that you then create the next `bump/v4.8.0` branch
for the next development cycle.
Set the `lean-toolchain` file on this branch to same `nightly` you used for this release.
- For Batteries/Aesop/Mathlib, which maintain a `nightly-testing` branch, make sure there is a tag
`nightly-testing-2024-02-29` with date corresponding to the nightly used for the release
(create it if not), and then on the `nightly-testing` branch `git reset --hard master`, and force push.
@@ -187,17 +189,8 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
Please also make sure that whoever is handling social media knows the release is out.
- Begin the next development cycle (i.e. for `v4.8.0`) on the Lean repository, by making a PR that:
- Updates `src/CMakeLists.txt` to say `set(LEAN_VERSION_MINOR 8)`
- Replaces the "development in progress" in the `v4.7.0` section of `RELEASES.md` with
```
Release candidate, release notes will be copied from `branch releases/v4.7.0` once completed.
```
and inserts the following section before that section:
```
v4.8.0
----------
Development in progress.
```
- Removes all the entries from the `./releases_drafts/` folder.
- 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.
## Time estimates:
Slightly longer than the corresponding steps for a stable release.
@@ -231,18 +224,3 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
* It is always okay to merge in the following directions:
`master` -> `bump/v4.7.0` -> `bump/nightly-2024-02-15` -> `nightly-testing`.
Please remember to push any merges you make to intermediate steps!
# Writing the release notes
We are currently trying a system where release notes are compiled all at once from someone looking through the commit history.
The exact steps are a work in progress.
Here is the general idea:
* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
The release notes for `v4.6.0` will be copied to `master`.
* There can be material for release notes entries in commit messages.
* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
See `./releases_drafts/README.md` for more information.
* The release notes should be written from a downstream expert user's point of view.
This section will be updated when the next release notes are written (for `v4.10.0`).

View File

@@ -125,10 +125,8 @@ 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,${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} \
${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} \
$(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
-o $out/$libName
'';

View File

@@ -224,8 +224,7 @@ 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';
bintools = if stdenv.isDarwin then darwin.cctools else stdenv.cc.bintools.bintools;
staticLib = runCommand "${name}-lib" { buildInputs = [ bintools ]; } ''
staticLib = runCommand "${name}-lib" { buildInputs = [ stdenv.cc.bintools.bintools ]; } ''
mkdir -p $out
ar Trcs $out/lib${libName}.a ${lib.concatStringsSep " " (map (drv: "${drv}/${drv.oPath}") (attrValues objects))};
'';

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -10,7 +10,5 @@ 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

View File

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

View File

@@ -60,6 +60,8 @@ 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)

View File

@@ -51,7 +51,7 @@ theorem foldlM_eq_foldlM_data.aux [Monad m]
simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H]
rw (config := {occs := .pos [2]}) [ List.get_drop_eq_drop _ _ _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
theorem foldlM_eq_foldlM_data [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
@@ -141,7 +141,7 @@ where
· rw [ List.get_drop_eq_drop _ i _]
simp only [aux (i + 1), map_eq_pure_bind, data_length, List.foldlM_cons, bind_assoc, pure_bind]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
termination_by arr.size - i
decreasing_by decreasing_trivial_pre_omega
@@ -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?_def]
simp [setD, h, getElem?]
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?_def, size_push, g, h1, h2, get_push_lt]
simp [getElem?, 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?_def, size_push]
simp only [getElem?, 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?_def, Nat.lt_irrefl, dite_false]
simp only [getElem?, 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

View File

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

View File

@@ -47,6 +47,8 @@ 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₀

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -52,9 +52,13 @@ 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
@@ -92,24 +96,20 @@ protected def append (a : ByteArray) (b : ByteArray) : ByteArray :=
instance : Append ByteArray := ByteArray.append
def toList (bs : ByteArray) : List UInt8 :=
partial 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] def findIdx? (a : ByteArray) (p : UInt8 Bool) (start := 0) : Option Nat :=
@[inline] partial 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
/--

View File

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

View File

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

View File

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

View File

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

View File

@@ -58,9 +58,13 @@ 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

View File

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

View File

@@ -8,7 +8,6 @@ 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

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -10,38 +10,58 @@ import Init.RCases
namespace Lean
namespace Parser.Attr
/--
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.
/-- 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, and it generates an `ext_iff` theorem.
The name of the theorem is from adding the suffix `_iff` to the theorem name.
* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic.
* 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.
-/
syntax (name := ext) "ext" (ppSpace extIff)? (ppSpace extFlat)? (ppSpace prio)? : attr
structures in the generated extensionality theorems. -/
syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr
end Parser.Attr
-- TODO: rename this namespace?
-- Remark: `ext` has scoped syntax, Mathlib may depend on the actual namespace name.
namespace Elab.Tactic.Ext
/--
Creates the type of the extensionality theorem for the given structure,
elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
-/
scoped syntax (name := extType) "ext_type% " term:max ppSpace ident : term
/--
Creates the type of the iff-variant of the extensionality theorem for the given structure,
elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
-/
scoped syntax (name := extIffType) "ext_iff_type% " term:max ppSpace ident : term
/--
`declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`.
These theorems state that two expressions with the structure type are equal if their fields are equal.
-/
syntax (name := declareExtTheoremFor) "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command
macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do
let flat := f.getD (mkIdent `true)
let names Macro.resolveGlobalName struct.getId.eraseMacroScopes
let name match names.filter (·.2.isEmpty) with
| [] => Macro.throwError s!"unknown constant {struct.getId}"
| [(name, _)] => pure name
| _ => Macro.throwError s!"ambiguous name {struct.getId}"
let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext"
let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff"
`(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident :=
fun {..} {..} => by intros; subst_eqs; rfl
protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident :=
fun {..} {..} =>
fun h => by cases h; and_intros <;> rfl,
fun _ => by (repeat cases _ _); subst_eqs; rfl)
/--
Applies extensionality lemmas that are registered with the `@[ext]` attribute.
@@ -76,8 +96,19 @@ macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic =>
end Elab.Tactic.Ext
end Lean
attribute [ext] Prod PProd Sigma PSigma
attribute [ext] funext propext Subtype.eq
@[ext] theorem Prod.ext : {x y : Prod α β} x.fst = y.fst x.snd = y.snd x = y
| _,_, _,_, rfl, rfl => rfl
@[ext] theorem PProd.ext : {x y : PProd α β} x.fst = y.fst x.snd = y.snd x = y
| _,_, _,_, rfl, rfl => rfl
@[ext] theorem Sigma.ext : {x y : Sigma β} x.fst = y.fst HEq x.snd y.snd x = y
| _,_, _,_, rfl, .rfl => rfl
@[ext] theorem PSigma.ext : {x y : PSigma β} x.fst = y.fst HEq x.snd y.snd x = y
| _,_, _,_, rfl, .rfl => rfl
@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
protected theorem Unit.ext (x y : Unit) : x = y := rfl

View File

@@ -7,57 +7,22 @@ prelude
import Init.Util
@[never_extract]
def outOfBounds [Inhabited α] : α :=
private def outOfBounds [Inhabited α] : α :=
panic! "index out of bounds"
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.
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 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`.
`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`.
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; 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`.
`get_elem_tactic` tactic, which can be extended by adding more clauses to
`get_elem_tactic_trivial`.
-/
class GetElem (coll : Type u) (idx : Type v) (elem : outParam (Type w))
(valid : outParam (coll idx Prop)) where
@@ -65,10 +30,33 @@ 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
export GetElem (getElem)
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?)
@[inherit_doc getElem]
syntax:max term noWs "[" withoutPosition(term) "]" : term
@@ -78,30 +66,6 @@ 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.
@@ -114,51 +78,32 @@ 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
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]
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
export LawfulGetElem (getElem?_def getElem!_def)
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]
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]
@@ -166,22 +111,23 @@ 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 := h.getElem!_def ..
@[simp] theorem getElem_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
getElem?_def _c _i _d := h.getElem?_def ..
getElem!_def _c _i _d := h.getElem!_def ..
@[simp] theorem getElem_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
a[i] = a[i.1] := rfl
@[simp] theorem getElem?_fin [h : GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) : a[i]? = a[i.1]? := by rfl
@[simp] theorem getElem?_fin [h : GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n)
[Decidable (Dom a i)] : a[i]? = a[i.1]? := by rfl
@[simp] theorem getElem!_fin [GetElem? Cont Nat Elem Dom] (a : Cont) (i : Fin n) [Inhabited Elem] : a[i]! = a[i.1]! := rfl
@[simp] theorem getElem!_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n)
[Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl
macro_rules
| `(tactic| get_elem_tactic_trivial) => `(tactic| apply Fin.val_lt_of_le; get_elem_tactic_trivial; done)
@@ -193,15 +139,17 @@ 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-06-12")] abbrev cons_getElem_zero := @getElem_cons_zero
@[deprecated (since := "2024-6-12")] abbrev cons_getElem_zero := @getElem_cons_zero
@[simp] theorem getElem_cons_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
rfl
@[deprecated (since := "2024-06-12")] abbrev cons_getElem_succ := @getElem_cons_succ
@[deprecated (since := "2024-6-12")] abbrev cons_getElem_succ := @getElem_cons_succ
theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
match as, i with
@@ -215,6 +163,8 @@ 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
@@ -222,4 +172,6 @@ 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

View File

@@ -218,14 +218,6 @@ 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`

View File

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

View File

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

View File

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

View File

@@ -253,9 +253,6 @@ end forall_congr
@[simp] theorem not_exists : (¬ x, p x) x, ¬p x := exists_imp
theorem forall_not_of_not_exists (h : ¬ x, p x) : x, ¬p x := not_exists.mp h
theorem not_exists_of_forall_not (h : x, ¬p x) : ¬ x, p x := not_exists.mpr h
theorem forall_and : ( x, p x q x) ( x, p x) ( x, q x) :=
fun h => fun x => (h x).1, fun x => (h x).2, fun h₁, h₂ x => h₁ x, h₂ x
@@ -295,8 +292,6 @@ theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x,
@[simp] theorem exists_eq_left' : ( a, a' = a p a) p a' := by simp [@eq_comm _ a']
@[simp] theorem exists_eq_right' : ( a, p a a' = a) p a' := by simp [@eq_comm _ a']
@[simp] theorem forall_eq_or_imp : ( a, a = a' q a p a) p a' a, q a p a := by
simp only [or_imp, forall_and, forall_eq]
@@ -373,6 +368,9 @@ else isTrue fun h2 => absurd h2 h
theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) p := by simp
@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ¬p :=
of_decide_eq_false, decide_eq_false
@[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} :
decide p = decide q (p q) :=
fun h => by rw [ decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -8,22 +8,11 @@ import Lean.CoreM
namespace Lean
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.addDecl (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment :=
addDeclCore env (Core.getMaxHeartbeats opts).toUSize 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?
def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment := do
let env addDecl env opts decl
compileDecl env opts decl
def addDecl (decl : Declaration) : CoreM Unit := do
@@ -31,7 +20,7 @@ def addDecl (decl : Declaration) : CoreM Unit := do
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
if !( MonadLog.hasErrors) && decl.hasSorry then
logWarning "declaration uses 'sorry'"
match ( getEnv).addDecl ( getOptions) decl ( read).cancelTk? with
match ( getEnv).addDecl ( getOptions) decl with
| .ok env => setEnv env
| .error ex => throwKernelException ex

View File

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

View File

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

View File

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

View File

@@ -211,12 +211,12 @@ instance : MonadTrace CoreM where
structure SavedState extends State where
/-- Number of heartbeats passed inside `withRestoreOrSaveFull`, not used otherwise. -/
passedHeartbeats : Nat
passedHearbeats : Nat
deriving Nonempty
def saveState : CoreM SavedState := do
let s get
return { toState := s, passedHeartbeats := 0 }
return { toState := s, passedHearbeats := 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.passedHeartbeats.toUInt64
IO.addHeartbeats state.passedHearbeats.toUInt64
return (val, state)
let startHeartbeats IO.getNumHeartbeats
let a act
let s get
let stopHeartbeats IO.getNumHeartbeats
return (a, { toState := s, passedHeartbeats := stopHeartbeats - startHeartbeats })
return (a, { toState := s, passedHearbeats := stopHeartbeats - startHeartbeats })
/-- Restore backtrackable parts of the state. -/
def SavedState.restore (b : SavedState) : CoreM Unit :=
@@ -472,30 +472,23 @@ 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` 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.
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.
-/
@[inline] protected def Core.tryCatch (x : CoreM α) (h : Exception CoreM α) : CoreM α := do
try
x
catch ex =>
if ex.isInterrupt || ex.isRuntime then
throw ex
throw ex -- We should use `tryCatchRuntimeEx` for catching runtime exceptions
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
@@ -519,16 +512,4 @@ 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

View File

@@ -223,6 +223,8 @@ 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

View File

@@ -72,6 +72,8 @@ 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

View File

@@ -161,6 +161,8 @@ 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₀

View File

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

View File

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

View File

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

View File

@@ -1292,7 +1292,6 @@ private partial def elabAppFnId (fIdent : Syntax) (fExplicitUnivs : List Level)
funLVals.foldlM (init := acc) fun acc (f, fIdent, fields) => do
let lvals' := toLVals fields (first := true)
let s observing do
checkDeprecated fIdent f
let f addTermInfo fIdent f expectedType?
let e elabAppLVals f (lvals' ++ lvals) namedArgs args expectedType? explicit ellipsis
if overloaded then ensureHasType expectedType? e else return e
@@ -1425,27 +1424,8 @@ private def getSuccesses (candidates : Array (TermElabResult Expr)) : TermElabM
return false
return true
| _ => return false
if r₂.size == 0 then
return r₁
if r₂.size == 1 then
return r₂
/-
If there are still more than one solution, discard solutions that have pending metavariables.
We added this extra filter to address regressions introduced after fixing
`isDefEqStuckEx` behavior at `ExprDefEq.lean`.
-/
let r₂ candidates.filterM fun
| .ok _ s => do
try
s.restore
synthesizeSyntheticMVars (postpone := .no)
return true
catch _ =>
return false
| _ => return false
if r₂.size == 0 then
return r₁
return r₂
if r₂.size == 0 then return r₁ else return r₂
/--
Throw an error message that describes why each possible interpretation for the overloaded notation and symbols did not work.
We use a nested error message to aggregate the exceptions produced by each failure.

View File

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

View File

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

View File

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

View File

@@ -157,19 +157,9 @@ 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 =>
if pure (debug.byAsSorry.get ( getOptions)) <&&> isProp expectedType then
mkSorry expectedType false
else
mkTacticMVar expectedType stx
| some expectedType => mkTacticMVar expectedType stx
| none =>
tryPostpone
throwError ("invalid 'by' tactic, expected type has not been provided")
@@ -316,7 +306,9 @@ private def mkSilentAnnotationIfHole (e : Expr) : TermElabM Expr := do
return false
return true
if canClear then
withErasedFVars #[fvarId] do elabTerm body expectedType?
let lctx := ( getLCtx).erase fvarId
let localInsts := ( getLocalInstances).filter (·.fvar.fvarId! != fvarId)
withLCtx lctx localInsts do elabTerm body expectedType?
else
elabTerm body expectedType?

View File

@@ -81,10 +81,7 @@ Remark: see comment at TermElabM
@[always_inline]
instance : Monad CommandElabM := let i := inferInstanceAs (Monad CommandElabM); { pure := i.pure, bind := i.bind }
/--
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.
-/
/-- Like `Core.tryCatch` but do catch runtime exceptions. -/
@[inline] protected def tryCatch (x : CommandElabM α) (h : Exception CommandElabM α) :
CommandElabM α := do
try

View File

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

View File

@@ -22,7 +22,7 @@ structure LetRecDeclView where
type : Expr
mvar : Expr -- auxiliary metavariable used to lift the 'let rec'
valStx : Syntax
termination : TerminationHints
termination : WF.TerminationHints
structure LetRecView where
decls : Array LetRecDeclView
@@ -30,24 +30,20 @@ structure LetRecView where
/- group ("let " >> nonReservedSymbol "rec ") >> sepBy1 (group (optional «attributes» >> letDecl)) ", " >> "; " >> termParser -/
private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
let mut decls : Array LetRecDeclView := #[]
for attrDeclStx in letRec[1][0].getSepArgs do
let decls letRec[1][0].getSepArgs.mapM fun (attrDeclStx : Syntax) => 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?
@@ -65,11 +61,9 @@ private def mkLetRecDeclView (letRec : Syntax) : TermElabM LetRecView := do
pure decl[4]
else
liftMacroM <| expandMatchAltsIntoMatch decl decl[3]
let termination elabTerminationHints attrDeclStx[3]
decls := decls.push {
ref := declId, attrs, shortDeclName, declName,
binderIds, type, mvar, valStx, termination
}
let termination WF.elabTerminationHints attrDeclStx[3]
pure { ref := declId, attrs, shortDeclName, declName, binderIds, type, mvar, valStx,
termination : LetRecDeclView }
else
throwUnsupportedSyntax
return { decls, body := letRec[3] }

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,34 +1,14 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Joachim Breitner
Authors: Leonardo de Moura
-/
prelude
import Lean.Elab.PreDefinition.TerminationArgument
import Lean.Elab.PreDefinition.Structural.Basic
import Lean.Elab.PreDefinition.Structural.RecArgInfo
namespace Lean.Elab.Structural
open Meta
def prettyParam (xs : Array Expr) (i : Nat) : MetaM MessageData := do
let x := xs[i]!
let n x.fvarId!.getUserName
addMessageContextFull <| if n.hasMacroScopes then m!"#{i+1}" else m!"{x}"
def prettyRecArg (xs : Array Expr) (value : Expr) (recArgInfo : RecArgInfo) : MetaM MessageData := do
lambdaTelescope value fun ys _ => prettyParam (xs ++ ys) recArgInfo.recArgPos
def prettyParameterSet (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
(recArgInfos : Array RecArgInfo) : MetaM MessageData := do
if fnNames.size = 1 then
return m!"parameter " ++ ( prettyRecArg xs values[0]! recArgInfos[0]!)
else
let mut l := #[]
for fnName in fnNames, value in values, recArgInfo in recArgInfos do
l := l.push m!"{(← prettyRecArg xs value recArgInfo)} of {fnName}"
return m!"parameters " ++ .andList l.toList
private def getIndexMinPos (xs : Array Expr) (indices : Array Expr) : Nat := Id.run do
let mut minPos := xs.size
for index in indices do
@@ -49,233 +29,114 @@ private def hasBadIndexDep? (ys : Array Expr) (indices : Array Expr) : MetaM (Op
-- Inductive datatype parameters cannot depend on ys
private def hasBadParamDep? (ys : Array Expr) (indParams : Array Expr) : MetaM (Option (Expr × Expr)) := do
for p in indParams do
let pType inferType p
for y in ys do
if dependsOn p y.fvarId! then
if dependsOn pType y.fvarId! then
return some (p, y)
return none
/--
Assemble the `RecArgInfo` for the `i`th parameter in the parameter list `xs`. This performs
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"
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)
/--
Collects the `RecArgInfos` for one function, and returns a report for why the others were not
considered.
Try to find an argument that is structurally smaller in every recursive application.
We use this argument to justify termination using the auxiliary `brecOn` construction.
The `xs` are the fixed parameters, `value` the body with the fixed prefix instantiated.
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.
Takes the optional user annotations into account (`termArg?`). If this is given and the argument
is unsuitable, throw an error.
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.
-/
def getRecArgInfos (fnName : Name) (xs : Array Expr) (value : Expr)
(termArg? : Option TerminationArgument) : MetaM (Array RecArgInfo × MessageData) := do
lambdaTelescope value fun ys _ => do
if let .some termArg := termArg? then
-- User explictly asked to use a certain argument, so throw errors eagerly
let recArgInfo withRef termArg.ref do
mapError (f := (m!"cannot use specified parameter for structural recursion:{indentD ·}")) do
getRecArgInfo fnName xs.size (xs ++ ys) ( termArg.structuralArg)
return (#[recArgInfo], m!"")
else
let mut recArgInfos := #[]
let mut report : MessageData := m!""
-- No `termination_by`, so try all, and remember the errors
for idx in [:xs.size + ys.size] do
try
let recArgInfo getRecArgInfo fnName xs.size (xs ++ ys) idx
recArgInfos := recArgInfos.push recArgInfo
catch e =>
report := report ++ (m!"Not considering parameter {← prettyParam (xs ++ ys) idx} of {fnName}:" ++
indentD e.toMessageData) ++ "\n"
trace[Elab.definition.structural] "getRecArgInfos report: {report}"
return (recArgInfos, report)
/--
Reorders the `RecArgInfos` of one function to put arguments that are indices of other arguments
last.
See issue #837 for an example where we can show termination using the index of an inductive family, but
we don't get the desired definitional equalities.
-/
def nonIndicesFirst (recArgInfos : Array RecArgInfo) : Array RecArgInfo := Id.run do
let mut indicesPos : HashSet Nat := {}
for recArgInfo in recArgInfos do
for pos in recArgInfo.indicesPos do
indicesPos := indicesPos.insert pos
let (indices,nonIndices) := recArgInfos.partition (indicesPos.contains ·.recArgPos)
return nonIndices ++ indices
private def dedup [Monad m] (eq : α α m Bool) (xs : Array α) : m (Array α) := do
let mut ret := #[]
partial def findRecArg (numFixed : Nat) (xs : Array Expr) (k : RecArgInfo M α) : M α := do
/- Collect arguments that are indices. See comment above. -/
let indicesRef : IO.Ref FVarIdSet IO.mkRef {}
for x in xs do
unless ( ret.anyM (eq · x)) do
ret := ret.push x
return ret
/--
Given the `RecArgInfo`s of all the recursive functions, find the inductive groups to consider.
-/
def inductiveGroups (recArgInfos : Array RecArgInfo) : MetaM (Array IndGroupInst) :=
dedup IndGroupInst.isDefEq (recArgInfos.map (·.indGroupInst))
/--
Filters the `recArgInfos` by those that describe an argument that's part of the recursive inductive
group `group`.
Because of nested inductives this function has the ability to change the `recArgInfo`.
Consider
```
inductive Tree where | node : List Tree → Tree
```
then when we look for arguments whose type is part of the group `Tree`, we want to also consider
the argument of type `List Tree`, even though that arguments `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)
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
#[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"
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)
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
throwStructuralFailed
go (i := numFixed) (firstPass := true)
end Lean.Elab.Structural

View File

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

View File

@@ -1,93 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Lean.Meta.InferType
/-!
This module contains the types
* `IndGroupInfo`, a variant of `InductiveVal` with information that
applies to a whole group of mutual inductives and
* `IndGroupInst` which extends `IndGroupInfo` with levels and parameters
to indicate a instantiation of the group.
One purpose of this abstraction is to make it clear when a fuction operates on a group as
a whole, rather than a specific inductive within the group.
-/
namespace Lean.Elab.Structural
open Lean Meta
/--
A mutually inductive group, identified by the `all` array of the `InductiveVal` of its
constituents.
-/
structure IndGroupInfo where
all : Array Name
numNested : Nat
deriving BEq, Inhabited
def IndGroupInfo.ofInductiveVal (indInfo : InductiveVal) : IndGroupInfo where
all := indInfo.all.toArray
numNested := indInfo.numNested
def IndGroupInfo.numMotives (group : IndGroupInfo) : Nat :=
group.all.size + group.numNested
/--
An instance of an mutually inductive group of inductives, identified by the `all` array
and the level and expressions parameters.
For example this distinguishes between `List α` and `List β` so that we will not even attempt
mutual structural recursion on such incompatible types.
-/
structure IndGroupInst extends IndGroupInfo where
levels : List Level
params : Array Expr
deriving Inhabited
def IndGroupInst.toMessageData (igi : IndGroupInst) : MessageData :=
mkAppN (.const igi.all[0]! igi.levels) igi.params
instance : ToMessageData IndGroupInst where
toMessageData := IndGroupInst.toMessageData
def IndGroupInst.isDefEq (igi1 igi2 : IndGroupInst) : MetaM Bool := do
unless igi1.toIndGroupInfo == igi2.toIndGroupInfo do return false
unless igi1.levels.length = igi2.levels.length do return false
unless (igi1.levels.zip igi2.levels).all (fun (l₁, l₂) => Level.isEquiv l₁ l₂) do return false
unless igi1.params.size = igi2.params.size do return false
unless ( (igi1.params.zip igi2.params).allM (fun (e₁, e₂) => Meta.isDefEqGuarded e₁ e₂)) do return false
return true
/--
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

View File

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

View File

@@ -1,10 +1,9 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Joachim Breitner
Authors: Leonardo de Moura
-/
prelude
import Lean.Elab.PreDefinition.TerminationArgument
import Lean.Elab.PreDefinition.Structural.Basic
import Lean.Elab.PreDefinition.Structural.FindRecArg
import Lean.Elab.PreDefinition.Structural.Preprocess
@@ -12,7 +11,6 @@ import Lean.Elab.PreDefinition.Structural.BRecOn
import Lean.Elab.PreDefinition.Structural.IndPred
import Lean.Elab.PreDefinition.Structural.Eqns
import Lean.Elab.PreDefinition.Structural.SmartUnfolding
import Lean.Meta.Tactic.TryThis
namespace Lean.Elab
namespace Structural
@@ -59,129 +57,40 @@ private def getFixedPrefix (declName : Name) (xs : Array Expr) (value : Expr) :
return true
numFixedRef.get
partial def withCommonTelescope (preDefs : Array PreDefinition) (k : Array Expr Array Expr M α) : M α :=
go #[] (preDefs.map (·.value))
where
go (fvars : Array Expr) (vals : Array Expr) : M α := do
if !(vals.all fun val => val.isLambda) then
k fvars vals
else if !( vals.allM fun val => return val.bindingName! == vals[0]!.bindingName! && val.binderInfo == vals[0]!.binderInfo && ( isDefEq val.bindingDomain! vals[0]!.bindingDomain!)) then
k fvars vals
else
withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
go (fvars.push x) (vals.map fun val => val.bindingBody!.instantiate1 x)
private def elimRecursion (preDef : PreDefinition) : M (Nat × PreDefinition) := do
trace[Elab.definition.structural] "{preDef.declName} := {preDef.value}"
withoutModifyingEnv do lambdaTelescope preDef.value fun xs value => do
addAsAxiom preDef
let value preprocess value preDef.declName
trace[Elab.definition.structural] "{preDef.declName} {xs} :=\n{value}"
let numFixed getFixedPrefix preDef.declName xs value
trace[Elab.definition.structural] "numFixed: {numFixed}"
findRecArg numFixed xs fun recArgInfo => do
-- 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 })
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
def structuralRecursion (preDefs : Array PreDefinition) : TermElabM Unit :=
if preDefs.size != 1 then
throwError "structural recursion does not handle mutually recursive functions"
else do
let ((recArgPos, preDefNonRec), state) run <| elimRecursion preDefs[0]!
let preDefNonRec eraseRecAppSyntax preDefNonRec
-- state.addMatchers.forM liftM
mapError (f := (m!"structural recursion failed, produced type incorrect term{indentD ·}")) do
-- We create the `_unsafe_rec` before we abstract nested proofs.
-- Reason: the nested proofs may be referring to the _unsafe_rec.
addNonRec preDefNonRec (applyAttrAfterCompilation := false) (all := names.toList)
let preDefs preDefs.mapM (eraseRecAppSyntax ·)
addAndCompilePartialRec preDefs
for preDef in preDefs, recArgPos in recArgPoss do
let mut preDef := preDef
let mut preDef eraseRecAppSyntax preDefs[0]!
state.addMatchers.forM liftM
mapError (addNonRec preDefNonRec (applyAttrAfterCompilation := false)) fun msg =>
m!"structural recursion failed, produced type incorrect term{indentD msg}"
-- We create the `_unsafe_rec` before we abstract nested proofs.
-- Reason: the nested proofs may be referring to the _unsafe_rec.
addAndCompilePartialRec #[preDef]
unless preDef.kind.isTheorem do
unless ( isProp preDef.type) do
preDef abstractNestedProofs preDef
@@ -190,11 +99,13 @@ def structuralRecursion (preDefs : Array PreDefinition) (termArg?s : Array (Opti
for theorems and definitions that are propositions.
See issue #2327
-/
registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos
registerEqnsInfo preDef recArgPos
addSmartUnfoldingDef preDef recArgPos
markAsRecursive preDef.declName
applyAttributesOf preDefsNonRec AttributeApplicationTime.afterCompilation
applyAttributesOf #[preDefNonRec] AttributeApplicationTime.afterCompilation
builtin_initialize
registerTraceClass `Elab.definition.structural
end Structural

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

Some files were not shown because too many files have changed in this diff Show More