mirror of
https://github.com/leanprover/lean4.git
synced 2026-04-06 20:24:08 +00:00
Compare commits
1 Commits
getElem_fl
...
grind_offs
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
fddf38a3e9 |
4
.github/workflows/ci.yml
vendored
4
.github/workflows/ci.yml
vendored
@@ -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
|
||||
|
||||
@@ -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()
|
||||
|
||||
@@ -33,9 +33,6 @@ Format of the commit message
|
||||
- chore (maintain, ex: travis-ci)
|
||||
- perf (performance improvement, optimization, ...)
|
||||
|
||||
Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
|
||||
beginning with "This PR " that will be included in the changelog.
|
||||
|
||||
``<subject>`` has the following constraints:
|
||||
|
||||
- use imperative, present tense: "change" not "changed" nor "changes"
|
||||
@@ -47,7 +44,6 @@ beginning with "This PR " that will be included in the changelog.
|
||||
- just as in ``<subject>``, use imperative, present tense
|
||||
- includes motivation for the change and contrasts with previous
|
||||
behavior
|
||||
- If a `changelog-*` label is present, the body must begin with "This PR ".
|
||||
|
||||
``<footer>`` is optional and may contain two items:
|
||||
|
||||
@@ -64,21 +60,17 @@ Examples
|
||||
|
||||
fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
|
||||
|
||||
This PR adds declarations `operator<<` for raw printing.
|
||||
The actual implementation of these two operators is outside of the
|
||||
kernel. They are implemented in the file 'library/printer.cpp'.
|
||||
|
||||
We declare them in the kernel to prevent the following problem.
|
||||
Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
kernel. They are implemented in the file 'library/printer.cpp'. We
|
||||
declare them in the kernel to prevent the following problem. Suppose
|
||||
there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
but contains
|
||||
```cpp
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
```
|
||||
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
|
||||
The compiler does not generate an error message. It silently uses the
|
||||
operator bool() to coerce the expression into a Boolean. This produces
|
||||
counter-intuitive behavior, and may confuse developers.
|
||||
|
||||
|
||||
@@ -49,9 +49,8 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
|
||||
is represented by the representation of that parameter's type.
|
||||
|
||||
For example, `{ x : α // p }`, the `Subtype` structure of a value of type `α` and an irrelevant proof, is represented by the representation of `α`.
|
||||
Similarly, the signed integer types `Int8`, ..., `Int64`, `ISize` are also represented by the unsigned C types `uint8_t`, ..., `uint64_t`, `size_t`, respectively, because they have a trivial structure.
|
||||
* `Nat` and `Int` are represented by `lean_object *`.
|
||||
Their runtime values is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number or integer (`lean_box`/`lean_unbox`).
|
||||
* `Nat` is represented by `lean_object *`.
|
||||
Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
|
||||
* A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
|
||||
* Any other type is represented by `lean_object *`.
|
||||
Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.
|
||||
|
||||
@@ -80,10 +80,3 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
|
||||
`prelude` keyword. This disables the automated import of `Init`, meaning that
|
||||
developers need to figure out their own subset of `Init` to import. This is done
|
||||
such that changing files in `Init` doesn't force a full rebuild of `Lean`.
|
||||
|
||||
### Testing against Mathlib/Batteries
|
||||
You can test a Lean PR against Mathlib and Batteries by rebasing your PR
|
||||
on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
|
||||
CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
|
||||
that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
|
||||
See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.
|
||||
|
||||
@@ -37,32 +37,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,6 +61,17 @@ 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`
|
||||
- [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
|
||||
- [import-graph](https://github.com/leanprover-community/import-graph)
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
```
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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" ];
|
||||
|
||||
@@ -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()
|
||||
@@ -22,36 +22,6 @@ def get_github_token():
|
||||
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 {}
|
||||
@@ -65,20 +35,11 @@ def get_branch_content(repo_url, branch, file_path, github_token):
|
||||
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 tag_exists(repo_url, tag_name, github_token):
|
||||
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
|
||||
headers = {'Authorization': f'token {github_token}'} if github_token else {}
|
||||
response = requests.get(api_url, headers=headers)
|
||||
return response.status_code == 200
|
||||
|
||||
def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
|
||||
# First get the commit SHA for the tag
|
||||
@@ -103,38 +64,23 @@ def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
|
||||
stable_commits = [commit['sha'] for commit in commits_response.json()]
|
||||
return tag_sha in stable_commits
|
||||
|
||||
def parse_version(version_str):
|
||||
# Remove 'v' prefix and split into components
|
||||
# Handle Lean toolchain format (leanprover/lean4:v4.x.y)
|
||||
if ':' in version_str:
|
||||
version_str = version_str.split(':')[1]
|
||||
version = version_str.lstrip('v')
|
||||
# Handle release candidates by removing -rc part for comparison
|
||||
version = version.split('-')[0]
|
||||
return tuple(map(int, version.split('.')))
|
||||
|
||||
def is_version_gte(version1, version2):
|
||||
"""Check if version1 >= version2"""
|
||||
return parse_version(version1) >= parse_version(version2)
|
||||
|
||||
def is_release_candidate(version):
|
||||
return "-rc" in version
|
||||
|
||||
def 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()
|
||||
|
||||
@@ -143,47 +89,6 @@ def main():
|
||||
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"]
|
||||
@@ -212,7 +117,7 @@ def main():
|
||||
# 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}`.")
|
||||
print(f" ❌ Tag {toolchain} does not exist")
|
||||
continue
|
||||
print(f" ✅ Tag {toolchain} exists")
|
||||
|
||||
|
||||
@@ -27,13 +27,6 @@ repositories:
|
||||
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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -150,10 +150,6 @@ See the `simp` tactic for more information. -/
|
||||
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
/-- `simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
|
||||
that would be sufficient to close the goal. See the `simp?` tactic for more information. -/
|
||||
syntax (name := simpTrace) "simp?" optConfig (discharger)? (&" only")? (simpArgs)? : conv
|
||||
|
||||
/--
|
||||
`dsimp` is the definitional simplifier in `conv`-mode. It differs from `simp` in that it only
|
||||
applies theorems that hold by reflexivity.
|
||||
@@ -171,9 +167,6 @@ example (a : Nat): (0 + 0) = a - a := by
|
||||
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
@[inherit_doc simpTrace]
|
||||
syntax (name := dsimpTrace) "dsimp?" optConfig (&" only")? (dsimpArgs)? : conv
|
||||
|
||||
/-- `simp_match` simplifies match expressions. For example,
|
||||
```
|
||||
match [a, b] with
|
||||
|
||||
@@ -244,7 +244,8 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
|
||||
def range (n : Nat) : Array Nat :=
|
||||
ofFn fun (i : Fin n) => i
|
||||
|
||||
@[inline] protected def singleton (v : α) : Array α := #[v]
|
||||
def singleton (v : α) : Array α :=
|
||||
mkArray 1 v
|
||||
|
||||
def back! [Inhabited α] (a : Array α) : α :=
|
||||
a[a.size - 1]!
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -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
@@ -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]
|
||||
@@ -2315,12 +2300,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]
|
||||
@@ -2607,13 +2586,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 +2628,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 +2640,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 +2667,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 +2823,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 +2967,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 +3104,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 +3406,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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -1076,31 +1075,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 +1086,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 +1114,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 +1280,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 +1489,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 +1556,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 +1580,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 +1609,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 +1637,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 +1686,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
|
||||
@@ -1898,7 +1868,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 +1883,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 +1908,7 @@ 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
|
||||
@[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 +1961,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 +1969,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 +1989,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 +2009,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 +2027,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 +2332,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -203,11 +203,11 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
|
||||
cases l₂ with
|
||||
| nil =>
|
||||
constructor
|
||||
· simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, exists_and_left, and_imp]
|
||||
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
|
||||
rintro rfl rfl
|
||||
exact ⟨[], x₁ :: l₁, [], by simp⟩
|
||||
· rintro ⟨w, x, y, z, h₁, _, h₃, rfl, rfl⟩
|
||||
simp only [nil_eq, append_eq_nil_iff] at h₃
|
||||
simp only [nil_eq, append_eq_nil] at h₃
|
||||
obtain ⟨rfl, rfl⟩ := h₃
|
||||
simp
|
||||
| cons x₂ l₂ =>
|
||||
|
||||
@@ -49,17 +49,4 @@ theorem lt_div_mul_self (h : 0 < k) (w : k ≤ x) : x - k < x / k * k := by
|
||||
have : x % k < k := mod_lt x h
|
||||
omega
|
||||
|
||||
theorem div_pos (hba : b ≤ a) (hb : 0 < b) : 0 < a / b := by
|
||||
cases b
|
||||
· contradiction
|
||||
· simp [Nat.pos_iff_ne_zero, div_eq_zero_iff_lt, hba]
|
||||
|
||||
theorem div_le_div_left (hcb : c ≤ b) (hc : 0 < c) : a / b ≤ a / c :=
|
||||
(Nat.le_div_iff_mul_le hc).2 <|
|
||||
Nat.le_trans (Nat.mul_le_mul_left _ hcb) (Nat.div_mul_le_self a b)
|
||||
|
||||
theorem div_add_le_right {z : Nat} (h : 0 < z) (x y : Nat) :
|
||||
x / (y + z) ≤ x / z :=
|
||||
div_le_div_left (Nat.le_add_left z y) h
|
||||
|
||||
end Nat
|
||||
|
||||
@@ -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 :=
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -159,8 +159,6 @@ def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.toBitVec <<< (mod b 32).toBitVec⟩
|
||||
@[extern "lean_uint32_shift_right"]
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
|
||||
def UInt32.lt (a b : UInt32) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt32.le (a b : UInt32) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance : Add UInt32 := ⟨UInt32.add⟩
|
||||
instance : Sub UInt32 := ⟨UInt32.sub⟩
|
||||
@@ -171,8 +169,6 @@ set_option linter.deprecated false in
|
||||
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
|
||||
|
||||
instance : Div UInt32 := ⟨UInt32.div⟩
|
||||
instance : LT UInt32 := ⟨UInt32.lt⟩
|
||||
instance : LE UInt32 := ⟨UInt32.le⟩
|
||||
|
||||
@[extern "lean_uint32_complement"]
|
||||
def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
@@ -13,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]
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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. -/
|
||||
@@ -170,13 +170,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⟩
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -157,14 +153,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 +685,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,6 +1035,8 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
cases l₂
|
||||
simp
|
||||
|
||||
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
|
||||
|
||||
/-! ### map -/
|
||||
|
||||
@[simp] theorem getElem_map (f : α → β) (a : Vector α n) (i : Nat) (hi : i < n) :
|
||||
@@ -1072,589 +1044,16 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
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]
|
||||
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 +1078,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) :
|
||||
|
||||
@@ -11,4 +11,3 @@ import Init.Grind.Cases
|
||||
import Init.Grind.Propagator
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.Offset
|
||||
import Init.Grind.PP
|
||||
|
||||
@@ -12,9 +12,6 @@ import Init.Grind.Util
|
||||
|
||||
namespace Lean.Grind
|
||||
|
||||
theorem rfl_true : true = true :=
|
||||
rfl
|
||||
|
||||
theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' → q) : p → q :=
|
||||
fun hp => h (he.mp hp)
|
||||
|
||||
@@ -69,12 +66,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
|
||||
|
||||
@@ -43,14 +43,8 @@ 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
|
||||
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
|
||||
-- @[grind_norm↓] theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
|
||||
-- by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
-- And
|
||||
@[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
|
||||
|
||||
@@ -8,85 +8,125 @@ 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
|
||||
abbrev Var := Nat
|
||||
abbrev Context := Lean.RArray Nat
|
||||
|
||||
/-! 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
|
||||
def fixedVar := 100000000 -- Any big number should work here
|
||||
|
||||
/-! 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
|
||||
def Var.denote (ctx : Context) (v : Var) : Nat :=
|
||||
bif v == fixedVar then 1 else ctx.get v
|
||||
|
||||
/-! 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
|
||||
structure Cnstr where
|
||||
x : Var
|
||||
y : Var
|
||||
k : Nat := 0
|
||||
l : Bool := true
|
||||
deriving Repr, BEq, Inhabited
|
||||
|
||||
/-!
|
||||
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
|
||||
def Cnstr.denote (c : Cnstr) (ctx : Context) : Prop :=
|
||||
if c.l then
|
||||
c.x.denote ctx + c.k ≤ c.y.denote ctx
|
||||
else
|
||||
c.x.denote ctx ≤ c.y.denote ctx + c.k
|
||||
|
||||
/-!
|
||||
Helper theorems for equality propagation
|
||||
-/
|
||||
def trivialCnstr : Cnstr := { x := 0, y := 0, k := 0, l := true }
|
||||
|
||||
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
|
||||
@[simp] theorem denote_trivial (ctx : Context) : trivialCnstr.denote ctx := by
|
||||
simp [Cnstr.denote, trivialCnstr]
|
||||
|
||||
def Cnstr.trans (c₁ c₂ : Cnstr) : Cnstr :=
|
||||
if c₁.y = c₂.x then
|
||||
let { x, k := k₁, l := l₁, .. } := c₁
|
||||
let { y, k := k₂, l := l₂, .. } := c₂
|
||||
match l₁, l₂ with
|
||||
| false, false =>
|
||||
{ x, y, k := k₁ + k₂, l := false }
|
||||
| false, true =>
|
||||
if k₁ < k₂ then
|
||||
{ x, y, k := k₂ - k₁, l := true }
|
||||
else
|
||||
{ x, y, k := k₁ - k₂, l := false }
|
||||
| true, false =>
|
||||
if k₁ < k₂ then
|
||||
{ x, y, k := k₂ - k₁, l := false }
|
||||
else
|
||||
{ x, y, k := k₁ - k₂, l := true }
|
||||
| true, true =>
|
||||
{ x, y, k := k₁ + k₂, l := true }
|
||||
else
|
||||
trivialCnstr
|
||||
|
||||
@[simp] theorem Cnstr.denote_trans_easy (ctx : Context) (c₁ c₂ : Cnstr) (h : c₁.y ≠ c₂.x) : (c₁.trans c₂).denote ctx := by
|
||||
simp [*, Cnstr.trans]
|
||||
|
||||
@[simp] theorem Cnstr.denote_trans (ctx : Context) (c₁ c₂ : Cnstr) : c₁.denote ctx → c₂.denote ctx → (c₁.trans c₂).denote ctx := by
|
||||
by_cases c₁.y = c₂.x
|
||||
case neg => simp [*]
|
||||
simp [trans, *]
|
||||
let { x, k := k₁, l := l₁, .. } := c₁
|
||||
let { y, k := k₂, l := l₂, .. } := c₂
|
||||
simp_all; split
|
||||
· simp [denote]; omega
|
||||
· split <;> simp [denote] <;> omega
|
||||
· split <;> simp [denote] <;> omega
|
||||
· simp [denote]; omega
|
||||
|
||||
def Cnstr.isTrivial (c : Cnstr) : Bool := c.x == c.y && c.k == 0
|
||||
|
||||
theorem Cnstr.of_isTrivial (ctx : Context) (c : Cnstr) : c.isTrivial = true → c.denote ctx := by
|
||||
cases c; simp [isTrivial]; intros; simp [*, denote]
|
||||
|
||||
def Cnstr.isFalse (c : Cnstr) : Bool := c.x == c.y && c.k != 0 && c.l == true
|
||||
|
||||
theorem Cnstr.of_isFalse (ctx : Context) {c : Cnstr} : c.isFalse = true → ¬c.denote ctx := by
|
||||
cases c; simp [isFalse]; intros; simp [*, denote]; omega
|
||||
|
||||
def Certificate := List Cnstr
|
||||
|
||||
def Certificate.denote' (ctx : Context) (c₁ : Cnstr) (c₂ : Certificate) : Prop :=
|
||||
match c₂ with
|
||||
| [] => c₁.denote ctx
|
||||
| c::cs => c₁.denote ctx ∧ Certificate.denote' ctx c cs
|
||||
|
||||
theorem Certificate.denote'_trans (ctx : Context) (c₁ c : Cnstr) (cs : Certificate) : c₁.denote ctx → denote' ctx c cs → denote' ctx (c₁.trans c) cs := by
|
||||
induction cs
|
||||
next => simp [denote', *]; apply Cnstr.denote_trans
|
||||
next c cs ih => simp [denote']; intros; simp [*]
|
||||
|
||||
def Certificate.trans' (c₁ : Cnstr) (c₂ : Certificate) : Cnstr :=
|
||||
match c₂ with
|
||||
| [] => c₁
|
||||
| c::c₂ => trans' (c₁.trans c) c₂
|
||||
|
||||
@[simp] theorem Certificate.denote'_trans' (ctx : Context) (c₁ : Cnstr) (c₂ : Certificate) : denote' ctx c₁ c₂ → (trans' c₁ c₂).denote ctx := by
|
||||
induction c₂ generalizing c₁
|
||||
next => intros; simp_all [trans', denote']
|
||||
next c cs ih => simp [denote']; intros; simp [trans']; apply ih; apply denote'_trans <;> assumption
|
||||
|
||||
def Certificate.denote (ctx : Context) (c : Certificate) : Prop :=
|
||||
match c with
|
||||
| [] => True
|
||||
| c::cs => denote' ctx c cs
|
||||
|
||||
def Certificate.trans (c : Certificate) : Cnstr :=
|
||||
match c with
|
||||
| [] => trivialCnstr
|
||||
| c::cs => trans' c cs
|
||||
|
||||
theorem Certificate.denote_trans {ctx : Context} {c : Certificate} : c.denote ctx → c.trans.denote ctx := by
|
||||
cases c <;> simp [*, trans, Certificate.denote] <;> intros <;> simp [*]
|
||||
|
||||
def Certificate.isFalse (c : Certificate) : Bool :=
|
||||
c.trans.isFalse
|
||||
|
||||
theorem Certificate.unsat (ctx : Context) (c : Certificate) : c.isFalse = true → ¬ c.denote ctx := by
|
||||
simp [isFalse]; intro h₁ h₂
|
||||
have := Certificate.denote_trans h₂
|
||||
have := Cnstr.of_isFalse ctx h₁
|
||||
contradiction
|
||||
|
||||
theorem Certificate.imp (ctx : Context) (c : Certificate) : c.denote ctx → c.trans.denote ctx := by
|
||||
apply denote_trans
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -1,30 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Lean.Grind
|
||||
/-!
|
||||
This is a hackish module for hovering node information in the `grind` tactic state.
|
||||
-/
|
||||
|
||||
inductive NodeDef where
|
||||
| unit
|
||||
|
||||
set_option linter.unusedVariables false in
|
||||
def node_def (_ : Nat) {α : Sort u} {a : α} : NodeDef := .unit
|
||||
|
||||
@[app_unexpander node_def]
|
||||
def nodeDefUnexpander : PrettyPrinter.Unexpander := fun stx => do
|
||||
match stx with
|
||||
| `($_ $id:num) => return mkIdent <| Name.mkSimple $ "#" ++ toString id.getNat
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander NodeDef]
|
||||
def NodeDefUnexpander : PrettyPrinter.Unexpander := fun _ => do
|
||||
return mkIdent <| Name.mkSimple "NodeDef"
|
||||
|
||||
end Lean.Grind
|
||||
@@ -25,7 +25,7 @@ Passed to `grind` using, for example, the `grind (config := { matchEqs := true }
|
||||
-/
|
||||
structure Config where
|
||||
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
|
||||
splits : Nat := 8
|
||||
splits : Nat := 5
|
||||
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
|
||||
ematch : Nat := 5
|
||||
/--
|
||||
@@ -45,10 +45,6 @@ structure Config where
|
||||
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
|
||||
|
||||
@@ -9,7 +9,7 @@ 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.
|
||||
@@ -28,7 +28,7 @@ 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
|
||||
|
||||
@@ -21,6 +21,11 @@ def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration
|
||||
else
|
||||
addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
|
||||
|
||||
def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
|
||||
let env ← addDecl env opts decl cancelTk?
|
||||
compileDecl env opts decl
|
||||
|
||||
def addDecl (decl : Declaration) : CoreM Unit := do
|
||||
profileitM Exception "type checking" (← getOptions) do
|
||||
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
|
||||
|
||||
@@ -144,7 +144,11 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
|
||||
let type := mkApp (mkConst `IO) (mkConst `Unit)
|
||||
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
|
||||
safety := DefinitionSafety.safe }
|
||||
addAndCompile decl
|
||||
IO.ofExcept (setBuiltinInitAttr (← getEnv) name) >>= setEnv
|
||||
match (← getEnv).addAndCompile {} decl with
|
||||
-- TODO: pretty print error
|
||||
| Except.error e => do
|
||||
let msg ← (e.toMessageData {}).toString
|
||||
throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
|
||||
| Except.ok env => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -53,3 +53,18 @@ def isUnsafeRecName? : Name → Option Name
|
||||
| _ => none
|
||||
|
||||
end Compiler
|
||||
|
||||
namespace Environment
|
||||
|
||||
/--
|
||||
Compile the given block of mutual declarations.
|
||||
Assumes the declarations have already been added to the environment using `addDecl`.
|
||||
-/
|
||||
@[extern "lean_compile_decls"]
|
||||
opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
|
||||
|
||||
/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
|
||||
def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
|
||||
compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
|
||||
|
||||
end Environment
|
||||
|
||||
@@ -514,16 +514,13 @@ register_builtin_option compiler.enableNew : Bool := {
|
||||
@[extern "lean_lcnf_compile_decls"]
|
||||
opaque compileDeclsNew (declNames : List Name) : CoreM Unit
|
||||
|
||||
@[extern "lean_compile_decls"]
|
||||
opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
|
||||
|
||||
def compileDecl (decl : Declaration) : CoreM Unit := do
|
||||
let opts ← getOptions
|
||||
let decls := Compiler.getDeclNamesForCodeGen decl
|
||||
if compiler.enableNew.get opts then
|
||||
compileDeclsNew decls
|
||||
let res ← withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
|
||||
return compileDeclsOld (← getEnv) opts decls
|
||||
return (← getEnv).compileDecl opts decl
|
||||
match res with
|
||||
| Except.ok env => setEnv env
|
||||
| Except.error (KernelException.other msg) =>
|
||||
@@ -536,7 +533,7 @@ def compileDecls (decls : List Name) : CoreM Unit := do
|
||||
let opts ← getOptions
|
||||
if compiler.enableNew.get opts then
|
||||
compileDeclsNew decls
|
||||
match compileDeclsOld (← getEnv) opts decls with
|
||||
match (← getEnv).compileDecls opts decls with
|
||||
| Except.ok env => setEnv env
|
||||
| Except.error (KernelException.other msg) =>
|
||||
throwError msg
|
||||
|
||||
@@ -24,7 +24,7 @@ abbrev empty : AssocList α β :=
|
||||
|
||||
instance : EmptyCollection (AssocList α β) := ⟨empty⟩
|
||||
|
||||
abbrev insertNew (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
abbrev insert (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
m.cons k v
|
||||
|
||||
def isEmpty : AssocList α β → Bool
|
||||
@@ -77,12 +77,6 @@ def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β
|
||||
| true => cons a b es
|
||||
| false => cons k v (replace a b es)
|
||||
|
||||
def insert [BEq α] (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
|
||||
if m.contains k then
|
||||
m.replace k v
|
||||
else
|
||||
m.insertNew k v
|
||||
|
||||
def erase [BEq α] (a : α) : AssocList α β → AssocList α β
|
||||
| nil => nil
|
||||
| cons k v es => match k == a with
|
||||
|
||||
@@ -1474,7 +1474,7 @@ where
|
||||
| field::fields, false => .fieldName field field.getId.getString! none fIdent :: toLVals fields false
|
||||
|
||||
/-- Resolve `(.$id:ident)` using the expected type to infer namespace. -/
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Name := do
|
||||
tryPostponeIfNoneOrMVar expectedType?
|
||||
let some expectedType := expectedType?
|
||||
| throwError "invalid dotted identifier notation, expected type must be known"
|
||||
@@ -1489,7 +1489,7 @@ where
|
||||
withForallBody body k
|
||||
else
|
||||
k body
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Name := do
|
||||
let resultType ← instantiateMVars resultType
|
||||
let resultTypeFn := resultType.cleanupAnnotations.getAppFn
|
||||
try
|
||||
@@ -1497,12 +1497,9 @@ where
|
||||
let .const declName .. := resultTypeFn.cleanupAnnotations
|
||||
| throwError "invalid dotted identifier notation, expected type is not of the form (... → C ...) where C is a constant{indentExpr expectedType}"
|
||||
let idNew := declName ++ id.getId.eraseMacroScopes
|
||||
if (← getEnv).contains idNew then
|
||||
mkConst idNew
|
||||
else if let some (fvar, []) ← resolveLocalName idNew then
|
||||
return fvar
|
||||
else
|
||||
unless (← getEnv).contains idNew do
|
||||
throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
|
||||
return idNew
|
||||
catch
|
||||
| ex@(.error ..) =>
|
||||
match (← unfoldDefinition? resultType) with
|
||||
@@ -1551,7 +1548,7 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
|
||||
| `(_) => throwError "placeholders '_' cannot be used where a function is expected"
|
||||
| `(.$id:ident) =>
|
||||
addCompletionInfo <| CompletionInfo.dotId f id.getId (← getLCtx) expectedType?
|
||||
let fConst ← resolveDotName id expectedType?
|
||||
let fConst ← mkConst (← resolveDotName id expectedType?)
|
||||
let s ← observing do
|
||||
-- Use (force := true) because we want to record the result of .ident resolution even in patterns
|
||||
let fConst ← addTermInfo f fConst expectedType? (force := true)
|
||||
|
||||
@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
|
||||
-/
|
||||
prelude
|
||||
import Lean.Parser.Module
|
||||
import Lean.Util.Paths
|
||||
import Lean.Data.Json
|
||||
|
||||
namespace Lean.Elab
|
||||
|
||||
@@ -42,12 +42,4 @@ def printImports (input : String) (fileName : Option String) : IO Unit := do
|
||||
let fname ← findOLean dep.module
|
||||
IO.println fname
|
||||
|
||||
@[export lean_print_import_srcs]
|
||||
def printImportSrcs (input : String) (fileName : Option String) : IO Unit := do
|
||||
let sp ← initSrcSearchPath
|
||||
let (deps, _, _) ← parseImports input fileName
|
||||
for dep in deps do
|
||||
let fname ← findLean sp dep.module
|
||||
IO.println fname
|
||||
|
||||
end Lean.Elab
|
||||
|
||||
@@ -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 {}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -35,9 +35,9 @@ def elabGrindPattern : CommandElab := fun stx => do
|
||||
| _ => 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 ())
|
||||
|
||||
@@ -11,14 +11,14 @@ import Lean.Meta.DecLevel
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
/-- Returns `id e` -/
|
||||
/-- Return `id e` -/
|
||||
def mkId (e : Expr) : MetaM Expr := do
|
||||
let type ← inferType e
|
||||
let u ← getLevel type
|
||||
return mkApp2 (mkConst ``id [u]) type e
|
||||
|
||||
/--
|
||||
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, returns
|
||||
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, return
|
||||
term `@id expectedType e`. -/
|
||||
def mkExpectedTypeHint (e : Expr) (expectedType : Expr) : MetaM Expr := do
|
||||
let u ← getLevel expectedType
|
||||
@@ -38,13 +38,13 @@ def mkLetFun (x : Expr) (v : Expr) (e : Expr) : MetaM Expr := do
|
||||
let u2 ← getLevel ety
|
||||
return mkAppN (.const ``letFun [u1, u2]) #[α, β, v, f]
|
||||
|
||||
/-- Returns `a = b`. -/
|
||||
/-- Return `a = b`. -/
|
||||
def mkEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp3 (mkConst ``Eq [u]) aType a b
|
||||
|
||||
/-- Returns `HEq a b`. -/
|
||||
/-- Return `HEq a b`. -/
|
||||
def mkHEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let bType ← inferType b
|
||||
@@ -52,7 +52,7 @@ def mkHEq (a b : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``HEq [u]) aType a bType b
|
||||
|
||||
/--
|
||||
If `a` and `b` have definitionally equal types, returns `Eq a b`, otherwise returns `HEq a b`.
|
||||
If `a` and `b` have definitionally equal types, return `Eq a b`, otherwise return `HEq a b`.
|
||||
-/
|
||||
def mkEqHEq (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
@@ -63,25 +63,25 @@ def mkEqHEq (a b : Expr) : MetaM Expr := do
|
||||
else
|
||||
return mkApp4 (mkConst ``HEq [u]) aType a bType b
|
||||
|
||||
/-- Returns a proof of `a = a`. -/
|
||||
/-- Return a proof of `a = a`. -/
|
||||
def mkEqRefl (a : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp2 (mkConst ``Eq.refl [u]) aType a
|
||||
|
||||
/-- Returns a proof of `HEq a a`. -/
|
||||
/-- Return a proof of `HEq a a`. -/
|
||||
def mkHEqRefl (a : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getLevel aType
|
||||
return mkApp2 (mkConst ``HEq.refl [u]) aType a
|
||||
|
||||
/-- Given `hp : P` and `nhp : Not P`, returns an instance of type `e`. -/
|
||||
/-- Given `hp : P` and `nhp : Not P` returns an instance of type `e`. -/
|
||||
def mkAbsurd (e : Expr) (hp hnp : Expr) : MetaM Expr := do
|
||||
let p ← inferType hp
|
||||
let u ← getLevel e
|
||||
return mkApp4 (mkConst ``absurd [u]) p e hp hnp
|
||||
|
||||
/-- Given `h : False`, returns an instance of type `e`. -/
|
||||
/-- Given `h : False`, return an instance of type `e`. -/
|
||||
def mkFalseElim (e : Expr) (h : Expr) : MetaM Expr := do
|
||||
let u ← getLevel e
|
||||
return mkApp2 (mkConst ``False.elim [u]) e h
|
||||
@@ -108,7 +108,7 @@ def mkEqSymm (h : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``Eq.symm [u]) α a b h
|
||||
| none => throwAppBuilderException ``Eq.symm ("equality proof expected" ++ hasTypeMsg h hType)
|
||||
|
||||
/-- Given `h₁ : a = b` and `h₂ : b = c`, returns a proof of `a = c`. -/
|
||||
/-- Given `h₁ : a = b` and `h₂ : b = c` returns a proof of `a = c`. -/
|
||||
def mkEqTrans (h₁ h₂ : Expr) : MetaM Expr := do
|
||||
if h₁.isAppOf ``Eq.refl then
|
||||
return h₂
|
||||
@@ -185,7 +185,7 @@ def mkHEqOfEq (h : Expr) : MetaM Expr := do
|
||||
return mkApp4 (mkConst ``heq_of_eq [u]) α a b h
|
||||
|
||||
/--
|
||||
If `e` is `@Eq.refl α a`, returns `a`.
|
||||
If `e` is `@Eq.refl α a`, return `a`.
|
||||
-/
|
||||
def isRefl? (e : Expr) : Option Expr := do
|
||||
if e.isAppOfArity ``Eq.refl 2 then
|
||||
@@ -194,7 +194,7 @@ def isRefl? (e : Expr) : Option Expr := do
|
||||
none
|
||||
|
||||
/--
|
||||
If `e` is `@congrArg α β a b f h`, returns `α`, `f` and `h`.
|
||||
If `e` is `@congrArg α β a b f h`, return `α`, `f` and `h`.
|
||||
Also works if `e` can be turned into such an application (e.g. `congrFun`).
|
||||
-/
|
||||
def congrArg? (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
|
||||
@@ -336,14 +336,13 @@ private def withAppBuilderTrace [ToMessageData α] [ToMessageData β]
|
||||
throw ex
|
||||
|
||||
/--
|
||||
Returns the application `constName xs`.
|
||||
Return the application `constName xs`.
|
||||
It tries to fill the implicit arguments before the last element in `xs`.
|
||||
|
||||
Remark:
|
||||
``mkAppM `arbitrary #[α]`` returns `@arbitrary.{u} α` without synthesizing
|
||||
the implicit argument occurring after `α`.
|
||||
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]``,
|
||||
returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
|
||||
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]`` returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
|
||||
-/
|
||||
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := do
|
||||
withAppBuilderTrace constName xs do withNewMCtxDepth do
|
||||
@@ -466,9 +465,8 @@ def mkPure (monad : Expr) (e : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Pure.pure #[monad, none, none, e]
|
||||
|
||||
/--
|
||||
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
|
||||
Remark: `fieldName` may be a subfield of `s`.
|
||||
-/
|
||||
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
|
||||
Remark: `fieldName` may be a subfield of `s`. -/
|
||||
partial def mkProjection (s : Expr) (fieldName : Name) : MetaM Expr := do
|
||||
let type ← inferType s
|
||||
let type ← whnf type
|
||||
@@ -522,11 +520,11 @@ def mkSome (type value : Expr) : MetaM Expr := do
|
||||
let u ← getDecLevel type
|
||||
return mkApp2 (mkConst ``Option.some [u]) type value
|
||||
|
||||
/-- Returns `Decidable.decide p` -/
|
||||
/-- Return `Decidable.decide p` -/
|
||||
def mkDecide (p : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Decidable.decide #[p, none]
|
||||
|
||||
/-- Returns a proof for `p : Prop` using `decide p` -/
|
||||
/-- Return a proof for `p : Prop` using `decide p` -/
|
||||
def mkDecideProof (p : Expr) : MetaM Expr := do
|
||||
let decP ← mkDecide p
|
||||
let decEqTrue ← mkEq decP (mkConst ``Bool.true)
|
||||
@@ -534,75 +532,59 @@ def mkDecideProof (p : Expr) : MetaM Expr := do
|
||||
let h ← mkExpectedTypeHint h decEqTrue
|
||||
mkAppM ``of_decide_eq_true #[h]
|
||||
|
||||
/-- Returns `a < b` -/
|
||||
/-- Return `a < b` -/
|
||||
def mkLt (a b : Expr) : MetaM Expr :=
|
||||
mkAppM ``LT.lt #[a, b]
|
||||
|
||||
/-- Returns `a <= b` -/
|
||||
/-- Return `a <= b` -/
|
||||
def mkLe (a b : Expr) : MetaM Expr :=
|
||||
mkAppM ``LE.le #[a, b]
|
||||
|
||||
/-- Returns `Inhabited.default α` -/
|
||||
/-- Return `Inhabited.default α` -/
|
||||
def mkDefault (α : Expr) : MetaM Expr :=
|
||||
mkAppOptM ``Inhabited.default #[α, none]
|
||||
|
||||
/-- Returns `@Classical.ofNonempty α _` -/
|
||||
/-- Return `@Classical.ofNonempty α _` -/
|
||||
def mkOfNonempty (α : Expr) : MetaM Expr := do
|
||||
mkAppOptM ``Classical.ofNonempty #[α, none]
|
||||
|
||||
/-- Returns `funext h` -/
|
||||
/-- Return `funext h` -/
|
||||
def mkFunExt (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``funext #[h]
|
||||
|
||||
/-- Returns `propext h` -/
|
||||
/-- Return `propext h` -/
|
||||
def mkPropExt (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``propext #[h]
|
||||
|
||||
/-- Returns `let_congr h₁ h₂` -/
|
||||
/-- Return `let_congr h₁ h₂` -/
|
||||
def mkLetCongr (h₁ h₂ : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_congr #[h₁, h₂]
|
||||
|
||||
/-- Returns `let_val_congr b h` -/
|
||||
/-- Return `let_val_congr b h` -/
|
||||
def mkLetValCongr (b h : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_val_congr #[b, h]
|
||||
|
||||
/-- Returns `let_body_congr a h` -/
|
||||
/-- Return `let_body_congr a h` -/
|
||||
def mkLetBodyCongr (a h : Expr) : MetaM Expr :=
|
||||
mkAppM ``let_body_congr #[a, h]
|
||||
|
||||
/-- Returns `@of_eq_true p h` -/
|
||||
def mkOfEqTrueCore (p : Expr) (h : Expr) : Expr :=
|
||||
match_expr h with
|
||||
| eq_true _ h => h
|
||||
| _ => mkApp2 (mkConst ``of_eq_true) p h
|
||||
/-- Return `of_eq_true h` -/
|
||||
def mkOfEqTrue (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``of_eq_true #[h]
|
||||
|
||||
/-- Returns `of_eq_true h` -/
|
||||
def mkOfEqTrue (h : Expr) : MetaM Expr := do
|
||||
match_expr h with
|
||||
| eq_true _ h => return h
|
||||
| _ => mkAppM ``of_eq_true #[h]
|
||||
|
||||
/-- Returns `eq_true h` -/
|
||||
def mkEqTrueCore (p : Expr) (h : Expr) : Expr :=
|
||||
match_expr h with
|
||||
| of_eq_true _ h => h
|
||||
| _ => mkApp2 (mkConst ``eq_true) p h
|
||||
|
||||
/-- Returns `eq_true h` -/
|
||||
def mkEqTrue (h : Expr) : MetaM Expr := do
|
||||
match_expr h with
|
||||
| of_eq_true _ h => return h
|
||||
| _ => return mkApp2 (mkConst ``eq_true) (← inferType h) h
|
||||
/-- Return `eq_true h` -/
|
||||
def mkEqTrue (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``eq_true #[h]
|
||||
|
||||
/--
|
||||
Returns `eq_false h`
|
||||
Return `eq_false h`
|
||||
`h` must have type definitionally equal to `¬ p` in the current
|
||||
reducibility setting. -/
|
||||
def mkEqFalse (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``eq_false #[h]
|
||||
|
||||
/--
|
||||
Returns `eq_false' h`
|
||||
Return `eq_false' h`
|
||||
`h` must have type definitionally equal to `p → False` in the current
|
||||
reducibility setting. -/
|
||||
def mkEqFalse' (h : Expr) : MetaM Expr :=
|
||||
@@ -620,7 +602,7 @@ def mkImpDepCongrCtx (h₁ h₂ : Expr) : MetaM Expr :=
|
||||
def mkForallCongr (h : Expr) : MetaM Expr :=
|
||||
mkAppM ``forall_congr #[h]
|
||||
|
||||
/-- Returns instance for `[Monad m]` if there is one -/
|
||||
/-- Return instance for `[Monad m]` if there is one -/
|
||||
def isMonad? (m : Expr) : MetaM (Option Expr) :=
|
||||
try
|
||||
let monadType ← mkAppM `Monad #[m]
|
||||
@@ -631,52 +613,52 @@ def isMonad? (m : Expr) : MetaM (Option Expr) :=
|
||||
catch _ =>
|
||||
pure none
|
||||
|
||||
/-- Returns `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
|
||||
/-- Return `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
|
||||
def mkNumeral (type : Expr) (n : Nat) : MetaM Expr := do
|
||||
let u ← getDecLevel type
|
||||
let inst ← synthInstance (mkApp2 (mkConst ``OfNat [u]) type (mkRawNatLit n))
|
||||
return mkApp3 (mkConst ``OfNat.ofNat [u]) type (mkRawNatLit n) inst
|
||||
|
||||
/--
|
||||
Returns `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
|
||||
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
Return `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
|
||||
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
private def mkBinaryOp (className : Name) (opName : Name) (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getDecLevel aType
|
||||
let inst ← synthInstance (mkApp3 (mkConst className [u, u, u]) aType aType aType)
|
||||
return mkApp6 (mkConst opName [u, u, u]) aType aType aType inst a b
|
||||
|
||||
/-- Returns `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkAdd (a b : Expr) : MetaM Expr := mkBinaryOp ``HAdd ``HAdd.hAdd a b
|
||||
|
||||
/-- Returns `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkSub (a b : Expr) : MetaM Expr := mkBinaryOp ``HSub ``HSub.hSub a b
|
||||
|
||||
/-- Returns `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkMul (a b : Expr) : MetaM Expr := mkBinaryOp ``HMul ``HMul.hMul a b
|
||||
|
||||
/--
|
||||
Returns `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type.
|
||||
Examples of supported classes: `LE` and `LT`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
Return `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
|
||||
This method assumes `a` and `b` have the same type.
|
||||
Examples of supported classes: `LE` and `LT`.
|
||||
We use heterogeneous operators to ensure we have a uniform representation.
|
||||
-/
|
||||
private def mkBinaryRel (className : Name) (rName : Name) (a b : Expr) : MetaM Expr := do
|
||||
let aType ← inferType a
|
||||
let u ← getDecLevel aType
|
||||
let inst ← synthInstance (mkApp (mkConst className [u]) aType)
|
||||
return mkApp4 (mkConst rName [u]) aType inst a b
|
||||
|
||||
/-- Returns `a ≤ b`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a ≤ b`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkLE (a b : Expr) : MetaM Expr := mkBinaryRel ``LE ``LE.le a b
|
||||
|
||||
/-- Returns `a < b`. This method assumes `a` and `b` have the same type. -/
|
||||
/-- Return `a < b`. This method assumes `a` and `b` have the same type. -/
|
||||
def mkLT (a b : Expr) : MetaM Expr := mkBinaryRel ``LT ``LT.lt a b
|
||||
|
||||
/-- Given `h : a = b`, returns a proof for `a ↔ b`. -/
|
||||
/-- Given `h : a = b`, return a proof for `a ↔ b`. -/
|
||||
def mkIffOfEq (h : Expr) : MetaM Expr := do
|
||||
if h.isAppOfArity ``propext 3 then
|
||||
return h.appArg!
|
||||
|
||||
@@ -1964,22 +1964,15 @@ def sortFVarIds (fvarIds : Array FVarId) : MetaM (Array FVarId) := do
|
||||
|
||||
end Methods
|
||||
|
||||
/--
|
||||
Return `some info` if `declName` is an inductive predicate where `info : InductiveVal`.
|
||||
That is, `inductive` type in `Prop`.
|
||||
-/
|
||||
def isInductivePredicate? (declName : Name) : MetaM (Option InductiveVal) := do
|
||||
match (← getEnv).find? declName with
|
||||
| some (.inductInfo info) =>
|
||||
forallTelescopeReducing info.type fun _ type => do
|
||||
match (← whnfD type) with
|
||||
| .sort u .. => if u == levelZero then return some info else return none
|
||||
| _ => return none
|
||||
| _ => return none
|
||||
|
||||
/-- Return `true` if `declName` is an inductive predicate. That is, `inductive` type in `Prop`. -/
|
||||
def isInductivePredicate (declName : Name) : MetaM Bool := do
|
||||
return (← isInductivePredicate? declName).isSome
|
||||
match (← getEnv).find? declName with
|
||||
| some (.inductInfo { type := type, ..}) =>
|
||||
forallTelescopeReducing type fun _ type => do
|
||||
match (← whnfD type) with
|
||||
| .sort u .. => return u == levelZero
|
||||
| _ => return false
|
||||
| _ => return false
|
||||
|
||||
def isListLevelDefEqAux : List Level → List Level → MetaM Bool
|
||||
| [], [] => return true
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -24,7 +24,6 @@ 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
|
||||
|
||||
@@ -43,14 +42,6 @@ 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
|
||||
@@ -62,7 +53,5 @@ builtin_initialize registerTraceClass `grind.debug.parent
|
||||
builtin_initialize registerTraceClass `grind.debug.final
|
||||
builtin_initialize registerTraceClass `grind.debug.forallPropagator
|
||||
builtin_initialize registerTraceClass `grind.debug.split
|
||||
builtin_initialize registerTraceClass `grind.debug.canon
|
||||
builtin_initialize registerTraceClass `grind.debug.offset
|
||||
builtin_initialize registerTraceClass `grind.debug.offset.proof
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -1,10 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Util
|
||||
import Lean.Meta.Tactic.Grind.Arith.Types
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
import Lean.Meta.Tactic.Grind.Arith.Main
|
||||
@@ -1,14 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
|
||||
Offset.internalize e parent?
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,14 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
def checkInvariants : GoalM Unit :=
|
||||
Offset.checkInvariants
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,34 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.PropagatorAttr
|
||||
import Lean.Meta.Tactic.Grind.Arith.Offset
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
namespace Offset
|
||||
def isCnstr? (e : Expr) : GoalM (Option (Cnstr NodeId)) :=
|
||||
return (← get).arith.offset.cnstrs.find? { expr := e }
|
||||
|
||||
def assertTrue (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
|
||||
addEdge c.u c.v c.k (← mkOfEqTrue p)
|
||||
|
||||
def assertFalse (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
|
||||
let p := mkOfNegEqFalse (← get').nodes c p
|
||||
let c := c.neg
|
||||
addEdge c.u c.v c.k p
|
||||
|
||||
end Offset
|
||||
|
||||
builtin_grind_propagator propagateLE ↓LE.le := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
if let some c ← Offset.isCnstr? e then
|
||||
Offset.assertTrue c (← mkEqTrueProof e)
|
||||
if (← isEqFalse e) then
|
||||
if let some c ← Offset.isCnstr? e then
|
||||
Offset.assertFalse c (← mkEqFalseProof e)
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -1,66 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Data.PersistentArray
|
||||
import Lean.Meta.Tactic.Grind.ENodeKey
|
||||
import Lean.Meta.Tactic.Grind.Arith.Util
|
||||
|
||||
namespace Lean.Meta.Grind.Arith
|
||||
|
||||
namespace Offset
|
||||
|
||||
abbrev NodeId := Nat
|
||||
|
||||
instance : ToMessageData (Offset.Cnstr NodeId) where
|
||||
toMessageData c := Offset.toMessageData (α := NodeId) (inst := { toMessageData n := m!"#{n}" }) c
|
||||
|
||||
/-- Auxiliary structure used for proof extraction. -/
|
||||
structure ProofInfo where
|
||||
w : NodeId
|
||||
k : Int
|
||||
proof : Expr
|
||||
deriving Inhabited
|
||||
|
||||
/-- State of the constraint offset procedure. -/
|
||||
structure State where
|
||||
/-- Mapping from `NodeId` to the `Expr` represented by the node. -/
|
||||
nodes : PArray Expr := {}
|
||||
/-- Mapping from `Expr` to a node representing it. -/
|
||||
nodeMap : PHashMap ENodeKey NodeId := {}
|
||||
/-- Mapping from `Expr` representing inequalites to constraints. -/
|
||||
cnstrs : PHashMap ENodeKey (Cnstr NodeId) := {}
|
||||
/--
|
||||
Mapping from pairs `(u, v)` to a list of offset constraints on `u` and `v`.
|
||||
We use this mapping to implement exhaustive constraint propagation.
|
||||
-/
|
||||
cnstrsOf : PHashMap (NodeId × NodeId) (List (Cnstr NodeId × Expr)) := {}
|
||||
/--
|
||||
For each node with id `u`, `sources[u]` contains
|
||||
pairs `(v, k)` s.t. there is a path from `v` to `u` with weight `k`.
|
||||
-/
|
||||
sources : PArray (AssocList NodeId Int) := {}
|
||||
/--
|
||||
For each node with id `u`, `targets[u]` contains
|
||||
pairs `(v, k)` s.t. there is a path from `u` to `v` with weight `k`.
|
||||
-/
|
||||
targets : PArray (AssocList NodeId Int) := {}
|
||||
/--
|
||||
Proof reconstruction information. For each node with id `u`, `proofs[u]` contains
|
||||
pairs `(v, { w, proof })` s.t. there is a path from `u` to `v`, and
|
||||
`w` is the penultimate node in the path, and `proof` is the justification for
|
||||
the last edge.
|
||||
-/
|
||||
proofs : PArray (AssocList NodeId ProofInfo) := {}
|
||||
deriving Inhabited
|
||||
|
||||
end Offset
|
||||
|
||||
/-- State for the arithmetic procedures. -/
|
||||
structure State where
|
||||
offset : Offset.State := {}
|
||||
deriving Inhabited
|
||||
|
||||
end Lean.Meta.Grind.Arith
|
||||
@@ -1,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
|
||||
@@ -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
|
||||
@@ -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,22 +102,15 @@ 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
|
||||
visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
|
||||
unless e.isApp || e.isForall do return e
|
||||
-- Check whether it is cached
|
||||
if let some r := (← get).find? e then
|
||||
@@ -158,11 +120,11 @@ where
|
||||
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
|
||||
@@ -170,11 +132,9 @@ where
|
||||
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 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'
|
||||
@@ -190,11 +150,10 @@ where
|
||||
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
|
||||
|
||||
@@ -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
|
||||
@@ -87,26 +86,6 @@ 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
|
||||
@@ -139,7 +118,7 @@ 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_goal[grind.debug] "after addEqStep, {← ppState}"
|
||||
checkInvariants
|
||||
where
|
||||
go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
|
||||
@@ -162,32 +141,31 @@ where
|
||||
updateRoots lhs rhsNode.root
|
||||
trace_goal[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 :=
|
||||
@@ -214,28 +192,22 @@ where
|
||||
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
|
||||
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 }
|
||||
/-- Adds a new heterogeneous equality `HEq lhs rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
|
||||
def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
|
||||
addEqCore lhs rhs proof true
|
||||
|
||||
/-- 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
|
||||
internalize lhs generation
|
||||
internalize rhs generation
|
||||
addEq lhs rhs proof
|
||||
|
||||
/-- 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}"
|
||||
if (← isInconsistent) then return ()
|
||||
resetNewEqs
|
||||
@@ -245,30 +217,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. -/
|
||||
|
||||
@@ -20,7 +20,7 @@ private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit :=
|
||||
| HEq _ lhs _ rhs =>
|
||||
pushHEq (← shareCommon lhs) (← shareCommon rhs) proof
|
||||
| _ =>
|
||||
reportIssue m!"unexpected injectivity theorem result type{indentExpr eqs}"
|
||||
trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
|
||||
return ()
|
||||
|
||||
/--
|
||||
|
||||
@@ -129,16 +129,6 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
|
||||
let c ← matchArg? c pArg eArg
|
||||
matchArgs? c p.appFn! e.appFn!
|
||||
|
||||
/-- Similar to `matchArgs?` but if `p` has fewer arguments than `e`, we match `p` with a prefix of `e`. -/
|
||||
private partial def matchArgsPrefix? (c : Choice) (p : Expr) (e : Expr) : OptionT GoalM Choice := do
|
||||
let pn := p.getAppNumArgs
|
||||
let en := e.getAppNumArgs
|
||||
guard (pn <= en)
|
||||
if pn == en then
|
||||
matchArgs? c p e
|
||||
else
|
||||
matchArgs? c p (e.getAppPrefix pn)
|
||||
|
||||
/--
|
||||
Matches pattern `p` with term `e` with respect to choice `c`.
|
||||
We traverse the equivalence class of `e` looking for applications compatible with `p`.
|
||||
@@ -204,7 +194,7 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
|
||||
let n ← getENode app
|
||||
if n.generation < maxGeneration
|
||||
&& (n.heqProofs || n.isCongrRoot) then
|
||||
if let some c ← matchArgsPrefix? c p app |>.run then
|
||||
if let some c ← matchArgs? c p app |>.run then
|
||||
let gen := n.generation
|
||||
let c := { c with gen := Nat.max gen c.gen }
|
||||
modify fun s => { s with choiceStack := c :: s.choiceStack }
|
||||
@@ -250,7 +240,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
|
||||
assert! c.assignment.size == numParams
|
||||
let (mvars, bis, _) ← forallMetaBoundedTelescope (← inferType proof) numParams
|
||||
if mvars.size != thm.numParams then
|
||||
reportIssue m!"unexpected number of parameters at {← thm.origin.pp}"
|
||||
trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
|
||||
return ()
|
||||
-- Apply assignment
|
||||
for h : i in [:mvars.size] do
|
||||
@@ -260,14 +250,14 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
|
||||
let mvarIdType ← mvarId.getType
|
||||
let vType ← inferType v
|
||||
unless (← isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
|
||||
reportIssue m!"type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
|
||||
trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
|
||||
return ()
|
||||
-- Synthesize instances
|
||||
for mvar in mvars, bi in bis do
|
||||
if bi.isInstImplicit && !(← mvar.mvarId!.isAssigned) then
|
||||
let type ← inferType mvar
|
||||
unless (← synthesizeInstance mvar type) do
|
||||
reportIssue m!"failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
|
||||
trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
|
||||
return ()
|
||||
let proof := mkAppN proof mvars
|
||||
if (← mvars.allM (·.mvarId!.isAssigned)) then
|
||||
@@ -275,7 +265,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
|
||||
else
|
||||
let mvars ← mvars.filterM fun mvar => return !(← mvar.mvarId!.isAssigned)
|
||||
if let some mvarBad ← mvars.findM? fun mvar => return !(← isProof mvar) then
|
||||
reportIssue m!"failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
|
||||
trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
|
||||
let proof ← mkLambdaFVars (binderInfoForMVars := .default) mvars (← instantiateMVars proof)
|
||||
addNewInstance thm.origin proof c.gen
|
||||
where
|
||||
@@ -310,7 +300,7 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
|
||||
if (n.heqProofs || n.isCongrRoot) &&
|
||||
(!useMT || n.mt == gmt) then
|
||||
withInitApp app do
|
||||
if let some c ← matchArgsPrefix? { cnstrs, assignment, gen := n.generation } p app |>.run then
|
||||
if let some c ← matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
|
||||
modify fun s => { s with choiceStack := [c] }
|
||||
processChoices
|
||||
|
||||
@@ -370,4 +360,7 @@ def ematchAndAssert : GrindTactic := fun goal => do
|
||||
return none
|
||||
assertAll goal
|
||||
|
||||
def ematchStar : GrindTactic :=
|
||||
ematchAndAssert.iterate
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -170,43 +170,11 @@ private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTh
|
||||
initial := {}
|
||||
}
|
||||
|
||||
/--
|
||||
Symbols with built-in support in `grind` are unsuitable as pattern candidates for E-matching.
|
||||
This is because `grind` performs normalization operations and uses specialized data structures
|
||||
to implement these symbols, which may interfere with E-matching behavior.
|
||||
-/
|
||||
-- TODO: create attribute?
|
||||
private def forbiddenDeclNames := #[``Eq, ``HEq, ``Iff, ``And, ``Or, ``Not]
|
||||
|
||||
private def isForbidden (declName : Name) := forbiddenDeclNames.contains declName
|
||||
|
||||
/--
|
||||
Auxiliary function to expand a pattern containing forbidden application symbols
|
||||
into a multi-pattern.
|
||||
|
||||
This function enhances the usability of the `[grind =]` attribute by automatically handling
|
||||
forbidden pattern symbols. For example, consider the following theorem tagged with this attribute:
|
||||
```
|
||||
getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a]
|
||||
```
|
||||
Here, the selected pattern is `xs.getLast? = some a`, but `Eq` is a forbidden pattern symbol.
|
||||
Instead of producing an error, this function converts the pattern into a multi-pattern,
|
||||
allowing the attribute to be used conveniently.
|
||||
|
||||
The function recursively expands patterns with forbidden symbols by splitting them
|
||||
into their sub-components. If the pattern does not contain forbidden symbols,
|
||||
it is returned as-is.
|
||||
-/
|
||||
partial def splitWhileForbidden (pat : Expr) : List Expr :=
|
||||
match_expr pat with
|
||||
| Not p => splitWhileForbidden p
|
||||
| And p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
|
||||
| Or p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
|
||||
| Eq _ lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| Iff lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| HEq _ lhs _ rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
|
||||
| _ => [pat]
|
||||
|
||||
private def dontCare := mkConst (Name.mkSimple "[grind_dontcare]")
|
||||
|
||||
def mkGroundPattern (e : Expr) : Expr :=
|
||||
@@ -269,36 +237,19 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
|
||||
|
||||
/--
|
||||
Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
|
||||
- a type (that is not a proposition) or type former (which has forward dependencies) or
|
||||
- a type (that is not a proposition) or type former, or
|
||||
- a proof, or
|
||||
- an instance implicit argument
|
||||
|
||||
When `mask[i]`, we say the corresponding argument is a "support" argument.
|
||||
-/
|
||||
def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
|
||||
let pinfos := (← getFunInfoNArgs f numArgs).paramInfo
|
||||
forallBoundedTelescope (← inferType f) numArgs fun xs _ => do
|
||||
xs.mapIdxM fun idx x => do
|
||||
xs.mapM fun x => do
|
||||
if (← isProp x) then
|
||||
return false
|
||||
else if (← isProof x) then
|
||||
else if (← isTypeFormer x <||> isProof x) then
|
||||
return true
|
||||
else if (← isTypeFormer x) then
|
||||
if h : idx < pinfos.size then
|
||||
/-
|
||||
We originally wanted to ignore types and type formers in `grind` and treat them as supporting elements.
|
||||
Thus, we would always return `true`. However, we changed our heuristic because of the following example:
|
||||
```
|
||||
example {α} (f : α → Type) (a : α) (h : ∀ x, Nonempty (f x)) : Nonempty (f a) := by
|
||||
grind
|
||||
```
|
||||
In this example, we are reasoning about types. Therefore, we adjusted the heuristic as follows:
|
||||
a type or type former is considered a supporting element only if it has forward dependencies.
|
||||
Note that this is not the case for `Nonempty`.
|
||||
-/
|
||||
return pinfos[idx].hasFwdDeps
|
||||
else
|
||||
return true
|
||||
else
|
||||
return (← x.fvarId!.getDecl).binderInfo matches .instImplicit
|
||||
|
||||
@@ -517,8 +468,7 @@ def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof :
|
||||
| _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
|
||||
let pat := if useLhs then lhs else rhs
|
||||
let pat ← preprocessPattern pat normalizePattern
|
||||
let pats := splitWhileForbidden (pat.abstract xs)
|
||||
return (xs.size, pats)
|
||||
return (xs.size, [pat.abstract xs])
|
||||
mkEMatchTheoremCore origin levelParams numParams proof patterns
|
||||
|
||||
/--
|
||||
@@ -549,7 +499,7 @@ def addEMatchEqTheorem (declName : Name) : MetaM Unit := do
|
||||
def getEMatchTheorems : CoreM EMatchTheorems :=
|
||||
return ematchTheoremsExt.getState (← getEnv)
|
||||
|
||||
inductive TheoremKind where
|
||||
private inductive TheoremKind where
|
||||
| eqLhs | eqRhs | eqBoth | fwd | bwd | default
|
||||
deriving Inhabited, BEq
|
||||
|
||||
|
||||
@@ -1,30 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Expr
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@[inline] def isSameExpr (a b : Expr) : Bool :=
|
||||
-- It is safe to use pointer equality because we hashcons all expressions
|
||||
-- inserted into the E-graph
|
||||
unsafe ptrEq a b
|
||||
|
||||
/--
|
||||
Key for the `ENodeMap` and `ParentMap` map.
|
||||
We use pointer addresses and rely on the fact all internalized expressions
|
||||
have been hash-consed, i.e., we have applied `shareCommon`.
|
||||
-/
|
||||
structure ENodeKey where
|
||||
expr : Expr
|
||||
|
||||
instance : Hashable ENodeKey where
|
||||
hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
|
||||
|
||||
instance : BEq ENodeKey where
|
||||
beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -24,7 +24,7 @@ def propagateForallPropUp (e : Expr) : GoalM Unit := do
|
||||
unless (← isEqTrue p) do return
|
||||
trace_goal[grind.debug.forallPropagator] "isEqTrue, {e}"
|
||||
let h₁ ← mkEqTrueProof p
|
||||
let qh₁ := q.instantiate1 (mkOfEqTrueCore p h₁)
|
||||
let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
|
||||
let r ← simp qh₁
|
||||
let q := mkLambda n bi p q
|
||||
let q' := r.expr
|
||||
@@ -51,13 +51,6 @@ private def isEqTrueHyp? (proof : Expr) : Option FVarId := Id.run do
|
||||
let .fvar fvarId := p | return none
|
||||
return some fvarId
|
||||
|
||||
/-- Similar to `mkEMatchTheoremWithKind?`, but swallow any exceptions. -/
|
||||
private def mkEMatchTheoremWithKind'? (origin : Origin) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
|
||||
try
|
||||
mkEMatchTheoremWithKind? origin #[] proof kind
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
|
||||
let proof ← mkEqTrueProof e
|
||||
let origin ← if let some fvarId := isEqTrueHyp? proof then
|
||||
@@ -65,19 +58,19 @@ private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
|
||||
else
|
||||
let idx ← modifyGet fun s => (s.nextThmIdx, { s with nextThmIdx := s.nextThmIdx + 1 })
|
||||
pure <| .local ((`local).appendIndexAfter idx)
|
||||
let proof := mkOfEqTrueCore e proof
|
||||
let proof := mkApp2 (mkConst ``of_eq_true) e proof
|
||||
let size := (← get).newThms.size
|
||||
let gen ← getGeneration e
|
||||
-- TODO: we should have a flag for collecting all unary patterns in a local theorem
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .fwd then
|
||||
if let some thm ← mkEMatchTheoremWithKind? origin #[] proof .fwd then
|
||||
activateTheorem thm gen
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .bwd then
|
||||
if let some thm ← mkEMatchTheoremWithKind? origin #[] proof .bwd then
|
||||
activateTheorem thm gen
|
||||
if (← get).newThms.size == size then
|
||||
if let some thm ← mkEMatchTheoremWithKind'? origin proof .default then
|
||||
if let some thm ← mkEMatchTheoremWithKind? origin #[] proof .default then
|
||||
activateTheorem thm gen
|
||||
if (← get).newThms.size == size then
|
||||
reportIssue m!"failed to create E-match local theorem for{indentExpr e}"
|
||||
trace[grind.issues] "failed to create E-match local theorem for{indentExpr e}"
|
||||
|
||||
def propagateForallPropDown (e : Expr) : GoalM Unit := do
|
||||
let .forallE n a b bi := e | return ()
|
||||
|
||||
@@ -11,8 +11,6 @@ import Lean.Meta.Match.MatcherInfo
|
||||
import Lean.Meta.Match.MatchEqsExt
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Util
|
||||
import Lean.Meta.Tactic.Grind.Canon
|
||||
import Lean.Meta.Tactic.Grind.Arith.Internalize
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -25,7 +23,7 @@ def addCongrTable (e : Expr) : GoalM Unit := do
|
||||
let g := e'.getAppFn
|
||||
unless isSameExpr f g do
|
||||
unless (← hasSameType f g) do
|
||||
reportIssue m!"found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
|
||||
trace_goal[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
|
||||
return ()
|
||||
trace_goal[grind.debug.congr] "{e} = {e'}"
|
||||
pushEqHEq e e' congrPlaceholderProof
|
||||
@@ -55,20 +53,12 @@ private def addSplitCandidate (e : Expr) : GoalM Unit := do
|
||||
-- TODO: add attribute to make this extensible
|
||||
private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
|
||||
|
||||
/-- Returns `true` if `e` is of the form `@Eq Prop a b` -/
|
||||
def isMorallyIff (e : Expr) : Bool :=
|
||||
let_expr Eq α _ _ := e | false
|
||||
α.isProp
|
||||
|
||||
/-- Inserts `e` into the list of case-split candidates if applicable. -/
|
||||
private def checkAndAddSplitCandidate (e : Expr) : GoalM Unit := do
|
||||
unless e.isApp do return ()
|
||||
if (← getConfig).splitIte && (e.isIte || e.isDIte) then
|
||||
addSplitCandidate e
|
||||
return ()
|
||||
if isMorallyIff e then
|
||||
addSplitCandidate e
|
||||
return ()
|
||||
if (← getConfig).splitMatch then
|
||||
if (← isMatcherApp e) then
|
||||
if let .reduced _ ← reduceMatcher? e then
|
||||
@@ -99,17 +89,14 @@ private def pushCastHEqs (e : Expr) : GoalM Unit := do
|
||||
| f@Eq.recOn α a motive b h v => pushHEq e v (mkApp6 (mkConst ``Grind.eqRecOn_heq f.constLevels!) α a motive b h v)
|
||||
| _ => return ()
|
||||
|
||||
private def preprocessGroundPattern (e : Expr) : GoalM Expr := do
|
||||
shareCommon (← canon (← normalizeLevels (← unfoldReducible e)))
|
||||
|
||||
mutual
|
||||
/-- Internalizes the nested ground terms in the given pattern. -/
|
||||
private partial def internalizePattern (pattern : Expr) (generation : Nat) : GoalM Expr := do
|
||||
if pattern.isBVar || isPatternDontCare pattern then
|
||||
return pattern
|
||||
else if let some e := groundPattern? pattern then
|
||||
let e ← preprocessGroundPattern e
|
||||
internalize e generation none
|
||||
let e ← shareCommon (← canon (← normalizeLevels (← unfoldReducible e)))
|
||||
internalize e generation
|
||||
return mkGroundPattern e
|
||||
else pattern.withApp fun f args => do
|
||||
return mkAppN f (← args.mapM (internalizePattern · generation))
|
||||
@@ -150,7 +137,7 @@ private partial def activateTheoremPatterns (fName : Name) (generation : Nat) :
|
||||
trace_goal[grind.ematch] "reinsert `{thm.origin.key}`"
|
||||
modify fun s => { s with thmMap := s.thmMap.insert thm }
|
||||
|
||||
partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr := none) : GoalM Unit := do
|
||||
partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
|
||||
if (← alreadyInternalized e) then return ()
|
||||
trace_goal[grind.internalize] "{e}"
|
||||
match e with
|
||||
@@ -161,10 +148,10 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
|
||||
| .forallE _ d b _ =>
|
||||
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
|
||||
if (← isProp d <&&> isProp e) then
|
||||
internalize d generation e
|
||||
internalize d generation
|
||||
registerParent e d
|
||||
unless b.hasLooseBVars do
|
||||
internalize b generation e
|
||||
internalize b generation
|
||||
registerParent e b
|
||||
propagateUp e
|
||||
| .lit .. | .const .. =>
|
||||
@@ -172,13 +159,12 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
|
||||
| .mvar ..
|
||||
| .mdata ..
|
||||
| .proj .. =>
|
||||
reportIssue m!"unexpected kernel projection term during internalization{indentExpr e}\n`grind` uses a pre-processing step that folds them as projection applications, the pre-processor should have failed to fold this term"
|
||||
trace_goal[grind.issues] "unexpected term during internalization{indentExpr e}"
|
||||
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
|
||||
| .app .. =>
|
||||
if (← isLitValue e) then
|
||||
-- We do not want to internalize the components of a literal value.
|
||||
mkENode e generation
|
||||
Arith.internalize e parent?
|
||||
else e.withApp fun f args => do
|
||||
checkAndAddSplitCandidate e
|
||||
pushCastHEqs e
|
||||
@@ -187,22 +173,21 @@ partial def internalize (e : Expr) (generation : Nat) (parent? : Option Expr :=
|
||||
-- We only internalize the proposition. We can skip the proof because of
|
||||
-- proof irrelevance
|
||||
let c := args[0]!
|
||||
internalize c generation e
|
||||
internalize c generation
|
||||
registerParent e c
|
||||
else
|
||||
if let .const fName _ := f then
|
||||
activateTheoremPatterns fName generation
|
||||
else
|
||||
internalize f generation e
|
||||
internalize f generation
|
||||
registerParent e f
|
||||
for h : i in [: args.size] do
|
||||
let arg := args[i]
|
||||
internalize arg generation e
|
||||
internalize arg generation
|
||||
registerParent e arg
|
||||
mkENode e generation
|
||||
addCongrTable e
|
||||
updateAppMap e
|
||||
Arith.internalize e parent?
|
||||
propagateUp e
|
||||
end
|
||||
|
||||
|
||||
@@ -25,14 +25,13 @@ private inductive IntroResult where
|
||||
private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
|
||||
let target ← goal.mvarId.getType
|
||||
if target.isArrow then
|
||||
let (r, _) ← GoalM.run goal do
|
||||
let mvarId := (← get).mvarId
|
||||
goal.mvarId.withContext do
|
||||
let p := target.bindingDomain!
|
||||
if !(← isProp p) then
|
||||
let (fvarId, mvarId) ← mvarId.intro1P
|
||||
return .newLocal fvarId { (← get) with mvarId }
|
||||
let (fvarId, mvarId) ← goal.mvarId.intro1P
|
||||
return .newLocal fvarId { goal with mvarId }
|
||||
else
|
||||
let tag ← mvarId.getTag
|
||||
let tag ← goal.mvarId.getTag
|
||||
let q := target.bindingBody!
|
||||
-- TODO: keep applying simp/eraseIrrelevantMData/canon/shareCommon until no progress
|
||||
let r ← simp p
|
||||
@@ -45,13 +44,12 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
|
||||
match r.proof? with
|
||||
| some he =>
|
||||
let hNew := mkAppN (mkConst ``Lean.Grind.intro_with_eq) #[p, r.expr, q, he, h]
|
||||
mvarId.assign hNew
|
||||
return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
|
||||
goal.mvarId.assign hNew
|
||||
return .newHyp fvarId { goal with mvarId := mvarIdNew }
|
||||
| none =>
|
||||
-- `p` and `p'` are definitionally equal
|
||||
mvarId.assign h
|
||||
return .newHyp fvarId { (← get) with mvarId := mvarIdNew }
|
||||
return r
|
||||
goal.mvarId.assign h
|
||||
return .newHyp fvarId { goal with mvarId := mvarIdNew }
|
||||
else if target.isLet || target.isForall || target.isLetFun then
|
||||
let (fvarId, mvarId) ← goal.mvarId.intro1P
|
||||
mvarId.withContext do
|
||||
@@ -63,11 +61,10 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
|
||||
else
|
||||
let goal := { goal with mvarId }
|
||||
if target.isLet || target.isLetFun then
|
||||
let goal ← GoalM.run' goal do
|
||||
let v := (← fvarId.getDecl).value
|
||||
let r ← simp v
|
||||
let x ← shareCommon (mkFVar fvarId)
|
||||
addNewEq x r.expr (← r.getProof) generation
|
||||
let v := (← fvarId.getDecl).value
|
||||
let r ← simp v
|
||||
let x ← shareCommon (mkFVar fvarId)
|
||||
let goal ← GoalM.run' goal <| addNewEq x r.expr (← r.getProof) generation
|
||||
return .newLocal fvarId goal
|
||||
else
|
||||
return .newLocal fvarId goal
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Proof
|
||||
import Lean.Meta.Tactic.Grind.Arith.Inv
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@@ -59,12 +58,9 @@ private def checkParents (e : Expr) : GoalM Unit := do
|
||||
found := true
|
||||
break
|
||||
-- Recall that we have support for `Expr.forallE` propagation. See `ForallProp.lean`.
|
||||
if let .forallE _ d b _ := parent then
|
||||
if let .forallE _ d _ _ := parent then
|
||||
if (← checkChild d) then
|
||||
found := true
|
||||
unless b.hasLooseBVars do
|
||||
if (← checkChild b) then
|
||||
found := true
|
||||
unless found do
|
||||
assert! (← checkChild parent.getAppFn)
|
||||
else
|
||||
@@ -104,7 +100,6 @@ def checkInvariants (expensive := false) : GoalM Unit := do
|
||||
checkEqc node
|
||||
if expensive then
|
||||
checkPtrEqImpliesStructEq
|
||||
Arith.checkInvariants
|
||||
if expensive && grind.debug.proofs.get (← getOptions) then
|
||||
checkProofs
|
||||
|
||||
|
||||
@@ -15,7 +15,6 @@ import Lean.Meta.Tactic.Grind.Inv
|
||||
import Lean.Meta.Tactic.Grind.Intro
|
||||
import Lean.Meta.Tactic.Grind.EMatch
|
||||
import Lean.Meta.Tactic.Grind.Split
|
||||
import Lean.Meta.Tactic.Grind.Solve
|
||||
import Lean.Meta.Tactic.Grind.SimpUtil
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
@@ -41,20 +40,17 @@ def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fa
|
||||
let scState := ShareCommon.State.mk _
|
||||
let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
|
||||
let (trueExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``True)
|
||||
let (natZExpr, scState) := ShareCommon.State.shareCommon scState (mkNatLit 0)
|
||||
let simprocs ← Grind.getSimprocs
|
||||
let simp ← Grind.getSimpContext
|
||||
x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr, natZExpr }
|
||||
x (← mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
|
||||
|
||||
private def mkGoal (mvarId : MVarId) : GrindM Goal := do
|
||||
let trueExpr ← getTrueExpr
|
||||
let falseExpr ← getFalseExpr
|
||||
let natZeroExpr ← getNatZeroExpr
|
||||
let thmMap ← getEMatchTheorems
|
||||
GoalM.run' { mvarId, thmMap } do
|
||||
mkENodeCore falseExpr (interpreted := true) (ctor := false) (generation := 0)
|
||||
mkENodeCore trueExpr (interpreted := true) (ctor := false) (generation := 0)
|
||||
mkENodeCore natZeroExpr (interpreted := true) (ctor := false) (generation := 0)
|
||||
|
||||
private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
|
||||
mvarId.ensureProp
|
||||
@@ -69,10 +65,17 @@ private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
|
||||
goals.forM (·.checkInvariants (expensive := true))
|
||||
return goals.filter fun goal => !goal.inconsistent
|
||||
|
||||
def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List Goal) := do
|
||||
let go : GrindM (List Goal) := do
|
||||
def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goal) := do
|
||||
goals.foldlM (init := []) fun acc goal => return acc ++ (← f goal)
|
||||
|
||||
/-- A very simple strategy -/
|
||||
private def simple (goals : List Goal) : GrindM (List Goal) := do
|
||||
applyToAll (assertAll >> ematchStar >> (splitNext >> assertAll >> ematchStar).iterate) goals
|
||||
|
||||
def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List MVarId) := do
|
||||
let go : GrindM (List MVarId) := do
|
||||
let goals ← initCore mvarId
|
||||
let goals ← solve goals
|
||||
let goals ← simple goals
|
||||
let goals ← goals.filterMapM fun goal => do
|
||||
if goal.inconsistent then return none
|
||||
let goal ← GoalM.run' goal fallback
|
||||
@@ -80,7 +83,7 @@ def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallba
|
||||
if (← goal.mvarId.isAssigned) then return none
|
||||
return some goal
|
||||
trace[grind.debug.final] "{← ppGoals goals}"
|
||||
return goals
|
||||
return goals.map (·.mvarId)
|
||||
go.run mainDeclName config fallback
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -5,162 +5,62 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Grind.Util
|
||||
import Init.Grind.PP
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.Arith.Model
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
def Goal.ppENodeRef (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
let some n := goal.getENode? e | return "_"
|
||||
let type ← inferType e
|
||||
let u ← getLevel type
|
||||
let d := mkApp3 (mkConst ``Grind.node_def [u]) (toExpr n.idx) type e
|
||||
return m!"{d}"
|
||||
|
||||
@[inherit_doc Goal.ppENodeRef]
|
||||
def ppENodeRef (e : Expr) : GoalM MessageData := do
|
||||
(← get).ppENodeRef e
|
||||
def ppENodeRef (e : Expr) : GoalM Format := do
|
||||
let some n ← getENode? e | return "_"
|
||||
return f!"#{n.idx}"
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
private def Goal.ppENodeDeclValue (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
def ppENodeDeclValue (e : Expr) : GoalM Format := do
|
||||
if e.isApp && !(← isLitValue e) then
|
||||
e.withApp fun f args => do
|
||||
let r ← if f.isConst then
|
||||
pure m!"{f}"
|
||||
ppExpr f
|
||||
else
|
||||
goal.ppENodeRef f
|
||||
ppENodeRef f
|
||||
let mut r := r
|
||||
for arg in args do
|
||||
r := r ++ " " ++ (← goal.ppENodeRef arg)
|
||||
r := r ++ " " ++ (← ppENodeRef arg)
|
||||
return r
|
||||
else
|
||||
ppExpr e
|
||||
|
||||
/-- Helper function for pretty printing the state for debugging purposes. -/
|
||||
private def Goal.ppENodeDecl (goal : Goal) (e : Expr) : MetaM MessageData := do
|
||||
let mut r := m!"{← goal.ppENodeRef e} := {← goal.ppENodeDeclValue e}"
|
||||
let n ← goal.getENode e
|
||||
def ppENodeDecl (e : Expr) : GoalM Format := do
|
||||
let mut r := f!"{← ppENodeRef e} := {← ppENodeDeclValue e}"
|
||||
let n ← getENode e
|
||||
unless isSameExpr e n.root do
|
||||
r := r ++ m!" ↦ {← goal.ppENodeRef n.root}"
|
||||
r := r ++ f!" ↦ {← ppENodeRef n.root}"
|
||||
if n.interpreted then
|
||||
r := r ++ ", [val]"
|
||||
if n.ctor then
|
||||
r := r ++ ", [ctor]"
|
||||
if grind.debug.get (← getOptions) then
|
||||
if let some target := goal.getTarget? e then
|
||||
r := r ++ m!" ↝ {← goal.ppENodeRef target}"
|
||||
if let some target ← getTarget? e then
|
||||
r := r ++ f!" ↝ {← ppENodeRef target}"
|
||||
return r
|
||||
|
||||
/-- Pretty print goal state for debugging purposes. -/
|
||||
def Goal.ppState (goal : Goal) : MetaM MessageData := do
|
||||
let mut r := m!"Goal:"
|
||||
let nodes := goal.getENodes
|
||||
def ppState : GoalM Format := do
|
||||
let mut r := f!"Goal:"
|
||||
let nodes ← getENodes
|
||||
for node in nodes do
|
||||
r := r ++ "\n" ++ (← goal.ppENodeDecl node.self)
|
||||
let eqcs := goal.getEqcs
|
||||
r := r ++ "\n" ++ (← ppENodeDecl node.self)
|
||||
let eqcs ← getEqcs
|
||||
for eqc in eqcs do
|
||||
if eqc.length > 1 then
|
||||
r := r ++ "\n" ++ "{" ++ (MessageData.joinSep (← eqc.mapM goal.ppENodeRef) ", ") ++ "}"
|
||||
r := r ++ "\n" ++ "{" ++ (Format.joinSep (← eqc.mapM ppENodeRef) ", ") ++ "}"
|
||||
return r
|
||||
|
||||
def ppGoals (goals : List Goal) : MetaM MessageData := do
|
||||
let mut r := m!""
|
||||
def ppGoals (goals : List Goal) : GrindM Format := do
|
||||
let mut r := f!""
|
||||
for goal in goals do
|
||||
let m ← goal.ppState
|
||||
r := r ++ Format.line ++ m
|
||||
let (f, _) ← GoalM.run goal ppState
|
||||
r := r ++ Format.line ++ f
|
||||
return r
|
||||
|
||||
private def ppExprArray (cls : Name) (header : String) (es : Array Expr) (clsElem : Name := Name.mkSimple "_") : MessageData :=
|
||||
let es := es.map fun e => .trace { cls := clsElem} m!"{e}" #[]
|
||||
.trace { cls } header es
|
||||
|
||||
private abbrev M := ReaderT Goal (StateT (Array MessageData) MetaM)
|
||||
|
||||
private def pushMsg (m : MessageData) : M Unit :=
|
||||
modify fun s => s.push m
|
||||
|
||||
private def ppEqcs : M Unit := do
|
||||
let mut trueEqc? : Option MessageData := none
|
||||
let mut falseEqc? : Option MessageData := none
|
||||
let mut otherEqcs : Array MessageData := #[]
|
||||
let goal ← read
|
||||
for eqc in goal.getEqcs do
|
||||
if Option.isSome <| eqc.find? (·.isTrue) then
|
||||
let eqc := eqc.filter fun e => !e.isTrue
|
||||
unless eqc.isEmpty do
|
||||
trueEqc? := ppExprArray `eqc "True propositions" eqc.toArray `prop
|
||||
else if Option.isSome <| eqc.find? (·.isFalse) then
|
||||
let eqc := eqc.filter fun e => !e.isFalse
|
||||
unless eqc.isEmpty do
|
||||
falseEqc? := ppExprArray `eqc "False propositions" eqc.toArray `prop
|
||||
else if let e :: _ :: _ := eqc then
|
||||
-- We may want to add a flag to pretty print equivalence classes of nested proofs
|
||||
unless (← isProof e) do
|
||||
otherEqcs := otherEqcs.push <| .trace { cls := `eqc } (.group ("{" ++ (MessageData.joinSep (eqc.map toMessageData) ("," ++ Format.line)) ++ "}")) #[]
|
||||
if let some trueEqc := trueEqc? then pushMsg trueEqc
|
||||
if let some falseEqc := falseEqc? then pushMsg falseEqc
|
||||
unless otherEqcs.isEmpty do
|
||||
pushMsg <| .trace { cls := `eqc } "Equivalence classes" otherEqcs
|
||||
|
||||
private def ppEMatchTheorem (thm : EMatchTheorem) : MetaM MessageData := do
|
||||
let m := m!"{← thm.origin.pp}:\n{← inferType thm.proof}\npatterns: {thm.patterns.map ppPattern}"
|
||||
return .trace { cls := `thm } m #[]
|
||||
|
||||
private def ppActiveTheorems : M Unit := do
|
||||
let goal ← read
|
||||
let m ← goal.thms.toArray.mapM fun thm => ppEMatchTheorem thm
|
||||
let m := m ++ (← goal.newThms.toArray.mapM fun thm => ppEMatchTheorem thm)
|
||||
unless m.isEmpty do
|
||||
pushMsg <| .trace { cls := `ematch } "E-matching" m
|
||||
|
||||
private def ppOffset : M Unit := do
|
||||
let goal ← read
|
||||
let s := goal.arith.offset
|
||||
let nodes := s.nodes
|
||||
if nodes.isEmpty then return ()
|
||||
let model ← Arith.Offset.mkModel goal
|
||||
let mut ms := #[]
|
||||
for (e, val) in model do
|
||||
ms := ms.push <| .trace { cls := `assign } m!"{e} := {val}" #[]
|
||||
pushMsg <| .trace { cls := `offset } "Assignment satisfying offset contraints" ms
|
||||
|
||||
private def ppIssues : M Unit := do
|
||||
let issues := (← read).issues
|
||||
unless issues.isEmpty do
|
||||
pushMsg <| .trace { cls := `issues } "Issues" issues.reverse.toArray
|
||||
|
||||
private def ppThresholds (c : Grind.Config) : M Unit := do
|
||||
let goal ← read
|
||||
let maxGen := goal.enodes.foldl (init := 0) fun g _ n => Nat.max g n.generation
|
||||
let mut msgs := #[]
|
||||
if goal.numInstances ≥ c.instances then
|
||||
msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of instances generated by E-matching has been reached, threshold: `(instances := {c.instances})`" #[]
|
||||
if goal.numEmatch ≥ c.ematch then
|
||||
msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of E-matching rounds has been reached, threshold: `(ematch := {c.ematch})`" #[]
|
||||
if goal.numSplits ≥ c.splits then
|
||||
msgs := msgs.push <| .trace { cls := `limit } m!"maximum number of case-splits has been reached, threshold: `(splits := {c.splits})`" #[]
|
||||
if maxGen ≥ c.gen then
|
||||
msgs := msgs.push <| .trace { cls := `limit } m!"maximum term generation has been reached, threshold: `(gen := {c.gen})`" #[]
|
||||
unless msgs.isEmpty do
|
||||
pushMsg <| .trace { cls := `limits } "Thresholds reached" msgs
|
||||
|
||||
def goalToMessageData (goal : Goal) (config : Grind.Config) : MetaM MessageData := goal.mvarId.withContext do
|
||||
let (_, m) ← go goal |>.run #[]
|
||||
let gm := MessageData.trace { cls := `grind, collapsed := false } "Diagnostics" m
|
||||
let r := m!"{.ofGoal goal.mvarId}\n{gm}"
|
||||
addMessageContextFull r
|
||||
where
|
||||
go : M Unit := do
|
||||
pushMsg <| ppExprArray `facts "Asserted facts" goal.facts.toArray `prop
|
||||
ppEqcs
|
||||
ppActiveTheorems
|
||||
ppOffset
|
||||
ppThresholds config
|
||||
ppIssues
|
||||
|
||||
def goalsToMessageData (goals : List Goal) (config : Grind.Config) : MetaM MessageData :=
|
||||
return MessageData.joinSep (← goals.mapM (goalToMessageData · config)) m!"\n"
|
||||
|
||||
end Lean.Meta.Grind
|
||||
|
||||
@@ -126,32 +126,32 @@ builtin_grind_propagator propagateEqUp ↑Eq := fun e => do
|
||||
else if (← isEqTrue b) then
|
||||
pushEq e a <| mkApp3 (mkConst ``Lean.Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
|
||||
else if (← isEqv a b) then
|
||||
pushEqTrue e <| mkEqTrueCore e (← mkEqProof a b)
|
||||
pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkEqProof a b)
|
||||
|
||||
/-- Propagates `Eq` downwards -/
|
||||
builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr Eq _ a b := e | return ()
|
||||
pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `EqMatch` downwards -/
|
||||
builtin_grind_propagator propagateEqMatchDown ↓Grind.EqMatch := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr Grind.EqMatch _ a b origin := e | return ()
|
||||
markCaseSplitAsResolved origin
|
||||
pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
pushEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `HEq` downwards -/
|
||||
builtin_grind_propagator propagateHEqDown ↓HEq := fun e => do
|
||||
if (← isEqTrue e) then
|
||||
let_expr HEq _ a _ b := e | return ()
|
||||
pushHEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
|
||||
pushHEq a b <| mkApp2 (mkConst ``of_eq_true) e (← mkEqTrueProof e)
|
||||
|
||||
/-- Propagates `HEq` upwards -/
|
||||
builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
|
||||
let_expr HEq _ a _ b := e | return ()
|
||||
if (← isEqv a b) then
|
||||
pushEqTrue e <| mkEqTrueCore e (← mkHEqProof a b)
|
||||
pushEqTrue e <| mkApp2 (mkConst ``eq_true) e (← mkHEqProof a b)
|
||||
|
||||
/-- Propagates `ite` upwards -/
|
||||
builtin_grind_propagator propagateIte ↑ite := fun e => do
|
||||
@@ -166,7 +166,7 @@ builtin_grind_propagator propagateDIte ↑dite := fun e => do
|
||||
let_expr f@dite α c h a b := e | return ()
|
||||
if (← isEqTrue c) then
|
||||
let h₁ ← mkEqTrueProof c
|
||||
let ah₁ := mkApp a (mkOfEqTrueCore c h₁)
|
||||
let ah₁ := mkApp a (mkApp2 (mkConst ``of_eq_true) c h₁)
|
||||
let p ← simp ah₁
|
||||
let r := p.expr
|
||||
let h₂ ← p.getProof
|
||||
|
||||
@@ -11,7 +11,6 @@ import Lean.Meta.Tactic.Grind.Util
|
||||
import Lean.Meta.Tactic.Grind.Types
|
||||
import Lean.Meta.Tactic.Grind.DoNotSimp
|
||||
import Lean.Meta.Tactic.Grind.MarkNestedProofs
|
||||
import Lean.Meta.Tactic.Grind.Canon
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
/-- Simplifies the given expression using the `grind` simprocs and normalization theorems. -/
|
||||
@@ -25,13 +24,13 @@ def simpCore (e : Expr) : GrindM Simp.Result := do
|
||||
Simplifies `e` using `grind` normalization theorems and simprocs,
|
||||
and then applies several other preprocessing steps.
|
||||
-/
|
||||
def simp (e : Expr) : GoalM Simp.Result := do
|
||||
def simp (e : Expr) : GrindM Simp.Result := do
|
||||
let e ← instantiateMVars e
|
||||
let r ← simpCore e
|
||||
let e' := r.expr
|
||||
let e' ← unfoldReducible e'
|
||||
let e' ← abstractNestedProofs e'
|
||||
let e' ← markNestedProofs e'
|
||||
let e' ← unfoldReducible e'
|
||||
let e' ← eraseIrrelevantMData e'
|
||||
let e' ← foldProjs e'
|
||||
let e' ← normalizeLevels e'
|
||||
|
||||
@@ -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 Lean.Meta.Tactic.Grind.Combinators
|
||||
import Lean.Meta.Tactic.Grind.Split
|
||||
import Lean.Meta.Tactic.Grind.EMatch
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
namespace Solve
|
||||
|
||||
structure State where
|
||||
todo : List Goal
|
||||
failures : List Goal := []
|
||||
stop : Bool := false
|
||||
|
||||
private abbrev M := StateRefT State GrindM
|
||||
|
||||
def getNext? : M (Option Goal) := do
|
||||
let goal::todo := (← get).todo | return none
|
||||
modify fun s => { s with todo }
|
||||
return some goal
|
||||
|
||||
def pushGoal (goal : Goal) : M Unit :=
|
||||
modify fun s => { s with todo := goal :: s.todo }
|
||||
|
||||
def pushGoals (goals : List Goal) : M Unit :=
|
||||
modify fun s => { s with todo := goals ++ s.todo }
|
||||
|
||||
def pushFailure (goal : Goal) : M Unit := do
|
||||
modify fun s => { s with failures := goal :: s.failures }
|
||||
if (← get).failures.length ≥ (← getConfig).failures then
|
||||
modify fun s => { s with stop := true }
|
||||
|
||||
@[inline] def stepGuard (x : Goal → M Bool) (goal : Goal) : M Bool := do
|
||||
try
|
||||
x goal
|
||||
catch ex =>
|
||||
if ex.isMaxHeartbeat || ex.isMaxRecDepth then
|
||||
let goal ← goal.reportIssue ex.toMessageData
|
||||
pushFailure goal
|
||||
return true
|
||||
else
|
||||
throw ex
|
||||
|
||||
def applyTac (x : GrindTactic) (goal : Goal) : M Bool := do
|
||||
let go (goal : Goal) : M Bool := do
|
||||
let some goals ← x goal | return false
|
||||
pushGoals goals
|
||||
return true
|
||||
stepGuard go goal
|
||||
|
||||
def tryAssertNext : Goal → M Bool := applyTac assertNext
|
||||
|
||||
def tryEmatch : Goal → M Bool := applyTac ematchAndAssert
|
||||
|
||||
def trySplit : Goal → M Bool := applyTac splitNext
|
||||
|
||||
def maxNumFailuresReached : M Bool := do
|
||||
return (← get).failures.length ≥ (← getConfig).failures
|
||||
|
||||
partial def main : M Unit := do
|
||||
repeat do
|
||||
if (← get).stop then
|
||||
return ()
|
||||
let some goal ← getNext? |
|
||||
return ()
|
||||
if goal.inconsistent then
|
||||
continue
|
||||
if (← tryAssertNext goal) then
|
||||
continue
|
||||
if (← tryEmatch goal) then
|
||||
continue
|
||||
if (← trySplit goal) then
|
||||
continue
|
||||
pushFailure goal
|
||||
|
||||
end Solve
|
||||
|
||||
/--
|
||||
Try to solve/close the given goals, and returns the ones that could not be solved.
|
||||
-/
|
||||
def solve (goals : List Goal) : GrindM (List Goal) := do
|
||||
let (_, s) ← Solve.main.run { todo := goals }
|
||||
let todo ← s.todo.mapM fun goal => do
|
||||
goal.reportIssue m!"this goal was not fully processed due to previous failures, threshold: `(failures := {(← getConfig).failures})`"
|
||||
return s.failures.reverse ++ todo
|
||||
|
||||
end Lean.Meta.Grind
|
||||
@@ -14,133 +14,77 @@ namespace Lean.Meta.Grind
|
||||
inductive CaseSplitStatus where
|
||||
| resolved
|
||||
| notReady
|
||||
| ready (numCases : Nat) (isRec := false)
|
||||
| ready
|
||||
deriving Inhabited, BEq
|
||||
|
||||
/-- Given `c`, the condition of an `if-then-else`, check whether we need to case-split on the `if-then-else` or not -/
|
||||
private def checkIteCondStatus (c : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue c <||> isEqFalse c) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
|
||||
/--
|
||||
Given `e` of the form `a ∨ b`, check whether we are ready to case-split on `e`.
|
||||
That is, `e` is `True`, but neither `a` nor `b` is `True`."
|
||||
-/
|
||||
private def checkDisjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
if (← isEqTrue a <||> isEqTrue b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else if (← isEqFalse e) then
|
||||
return .resolved
|
||||
else
|
||||
return .notReady
|
||||
|
||||
/--
|
||||
Given `e` of the form `a ∧ b`, check whether we are ready to case-split on `e`.
|
||||
That is, `e` is `False`, but neither `a` nor `b` is `False`.
|
||||
-/
|
||||
private def checkConjunctStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
return .resolved
|
||||
else if (← isEqFalse e) then
|
||||
if (← isEqFalse a <||> isEqFalse b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else
|
||||
return .notReady
|
||||
|
||||
/--
|
||||
Given `e` of the form `@Eq Prop a b`, check whether we are ready to case-split on `e`.
|
||||
There are two cases:
|
||||
1- `e` is `True`, but neither both `a` and `b` are `True`, nor both `a` and `b` are `False`.
|
||||
2- `e` is `False`, but neither `a` is `True` and `b` is `False`, nor `a` is `False` and `b` is `True`.
|
||||
-/
|
||||
private def checkIffStatus (e a b : Expr) : GoalM CaseSplitStatus := do
|
||||
if (← isEqTrue e) then
|
||||
if (← (isEqTrue a <&&> isEqTrue b) <||> (isEqFalse a <&&> isEqFalse b)) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else if (← isEqFalse e) then
|
||||
if (← (isEqTrue a <&&> isEqFalse b) <||> (isEqFalse a <&&> isEqTrue b)) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready 2
|
||||
else
|
||||
return .notReady
|
||||
|
||||
/-- Returns `true` is `c` is congruent to a case-split that was already performed. -/
|
||||
private def isCongrToPrevSplit (c : Expr) : GoalM Bool := do
|
||||
(← get).resolvedSplits.foldM (init := false) fun flag { expr := c' } => do
|
||||
if flag then
|
||||
return true
|
||||
else
|
||||
return isCongruent (← get).enodes c c'
|
||||
|
||||
private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
|
||||
match_expr e with
|
||||
| Or a b => checkDisjunctStatus e a b
|
||||
| And a b => checkConjunctStatus e a b
|
||||
| Eq _ a b => checkIffStatus e a b
|
||||
| ite _ c _ _ _ => checkIteCondStatus c
|
||||
| dite _ c _ _ _ => checkIteCondStatus c
|
||||
| Or a b =>
|
||||
if (← isEqTrue e) then
|
||||
if (← isEqTrue a <||> isEqTrue b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready
|
||||
else if (← isEqFalse e) then
|
||||
return .resolved
|
||||
else
|
||||
return .notReady
|
||||
| And a b =>
|
||||
if (← isEqTrue e) then
|
||||
return .resolved
|
||||
else if (← isEqFalse e) then
|
||||
if (← isEqFalse a <||> isEqFalse b) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready
|
||||
else
|
||||
return .notReady
|
||||
| ite _ c _ _ _ =>
|
||||
if (← isEqTrue c <||> isEqFalse c) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready
|
||||
| dite _ c _ _ _ =>
|
||||
if (← isEqTrue c <||> isEqFalse c) then
|
||||
return .resolved
|
||||
else
|
||||
return .ready
|
||||
| _ =>
|
||||
if (← isResolvedCaseSplit e) then
|
||||
trace[grind.debug.split] "split resolved: {e}"
|
||||
return .resolved
|
||||
if (← isCongrToPrevSplit e) then
|
||||
return .resolved
|
||||
if let some info := isMatcherAppCore? (← getEnv) e then
|
||||
return .ready info.numAlts
|
||||
if (← isMatcherApp e) then
|
||||
return .ready
|
||||
let .const declName .. := e.getAppFn | unreachable!
|
||||
if let some info ← isInductivePredicate? declName then
|
||||
if (← isEqTrue e) then
|
||||
return .ready info.ctors.length info.isRec
|
||||
if (← isInductivePredicate declName <&&> isEqTrue e) then
|
||||
return .ready
|
||||
return .notReady
|
||||
|
||||
private inductive SplitCandidate where
|
||||
| none
|
||||
| some (c : Expr) (numCases : Nat) (isRec : Bool)
|
||||
|
||||
/-- Returns the next case-split to be performed. It uses a very simple heuristic. -/
|
||||
private def selectNextSplit? : GoalM SplitCandidate := do
|
||||
if (← isInconsistent) then return .none
|
||||
if (← checkMaxCaseSplit) then return .none
|
||||
go (← get).splitCandidates .none []
|
||||
private def selectNextSplit? : GoalM (Option Expr) := do
|
||||
if (← isInconsistent) then return none
|
||||
if (← checkMaxCaseSplit) then return none
|
||||
go (← get).splitCandidates none []
|
||||
where
|
||||
go (cs : List Expr) (c? : SplitCandidate) (cs' : List Expr) : GoalM SplitCandidate := do
|
||||
go (cs : List Expr) (c? : Option Expr) (cs' : List Expr) : GoalM (Option Expr) := do
|
||||
match cs with
|
||||
| [] =>
|
||||
modify fun s => { s with splitCandidates := cs'.reverse }
|
||||
if let .some _ numCases isRec := c? then
|
||||
let numSplits := (← get).numSplits
|
||||
-- We only increase the number of splits if there is more than one case or it is recursive.
|
||||
let numSplits := if numCases > 1 || isRec then numSplits + 1 else numSplits
|
||||
if c?.isSome then
|
||||
-- Remark: we reset `numEmatch` after each case split.
|
||||
-- We should consider other strategies in the future.
|
||||
modify fun s => { s with numSplits, numEmatch := 0 }
|
||||
modify fun s => { s with numSplits := s.numSplits + 1, numEmatch := 0 }
|
||||
return c?
|
||||
| c::cs =>
|
||||
match (← checkCaseSplitStatus c) with
|
||||
| .notReady => go cs c? (c::cs')
|
||||
| .resolved => go cs c? cs'
|
||||
| .ready numCases isRec =>
|
||||
| .ready =>
|
||||
match c? with
|
||||
| .none => go cs (.some c numCases isRec) cs'
|
||||
| .some c' numCases' _ =>
|
||||
let isBetter : GoalM Bool := do
|
||||
if numCases == 1 && !isRec && numCases' > 1 then
|
||||
return true
|
||||
if (← getGeneration c) < (← getGeneration c') then
|
||||
return true
|
||||
return numCases < numCases'
|
||||
if (← isBetter) then
|
||||
go cs (.some c numCases isRec) (c'::cs')
|
||||
| none => go cs (some c) cs'
|
||||
| some c' =>
|
||||
if (← getGeneration c) < (← getGeneration c') then
|
||||
go cs (some c) (c'::cs')
|
||||
else
|
||||
go cs c? (c::cs')
|
||||
|
||||
@@ -150,12 +94,7 @@ private def mkCasesMajor (c : Expr) : GoalM Expr := do
|
||||
| And a b => return mkApp3 (mkConst ``Grind.or_of_and_eq_false) a b (← mkEqFalseProof c)
|
||||
| ite _ c _ _ _ => return mkEM c
|
||||
| dite _ c _ _ _ => return mkEM c
|
||||
| Eq _ a b =>
|
||||
if (← isEqTrue c) then
|
||||
return mkApp3 (mkConst ``Grind.of_eq_eq_true) a b (← mkEqTrueProof c)
|
||||
else
|
||||
return mkApp3 (mkConst ``Grind.of_eq_eq_false) a b (← mkEqFalseProof c)
|
||||
| _ => return mkOfEqTrueCore c (← mkEqTrueProof c)
|
||||
| _ => return mkApp2 (mkConst ``of_eq_true) c (← mkEqTrueProof c)
|
||||
|
||||
/-- Introduces new hypotheses in each goal. -/
|
||||
private def introNewHyp (goals : List Goal) (acc : List Goal) (generation : Nat) : GrindM (List Goal) := do
|
||||
@@ -169,11 +108,9 @@ and returns a new list of goals if successful.
|
||||
-/
|
||||
def splitNext : GrindTactic := fun goal => do
|
||||
let (goals?, _) ← GoalM.run goal do
|
||||
let .some c numCases isRec ← selectNextSplit?
|
||||
let some c ← selectNextSplit?
|
||||
| return none
|
||||
let gen ← getGeneration c
|
||||
let genNew := if numCases > 1 || isRec then gen+1 else gen
|
||||
markCaseSplitAsResolved c
|
||||
trace_goal[grind.split] "{c}, generation: {gen}"
|
||||
let mvarIds ← if (← isMatcherApp c) then
|
||||
casesMatch (← get).mvarId c
|
||||
@@ -182,7 +119,7 @@ def splitNext : GrindTactic := fun goal => do
|
||||
cases (← get).mvarId major
|
||||
let goal ← get
|
||||
let goals := mvarIds.map fun mvarId => { goal with mvarId }
|
||||
let goals ← introNewHyp goals [] genNew
|
||||
let goals ← introNewHyp goals [] (gen+1)
|
||||
return some goals
|
||||
return goals?
|
||||
|
||||
|
||||
@@ -13,13 +13,17 @@ import Lean.Meta.CongrTheorems
|
||||
import Lean.Meta.AbstractNestedProofs
|
||||
import Lean.Meta.Tactic.Simp.Types
|
||||
import Lean.Meta.Tactic.Util
|
||||
import Lean.Meta.Tactic.Grind.ENodeKey
|
||||
import Lean.Meta.Tactic.Grind.Canon
|
||||
import Lean.Meta.Tactic.Grind.Attr
|
||||
import Lean.Meta.Tactic.Grind.Arith.Types
|
||||
import Lean.Meta.Tactic.Grind.EMatchTheorem
|
||||
|
||||
namespace Lean.Meta.Grind
|
||||
|
||||
@[inline] def isSameExpr (a b : Expr) : Bool :=
|
||||
-- It is safe to use pointer equality because we hashcons all expressions
|
||||
-- inserted into the E-graph
|
||||
unsafe ptrEq a b
|
||||
|
||||
/-- We use this auxiliary constant to mark delayed congruence proofs. -/
|
||||
def congrPlaceholderProof := mkConst (Name.mkSimple "[congruence]")
|
||||
|
||||
@@ -65,6 +69,7 @@ instance : Hashable CongrTheoremCacheKey where
|
||||
|
||||
/-- State for the `GrindM` monad. -/
|
||||
structure State where
|
||||
canon : Canon.State := {}
|
||||
/-- `ShareCommon` (aka `Hashconsing`) state. -/
|
||||
scState : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
|
||||
/-- Next index for creating auxiliary theorems. -/
|
||||
@@ -78,7 +83,6 @@ structure State where
|
||||
simpStats : Simp.Stats := {}
|
||||
trueExpr : Expr
|
||||
falseExpr : Expr
|
||||
natZExpr : Expr
|
||||
/--
|
||||
Used to generate trace messages of the for `[grind] working on <tag>`,
|
||||
and implement the macro `trace_goal`.
|
||||
@@ -103,10 +107,6 @@ def getTrueExpr : GrindM Expr := do
|
||||
def getFalseExpr : GrindM Expr := do
|
||||
return (← get).falseExpr
|
||||
|
||||
/-- Returns the internalized `0 : Nat` numeral. -/
|
||||
def getNatZeroExpr : GrindM Expr := do
|
||||
return (← get).natZExpr
|
||||
|
||||
def getMainDeclName : GrindM Name :=
|
||||
return (← readThe Context).mainDeclName
|
||||
|
||||
@@ -131,9 +131,18 @@ Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
|
||||
been hash-consed. We perform this step before we internalize expressions.
|
||||
-/
|
||||
def shareCommon (e : Expr) : GrindM Expr := do
|
||||
modifyGet fun { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag } =>
|
||||
modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
|
||||
let (e, scState) := ShareCommon.State.shareCommon scState e
|
||||
(e, { scState, nextThmIdx, congrThms, trueExpr, falseExpr, natZExpr, simpStats, lastTag })
|
||||
(e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag })
|
||||
|
||||
/--
|
||||
Canonicalizes nested types, type formers, and instances in `e`.
|
||||
-/
|
||||
def canon (e : Expr) : GrindM Expr := do
|
||||
let canonS ← modifyGet fun s => (s.canon, { s with canon := {} })
|
||||
let (e, canonS) ← Canon.canon e |>.run canonS
|
||||
modify fun s => { s with canon := canonS }
|
||||
return e
|
||||
|
||||
/-- Returns `true` if `e` is the internalized `True` expression. -/
|
||||
def isTrueExpr (e : Expr) : GrindM Bool :=
|
||||
@@ -196,19 +205,13 @@ structure ENode where
|
||||
on heterogeneous equality.
|
||||
-/
|
||||
heqProofs : Bool := false
|
||||
/-- Unique index used for pretty printing and debugging purposes. -/
|
||||
/--
|
||||
Unique index used for pretty printing and debugging purposes.
|
||||
-/
|
||||
idx : Nat := 0
|
||||
/-- The generation in which this enode was created. -/
|
||||
generation : Nat := 0
|
||||
/-- Modification time -/
|
||||
mt : Nat := 0
|
||||
/--
|
||||
The `offset?` field is used to propagate equalities from the `grind` congruence closure module
|
||||
to the offset constraints module. When `grind` merges two equivalence classes, and both have
|
||||
an associated `offset?` set to `some e`, the equality is propagated. This field is
|
||||
assigned during the internalization of offset terms.
|
||||
-/
|
||||
offset? : Option Expr := none
|
||||
deriving Inhabited, Repr
|
||||
|
||||
def ENode.isCongrRoot (n : ENode) :=
|
||||
@@ -221,6 +224,20 @@ structure NewEq where
|
||||
proof : Expr
|
||||
isHEq : Bool
|
||||
|
||||
/--
|
||||
Key for the `ENodeMap` and `ParentMap` map.
|
||||
We use pointer addresses and rely on the fact all internalized expressions
|
||||
have been hash-consed, i.e., we have applied `shareCommon`.
|
||||
-/
|
||||
private structure ENodeKey where
|
||||
expr : Expr
|
||||
|
||||
instance : Hashable ENodeKey where
|
||||
hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
|
||||
|
||||
instance : BEq ENodeKey where
|
||||
beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
|
||||
|
||||
abbrev ENodeMap := PHashMap ENodeKey ENode
|
||||
|
||||
/--
|
||||
@@ -332,16 +349,8 @@ structure NewFact where
|
||||
generation : Nat
|
||||
deriving Inhabited
|
||||
|
||||
/-- Canonicalizer state. See `Canon.lean` for additional details. -/
|
||||
structure Canon.State where
|
||||
argMap : PHashMap (Expr × Nat) (List Expr) := {}
|
||||
canon : PHashMap Expr Expr := {}
|
||||
proofCanon : PHashMap Expr Expr := {}
|
||||
deriving Inhabited
|
||||
|
||||
structure Goal where
|
||||
mvarId : MVarId
|
||||
canon : Canon.State := {}
|
||||
enodes : ENodeMap := {}
|
||||
parents : ParentMap := {}
|
||||
congrTable : CongrTable enodes := {}
|
||||
@@ -359,8 +368,6 @@ structure Goal where
|
||||
gmt : Nat := 0
|
||||
/-- Next unique index for creating ENodes -/
|
||||
nextIdx : Nat := 0
|
||||
/-- State of arithmetic procedures -/
|
||||
arith : Arith.State := {}
|
||||
/-- Active theorems that we have performed ematching at least once. -/
|
||||
thms : PArray EMatchTheorem := {}
|
||||
/-- Active theorems that we have not performed any round of ematching yet. -/
|
||||
@@ -384,17 +391,10 @@ structure Goal where
|
||||
splitCandidates : List Expr := []
|
||||
/-- Number of splits performed to get to this goal. -/
|
||||
numSplits : Nat := 0
|
||||
/-- Case-splits that have already been performed, or that do not have to be performed anymore. -/
|
||||
/-- Case-splits that do not have to be performed anymore. -/
|
||||
resolvedSplits : PHashSet ENodeKey := {}
|
||||
/-- Next local E-match theorem idx. -/
|
||||
nextThmIdx : Nat := 0
|
||||
/-- Asserted facts -/
|
||||
facts : PArray Expr := {}
|
||||
/--
|
||||
Issues found during the proof search in this goal. This issues are reported to
|
||||
users when `grind` fails.
|
||||
-/
|
||||
issues : List MessageData := []
|
||||
deriving Inhabited
|
||||
|
||||
def Goal.admit (goal : Goal) : MetaM Unit :=
|
||||
@@ -415,20 +415,6 @@ def updateLastTag : GoalM Unit := do
|
||||
trace[grind] "working on goal `{currTag}`"
|
||||
modifyThe Grind.State fun s => { s with lastTag := currTag }
|
||||
|
||||
def Goal.reportIssue (goal : Goal) (msg : MessageData) : MetaM Goal := do
|
||||
let msg ← addMessageContext msg
|
||||
let goal := { goal with issues := .trace { cls := `issue } msg #[] :: goal.issues }
|
||||
/-
|
||||
We also add a trace message because we may want to know when
|
||||
an issue happened relative to other trace messages.
|
||||
-/
|
||||
trace[grind.issues] msg
|
||||
return goal
|
||||
|
||||
def reportIssue (msg : MessageData) : GoalM Unit := do
|
||||
let goal ← (← get).reportIssue msg
|
||||
set goal
|
||||
|
||||
/--
|
||||
Macro similar to `trace[...]`, but it includes the trace message `trace[grind] "working on <current goal>"`
|
||||
if the tag has changed since the last trace message.
|
||||
@@ -477,25 +463,14 @@ def checkMaxEmatchExceeded : GoalM Bool := do
|
||||
Returns `some n` if `e` has already been "internalized" into the
|
||||
Otherwise, returns `none`s.
|
||||
-/
|
||||
def Goal.getENode? (goal : Goal) (e : Expr) : Option ENode :=
|
||||
goal.enodes.find? { expr := e }
|
||||
|
||||
@[inline, inherit_doc Goal.getENode?]
|
||||
def getENode? (e : Expr) : GoalM (Option ENode) :=
|
||||
return (← get).getENode? e
|
||||
|
||||
def throwNonInternalizedExpr (e : Expr) : CoreM α :=
|
||||
throwError "internal `grind` error, term has not been internalized{indentExpr e}"
|
||||
return (← get).enodes.find? { expr := e }
|
||||
|
||||
/-- Returns node associated with `e`. It assumes `e` has already been internalized. -/
|
||||
def Goal.getENode (goal : Goal) (e : Expr) : CoreM ENode := do
|
||||
let some n := goal.enodes.find? { expr := e }
|
||||
| throwNonInternalizedExpr e
|
||||
return n
|
||||
|
||||
@[inline, inherit_doc Goal.getENode]
|
||||
def getENode (e : Expr) : GoalM ENode := do
|
||||
(← get).getENode e
|
||||
let some n := (← get).enodes.find? { expr := e }
|
||||
| throwError "internal `grind` error, term has not been internalized{indentExpr e}"
|
||||
return n
|
||||
|
||||
/-- Returns the generation of the given term. Is assumes it has been internalized -/
|
||||
def getGeneration (e : Expr) : GoalM Nat :=
|
||||
@@ -526,53 +501,30 @@ def isRoot (e : Expr) : GoalM Bool := do
|
||||
return isSameExpr n.root e
|
||||
|
||||
/-- Returns the root element in the equivalence class of `e` IF `e` has been internalized. -/
|
||||
def Goal.getRoot? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
def getRoot? (e : Expr) : GoalM (Option Expr) := do
|
||||
let some n ← getENode? e | return none
|
||||
return some n.root
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot?]
|
||||
def getRoot? (e : Expr) : GoalM (Option Expr) := do
|
||||
return (← get).getRoot? e
|
||||
|
||||
/-- Returns the root element in the equivalence class of `e`. -/
|
||||
def Goal.getRoot (goal : Goal) (e : Expr) : CoreM Expr :=
|
||||
return (← goal.getENode e).root
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot]
|
||||
def getRoot (e : Expr) : GoalM Expr := do
|
||||
(← get).getRoot e
|
||||
def getRoot (e : Expr) : GoalM Expr :=
|
||||
return (← getENode e).root
|
||||
|
||||
/-- Returns the root enode in the equivalence class of `e`. -/
|
||||
def getRootENode (e : Expr) : GoalM ENode := do
|
||||
getENode (← getRoot e)
|
||||
|
||||
/--
|
||||
Returns the next element in the equivalence class of `e`
|
||||
if `e` has been internalized in the given goal.
|
||||
-/
|
||||
def Goal.getNext? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
return some n.next
|
||||
|
||||
/-- Returns the next element in the equivalence class of `e`. -/
|
||||
def Goal.getNext (goal : Goal) (e : Expr) : CoreM Expr :=
|
||||
return (← goal.getENode e).next
|
||||
|
||||
@[inline, inherit_doc Goal.getRoot]
|
||||
def getNext (e : Expr) : GoalM Expr := do
|
||||
(← get).getNext e
|
||||
def getNext (e : Expr) : GoalM Expr :=
|
||||
return (← getENode e).next
|
||||
|
||||
/-- Returns `true` if `e` has already been internalized. -/
|
||||
def alreadyInternalized (e : Expr) : GoalM Bool :=
|
||||
return (← get).enodes.contains { expr := e }
|
||||
|
||||
def Goal.getTarget? (goal : Goal) (e : Expr) : Option Expr := Id.run do
|
||||
let some n ← goal.getENode? e | return none
|
||||
def getTarget? (e : Expr) : GoalM (Option Expr) := do
|
||||
let some n ← getENode? e | return none
|
||||
return n.target?
|
||||
|
||||
@[inline] def getTarget? (e : Expr) : GoalM (Option Expr) := do
|
||||
return (← get).getTarget? e
|
||||
|
||||
/--
|
||||
If `isHEq` is `false`, it pushes `lhs = rhs` with `proof` to `newEqs`.
|
||||
Otherwise, it pushes `HEq lhs rhs`.
|
||||
@@ -670,41 +622,6 @@ def mkENode (e : Expr) (generation : Nat) : GoalM Unit := do
|
||||
let interpreted ← isInterpreted e
|
||||
mkENodeCore e interpreted ctor generation
|
||||
|
||||
/--
|
||||
Notify the offset constraint module that `a = b` where
|
||||
`a` and `b` are terms that have been internalized by this module.
|
||||
-/
|
||||
@[extern "lean_process_new_offset_eq"] -- forward definition
|
||||
opaque Arith.processNewOffsetEq (a b : Expr) : GoalM Unit
|
||||
|
||||
/--
|
||||
Notify the offset constraint module that `a = k` where
|
||||
`a` is term that has been internalized by this module,
|
||||
and `k` is a numeral.
|
||||
-/
|
||||
@[extern "lean_process_new_offset_eq_lit"] -- forward definition
|
||||
opaque Arith.processNewOffsetEqLit (a k : Expr) : GoalM Unit
|
||||
|
||||
/-- Returns `true` if `e` is a numeral and has type `Nat`. -/
|
||||
def isNatNum (e : Expr) : Bool := Id.run do
|
||||
let_expr OfNat.ofNat _ _ inst := e | false
|
||||
let_expr instOfNatNat _ := inst | false
|
||||
true
|
||||
|
||||
/--
|
||||
Marks `e` as a term of interest to the offset constraint module.
|
||||
If the root of `e`s equivalence class has already a term of interest,
|
||||
a new equality is propagated to the offset module.
|
||||
-/
|
||||
def markAsOffsetTerm (e : Expr) : GoalM Unit := do
|
||||
let root ← getRootENode e
|
||||
if let some e' := root.offset? then
|
||||
Arith.processNewOffsetEq e e'
|
||||
else if isNatNum root.self && !isSameExpr e root.self then
|
||||
Arith.processNewOffsetEqLit e root.self
|
||||
else
|
||||
setENode root.self { root with offset? := some e }
|
||||
|
||||
/-- Returns `true` is `e` is the root of its congruence class. -/
|
||||
def isCongrRoot (e : Expr) : GoalM Bool := do
|
||||
return (← getENode e).isCongrRoot
|
||||
@@ -779,23 +696,11 @@ def closeGoal (falseProof : Expr) : GoalM Unit := do
|
||||
else
|
||||
mvarId.assign (← mkFalseElim target falseProof)
|
||||
|
||||
def Goal.getENodes (goal : Goal) : Array ENode :=
|
||||
-- We must sort because we are using pointer addresses as keys in `enodes`
|
||||
let nodes := goal.enodes.toArray.map (·.2)
|
||||
nodes.qsort fun a b => a.idx < b.idx
|
||||
|
||||
/-- Returns all enodes in the goal -/
|
||||
def getENodes : GoalM (Array ENode) := do
|
||||
return (← get).getENodes
|
||||
|
||||
/-- Executes `f` to each term in the equivalence class containing `e` -/
|
||||
@[inline] def traverseEqc (e : Expr) (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let mut curr := e
|
||||
repeat
|
||||
let n ← getENode curr
|
||||
f n
|
||||
if isSameExpr n.next e then return ()
|
||||
curr := n.next
|
||||
-- We must sort because we are using pointer addresses as keys in `enodes`
|
||||
let nodes := (← get).enodes.toArray.map (·.2)
|
||||
return nodes.qsort fun a b => a.idx < b.idx
|
||||
|
||||
def forEachENode (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let nodes ← getENodes
|
||||
@@ -809,7 +714,7 @@ def filterENodes (p : ENode → GoalM Bool) : GoalM (Array ENode) := do
|
||||
ref.modify (·.push n)
|
||||
ref.get
|
||||
|
||||
def forEachEqcRoot (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
def forEachEqc (f : ENode → GoalM Unit) : GoalM Unit := do
|
||||
let nodes ← getENodes
|
||||
for n in nodes do
|
||||
if isSameExpr n.self n.root then
|
||||
@@ -844,42 +749,33 @@ def applyFallback : GoalM Unit := do
|
||||
fallback
|
||||
|
||||
/-- Returns expressions in the given expression equivalence class. -/
|
||||
partial def Goal.getEqc (goal : Goal) (e : Expr) : List Expr :=
|
||||
partial def getEqc (e : Expr) : GoalM (List Expr) :=
|
||||
go e e []
|
||||
where
|
||||
go (first : Expr) (e : Expr) (acc : List Expr) : List Expr := Id.run do
|
||||
let some next ← goal.getNext? e | acc
|
||||
go (first : Expr) (e : Expr) (acc : List Expr) : GoalM (List Expr) := do
|
||||
let next ← getNext e
|
||||
let acc := e :: acc
|
||||
if isSameExpr first next then
|
||||
return acc
|
||||
else
|
||||
go first next acc
|
||||
|
||||
@[inline, inherit_doc Goal.getEqc]
|
||||
partial def getEqc (e : Expr) : GoalM (List Expr) :=
|
||||
return (← get).getEqc e
|
||||
|
||||
/-- Returns all equivalence classes in the current goal. -/
|
||||
partial def Goal.getEqcs (goal : Goal) : List (List Expr) := Id.run do
|
||||
let mut r : List (List Expr) := []
|
||||
let nodes ← goal.getENodes
|
||||
partial def getEqcs : GoalM (List (List Expr)) := do
|
||||
let mut r := []
|
||||
let nodes ← getENodes
|
||||
for node in nodes do
|
||||
if isSameExpr node.root node.self then
|
||||
r := goal.getEqc node.self :: r
|
||||
r := (← getEqc node.self) :: r
|
||||
return r
|
||||
|
||||
@[inline, inherit_doc Goal.getEqcs]
|
||||
def getEqcs : GoalM (List (List Expr)) :=
|
||||
return (← get).getEqcs
|
||||
|
||||
/-- Returns `true` if `e` is a case-split that does not need to be performed anymore. -/
|
||||
def isResolvedCaseSplit (e : Expr) : GoalM Bool :=
|
||||
return (← get).resolvedSplits.contains { expr := e }
|
||||
|
||||
/--
|
||||
Mark `e` as a case-split that does not need to be performed anymore.
|
||||
Remark: we currently use this feature to disable `match`-case-splits.
|
||||
Remark: we also use this feature to record the case-splits that have already been performed.
|
||||
Remark: we currently use this feature to disable `match`-case-splits
|
||||
-/
|
||||
def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
|
||||
unless (← isResolvedCaseSplit e) do
|
||||
|
||||
@@ -50,24 +50,18 @@ def simpCnstr? (e : Expr) : MetaM (Option (Expr × Expr)) := do
|
||||
if let some arg := e.not? then
|
||||
let mut eNew? := none
|
||||
let mut thmName := Name.anonymous
|
||||
match_expr arg with
|
||||
| LE.le α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_le_eq
|
||||
| GE.ge α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_ge_eq
|
||||
| LT.lt α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_lt_eq
|
||||
| GT.gt α _ _ _ =>
|
||||
if α.isConstOf ``Nat then
|
||||
eNew? := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_gt_eq
|
||||
| _ => pure ()
|
||||
if arg.isAppOfArity ``LE.le 4 then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 3) (mkNatLit 1)) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_le_eq
|
||||
else if arg.isAppOfArity ``GE.ge 4 then
|
||||
eNew? := some (← mkLE (← mkAdd (arg.getArg! 2) (mkNatLit 1)) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_ge_eq
|
||||
else if arg.isAppOfArity ``LT.lt 4 then
|
||||
eNew? := some (← mkLE (arg.getArg! 3) (arg.getArg! 2))
|
||||
thmName := ``Nat.not_lt_eq
|
||||
else if arg.isAppOfArity ``GT.gt 4 then
|
||||
eNew? := some (← mkLE (arg.getArg! 2) (arg.getArg! 3))
|
||||
thmName := ``Nat.not_gt_eq
|
||||
if let some eNew := eNew? then
|
||||
let h₁ := mkApp2 (mkConst thmName) (arg.getArg! 2) (arg.getArg! 3)
|
||||
if let some (eNew', h₂) ← simpCnstrPos? eNew then
|
||||
|
||||
@@ -1583,8 +1583,8 @@ namespace TokenMap
|
||||
|
||||
def insert (map : TokenMap α) (k : Name) (v : α) : TokenMap α :=
|
||||
match map.find? k with
|
||||
| none => RBMap.insert map k [v]
|
||||
| some vs => RBMap.insert map k (v::vs)
|
||||
| none => .insert map k [v]
|
||||
| some vs => .insert map k (v::vs)
|
||||
|
||||
instance : Inhabited (TokenMap α) where
|
||||
default := RBMap.empty
|
||||
|
||||
@@ -103,8 +103,11 @@ partial def compileParserExpr (e : Expr) : MetaM Expr := do
|
||||
name := c', levelParams := []
|
||||
type := ty, value := value, hints := ReducibilityHints.opaque, safety := DefinitionSafety.safe
|
||||
}
|
||||
addAndCompile decl
|
||||
modifyEnv (ctx.combinatorAttr.setDeclFor · c c')
|
||||
let env ← getEnv
|
||||
let env ← match env.addAndCompile {} decl with
|
||||
| Except.ok env => pure env
|
||||
| Except.error kex => do throwError (← (kex.toMessageData {}).toString)
|
||||
setEnv <| ctx.combinatorAttr.setDeclFor env c c'
|
||||
if cinfo.type.isConst then
|
||||
if let some kind ← parserNodeKind? cinfo.value! then
|
||||
-- If the parser is parameter-less and produces a node of kind `kind`,
|
||||
|
||||
@@ -97,7 +97,7 @@ abbrev RequestT m := ReaderT RequestContext <| ExceptT RequestError m
|
||||
/-- Workers execute request handlers in this monad. -/
|
||||
abbrev RequestM := ReaderT RequestContext <| EIO RequestError
|
||||
|
||||
abbrev RequestTask.pure (a : α) : RequestTask α := Task.pure (.ok a)
|
||||
abbrev RequestTask.pure (a : α) : RequestTask α := .pure (.ok a)
|
||||
|
||||
instance : MonadLift IO RequestM where
|
||||
monadLift x := do
|
||||
|
||||
@@ -104,26 +104,17 @@ def initSearchPath (leanSysroot : FilePath) (sp : SearchPath := ∅) : IO Unit :
|
||||
private def initSearchPathInternal : IO Unit := do
|
||||
initSearchPath (← getBuildDir)
|
||||
|
||||
/-- Find the compiled `.olean` of a module in the `LEAN_PATH` search path. -/
|
||||
partial def findOLean (mod : Name) : IO FilePath := do
|
||||
let sp ← searchPathRef.get
|
||||
if let some fname ← sp.findWithExt "olean" mod then
|
||||
return fname
|
||||
else
|
||||
let pkg := FilePath.mk <| mod.getRoot.toString (escape := false)
|
||||
throw <| IO.userError s!"unknown module prefix '{pkg}'\n\n\
|
||||
No directory '{pkg}' or file '{pkg}.olean' in the search path entries:\n\
|
||||
{"\n".intercalate <| sp.map (·.toString)}"
|
||||
let mut msg := s!"unknown module prefix '{pkg}'
|
||||
|
||||
/-- Find the `.lean` source of a module in a `LEAN_SRC_PATH` search path. -/
|
||||
partial def findLean (sp : SearchPath) (mod : Name) : IO FilePath := do
|
||||
if let some fname ← sp.findWithExt "lean" mod then
|
||||
return fname
|
||||
else
|
||||
let pkg := FilePath.mk <| mod.getRoot.toString (escape := false)
|
||||
throw <| IO.userError s!"unknown module prefix '{pkg}'\n\n\
|
||||
No directory '{pkg}' or file '{pkg}.lean' in the search path entries:\n\
|
||||
{"\n".intercalate <| sp.map (·.toString)}"
|
||||
No directory '{pkg}' or file '{pkg}.olean' in the search path entries:
|
||||
{"\n".intercalate <| sp.map (·.toString)}"
|
||||
throw <| IO.userError msg
|
||||
|
||||
/-- Infer module name of source file name. -/
|
||||
@[export lean_module_name_of_file]
|
||||
|
||||
@@ -207,9 +207,7 @@ partial def msgToInteractive (msgData : MessageData) (hasWidgets : Bool) (indent
|
||||
| .widget wi alt =>
|
||||
return .tag (.widget wi (← fmtToTT alt col)) default
|
||||
| .trace cls msg collapsed children => do
|
||||
-- absolute column = request-level indentation (e.g. from nested lazy trace request) +
|
||||
-- offset inside `fmt`
|
||||
let col := indent + col
|
||||
let col := col + tt.stripTags.length - 2
|
||||
let children ←
|
||||
match children with
|
||||
| .lazy children => pure <| .lazy ⟨{indent := col+2, children := children.map .mk}⟩
|
||||
|
||||
@@ -10,4 +10,3 @@ import Std.Sync
|
||||
import Std.Time
|
||||
import Std.Tactic
|
||||
import Std.Internal
|
||||
import Std.Net
|
||||
|
||||
@@ -251,27 +251,34 @@ instance [BEq α] [Hashable α] : ForIn m (DHashMap α β) ((a : α) × β a) wh
|
||||
Modifies in place the value associated with a given key.
|
||||
|
||||
This function ensures that the value is used linearly.
|
||||
It is currently implemented in terms of `get?`, `erase`, and `insert`,
|
||||
but will later become a primitive operation.
|
||||
(It is provided already to help avoid non-linear code.)
|
||||
-/
|
||||
@[inline] def modify [LawfulBEq α] (m : DHashMap α β) (a : α) (f : β a → β a) : DHashMap α β :=
|
||||
⟨Raw₀.modify ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.modify₀ m.2⟩
|
||||
|
||||
@[inline, inherit_doc DHashMap.modify] def Const.modify {β : Type v} (m : DHashMap α (fun _ => β))
|
||||
(a : α) (f : β → β) : DHashMap α (fun _ => β) :=
|
||||
⟨Raw₀.Const.modify ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.constModify₀ m.2⟩
|
||||
match m.get? a with
|
||||
| none => m
|
||||
| some b => m.erase a |>.insert a (f b)
|
||||
|
||||
/--
|
||||
Modifies in place the value associated with a given key,
|
||||
allowing creating new values and deleting values via an `Option` valued replacement function.
|
||||
|
||||
This function ensures that the value is used linearly.
|
||||
It is currently implemented in terms of `get?`, `erase`, and `insert`,
|
||||
but will later become a primitive operation.
|
||||
(It is provided already to help avoid non-linear code.)
|
||||
-/
|
||||
@[inline] def alter [LawfulBEq α] (m : DHashMap α β)
|
||||
(a : α) (f : Option (β a) → Option (β a)) : DHashMap α β :=
|
||||
⟨Raw₀.alter ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.alter₀ m.2⟩
|
||||
|
||||
@[inline, inherit_doc DHashMap.alter] def Const.alter {β : Type v}
|
||||
(m : DHashMap α (fun _ => β)) (a : α) (f : Option β → Option β) : DHashMap α (fun _ => β) :=
|
||||
⟨Raw₀.Const.alter ⟨m.1, m.2.size_buckets_pos⟩ a f, Raw.WF.constAlter₀ m.2⟩
|
||||
@[inline] def alter [LawfulBEq α] (m : DHashMap α β) (a : α) (f : Option (β a) → Option (β a)) : DHashMap α β :=
|
||||
match m.get? a with
|
||||
| none =>
|
||||
match f none with
|
||||
| none => m
|
||||
| some b => m.insert a b
|
||||
| some b =>
|
||||
match f (some b) with
|
||||
| none => m.erase a
|
||||
| some b => m.erase a |>.insert a b
|
||||
|
||||
@[inline, inherit_doc Raw.insertMany] def insertMany {ρ : Type w}
|
||||
[ForIn Id ρ ((a : α) × β a)] (m : DHashMap α β) (l : ρ) : DHashMap α β :=
|
||||
@@ -290,12 +297,24 @@ This function ensures that the value is used linearly.
|
||||
⟨(Raw₀.Const.insertManyIfNewUnit ⟨m.1, m.2.size_buckets_pos⟩ l).1,
|
||||
(Raw₀.Const.insertManyIfNewUnit ⟨m.1, m.2.size_buckets_pos⟩ l).2 _ Raw.WF.insertIfNew₀ m.2⟩
|
||||
|
||||
@[inline, inherit_doc Raw.ofList] def ofList [BEq α] [Hashable α] (l : List ((a : α) × β a)) :
|
||||
DHashMap α β :=
|
||||
insertMany ∅ l
|
||||
|
||||
/-- Computes the union of the given hash maps, by traversing `m₂` and inserting its elements into `m₁`. -/
|
||||
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : DHashMap α β) : DHashMap α β :=
|
||||
m₂.fold (init := m₁) fun acc x => acc.insert x
|
||||
|
||||
instance [BEq α] [Hashable α] : Union (DHashMap α β) := ⟨union⟩
|
||||
|
||||
@[inline, inherit_doc Raw.Const.ofList] def Const.ofList {β : Type v} [BEq α] [Hashable α]
|
||||
(l : List (α × β)) : DHashMap α (fun _ => β) :=
|
||||
Const.insertMany ∅ l
|
||||
|
||||
@[inline, inherit_doc Raw.Const.unitOfList] def Const.unitOfList [BEq α] [Hashable α] (l : List α) :
|
||||
DHashMap α (fun _ => Unit) :=
|
||||
Const.insertManyIfNewUnit ∅ l
|
||||
|
||||
@[inline, inherit_doc Raw.Const.unitOfArray] def Const.unitOfArray [BEq α] [Hashable α] (l : Array α) :
|
||||
DHashMap α (fun _ => Unit) :=
|
||||
Const.insertManyIfNewUnit ∅ l
|
||||
@@ -309,16 +328,4 @@ instance [BEq α] [Hashable α] [Repr α] [(a : α) → Repr (β a)] : Repr (DHa
|
||||
|
||||
end Unverified
|
||||
|
||||
@[inline, inherit_doc Raw.ofList] def ofList [BEq α] [Hashable α] (l : List ((a : α) × β a)) :
|
||||
DHashMap α β :=
|
||||
insertMany ∅ l
|
||||
|
||||
@[inline, inherit_doc Raw.Const.ofList] def Const.ofList {β : Type v} [BEq α] [Hashable α]
|
||||
(l : List (α × β)) : DHashMap α (fun _ => β) :=
|
||||
Const.insertMany ∅ l
|
||||
|
||||
@[inline, inherit_doc Raw.Const.unitOfList] def Const.unitOfList [BEq α] [Hashable α] (l : List α) :
|
||||
DHashMap α (fun _ => Unit) :=
|
||||
Const.insertManyIfNewUnit ∅ l
|
||||
|
||||
end Std.DHashMap
|
||||
|
||||
@@ -169,63 +169,6 @@ def erase [BEq α] (a : α) : AssocList α β → AssocList α β
|
||||
| nil => nil
|
||||
| cons k v l => bif k == a then l else cons k v (l.erase a)
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
def modify [BEq α] [LawfulBEq α] (a : α) (f : β a → β a) :
|
||||
AssocList α β → AssocList α β
|
||||
| nil => nil
|
||||
| cons k v l =>
|
||||
if h : k == a then
|
||||
have h' : k = a := eq_of_beq h
|
||||
let b := f (cast (congrArg β h') v)
|
||||
cons a b l
|
||||
else
|
||||
cons k v (modify a f l)
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
def alter [BEq α] [LawfulBEq α] (a : α) (f : Option (β a) → Option (β a)) :
|
||||
AssocList α β → AssocList α β
|
||||
| nil => match f none with
|
||||
| none => nil
|
||||
| some b => cons a b nil
|
||||
| cons k v l =>
|
||||
if h : k == a then
|
||||
have h' : k = a := eq_of_beq h
|
||||
match f (some (cast (congrArg β h') v)) with
|
||||
| none => l
|
||||
| some b => cons a b l
|
||||
else
|
||||
let tail := alter a f l
|
||||
cons k v tail
|
||||
|
||||
namespace Const
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
def modify [BEq α] {β : Type v} (a : α) (f : β → β) :
|
||||
AssocList α (fun _ => β) → AssocList α (fun _ => β)
|
||||
| nil => nil
|
||||
| cons k v l =>
|
||||
if k == a then
|
||||
cons a (f v) l
|
||||
else
|
||||
cons k v (modify a f l)
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
def alter [BEq α] {β : Type v} (a : α) (f : Option β → Option β) :
|
||||
AssocList α (fun _ => β) → AssocList α (fun _ => β)
|
||||
| nil => match f none with
|
||||
| none => nil
|
||||
| some b => AssocList.cons a b nil
|
||||
| cons k v l =>
|
||||
if k == a then
|
||||
match f v with
|
||||
| none => l
|
||||
| some b => cons a b l
|
||||
else
|
||||
let tail := alter a f l
|
||||
cons k v tail
|
||||
|
||||
end Const
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def filterMap (f : (a : α) → β a → Option (γ a)) :
|
||||
AssocList α β → AssocList α γ :=
|
||||
|
||||
@@ -199,45 +199,6 @@ theorem toList_filter {f : (a : α) → β a → Bool} {l : AssocList α β} :
|
||||
· exact (ih _).trans (by simpa using perm_middle.symm)
|
||||
· exact ih _
|
||||
|
||||
theorem toList_alter [BEq α] [LawfulBEq α] {a : α} {f : Option (β a) → Option (β a)}
|
||||
{l : AssocList α β} :
|
||||
Perm (l.alter a f).toList (alterKey a f l.toList) := by
|
||||
induction l
|
||||
· simp only [alter, toList_nil, alterKey_nil]
|
||||
split <;> simp_all
|
||||
· rw [toList]
|
||||
refine Perm.trans ?_ alterKey_cons_perm.symm
|
||||
rw [alter]
|
||||
split <;> (try split) <;> simp_all
|
||||
|
||||
theorem modify_eq_alter [BEq α] [LawfulBEq α] {a : α} {f : β a → β a} {l : AssocList α β} :
|
||||
modify a f l = alter a (·.map f) l := by
|
||||
induction l
|
||||
· rfl
|
||||
· next ih => simp only [modify, beq_iff_eq, alter, Option.map_some', ih]
|
||||
|
||||
namespace Const
|
||||
|
||||
variable {β : Type v}
|
||||
|
||||
theorem toList_alter [BEq α] [EquivBEq α] {a : α} {f : Option β → Option β}
|
||||
{l : AssocList α (fun _ => β)} : Perm (alter a f l).toList (Const.alterKey a f l.toList) := by
|
||||
induction l
|
||||
· simp only [alter, toList_nil, alterKey_nil]
|
||||
split <;> simp_all
|
||||
· rw [toList]
|
||||
refine Perm.trans ?_ Const.alterKey_cons_perm.symm
|
||||
rw [alter]
|
||||
split <;> (try split) <;> simp_all
|
||||
|
||||
theorem modify_eq_alter [BEq α] [EquivBEq α] {a : α} {f : β → β} {l : AssocList α (fun _ => β)} :
|
||||
modify a f l = alter a (·.map f) l := by
|
||||
induction l
|
||||
· rfl
|
||||
· next ih => simp only [modify, beq_iff_eq, alter, Option.map_some', ih]
|
||||
|
||||
end Const
|
||||
|
||||
theorem foldl_apply {l : AssocList α β} {acc : List δ} (f : (a : α) → β a → δ) :
|
||||
l.foldl (fun acc k v => f k v :: acc) acc =
|
||||
(l.toList.map (fun p => f p.1 p.2)).reverse ++ acc := by
|
||||
|
||||
@@ -226,72 +226,6 @@ where
|
||||
let buckets' := buckets.uset i (AssocList.cons a b bkt) h
|
||||
expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def modify [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α) (f : β a → β a) :
|
||||
Raw₀ α β :=
|
||||
let ⟨⟨size, buckets⟩, hm⟩ := m
|
||||
let size' := size
|
||||
let ⟨i, hi⟩ := mkIdx buckets.size hm (hash a)
|
||||
let bucket := buckets[i]
|
||||
if bucket.contains a then
|
||||
let buckets := buckets.uset i .nil hi
|
||||
let bucket := bucket.modify a f
|
||||
⟨⟨size, buckets.uset i bucket (by simpa [buckets])⟩, (by simpa [buckets])⟩
|
||||
else
|
||||
m
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def Const.modify [BEq α] {β : Type v} [Hashable α] (m : Raw₀ α (fun _ => β)) (a : α)
|
||||
(f : β → β) : Raw₀ α (fun _ => β) :=
|
||||
let ⟨⟨size, buckets⟩, hm⟩ := m
|
||||
let size' := size
|
||||
let ⟨i, hi⟩ := mkIdx buckets.size hm (hash a)
|
||||
let bucket := buckets[i]
|
||||
if bucket.contains a then
|
||||
let buckets := buckets.uset i .nil hi
|
||||
let bucket := AssocList.Const.modify a f bucket
|
||||
⟨⟨size, buckets.uset i bucket (by simpa [buckets])⟩, (by simpa [buckets])⟩
|
||||
else
|
||||
m
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def alter [BEq α] [Hashable α] [LawfulBEq α] (m : Raw₀ α β) (a : α)
|
||||
(f : Option (β a) → Option (β a)) : Raw₀ α β :=
|
||||
let ⟨⟨size, buckets⟩, hm⟩ := m
|
||||
let ⟨i, h⟩ := mkIdx buckets.size hm (hash a)
|
||||
let bkt := buckets[i]
|
||||
if bkt.contains a then
|
||||
let buckets' := buckets.uset i .nil h
|
||||
let bkt' := bkt.alter a f
|
||||
let size' := if bkt'.contains a then size else size - 1
|
||||
⟨⟨size', buckets'.uset i bkt' (by simpa [buckets'])⟩, by simpa [buckets']⟩
|
||||
else
|
||||
match f none with
|
||||
| none => m
|
||||
| some b =>
|
||||
let size' := size + 1
|
||||
let buckets' := buckets.uset i (.cons a b bkt) h
|
||||
expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def Const.alter [BEq α] [Hashable α] {β : Type v} (m : Raw₀ α (fun _ => β)) (a : α)
|
||||
(f : Option β → Option β) : Raw₀ α (fun _ => β) :=
|
||||
let ⟨⟨size, buckets⟩, hm⟩ := m
|
||||
let ⟨i, h⟩ := mkIdx buckets.size hm (hash a)
|
||||
let bkt := buckets[i]
|
||||
if bkt.contains a then
|
||||
let buckets' := buckets.uset i .nil h
|
||||
let bkt' := AssocList.Const.alter a f bkt
|
||||
let size' := if bkt'.contains a then size else size - 1
|
||||
⟨⟨size', buckets'.uset i bkt' (by simpa [buckets'])⟩, by simpa [buckets']⟩
|
||||
else
|
||||
match f none with
|
||||
| none => m
|
||||
| some b =>
|
||||
let size' := size + 1
|
||||
let buckets' := buckets.uset i (.cons a b bkt) h
|
||||
expandIfNecessary ⟨⟨size', buckets'⟩, by simpa [buckets']⟩
|
||||
|
||||
/-- Internal implementation detail of the hash map -/
|
||||
@[inline] def containsThenInsert [BEq α] [Hashable α] (m : Raw₀ α β) (a : α) (b : β a) :
|
||||
Bool × Raw₀ α β :=
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user