Compare commits

..

3 Commits

Author SHA1 Message Date
Leonardo de Moura
7d948b2763 feat: add user-defined fallback procedure for the grind tactic
This PR introduces support for user-defined fallback code in the
`grind` tactic. The fallback code can be utilized to inspect the state
of failing `grind` subgoals and/or invoke user-defined
automation. Users can now write `grind on_failure <code>`, where
`<code>` should have the type `GoalM Unit`. See the modified tests in
this PR for examples.
2025-01-02 15:40:50 -08:00
Leonardo de Moura
b390ed1414 test: nonlinear pattern 2025-01-02 15:40:50 -08:00
Leonardo de Moura
8bb20c80f2 test: another grind test 2025-01-02 15:40:50 -08:00
435 changed files with 2178 additions and 19357 deletions

View File

@@ -238,7 +238,7 @@ jobs:
"name": "Linux 32bit",
"os": "ubuntu-latest",
// Use 32bit on stage0 and stage1 to keep oleans compatible
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DPKG_CONFIG_EXECUTABLE=/usr/bin/i386-linux-gnu-pkg-config",
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
"cmultilib": true,
"release": true,
"check-level": 2,
@@ -327,7 +327,7 @@ jobs:
run: |
sudo dpkg --add-architecture i386
sudo apt-get update
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386
if: matrix.cmultilib
- name: Cache
uses: actions/cache@v4

View File

@@ -18,9 +18,6 @@ foreach(var ${vars})
if("${var}" MATCHES "LLVM*")
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
endif()
if("${var}" MATCHES "PKG_CONFIG*")
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
endif()
elseif(("${var}" MATCHES "CMAKE_.*") AND NOT ("${var}" MATCHES "CMAKE_BUILD_TYPE") AND NOT ("${var}" MATCHES "CMAKE_HOME_DIRECTORY"))
list(APPEND PLATFORM_ARGS "-D${var}=${${var}}")
endif()

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

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

View File

@@ -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`).

View File

@@ -32,13 +32,12 @@ following to use `g++`.
cmake -DCMAKE_CXX_COMPILER=g++ ...
```
## Required Packages: CMake, GMP, libuv, pkgconf
## Required Packages: CMake, GMP, libuv
```bash
brew install cmake
brew install gmp
brew install libuv
brew install pkgconf
```
## Recommended Packages: CCache

View File

@@ -8,5 +8,5 @@ follow the [generic build instructions](index.md).
## Basic packages
```bash
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang
```

View File

