mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-18 02:44:12 +00:00
Compare commits
3 Commits
mkArray_re
...
array_appe
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
cdcb5780b9 | ||
|
|
fa78cf7275 | ||
|
|
f276a7c4db |
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.
|
||||
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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")
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -161,10 +161,7 @@ def pop (a : Array α) : Array α where
|
||||
| ⟨[]⟩ => rfl
|
||||
| ⟨a::as⟩ => simp [pop, Nat.succ_sub_succ_eq_sub, size]
|
||||
|
||||
def replicate {α : Type u} (n : Nat) (v : α) : Array α where
|
||||
toList := List.replicate n v
|
||||
|
||||
@[extern "lean_mk_array", deprecated replicate (since := "2025-01-16")]
|
||||
@[extern "lean_mk_array"]
|
||||
def mkArray {α : Type u} (n : Nat) (v : α) : Array α where
|
||||
toList := List.replicate n v
|
||||
|
||||
@@ -579,12 +576,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,29 +95,24 @@ 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?_replicate : findSome? f (replicate n a) = if n = 0 then none else f a := by
|
||||
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
|
||||
simp [← List.toArray_replicate, List.findSome?_replicate]
|
||||
|
||||
@[simp] theorem findSome?_replicate_of_pos (h : 0 < n) : findSome? f (replicate n a) = f a := by
|
||||
simp [findSome?_replicate, Nat.ne_of_gt h]
|
||||
@[simp] theorem findSome?_mkArray_of_pos (h : 0 < n) : findSome? f (mkArray n a) = f a := by
|
||||
simp [findSome?_mkArray, Nat.ne_of_gt h]
|
||||
|
||||
-- Argument is unused, but used to decide whether `simp` should unfold.
|
||||
@[simp] theorem findSome?_replicate_of_isSome (_ : (f a).isSome) :
|
||||
findSome? f (replicate n a) = if n = 0 then none else f a := by
|
||||
simp [findSome?_replicate]
|
||||
@[simp] theorem findSome?_mkArray_of_isSome (_ : (f a).isSome) :
|
||||
findSome? f (mkArray n a) = if n = 0 then none else f a := by
|
||||
simp [findSome?_mkArray]
|
||||
|
||||
@[simp] theorem findSome?_replicate_of_isNone (h : (f a).isNone) :
|
||||
findSome? f (replicate n a) = none := by
|
||||
@[simp] theorem findSome?_mkArray_of_isNone (h : (f a).isNone) :
|
||||
findSome? f (mkArray n a) = none := by
|
||||
rw [Option.isNone_iff_eq_none] at h
|
||||
simp [findSome?_replicate, h]
|
||||
|
||||
@[deprecated findSome?_replicate (since := "2025-01-16")] abbrev findSome?_mkArray := @findSome?_replicate
|
||||
@[deprecated findSome?_replicate_of_pos (since := "2025-01-16")] abbrev findSome?_mkArray_of_pos := @findSome?_replicate_of_pos
|
||||
@[deprecated findSome?_replicate_of_isSome (since := "2025-01-16")] abbrev findSome?_mkArray_of_isSome := @findSome?_replicate_of_isSome
|
||||
@[deprecated findSome?_replicate_of_isNone (since := "2025-01-16")] abbrev findSome?_mkArray_of_isNone := @findSome?_replicate_of_isNone
|
||||
simp [findSome?_mkArray, h]
|
||||
|
||||
/-! ### find? -/
|
||||
|
||||
@@ -208,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} :
|
||||
@@ -225,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
|
||||
@@ -249,42 +244,34 @@ theorem find?_flatMap_eq_none {xs : Array α} {f : α → Array β} {p : β →
|
||||
(xs.flatMap f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
|
||||
simp
|
||||
|
||||
theorem find?_replicate :
|
||||
find? p (replicate n a) = if n = 0 then none else if p a then some a else none := by
|
||||
theorem find?_mkArray :
|
||||
find? p (mkArray n a) = if n = 0 then none else if p a then some a else none := by
|
||||
simp [← List.toArray_replicate, List.find?_replicate]
|
||||
|
||||
@[simp] theorem find?_replicate_of_length_pos (h : 0 < n) :
|
||||
find? p (replicate n a) = if p a then some a else none := by
|
||||
simp [find?_replicate, Nat.ne_of_gt h]
|
||||
@[simp] theorem find?_mkArray_of_length_pos (h : 0 < n) :
|
||||
find? p (mkArray n a) = if p a then some a else none := by
|
||||
simp [find?_mkArray, Nat.ne_of_gt h]
|
||||
|
||||
@[simp] theorem find?_replicate_of_pos (h : p a) :
|
||||
find? p (replicate n a) = if n = 0 then none else some a := by
|
||||
simp [find?_replicate, h]
|
||||
@[simp] theorem find?_mkArray_of_pos (h : p a) :
|
||||
find? p (mkArray n a) = if n = 0 then none else some a := by
|
||||
simp [find?_mkArray, h]
|
||||
|
||||
@[simp] theorem find?_replicate_of_neg (h : ¬ p a) : find? p (replicate n a) = none := by
|
||||
simp [find?_replicate, h]
|
||||
@[simp] theorem find?_mkArray_of_neg (h : ¬ p a) : find? p (mkArray n a) = none := by
|
||||
simp [find?_mkArray, h]
|
||||
|
||||
-- This isn't a `@[simp]` lemma since there is already a lemma for `l.find? p = none` for any `l`.
|
||||
theorem find?_replicate_eq_none {n : Nat} {a : α} {p : α → Bool} :
|
||||
(replicate n a).find? p = none ↔ n = 0 ∨ !p a := by
|
||||
theorem find?_mkArray_eq_none {n : Nat} {a : α} {p : α → Bool} :
|
||||
(mkArray n a).find? p = none ↔ n = 0 ∨ !p a := by
|
||||
simp [← List.toArray_replicate, List.find?_replicate_eq_none, Classical.or_iff_not_imp_left]
|
||||
|
||||
@[simp] theorem find?_replicate_eq_some {n : Nat} {a b : α} {p : α → Bool} :
|
||||
(replicate n a).find? p = some b ↔ n ≠ 0 ∧ p a ∧ a = b := by
|
||||
@[simp] theorem find?_mkArray_eq_some {n : Nat} {a b : α} {p : α → Bool} :
|
||||
(mkArray n a).find? p = some b ↔ n ≠ 0 ∧ p a ∧ a = b := by
|
||||
simp [← List.toArray_replicate]
|
||||
|
||||
@[simp] theorem get_find?_replicate (n : Nat) (a : α) (p : α → Bool) (h) :
|
||||
((replicate n a).find? p).get h = a := by
|
||||
@[simp] theorem get_find?_mkArray (n : Nat) (a : α) (p : α → Bool) (h) :
|
||||
((mkArray n a).find? p).get h = a := by
|
||||
simp [← List.toArray_replicate]
|
||||
|
||||
@[deprecated find?_replicate (since := "2025-01-16")] abbrev find?_mkArray := @find?_replicate
|
||||
@[deprecated find?_replicate_of_length_pos (since := "2025-01-16")] abbrev find?_mkArray_of_length_pos := @find?_replicate_of_length_pos
|
||||
@[deprecated find?_replicate_of_pos (since := "2025-01-16")] abbrev find?_mkArray_of_pos := @find?_replicate_of_pos
|
||||
@[deprecated find?_replicate_of_neg (since := "2025-01-16")] abbrev find?_mkArray_of_neg := @find?_replicate_of_neg
|
||||
@[deprecated find?_replicate_eq_none (since := "2025-01-16")] abbrev find?_mkArray_eq_none := @find?_replicate_eq_none
|
||||
@[deprecated find?_replicate_eq_some (since := "2025-01-16")] abbrev find?_mkArray_eq_some := @find?_replicate_eq_some
|
||||
@[deprecated get_find?_mkArray (since := "2025-01-16")] abbrev get_find?_mkArray := @get_find?_replicate
|
||||
|
||||
theorem find?_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : Array α)
|
||||
(H : ∀ (a : α), a ∈ xs → P a) (p : β → Bool) :
|
||||
(xs.pmap f H).find? p = (xs.attach.find? (fun ⟨a, m⟩ => p (f a (H a m)))).map fun ⟨a, m⟩ => f a (H a m) := by
|
||||
|
||||
@@ -38,14 +38,6 @@ namespace Array
|
||||
|
||||
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
|
||||
|
||||
theorem eq_toArray : v = List.toArray a ↔ v.toList = a := by
|
||||
cases v
|
||||
simp
|
||||
|
||||
theorem toArray_eq : List.toArray a = v ↔ a = v.toList := by
|
||||
cases v
|
||||
simp
|
||||
|
||||
/-! ### empty -/
|
||||
|
||||
@[simp] theorem empty_eq {xs : Array α} : #[] = xs ↔ xs = #[] := by
|
||||
@@ -160,38 +152,31 @@ theorem exists_push_of_size_eq_add_one {xs : Array α} (h : xs.size = n + 1) :
|
||||
theorem singleton_inj : #[a] = #[b] ↔ a = b := by
|
||||
simp
|
||||
|
||||
/-! ### replicate -/
|
||||
/-! ### mkArray -/
|
||||
|
||||
@[simp] theorem size_replicate (n : Nat) (v : α) : (replicate n v).size = n :=
|
||||
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
|
||||
List.length_replicate ..
|
||||
|
||||
@[simp] theorem toList_replicate : (replicate n a).toList = List.replicate n a := by
|
||||
simp only [replicate]
|
||||
@[simp] theorem toList_mkArray : (mkArray n a).toList = List.replicate n a := by
|
||||
simp only [mkArray]
|
||||
|
||||
@[simp] theorem replicate_zero : replicate 0 a = #[] := rfl
|
||||
@[simp] theorem mkArray_zero : mkArray 0 a = #[] := rfl
|
||||
|
||||
theorem replicate_succ : replicate (n + 1) a = (replicate n a).push a := by
|
||||
theorem mkArray_succ : mkArray (n + 1) a = (mkArray n a).push a := by
|
||||
apply toList_inj.1
|
||||
simp [List.replicate_succ']
|
||||
|
||||
theorem replicate_inj : replicate n a = replicate m b ↔ n = m ∧ (n = 0 ∨ a = b) := by
|
||||
theorem mkArray_inj : mkArray n a = mkArray m b ↔ n = m ∧ (n = 0 ∨ a = b) := by
|
||||
rw [← List.replicate_inj, ← toList_inj]
|
||||
simp
|
||||
|
||||
@[simp] theorem getElem_replicate (n : Nat) (v : α) (h : i < (replicate n v).size) :
|
||||
(replicate n v)[i] = v := by simp [← getElem_toList]
|
||||
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
|
||||
(mkArray n v)[i] = v := by simp [← getElem_toList]
|
||||
|
||||
theorem getElem?_replicate (n : Nat) (v : α) (i : Nat) :
|
||||
(replicate n v)[i]? = if i < n then some v else none := by
|
||||
theorem getElem?_mkArray (n : Nat) (v : α) (i : Nat) :
|
||||
(mkArray n v)[i]? = if i < n then some v else none := by
|
||||
simp [getElem?_def]
|
||||
|
||||
@[deprecated size_replicate (since := "2025-01-16")] abbrev size_mkArray := @size_replicate
|
||||
@[deprecated replicate_zero (since := "2025-01-16")] abbrev replicate_mkArray_zero := @replicate_zero
|
||||
@[deprecated replicate_succ (since := "2025-01-16")] abbrev replicate_mkArray_succ := @replicate_succ
|
||||
@[deprecated replicate_inj (since := "2025-01-16")] abbrev replicate_mkArray_inj := @replicate_inj
|
||||
@[deprecated getElem_replicate (since := "2025-01-16")] abbrev getElem_mkArray := @getElem_replicate
|
||||
@[deprecated getElem?_replicate (since := "2025-01-16")] abbrev getElem?_mkArray := @getElem?_replicate
|
||||
|
||||
/-! ## L[i] and L[i]? -/
|
||||
|
||||
@[simp] theorem getElem?_eq_none_iff {a : Array α} : a[i]? = none ↔ a.size ≤ i := by
|
||||
@@ -271,11 +256,6 @@ theorem getElem?_push {a : Array α} {x} : (a.push x)[i]? = if i = a.size then s
|
||||
theorem getElem?_singleton (a : α) (i : Nat) : #[a][i]? = if i = 0 then some a else none := by
|
||||
simp [List.getElem?_singleton]
|
||||
|
||||
theorem ext_getElem? {l₁ l₂ : Array α} (h : ∀ i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ := by
|
||||
rcases l₁ with ⟨l₁⟩
|
||||
rcases l₂ with ⟨l₂⟩
|
||||
simpa using List.ext_getElem? (by simpa using h)
|
||||
|
||||
/-! ### mem -/
|
||||
|
||||
theorem not_mem_empty (a : α) : ¬ a ∈ #[] := by simp
|
||||
@@ -969,17 +949,15 @@ theorem size_eq_of_beq [BEq α] {xs ys : Array α} (h : xs == ys) : xs.size = ys
|
||||
cases ys
|
||||
simp [List.length_eq_of_beq (by simpa using h)]
|
||||
|
||||
@[simp] theorem replicate_beq_replicate [BEq α] {a b : α} {n : Nat} :
|
||||
(replicate n a == replicate n b) = (n == 0 || a == b) := by
|
||||
@[simp] theorem mkArray_beq_mkArray [BEq α] {a b : α} {n : Nat} :
|
||||
(mkArray n a == mkArray n b) = (n == 0 || a == b) := by
|
||||
cases n with
|
||||
| zero => simp
|
||||
| succ n =>
|
||||
rw [replicate_succ, replicate_succ, push_beq_push, replicate_beq_replicate]
|
||||
rw [mkArray_succ, mkArray_succ, push_beq_push, mkArray_beq_mkArray]
|
||||
rw [Bool.eq_iff_iff]
|
||||
simp +contextual
|
||||
|
||||
@[deprecated replicate_beq_replicate (since := "2025-01-16")] abbrev mkArray_beq_mkArray := @replicate_beq_replicate
|
||||
|
||||
private theorem beq_of_beq_singleton [BEq α] {a b : α} : #[a] == #[b] → a == b := by
|
||||
intro h
|
||||
have : isEqv #[a] #[b] BEq.beq = true := h
|
||||
@@ -1111,21 +1089,9 @@ theorem forall_mem_map {f : α → β} {l : Array α} {P : β → Prop} :
|
||||
(∀ (i) (_ : i ∈ l.map f), P i) ↔ ∀ (j) (_ : j ∈ l), P (f j) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem map_eq_empty_iff {f : α → β} {l : Array α} : map f l = #[] ↔ l = #[] := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem eq_empty_of_map_eq_empty {f : α → β} {l : Array α} (h : map f l = #[]) : l = #[] :=
|
||||
map_eq_empty_iff.mp h
|
||||
|
||||
@[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 [List.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
|
||||
|
||||
@@ -1134,6 +1100,13 @@ 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_empty_iff {f : α → β} {l : Array α} : map f l = #[] ↔ l = #[] := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem eq_empty_of_map_eq_empty {f : α → β} {l : Array α} (h : map f l = #[]) : l = #[] :=
|
||||
map_eq_empty_iff.mp h
|
||||
|
||||
theorem map_eq_push_iff {f : α → β} {l : Array α} {l₂ : Array β} {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⟩
|
||||
@@ -1216,30 +1189,6 @@ theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
|
||||
rfl
|
||||
termination_by as.size - i
|
||||
|
||||
/--
|
||||
Use this as `induction ass using array₂_induction` on a hypothesis of the form `ass : Array (Array α)`.
|
||||
The hypothesis `ass` will be replaced with a hypothesis `ass : List (List α)`,
|
||||
and former appearances of `ass` in the goal will be replaced with `(ass.map List.toArray).toArray`.
|
||||
-/
|
||||
-- We can't use `@[cases_eliminator]` here as
|
||||
-- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
|
||||
theorem array₂_induction (P : Array (Array α) → Prop) (of : ∀ (xss : List (List α)), P (xss.map List.toArray).toArray)
|
||||
(ass : Array (Array α)) : P ass := by
|
||||
specialize of (ass.toList.map toList)
|
||||
simpa [← toList_map, Function.comp_def, map_id] using of
|
||||
|
||||
/--
|
||||
Use this as `induction ass using array₃_induction` on a hypothesis of the form `ass : Array (Array (Array α))`.
|
||||
The hypothesis `ass` will be replaced with a hypothesis `ass : List (List (List α))`,
|
||||
and former appearances of `ass` in the goal will be replaced with
|
||||
`((ass.map (fun xs => xs.map List.toArray)).map List.toArray).toArray`.
|
||||
-/
|
||||
theorem array₃_induction (P : Array (Array (Array α)) → Prop)
|
||||
(of : ∀ (xss : List (List (List α))), P ((xss.map (fun xs => xs.map List.toArray)).map List.toArray).toArray)
|
||||
(ass : Array (Array (Array α))) : P ass := by
|
||||
specialize of ((ass.toList.map toList).map (fun as => as.map toList))
|
||||
simpa [← toList_map, Function.comp_def, map_id] using of
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@[congr]
|
||||
@@ -1555,25 +1504,14 @@ theorem filterMap_eq_push_iff {f : α → Option β} {l : Array α} {l' : Array
|
||||
· rintro ⟨⟨l₁⟩, a, ⟨l₂⟩, h₁, h₂, h₃, h₄⟩
|
||||
refine ⟨l₂.reverse, a, l₁.reverse, by simp_all⟩
|
||||
|
||||
/-! Content below this point has not yet been aligned with `List`. -/
|
||||
|
||||
/-! ### singleton -/
|
||||
|
||||
@[simp] theorem singleton_def (v : α) : Array.singleton v = #[v] := rfl
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
|
||||
simp only [size, toList_append, List.length_append]
|
||||
|
||||
@[simp] theorem append_push {as bs : Array α} {a : α} : as ++ bs.push a = (as ++ bs).push a := by
|
||||
cases as
|
||||
cases bs
|
||||
simp
|
||||
|
||||
theorem toArray_append {xs : List α} {ys : Array α} :
|
||||
xs.toArray ++ ys = (xs ++ ys.toList).toArray := by
|
||||
rcases ys with ⟨ys⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_eq_append_iff {xs : List α} {as bs : Array α} :
|
||||
xs.toArray = as ++ bs ↔ xs = as.toList ++ bs.toList := by
|
||||
cases as
|
||||
@@ -1601,24 +1539,12 @@ theorem mem_append_left {a : α} {l₁ : Array α} (l₂ : Array α) (h : a ∈
|
||||
theorem mem_append_right {a : α} (l₁ : Array α) {l₂ : Array α} (h : a ∈ l₂) : a ∈ l₁ ++ l₂ :=
|
||||
mem_append.2 (Or.inr h)
|
||||
|
||||
theorem not_mem_append {a : α} {s t : Array α} (h₁ : a ∉ s) (h₂ : a ∉ t) : a ∉ s ++ t :=
|
||||
mt mem_append.1 $ not_or.mpr ⟨h₁, h₂⟩
|
||||
@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
|
||||
simp only [size, toList_append, List.length_append]
|
||||
|
||||
/--
|
||||
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 : Array α} (h : a ∈ l) : ∃ s t : Array α, l = s.push a ++ t := by
|
||||
obtain ⟨s, t, w⟩ := List.append_of_mem (l := l.toList) (by simpa using h)
|
||||
replace w := congrArg List.toArray w
|
||||
refine ⟨s.toArray, t.toArray, by simp_all⟩
|
||||
theorem empty_append (as : Array α) : #[] ++ as = as := by simp
|
||||
|
||||
theorem mem_iff_append {a : α} {l : Array α} : a ∈ l ↔ ∃ s t : Array α, l = s.push a ++ t :=
|
||||
⟨append_of_mem, fun ⟨s, t, e⟩ => e ▸ by simp⟩
|
||||
|
||||
theorem forall_mem_append {p : α → Prop} {l₁ l₂ : Array α} :
|
||||
(∀ (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 append_empty (as : Array α) : as ++ #[] = as := by simp
|
||||
|
||||
theorem getElem_append {as bs : Array α} (h : i < (as ++ bs).size) :
|
||||
(as ++ bs)[i] = if h' : i < as.size then as[i] else bs[i - as.size]'(by simp at h; omega) := by
|
||||
@@ -1673,478 +1599,6 @@ theorem getElem_of_append {l l₁ l₂ : Array α} (eq : l = l₁.push a ++ l₂
|
||||
rw [← getElem?_eq_getElem, eq, getElem?_append_left (by simp; omega), ← h]
|
||||
simp
|
||||
|
||||
@[simp 1100] theorem append_singleton {a : α} {as : Array α} : as ++ #[a] = as.push a := by
|
||||
cases as
|
||||
simp
|
||||
|
||||
theorem append_inj {s₁ s₂ t₁ t₂ : Array α} (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) :
|
||||
s₁ = s₂ ∧ t₁ = t₂ := by
|
||||
rcases s₁ with ⟨s₁⟩
|
||||
rcases s₂ with ⟨s₂⟩
|
||||
rcases t₁ with ⟨t₁⟩
|
||||
rcases t₂ with ⟨t₂⟩
|
||||
simpa using List.append_inj (by simpa using h) (by simpa using hl)
|
||||
|
||||
theorem append_inj_right {s₁ s₂ t₁ t₂ : Array α}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) : t₁ = t₂ :=
|
||||
(append_inj h hl).right
|
||||
|
||||
theorem append_inj_left {s₁ s₂ t₁ t₂ : Array α}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) (hl : s₁.size = s₂.size) : s₁ = s₂ :=
|
||||
(append_inj h hl).left
|
||||
|
||||
/-- Variant of `append_inj` instead requiring equality of the sizes of the second arrays. -/
|
||||
theorem append_inj' {s₁ s₂ t₁ t₂ : Array α} (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) :
|
||||
s₁ = s₂ ∧ t₁ = t₂ :=
|
||||
append_inj h <| @Nat.add_right_cancel _ t₁.size _ <| by
|
||||
let hap := congrArg size h; simp only [size_append, ← hl] at hap; exact hap
|
||||
|
||||
/-- Variant of `append_inj_right` instead requiring equality of the sizes of the second arrays. -/
|
||||
theorem append_inj_right' {s₁ s₂ t₁ t₂ : Array α}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) : t₁ = t₂ :=
|
||||
(append_inj' h hl).right
|
||||
|
||||
/-- Variant of `append_inj_left` instead requiring equality of the sizes of the second arrays. -/
|
||||
theorem append_inj_left' {s₁ s₂ t₁ t₂ : Array α}
|
||||
(h : s₁ ++ t₁ = s₂ ++ t₂) (hl : t₁.size = t₂.size) : s₁ = s₂ :=
|
||||
(append_inj' h hl).left
|
||||
|
||||
theorem append_right_inj {t₁ t₂ : Array α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
|
||||
⟨fun h => append_inj_right h rfl, congrArg _⟩
|
||||
|
||||
theorem append_left_inj {s₁ s₂ : Array α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
|
||||
⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩
|
||||
|
||||
@[simp] theorem append_left_eq_self {x y : Array α} : x ++ y = y ↔ x = #[] := by
|
||||
rw [← append_left_inj (s₁ := x), empty_append]
|
||||
|
||||
@[simp] theorem self_eq_append_left {x y : Array α} : y = x ++ y ↔ x = #[] := by
|
||||
rw [eq_comm, append_left_eq_self]
|
||||
|
||||
@[simp] theorem append_right_eq_self {x y : Array α} : x ++ y = x ↔ y = #[] := by
|
||||
rw [← append_right_inj (t₁ := y), append_empty]
|
||||
|
||||
@[simp] theorem self_eq_append_right {x y : Array α} : x = x ++ y ↔ y = #[] := by
|
||||
rw [eq_comm, append_right_eq_self]
|
||||
|
||||
@[simp] theorem append_eq_empty_iff : p ++ q = #[] ↔ p = #[] ∧ q = #[] := by
|
||||
cases p <;> simp
|
||||
|
||||
@[simp] theorem empty_eq_append_iff : #[] = a ++ b ↔ a = #[] ∧ b = #[] := by
|
||||
rw [eq_comm, append_eq_empty_iff]
|
||||
|
||||
theorem append_ne_empty_of_left_ne_empty {s : Array α} (h : s ≠ #[]) (t : Array α) :
|
||||
s ++ t ≠ #[] := by
|
||||
simp_all
|
||||
|
||||
theorem append_ne_empty_of_right_ne_empty (s : Array α) : t ≠ #[] → s ++ t ≠ #[] := by
|
||||
simp_all
|
||||
|
||||
theorem append_eq_push_iff {a b c : Array α} {x : α} :
|
||||
a ++ b = c.push x ↔ (b = #[] ∧ a = c.push x) ∨ (∃ b', b = b'.push x ∧ c = a ++ b') := by
|
||||
rcases a with ⟨a⟩
|
||||
rcases b with ⟨b⟩
|
||||
rcases c with ⟨c⟩
|
||||
simp only [List.append_toArray, List.push_toArray, mk.injEq, List.append_eq_append_iff,
|
||||
toArray_eq_append_iff]
|
||||
constructor
|
||||
· rintro (⟨a', rfl, rfl⟩ | ⟨b', rfl, h⟩)
|
||||
· right; exact ⟨⟨a'⟩, by simp⟩
|
||||
· rw [List.singleton_eq_append_iff] at h
|
||||
obtain (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) := h
|
||||
· right; exact ⟨#[], by simp⟩
|
||||
· left; simp
|
||||
· rintro (⟨rfl, rfl⟩ | ⟨b', h, rfl⟩)
|
||||
· right; exact ⟨[x], by simp⟩
|
||||
· left; refine ⟨b'.toList, ?_⟩
|
||||
replace h := congrArg Array.toList h
|
||||
simp_all
|
||||
|
||||
theorem push_eq_append_iff {a b c : Array α} {x : α} :
|
||||
c.push x = a ++ b ↔ (b = #[] ∧ a = c.push x) ∨ (∃ b', b = b'.push x ∧ c = a ++ b') := by
|
||||
rw [eq_comm, append_eq_push_iff]
|
||||
|
||||
theorem append_eq_singleton_iff {a b : Array α} {x : α} :
|
||||
a ++ b = #[x] ↔ (a = #[] ∧ b = #[x]) ∨ (a = #[x] ∧ b = #[]) := by
|
||||
rcases a with ⟨a⟩
|
||||
rcases b with ⟨b⟩
|
||||
simp only [List.append_toArray, mk.injEq, List.append_eq_singleton_iff, toArray_eq_append_iff]
|
||||
|
||||
theorem singleton_eq_append_iff {a b : Array α} {x : α} :
|
||||
#[x] = a ++ b ↔ (a = #[] ∧ b = #[x]) ∨ (a = #[x] ∧ b = #[]) := by
|
||||
rw [eq_comm, append_eq_singleton_iff]
|
||||
|
||||
theorem append_eq_append_iff {a b c d : Array α} :
|
||||
a ++ b = c ++ d ↔ (∃ a', c = a ++ a' ∧ b = a' ++ d) ∨ ∃ c', a = c ++ c' ∧ d = c' ++ b := by
|
||||
rcases a with ⟨a⟩
|
||||
rcases b with ⟨b⟩
|
||||
rcases c with ⟨c⟩
|
||||
rcases d with ⟨d⟩
|
||||
simp only [List.append_toArray, mk.injEq, List.append_eq_append_iff, toArray_eq_append_iff]
|
||||
constructor
|
||||
· rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
|
||||
· left; exact ⟨⟨a'⟩, by simp⟩
|
||||
· right; exact ⟨⟨c'⟩, by simp⟩
|
||||
· rintro (⟨a', rfl, rfl⟩ | ⟨c', rfl, rfl⟩)
|
||||
· left; exact ⟨a'.toList, by simp⟩
|
||||
· right; exact ⟨c'.toList, by simp⟩
|
||||
|
||||
theorem set_append {s t : Array α} {i : Nat} {x : α} (h : i < (s ++ t).size) :
|
||||
(s ++ t).set i x =
|
||||
if h' : i < s.size then
|
||||
s.set i x ++ t
|
||||
else
|
||||
s ++ t.set (i - s.size) x (by simp at h; omega) := by
|
||||
rcases s with ⟨s⟩
|
||||
rcases t with ⟨t⟩
|
||||
simp only [List.append_toArray, List.set_toArray, List.set_append]
|
||||
split <;> simp
|
||||
|
||||
@[simp] theorem set_append_left {s t : Array α} {i : Nat} {x : α} (h : i < s.size) :
|
||||
(s ++ t).set i x (by simp; omega) = s.set i x ++ t := by
|
||||
simp [set_append, h]
|
||||
|
||||
@[simp] theorem set_append_right {s t : Array α} {i : Nat} {x : α}
|
||||
(h' : i < (s ++ t).size) (h : s.size ≤ i) :
|
||||
(s ++ t).set i x = s ++ t.set (i - s.size) x (by simp at h'; omega) := by
|
||||
rw [set_append, dif_neg (by omega)]
|
||||
|
||||
theorem setIfInBounds_append {s t : Array α} {i : Nat} {x : α} :
|
||||
(s ++ t).setIfInBounds i x =
|
||||
if i < s.size then
|
||||
s.setIfInBounds i x ++ t
|
||||
else
|
||||
s ++ t.setIfInBounds (i - s.size) x := by
|
||||
rcases s with ⟨s⟩
|
||||
rcases t with ⟨t⟩
|
||||
simp only [List.append_toArray, List.setIfInBounds_toArray, List.set_append]
|
||||
split <;> simp
|
||||
|
||||
@[simp] theorem setIfInBounds_append_left {s t : Array α} {i : Nat} {x : α} (h : i < s.size) :
|
||||
(s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
|
||||
simp [setIfInBounds_append, h]
|
||||
|
||||
@[simp] theorem setIfInBounds_append_right {s t : Array α} {i : Nat} {x : α} (h : s.size ≤ i) :
|
||||
(s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - s.size) x := by
|
||||
rw [setIfInBounds_append, if_neg (by omega)]
|
||||
|
||||
theorem filterMap_eq_append_iff {f : α → Option β} :
|
||||
filterMap f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
|
||||
rcases l with ⟨l⟩
|
||||
rcases L₁ with ⟨L₁⟩
|
||||
rcases L₂ with ⟨L₂⟩
|
||||
simp only [size_toArray, List.filterMap_toArray', List.append_toArray, mk.injEq,
|
||||
List.filterMap_eq_append_iff, toArray_eq_append_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
|
||||
exact ⟨⟨l₁⟩, ⟨l₂⟩, by simp⟩
|
||||
· rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
|
||||
exact ⟨l₁, l₂, by simp_all⟩
|
||||
|
||||
theorem append_eq_filterMap_iff {f : α → Option β} :
|
||||
L₁ ++ L₂ = filterMap f l ↔
|
||||
∃ l₁ l₂, l = l₁ ++ l₂ ∧ filterMap f l₁ = L₁ ∧ filterMap f l₂ = L₂ := by
|
||||
rw [eq_comm, filterMap_eq_append_iff]
|
||||
|
||||
@[simp] theorem map_append (f : α → β) (l₁ l₂ : Array α) :
|
||||
map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
|
||||
cases l₁
|
||||
cases l₂
|
||||
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
|
||||
rw [← filterMap_eq_map, filterMap_eq_append_iff]
|
||||
|
||||
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_empty : (#[] : Array (Array α)).flatten = #[] := by simp [flatten]; rfl
|
||||
|
||||
@[simp] theorem toList_flatten {l : Array (Array α)} :
|
||||
l.flatten.toList = (l.toList.map toList).flatten := by
|
||||
dsimp [flatten]
|
||||
simp only [← foldl_toList]
|
||||
generalize l.toList = l
|
||||
have : ∀ a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
|
||||
exact this #[]
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons h => induction h.toList <;> simp [*]
|
||||
|
||||
@[simp] theorem flatten_map_toArray (l : List (List α)) :
|
||||
(l.toArray.map List.toArray).flatten = l.flatten.toArray := by
|
||||
apply ext'
|
||||
simp [Function.comp_def]
|
||||
|
||||
@[simp] theorem flatten_toArray_map (l : List (List α)) :
|
||||
(l.map List.toArray).toArray.flatten = l.flatten.toArray := by
|
||||
rw [← flatten_map_toArray]
|
||||
simp
|
||||
|
||||
theorem flatten_toArray (l : List (Array α)) :
|
||||
l.toArray.flatten = (l.map Array.toList).flatten.toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem size_flatten (L : Array (Array α)) : L.flatten.size = (L.map size).sum := by
|
||||
cases L using array₂_induction
|
||||
simp [Function.comp_def]
|
||||
|
||||
@[simp] theorem flatten_singleton (l : Array α) : #[l].flatten = l := by simp [flatten]; rfl
|
||||
|
||||
theorem mem_flatten : ∀ {L : Array (Array α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
|
||||
simp only [mem_def, toList_flatten, List.mem_flatten, List.mem_map]
|
||||
intro l
|
||||
constructor
|
||||
· rintro ⟨_, ⟨s, m, rfl⟩, h⟩
|
||||
exact ⟨s, m, h⟩
|
||||
· rintro ⟨s, h₁, h₂⟩
|
||||
refine ⟨s.toList, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩
|
||||
|
||||
@[simp] theorem flatten_eq_empty_iff {L : Array (Array α)} : L.flatten = #[] ↔ ∀ l ∈ L, l = #[] := by
|
||||
induction L using array₂_induction
|
||||
simp
|
||||
|
||||
@[simp] theorem empty_eq_flatten_iff {L : Array (Array α)} : #[] = L.flatten ↔ ∀ l ∈ L, l = #[] := by
|
||||
rw [eq_comm, flatten_eq_empty_iff]
|
||||
|
||||
theorem flatten_ne_empty_iff {xs : Array (Array α)} : xs.flatten ≠ #[] ↔ ∃ x, x ∈ xs ∧ x ≠ #[] := by
|
||||
simp
|
||||
|
||||
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 : Array (Array α)} :
|
||||
(∀ (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)
|
||||
|
||||
theorem flatten_eq_flatMap {L : Array (Array α)} : flatten L = L.flatMap id := by
|
||||
induction L using array₂_induction
|
||||
rw [flatten_toArray_map, List.flatten_eq_flatMap]
|
||||
simp [List.flatMap_map]
|
||||
|
||||
@[simp] theorem map_flatten (f : α → β) (L : Array (Array α)) :
|
||||
(flatten L).map f = (map (map f) L).flatten := by
|
||||
induction L using array₂_induction with
|
||||
| of xss =>
|
||||
simp only [flatten_toArray_map, List.map_toArray, List.map_flatten, List.map_map,
|
||||
Function.comp_def]
|
||||
rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
|
||||
|
||||
@[simp] theorem filterMap_flatten (f : α → Option β) (L : Array (Array α)) :
|
||||
filterMap f (flatten L) = flatten (map (filterMap f) L) := by
|
||||
induction L using array₂_induction
|
||||
simp only [flatten_toArray_map, size_toArray, List.length_flatten, List.filterMap_toArray',
|
||||
List.filterMap_flatten, List.map_toArray, List.map_map, Function.comp_def]
|
||||
rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
|
||||
|
||||
@[simp] theorem filter_flatten (p : α → Bool) (L : Array (Array α)) :
|
||||
filter p (flatten L) = flatten (map (filter p) L) := by
|
||||
induction L using array₂_induction
|
||||
simp only [flatten_toArray_map, size_toArray, List.length_flatten, List.filter_toArray',
|
||||
List.filter_flatten, List.map_toArray, List.map_map, Function.comp_def]
|
||||
rw [← Function.comp_def, ← List.map_map, flatten_toArray_map]
|
||||
|
||||
theorem flatten_filter_not_isEmpty {L : Array (Array α)} :
|
||||
flatten (L.filter fun l => !l.isEmpty) = L.flatten := by
|
||||
induction L using array₂_induction
|
||||
simp [List.filter_map, Function.comp_def, List.flatten_filter_not_isEmpty]
|
||||
|
||||
theorem flatten_filter_ne_empty [DecidablePred fun l : Array α => l ≠ #[]] {L : Array (Array α)} :
|
||||
flatten (L.filter fun l => l ≠ #[]) = L.flatten := by
|
||||
simp only [ne_eq, ← isEmpty_iff, Bool.not_eq_true, Bool.decide_eq_false,
|
||||
flatten_filter_not_isEmpty]
|
||||
|
||||
@[simp] theorem flatten_append (L₁ L₂ : Array (Array α)) :
|
||||
flatten (L₁ ++ L₂) = flatten L₁ ++ flatten L₂ := by
|
||||
induction L₁ using array₂_induction
|
||||
induction L₂ using array₂_induction
|
||||
simp [← List.map_append]
|
||||
|
||||
theorem flatten_push (L : Array (Array α)) (l : Array α) :
|
||||
flatten (L.push l) = flatten L ++ l := by
|
||||
induction L using array₂_induction
|
||||
rcases l with ⟨l⟩
|
||||
have this : [l.toArray] = [l].map List.toArray := by simp
|
||||
simp only [List.push_toArray, flatten_toArray_map, List.append_toArray]
|
||||
rw [this, ← List.map_append, flatten_toArray_map]
|
||||
simp
|
||||
|
||||
theorem flatten_flatten {L : Array (Array (Array α))} : flatten (flatten L) = flatten (map flatten L) := by
|
||||
induction L using array₃_induction with
|
||||
| of xss =>
|
||||
rw [flatten_toArray_map]
|
||||
have : (xss.map (fun xs => xs.map List.toArray)).flatten = xss.flatten.map List.toArray := by
|
||||
induction xss with
|
||||
| nil => simp
|
||||
| cons xs xss ih =>
|
||||
simp only [List.map_cons, List.flatten_cons, ih, List.map_append]
|
||||
rw [this, flatten_toArray_map, List.flatten_flatten, ← List.map_toArray, Array.map_map,
|
||||
← List.map_toArray, map_map, Function.comp_def]
|
||||
simp only [Function.comp_apply, flatten_toArray_map]
|
||||
rw [List.map_toArray, ← Function.comp_def, ← List.map_map, flatten_toArray_map]
|
||||
|
||||
theorem flatten_eq_push_iff {xs : Array (Array α)} {ys : Array α} {y : α} :
|
||||
xs.flatten = ys.push y ↔
|
||||
∃ (as : Array (Array α)) (bs : Array α) (cs : Array (Array α)),
|
||||
xs = as.push (bs.push y) ++ cs ∧ (∀ l, l ∈ cs → l = #[]) ∧ ys = as.flatten ++ bs := by
|
||||
induction xs using array₂_induction with
|
||||
| of xs =>
|
||||
rcases ys with ⟨ys⟩
|
||||
rw [flatten_toArray_map, List.push_toArray, mk.injEq, List.flatten_eq_append_iff]
|
||||
constructor
|
||||
· rintro (⟨as, bs, rfl, rfl, h⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, h⟩)
|
||||
· rw [List.singleton_eq_flatten_iff] at h
|
||||
obtain ⟨xs, ys, rfl, h₁, h₂⟩ := h
|
||||
exact ⟨((as ++ xs).map List.toArray).toArray, #[], (ys.map List.toArray).toArray, by simp,
|
||||
by simpa using h₂, by rw [flatten_toArray_map]; simpa⟩
|
||||
· rw [List.singleton_eq_append_iff] at h
|
||||
obtain (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩) := h
|
||||
· simp at h₁
|
||||
· simp at h₁ h₂
|
||||
obtain ⟨rfl, rfl⟩ := h₁
|
||||
exact ⟨(as.map List.toArray).toArray, bs.toArray, (ds.map List.toArray).toArray, by simpa⟩
|
||||
· rintro ⟨as, bs, cs, h₁, h₂, h₃⟩
|
||||
replace h₁ := congrArg (List.map Array.toList) (congrArg Array.toList h₁)
|
||||
simp [Function.comp_def] at h₁
|
||||
subst h₁
|
||||
replace h₃ := congrArg Array.toList h₃
|
||||
simp at h₃
|
||||
subst h₃
|
||||
right
|
||||
exact ⟨(as.map Array.toList).toList, bs.toList, y, [], (cs.map Array.toList).toList, by simpa⟩
|
||||
|
||||
theorem push_eq_flatten_iff {xs : Array (Array α)} {ys : Array α} {y : α} :
|
||||
ys.push y = xs.flatten ↔
|
||||
∃ (as : Array (Array α)) (bs : Array α) (cs : Array (Array α)),
|
||||
xs = as.push (bs.push y) ++ cs ∧ (∀ l, l ∈ cs → l = #[]) ∧ ys = as.flatten ++ bs := by
|
||||
rw [eq_comm, flatten_eq_push_iff]
|
||||
|
||||
-- For now we omit `flatten_eq_append_iff`,
|
||||
-- because it is not easily obtainable from `List.flatten_eq_append_iff`.
|
||||
-- theorem flatten_eq_append_iff {xs : Array (Array α)} {ys zs : Array α} :
|
||||
-- xs.flatten = ys ++ zs ↔
|
||||
-- (∃ as bs, xs = as ++ bs ∧ ys = as.flatten ∧ zs = bs.flatten) ∨
|
||||
-- ∃ (as : Array (Array α)) (bs : Array α) (c : α) (cs : Array α) (ds : Array (Array α)),
|
||||
-- xs = as.push ((bs.push c ++ cs)) ++ ds ∧ ys = as.flatten ++ bs.push c ∧
|
||||
-- zs = cs ++ ds.flatten := by sorry
|
||||
|
||||
|
||||
/-- Two arrays of subarrays are equal iff their flattens coincide, as well as the sizes of the
|
||||
subarrays. -/
|
||||
theorem eq_iff_flatten_eq {L L' : Array (Array α)} :
|
||||
L = L' ↔ L.flatten = L'.flatten ∧ map size L = map size L' := by
|
||||
cases L using array₂_induction with
|
||||
| of L =>
|
||||
cases L' using array₂_induction with
|
||||
| of L' =>
|
||||
simp [Function.comp_def, ← List.eq_iff_flatten_eq]
|
||||
rw [List.map_inj_right]
|
||||
simp +contextual
|
||||
|
||||
/-! ### flatMap -/
|
||||
|
||||
theorem flatMap_def (l : Array α) (f : α → Array β) : l.flatMap f = flatten (map f l) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [flatten_toArray, Function.comp_def, List.flatMap_def]
|
||||
|
||||
theorem flatMap_toList (l : Array α) (f : α → List β) :
|
||||
l.toList.flatMap f = (l.flatMap (fun a => (f a).toArray)).toList := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem flatMap_id (l : Array (Array α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
|
||||
|
||||
@[simp] theorem flatMap_id' (l : Array (Array α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
|
||||
|
||||
@[simp]
|
||||
theorem size_flatMap (l : Array α) (f : α → Array β) :
|
||||
(l.flatMap f).size = sum (map (fun a => (f a).size) l) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [Function.comp_def]
|
||||
|
||||
@[simp] theorem mem_flatMap {f : α → Array β} {b} {l : Array α} : 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 : Array α} {f : α → Array β} :
|
||||
b ∈ l.flatMap f → ∃ a, a ∈ l ∧ b ∈ f a := mem_flatMap.1
|
||||
|
||||
theorem mem_flatMap_of_mem {b : β} {l : Array α} {f : α → Array β} {a} (al : a ∈ l) (h : b ∈ f a) :
|
||||
b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
|
||||
|
||||
@[simp]
|
||||
theorem flatMap_eq_empty_iff {l : Array α} {f : α → Array β} : l.flatMap f = #[] ↔ ∀ x ∈ l, f x = #[] := by
|
||||
rw [flatMap_def, flatten_eq_empty_iff]
|
||||
simp
|
||||
|
||||
theorem forall_mem_flatMap {p : β → Prop} {l : Array α} {f : α → Array β} :
|
||||
(∀ (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 : α → Array β) (x : α) : #[x].flatMap f = f x := by
|
||||
simp
|
||||
|
||||
@[simp] theorem flatMap_singleton' (l : Array α) : (l.flatMap fun x => #[x]) = l := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem flatMap_append (xs ys : Array α) (f : α → Array β) :
|
||||
(xs ++ ys).flatMap f = xs.flatMap f ++ ys.flatMap f := by
|
||||
rcases xs with ⟨xs⟩
|
||||
rcases ys with ⟨ys⟩
|
||||
simp
|
||||
|
||||
theorem flatMap_assoc {α β} (l : Array α) (f : α → Array β) (g : β → Array γ) :
|
||||
(l.flatMap f).flatMap g = l.flatMap fun x => (f x).flatMap g := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.flatMap_assoc, flatMap_toList]
|
||||
|
||||
theorem map_flatMap (f : β → γ) (g : α → Array β) (l : Array α) :
|
||||
(l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.map_flatMap]
|
||||
|
||||
theorem flatMap_map (f : α → β) (g : β → Array γ) (l : Array α) :
|
||||
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.flatMap_map]
|
||||
|
||||
theorem map_eq_flatMap {α β} (f : α → β) (l : Array α) : map f l = l.flatMap fun x => #[f x] := by
|
||||
simp only [← map_singleton]
|
||||
rw [← flatMap_singleton' l, map_flatMap, flatMap_singleton']
|
||||
|
||||
theorem filterMap_flatMap {β γ} (l : Array α) (g : α → Array β) (f : β → Option γ) :
|
||||
(l.flatMap g).filterMap f = l.flatMap fun a => (g a).filterMap f := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.filterMap_flatMap]
|
||||
|
||||
theorem filter_flatMap (l : Array α) (g : α → Array β) (f : β → Bool) :
|
||||
(l.flatMap g).filter f = l.flatMap fun a => (g a).filter f := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.filter_flatMap]
|
||||
|
||||
theorem flatMap_eq_foldl (f : α → Array β) (l : Array α) :
|
||||
l.flatMap f = l.foldl (fun acc a => acc ++ f a) #[] := by
|
||||
rcases l with ⟨l⟩
|
||||
simp only [List.flatMap_toArray, List.flatMap_eq_foldl, size_toArray, List.foldl_toArray']
|
||||
suffices ∀ l', (List.foldl (fun acc a => acc ++ (f a).toList) l' l).toArray =
|
||||
List.foldl (fun acc a => acc ++ f a) l'.toArray l by
|
||||
simpa using this []
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons a l ih =>
|
||||
intro l'
|
||||
simp [ih ((l' ++ (f a).toList)), toArray_append]
|
||||
|
||||
/-! Content below this point has not yet been aligned with `List`. -/
|
||||
|
||||
-- This is a duplicate of `List.toArray_toList`.
|
||||
-- It's confusing to guess which namespace this theorem should live in,
|
||||
@@ -2758,6 +2212,28 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : α → α} {j : Nat} :
|
||||
|
||||
theorem size_empty : (#[] : Array α).size = 0 := rfl
|
||||
|
||||
/-! ### flatten -/
|
||||
|
||||
@[simp] theorem toList_flatten {l : Array (Array α)} :
|
||||
l.flatten.toList = (l.toList.map toList).flatten := by
|
||||
dsimp [flatten]
|
||||
simp only [← foldl_toList]
|
||||
generalize l.toList = l
|
||||
have : ∀ a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
|
||||
exact this #[]
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons h => induction h.toList <;> simp [*]
|
||||
|
||||
theorem mem_flatten : ∀ {L : Array (Array α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
|
||||
simp only [mem_def, toList_flatten, List.mem_flatten, List.mem_map]
|
||||
intro l
|
||||
constructor
|
||||
· rintro ⟨_, ⟨s, m, rfl⟩, h⟩
|
||||
exact ⟨s, m, h⟩
|
||||
· rintro ⟨s, h₁, h₂⟩
|
||||
refine ⟨s.toList, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩
|
||||
|
||||
/-! ### extract -/
|
||||
|
||||
theorem extract_loop_zero (as bs : Array α) (start : Nat) : extract.loop as 0 start bs = bs := by
|
||||
@@ -2774,16 +2250,16 @@ theorem extract_loop_of_ge (as bs : Array α) (size start : Nat) (h : start ≥
|
||||
theorem extract_loop_eq_aux (as bs : Array α) (size start : Nat) :
|
||||
extract.loop as size start bs = bs ++ extract.loop as size start #[] := by
|
||||
induction size using Nat.recAux generalizing start bs with
|
||||
| zero => rw [extract_loop_zero, extract_loop_zero, append_empty]
|
||||
| zero => rw [extract_loop_zero, extract_loop_zero, append_nil]
|
||||
| succ size ih =>
|
||||
if h : start < as.size then
|
||||
rw [extract_loop_succ (h:=h), ih (bs.push _), push_eq_append_singleton]
|
||||
rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, empty_append]
|
||||
rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, nil_append]
|
||||
rw [append_assoc]
|
||||
else
|
||||
rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
|
||||
rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
|
||||
rw [append_empty]
|
||||
rw [append_nil]
|
||||
|
||||
theorem extract_loop_eq (as bs : Array α) (size start : Nat) (h : start + size ≤ as.size) :
|
||||
extract.loop as size start bs = bs ++ as.extract start (start + size) := by
|
||||
@@ -3139,6 +2615,11 @@ namespace Array
|
||||
|
||||
/-! ### map -/
|
||||
|
||||
theorem array_array_induction (P : Array (Array α) → Prop) (h : ∀ (xss : List (List α)), P (xss.map List.toArray).toArray)
|
||||
(ass : Array (Array α)) : P ass := by
|
||||
specialize h (ass.toList.map toList)
|
||||
simpa [← toList_map, Function.comp_def, map_id] using h
|
||||
|
||||
theorem foldl_map (f : β₁ → β₂) (g : α → β₂ → α) (l : Array β₁) (init : α) :
|
||||
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
|
||||
cases l; simp [List.foldl_map]
|
||||
@@ -3175,6 +2656,8 @@ theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β
|
||||
|
||||
/-! ### flatten -/
|
||||
|
||||
@[simp] theorem flatten_empty : flatten (#[] : Array (Array α)) = #[] := rfl
|
||||
|
||||
@[simp] theorem flatten_toArray_map_toArray (xss : List (List α)) :
|
||||
(xss.map List.toArray).toArray.flatten = xss.flatten.toArray := by
|
||||
simp [flatten]
|
||||
@@ -3185,54 +2668,12 @@ theorem foldr_map' (g : α → β) (f : α → α → α) (f' : β → β → β
|
||||
| nil => simp
|
||||
| cons xs xss ih => simp [ih]
|
||||
|
||||
/-! ### sum -/
|
||||
/-! ### mkArray -/
|
||||
|
||||
theorem sum_eq_sum_toList [Add α] [Zero α] (as : Array α) : as.sum = as.toList.sum := by
|
||||
cases as
|
||||
simp [Array.sum, List.sum]
|
||||
|
||||
/-! ### replicate -/
|
||||
|
||||
theorem eq_replicate_of_mem {a : α} {l : Array α} (h : ∀ (b) (_ : b ∈ l), b = a) : l = replicate l.size a := by
|
||||
rcases l with ⟨l⟩
|
||||
have := List.eq_replicate_of_mem (by simpa using h)
|
||||
rw [this]
|
||||
@[simp] theorem mem_mkArray (a : α) (n : Nat) : b ∈ mkArray n a ↔ n ≠ 0 ∧ b = a := by
|
||||
rw [mkArray, mem_toArray]
|
||||
simp
|
||||
|
||||
theorem eq_replicate_iff {a : α} {n} {l : Array α} :
|
||||
l = replicate n a ↔ l.size = n ∧ ∀ (b) (_ : b ∈ l), b = a := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [← List.eq_replicate_iff, toArray_eq]
|
||||
|
||||
theorem map_eq_replicate_iff {l : Array α} {f : α → β} {b : β} :
|
||||
l.map f = replicate l.size b ↔ ∀ x ∈ l, f x = b := by
|
||||
simp [eq_replicate_iff]
|
||||
|
||||
@[simp] theorem mem_replicate (a : α) (n : Nat) : b ∈ replicate n a ↔ n ≠ 0 ∧ b = a := by
|
||||
rw [replicate, mem_toArray]
|
||||
simp
|
||||
|
||||
@[simp] theorem map_const (l : Array α) (b : β) : map (Function.const α b) l = replicate l.size b :=
|
||||
map_eq_replicate_iff.mpr fun _ _ => rfl
|
||||
|
||||
@[simp] theorem map_const_fun (x : β) : map (Function.const α x) = (replicate ·.size x) := by
|
||||
funext l
|
||||
simp
|
||||
|
||||
/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
|
||||
-- This can not be a `@[simp]` lemma because it would fire on every `Array.map`.
|
||||
theorem map_const' (l : Array α) (b : β) : map (fun _ => b) l = replicate l.size b :=
|
||||
map_const l b
|
||||
|
||||
@[simp] theorem sum_replicate_nat (n : Nat) (a : Nat) : (replicate n a).sum = n * a := by
|
||||
simp [sum_eq_sum_toList, List.sum_replicate_nat]
|
||||
|
||||
@[deprecated eq_replicate_of_mem (since := "2025-01-16")] abbrev eq_mkArray_of_mem := @eq_replicate_of_mem
|
||||
@[deprecated eq_replicate_iff (since := "2025-01-16")] abbrev eq_mkArray_iff := @eq_replicate_iff
|
||||
@[deprecated map_eq_replicate_iff (since := "2025-01-16")] abbrev map_eq_mkArray_iff := @map_eq_replicate_iff
|
||||
@[deprecated mem_replicate (since := "2025-01-16")] abbrev mem_mkArray := @mem_replicate
|
||||
@[deprecated sum_replicate_nat (since := "2025-01-16")] abbrev sum_mkArray_nat := @sum_replicate_nat
|
||||
|
||||
/-! ### reverse -/
|
||||
|
||||
@[simp] theorem mem_reverse {x : α} {as : Array α} : x ∈ as.reverse ↔ x ∈ as := by
|
||||
|
||||
@@ -3539,7 +3539,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
|
||||
|
||||
@@ -1076,31 +1076,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 +1087,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
|
||||
@@ -1508,34 +1494,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 +1561,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 +1585,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 +1614,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 +1642,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 +1691,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 +1873,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 +1888,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 +1913,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 +1966,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 +1974,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 +1994,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 +2014,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 +2032,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 +2337,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
|
||||
|
||||
@@ -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'
|
||||
@@ -392,29 +389,9 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
|
||||
· simp
|
||||
· simp_all [List.set_eq_of_length_le]
|
||||
|
||||
@[simp] theorem toArray_replicate (n : Nat) (v : α) : (List.replicate n v).toArray = Array.replicate n v := rfl
|
||||
@[simp] theorem toArray_replicate (n : Nat) (v : α) : (List.replicate n v).toArray = mkArray n v := rfl
|
||||
|
||||
@[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₂ =>
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -52,15 +52,13 @@ def elimAsList {motive : Vector α n → Sort u}
|
||||
@[inline] def mkEmpty (capacity : Nat) : Vector α 0 := ⟨.mkEmpty capacity, rfl⟩
|
||||
|
||||
/-- Makes a vector of size `n` with all cells containing `v`. -/
|
||||
@[inline] def replicate (n) (v : α) : Vector α n := ⟨Array.replicate n v, by simp⟩
|
||||
|
||||
@[deprecated replicate (since := "2025-01-16")] abbrev mkVector := @replicate
|
||||
@[inline] def mkVector (n) (v : α) : Vector α n := ⟨mkArray n v, by simp⟩
|
||||
|
||||
/-- Returns a vector of size `1` with element `v`. -/
|
||||
@[inline] def singleton (v : α) : Vector α 1 := ⟨#[v], rfl⟩
|
||||
|
||||
instance [Inhabited α] : Inhabited (Vector α n) where
|
||||
default := replicate n default
|
||||
default := mkVector n default
|
||||
|
||||
/-- Get an element of a vector using a `Fin` index. -/
|
||||
@[inline] def get (v : Vector α n) (i : Fin n) : α :=
|
||||
@@ -172,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⟩
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
|
||||
-/
|
||||
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
|
||||
|
||||
@@ -269,9 +265,7 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
|
||||
cases v
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_replicate : (replicate n a).toArray = Array.replicate n a := rfl
|
||||
|
||||
@[deprecated toArray_replicate (since := "2025-01-16")] abbrev toArray_mkVector := @toArray_replicate
|
||||
@[simp] theorem toArray_mkVector : (mkVector n a).toArray = mkArray n a := rfl
|
||||
|
||||
@[simp] theorem toArray_inj {v w : Vector α n} : v.toArray = w.toArray ↔ v = w := by
|
||||
cases v
|
||||
@@ -391,9 +385,7 @@ theorem toList_swap (a : Vector α n) (i j) (hi hj) :
|
||||
cases v
|
||||
simp
|
||||
|
||||
@[simp] theorem toList_replicate : (replicate n a).toList = List.replicate n a := rfl
|
||||
|
||||
@[deprecated toList_replicate (since := "2025-01-16")] abbrev toList_mkVector := @toList_replicate
|
||||
@[simp] theorem toList_mkVector : (mkVector n a).toList = List.replicate n a := rfl
|
||||
|
||||
theorem toList_inj {v w : Vector α n} : v.toList = w.toList ↔ v = w := by
|
||||
cases v
|
||||
@@ -472,19 +464,15 @@ theorem exists_push {xs : Vector α (n + 1)} :
|
||||
theorem singleton_inj : #v[a] = #v[b] ↔ a = b := by
|
||||
simp
|
||||
|
||||
/-! ### replicate -/
|
||||
/-! ### mkVector -/
|
||||
|
||||
@[simp] theorem replicate_zero : replicate 0 a = #v[] := rfl
|
||||
@[simp] theorem mkVector_zero : mkVector 0 a = #v[] := rfl
|
||||
|
||||
theorem replicate_succ : replicate (n + 1) a = (replicate n a).push a := by
|
||||
simp [replicate, Array.replicate_succ]
|
||||
theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
|
||||
simp [mkVector, Array.mkArray_succ]
|
||||
|
||||
theorem replicate_inj : replicate n a = replicate n b ↔ n = 0 ∨ a = b := by
|
||||
simp [← toArray_inj, toArray_replicate, Array.replicate_inj]
|
||||
|
||||
@[deprecated replicate_zero (since := "2025-01-16")] abbrev mkVector_zero := @replicate_zero
|
||||
@[deprecated replicate_succ (since := "2025-01-16")] abbrev mkVector_succ := @replicate_succ
|
||||
@[deprecated replicate_inj (since := "2025-01-16")] abbrev mkVector_inj := @replicate_inj
|
||||
theorem mkVector_inj : mkVector n a = mkVector n b ↔ n = 0 ∨ a = b := by
|
||||
simp [← toArray_inj, toArray_mkVector, Array.mkArray_inj]
|
||||
|
||||
/-! ## L[i] and L[i]? -/
|
||||
|
||||
@@ -705,24 +693,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] :
|
||||
@@ -1013,17 +983,15 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
cases w
|
||||
simp
|
||||
|
||||
@[simp] theorem replicate_beq_replicate [BEq α] {a b : α} {n : Nat} :
|
||||
(replicate n a == replicate n b) = (n == 0 || a == b) := by
|
||||
@[simp] theorem mkVector_beq_mkVector [BEq α] {a b : α} {n : Nat} :
|
||||
(mkVector n a == mkVector n b) = (n == 0 || a == b) := by
|
||||
cases n with
|
||||
| zero => simp
|
||||
| succ n =>
|
||||
rw [replicate_succ, replicate_succ, push_beq_push, replicate_beq_replicate]
|
||||
rw [mkVector_succ, mkVector_succ, push_beq_push, mkVector_beq_mkVector]
|
||||
rw [Bool.eq_iff_iff]
|
||||
simp +contextual
|
||||
|
||||
@[deprecated replicate_beq_replicate (since := "2025-01-16")] abbrev mkVector_beq_mkVector := @replicate_beq_replicate
|
||||
|
||||
@[simp] theorem reflBEq_iff [BEq α] [NeZero n] : ReflBEq (Vector α n) ↔ ReflBEq α := by
|
||||
match n, NeZero.ne n with
|
||||
| n + 1, _ =>
|
||||
@@ -1031,8 +999,8 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
· intro h
|
||||
constructor
|
||||
intro a
|
||||
suffices (replicate (n + 1) a == replicate (n + 1) a) = true by
|
||||
rw [replicate_succ, push_beq_push, Bool.and_eq_true] at this
|
||||
suffices (mkVector (n + 1) a == mkVector (n + 1) a) = true by
|
||||
rw [mkVector_succ, push_beq_push, Bool.and_eq_true] at this
|
||||
exact this.2
|
||||
simp
|
||||
· intro h
|
||||
@@ -1047,15 +1015,15 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
|
||||
· intro h
|
||||
constructor
|
||||
· intro a b h
|
||||
have := replicate_inj (n := n+1) (a := a) (b := b)
|
||||
have := mkVector_inj (n := n+1) (a := a) (b := b)
|
||||
simp only [Nat.add_one_ne_zero, false_or] at this
|
||||
rw [← this]
|
||||
apply eq_of_beq
|
||||
rw [replicate_beq_replicate]
|
||||
rw [mkVector_beq_mkVector]
|
||||
simpa
|
||||
· intro a
|
||||
suffices (replicate (n + 1) a == replicate (n + 1) a) = true by
|
||||
rw [replicate_beq_replicate] at this
|
||||
suffices (mkVector (n + 1) a == mkVector (n + 1) a) = true by
|
||||
rw [mkVector_beq_mkVector] at this
|
||||
simpa
|
||||
simp
|
||||
· intro h
|
||||
@@ -1129,11 +1097,6 @@ theorem forall_mem_map {f : α → β} {l : Vector α n} {P : β → Prop} :
|
||||
@[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
|
||||
|
||||
@@ -1141,8 +1104,8 @@ theorem map_inj [NeZero n] : map (n := n) f = map g ↔ f = g := by
|
||||
constructor
|
||||
· intro h
|
||||
ext a
|
||||
replace h := congrFun h (replicate n a)
|
||||
simp only [replicate, map_mk, mk.injEq, Array.map_inj_left, Array.mem_replicate, and_imp,
|
||||
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
|
||||
@@ -1204,406 +1167,6 @@ theorem map_eq_iff {f : α → β} {l : Vector α n} {l' : Vector β n} :
|
||||
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 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 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) :
|
||||
@@ -1634,6 +1197,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
|
||||
|
||||
@@ -46,12 +46,6 @@ attribute [grind_norm] not_false_eq_true
|
||||
theorem imp_eq (p q : Prop) : (p → q) = (¬ p ∨ q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
@[grind_norm] theorem true_imp_eq (p : Prop) : (True → p) = p := by simp
|
||||
@[grind_norm] theorem false_imp_eq (p : Prop) : (False → p) = True := by simp
|
||||
@[grind_norm] theorem imp_true_eq (p : Prop) : (p → True) = True := by simp
|
||||
@[grind_norm] theorem imp_false_eq (p : Prop) : (p → False) = ¬p := by simp
|
||||
@[grind_norm] theorem imp_self_eq (p : Prop) : (p → p) = True := by simp
|
||||
|
||||
-- And
|
||||
@[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
@@ -7,86 +7,159 @@ prelude
|
||||
import Init.Core
|
||||
import Init.Omega
|
||||
|
||||
namespace Lean.Grind
|
||||
abbrev isLt (x y : Nat) : Bool := x < y
|
||||
abbrev isLE (x y : Nat) : Bool := x ≤ y
|
||||
namespace Lean.Grind.Offset
|
||||
|
||||
/-! 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, DecidableEq, 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]
|
||||
|
||||
end Lean.Grind
|
||||
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 Cnstrs := List Cnstr
|
||||
|
||||
def Cnstrs.denoteAnd' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : Prop :=
|
||||
match c₂ with
|
||||
| [] => c₁.denote ctx
|
||||
| c::cs => c₁.denote ctx ∧ Cnstrs.denoteAnd' ctx c cs
|
||||
|
||||
theorem Cnstrs.denote'_trans (ctx : Context) (c₁ c : Cnstr) (cs : Cnstrs) : c₁.denote ctx → denoteAnd' ctx c cs → denoteAnd' ctx (c₁.trans c) cs := by
|
||||
induction cs
|
||||
next => simp [denoteAnd', *]; apply Cnstr.denote_trans
|
||||
next c cs ih => simp [denoteAnd']; intros; simp [*]
|
||||
|
||||
def Cnstrs.trans' (c₁ : Cnstr) (c₂ : Cnstrs) : Cnstr :=
|
||||
match c₂ with
|
||||
| [] => c₁
|
||||
| c::c₂ => trans' (c₁.trans c) c₂
|
||||
|
||||
@[simp] theorem Cnstrs.denote'_trans' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : denoteAnd' ctx c₁ c₂ → (trans' c₁ c₂).denote ctx := by
|
||||
induction c₂ generalizing c₁
|
||||
next => intros; simp_all [trans', denoteAnd']
|
||||
next c cs ih => simp [denoteAnd']; intros; simp [trans']; apply ih; apply denote'_trans <;> assumption
|
||||
|
||||
def Cnstrs.denoteAnd (ctx : Context) (c : Cnstrs) : Prop :=
|
||||
match c with
|
||||
| [] => True
|
||||
| c::cs => denoteAnd' ctx c cs
|
||||
|
||||
def Cnstrs.trans (c : Cnstrs) : Cnstr :=
|
||||
match c with
|
||||
| [] => trivialCnstr
|
||||
| c::cs => trans' c cs
|
||||
|
||||
theorem Cnstrs.of_denoteAnd_trans {ctx : Context} {c : Cnstrs} : c.denoteAnd ctx → c.trans.denote ctx := by
|
||||
cases c <;> simp [*, trans, denoteAnd] <;> intros <;> simp [*]
|
||||
|
||||
def Cnstrs.isFalse (c : Cnstrs) : Bool :=
|
||||
c.trans.isFalse
|
||||
|
||||
theorem Cnstrs.unsat' (ctx : Context) (c : Cnstrs) : c.isFalse = true → ¬ c.denoteAnd ctx := by
|
||||
simp [isFalse]; intro h₁ h₂
|
||||
have := of_denoteAnd_trans h₂
|
||||
have := Cnstr.of_isFalse ctx h₁
|
||||
contradiction
|
||||
|
||||
/-- `denote ctx [c_1, ..., c_n] C` is `c_1.denote ctx → ... → c_n.denote ctx → C` -/
|
||||
def Cnstrs.denote (ctx : Context) (cs : Cnstrs) (C : Prop) : Prop :=
|
||||
match cs with
|
||||
| [] => C
|
||||
| c::cs => c.denote ctx → denote ctx cs C
|
||||
|
||||
theorem Cnstrs.not_denoteAnd'_eq (ctx : Context) (c : Cnstr) (cs : Cnstrs) (C : Prop) : (denoteAnd' ctx c cs → C) = denote ctx (c::cs) C := by
|
||||
simp [denote]
|
||||
induction cs generalizing c
|
||||
next => simp [denoteAnd', denote]
|
||||
next c' cs ih =>
|
||||
simp [denoteAnd', denote, *]
|
||||
|
||||
theorem Cnstrs.not_denoteAnd_eq (ctx : Context) (cs : Cnstrs) (C : Prop) : (denoteAnd ctx cs → C) = denote ctx cs C := by
|
||||
cases cs
|
||||
next => simp [denoteAnd, denote]
|
||||
next c cs => apply not_denoteAnd'_eq
|
||||
|
||||
def Cnstr.isImpliedBy (cs : Cnstrs) (c : Cnstr) : Bool :=
|
||||
cs.trans == c
|
||||
|
||||
/-! Main theorems used by `grind`. -/
|
||||
|
||||
/-- Auxiliary theorem used by `grind` to prove that a system of offset inequalities is unsatisfiable. -/
|
||||
theorem Cnstrs.unsat (ctx : Context) (cs : Cnstrs) : cs.isFalse = true → cs.denote ctx False := by
|
||||
intro h
|
||||
rw [← not_denoteAnd_eq]
|
||||
apply unsat'
|
||||
assumption
|
||||
|
||||
/-- Auxiliary theorem used by `grind` to prove an implied offset inequality. -/
|
||||
theorem Cnstrs.imp (ctx : Context) (cs : Cnstrs) (c : Cnstr) (h : c.isImpliedBy cs = true) : cs.denote ctx (c.denote ctx) := by
|
||||
rw [← eq_of_beq h]
|
||||
rw [← not_denoteAnd_eq]
|
||||
apply of_denoteAnd_trans
|
||||
|
||||
end Lean.Grind.Offset
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -85,7 +85,7 @@ partial def eraseProjIncForAux (y : VarId) (bs : Array FnBody) (mask : Mask) (ke
|
||||
/-- Try to erase `inc` instructions on projections of `y` occurring in the tail of `bs`.
|
||||
Return the updated `bs` and a bit mask specifying which `inc`s have been removed. -/
|
||||
def eraseProjIncFor (n : Nat) (y : VarId) (bs : Array FnBody) : Array FnBody × Mask :=
|
||||
eraseProjIncForAux y bs (Array.replicate n none) #[]
|
||||
eraseProjIncForAux y bs (mkArray n none) #[]
|
||||
|
||||
/-- Replace `reuse x ctor ...` with `ctor ...`, and remove `dec x` -/
|
||||
partial def reuseToCtor (x : VarId) : FnBody → FnBody
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -169,7 +169,7 @@ def mkFixedParamsMap (decls : Array Decl) : NameMap (Array Bool) := Id.run do
|
||||
for decl in decls do
|
||||
let values := mkInitialValues decl.params.size
|
||||
let assignment := mkAssignment decl values
|
||||
let fixed := Array.replicate decl.params.size true
|
||||
let fixed := Array.mkArray decl.params.size true
|
||||
match decl.value with
|
||||
| .code c =>
|
||||
match evalCode c |>.run { main := decl, decls, assignment } |>.run { fixed } with
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -98,7 +98,7 @@ where
|
||||
return { ctx with discrCtorMap := ctx.discrCtorMap.insert discr ctorInfo, ctorDiscrMap := ctx.ctorDiscrMap.insert ctor.toExpr discr }
|
||||
else
|
||||
-- For the discrCtor map, the constructor parameters are irrelevant for optimizations that use this information
|
||||
let ctorInfo := .ctor ctorVal (Array.replicate ctorVal.numParams Arg.erased ++ fieldArgs)
|
||||
let ctorInfo := .ctor ctorVal (mkArray ctorVal.numParams Arg.erased ++ fieldArgs)
|
||||
return { ctx with discrCtorMap := ctx.discrCtorMap.insert discr ctorInfo }
|
||||
|
||||
@[inline, inherit_doc withDiscrCtorImp] def withDiscrCtor [MonadFunctorT DiscrM m] (discr : FVarId) (ctorName : Name) (ctorFields : Array Param) : m α → m α :=
|
||||
|
||||
@@ -147,7 +147,7 @@ def saveSpecParamInfo (decls : Array Decl) : CompilerM Unit := do
|
||||
let mut declsInfo := #[]
|
||||
for decl in decls do
|
||||
if hasNospecializeAttribute (← getEnv) decl.name then
|
||||
declsInfo := declsInfo.push (Array.replicate decl.params.size .other)
|
||||
declsInfo := declsInfo.push (mkArray decl.params.size .other)
|
||||
else
|
||||
let specArgs? := getSpecializationArgs? (← getEnv) decl.name
|
||||
let contains (i : Nat) : Bool := specArgs?.getD #[] |>.contains i
|
||||
|
||||
@@ -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 @@ order, exists in the array.
|
||||
-/
|
||||
def filterPairsM {m} [Monad m] {α} (a : Array α) (f : α → α → m (Bool × Bool)) :
|
||||
m (Array α) := do
|
||||
let mut removed := Array.replicate a.size false
|
||||
let mut removed := Array.mkArray a.size false
|
||||
let mut numRemoved := 0
|
||||
for h1 : i in [:a.size] do for h2 : j in [i+1:a.size] do
|
||||
unless removed[i]! || removed[j]! do
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -99,11 +99,11 @@ private def fuzzyMatchCore (pattern word : String) (patternRoles wordRoles : Arr
|
||||
between the substrings pattern[:i+1] and word[:j+1] assuming that pattern[i] misses at word[j] (k = 0, i.e.
|
||||
it was matched earlier), or matches at word[j] (k = 1). A value of `none` corresponds to a score of -∞, and is used
|
||||
where no such match/miss is possible or for unneeded parts of the table. -/
|
||||
let mut result : Array (Option Int) := Array.replicate (pattern.length * word.length * 2) none
|
||||
let mut runLengths : Array Int := Array.replicate (pattern.length * word.length) 0
|
||||
let mut result : Array (Option Int) := Array.mkArray (pattern.length * word.length * 2) none
|
||||
let mut runLengths : Array Int := Array.mkArray (pattern.length * word.length) 0
|
||||
|
||||
-- penalty for starting a consecutive run at each index
|
||||
let mut startPenalties : Array Int := Array.replicate word.length 0
|
||||
let mut startPenalties : Array Int := Array.mkArray word.length 0
|
||||
|
||||
let mut lastSepIdx := 0
|
||||
let mut penaltyNs : Int := 0
|
||||
@@ -124,8 +124,8 @@ private def fuzzyMatchCore (pattern word : String) (patternRoles wordRoles : Arr
|
||||
`word.length - pattern.length` at each index (because at the very end, we can only consider fuzzy matches
|
||||
of `pattern` with a longer substring of `word`). -/
|
||||
for wordIdx in [patternIdx:word.length-(pattern.length - patternIdx - 1)] do
|
||||
let missScore? :=
|
||||
if wordIdx >= 1 then
|
||||
let missScore? :=
|
||||
if wordIdx >= 1 then
|
||||
selectBest
|
||||
(getMiss result patternIdx (wordIdx - 1))
|
||||
(getMatch result patternIdx (wordIdx - 1))
|
||||
@@ -134,7 +134,7 @@ private def fuzzyMatchCore (pattern word : String) (patternRoles wordRoles : Arr
|
||||
let mut matchScore? := none
|
||||
|
||||
if allowMatch (pattern.get ⟨patternIdx⟩) (word.get ⟨wordIdx⟩) (patternRoles.get! patternIdx) (wordRoles.get! wordIdx) then
|
||||
if patternIdx >= 1 then
|
||||
if patternIdx >= 1 then
|
||||
let runLength := runLengths.get! (getIdx (patternIdx - 1) (wordIdx - 1)) + 1
|
||||
runLengths := runLengths.set! (getIdx patternIdx wordIdx) runLength
|
||||
|
||||
@@ -213,7 +213,7 @@ private def fuzzyMatchCore (pattern word : String) (patternRoles wordRoles : Arr
|
||||
/- Consecutive character match. -/
|
||||
if let some bonus := consecutive then
|
||||
/- consecutive run bonus -/
|
||||
score := score + bonus
|
||||
score := score + bonus
|
||||
return score
|
||||
|
||||
/-- Match the given pattern with the given word using a fuzzy matching
|
||||
|
||||
@@ -32,7 +32,7 @@ private def numBucketsForCapacity (capacity : Nat) : Nat :=
|
||||
def mkHashMapImp {α : Type u} {β : Type v} (capacity := 8) : HashMapImp α β :=
|
||||
{ size := 0
|
||||
buckets :=
|
||||
⟨Array.replicate (numBucketsForCapacity capacity).nextPowerOfTwo AssocList.nil,
|
||||
⟨mkArray (numBucketsForCapacity capacity).nextPowerOfTwo AssocList.nil,
|
||||
by simp; apply Nat.isPowerOfTwo_nextPowerOfTwo⟩ }
|
||||
|
||||
namespace HashMapImp
|
||||
@@ -101,7 +101,7 @@ decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def expand [Hashable α] (size : Nat) (buckets : HashMapBucket α β) : HashMapImp α β :=
|
||||
let bucketsNew : HashMapBucket α β := ⟨
|
||||
Array.replicate (buckets.val.size * 2) AssocList.nil,
|
||||
mkArray (buckets.val.size * 2) AssocList.nil,
|
||||
by simp; apply Nat.mul2_isPowerOfTwo_of_isPowerOfTwo buckets.property
|
||||
⟩
|
||||
{ size := size,
|
||||
|
||||
@@ -28,7 +28,7 @@ structure HashSetImp (α : Type u) where
|
||||
def mkHashSetImp {α : Type u} (capacity := 8) : HashSetImp α :=
|
||||
{ size := 0
|
||||
buckets :=
|
||||
⟨Array.replicate ((capacity * 4) / 3).nextPowerOfTwo [],
|
||||
⟨mkArray ((capacity * 4) / 3).nextPowerOfTwo [],
|
||||
by simp; apply Nat.isPowerOfTwo_nextPowerOfTwo⟩ }
|
||||
|
||||
namespace HashSetImp
|
||||
@@ -92,7 +92,7 @@ decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def expand [Hashable α] (size : Nat) (buckets : HashSetBucket α) : HashSetImp α :=
|
||||
let bucketsNew : HashSetBucket α := ⟨
|
||||
Array.replicate (buckets.val.size * 2) [],
|
||||
mkArray (buckets.val.size * 2) [],
|
||||
by simp; apply Nat.mul2_isPowerOfTwo_of_isPowerOfTwo buckets.property
|
||||
⟩
|
||||
{ size := size,
|
||||
|
||||
@@ -39,7 +39,7 @@ abbrev maxDepth : USize := 7
|
||||
abbrev maxCollisions : Nat := 4
|
||||
|
||||
def mkEmptyEntriesArray {α β} : Array (Entry α β (Node α β)) :=
|
||||
(Array.replicate PersistentHashMap.branching.toNat PersistentHashMap.Entry.null)
|
||||
(Array.mkArray PersistentHashMap.branching.toNat PersistentHashMap.Entry.null)
|
||||
|
||||
end PersistentHashMap
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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 ())
|
||||
|
||||
@@ -735,7 +735,7 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
|
||||
let extDescrs ← persistentEnvExtensionsRef.get
|
||||
/- For extensions starting at `startingAt`, ensure their `importedEntries` array have size `mods.size`. -/
|
||||
for extDescr in extDescrs[startingAt:] do
|
||||
env := extDescr.toEnvExtension.modifyState env fun s => { s with importedEntries := Array.replicate mods.size #[] }
|
||||
env := extDescr.toEnvExtension.modifyState env fun s => { s with importedEntries := mkArray mods.size #[] }
|
||||
/- For each module `mod`, and `mod.entries`, if the extension name is one of the extensions after `startingAt`, set `entries` -/
|
||||
let extNameIdx ← mkExtNameMap startingAt
|
||||
for h : modIdx in [:mods.size] do
|
||||
|
||||
@@ -1127,7 +1127,7 @@ private def getAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
@[inline] def getAppArgs (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
getAppArgsAux e (Array.replicate nargs dummy) (nargs-1)
|
||||
getAppArgsAux e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
private def getBoundedAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
| app f a, as, i + 1 => getBoundedAppArgsAux f (as.set! i a) i
|
||||
@@ -1142,7 +1142,7 @@ where `k` is minimal such that the size of this array is at most `maxArgs`.
|
||||
@[inline] def getBoundedAppArgs (maxArgs : Nat) (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := min maxArgs e.getAppNumArgs
|
||||
getBoundedAppArgsAux e (Array.replicate nargs dummy) nargs
|
||||
getBoundedAppArgsAux e (mkArray nargs dummy) nargs
|
||||
|
||||
private def getAppRevArgsAux : Expr → Array Expr → Array Expr
|
||||
| app f a, as => getAppRevArgsAux f (as.push a)
|
||||
@@ -1160,7 +1160,7 @@ private def getAppRevArgsAux : Expr → Array Expr → Array Expr
|
||||
@[inline] def withApp (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
withAppAux k e (Array.replicate nargs dummy) (nargs-1)
|
||||
withAppAux k e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
/-- Return the function (name) and arguments of an application. -/
|
||||
def getAppFnArgs (e : Expr) : Name × Array Expr :=
|
||||
@@ -1173,7 +1173,7 @@ The resulting array has size `n` even if `f.getAppNumArgs < n`.
|
||||
-/
|
||||
@[inline] def getAppArgsN (e : Expr) (n : Nat) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
loop n e (Array.replicate n dummy)
|
||||
loop n e (mkArray n dummy)
|
||||
where
|
||||
loop : Nat → Expr → Array Expr → Array Expr
|
||||
| 0, _, as => as
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -196,7 +196,7 @@ def mkSizeOfSpecLemmaInstance (ctorApp : Expr) : MetaM Expr :=
|
||||
let lemmaInfo ← getConstInfo lemmaName
|
||||
let lemmaArity ← forallTelescopeReducing lemmaInfo.type fun xs _ => return xs.size
|
||||
let lemmaArgMask := ctorParams.toArray.map some
|
||||
let lemmaArgMask := lemmaArgMask ++ Array.replicate (lemmaArity - ctorInfo.numParams - ctorInfo.numFields) (none (α := Expr))
|
||||
let lemmaArgMask := lemmaArgMask ++ mkArray (lemmaArity - ctorInfo.numParams - ctorInfo.numFields) (none (α := Expr))
|
||||
let lemmaArgMask := lemmaArgMask ++ ctorFields.toArray.map some
|
||||
mkAppOptM lemmaName lemmaArgMask
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -63,6 +54,4 @@ 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,42 @@ 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
|
||||
structure State where
|
||||
argMap : PHashMap (Expr × Nat) (List Expr) := {}
|
||||
canon : PHashMap Expr Expr := {}
|
||||
proofCanon : PHashMap Expr Expr := {}
|
||||
deriving Inhabited
|
||||
|
||||
@[inline] private def modify' (f : State → State) : GoalM Unit :=
|
||||
modify fun s => { s with canon := f s.canon }
|
||||
inductive CanonElemKind where
|
||||
| /--
|
||||
Type class instances are canonicalized using `TransparencyMode.instances`.
|
||||
-/
|
||||
instance
|
||||
| /--
|
||||
Types and Type formers are canonicalized using `TransparencyMode.default`.
|
||||
Remark: propositions are just visited. We do not invoke `canonElemCore` for them.
|
||||
-/
|
||||
type
|
||||
| /--
|
||||
Implicit arguments that are not types, type formers, or instances, are canonicalized
|
||||
using `TransparencyMode.reducible`
|
||||
-/
|
||||
implicit
|
||||
deriving BEq
|
||||
|
||||
/--
|
||||
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
|
||||
def CanonElemKind.explain : CanonElemKind → String
|
||||
| .instance => "type class instances"
|
||||
| .type => "types (or type formers)"
|
||||
| .implicit => "implicit arguments (which are not type class instances or types)"
|
||||
|
||||
/--
|
||||
Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
|
||||
If `useIsDefEqBounded` is `true`, we try `isDefEqBounded` before returning false
|
||||
|
||||
Thus, if diagnostics are enabled, we also re-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) (kind : CanonElemKind) : 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 +85,20 @@ 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 }
|
||||
trace[grind.debug.canon] "found {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
|
||||
if kind != .type then
|
||||
if (← isTracingEnabledFor `grind.issues <&&> (withDefault <| isDefEq e c)) then
|
||||
-- TODO: consider storing this information in some structure that can be browsed later.
|
||||
trace[grind.issues] "the following {kind.explain} are definitionally equal with `default` transparency but not with a more restrictive transparency{indentExpr e}\nand{indentExpr c}"
|
||||
trace[grind.debug.canon] "({f}, {i}) ↦ {e}"
|
||||
modify' fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
|
||||
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 .type
|
||||
abbrev canonInst (f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore f i e .instance
|
||||
abbrev canonImplicit (f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore f i e .implicit
|
||||
|
||||
/--
|
||||
Return type for the `shouldCanon` function.
|
||||
@@ -145,10 +146,10 @@ def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Should
|
||||
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 +159,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
|
||||
@@ -172,9 +173,9 @@ where
|
||||
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
|
||||
| .canonImplicit => canonImplicit f i (← visit arg)
|
||||
| .visit => visit arg
|
||||
unless ptrEq arg arg' do
|
||||
args := args.set i arg'
|
||||
@@ -190,11 +191,11 @@ 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 := do
|
||||
trace[grind.debug.canon] "{e}"
|
||||
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
|
||||
|
||||
/--
|
||||
|
||||
@@ -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
|
||||
@@ -65,7 +65,7 @@ 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
|
||||
@@ -77,7 +77,7 @@ private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
|
||||
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`,
|
||||
|
||||
@@ -419,10 +419,10 @@ mutual
|
||||
|| (getPPAnalyzeTrustSubtypeMk (← getOptions) && (← getExpr).isAppOfArity ``Subtype.mk 4)
|
||||
|
||||
analyzeAppStagedCore { f, fType, args, mvars, bInfos, forceRegularApp } |>.run' {
|
||||
bottomUps := Array.replicate args.size false,
|
||||
higherOrders := Array.replicate args.size false,
|
||||
provideds := Array.replicate args.size false,
|
||||
funBinders := Array.replicate args.size false
|
||||
bottomUps := mkArray args.size false,
|
||||
higherOrders := mkArray args.size false,
|
||||
provideds := mkArray args.size false,
|
||||
funBinders := mkArray args.size false
|
||||
}
|
||||
|
||||
if !rest.isEmpty then
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -495,7 +495,7 @@ def getCanonicalAntiquot (stx : Syntax) : Syntax :=
|
||||
stx
|
||||
|
||||
def mkAntiquotNode (kind : Name) (term : Syntax) (nesting := 0) (name : Option String := none) (isPseudoKind := false) : Syntax :=
|
||||
let nesting := mkNullNode (Array.replicate nesting (mkAtom "$"))
|
||||
let nesting := mkNullNode (mkArray nesting (mkAtom "$"))
|
||||
let term :=
|
||||
if term.isIdent then term
|
||||
else if term.isOfKind `Lean.Parser.Term.hole then term[0]
|
||||
@@ -558,7 +558,7 @@ def getAntiquotSpliceSuffix (stx : Syntax) : Syntax :=
|
||||
stx[1]
|
||||
|
||||
def mkAntiquotSpliceNode (kind : SyntaxNodeKind) (contents : Array Syntax) (suffix : String) (nesting := 0) : Syntax :=
|
||||
let nesting := mkNullNode (Array.replicate nesting (mkAtom "$"))
|
||||
let nesting := mkNullNode (mkArray nesting (mkAtom "$"))
|
||||
mkNode (kind ++ `antiquot_splice) #[mkAtom "$", nesting, mkAtom "[", mkNullNode contents, mkAtom "]", mkAtom suffix]
|
||||
|
||||
-- `$x,*` etc.
|
||||
|
||||
@@ -31,7 +31,7 @@ structure State where
|
||||
checked : Std.HashSet Expr
|
||||
|
||||
unsafe def initCache : State := {
|
||||
visited := Array.replicate cacheSize.toNat (cast lcProof ())
|
||||
visited := mkArray cacheSize.toNat (cast lcProof ())
|
||||
checked := {}
|
||||
}
|
||||
|
||||
|
||||
@@ -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]
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user