mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-29 16:24:08 +00:00
Compare commits
3 Commits
grind_offs
...
grind_fall
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
7d948b2763 | ||
|
|
b390ed1414 | ||
|
|
8bb20c80f2 |
1189
RELEASES.md
1189
RELEASES.md
File diff suppressed because it is too large
Load Diff
@@ -33,9 +33,6 @@ Format of the commit message
|
||||
- chore (maintain, ex: travis-ci)
|
||||
- perf (performance improvement, optimization, ...)
|
||||
|
||||
Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
|
||||
beginning with "This PR " that will be included in the changelog.
|
||||
|
||||
``<subject>`` has the following constraints:
|
||||
|
||||
- use imperative, present tense: "change" not "changed" nor "changes"
|
||||
@@ -47,7 +44,6 @@ beginning with "This PR " that will be included in the changelog.
|
||||
- just as in ``<subject>``, use imperative, present tense
|
||||
- includes motivation for the change and contrasts with previous
|
||||
behavior
|
||||
- If a `changelog-*` label is present, the body must begin with "This PR ".
|
||||
|
||||
``<footer>`` is optional and may contain two items:
|
||||
|
||||
@@ -64,21 +60,17 @@ Examples
|
||||
|
||||
fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
|
||||
|
||||
This PR adds declarations `operator<<` for raw printing.
|
||||
The actual implementation of these two operators is outside of the
|
||||
kernel. They are implemented in the file 'library/printer.cpp'.
|
||||
|
||||
We declare them in the kernel to prevent the following problem.
|
||||
Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
kernel. They are implemented in the file 'library/printer.cpp'. We
|
||||
declare them in the kernel to prevent the following problem. Suppose
|
||||
there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
but contains
|
||||
```cpp
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
```
|
||||
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
|
||||
The compiler does not generate an error message. It silently uses the
|
||||
operator bool() to coerce the expression into a Boolean. This produces
|
||||
counter-intuitive behavior, and may confuse developers.
|
||||
|
||||
|
||||
@@ -49,9 +49,8 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
|
||||
is represented by the representation of that parameter's type.
|
||||
|
||||
For example, `{ x : α // p }`, the `Subtype` structure of a value of type `α` and an irrelevant proof, is represented by the representation of `α`.
|
||||
Similarly, the signed integer types `Int8`, ..., `Int64`, `ISize` are also represented by the unsigned C types `uint8_t`, ..., `uint64_t`, `size_t`, respectively, because they have a trivial structure.
|
||||
* `Nat` and `Int` are represented by `lean_object *`.
|
||||
Their runtime values is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number or integer (`lean_box`/`lean_unbox`).
|
||||
* `Nat` is represented by `lean_object *`.
|
||||
Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
|
||||
* A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
|
||||
* Any other type is represented by `lean_object *`.
|
||||
Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.
|
||||
|
||||
@@ -80,10 +80,3 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
|
||||
`prelude` keyword. This disables the automated import of `Init`, meaning that
|
||||
developers need to figure out their own subset of `Init` to import. This is done
|
||||
such that changing files in `Init` doesn't force a full rebuild of `Lean`.
|
||||
|
||||
### Testing against Mathlib/Batteries
|
||||
You can test a Lean PR against Mathlib and Batteries by rebasing your PR
|
||||
on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
|
||||
CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
|
||||
that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
|
||||
See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.
|
||||
|
||||
@@ -5,6 +5,11 @@ See below for the checklist for release candidates.
|
||||
|
||||
We'll use `v4.6.0` as the intended release version as a running example.
|
||||
|
||||
- One week before the planned release, ensure that
|
||||
(1) someone has written the release notes and
|
||||
(2) someone has written the first draft of the release blog post.
|
||||
If there is any material in `./releases_drafts/` on the `releases/v4.6.0` branch, then the release notes are not done.
|
||||
(See the section "Writing the release notes".)
|
||||
- `git checkout releases/v4.6.0`
|
||||
(This branch should already exist, from the release candidates.)
|
||||
- `git pull`
|
||||
@@ -37,32 +42,16 @@ We'll use `v4.6.0` as the intended release version as a running example.
|
||||
- Create the tag `v4.6.0` from `master`/`main` and push it.
|
||||
- Merge the tag `v4.6.0` into the `stable` branch and push it.
|
||||
- We do this for the repositories:
|
||||
- [Batteries](https://github.com/leanprover-community/batteries)
|
||||
- No dependencies
|
||||
- Toolchain bump PR
|
||||
- Create and push the tag
|
||||
- Merge the tag into `stable`
|
||||
- [lean4checker](https://github.com/leanprover/lean4checker)
|
||||
- No dependencies
|
||||
- Toolchain bump PR
|
||||
- Create and push the tag
|
||||
- Merge the tag into `stable`
|
||||
- [doc-gen4](https://github.com/leanprover/doc-gen4)
|
||||
- Dependencies: exist, but they're not part of the release workflow
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
- [Verso](https://github.com/leanprover/verso)
|
||||
- Dependencies: exist, but they're not part of the release workflow
|
||||
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
- [Cli](https://github.com/leanprover/lean4-cli)
|
||||
- [Batteries](https://github.com/leanprover-community/batteries)
|
||||
- No dependencies
|
||||
- Toolchain bump PR
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
- Merge the tag into `stable`
|
||||
- [ProofWidgets4](https://github.com/leanprover-community/ProofWidgets4)
|
||||
- Dependencies: `Batteries`
|
||||
- Note on versions and branches:
|
||||
@@ -77,11 +66,18 @@ 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`
|
||||
- [import-graph](https://github.com/leanprover-community/import-graph)
|
||||
- [doc-gen4](https://github.com/leanprover/doc-gen4)
|
||||
- Dependencies: exist, but they're not part of the release workflow
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
- [plausible](https://github.com/leanprover-community/plausible)
|
||||
- [Verso](https://github.com/leanprover/verso)
|
||||
- Dependencies: exist, but they're not part of the release workflow
|
||||
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
- [import-graph](https://github.com/leanprover-community/import-graph)
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- There is no `stable` branch; skip this step
|
||||
@@ -90,7 +86,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
|
||||
- Toolchain bump PR notes:
|
||||
- In addition to updating the `lean-toolchain` and `lakefile.lean`,
|
||||
in `.github/workflows/lean4checker.yml` update the line
|
||||
`git checkout v4.6.0` to the appropriate tag.
|
||||
`git checkout v4.6.0` to the appropriate tag.
|
||||
- Push the PR branch to the main Mathlib repository rather than a fork, or CI may not work reliably
|
||||
- Create and push the tag
|
||||
- Create a new branch from the tag, push it, and open a pull request against `stable`.
|
||||
@@ -102,7 +98,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`
|
||||
- Run `scripts/release_checklist.py v4.6.0` to check that everything is in order.
|
||||
- The `v4.6.0` section of `RELEASES.md` is out of sync between
|
||||
`releases/v4.6.0` and `master`. This should be reconciled:
|
||||
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
|
||||
@@ -144,13 +139,16 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
|
||||
git checkout -b releases/v4.7.0
|
||||
```
|
||||
- In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
|
||||
- It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
|
||||
- We will rely on automatically generated release notes for release candidates,
|
||||
and the written release notes will be used for stable versions only.
|
||||
It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
|
||||
- In `src/CMakeLists.txt`,
|
||||
- verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
|
||||
- `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
|
||||
- Commit your changes to `src/CMakeLists.txt`, and push.
|
||||
- `git tag v4.7.0-rc1`
|
||||
- `git push origin v4.7.0-rc1`
|
||||
- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
|
||||
- Now wait, while CI runs.
|
||||
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
|
||||
- This step can take up to an hour.
|
||||
@@ -250,12 +248,15 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
|
||||
|
||||
# Writing the release notes
|
||||
|
||||
Release notes are automatically generated from the commit history, using `script/release_notes.py`.
|
||||
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:
|
||||
|
||||
Run this as `script/release_notes.py v4.6.0`, where `v4.6.0` is the *previous* release version. This will generate output
|
||||
for all commits since that tag. Note that there is output on both stderr, which should be manually reviewed,
|
||||
and on stdout, which should be manually copied to `RELEASES.md`.
|
||||
|
||||
There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
|
||||
* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
|
||||
The release notes for `v4.6.0` will later be copied to `master` when we begin a new development cycle.
|
||||
* There can be material for release notes entries in commit messages.
|
||||
* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
|
||||
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`).
|
||||
|
||||
16
releases_drafts/list_lex.md
Normal file
16
releases_drafts/list_lex.md
Normal file
@@ -0,0 +1,16 @@
|
||||
We replace the inductive predicate `List.lt` with an upstreamed version of `List.Lex` from Mathlib.
|
||||
(Previously `Lex.lt` was defined in terms of `<`; now it is generalized to take an arbitrary relation.)
|
||||
This subtely changes the notion of ordering on `List α`.
|
||||
|
||||
`List.lt` was a weaker relation: in particular if `l₁ < l₂`, then
|
||||
`a :: l₁ < b :: l₂` may hold according to `List.lt` even if `a` and `b` are merely incomparable
|
||||
(either neither `a < b` nor `b < a`), whereas according to `List.Lex` this would require `a = b`.
|
||||
|
||||
When `<` is total, in the sense that `¬ · < ·` is antisymmetric, then the two relations coincide.
|
||||
|
||||
Mathlib was already overriding the order instances for `List α`,
|
||||
so this change should not be noticed by anyone already using Mathlib.
|
||||
|
||||
We simultaneously add the boolean valued `List.lex` function, parameterised by a `BEq` typeclass
|
||||
and an arbitrary `lt` function. This will support the flexibility previously provided for `List.lt`,
|
||||
via a `==` function which is weaker than strict equality.
|
||||
@@ -63,8 +63,8 @@ else
|
||||
fi
|
||||
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
|
||||
# but do not change sysroot so users can still link against system libs
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP dynamically/as usual
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
|
||||
@@ -48,11 +48,12 @@ if [[ -L llvm-host ]]; then
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang"
|
||||
gcp $GMP/lib/libgmp.a stage1/lib/
|
||||
gcp $LIBUV/lib/libuv.a stage1/lib/
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv'"
|
||||
else
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/llvm-host/bin/clang -DLEANC_OPTS='--sysroot $PWD/stage1 -resource-dir $PWD/stage1/lib/clang/15.0.1 ${EXTRA_FLAGS:-}'"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
|
||||
fi
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
# do not set `LEAN_CC` for tests
|
||||
echo -n " -DLEAN_TEST_VARS=''"
|
||||
|
||||
@@ -43,7 +43,7 @@ echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=
|
||||
echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
|
||||
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP dynamically/as usual. Always link ICU dynamically.
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
|
||||
@@ -1,132 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import argparse
|
||||
import yaml
|
||||
import requests
|
||||
import base64
|
||||
import subprocess
|
||||
import sys
|
||||
import os
|
||||
|
||||
def parse_repos_config(file_path):
|
||||
with open(file_path, "r") as f:
|
||||
return yaml.safe_load(f)["repositories"]
|
||||
|
||||
def get_github_token():
|
||||
try:
|
||||
import subprocess
|
||||
result = subprocess.run(['gh', 'auth', 'token'], capture_output=True, text=True)
|
||||
if result.returncode == 0:
|
||||
return result.stdout.strip()
|
||||
except FileNotFoundError:
|
||||
print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
|
||||
return None
|
||||
|
||||
def get_branch_content(repo_url, branch, file_path, github_token):
|
||||
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
|
||||
headers = {'Authorization': f'token {github_token}'} if github_token else {}
|
||||
response = requests.get(api_url, headers=headers)
|
||||
if response.status_code == 200:
|
||||
content = response.json().get("content", "")
|
||||
content = content.replace("\n", "")
|
||||
try:
|
||||
return base64.b64decode(content).decode('utf-8').strip()
|
||||
except Exception:
|
||||
return None
|
||||
return None
|
||||
|
||||
def tag_exists(repo_url, tag_name, github_token):
|
||||
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
|
||||
headers = {'Authorization': f'token {github_token}'} if github_token else {}
|
||||
response = requests.get(api_url, headers=headers)
|
||||
return response.status_code == 200
|
||||
|
||||
def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
|
||||
# First get the commit SHA for the tag
|
||||
api_base = repo_url.replace("https://github.com/", "https://api.github.com/repos/")
|
||||
headers = {'Authorization': f'token {github_token}'} if github_token else {}
|
||||
|
||||
# Get tag's commit SHA
|
||||
tag_response = requests.get(f"{api_base}/git/refs/tags/{tag_name}", headers=headers)
|
||||
if tag_response.status_code != 200:
|
||||
return False
|
||||
tag_sha = tag_response.json()['object']['sha']
|
||||
|
||||
# Get commits on stable branch containing this SHA
|
||||
commits_response = requests.get(
|
||||
f"{api_base}/commits?sha={stable_branch}&per_page=100",
|
||||
headers=headers
|
||||
)
|
||||
if commits_response.status_code != 200:
|
||||
return False
|
||||
|
||||
# Check if any commit in stable's history matches our tag's SHA
|
||||
stable_commits = [commit['sha'] for commit in commits_response.json()]
|
||||
return tag_sha in stable_commits
|
||||
|
||||
def parse_version(version_str):
|
||||
# Remove 'v' prefix and split into components
|
||||
# Handle Lean toolchain format (leanprover/lean4:v4.x.y)
|
||||
if ':' in version_str:
|
||||
version_str = version_str.split(':')[1]
|
||||
version = version_str.lstrip('v')
|
||||
# Handle release candidates by removing -rc part for comparison
|
||||
version = version.split('-')[0]
|
||||
return tuple(map(int, version.split('.')))
|
||||
|
||||
def is_version_gte(version1, version2):
|
||||
"""Check if version1 >= version2"""
|
||||
return parse_version(version1) >= parse_version(version2)
|
||||
|
||||
def is_release_candidate(version):
|
||||
return "-rc" in version
|
||||
|
||||
def main():
|
||||
github_token = get_github_token()
|
||||
|
||||
if len(sys.argv) != 2:
|
||||
print("Usage: python3 release_checklist.py <toolchain>")
|
||||
sys.exit(1)
|
||||
|
||||
toolchain = sys.argv[1]
|
||||
|
||||
with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
|
||||
repos = yaml.safe_load(f)["repositories"]
|
||||
|
||||
for repo in repos:
|
||||
name = repo["name"]
|
||||
url = repo["url"]
|
||||
branch = repo["branch"]
|
||||
check_stable = repo["stable-branch"]
|
||||
check_tag = repo.get("toolchain-tag", True)
|
||||
|
||||
print(f"\nRepository: {name}")
|
||||
|
||||
# Check if branch is on at least the target toolchain
|
||||
lean_toolchain_content = get_branch_content(url, branch, "lean-toolchain", github_token)
|
||||
if lean_toolchain_content is None:
|
||||
print(f" ❌ No lean-toolchain file found in {branch} branch")
|
||||
continue
|
||||
|
||||
on_target_toolchain = is_version_gte(lean_toolchain_content.strip(), toolchain)
|
||||
if not on_target_toolchain:
|
||||
print(f" ❌ Not on target toolchain (needs ≥ {toolchain}, but {branch} is on {lean_toolchain_content.strip()})")
|
||||
continue
|
||||
print(f" ✅ On compatible toolchain (>= {toolchain})")
|
||||
|
||||
# Only check for tag if toolchain-tag is true
|
||||
if check_tag:
|
||||
if not tag_exists(url, toolchain, github_token):
|
||||
print(f" ❌ Tag {toolchain} does not exist")
|
||||
continue
|
||||
print(f" ✅ Tag {toolchain} exists")
|
||||
|
||||
# Only check merging into stable if stable-branch is true and not a release candidate
|
||||
if check_stable and not is_release_candidate(toolchain):
|
||||
if not is_merged_into_stable(url, toolchain, "stable", github_token):
|
||||
print(f" ❌ Tag {toolchain} is not merged into stable")
|
||||
continue
|
||||
print(f" ✅ Tag {toolchain} is merged into stable")
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
@@ -1,145 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import sys
|
||||
import re
|
||||
import json
|
||||
import requests
|
||||
import subprocess
|
||||
from collections import defaultdict
|
||||
from git import Repo
|
||||
|
||||
def get_commits_since_tag(repo, tag):
|
||||
try:
|
||||
tag_commit = repo.commit(tag)
|
||||
commits = list(repo.iter_commits(f"{tag_commit.hexsha}..HEAD"))
|
||||
return [
|
||||
(commit.hexsha, commit.message.splitlines()[0], commit.message)
|
||||
for commit in commits
|
||||
]
|
||||
except Exception as e:
|
||||
sys.stderr.write(f"Error retrieving commits: {e}\n")
|
||||
sys.exit(1)
|
||||
|
||||
def check_pr_number(first_line):
|
||||
match = re.search(r"\(\#(\d+)\)$", first_line)
|
||||
if match:
|
||||
return int(match.group(1))
|
||||
return None
|
||||
|
||||
def fetch_pr_labels(pr_number):
|
||||
try:
|
||||
# Use gh CLI to fetch PR details
|
||||
result = subprocess.run([
|
||||
"gh", "api", f"repos/leanprover/lean4/pulls/{pr_number}"
|
||||
], capture_output=True, text=True, check=True)
|
||||
pr_data = result.stdout
|
||||
pr_json = json.loads(pr_data)
|
||||
return [label["name"] for label in pr_json.get("labels", [])]
|
||||
except subprocess.CalledProcessError as e:
|
||||
sys.stderr.write(f"Failed to fetch PR #{pr_number} using gh: {e.stderr}\n")
|
||||
return []
|
||||
|
||||
def format_section_title(label):
|
||||
title = label.replace("changelog-", "").capitalize()
|
||||
if title == "Doc":
|
||||
return "Documentation"
|
||||
elif title == "Pp":
|
||||
return "Pretty Printing"
|
||||
return title
|
||||
|
||||
def sort_sections_order():
|
||||
return [
|
||||
"Language",
|
||||
"Library",
|
||||
"Compiler",
|
||||
"Pretty Printing",
|
||||
"Documentation",
|
||||
"Server",
|
||||
"Lake",
|
||||
"Other",
|
||||
"Uncategorised"
|
||||
]
|
||||
|
||||
def format_markdown_description(pr_number, description):
|
||||
link = f"[#{pr_number}](https://github.com/leanprover/lean4/pull/{pr_number})"
|
||||
return f"{link} {description}"
|
||||
|
||||
def main():
|
||||
if len(sys.argv) != 2:
|
||||
sys.stderr.write("Usage: script.py <git-tag>\n")
|
||||
sys.exit(1)
|
||||
|
||||
tag = sys.argv[1]
|
||||
try:
|
||||
repo = Repo(".")
|
||||
except Exception as e:
|
||||
sys.stderr.write(f"Error opening Git repository: {e}\n")
|
||||
sys.exit(1)
|
||||
|
||||
commits = get_commits_since_tag(repo, tag)
|
||||
|
||||
sys.stderr.write(f"Found {len(commits)} commits since tag {tag}:\n")
|
||||
for commit_hash, first_line, _ in commits:
|
||||
sys.stderr.write(f"- {commit_hash}: {first_line}\n")
|
||||
|
||||
changelog = defaultdict(list)
|
||||
|
||||
for commit_hash, first_line, full_message in commits:
|
||||
# Skip commits with the specific first lines
|
||||
if first_line == "chore: update stage0" or first_line.startswith("chore: CI: bump "):
|
||||
continue
|
||||
|
||||
pr_number = check_pr_number(first_line)
|
||||
|
||||
if not pr_number:
|
||||
sys.stderr.write(f"No PR number found in {first_line}\n")
|
||||
continue
|
||||
|
||||
# Remove the first line from the full_message for further processing
|
||||
body = full_message[len(first_line):].strip()
|
||||
|
||||
paragraphs = body.split('\n\n')
|
||||
second_paragraph = paragraphs[0] if len(paragraphs) > 0 else ""
|
||||
|
||||
labels = fetch_pr_labels(pr_number)
|
||||
|
||||
# Skip entries with the "changelog-no" label
|
||||
if "changelog-no" in labels:
|
||||
continue
|
||||
|
||||
report_errors = first_line.startswith("feat:") or first_line.startswith("fix:")
|
||||
|
||||
if not second_paragraph.startswith("This PR "):
|
||||
if report_errors:
|
||||
sys.stderr.write(f"No PR description found in commit:\n{commit_hash}\n{first_line}\n{body}\n\n")
|
||||
fallback_description = re.sub(r":$", "", first_line.split(" ", 1)[1]).rsplit(" (#", 1)[0]
|
||||
markdown_description = format_markdown_description(pr_number, fallback_description)
|
||||
else:
|
||||
continue
|
||||
else:
|
||||
markdown_description = format_markdown_description(pr_number, second_paragraph.replace("This PR ", ""))
|
||||
|
||||
changelog_labels = [label for label in labels if label.startswith("changelog-")]
|
||||
if len(changelog_labels) > 1:
|
||||
sys.stderr.write(f"Warning: Multiple changelog-* labels found for PR #{pr_number}: {changelog_labels}\n")
|
||||
|
||||
if not changelog_labels:
|
||||
if report_errors:
|
||||
sys.stderr.write(f"Warning: No changelog-* label found for PR #{pr_number}\n")
|
||||
else:
|
||||
continue
|
||||
|
||||
for label in changelog_labels:
|
||||
changelog[label].append((pr_number, markdown_description))
|
||||
|
||||
section_order = sort_sections_order()
|
||||
sorted_changelog = sorted(changelog.items(), key=lambda item: section_order.index(format_section_title(item[0])) if format_section_title(item[0]) in section_order else len(section_order))
|
||||
|
||||
for label, entries in sorted_changelog:
|
||||
section_title = format_section_title(label) if label != "Uncategorised" else "Uncategorised"
|
||||
print(f"## {section_title}\n")
|
||||
for _, entry in sorted(entries, key=lambda x: x[0]):
|
||||
print(f"* {entry}\n")
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
@@ -1,86 +0,0 @@
|
||||
repositories:
|
||||
- name: Batteries
|
||||
url: https://github.com/leanprover-community/batteries
|
||||
toolchain-tag: true
|
||||
stable-branch: true
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: lean4checker
|
||||
url: https://github.com/leanprover/lean4checker
|
||||
toolchain-tag: true
|
||||
stable-branch: true
|
||||
branch: master
|
||||
dependencies: []
|
||||
|
||||
- name: doc-gen4
|
||||
url: https://github.com/leanprover/doc-gen4
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: Verso
|
||||
url: https://github.com/leanprover/verso
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: Cli
|
||||
url: https://github.com/leanprover/lean4-cli
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: ProofWidgets4
|
||||
url: https://github.com/leanprover-community/ProofWidgets4
|
||||
toolchain-tag: false
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies:
|
||||
- Batteries
|
||||
|
||||
- name: Aesop
|
||||
url: https://github.com/leanprover-community/aesop
|
||||
toolchain-tag: true
|
||||
stable-branch: true
|
||||
branch: master
|
||||
dependencies:
|
||||
- Batteries
|
||||
|
||||
- name: import-graph
|
||||
url: https://github.com/leanprover-community/import-graph
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: plausible
|
||||
url: https://github.com/leanprover-community/plausible
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: main
|
||||
dependencies: []
|
||||
|
||||
- name: Mathlib
|
||||
url: https://github.com/leanprover-community/mathlib4
|
||||
toolchain-tag: true
|
||||
stable-branch: true
|
||||
branch: master
|
||||
dependencies:
|
||||
- Aesop
|
||||
- ProofWidgets4
|
||||
- lean4checker
|
||||
- Batteries
|
||||
- doc-gen4
|
||||
- import-graph
|
||||
|
||||
- name: REPL
|
||||
url: https://github.com/leanprover-community/repl
|
||||
toolchain-tag: true
|
||||
stable-branch: true
|
||||
branch: master
|
||||
dependencies:
|
||||
- Mathlib
|
||||
@@ -150,10 +150,6 @@ See the `simp` tactic for more information. -/
|
||||
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
/-- `simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
|
||||
that would be sufficient to close the goal. See the `simp?` tactic for more information. -/
|
||||
syntax (name := simpTrace) "simp?" optConfig (discharger)? (&" only")? (simpArgs)? : conv
|
||||
|
||||
/--
|
||||
`dsimp` is the definitional simplifier in `conv`-mode. It differs from `simp` in that it only
|
||||
applies theorems that hold by reflexivity.
|
||||
@@ -171,9 +167,6 @@ example (a : Nat): (0 + 0) = a - a := by
|
||||
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
@[inherit_doc simpTrace]
|
||||
syntax (name := dsimpTrace) "dsimp?" optConfig (&" only")? (dsimpArgs)? : conv
|
||||
|
||||
/-- `simp_match` simplifies match expressions. For example,
|
||||
```
|
||||
match [a, b] with
|
||||
|
||||
@@ -244,7 +244,8 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
|
||||
def range (n : Nat) : Array Nat :=
|
||||
ofFn fun (i : Fin n) => i
|
||||
|
||||
@[inline] protected def singleton (v : α) : Array α := #[v]
|
||||
def singleton (v : α) : Array α :=
|
||||
mkArray 1 v
|
||||
|
||||
def back! [Inhabited α] (a : Array α) : α :=
|
||||
a[a.size - 1]!
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -9,9 +9,7 @@ import Init.Data.Bool
|
||||
import Init.Data.BitVec.Basic
|
||||
import Init.Data.Fin.Lemmas
|
||||
import Init.Data.Nat.Lemmas
|
||||
import Init.Data.Nat.Div.Lemmas
|
||||
import Init.Data.Nat.Mod
|
||||
import Init.Data.Nat.Div.Lemmas
|
||||
import Init.Data.Int.Bitwise.Lemmas
|
||||
import Init.Data.Int.Pow
|
||||
|
||||
@@ -100,12 +98,6 @@ theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by
|
||||
theorem eq_of_toNat_eq {n} : ∀ {x y : BitVec n}, x.toNat = y.toNat → x = y
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
|
||||
/-- Prove nonequality of bitvectors in terms of nat operations. -/
|
||||
theorem toNat_ne_iff_ne {n} {x y : BitVec n} : x.toNat ≠ y.toNat ↔ x ≠ y := by
|
||||
constructor
|
||||
· rintro h rfl; apply h rfl
|
||||
· intro h h_eq; apply h <| eq_of_toNat_eq h_eq
|
||||
|
||||
@[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl
|
||||
|
||||
@[bv_toNat] theorem toNat_eq {x y : BitVec n} : x = y ↔ x.toNat = y.toNat :=
|
||||
@@ -450,10 +442,6 @@ theorem toInt_eq_toNat_cond (x : BitVec n) :
|
||||
(x.toNat : Int) - (2^n : Nat) :=
|
||||
rfl
|
||||
|
||||
theorem toInt_eq_toNat_of_lt {x : BitVec n} (h : 2 * x.toNat < 2^n) :
|
||||
x.toInt = x.toNat := by
|
||||
simp [toInt_eq_toNat_cond, h]
|
||||
|
||||
theorem msb_eq_false_iff_two_mul_lt {x : BitVec w} : x.msb = false ↔ 2 * x.toNat < 2^w := by
|
||||
cases w <;> simp [Nat.pow_succ, Nat.mul_comm _ 2, msb_eq_decide, toNat_of_zero_length]
|
||||
|
||||
@@ -466,9 +454,6 @@ theorem toInt_eq_msb_cond (x : BitVec w) :
|
||||
simp only [BitVec.toInt, ← msb_eq_false_iff_two_mul_lt]
|
||||
cases x.msb <;> rfl
|
||||
|
||||
theorem toInt_eq_toNat_of_msb {x : BitVec w} (h : x.msb = false) :
|
||||
x.toInt = x.toNat := by
|
||||
simp [toInt_eq_msb_cond, h]
|
||||
|
||||
theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) := by
|
||||
simp only [toInt_eq_toNat_cond]
|
||||
@@ -800,19 +785,6 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
|
||||
unfold allOnes
|
||||
simp
|
||||
|
||||
@[simp] theorem toInt_allOnes : (allOnes w).toInt = if 0 < w then -1 else 0 := by
|
||||
norm_cast
|
||||
by_cases h : w = 0
|
||||
· subst h
|
||||
simp
|
||||
· have : 1 < 2 ^ w := by simp [h]
|
||||
simp [BitVec.toInt]
|
||||
omega
|
||||
|
||||
@[simp] theorem toFin_allOnes : (allOnes w).toFin = Fin.ofNat' (2^w) (2^w - 1) := by
|
||||
ext
|
||||
simp
|
||||
|
||||
@[simp] theorem getLsbD_allOnes : (allOnes v).getLsbD i = decide (i < v) := by
|
||||
simp [allOnes]
|
||||
|
||||
@@ -1170,16 +1142,11 @@ theorem getMsb_not {x : BitVec w} :
|
||||
/-! ### shiftLeft -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
|
||||
(x <<< n).toNat = x.toNat <<< n % 2^v :=
|
||||
BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v :=
|
||||
BitVec.toNat_ofNat _ _
|
||||
|
||||
@[simp] theorem toInt_shiftLeft {x : BitVec w} :
|
||||
(x <<< n).toInt = (x.toNat <<< n : Int).bmod (2^w) := by
|
||||
rw [toInt_eq_toNat_bmod, toNat_shiftLeft, Nat.shiftLeft_eq]
|
||||
simp
|
||||
|
||||
@[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) :
|
||||
(x <<< n).toFin = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
|
||||
BitVec.toFin (x <<< n) = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
|
||||
|
||||
@[simp]
|
||||
theorem shiftLeft_zero (x : BitVec w) : x <<< 0 = x := by
|
||||
@@ -2315,12 +2282,6 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
|
||||
@[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
|
||||
simp [Neg.neg, BitVec.neg]
|
||||
|
||||
theorem toNat_neg_of_pos {x : BitVec n} (h : 0#n < x) :
|
||||
(- x).toNat = 2^n - x.toNat := by
|
||||
change 0 < x.toNat at h
|
||||
rw [toNat_neg, Nat.mod_eq_of_lt]
|
||||
omega
|
||||
|
||||
theorem toInt_neg {x : BitVec w} :
|
||||
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
|
||||
rw [← BitVec.zero_sub, toInt_sub]
|
||||
@@ -2416,54 +2377,6 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
|
||||
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
|
||||
omega
|
||||
|
||||
/-! ### fill -/
|
||||
|
||||
@[simp]
|
||||
theorem getLsbD_fill {w i : Nat} {v : Bool} :
|
||||
(fill w v).getLsbD i = (v && decide (i < w)) := by
|
||||
by_cases h : v
|
||||
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
|
||||
|
||||
@[simp]
|
||||
theorem getMsbD_fill {w i : Nat} {v : Bool} :
|
||||
(fill w v).getMsbD i = (v && decide (i < w)) := by
|
||||
by_cases h : v
|
||||
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
|
||||
|
||||
@[simp]
|
||||
theorem getElem_fill {w i : Nat} {v : Bool} (h : i < w) :
|
||||
(fill w v)[i] = v := by
|
||||
by_cases h : v
|
||||
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
|
||||
|
||||
@[simp]
|
||||
theorem msb_fill {w : Nat} {v : Bool} :
|
||||
(fill w v).msb = (v && decide (0 < w)) := by
|
||||
simp [BitVec.msb]
|
||||
|
||||
theorem fill_eq {w : Nat} {v : Bool} : fill w v = if v = true then allOnes w else 0#w := by
|
||||
by_cases h : v <;> (simp only [h] ; ext ; simp)
|
||||
|
||||
@[simp]
|
||||
theorem fill_true {w : Nat} : fill w true = allOnes w := by
|
||||
simp [fill_eq]
|
||||
|
||||
@[simp]
|
||||
theorem fill_false {w : Nat} : fill w false = 0#w := by
|
||||
simp [fill_eq]
|
||||
|
||||
@[simp] theorem fill_toNat {w : Nat} {v : Bool} :
|
||||
(fill w v).toNat = if v = true then 2^w - 1 else 0 := by
|
||||
by_cases h : v <;> simp [h]
|
||||
|
||||
@[simp] theorem fill_toInt {w : Nat} {v : Bool} :
|
||||
(fill w v).toInt = if v = true && 0 < w then -1 else 0 := by
|
||||
by_cases h : v <;> simp [h]
|
||||
|
||||
@[simp] theorem fill_toFin {w : Nat} {v : Bool} :
|
||||
(fill w v).toFin = if v = true then (allOnes w).toFin else Fin.ofNat' (2 ^ w) 0 := by
|
||||
by_cases h : v <;> simp [h]
|
||||
|
||||
/-! ### mul -/
|
||||
|
||||
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
|
||||
@@ -2607,13 +2520,13 @@ theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) :
|
||||
rw [← udiv_eq]
|
||||
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
|
||||
|
||||
@[simp]
|
||||
theorem toFin_udiv {x y : BitVec n} : (x / y).toFin = x.toFin / y.toFin := by
|
||||
rfl
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_udiv {x y : BitVec n} : (x / y).toNat = x.toNat / y.toNat := by
|
||||
rfl
|
||||
rw [udiv_def]
|
||||
by_cases h : y = 0
|
||||
· simp [h]
|
||||
· rw [toNat_ofNat, Nat.mod_eq_of_lt]
|
||||
exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
|
||||
|
||||
@[simp]
|
||||
theorem zero_udiv {x : BitVec w} : (0#w) / x = 0#w := by
|
||||
@@ -2649,45 +2562,6 @@ theorem udiv_self {x : BitVec w} :
|
||||
↓reduceIte, toNat_udiv]
|
||||
rw [Nat.div_self (by omega), Nat.mod_eq_of_lt (by omega)]
|
||||
|
||||
theorem msb_udiv (x y : BitVec w) :
|
||||
(x / y).msb = (x.msb && y == 1#w) := by
|
||||
cases msb_x : x.msb
|
||||
· suffices x.toNat / y.toNat < 2 ^ (w - 1) by simpa [msb_eq_decide]
|
||||
calc
|
||||
x.toNat / y.toNat ≤ x.toNat := by apply Nat.div_le_self
|
||||
_ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
|
||||
. rcases w with _|w
|
||||
· contradiction
|
||||
· have : (y == 1#_) = decide (y.toNat = 1) := by
|
||||
simp [(· == ·), toNat_eq]
|
||||
simp only [this, Bool.true_and]
|
||||
match hy : y.toNat with
|
||||
| 0 =>
|
||||
obtain rfl : y = 0#_ := eq_of_toNat_eq hy
|
||||
simp
|
||||
| 1 =>
|
||||
obtain rfl : y = 1#_ := eq_of_toNat_eq (by simp [hy])
|
||||
simpa using msb_x
|
||||
| y + 2 =>
|
||||
suffices x.toNat / (y + 2) < 2 ^ w by
|
||||
simp_all [msb_eq_decide, hy]
|
||||
calc
|
||||
x.toNat / (y + 2)
|
||||
≤ x.toNat / 2 := by apply Nat.div_add_le_right (by omega)
|
||||
_ < 2 ^ w := by omega
|
||||
|
||||
theorem msb_udiv_eq_false_of {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
|
||||
(x / y).msb = false := by
|
||||
simp [msb_udiv, h]
|
||||
|
||||
/--
|
||||
If `x` is nonnegative (i.e., does not have its msb set),
|
||||
then `x / y` is nonnegative, thus `toInt` and `toNat` coincide.
|
||||
-/
|
||||
theorem toInt_udiv_of_msb {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
|
||||
(x / y).toInt = x.toNat / y.toNat := by
|
||||
simp [toInt_eq_msb_cond, msb_udiv_eq_false_of h]
|
||||
|
||||
/-! ### umod -/
|
||||
|
||||
theorem umod_def {x y : BitVec n} :
|
||||
@@ -2700,10 +2574,6 @@ theorem umod_def {x y : BitVec n} :
|
||||
theorem toNat_umod {x y : BitVec n} :
|
||||
(x % y).toNat = x.toNat % y.toNat := rfl
|
||||
|
||||
@[simp]
|
||||
theorem toFin_umod {x y : BitVec w} :
|
||||
(x % y).toFin = x.toFin % y.toFin := rfl
|
||||
|
||||
@[simp]
|
||||
theorem umod_zero {x : BitVec n} : x % 0#n = x := by
|
||||
simp [umod_def]
|
||||
@@ -2731,55 +2601,6 @@ theorem umod_eq_and {x y : BitVec 1} : x % y = x &&& (~~~y) := by
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
theorem umod_eq_of_lt {x y : BitVec w} (h : x < y) :
|
||||
x % y = x := by
|
||||
apply eq_of_toNat_eq
|
||||
simp [Nat.mod_eq_of_lt h]
|
||||
|
||||
@[simp]
|
||||
theorem msb_umod {x y : BitVec w} :
|
||||
(x % y).msb = (x.msb && (x < y || y == 0#w)) := by
|
||||
rw [msb_eq_decide, toNat_umod]
|
||||
cases msb_x : x.msb
|
||||
· suffices x.toNat % y.toNat < 2 ^ (w - 1) by simpa
|
||||
calc
|
||||
x.toNat % y.toNat ≤ x.toNat := by apply Nat.mod_le
|
||||
_ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
|
||||
. by_cases hy : y = 0
|
||||
· simp_all [msb_eq_decide]
|
||||
· suffices 2 ^ (w - 1) ≤ x.toNat % y.toNat ↔ x < y by simp_all
|
||||
by_cases x_lt_y : x < y
|
||||
. simp_all [Nat.mod_eq_of_lt x_lt_y, msb_eq_decide]
|
||||
· suffices x.toNat % y.toNat < 2 ^ (w - 1) by
|
||||
simpa [x_lt_y]
|
||||
have y_le_x : y.toNat ≤ x.toNat := by
|
||||
simpa using x_lt_y
|
||||
replace hy : y.toNat ≠ 0 :=
|
||||
toNat_ne_iff_ne.mpr hy
|
||||
by_cases msb_y : y.toNat < 2 ^ (w - 1)
|
||||
· have : x.toNat % y.toNat < y.toNat := Nat.mod_lt _ (by omega)
|
||||
omega
|
||||
· rcases w with _|w
|
||||
· contradiction
|
||||
simp only [Nat.add_one_sub_one]
|
||||
replace msb_y : 2 ^ w ≤ y.toNat := by
|
||||
simpa using msb_y
|
||||
have : y.toNat ≤ y.toNat * (x.toNat / y.toNat) := by
|
||||
apply Nat.le_mul_of_pos_right
|
||||
apply Nat.div_pos y_le_x
|
||||
omega
|
||||
have : x.toNat % y.toNat ≤ x.toNat - y.toNat := by
|
||||
rw [Nat.mod_eq_sub]; omega
|
||||
omega
|
||||
|
||||
theorem toInt_umod {x y : BitVec w} :
|
||||
(x % y).toInt = (x.toNat % y.toNat : Int).bmod (2 ^ w) := by
|
||||
simp [toInt_eq_toNat_bmod]
|
||||
|
||||
theorem toInt_umod_of_msb {x y : BitVec w} (h : x.msb = false) :
|
||||
(x % y).toInt = x.toInt % y.toNat := by
|
||||
simp [toInt_eq_msb_cond, h]
|
||||
|
||||
/-! ### smtUDiv -/
|
||||
|
||||
theorem smtUDiv_eq (x y : BitVec w) : smtUDiv x y = if y = 0#w then allOnes w else x / y := by
|
||||
@@ -2936,12 +2757,7 @@ theorem smod_zero {x : BitVec n} : x.smod 0#n = x := by
|
||||
|
||||
/-! # Rotate Left -/
|
||||
|
||||
/--`rotateLeft` is defined in terms of left and right shifts. -/
|
||||
theorem rotateLeft_def {x : BitVec w} {r : Nat} :
|
||||
x.rotateLeft r = (x <<< (r % w)) ||| (x >>> (w - r % w)) := by
|
||||
simp only [rotateLeft, rotateLeftAux]
|
||||
|
||||
/-- `rotateLeft` is invariant under `mod` by the bitwidth. -/
|
||||
/-- rotateLeft is invariant under `mod` by the bitwidth. -/
|
||||
@[simp]
|
||||
theorem rotateLeft_mod_eq_rotateLeft {x : BitVec w} {r : Nat} :
|
||||
x.rotateLeft (r % w) = x.rotateLeft r := by
|
||||
@@ -3085,18 +2901,8 @@ theorem msb_rotateLeft {m w : Nat} {x : BitVec w} :
|
||||
· simp
|
||||
omega
|
||||
|
||||
@[simp]
|
||||
theorem toNat_rotateLeft {x : BitVec w} {r : Nat} :
|
||||
(x.rotateLeft r).toNat = (x.toNat <<< (r % w)) % (2^w) ||| x.toNat >>> (w - r % w) := by
|
||||
simp only [rotateLeft_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
|
||||
|
||||
/-! ## Rotate Right -/
|
||||
|
||||
/-- `rotateRight` is defined in terms of left and right shifts. -/
|
||||
theorem rotateRight_def {x : BitVec w} {r : Nat} :
|
||||
x.rotateRight r = (x >>> (r % w)) ||| (x <<< (w - r % w)) := by
|
||||
simp only [rotateRight, rotateRightAux]
|
||||
|
||||
/--
|
||||
Accessing bits in `x.rotateRight r` the range `[0, w-r)` is equal to
|
||||
accessing bits `x` in the range `[r, w)`.
|
||||
@@ -3232,11 +3038,6 @@ theorem msb_rotateRight {r w : Nat} {x : BitVec w} :
|
||||
simp [h₁]
|
||||
· simp [show w = 0 by omega]
|
||||
|
||||
@[simp]
|
||||
theorem toNat_rotateRight {x : BitVec w} {r : Nat} :
|
||||
(x.rotateRight r).toNat = (x.toNat >>> (r % w)) ||| x.toNat <<< (w - r % w) % (2^w) := by
|
||||
simp only [rotateRight_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
|
||||
|
||||
/- ## twoPow -/
|
||||
|
||||
theorem twoPow_eq (w : Nat) (i : Nat) : twoPow w i = 1#w <<< i := by
|
||||
|
||||
@@ -534,13 +534,6 @@ theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by
|
||||
@[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by
|
||||
conv => rhs; rw [← emod_add_ediv a b, add_mul_emod_self_left]
|
||||
|
||||
@[simp] theorem emod_sub_emod (m n k : Int) : (m % n - k) % n = (m - k) % n :=
|
||||
Int.emod_add_emod m n (-k)
|
||||
|
||||
@[simp] theorem sub_emod_emod (m n k : Int) : (m - n % k) % k = (m - n) % k := by
|
||||
apply (emod_add_cancel_right (n % k)).mp
|
||||
rw [Int.sub_add_cancel, Int.add_emod_emod, Int.sub_add_cancel]
|
||||
|
||||
theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by
|
||||
apply (emod_add_cancel_right b).mp
|
||||
rw [Int.sub_add_cancel, ← Int.add_emod_emod, Int.sub_add_cancel, emod_emod]
|
||||
@@ -1105,32 +1098,6 @@ theorem bmod_def (x : Int) (m : Nat) : bmod x m =
|
||||
(x % m) - m :=
|
||||
rfl
|
||||
|
||||
theorem bdiv_add_bmod (x : Int) (m : Nat) : m * bdiv x m + bmod x m = x := by
|
||||
unfold bdiv bmod
|
||||
split
|
||||
· simp_all only [Nat.cast_ofNat_Int, Int.mul_zero, emod_zero, Int.zero_add, Int.sub_zero,
|
||||
ite_self]
|
||||
· dsimp only
|
||||
split
|
||||
· exact ediv_add_emod x m
|
||||
· rw [Int.mul_add, Int.mul_one, Int.add_assoc, Int.add_comm m, Int.sub_add_cancel]
|
||||
exact ediv_add_emod x m
|
||||
|
||||
theorem bmod_add_bdiv (x : Int) (m : Nat) : bmod x m + m * bdiv x m = x := by
|
||||
rw [Int.add_comm]; exact bdiv_add_bmod x m
|
||||
|
||||
theorem bdiv_add_bmod' (x : Int) (m : Nat) : bdiv x m * m + bmod x m = x := by
|
||||
rw [Int.mul_comm]; exact bdiv_add_bmod x m
|
||||
|
||||
theorem bmod_add_bdiv' (x : Int) (m : Nat) : bmod x m + bdiv x m * m = x := by
|
||||
rw [Int.add_comm]; exact bdiv_add_bmod' x m
|
||||
|
||||
theorem bmod_eq_self_sub_mul_bdiv (x : Int) (m : Nat) : bmod x m = x - m * bdiv x m := by
|
||||
rw [← Int.add_sub_cancel (bmod x m), bmod_add_bdiv]
|
||||
|
||||
theorem bmod_eq_self_sub_bdiv_mul (x : Int) (m : Nat) : bmod x m = x - bdiv x m * m := by
|
||||
rw [← Int.add_sub_cancel (bmod x m), bmod_add_bdiv']
|
||||
|
||||
theorem bmod_pos (x : Int) (m : Nat) (p : x % m < (m + 1) / 2) : bmod x m = x % m := by
|
||||
simp [bmod_def, p]
|
||||
|
||||
|
||||
@@ -1,8 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
|
||||
Kim Morrison
|
||||
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Bool
|
||||
@@ -758,6 +757,207 @@ theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l
|
||||
| nil => simp
|
||||
| cons b l₂ => simp [isEqv, ih]
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
|
||||
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
|
||||
|
||||
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
|
||||
induction l generalizing b <;> simp [*]
|
||||
|
||||
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
|
||||
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
|
||||
simp only [foldrM]
|
||||
induction l <;> simp_all
|
||||
|
||||
theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
|
||||
l.foldl f b = l.foldlM (m := Id) f b := by
|
||||
induction l generalizing b <;> simp [*, foldl]
|
||||
|
||||
theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
|
||||
l.foldr f b = l.foldrM (m := Id) f b := by
|
||||
induction l <;> simp [*, foldr]
|
||||
|
||||
@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : List α) :
|
||||
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
|
||||
|
||||
@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : List α) :
|
||||
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
|
||||
|
||||
/-! ### foldl and foldr -/
|
||||
|
||||
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
|
||||
|
||||
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
|
||||
induction l generalizing l' <;> simp [*]
|
||||
|
||||
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
|
||||
|
||||
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
|
||||
|
||||
theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) :
|
||||
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
|
||||
induction l generalizing init <;> simp [*]
|
||||
|
||||
theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) :
|
||||
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
|
||||
induction l generalizing init <;> simp [*]
|
||||
|
||||
theorem foldl_filterMap (f : α → Option β) (g : γ → β → γ) (l : List α) (init : γ) :
|
||||
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
|
||||
induction l generalizing init with
|
||||
| nil => rfl
|
||||
| cons a l ih =>
|
||||
simp only [filterMap_cons, foldl_cons]
|
||||
cases f a <;> simp [ih]
|
||||
|
||||
theorem foldr_filterMap (f : α → Option β) (g : β → γ → γ) (l : List α) (init : γ) :
|
||||
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
|
||||
induction l generalizing init with
|
||||
| nil => rfl
|
||||
| cons a l ih =>
|
||||
simp only [filterMap_cons, foldr_cons]
|
||||
cases f a <;> simp [ih]
|
||||
|
||||
theorem foldl_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
|
||||
(h : ∀ x y, f' (g x) (g y) = g (f x y)) :
|
||||
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
|
||||
induction l generalizing a
|
||||
· simp
|
||||
· simp [*, h]
|
||||
|
||||
theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
|
||||
(h : ∀ x y, f' (g x) (g y) = g (f x y)) :
|
||||
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
|
||||
induction l generalizing a
|
||||
· simp
|
||||
· simp [*, h]
|
||||
|
||||
theorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldl_cons, ha.assoc]
|
||||
rw [foldl_assoc]
|
||||
|
||||
theorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldr_cons, ha.assoc]
|
||||
rw [foldr_assoc]
|
||||
|
||||
theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁)
|
||||
(H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
|
||||
induction l generalizing init <;> simp [*, H]
|
||||
|
||||
theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : α → β₂ → β₂) (l : List α) (init : β₁)
|
||||
(H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
|
||||
induction l <;> simp [*, H]
|
||||
|
||||
/--
|
||||
Prove a proposition about the result of `List.foldl`,
|
||||
by proving it for the initial data,
|
||||
and the implication that the operation applied to any element of the list preserves the property.
|
||||
|
||||
The motive can take values in `Sort _`, so this may be used to construct data,
|
||||
as well as to prove propositions.
|
||||
-/
|
||||
def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α → β) (b : β) (_ : motive b)
|
||||
(_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op b a)), motive (List.foldl op b l)
|
||||
| [], _, _, hb, _ => hb
|
||||
| hd :: tl, op, b, hb, hl =>
|
||||
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
|
||||
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
|
||||
|
||||
@[simp] theorem foldlRecOn_nil {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
|
||||
foldlRecOn [] op b hb hl = hb := rfl
|
||||
|
||||
@[simp] theorem foldlRecOn_cons {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
|
||||
foldlRecOn (x :: l) op b hb hl =
|
||||
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
|
||||
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
Prove a proposition about the result of `List.foldr`,
|
||||
by proving it for the initial data,
|
||||
and the implication that the operation applied to any element of the list preserves the property.
|
||||
|
||||
The motive can take values in `Sort _`, so this may be used to construct data,
|
||||
as well as to prove propositions.
|
||||
-/
|
||||
def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β → β) (b : β) (_ : motive b)
|
||||
(_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op a b)), motive (List.foldr op b l)
|
||||
| nil, _, _, hb, _ => hb
|
||||
| x :: l, op, b, hb, hl =>
|
||||
hl (foldr op b l)
|
||||
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
|
||||
|
||||
@[simp] theorem foldrRecOn_nil {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
|
||||
foldrRecOn [] op b hb hl = hb := rfl
|
||||
|
||||
@[simp] theorem foldrRecOn_cons {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
|
||||
foldrRecOn (x :: l) op b hb hl =
|
||||
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
|
||||
x (mem_cons_self x l) :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldl_rel {l : List α} {f g : β → α → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f c a) (g c' a)) :
|
||||
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldl_cons]
|
||||
apply ih
|
||||
· simp_all
|
||||
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldr_rel {l : List α} {f g : α → β → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f a c) (g a c')) :
|
||||
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldr_cons]
|
||||
apply h'
|
||||
· simp
|
||||
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
|
||||
l.foldl (fun x _ => x + a) b = b + a * l.length := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons y l ih =>
|
||||
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
|
||||
Nat.add_comm a]
|
||||
|
||||
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
|
||||
l.foldr (fun _ x => x + a) b = b + a * l.length := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons y l ih =>
|
||||
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
|
||||
|
||||
/-! ### getLast -/
|
||||
|
||||
theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
|
||||
@@ -1016,6 +1216,27 @@ theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then n
|
||||
|
||||
/-! ### map -/
|
||||
|
||||
@[simp] theorem map_id_fun : map (id : α → α) = id := by
|
||||
funext l
|
||||
induction l <;> simp_all
|
||||
|
||||
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
|
||||
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
|
||||
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
|
||||
theorem map_id (l : List α) : map (id : α → α) l = l := by
|
||||
induction l <;> simp_all
|
||||
|
||||
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
|
||||
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
|
||||
|
||||
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
|
||||
theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : List α) : map f l = l := by
|
||||
simp [show f = id from funext h]
|
||||
|
||||
theorem map_singleton (f : α → β) (a : α) : map f [a] = [f a] := rfl
|
||||
|
||||
@[simp] theorem length_map (as : List α) (f : α → β) : (as.map f).length = as.length := by
|
||||
induction as with
|
||||
| nil => simp [List.map]
|
||||
@@ -1041,27 +1262,6 @@ theorem get_map (f : α → β) {l i} :
|
||||
get (map f l) i = f (get l ⟨i, length_map l f ▸ i.2⟩) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem map_id_fun : map (id : α → α) = id := by
|
||||
funext l
|
||||
induction l <;> simp_all
|
||||
|
||||
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
|
||||
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
|
||||
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
|
||||
theorem map_id (l : List α) : map (id : α → α) l = l := by
|
||||
induction l <;> simp_all
|
||||
|
||||
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
|
||||
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
|
||||
|
||||
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
|
||||
theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : List α) : map f l = l := by
|
||||
simp [show f = id from funext h]
|
||||
|
||||
theorem map_singleton (f : α → β) (a : α) : map f [a] = [f a] := rfl
|
||||
|
||||
@[simp] theorem mem_map {f : α → β} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b
|
||||
| [] => by simp
|
||||
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
|
||||
@@ -1115,10 +1315,6 @@ theorem map_eq_cons_iff' {f : α → β} {l : List α} :
|
||||
|
||||
@[deprecated map_eq_cons' (since := "2024-09-05")] abbrev map_eq_cons' := @map_eq_cons_iff'
|
||||
|
||||
@[simp] theorem map_eq_singleton_iff {f : α → β} {l : List α} {b : β} :
|
||||
map f l = [b] ↔ ∃ a, l = [a] ∧ f a = b := by
|
||||
simp [map_eq_cons_iff]
|
||||
|
||||
theorem map_eq_map_iff : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
|
||||
induction l <;> simp
|
||||
|
||||
@@ -1285,7 +1481,7 @@ theorem map_filter_eq_foldr (f : α → β) (p : α → Bool) (as : List α) :
|
||||
@[simp] theorem filter_append {p : α → Bool} :
|
||||
∀ (l₁ l₂ : List α), filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂
|
||||
| [], _ => rfl
|
||||
| a :: l₁, l₂ => by simp only [cons_append, filter]; split <;> simp [filter_append l₁]
|
||||
| a :: l₁, l₂ => by simp [filter]; split <;> simp [filter_append l₁]
|
||||
|
||||
theorem filter_eq_cons_iff {l} {a} {as} :
|
||||
filter p l = a :: as ↔
|
||||
@@ -1494,34 +1690,6 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
|
||||
@[simp] theorem cons_append_fun (a : α) (as : List α) :
|
||||
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
|
||||
|
||||
@[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
|
||||
induction s <;> simp_all [or_assoc]
|
||||
|
||||
theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
|
||||
mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
|
||||
|
||||
@[deprecated mem_append (since := "2025-01-13")]
|
||||
theorem mem_append_eq (a : α) (s t : List α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
|
||||
propext mem_append
|
||||
|
||||
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
|
||||
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
|
||||
|
||||
/--
|
||||
See also `eq_append_cons_of_mem`, which proves a stronger version
|
||||
in which the initial list must not contain the element.
|
||||
-/
|
||||
theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t
|
||||
| .head l => ⟨[], l, rfl⟩
|
||||
| .tail b h => let ⟨s, t, h'⟩ := append_of_mem h; ⟨b::s, t, by rw [h', cons_append]⟩
|
||||
|
||||
theorem mem_iff_append {a : α} {l : List α} : a ∈ l ↔ ∃ s t : List α, l = s ++ a :: t :=
|
||||
⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
|
||||
|
||||
theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} :
|
||||
(∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
|
||||
simp only [mem_append, or_imp, forall_and]
|
||||
|
||||
theorem getElem_append {l₁ l₂ : List α} (i : Nat) (h : i < (l₁ ++ l₂).length) :
|
||||
(l₁ ++ l₂)[i] = if h' : i < l₁.length then l₁[i] else l₂[i - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
|
||||
split <;> rename_i h'
|
||||
@@ -1589,6 +1757,14 @@ theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.lengt
|
||||
l.get ⟨i, get_of_append_proof eq h⟩ = a := Option.some.inj <| by
|
||||
rw [← get?_eq_get, eq, get?_append_right (h ▸ Nat.le_refl _), h, Nat.sub_self]; rfl
|
||||
|
||||
/--
|
||||
See also `eq_append_cons_of_mem`, which proves a stronger version
|
||||
in which the initial list must not contain the element.
|
||||
-/
|
||||
theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l = s ++ a :: t
|
||||
| .head l => ⟨[], l, rfl⟩
|
||||
| .tail b h => let ⟨s, t, h'⟩ := append_of_mem h; ⟨b::s, t, by rw [h', cons_append]⟩
|
||||
|
||||
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
|
||||
|
||||
theorem append_inj :
|
||||
@@ -1605,8 +1781,8 @@ theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = le
|
||||
|
||||
/-- Variant of `append_inj` instead requiring equality of the lengths of the second lists. -/
|
||||
theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ :=
|
||||
append_inj h <| @Nat.add_right_cancel _ t₁.length _ <| by
|
||||
let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
|
||||
append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
|
||||
let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
|
||||
|
||||
/-- Variant of `append_inj_right` instead requiring equality of the lengths of the second lists. -/
|
||||
theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
|
||||
@@ -1634,6 +1810,9 @@ theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s
|
||||
@[simp] theorem self_eq_append_right {x y : List α} : x = x ++ y ↔ y = [] := by
|
||||
rw [eq_comm, append_right_eq_self]
|
||||
|
||||
@[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by
|
||||
cases p <;> simp
|
||||
|
||||
theorem getLast_concat {a : α} : ∀ (l : List α), getLast (l ++ [a]) (by simp) = a
|
||||
| [] => rfl
|
||||
| a::t => by
|
||||
@@ -1659,54 +1838,6 @@ theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
|
||||
(l₁ ++ l₂).get? n = l₁.get? n := by
|
||||
simp [getElem?_append_left hn]
|
||||
|
||||
@[simp] theorem append_eq_nil_iff : p ++ q = [] ↔ p = [] ∧ q = [] := by
|
||||
cases p <;> simp
|
||||
|
||||
@[deprecated append_eq_nil_iff (since := "2025-01-13")] abbrev append_eq_nil := @append_eq_nil_iff
|
||||
|
||||
@[simp] theorem nil_eq_append_iff : [] = a ++ b ↔ a = [] ∧ b = [] := by
|
||||
rw [eq_comm, append_eq_nil_iff]
|
||||
|
||||
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
|
||||
|
||||
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
|
||||
theorem append_ne_nil_of_right_ne_nil (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
|
||||
|
||||
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
|
||||
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
|
||||
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
|
||||
theorem append_ne_nil_of_ne_nil_right (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
|
||||
|
||||
theorem append_eq_cons_iff :
|
||||
a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
|
||||
cases a with simp | cons a as => ?_
|
||||
exact ⟨fun h => ⟨as, by simp [h]⟩, fun ⟨a', ⟨aeq, aseq⟩, h⟩ => ⟨aeq, by rw [aseq, h]⟩⟩
|
||||
|
||||
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
|
||||
|
||||
theorem cons_eq_append_iff :
|
||||
x :: c = a ++ b ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
|
||||
rw [eq_comm, append_eq_cons_iff]
|
||||
|
||||
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
|
||||
|
||||
theorem append_eq_singleton_iff :
|
||||
a ++ b = [x] ↔ (a = [] ∧ b = [x]) ∨ (a = [x] ∧ b = []) := by
|
||||
cases a <;> cases b <;> simp
|
||||
|
||||
theorem singleton_eq_append_iff :
|
||||
[x] = a ++ b ↔ (a = [] ∧ b = [x]) ∨ (a = [x] ∧ b = []) := by
|
||||
cases a <;> cases b <;> simp [eq_comm]
|
||||
|
||||
theorem append_eq_append_iff {a b c d : List α} :
|
||||
a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
|
||||
induction a generalizing c with
|
||||
| nil => simp_all
|
||||
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
|
||||
|
||||
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
|
||||
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
|
||||
|
||||
@[simp] theorem head_append_of_ne_nil {l : List α} {w₁} (w₂) :
|
||||
head (l ++ l') w₁ = head l w₂ := by
|
||||
match l, w₂ with
|
||||
@@ -1756,6 +1887,60 @@ theorem tail_append {l l' : List α} : (l ++ l').tail = if l.isEmpty then l'.tai
|
||||
|
||||
@[deprecated tail_append_of_ne_nil (since := "2024-07-24")] abbrev tail_append_left := @tail_append_of_ne_nil
|
||||
|
||||
theorem nil_eq_append_iff : [] = a ++ b ↔ a = [] ∧ b = [] := by
|
||||
rw [eq_comm, append_eq_nil]
|
||||
|
||||
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
|
||||
|
||||
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
|
||||
theorem append_ne_nil_of_right_ne_nil (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
|
||||
|
||||
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
|
||||
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s ≠ []) (t : List α) : s ++ t ≠ [] := by simp_all
|
||||
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
|
||||
theorem append_ne_nil_of_ne_nil_right (s : List α) : t ≠ [] → s ++ t ≠ [] := by simp_all
|
||||
|
||||
theorem append_eq_cons_iff :
|
||||
a ++ b = x :: c ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
|
||||
cases a with simp | cons a as => ?_
|
||||
exact ⟨fun h => ⟨as, by simp [h]⟩, fun ⟨a', ⟨aeq, aseq⟩, h⟩ => ⟨aeq, by rw [aseq, h]⟩⟩
|
||||
|
||||
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
|
||||
|
||||
theorem cons_eq_append_iff :
|
||||
x :: c = a ++ b ↔ (a = [] ∧ b = x :: c) ∨ (∃ a', a = x :: a' ∧ c = a' ++ b) := by
|
||||
rw [eq_comm, append_eq_cons_iff]
|
||||
|
||||
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
|
||||
|
||||
theorem append_eq_append_iff {a b c d : List α} :
|
||||
a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
|
||||
induction a generalizing c with
|
||||
| nil => simp_all
|
||||
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
|
||||
|
||||
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
|
||||
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
|
||||
|
||||
@[simp] theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
|
||||
induction s <;> simp_all [or_assoc]
|
||||
|
||||
theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
|
||||
mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
|
||||
|
||||
theorem mem_append_eq (a : α) (s t : List α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
|
||||
propext mem_append
|
||||
|
||||
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
|
||||
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
|
||||
|
||||
theorem mem_iff_append {a : α} {l : List α} : a ∈ l ↔ ∃ s t : List α, l = s ++ a :: t :=
|
||||
⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
|
||||
|
||||
theorem forall_mem_append {p : α → Prop} {l₁ l₂ : List α} :
|
||||
(∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
|
||||
simp only [mem_append, or_imp, forall_and]
|
||||
|
||||
theorem set_append {s t : List α} :
|
||||
(s ++ t).set i x = if i < s.length then s.set i x ++ t else s ++ t.set (i - s.length) x := by
|
||||
induction s generalizing i with
|
||||
@@ -1776,6 +1961,16 @@ theorem set_append {s t : List α} :
|
||||
(s ++ t).set i x = s ++ t.set (i - s.length) x := by
|
||||
rw [set_append, if_neg (by simp_all)]
|
||||
|
||||
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
|
||||
|
||||
@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
|
||||
|
||||
theorem filterMap_eq_append_iff {f : α → Option β} :
|
||||
filterMap f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
|
||||
constructor
|
||||
@@ -1924,6 +2119,14 @@ theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun
|
||||
-- `getLast?_flatten` is proved later, after the `reverse` section.
|
||||
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
|
||||
|
||||
theorem foldl_flatten (f : β → α → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
|
||||
induction L generalizing b <;> simp_all
|
||||
|
||||
theorem foldr_flatten (f : α → β → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@[simp] theorem map_flatten (f : α → β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@@ -1985,8 +2188,8 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
|
||||
constructor
|
||||
· induction xs generalizing ys with
|
||||
| nil =>
|
||||
simp only [flatten_nil, nil_eq, append_eq_nil_iff, and_false, cons_append, false_and,
|
||||
exists_const, exists_false, or_false, and_imp, List.cons_ne_nil]
|
||||
simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
|
||||
exists_false, or_false, and_imp, List.cons_ne_nil]
|
||||
rintro rfl rfl
|
||||
exact ⟨[], [], by simp⟩
|
||||
| cons x xs ih =>
|
||||
@@ -2496,114 +2699,10 @@ theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.fla
|
||||
@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
|
||||
reverseAux_eq_append ..
|
||||
|
||||
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
|
||||
eq_replicate_iff.2
|
||||
⟨by rw [length_reverse, length_replicate],
|
||||
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)⟩
|
||||
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
|
||||
induction l generalizing b <;> simp [*]
|
||||
|
||||
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
|
||||
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
|
||||
simp only [foldrM]
|
||||
induction l <;> simp_all
|
||||
|
||||
theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
|
||||
l.foldl f b = l.foldlM (m := Id) f b := by
|
||||
induction l generalizing b <;> simp [*, foldl]
|
||||
|
||||
theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
|
||||
l.foldr f b = l.foldrM (m := Id) f b := by
|
||||
induction l <;> simp [*, foldr]
|
||||
|
||||
@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : List α) :
|
||||
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
|
||||
|
||||
@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : List α) :
|
||||
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
|
||||
|
||||
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
|
||||
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
|
||||
|
||||
@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) :
|
||||
l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
|
||||
(foldlM_reverse ..).symm.trans <| by simp
|
||||
|
||||
/-! ### foldl and foldr -/
|
||||
|
||||
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
|
||||
|
||||
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
|
||||
induction l generalizing l' <;> simp [*]
|
||||
|
||||
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
|
||||
|
||||
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
|
||||
|
||||
theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : List β₁) (init : α) :
|
||||
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
|
||||
induction l generalizing init <;> simp [*]
|
||||
|
||||
theorem foldr_map (f : α₁ → α₂) (g : α₂ → β → β) (l : List α₁) (init : β) :
|
||||
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
|
||||
induction l generalizing init <;> simp [*]
|
||||
|
||||
theorem foldl_filterMap (f : α → Option β) (g : γ → β → γ) (l : List α) (init : γ) :
|
||||
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
|
||||
induction l generalizing init with
|
||||
| nil => rfl
|
||||
| cons a l ih =>
|
||||
simp only [filterMap_cons, foldl_cons]
|
||||
cases f a <;> simp [ih]
|
||||
|
||||
theorem foldr_filterMap (f : α → Option β) (g : β → γ → γ) (l : List α) (init : γ) :
|
||||
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
|
||||
induction l generalizing init with
|
||||
| nil => rfl
|
||||
| cons a l ih =>
|
||||
simp only [filterMap_cons, foldr_cons]
|
||||
cases f a <;> simp [ih]
|
||||
|
||||
theorem foldl_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
|
||||
(h : ∀ x y, f' (g x) (g y) = g (f x y)) :
|
||||
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
|
||||
induction l generalizing a
|
||||
· simp
|
||||
· simp [*, h]
|
||||
|
||||
theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β) (a : α) (l : List α)
|
||||
(h : ∀ x y, f' (g x) (g y) = g (f x y)) :
|
||||
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
|
||||
induction l generalizing a
|
||||
· simp
|
||||
· simp [*, h]
|
||||
|
||||
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
|
||||
|
||||
@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
|
||||
|
||||
theorem foldl_flatten (f : β → α → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
|
||||
induction L generalizing b <;> simp_all
|
||||
|
||||
theorem foldr_flatten (f : α → β → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) :
|
||||
l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
|
||||
|
||||
@@ -2617,127 +2716,10 @@ theorem foldl_eq_foldr_reverse (l : List α) (f : β → α → β) (b) :
|
||||
theorem foldr_eq_foldl_reverse (l : List α) (f : α → β → β) (b) :
|
||||
l.foldr f b = l.reverse.foldl (fun x y => f y x) b := by simp
|
||||
|
||||
theorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldl_cons, ha.assoc]
|
||||
rw [foldl_assoc]
|
||||
|
||||
theorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldr_cons, ha.assoc]
|
||||
rw [foldr_assoc]
|
||||
|
||||
theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁)
|
||||
(H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
|
||||
induction l generalizing init <;> simp [*, H]
|
||||
|
||||
theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ : α → β₂ → β₂) (l : List α) (init : β₁)
|
||||
(H : ∀ x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
|
||||
induction l <;> simp [*, H]
|
||||
|
||||
/--
|
||||
Prove a proposition about the result of `List.foldl`,
|
||||
by proving it for the initial data,
|
||||
and the implication that the operation applied to any element of the list preserves the property.
|
||||
|
||||
The motive can take values in `Sort _`, so this may be used to construct data,
|
||||
as well as to prove propositions.
|
||||
-/
|
||||
def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α → β) (b : β) (_ : motive b)
|
||||
(_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op b a)), motive (List.foldl op b l)
|
||||
| [], _, _, hb, _ => hb
|
||||
| hd :: tl, op, b, hb, hl =>
|
||||
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
|
||||
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
|
||||
|
||||
@[simp] theorem foldlRecOn_nil {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
|
||||
foldlRecOn [] op b hb hl = hb := rfl
|
||||
|
||||
@[simp] theorem foldlRecOn_cons {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
|
||||
foldlRecOn (x :: l) op b hb hl =
|
||||
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
|
||||
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
Prove a proposition about the result of `List.foldr`,
|
||||
by proving it for the initial data,
|
||||
and the implication that the operation applied to any element of the list preserves the property.
|
||||
|
||||
The motive can take values in `Sort _`, so this may be used to construct data,
|
||||
as well as to prove propositions.
|
||||
-/
|
||||
def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β → β) (b : β) (_ : motive b)
|
||||
(_ : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ l), motive (op a b)), motive (List.foldr op b l)
|
||||
| nil, _, _, hb, _ => hb
|
||||
| x :: l, op, b, hb, hl =>
|
||||
hl (foldr op b l)
|
||||
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
|
||||
|
||||
@[simp] theorem foldrRecOn_nil {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
|
||||
foldrRecOn [] op b hb hl = hb := rfl
|
||||
|
||||
@[simp] theorem foldrRecOn_cons {motive : β → Sort _} (hb : motive b)
|
||||
(hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
|
||||
foldrRecOn (x :: l) op b hb hl =
|
||||
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
|
||||
x (mem_cons_self x l) :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldl_rel {l : List α} {f g : β → α → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f c a) (g c' a)) :
|
||||
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldl_cons]
|
||||
apply ih
|
||||
· simp_all
|
||||
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldr_rel {l : List α} {f g : α → β → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f a c) (g a c')) :
|
||||
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldr_cons]
|
||||
apply h'
|
||||
· simp
|
||||
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
|
||||
l.foldl (fun x _ => x + a) b = b + a * l.length := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons y l ih =>
|
||||
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
|
||||
Nat.add_comm a]
|
||||
|
||||
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
|
||||
l.foldr (fun _ x => x + a) b = b + a * l.length := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons y l ih =>
|
||||
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
|
||||
|
||||
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
|
||||
eq_replicate_iff.2
|
||||
⟨by rw [length_reverse, length_replicate],
|
||||
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)⟩
|
||||
|
||||
/-! #### Further results about `getLast` and `getLast?` -/
|
||||
|
||||
|
||||
@@ -510,18 +510,4 @@ theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
|
||||
refine (IH₁ H).trans (IH₂ ((p₁.pairwise_iff ?_).1 H))
|
||||
exact fun h h₁ h₂ => h h₂ h₁
|
||||
|
||||
theorem perm_insertIdx {α} (x : α) (l : List α) {n} (h : n ≤ l.length) :
|
||||
insertIdx n x l ~ x :: l := by
|
||||
induction l generalizing n with
|
||||
| nil =>
|
||||
cases n with
|
||||
| zero => rfl
|
||||
| succ => cases h
|
||||
| cons _ _ ih =>
|
||||
cases n with
|
||||
| zero => simp [insertIdx]
|
||||
| succ =>
|
||||
simp only [insertIdx, modifyTailIdx]
|
||||
refine .trans (.cons _ (ih (Nat.le_of_succ_le_succ h))) (.swap ..)
|
||||
|
||||
end List
|
||||
|
||||
@@ -253,10 +253,6 @@ theorem merge_perm_append : ∀ {xs ys : List α}, merge xs ys le ~ xs ++ ys
|
||||
· exact (merge_perm_append.cons y).trans
|
||||
((Perm.swap x y _).trans (perm_middle.symm.cons x))
|
||||
|
||||
theorem Perm.merge (s₁ s₂ : α → α → Bool) (hl : l₁ ~ l₂) (hr : r₁ ~ r₂) :
|
||||
merge l₁ r₁ s₁ ~ merge l₂ r₂ s₂ :=
|
||||
Perm.trans (merge_perm_append ..) <| Perm.trans (Perm.append hl hr) <| Perm.symm (merge_perm_append ..)
|
||||
|
||||
/-! ### mergeSort -/
|
||||
|
||||
@[simp] theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]
|
||||
|
||||
@@ -46,7 +46,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
|
||||
@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
|
||||
cases l <;> simp [Array.isEmpty]
|
||||
|
||||
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
|
||||
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
|
||||
|
||||
@[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
|
||||
simp only [back!, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
|
||||
|
||||
@@ -203,11 +203,11 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
|
||||
cases l₂ with
|
||||
| nil =>
|
||||
constructor
|
||||
· simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, exists_and_left, and_imp]
|
||||
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
|
||||
rintro rfl rfl
|
||||
exact ⟨[], x₁ :: l₁, [], by simp⟩
|
||||
· rintro ⟨w, x, y, z, h₁, _, h₃, rfl, rfl⟩
|
||||
simp only [nil_eq, append_eq_nil_iff] at h₃
|
||||
simp only [nil_eq, append_eq_nil] at h₃
|
||||
obtain ⟨rfl, rfl⟩ := h₃
|
||||
simp
|
||||
| cons x₂ l₂ =>
|
||||
|
||||
@@ -49,17 +49,4 @@ theorem lt_div_mul_self (h : 0 < k) (w : k ≤ x) : x - k < x / k * k := by
|
||||
have : x % k < k := mod_lt x h
|
||||
omega
|
||||
|
||||
theorem div_pos (hba : b ≤ a) (hb : 0 < b) : 0 < a / b := by
|
||||
cases b
|
||||
· contradiction
|
||||
· simp [Nat.pos_iff_ne_zero, div_eq_zero_iff_lt, hba]
|
||||
|
||||
theorem div_le_div_left (hcb : c ≤ b) (hc : 0 < c) : a / b ≤ a / c :=
|
||||
(Nat.le_div_iff_mul_le hc).2 <|
|
||||
Nat.le_trans (Nat.mul_le_mul_left _ hcb) (Nat.div_mul_le_self a b)
|
||||
|
||||
theorem div_add_le_right {z : Nat} (h : 0 < z) (x y : Nat) :
|
||||
x / (y + z) ≤ x / z :=
|
||||
div_le_div_left (Nat.le_add_left z y) h
|
||||
|
||||
end Nat
|
||||
|
||||
@@ -159,8 +159,6 @@ def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.toBitVec <<< (mod b 32).toBitVec⟩
|
||||
@[extern "lean_uint32_shift_right"]
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
|
||||
def UInt32.lt (a b : UInt32) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt32.le (a b : UInt32) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance : Add UInt32 := ⟨UInt32.add⟩
|
||||
instance : Sub UInt32 := ⟨UInt32.sub⟩
|
||||
@@ -171,8 +169,6 @@ set_option linter.deprecated false in
|
||||
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
|
||||
|
||||
instance : Div UInt32 := ⟨UInt32.div⟩
|
||||
instance : LT UInt32 := ⟨UInt32.lt⟩
|
||||
instance : LE UInt32 := ⟨UInt32.le⟩
|
||||
|
||||
@[extern "lean_uint32_complement"]
|
||||
def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
@@ -13,12 +13,6 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
|
||||
`(
|
||||
namespace $typeName
|
||||
|
||||
@[simp] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
|
||||
@@ -43,31 +37,3 @@ declare_bitwise_uint_theorems UInt16 16
|
||||
declare_bitwise_uint_theorems UInt32 32
|
||||
declare_bitwise_uint_theorems UInt64 64
|
||||
declare_bitwise_uint_theorems USize System.Platform.numBits
|
||||
|
||||
@[simp]
|
||||
theorem Bool.toBitVec_toUInt8 {b : Bool} :
|
||||
b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
|
||||
cases b <;> simp [toUInt8]
|
||||
|
||||
@[simp]
|
||||
theorem Bool.toBitVec_toUInt16 {b : Bool} :
|
||||
b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
|
||||
cases b <;> simp [toUInt16]
|
||||
|
||||
@[simp]
|
||||
theorem Bool.toBitVec_toUInt32 {b : Bool} :
|
||||
b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
|
||||
cases b <;> simp [toUInt32]
|
||||
|
||||
@[simp]
|
||||
theorem Bool.toBitVec_toUInt64 {b : Bool} :
|
||||
b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
|
||||
cases b <;> simp [toUInt64]
|
||||
|
||||
@[simp]
|
||||
theorem Bool.toBitVec_toUSize {b : Bool} :
|
||||
b.toUSize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
|
||||
cases b
|
||||
· simp [toUSize]
|
||||
· apply BitVec.eq_of_toNat_eq
|
||||
simp [toUSize]
|
||||
|
||||
@@ -103,7 +103,7 @@ of bounds.
|
||||
@[inline] def head [NeZero n] (v : Vector α n) := v[0]'(Nat.pos_of_neZero n)
|
||||
|
||||
/-- Push an element `x` to the end of a vector. -/
|
||||
@[inline] def push (v : Vector α n) (x : α) : Vector α (n + 1) :=
|
||||
@[inline] def push (x : α) (v : Vector α n) : Vector α (n + 1) :=
|
||||
⟨v.toArray.push x, by simp⟩
|
||||
|
||||
/-- Remove the last element of a vector. -/
|
||||
@@ -136,18 +136,6 @@ This will perform the update destructively provided that the vector has a refere
|
||||
@[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
|
||||
⟨v.toArray.set! i x, by simp⟩
|
||||
|
||||
@[inline] def foldlM [Monad m] (f : β → α → m β) (b : β) (v : Vector α n) : m β :=
|
||||
v.toArray.foldlM f b
|
||||
|
||||
@[inline] def foldrM [Monad m] (f : α → β → m β) (b : β) (v : Vector α n) : m β :=
|
||||
v.toArray.foldrM f b
|
||||
|
||||
@[inline] def foldl (f : β → α → β) (b : β) (v : Vector α n) : β :=
|
||||
v.toArray.foldl f b
|
||||
|
||||
@[inline] def foldr (f : α → β → β) (b : β) (v : Vector α n) : β :=
|
||||
v.toArray.foldr f b
|
||||
|
||||
/-- Append two vectors. -/
|
||||
@[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) :=
|
||||
⟨v.toArray ++ w.toArray, by simp⟩
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2024 Shreyas Srinivas. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
|
||||
Authors: Shreyas Srinivas, Francois Dorais
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Vector.Basic
|
||||
@@ -66,18 +66,6 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
|
||||
@[simp] theorem back?_mk (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).back? = a.back? := rfl
|
||||
|
||||
@[simp] theorem foldlM_mk [Monad m] (f : β → α → m β) (b : β) (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).foldlM f b = a.foldlM f b := rfl
|
||||
|
||||
@[simp] theorem foldrM_mk [Monad m] (f : α → β → m β) (b : β) (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).foldrM f b = a.foldrM f b := rfl
|
||||
|
||||
@[simp] theorem foldl_mk (f : β → α → β) (b : β) (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).foldl f b = a.foldl f b := rfl
|
||||
|
||||
@[simp] theorem foldr_mk (f : α → β → β) (b : β) (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).foldr f b = a.foldr f b := rfl
|
||||
|
||||
@[simp] theorem drop_mk (a : Array α) (h : a.size = n) (m) :
|
||||
(Vector.mk a h).drop m = Vector.mk (a.extract m a.size) (by simp [h]) := rfl
|
||||
|
||||
@@ -153,14 +141,6 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
|
||||
@[simp] theorem all_mk (p : α → Bool) (a : Array α) (h : a.size = n) :
|
||||
(Vector.mk a h).all p = a.all p := rfl
|
||||
|
||||
@[simp] theorem eq_mk : v = Vector.mk a h ↔ v.toArray = a := by
|
||||
cases v
|
||||
simp
|
||||
|
||||
@[simp] theorem mk_eq : Vector.mk a h = v ↔ a = v.toArray := by
|
||||
cases v
|
||||
simp
|
||||
|
||||
/-! ### toArray lemmas -/
|
||||
|
||||
@[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) :
|
||||
@@ -693,24 +673,6 @@ theorem forall_getElem {l : Vector α n} {p : α → Prop} :
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.forall_getElem]
|
||||
|
||||
|
||||
/-! ### cast -/
|
||||
|
||||
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
|
||||
(a.cast h)[i] = a[i] := by
|
||||
cases a
|
||||
simp
|
||||
|
||||
@[simp] theorem getElem?_cast {l : Vector α n} {m : Nat} {w : n = m} {i : Nat} :
|
||||
(l.cast w)[i]? = l[i]? := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem mem_cast {a : α} {l : Vector α n} {m : Nat} {w : n = m} :
|
||||
a ∈ l.cast w ↔ a ∈ l := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
/-! ### Decidability of bounded quantifiers -/
|
||||
|
||||
instance {xs : Vector α n} {p : α → Prop} [DecidablePred p] :
|
||||
@@ -1061,12 +1023,11 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
cases l₂
|
||||
simp
|
||||
|
||||
/-! ### map -/
|
||||
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
|
||||
|
||||
@[simp] theorem getElem_map (f : α → β) (a : Vector α n) (i : Nat) (hi : i < n) :
|
||||
(a.map f)[i] = f a[i] := by
|
||||
cases a
|
||||
simp
|
||||
@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
|
||||
(Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
|
||||
simp [ofFn]
|
||||
|
||||
/-- The empty vector maps to the empty vector. -/
|
||||
@[simp]
|
||||
@@ -1074,344 +1035,6 @@ theorem map_empty (f : α → β) : map f #v[] = #v[] := by
|
||||
rw [map, mk.injEq]
|
||||
exact Array.map_empty f
|
||||
|
||||
@[simp] theorem map_push {f : α → β} {as : Vector α n} {x : α} :
|
||||
(as.push x).map f = (as.map f).push (f x) := by
|
||||
cases as
|
||||
simp
|
||||
|
||||
@[simp] theorem map_id_fun : map (n := n) (id : α → α) = id := by
|
||||
funext l
|
||||
induction l <;> simp_all
|
||||
|
||||
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
|
||||
@[simp] theorem map_id_fun' : map (n := n) (fun (a : α) => a) = id := map_id_fun
|
||||
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
|
||||
theorem map_id (l : Vector α n) : map (id : α → α) l = l := by
|
||||
cases l <;> simp_all
|
||||
|
||||
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
|
||||
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
|
||||
theorem map_id' (l : Vector α n) : map (fun (a : α) => a) l = l := map_id l
|
||||
|
||||
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
|
||||
theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (l : Vector α n) : map f l = l := by
|
||||
simp [show f = id from funext h]
|
||||
|
||||
theorem map_singleton (f : α → β) (a : α) : map f #v[a] = #v[f a] := rfl
|
||||
|
||||
@[simp] theorem mem_map {f : α → β} {l : Vector α n} : b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_map (h : b ∈ map f l) : ∃ a, a ∈ l ∧ f a = b := mem_map.1 h
|
||||
|
||||
theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩
|
||||
|
||||
theorem forall_mem_map {f : α → β} {l : Vector α n} {P : β → Prop} :
|
||||
(∀ (i) (_ : i ∈ l.map f), P i) ↔ ∀ (j) (_ : j ∈ l), P (f j) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem map_inj_left {f g : α → β} : map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
|
||||
cases l <;> simp_all
|
||||
|
||||
theorem map_congr_left (h : ∀ a ∈ l, f a = g a) : map f l = map g l :=
|
||||
map_inj_left.2 h
|
||||
|
||||
theorem map_inj [NeZero n] : map (n := n) f = map g ↔ f = g := by
|
||||
constructor
|
||||
· intro h
|
||||
ext a
|
||||
replace h := congrFun h (mkVector n a)
|
||||
simp only [mkVector, map_mk, mk.injEq, Array.map_inj_left, Array.mem_mkArray, and_imp,
|
||||
forall_eq_apply_imp_iff] at h
|
||||
exact h (NeZero.ne n)
|
||||
· intro h; subst h; rfl
|
||||
|
||||
theorem map_eq_push_iff {f : α → β} {l : Vector α (n + 1)} {l₂ : Vector β n} {b : β} :
|
||||
map f l = l₂.push b ↔ ∃ l₁ a, l = l₁.push a ∧ map f l₁ = l₂ ∧ f a = b := by
|
||||
rcases l with ⟨l, h⟩
|
||||
rcases l₂ with ⟨l₂, rfl⟩
|
||||
simp only [map_mk, push_mk, mk.injEq, Array.map_eq_push_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, a, rfl, rfl, rfl⟩
|
||||
refine ⟨⟨l₁, by simp⟩, a, by simp⟩
|
||||
· rintro ⟨l₁, a, h₁, h₂, rfl⟩
|
||||
refine ⟨l₁.toArray, a, by simp_all⟩
|
||||
|
||||
@[simp] theorem map_eq_singleton_iff {f : α → β} {l : Vector α 1} {b : β} :
|
||||
map f l = #v[b] ↔ ∃ a, l = #v[a] ∧ f a = b := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem map_eq_map_iff {f g : α → β} {l : Vector α n} :
|
||||
map f l = map g l ↔ ∀ a ∈ l, f a = g a := by
|
||||
cases l <;> simp_all
|
||||
|
||||
theorem map_eq_iff {f : α → β} {l : Vector α n} {l' : Vector β n} :
|
||||
map f l = l' ↔ ∀ i (h : i < n), l'[i] = f l[i] := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
rcases l' with ⟨l', h'⟩
|
||||
simp only [map_mk, eq_mk, Array.map_eq_iff, getElem_mk]
|
||||
constructor
|
||||
· intro w i h
|
||||
simpa [h, h'] using w i
|
||||
· intro w i
|
||||
if h : i < l.size then
|
||||
simpa [h, h'] using w i h
|
||||
else
|
||||
rw [getElem?_neg, getElem?_neg, Option.map_none'] <;> omega
|
||||
|
||||
@[simp] theorem map_set {f : α → β} {l : Vector α n} {i : Nat} {h : i < n} {a : α} :
|
||||
(l.set i a).map f = (l.map f).set i (f a) (by simpa using h) := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
@[simp] theorem map_setIfInBounds {f : α → β} {l : Vector α n} {i : Nat} {a : α} :
|
||||
(l.setIfInBounds i a).map f = (l.map f).setIfInBounds i (f a) := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
@[simp] theorem map_pop {f : α → β} {l : Vector α n} : l.pop.map f = (l.map f).pop := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
@[simp] theorem back?_map {f : α → β} {l : Vector α n} : (l.map f).back? = l.back?.map f := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
@[simp] theorem map_map {f : α → β} {g : β → γ} {as : Vector α n} :
|
||||
(as.map f).map g = as.map (g ∘ f) := by
|
||||
cases as
|
||||
simp
|
||||
|
||||
/-! ### singleton -/
|
||||
|
||||
@[simp] theorem singleton_def (v : α) : Vector.singleton v = #v[v] := rfl
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
@[simp] theorem append_push {as : Vector α n} {bs : Vector α m} {a : α} :
|
||||
as ++ bs.push a = (as ++ bs).push a := by
|
||||
cases as
|
||||
cases bs
|
||||
simp
|
||||
|
||||
theorem singleton_eq_toVector_singleton (a : α) : #v[a] = #[a].toVector := rfl
|
||||
|
||||
@[simp] theorem mem_append {a : α} {s : Vector α n} {t : Vector α m} :
|
||||
a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
|
||||
cases s
|
||||
cases t
|
||||
simp
|
||||
|
||||
theorem mem_append_left {a : α} {s : Vector α n} {t : Vector α m} (h : a ∈ s) : a ∈ s ++ t :=
|
||||
mem_append.2 (Or.inl h)
|
||||
|
||||
theorem mem_append_right {a : α} {s : Vector α n} {t : Vector α m} (h : a ∈ t) : a ∈ s ++ t :=
|
||||
mem_append.2 (Or.inr h)
|
||||
|
||||
theorem not_mem_append {a : α} {s : Vector α n} {t : Vector α m} (h₁ : a ∉ s) (h₂ : a ∉ t) :
|
||||
a ∉ s ++ t :=
|
||||
mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
|
||||
|
||||
/--
|
||||
See also `eq_push_append_of_mem`, which proves a stronger version
|
||||
in which the initial array must not contain the element.
|
||||
-/
|
||||
theorem append_of_mem {a : α} {l : Vector α n} (h : a ∈ l) :
|
||||
∃ (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
|
||||
l = (s.push a ++ t).cast w := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
obtain ⟨s, t, rfl⟩ := Array.append_of_mem (by simpa using h)
|
||||
refine ⟨_, _, by simp, s.toVector, t.toVector, by simp_all⟩
|
||||
|
||||
theorem mem_iff_append {a : α} {l : Vector α n} :
|
||||
a ∈ l ↔ ∃ (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
|
||||
l = (s.push a ++ t).cast w :=
|
||||
⟨append_of_mem, by rintro ⟨m, k, rfl, s, t, rfl⟩; simp⟩
|
||||
|
||||
theorem forall_mem_append {p : α → Prop} {l₁ : Vector α n} {l₂ : Vector α m} :
|
||||
(∀ (x) (_ : x ∈ l₁ ++ l₂), p x) ↔ (∀ (x) (_ : x ∈ l₁), p x) ∧ (∀ (x) (_ : x ∈ l₂), p x) := by
|
||||
simp only [mem_append, or_imp, forall_and]
|
||||
|
||||
theorem empty_append (as : Vector α n) : (#v[] : Vector α 0) ++ as = as.cast (by omega) := by
|
||||
rcases as with ⟨as, rfl⟩
|
||||
simp
|
||||
|
||||
theorem append_empty (as : Vector α n) : as ++ (#v[] : Vector α 0) = as := by
|
||||
rw [← toArray_inj, toArray_append, Array.append_nil]
|
||||
|
||||
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
|
||||
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
rcases b with ⟨b, rfl⟩
|
||||
simp [Array.getElem_append, hi]
|
||||
|
||||
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
|
||||
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
|
||||
|
||||
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n ≤ i) :
|
||||
(a ++ b)[i] = b[i - n] := by
|
||||
rw [getElem_append, dif_neg (by omega)]
|
||||
|
||||
theorem getElem?_append_left {as : Vector α n} {bs : Vector α m} {i : Nat} (hn : i < n) :
|
||||
(as ++ bs)[i]? = as[i]? := by
|
||||
have hn' : i < n + m := by omega
|
||||
simp_all [getElem?_eq_getElem, getElem_append]
|
||||
|
||||
theorem getElem?_append_right {as : Vector α n} {bs : Vector α m} {i : Nat} (h : n ≤ i) :
|
||||
(as ++ bs)[i]? = bs[i - n]? := by
|
||||
rcases as with ⟨as, rfl⟩
|
||||
rcases bs with ⟨bs, rfl⟩
|
||||
simp [Array.getElem?_append_right, h]
|
||||
|
||||
theorem getElem?_append {as : Vector α n} {bs : Vector α m} {i : Nat} :
|
||||
(as ++ bs)[i]? = if i < n then as[i]? else bs[i - n]? := by
|
||||
split <;> rename_i h
|
||||
· exact getElem?_append_left h
|
||||
· exact getElem?_append_right (by simpa using h)
|
||||
|
||||
/-- Variant of `getElem_append_left` useful for rewriting from the small array to the big array. -/
|
||||
theorem getElem_append_left' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < m) :
|
||||
l₁[i] = (l₁ ++ l₂)[i] := by
|
||||
rw [getElem_append_left] <;> simp
|
||||
|
||||
/-- Variant of `getElem_append_right` useful for rewriting from the small array to the big array. -/
|
||||
theorem getElem_append_right' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < n) :
|
||||
l₂[i] = (l₁ ++ l₂)[i + m] := by
|
||||
rw [getElem_append_right] <;> simp [*, Nat.le_add_left]
|
||||
|
||||
theorem getElem_of_append {l : Vector α n} {l₁ : Vector α m} {l₂ : Vector α k}
|
||||
(w : m + 1 + k = n) (eq : l = (l₁.push a ++ l₂).cast w) :
|
||||
l[m] = a := Option.some.inj <| by
|
||||
rw [← getElem?_eq_getElem, eq, getElem?_cast, getElem?_append_left (by simp)]
|
||||
simp
|
||||
|
||||
@[simp 1100] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
|
||||
cases as
|
||||
simp
|
||||
|
||||
theorem append_inj {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m} (h : s₁ ++ t₁ = s₂ ++ t₂) :
|
||||
s₁ = s₂ ∧ t₁ = t₂ := by
|
||||
rcases s₁ with ⟨s₁, rfl⟩
|
||||
rcases s₂ with ⟨s₂, hs⟩
|
||||
rcases t₁ with ⟨t₁, rfl⟩
|
||||
rcases t₂ with ⟨t₂, ht⟩
|
||||
simpa using Array.append_inj (by simpa using h) (by omega)
|
||||
|
||||
theorem append_inj_right {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) : t₁ = t₂ :=
|
||||
(append_inj h).right
|
||||
|
||||
theorem append_inj_left {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) : s₁ = s₂ :=
|
||||
(append_inj h).left
|
||||
|
||||
theorem append_right_inj {t₁ t₂ : Vector α m} (s : Vector α n) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
|
||||
⟨fun h => append_inj_right h, congrArg _⟩
|
||||
|
||||
theorem append_left_inj {s₁ s₂ : Vector α n} (t : Vector α m) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
|
||||
⟨fun h => append_inj_left h, congrArg (· ++ _)⟩
|
||||
|
||||
theorem append_eq_append_iff {a : Vector α n} {b : Vector α m} {c : Vector α k} {d : Vector α l}
|
||||
(w : k + l = n + m) :
|
||||
a ++ b = (c ++ d).cast w ↔
|
||||
if h : n ≤ k then
|
||||
∃ a' : Vector α (k - n), c = (a ++ a').cast (by omega) ∧ b = (a' ++ d).cast (by omega)
|
||||
else
|
||||
∃ c' : Vector α (n - k), a = (c ++ c').cast (by omega) ∧ d = (c' ++ b).cast (by omega) := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
rcases b with ⟨b, rfl⟩
|
||||
rcases c with ⟨c, rfl⟩
|
||||
rcases d with ⟨d, rfl⟩
|
||||
simp only [mk_append_mk, Array.append_eq_append_iff, mk_eq, toArray_cast]
|
||||
constructor
|
||||
· rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
|
||||
· rw [dif_pos (by simp)]
|
||||
exact ⟨a'.toVector.cast (by simp; omega), by simp⟩
|
||||
· split <;> rename_i h
|
||||
· have hc : c'.size = 0 := by simp at h; omega
|
||||
simp at hc
|
||||
exact ⟨#v[].cast (by simp; omega), by simp_all⟩
|
||||
· exact ⟨c'.toVector.cast (by simp; omega), by simp⟩
|
||||
· split <;> rename_i h
|
||||
· rintro ⟨a', hc, rfl⟩
|
||||
left
|
||||
refine ⟨a'.toArray, hc, rfl⟩
|
||||
· rintro ⟨c', ha, rfl⟩
|
||||
right
|
||||
refine ⟨c'.toArray, ha, rfl⟩
|
||||
|
||||
theorem set_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n + m) :
|
||||
(s ++ t).set i x =
|
||||
if h' : i < n then
|
||||
s.set i x ++ t
|
||||
else
|
||||
s ++ t.set (i - n) x := by
|
||||
rcases s with ⟨s, rfl⟩
|
||||
rcases t with ⟨t, rfl⟩
|
||||
simp only [mk_append_mk, set_mk, Array.set_append]
|
||||
split <;> simp
|
||||
|
||||
@[simp] theorem set_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
|
||||
(s ++ t).set i x = s.set i x ++ t := by
|
||||
simp [set_append, h]
|
||||
|
||||
@[simp] theorem set_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
|
||||
(h' : i < n + m) (h : n ≤ i) :
|
||||
(s ++ t).set i x = s ++ t.set (i - n) x := by
|
||||
rw [set_append, dif_neg (by omega)]
|
||||
|
||||
theorem setIfInBounds_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} :
|
||||
(s ++ t).setIfInBounds i x =
|
||||
if i < n then
|
||||
s.setIfInBounds i x ++ t
|
||||
else
|
||||
s ++ t.setIfInBounds (i - n) x := by
|
||||
rcases s with ⟨s, rfl⟩
|
||||
rcases t with ⟨t, rfl⟩
|
||||
simp only [mk_append_mk, setIfInBounds_mk, Array.setIfInBounds_append]
|
||||
split <;> simp
|
||||
|
||||
@[simp] theorem setIfInBounds_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
|
||||
(s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
|
||||
simp [setIfInBounds_append, h]
|
||||
|
||||
@[simp] theorem setIfInBounds_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
|
||||
(h : n ≤ i) :
|
||||
(s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - n) x := by
|
||||
rw [setIfInBounds_append, if_neg (by omega)]
|
||||
|
||||
@[simp] theorem map_append (f : α → β) (l₁ : Vector α n) (l₂ : Vector α m) :
|
||||
map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
|
||||
rcases l₁ with ⟨l₁, rfl⟩
|
||||
rcases l₂ with ⟨l₂, rfl⟩
|
||||
simp
|
||||
|
||||
theorem map_eq_append_iff {f : α → β} :
|
||||
map f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
|
||||
rcases l with ⟨l, h⟩
|
||||
rcases L₁ with ⟨L₁, rfl⟩
|
||||
rcases L₂ with ⟨L₂, rfl⟩
|
||||
simp only [map_mk, mk_append_mk, eq_mk, Array.map_eq_append_iff, mk_eq, toArray_append,
|
||||
toArray_map]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
|
||||
exact ⟨l₁.toVector.cast (by simp), l₂.toVector.cast (by simp), by simp⟩
|
||||
· rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
|
||||
exact ⟨l₁, l₂, by simp_all⟩
|
||||
|
||||
theorem append_eq_map_iff {f : α → β} :
|
||||
L₁ ++ L₂ = map f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
|
||||
rw [eq_comm, map_eq_append_iff]
|
||||
|
||||
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
|
||||
|
||||
@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) :
|
||||
(Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by
|
||||
simp [ofFn]
|
||||
|
||||
@[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
|
||||
rcases v with ⟨data, rfl⟩
|
||||
simp
|
||||
@@ -1436,6 +1059,28 @@ defeq issues in the implicit size argument.
|
||||
subst h
|
||||
simp [pop, back, back!, ← Array.eq_push_pop_back!_of_size_ne_zero]
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
|
||||
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
rcases b with ⟨b, rfl⟩
|
||||
simp [Array.getElem_append, hi]
|
||||
|
||||
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
|
||||
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
|
||||
|
||||
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n ≤ i) :
|
||||
(a ++ b)[i] = b[i - n] := by
|
||||
rw [getElem_append, dif_neg (by omega)]
|
||||
|
||||
/-! ### cast -/
|
||||
|
||||
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
|
||||
(a.cast h)[i] = a[i] := by
|
||||
cases a
|
||||
simp
|
||||
|
||||
/-! ### extract -/
|
||||
|
||||
@[simp] theorem getElem_extract (a : Vector α n) (start stop) (i : Nat) (hi : i < min stop n - start) :
|
||||
@@ -1443,6 +1088,13 @@ defeq issues in the implicit size argument.
|
||||
cases a
|
||||
simp
|
||||
|
||||
/-! ### map -/
|
||||
|
||||
@[simp] theorem getElem_map (f : α → β) (a : Vector α n) (i : Nat) (hi : i < n) :
|
||||
(a.map f)[i] = f a[i] := by
|
||||
cases a
|
||||
simp
|
||||
|
||||
/-! ### zipWith -/
|
||||
|
||||
@[simp] theorem getElem_zipWith (f : α → β → γ) (a : Vector α n) (b : Vector β n) (i : Nat)
|
||||
@@ -1451,37 +1103,6 @@ defeq issues in the implicit size argument.
|
||||
cases b
|
||||
simp
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l : Vector α n) (l' : Vector α n') :
|
||||
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
|
||||
cases l
|
||||
cases l'
|
||||
simp
|
||||
|
||||
@[simp] theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (l : Vector α n) (a : α) :
|
||||
(l.push a).foldrM f init = f a init >>= l.foldrM f := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem foldl_eq_foldlM (f : β → α → β) (b) (l : Vector α n) :
|
||||
l.foldl f b = l.foldlM (m := Id) f b := by
|
||||
cases l
|
||||
simp [Array.foldl_eq_foldlM]
|
||||
|
||||
theorem foldr_eq_foldrM (f : α → β → β) (b) (l : Vector α n) :
|
||||
l.foldr f b = l.foldrM (m := Id) f b := by
|
||||
cases l
|
||||
simp [Array.foldr_eq_foldrM]
|
||||
|
||||
@[simp] theorem id_run_foldlM (f : β → α → Id β) (b) (l : Vector α n) :
|
||||
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
|
||||
|
||||
@[simp] theorem id_run_foldrM (f : α → β → Id β) (b) (l : Vector α n) :
|
||||
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
|
||||
|
||||
/-! ### foldl and foldr -/
|
||||
|
||||
/-! ### take -/
|
||||
|
||||
@[simp] theorem take_size (a : Vector α n) : a.take n = a.cast (by simp) := by
|
||||
|
||||
@@ -10,5 +10,3 @@ import Init.Grind.Lemmas
|
||||
import Init.Grind.Cases
|
||||
import Init.Grind.Propagator
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.Offset
|
||||
import Init.Grind.PP
|
||||
|
||||
@@ -12,9 +12,6 @@ import Init.Grind.Util
|
||||
|
||||
namespace Lean.Grind
|
||||
|
||||
theorem rfl_true : true = true :=
|
||||
rfl
|
||||
|
||||
theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' → q) : p → q :=
|
||||
fun hp => h (he.mp hp)
|
||||
|
||||
@@ -28,9 +25,6 @@ theorem and_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∧ b) = Fals
|
||||
theorem eq_true_of_and_eq_true_left {a b : Prop} (h : (a ∧ b) = True) : a = True := by simp_all
|
||||
theorem eq_true_of_and_eq_true_right {a b : Prop} (h : (a ∧ b) = True) : b = True := by simp_all
|
||||
|
||||
theorem or_of_and_eq_false {a b : Prop} (h : (a ∧ b) = False) : (¬a ∨ ¬b) := by
|
||||
by_cases a <;> by_cases b <;> simp_all
|
||||
|
||||
/-! Or -/
|
||||
|
||||
theorem or_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a ∨ b) = True := by simp [h]
|
||||
@@ -41,15 +35,6 @@ theorem or_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∨ b) = a :=
|
||||
theorem eq_false_of_or_eq_false_left {a b : Prop} (h : (a ∨ b) = False) : a = False := by simp_all
|
||||
theorem eq_false_of_or_eq_false_right {a b : Prop} (h : (a ∨ b) = False) : b = False := by simp_all
|
||||
|
||||
/-! Implies -/
|
||||
|
||||
theorem imp_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a → b) = True := by simp [h]
|
||||
theorem imp_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a → b) = True := by simp [h]
|
||||
theorem imp_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a → b) = b := by simp [h]
|
||||
|
||||
theorem eq_true_of_imp_eq_false {a b : Prop} (h : (a → b) = False) : a = True := by simp_all
|
||||
theorem eq_false_of_imp_eq_false {a b : Prop} (h : (a → b) = False) : b = False := by simp_all
|
||||
|
||||
/-! Not -/
|
||||
|
||||
theorem not_eq_of_eq_true {a : Prop} (h : a = True) : (Not a) = False := by simp [h]
|
||||
@@ -69,12 +54,6 @@ theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by s
|
||||
theorem eq_congr {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
|
||||
theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
|
||||
|
||||
/- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
|
||||
theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a ∨ b) ∧ (¬b ∨ a) := by
|
||||
by_cases a <;> by_cases b <;> simp_all
|
||||
theorem of_eq_eq_false {a b : Prop} (h : (a = b) = False) : (¬a ∨ ¬b) ∧ (b ∨ a) := by
|
||||
by_cases a <;> by_cases b <;> simp_all
|
||||
|
||||
/-! Forall -/
|
||||
|
||||
theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = True) (h₂ : q (of_eq_true h₁) = q') : (∀ hp : p, q hp) = q' := by
|
||||
@@ -82,28 +61,4 @@ theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = Tr
|
||||
· intro h'; exact Eq.mp h₂ (h' (of_eq_true h₁))
|
||||
· intro h'; intros; exact Eq.mpr h₂ h'
|
||||
|
||||
theorem of_forall_eq_false (α : Sort u) (p : α → Prop) (h : (∀ x : α, p x) = False) : ∃ x : α, ¬ p x := by simp_all
|
||||
|
||||
/-! dite -/
|
||||
|
||||
theorem dite_cond_eq_true' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c → α} {b : ¬ c → α} {r : α} (h₁ : c = True) (h₂ : a (of_eq_true h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
|
||||
theorem dite_cond_eq_false' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c → α} {b : ¬ c → α} {r : α} (h₁ : c = False) (h₂ : b (of_eq_false h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
|
||||
|
||||
/-! Casts -/
|
||||
|
||||
theorem eqRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
|
||||
{motive : (x : α) → a = x → Sort u_1} (v : motive a (Eq.refl a)) {b : α} (h : a = b)
|
||||
: HEq (@Eq.rec α a motive v b h) v := by
|
||||
subst h; rfl
|
||||
|
||||
theorem eqRecOn_heq.{u_1, u_2} {α : Sort u_2} {a : α}
|
||||
{motive : (x : α) → a = x → Sort u_1} {b : α} (h : a = b) (v : motive a (Eq.refl a))
|
||||
: HEq (@Eq.recOn α a motive b h v) v := by
|
||||
subst h; rfl
|
||||
|
||||
theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
|
||||
{motive : α → Sort u_1} (v : motive a) {b : α} (h : a = b)
|
||||
: HEq (@Eq.ndrec α a motive v b h) v := by
|
||||
subst h; rfl
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.SimpLemmas
|
||||
import Init.PropLemmas
|
||||
import Init.Classical
|
||||
import Init.ByCases
|
||||
|
||||
@@ -41,17 +40,10 @@ attribute [grind_norm] not_true
|
||||
-- False
|
||||
attribute [grind_norm] not_false_eq_true
|
||||
|
||||
-- Remark: we disabled the following normalization rule because we want this information when implementing splitting heuristics
|
||||
-- Implication as a clause
|
||||
theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
|
||||
@[grind_norm↓] theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
@[grind_norm] theorem true_imp_eq (p : Prop) : (True → p) = p := by simp
|
||||
@[grind_norm] theorem false_imp_eq (p : Prop) : (False → p) = True := by simp
|
||||
@[grind_norm] theorem imp_true_eq (p : Prop) : (p → True) = True := by simp
|
||||
@[grind_norm] theorem imp_false_eq (p : Prop) : (p → False) = ¬p := by simp
|
||||
@[grind_norm] theorem imp_self_eq (p : Prop) : (p → p) = True := by simp
|
||||
|
||||
-- And
|
||||
@[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
@@ -66,19 +58,13 @@ attribute [grind_norm] ite_true ite_false
|
||||
@[grind_norm↓] theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
|
||||
by_cases p <;> simp [*]
|
||||
|
||||
@[grind_norm] theorem ite_true_false {_ : Decidable p} : (ite p True False) = p := by
|
||||
by_cases p <;> simp
|
||||
|
||||
@[grind_norm] theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
|
||||
by_cases p <;> simp
|
||||
|
||||
-- Forall
|
||||
@[grind_norm↓] theorem not_forall (p : α → Prop) : (¬∀ x, p x) = ∃ x, ¬p x := by simp
|
||||
attribute [grind_norm] forall_and
|
||||
|
||||
-- Exists
|
||||
@[grind_norm↓] theorem not_exists (p : α → Prop) : (¬∃ x, p x) = ∀ x, ¬p x := by simp
|
||||
attribute [grind_norm] exists_const exists_or exists_prop exists_and_left exists_and_right
|
||||
attribute [grind_norm] exists_const exists_or
|
||||
|
||||
-- Bool cond
|
||||
@[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
|
||||
@@ -121,7 +107,4 @@ attribute [grind_norm] Nat.le_zero_eq
|
||||
-- GT GE
|
||||
attribute [grind_norm] GT.gt GE.ge
|
||||
|
||||
-- Succ
|
||||
attribute [grind_norm] Nat.succ_eq_add_one
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -1,83 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Core
|
||||
import Init.Omega
|
||||
|
||||
namespace Lean.Grind
|
||||
abbrev isLt (x y : Nat) : Bool := x < y
|
||||
abbrev isLE (x y : Nat) : Bool := x ≤ y
|
||||
|
||||
/-! Theorems for transitivity. -/
|
||||
theorem Nat.le_ro (u w v k : Nat) : u ≤ w → w ≤ v + k → u ≤ v + k := by
|
||||
omega
|
||||
theorem Nat.le_lo (u w v k : Nat) : u ≤ w → w + k ≤ v → u + k ≤ v := by
|
||||
omega
|
||||
theorem Nat.lo_le (u w v k : Nat) : u + k ≤ w → w ≤ v → u + k ≤ v := by
|
||||
omega
|
||||
theorem Nat.lo_lo (u w v k₁ k₂ : Nat) : u + k₁ ≤ w → w + k₂ ≤ v → u + (k₁ + k₂) ≤ v := by
|
||||
omega
|
||||
theorem Nat.lo_ro_1 (u w v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ w → w ≤ v + k₂ → u + (k₁ - k₂) ≤ v := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.lo_ro_2 (u w v k₁ k₂ : Nat) : u + k₁ ≤ w → w ≤ v + k₂ → u ≤ v + (k₂ - k₁) := by
|
||||
omega
|
||||
theorem Nat.ro_le (u w v k : Nat) : u ≤ w + k → w ≤ v → u ≤ v + k := by
|
||||
omega
|
||||
theorem Nat.ro_lo_1 (u w v k₁ k₂ : Nat) : u ≤ w + k₁ → w + k₂ ≤ v → u ≤ v + (k₁ - k₂) := by
|
||||
omega
|
||||
theorem Nat.ro_lo_2 (u w v k₁ k₂ : Nat) : isLt k₁ k₂ = true → u ≤ w + k₁ → w + k₂ ≤ v → u + (k₂ - k₁) ≤ v := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.ro_ro (u w v k₁ k₂ : Nat) : u ≤ w + k₁ → w ≤ v + k₂ → u ≤ v + (k₁ + k₂) := by
|
||||
omega
|
||||
|
||||
/-! Theorems for negating constraints. -/
|
||||
theorem Nat.of_le_eq_false (u v : Nat) : ((u ≤ v) = False) → v + 1 ≤ u := by
|
||||
simp; omega
|
||||
theorem Nat.of_lo_eq_false_1 (u v : Nat) : ((u + 1 ≤ v) = False) → v ≤ u := by
|
||||
simp; omega
|
||||
theorem Nat.of_lo_eq_false (u v k : Nat) : ((u + k ≤ v) = False) → v ≤ u + (k-1) := by
|
||||
simp; omega
|
||||
theorem Nat.of_ro_eq_false (u v k : Nat) : ((u ≤ v + k) = False) → v + (k+1) ≤ u := by
|
||||
simp; omega
|
||||
|
||||
/-! Theorems for closing a goal. -/
|
||||
theorem Nat.unsat_le_lo (u v k : Nat) : isLt 0 k = true → u ≤ v → v + k ≤ u → False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.unsat_lo_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true → u + k₁ ≤ v → v + k₂ ≤ u → False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.unsat_lo_ro (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ v → v ≤ u + k₂ → False := by
|
||||
simp [isLt]; omega
|
||||
|
||||
/-! Theorems for propagating constraints to `True` -/
|
||||
theorem Nat.lo_eq_true_of_lo (u v k₁ k₂ : Nat) : isLE k₂ k₁ = true → u + k₁ ≤ v → (u + k₂ ≤ v) = True :=
|
||||
by simp [isLt]; omega
|
||||
theorem Nat.le_eq_true_of_lo (u v k : Nat) : u + k ≤ v → (u ≤ v) = True :=
|
||||
by simp; omega
|
||||
theorem Nat.le_eq_true_of_le (u v : Nat) : u ≤ v → (u ≤ v) = True :=
|
||||
by simp
|
||||
theorem Nat.ro_eq_true_of_lo (u v k₁ k₂ : Nat) : u + k₁ ≤ v → (u ≤ v + k₂) = True :=
|
||||
by simp; omega
|
||||
theorem Nat.ro_eq_true_of_le (u v k : Nat) : u ≤ v → (u ≤ v + k) = True :=
|
||||
by simp; omega
|
||||
theorem Nat.ro_eq_true_of_ro (u v k₁ k₂ : Nat) : isLE k₁ k₂ = true → u ≤ v + k₁ → (u ≤ v + k₂) = True :=
|
||||
by simp [isLE]; omega
|
||||
|
||||
/-!
|
||||
Theorems for propagating constraints to `False`.
|
||||
They are variants of the theorems for closing a goal.
|
||||
-/
|
||||
theorem Nat.lo_eq_false_of_le (u v k : Nat) : isLt 0 k = true → u ≤ v → (v + k ≤ u) = False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.le_eq_false_of_lo (u v k : Nat) : isLt 0 k = true → u + k ≤ v → (v ≤ u) = False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.lo_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true → u + k₁ ≤ v → (v + k₂ ≤ u) = False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.ro_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true → u + k₁ ≤ v → (v ≤ u + k₂) = False := by
|
||||
simp [isLt]; omega
|
||||
theorem Nat.lo_eq_false_of_ro (u v k₁ k₂ : Nat) : isLt k₁ k₂ = true → u ≤ v + k₁ → (v + k₂ ≤ u) = False := by
|
||||
simp [isLt]; omega
|
||||
|
||||
end Lean.Grind
|
||||
@@ -1,30 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Lean.Grind
|
||||
/-!
|
||||
This is a hackish module for hovering node information in the `grind` tactic state.
|
||||
-/
|
||||
|
||||
inductive NodeDef where
|
||||
| unit
|
||||
|
||||
set_option linter.unusedVariables false in
|
||||
def node_def (_ : Nat) {α : Sort u} {a : α} : NodeDef := .unit
|
||||
|
||||
@[app_unexpander node_def]
|
||||
def nodeDefUnexpander : PrettyPrinter.Unexpander := fun stx => do
|
||||
match stx with
|
||||
| `($_ $id:num) => return mkIdent <| Name.mkSimple $ "#" ++ toString id.getNat
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander NodeDef]
|
||||
def NodeDefUnexpander : PrettyPrinter.Unexpander := fun _ => do
|
||||
return mkIdent <| Name.mkSimple "NodeDef"
|
||||
|
||||
end Lean.Grind
|
||||
@@ -6,27 +6,20 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Tactics
|
||||
|
||||
namespace Lean.Parser.Attr
|
||||
|
||||
syntax grindEq := "="
|
||||
syntax grindEqBoth := atomic("_" "=" "_")
|
||||
syntax grindEqRhs := atomic("=" "_")
|
||||
syntax grindBwd := "←"
|
||||
syntax grindFwd := "→"
|
||||
|
||||
syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
|
||||
|
||||
end Lean.Parser.Attr
|
||||
|
||||
namespace Lean.Grind
|
||||
/--
|
||||
The configuration for `grind`.
|
||||
Passed to `grind` using, for example, the `grind (config := { matchEqs := true })` syntax.
|
||||
Passed to `grind` using, for example, the `grind (config := { eager := true })` syntax.
|
||||
-/
|
||||
structure Config where
|
||||
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
|
||||
splits : Nat := 8
|
||||
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
|
||||
/-- When `eager` is true (default: `false`), `grind` eagerly splits `if-then-else` and `match` expressions during internalization. -/
|
||||
eager : Bool := false
|
||||
/-- Maximum number of branches (i.e., case-splits) in the proof search tree. -/
|
||||
splits : Nat := 100
|
||||
/--
|
||||
Maximum number of E-matching (aka heuristic theorem instantiation)
|
||||
in a proof search tree branch.
|
||||
-/
|
||||
ematch : Nat := 5
|
||||
/--
|
||||
Maximum term generation.
|
||||
@@ -35,16 +28,6 @@ structure Config where
|
||||
gen : Nat := 5
|
||||
/-- Maximum number of theorem instances generated using E-matching in a proof search tree branch. -/
|
||||
instances : Nat := 1000
|
||||
/-- If `matchEqs` is `true`, `grind` uses `match`-equations as E-matching theorems. -/
|
||||
matchEqs : Bool := true
|
||||
/-- If `splitMatch` is `true`, `grind` performs case-splitting on `match`-expressions during the search. -/
|
||||
splitMatch : Bool := true
|
||||
/-- If `splitIte` is `true`, `grind` performs case-splitting on `if-then-else` expressions during the search. -/
|
||||
splitIte : Bool := true
|
||||
/--
|
||||
If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
|
||||
Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
|
||||
splitIndPred : Bool := true
|
||||
deriving Inhabited, BEq
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -9,26 +9,11 @@ import Init.Core
|
||||
namespace Lean.Grind
|
||||
|
||||
/-- A helper gadget for annotating nested proofs in goals. -/
|
||||
def nestedProof (p : Prop) {h : p} : p := h
|
||||
def nestedProof (p : Prop) (h : p) : p := h
|
||||
|
||||
/--
|
||||
Gadget for marking terms that should not be normalized by `grind`s simplifier.
|
||||
`grind` uses a simproc to implement this feature.
|
||||
We use it when adding instances of `match`-equations to prevent them from being simplified to true.
|
||||
-/
|
||||
def doNotSimp {α : Sort u} (a : α) : α := a
|
||||
set_option pp.proofs true
|
||||
|
||||
/-- Gadget for representing offsets `t+k` in patterns. -/
|
||||
def offset (a b : Nat) : Nat := a + b
|
||||
|
||||
/--
|
||||
Gadget for annotating the equalities in `match`-equations conclusions.
|
||||
`_origin` is the term used to instantiate the `match`-equation using E-matching.
|
||||
When `EqMatch a b origin` is `True`, we mark `origin` as a resolved case-split.
|
||||
-/
|
||||
def EqMatch (a b : α) {_origin : α} : Prop := a = b
|
||||
|
||||
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
|
||||
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (nestedProof p hp) (nestedProof q hq) := by
|
||||
subst h; apply HEq.refl
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -4170,16 +4170,6 @@ def withRef [Monad m] [MonadRef m] {α} (ref : Syntax) (x : m α) : m α :=
|
||||
let ref := replaceRef ref oldRef
|
||||
MonadRef.withRef ref x
|
||||
|
||||
/--
|
||||
If `ref? = some ref`, run `x : m α` with a modified value for the `ref` by calling `withRef`.
|
||||
Otherwise, run `x` directly.
|
||||
-/
|
||||
@[always_inline, inline]
|
||||
def withRef? [Monad m] [MonadRef m] {α} (ref? : Option Syntax) (x : m α) : m α :=
|
||||
match ref? with
|
||||
| some ref => withRef ref x
|
||||
| _ => x
|
||||
|
||||
/-- A monad that supports syntax quotations. Syntax quotations (in term
|
||||
position) are monadic values that when executed retrieve the current "macro
|
||||
scope" from the monad and apply it to every identifier they introduce
|
||||
|
||||
@@ -818,7 +818,7 @@ syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
|
||||
After `with`, there is an optional tactic that runs on all branches, and
|
||||
then a list of alternatives.
|
||||
-/
|
||||
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)*)
|
||||
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
|
||||
|
||||
/--
|
||||
Assuming `x` is a variable in the local context with an inductive type,
|
||||
|
||||
@@ -21,6 +21,11 @@ def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration
|
||||
else
|
||||
addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
|
||||
|
||||
def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
|
||||
let env ← addDecl env opts decl cancelTk?
|
||||
compileDecl env opts decl
|
||||
|
||||
def addDecl (decl : Declaration) : CoreM Unit := do
|
||||
profileitM Exception "type checking" (← getOptions) do
|
||||
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
|
||||
|
||||
@@ -144,7 +144,11 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
|
||||
let type := mkApp (mkConst `IO) (mkConst `Unit)
|
||||
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
|
||||
safety := DefinitionSafety.safe }
|
||||
addAndCompile decl
|
||||
IO.ofExcept (setBuiltinInitAttr (← getEnv) name) >>= setEnv
|
||||
match (← getEnv).addAndCompile {} decl with
|
||||
-- TODO: pretty print error
|
||||
| Except.error e => do
|
||||
let msg ← (e.toMessageData {}).toString
|
||||
throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
|
||||
| Except.ok env => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -53,3 +53,18 @@ def isUnsafeRecName? : Name → Option Name
|
||||
| _ => none
|
||||
|
||||
end Compiler
|
||||
|
||||
namespace Environment
|
||||
|
||||
/--
|
||||
Compile the given block of mutual declarations.
|
||||
Assumes the declarations have already been added to the environment using `addDecl`.
|
||||
-/
|
||||
@[extern "lean_compile_decls"]
|
||||
opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
|
||||
|
||||
/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
|
||||
def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
|
||||
compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
|
||||
|
||||
end Environment
|
||||
|
||||
@@ -514,16 +514,13 @@ register_builtin_option compiler.enableNew : Bool := {
|
||||
@[extern "lean_lcnf_compile_decls"]
|
||||
opaque compileDeclsNew (declNames : List Name) : CoreM Unit
|
||||
|
||||
@[extern "lean_compile_decls"]
|
||||
opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
|
||||
|
||||
def compileDecl (decl : Declaration) : CoreM Unit := do
|
||||
let opts ← getOptions
|
||||
let decls := Compiler.getDeclNamesForCodeGen decl
|
||||
if compiler.enableNew.get opts then
|
||||
compileDeclsNew decls
|
||||
let res ← withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
|
||||
return compileDeclsOld (← getEnv) opts decls
|
||||
return (← getEnv).compileDecl opts decl
|
||||
match res with
|
||||
| Except.ok env => setEnv env
|
||||
| Except.error (KernelException.other msg) =>
|
||||
@@ -536,7 +533,7 @@ def compileDecls (decls : List Name) : CoreM Unit := do
|
||||
let opts ← getOptions
|
||||
if compiler.enableNew.get opts then
|
||||
compileDeclsNew decls
|
||||
match compileDeclsOld (← getEnv) opts decls with
|
||||
match (← getEnv).compileDecls opts decls with
|
||||
| Except.ok env => setEnv env
|
||||
| Except.error (KernelException.other msg) =>
|
||||
throwError msg
|
||||
|
||||
@@ -24,7 +24,7 @@ abbrev empty : AssocList α β :=
|
||||
|
||||
instance : EmptyCollection (AssocList α β) := ⟨empty⟩
|
||||
|
||||
abbrev insertNew (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
abbrev insert (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
m.cons k v
|
||||
|
||||
def isEmpty : AssocList α β → Bool
|
||||
@@ -77,12 +77,6 @@ def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β
|
||||
| true => cons a b es
|
||||
| false => cons k v (replace a b es)
|
||||
|
||||
def insert [BEq α] (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
if m.contains k then
|
||||
m.replace k v
|
||||
else
|
||||
m.insertNew k v
|
||||
|
||||
def erase [BEq α] (a : α) : AssocList α β → AssocList α β
|
||||
| nil => nil
|
||||
| cons k v es => match k == a with
|
||||
|
||||
@@ -11,22 +11,6 @@ import Init.Data.List.Impl
|
||||
namespace Lean
|
||||
namespace Json
|
||||
|
||||
set_option maxRecDepth 1024 in
|
||||
/--
|
||||
This table contains for each UTF-8 byte whether we need to escape a string that contains it.
|
||||
-/
|
||||
private def escapeTable : { xs : ByteArray // xs.size = 256 } :=
|
||||
⟨ByteArray.mk #[
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
|
||||
0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
|
||||
], by rfl⟩
|
||||
|
||||
private def escapeAux (acc : String) (c : Char) : String :=
|
||||
-- escape ", \, \n and \r, keep all other characters ≥ 0x20 and render characters < 0x20 with \u
|
||||
if c = '"' then -- hack to prevent emacs from regarding the rest of the file as a string: "
|
||||
@@ -55,27 +39,8 @@ private def escapeAux (acc : String) (c : Char) : String :=
|
||||
let d4 := Nat.digitChar (n % 16)
|
||||
acc ++ "\\u" |>.push d1 |>.push d2 |>.push d3 |>.push d4
|
||||
|
||||
private def needEscape (s : String) : Bool :=
|
||||
go s 0
|
||||
where
|
||||
go (s : String) (i : Nat) : Bool :=
|
||||
if h : i < s.utf8ByteSize then
|
||||
let byte := s.getUtf8Byte i h
|
||||
have h1 : byte.toNat < 256 := UInt8.toNat_lt_size byte
|
||||
have h2 : escapeTable.val.size = 256 := escapeTable.property
|
||||
if escapeTable.val.get byte.toNat (Nat.lt_of_lt_of_eq h1 h2.symm) == 0 then
|
||||
go s (i + 1)
|
||||
else
|
||||
true
|
||||
else
|
||||
false
|
||||
|
||||
def escape (s : String) (acc : String := "") : String :=
|
||||
-- If we don't have any characters that need to be escaped we can just append right away.
|
||||
if needEscape s then
|
||||
s.foldl escapeAux acc
|
||||
else
|
||||
acc ++ s
|
||||
s.foldl escapeAux acc
|
||||
|
||||
def renderString (s : String) (acc : String := "") : String :=
|
||||
let acc := acc ++ "\""
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
prelude
|
||||
import Lean.Data.Lsp.Basic
|
||||
import Lean.Data.Lsp.CancelParams
|
||||
import Lean.Data.Lsp.Capabilities
|
||||
import Lean.Data.Lsp.Client
|
||||
import Lean.Data.Lsp.Communication
|
||||
|
||||
@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
prelude
|
||||
import Lean.Data.Json
|
||||
import Lean.Data.JsonRpc
|
||||
|
||||
/-! Defines most of the 'Basic Structures' in the LSP specification
|
||||
(https://microsoft.github.io/language-server-protocol/specifications/specification-current/),
|
||||
@@ -18,6 +19,10 @@ namespace Lsp
|
||||
|
||||
open Json
|
||||
|
||||
structure CancelParams where
|
||||
id : JsonRpc.RequestID
|
||||
deriving Inhabited, BEq, ToJson, FromJson
|
||||
|
||||
abbrev DocumentUri := String
|
||||
|
||||
/-- We adopt the convention that zero-based UTF-16 positions as sent by LSP clients
|
||||
|
||||
@@ -1,25 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2020 Marc Huisinga. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
|
||||
Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
prelude
|
||||
import Lean.Data.JsonRpc
|
||||
|
||||
/-! # Defines `Lean.Lsp.CancelParams`.
|
||||
|
||||
This is separate from `Lean.Data.Lsp.Basic` to reduce transitive dependencies.
|
||||
-/
|
||||
|
||||
namespace Lean
|
||||
namespace Lsp
|
||||
|
||||
open Json
|
||||
|
||||
structure CancelParams where
|
||||
id : JsonRpc.RequestID
|
||||
deriving Inhabited, BEq, ToJson, FromJson
|
||||
|
||||
end Lsp
|
||||
end Lean
|
||||
@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.String
|
||||
import Init.Data.Array
|
||||
import Lean.Data.Lsp.Basic
|
||||
import Lean.Data.Position
|
||||
import Lean.DeclarationRange
|
||||
|
||||
@@ -1474,7 +1474,7 @@ where
|
||||
| field::fields, false => .fieldName field field.getId.getString! none fIdent :: toLVals fields false
|
||||
|
||||
/-- Resolve `(.$id:ident)` using the expected type to infer namespace. -/
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Name := do
|
||||
tryPostponeIfNoneOrMVar expectedType?
|
||||
let some expectedType := expectedType?
|
||||
| throwError "invalid dotted identifier notation, expected type must be known"
|
||||
@@ -1489,7 +1489,7 @@ where
|
||||
withForallBody body k
|
||||
else
|
||||
k body
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Name := do
|
||||
let resultType ← instantiateMVars resultType
|
||||
let resultTypeFn := resultType.cleanupAnnotations.getAppFn
|
||||
try
|
||||
@@ -1497,12 +1497,9 @@ where
|
||||
let .const declName .. := resultTypeFn.cleanupAnnotations
|
||||
| throwError "invalid dotted identifier notation, expected type is not of the form (... → C ...) where C is a constant{indentExpr expectedType}"
|
||||
let idNew := declName ++ id.getId.eraseMacroScopes
|
||||
if (← getEnv).contains idNew then
|
||||
mkConst idNew
|
||||
else if let some (fvar, []) ← resolveLocalName idNew then
|
||||
return fvar
|
||||
else
|
||||
unless (← getEnv).contains idNew do
|
||||
throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
|
||||
return idNew
|
||||
catch
|
||||
| ex@(.error ..) =>
|
||||
match (← unfoldDefinition? resultType) with
|
||||
@@ -1551,7 +1548,7 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
|
||||
| `(_) => throwError "placeholders '_' cannot be used where a function is expected"
|
||||
| `(.$id:ident) =>
|
||||
addCompletionInfo <| CompletionInfo.dotId f id.getId (← getLCtx) expectedType?
|
||||
let fConst ← resolveDotName id expectedType?
|
||||
let fConst ← mkConst (← resolveDotName id expectedType?)
|
||||
let s ← observing do
|
||||
-- Use (force := true) because we want to record the result of .ident resolution even in patterns
|
||||
let fConst ← addTermInfo f fConst expectedType? (force := true)
|
||||
|
||||
@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
|
||||
-/
|
||||
prelude
|
||||
import Lean.Parser.Module
|
||||
import Lean.Util.Paths
|
||||
import Lean.Data.Json
|
||||
|
||||
namespace Lean.Elab
|
||||
|
||||
@@ -42,12 +42,4 @@ def printImports (input : String) (fileName : Option String) : IO Unit := do
|
||||
let fname ← findOLean dep.module
|
||||
IO.println fname
|
||||
|
||||
@[export lean_print_import_srcs]
|
||||
def printImportSrcs (input : String) (fileName : Option String) : IO Unit := do
|
||||
let sp ← initSrcSearchPath
|
||||
let (deps, _, _) ← parseImports input fileName
|
||||
for dep in deps do
|
||||
let fname ← findLean sp dep.module
|
||||
IO.println fname
|
||||
|
||||
end Lean.Elab
|
||||
|
||||
@@ -362,9 +362,9 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
|
||||
| `(tactic| intro $h:term $hs:term*) => evalTactic (← `(tactic| intro $h:term; intro $hs:term*))
|
||||
| _ => throwUnsupportedSyntax
|
||||
where
|
||||
introStep (ref? : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
|
||||
introStep (ref : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
|
||||
let fvarId ← liftMetaTacticAux fun mvarId => do
|
||||
let (fvarId, mvarId) ← withRef? ref? <| mvarId.intro n
|
||||
let (fvarId, mvarId) ← mvarId.intro n
|
||||
pure (fvarId, [mvarId])
|
||||
if let some typeStx := typeStx? then
|
||||
withMainContext do
|
||||
@@ -374,9 +374,9 @@ where
|
||||
unless (← isDefEqGuarded type fvarType) do
|
||||
throwError "type mismatch at `intro {fvar}`{← mkHasTypeButIsExpectedMsg fvarType type}"
|
||||
liftMetaTactic fun mvarId => return [← mvarId.replaceLocalDeclDefEq fvarId type]
|
||||
if let some ref := ref? then
|
||||
if let some stx := ref then
|
||||
withMainContext do
|
||||
Term.addLocalVarInfo ref (mkFVar fvarId)
|
||||
Term.addLocalVarInfo stx (mkFVar fvarId)
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.introMatch] def evalIntroMatch : Tactic := fun stx => do
|
||||
let matchAlts := stx[1]
|
||||
|
||||
@@ -24,8 +24,11 @@ def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t :
|
||||
finally
|
||||
modifyEnv Meta.instanceExtension.popScope
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.classical, builtin_incremental]
|
||||
def evalClassical : Tactic := fun stx =>
|
||||
classical <| Term.withNarrowedArgTacticReuse (argIdx := 1) Elab.Tactic.evalTactic stx
|
||||
@[builtin_tactic Lean.Parser.Tactic.classical]
|
||||
def evalClassical : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| classical $tacs:tacticSeq) =>
|
||||
classical <| Elab.Tactic.evalTactic tacs
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
|
||||
@@ -7,10 +7,9 @@ prelude
|
||||
import Lean.Elab.Tactic.Simp
|
||||
import Lean.Elab.Tactic.Split
|
||||
import Lean.Elab.Tactic.Conv.Basic
|
||||
import Lean.Elab.Tactic.SimpTrace
|
||||
|
||||
namespace Lean.Elab.Tactic.Conv
|
||||
open Meta Tactic TryThis
|
||||
open Meta
|
||||
|
||||
def applySimpResult (result : Simp.Result) : TacticM Unit := do
|
||||
if result.proof?.isNone then
|
||||
@@ -24,19 +23,6 @@ def applySimpResult (result : Simp.Result) : TacticM Unit := do
|
||||
let (result, _) ← dischargeWrapper.with fun d? => simp lhs ctx (simprocs := simprocs) (discharge? := d?)
|
||||
applySimpResult result
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.simpTrace] def evalSimpTrace : Tactic := fun stx => withMainContext do
|
||||
match stx with
|
||||
| `(conv| simp?%$tk $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]?) => do
|
||||
let stx ← `(tactic| simp%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]?)
|
||||
let { ctx, simprocs, dischargeWrapper, .. } ← mkSimpContext stx (eraseLocal := false)
|
||||
let lhs ← getLhs
|
||||
let (result, stats) ← dischargeWrapper.with fun d? =>
|
||||
simp lhs ctx (simprocs := simprocs) (discharge? := d?)
|
||||
applySimpResult result
|
||||
let stx ← mkSimpCallStx stx stats.usedTheorems
|
||||
addSuggestion tk stx (origSpan? := ← getRef)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.simpMatch] def evalSimpMatch : Tactic := fun _ => withMainContext do
|
||||
applySimpResult (← Split.simpMatch (← getLhs))
|
||||
|
||||
@@ -44,15 +30,4 @@ def applySimpResult (result : Simp.Result) : TacticM Unit := do
|
||||
let { ctx, .. } ← mkSimpContext stx (eraseLocal := false) (kind := .dsimp)
|
||||
changeLhs (← Lean.Meta.dsimp (← getLhs) ctx).1
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.dsimpTrace] def evalDSimpTrace : Tactic := fun stx => withMainContext do
|
||||
match stx with
|
||||
| `(conv| dsimp?%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]?) =>
|
||||
let stx ← `(tactic| dsimp%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]?)
|
||||
let { ctx, .. } ← mkSimpContext stx (eraseLocal := false) (kind := .dsimp)
|
||||
let (result, stats) ← Lean.Meta.dsimp (← getLhs) ctx
|
||||
changeLhs result
|
||||
let stx ← mkSimpCallStx stx stats.usedTheorems
|
||||
addSuggestion tk stx (origSpan? := ← getRef)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic.Conv
|
||||
|
||||
@@ -26,18 +26,16 @@ def elabGrindPattern : CommandElab := fun stx => do
|
||||
let info ← getConstInfo declName
|
||||
forallTelescope info.type fun xs _ => do
|
||||
let patterns ← terms.getElems.mapM fun term => do
|
||||
let pattern ← elabTerm term none
|
||||
synthesizeSyntheticMVarsUsingDefault
|
||||
let pattern ← instantiateMVars pattern
|
||||
let pattern ← Grind.preprocessPattern pattern
|
||||
let pattern ← instantiateMVars (← elabTerm term none)
|
||||
let pattern ← Grind.unfoldReducible pattern
|
||||
return pattern.abstract xs
|
||||
Grind.addEMatchTheorem declName xs.size patterns.toList
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
def grind (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
|
||||
let goals ← Grind.main mvarId config mainDeclName fallback
|
||||
unless goals.isEmpty do
|
||||
throwError "`grind` failed\n{← Grind.goalsToMessageData goals}"
|
||||
let mvarIds ← Grind.main mvarId config mainDeclName fallback
|
||||
unless mvarIds.isEmpty do
|
||||
throwError "`grind` failed\n{goalsToMessageData mvarIds}"
|
||||
|
||||
private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
|
||||
let some fallback := fallback? | return (pure ())
|
||||
|
||||
@@ -258,11 +258,11 @@ private def saveAltVarsInfo (altMVarId : MVarId) (altStx : Syntax) (fvarIds : Ar
|
||||
i := i + 1
|
||||
|
||||
open Language in
|
||||
def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs? : Option (Array Syntax))
|
||||
def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs : Array Syntax)
|
||||
(initialInfo : Info)
|
||||
(numEqs : Nat := 0) (numGeneralized : Nat := 0) (toClear : Array FVarId := #[])
|
||||
(toTag : Array (Ident × FVarId) := #[]) : TacticM Unit := do
|
||||
let hasAlts := altStxs?.isSome
|
||||
let hasAlts := altStxs.size > 0
|
||||
if hasAlts then
|
||||
-- default to initial state outside of alts
|
||||
-- HACK: because this node has the same span as the original tactic,
|
||||
@@ -274,7 +274,9 @@ def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altS
|
||||
where
|
||||
-- continuation in the correct info context
|
||||
goWithInfo := do
|
||||
if let some altStxs := altStxs? then
|
||||
let hasAlts := altStxs.size > 0
|
||||
|
||||
if hasAlts then
|
||||
if let some tacSnap := (← readThe Term.Context).tacSnap? then
|
||||
-- incrementality: create a new promise for each alternative, resolve current snapshot to
|
||||
-- them, eventually put each of them back in `Context.tacSnap?` in `applyAltStx`
|
||||
@@ -307,8 +309,7 @@ where
|
||||
|
||||
-- continuation in the correct incrementality context
|
||||
goWithIncremental (tacSnaps : Array (SnapshotBundle TacticParsedSnapshot)) := do
|
||||
let hasAlts := altStxs?.isSome
|
||||
let altStxs := altStxs?.getD #[]
|
||||
let hasAlts := altStxs.size > 0
|
||||
let mut alts := alts
|
||||
|
||||
-- initial sanity checks: named cases should be known, wildcards should be last
|
||||
@@ -342,12 +343,12 @@ where
|
||||
let altName := getAltName altStx
|
||||
if let some i := alts.findFinIdx? (·.1 == altName) then
|
||||
-- cover named alternative
|
||||
applyAltStx tacSnaps altStxs altStxIdx altStx alts[i]
|
||||
applyAltStx tacSnaps altStxIdx altStx alts[i]
|
||||
alts := alts.eraseIdx i
|
||||
else if !alts.isEmpty && isWildcard altStx then
|
||||
-- cover all alternatives
|
||||
for alt in alts do
|
||||
applyAltStx tacSnaps altStxs altStxIdx altStx alt
|
||||
applyAltStx tacSnaps altStxIdx altStx alt
|
||||
alts := #[]
|
||||
else
|
||||
throwErrorAt altStx "unused alternative '{altName}'"
|
||||
@@ -378,7 +379,7 @@ where
|
||||
altMVarIds.forM fun mvarId => admitGoal mvarId
|
||||
|
||||
/-- Applies syntactic alternative to alternative goal. -/
|
||||
applyAltStx tacSnaps altStxs altStxIdx altStx alt := withRef altStx do
|
||||
applyAltStx tacSnaps altStxIdx altStx alt := withRef altStx do
|
||||
let { name := altName, info, mvarId := altMVarId } := alt
|
||||
-- also checks for unknown alternatives
|
||||
let numFields ← getAltNumFields elimInfo altName
|
||||
@@ -475,7 +476,7 @@ private def generalizeVars (mvarId : MVarId) (stx : Syntax) (targets : Array Exp
|
||||
/--
|
||||
Given `inductionAlts` of the form
|
||||
```
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
|
||||
```
|
||||
Return an array containing its alternatives.
|
||||
-/
|
||||
@@ -485,30 +486,21 @@ private def getAltsOfInductionAlts (inductionAlts : Syntax) : Array Syntax :=
|
||||
/--
|
||||
Given `inductionAlts` of the form
|
||||
```
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
|
||||
```
|
||||
runs `cont (some alts)` where `alts` is an array containing all `inductionAlt`s while disabling incremental
|
||||
reuse if any other syntax changed. If there's no `with` clause, then runs `cont none`.
|
||||
runs `cont alts` where `alts` is an array containing all `inductionAlt`s while disabling incremental
|
||||
reuse if any other syntax changed.
|
||||
-/
|
||||
private def withAltsOfOptInductionAlts (optInductionAlts : Syntax)
|
||||
(cont : Option (Array Syntax) → TacticM α) : TacticM α :=
|
||||
(cont : Array Syntax → TacticM α) : TacticM α :=
|
||||
Term.withNarrowedTacticReuse (stx := optInductionAlts) (fun optInductionAlts =>
|
||||
if optInductionAlts.isNone then
|
||||
-- if there are no alternatives, what to compare is irrelevant as there will be no reuse
|
||||
(mkNullNode #[], mkNullNode #[])
|
||||
else
|
||||
-- if there are no alts, then use the `with` token for `inner` for a ref for messages
|
||||
let altStxs := optInductionAlts[0].getArg 2
|
||||
let inner := if altStxs.getNumArgs > 0 then altStxs else optInductionAlts[0][0]
|
||||
-- `with` and tactic applied to all branches must be unchanged for reuse
|
||||
(mkNullNode optInductionAlts[0].getArgs[:2], inner))
|
||||
(fun alts? =>
|
||||
if optInductionAlts.isNone then -- no `with` clause
|
||||
cont none
|
||||
else if alts?.isOfKind nullKind then -- has alts
|
||||
cont (some alts?.getArgs)
|
||||
else -- has `with` clause, but no alts
|
||||
cont (some #[]))
|
||||
(mkNullNode optInductionAlts[0].getArgs[:2], optInductionAlts[0].getArg 2))
|
||||
(fun alts => cont alts.getArgs)
|
||||
|
||||
private def getOptPreTacOfOptInductionAlts (optInductionAlts : Syntax) : Syntax :=
|
||||
if optInductionAlts.isNone then mkNullNode else optInductionAlts[0][1]
|
||||
@@ -526,7 +518,7 @@ private def expandMultiAlt? (alt : Syntax) : Option (Array Syntax) := Id.run do
|
||||
/--
|
||||
Given `inductionAlts` of the form
|
||||
```
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
|
||||
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
|
||||
```
|
||||
Return `some inductionAlts'` if one of the alternatives have multiple LHSs, in the new `inductionAlts'`
|
||||
all alternatives have a single LHS.
|
||||
@@ -708,10 +700,10 @@ def evalInduction : Tactic := fun stx =>
|
||||
-- unchanged
|
||||
-- everything up to the alternatives must be unchanged for reuse
|
||||
Term.withNarrowedArgTacticReuse (stx := stx) (argIdx := 4) fun optInductionAlts => do
|
||||
withAltsOfOptInductionAlts optInductionAlts fun alts? => do
|
||||
withAltsOfOptInductionAlts optInductionAlts fun alts => do
|
||||
let optPreTac := getOptPreTacOfOptInductionAlts optInductionAlts
|
||||
mvarId.assign result.elimApp
|
||||
ElimApp.evalAlts elimInfo result.alts optPreTac alts? initInfo (numGeneralized := n) (toClear := targetFVarIds)
|
||||
ElimApp.evalAlts elimInfo result.alts optPreTac alts initInfo (numGeneralized := n) (toClear := targetFVarIds)
|
||||
appendGoals result.others.toList
|
||||
where
|
||||
checkTargets (targets : Array Expr) : MetaM Unit := do
|
||||
|
||||
@@ -680,7 +680,7 @@ def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do
|
||||
|
||||
/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This
|
||||
`TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via
|
||||
the tactic call `aesop (add 50% tactic Lean.Elab.Tactic.Omega.omegaDefault)`. -/
|
||||
the tactic call `aesop (add 50% tactic Lean.Omega.omegaDefault)`. -/
|
||||
def omegaDefault : TacticM Unit := omegaTactic {}
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.omega]
|
||||
|
||||
@@ -507,7 +507,7 @@ partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a
|
||||
match pat with
|
||||
| `(rintroPat| $pat:rcasesPat) =>
|
||||
let pat := (← RCasesPatt.parse pat).typed? ref ty?
|
||||
let (v, g) ← withRef pat.ref <| g.intro (pat.name?.getD `_)
|
||||
let (v, g) ← g.intro (pat.name?.getD `_)
|
||||
rcasesCore g fs clears (.fvar v) a pat cont
|
||||
| `(rintroPat| ($(pats)* $[: $ty?']?)) =>
|
||||
let ref := if pats.size == 1 then pat.raw else .missing
|
||||
|
||||
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Parser.Syntax
|
||||
import Lean.Meta.Tactic.Simp.RegisterCommand
|
||||
import Lean.Elab.Command
|
||||
import Lean.Elab.SetOption
|
||||
|
||||
@@ -11,14 +11,14 @@ import Lean.Meta.DecLevel
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
/-- Returns `id e` -/
|
||||
/-- Return `id e` -/
|
||||
def mkId (e : Expr) : MetaM Expr := do
|
||||
let type ← inferType e
|
||||
let u ← getLevel type
|
||||
return mkApp2 (mkConst ``id [u]) type e
|
||||
|
||||
/--
|
||||
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, returns
|
||||
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, return
|
||||
term `@id expectedType e`. -/
|
||||
def mkExpectedTypeHint (e : Expr) (expectedType : Expr) : MetaM Expr := do
|
||||
let u ← getLevel expectedType
|
||||
@@ -38,13 +38,13 @@ def mkLetFun (x : Expr) (v : Expr) (e : Expr) : MetaM Expr := do
|
||||
let u2 ← getLevel ety
|
||||
return mkAppN (.const ``letFun [u1, u2]) #[α, β, v, f]
|
||||
|
||||
/-- Returns `a = b`. -/
|
||||
/-- Return `a = b`. -/
|
||||
def mkEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp3 (mkConst ``Eq [u]) aType a b
|
||||
|
||||
/-- Returns `HEq a b`. -/
|
||||
/-- Return `HEq a b`. -/
|
||||
def mkHEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let bType ← inferType b
|
||||
@@ -52,7 +52,7 @@ def mkHEq (a b : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``HEq [u]) aType a bType b
|
||||
|
||||
/--
|
||||
If `a` and `b` have definitionally equal types, returns `Eq a b`, otherwise returns `HEq a b`.
|
||||
If `a` and `b` have definitionally equal types, return `Eq a b`, otherwise return `HEq a b`.
|
||||
-/
|
||||
def mkEqHEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
@@ -63,25 +63,25 @@ def mkEqHEq (a b : Expr) : MetaM Expr := do
|
||||
else
|
||||
return mkApp4 (mkConst ``HEq [u]) aType a bType b
|
||||
|
||||
/-- Returns a proof of `a = a`. -/
|
||||
/-- Return a proof of `a = a`. -/
|
||||
def mkEqRefl (a : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp2 (mkConst ``Eq.refl [u]) aType a
|
||||
|
||||
/-- Returns a proof of `HEq a a`. -/
|
||||
/-- Return a proof of `HEq a a`. -/
|
||||
def mkHEqRefl (a : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp2 (mkConst ``HEq.refl [u]) aType a
|
||||
|
||||
/-- Given `hp : P` and `nhp : Not P`, returns an instance of type `e`. -/
|
||||
/-- Given `hp : P` and `nhp : Not P` returns an instance of type `e`. -/
|
||||
def mkAbsurd (e : Expr) (hp hnp : Expr) : MetaM Expr := do
|
||||
let p ← inferType hp
|
||||
let u ← getLevel e
|
||||
return mkApp4 (mkConst ``absurd [u]) p e hp hnp
|
||||
|
||||
/-- Given `h : False`, returns an instance of type `e`. -/
|
||||
/-- Given `h : False`, return an instance of type `e`. -/
|
||||
def mkFalseElim (e : Expr) (h : Expr) : MetaM Expr := do
|
||||
let u ← getLevel e
|
||||
return mkApp2 (mkConst ``False.elim [u]) e h
|
||||
@@ -108,7 +108,7 @@ def mkEqSymm (h : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``Eq.symm [u]) α a b h
|
||||
| none => throwAppBuilderException ``Eq.symm ("equality proof expected" ++ hasTypeMsg h hType)
|
||||
|
||||
/-- Given `h₁ : a = b` and `h₂ : b = c`, returns a proof of `a = c`. -/
|
||||
/-- Given `h₁ : a = b` and `h₂ : b = c` returns a proof of `a = c`. -/
|
||||
def mkEqTrans (h₁ h₂ : Expr) : MetaM Expr := do
|
||||
if h₁.isAppOf ``Eq.refl then
|
||||
return h₂
|
||||
@@ -185,7 +185,7 @@ def mkHEqOfEq (h : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``heq_of_eq [u]) α a b h
|
||||
|
||||
/--
|
||||
If `e` is `@Eq.refl α a`, returns `a`.
|
||||
If `e` is `@Eq.refl α a`, return `a`.
|
||||
-/
|
||||
def isRefl? (e : Expr) : Option Expr := do
|
||||
if e.isAppOfArity ``Eq.refl 2 then
|
||||
@@ -194,7 +194,7 @@ def isRefl? (e : Expr) : Option Expr := do
|
||||
none
|
||||
|
||||
/--
|
||||
If `e` is `@congrArg α β a b f h`, returns `α`, `f` and `h`.
|
||||
If `e` is `@congrArg α β a b f h`, return `α`, `f` and `h`.
|
||||
Also works if `e` can be turned into such an application (e.g. `congrFun`).
|
||||
-/
|
||||
def congrArg? (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
|
||||
@@ -336,14 +336,13 @@ private def withAppBuilderTrace [ToMessageData α] [ToMessageData β]
|
||||
throw ex
|
||||
|
||||
/--
|
||||
Returns the application `constName xs`.
|
||||
Return the application `constName xs`.
|
||||
It tries to fill the implicit arguments before the last element in `xs`.
|
||||
|
||||
Remark:
|
||||
``mkAppM `arbitrary #[α]`` returns `@arbitrary.{u} α` without synthesizing
|
||||
the implicit argument occurring after `α`.
|
||||
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]``,
|
||||
returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
|
||||
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]`` returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
|
||||
-/
|
||||
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := do
|
||||
withAppBuilderTrace constName xs do withNewMCtxDepth do
|
||||
@@ -466,9 +465,8 @@ def mkPure (monad : Expr) (e : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Pure.pure #[monad, none, none, e]
|
||||
|
||||
/--
|
||||
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
|
||||
Remark: `fieldName` may be a subfield of `s`.
|
||||
-/
|
||||
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
|
||||
Remark: `fieldName` may be a subfield of `s`. -/
|
||||
partial def mkProjection (s : Expr) (fieldName : Name) : MetaM Expr := do
|
||||
let type ← inferType s
|
||||
let type ← whnf type
|
||||
@@ -522,11 +520,11 @@ def mkSome (type value : Expr) : MetaM Expr := do
|
||||
let u ← getDecLevel type
|
||||
return mkApp2 (mkConst ``Option.some [u]) type value
|
||||
|
||||
/-- Returns `Decidable.decide p` -/
|
||||
/-- Return `Decidable.decide p` -/
|
||||
def mkDecide (p : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Decidable.decide #[p, none]
|
||||
|
||||
/-- Returns a proof for `p : Prop` using `decide p` -/
|
||||
/-- Return a proof for `p : Prop` using `decide p` -/
|
||||
def mkDecideProof (p : Expr) : MetaM Expr := do
|
||||
let decP ← mkDecide p
|
||||
let decEqTrue ← mkEq decP (mkConst ``Bool.true)
|
||||
@@ -534,75 +532,59 @@ def mkDecideProof (p : Expr) : MetaM Expr := do
|
||||
let h ← mkExpectedTypeHint h decEqTrue
|
||||
mkAppM ``of_decide_eq_true #[h]
|
||||
|
||||
/-- Returns `a < b` -/
|
||||
/-- Return `a < b` -/
|
||||
def mkLt (a b : Expr) : MetaM Expr :=
|
||||
mkAppM ``LT.lt #[a, b]
|
||||
|
||||
/-- Returns `a <= b` -/
|
||||
/-- Return `a <= b` -/
|
||||
def mkLe (a b : Expr) : MetaM Expr :=
|
||||
mkAppM ``LE.le #[a, b]
|
||||
|
||||
/-- Returns `Inhabited.default α` -/
|
||||
/-- Return `Inhabited.default α` -/
|
||||
def mkDefault (α : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Inhabited.default #[α, none]
|
||||
|
||||
/-- Returns `@Classical.ofNonempty α _` -/
|
||||
/-- Return `@Classical.ofNonempty α _` -/
|
||||
def mkOfNonempty (α : Expr) : MetaM Expr := do
|
||||
mkAppOptM ``Classical.ofNonempty #[α, none]
|
||||
|
||||
/-- Returns `funext h` -/
|
||||
/-- Return `funext h` -/
|
||||
def mkFunExt (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``funext #[h]
|
||||
|
||||
/-- Returns `propext h` -/
|
||||
/-- Return `propext h` -/
|
||||
def mkPropExt (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``propext #[h]
|
||||
|
||||
/-- Returns `let_congr h₁ h₂` -/
|
||||
/-- Return `let_congr h₁ h₂` -/
|
||||
def mkLetCongr (h₁ h₂ : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_congr #[h₁, h₂]
|
||||
|
||||
/-- Returns `let_val_congr b h` -/
|
||||
/-- Return `let_val_congr b h` -/
|
||||
def mkLetValCongr (b h : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_val_congr #[b, h]
|
||||
|
||||
/-- Returns `let_body_congr a h` -/
|
||||
/-- Return `let_body_congr a h` -/
|
||||
def mkLetBodyCongr (a h : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_body_congr #[a, h]
|
||||
|
||||
/-- Returns `@of_eq_true p h` -/
|
||||
def mkOfEqTrueCore (p : Expr) (h : Expr) : Expr :=
|
||||
match_expr h with
|
||||
| eq_true _ h => h
|
||||
| _ => mkApp2 (mkConst ``of_eq_true) p h
|
||||
/-- Return `of_eq_true h` -/
|
||||
def mkOfEqTrue (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``of_eq_true #[h]
|
||||
|
||||
/-- Returns `of_eq_true h` -/
|
||||
def mkOfEqTrue (h : Expr) : MetaM Expr := do
|
||||
match_expr h with
|
||||
| eq_true _ h => return h
|
||||
| _ => mkAppM ``of_eq_true #[h]
|
||||
|
||||
/-- Returns `eq_true h` -/
|
||||
def mkEqTrueCore (p : Expr) (h : Expr) : Expr :=
|
||||
match_expr h with
|
||||
| of_eq_true _ h => h
|
||||
| _ => mkApp2 (mkConst ``eq_true) p h
|
||||
|
||||
/-- Returns `eq_true h` -/
|
||||
def mkEqTrue (h : Expr) : MetaM Expr := do
|
||||
match_expr h with
|
||||
| of_eq_true _ h => return h
|
||||
| _ => return mkApp2 (mkConst ``eq_true) (← inferType h) h
|
||||
/-- Return `eq_true h` -/
|
||||
def mkEqTrue (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``eq_true #[h]
|
||||
|
||||
/--
|
||||
Returns `eq_false h`
|
||||
Return `eq_false h`
|
||||
`h` must have type definitionally equal to `¬ p` in the current
|
||||
reducibility setting. -/
|
||||
def mkEqFalse (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``eq_false #[h]
|
||||
|
||||
/--
|
||||
Returns `eq_false' h`
|
||||
Return `eq_false' h`
|
||||
`h` must have type definitionally equal to `p → False` in the current
|
||||
reducibility setting. -/
|
||||
def mkEqFalse' (h : Expr) : MetaM Expr :=
|
||||
@@ -620,7 +602,7 @@ def mkImpDepCongrCtx (h₁ h₂ : Expr) : MetaM Expr :=
|
||||
def mkForallCongr (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``forall_congr #[h]
|
||||
|
||||
/-- Returns instance for `[Monad m]` if there is one -/
|
||||
/-- Return instance for `[Monad m]` if there is one -/
|
||||
def isMonad? (m : Expr) : MetaM (Option Expr) :=
|
||||
try
|
||||
let monadType ← mkAppM `Monad #[m]
|
||||
@@ -631,52 +613,52 @@ def isMonad? (m : Expr) : MetaM (Option Expr) :=
|
||||
catch _ =>
|
||||
pure none
|
||||
|
||||
/-- Returns `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
|
||||
/-- Return `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
|
||||
def mkNumeral (type : Expr) (n : Nat) : MetaM Expr := do
|
||||
let u ← getDecLevel type
|
||||
let inst ← synthInstance (mkApp2 (mkConst ``OfNat [u]) type (mkRawNatLit n))
|
||||
return mkApp3 (mkConst ``OfNat.ofNat [u]) type (mkRawNatLit n) inst
|
||||
|
||||
/--
|
||||
Returns `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
|
||||
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
Return `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
|
||||
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
private def mkBinaryOp (className : Name) (opName : Name) (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getDecLevel aType
|
||||
let inst ← synthInstance (mkApp3 (mkConst className [u, u, u]) aType aType aType)
|
||||
return mkApp6 (mkConst opName [u, u, u]) aType aType aType inst a b
|
||||
|
||||
/-- Returns `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkAdd (a b : Expr) : MetaM Expr := mkBinaryOp ``HAdd ``HAdd.hAdd a b
|
||||
|
||||
/-- Returns `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkSub (a b : Expr) : MetaM Expr := mkBinaryOp ``HSub ``HSub.hSub a b
|
||||
|
||||
/-- Returns `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkMul (a b : Expr) : MetaM Expr := mkBinaryOp ``HMul ``HMul.hMul a b
|
||||
|
||||
/--
|
||||
Returns `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type.
|
||||
Examples of supported classes: `LE` and `LT`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
Return `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type.
|
||||
Examples of supported classes: `LE` and `LT`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
private def mkBinaryRel (className : Name) (rName : Name) (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getDecLevel aType
|
||||
let inst ← synthInstance (mkApp (mkConst className [u]) aType)
|
||||
return mkApp4 (mkConst rName [u]) aType inst a b
|
||||
|
||||
/-- Returns `a ≤ b`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a ≤ b`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkLE (a b : Expr) : MetaM Expr := mkBinaryRel ``LE ``LE.le a b
|
||||
|
||||
/-- Returns `a < b`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a < b`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkLT (a b : Expr) : MetaM Expr := mkBinaryRel ``LT ``LT.lt a b
|
||||
|
||||
/-- Given `h : a = b`, returns a proof for `a ↔ b`. -/
|
||||
/-- Given `h : a = b`, return a proof for `a ↔ b`. -/
|
||||
def mkIffOfEq (h : Expr) : MetaM Expr := do
|
||||
if h.isAppOfArity ``propext 3 then
|
||||
return h.appArg!
|
||||
|
||||
@@ -1964,22 +1964,15 @@ def sortFVarIds (fvarIds : Array FVarId) : MetaM (Array FVarId) := do
|
||||
|
||||
end Methods
|
||||
|
||||
/--
|
||||
Return `some info` if `declName` is an inductive predicate where `info : InductiveVal`.
|
||||
That is, `inductive` type in `Prop`.
|
||||
-/
|
||||
def isInductivePredicate? (declName : Name) : MetaM (Option InductiveVal) := do
|
||||
match (← getEnv).find? declName with
|
||||
| some (.inductInfo info) =>
|
||||
forallTelescopeReducing info.type fun _ type => do
|
||||
match (← whnfD type) with
|
||||
| .sort u .. => if u == levelZero then return some info else return none
|
||||
| _ => return none
|
||||
| _ => return none
|
||||
|
||||
/-- Return `true` if `declName` is an inductive predicate. That is, `inductive` type in `Prop`. -/
|
||||
def isInductivePredicate (declName : Name) : MetaM Bool := do
|
||||
return (← isInductivePredicate? declName).isSome
|
||||
match (← getEnv).find? declName with
|
||||
| some (.inductInfo { type := type, ..}) =>
|
||||
forallTelescopeReducing type fun _ type => do
|
||||
match (← whnfD type) with
|
||||
| .sort u .. => return u == levelZero
|
||||
| _ => return false
|
||||
| _ => return false
|
||||
|
||||
def isListLevelDefEqAux : List Level → List Level → MetaM Bool
|
||||
| [], [] => return true
|
||||
|
||||
@@ -33,7 +33,7 @@ private def mkEqAndProof (lhs rhs : Expr) : MetaM (Expr × Expr) := do
|
||||
else
|
||||
pure (mkApp4 (mkConst ``HEq [u]) lhsType lhs rhsType rhs, mkApp2 (mkConst ``HEq.refl [u]) lhsType lhs)
|
||||
|
||||
partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr → Array Expr → MetaM α) : MetaM α :=
|
||||
private partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr → Array Expr → MetaM α) : MetaM α :=
|
||||
let rec loop (i : Nat) (newEqs : Array Expr) (newRefls : Array Expr) := do
|
||||
if i < targets.size then
|
||||
let (newEqType, newRefl) ← mkEqAndProof targets[i]! targetsNew[i]!
|
||||
@@ -66,31 +66,30 @@ structure GeneralizeIndicesSubgoal where
|
||||
numEqs : Nat
|
||||
|
||||
/--
|
||||
Given a metavariable `mvarId` representing the goal
|
||||
```
|
||||
Ctx |- T
|
||||
```
|
||||
and an expression `e : I A j`, where `I A j` is an inductive datatype where `A` are parameters,
|
||||
and `j` the indices. Generate the goal
|
||||
```
|
||||
Ctx, j' : J, h' : I A j' |- j == j' -> e == h' -> T
|
||||
```
|
||||
Remark: `(j == j' -> e == h')` is a "telescopic" equality.
|
||||
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
|
||||
The result contains the fields
|
||||
- `mvarId`: the new goal
|
||||
- `indicesFVarIds`: `j'` ids
|
||||
- `fvarId`: `h'` id
|
||||
- `numEqs`: number of equations in the target
|
||||
|
||||
If `varName?` is not none, it is used to name `h'`.
|
||||
-/
|
||||
def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := none) : MetaM GeneralizeIndicesSubgoal :=
|
||||
Similar to `generalizeTargets` but customized for the `casesOn` motive.
|
||||
Given a metavariable `mvarId` representing the
|
||||
```
|
||||
Ctx, h : I A j, D |- T
|
||||
```
|
||||
where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
|
||||
and `j` the indices. Generate the goal
|
||||
```
|
||||
Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
|
||||
```
|
||||
Remark: `(j == j' -> h == h')` is a "telescopic" equality.
|
||||
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
|
||||
The result contains the fields
|
||||
- `mvarId`: the new goal
|
||||
- `indicesFVarIds`: `j'` ids
|
||||
- `fvarId`: `h'` id
|
||||
- `numEqs`: number of equations in the target -/
|
||||
def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
|
||||
mvarId.withContext do
|
||||
let lctx ← getLCtx
|
||||
let localInsts ← getLocalInstances
|
||||
mvarId.checkNotAssigned `generalizeIndices
|
||||
let type ← whnfD (← inferType e)
|
||||
let fvarDecl ← fvarId.getDecl
|
||||
let type ← whnf fvarDecl.type
|
||||
type.withApp fun f args => matchConstInduct f (fun _ => throwTacticEx `generalizeIndices mvarId "inductive type expected") fun val _ => do
|
||||
unless val.numIndices > 0 do throwTacticEx `generalizeIndices mvarId "indexed inductive type expected"
|
||||
unless args.size == val.numIndices + val.numParams do throwTacticEx `generalizeIndices mvarId "ill-formed inductive datatype"
|
||||
@@ -99,10 +98,9 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
|
||||
let IAType ← inferType IA
|
||||
forallTelescopeReducing IAType fun newIndices _ => do
|
||||
let newType := mkAppN IA newIndices
|
||||
let varName ← if let some varName := varName? then pure varName else mkFreshUserName `x
|
||||
withLocalDeclD varName newType fun h' =>
|
||||
withLocalDeclD fvarDecl.userName newType fun h' =>
|
||||
withNewEqs indices newIndices fun newEqs newRefls => do
|
||||
let (newEqType, newRefl) ← mkEqAndProof e h'
|
||||
let (newEqType, newRefl) ← mkEqAndProof fvarDecl.toExpr h'
|
||||
let newRefls := newRefls.push newRefl
|
||||
withLocalDeclD `h newEqType fun newEq => do
|
||||
let newEqs := newEqs.push newEq
|
||||
@@ -114,7 +112,7 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
|
||||
let auxType ← mkForallFVars newIndices auxType
|
||||
let newMVar ← mkFreshExprMVarAt lctx localInsts auxType MetavarKind.syntheticOpaque tag
|
||||
/- assign mvarId := newMVar indices h refls -/
|
||||
mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) e) newRefls)
|
||||
mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) fvarDecl.toExpr) newRefls)
|
||||
let (indicesFVarIds, newMVarId) ← newMVar.mvarId!.introNP newIndices.size
|
||||
let (fvarId, newMVarId) ← newMVarId.intro1P
|
||||
return {
|
||||
@@ -124,29 +122,6 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
|
||||
numEqs := newEqs.size
|
||||
}
|
||||
|
||||
/--
|
||||
Similar to `generalizeTargets` but customized for the `casesOn` motive.
|
||||
Given a metavariable `mvarId` representing the
|
||||
```
|
||||
Ctx, h : I A j, D |- T
|
||||
```
|
||||
where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
|
||||
and `j` the indices. Generate the goal
|
||||
```
|
||||
Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
|
||||
```
|
||||
Remark: `(j == j' -> h == h')` is a "telescopic" equality.
|
||||
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
|
||||
The result contains the fields
|
||||
- `mvarId`: the new goal
|
||||
- `indicesFVarIds`: `j'` ids
|
||||
- `fvarId`: `h'` id
|
||||
- `numEqs`: number of equations in the target -/
|
||||
def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
|
||||
mvarId.withContext do
|
||||
let fvarDecl ← fvarId.getDecl
|
||||
generalizeIndices' mvarId fvarDecl.toExpr fvarDecl.userName
|
||||
|
||||
structure CasesSubgoal extends InductionSubgoal where
|
||||
ctorName : Name
|
||||
|
||||
|
||||
@@ -35,7 +35,7 @@ def insert (s : FVarSubst) (fvarId : FVarId) (v : Expr) : FVarSubst :=
|
||||
if s.contains fvarId then s
|
||||
else
|
||||
let map := s.map.mapVal fun e => e.replaceFVarId fvarId v;
|
||||
{ map := map.insertNew fvarId v }
|
||||
{ map := map.insert fvarId v }
|
||||
|
||||
def erase (s : FVarSubst) (fvarId : FVarId) : FVarSubst :=
|
||||
{ map := s.map.erase fvarId }
|
||||
|
||||
@@ -23,8 +23,7 @@ import Lean.Meta.Tactic.Grind.Parser
|
||||
import Lean.Meta.Tactic.Grind.EMatchTheorem
|
||||
import Lean.Meta.Tactic.Grind.EMatch
|
||||
import Lean.Meta.Tactic.Grind.Main
|
||||
import Lean.Meta.Tactic.Grind.CasesMatch
|
||||
import Lean.Meta.Tactic.Grind.Arith
|
||||
|
||||
|
||||
namespace Lean
|
||||
|
||||
@@ -35,19 +34,10 @@ builtin_initialize registerTraceClass `grind.eqc
|
||||
builtin_initialize registerTraceClass `grind.internalize
|
||||
builtin_initialize registerTraceClass `grind.ematch
|
||||
builtin_initialize registerTraceClass `grind.ematch.pattern
|
||||
builtin_initialize registerTraceClass `grind.ematch.pattern.search
|
||||
builtin_initialize registerTraceClass `grind.ematch.instance
|
||||
builtin_initialize registerTraceClass `grind.ematch.instance.assignment
|
||||
builtin_initialize registerTraceClass `grind.issues
|
||||
builtin_initialize registerTraceClass `grind.simp
|
||||
builtin_initialize registerTraceClass `grind.split
|
||||
builtin_initialize registerTraceClass `grind.split.candidate
|
||||
builtin_initialize registerTraceClass `grind.split.resolved
|
||||
builtin_initialize registerTraceClass `grind.offset
|
||||
builtin_initialize registerTraceClass `grind.offset.dist
|
||||
builtin_initialize registerTraceClass `grind.offset.internalize
|
||||
builtin_initialize registerTraceClass `grind.offset.internalize.term (inherited := true)
|
||||
builtin_initialize registerTraceClass `grind.offset.propagate
|
||||
|
||||
/-! Trace options for `grind` developers -/
|
||||
builtin_initialize registerTraceClass `grind.debug
|
||||
@@ -57,9 +47,5 @@ builtin_initialize registerTraceClass `grind.debug.proof
|
||||
builtin_initialize registerTraceClass `grind.debug.proj
|
||||
builtin_initialize registerTraceClass `grind.debug.parent
|
||||
builtin_initialize registerTraceClass `grind.debug.final
|
||||
builtin_initialize registerTraceClass `grind.debug.forallPropagator
|
||||
builtin_initialize registerTraceClass `grind.debug.split
|
||||
builtin_initialize registerTraceClass `grind.debug.canon
|
||||
builtin_initialize registerTraceClass `grind.debug.offset
|
||||
builtin_initialize registerTraceClass `grind.debug.offset.proof
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -1,10 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Util
|
||||
import Lean.Meta.Tactic.Grind.Arith.Types
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
import Lean.Meta.Tactic.Grind.Arith.Main
|
||||
@@ -1,14 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
def internalize (e : Expr) : GoalM Unit := do
|
||||
Offset.internalizeCnstr e
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,14 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
def checkInvariants : GoalM Unit :=
|
||||
Offset.checkInvariants
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,34 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.PropagatorAttr
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
namespace Offset
|
||||
def isCnstr? (e : Expr) : GoalM (Option (Cnstr NodeId)) :=
|
||||
return (← get).arith.offset.cnstrs.find? { expr := e }
|
||||
|
||||
def assertTrue (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
|
||||
addEdge c.u c.v c.k (← mkOfEqTrue p)
|
||||
|
||||
def assertFalse (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
|
||||
let p := mkOfNegEqFalse (← get').nodes c p
|
||||
let c := c.neg
|
||||
addEdge c.u c.v c.k p
|
||||
|
||||
end Offset
|
||||
|
||||
builtin_grind_propagator propagateLE ↓LE.le := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
if let some c ← Offset.isCnstr? e then
|
||||
Offset.assertTrue c (← mkEqTrueProof e)
|
||||
if (← isEqFalse e) then
|
||||
if let some c ← Offset.isCnstr? e then
|
||||
Offset.assertFalse c (← mkEqFalseProof e)
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,39 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Basic
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
|
||||
namespace Lean.Meta.Grind.Arith.Offset
|
||||
/-- Construct a model that statisfies all offset constraints -/
|
||||
def mkModel (goal : Goal) : MetaM (Array (Expr × Nat)) := do
|
||||
let s := goal.arith.offset
|
||||
let nodes := s.nodes
|
||||
let mut pre : Array (Option Int) := mkArray nodes.size none
|
||||
for u in [:nodes.size] do
|
||||
let val? := s.sources[u]!.foldl (init := @none Int) fun val? v k => Id.run do
|
||||
let some va := pre[v]! | return val?
|
||||
let val' := va - k
|
||||
let some val := val? | return val'
|
||||
if val' > val then return val' else val?
|
||||
let val? := s.targets[u]!.foldl (init := val?) fun val? v k => Id.run do
|
||||
let some va := pre[v]! | return val?
|
||||
let val' := va + k
|
||||
let some val := val? | return val'
|
||||
if val' < val then return val' else val?
|
||||
let val := val?.getD 0
|
||||
pre := pre.set! u (some val)
|
||||
let min := pre.foldl (init := 0) fun min val? => Id.run do
|
||||
let some val := val? | return min
|
||||
if val < min then val else min
|
||||
let mut r := {}
|
||||
for u in [:nodes.size] do
|
||||
let some val := pre[u]! | unreachable!
|
||||
let val := (val - min).toNat
|
||||
r := r.push (nodes[u]!, val)
|
||||
return r
|
||||
|
||||
end Lean.Meta.Grind.Arith.Offset
|
||||
@@ -1,255 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Offset
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Arith.ProofUtil
|
||||
|
||||
namespace Lean.Meta.Grind.Arith.Offset
|
||||
/-!
|
||||
This module implements a decision procedure for offset constraints of the form:
|
||||
```
|
||||
x + k ≤ y
|
||||
x ≤ y + k
|
||||
```
|
||||
where `k` is a numeral.
|
||||
Each constraint is represented as an edge in a weighted graph.
|
||||
The constraint `x + k ≤ y` is represented as a negative edge.
|
||||
The shortest path between two nodes in the graph corresponds to an implied inequality.
|
||||
When adding a new edge, the state is considered unsatisfiable if the new edge creates a negative cycle.
|
||||
An incremental Floyd-Warshall algorithm is used to find the shortest paths between all nodes.
|
||||
This module can also handle offset equalities of the form `x + k = y` by representing them with two edges:
|
||||
```
|
||||
x + k ≤ y
|
||||
y ≤ x + k
|
||||
```
|
||||
The main advantage of this module over a full linear integer arithmetic procedure is
|
||||
its ability to efficiently detect all implied equalities and inequalities.
|
||||
-/
|
||||
|
||||
def get' : GoalM State := do
|
||||
return (← get).arith.offset
|
||||
|
||||
@[inline] def modify' (f : State → State) : GoalM Unit := do
|
||||
modify fun s => { s with arith.offset := f s.arith.offset }
|
||||
|
||||
def mkNode (expr : Expr) : GoalM NodeId := do
|
||||
if let some nodeId := (← get').nodeMap.find? { expr } then
|
||||
return nodeId
|
||||
let nodeId : NodeId := (← get').nodes.size
|
||||
trace[grind.offset.internalize.term] "{expr} ↦ #{nodeId}"
|
||||
modify' fun s => { s with
|
||||
nodes := s.nodes.push expr
|
||||
nodeMap := s.nodeMap.insert { expr } nodeId
|
||||
sources := s.sources.push {}
|
||||
targets := s.targets.push {}
|
||||
proofs := s.proofs.push {}
|
||||
}
|
||||
return nodeId
|
||||
|
||||
private def getExpr (u : NodeId) : GoalM Expr := do
|
||||
return (← get').nodes[u]!
|
||||
|
||||
private def getDist? (u v : NodeId) : GoalM (Option Int) := do
|
||||
return (← get').targets[u]!.find? v
|
||||
|
||||
private def getProof? (u v : NodeId) : GoalM (Option ProofInfo) := do
|
||||
return (← get').proofs[u]!.find? v
|
||||
|
||||
/--
|
||||
Returns a proof for `u + k ≤ v` (or `u ≤ v + k`) where `k` is the
|
||||
shortest path between `u` and `v`.
|
||||
-/
|
||||
private partial def mkProofForPath (u v : NodeId) : GoalM Expr := do
|
||||
go (← getProof? u v).get!
|
||||
where
|
||||
go (p : ProofInfo) : GoalM Expr := do
|
||||
if u == p.w then
|
||||
return p.proof
|
||||
else
|
||||
let p' := (← getProof? u p.w).get!
|
||||
go (mkTrans (← get').nodes p' p v)
|
||||
|
||||
/--
|
||||
Given a new edge edge `u --(kuv)--> v` justified by proof `huv` s.t.
|
||||
it creates a negative cycle with the existing path `v --{kvu}-->* u`, i.e., `kuv + kvu < 0`,
|
||||
this function closes the current goal by constructing a proof of `False`.
|
||||
-/
|
||||
private def setUnsat (u v : NodeId) (kuv : Int) (huv : Expr) (kvu : Int) : GoalM Unit := do
|
||||
assert! kuv + kvu < 0
|
||||
let hvu ← mkProofForPath v u
|
||||
let u ← getExpr u
|
||||
let v ← getExpr v
|
||||
closeGoal (mkUnsatProof u v kuv huv kvu hvu)
|
||||
|
||||
/-- Sets the new shortest distance `k` between nodes `u` and `v`. -/
|
||||
private def setDist (u v : NodeId) (k : Int) : GoalM Unit := do
|
||||
trace[grind.offset.dist] "{({ u, v, k : Cnstr NodeId})}"
|
||||
modify' fun s => { s with
|
||||
targets := s.targets.modify u fun es => es.insert v k
|
||||
sources := s.sources.modify v fun es => es.insert u k
|
||||
}
|
||||
|
||||
private def setProof (u v : NodeId) (p : ProofInfo) : GoalM Unit := do
|
||||
modify' fun s => { s with
|
||||
proofs := s.proofs.modify u fun es => es.insert v p
|
||||
}
|
||||
|
||||
@[inline]
|
||||
private def forEachSourceOf (u : NodeId) (f : NodeId → Int → GoalM Unit) : GoalM Unit := do
|
||||
(← get').sources[u]!.forM f
|
||||
|
||||
@[inline]
|
||||
private def forEachTargetOf (u : NodeId) (f : NodeId → Int → GoalM Unit) : GoalM Unit := do
|
||||
(← get').targets[u]!.forM f
|
||||
|
||||
/-- Returns `true` if `k` is smaller than the shortest distance between `u` and `v` -/
|
||||
private def isShorter (u v : NodeId) (k : Int) : GoalM Bool := do
|
||||
if let some k' ← getDist? u v then
|
||||
return k < k'
|
||||
else
|
||||
return true
|
||||
|
||||
/--
|
||||
Tries to assign `e` to `True`, which is represented by constraint `c` (from `u` to `v`), using the
|
||||
path `u --(k)--> v`.
|
||||
-/
|
||||
private def propagateTrue (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
|
||||
if k ≤ c.k then
|
||||
trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = True"
|
||||
let kuv ← mkProofForPath u v
|
||||
let u ← getExpr u
|
||||
let v ← getExpr v
|
||||
pushEqTrue e <| mkPropagateEqTrueProof u v k kuv c.k
|
||||
return true
|
||||
return false
|
||||
|
||||
example (x y : Nat) : x + 2 ≤ y → ¬ (y ≤ x + 1) := by omega
|
||||
|
||||
/--
|
||||
Tries to assign `e` to `False`, which is represented by constraint `c` (from `v` to `u`), using the
|
||||
path `u --(k)--> v`.
|
||||
-/
|
||||
private def propagateFalse (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
|
||||
if k + c.k < 0 then
|
||||
trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = False"
|
||||
let kuv ← mkProofForPath u v
|
||||
let u ← getExpr u
|
||||
let v ← getExpr v
|
||||
pushEqFalse e <| mkPropagateEqFalseProof u v k kuv c.k
|
||||
return false
|
||||
|
||||
/--
|
||||
Auxiliary function for implementing `propagateAll`.
|
||||
Traverses the constraints `c` (representing an expression `e`) s.t.
|
||||
`c.u = u` and `c.v = v`, it removes `c` from the list of constraints
|
||||
associated with `(u, v)` IF
|
||||
- `e` is already assigned, or
|
||||
- `f c e` returns true
|
||||
-/
|
||||
@[inline]
|
||||
private def updateCnstrsOf (u v : NodeId) (f : Cnstr NodeId → Expr → GoalM Bool) : GoalM Unit := do
|
||||
if let some cs := (← get').cnstrsOf.find? (u, v) then
|
||||
let cs' ← cs.filterM fun (c, e) => do
|
||||
if (← isEqTrue e <||> isEqFalse e) then
|
||||
return false -- constraint was already assigned
|
||||
else
|
||||
return !(← f c e)
|
||||
modify' fun s => { s with cnstrsOf := s.cnstrsOf.insert (u, v) cs' }
|
||||
|
||||
/-- Performs constraint propagation. -/
|
||||
private def propagateAll (u v : NodeId) (k : Int) : GoalM Unit := do
|
||||
updateCnstrsOf u v fun c e => return !(← propagateTrue u v k c e)
|
||||
updateCnstrsOf v u fun c e => return !(← propagateFalse u v k c e)
|
||||
|
||||
/--
|
||||
If `isShorter u v k`, updates the shortest distance between `u` and `v`.
|
||||
`w` is the penultimate node in the path from `u` to `v`.
|
||||
-/
|
||||
private def updateIfShorter (u v : NodeId) (k : Int) (w : NodeId) : GoalM Unit := do
|
||||
if (← isShorter u v k) then
|
||||
setDist u v k
|
||||
setProof u v (← getProof? w v).get!
|
||||
propagateAll u v k
|
||||
|
||||
/--
|
||||
Adds an edge `u --(k) --> v` justified by the proof term `p`, and then
|
||||
if no negative cycle was created, updates the shortest distance of affected
|
||||
node pairs.
|
||||
-/
|
||||
def addEdge (u : NodeId) (v : NodeId) (k : Int) (p : Expr) : GoalM Unit := do
|
||||
if (← isInconsistent) then return ()
|
||||
if let some k' ← getDist? v u then
|
||||
if k'+k < 0 then
|
||||
setUnsat u v k p k'
|
||||
return ()
|
||||
if (← isShorter u v k) then
|
||||
setDist u v k
|
||||
setProof u v { w := u, k, proof := p }
|
||||
propagateAll u v k
|
||||
update
|
||||
where
|
||||
update : GoalM Unit := do
|
||||
forEachTargetOf v fun j k₂ => do
|
||||
/- Check whether new path: `u -(k)-> v -(k₂)-> j` is shorter -/
|
||||
updateIfShorter u j (k+k₂) v
|
||||
forEachSourceOf u fun i k₁ => do
|
||||
/- Check whether new path: `i -(k₁)-> u -(k)-> v` is shorter -/
|
||||
updateIfShorter i v (k₁+k) u
|
||||
forEachTargetOf v fun j k₂ => do
|
||||
/- Check whether new path: `i -(k₁)-> u -(k)-> v -(k₂) -> j` is shorter -/
|
||||
updateIfShorter i j (k₁+k+k₂) v
|
||||
|
||||
def internalizeCnstr (e : Expr) : GoalM Unit := do
|
||||
let some c := isNatOffsetCnstr? e | return ()
|
||||
let u ← mkNode c.u
|
||||
let v ← mkNode c.v
|
||||
let c := { c with u, v }
|
||||
if let some k ← getDist? u v then
|
||||
if (← propagateTrue u v k c e) then
|
||||
return ()
|
||||
if let some k ← getDist? v u then
|
||||
if (← propagateFalse v u k c e) then
|
||||
return ()
|
||||
trace[grind.offset.internalize] "{e} ↦ {c}"
|
||||
modify' fun s => { s with
|
||||
cnstrs := s.cnstrs.insert { expr := e } c
|
||||
cnstrsOf :=
|
||||
let cs := if let some cs := s.cnstrsOf.find? (u, v) then (c, e) :: cs else [(c, e)]
|
||||
s.cnstrsOf.insert (u, v) cs
|
||||
}
|
||||
|
||||
def traceDists : GoalM Unit := do
|
||||
let s ← get'
|
||||
for u in [:s.targets.size], es in s.targets.toArray do
|
||||
for (v, k) in es do
|
||||
trace[grind.offset.dist] "#{u} -({k})-> #{v}"
|
||||
|
||||
def Cnstr.toExpr (c : Cnstr NodeId) : GoalM Expr := do
|
||||
let u := (← get').nodes[c.u]!
|
||||
let v := (← get').nodes[c.v]!
|
||||
let mk := if c.le then mkNatLE else mkNatEq
|
||||
if c.k == 0 then
|
||||
return mk u v
|
||||
else if c.k < 0 then
|
||||
return mk (mkNatAdd u (Lean.toExpr ((-c.k).toNat))) v
|
||||
else
|
||||
return mk u (mkNatAdd v (Lean.toExpr c.k.toNat))
|
||||
|
||||
def checkInvariants : GoalM Unit := do
|
||||
let s ← get'
|
||||
for u in [:s.targets.size], es in s.targets.toArray do
|
||||
for (v, k) in es do
|
||||
let c : Cnstr NodeId := { u, v, k }
|
||||
trace[grind.debug.offset] "{c}"
|
||||
let p ← mkProofForPath u v
|
||||
trace[grind.debug.offset.proof] "{p} : {← inferType p}"
|
||||
check p
|
||||
unless (← withDefault <| isDefEq (← inferType p) (← Cnstr.toExpr c)) do
|
||||
trace[grind.debug.offset.proof] "failed: {← inferType p} =?= {← Cnstr.toExpr c}"
|
||||
unreachable!
|
||||
|
||||
end Lean.Meta.Grind.Arith.Offset
|
||||
@@ -1,168 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Offset
|
||||
import Init.Grind.Lemmas
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
/-!
|
||||
Helper functions for constructing proof terms in the arithmetic procedures.
|
||||
-/
|
||||
|
||||
namespace Offset
|
||||
|
||||
/-- Returns a proof for `true = true` -/
|
||||
def rfl_true : Expr := mkConst ``Grind.rfl_true
|
||||
|
||||
private def toExprN (n : Int) :=
|
||||
assert! n >= 0
|
||||
toExpr n.toNat
|
||||
|
||||
open Lean.Grind in
|
||||
/--
|
||||
Assume `pi₁` is `{ w := u, k := k₁, proof := p₁ }` and `pi₂` is `{ w := w, k := k₂, proof := p₂ }`
|
||||
`p₁` is the proof for edge `u -(k₁) → w` and `p₂` the proof for edge `w -(k₂)-> v`.
|
||||
Then, this function returns a proof for edge `u -(k₁+k₂) -> v`.
|
||||
-/
|
||||
def mkTrans (nodes : PArray Expr) (pi₁ : ProofInfo) (pi₂ : ProofInfo) (v : NodeId) : ProofInfo :=
|
||||
let { w := u, k := k₁, proof := p₁ } := pi₁
|
||||
let { w, k := k₂, proof := p₂ } := pi₂
|
||||
let u := nodes[u]!
|
||||
let w := nodes[w]!
|
||||
let v := nodes[v]!
|
||||
let p := if k₁ == 0 then
|
||||
if k₂ == 0 then
|
||||
-- u ≤ w, w ≤ v
|
||||
mkApp5 (mkConst ``Nat.le_trans) u w v p₁ p₂
|
||||
else if k₂ > 0 then
|
||||
-- u ≤ v, w ≤ v + k₂
|
||||
mkApp6 (mkConst ``Nat.le_ro) u w v (toExprN k₂) p₁ p₂
|
||||
else
|
||||
let k₂ := - k₂
|
||||
-- u ≤ w, w + k₂ ≤ v
|
||||
mkApp6 (mkConst ``Nat.le_lo) u w v (toExprN k₂) p₁ p₂
|
||||
else if k₁ < 0 then
|
||||
let k₁ := -k₁
|
||||
if k₂ == 0 then
|
||||
mkApp6 (mkConst ``Nat.lo_le) u w v (toExprN k₁) p₁ p₂
|
||||
else if k₂ < 0 then
|
||||
let k₂ := -k₂
|
||||
mkApp7 (mkConst ``Nat.lo_lo) u w v (toExprN k₁) (toExprN k₂) p₁ p₂
|
||||
else
|
||||
let ke₁ := toExprN k₁
|
||||
let ke₂ := toExprN k₂
|
||||
if k₁ > k₂ then
|
||||
mkApp8 (mkConst ``Nat.lo_ro_1) u w v ke₁ ke₂ rfl_true p₁ p₂
|
||||
else
|
||||
mkApp7 (mkConst ``Nat.lo_ro_2) u w v ke₁ ke₂ p₁ p₂
|
||||
else
|
||||
let ke₁ := toExprN k₁
|
||||
if k₂ == 0 then
|
||||
mkApp6 (mkConst ``Nat.ro_le) u w v ke₁ p₁ p₂
|
||||
else if k₂ < 0 then
|
||||
let k₂ := -k₂
|
||||
let ke₂ := toExprN k₂
|
||||
if k₂ > k₁ then
|
||||
mkApp8 (mkConst ``Nat.ro_lo_2) u w v ke₁ ke₂ rfl_true p₁ p₂
|
||||
else
|
||||
mkApp7 (mkConst ``Nat.ro_lo_1) u w v ke₁ ke₂ p₁ p₂
|
||||
else
|
||||
let ke₂ := toExprN k₂
|
||||
mkApp7 (mkConst ``Nat.ro_ro) u w v ke₁ ke₂ p₁ p₂
|
||||
{ w := pi₁.w, k := k₁+k₂, proof := p }
|
||||
|
||||
open Lean.Grind in
|
||||
def mkOfNegEqFalse (nodes : PArray Expr) (c : Cnstr NodeId) (h : Expr) : Expr :=
|
||||
let u := nodes[c.u]!
|
||||
let v := nodes[c.v]!
|
||||
if c.k == 0 then
|
||||
mkApp3 (mkConst ``Nat.of_le_eq_false) u v h
|
||||
else if c.k == -1 && c.le then
|
||||
mkApp3 (mkConst ``Nat.of_lo_eq_false_1) u v h
|
||||
else if c.k < 0 then
|
||||
mkApp4 (mkConst ``Nat.of_lo_eq_false) u v (toExprN (-c.k)) h
|
||||
else
|
||||
mkApp4 (mkConst ``Nat.of_ro_eq_false) u v (toExprN c.k) h
|
||||
|
||||
/--
|
||||
Returns a proof of `False` using a negative cycle composed of
|
||||
- `u --(kuv)--> v` with proof `huv`
|
||||
- `v --(kvu)--> u` with proof `hvu`
|
||||
-/
|
||||
def mkUnsatProof (u v : Expr) (kuv : Int) (huv : Expr) (kvu : Int) (hvu : Expr) : Expr :=
|
||||
if kuv == 0 then
|
||||
assert! kvu < 0
|
||||
mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) u v (toExprN (-kvu)) rfl_true huv hvu
|
||||
else if kvu == 0 then
|
||||
mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) v u (toExprN (-kuv)) rfl_true hvu huv
|
||||
else if kuv < 0 then
|
||||
if kvu > 0 then
|
||||
mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) u v (toExprN (-kuv)) (toExprN kvu) rfl_true huv hvu
|
||||
else
|
||||
assert! kvu < 0
|
||||
mkApp7 (mkConst ``Grind.Nat.unsat_lo_lo) u v (toExprN (-kuv)) (toExprN (-kvu)) rfl_true huv hvu
|
||||
else
|
||||
assert! kuv > 0 && kvu < 0
|
||||
mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) v u (toExprN (-kvu)) (toExprN kuv) rfl_true hvu huv
|
||||
|
||||
/--
|
||||
Given a path `u --(kuv)--> v` justified by proof `huv`,
|
||||
construct a proof of `e = True` where `e` is a term corresponding to the edgen `u --(k') --> v`
|
||||
s.t. `k ≤ k'`
|
||||
-/
|
||||
def mkPropagateEqTrueProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
|
||||
if k == 0 then
|
||||
if k' == 0 then
|
||||
mkApp3 (mkConst ``Grind.Nat.le_eq_true_of_le) u v huv
|
||||
else
|
||||
assert! k' > 0
|
||||
mkApp4 (mkConst ``Grind.Nat.ro_eq_true_of_le) u v (toExprN k') huv
|
||||
else if k < 0 then
|
||||
let k := -k
|
||||
if k' == 0 then
|
||||
mkApp4 (mkConst ``Grind.Nat.le_eq_true_of_lo) u v (toExprN k) huv
|
||||
else if k' < 0 then
|
||||
let k' := -k'
|
||||
mkApp6 (mkConst ``Grind.Nat.lo_eq_true_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
|
||||
else
|
||||
assert! k' > 0
|
||||
mkApp5 (mkConst ``Grind.Nat.ro_eq_true_of_lo) u v (toExprN k) (toExprN k') huv
|
||||
else
|
||||
assert! k > 0
|
||||
assert! k' > 0
|
||||
mkApp6 (mkConst ``Grind.Nat.ro_eq_true_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
|
||||
|
||||
/--
|
||||
Given a path `u --(kuv)--> v` justified by proof `huv`,
|
||||
construct a proof of `e = False` where `e` is a term corresponding to the edgen `v --(k') --> u`
|
||||
s.t. `k+k' < 0`
|
||||
-/
|
||||
def mkPropagateEqFalseProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
|
||||
if k == 0 then
|
||||
assert! k' < 0
|
||||
let k' := -k'
|
||||
mkApp5 (mkConst ``Grind.Nat.lo_eq_false_of_le) u v (toExprN k') rfl_true huv
|
||||
else if k < 0 then
|
||||
let k := -k
|
||||
if k' == 0 then
|
||||
mkApp5 (mkConst ``Grind.Nat.le_eq_false_of_lo) u v (toExprN k) rfl_true huv
|
||||
else if k' < 0 then
|
||||
let k' := -k'
|
||||
mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
|
||||
else
|
||||
assert! k' > 0
|
||||
mkApp6 (mkConst ``Grind.Nat.ro_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
|
||||
else
|
||||
assert! k > 0
|
||||
assert! k' < 0
|
||||
let k' := -k'
|
||||
mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
|
||||
|
||||
end Offset
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,66 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Data.PersistentArray
|
||||
import Lean.Meta.Tactic.Grind.ENodeKey
|
||||
import Lean.Meta.Tactic.Grind.Arith.Util
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
namespace Offset
|
||||
|
||||
abbrev NodeId := Nat
|
||||
|
||||
instance : ToMessageData (Offset.Cnstr NodeId) where
|
||||
toMessageData c := Offset.toMessageData (α := NodeId) (inst := { toMessageData n := m!"#{n}" }) c
|
||||
|
||||
/-- Auxiliary structure used for proof extraction. -/
|
||||
structure ProofInfo where
|
||||
w : NodeId
|
||||
k : Int
|
||||
proof : Expr
|
||||
deriving Inhabited
|
||||
|
||||
/-- State of the constraint offset procedure. -/
|
||||
structure State where
|
||||
/-- Mapping from `NodeId` to the `Expr` represented by the node. -/
|
||||
nodes : PArray Expr := {}
|
||||
/-- Mapping from `Expr` to a node representing it. -/
|
||||
nodeMap : PHashMap ENodeKey NodeId := {}
|
||||
/-- Mapping from `Expr` representing inequalites to constraints. -/
|
||||
cnstrs : PHashMap ENodeKey (Cnstr NodeId) := {}
|
||||
/--
|
||||
Mapping from pairs `(u, v)` to a list of offset constraints on `u` and `v`.
|
||||
We use this mapping to implement exhaustive constraint propagation.
|
||||
-/
|
||||
cnstrsOf : PHashMap (NodeId × NodeId) (List (Cnstr NodeId × Expr)) := {}
|
||||
/--
|
||||
For each node with id `u`, `sources[u]` contains
|
||||
pairs `(v, k)` s.t. there is a path from `v` to `u` with weight `k`.
|
||||
-/
|
||||
sources : PArray (AssocList NodeId Int) := {}
|
||||
/--
|
||||
For each node with id `u`, `targets[u]` contains
|
||||
pairs `(v, k)` s.t. there is a path from `u` to `v` with weight `k`.
|
||||
-/
|
||||
targets : PArray (AssocList NodeId Int) := {}
|
||||
/--
|
||||
Proof reconstruction information. For each node with id `u`, `proofs[u]` contains
|
||||
pairs `(v, { w, proof })` s.t. there is a path from `u` to `v`, and
|
||||
`w` is the penultimate node in the path, and `proof` is the justification for
|
||||
the last edge.
|
||||
-/
|
||||
proofs : PArray (AssocList NodeId ProofInfo) := {}
|
||||
deriving Inhabited
|
||||
|
||||
end Offset
|
||||
|
||||
/-- State for the arithmetic procedures. -/
|
||||
structure State where
|
||||
offset : Offset.State := {}
|
||||
deriving Inhabited
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,89 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Expr
|
||||
import Lean.Message
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
/-- Returns `true` if `e` is of the form `Nat` -/
|
||||
def isNatType (e : Expr) : Bool :=
|
||||
e.isConstOf ``Nat
|
||||
|
||||
/-- Returns `true` if `e` is of the form `@instHAdd Nat instAddNat` -/
|
||||
def isInstAddNat (e : Expr) : Bool :=
|
||||
let_expr instHAdd a b := e | false
|
||||
isNatType a && b.isConstOf ``instAddNat
|
||||
|
||||
/-- Returns `true` if `e` is `instLENat` -/
|
||||
def isInstLENat (e : Expr) : Bool :=
|
||||
e.isConstOf ``instLENat
|
||||
|
||||
/--
|
||||
Returns `some (a, b)` if `e` is of the form
|
||||
```
|
||||
@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) a b
|
||||
```
|
||||
-/
|
||||
def isNatAdd? (e : Expr) : Option (Expr × Expr) :=
|
||||
let_expr HAdd.hAdd _ _ _ i a b := e | none
|
||||
if isInstAddNat i then some (a, b) else none
|
||||
|
||||
/-- Returns `some k` if `e` `@OfNat.ofNat Nat _ (instOfNatNat k)` -/
|
||||
def isNatNum? (e : Expr) : Option Nat := Id.run do
|
||||
let_expr OfNat.ofNat _ _ inst := e | none
|
||||
let_expr instOfNatNat k := inst | none
|
||||
let .lit (.natVal k) := k | none
|
||||
some k
|
||||
|
||||
/-- Returns `some (a, k)` if `e` is of the form `a + k`. -/
|
||||
def isNatOffset? (e : Expr) : Option (Expr × Nat) := Id.run do
|
||||
let some (a, b) := isNatAdd? e | none
|
||||
let some k := isNatNum? b | none
|
||||
some (a, k)
|
||||
|
||||
/-- An offset constraint. -/
|
||||
structure Offset.Cnstr (α : Type) where
|
||||
u : α
|
||||
v : α
|
||||
k : Int := 0
|
||||
le : Bool := true
|
||||
deriving Inhabited
|
||||
|
||||
def Offset.Cnstr.neg : Cnstr α → Cnstr α
|
||||
| { u, v, k, le } => { u := v, v := u, le, k := -k - 1 }
|
||||
|
||||
example (c : Offset.Cnstr α) : c.neg.neg = c := by
|
||||
cases c; simp [Offset.Cnstr.neg]; omega
|
||||
|
||||
def Offset.toMessageData [inst : ToMessageData α] (c : Offset.Cnstr α) : MessageData :=
|
||||
match c.k, c.le with
|
||||
| .ofNat 0, true => m!"{c.u} ≤ {c.v}"
|
||||
| .ofNat 0, false => m!"{c.u} = {c.v}"
|
||||
| .ofNat k, true => m!"{c.u} ≤ {c.v} + {k}"
|
||||
| .ofNat k, false => m!"{c.u} = {c.v} + {k}"
|
||||
| .negSucc k, true => m!"{c.u} + {k + 1} ≤ {c.v}"
|
||||
| .negSucc k, false => m!"{c.u} + {k + 1} = {c.v}"
|
||||
|
||||
instance : ToMessageData (Offset.Cnstr Expr) where
|
||||
toMessageData c := Offset.toMessageData c
|
||||
|
||||
/-- Returns `some cnstr` if `e` is offset constraint. -/
|
||||
def isNatOffsetCnstr? (e : Expr) : Option (Offset.Cnstr Expr) :=
|
||||
match_expr e with
|
||||
| LE.le _ inst a b => if isInstLENat inst then go a b true else none
|
||||
| Eq α a b => if isNatType α then go a b false else none
|
||||
| _ => none
|
||||
where
|
||||
go (u v : Expr) (le : Bool) :=
|
||||
if let some (u, k) := isNatOffset? u then
|
||||
some { u, k := - k, v, le }
|
||||
else if let some (v, k) := isNatOffset? v then
|
||||
some { u, v, k := k, le }
|
||||
else
|
||||
some { u, v, le }
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -22,7 +22,7 @@ to detect when two structurally different atoms are definitionally equal.
|
||||
The `grind` tactic, on the other hand, uses congruence closure. Moreover, types, type formers, proofs, and instances
|
||||
are considered supporting elements and are not factored into congruence detection.
|
||||
|
||||
This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they are instances,
|
||||
This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they instances,
|
||||
types, or type formers and are the `i`-th arguments of two different `f`-applications. This approach is
|
||||
sufficient for the congruence closure procedure used by the `grind` tactic.
|
||||
|
||||
@@ -46,35 +46,15 @@ structure State where
|
||||
proofCanon : PHashMap Expr Expr := {}
|
||||
deriving Inhabited
|
||||
|
||||
inductive CanonElemKind where
|
||||
| /--
|
||||
Type class instances are canonicalized using `TransparencyMode.instances`.
|
||||
-/
|
||||
instance
|
||||
| /--
|
||||
Types and Type formers are canonicalized using `TransparencyMode.default`.
|
||||
Remark: propositions are just visited. We do not invoke `canonElemCore` for them.
|
||||
-/
|
||||
type
|
||||
| /--
|
||||
Implicit arguments that are not types, type formers, or instances, are canonicalized
|
||||
using `TransparencyMode.reducible`
|
||||
-/
|
||||
implicit
|
||||
deriving BEq
|
||||
|
||||
def CanonElemKind.explain : CanonElemKind → String
|
||||
| .instance => "type class instances"
|
||||
| .type => "types (or type formers)"
|
||||
| .implicit => "implicit arguments (which are not type class instances or types)"
|
||||
|
||||
/--
|
||||
Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
|
||||
`isInst` is true if `e` is an type class instance.
|
||||
|
||||
Thus, if diagnostics are enabled, we also re-check them using `TransparencyMode.default`. If the result is different
|
||||
Recall that we use `TransparencyMode.instances` for checking whether two instances are definitionally equal or not.
|
||||
Thus, if diagnostics are enabled, we also check them using `TransparencyMode.default`. If the result is different
|
||||
we report to the user.
|
||||
-/
|
||||
def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : StateT State MetaM Expr := do
|
||||
def canonElemCore (f : Expr) (i : Nat) (e : Expr) (isInst : Bool) : StateT State MetaM Expr := do
|
||||
let s ← get
|
||||
if let some c := s.canon.find? e then
|
||||
return c
|
||||
@@ -86,19 +66,16 @@ def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : State
|
||||
-- in general safe to replace `e` with `c` if `c` has more free variables than `e`.
|
||||
-- However, we don't revert previously canonicalized elements in the `grind` tactic.
|
||||
modify fun s => { s with canon := s.canon.insert e c }
|
||||
trace[grind.debug.canon] "found {e} ===> {c}"
|
||||
return c
|
||||
if kind != .type then
|
||||
if (← isTracingEnabledFor `grind.issues <&&> (withDefault <| isDefEq e c)) then
|
||||
if isInst then
|
||||
if (← isDiagnosticsEnabled <&&> pure (c.fvarsSubset e) <&&> (withDefault <| isDefEq e c)) then
|
||||
-- TODO: consider storing this information in some structure that can be browsed later.
|
||||
trace[grind.issues] "the following {kind.explain} are definitionally equal with `default` transparency but not with a more restrictive transparency{indentExpr e}\nand{indentExpr c}"
|
||||
trace[grind.debug.canon] "({f}, {i}) ↦ {e}"
|
||||
trace[grind.issues] "the following `grind` static elements are definitionally equal with `default` transparency, but not with `instances` transparency{indentExpr e}\nand{indentExpr c}"
|
||||
modify fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
|
||||
return e
|
||||
|
||||
abbrev canonType (f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore f i e .type
|
||||
abbrev canonInst (f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore f i e .instance
|
||||
abbrev canonImplicit (f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore f i e .implicit
|
||||
abbrev canonType (f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore f i e false
|
||||
abbrev canonInst (f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore f i e true
|
||||
|
||||
/--
|
||||
Return type for the `shouldCanon` function.
|
||||
@@ -108,8 +85,6 @@ private inductive ShouldCanonResult where
|
||||
canonType
|
||||
| /- Nested instances are canonicalized. -/
|
||||
canonInst
|
||||
| /- Implicit argument that is not an instance nor a type. -/
|
||||
canonImplicit
|
||||
| /-
|
||||
Term is not a proof, type (former), nor an instance.
|
||||
Thus, it must be recursively visited by the canonizer.
|
||||
@@ -117,13 +92,6 @@ private inductive ShouldCanonResult where
|
||||
visit
|
||||
deriving Inhabited
|
||||
|
||||
instance : Repr ShouldCanonResult where
|
||||
reprPrec r _ := match r with
|
||||
| .canonType => "canonType"
|
||||
| .canonInst => "canonInst"
|
||||
| .canonImplicit => "canonImplicit"
|
||||
| .visit => "visit"
|
||||
|
||||
/--
|
||||
See comments at `ShouldCanonResult`.
|
||||
-/
|
||||
@@ -134,14 +102,7 @@ def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Should
|
||||
return .canonInst
|
||||
else if pinfo.isProp then
|
||||
return .visit
|
||||
else if pinfo.isImplicit then
|
||||
if (← isTypeFormer arg) then
|
||||
return .canonType
|
||||
else
|
||||
return .canonImplicit
|
||||
if (← isProp arg) then
|
||||
return .visit
|
||||
else if (← isTypeFormer arg) then
|
||||
if (← isTypeFormer arg) then
|
||||
return .canonType
|
||||
else
|
||||
return .visit
|
||||
@@ -150,13 +111,22 @@ unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
|
||||
visit e |>.run' mkPtrMap
|
||||
where
|
||||
visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
|
||||
unless e.isApp || e.isForall do return e
|
||||
-- Check whether it is cached
|
||||
if let some r := (← get).find? e then
|
||||
return r
|
||||
let e' ← match e with
|
||||
| .app .. => e.withApp fun f args => do
|
||||
if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
|
||||
match e with
|
||||
| .bvar .. => unreachable!
|
||||
-- Recall that `grind` treats `let`, `forall`, and `lambda` as atomic terms.
|
||||
| .letE .. | .forallE .. | .lam ..
|
||||
| .const .. | .lit .. | .mvar .. | .sort .. | .fvar ..
|
||||
-- Recall that the `grind` preprocessor uses the `foldProjs` preprocessing step.
|
||||
| .proj ..
|
||||
-- Recall that the `grind` preprocessor uses the `eraseIrrelevantMData` preprocessing step.
|
||||
| .mdata .. => return e
|
||||
-- We only visit applications
|
||||
| .app .. =>
|
||||
-- Check whether it is cached
|
||||
if let some r := (← get).find? e then
|
||||
return r
|
||||
e.withApp fun f args => do
|
||||
let e' ← if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
|
||||
let prop := args[0]!
|
||||
let prop' ← visit prop
|
||||
if let some r := (← getThe State).proofCanon.find? prop' then
|
||||
@@ -168,32 +138,24 @@ where
|
||||
else
|
||||
let pinfos := (← getFunInfo f).paramInfo
|
||||
let mut modified := false
|
||||
let mut args := args.toVector
|
||||
for h : i in [:args.size] do
|
||||
let arg := args[i]
|
||||
trace[grind.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
|
||||
let mut args := args
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
let arg' ← match (← shouldCanon pinfos i arg) with
|
||||
| .canonType => canonType f i arg
|
||||
| .canonInst => canonInst f i arg
|
||||
| .canonImplicit => canonImplicit f i (← visit arg)
|
||||
| .visit => visit arg
|
||||
unless ptrEq arg arg' do
|
||||
args := args.set i arg'
|
||||
args := args.set! i arg'
|
||||
modified := true
|
||||
pure <| if modified then mkAppN f args.toArray else e
|
||||
| .forallE _ d b _ =>
|
||||
-- Recall that we have `ForallProp.lean`.
|
||||
let d' ← visit d
|
||||
-- Remark: users may not want to convert `p → q` into `¬p ∨ q`
|
||||
let b' ← if b.hasLooseBVars then pure b else visit b
|
||||
pure <| e.updateForallE! d' b'
|
||||
| _ => unreachable!
|
||||
modify fun s => s.insert e e'
|
||||
return e'
|
||||
pure <| if modified then mkAppN f args else e
|
||||
modify fun s => s.insert e e'
|
||||
return e'
|
||||
|
||||
/-- Canonicalizes nested types, type formers, and instances in `e`. -/
|
||||
def canon (e : Expr) : StateT State MetaM Expr := do
|
||||
trace[grind.debug.canon] "{e}"
|
||||
/--
|
||||
Canonicalizes nested types, type formers, and instances in `e`.
|
||||
-/
|
||||
def canon (e : Expr) : StateT State MetaM Expr :=
|
||||
unsafe canonImpl e
|
||||
|
||||
end Canon
|
||||
|
||||
@@ -11,56 +11,52 @@ namespace Lean.Meta.Grind
|
||||
The `grind` tactic includes an auxiliary `cases` tactic that is not intended for direct use by users.
|
||||
This method implements it.
|
||||
This tactic is automatically applied when introducing local declarations with a type tagged with `[grind_cases]`.
|
||||
It is also used for "case-splitting" on terms during the search.
|
||||
|
||||
It differs from the user-facing Lean `cases` tactic in the following ways:
|
||||
|
||||
- It avoids unnecessary `revert` and `intro` operations.
|
||||
|
||||
- It does not introduce new local declarations for each minor premise. Instead, the `grind` tactic preprocessor is responsible for introducing them.
|
||||
|
||||
- It assumes that the major premise (i.e., the parameter `fvarId`) is the latest local declaration in the current goal.
|
||||
|
||||
- If the major premise type is an indexed family, auxiliary declarations and (heterogeneous) equalities are introduced.
|
||||
However, these equalities are not resolved using `unifyEqs`. Instead, the `grind` tactic employs union-find and
|
||||
congruence closure to process these auxiliary equalities. This approach avoids applying substitution to propositions
|
||||
that have already been internalized by `grind`.
|
||||
-/
|
||||
def cases (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
|
||||
def cases (mvarId : MVarId) (fvarId : FVarId) : MetaM (List MVarId) := mvarId.withContext do
|
||||
let tag ← mvarId.getTag
|
||||
let type ← whnf (← inferType e)
|
||||
let type ← whnf (← fvarId.getType)
|
||||
let .const declName _ := type.getAppFn | throwInductiveExpected type
|
||||
let .inductInfo _ ← getConstInfo declName | throwInductiveExpected type
|
||||
let recursorInfo ← mkRecursorInfo (mkCasesOnName declName)
|
||||
let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array FVarId) : MetaM (List MVarId) := do
|
||||
let indicesExpr := indices.map mkFVar
|
||||
let recursor ← mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indicesExpr
|
||||
let mut recursor := mkApp (mkAppN recursor indicesExpr) (mkFVar fvarId)
|
||||
let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array Expr) (clearMajor : Bool) : MetaM (List MVarId) := do
|
||||
let recursor ← mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indices
|
||||
let mut recursor := mkApp (mkAppN recursor indices) (mkFVar fvarId)
|
||||
let mut recursorType ← inferType recursor
|
||||
let mut mvarIdsNew := #[]
|
||||
let mut idx := 1
|
||||
for _ in [:recursorInfo.numMinors] do
|
||||
let .forallE _ targetNew recursorTypeNew _ ← whnf recursorType
|
||||
| throwTacticEx `grind.cases mvarId "unexpected recursor type"
|
||||
recursorType := recursorTypeNew
|
||||
let tagNew := if recursorInfo.numMinors > 1 then Name.num tag idx else tag
|
||||
let mvar ← mkFreshExprSyntheticOpaqueMVar targetNew tagNew
|
||||
let mvar ← mkFreshExprSyntheticOpaqueMVar targetNew tag
|
||||
recursor := mkApp recursor mvar
|
||||
let mvarIdNew ← mvar.mvarId!.tryClearMany (indices.push fvarId)
|
||||
let mvarIdNew ← if clearMajor then
|
||||
mvar.mvarId!.clear fvarId
|
||||
else
|
||||
pure mvar.mvarId!
|
||||
mvarIdsNew := mvarIdsNew.push mvarIdNew
|
||||
idx := idx + 1
|
||||
mvarId.assign recursor
|
||||
return mvarIdsNew.toList
|
||||
if recursorInfo.numIndices > 0 then
|
||||
let s ← generalizeIndices' mvarId e
|
||||
let s ← generalizeIndices mvarId fvarId
|
||||
s.mvarId.withContext do
|
||||
k s.mvarId s.fvarId s.indicesFVarIds
|
||||
else if let .fvar fvarId := e then
|
||||
k mvarId fvarId #[]
|
||||
k s.mvarId s.fvarId (s.indicesFVarIds.map mkFVar) (clearMajor := false)
|
||||
else
|
||||
let mvarId ← mvarId.assert (← mkFreshUserName `x) type e
|
||||
let (fvarId, mvarId) ← mvarId.intro1
|
||||
mvarId.withContext do k mvarId fvarId #[]
|
||||
let indices ← getMajorTypeIndices mvarId `grind.cases recursorInfo type
|
||||
k mvarId fvarId indices (clearMajor := true)
|
||||
where
|
||||
throwInductiveExpected {α} (type : Expr) : MetaM α := do
|
||||
throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {e}{indentExpr type}"
|
||||
throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {mkFVar fvarId}{indentExpr type}"
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -1,53 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Util
|
||||
import Lean.Meta.Tactic.Cases
|
||||
import Lean.Meta.Match.MatcherApp
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
def casesMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
|
||||
let some app ← matchMatcherApp? e
|
||||
| throwTacticEx `grind.casesMatch mvarId m!"`match`-expression expected{indentExpr e}"
|
||||
let (motive, eqRefls) ← mkMotiveAndRefls app
|
||||
let target ← mvarId.getType
|
||||
let mut us := app.matcherLevels
|
||||
if let some i := app.uElimPos? then
|
||||
us := us.set! i (← getLevel target)
|
||||
let splitterName := (← Match.getEquationsFor app.matcherName).splitterName
|
||||
let splitterApp := mkConst splitterName us.toList
|
||||
let splitterApp := mkAppN splitterApp app.params
|
||||
let splitterApp := mkApp splitterApp motive
|
||||
let splitterApp := mkAppN splitterApp app.discrs
|
||||
let (mvars, _, _) ← forallMetaBoundedTelescope (← inferType splitterApp) app.alts.size (kind := .syntheticOpaque)
|
||||
let splitterApp := mkAppN splitterApp mvars
|
||||
let val := mkAppN splitterApp eqRefls
|
||||
mvarId.assign val
|
||||
updateTags mvars
|
||||
return mvars.toList.map (·.mvarId!)
|
||||
where
|
||||
mkMotiveAndRefls (app : MatcherApp) : MetaM (Expr × Array Expr) := do
|
||||
let dummy := mkSort 0
|
||||
let aux := mkApp (mkAppN e.getAppFn app.params) dummy
|
||||
forallBoundedTelescope (← inferType aux) app.discrs.size fun xs _ => do
|
||||
withNewEqs app.discrs xs fun eqs eqRefls => do
|
||||
let type ← mvarId.getType
|
||||
let type ← mkForallFVars eqs type
|
||||
let motive ← mkLambdaFVars xs type
|
||||
return (motive, eqRefls)
|
||||
|
||||
updateTags (mvars : Array Expr) : MetaM Unit := do
|
||||
let tag ← mvarId.getTag
|
||||
if mvars.size == 1 then
|
||||
mvars[0]!.mvarId!.setTag tag
|
||||
else
|
||||
let mut idx := 1
|
||||
for mvar in mvars do
|
||||
mvar.mvarId!.setTag (Name.num tag idx)
|
||||
idx := idx + 1
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -1,71 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
/-!
|
||||
Combinators for manipulating `GrindTactic`s.
|
||||
TODO: a proper tactic language for `grind`.
|
||||
-/
|
||||
|
||||
def GrindTactic := Goal → GrindM (Option (List Goal))
|
||||
|
||||
def GrindTactic.try (x : GrindTactic) : GrindTactic := fun g => do
|
||||
let some gs ← x g | return some [g]
|
||||
return some gs
|
||||
|
||||
def applyToAll (x : GrindTactic) (goals : List Goal) : GrindM (List Goal) := do
|
||||
go goals []
|
||||
where
|
||||
go (goals : List Goal) (acc : List Goal) : GrindM (List Goal) := do
|
||||
match goals with
|
||||
| [] => return acc.reverse
|
||||
| goal :: goals => match (← x goal) with
|
||||
| none => go goals (goal :: acc)
|
||||
| some goals' => go goals (goals' ++ acc)
|
||||
|
||||
partial def GrindTactic.andThen (x y : GrindTactic) : GrindTactic := fun goal => do
|
||||
let some goals ← x goal | return none
|
||||
applyToAll y goals
|
||||
|
||||
instance : AndThen GrindTactic where
|
||||
andThen a b := GrindTactic.andThen a (b ())
|
||||
|
||||
partial def GrindTactic.iterate (x : GrindTactic) : GrindTactic := fun goal => do
|
||||
go [goal] []
|
||||
where
|
||||
go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
|
||||
match todo with
|
||||
| [] => return result
|
||||
| goal :: todo =>
|
||||
if let some goalsNew ← x goal then
|
||||
go (goalsNew ++ todo) result
|
||||
else
|
||||
go todo (goal :: result)
|
||||
|
||||
partial def GrindTactic.orElse (x y : GrindTactic) : GrindTactic := fun goal => do
|
||||
let some goals ← x goal | y goal
|
||||
return goals
|
||||
|
||||
instance : OrElse GrindTactic where
|
||||
orElse a b := GrindTactic.andThen a (b ())
|
||||
|
||||
def toGrindTactic (f : GoalM Unit) : GrindTactic := fun goal => do
|
||||
let goal ← GoalM.run' goal f
|
||||
if goal.inconsistent then
|
||||
return some []
|
||||
else
|
||||
return some [goal]
|
||||
|
||||
def GrindTactic' := Goal → GrindM (List Goal)
|
||||
|
||||
def GrindTactic'.toGrindTactic (x : GrindTactic') : GrindTactic := fun goal => do
|
||||
let goals ← x goal
|
||||
return some goals
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -41,9 +41,8 @@ This is an auxiliary function performed while merging equivalence classes.
|
||||
private def removeParents (root : Expr) : GoalM ParentSet := do
|
||||
let parents ← getParentsAndReset root
|
||||
for parent in parents do
|
||||
-- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
|
||||
if (← pure parent.isApp <&&> isCongrRoot parent) then
|
||||
trace_goal[grind.debug.parent] "remove: {parent}"
|
||||
if (← isCongrRoot parent) then
|
||||
trace[grind.debug.parent] "remove: {parent}"
|
||||
modify fun s => { s with congrTable := s.congrTable.erase { e := parent } }
|
||||
return parents
|
||||
|
||||
@@ -53,8 +52,8 @@ This is an auxiliary function performed while merging equivalence classes.
|
||||
-/
|
||||
private def reinsertParents (parents : ParentSet) : GoalM Unit := do
|
||||
for parent in parents do
|
||||
if (← pure parent.isApp <&&> isCongrRoot parent) then
|
||||
trace_goal[grind.debug.parent] "reinsert: {parent}"
|
||||
if (← isCongrRoot parent) then
|
||||
trace[grind.debug.parent] "reinsert: {parent}"
|
||||
addCongrTable parent
|
||||
|
||||
/-- Closes the goal when `True` and `False` are in the same equivalence class. -/
|
||||
@@ -91,9 +90,9 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
|
||||
let rhsNode ← getENode rhs
|
||||
if isSameExpr lhsNode.root rhsNode.root then
|
||||
-- `lhs` and `rhs` are already in the same equivalence class.
|
||||
trace_goal[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
|
||||
trace[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
|
||||
return ()
|
||||
trace_goal[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
|
||||
trace[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
|
||||
let lhsRoot ← getENode lhsNode.root
|
||||
let rhsRoot ← getENode rhsNode.root
|
||||
let mut valueInconsistency := false
|
||||
@@ -118,11 +117,11 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
|
||||
unless (← isInconsistent) do
|
||||
if valueInconsistency then
|
||||
closeGoalWithValuesEq lhsRoot.self rhsRoot.self
|
||||
trace_goal[grind.debug] "after addEqStep, {← (← get).ppState}"
|
||||
trace[grind.debug] "after addEqStep, {← ppState}"
|
||||
checkInvariants
|
||||
where
|
||||
go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
|
||||
trace_goal[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
|
||||
trace[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
|
||||
/-
|
||||
We have the following `target?/proof?`
|
||||
`lhs -> ... -> lhsNode.root`
|
||||
@@ -139,9 +138,8 @@ where
|
||||
}
|
||||
let parents ← removeParents lhsRoot.self
|
||||
updateRoots lhs rhsNode.root
|
||||
trace_goal[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
|
||||
trace[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
|
||||
reinsertParents parents
|
||||
propagateEqcDown lhs
|
||||
setENode lhsNode.root { (← getENode lhsRoot.self) with -- We must retrieve `lhsRoot` since it was updated.
|
||||
next := rhsRoot.next
|
||||
}
|
||||
@@ -159,13 +157,14 @@ where
|
||||
updateMT rhsRoot.self
|
||||
|
||||
updateRoots (lhs : Expr) (rootNew : Expr) : GoalM Unit := do
|
||||
traverseEqc lhs fun n =>
|
||||
setENode n.self { n with root := rootNew }
|
||||
|
||||
propagateEqcDown (lhs : Expr) : GoalM Unit := do
|
||||
traverseEqc lhs fun n =>
|
||||
let rec loop (e : Expr) : GoalM Unit := do
|
||||
let n ← getENode e
|
||||
setENode e { n with root := rootNew }
|
||||
unless (← isInconsistent) do
|
||||
propagateDown n.self
|
||||
propagateDown e
|
||||
if isSameExpr lhs n.next then return ()
|
||||
loop n.next
|
||||
loop lhs
|
||||
|
||||
/-- Ensures collection of equations to be processed is empty. -/
|
||||
private def resetNewEqs : GoalM Unit :=
|
||||
@@ -191,29 +190,17 @@ where
|
||||
addEqStep lhs rhs proof isHEq
|
||||
processTodo
|
||||
|
||||
/-- Adds a new equality `lhs = rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
|
||||
private def addEq (lhs rhs proof : Expr) : GoalM Unit := do
|
||||
def addEq (lhs rhs proof : Expr) : GoalM Unit := do
|
||||
addEqCore lhs rhs proof false
|
||||
|
||||
/-- Adds a new heterogeneous equality `HEq lhs rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
|
||||
private def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
|
||||
def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
|
||||
addEqCore lhs rhs proof true
|
||||
|
||||
/-- Save asserted facts for pretty printing goal. -/
|
||||
private def storeFact (fact : Expr) : GoalM Unit := do
|
||||
modify fun s => { s with facts := s.facts.push fact }
|
||||
|
||||
/-- Internalizes `lhs` and `rhs`, and then adds equality `lhs = rhs`. -/
|
||||
def addNewEq (lhs rhs proof : Expr) (generation : Nat) : GoalM Unit := do
|
||||
storeFact (← mkEq lhs rhs)
|
||||
internalize lhs generation
|
||||
internalize rhs generation
|
||||
addEq lhs rhs proof
|
||||
|
||||
/-- Adds a new `fact` justified by the given proof and using the given generation. -/
|
||||
/--
|
||||
Adds a new `fact` justified by the given proof and using the given generation.
|
||||
-/
|
||||
def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
|
||||
storeFact fact
|
||||
trace_goal[grind.assert] "{fact}"
|
||||
trace[grind.assert] "{fact}"
|
||||
if (← isInconsistent) then return ()
|
||||
resetNewEqs
|
||||
let_expr Not p := fact
|
||||
@@ -222,22 +209,14 @@ def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
|
||||
where
|
||||
go (p : Expr) (isNeg : Bool) : GoalM Unit := do
|
||||
match_expr p with
|
||||
| Eq α lhs rhs =>
|
||||
if α.isProp then
|
||||
-- It is morally an iff.
|
||||
-- We do not use the `goEq` optimization because we want to register `p` as a case-split
|
||||
goFact p isNeg
|
||||
else
|
||||
goEq p lhs rhs isNeg false
|
||||
| Eq _ lhs rhs => goEq p lhs rhs isNeg false
|
||||
| HEq _ lhs _ rhs => goEq p lhs rhs isNeg true
|
||||
| _ => goFact p isNeg
|
||||
|
||||
goFact (p : Expr) (isNeg : Bool) : GoalM Unit := do
|
||||
internalize p generation
|
||||
if isNeg then
|
||||
addEq p (← getFalseExpr) (← mkEqFalse proof)
|
||||
else
|
||||
addEq p (← getTrueExpr) (← mkEqTrue proof)
|
||||
| _ =>
|
||||
internalize p generation
|
||||
if isNeg then
|
||||
addEq p (← getFalseExpr) (← mkEqFalse proof)
|
||||
else
|
||||
addEq p (← getTrueExpr) (← mkEqTrue proof)
|
||||
|
||||
goEq (p : Expr) (lhs rhs : Expr) (isNeg : Bool) (isHEq : Bool) : GoalM Unit := do
|
||||
if isNeg then
|
||||
|
||||
@@ -9,18 +9,14 @@ import Lean.Meta.Tactic.Grind.Types
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit := do
|
||||
-- Remark: we must use `shareCommon` before using `pushEq` and `pushHEq`.
|
||||
-- This is needed because the result type of the injection theorem may allocate
|
||||
match_expr eqs with
|
||||
| And left right =>
|
||||
propagateInjEqs left (.proj ``And 0 proof)
|
||||
propagateInjEqs right (.proj ``And 1 proof)
|
||||
| Eq _ lhs rhs =>
|
||||
pushEq (← shareCommon lhs) (← shareCommon rhs) proof
|
||||
| HEq _ lhs _ rhs =>
|
||||
pushHEq (← shareCommon lhs) (← shareCommon rhs) proof
|
||||
| Eq _ lhs rhs => pushEq lhs rhs proof
|
||||
| HEq _ lhs _ rhs => pushHEq lhs rhs proof
|
||||
| _ =>
|
||||
trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
|
||||
trace[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
|
||||
return ()
|
||||
|
||||
/--
|
||||
|
||||
@@ -1,35 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Util
|
||||
import Init.Simproc
|
||||
import Lean.Meta.Tactic.Simp.Simproc
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
/--
|
||||
Returns `Grind.doNotSimp e`.
|
||||
Recall that `Grind.doNotSimp` is an identity function, but the following simproc is used to prevent the term `e` from being simplified.
|
||||
-/
|
||||
def markAsDoNotSimp (e : Expr) : MetaM Expr :=
|
||||
mkAppM ``Grind.doNotSimp #[e]
|
||||
|
||||
builtin_dsimproc_decl reduceDoNotSimp (Grind.doNotSimp _) := fun e => do
|
||||
let_expr Grind.doNotSimp _ _ ← e | return .continue
|
||||
return .done e
|
||||
|
||||
/-- Adds `reduceDoNotSimp` to `s` -/
|
||||
def addDoNotSimp (s : Simprocs) : CoreM Simprocs := do
|
||||
s.add ``reduceDoNotSimp (post := false)
|
||||
|
||||
/-- Erases `Grind.doNotSimp` annotations. -/
|
||||
def eraseDoNotSimp (e : Expr) : CoreM Expr := do
|
||||
let pre (e : Expr) := do
|
||||
let_expr Grind.doNotSimp _ a := e | return .continue e
|
||||
return .continue a
|
||||
Core.transform e (pre := pre)
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Intro
|
||||
import Lean.Meta.Tactic.Grind.DoNotSimp
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
namespace EMatch
|
||||
@@ -16,8 +15,6 @@ namespace EMatch
|
||||
inductive Cnstr where
|
||||
| /-- Matches pattern `pat` with term `e` -/
|
||||
«match» (pat : Expr) (e : Expr)
|
||||
| /-- Matches offset pattern `pat+k` with term `e` -/
|
||||
offset (pat : Expr) (k : Nat) (e : Expr)
|
||||
| /-- This constraint is used to encode multi-patterns. -/
|
||||
«continue» (pat : Expr)
|
||||
deriving Inhabited
|
||||
@@ -51,8 +48,6 @@ structure Context where
|
||||
useMT : Bool := true
|
||||
/-- `EMatchTheorem` being processed. -/
|
||||
thm : EMatchTheorem := default
|
||||
/-- Initial application used to start E-matching -/
|
||||
initApp : Expr := default
|
||||
deriving Inhabited
|
||||
|
||||
/-- State for the E-matching monad -/
|
||||
@@ -66,9 +61,6 @@ abbrev M := ReaderT Context $ StateRefT State GoalM
|
||||
def M.run' (x : M α) : GoalM α :=
|
||||
x {} |>.run' {}
|
||||
|
||||
@[inline] private abbrev withInitApp (e : Expr) (x : M α) : M α :=
|
||||
withReader (fun ctx => { ctx with initApp := e }) x
|
||||
|
||||
/--
|
||||
Assigns `bidx := e` in `c`. If `bidx` is already assigned in `c`, we check whether
|
||||
`e` and `c.assignment[bidx]` are in the same equivalence class.
|
||||
@@ -95,28 +87,6 @@ private def eqvFunctions (pFn eFn : Expr) : Bool :=
|
||||
(pFn.isFVar && pFn == eFn)
|
||||
|| (pFn.isConst && eFn.isConstOf pFn.constName!)
|
||||
|
||||
/-- Matches a pattern argument. See `matchArgs?`. -/
|
||||
private def matchArg? (c : Choice) (pArg : Expr) (eArg : Expr) : OptionT GoalM Choice := do
|
||||
if isPatternDontCare pArg then
|
||||
return c
|
||||
else if pArg.isBVar then
|
||||
assign? c pArg.bvarIdx! eArg
|
||||
else if let some pArg := groundPattern? pArg then
|
||||
guard (← isEqv pArg eArg)
|
||||
return c
|
||||
else if let some (pArg, k) := isOffsetPattern? pArg then
|
||||
assert! Option.isNone <| isOffsetPattern? pArg
|
||||
assert! !isPatternDontCare pArg
|
||||
return { c with cnstrs := .offset pArg k eArg :: c.cnstrs }
|
||||
else
|
||||
return { c with cnstrs := .match pArg eArg :: c.cnstrs }
|
||||
|
||||
private def Choice.updateGen (c : Choice) (gen : Nat) : Choice :=
|
||||
{ c with gen := Nat.max gen c.gen }
|
||||
|
||||
private def pushChoice (c : Choice) : M Unit :=
|
||||
modify fun s => { s with choiceStack := c :: s.choiceStack }
|
||||
|
||||
/--
|
||||
Matches arguments of pattern `p` with term `e`. Returns `some` if successful,
|
||||
and `none` otherwise. It may update `c`s assignment and list of contraints to be
|
||||
@@ -126,8 +96,16 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
|
||||
if !p.isApp then return c -- Done
|
||||
let pArg := p.appArg!
|
||||
let eArg := e.appArg!
|
||||
let c ← matchArg? c pArg eArg
|
||||
matchArgs? c p.appFn! e.appFn!
|
||||
let goFn c := matchArgs? c p.appFn! e.appFn!
|
||||
if isPatternDontCare pArg then
|
||||
goFn c
|
||||
else if pArg.isBVar then
|
||||
goFn (← assign? c pArg.bvarIdx! eArg)
|
||||
else if let some pArg := groundPattern? pArg then
|
||||
guard (← isEqv pArg eArg)
|
||||
goFn c
|
||||
else
|
||||
goFn { c with cnstrs := .match pArg eArg :: c.cnstrs }
|
||||
|
||||
/--
|
||||
Matches pattern `p` with term `e` with respect to choice `c`.
|
||||
@@ -142,46 +120,15 @@ private partial def processMatch (c : Choice) (p : Expr) (e : Expr) : M Unit :=
|
||||
let mut curr := e
|
||||
repeat
|
||||
let n ← getENode curr
|
||||
-- Remark: we use `<` because the instance generation is the maximum term generation + 1
|
||||
if n.generation < maxGeneration
|
||||
if n.generation <= maxGeneration
|
||||
-- uses heterogeneous equality or is the root of its congruence class
|
||||
&& (n.heqProofs || n.isCongrRoot)
|
||||
&& eqvFunctions pFn curr.getAppFn
|
||||
&& curr.getAppNumArgs == numArgs then
|
||||
if let some c ← matchArgs? c p curr |>.run then
|
||||
pushChoice (c.updateGen n.generation)
|
||||
curr ← getNext curr
|
||||
if isSameExpr curr e then break
|
||||
|
||||
/--
|
||||
Matches offset pattern `pArg+k` with term `e` with respect to choice `c`.
|
||||
-/
|
||||
private partial def processOffset (c : Choice) (pArg : Expr) (k : Nat) (e : Expr) : M Unit := do
|
||||
let maxGeneration ← getMaxGeneration
|
||||
let mut curr := e
|
||||
repeat
|
||||
let n ← getENode curr
|
||||
if n.generation < maxGeneration then
|
||||
if let some (eArg, k') ← isOffset? curr |>.run then
|
||||
if k' < k then
|
||||
let c := c.updateGen n.generation
|
||||
pushChoice { c with cnstrs := .offset pArg (k - k') eArg :: c.cnstrs }
|
||||
else if k' == k then
|
||||
if let some c ← matchArg? c pArg eArg |>.run then
|
||||
pushChoice (c.updateGen n.generation)
|
||||
else if k' > k then
|
||||
let eArg' := mkNatAdd eArg (mkNatLit (k' - k))
|
||||
let eArg' ← shareCommon (← canon eArg')
|
||||
internalize eArg' (n.generation+1)
|
||||
if let some c ← matchArg? c pArg eArg' |>.run then
|
||||
pushChoice (c.updateGen n.generation)
|
||||
else if let some k' ← evalNat curr |>.run then
|
||||
if k' >= k then
|
||||
let eArg' := mkNatLit (k' - k)
|
||||
let eArg' ← shareCommon (← canon eArg')
|
||||
internalize eArg' (n.generation+1)
|
||||
if let some c ← matchArg? c pArg eArg' |>.run then
|
||||
pushChoice (c.updateGen n.generation)
|
||||
let gen := n.generation
|
||||
let c := { c with gen := Nat.max gen c.gen }
|
||||
modify fun s => { s with choiceStack := c :: s.choiceStack }
|
||||
curr ← getNext curr
|
||||
if isSameExpr curr e then break
|
||||
|
||||
@@ -192,26 +139,13 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
|
||||
let maxGeneration ← getMaxGeneration
|
||||
for app in apps do
|
||||
let n ← getENode app
|
||||
if n.generation < maxGeneration
|
||||
if n.generation <= maxGeneration
|
||||
&& (n.heqProofs || n.isCongrRoot) then
|
||||
if let some c ← matchArgs? c p app |>.run then
|
||||
let gen := n.generation
|
||||
let c := { c with gen := Nat.max gen c.gen }
|
||||
modify fun s => { s with choiceStack := c :: s.choiceStack }
|
||||
|
||||
/--
|
||||
Helper function for marking parts of `match`-equation theorem as "do-not-simplify"
|
||||
`initApp` is the match-expression used to instantiate the `match`-equation.
|
||||
-/
|
||||
private partial def annotateMatchEqnType (prop : Expr) (initApp : Expr) : M Expr := do
|
||||
if let .forallE n d b bi := prop then
|
||||
withLocalDecl n bi (← markAsDoNotSimp d) fun x => do
|
||||
mkForallFVars #[x] (← annotateMatchEqnType (b.instantiate1 x) initApp)
|
||||
else
|
||||
let_expr f@Eq α lhs rhs := prop | return prop
|
||||
-- See comment at `Grind.EqMatch`
|
||||
return mkApp4 (mkConst ``Grind.EqMatch f.constLevels!) α (← markAsDoNotSimp lhs) rhs initApp
|
||||
|
||||
/--
|
||||
Stores new theorem instance in the state.
|
||||
Recall that new instances are internalized later, after a full round of ematching.
|
||||
@@ -220,11 +154,9 @@ private def addNewInstance (origin : Origin) (proof : Expr) (generation : Nat) :
|
||||
let proof ← instantiateMVars proof
|
||||
if grind.debug.proofs.get (← getOptions) then
|
||||
check proof
|
||||
let mut prop ← inferType proof
|
||||
if Match.isMatchEqnTheorem (← getEnv) origin.key then
|
||||
prop ← annotateMatchEqnType prop (← read).initApp
|
||||
trace_goal[grind.ematch.instance] "{← origin.pp}: {prop}"
|
||||
addTheoremInstance proof prop (generation+1)
|
||||
let prop ← inferType proof
|
||||
trace[grind.ematch.instance] "{← origin.pp}: {prop}"
|
||||
addTheoremInstance proof prop generation
|
||||
|
||||
/--
|
||||
After processing a (multi-)pattern, use the choice assignment to instantiate the proof.
|
||||
@@ -234,38 +166,36 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
|
||||
let thm := (← read).thm
|
||||
unless (← markTheoremInstance thm.proof c.assignment) do
|
||||
return ()
|
||||
trace_goal[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
|
||||
trace[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
|
||||
let proof ← thm.getProofWithFreshMVarLevels
|
||||
let numParams := thm.numParams
|
||||
assert! c.assignment.size == numParams
|
||||
let (mvars, bis, _) ← forallMetaBoundedTelescope (← inferType proof) numParams
|
||||
if mvars.size != thm.numParams then
|
||||
trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
|
||||
trace[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
|
||||
return ()
|
||||
-- Apply assignment
|
||||
for h : i in [:mvars.size] do
|
||||
let v := c.assignment[numParams - i - 1]!
|
||||
unless isSameExpr v unassigned do
|
||||
let mvarId := mvars[i].mvarId!
|
||||
let mvarIdType ← mvarId.getType
|
||||
let vType ← inferType v
|
||||
unless (← isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
|
||||
trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
|
||||
unless (← isDefEq (← mvarId.getType) (← inferType v) <&&> mvarId.checkedAssign v) do
|
||||
trace[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}"
|
||||
return ()
|
||||
-- Synthesize instances
|
||||
for mvar in mvars, bi in bis do
|
||||
if bi.isInstImplicit && !(← mvar.mvarId!.isAssigned) then
|
||||
let type ← inferType mvar
|
||||
unless (← synthesizeInstance mvar type) do
|
||||
trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
|
||||
trace[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
|
||||
return ()
|
||||
let proof := mkAppN proof mvars
|
||||
if (← mvars.allM (·.mvarId!.isAssigned)) then
|
||||
addNewInstance thm.origin proof c.gen
|
||||
addNewInstance thm.origin (mkAppN proof mvars) c.gen
|
||||
else
|
||||
let proof := mkAppN proof mvars
|
||||
let mvars ← mvars.filterM fun mvar => return !(← mvar.mvarId!.isAssigned)
|
||||
if let some mvarBad ← mvars.findM? fun mvar => return !(← isProof mvar) then
|
||||
trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
|
||||
trace[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
|
||||
let proof ← mkLambdaFVars (binderInfoForMVars := .default) mvars (← instantiateMVars proof)
|
||||
addNewInstance thm.origin proof c.gen
|
||||
where
|
||||
@@ -274,18 +204,16 @@ where
|
||||
isDefEq x val
|
||||
|
||||
/-- Process choice stack until we don't have more choices to be processed. -/
|
||||
private def processChoices : M Unit := do
|
||||
let maxGeneration ← getMaxGeneration
|
||||
while !(← get).choiceStack.isEmpty do
|
||||
private partial def processChoices : M Unit := do
|
||||
unless (← get).choiceStack.isEmpty do
|
||||
checkSystem "ematch"
|
||||
if (← checkMaxInstancesExceeded) then return ()
|
||||
let c ← modifyGet fun s : State => (s.choiceStack.head!, { s with choiceStack := s.choiceStack.tail! })
|
||||
if c.gen < maxGeneration then
|
||||
match c.cnstrs with
|
||||
| [] => instantiateTheorem c
|
||||
| .match p e :: cnstrs => processMatch { c with cnstrs } p e
|
||||
| .offset p k e :: cnstrs => processOffset { c with cnstrs } p k e
|
||||
| .continue p :: cnstrs => processContinue { c with cnstrs } p
|
||||
match c.cnstrs with
|
||||
| [] => instantiateTheorem c
|
||||
| .match p e :: cnstrs => processMatch { c with cnstrs } p e
|
||||
| .continue p :: cnstrs => processContinue { c with cnstrs } p
|
||||
processChoices
|
||||
|
||||
private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
|
||||
let some apps := (← getThe Goal).appMap.find? p.toHeadIndex
|
||||
@@ -299,10 +227,9 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
|
||||
let n ← getENode app
|
||||
if (n.heqProofs || n.isCongrRoot) &&
|
||||
(!useMT || n.mt == gmt) then
|
||||
withInitApp app do
|
||||
if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
|
||||
modify fun s => { s with choiceStack := [c] }
|
||||
processChoices
|
||||
if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
|
||||
modify fun s => { s with choiceStack := [c] }
|
||||
processChoices
|
||||
|
||||
def ematchTheorem (thm : EMatchTheorem) : M Unit := do
|
||||
if (← checkMaxInstancesExceeded) then return ()
|
||||
@@ -341,7 +268,7 @@ def ematch : GoalM Unit := do
|
||||
let go (thms newThms : PArray EMatchTheorem) : EMatch.M Unit := do
|
||||
withReader (fun ctx => { ctx with useMT := true }) <| ematchTheorems thms
|
||||
withReader (fun ctx => { ctx with useMT := false }) <| ematchTheorems newThms
|
||||
if (← checkMaxInstancesExceeded <||> checkMaxEmatchExceeded) then
|
||||
if (← checkMaxInstancesExceeded) then
|
||||
return ()
|
||||
else
|
||||
go (← get).thms (← get).newThms |>.run'
|
||||
@@ -349,18 +276,17 @@ def ematch : GoalM Unit := do
|
||||
thms := s.thms ++ s.newThms
|
||||
newThms := {}
|
||||
gmt := s.gmt + 1
|
||||
numEmatch := s.numEmatch + 1
|
||||
}
|
||||
|
||||
/-- Performs one round of E-matching, and assert new instances. -/
|
||||
def ematchAndAssert : GrindTactic := fun goal => do
|
||||
def ematchAndAssert? (goal : Goal) : GrindM (Option (List Goal)) := do
|
||||
let numInstances := goal.numInstances
|
||||
let goal ← GoalM.run' goal ematch
|
||||
if goal.numInstances == numInstances then
|
||||
return none
|
||||
assertAll goal
|
||||
|
||||
def ematchStar : GrindTactic :=
|
||||
ematchAndAssert.iterate
|
||||
def ematchStar (goal : Goal) : GrindM (List Goal) := do
|
||||
iterate goal ematchAndAssert?
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -4,49 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.Tactics
|
||||
import Lean.HeadIndex
|
||||
import Lean.PrettyPrinter
|
||||
import Lean.Util.FoldConsts
|
||||
import Lean.Util.CollectFVars
|
||||
import Lean.Meta.Basic
|
||||
import Lean.Meta.InferType
|
||||
import Lean.Meta.Eqns
|
||||
import Lean.Meta.Tactic.Grind.Util
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
def mkOffsetPattern (pat : Expr) (k : Nat) : Expr :=
|
||||
mkApp2 (mkConst ``Grind.offset) pat (mkRawNatLit k)
|
||||
|
||||
private def detectOffsets (pat : Expr) : MetaM Expr := do
|
||||
let pre (e : Expr) := do
|
||||
if e == pat then
|
||||
-- We only consider nested offset patterns
|
||||
return .continue e
|
||||
else match e with
|
||||
| .letE .. | .lam .. | .forallE .. => return .done e
|
||||
| _ =>
|
||||
let some (e, k) ← isOffset? e
|
||||
| return .continue e
|
||||
if k == 0 then return .continue e
|
||||
return .continue <| mkOffsetPattern e k
|
||||
Core.transform pat (pre := pre)
|
||||
|
||||
def isOffsetPattern? (pat : Expr) : Option (Expr × Nat) := Id.run do
|
||||
let_expr Grind.offset pat k := pat | none
|
||||
let .lit (.natVal k) := k | none
|
||||
return some (pat, k)
|
||||
|
||||
def preprocessPattern (pat : Expr) (normalizePattern := true) : MetaM Expr := do
|
||||
let pat ← instantiateMVars pat
|
||||
let pat ← unfoldReducible pat
|
||||
let pat ← if normalizePattern then normalize pat else pure pat
|
||||
let pat ← detectOffsets pat
|
||||
let pat ← foldProjs pat
|
||||
return pat
|
||||
|
||||
inductive Origin where
|
||||
/-- A global declaration in the environment. -/
|
||||
| decl (declName : Name)
|
||||
@@ -57,29 +23,22 @@ inductive Origin where
|
||||
is the provided grind argument. The `id` is a unique identifier for the call.
|
||||
-/
|
||||
| stx (id : Name) (ref : Syntax)
|
||||
/-- It is local, but we don't have a local hypothesis for it. -/
|
||||
| local (id : Name)
|
||||
deriving Inhabited, Repr, BEq
|
||||
| other
|
||||
deriving Inhabited, Repr
|
||||
|
||||
/-- A unique identifier corresponding to the origin. -/
|
||||
def Origin.key : Origin → Name
|
||||
| .decl declName => declName
|
||||
| .fvar fvarId => fvarId.name
|
||||
| .stx id _ => id
|
||||
| .local id => id
|
||||
| .other => `other
|
||||
|
||||
def Origin.pp [Monad m] [MonadEnv m] [MonadError m] (o : Origin) : m MessageData := do
|
||||
match o with
|
||||
| .decl declName => return MessageData.ofConst (← mkConstWithLevelParams declName)
|
||||
| .fvar fvarId => return mkFVar fvarId
|
||||
| .stx _ ref => return ref
|
||||
| .local id => return id
|
||||
|
||||
instance : BEq Origin where
|
||||
beq a b := a.key == b.key
|
||||
|
||||
instance : Hashable Origin where
|
||||
hash a := hash a.key
|
||||
| .other => return "[unknown]"
|
||||
|
||||
/-- A theorem for heuristic instantiation based on E-matching. -/
|
||||
structure EMatchTheorem where
|
||||
@@ -97,58 +56,17 @@ structure EMatchTheorem where
|
||||
origin : Origin
|
||||
deriving Inhabited
|
||||
|
||||
/-- Set of E-matching theorems. -/
|
||||
structure EMatchTheorems where
|
||||
/-- The key is a symbol from `EMatchTheorem.symbols`. -/
|
||||
private map : PHashMap Name (List EMatchTheorem) := {}
|
||||
/-- Set of theorem ids that have been inserted using `insert`. -/
|
||||
private origins : PHashSet Origin := {}
|
||||
/-- Theorems that have been marked as erased -/
|
||||
private erased : PHashSet Origin := {}
|
||||
deriving Inhabited
|
||||
/-- The key is a symbol from `EMatchTheorem.symbols`. -/
|
||||
abbrev EMatchTheorems := PHashMap Name (List EMatchTheorem)
|
||||
|
||||
/--
|
||||
Inserts a `thm` with symbols `[s_1, ..., s_n]` to `s`.
|
||||
We add `s_1 -> { thm with symbols := [s_2, ..., s_n] }`.
|
||||
When `grind` internalizes a term containing symbol `s`, we
|
||||
process all theorems `thm` associated with key `s`.
|
||||
If their `thm.symbols` is empty, we say they are activated.
|
||||
Otherwise, we reinsert into `map`.
|
||||
-/
|
||||
def EMatchTheorems.insert (s : EMatchTheorems) (thm : EMatchTheorem) : EMatchTheorems := Id.run do
|
||||
let .const declName :: syms := thm.symbols
|
||||
| unreachable!
|
||||
let thm := { thm with symbols := syms }
|
||||
let { map, origins, erased } := s
|
||||
let origins := origins.insert thm.origin
|
||||
let erased := erased.erase thm.origin
|
||||
if let some thms := map.find? declName then
|
||||
return { map := map.insert declName (thm::thms), origins, erased }
|
||||
if let some thms := s.find? declName then
|
||||
return PersistentHashMap.insert s declName (thm::thms)
|
||||
else
|
||||
return { map := map.insert declName [thm], origins, erased }
|
||||
|
||||
/-- Returns `true` if `s` contains a theorem with the given origin. -/
|
||||
def EMatchTheorems.contains (s : EMatchTheorems) (origin : Origin) : Bool :=
|
||||
s.origins.contains origin
|
||||
|
||||
/-- Mark the theorm with the given origin as `erased` -/
|
||||
def EMatchTheorems.erase (s : EMatchTheorems) (origin : Origin) : EMatchTheorems :=
|
||||
{ s with erased := s.erased.insert origin, origins := s.origins.erase origin }
|
||||
|
||||
/-- Returns true if the theorem has been marked as erased. -/
|
||||
def EMatchTheorems.isErased (s : EMatchTheorems) (origin : Origin) : Bool :=
|
||||
s.erased.contains origin
|
||||
|
||||
/--
|
||||
Retrieves theorems from `s` associated with the given symbol. See `EMatchTheorem.insert`.
|
||||
The theorems are removed from `s`.
|
||||
-/
|
||||
@[inline]
|
||||
def EMatchTheorems.retrieve? (s : EMatchTheorems) (sym : Name) : Option (List EMatchTheorem × EMatchTheorems) :=
|
||||
if let some thms := s.map.find? sym then
|
||||
some (thms, { s with map := s.map.erase sym })
|
||||
else
|
||||
none
|
||||
return PersistentHashMap.insert s declName [thm]
|
||||
|
||||
def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr := do
|
||||
if thm.proof.isConst && thm.levelParams.isEmpty then
|
||||
@@ -167,46 +85,14 @@ def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr
|
||||
private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTheorem EMatchTheorems ←
|
||||
registerSimpleScopedEnvExtension {
|
||||
addEntry := EMatchTheorems.insert
|
||||
initial := {}
|
||||
initial := .empty
|
||||
}
|
||||
|
||||
/--
|
||||
Symbols with built-in support in `grind` are unsuitable as pattern candidates for E-matching.
|
||||
This is because `grind` performs normalization operations and uses specialized data structures
|
||||
to implement these symbols, which may interfere with E-matching behavior.
|
||||
-/
|
||||
-- TODO: create attribute?
|
||||
private def forbiddenDeclNames := #[``Eq, ``HEq, ``Iff, ``And, ``Or, ``Not]
|
||||
|
||||
private def isForbidden (declName : Name) := forbiddenDeclNames.contains declName
|
||||
|
||||
/--
|
||||
Auxiliary function to expand a pattern containing forbidden application symbols
|
||||
into a multi-pattern.
|
||||
|
||||
This function enhances the usability of the `[grind =]` attribute by automatically handling
|
||||
forbidden pattern symbols. For example, consider the following theorem tagged with this attribute:
|
||||
```
|
||||
getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a]
|
||||
```
|
||||
Here, the selected pattern is `xs.getLast? = some a`, but `Eq` is a forbidden pattern symbol.
|
||||
Instead of producing an error, this function converts the pattern into a multi-pattern,
|
||||
allowing the attribute to be used conveniently.
|
||||
|
||||
The function recursively expands patterns with forbidden symbols by splitting them
|
||||
into their sub-components. If the pattern does not contain forbidden symbols,
|
||||
it is returned as-is.
|
||||
-/
|
||||
partial def splitWhileForbidden (pat : Expr) : List Expr :=
|
||||
match_expr pat with
|
||||
| Not p => splitWhileForbidden p
|
||||
| And p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
|
||||
| Or p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
|
||||
| Eq _ lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| Iff lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| HEq _ lhs _ rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| _ => [pat]
|
||||
|
||||
private def dontCare := mkConst (Name.mkSimple "[grind_dontcare]")
|
||||
|
||||
def mkGroundPattern (e : Expr) : Expr :=
|
||||
@@ -268,19 +154,17 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
|
||||
| _ => none
|
||||
|
||||
/--
|
||||
Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
|
||||
- a type (that is not a proposition) or type former, or
|
||||
Returns a bit-mask `mask` s.t. `mask[i]` is true if the the corresponding argument is
|
||||
- a type or type former, or
|
||||
- a proof, or
|
||||
- an instance implicit argument
|
||||
|
||||
When `mask[i]`, we say the corresponding argument is a "support" argument.
|
||||
-/
|
||||
def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
|
||||
private def getPatternFunMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
|
||||
forallBoundedTelescope (← inferType f) numArgs fun xs _ => do
|
||||
xs.mapM fun x => do
|
||||
if (← isProp x) then
|
||||
return false
|
||||
else if (← isTypeFormer x <||> isProof x) then
|
||||
if (← isTypeFormer x <||> isProof x) then
|
||||
return true
|
||||
else
|
||||
return (← x.fvarId!.getDecl).binderInfo matches .instImplicit
|
||||
@@ -288,26 +172,16 @@ def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
|
||||
private partial def go (pattern : Expr) (root := false) : M Expr := do
|
||||
if root && !pattern.hasLooseBVars then
|
||||
throwError "invalid pattern, it does not have pattern variables"
|
||||
if let some (e, k) := isOffsetPattern? pattern then
|
||||
let e ← goArg e (isSupport := false)
|
||||
if e == dontCare then
|
||||
return dontCare
|
||||
else
|
||||
return mkOffsetPattern e k
|
||||
let some f := getPatternFn? pattern
|
||||
| throwError "invalid pattern, (non-forbidden) application expected{indentExpr pattern}"
|
||||
| throwError "invalid pattern, (non-forbidden) application expected"
|
||||
assert! f.isConst || f.isFVar
|
||||
saveSymbol f.toHeadIndex
|
||||
let mut args := pattern.getAppArgs.toVector
|
||||
let supportMask ← getPatternSupportMask f args.size
|
||||
for h : i in [:args.size] do
|
||||
let arg := args[i]
|
||||
let mut args := pattern.getAppArgs
|
||||
let supportMask ← getPatternFunMask f args.size
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
let isSupport := supportMask[i]?.getD false
|
||||
args := args.set i (← goArg arg isSupport)
|
||||
return mkAppN f args.toArray
|
||||
where
|
||||
goArg (arg : Expr) (isSupport : Bool) : M Expr := do
|
||||
if !arg.hasLooseBVars then
|
||||
let arg ← if !arg.hasLooseBVars then
|
||||
if arg.hasMVar then
|
||||
pure dontCare
|
||||
else
|
||||
@@ -326,14 +200,13 @@ where
|
||||
go arg
|
||||
else
|
||||
pure dontCare
|
||||
args := args.set! i arg
|
||||
return mkAppN f args
|
||||
|
||||
def main (patterns : List Expr) : MetaM (List Expr × List HeadIndex × Std.HashSet Nat) := do
|
||||
let (patterns, s) ← patterns.mapM go |>.run {}
|
||||
return (patterns, s.symbols.toList, s.bvarsFound)
|
||||
|
||||
def normalizePattern (e : Expr) : M Expr := do
|
||||
go e
|
||||
|
||||
end NormalizePattern
|
||||
|
||||
/--
|
||||
@@ -447,8 +320,8 @@ private def checkCoverage (thmProof : Expr) (numParams : Nat) (bvarsFound : Std.
|
||||
Given a theorem with proof `proof` and `numParams` parameters, returns a message
|
||||
containing the parameters at positions `paramPos`.
|
||||
-/
|
||||
private def ppParamsAt (proof : Expr) (numParams : Nat) (paramPos : List Nat) : MetaM MessageData := do
|
||||
forallBoundedTelescope (← inferType proof) numParams fun xs _ => do
|
||||
private def ppParamsAt (proof : Expr) (numParms : Nat) (paramPos : List Nat) : MetaM MessageData := do
|
||||
forallBoundedTelescope (← inferType proof) numParms fun xs _ => do
|
||||
let mut msg := m!""
|
||||
let mut first := true
|
||||
for h : i in [:xs.size] do
|
||||
@@ -458,301 +331,24 @@ private def ppParamsAt (proof : Expr) (numParams : Nat) (paramPos : List Nat) :
|
||||
msg := msg ++ m!"{x} : {← inferType x}"
|
||||
addMessageContextFull msg
|
||||
|
||||
/--
|
||||
Creates an E-matching theorem for a theorem with proof `proof`, `numParams` parameters, and the given set of patterns.
|
||||
Pattern variables are represented using de Bruijn indices.
|
||||
-/
|
||||
def mkEMatchTheoremCore (origin : Origin) (levelParams : Array Name) (numParams : Nat) (proof : Expr) (patterns : List Expr) : MetaM EMatchTheorem := do
|
||||
def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
|
||||
let .thmInfo info ← getConstInfo declName
|
||||
| throwError "`{declName}` is not a theorem, you cannot assign patterns to non-theorems for the `grind` tactic"
|
||||
let us := info.levelParams.map mkLevelParam
|
||||
let proof := mkConst declName us
|
||||
let (patterns, symbols, bvarFound) ← NormalizePattern.main patterns
|
||||
trace[grind.ematch.pattern] "{MessageData.ofConst proof}: {patterns.map ppPattern}"
|
||||
assert! symbols.all fun s => s matches .const _
|
||||
trace[grind.ematch.pattern] "{declName}: {patterns.map ppPattern}"
|
||||
if let .missing pos ← checkCoverage proof numParams bvarFound then
|
||||
let pats : MessageData := m!"{patterns.map ppPattern}"
|
||||
throwError "invalid pattern(s) for `{← origin.pp}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
|
||||
return {
|
||||
proof, patterns, numParams, symbols
|
||||
levelParams, origin
|
||||
throwError "invalid pattern(s) for `{declName}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
|
||||
ematchTheoremsExt.add {
|
||||
proof, patterns, numParams, symbols
|
||||
levelParams := #[]
|
||||
origin := .decl declName
|
||||
}
|
||||
|
||||
private def getProofFor (declName : Name) : CoreM Expr := do
|
||||
let .thmInfo info ← getConstInfo declName
|
||||
| throwError "`{declName}` is not a theorem"
|
||||
let us := info.levelParams.map mkLevelParam
|
||||
return mkConst declName us
|
||||
|
||||
/--
|
||||
Creates an E-matching theorem for `declName` with `numParams` parameters, and the given set of patterns.
|
||||
Pattern variables are represented using de Bruijn indices.
|
||||
-/
|
||||
def mkEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM EMatchTheorem := do
|
||||
mkEMatchTheoremCore (.decl declName) #[] numParams (← getProofFor declName) patterns
|
||||
|
||||
/--
|
||||
Given a theorem with proof `proof` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
|
||||
creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
|
||||
If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the pattern.
|
||||
-/
|
||||
def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof : Expr) (normalizePattern : Bool) (useLhs : Bool) : MetaM EMatchTheorem := do
|
||||
let (numParams, patterns) ← forallTelescopeReducing (← inferType proof) fun xs type => do
|
||||
let (lhs, rhs) ← match_expr type with
|
||||
| Eq _ lhs rhs => pure (lhs, rhs)
|
||||
| Iff lhs rhs => pure (lhs, rhs)
|
||||
| HEq _ lhs _ rhs => pure (lhs, rhs)
|
||||
| _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
|
||||
let pat := if useLhs then lhs else rhs
|
||||
let pat ← preprocessPattern pat normalizePattern
|
||||
let pats := splitWhileForbidden (pat.abstract xs)
|
||||
return (xs.size, pats)
|
||||
mkEMatchTheoremCore origin levelParams numParams proof patterns
|
||||
|
||||
/--
|
||||
Given theorem with name `declName` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
|
||||
creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
|
||||
|
||||
If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the
|
||||
pattern.
|
||||
-/
|
||||
def mkEMatchEqTheorem (declName : Name) (normalizePattern := true) (useLhs : Bool := true) : MetaM EMatchTheorem := do
|
||||
mkEMatchEqTheoremCore (.decl declName) #[] (← getProofFor declName) normalizePattern useLhs
|
||||
|
||||
/--
|
||||
Adds an E-matching theorem to the environment.
|
||||
See `mkEMatchTheorem`.
|
||||
-/
|
||||
def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
|
||||
ematchTheoremsExt.add (← mkEMatchTheorem declName numParams patterns)
|
||||
|
||||
/--
|
||||
Adds an E-matching equality theorem to the environment.
|
||||
See `mkEMatchEqTheorem`.
|
||||
-/
|
||||
def addEMatchEqTheorem (declName : Name) : MetaM Unit := do
|
||||
ematchTheoremsExt.add (← mkEMatchEqTheorem declName)
|
||||
|
||||
/-- Returns the E-matching theorems registered in the environment. -/
|
||||
def getEMatchTheorems : CoreM EMatchTheorems :=
|
||||
return ematchTheoremsExt.getState (← getEnv)
|
||||
|
||||
inductive TheoremKind where
|
||||
| eqLhs | eqRhs | eqBoth | fwd | bwd | default
|
||||
deriving Inhabited, BEq
|
||||
|
||||
private def TheoremKind.toAttribute : TheoremKind → String
|
||||
| .eqLhs => "[grind =]"
|
||||
| .eqRhs => "[grind =_]"
|
||||
| .eqBoth => "[grind _=_]"
|
||||
| .fwd => "[grind →]"
|
||||
| .bwd => "[grind ←]"
|
||||
| .default => "[grind]"
|
||||
|
||||
private def TheoremKind.explainFailure : TheoremKind → String
|
||||
| .eqLhs => "failed to find pattern in the left-hand side of the theorem's conclusion"
|
||||
| .eqRhs => "failed to find pattern in the right-hand side of the theorem's conclusion"
|
||||
| .eqBoth => unreachable! -- eqBoth is a macro
|
||||
| .fwd => "failed to find patterns in the antecedents of the theorem"
|
||||
| .bwd => "failed to find patterns in the theorem's conclusion"
|
||||
| .default => "failed to find patterns"
|
||||
|
||||
/-- Returns the types of `xs` that are propositions. -/
|
||||
private def getPropTypes (xs : Array Expr) : MetaM (Array Expr) :=
|
||||
xs.filterMapM fun x => do
|
||||
let type ← inferType x
|
||||
if (← isProp type) then return some type else return none
|
||||
|
||||
/-- State for the (pattern) `CollectorM` monad -/
|
||||
private structure Collector.State where
|
||||
/-- Pattern found so far. -/
|
||||
patterns : Array Expr := #[]
|
||||
done : Bool := false
|
||||
|
||||
private structure Collector.Context where
|
||||
proof : Expr
|
||||
xs : Array Expr
|
||||
|
||||
/-- Monad for collecting patterns for a theorem. -/
|
||||
private abbrev CollectorM := ReaderT Collector.Context $ StateRefT Collector.State NormalizePattern.M
|
||||
|
||||
/-- Similar to `getPatternFn?`, but operates on expressions that do not contain loose de Bruijn variables. -/
|
||||
private def isPatternFnCandidate (f : Expr) : CollectorM Bool := do
|
||||
match f with
|
||||
| .const declName _ => return !isForbidden declName
|
||||
| .fvar .. => return !(← read).xs.contains f
|
||||
| _ => return false
|
||||
|
||||
private def addNewPattern (p : Expr) : CollectorM Unit := do
|
||||
trace[grind.ematch.pattern.search] "found pattern: {ppPattern p}"
|
||||
let bvarsFound := (← getThe NormalizePattern.State).bvarsFound
|
||||
let done := (← checkCoverage (← read).proof (← read).xs.size bvarsFound) matches .ok
|
||||
if done then
|
||||
trace[grind.ematch.pattern.search] "found full coverage"
|
||||
modify fun s => { s with patterns := s.patterns.push p, done }
|
||||
|
||||
private partial def collect (e : Expr) : CollectorM Unit := do
|
||||
if (← get).done then return ()
|
||||
match e with
|
||||
| .app .. =>
|
||||
let f := e.getAppFn
|
||||
if (← isPatternFnCandidate f) then
|
||||
let saved ← getThe NormalizePattern.State
|
||||
try
|
||||
trace[grind.ematch.pattern.search] "candidate: {e}"
|
||||
let p := e.abstract (← read).xs
|
||||
unless p.hasLooseBVars do
|
||||
trace[grind.ematch.pattern.search] "skip, does not contain pattern variables"
|
||||
return ()
|
||||
let p ← NormalizePattern.normalizePattern p
|
||||
if saved.bvarsFound.size < (← getThe NormalizePattern.State).bvarsFound.size then
|
||||
addNewPattern p
|
||||
return ()
|
||||
trace[grind.ematch.pattern.search] "skip, no new variables covered"
|
||||
-- restore state and continue search
|
||||
set saved
|
||||
catch _ =>
|
||||
trace[grind.ematch.pattern.search] "skip, exception during normalization"
|
||||
-- restore state and continue search
|
||||
set saved
|
||||
let args := e.getAppArgs
|
||||
for arg in args, flag in (← NormalizePattern.getPatternSupportMask f args.size) do
|
||||
unless flag do
|
||||
collect arg
|
||||
| .forallE _ d b _ =>
|
||||
if (← pure e.isArrow <&&> isProp d <&&> isProp b) then
|
||||
collect d
|
||||
collect b
|
||||
| _ => return ()
|
||||
|
||||
private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option (List Expr × List HeadIndex)) := do
|
||||
let go : CollectorM (Option (List Expr)) := do
|
||||
for place in searchPlaces do
|
||||
let place ← preprocessPattern place
|
||||
collect place
|
||||
if (← get).done then
|
||||
return some ((← get).patterns.toList)
|
||||
return none
|
||||
let (some ps, s) ← go { proof, xs } |>.run' {} |>.run {}
|
||||
| return none
|
||||
return some (ps, s.symbols.toList)
|
||||
|
||||
def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
|
||||
if kind == .eqLhs then
|
||||
return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := true))
|
||||
else if kind == .eqRhs then
|
||||
return (← mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := false))
|
||||
let type ← inferType proof
|
||||
forallTelescopeReducing type fun xs type => do
|
||||
let searchPlaces ← match kind with
|
||||
| .fwd =>
|
||||
let ps ← getPropTypes xs
|
||||
if ps.isEmpty then
|
||||
throwError "invalid `grind` forward theorem, theorem `{← origin.pp}` does not have propositional hypotheses"
|
||||
pure ps
|
||||
| .bwd => pure #[type]
|
||||
| .default => pure <| #[type] ++ (← getPropTypes xs)
|
||||
| _ => unreachable!
|
||||
go xs searchPlaces
|
||||
where
|
||||
go (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option EMatchTheorem) := do
|
||||
let some (patterns, symbols) ← collectPatterns? proof xs searchPlaces
|
||||
| return none
|
||||
let numParams := xs.size
|
||||
trace[grind.ematch.pattern] "{← origin.pp}: {patterns.map ppPattern}"
|
||||
return some {
|
||||
proof, patterns, numParams, symbols
|
||||
levelParams, origin
|
||||
}
|
||||
|
||||
private def getKind (stx : Syntax) : TheoremKind :=
|
||||
if stx[1].isNone then
|
||||
.default
|
||||
else if stx[1][0].getKind == ``Parser.Attr.grindEq then
|
||||
.eqLhs
|
||||
else if stx[1][0].getKind == ``Parser.Attr.grindFwd then
|
||||
.fwd
|
||||
else if stx[1][0].getKind == ``Parser.Attr.grindEqRhs then
|
||||
.eqRhs
|
||||
else if stx[1][0].getKind == ``Parser.Attr.grindEqBoth then
|
||||
.eqBoth
|
||||
else
|
||||
.bwd
|
||||
|
||||
private def addGrindEqAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) (useLhs := true) : MetaM Unit := do
|
||||
if (← getConstInfo declName).isTheorem then
|
||||
ematchTheoremsExt.add (← mkEMatchEqTheorem declName (normalizePattern := true) (useLhs := useLhs)) attrKind
|
||||
else if let some eqns ← getEqnsFor? declName then
|
||||
unless useLhs do
|
||||
throwError "`{declName}` is a definition, you must only use the left-hand side for extracting patterns"
|
||||
for eqn in eqns do
|
||||
ematchTheoremsExt.add (← mkEMatchEqTheorem eqn) attrKind
|
||||
else
|
||||
throwError s!"`{thmKind.toAttribute}` attribute can only be applied to equational theorems or function definitions"
|
||||
|
||||
private def addGrindAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) : MetaM Unit := do
|
||||
if thmKind == .eqLhs then
|
||||
addGrindEqAttr declName attrKind thmKind (useLhs := true)
|
||||
else if thmKind == .eqRhs then
|
||||
addGrindEqAttr declName attrKind thmKind (useLhs := false)
|
||||
else if thmKind == .eqBoth then
|
||||
addGrindEqAttr declName attrKind thmKind (useLhs := true)
|
||||
addGrindEqAttr declName attrKind thmKind (useLhs := false)
|
||||
else if !(← getConstInfo declName).isTheorem then
|
||||
addGrindEqAttr declName attrKind thmKind
|
||||
else
|
||||
let some thm ← mkEMatchTheoremWithKind? (.decl declName) #[] (← getProofFor declName) thmKind
|
||||
| throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
|
||||
ematchTheoremsExt.add thm attrKind
|
||||
|
||||
builtin_initialize
|
||||
registerBuiltinAttribute {
|
||||
name := `grind
|
||||
descr :=
|
||||
"The `[grind]` attribute is used to annotate declarations.\
|
||||
\
|
||||
When applied to an equational theorem, `[grind =]`, `[grind =_]`, or `[grind _=_]`\
|
||||
will mark the theorem for use in heuristic instantiations by the `grind` tactic,
|
||||
using respectively the left-hand side, the right-hand side, or both sides of the theorem.\
|
||||
When applied to a function, `[grind =]` automatically annotates the equational theorems associated with that function.\
|
||||
When applied to a theorem `[grind ←]` will instantiate the theorem whenever it encounters the conclusion of the theorem
|
||||
(that is, it will use the theorem for backwards reasoning).\
|
||||
When applied to a theorem `[grind →]` will instantiate the theorem whenever it encounters sufficiently many of the propositional hypotheses
|
||||
(that is, it will use the theorem for forwards reasoning).\
|
||||
\
|
||||
The attribute `[grind]` by itself will effectively try `[grind ←]` (if the conclusion is sufficient for instantiation) and then `[grind →]`.\
|
||||
\
|
||||
The `grind` tactic utilizes annotated theorems to add instances of matching patterns into the local context during proof search.\
|
||||
For example, if a theorem `@[grind =] theorem foo_idempotent : foo (foo x) = foo x` is annotated,\
|
||||
`grind` will add an instance of this theorem to the local context whenever it encounters the pattern `foo (foo x)`."
|
||||
applicationTime := .afterCompilation
|
||||
add := fun declName stx attrKind => do
|
||||
addGrindAttr declName attrKind (getKind stx) |>.run' {}
|
||||
erase := fun declName => MetaM.run' do
|
||||
/-
|
||||
Remark: consider the following example
|
||||
```
|
||||
attribute [grind] foo -- ok
|
||||
attribute [-grind] foo.eqn_2 -- ok
|
||||
attribute [-grind] foo -- error
|
||||
```
|
||||
One may argue that the correct behavior should be
|
||||
```
|
||||
attribute [grind] foo -- ok
|
||||
attribute [-grind] foo.eqn_2 -- error
|
||||
attribute [-grind] foo -- ok
|
||||
```
|
||||
-/
|
||||
let throwErr := throwError "`{declName}` is not marked with the `[grind]` attribute"
|
||||
let info ← getConstInfo declName
|
||||
if !info.isTheorem then
|
||||
if let some eqns ← getEqnsFor? declName then
|
||||
let s := ematchTheoremsExt.getState (← getEnv)
|
||||
unless eqns.all fun eqn => s.contains (.decl eqn) do
|
||||
throwErr
|
||||
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s =>
|
||||
eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
|
||||
else
|
||||
throwErr
|
||||
else
|
||||
unless ematchTheoremsExt.getState (← getEnv) |>.contains (.decl declName) do
|
||||
throwErr
|
||||
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s => s.erase (.decl declName)
|
||||
}
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -1,30 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Expr
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@[inline] def isSameExpr (a b : Expr) : Bool :=
|
||||
-- It is safe to use pointer equality because we hashcons all expressions
|
||||
-- inserted into the E-graph
|
||||
unsafe ptrEq a b
|
||||
|
||||
/--
|
||||
Key for the `ENodeMap` and `ParentMap` map.
|
||||
We use pointer addresses and rely on the fact all internalized expressions
|
||||
have been hash-consed, i.e., we have applied `shareCommon`.
|
||||
-/
|
||||
structure ENodeKey where
|
||||
expr : Expr
|
||||
|
||||
instance : Hashable ENodeKey where
|
||||
hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
|
||||
|
||||
instance : BEq ENodeKey where
|
||||
beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -15,88 +15,17 @@ If `parent` is a projection-application `proj_i c`,
|
||||
check whether the root of the equivalence class containing `c` is a constructor-application `ctor ... a_i ...`.
|
||||
If so, internalize the term `proj_i (ctor ... a_i ...)` and add the equality `proj_i (ctor ... a_i ...) = a_i`.
|
||||
-/
|
||||
def propagateForallPropUp (e : Expr) : GoalM Unit := do
|
||||
let .forallE n p q bi := e | return ()
|
||||
trace_goal[grind.debug.forallPropagator] "{e}"
|
||||
if !q.hasLooseBVars then
|
||||
propagateImpliesUp p q
|
||||
else
|
||||
unless (← isEqTrue p) do return
|
||||
trace_goal[grind.debug.forallPropagator] "isEqTrue, {e}"
|
||||
let h₁ ← mkEqTrueProof p
|
||||
let qh₁ := q.instantiate1 (mkOfEqTrueCore p h₁)
|
||||
let r ← simp qh₁
|
||||
let q := mkLambda n bi p q
|
||||
let q' := r.expr
|
||||
internalize q' (← getGeneration e)
|
||||
trace_goal[grind.debug.forallPropagator] "q': {q'} for{indentExpr e}"
|
||||
let h₂ ← r.getProof
|
||||
let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
|
||||
pushEq e q' h
|
||||
where
|
||||
propagateImpliesUp (a b : Expr) : GoalM Unit := do
|
||||
unless (← alreadyInternalized b) do return ()
|
||||
if (← isEqFalse a) then
|
||||
-- a = False → (a → b) = True
|
||||
pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_false_left) a b (← mkEqFalseProof a)
|
||||
else if (← isEqTrue a) then
|
||||
-- a = True → (a → b) = b
|
||||
pushEq e b <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_left) a b (← mkEqTrueProof a)
|
||||
else if (← isEqTrue b) then
|
||||
-- b = True → (a → b) = True
|
||||
pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_right) a b (← mkEqTrueProof b)
|
||||
|
||||
private def isEqTrueHyp? (proof : Expr) : Option FVarId := Id.run do
|
||||
let_expr eq_true _ p := proof | return none
|
||||
let .fvar fvarId := p | return none
|
||||
return some fvarId
|
||||
|
||||
/-- Similar to `mkEMatchTheoremWithKind?`, but swallow any exceptions. -/
|
||||
private def mkEMatchTheoremWithKind'? (origin : Origin) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
|
||||
try
|
||||
mkEMatchTheoremWithKind? origin #[] proof kind
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
|
||||
let proof ← mkEqTrueProof e
|
||||
let origin ← if let some fvarId := isEqTrueHyp? proof then
|
||||
pure <| .fvar fvarId
|
||||
else
|
||||
let idx ← modifyGet fun s => (s.nextThmIdx, { s with nextThmIdx := s.nextThmIdx + 1 })
|
||||
pure <| .local ((`local).appendIndexAfter idx)
|
||||
let proof := mkOfEqTrueCore e proof
|
||||
let size := (← get).newThms.size
|
||||
let gen ← getGeneration e
|
||||
-- TODO: we should have a flag for collecting all unary patterns in a local theorem
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .fwd then
|
||||
activateTheorem thm gen
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .bwd then
|
||||
activateTheorem thm gen
|
||||
if (← get).newThms.size == size then
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .default then
|
||||
activateTheorem thm gen
|
||||
if (← get).newThms.size == size then
|
||||
trace[grind.issues] "failed to create E-match local theorem for{indentExpr e}"
|
||||
|
||||
def propagateForallPropDown (e : Expr) : GoalM Unit := do
|
||||
let .forallE n a b bi := e | return ()
|
||||
if (← isEqFalse e) then
|
||||
if b.hasLooseBVars then
|
||||
let α := a
|
||||
let p := b
|
||||
-- `e` is of the form `∀ x : α, p x`
|
||||
-- Add fact `∃ x : α, ¬ p x`
|
||||
let u ← getLevel α
|
||||
let prop := mkApp2 (mkConst ``Exists [u]) α (mkLambda n bi α (mkNot p))
|
||||
let proof := mkApp3 (mkConst ``Grind.of_forall_eq_false [u]) α (mkLambda n bi α p) (← mkEqFalseProof e)
|
||||
addNewFact proof prop (← getGeneration e)
|
||||
else
|
||||
let h ← mkEqFalseProof e
|
||||
pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_imp_eq_false) a b h
|
||||
pushEqFalse b <| mkApp3 (mkConst ``Grind.eq_false_of_imp_eq_false) a b h
|
||||
else if (← isEqTrue e) then
|
||||
if b.hasLooseBVars then
|
||||
addLocalEMatchTheorems e
|
||||
def propagateForallProp (parent : Expr) : GoalM Unit := do
|
||||
let .forallE n p q bi := parent | return ()
|
||||
unless (← isEqTrue p) do return ()
|
||||
let h₁ ← mkEqTrueProof p
|
||||
let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
|
||||
let r ← simp qh₁
|
||||
let q := mkLambda n bi p q
|
||||
let q' := r.expr
|
||||
internalize q' (← getGeneration parent)
|
||||
let h₂ ← r.getProof
|
||||
let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
|
||||
pushEq parent q' h
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -5,13 +5,9 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.Lemmas
|
||||
import Lean.Meta.LitValues
|
||||
import Lean.Meta.Match.MatcherInfo
|
||||
import Lean.Meta.Match.MatchEqsExt
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Util
|
||||
import Lean.Meta.Tactic.Grind.Arith.Internalize
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -24,19 +20,15 @@ def addCongrTable (e : Expr) : GoalM Unit := do
|
||||
let g := e'.getAppFn
|
||||
unless isSameExpr f g do
|
||||
unless (← hasSameType f g) do
|
||||
trace_goal[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
|
||||
trace[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
|
||||
return ()
|
||||
trace_goal[grind.debug.congr] "{e} = {e'}"
|
||||
trace[grind.debug.congr] "{e} = {e'}"
|
||||
pushEqHEq e e' congrPlaceholderProof
|
||||
let node ← getENode e
|
||||
setENode e { node with congr := e' }
|
||||
else
|
||||
modify fun s => { s with congrTable := s.congrTable.insert { e } }
|
||||
|
||||
/--
|
||||
Given an application `e` of the form `f a_1 ... a_n`,
|
||||
adds entry `f ↦ e` to `appMap`. Recall that `appMap` is a multi-map.
|
||||
-/
|
||||
private def updateAppMap (e : Expr) : GoalM Unit := do
|
||||
let key := e.toHeadIndex
|
||||
modify fun s => { s with
|
||||
@@ -46,58 +38,6 @@ private def updateAppMap (e : Expr) : GoalM Unit := do
|
||||
s.appMap.insert key [e]
|
||||
}
|
||||
|
||||
/-- Inserts `e` into the list of case-split candidates. -/
|
||||
private def addSplitCandidate (e : Expr) : GoalM Unit := do
|
||||
trace_goal[grind.split.candidate] "{e}"
|
||||
modify fun s => { s with splitCandidates := e :: s.splitCandidates }
|
||||
|
||||
-- TODO: add attribute to make this extensible
|
||||
private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
|
||||
|
||||
/-- Returns `true` if `e` is of the form `@Eq Prop a b` -/
|
||||
def isMorallyIff (e : Expr) : Bool :=
|
||||
let_expr Eq α _ _ := e | false
|
||||
α.isProp
|
||||
|
||||
/-- Inserts `e` into the list of case-split candidates if applicable. -/
|
||||
private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
|
||||
unless e.isApp do return ()
|
||||
if (← getConfig).splitIte && (e.isIte || e.isDIte) then
|
||||
addSplitCandidate e
|
||||
return ()
|
||||
if isMorallyIff e then
|
||||
addSplitCandidate e
|
||||
return ()
|
||||
if (← getConfig).splitMatch then
|
||||
if (← isMatcherApp e) then
|
||||
if let .reduced _ ← reduceMatcher? e then
|
||||
-- When instantiating `match`-equations, we add `match`-applications that can be reduced,
|
||||
-- and consequently don't need to be splitted.
|
||||
return ()
|
||||
else
|
||||
addSplitCandidate e
|
||||
return ()
|
||||
let .const declName _ := e.getAppFn | return ()
|
||||
if forbiddenSplitTypes.contains declName then return ()
|
||||
-- We should have a mechanism for letting users to select types to case-split.
|
||||
-- Right now, we just consider inductive predicates that are not in the forbidden list
|
||||
if (← getConfig).splitIndPred then
|
||||
if (← isInductivePredicate declName) then
|
||||
addSplitCandidate e
|
||||
|
||||
/--
|
||||
If `e` is a `cast`-like term (e.g., `cast h a`), add `HEq e a` to the to-do list.
|
||||
It could be an E-matching theorem, but we want to ensure it is always applied since
|
||||
we want to rely on the fact that `cast h a` and `a` are in the same equivalence class.
|
||||
-/
|
||||
private def pushCastHEqs (e : Expr) : GoalM Unit := do
|
||||
match_expr e with
|
||||
| f@cast α β h a => pushHEq e a (mkApp4 (mkConst ``cast_heq f.constLevels!) α β h a)
|
||||
| f@Eq.rec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqRec_heq f.constLevels!) α a motive v b h)
|
||||
| f@Eq.ndrec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqNDRec_heq f.constLevels!) α a motive v b h)
|
||||
| f@Eq.recOn α a motive b h v => pushHEq e v (mkApp6 (mkConst ``Grind.eqRecOn_heq f.constLevels!) α a motive b h v)
|
||||
| _ => return ()
|
||||
|
||||
mutual
|
||||
/-- Internalizes the nested ground terms in the given pattern. -/
|
||||
private partial def internalizePattern (pattern : Expr) (generation : Nat) : GoalM Expr := do
|
||||
@@ -110,74 +50,51 @@ private partial def internalizePattern (pattern : Expr) (generation : Nat) : Goa
|
||||
else pattern.withApp fun f args => do
|
||||
return mkAppN f (← args.mapM (internalizePattern · generation))
|
||||
|
||||
partial def activateTheorem (thm : EMatchTheorem) (generation : Nat) : GoalM Unit := do
|
||||
-- Recall that we use the proof as part of the key for a set of instances found so far.
|
||||
-- We don't want to use structural equality when comparing keys.
|
||||
let proof ← shareCommon thm.proof
|
||||
let thm := { thm with proof, patterns := (← thm.patterns.mapM (internalizePattern · generation)) }
|
||||
trace_goal[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
|
||||
modify fun s => { s with newThms := s.newThms.push thm }
|
||||
|
||||
/--
|
||||
If `Config.matchEqs` is set to `true`, and `f` is `match`-auxiliary function,
|
||||
adds its equations to `newThms`.
|
||||
-/
|
||||
private partial def addMatchEqns (f : Expr) (generation : Nat) : GoalM Unit := do
|
||||
if !(← getConfig).matchEqs then return ()
|
||||
let .const declName _ := f | return ()
|
||||
if !(← isMatcher declName) then return ()
|
||||
if (← get).matchEqNames.contains declName then return ()
|
||||
modify fun s => { s with matchEqNames := s.matchEqNames.insert declName }
|
||||
for eqn in (← Match.getEquationsFor declName).eqnNames do
|
||||
-- We disable pattern normalization to prevent the `match`-expression to be reduced.
|
||||
activateTheorem (← mkEMatchEqTheorem eqn (normalizePattern := false)) generation
|
||||
|
||||
private partial def activateTheoremPatterns (fName : Name) (generation : Nat) : GoalM Unit := do
|
||||
if let some (thms, thmMap) := (← get).thmMap.retrieve? fName then
|
||||
modify fun s => { s with thmMap }
|
||||
if let some thms := (← get).thmMap.find? fName then
|
||||
modify fun s => { s with thmMap := s.thmMap.erase fName }
|
||||
let appMap := (← get).appMap
|
||||
for thm in thms do
|
||||
unless (← get).thmMap.isErased thm.origin do
|
||||
let symbols := thm.symbols.filter fun sym => !appMap.contains sym
|
||||
let thm := { thm with symbols }
|
||||
match symbols with
|
||||
| [] => activateTheorem thm generation
|
||||
| _ =>
|
||||
trace_goal[grind.ematch] "reinsert `{thm.origin.key}`"
|
||||
modify fun s => { s with thmMap := s.thmMap.insert thm }
|
||||
let symbols := thm.symbols.filter fun sym => !appMap.contains sym
|
||||
let thm := { thm with symbols }
|
||||
match symbols with
|
||||
| [] =>
|
||||
-- Recall that we use the proof as part of the key for a set of instances found so far.
|
||||
-- We don't want to use structural equality when comparing keys.
|
||||
let proof ← shareCommon thm.proof
|
||||
let thm := { thm with proof, patterns := (← thm.patterns.mapM (internalizePattern · generation)) }
|
||||
trace[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
|
||||
modify fun s => { s with newThms := s.newThms.push thm }
|
||||
| _ =>
|
||||
trace[grind.ematch] "reinsert `{thm.origin.key}`"
|
||||
modify fun s => { s with thmMap := s.thmMap.insert thm }
|
||||
|
||||
partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
|
||||
if (← alreadyInternalized e) then return ()
|
||||
trace_goal[grind.internalize] "{e}"
|
||||
trace[grind.internalize] "{e}"
|
||||
match e with
|
||||
| .bvar .. => unreachable!
|
||||
| .sort .. => return ()
|
||||
| .fvar .. | .letE .. | .lam .. =>
|
||||
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
|
||||
| .forallE _ d b _ =>
|
||||
| .forallE _ d _ _ =>
|
||||
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
|
||||
if (← isProp d <&&> isProp e) then
|
||||
internalize d generation
|
||||
registerParent e d
|
||||
unless b.hasLooseBVars do
|
||||
internalize b generation
|
||||
registerParent e b
|
||||
propagateUp e
|
||||
| .lit .. | .const .. =>
|
||||
mkENode e generation
|
||||
| .mvar ..
|
||||
| .mdata ..
|
||||
| .proj .. =>
|
||||
trace_goal[grind.issues] "unexpected term during internalization{indentExpr e}"
|
||||
trace[grind.issues] "unexpected term during internalization{indentExpr e}"
|
||||
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
|
||||
| .app .. =>
|
||||
if (← isLitValue e) then
|
||||
-- We do not want to internalize the components of a literal value.
|
||||
mkENode e generation
|
||||
else e.withApp fun f args => do
|
||||
checkAndAddSplitCandidate e
|
||||
pushCastHEqs e
|
||||
addMatchEqns f generation
|
||||
if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
|
||||
-- We only internalize the proposition. We can skip the proof because of
|
||||
-- proof irrelevance
|
||||
@@ -197,7 +114,6 @@ partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
|
||||
mkENode e generation
|
||||
addCongrTable e
|
||||
updateAppMap e
|
||||
Arith.internalize e
|
||||
propagateUp e
|
||||
end
|
||||
|
||||
|
||||
@@ -11,7 +11,6 @@ import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Cases
|
||||
import Lean.Meta.Tactic.Grind.Injection
|
||||
import Lean.Meta.Tactic.Grind.Core
|
||||
import Lean.Meta.Tactic.Grind.Combinators
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -22,7 +21,7 @@ private inductive IntroResult where
|
||||
| newLocal (fvarId : FVarId) (goal : Goal)
|
||||
deriving Inhabited
|
||||
|
||||
private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
|
||||
private def introNext (goal : Goal) : GrindM IntroResult := do
|
||||
let target ← goal.mvarId.getType
|
||||
if target.isArrow then
|
||||
goal.mvarId.withContext do
|
||||
@@ -50,7 +49,7 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
|
||||
-- `p` and `p'` are definitionally equal
|
||||
goal.mvarId.assign h
|
||||
return .newHyp fvarId { goal with mvarId := mvarIdNew }
|
||||
else if target.isLet || target.isForall || target.isLetFun then
|
||||
else if target.isLet || target.isForall then
|
||||
let (fvarId, mvarId) ← goal.mvarId.intro1P
|
||||
mvarId.withContext do
|
||||
let localDecl ← fvarId.getDecl
|
||||
@@ -59,25 +58,17 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
|
||||
let mvarId ← mvarId.assert (← mkFreshUserName localDecl.userName) localDecl.type (mkFVar fvarId)
|
||||
return .newDepHyp { goal with mvarId }
|
||||
else
|
||||
let goal := { goal with mvarId }
|
||||
if target.isLet || target.isLetFun then
|
||||
let v := (← fvarId.getDecl).value
|
||||
let r ← simp v
|
||||
let x ← shareCommon (mkFVar fvarId)
|
||||
let goal ← GoalM.run' goal <| addNewEq x r.expr (← r.getProof) generation
|
||||
return .newLocal fvarId goal
|
||||
else
|
||||
return .newLocal fvarId goal
|
||||
return .newLocal fvarId { goal with mvarId }
|
||||
else
|
||||
return .done
|
||||
|
||||
private def isCasesCandidate (type : Expr) : MetaM Bool := do
|
||||
let .const declName _ := type.getAppFn | return false
|
||||
private def isCasesCandidate (fvarId : FVarId) : MetaM Bool := do
|
||||
let .const declName _ := (← fvarId.getType).getAppFn | return false
|
||||
isGrindCasesTarget declName
|
||||
|
||||
private def applyCases? (goal : Goal) (fvarId : FVarId) : MetaM (Option (List Goal)) := goal.mvarId.withContext do
|
||||
if (← isCasesCandidate (← fvarId.getType)) then
|
||||
let mvarIds ← cases goal.mvarId (mkFVar fvarId)
|
||||
if (← isCasesCandidate fvarId) then
|
||||
let mvarIds ← cases goal.mvarId fvarId
|
||||
return mvarIds.map fun mvarId => { goal with mvarId }
|
||||
else
|
||||
return none
|
||||
@@ -89,11 +80,11 @@ private def applyInjection? (goal : Goal) (fvarId : FVarId) : MetaM (Option Goal
|
||||
return none
|
||||
|
||||
/-- Introduce new hypotheses (and apply `by_contra`) until goal is of the form `... ⊢ False` -/
|
||||
partial def intros (generation : Nat) : GrindTactic' := fun goal => do
|
||||
partial def intros (goal : Goal) (generation : Nat) : GrindM (List Goal) := do
|
||||
let rec go (goal : Goal) : StateRefT (Array Goal) GrindM Unit := do
|
||||
if goal.inconsistent then
|
||||
return ()
|
||||
match (← introNext goal generation) with
|
||||
match (← introNext goal) with
|
||||
| .done =>
|
||||
if let some mvarId ← goal.mvarId.byContra? then
|
||||
go { goal with mvarId }
|
||||
@@ -117,27 +108,32 @@ partial def intros (generation : Nat) : GrindTactic' := fun goal => do
|
||||
return goals.toList
|
||||
|
||||
/-- Asserts a new fact `prop` with proof `proof` to the given `goal`. -/
|
||||
def assertAt (proof : Expr) (prop : Expr) (generation : Nat) : GrindTactic' := fun goal => do
|
||||
if (← isCasesCandidate prop) then
|
||||
let mvarId ← goal.mvarId.assert (← mkFreshUserName `h) prop proof
|
||||
let goal := { goal with mvarId }
|
||||
intros generation goal
|
||||
else
|
||||
let goal ← GoalM.run' goal do
|
||||
let r ← simp prop
|
||||
let prop' := r.expr
|
||||
let proof' ← mkEqMP (← r.getProof) proof
|
||||
add prop' proof' generation
|
||||
if goal.inconsistent then return [] else return [goal]
|
||||
def assertAt (goal : Goal) (proof : Expr) (prop : Expr) (generation : Nat) : GrindM (List Goal) := do
|
||||
-- TODO: check whether `prop` may benefit from `intros` or not. If not, we should avoid the `assert`+`intros` step and use `Grind.add`
|
||||
let mvarId ← goal.mvarId.assert (← mkFreshUserName `h) prop proof
|
||||
let goal := { goal with mvarId }
|
||||
intros goal generation
|
||||
|
||||
/-- Asserts next fact in the `goal` fact queue. -/
|
||||
def assertNext : GrindTactic := fun goal => do
|
||||
def assertNext? (goal : Goal) : GrindM (Option (List Goal)) := do
|
||||
let some (fact, newFacts) := goal.newFacts.dequeue?
|
||||
| return none
|
||||
assertAt fact.proof fact.prop fact.generation { goal with newFacts }
|
||||
assertAt { goal with newFacts } fact.proof fact.prop fact.generation
|
||||
|
||||
partial def iterate (goal : Goal) (f : Goal → GrindM (Option (List Goal))) : GrindM (List Goal) := do
|
||||
go [goal] []
|
||||
where
|
||||
go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
|
||||
match todo with
|
||||
| [] => return result
|
||||
| goal :: todo =>
|
||||
if let some goalsNew ← f goal then
|
||||
go (goalsNew ++ todo) result
|
||||
else
|
||||
go todo (goal :: result)
|
||||
|
||||
/-- Asserts all facts in the `goal` fact queue. -/
|
||||
partial def assertAll : GrindTactic :=
|
||||
assertNext.iterate
|
||||
partial def assertAll (goal : Goal) : GrindM (List Goal) := do
|
||||
iterate goal assertNext?
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Proof
|
||||
import Lean.Meta.Tactic.Grind.Arith.Inv
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -59,12 +58,9 @@ private def checkParents (e : Expr) : GoalM Unit := do
|
||||
found := true
|
||||
break
|
||||
-- Recall that we have support for `Expr.forallE` propagation. See `ForallProp.lean`.
|
||||
if let .forallE _ d b _ := parent then
|
||||
if let .forallE _ d _ _ := parent then
|
||||
if (← checkChild d) then
|
||||
found := true
|
||||
unless b.hasLooseBVars do
|
||||
if (← checkChild b) then
|
||||
found := true
|
||||
unless found do
|
||||
assert! (← checkChild parent.getAppFn)
|
||||
else
|
||||
@@ -89,9 +85,9 @@ private def checkProofs : GoalM Unit := do
|
||||
for b in eqc do
|
||||
unless isSameExpr a b do
|
||||
let p ← mkEqHEqProof a b
|
||||
trace_goal[grind.debug.proofs] "{a} = {b}"
|
||||
trace[grind.debug.proofs] "{a} = {b}"
|
||||
check p
|
||||
trace_goal[grind.debug.proofs] "checked: {← inferType p}"
|
||||
trace[grind.debug.proofs] "checked: {← inferType p}"
|
||||
|
||||
/--
|
||||
Checks basic invariants if `grind.debug` is enabled.
|
||||
@@ -104,7 +100,6 @@ def checkInvariants (expensive := false) : GoalM Unit := do
|
||||
checkEqc node
|
||||
if expensive then
|
||||
checkPtrEqImpliesStructEq
|
||||
Arith.checkInvariants
|
||||
if expensive && grind.debug.proofs.get (← getOptions) then
|
||||
checkProofs
|
||||
|
||||
|
||||
@@ -14,8 +14,6 @@ import Lean.Meta.Tactic.Grind.Util
|
||||
import Lean.Meta.Tactic.Grind.Inv
|
||||
import Lean.Meta.Tactic.Grind.Intro
|
||||
import Lean.Meta.Tactic.Grind.EMatch
|
||||
import Lean.Meta.Tactic.Grind.Split
|
||||
import Lean.Meta.Tactic.Grind.SimpUtil
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -24,13 +22,12 @@ def mkMethods (fallback : Fallback) : CoreM Methods := do
|
||||
return {
|
||||
fallback
|
||||
propagateUp := fun e => do
|
||||
propagateForallPropUp e
|
||||
propagateForallProp e
|
||||
let .const declName _ := e.getAppFn | return ()
|
||||
propagateProjEq e
|
||||
if let some prop := builtinPropagators.up[declName]? then
|
||||
prop e
|
||||
propagateDown := fun e => do
|
||||
propagateForallPropDown e
|
||||
let .const declName _ := e.getAppFn | return ()
|
||||
if let some prop := builtinPropagators.down[declName]? then
|
||||
prop e
|
||||
@@ -40,8 +37,12 @@ def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fa
|
||||
let scState := ShareCommon.State.mk _
|
||||
let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
|
||||
let (trueExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``True)
|
||||
let simprocs ← Grind.getSimprocs
|
||||
let simp ← Grind.getSimpContext
|
||||
let thms ← grindNormExt.getTheorems
|
||||
let simprocs := #[(← grindNormSimprocExt.getSimprocs)]
|
||||
let simp ← Simp.mkContext
|
||||
(config := { arith := true })
|
||||
(simpTheorems := #[thms])
|
||||
(congrTheorems := (← getSimpCongrTheorems))
|
||||
x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
|
||||
|
||||
private def mkGoal (mvarId : MVarId) : GrindM Goal := do
|
||||
@@ -60,7 +61,6 @@ private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
|
||||
let mvarId ← mvarId.revertAll
|
||||
let mvarId ← mvarId.unfoldReducible
|
||||
let mvarId ← mvarId.betaReduce
|
||||
appendTagSuffix mvarId `grind
|
||||
let goals ← intros (← mkGoal mvarId) (generation := 0)
|
||||
goals.forM (·.checkInvariants (expensive := true))
|
||||
return goals.filter fun goal => !goal.inconsistent
|
||||
@@ -70,10 +70,10 @@ def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goa
|
||||
|
||||
/-- A very simple strategy -/
|
||||
private def simple (goals : List Goal) : GrindM (List Goal) := do
|
||||
applyToAll (assertAll >> ematchStar >> (splitNext >> assertAll >> ematchStar).iterate) goals
|
||||
all goals ematchStar
|
||||
|
||||
def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List Goal) := do
|
||||
let go : GrindM (List Goal) := do
|
||||
def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List MVarId) := do
|
||||
let go : GrindM (List MVarId) := do
|
||||
let goals ← initCore mvarId
|
||||
let goals ← simple goals
|
||||
let goals ← goals.filterMapM fun goal => do
|
||||
@@ -83,7 +83,7 @@ def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallba
|
||||
if (← goal.mvarId.isAssigned) then return none
|
||||
return some goal
|
||||
trace[grind.debug.final] "{← ppGoals goals}"
|
||||
return goals
|
||||
return goals.map (·.mvarId)
|
||||
go.run mainDeclName config fallback
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -24,37 +24,30 @@ where
|
||||
let e' := mkApp2 (mkConst ``Lean.Grind.nestedProof) prop e
|
||||
modify fun s => s.insert e e'
|
||||
return e'
|
||||
-- Remark: we have to process `Expr.proj` since we only
|
||||
-- fold projections later during term internalization
|
||||
unless e.isApp || e.isForall || e.isProj do
|
||||
return e
|
||||
-- Check whether it is cached
|
||||
if let some r := (← get).find? e then
|
||||
return r
|
||||
let e' ← match e with
|
||||
| .app .. => e.withApp fun f args => do
|
||||
let mut modified := false
|
||||
let mut args := args
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
let arg' ← visit arg
|
||||
unless ptrEq arg arg' do
|
||||
args := args.set! i arg'
|
||||
modified := true
|
||||
if modified then
|
||||
pure <| mkAppN f args
|
||||
else
|
||||
pure e
|
||||
| .proj _ _ b =>
|
||||
pure <| e.updateProj! (← visit b)
|
||||
| .forallE _ d b _ =>
|
||||
-- Recall that we have `ForallProp.lean`.
|
||||
let d' ← visit d
|
||||
let b' ← if b.hasLooseBVars then pure b else visit b
|
||||
pure <| e.updateForallE! d' b'
|
||||
| _ => unreachable!
|
||||
modify fun s => s.insert e e'
|
||||
return e'
|
||||
else match e with
|
||||
| .bvar .. => unreachable!
|
||||
-- See comments on `Canon.lean` for why we do not visit these cases.
|
||||
| .letE .. | .forallE .. | .lam ..
|
||||
| .const .. | .lit .. | .mvar .. | .sort .. | .fvar .. => return e
|
||||
| .proj _ _ b => return e.updateProj! (← visit b)
|
||||
| .mdata _ b => return e.updateMData! (← visit b)
|
||||
-- We only visit applications
|
||||
| .app .. =>
|
||||
-- Check whether it is cached
|
||||
if let some r := (← get).find? e then
|
||||
return r
|
||||
e.withApp fun f args => do
|
||||
let mut modified := false
|
||||
let mut args := args
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
let arg' ← visit arg
|
||||
unless ptrEq arg arg' do
|
||||
args := args.set! i arg'
|
||||
modified := true
|
||||
let e' := if modified then mkAppN f args else e
|
||||
modify fun s => s.insert e e'
|
||||
return e'
|
||||
|
||||
/--
|
||||
Wrap nested proofs `e` with `Lean.Grind.nestedProof`-applications.
|
||||
|
||||
@@ -5,132 +5,62 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.PP
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Arith.Model
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
def Goal.ppENodeRef (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
let some n := goal.getENode? e | return "_"
|
||||
let type ← inferType e
|
||||
let u ← getLevel type
|
||||
let d := mkApp3 (mkConst ``Grind.node_def [u]) (toExpr n.idx) type e
|
||||
return m!"{d}"
|
||||
|
||||
@[inherit_doc Goal.ppENodeRef]
|
||||
def ppENodeRef (e : Expr) : GoalM MessageData := do
|
||||
(← get).ppENodeRef e
|
||||
def ppENodeRef (e : Expr) : GoalM Format := do
|
||||
let some n ← getENode? e | return "_"
|
||||
return f!"#{n.idx}"
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
private def Goal.ppENodeDeclValue (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
def ppENodeDeclValue (e : Expr) : GoalM Format := do
|
||||
if e.isApp && !(← isLitValue e) then
|
||||
e.withApp fun f args => do
|
||||
let r ← if f.isConst then
|
||||
pure m!"{f}"
|
||||
ppExpr f
|
||||
else
|
||||
goal.ppENodeRef f
|
||||
ppENodeRef f
|
||||
let mut r := r
|
||||
for arg in args do
|
||||
r := r ++ " " ++ (← goal.ppENodeRef arg)
|
||||
r := r ++ " " ++ (← ppENodeRef arg)
|
||||
return r
|
||||
else
|
||||
ppExpr e
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
private def Goal.ppENodeDecl (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
let mut r := m!"{← goal.ppENodeRef e} := {← goal.ppENodeDeclValue e}"
|
||||
let n ← goal.getENode e
|
||||
def ppENodeDecl (e : Expr) : GoalM Format := do
|
||||
let mut r := f!"{← ppENodeRef e} := {← ppENodeDeclValue e}"
|
||||
let n ← getENode e
|
||||
unless isSameExpr e n.root do
|
||||
r := r ++ m!" ↦ {← goal.ppENodeRef n.root}"
|
||||
r := r ++ f!" ↦ {← ppENodeRef n.root}"
|
||||
if n.interpreted then
|
||||
r := r ++ ", [val]"
|
||||
if n.ctor then
|
||||
r := r ++ ", [ctor]"
|
||||
if grind.debug.get (← getOptions) then
|
||||
if let some target := goal.getTarget? e then
|
||||
r := r ++ m!" ↝ {← goal.ppENodeRef target}"
|
||||
if let some target ← getTarget? e then
|
||||
r := r ++ f!" ↝ {← ppENodeRef target}"
|
||||
return r
|
||||
|
||||
/-- Pretty print goal state for debugging purposes. -/
|
||||
def Goal.ppState (goal : Goal) : MetaM MessageData := do
|
||||
let mut r := m!"Goal:"
|
||||
let nodes := goal.getENodes
|
||||
def ppState : GoalM Format := do
|
||||
let mut r := f!"Goal:"
|
||||
let nodes ← getENodes
|
||||
for node in nodes do
|
||||
r := r ++ "\n" ++ (← goal.ppENodeDecl node.self)
|
||||
let eqcs := goal.getEqcs
|
||||
r := r ++ "\n" ++ (← ppENodeDecl node.self)
|
||||
let eqcs ← getEqcs
|
||||
for eqc in eqcs do
|
||||
if eqc.length > 1 then
|
||||
r := r ++ "\n" ++ "{" ++ (MessageData.joinSep (← eqc.mapM goal.ppENodeRef) ", ") ++ "}"
|
||||
r := r ++ "\n" ++ "{" ++ (Format.joinSep (← eqc.mapM ppENodeRef) ", ") ++ "}"
|
||||
return r
|
||||
|
||||
def ppGoals (goals : List Goal) : MetaM MessageData := do
|
||||
let mut r := m!""
|
||||
def ppGoals (goals : List Goal) : GrindM Format := do
|
||||
let mut r := f!""
|
||||
for goal in goals do
|
||||
let m ← goal.ppState
|
||||
r := r ++ Format.line ++ m
|
||||
let (f, _) ← GoalM.run goal ppState
|
||||
r := r ++ Format.line ++ f
|
||||
return r
|
||||
|
||||
private def ppExprArray (cls : Name) (header : String) (es : Array Expr) (clsElem : Name := Name.mkSimple "_") : MessageData :=
|
||||
let es := es.map fun e => .trace { cls := clsElem} m!"{e}" #[]
|
||||
.trace { cls } header es
|
||||
|
||||
private def ppEqcs (goal : Goal) : MetaM (Array MessageData) := do
|
||||
let mut trueEqc? : Option MessageData := none
|
||||
let mut falseEqc? : Option MessageData := none
|
||||
let mut otherEqcs : Array MessageData := #[]
|
||||
for eqc in goal.getEqcs do
|
||||
if Option.isSome <| eqc.find? (·.isTrue) then
|
||||
let eqc := eqc.filter fun e => !e.isTrue
|
||||
unless eqc.isEmpty do
|
||||
trueEqc? := ppExprArray `eqc "True propositions" eqc.toArray `prop
|
||||
else if Option.isSome <| eqc.find? (·.isFalse) then
|
||||
let eqc := eqc.filter fun e => !e.isFalse
|
||||
unless eqc.isEmpty do
|
||||
falseEqc? := ppExprArray `eqc "False propositions" eqc.toArray `prop
|
||||
else if let e :: _ :: _ := eqc then
|
||||
-- We may want to add a flag to pretty print equivalence classes of nested proofs
|
||||
unless (← isProof e) do
|
||||
otherEqcs := otherEqcs.push <| .trace { cls := `eqc } (.group ("{" ++ (MessageData.joinSep (eqc.map toMessageData) ("," ++ Format.line)) ++ "}")) #[]
|
||||
let mut result := #[]
|
||||
if let some trueEqc := trueEqc? then result := result.push trueEqc
|
||||
if let some falseEqc := falseEqc? then result := result.push falseEqc
|
||||
unless otherEqcs.isEmpty do
|
||||
result := result.push <| .trace { cls := `eqc } "Equivalence classes" otherEqcs
|
||||
return result
|
||||
|
||||
private def ppEMatchTheorem (thm : EMatchTheorem) : MetaM MessageData := do
|
||||
let m := m!"{← thm.origin.pp}\n{← inferType thm.proof}\npatterns: {thm.patterns.map ppPattern}"
|
||||
return .trace { cls := `thm } m #[]
|
||||
|
||||
private def ppActiveTheorems (goal : Goal) : MetaM MessageData := do
|
||||
let m ← goal.thms.toArray.mapM ppEMatchTheorem
|
||||
let m := m ++ (← goal.newThms.toArray.mapM ppEMatchTheorem)
|
||||
if m.isEmpty then
|
||||
return ""
|
||||
else
|
||||
return .trace { cls := `ematch } "E-matching" m
|
||||
|
||||
def ppOffset (goal : Goal) : MetaM MessageData := do
|
||||
let s := goal.arith.offset
|
||||
let nodes := s.nodes
|
||||
if nodes.isEmpty then return ""
|
||||
let model ← Arith.Offset.mkModel goal
|
||||
let mut ms := #[]
|
||||
for (e, val) in model do
|
||||
ms := ms.push <| .trace { cls := `assign } m!"{e} := {val}" #[]
|
||||
return .trace { cls := `offset } "Assignment satisfying offset contraints" ms
|
||||
|
||||
def goalToMessageData (goal : Goal) : MetaM MessageData := goal.mvarId.withContext do
|
||||
let mut m : Array MessageData := #[.ofGoal goal.mvarId]
|
||||
m := m.push <| ppExprArray `facts "Asserted facts" goal.facts.toArray `prop
|
||||
m := m ++ (← ppEqcs goal)
|
||||
m := m.push (← ppActiveTheorems goal)
|
||||
m := m.push (← ppOffset goal)
|
||||
addMessageContextFull <| MessageData.joinSep m.toList ""
|
||||
|
||||
def goalsToMessageData (goals : List Goal) : MetaM MessageData :=
|
||||
return MessageData.joinSep (← goals.mapM goalToMessageData) m!"\n"
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -30,7 +30,7 @@ def propagateProjEq (parent : Expr) : GoalM Unit := do
|
||||
let parentNew ← shareCommon (mkApp parent.appFn! ctor)
|
||||
internalize parentNew (← getGeneration parent)
|
||||
pure parentNew
|
||||
trace_goal[grind.debug.proj] "{parentNew}"
|
||||
trace[grind.debug.proj] "{parentNew}"
|
||||
let idx := info.numParams + info.i
|
||||
unless idx < ctor.getAppNumArgs do return ()
|
||||
let v := ctor.getArg! idx
|
||||
|
||||
@@ -7,8 +7,6 @@ prelude
|
||||
import Init.Grind
|
||||
import Lean.Meta.Tactic.Grind.Proof
|
||||
import Lean.Meta.Tactic.Grind.PropagatorAttr
|
||||
import Lean.Meta.Tactic.Grind.Simp
|
||||
import Lean.Meta.Tactic.Grind.Internalize
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -99,8 +97,6 @@ builtin_grind_propagator propagateNotUp ↑Not := fun e => do
|
||||
else if (← isEqTrue a) then
|
||||
-- a = True → (Not a) = False
|
||||
pushEqFalse e <| mkApp2 (mkConst ``Lean.Grind.not_eq_of_eq_true) a (← mkEqTrueProof a)
|
||||
else if (← isEqv e a) then
|
||||
closeGoal <| mkApp2 (mkConst ``Lean.Grind.false_of_not_eq_self) a (← mkEqProof e a)
|
||||
|
||||
/--
|
||||
Propagates truth values downwards for a negation expression `Not a` based on the truth value of `Not a`.
|
||||
@@ -126,59 +122,24 @@ builtin_grind_propagator propagateEqUp ↑Eq := fun e => do
|
||||
else if (← isEqTrue b) then
|
||||
pushEq e a <| mkApp3 (mkConst ``Lean.Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
|
||||
else if (← isEqv a b) then
|
||||
pushEqTrue e <| mkEqTrueCore e (← mkEqProof a b)
|
||||
pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkEqProof a b)
|
||||
|
||||
/-- Propagates `Eq` downwards -/
|
||||
builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr Eq _ a b := e | return ()
|
||||
pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `EqMatch` downwards -/
|
||||
builtin_grind_propagator propagateEqMatchDown ↓Grind.EqMatch := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr Grind.EqMatch _ a b origin := e | return ()
|
||||
markCaseSplitAsResolved origin
|
||||
pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `HEq` downwards -/
|
||||
builtin_grind_propagator propagateHEqDown ↓HEq := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr HEq _ a _ b := e | return ()
|
||||
pushHEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
pushHEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `HEq` upwards -/
|
||||
builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
|
||||
let_expr HEq _ a _ b := e | return ()
|
||||
if (← isEqv a b) then
|
||||
pushEqTrue e <| mkEqTrueCore e (← mkHEqProof a b)
|
||||
|
||||
/-- Propagates `ite` upwards -/
|
||||
builtin_grind_propagator propagateIte ↑ite := fun e => do
|
||||
let_expr f@ite α c h a b := e | return ()
|
||||
if (← isEqTrue c) then
|
||||
pushEq e a <| mkApp6 (mkConst ``ite_cond_eq_true f.constLevels!) α c h a b (← mkEqTrueProof c)
|
||||
else if (← isEqFalse c) then
|
||||
pushEq e b <| mkApp6 (mkConst ``ite_cond_eq_false f.constLevels!) α c h a b (← mkEqFalseProof c)
|
||||
|
||||
/-- Propagates `dite` upwards -/
|
||||
builtin_grind_propagator propagateDIte ↑dite := fun e => do
|
||||
let_expr f@dite α c h a b := e | return ()
|
||||
if (← isEqTrue c) then
|
||||
let h₁ ← mkEqTrueProof c
|
||||
let ah₁ := mkApp a (mkOfEqTrueCore c h₁)
|
||||
let p ← simp ah₁
|
||||
let r := p.expr
|
||||
let h₂ ← p.getProof
|
||||
internalize r (← getGeneration e)
|
||||
pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_true' f.constLevels!) α c h a b r h₁ h₂
|
||||
else if (← isEqFalse c) then
|
||||
let h₁ ← mkEqFalseProof c
|
||||
let bh₁ := mkApp b (mkApp2 (mkConst ``of_eq_false) c h₁)
|
||||
let p ← simp bh₁
|
||||
let r := p.expr
|
||||
let h₂ ← p.getProof
|
||||
internalize r (← getGeneration e)
|
||||
pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) α c h a b r h₁ h₂
|
||||
pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkHEqProof a b)
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -9,7 +9,6 @@ import Lean.Meta.Tactic.Assert
|
||||
import Lean.Meta.Tactic.Simp.Main
|
||||
import Lean.Meta.Tactic.Grind.Util
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.DoNotSimp
|
||||
import Lean.Meta.Tactic.Grind.MarkNestedProofs
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
@@ -34,7 +33,6 @@ def simp (e : Expr) : GrindM Simp.Result := do
|
||||
let e' ← eraseIrrelevantMData e'
|
||||
let e' ← foldProjs e'
|
||||
let e' ← normalizeLevels e'
|
||||
let e' ← eraseDoNotSimp e'
|
||||
let e' ← canon e'
|
||||
let e' ← shareCommon e'
|
||||
trace[grind.simp] "{e}\n===>\n{e'}"
|
||||
|
||||
@@ -1,32 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Simp.Simproc
|
||||
import Lean.Meta.Tactic.Grind.Simp
|
||||
import Lean.Meta.Tactic.Grind.DoNotSimp
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
/-- Returns the array of simprocs used by `grind`. -/
|
||||
protected def getSimprocs : MetaM (Array Simprocs) := do
|
||||
let s ← grindNormSimprocExt.getSimprocs
|
||||
let s ← addDoNotSimp s
|
||||
return #[s, (← Simp.getSEvalSimprocs)]
|
||||
|
||||
/-- Returns the simplification context used by `grind`. -/
|
||||
protected def getSimpContext : MetaM Simp.Context := do
|
||||
let thms ← grindNormExt.getTheorems
|
||||
Simp.mkContext
|
||||
(config := { arith := true })
|
||||
(simpTheorems := #[thms])
|
||||
(congrTheorems := (← getSimpCongrTheorems))
|
||||
|
||||
@[export lean_grind_normalize]
|
||||
def normalizeImp (e : Expr) : MetaM Expr := do
|
||||
let (r, _) ← Meta.simp e (← Grind.getSimpContext) (← Grind.getSimprocs)
|
||||
return r.expr
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -1,178 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Intro
|
||||
import Lean.Meta.Tactic.Grind.Cases
|
||||
import Lean.Meta.Tactic.Grind.CasesMatch
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
inductive CaseSplitStatus where
|
||||
| resolved
|
||||
| notReady
|
||||
| ready (numCases : Nat) (isRec := false)
|
||||
deriving Inhabited, BEq
|
||||
|
||||
/-- Given `c`, the condition of an `if-then-else`, check whether we need to case-split on the `if-then-else` or not -/
|
||||
private def checkIteCondStatus (c : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue c <||> isEqFalse c) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
|
||||
/--
|
||||
Given `e` of the form `a ∨ b`, check whether we are ready to case-split on `e`.
|
||||
That is, `e` is `True`, but neither `a` nor `b` is `True`."
|
||||
-/
|
||||
private def checkDisjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
if (← isEqTrue a <||> isEqTrue b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else if (← isEqFalse e) then
|
||||
return .resolved
|
||||
else
|
||||
return .notReady
|
||||
|
||||
/--
|
||||
Given `e` of the form `a ∧ b`, check whether we are ready to case-split on `e`.
|
||||
That is, `e` is `False`, but neither `a` nor `b` is `False`.
|
||||
-/
|
||||
private def checkConjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
return .resolved
|
||||
else if (← isEqFalse e) then
|
||||
if (← isEqFalse a <||> isEqFalse b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else
|
||||
return .notReady
|
||||
|
||||
/--
|
||||
Given `e` of the form `@Eq Prop a b`, check whether we are ready to case-split on `e`.
|
||||
There are two cases:
|
||||
1- `e` is `True`, but neither both `a` and `b` are `True`, nor both `a` and `b` are `False`.
|
||||
2- `e` is `False`, but neither `a` is `True` and `b` is `False`, nor `a` is `False` and `b` is `True`.
|
||||
-/
|
||||
private def checkIffStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
if (← (isEqTrue a <&&> isEqTrue b) <||> (isEqFalse a <&&> isEqFalse b)) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else if (← isEqFalse e) then
|
||||
if (← (isEqTrue a <&&> isEqFalse b) <||> (isEqFalse a <&&> isEqTrue b)) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else
|
||||
return .notReady
|
||||
|
||||
private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
|
||||
match_expr e with
|
||||
| Or a b => checkDisjunctStatus e a b
|
||||
| And a b => checkConjunctStatus e a b
|
||||
| Eq _ a b => checkIffStatus e a b
|
||||
| ite _ c _ _ _ => checkIteCondStatus c
|
||||
| dite _ c _ _ _ => checkIteCondStatus c
|
||||
| _ =>
|
||||
if (← isResolvedCaseSplit e) then
|
||||
trace[grind.debug.split] "split resolved: {e}"
|
||||
return .resolved
|
||||
if let some info := isMatcherAppCore? (← getEnv) e then
|
||||
return .ready info.numAlts
|
||||
let .const declName .. := e.getAppFn | unreachable!
|
||||
if let some info ← isInductivePredicate? declName then
|
||||
if (← isEqTrue e) then
|
||||
return .ready info.ctors.length info.isRec
|
||||
return .notReady
|
||||
|
||||
private inductive SplitCandidate where
|
||||
| none
|
||||
| some (c : Expr) (numCases : Nat) (isRec : Bool)
|
||||
|
||||
/-- Returns the next case-split to be performed. It uses a very simple heuristic. -/
|
||||
private def selectNextSplit? : GoalM SplitCandidate := do
|
||||
if (← isInconsistent) then return .none
|
||||
if (← checkMaxCaseSplit) then return .none
|
||||
go (← get).splitCandidates .none []
|
||||
where
|
||||
go (cs : List Expr) (c? : SplitCandidate) (cs' : List Expr) : GoalM SplitCandidate := do
|
||||
match cs with
|
||||
| [] =>
|
||||
modify fun s => { s with splitCandidates := cs'.reverse }
|
||||
if let .some _ numCases isRec := c? then
|
||||
let numSplits := (← get).numSplits
|
||||
-- We only increase the number of splits if there is more than one case or it is recursive.
|
||||
let numSplits := if numCases > 1 || isRec then numSplits + 1 else numSplits
|
||||
-- Remark: we reset `numEmatch` after each case split.
|
||||
-- We should consider other strategies in the future.
|
||||
modify fun s => { s with numSplits, numEmatch := 0 }
|
||||
return c?
|
||||
| c::cs =>
|
||||
match (← checkCaseSplitStatus c) with
|
||||
| .notReady => go cs c? (c::cs')
|
||||
| .resolved => go cs c? cs'
|
||||
| .ready numCases isRec =>
|
||||
match c? with
|
||||
| .none => go cs (.some c numCases isRec) cs'
|
||||
| .some c' numCases' _ =>
|
||||
let isBetter : GoalM Bool := do
|
||||
if numCases == 1 && !isRec && numCases' > 1 then
|
||||
return true
|
||||
if (← getGeneration c) < (← getGeneration c') then
|
||||
return true
|
||||
return numCases < numCases'
|
||||
if (← isBetter) then
|
||||
go cs (.some c numCases isRec) (c'::cs')
|
||||
else
|
||||
go cs c? (c::cs')
|
||||
|
||||
/-- Constructs a major premise for the `cases` tactic used by `grind`. -/
|
||||
private def mkCasesMajor (c : Expr) : GoalM Expr := do
|
||||
match_expr c with
|
||||
| And a b => return mkApp3 (mkConst ``Grind.or_of_and_eq_false) a b (← mkEqFalseProof c)
|
||||
| ite _ c _ _ _ => return mkEM c
|
||||
| dite _ c _ _ _ => return mkEM c
|
||||
| Eq _ a b =>
|
||||
if (← isEqTrue c) then
|
||||
return mkApp3 (mkConst ``Grind.of_eq_eq_true) a b (← mkEqTrueProof c)
|
||||
else
|
||||
return mkApp3 (mkConst ``Grind.of_eq_eq_false) a b (← mkEqFalseProof c)
|
||||
| _ => return mkOfEqTrueCore c (← mkEqTrueProof c)
|
||||
|
||||
/-- Introduces new hypotheses in each goal. -/
|
||||
private def introNewHyp (goals : List Goal) (acc : List Goal) (generation : Nat) : GrindM (List Goal) := do
|
||||
match goals with
|
||||
| [] => return acc.reverse
|
||||
| goal::goals => introNewHyp goals ((← intros generation goal) ++ acc) generation
|
||||
|
||||
/--
|
||||
Selects a case-split from the list of candidates,
|
||||
and returns a new list of goals if successful.
|
||||
-/
|
||||
def splitNext : GrindTactic := fun goal => do
|
||||
let (goals?, _) ← GoalM.run goal do
|
||||
let .some c numCases isRec ← selectNextSplit?
|
||||
| return none
|
||||
let gen ← getGeneration c
|
||||
let genNew := if numCases > 1 || isRec then gen+1 else gen
|
||||
trace_goal[grind.split] "{c}, generation: {gen}"
|
||||
let mvarIds ← if (← isMatcherApp c) then
|
||||
casesMatch (← get).mvarId c
|
||||
else
|
||||
let major ← mkCasesMajor c
|
||||
cases (← get).mvarId major
|
||||
let goal ← get
|
||||
let goals := mvarIds.map fun mvarId => { goal with mvarId }
|
||||
let goals ← introNewHyp goals [] genNew
|
||||
return some goals
|
||||
return goals?
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -13,20 +13,23 @@ import Lean.Meta.CongrTheorems
|
||||
import Lean.Meta.AbstractNestedProofs
|
||||
import Lean.Meta.Tactic.Simp.Types
|
||||
import Lean.Meta.Tactic.Util
|
||||
import Lean.Meta.Tactic.Grind.ENodeKey
|
||||
import Lean.Meta.Tactic.Grind.Canon
|
||||
import Lean.Meta.Tactic.Grind.Attr
|
||||
import Lean.Meta.Tactic.Grind.Arith.Types
|
||||
import Lean.Meta.Tactic.Grind.EMatchTheorem
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@[inline] def isSameExpr (a b : Expr) : Bool :=
|
||||
-- It is safe to use pointer equality because we hashcons all expressions
|
||||
-- inserted into the E-graph
|
||||
unsafe ptrEq a b
|
||||
|
||||
/-- We use this auxiliary constant to mark delayed congruence proofs. -/
|
||||
def congrPlaceholderProof := mkConst (Name.mkSimple "[congruence]")
|
||||
|
||||
/--
|
||||
Returns `true` if `e` is `True`, `False`, or a literal value.
|
||||
See `Lean.Meta.LitValues` for supported literals.
|
||||
See `LitValues` for supported literals.
|
||||
-/
|
||||
def isInterpreted (e : Expr) : MetaM Bool := do
|
||||
if e.isTrue || e.isFalse then return true
|
||||
@@ -56,16 +59,16 @@ structure CongrTheoremCacheKey where
|
||||
f : Expr
|
||||
numArgs : Nat
|
||||
|
||||
-- We manually define `BEq` because we want to use pointer equality.
|
||||
-- We manually define `BEq` because we wannt to use pointer equality.
|
||||
instance : BEq CongrTheoremCacheKey where
|
||||
beq a b := isSameExpr a.f b.f && a.numArgs == b.numArgs
|
||||
|
||||
-- We manually define `Hashable` because we want to use pointer equality.
|
||||
-- We manually define `Hashable` because we wannt to use pointer equality.
|
||||
instance : Hashable CongrTheoremCacheKey where
|
||||
hash a := mixHash (unsafe ptrAddrUnsafe a.f).toUInt64 (hash a.numArgs)
|
||||
|
||||
/-- State for the `GrindM` monad. -/
|
||||
structure State where
|
||||
structure CoreState where
|
||||
canon : Canon.State := {}
|
||||
/-- `ShareCommon` (aka `Hashconsing`) state. -/
|
||||
scState : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
|
||||
@@ -80,17 +83,12 @@ structure State where
|
||||
simpStats : Simp.Stats := {}
|
||||
trueExpr : Expr
|
||||
falseExpr : Expr
|
||||
/--
|
||||
Used to generate trace messages of the for `[grind] working on <tag>`,
|
||||
and implement the macro `trace_goal`.
|
||||
-/
|
||||
lastTag : Name := .anonymous
|
||||
|
||||
private opaque MethodsRefPointed : NonemptyType.{0}
|
||||
private def MethodsRef : Type := MethodsRefPointed.type
|
||||
instance : Nonempty MethodsRef := MethodsRefPointed.property
|
||||
|
||||
abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT State MetaM
|
||||
abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT CoreState MetaM
|
||||
|
||||
/-- Returns the user-defined configuration options -/
|
||||
def getConfig : GrindM Grind.Config :=
|
||||
@@ -125,12 +123,12 @@ def abstractNestedProofs (e : Expr) : GrindM Expr := do
|
||||
|
||||
/--
|
||||
Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
|
||||
been hash-consed. We perform this step before we internalize expressions.
|
||||
been hash-consing. We perform this step before we internalize expressions.
|
||||
-/
|
||||
def shareCommon (e : Expr) : GrindM Expr := do
|
||||
modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
|
||||
modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats } =>
|
||||
let (e, scState) := ShareCommon.State.shareCommon scState e
|
||||
(e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag })
|
||||
(e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats })
|
||||
|
||||
/--
|
||||
Canonicalizes nested types, type formers, and instances in `e`.
|
||||
@@ -195,7 +193,7 @@ structure ENode where
|
||||
interpreted : Bool := false
|
||||
/-- `ctor := true` if the head symbol is a constructor application. -/
|
||||
ctor : Bool := false
|
||||
/-- `hasLambdas := true` if the equivalence class contains lambda expressions. -/
|
||||
/-- `hasLambdas := true` if equivalence class contains lambda expressions. -/
|
||||
hasLambdas : Bool := false
|
||||
/--
|
||||
If `heqProofs := true`, then some proofs in the equivalence class are based
|
||||
@@ -209,6 +207,7 @@ structure ENode where
|
||||
generation : Nat := 0
|
||||
/-- Modification time -/
|
||||
mt : Nat := 0
|
||||
-- TODO: see Lean 3 implementation
|
||||
deriving Inhabited, Repr
|
||||
|
||||
def ENode.isCongrRoot (n : ENode) :=
|
||||
@@ -221,6 +220,20 @@ structure NewEq where
|
||||
proof : Expr
|
||||
isHEq : Bool
|
||||
|
||||
/--
|
||||
Key for the `ENodeMap` and `ParentMap` map.
|
||||
We use pointer addresses and rely on the fact all internalized expressions
|
||||
have been hash-consed, i.e., we have applied `shareCommon`.
|
||||
-/
|
||||
private structure ENodeKey where
|
||||
expr : Expr
|
||||
|
||||
instance : Hashable ENodeKey where
|
||||
hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
|
||||
|
||||
instance : BEq ENodeKey where
|
||||
beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
|
||||
|
||||
abbrev ENodeMap := PHashMap ENodeKey ENode
|
||||
|
||||
/--
|
||||
@@ -351,8 +364,6 @@ structure Goal where
|
||||
gmt : Nat := 0
|
||||
/-- Next unique index for creating ENodes -/
|
||||
nextIdx : Nat := 0
|
||||
/-- State of arithmetic procedures -/
|
||||
arith : Arith.State := {}
|
||||
/-- Active theorems that we have performed ematching at least once. -/
|
||||
thms : PArray EMatchTheorem := {}
|
||||
/-- Active theorems that we have not performed any round of ematching yet. -/
|
||||
@@ -364,24 +375,10 @@ structure Goal where
|
||||
thmMap : EMatchTheorems
|
||||
/-- Number of theorem instances generated so far -/
|
||||
numInstances : Nat := 0
|
||||
/-- Number of E-matching rounds performed in this goal since the last case-split. -/
|
||||
numEmatch : Nat := 0
|
||||
/-- (pre-)instances found so far. It includes instances that failed to be instantiated. -/
|
||||
preInstances : PreInstanceSet := {}
|
||||
/-- new facts to be processed. -/
|
||||
newFacts : Std.Queue NewFact := ∅
|
||||
/-- `match` auxiliary functions whose equations have already been created and activated. -/
|
||||
matchEqNames : PHashSet Name := {}
|
||||
/-- Case-split candidates. -/
|
||||
splitCandidates : List Expr := []
|
||||
/-- Number of splits performed to get to this goal. -/
|
||||
numSplits : Nat := 0
|
||||
/-- Case-splits that do not have to be performed anymore. -/
|
||||
resolvedSplits : PHashSet ENodeKey := {}
|
||||
/-- Next local E-match theorem idx. -/
|
||||
nextThmIdx : Nat := 0
|
||||
/-- Asserted facts -/
|
||||
facts : PArray Expr := {}
|
||||
deriving Inhabited
|
||||
|
||||
def Goal.admit (goal : Goal) : MetaM Unit :=
|
||||
@@ -395,25 +392,6 @@ abbrev GoalM := StateRefT Goal GrindM
|
||||
@[inline] def GoalM.run' (goal : Goal) (x : GoalM Unit) : GrindM Goal :=
|
||||
goal.mvarId.withContext do StateRefT'.run' (x *> get) goal
|
||||
|
||||
def updateLastTag : GoalM Unit := do
|
||||
if (← isTracingEnabledFor `grind) then
|
||||
let currTag ← (← get).mvarId.getTag
|
||||
if currTag != (← getThe Grind.State).lastTag then
|
||||
trace[grind] "working on goal `{currTag}`"
|
||||
modifyThe Grind.State fun s => { s with lastTag := currTag }
|
||||
|
||||
/--
|
||||
Macro similar to `trace[...]`, but it includes the trace message `trace[grind] "working on <current goal>"`
|
||||
if the tag has changed since the last trace message.
|
||||
-/
|
||||
macro "trace_goal[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
|
||||
let msg ← if s.raw.getKind == interpolatedStrKind then `(m! $(⟨s⟩)) else `(($(⟨s⟩) : MessageData))
|
||||
`(doElem| do
|
||||
let cls := $(quote id.getId.eraseMacroScopes)
|
||||
if (← Lean.isTracingEnabledFor cls) then
|
||||
updateLastTag
|
||||
Lean.addTrace cls $msg)
|
||||
|
||||
/--
|
||||
A helper function used to mark a theorem instance found by the E-matching module.
|
||||
It returns `true` if it is a new instance and `false` otherwise.
|
||||
@@ -438,37 +416,18 @@ def addTheoremInstance (proof : Expr) (prop : Expr) (generation : Nat) : GoalM U
|
||||
def checkMaxInstancesExceeded : GoalM Bool := do
|
||||
return (← get).numInstances >= (← getConfig).instances
|
||||
|
||||
/-- Returns `true` if the maximum number of case-splits has been reached. -/
|
||||
def checkMaxCaseSplit : GoalM Bool := do
|
||||
return (← get).numSplits >= (← getConfig).splits
|
||||
|
||||
/-- Returns `true` if the maximum number of E-matching rounds has been reached. -/
|
||||
def checkMaxEmatchExceeded : GoalM Bool := do
|
||||
return (← get).numEmatch >= (← getConfig).ematch
|
||||
|
||||
/--
|
||||
Returns `some n` if `e` has already been "internalized" into the
|
||||
Otherwise, returns `none`s.
|
||||
-/
|
||||
def Goal.getENode? (goal : Goal) (e : Expr) : Option ENode :=
|
||||
goal.enodes.find? { expr := e }
|
||||
|
||||
@[inline, inherit_doc Goal.getENode?]
|
||||
def getENode? (e : Expr) : GoalM (Option ENode) :=
|
||||
return (← get).getENode? e
|
||||
|
||||
def throwNonInternalizedExpr (e : Expr) : CoreM α :=
|
||||
throwError "internal `grind` error, term has not been internalized{indentExpr e}"
|
||||
return (← get).enodes.find? { expr := e }
|
||||
|
||||
/-- Returns node associated with `e`. It assumes `e` has already been internalized. -/
|
||||
def Goal.getENode (goal : Goal) (e : Expr) : CoreM ENode := do
|
||||
let some n := goal.enodes.find? { expr := e }
|
||||
| throwNonInternalizedExpr e
|
||||
return n
|
||||
|
||||
@[inline, inherit_doc Goal.getENode]
|
||||
def getENode (e : Expr) : GoalM ENode := do
|
||||
(← get).getENode e
|
||||
let some n := (← get).enodes.find? { expr := e }
|
||||
| throwError "internal `grind` error, term has not been internalized{indentExpr e}"
|
||||
return n
|
||||
|
||||
/-- Returns the generation of the given term. Is assumes it has been internalized -/
|
||||
def getGeneration (e : Expr) : GoalM Nat :=
|
||||
@@ -499,53 +458,30 @@ def isRoot (e : Expr) : GoalM Bool := do
|
||||
return isSameExpr n.root e
|
||||
|
||||
/-- Returns the root element in the equivalence class of `e` IF `e` has been internalized. -/
|
||||
def Goal.getRoot? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
def getRoot? (e : Expr) : GoalM (Option Expr) := do
|
||||
let some n ← getENode? e | return none
|
||||
return some n.root
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot?]
|
||||
def getRoot? (e : Expr) : GoalM (Option Expr) := do
|
||||
return (← get).getRoot? e
|
||||
|
||||
/-- Returns the root element in the equivalence class of `e`. -/
|
||||
def Goal.getRoot (goal : Goal) (e : Expr) : CoreM Expr :=
|
||||
return (← goal.getENode e).root
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot]
|
||||
def getRoot (e : Expr) : GoalM Expr := do
|
||||
(← get).getRoot e
|
||||
def getRoot (e : Expr) : GoalM Expr :=
|
||||
return (← getENode e).root
|
||||
|
||||
/-- Returns the root enode in the equivalence class of `e`. -/
|
||||
def getRootENode (e : Expr) : GoalM ENode := do
|
||||
getENode (← getRoot e)
|
||||
|
||||
/--
|
||||
Returns the next element in the equivalence class of `e`
|
||||
if `e` has been internalized in the given goal.
|
||||
-/
|
||||
def Goal.getNext? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
return some n.next
|
||||
|
||||
/-- Returns the next element in the equivalence class of `e`. -/
|
||||
def Goal.getNext (goal : Goal) (e : Expr) : CoreM Expr :=
|
||||
return (← goal.getENode e).next
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot]
|
||||
def getNext (e : Expr) : GoalM Expr := do
|
||||
(← get).getNext e
|
||||
def getNext (e : Expr) : GoalM Expr :=
|
||||
return (← getENode e).next
|
||||
|
||||
/-- Returns `true` if `e` has already been internalized. -/
|
||||
def alreadyInternalized (e : Expr) : GoalM Bool :=
|
||||
return (← get).enodes.contains { expr := e }
|
||||
|
||||
def Goal.getTarget? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
def getTarget? (e : Expr) : GoalM (Option Expr) := do
|
||||
let some n ← getENode? e | return none
|
||||
return n.target?
|
||||
|
||||
@[inline] def getTarget? (e : Expr) : GoalM (Option Expr) := do
|
||||
return (← get).getTarget? e
|
||||
|
||||
/--
|
||||
If `isHEq` is `false`, it pushes `lhs = rhs` with `proof` to `newEqs`.
|
||||
Otherwise, it pushes `HEq lhs rhs`.
|
||||
@@ -699,9 +635,7 @@ def mkEqFalseProof (a : Expr) : GoalM Expr := do
|
||||
|
||||
/-- Marks current goal as inconsistent without assigning `mvarId`. -/
|
||||
def markAsInconsistent : GoalM Unit := do
|
||||
unless (← get).inconsistent do
|
||||
trace[grind] "closed `{← (← get).mvarId.getTag}`"
|
||||
modify fun s => { s with inconsistent := true }
|
||||
modify fun s => { s with inconsistent := true }
|
||||
|
||||
/--
|
||||
Closes the current goal using the given proof of `False` and
|
||||
@@ -717,23 +651,11 @@ def closeGoal (falseProof : Expr) : GoalM Unit := do
|
||||
else
|
||||
mvarId.assign (← mkFalseElim target falseProof)
|
||||
|
||||
def Goal.getENodes (goal : Goal) : Array ENode :=
|
||||
-- We must sort because we are using pointer addresses as keys in `enodes`
|
||||
let nodes := goal.enodes.toArray.map (·.2)
|
||||
nodes.qsort fun a b => a.idx < b.idx
|
||||
|
||||
/-- Returns all enodes in the goal -/
|
||||
def getENodes : GoalM (Array ENode) := do
|
||||
return (← get).getENodes
|
||||
|
||||
/-- Executes `f` to each term in the equivalence class containing `e` -/
|
||||
@[inline] def traverseEqc (e : Expr) (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let mut curr := e
|
||||
repeat
|
||||
let n ← getENode curr
|
||||
f n
|
||||
if isSameExpr n.next e then return ()
|
||||
curr := n.next
|
||||
-- We must sort because we are using pointer addresses as keys in `enodes`
|
||||
let nodes := (← get).enodes.toArray.map (·.2)
|
||||
return nodes.qsort fun a b => a.idx < b.idx
|
||||
|
||||
def forEachENode (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let nodes ← getENodes
|
||||
@@ -747,7 +669,7 @@ def filterENodes (p : ENode → GoalM Bool) : GoalM (Array ENode) := do
|
||||
ref.modify (·.push n)
|
||||
ref.get
|
||||
|
||||
def forEachEqcRoot (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
def forEachEqc (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let nodes ← getENodes
|
||||
for n in nodes do
|
||||
if isSameExpr n.self n.root then
|
||||
@@ -782,45 +704,24 @@ def applyFallback : GoalM Unit := do
|
||||
fallback
|
||||
|
||||
/-- Returns expressions in the given expression equivalence class. -/
|
||||
partial def Goal.getEqc (goal : Goal) (e : Expr) : List Expr :=
|
||||
partial def getEqc (e : Expr) : GoalM (List Expr) :=
|
||||
go e e []
|
||||
where
|
||||
go (first : Expr) (e : Expr) (acc : List Expr) : List Expr := Id.run do
|
||||
let some next ← goal.getNext? e | acc
|
||||
go (first : Expr) (e : Expr) (acc : List Expr) : GoalM (List Expr) := do
|
||||
let next ← getNext e
|
||||
let acc := e :: acc
|
||||
if isSameExpr first next then
|
||||
return acc
|
||||
else
|
||||
go first next acc
|
||||
|
||||
@[inline, inherit_doc Goal.getEqc]
|
||||
partial def getEqc (e : Expr) : GoalM (List Expr) :=
|
||||
return (← get).getEqc e
|
||||
|
||||
/-- Returns all equivalence classes in the current goal. -/
|
||||
partial def Goal.getEqcs (goal : Goal) : List (List Expr) := Id.run do
|
||||
let mut r : List (List Expr) := []
|
||||
let nodes ← goal.getENodes
|
||||
partial def getEqcs : GoalM (List (List Expr)) := do
|
||||
let mut r := []
|
||||
let nodes ← getENodes
|
||||
for node in nodes do
|
||||
if isSameExpr node.root node.self then
|
||||
r := goal.getEqc node.self :: r
|
||||
r := (← getEqc node.self) :: r
|
||||
return r
|
||||
|
||||
@[inline, inherit_doc Goal.getEqcs]
|
||||
def getEqcs : GoalM (List (List Expr)) :=
|
||||
return (← get).getEqcs
|
||||
|
||||
/-- Returns `true` if `e` is a case-split that does not need to be performed anymore. -/
|
||||
def isResolvedCaseSplit (e : Expr) : GoalM Bool :=
|
||||
return (← get).resolvedSplits.contains { expr := e }
|
||||
|
||||
/--
|
||||
Mark `e` as a case-split that does not need to be performed anymore.
|
||||
Remark: we currently use this feature to disable `match`-case-splits
|
||||
-/
|
||||
def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
|
||||
unless (← isResolvedCaseSplit e) do
|
||||
trace_goal[grind.split.resolved] "{e}"
|
||||
modify fun s => { s with resolvedSplits := s.resolvedSplits.insert { expr := e } }
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -100,14 +100,12 @@ def _root_.Lean.MVarId.clearAuxDecls (mvarId : MVarId) : MetaM MVarId := mvarId.
|
||||
/--
|
||||
In the `grind` tactic, during `Expr` internalization, we don't expect to find `Expr.mdata`.
|
||||
This function ensures `Expr.mdata` is not found during internalization.
|
||||
Recall that we do not internalize `Expr.lam` children.
|
||||
Recall that we still have to process `Expr.forallE` because of `ForallProp.lean`.
|
||||
Moreover, we may not want to reduce `p → q` to `¬p ∨ q` when `(p q : Prop)`.
|
||||
Recall that we do not internalize `Expr.forallE` and `Expr.lam` components.
|
||||
-/
|
||||
def eraseIrrelevantMData (e : Expr) : CoreM Expr := do
|
||||
let pre (e : Expr) := do
|
||||
match e with
|
||||
| .letE .. | .lam .. => return .done e
|
||||
| .letE .. | .lam .. | .forallE .. => return .done e
|
||||
| .mdata _ e => return .continue e
|
||||
| _ => return .continue e
|
||||
Core.transform e (pre := pre)
|
||||
@@ -118,14 +116,11 @@ Converts nested `Expr.proj`s into projection applications if possible.
|
||||
def foldProjs (e : Expr) : MetaM Expr := do
|
||||
let post (e : Expr) := do
|
||||
let .proj structName idx s := e | return .done e
|
||||
let some info := getStructureInfo? (← getEnv) structName |
|
||||
trace[grind.issues] "found `Expr.proj` but `{structName}` is not marked as structure{indentExpr e}"
|
||||
return .done e
|
||||
let some info := getStructureInfo? (← getEnv) structName | return .done e
|
||||
if h : idx < info.fieldNames.size then
|
||||
let fieldName := info.fieldNames[idx]
|
||||
return .done (← mkProjection s fieldName)
|
||||
else
|
||||
trace[grind.issues] "found `Expr.proj` with invalid field index `{idx}`{indentExpr e}"
|
||||
return .done e
|
||||
Meta.transform e (post := post)
|
||||
|
||||
@@ -140,11 +135,4 @@ def normalizeLevels (e : Expr) : CoreM Expr := do
|
||||
| _ => return .continue
|
||||
Core.transform e (pre := pre)
|
||||
|
||||
/--
|
||||
Normalizes the given expression using the `grind` simplification theorems and simprocs.
|
||||
This function is used for normalzing E-matching patterns. Note that it does not return a proof.
|
||||
-/
|
||||
@[extern "lean_grind_normalize"] -- forward definition
|
||||
opaque normalize (e : Expr) : MetaM Expr
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -50,24 +50,18 @@ def simpCnstr? (e : Expr) : MetaM (Option (Expr × Expr)) := do
|
||||
if let some arg := e.not? then
|
||||
let mut eNew? := none
|
||||
let mut thmName := Name.anonymous
|
||||
match_expr arg with
|
||||
| LE.le α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_le_eq
|
||||
| GE.ge α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_ge_eq
|
||||
| LT.lt α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_lt_eq
|
||||
| GT.gt α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_gt_eq
|
||||
| _ => pure ()
|
||||
if arg.isAppOfArity ``LE.le 4 then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_le_eq
|
||||
else if arg.isAppOfArity ``GE.ge 4 then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_ge_eq
|
||||
else if arg.isAppOfArity ``LT.lt 4 then
|
||||
eNew? := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_lt_eq
|
||||
else if arg.isAppOfArity ``GT.gt 4 then
|
||||
eNew? := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_gt_eq
|
||||
if let some eNew := eNew? then
|
||||
let h₁ := mkApp2 (mkConst thmName) (arg.getArg! 2) (arg.getArg! 3)
|
||||
if let some (eNew', h₂) ← simpCnstrPos? eNew then
|
||||
|
||||
@@ -1583,8 +1583,8 @@ namespace TokenMap
|
||||
|
||||
def insert (map : TokenMap α) (k : Name) (v : α) : TokenMap α :=
|
||||
match map.find? k with
|
||||
| none => RBMap.insert map k [v]
|
||||
| some vs => RBMap.insert map k (v::vs)
|
||||
| none => .insert map k [v]
|
||||
| some vs => .insert map k (v::vs)
|
||||
|
||||
instance : Inhabited (TokenMap α) where
|
||||
default := RBMap.empty
|
||||
|
||||
@@ -103,8 +103,11 @@ partial def compileParserExpr (e : Expr) : MetaM Expr := do
|
||||
name := c', levelParams := []
|
||||
type := ty, value := value, hints := ReducibilityHints.opaque, safety := DefinitionSafety.safe
|
||||
}
|
||||
addAndCompile decl
|
||||
modifyEnv (ctx.combinatorAttr.setDeclFor · c c')
|
||||
let env ← getEnv
|
||||
let env ← match env.addAndCompile {} decl with
|
||||
| Except.ok env => pure env
|
||||
| Except.error kex => do throwError (← (kex.toMessageData {}).toString)
|
||||
setEnv <| ctx.combinatorAttr.setDeclFor env c c'
|
||||
if cinfo.type.isConst then
|
||||
if let some kind ← parserNodeKind? cinfo.value! then
|
||||
-- If the parser is parameter-less and produces a node of kind `kind`,
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Ullrich, Leonardo de Moura, Gabriel Ebner, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Parser
|
||||
import Lean.PrettyPrinter.Delaborator.Attributes
|
||||
import Lean.PrettyPrinter.Delaborator.Basic
|
||||
import Lean.PrettyPrinter.Delaborator.SubExpr
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Marc Huisinga
|
||||
-/
|
||||
prelude
|
||||
import Lean.Server.Completion.CompletionCollectors
|
||||
import Std.Data.HashMap
|
||||
|
||||
namespace Lean.Server.Completion
|
||||
open Lsp
|
||||
|
||||
@@ -97,7 +97,7 @@ abbrev RequestT m := ReaderT RequestContext <| ExceptT RequestError m
|
||||
/-- Workers execute request handlers in this monad. -/
|
||||
abbrev RequestM := ReaderT RequestContext <| EIO RequestError
|
||||
|
||||
abbrev RequestTask.pure (a : α) : RequestTask α := Task.pure (.ok a)
|
||||
abbrev RequestTask.pure (a : α) : RequestTask α := .pure (.ok a)
|
||||
|
||||
instance : MonadLift IO RequestM where
|
||||
monadLift x := do
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user