@@ -28,7 +28,7 @@
stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
} ({
buildInputs = with pkgs; [
cmake gmp libuv ccache cadical pkg-config
cmake gmp libuv ccache cadical
lean-packages.llvmPackages.llvm # llvm-symbolizer for asan/lsan
gdb
tree # for CI

View File

@@ -1,12 +1,12 @@
{ src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
stdenv, lib, cmake, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
... } @ args:
with builtins;
lib.warn "The Nix-based build is deprecated" rec {
inherit stdenv;
sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
buildCMake = args: stdenv.mkDerivation ({
nativeBuildInputs = [ cmake pkg-config ];
nativeBuildInputs = [ cmake ];
buildInputs = [ gmp libuv llvmPackages.llvm ];
# https://github.com/NixOS/nixpkgs/issues/60919
hardeningDisable = [ "all" ];

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

View File

@@ -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

View File

@@ -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=''"

View File

@@ -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

View File

@@ -1,69 +0,0 @@
#!/usr/bin/env python3
import sys
import subprocess
import requests
def main():
if len(sys.argv) != 4:
print("Usage: ./push_repo_release_tag.py <repo> <branch> <version_tag>")
sys.exit(1)
repo, branch, version_tag = sys.argv[1], sys.argv[2], sys.argv[3]
if branch not in {"master", "main"}:
print(f"Error: Branch '{branch}' is not 'master' or 'main'.")
sys.exit(1)
# Get the `lean-toolchain` file content
lean_toolchain_url = f"https://raw.githubusercontent.com/{repo}/{branch}/lean-toolchain"
try:
response = requests.get(lean_toolchain_url)
response.raise_for_status()
except requests.exceptions.RequestException as e:
print(f"Error fetching 'lean-toolchain' file: {e}")
sys.exit(1)
lean_toolchain_content = response.text.strip()
expected_prefix = "leanprover/lean4:"
if not lean_toolchain_content.startswith(expected_prefix) or lean_toolchain_content != f"{expected_prefix}{version_tag}":
print(f"Error: 'lean-toolchain' content does not match '{expected_prefix}{version_tag}'.")
sys.exit(1)
# Create and push the tag using `gh`
try:
# Check if the tag already exists
list_tags_cmd = ["gh", "api", f"repos/{repo}/git/matching-refs/tags/v4", "--jq", ".[].ref"]
list_tags_output = subprocess.run(list_tags_cmd, capture_output=True, text=True)
if list_tags_output.returncode == 0:
existing_tags = list_tags_output.stdout.strip().splitlines()
if f"refs/tags/{version_tag}" in existing_tags:
print(f"Error: Tag '{version_tag}' already exists.")
print("Existing tags starting with 'v4':")
for tag in existing_tags:
print(tag.replace("refs/tags/", ""))
sys.exit(1)
# Get the SHA of the branch
get_sha_cmd = [
"gh", "api", f"repos/{repo}/git/ref/heads/{branch}", "--jq", ".object.sha"
]
sha_result = subprocess.run(get_sha_cmd, capture_output=True, text=True, check=True)
sha = sha_result.stdout.strip()
# Create the tag
create_tag_cmd = [
"gh", "api", f"repos/{repo}/git/refs",
"-X", "POST",
"-F", f"ref=refs/tags/{version_tag}",
"-F", f"sha={sha}"
]
subprocess.run(create_tag_cmd, capture_output=True, text=True, check=True)
print(f"Successfully created and pushed tag '{version_tag}' to {repo}.")
except subprocess.CalledProcessError as e:
print(f"Error while creating/pushing tag: {e.stderr.strip() if e.stderr else e}")
sys.exit(1)
if __name__ == "__main__":
main()

View File

@@ -1,227 +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 strip_rc_suffix(toolchain):
"""Remove -rcX suffix from the toolchain."""
return toolchain.split("-")[0]
def branch_exists(repo_url, branch, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/branches/{branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
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 release_page_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/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 get_release_notes(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
return response.json().get("body", "").strip()
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 parse_version(version_str):
# Remove 'v' prefix and extract version and release candidate suffix
if ':' in version_str:
version_str = version_str.split(':')[1]
version = version_str.lstrip('v')
parts = version.split('-')
base_version = tuple(map(int, parts[0].split('.')))
rc_part = parts[1] if len(parts) > 1 and parts[1].startswith('rc') else None
rc_number = int(rc_part[2:]) if rc_part else float('inf') # Treat non-rc as higher than rc
return base_version + (rc_number,)
def is_version_gte(version1, version2):
"""Check if version1 >= version2, including proper handling of release candidates."""
return parse_version(version1) >= parse_version(version2)
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 is_release_candidate(version):
return "-rc" in version
def check_cmake_version(repo_url, branch, version_major, version_minor, github_token):
"""Verify the CMake version settings in src/CMakeLists.txt."""
cmake_file_path = "src/CMakeLists.txt"
content = get_branch_content(repo_url, branch, cmake_file_path, github_token)
if content is None:
print(f" ❌ Could not retrieve {cmake_file_path} from {branch}")
return False
expected_lines = [
f"set(LEAN_VERSION_MAJOR {version_major})",
f"set(LEAN_VERSION_MINOR {version_minor})",
f"set(LEAN_VERSION_PATCH 0)",
f"set(LEAN_VERSION_IS_RELEASE 1)"
]
for line in expected_lines:
if not any(l.strip().startswith(line) for l in content.splitlines()):
print(f" ❌ Missing or incorrect line in {cmake_file_path}: {line}")
return False
print(f" ✅ CMake version settings are correct in {cmake_file_path}")
return True
def extract_org_repo_from_url(repo_url):
"""Extract the 'org/repo' part from a GitHub URL."""
if repo_url.startswith("https://github.com/"):
return repo_url.replace("https://github.com/", "").rstrip("/")
return repo_url
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]
stripped_toolchain = strip_rc_suffix(toolchain)
lean_repo_url = "https://github.com/leanprover/lean4"
# Preliminary checks
print("\nPerforming preliminary checks...")
# Check for branch releases/v4.Y.0
version_major, version_minor, _ = map(int, stripped_toolchain.lstrip('v').split('.'))
branch_name = f"releases/v{version_major}.{version_minor}.0"
if branch_exists(lean_repo_url, branch_name, github_token):
print(f" ✅ Branch {branch_name} exists")
# Check CMake version settings
check_cmake_version(lean_repo_url, branch_name, version_major, version_minor, github_token)
else:
print(f" ❌ Branch {branch_name} does not exist")
# Check for tag v4.X.Y(-rcZ)
if tag_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Tag {toolchain} exists")
else:
print(f" ❌ Tag {toolchain} does not exist.")
# Check for release page
if release_page_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Release page for {toolchain} exists")
# Check the first line of the release notes
release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
if release_notes and release_notes.splitlines()[0].strip() == toolchain:
print(f" ✅ Release notes look good.")
else:
previous_minor_version = version_minor - 1
previous_stable_branch = f"releases/v{version_major}.{previous_minor_version}.0"
previous_release = f"v{version_major}.{previous_minor_version}.0"
print(f" ❌ Release notes not published. Please run `script/release_notes.py {previous_release}` on branch `{previous_stable_branch}`.")
else:
print(f" ❌ Release page for {toolchain} does not exist")
# Load repositories and perform further checks
print("\nChecking repositories...")
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. Run `script/push_repo_release_tag.py {extract_org_repo_from_url(url)} {branch} {toolchain}`.")
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()

View File

@@ -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()

View File

@@ -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

View File

@@ -295,15 +295,14 @@ index 5e8e0166..f3b29134 100644
PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
BUILD_IN_SOURCE ON
INSTALL_COMMAND "")
set(LIBUV_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LDFLAGS "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
set(LIBUV_INCLUDE_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
else()
find_package(LibUV 1.0.0 REQUIRED)
endif()
include_directories(${LIBUV_INCLUDE_DIRS})
include_directories(${LIBUV_INCLUDE_DIR})
if(NOT LEAN_STANDALONE)
string(JOIN " " LIBUV_LDFLAGS ${LIBUV_LDFLAGS})
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
endif()
# Windows SDK (for ICU)

View File

@@ -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

View File

@@ -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]!
@@ -576,12 +577,6 @@ def foldl {α : Type u} {β : Type v} (f : β → α → β) (init : β) (as : A
def foldr {α : Type u} {β : Type v} (f : α β β) (init : β) (as : Array α) (start := as.size) (stop := 0) : β :=
Id.run <| as.foldrM f init start stop
/-- Sum of an array.
`Array.sum #[a, b, c] = a + (b + (c + 0))` -/
def sum {α} [Add α] [Zero α] : Array α α :=
foldr (· + ·) 0
@[inline]
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f

View File

@@ -81,18 +81,12 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
@[deprecated append_empty (since := "2025-01-13")]
abbrev append_nil := @append_empty
@[simp] theorem empty_append (as : Array α) : #[] ++ as = as := by
@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
apply ext'; simp only [toList_append, toList_empty, List.nil_append]
@[deprecated empty_append (since := "2025-01-13")]
abbrev nil_append := @empty_append
@[simp] theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
apply ext'; simp only [toList_append, List.append_assoc]

View File

@@ -74,12 +74,12 @@ theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (
theorem getElem?_zero_flatten (L : Array (Array α)) :
(flatten L)[0]? = L.findSome? fun l => l[0]? := by
cases L using array_induction
cases L using array_array_induction
simp [ List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
(L.findSome? fun l => l[0]?).isSome := by
cases L using array_induction
cases L using array_array_induction
simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
List.findSome?_isSome_iff, isSome_getElem?]
simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
@@ -95,7 +95,7 @@ theorem getElem_zero_flatten {L : Array (Array α)} (h) :
theorem back?_flatten {L : Array (Array α)} :
(flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
cases L using array_induction
cases L using array_array_induction
simp [List.getLast?_flatten, List.map_reverse, List.findSome?_map, Function.comp_def]
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
@@ -203,7 +203,7 @@ theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h ∈ xs := by
@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α Bool) :
xs.flatten.find? p = xs.findSome? (·.find? p) := by
cases xs using array_induction
cases xs using array_array_induction
simp [List.findSome?_map, Function.comp_def]
theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α Bool} :
@@ -220,7 +220,7 @@ theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α → Bool} {a : α}
p a (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
xs = as.push (ys.push a ++ zs) ++ bs
( a as, x a, !p x) ( x ys, !p x) := by
cases xs using array_induction
cases xs using array_array_induction
simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
intro w

File diff suppressed because it is too large Load Diff

View File

@@ -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
@@ -3539,7 +3340,7 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
/-! ### Non-overflow theorems -/
/-- If `x.toNat + y.toNat < 2^w`, then the addition `(x + y)` does not overflow. -/
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
(x + y).toNat = x.toNat + y.toNat := by
rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]

View File

@@ -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]

View File

@@ -606,11 +606,11 @@ set_option linter.missingDocs false in
to get a list of lists, and then concatenates them all together.
* `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
-/
@[inline] def flatMap {α : Type u} {β : Type v} (b : α List β) (a : List α) : List β := flatten (map b a)
@[inline] def flatMap {α : Type u} {β : Type v} (a : List α) (b : α List β) : List β := flatten (map b a)
@[simp] theorem flatMap_nil (f : α List β) : List.flatMap f [] = [] := by simp [flatten, List.flatMap]
@[simp] theorem flatMap_nil (f : α List β) : List.flatMap [] f = [] := by simp [flatten, List.flatMap]
@[simp] theorem flatMap_cons x xs (f : α List β) :
List.flatMap f (x :: xs) = f x ++ List.flatMap f xs := by simp [flatten, List.flatMap]
List.flatMap (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
set_option linter.missingDocs false in
@[deprecated flatMap (since := "2024-10-16")] abbrev bind := @flatMap

View File

@@ -96,14 +96,14 @@ The following operations are given `@[csimp]` replacements below:
/-! ### flatMap -/
/-- Tail recursive version of `List.flatMap`. -/
@[inline] def flatMapTR (f : α List β) (as : List α) : List β := go as #[] where
@[inline] def flatMapTR (as : List α) (f : α List β) : List β := go as #[] where
/-- Auxiliary for `flatMap`: `flatMap.go f as = acc.toList ++ bind f as` -/
@[specialize] go : List α Array β List β
| [], acc => acc.toList
| x::xs, acc => go xs (acc ++ f x)
@[csimp] theorem flatMap_eq_flatMapTR : @List.flatMap = @flatMapTR := by
funext α β f as
funext α β as f
let rec go : as acc, flatMapTR.go f as acc = acc.toList ++ as.flatMap f
| [], acc => by simp [flatMapTR.go, flatMap]
| x::xs, acc => by simp [flatMapTR.go, flatMap, go xs]
@@ -112,7 +112,7 @@ The following operations are given `@[csimp]` replacements below:
/-! ### flatten -/
/-- Tail recursive version of `List.flatten`. -/
@[inline] def flattenTR (l : List (List α)) : List α := l.flatMapTR id
@[inline] def flattenTR (l : List (List α)) : List α := flatMapTR l id
@[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
funext α l; rw [ List.flatMap_id, List.flatMap_eq_flatMapTR]; rfl

View File

@@ -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)]
@@ -1076,31 +1276,9 @@ theorem forall_mem_map {f : α → β} {l : List α} {P : β → Prop} :
@[deprecated forall_mem_map (since := "2024-07-25")] abbrev forall_mem_map_iff := @forall_mem_map
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
induction l <;> simp_all
theorem map_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
induction l generalizing l' with
| nil => simp
| cons a l ih =>
simp only [map_cons]
cases l' with
| nil => simp
| cons a' l' =>
simp only [map_cons, cons.injEq, ih, and_congr_left_iff]
intro h
constructor
· apply w
· simp +contextual
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
@@ -1109,6 +1287,14 @@ theorem map_inj : map f = map g ↔ f = g := by
· intro h; ext a; replace h := congrFun h [a]; simpa using h
· intro h; subst h; rfl
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
theorem map_eq_cons_iff {f : α β} {l : List α} :
map f l = b :: l₂ a l₁, l = a :: l₁ f a = b map f l₁ = l₂ := by
cases l
@@ -1129,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
@@ -1299,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
@@ -1508,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'
@@ -1603,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 :
@@ -1619,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₂ :=
@@ -1648,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
@@ -1673,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
@@ -1770,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
@@ -1790,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
@@ -1898,7 +2079,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∃ L b, l = concat L b
/-! ### flatten -/
@[simp] theorem length_flatten (L : List (List α)) : L.flatten.length = (L.map length).sum := by
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
induction L with
| nil => rfl
| cons =>
@@ -1913,9 +2094,6 @@ theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
@[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] l L, l = [] := by
induction L <;> simp_all
@[simp] theorem nil_eq_flatten_iff {L : List (List α)} : [] = L.flatten l L, l = [] := by
rw [eq_comm, flatten_eq_nil_iff]
theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten [] x, x xs x [] := by
simp
@@ -1941,8 +2119,15 @@ 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`.
@[simp] theorem map_flatten (f : α β) (L : List (List α)) :
(flatten L).map f = (map (map f) L).flatten := by
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
@[simp] theorem filterMap_flatten (f : α Option β) (L : List (List α)) :
@@ -1995,26 +2180,6 @@ theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
· rintro as, bs, cs, rfl, h₁, rfl
simp [flatten_eq_nil_iff.mpr h₁]
theorem cons_eq_flatten_iff {xs : List (List α)} {y : α} {ys : List α} :
y :: ys = xs.flatten
as bs cs, xs = as ++ (y :: bs) :: cs ( l, l as l = []) ys = bs ++ cs.flatten := by
rw [eq_comm, flatten_eq_cons_iff]
theorem flatten_eq_singleton_iff {xs : List (List α)} {y : α} :
xs.flatten = [y] as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [flatten_eq_cons_iff]
constructor
· rintro as, bs, cs, rfl, h₁, h₂
simp at h₂
obtain rfl, h₂ := h₂
exact as, cs, by simp, h₁, h₂
· rintro as, bs, rfl, h₁, h₂
exact as, [], bs, rfl, h₁, by simpa
theorem singleton_eq_flatten_iff {xs : List (List α)} {y : α} :
[y] = xs.flatten as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [eq_comm, flatten_eq_singleton_iff]
theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
xs.flatten = ys ++ zs
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
@@ -2023,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 =>
@@ -2043,13 +2208,6 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
· simp
· simp
theorem append_eq_flatten_iff {xs : List (List α)} {ys zs : List α} :
ys ++ zs = xs.flatten
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ys = as.flatten ++ bs
zs = c :: cs ++ ds.flatten := by
rw [eq_comm, flatten_eq_append_iff]
/-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_flatten_eq : {L L' : List (List α)},
@@ -2070,14 +2228,12 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
theorem flatMap_def (l : List α) (f : α List β) : l.flatMap f = flatten (map f l) := by rfl
@[simp] theorem flatMap_id (l : List (List α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : List (List α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
@[simp]
theorem length_flatMap (l : List α) (f : α List β) :
length (l.flatMap f) = sum (map (fun a => (f a).length) l) := by
rw [List.flatMap, length_flatten, map_map, Function.comp_def]
length (l.flatMap f) = sum (map (length f) l) := by
rw [List.flatMap, length_flatten, map_map]
@[simp] theorem mem_flatMap {f : α List β} {b} {l : List α} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
@@ -2090,7 +2246,7 @@ theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al :
b l.flatMap f := mem_flatMap.2 a, al, h
@[simp]
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : l.flatMap f = [] x l, f x = [] :=
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : List.flatMap l f = [] x l, f x = [] :=
flatten_eq_nil_iff.trans <| by
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
@@ -2395,9 +2551,6 @@ theorem replicateRecOn {α : Type _} {p : List α → Prop} (m : List α)
exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
termination_by m.length
@[simp] theorem sum_replicate_nat (n : Nat) (a : Nat) : (replicate n a).sum = n * a := by
induction n <;> simp_all [replicate_succ, Nat.add_mul, Nat.add_comm]
/-! ### reverse -/
@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
@@ -2546,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]
@@ -2667,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?` -/

View File

@@ -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

View File

@@ -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]

View File

@@ -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!]
@@ -143,9 +143,6 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
subst h
rw [foldl_toList]
@[simp] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
simp [Array.sum, List.sum]
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
apply ext'
@@ -397,24 +394,4 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
@[deprecated toArray_replicate (since := "2024-12-13")]
abbrev _root_.Array.mkArray_eq_toArray_replicate := @toArray_replicate
@[simp] theorem flatMap_empty {β} (f : α Array β) : (#[] : Array α).flatMap f = #[] := rfl
theorem flatMap_toArray_cons {β} (f : α Array β) (a : α) (as : List α) :
(a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
simp [Array.flatMap]
suffices cs, List.foldl (fun bs a => bs ++ f a) (f a ++ cs) as =
f a ++ List.foldl (fun bs a => bs ++ f a) cs as by
erw [empty_append] -- Why doesn't this work via `simp`?
simpa using this #[]
intro cs
induction as generalizing cs <;> simp_all
@[simp] theorem flatMap_toArray {β} (f : α Array β) (as : List α) :
as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
induction as with
| nil => simp
| cons a as ih =>
apply ext'
simp [ih, flatMap_toArray_cons]
end List

View File

@@ -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₂ =>

View File

@@ -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

View File

@@ -622,14 +622,6 @@ protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by
0 < a * b 0 < a :=
Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h
protected theorem pos_of_lt_mul_left {a b c : Nat} (h : a < b * c) : 0 < c := by
replace h : 0 < b * c := by omega
exact Nat.pos_of_mul_pos_left h
protected theorem pos_of_lt_mul_right {a b c : Nat} (h : a < b * c) : 0 < b := by
replace h : 0 < b * c := by omega
exact Nat.pos_of_mul_pos_right h
/-! ### div/mod -/
theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 n % 2 = 1 :=

View File

@@ -208,15 +208,6 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
theorem mem_map_of_mem (g : α β) (h : a x) : g a Option.map g x := h.symm map_some' ..
theorem map_inj_right {f : α β} {o o' : Option α} (w : x y, f x = f y x = y) :
o.map f = o'.map f o = o' := by
cases o with
| none => cases o' <;> simp
| some a =>
cases o' with
| none => simp
| some a' => simpa using fun h => w _ _ h, fun h => congrArg f h
@[simp] theorem map_if {f : α β} [Decidable c] :
(if c then some a else none).map f = if c then some (f a) else none := by
split <;> rfl
@@ -638,15 +629,6 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → a ∈ o → Option
· rintro h, rfl
rfl
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (o : Option α) (H) :
@pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
cases o <;> simp
theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (o H) :
Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
cases o <;> simp
/-! ### pelim -/
@[simp] theorem pelim_none : pelim none b f = b := rfl

View File

@@ -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

View File

@@ -13,17 +13,11 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
`(
namespace $typeName
@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := 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
@[simp] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
@[simp] protected theorem toNat_and (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := by simp [toNat]
@[simp] protected theorem toNat_or (a b : $typeName) : (a ||| b).toNat = a.toNat ||| b.toNat := by simp [toNat]
@@ -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, int_toBitVec]
theorem Bool.toBitVec_toUInt8 {b : Bool} :
b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
cases b <;> simp [toUInt8]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt16 {b : Bool} :
b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
cases b <;> simp [toUInt16]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt32 {b : Bool} :
b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
cases b <;> simp [toUInt32]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt64 {b : Bool} :
b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
cases b <;> simp [toUInt64]
@[simp, int_toBitVec]
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]

View File

@@ -41,9 +41,9 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
rw [toNat, toBitVec_eq_of_lt h]
@[int_toBitVec] theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
@[int_toBitVec] theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
theorem le_iff_toNat_le {a b : $typeName} : a b a.toNat b.toNat := .rfl
@@ -74,11 +74,6 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
protected theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec a = b :=
Iff.intro eq_of_toBitVec_eq toBitVec_eq_of_eq
open $typeName (eq_of_toBitVec_eq toBitVec_eq_of_eq) in
@[int_toBitVec]
protected theorem eq_iff_toBitVec_eq {a b : $typeName} : a = b a.toBitVec = b.toBitVec :=
Iff.intro toBitVec_eq_of_eq eq_of_toBitVec_eq
open $typeName (eq_of_toBitVec_eq) in
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by
rcases a with _; rcases b with _; simp_all [val]
@@ -87,19 +82,10 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
protected theorem val_inj {a b : $typeName} : a.val = b.val a = b :=
Iff.intro eq_of_val_eq (congrArg val)
open $typeName (eq_of_toBitVec_eq) in
protected theorem toBitVec_ne_of_ne {a b : $typeName} (h : a b) : a.toBitVec b.toBitVec :=
fun h' => h (eq_of_toBitVec_eq h')
open $typeName (toBitVec_eq_of_eq) in
protected theorem ne_of_toBitVec_ne {a b : $typeName} (h : a.toBitVec b.toBitVec) : a b :=
fun h' => absurd (toBitVec_eq_of_eq h') h
open $typeName (ne_of_toBitVec_ne toBitVec_ne_of_ne) in
@[int_toBitVec]
protected theorem ne_iff_toBitVec_ne {a b : $typeName} : a b a.toBitVec b.toBitVec :=
Iff.intro toBitVec_ne_of_ne ne_of_toBitVec_ne
open $typeName (ne_of_toBitVec_ne) in
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a b := by
apply ne_of_toBitVec_ne
@@ -173,7 +159,7 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
@[simp]
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
@[simp, int_toBitVec]
@[simp]
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
@[simp]

View File

@@ -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
@@ -170,13 +158,6 @@ result is empty. If `stop` is greater than the size of the vector, the size is u
@[inline] def map (f : α β) (v : Vector α n) : Vector β n :=
v.toArray.map f, by simp
@[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
(v.toArray.map Vector.toArray).flatten,
by rcases v; simp_all [Function.comp_def, Array.map_const']
@[inline] def flatMap (v : Vector α n) (f : α Vector β m) : Vector β (n * m) :=
v.toArray.flatMap fun a => (f a).toArray, by simp [Array.map_const']
/-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α β φ) : Vector φ n :=
Array.zipWith a.toArray b.toArray f, by simp

View File

@@ -1,11 +1,10 @@
/-
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
import Init.Data.Array.Attach
/-!
## Vectors
@@ -28,9 +27,6 @@ namespace Vector
theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a := rfl
@[simp] theorem mk_toArray (v : Vector α n) : mk v.toArray v.2 = v := by
rfl
@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) :
(Vector.mk data size)[i] = data[i] := rfl
@@ -70,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
@@ -157,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) :
@@ -697,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] :
@@ -1065,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]
@@ -1078,583 +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_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
cases l
cases l'
simp [Array.map_inj_right w]
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
/--
Use this as `induction ass using vector₂_induction` on a hypothesis of the form `ass : Vector (Vector α n) m`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array α)`
along with additional hypotheses `h₁ : ass.size = m` and `h₂ : ∀ xs ∈ ass, xs.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk xs ⋯)) ⋯`.
-/
-- We can't use `@[cases_eliminator]` here as
-- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
theorem vector₂_induction (P : Vector (Vector α n) m Prop)
(of : (xss : Array (Array α)) (h₁ : xss.size = m) (h₂ : xs xss, xs.size = n),
P (mk (xss.attach.map (fun xs, m => mk xs (h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector α n) m) : P ass := by
specialize of (ass.map toArray).toArray (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/--
Use this as `induction ass using vector₃_induction` on a hypothesis of the form `ass : Vector (Vector (Vector α n) m) k`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array (Array α))`
along with additional hypotheses `h₁ : ass.size = k`, `h₂ : ∀ xs ∈ ass, xs.size = m`,
and `h₃ : ∀ xs ∈ ass, ∀ x ∈ xs, x.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk (xs.attach.map (fun ⟨x, m'⟩ => Vector.mk x ⋯)) ⋯)) ⋯`.
-/
theorem vector₃_induction (P : Vector (Vector (Vector α n) m) k Prop)
(of : (xss : Array (Array (Array α))) (h₁ : xss.size = k) (h₂ : xs xss, xs.size = m)
(h₃ : xs xss, x xs, x.size = n),
P (mk (xss.attach.map (fun xs, m =>
mk (xs.attach.map (fun x, m' =>
mk x (h₃ xs m x m'))) (by simpa using h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector (Vector α n) m) k) : P ass := by
specialize of (ass.map (fun as => (as.map toArray).toArray)).toArray (by simp) (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/-! ### 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_empty]
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]
/-! ### flatten -/
@[simp] theorem flatten_mk (L : Array (Vector α n)) (h : L.size = m) :
(mk L h).flatten =
mk (L.map toArray).flatten (by simp [Function.comp_def, Array.map_const', h]) := by
simp [flatten]
@[simp] theorem getElem_flatten (l : Vector (Vector β m) n) (i : Nat) (hi : i < n * m) :
l.flatten[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
l[i / m][i % m] := by
rcases l with l, rfl
simp only [flatten_mk, List.map_toArray, getElem_mk, List.getElem_toArray, Array.flatten_toArray]
induction l generalizing i with
| nil => simp at hi
| cons a l ih =>
simp only [List.map_cons, List.map_map, List.flatten_cons]
by_cases h : i < m
· rw [List.getElem_append_left (by simpa)]
have h₁ : i / m = 0 := Nat.div_eq_of_lt h
have h₂ : i % m = i := Nat.mod_eq_of_lt h
simp [h₁, h₂]
· have h₁ : a.toList.length i := by simp; omega
rw [List.getElem_append_right h₁]
simp only [Array.length_toList, size_toArray]
specialize ih (i - m) (by simp_all [Nat.add_one_mul]; omega)
have h₂ : i / m = (i - m) / m + 1 := by
conv => lhs; rw [show i = i - m + m by omega]
rw [Nat.add_div_right]
exact Nat.pos_of_lt_mul_left hi
simp only [Array.length_toList, size_toArray] at h₁
have h₃ : (i - m) % m = i % m := (Nat.mod_eq_sub_mod h₁).symm
simp_all
theorem getElem?_flatten (l : Vector (Vector β m) n) (i : Nat) :
l.flatten[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some l[i / m][i % m]
else
none := by
simp [getElem?_def]
@[simp] theorem flatten_singleton (l : Vector α n) : #v[l].flatten = l.cast (by simp) := by
simp [flatten]
theorem mem_flatten {L : Vector (Vector α n) m} : a L.flatten l, l L a l := by
rcases L with L, rfl
simp [Array.mem_flatten]
constructor
· rintro _, l, h₁, rfl, h₂
exact l, h₁, by simpa using h₂
· rintro l, h₁, h₂
exact l.toArray, l, h₁, rfl, by simpa using h₂
theorem exists_of_mem_flatten : a flatten L l, l L a l := mem_flatten.1
theorem mem_flatten_of_mem (lL : l L) (al : a l) : a flatten L := mem_flatten.2 l, lL, al
theorem forall_mem_flatten {p : α Prop} {L : Vector (Vector α n) m} :
( (x) (_ : x flatten L), p x) (l) (_ : l L) (x) (_ : x l), p x := by
simp only [mem_flatten, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
@[simp] theorem map_flatten (f : α β) (L : Vector (Vector α n) m) :
(flatten L).map f = (map (map f) L).flatten := by
induction L using vector₂_induction with
| of xss h₁ h₂ => simp
@[simp] theorem flatten_append (L₁ : Vector (Vector α n) m₁) (L₂ : Vector (Vector α n) m₂) :
flatten (L₁ ++ L₂) = (flatten L₁ ++ flatten L₂).cast (by simp [Nat.add_mul]) := by
induction L₁ using vector₂_induction
induction L₂ using vector₂_induction
simp
theorem flatten_push (L : Vector (Vector α n) m) (l : Vector α n) :
flatten (L.push l) = (flatten L ++ l).cast (by simp [Nat.add_mul]) := by
induction L using vector₂_induction
rcases l with l
simp [Array.flatten_push]
theorem flatten_flatten {L : Vector (Vector (Vector α n) m) k} :
flatten (flatten L) = (flatten (map flatten L)).cast (by simp [Nat.mul_assoc]) := by
induction L using vector₃_induction with
| of xss h₁ h₂ h₃ =>
-- simp [Array.flatten_flatten] -- FIXME: `simp` produces a bad proof here!
simp [Array.map_attach, Array.flatten_flatten, Array.map_pmap]
/-- Two vectors of constant length vectors are equal iff their flattens coincide. -/
theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
L = L' L.flatten = L'.flatten := by
induction L using vector₂_induction with | of L h₁ h₂ =>
induction L' using vector₂_induction with | of L' h₁' h₂' =>
simp only [eq_mk, flatten_mk, Array.map_map, Function.comp_apply, Array.map_subtype,
Array.unattach_attach, Array.map_id_fun', id_eq]
constructor
· intro h
suffices L = L' by simp_all
apply Array.ext_getElem?
intro i
replace h := congrArg (fun x => x[i]?.map (fun x => x.toArray)) h
simpa [Option.map_pmap] using h
· intro h
have w : L.map Array.size = L'.map Array.size := by
ext i h h'
· simp_all
· simp only [Array.getElem_map]
rw [h₂ _ (by simp), h₂' _ (by simp)]
have := Array.eq_iff_flatten_eq.mpr h, w
subst this
rfl
/-! ### flatMap -/
@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α Vector β n) :
(mk l h).flatMap f =
mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
simp [flatMap]
@[simp] theorem flatMap_toArray (l : Vector α n) (f : α Vector β m) :
l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
rcases l with l, rfl
simp
theorem flatMap_def (l : Vector α n) (f : α Vector β m) : l.flatMap f = flatten (map f l) := by
rcases l with l, rfl
simp [Array.flatMap_def, Function.comp_def]
@[simp] theorem getElem_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) (hi : i < n * m) :
(l.flatMap f)[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
(f (l[i / m]))[i % m] := by
rw [flatMap_def, getElem_flatten, getElem_map]
theorem getElem?_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) :
(l.flatMap f)[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some ((f (l[i / m]))[i % m])
else
none := by
simp [getElem?_def]
@[simp] theorem flatMap_id (l : Vector (Vector α m) n) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : Vector (Vector α m) n) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp] theorem mem_flatMap {f : α Vector β m} {b} {l : Vector α n} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
exact fun _, a, h₁, rfl, h₂ => a, h₁, h₂, fun a, h₁, h₂ => _, a, h₁, rfl, h₂
theorem exists_of_mem_flatMap {b : β} {l : Vector α n} {f : α Vector β m} :
b l.flatMap f a, a l b f a := mem_flatMap.1
theorem mem_flatMap_of_mem {b : β} {l : Vector α n} {f : α Vector β m} {a} (al : a l) (h : b f a) :
b l.flatMap f := mem_flatMap.2 a, al, h
theorem forall_mem_flatMap {p : β Prop} {l : Vector α n} {f : α Vector β m} :
( (x) (_ : x l.flatMap f), p x) (a) (_ : a l) (b) (_ : b f a), p b := by
simp only [mem_flatMap, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
theorem flatMap_singleton (f : α Vector β m) (x : α) : #v[x].flatMap f = (f x).cast (by simp) := by
simp [flatMap_def]
@[simp] theorem flatMap_singleton' (l : Vector α n) : (l.flatMap fun x => #v[x]) = l.cast (by simp) := by
rcases l with l, rfl
simp
@[simp] theorem flatMap_append (xs ys : Vector α n) (f : α Vector β m) :
(xs ++ ys).flatMap f = (xs.flatMap f ++ ys.flatMap f).cast (by simp [Nat.add_mul]) := by
rcases xs with xs
rcases ys with ys
simp [flatMap_def, flatten_append]
theorem flatMap_assoc {α β} (l : Vector α n) (f : α Vector β m) (g : β Vector γ k) :
(l.flatMap f).flatMap g = (l.flatMap fun x => (f x).flatMap g).cast (by simp [Nat.mul_assoc]) := by
rcases l with l, rfl
simp [Array.flatMap_assoc]
theorem map_flatMap (f : β γ) (g : α Vector β m) (l : Vector α n) :
(l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
rcases l with l, rfl
simp [Array.map_flatMap]
theorem flatMap_map (f : α β) (g : β Vector γ k) (l : Vector α n) :
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
rcases l with l, rfl
simp [Array.flatMap_map]
theorem map_eq_flatMap {α β} (f : α β) (l : Vector α n) :
map f l = (l.flatMap fun x => #v[f x]).cast (by simp) := by
rcases l with l, rfl
simp [Array.map_eq_flatMap]
/-! 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
@@ -1679,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) :
@@ -1686,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)
@@ -1694,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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -1,92 +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
/-!
Helper theorems for equality propagation
-/
theorem Nat.le_of_eq_1 (u v : Nat) : u = v u v := by omega
theorem Nat.le_of_eq_2 (u v : Nat) : u = v v u := by omega
theorem Nat.eq_of_le_of_le (u v : Nat) : u v v u u = v := by omega
theorem Nat.le_offset (a k : Nat) : k a + k := by omega
end Lean.Grind

View File

@@ -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

View File

@@ -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,20 +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
/-- By default, `grind` halts as soon as it encounters a sub-goal where no further progress can be made. -/
failures : Nat := 1
/-- Maximum number of heartbeats (in thousands) the canonicalizer can spend per definitional equality test. -/
canonHeartbeats : Nat := 1000
deriving Inhabited, BEq
end Lean.Grind

View File

@@ -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

View File

@@ -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

View File

@@ -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,

View File

@@ -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

View File

@@ -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

View File

@@ -74,6 +74,8 @@ partial def toMonoType (type : Expr) : CoreM Expr := do
let type := type.headBeta
if type.isErased then
return erasedExpr
else if type.isErased then
return erasedExpr
else if isTypeFormerType type then
return erasedExpr
else match type with

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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 ++ "\""

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

@@ -38,9 +38,6 @@ declare_config_elab elabBVDecideConfig Lean.Elab.Tactic.BVDecide.Frontend.BVDeci
builtin_initialize bvNormalizeExt : Meta.SimpExtension
Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"
builtin_initialize intToBitVecExt : Meta.SimpExtension
Meta.registerSimpAttr `int_toBitVec "simp theorems used to convert UIntX/IntX statements into BitVec ones"
/-- Builtin `bv_normalize` simprocs. -/
builtin_initialize builtinBVNormalizeSimprocsRef : IO.Ref Meta.Simp.Simprocs IO.mkRef {}

View File

@@ -4,28 +4,342 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Meta.AppBuilder
import Lean.Meta.Tactic.AC.Main
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.FalseOrByContra
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Simproc
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Rewrite
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
import Std.Tactic.BVDecide.Normalize
import Std.Tactic.BVDecide.Syntax
/-!
This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
It is in essence a (slightly reduced) version of the Bitwuzla preprocessor together with Lean
specific details.
This module contains the implementation of `bv_normalize` which is effectively a custom `bv_normalize`
simp set that is called like this: `simp only [seval, bv_normalize]`. The rules in `bv_normalize`
fulfill two goals:
1. Turn all hypothesis involving `Bool` and `BitVec` into the form `x = true` where `x` only consists
of a operations on `Bool` and `BitVec`. In particular no `Prop` should be contained. This makes
the reflection procedure further down the pipeline much easier to implement.
2. Apply simplification rules from the Bitwuzla SMT solver.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
open Std.Tactic.BVDecide.Normalize
def passPipeline : PreProcessM (List Pass) := do
let mut passPipeline := [rewriteRulesPass]
let cfg PreProcessM.getConfig
builtin_simproc [bv_normalize] reduceCond (cond _ _ _) := fun e => do
let_expr f@cond α c tb eb := e | return .continue
let r Simp.simp c
if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := tb, proof? := pr }
else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := eb, proof? := pr }
else
return .continue
builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
let_expr Eq _ lhs rhs := e | return .continue
match_expr rhs with
| Bool.true => return .continue
| _ =>
let beqApp mkAppM ``BEq.beq #[lhs, rhs]
let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
return .done { expr := new, proof? := some proof }
builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, rhsValue getBitVecValue? rhs | return .continue
if rhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
return .visit { expr := lhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
return .visit { expr := rhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
let_expr BitVec.ult _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
return .visit { expr := toExpr Bool.false, proof? := some proof }
else
return .continue
-- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
let_expr Neg.neg typ _ val := e | return .continue
let_expr BitVec widthExpr := typ | return .continue
let some w getNatValue? widthExpr | return .continue
match getBitVecValue? val with
| some _ => return .continue
| none =>
let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
let expr mkAppM ``HAdd.hAdd #[ mkAppM ``Complement.complement #[val], (toExpr 1#w)]
return .visit { expr := expr, proof? := some proof }
builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
let some w, exp1Val getBitVecValue? exp1 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp2 with
| some w', exp2Val =>
if h : w = w' then
let newLhs := exp1Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp3Val getBitVecValue? exp3 | return .continue
if h : w = w' then
let newLhs := exp1Val + h exp3Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
return .visit { expr := expr, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
let some w, exp3Val getBitVecValue? exp3 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp1 with
| some w', exp1Val =>
if h : w = w' then
let newLhs := exp3Val + h exp1Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp2Val getBitVecValue? exp2 | return .continue
if h : w = w' then
let newLhs := exp3Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
return .visit { expr := expr, proof? := some proof }
else
return .continue
/-- Return a number `k` such that `2^k = n`. -/
private def Nat.log2Exact (n : Nat) : Option Nat := do
guard <| n 0
let k := n.log2
guard <| Nat.pow 2 k == n
return k
-- Build an expression for `x ^ y`.
def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
let some w, yVal getBitVecValue? y | return .continue
let n := yVal.toNat
-- BitVec.ofNat w n, where n =def= 2^k
let some k := Nat.log2Exact n | return .continue
-- check that k < w.
if k w then return .continue
let rhs mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
-- 2^k = n
let hk mkDecideProof ( mkEq ( mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
-- k < w
let hlt mkDecideProof ( mkLt (mkNatLit k) (mkNatLit w))
let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
#[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
return .done {
expr := rhs
proof? := some proof
}
/--
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
the goal fully, indicated by returning `none`.
-/
structure Pass where
name : Name
run : MVarId MetaM (Option MVarId)
namespace Pass
/--
Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
the goal anymore.
-/
partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : MetaM (Option MVarId) := do
let runPass (goal? : Option MVarId) (pass : Pass) : MetaM (Option MVarId) := do
let some goal := goal? | return none
withTraceNode `bv (fun _ => return s!"Running pass: {pass.name}") do
pass.run goal
let some newGoal := passes.foldlM (init := some goal) runPass | return none
if goal != newGoal then
trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
fixpointPipeline passes newGoal
else
trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
return newGoal
/--
Responsible for applying the Bitwuzla style rewrite rules.
-/
def rewriteRulesPass (maxSteps : Nat) : Pass where
name := `rewriteRules
run goal := do
let bvThms bvNormalizeExt.getTheorems
let bvSimprocs bvNormalizeSimprocExt.getSimprocs
let sevalThms getSEvalTheorems
let sevalSimprocs Simp.getSEvalSimprocs
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps })
(simpTheorems := #[bvThms, sevalThms])
(congrTheorems := ( getSimpCongrTheorems))
let hyps goal.getNondepPropHyps
let result?, _ simpGoal goal
(ctx := simpCtx)
(simprocs := #[bvSimprocs, sevalSimprocs])
(fvarIdsToSimp := hyps)
let some (_, newGoal) := result? | return none
return newGoal
/--
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
in embedded constraint substitution.
-/
partial def andFlatteningPass : Pass where
name := `andFlattening
run goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut newHyps := #[]
let mut oldHyps := #[]
for fvar in hyps do
let hyp : Hypothesis := {
userName := ( fvar.getDecl).userName
type := fvar.getType
value := mkFVar fvar
}
let sizeBefore := newHyps.size
newHyps splitAnds hyp newHyps
if newHyps.size > sizeBefore then
oldHyps := oldHyps.push fvar
if newHyps.size == 0 then
return goal
else
let (_, goal) goal.assertHypotheses newHyps
-- Given that we collected the hypotheses in the correct order above the invariant is given
let goal goal.tryClearMany oldHyps
return goal
where
splitAnds (hyp : Hypothesis) (hyps : Array Hypothesis) (first : Bool := true) :
MetaM (Array Hypothesis) := do
match trySplit hyp with
| some (left, right) =>
let hyps splitAnds left hyps false
splitAnds right hyps false
| none =>
if first then
return hyps
else
return hyps.push hyp
trySplit (hyp : Hypothesis) : MetaM (Option (Hypothesis × Hypothesis)) := do
let typ := hyp.type
let_expr Eq α eqLhs eqRhs := typ | return none
let_expr Bool.and lhs rhs := eqLhs | return none
let_expr Bool.true := eqRhs | return none
let_expr Bool := α | return none
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let leftHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
}
let rightHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
}
return some (leftHyp, rightHyp)
/--
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
them to substitute occurences of `x` within other hypotheses. Additionally this drops all
redundant top level hypotheses.
-/
def embeddedConstraintPass (maxSteps : Nat) : Pass where
name := `embeddedConstraintSubsitution
run goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut relevantHyps : SimpTheoremsArray := #[]
let mut seen : Std.HashSet Expr := {}
let mut duplicates : Array FVarId := #[]
for hyp in hyps do
let typ hyp.getType
let_expr Eq α lhs rhs := typ | continue
let_expr Bool.true := rhs | continue
let_expr Bool := α | continue
if seen.contains lhs then
-- collect and later remove duplicates on the fly
duplicates := duplicates.push hyp
else
seen := seen.insert lhs
let localDecl hyp.getDecl
let proof := localDecl.toExpr
relevantHyps relevantHyps.addTheorem (.fvar hyp) proof
let goal goal.tryClearMany duplicates
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, maxSteps })
(simpTheorems := relevantHyps)
(congrTheorems := ( getSimpCongrTheorems))
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := goal.getNondepPropHyps)
let some (_, newGoal) := result? | return none
return newGoal
/--
Normalize with respect to Associativity and Commutativity.
-/
def acNormalizePass : Pass where
name := `ac_nf
run goal := do
let mut newGoal := goal
for hyp in ( goal.getNondepPropHyps) do
let result Lean.Meta.AC.acNfHypMeta newGoal hyp
if let .some nextGoal := result then
newGoal := nextGoal
else
return none
return newGoal
def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
let mut passPipeline := [rewriteRulesPass cfg.maxSteps]
if cfg.acNf then
passPipeline := passPipeline ++ [acNormalizePass]
@@ -34,20 +348,18 @@ def passPipeline : PreProcessM (List Pass) := do
passPipeline := passPipeline ++ [andFlatteningPass]
if cfg.embeddedConstraintSubst then
passPipeline := passPipeline ++ [embeddedConstraintPass]
passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
return passPipeline
def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
withTraceNode `bv (fun _ => return "Preprocessing goal") do
(go g).run cfg g
where
go (g : MVarId) : PreProcessM (Option MVarId) := do
let some g g.falseOrByContra | return none
end Pass
def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
withTraceNode `bv (fun _ => return "Normalizing goal") do
-- Contradiction proof
let some g g.falseOrByContra | return none
trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
let pipeline passPipeline
Pass.fixpointPipeline pipeline g
Pass.fixpointPipeline (Pass.passPipeline cfg) g
@[builtin_tactic Lean.Parser.Tactic.bvNormalize]
def evalBVNormalize : Tactic := fun

View File

@@ -1,39 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.AC.Main
/-!
This module contains the implementation of the associativity and commutativity normalisation pass
in the fixpoint pipeline.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Normalize with respect to Associativity and Commutativity.
-/
def acNormalizePass : Pass where
name := `ac_nf
run' goal := do
let mut newGoal := goal
for hyp in ( goal.getNondepPropHyps) do
let result AC.acNfHypMeta newGoal hyp
if let .some nextGoal := result then
newGoal := nextGoal
else
return none
return newGoal
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -1,99 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Normalize.Bool
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.Assert
/-!
This module contains the implementation of the and flattening pass in the fixpoint pipeline, taking
hypotheses of the form `h : x && y = true` and splitting them into `h1 : x = true` and
`h2 : y = true` recursively.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
structure AndFlattenState where
hypsToDelete : Array FVarId := #[]
hypsToAdd : Array Hypothesis := #[]
cache : Std.HashSet Expr := {}
/--
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
in embedded constraint substitution.
-/
partial def andFlatteningPass : Pass where
name := `andFlattening
run' goal := do
let (_, { hypsToDelete, hypsToAdd, .. }) processGoal goal |>.run {}
if hypsToAdd.isEmpty then
return goal
else
let (_, goal) goal.assertHypotheses hypsToAdd
-- Given that we collected the hypotheses in the correct order above the invariant is given
let goal goal.tryClearMany hypsToDelete
return goal
where
processGoal (goal : MVarId) : StateRefT AndFlattenState MetaM Unit := do
goal.withContext do
let hyps goal.getNondepPropHyps
hyps.forM processFVar
processFVar (fvar : FVarId) : StateRefT AndFlattenState MetaM Unit := do
let type fvar.getType
if ( get).cache.contains type then
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
else
let hyp := {
userName := ( fvar.getDecl).userName
type := type
value := mkFVar fvar
}
let some (lhs, rhs) trySplit hyp | return ()
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
splitAnds [lhs, rhs]
splitAnds (worklist : List Hypothesis) : StateRefT AndFlattenState MetaM Unit := do
match worklist with
| [] => return ()
| hyp :: worklist =>
match trySplit hyp with
| some (left, right) => splitAnds <| left :: right :: worklist
| none =>
modify (fun s => { s with hypsToAdd := s.hypsToAdd.push hyp })
splitAnds worklist
trySplit (hyp : Hypothesis) :
StateRefT AndFlattenState MetaM (Option (Hypothesis × Hypothesis)) := do
let typ := hyp.type
if ( get).cache.contains typ then
return none
else
modify (fun s => { s with cache := s.cache.insert typ })
let_expr Eq _ eqLhs eqRhs := typ | return none
let_expr Bool.and lhs rhs := eqLhs | return none
let_expr Bool.true := eqRhs | return none
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let leftHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
}
let rightHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
}
return some (leftHyp, rightHyp)
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -1,86 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Meta.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains the basic preprocessing pipeline framework for `bv_normalize`.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
structure PreProcessState where
/--
Contains `FVarId` that we already know are in `bv_normalize` simp normal form and thus don't
need to be processed again when we visit the next time.
-/
rewriteCache : Std.HashSet FVarId := {}
abbrev PreProcessM : Type Type := ReaderT BVDecideConfig <| StateRefT PreProcessState MetaM
namespace PreProcessM
def getConfig : PreProcessM BVDecideConfig := read
@[inline]
def checkRewritten (fvar : FVarId) : PreProcessM Bool := do
let val := ( get).rewriteCache.contains fvar
trace[Meta.Tactic.bv] m!"{mkFVar fvar} was already rewritten? {val}"
return val
@[inline]
def rewriteFinished (fvar : FVarId) : PreProcessM Unit := do
trace[Meta.Tactic.bv] m!"Adding {mkFVar fvar} to the rewritten set"
modify (fun s => { s with rewriteCache := s.rewriteCache.insert fvar })
def run (cfg : BVDecideConfig) (goal : MVarId) (x : PreProcessM α) : MetaM α := do
let hyps goal.getNondepPropHyps
ReaderT.run x cfg |>.run' { rewriteCache := Std.HashSet.empty hyps.size }
end PreProcessM
/--
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
the goal fully, indicated by returning `none`.
-/
structure Pass where
name : Name
run' : MVarId PreProcessM (Option MVarId)
namespace Pass
def run (pass : Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
withTraceNode `bv (fun _ => return m!"Running pass: {pass.name} on\n{goal}") do
pass.run' goal
/--
Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
the goal anymore.
-/
partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
let mut newGoal := goal
for pass in passes do
if let some nextGoal pass.run newGoal then
newGoal := nextGoal
else
trace[Meta.Tactic.bv] "Fixpoint iteration solved the goal"
return none
if goal != newGoal then
trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
fixpointPipeline passes newGoal
else
trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
return newGoal
end Pass
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -1,62 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Normalize.Bool
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.Simp
/-!
This module contains the implementation of the embedded constraint substitution pass in the fixpoint
pipeline, substituting hypotheses of the form `h : x = true` in other hypotheses.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
them to substitute occurences of `x` within other hypotheses. Additionally this drops all
redundant top level hypotheses.
-/
def embeddedConstraintPass : Pass where
name := `embeddedConstraintSubsitution
run' goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut relevantHyps : SimpTheoremsArray := #[]
let mut seen : Std.HashSet Expr := {}
let mut duplicates : Array FVarId := #[]
for hyp in hyps do
let typ hyp.getType
let_expr Eq _ lhs rhs := typ | continue
let_expr Bool.true := rhs | continue
if seen.contains lhs then
duplicates := duplicates.push hyp
else
seen := seen.insert lhs
let localDecl hyp.getDecl
let proof := localDecl.toExpr
relevantHyps relevantHyps.addTheorem (.fvar hyp) proof
let goal goal.tryClearMany duplicates
if relevantHyps.isEmpty then
return goal
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, maxSteps := cfg.maxSteps })
(simpTheorems := relevantHyps)
(congrTheorems := ( getSimpCongrTheorems))
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := goal.getNondepPropHyps)
let some (_, newGoal) := result? | return none
return newGoal
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -1,61 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains the implementation of the rewriting pass in the fixpoint pipeline, applying
rules from the `bv_normalize` simp set.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Responsible for applying the Bitwuzla style rewrite rules.
-/
def rewriteRulesPass : Pass where
name := `rewriteRules
run' goal := do
let bvThms bvNormalizeExt.getTheorems
let bvSimprocs bvNormalizeSimprocExt.getSimprocs
let sevalThms getSEvalTheorems
let sevalSimprocs Simp.getSEvalSimprocs
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps := cfg.maxSteps })
(simpTheorems := #[bvThms, sevalThms])
(congrTheorems := ( getSimpCongrTheorems))
let hyps getHyps goal
if hyps.isEmpty then
return goal
else
let result?, _ simpGoal goal
(ctx := simpCtx)
(simprocs := #[bvSimprocs, sevalSimprocs])
(fvarIdsToSimp := hyps)
let some (_, newGoal) := result? | return none
newGoal.withContext do
( newGoal.getNondepPropHyps).forM PreProcessM.rewriteFinished
return newGoal
where
getHyps (goal : MVarId) : PreProcessM (Array FVarId) := do
goal.withContext do
let mut hyps goal.getNondepPropHyps
let filter hyp := do
return !( PreProcessM.checkRewritten hyp)
hyps.filterM filter
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -1,164 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Normalize
import Std.Tactic.BVDecide.Syntax
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains implementations of simprocs used in the `bv_normalize` simp set.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
open Std.Tactic.BVDecide.Normalize
builtin_simproc [bv_normalize] reduceCond (cond _ _ _) := fun e => do
let_expr f@cond α c tb eb := e | return .continue
let r Simp.simp c
if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := tb, proof? := pr }
else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := eb, proof? := pr }
else
return .continue
builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
let_expr Eq _ lhs rhs := e | return .continue
match_expr rhs with
| Bool.true => return .continue
| _ =>
let beqApp mkAppM ``BEq.beq #[lhs, rhs]
let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
return .done { expr := new, proof? := some proof }
builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, rhsValue getBitVecValue? rhs | return .continue
if rhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
return .visit { expr := lhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
return .visit { expr := rhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
let_expr BitVec.ult _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
return .visit { expr := toExpr Bool.false, proof? := some proof }
else
return .continue
-- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
let_expr Neg.neg typ _ val := e | return .continue
let_expr BitVec widthExpr := typ | return .continue
let some w getNatValue? widthExpr | return .continue
match getBitVecValue? val with
| some _ => return .continue
| none =>
let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
let expr mkAppM ``HAdd.hAdd #[ mkAppM ``Complement.complement #[val], (toExpr 1#w)]
return .visit { expr := expr, proof? := some proof }
builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
let some w, exp1Val getBitVecValue? exp1 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp2 with
| some w', exp2Val =>
if h : w = w' then
let newLhs := exp1Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp3Val getBitVecValue? exp3 | return .continue
if h : w = w' then
let newLhs := exp1Val + h exp3Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
return .visit { expr := expr, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
let some w, exp3Val getBitVecValue? exp3 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp1 with
| some w', exp1Val =>
if h : w = w' then
let newLhs := exp3Val + h exp1Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp2Val getBitVecValue? exp2 | return .continue
if h : w = w' then
let newLhs := exp3Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
return .visit { expr := expr, proof? := some proof }
else
return .continue
/-- Return a number `k` such that `2^k = n`. -/
private def Nat.log2Exact (n : Nat) : Option Nat := do
guard <| n 0
let k := n.log2
guard <| Nat.pow 2 k == n
return k
-- Build an expression for `x ^ y`.
def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
let some w, yVal getBitVecValue? y | return .continue
let n := yVal.toNat
-- BitVec.ofNat w n, where n =def= 2^k
let some k := Nat.log2Exact n | return .continue
-- check that k < w.
if k w then return .continue
let rhs mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
-- 2^k = n
let hk mkDecideProof ( mkEq ( mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
-- k < w
let hlt mkDecideProof ( mkLt (mkNatLit k) (mkNatLit w))
let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
#[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
return .done {
expr := rhs
proof? := some proof
}
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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 config}"
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 ())

View File

@@ -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

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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!

View File

@@ -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

View File

@@ -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

View File

@@ -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 }

View File

@@ -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,22 +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
builtin_initialize registerTraceClass `grind.offset.eq
builtin_initialize registerTraceClass `grind.offset.eq.to (inherited := true)
builtin_initialize registerTraceClass `grind.offset.eq.from (inherited := true)
/-! Trace options for `grind` developers -/
builtin_initialize registerTraceClass `grind.debug
@@ -60,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

View File

@@ -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

View File

@@ -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) (parent? : Option Expr) : GoalM Unit := do
Offset.internalize e parent?
end Lean.Meta.Grind.Arith

View File

@@ -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

View File

@@ -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

View File

@@ -1,46 +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
import Lean.Meta.Tactic.Grind.Util
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
let e := nodes[u]!
/-
We should not include the assignment for auxiliary offset terms since
they do not provide any additional information.
-/
if (isNatOffset? e).isNone && isNatNum? e != some 0 then
r := r.push (e, val)
return r
end Lean.Meta.Grind.Arith.Offset

View File

@@ -1,335 +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 {}
}
markAsOffsetTerm expr
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
private def getNodeId (e : Expr) : GoalM NodeId := do
let some nodeId := ( get').nodeMap.find? { expr := e }
| throwError "internal `grind` error, term has not been internalized by offset module{indentExpr e}"
return nodeId
/--
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
/--
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' }
/-- Equality propagation. -/
private def propagateEq (u v : NodeId) (k : Int) : GoalM Unit := do
if k != 0 then return ()
let some k' getDist? v u | return ()
if k' != 0 then return ()
let ue getExpr u
let ve getExpr v
if ( isEqv ue ve) then return ()
let huv mkProofForPath u v
let hvu mkProofForPath v u
trace[grind.offset.eq.from] "{ue}, {ve}"
pushEq ue ve <| mkApp4 (mkConst ``Grind.Nat.eq_of_le_of_le) ue ve huv hvu
/-- 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)
propagateEq u v k
/--
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
private def internalizeCnstr (e : Expr) (c : Cnstr Expr) : GoalM Unit := do
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
}
private def getZeroNode : GoalM NodeId := do
mkNode ( getNatZeroExpr)
/-- Internalize `e` of the form `b + k` -/
private def internalizeTerm (e : Expr) (b : Expr) (k : Nat) : GoalM Unit := do
-- `e` is of the form `b + k`
let u mkNode e
let v mkNode b
-- `u = v + k`. So, we add edges for `u ≤ v + k` and `v + k ≤ u`.
let h := mkApp (mkConst ``Nat.le_refl) e
addEdge u v k h
addEdge v u (-k) h
-- `0 + k ≤ u`
let z getZeroNode
addEdge z u (-k) <| mkApp2 (mkConst ``Grind.Nat.le_offset) b (toExpr k)
/--
Returns `true`, if `parent?` is relevant for internalization.
For example, we do not want to internalize an offset term that
is the child of an addition. This kind of term will be processed by the
more general linear arithmetic module.
-/
private def isRelevantParent (parent? : Option Expr) : GoalM Bool := do
let some parent := parent? | return false
let z getNatZeroExpr
return !isNatAdd parent && (isNatOffsetCnstr? parent z).isNone
private def isEqParent (parent? : Option Expr) : Bool := Id.run do
let some parent := parent? | return false
return parent.isEq
def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
let z getNatZeroExpr
if let some c := isNatOffsetCnstr? e z then
internalizeCnstr e c
else if ( isRelevantParent parent?) then
if let some (b, k) := isNatOffset? e then
internalizeTerm e b k
else if let some k := isNatNum? e then
-- core module has support for detecting equality between literals
unless isEqParent parent? do
internalizeTerm e z k
@[export lean_process_new_offset_eq]
def processNewOffsetEqImpl (a b : Expr) : GoalM Unit := do
unless isSameExpr a b do
trace[grind.offset.eq.to] "{a}, {b}"
let u getNodeId a
let v getNodeId b
let h mkEqProof a b
addEdge u v 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
addEdge v u 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
@[export lean_process_new_offset_eq_lit]
def processNewOffsetEqLitImpl (a b : Expr) : GoalM Unit := do
unless isSameExpr a b do
trace[grind.offset.eq.to] "{a}, {b}"
let some k := isNatNum? b | unreachable!
let u getNodeId a
let z mkNode ( getNatZeroExpr)
let h mkEqProof a b
addEdge u z k <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
addEdge z u (-k) <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
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]!
if c.k == 0 then
return mkNatLE u v
else if c.k < 0 then
return mkNatLE (mkNatAdd u (Lean.toExpr ((-c.k).toNat))) v
else
return mkNatLE 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

View File

@@ -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 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

View File

@@ -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

View File

@@ -1,102 +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 `true` if `e` is of the form
```
@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) _ _
```
-/
def isNatAdd (e : Expr) : Bool :=
let_expr HAdd.hAdd _ _ _ i _ _ := e | false
isInstAddNat i
/-- 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
deriving Inhabited
def Offset.Cnstr.neg : Cnstr α Cnstr α
| { u, v, k } => { u := v, v := u, 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 with
| .ofNat 0 => m!"{c.u} ≤ {c.v}"
| .ofNat k => m!"{c.u} ≤ {c.v} + {k}"
| .negSucc k => 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.
Remark: `z` is `0` numeral. It is an extra argument because we
want to be able to provide the one that has already been internalized.
-/
def isNatOffsetCnstr? (e : Expr) (z : Expr) : Option (Offset.Cnstr Expr) :=
match_expr e with
| LE.le _ inst a b => if isInstLENat inst then go a b else none
| _ => none
where
go (u v : Expr) :=
if let some (u, k) := isNatOffset? u then
some { u, k := - k, v }
else if let some (v, k) := isNatOffset? v then
some { u, v, k }
else if let some k := isNatNum? u then
some { u := z, v, k := - k }
else if let some k := isNatNum? v then
some { u, v := z, k }
else
some { u, v }
end Lean.Meta.Grind.Arith

View File

@@ -10,7 +10,6 @@ import Lean.Meta.FunInfo
import Lean.Util.FVarSubset
import Lean.Util.PtrSet
import Lean.Util.FVarSubset
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
namespace Canon
@@ -23,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.
@@ -41,37 +40,22 @@ additions will still use structurally different (and definitionally different) i
Furthermore, `grind` will not be able to infer that `HEq (a + a) (b + b)` even if we add the assumptions `n = m` and `HEq a b`.
-/
@[inline] private def get' : GoalM State :=
return ( get).canon
@[inline] private def modify' (f : State State) : GoalM Unit :=
modify fun s => { s with canon := f s.canon }
/--
Helper function for `canonElemCore`. It tries `isDefEq a b` with default transparency, but using
at most `canonHeartbeats` heartbeats. It reports an issue if the threshold is reached.
Remark: `parent` is use only to report an issue
-/
private def isDefEqBounded (a b : Expr) (parent : Expr) : GoalM Bool := do
withCurrHeartbeats do
let config getConfig
tryCatchRuntimeEx
(withTheReader Core.Context (fun ctx => { ctx with maxHeartbeats := config.canonHeartbeats }) do
withDefault <| isDefEq a b)
fun ex => do
if ex.isRuntime then
let curr := ( getConfig).canonHeartbeats
reportIssue m!"failed to show that{indentExpr a}\nis definitionally equal to{indentExpr b}\nwhile canonicalizing{indentExpr parent}\nusing `{curr}*1000` heartbeats, `(canonHeartbeats := {curr})`"
return false
else
throw ex
structure State where
argMap : PHashMap (Expr × Nat) (List Expr) := {}
canon : PHashMap Expr Expr := {}
proofCanon : PHashMap Expr Expr := {}
deriving Inhabited
/--
Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
If `useIsDefEqBounded` is `true`, we try `isDefEqBounded` before returning false
`isInst` is true if `e` is an type class instance.
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 (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBounded : Bool) : GoalM Expr := do
let s get'
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
let key := (f, i)
@@ -81,23 +65,17 @@ def canonElemCore (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBou
-- We used to check `c.fvarsSubset e` because it is not
-- 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.
-- Moreover, we store the canonicalizer state in the `Goal` because we case-split
-- and different locals are added in different branches.
modify' fun s => { s with canon := s.canon.insert e c }
trace[grind.debugn.canon] "found {e} ===> {c}"
modify fun s => { s with canon := s.canon.insert e c }
return c
if useIsDefEqBounded then
if ( isDefEqBounded e c parent) then
modify' fun s => { s with canon := s.canon.insert e c }
trace[grind.debugn.canon] "found using `isDefEqBounded`: {e} ===> {c}"
return c
trace[grind.debug.canon] "({f}, {i}) ↦ {e}"
modify' fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
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 `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 (parent f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore parent f i e (useIsDefEqBounded := false)
abbrev canonInst (parent f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore parent f i e (useIsDefEqBounded := true)
abbrev canonImplicit (parent f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore parent f i e (useIsDefEqBounded := true)
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.
@@ -107,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.
@@ -116,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`.
-/
@@ -133,68 +102,62 @@ 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
unsafe def canonImpl (e : Expr) : GoalM Expr := do
unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
visit e |>.run' mkPtrMap
where
visit (e : Expr) : StateRefT (PtrMap Expr Expr) GoalM 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
visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
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 := ( get').proofCanon.find? prop' then
if let some r := ( getThe State).proofCanon.find? prop' then
pure r
else
let e' := if ptrEq prop prop' then e else mkAppN f (args.set! 0 prop')
modify' fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
modifyThe State fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
pure e'
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 e f i arg
| .canonInst => canonInst e f i arg
| .canonImplicit => canonImplicit e f i ( visit arg)
| .canonType => canonType f i arg
| .canonInst => canonInst f i 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 :=
unsafe canonImpl e
end Canon
/-- Canonicalizes nested types, type formers, and instances in `e`. -/
def canon (e : Expr) : GoalM Expr := do
trace[grind.debug.canon] "{e}"
unsafe Canon.canonImpl e
end Lean.Meta.Grind

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -10,7 +10,6 @@ import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Inv
import Lean.Meta.Tactic.Grind.PP
import Lean.Meta.Tactic.Grind.Ctor
import Lean.Meta.Tactic.Grind.Util
import Lean.Meta.Tactic.Grind.Internalize
namespace Lean.Meta.Grind
@@ -42,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
@@ -54,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. -/
@@ -87,34 +85,14 @@ private partial def updateMT (root : Expr) : GoalM Unit := do
setENode parent { node with mt := gmt }
updateMT parent
/--
Helper function for combining `ENode.offset?` fields and propagating an equality
to the offset constraint module.
-/
private def propagateOffsetEq (rhsRoot lhsRoot : ENode) : GoalM Unit := do
match lhsRoot.offset? with
| some lhsOffset =>
if let some rhsOffset := rhsRoot.offset? then
Arith.processNewOffsetEq lhsOffset rhsOffset
else if isNatNum rhsRoot.self then
Arith.processNewOffsetEqLit lhsOffset rhsRoot.self
else
-- We have to retrieve the node because other fields have been updated
let rhsRoot getENode rhsRoot.self
setENode rhsRoot.self { rhsRoot with offset? := lhsOffset }
| none =>
if isNatNum lhsRoot.self then
if let some rhsOffset := rhsRoot.offset? then
Arith.processNewOffsetEqLit rhsOffset lhsRoot.self
private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit := do
let lhsNode getENode lhs
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
@@ -139,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`
@@ -160,34 +138,33 @@ 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
}
setENode rhsNode.root { rhsRoot with
next := lhsRoot.next
size := rhsRoot.size + lhsRoot.size
next := lhsRoot.next
size := rhsRoot.size + lhsRoot.size
hasLambdas := rhsRoot.hasLambdas || lhsRoot.hasLambdas
heqProofs := isHEq || rhsRoot.heqProofs || lhsRoot.heqProofs
}
copyParentsTo parents rhsNode.root
unless ( isInconsistent) do
updateMT rhsRoot.self
propagateOffsetEq rhsRoot lhsRoot
unless ( isInconsistent) do
for parent in parents do
propagateUp parent
unless ( isInconsistent) do
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 :=
@@ -213,30 +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
let eq mkEq lhs rhs
storeFact eq
internalize lhs generation eq
internalize rhs generation eq
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
@@ -245,30 +209,22 @@ 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
internalize p generation
addEq p ( getFalseExpr) ( mkEqFalse proof)
else
internalize lhs generation p
internalize rhs generation p
internalize lhs generation
internalize rhs generation
addEqCore lhs rhs proof isHEq
/-- Adds a new hypothesis. -/

View File

@@ -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
| _ =>
reportIssue m!"unexpected injectivity theorem result type{indentExpr eqs}"
trace[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
return ()
/--

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