Compare commits

..

3 Commits

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

File diff suppressed because it is too large Load Diff

View File

@@ -5,6 +5,11 @@ See below for the checklist for release candidates.
We'll use `v4.6.0` as the intended release version as a running example.
- One week before the planned release, ensure that
(1) someone has written the release notes and
(2) someone has written the first draft of the release blog post.
If there is any material in `./releases_drafts/` on the `releases/v4.6.0` branch, then the release notes are not done.
(See the section "Writing the release notes".)
- `git checkout releases/v4.6.0`
(This branch should already exist, from the release candidates.)
- `git pull`
@@ -76,16 +81,12 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [plausible](https://github.com/leanprover-community/plausible)
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Mathlib](https://github.com/leanprover-community/mathlib4)
- Dependencies: `Aesop`, `ProofWidgets4`, `lean4checker`, `Batteries`, `doc-gen4`, `import-graph`
- Toolchain bump PR notes:
- In addition to updating the `lean-toolchain` and `lakefile.lean`,
in `.github/workflows/lean4checker.yml` update the line
`git checkout v4.6.0` to the appropriate tag.
`git checkout v4.6.0` to the appropriate tag.
- Push the PR branch to the main Mathlib repository rather than a fork, or CI may not work reliably
- Create and push the tag
- Create a new branch from the tag, push it, and open a pull request against `stable`.
@@ -97,7 +98,6 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- Run `scripts/release_checklist.py v4.6.0` to check that everything is in order.
- The `v4.6.0` section of `RELEASES.md` is out of sync between
`releases/v4.6.0` and `master`. This should be reconciled:
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
@@ -139,13 +139,16 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
git checkout -b releases/v4.7.0
```
- In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
- It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
- We will rely on automatically generated release notes for release candidates,
and the written release notes will be used for stable versions only.
It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
- In `src/CMakeLists.txt`,
- verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
- `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
- Commit your changes to `src/CMakeLists.txt`, and push.
- `git tag v4.7.0-rc1`
- `git push origin v4.7.0-rc1`
- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
- Now wait, while CI runs.
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
- This step can take up to an hour.
@@ -245,12 +248,15 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
# Writing the release notes
Release notes are automatically generated from the commit history, using `script/release_notes.py`.
We are currently trying a system where release notes are compiled all at once from someone looking through the commit history.
The exact steps are a work in progress.
Here is the general idea:
Run this as `script/release_notes.py v4.6.0`, where `v4.6.0` is the *previous* release version. This will generate output
for all commits since that tag. Note that there is output on both stderr, which should be manually reviewed,
and on stdout, which should be manually copied to `RELEASES.md`.
There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
The release notes for `v4.6.0` will later be copied to `master` when we begin a new development cycle.
* There can be material for release notes entries in commit messages.
* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
See `./releases_drafts/README.md` for more information.
* The release notes should be written from a downstream expert user's point of view.
This section will be updated when the next release notes are written (for `v4.10.0`).

View File

@@ -0,0 +1,16 @@
We replace the inductive predicate `List.lt` with an upstreamed version of `List.Lex` from Mathlib.
(Previously `Lex.lt` was defined in terms of `<`; now it is generalized to take an arbitrary relation.)
This subtely changes the notion of ordering on `List α`.
`List.lt` was a weaker relation: in particular if `l₁ < l₂`, then
`a :: l₁ < b :: l₂` may hold according to `List.lt` even if `a` and `b` are merely incomparable
(either neither `a < b` nor `b < a`), whereas according to `List.Lex` this would require `a = b`.
When `<` is total, in the sense that `¬ · < ·` is antisymmetric, then the two relations coincide.
Mathlib was already overriding the order instances for `List α`,
so this change should not be noticed by anyone already using Mathlib.
We simultaneously add the boolean valued `List.lex` function, parameterised by a `BEq` typeclass
and an arbitrary `lt` function. This will support the flexibility previously provided for `List.lt`,
via a `==` function which is weaker than strict equality.

View File

@@ -63,8 +63,8 @@ else
fi
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
# but do not change sysroot so users can still link against system libs
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
# do not set `LEAN_CC` for tests

View File

@@ -48,11 +48,12 @@ if [[ -L llvm-host ]]; then
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang"
gcp $GMP/lib/libgmp.a stage1/lib/
gcp $LIBUV/lib/libuv.a stage1/lib/
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv'"
else
echo -n " -DCMAKE_C_COMPILER=$PWD/llvm-host/bin/clang -DLEANC_OPTS='--sysroot $PWD/stage1 -resource-dir $PWD/stage1/lib/clang/15.0.1 ${EXTRA_FLAGS:-}'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
fi
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/libc -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
# do not set `LEAN_CC` for tests
echo -n " -DLEAN_TEST_VARS=''"

View File

@@ -43,7 +43,7 @@ echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=
echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual. Always link ICU dynamically.
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
# do not set `LEAN_CC` for tests

View File

@@ -1,132 +0,0 @@
#!/usr/bin/env python3
import argparse
import yaml
import requests
import base64
import subprocess
import sys
import os
def parse_repos_config(file_path):
with open(file_path, "r") as f:
return yaml.safe_load(f)["repositories"]
def get_github_token():
try:
import subprocess
result = subprocess.run(['gh', 'auth', 'token'], capture_output=True, text=True)
if result.returncode == 0:
return result.stdout.strip()
except FileNotFoundError:
print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
return None
def get_branch_content(repo_url, branch, file_path, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
content = response.json().get("content", "")
content = content.replace("\n", "")
try:
return base64.b64decode(content).decode('utf-8').strip()
except Exception:
return None
return None
def tag_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
# First get the commit SHA for the tag
api_base = repo_url.replace("https://github.com/", "https://api.github.com/repos/")
headers = {'Authorization': f'token {github_token}'} if github_token else {}
# Get tag's commit SHA
tag_response = requests.get(f"{api_base}/git/refs/tags/{tag_name}", headers=headers)
if tag_response.status_code != 200:
return False
tag_sha = tag_response.json()['object']['sha']
# Get commits on stable branch containing this SHA
commits_response = requests.get(
f"{api_base}/commits?sha={stable_branch}&per_page=100",
headers=headers
)
if commits_response.status_code != 200:
return False
# Check if any commit in stable's history matches our tag's SHA
stable_commits = [commit['sha'] for commit in commits_response.json()]
return tag_sha in stable_commits
def parse_version(version_str):
# Remove 'v' prefix and split into components
# Handle Lean toolchain format (leanprover/lean4:v4.x.y)
if ':' in version_str:
version_str = version_str.split(':')[1]
version = version_str.lstrip('v')
# Handle release candidates by removing -rc part for comparison
version = version.split('-')[0]
return tuple(map(int, version.split('.')))
def is_version_gte(version1, version2):
"""Check if version1 >= version2"""
return parse_version(version1) >= parse_version(version2)
def is_release_candidate(version):
return "-rc" in version
def main():
github_token = get_github_token()
if len(sys.argv) != 2:
print("Usage: python3 release_checklist.py <toolchain>")
sys.exit(1)
toolchain = sys.argv[1]
with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
repos = yaml.safe_load(f)["repositories"]
for repo in repos:
name = repo["name"]
url = repo["url"]
branch = repo["branch"]
check_stable = repo["stable-branch"]
check_tag = repo.get("toolchain-tag", True)
print(f"\nRepository: {name}")
# Check if branch is on at least the target toolchain
lean_toolchain_content = get_branch_content(url, branch, "lean-toolchain", github_token)
if lean_toolchain_content is None:
print(f" ❌ No lean-toolchain file found in {branch} branch")
continue
on_target_toolchain = is_version_gte(lean_toolchain_content.strip(), toolchain)
if not on_target_toolchain:
print(f" ❌ Not on target toolchain (needs ≥ {toolchain}, but {branch} is on {lean_toolchain_content.strip()})")
continue
print(f" ✅ On compatible toolchain (>= {toolchain})")
# Only check for tag if toolchain-tag is true
if check_tag:
if not tag_exists(url, toolchain, github_token):
print(f" ❌ Tag {toolchain} does not exist")
continue
print(f" ✅ Tag {toolchain} exists")
# Only check merging into stable if stable-branch is true and not a release candidate
if check_stable and not is_release_candidate(toolchain):
if not is_merged_into_stable(url, toolchain, "stable", github_token):
print(f" ❌ Tag {toolchain} is not merged into stable")
continue
print(f" ✅ Tag {toolchain} is merged into stable")
if __name__ == "__main__":
main()

View File

@@ -1,145 +0,0 @@
#!/usr/bin/env python3
import sys
import re
import json
import requests
import subprocess
from collections import defaultdict
from git import Repo
def get_commits_since_tag(repo, tag):
try:
tag_commit = repo.commit(tag)
commits = list(repo.iter_commits(f"{tag_commit.hexsha}..HEAD"))
return [
(commit.hexsha, commit.message.splitlines()[0], commit.message)
for commit in commits
]
except Exception as e:
sys.stderr.write(f"Error retrieving commits: {e}\n")
sys.exit(1)
def check_pr_number(first_line):
match = re.search(r"\(\#(\d+)\)$", first_line)
if match:
return int(match.group(1))
return None
def fetch_pr_labels(pr_number):
try:
# Use gh CLI to fetch PR details
result = subprocess.run([
"gh", "api", f"repos/leanprover/lean4/pulls/{pr_number}"
], capture_output=True, text=True, check=True)
pr_data = result.stdout
pr_json = json.loads(pr_data)
return [label["name"] for label in pr_json.get("labels", [])]
except subprocess.CalledProcessError as e:
sys.stderr.write(f"Failed to fetch PR #{pr_number} using gh: {e.stderr}\n")
return []
def format_section_title(label):
title = label.replace("changelog-", "").capitalize()
if title == "Doc":
return "Documentation"
elif title == "Pp":
return "Pretty Printing"
return title
def sort_sections_order():
return [
"Language",
"Library",
"Compiler",
"Pretty Printing",
"Documentation",
"Server",
"Lake",
"Other",
"Uncategorised"
]
def format_markdown_description(pr_number, description):
link = f"[#{pr_number}](https://github.com/leanprover/lean4/pull/{pr_number})"
return f"{link} {description}"
def main():
if len(sys.argv) != 2:
sys.stderr.write("Usage: script.py <git-tag>\n")
sys.exit(1)
tag = sys.argv[1]
try:
repo = Repo(".")
except Exception as e:
sys.stderr.write(f"Error opening Git repository: {e}\n")
sys.exit(1)
commits = get_commits_since_tag(repo, tag)
sys.stderr.write(f"Found {len(commits)} commits since tag {tag}:\n")
for commit_hash, first_line, _ in commits:
sys.stderr.write(f"- {commit_hash}: {first_line}\n")
changelog = defaultdict(list)
for commit_hash, first_line, full_message in commits:
# Skip commits with the specific first lines
if first_line == "chore: update stage0" or first_line.startswith("chore: CI: bump "):
continue
pr_number = check_pr_number(first_line)
if not pr_number:
sys.stderr.write(f"No PR number found in {first_line}\n")
continue
# Remove the first line from the full_message for further processing
body = full_message[len(first_line):].strip()
paragraphs = body.split('\n\n')
second_paragraph = paragraphs[0] if len(paragraphs) > 0 else ""
labels = fetch_pr_labels(pr_number)
# Skip entries with the "changelog-no" label
if "changelog-no" in labels:
continue
report_errors = first_line.startswith("feat:") or first_line.startswith("fix:")
if not second_paragraph.startswith("This PR "):
if report_errors:
sys.stderr.write(f"No PR description found in commit:\n{commit_hash}\n{first_line}\n{body}\n\n")
fallback_description = re.sub(r":$", "", first_line.split(" ", 1)[1]).rsplit(" (#", 1)[0]
markdown_description = format_markdown_description(pr_number, fallback_description)
else:
continue
else:
markdown_description = format_markdown_description(pr_number, second_paragraph.replace("This PR ", ""))
changelog_labels = [label for label in labels if label.startswith("changelog-")]
if len(changelog_labels) > 1:
sys.stderr.write(f"Warning: Multiple changelog-* labels found for PR #{pr_number}: {changelog_labels}\n")
if not changelog_labels:
if report_errors:
sys.stderr.write(f"Warning: No changelog-* label found for PR #{pr_number}\n")
else:
continue
for label in changelog_labels:
changelog[label].append((pr_number, markdown_description))
section_order = sort_sections_order()
sorted_changelog = sorted(changelog.items(), key=lambda item: section_order.index(format_section_title(item[0])) if format_section_title(item[0]) in section_order else len(section_order))
for label, entries in sorted_changelog:
section_title = format_section_title(label) if label != "Uncategorised" else "Uncategorised"
print(f"## {section_title}\n")
for _, entry in sorted(entries, key=lambda x: x[0]):
print(f"* {entry}\n")
if __name__ == "__main__":
main()

View File

@@ -1,79 +0,0 @@
repositories:
- name: Batteries
url: https://github.com/leanprover-community/batteries
toolchain-tag: true
stable-branch: true
branch: main
dependencies: []
- name: lean4checker
url: https://github.com/leanprover/lean4checker
toolchain-tag: true
stable-branch: true
branch: master
dependencies: []
- name: doc-gen4
url: https://github.com/leanprover/doc-gen4
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: Verso
url: https://github.com/leanprover/verso
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: ProofWidgets4
url: https://github.com/leanprover-community/ProofWidgets4
toolchain-tag: false
stable-branch: false
branch: main
dependencies:
- Batteries
- name: Aesop
url: https://github.com/leanprover-community/aesop
toolchain-tag: true
stable-branch: true
branch: master
dependencies:
- Batteries
- name: import-graph
url: https://github.com/leanprover-community/import-graph
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: plausible
url: https://github.com/leanprover-community/plausible
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: Mathlib
url: https://github.com/leanprover-community/mathlib4
toolchain-tag: true
stable-branch: true
branch: master
dependencies:
- Aesop
- ProofWidgets4
- lean4checker
- Batteries
- doc-gen4
- import-graph
- name: REPL
url: https://github.com/leanprover-community/repl
toolchain-tag: true
stable-branch: true
branch: master
dependencies:
- Mathlib

View File

@@ -36,8 +36,6 @@ namespace Array
@[simp] theorem mem_toList_iff (a : α) (l : Array α) : a l.toList a l := by
cases l <;> simp
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
/-! ### empty -/
@[simp] theorem empty_eq {xs : Array α} : #[] = xs xs = #[] := by
@@ -1003,7 +1001,52 @@ private theorem beq_of_beq_singleton [BEq α] {a b : α} : #[a] == #[b] → a ==
/-! Content below this point has not yet been aligned with `List`. -/
/-! ### map -/
theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-- This is a duplicate of `List.toArray_toList`.
-- It's confusing to guess which namespace this theorem should live in,
-- so we provide both.
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[deprecated size_toArray (since := "2024-12-11")]
theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
/--
Variant of `foldrM_push` with `h : start = arr.size + 1`
rather than `(arr.push a).size` as the argument.
-/
@[simp] theorem foldrM_push' [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α)
{start} (h : start = arr.size + 1) :
(arr.push a).foldrM f init start = f a init >>= arr.foldrM f := by
simp [ foldrM_push, h]
theorem foldr_push (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
/--
Variant of `foldr_push` with the `h : start = arr.size + 1`
rather than `(arr.push a).size` as the argument.
-/
@[simp] theorem foldr_push' (f : α β β) (init : β) (arr : Array α) (a : α) {start}
(h : start = arr.size + 1) : (arr.push a).foldr f init start = arr.foldr f (f a init) :=
foldrM_push' _ _ _ _ h
/-- A more efficient version of `arr.toList.reverse`. -/
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
@@ -1027,11 +1070,6 @@ where
induction l generalizing arr <;> simp [*]
simp [H]
@[simp] theorem _root_.List.map_toArray (f : α β) (l : List α) :
l.toArray.map f = (l.map f).toArray := by
apply ext'
simp
@[simp] theorem size_map (f : α β) (arr : Array α) : (arr.map f).size = arr.size := by
simp only [ length_toList]
simp
@@ -1041,128 +1079,6 @@ where
@[simp] theorem map_empty (f : α β) : map f #[] = #[] := mapM_empty f
@[simp] theorem getElem_map (f : α β) (a : Array α) (i : Nat) (hi : i < (a.map f).size) :
(a.map f)[i] = f (a[i]'(by simpa using hi)) := by
cases a
simp
@[simp] theorem getElem?_map (f : α β) (as : Array α) (i : Nat) :
(as.map f)[i]? = as[i]?.map f := by
simp [getElem?_def]
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : Array α) : map (id : α α) l = l := by
cases l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : Array α) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : Array α) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f #[a] = #[f a] := rfl
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
simp only [mem_def, toList_map, List.mem_map]
theorem exists_of_mem_map (h : b map f l) : a, a l f a = b := mem_map.1 h
theorem mem_map_of_mem (f : α β) (h : a l) : f a map f l := mem_map.2 _, h, rfl
theorem forall_mem_map {f : α β} {l : Array α} {P : β Prop} :
( (i) (_ : i l.map f), P i) (j) (_ : j l), P (f j) := by
simp
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
cases l <;> simp_all
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
theorem map_inj : map f = map g f = g := by
constructor
· 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
@[simp] theorem map_map {f : α β} {g : β γ} {as : Array α} :
(as.map f).map g = as.map (g f) := by
cases as; simp
@[simp] theorem map_push {f : α β} {as : Array α} {x : α} :
(as.push x).map f = (as.map f).push (f x) := by
ext
· simp
· simp only [getElem_map, getElem_push, size_map]
split <;> rfl
theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
rw [mapM_eq_foldlM, foldlM_toList, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.toList]
induction arr.toList.reverse with
| nil => simp
| cons a l ih => simp [ih]
@[simp] theorem toList_mapM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
toList <$> arr.mapM f = arr.toList.mapM f := by
simp [mapM_eq_mapM_toList]
theorem mapM_map_eq_foldl (as : Array α) (f : α β) (i) :
mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
unfold mapM.map
split <;> rename_i h
· simp only [Id.bind_eq]
dsimp [foldl, Id.run, foldlM]
rw [mapM_map_eq_foldl, dif_pos (by omega), foldlM.loop, dif_pos h]
-- Calling `split` here gives a bad goal.
have : size as - i = Nat.succ (size as - i - 1) := by omega
rw [this]
simp [foldl, foldlM, Id.run, Nat.sub_add_eq]
· dsimp [foldl, Id.run, foldlM]
rw [dif_pos (by omega), foldlM.loop, dif_neg h]
rfl
termination_by as.size - i
theorem map_eq_foldl (as : Array α) (f : α β) :
as.map f = as.foldl (fun r a => r.push (f a)) #[] :=
mapM_map_eq_foldl _ _ _
theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-- This is a duplicate of `List.toArray_toList`.
-- It's confusing to guess which namespace this theorem should live in,
-- so we provide both.
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[deprecated size_toArray (since := "2024-12-11")]
theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
/-- A more efficient version of `arr.toList.reverse`. -/
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp)
@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) :
@@ -1178,6 +1094,7 @@ theorem foldl_toList_eq_map (l : List α) (acc : Array β) (G : α → β) :
(l.foldl (fun acc a => acc.push (G a)) acc).toList = acc.toList ++ l.map G := by
induction l generalizing acc <;> simp [*]
/-! # uset -/
attribute [simp] uset
@@ -1353,16 +1270,18 @@ theorem get_set (a : Array α) (i : Nat) (hi : i < a.size) (j : Nat) (hj : j < a
(h : i j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
simp only [set, getElem_toList, List.getElem_set_ne h]
private theorem fin_cast_val (e : n = n') (i : Fin n) : e i = i.1, e i.2 := by cases e; rfl
theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
simp [swap]
simp [swap, fin_cast_val]
@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
(a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
theorem getElem?_swap (a : Array α) (i j : Nat) (hi hj) (k : Nat) : (a.swap i j hi hj)[k]? =
if j = k then some a[i] else if i = k then some a[j] else a[k]? := by
simp [swap_def, get?_set]
simp [swap_def, get?_set, getElem_fin_eq_getElem_toList]
@[simp] theorem swapAt_def (a : Array α) (i : Nat) (v : α) (hi) :
a.swapAt i v hi = (a[i], a.set i v) := rfl
@@ -1477,90 +1396,6 @@ theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Arra
true_and, Nat.not_lt] at h
rw [List.getElem?_eq_none_iff.2 _, List.getElem?_eq_none_iff.2 (a.toList.length_reverse _)]
end Array
open Array
namespace List
@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
apply ext'
simp only [toList_reverse]
end List
namespace Array
/-! ### foldlM and foldrM -/
theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : Array α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
cases l
cases l'
rw [List.append_toArray]
simp
/-- Variant of `foldM_append` with `h : stop = (l ++ l').size`. -/
@[simp] theorem foldlM_append' [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : Array α)
(h : stop = (l ++ l').size) :
(l ++ l').foldlM f b 0 stop = l.foldlM f b >>= l'.foldlM f := by
subst h
rw [foldlM_append]
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
/--
Variant of `foldrM_push` with `h : start = arr.size + 1`
rather than `(arr.push a).size` as the argument.
-/
@[simp] theorem foldrM_push' [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α)
{start} (h : start = arr.size + 1) :
(arr.push a).foldrM f init start = f a init >>= arr.foldrM f := by
simp [ foldrM_push, h]
theorem foldl_eq_foldlM (f : β α β) (b) (l : Array α) :
l.foldl f b = l.foldlM (m := Id) f b := by
cases l
simp [List.foldl_eq_foldlM]
theorem foldr_eq_foldrM (f : α β β) (b) (l : Array α) :
l.foldr f b = l.foldrM (m := Id) f b := by
cases l
simp [List.foldr_eq_foldrM]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : Array α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : Array α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
theorem foldr_push (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
/--
Variant of `foldr_push` with the `h : start = arr.size + 1`
rather than `(arr.push a).size` as the argument.
-/
@[simp] theorem foldr_push' (f : α β β) (init : β) (arr : Array α) (a : α) {start}
(h : start = arr.size + 1) : (arr.push a).foldr f init start = arr.foldr f (f a init) :=
foldrM_push' _ _ _ _ h
@[simp] theorem foldl_push_eq_append (l l' : Array α) : l.foldl push l' = l' ++ l := by
cases l
cases l'
simp
@[simp] theorem foldr_flip_push_eq_append (l l' : Array α) :
l.foldr (fun x y => push y x) l' = l' ++ l.reverse := by
cases l
cases l'
simp
/-! ### take -/
@[simp] theorem size_take_loop (a : Array α) (n : Nat) : (take.loop n a).size = a.size - n := by
@@ -1673,6 +1508,22 @@ theorem foldr_congr {as bs : Array α} (h₀ : as = bs) {f g : α → β → β}
as.foldr f a start stop = bs.foldr g b start' stop' := by
congr
theorem foldl_eq_foldlM (f : β α β) (b) (l : Array α) :
l.foldl f b = l.foldlM (m := Id) f b := by
cases l
simp [List.foldl_eq_foldlM]
theorem foldr_eq_foldrM (f : α β β) (b) (l : Array α) :
l.foldr f b = l.foldrM (m := Id) f b := by
cases l
simp [List.foldr_eq_foldrM]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : Array α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : Array α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : Array β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
cases l
@@ -1687,13 +1538,45 @@ theorem foldr_hom (f : β₁ → β₂) (g₁ : α → β₁ → β₁) (g₂ :
/-! ### map -/
@[simp] theorem map_pop {f : α β} {as : Array α} :
as.pop.map f = (as.map f).pop := by
ext
· simp
· simp only [getElem_map, getElem_pop, size_map]
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
simp only [mem_def, toList_map, List.mem_map]
theorem exists_of_mem_map (h : b map f l) : a, a l f a = b := mem_map.1 h
theorem mem_map_of_mem (f : α β) (h : a l) : f a map f l := mem_map.2 _, h, rfl
theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
rw [mapM_eq_foldlM, foldlM_toList, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.toList]
induction arr.toList.reverse with
| nil => simp
| cons a l ih => simp [ih]
@[simp] theorem toList_mapM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
toList <$> arr.mapM f = arr.toList.mapM f := by
simp [mapM_eq_mapM_toList]
theorem mapM_map_eq_foldl (as : Array α) (f : α β) (i) :
mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
unfold mapM.map
split <;> rename_i h
· simp only [Id.bind_eq]
dsimp [foldl, Id.run, foldlM]
rw [mapM_map_eq_foldl, dif_pos (by omega), foldlM.loop, dif_pos h]
-- Calling `split` here gives a bad goal.
have : size as - i = Nat.succ (size as - i - 1) := by omega
rw [this]
simp [foldl, foldlM, Id.run, Nat.sub_add_eq]
· dsimp [foldl, Id.run, foldlM]
rw [dif_pos (by omega), foldlM.loop, dif_neg h]
rfl
termination_by as.size - i
theorem map_eq_foldl (as : Array α) (f : α β) :
as.map f = as.foldl (fun r a => r.push (f a)) #[] :=
mapM_map_eq_foldl _ _ _
@[deprecated "Use `toList_map` or `List.map_toArray` to characterize `Array.map`." (since := "2025-01-06")]
theorem map_induction (as : Array α) (f : α β) (motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop) (hs : i, motive i.1 p i (f as[i]) motive (i+1)) :
motive as.size
@@ -1721,13 +1604,36 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
simp only [show j = i by omega]
exact (hs _ m).1
set_option linter.deprecated false in
@[deprecated "Use `toList_map` or `List.map_toArray` to characterize `Array.map`." (since := "2025-01-06")]
theorem map_spec (as : Array α) (f : α β) (p : Fin as.size β Prop)
(hs : i, p i (f as[i])) :
eq : (as.map f).size = as.size, i h, p i, h ((as.map f)[i]) := by
simpa using map_induction as f (fun _ => True) trivial p (by simp_all)
@[simp] theorem getElem_map (f : α β) (as : Array α) (i : Nat) (h) :
(as.map f)[i] = f (as[i]'(size_map .. h)) := by
have := map_spec as f (fun i b => b = f (as[i]))
simp only [implies_true, true_implies] at this
obtain eq, w := this
apply w
simp_all
@[simp] theorem getElem?_map (f : α β) (as : Array α) (i : Nat) :
(as.map f)[i]? = as[i]?.map f := by
simp [getElem?_def]
@[simp] theorem map_push {f : α β} {as : Array α} {x : α} :
(as.push x).map f = (as.map f).push (f x) := by
ext
· simp
· simp only [getElem_map, getElem_push, size_map]
split <;> rfl
@[simp] theorem map_pop {f : α β} {as : Array α} :
as.pop.map f = (as.map f).pop := by
ext
· simp
· simp only [getElem_map, getElem_pop, size_map]
/-! ### modify -/
@[simp] theorem size_modify (a : Array α) (i : Nat) (f : α α) : (a.modify i f).size = a.size := by
@@ -2214,6 +2120,10 @@ theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
rw [size_toArray, mapM'_cons, foldlM_toArray]
simp [ih]
@[simp] theorem map_toArray (f : α β) (l : List α) : l.toArray.map f = (l.map f).toArray := by
apply ext'
simp
theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
l.toArray.uset i a h = (l.set i.toNat a).toArray := by simp
@@ -2222,6 +2132,10 @@ theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray
apply ext'
simp
@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
apply ext'
simp
@[simp] theorem modify_toArray (f : α α) (l : List α) :
l.toArray.modify i f = (l.modify f i).toArray := by
apply ext'
@@ -2315,6 +2229,29 @@ namespace Array
/-! ### map -/
@[simp] theorem map_map {f : α β} {g : β γ} {as : Array α} :
(as.map f).map g = as.map (g f) := by
cases as; simp
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (as : Array α) : map (id : α α) as = as := by
cases as <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (as : Array α) : map (fun (a : α) => a) as = as := map_id as
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (as : Array α) : map f as = as := by
simp [show f = id from funext h]
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)

View File

@@ -785,19 +785,6 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
unfold allOnes
simp
@[simp] theorem toInt_allOnes : (allOnes w).toInt = if 0 < w then -1 else 0 := by
norm_cast
by_cases h : w = 0
· subst h
simp
· have : 1 < 2 ^ w := by simp [h]
simp [BitVec.toInt]
omega
@[simp] theorem toFin_allOnes : (allOnes w).toFin = Fin.ofNat' (2^w) (2^w - 1) := by
ext
simp
@[simp] theorem getLsbD_allOnes : (allOnes v).getLsbD i = decide (i < v) := by
simp [allOnes]
@@ -1155,16 +1142,11 @@ theorem getMsb_not {x : BitVec w} :
/-! ### shiftLeft -/
@[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
(x <<< n).toNat = x.toNat <<< n % 2^v :=
BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v :=
BitVec.toNat_ofNat _ _
@[simp] theorem toInt_shiftLeft {x : BitVec w} :
(x <<< n).toInt = (x.toNat <<< n : Int).bmod (2^w) := by
rw [toInt_eq_toNat_bmod, toNat_shiftLeft, Nat.shiftLeft_eq]
simp
@[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) :
(x <<< n).toFin = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
BitVec.toFin (x <<< n) = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
@[simp]
theorem shiftLeft_zero (x : BitVec w) : x <<< 0 = x := by
@@ -2395,54 +2377,6 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
omega
/-! ### fill -/
@[simp]
theorem getLsbD_fill {w i : Nat} {v : Bool} :
(fill w v).getLsbD i = (v && decide (i < w)) := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem getMsbD_fill {w i : Nat} {v : Bool} :
(fill w v).getMsbD i = (v && decide (i < w)) := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem getElem_fill {w i : Nat} {v : Bool} (h : i < w) :
(fill w v)[i] = v := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem msb_fill {w : Nat} {v : Bool} :
(fill w v).msb = (v && decide (0 < w)) := by
simp [BitVec.msb]
theorem fill_eq {w : Nat} {v : Bool} : fill w v = if v = true then allOnes w else 0#w := by
by_cases h : v <;> (simp only [h] ; ext ; simp)
@[simp]
theorem fill_true {w : Nat} : fill w true = allOnes w := by
simp [fill_eq]
@[simp]
theorem fill_false {w : Nat} : fill w false = 0#w := by
simp [fill_eq]
@[simp] theorem fill_toNat {w : Nat} {v : Bool} :
(fill w v).toNat = if v = true then 2^w - 1 else 0 := by
by_cases h : v <;> simp [h]
@[simp] theorem fill_toInt {w : Nat} {v : Bool} :
(fill w v).toInt = if v = true && 0 < w then -1 else 0 := by
by_cases h : v <;> simp [h]
@[simp] theorem fill_toFin {w : Nat} {v : Bool} :
(fill w v).toFin = if v = true then (allOnes w).toFin else Fin.ofNat' (2 ^ w) 0 := by
by_cases h : v <;> simp [h]
/-! ### mul -/
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl

View File

@@ -534,13 +534,6 @@ theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by
@[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by
conv => rhs; rw [ emod_add_ediv a b, add_mul_emod_self_left]
@[simp] theorem emod_sub_emod (m n k : Int) : (m % n - k) % n = (m - k) % n :=
Int.emod_add_emod m n (-k)
@[simp] theorem sub_emod_emod (m n k : Int) : (m - n % k) % k = (m - n) % k := by
apply (emod_add_cancel_right (n % k)).mp
rw [Int.sub_add_cancel, Int.add_emod_emod, Int.sub_add_cancel]
theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by
apply (emod_add_cancel_right b).mp
rw [Int.sub_add_cancel, Int.add_emod_emod, Int.sub_add_cancel, emod_emod]
@@ -1105,32 +1098,6 @@ theorem bmod_def (x : Int) (m : Nat) : bmod x m =
(x % m) - m :=
rfl
theorem bdiv_add_bmod (x : Int) (m : Nat) : m * bdiv x m + bmod x m = x := by
unfold bdiv bmod
split
· simp_all only [Nat.cast_ofNat_Int, Int.mul_zero, emod_zero, Int.zero_add, Int.sub_zero,
ite_self]
· dsimp only
split
· exact ediv_add_emod x m
· rw [Int.mul_add, Int.mul_one, Int.add_assoc, Int.add_comm m, Int.sub_add_cancel]
exact ediv_add_emod x m
theorem bmod_add_bdiv (x : Int) (m : Nat) : bmod x m + m * bdiv x m = x := by
rw [Int.add_comm]; exact bdiv_add_bmod x m
theorem bdiv_add_bmod' (x : Int) (m : Nat) : bdiv x m * m + bmod x m = x := by
rw [Int.mul_comm]; exact bdiv_add_bmod x m
theorem bmod_add_bdiv' (x : Int) (m : Nat) : bmod x m + bdiv x m * m = x := by
rw [Int.add_comm]; exact bdiv_add_bmod' x m
theorem bmod_eq_self_sub_mul_bdiv (x : Int) (m : Nat) : bmod x m = x - m * bdiv x m := by
rw [ Int.add_sub_cancel (bmod x m), bmod_add_bdiv]
theorem bmod_eq_self_sub_bdiv_mul (x : Int) (m : Nat) : bmod x m = x - bdiv x m * m := by
rw [ Int.add_sub_cancel (bmod x m), bmod_add_bdiv']
theorem bmod_pos (x : Int) (m : Nat) (p : x % m < (m + 1) / 2) : bmod x m = x % m := by
simp [bmod_def, p]

View File

@@ -757,6 +757,207 @@ theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l
| nil => simp
| cons b l₂ => simp [isEqv, ih]
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β α m β) (b) :
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : List α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
induction l generalizing b <;> simp [*]
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α β m β) (b) :
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
simp only [foldrM]
induction l <;> simp_all
theorem foldl_eq_foldlM (f : β α β) (b) (l : List α) :
l.foldl f b = l.foldlM (m := Id) f b := by
induction l generalizing b <;> simp [*, foldl]
theorem foldr_eq_foldrM (f : α β β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : List α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : List α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
induction l <;> simp [*]
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
induction l generalizing l' <;> simp [*]
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
theorem foldl_map (f : β₁ β₂) (g : α β₂ α) (l : List β₁) (init : α) :
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
induction l generalizing init <;> simp [*]
theorem foldr_map (f : α₁ α₂) (g : α₂ β β) (l : List α₁) (init : β) :
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
induction l generalizing init <;> simp [*]
theorem foldl_filterMap (f : α Option β) (g : γ β γ) (l : List α) (init : γ) :
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldl_cons]
cases f a <;> simp [ih]
theorem foldr_filterMap (f : α Option β) (g : β γ γ) (l : List α) (init : γ) :
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldr_cons]
cases f a <;> simp [ih]
theorem foldl_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldr_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldl_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldl_cons, ha.assoc]
rw [foldl_assoc]
theorem foldr_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldr_cons, ha.assoc]
rw [foldr_assoc]
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : List β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
induction l generalizing init <;> simp [*, H]
theorem foldr_hom (f : β₁ β₂) (g₁ : α β₁ β₁) (g₂ : α β₂ β₂) (l : List α) (init : β₁)
(H : x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
induction l <;> simp [*, H]
/--
Prove a proposition about the result of `List.foldl`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldlRecOn {motive : β Sort _} : (l : List α) (op : β α β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op b a)), motive (List.foldl op b l)
| [], _, _, hb, _ => hb
| hd :: tl, op, b, hb, hl =>
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
@[simp] theorem foldlRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op b a)) :
foldlRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldlRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op b a)) :
foldlRecOn (x :: l) op b hb hl =
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
rfl
/--
Prove a proposition about the result of `List.foldr`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldrRecOn {motive : β Sort _} : (l : List α) (op : α β β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op a b)), motive (List.foldr op b l)
| nil, _, _, hb, _ => hb
| x :: l, op, b, hb, hl =>
hl (foldr op b l)
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
@[simp] theorem foldrRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op a b)) :
foldrRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldrRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op a b)) :
foldrRecOn (x :: l) op b hb hl =
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
x (mem_cons_self x l) :=
rfl
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldl_rel {l : List α} {f g : β α β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f c a) (g c' a)) :
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldl_cons]
apply ih
· simp_all
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldr_rel {l : List α} {f g : α β β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f a c) (g a c')) :
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldr_cons]
apply h'
· simp
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
l.foldl (fun x _ => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
Nat.add_comm a]
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
l.foldr (fun _ x => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
/-! ### getLast -/
theorem getLast_eq_getElem : (l : List α) (h : l []),
@@ -1015,6 +1216,27 @@ theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then n
/-! ### map -/
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : List α) : map (id : α α) l = l := by
induction l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : List α) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f [a] = [f a] := rfl
@[simp] theorem length_map (as : List α) (f : α β) : (as.map f).length = as.length := by
induction as with
| nil => simp [List.map]
@@ -1040,27 +1262,6 @@ theorem get_map (f : α → β) {l i} :
get (map f l) i = f (get l i, length_map l f i.2) := by
simp
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : List α) : map (id : α α) l = l := by
induction l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : List α) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f [a] = [f a] := rfl
@[simp] theorem mem_map {f : α β} : {l : List α}, b l.map f a, a l f a = b
| [] => by simp
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
@@ -1760,6 +1961,16 @@ theorem set_append {s t : List α} :
(s ++ t).set i x = s ++ t.set (i - s.length) x := by
rw [set_append, if_neg (by simp_all)]
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α β m β) (b) (l l' : List α) :
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
induction l <;> simp [*]
@[simp] theorem foldl_append {β : Type _} (f : β α β) (b) (l l' : List α) :
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
@[simp] theorem foldr_append (f : α β β) (b) (l l' : List α) :
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
theorem filterMap_eq_append_iff {f : α Option β} :
filterMap f l = L₁ ++ L₂ l₁ l₂, l = l₁ ++ l₂ filterMap f l₁ = L₁ filterMap f l₂ = L₂ := by
constructor
@@ -1908,6 +2119,14 @@ theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun
-- `getLast?_flatten` is proved later, after the `reverse` section.
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
theorem foldl_flatten (f : β α β) (b : β) (L : List (List α)) :
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
induction L generalizing b <;> simp_all
theorem foldr_flatten (f : α β β) (b : β) (L : List (List α)) :
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
induction L <;> simp_all
@[simp] theorem map_flatten (f : α β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
induction L <;> simp_all
@@ -2480,114 +2699,10 @@ theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.fla
@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
reverseAux_eq_append ..
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
eq_replicate_iff.2
by rw [length_reverse, length_replicate],
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : List α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
induction l generalizing b <;> simp [*]
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α β m β) (b) :
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
simp only [foldrM]
induction l <;> simp_all
theorem foldl_eq_foldlM (f : β α β) (b) (l : List α) :
l.foldl f b = l.foldlM (m := Id) f b := by
induction l generalizing b <;> simp [*, foldl]
theorem foldr_eq_foldrM (f : α β β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : List α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : List α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β α m β) (b) :
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α β m β) (b) :
l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
(foldlM_reverse ..).symm.trans <| by simp
/-! ### foldl and foldr -/
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
induction l <;> simp [*]
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
induction l generalizing l' <;> simp [*]
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
theorem foldl_map (f : β₁ β₂) (g : α β₂ α) (l : List β₁) (init : α) :
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
induction l generalizing init <;> simp [*]
theorem foldr_map (f : α₁ α₂) (g : α₂ β β) (l : List α₁) (init : β) :
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
induction l generalizing init <;> simp [*]
theorem foldl_filterMap (f : α Option β) (g : γ β γ) (l : List α) (init : γ) :
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldl_cons]
cases f a <;> simp [ih]
theorem foldr_filterMap (f : α Option β) (g : β γ γ) (l : List α) (init : γ) :
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldr_cons]
cases f a <;> simp [ih]
theorem foldl_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldr_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
induction l generalizing a
· simp
· simp [*, h]
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α β m β) (b) (l l' : List α) :
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
induction l <;> simp [*]
@[simp] theorem foldl_append {β : Type _} (f : β α β) (b) (l l' : List α) :
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
@[simp] theorem foldr_append (f : α β β) (b) (l l' : List α) :
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
theorem foldl_flatten (f : β α β) (b : β) (L : List (List α)) :
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
induction L generalizing b <;> simp_all
theorem foldr_flatten (f : α β β) (b : β) (L : List (List α)) :
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
induction L <;> simp_all
@[simp] theorem foldl_reverse (l : List α) (f : β α β) (b) :
l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
@@ -2601,127 +2716,10 @@ theorem foldl_eq_foldr_reverse (l : List α) (f : β → α → β) (b) :
theorem foldr_eq_foldl_reverse (l : List α) (f : α β β) (b) :
l.foldr f b = l.reverse.foldl (fun x y => f y x) b := by simp
theorem foldl_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldl_cons, ha.assoc]
rw [foldl_assoc]
theorem foldr_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldr_cons, ha.assoc]
rw [foldr_assoc]
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : List β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
induction l generalizing init <;> simp [*, H]
theorem foldr_hom (f : β₁ β₂) (g₁ : α β₁ β₁) (g₂ : α β₂ β₂) (l : List α) (init : β₁)
(H : x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
induction l <;> simp [*, H]
/--
Prove a proposition about the result of `List.foldl`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldlRecOn {motive : β Sort _} : (l : List α) (op : β α β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op b a)), motive (List.foldl op b l)
| [], _, _, hb, _ => hb
| hd :: tl, op, b, hb, hl =>
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
@[simp] theorem foldlRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op b a)) :
foldlRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldlRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op b a)) :
foldlRecOn (x :: l) op b hb hl =
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
rfl
/--
Prove a proposition about the result of `List.foldr`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldrRecOn {motive : β Sort _} : (l : List α) (op : α β β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op a b)), motive (List.foldr op b l)
| nil, _, _, hb, _ => hb
| x :: l, op, b, hb, hl =>
hl (foldr op b l)
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
@[simp] theorem foldrRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op a b)) :
foldrRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldrRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op a b)) :
foldrRecOn (x :: l) op b hb hl =
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
x (mem_cons_self x l) :=
rfl
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldl_rel {l : List α} {f g : β α β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f c a) (g c' a)) :
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldl_cons]
apply ih
· simp_all
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldr_rel {l : List α} {f g : α β β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f a c) (g a c')) :
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldr_cons]
apply h'
· simp
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
l.foldl (fun x _ => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
Nat.add_comm a]
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
l.foldr (fun _ x => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
eq_replicate_iff.2
by rw [length_reverse, length_replicate],
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)
/-! #### Further results about `getLast` and `getLast?` -/

View File

@@ -510,18 +510,4 @@ theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
refine (IH₁ H).trans (IH₂ ((p₁.pairwise_iff ?_).1 H))
exact fun h h₁ h₂ => h h₂ h₁
theorem perm_insertIdx {α} (x : α) (l : List α) {n} (h : n l.length) :
insertIdx n x l ~ x :: l := by
induction l generalizing n with
| nil =>
cases n with
| zero => rfl
| succ => cases h
| cons _ _ ih =>
cases n with
| zero => simp [insertIdx]
| succ =>
simp only [insertIdx, modifyTailIdx]
refine .trans (.cons _ (ih (Nat.le_of_succ_le_succ h))) (.swap ..)
end List

View File

@@ -253,10 +253,6 @@ theorem merge_perm_append : ∀ {xs ys : List α}, merge xs ys le ~ xs ++ ys
· exact (merge_perm_append.cons y).trans
((Perm.swap x y _).trans (perm_middle.symm.cons x))
theorem Perm.merge (s₁ s₂ : α α Bool) (hl : l₁ ~ l₂) (hr : r₁ ~ r₂) :
merge l₁ r₁ s₁ ~ merge l₂ r₂ s₂ :=
Perm.trans (merge_perm_append ..) <| Perm.trans (Perm.append hl hr) <| Perm.symm (merge_perm_append ..)
/-! ### mergeSort -/
@[simp] theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]

View File

@@ -136,18 +136,6 @@ This will perform the update destructively provided that the vector has a refere
@[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
v.toArray.set! i x, by simp
@[inline] def foldlM [Monad m] (f : β α m β) (b : β) (v : Vector α n) : m β :=
v.toArray.foldlM f b
@[inline] def foldrM [Monad m] (f : α β m β) (b : β) (v : Vector α n) : m β :=
v.toArray.foldrM f b
@[inline] def foldl (f : β α β) (b : β) (v : Vector α n) : β :=
v.toArray.foldl f b
@[inline] def foldr (f : α β β) (b : β) (v : Vector α n) : β :=
v.toArray.foldr f b
/-- Append two vectors. -/
@[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) :=
v.toArray ++ w.toArray, by simp

View File

@@ -66,18 +66,6 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem back?_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).back? = a.back? := rfl
@[simp] theorem foldlM_mk [Monad m] (f : β α m β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldlM f b = a.foldlM f b := rfl
@[simp] theorem foldrM_mk [Monad m] (f : α β m β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldrM f b = a.foldrM f b := rfl
@[simp] theorem foldl_mk (f : β α β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldl f b = a.foldl f b := rfl
@[simp] theorem foldr_mk (f : α β β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldr f b = a.foldr f b := rfl
@[simp] theorem drop_mk (a : Array α) (h : a.size = n) (m) :
(Vector.mk a h).drop m = Vector.mk (a.extract m a.size) (by simp [h]) := rfl
@@ -1037,13 +1025,6 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
/-! ### map -/
@[simp] theorem getElem_map (f : α β) (a : Vector α n) (i : Nat) (hi : i < n) :
(a.map f)[i] = f a[i] := by
cases a
simp
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
@@ -1107,6 +1088,13 @@ theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h :
cases a
simp
/-! ### map -/
@[simp] theorem getElem_map (f : α β) (a : Vector α n) (i : Nat) (hi : i < n) :
(a.map f)[i] = f a[i] := by
cases a
simp
/-! ### zipWith -/
@[simp] theorem getElem_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) (i : Nat)
@@ -1115,37 +1103,6 @@ theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h :
cases b
simp
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l : Vector α n) (l' : Vector α n') :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
cases l
cases l'
simp
@[simp] theorem foldrM_push [Monad m] (f : α β m β) (init : β) (l : Vector α n) (a : α) :
(l.push a).foldrM f init = f a init >>= l.foldrM f := by
cases l
simp
theorem foldl_eq_foldlM (f : β α β) (b) (l : Vector α n) :
l.foldl f b = l.foldlM (m := Id) f b := by
cases l
simp [Array.foldl_eq_foldlM]
theorem foldr_eq_foldrM (f : α β β) (b) (l : Vector α n) :
l.foldr f b = l.foldrM (m := Id) f b := by
cases l
simp [Array.foldr_eq_foldrM]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : Vector α n) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : Vector α n) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
/-! ### take -/
@[simp] theorem take_size (a : Vector α n) : a.take n = a.cast (by simp) := by

View File

@@ -10,4 +10,3 @@ import Init.Grind.Lemmas
import Init.Grind.Cases
import Init.Grind.Propagator
import Init.Grind.Util
import Init.Grind.Offset

View File

@@ -25,9 +25,6 @@ theorem and_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a ∧ b) = Fals
theorem eq_true_of_and_eq_true_left {a b : Prop} (h : (a b) = True) : a = True := by simp_all
theorem eq_true_of_and_eq_true_right {a b : Prop} (h : (a b) = True) : b = True := by simp_all
theorem or_of_and_eq_false {a b : Prop} (h : (a b) = False) : (¬a ¬b) := by
by_cases a <;> by_cases b <;> simp_all
/-! Or -/
theorem or_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a b) = True := by simp [h]
@@ -38,15 +35,6 @@ theorem or_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a b) = a :=
theorem eq_false_of_or_eq_false_left {a b : Prop} (h : (a b) = False) : a = False := by simp_all
theorem eq_false_of_or_eq_false_right {a b : Prop} (h : (a b) = False) : b = False := by simp_all
/-! Implies -/
theorem imp_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a b) = True := by simp [h]
theorem imp_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a b) = True := by simp [h]
theorem imp_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a b) = b := by simp [h]
theorem eq_true_of_imp_eq_false {a b : Prop} (h : (a b) = False) : a = True := by simp_all
theorem eq_false_of_imp_eq_false {a b : Prop} (h : (a b) = False) : b = False := by simp_all
/-! Not -/
theorem not_eq_of_eq_true {a : Prop} (h : a = True) : (Not a) = False := by simp [h]
@@ -73,28 +61,4 @@ theorem forall_propagator (p : Prop) (q : p → Prop) (q' : Prop) (h₁ : p = Tr
· intro h'; exact Eq.mp h₂ (h' (of_eq_true h₁))
· intro h'; intros; exact Eq.mpr h₂ h'
theorem of_forall_eq_false (α : Sort u) (p : α Prop) (h : ( x : α, p x) = False) : x : α, ¬ p x := by simp_all
/-! dite -/
theorem dite_cond_eq_true' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c α} {b : ¬ c α} {r : α} (h₁ : c = True) (h₂ : a (of_eq_true h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
theorem dite_cond_eq_false' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c α} {b : ¬ c α} {r : α} (h₁ : c = False) (h₂ : b (of_eq_false h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
/-! Casts -/
theorem eqRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : (x : α) a = x Sort u_1} (v : motive a (Eq.refl a)) {b : α} (h : a = b)
: HEq (@Eq.rec α a motive v b h) v := by
subst h; rfl
theorem eqRecOn_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : (x : α) a = x Sort u_1} {b : α} (h : a = b) (v : motive a (Eq.refl a))
: HEq (@Eq.recOn α a motive b h v) v := by
subst h; rfl
theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : α Sort u_1} (v : motive a) {b : α} (h : a = b)
: HEq (@Eq.ndrec α a motive v b h) v := by
subst h; rfl
end Lean.Grind

View File

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
-/
prelude
import Init.SimpLemmas
import Init.PropLemmas
import Init.Classical
import Init.ByCases
@@ -41,10 +40,9 @@ attribute [grind_norm] not_true
-- False
attribute [grind_norm] not_false_eq_true
-- Remark: we disabled the following normalization rule because we want this information when implementing splitting heuristics
-- Implication as a clause
-- @[grind_norm↓] theorem imp_eq (p q : Prop) : (p → q) = (¬ p q) := by
-- by_cases p <;> by_cases q <;> simp [*]
@[grind_norm] theorem imp_eq (p q : Prop) : (p q) = (¬ p q) := by
by_cases p <;> by_cases q <;> simp [*]
-- And
@[grind_norm] theorem not_and (p q : Prop) : (¬(p q)) = (¬p ¬q) := by
@@ -60,19 +58,13 @@ attribute [grind_norm] ite_true ite_false
@[grind_norm] theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
by_cases p <;> simp [*]
@[grind_norm] theorem ite_true_false {_ : Decidable p} : (ite p True False) = p := by
by_cases p <;> simp
@[grind_norm] theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
by_cases p <;> simp
-- Forall
@[grind_norm] theorem not_forall (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] forall_and
-- Exists
@[grind_norm] theorem not_exists (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] exists_const exists_or exists_prop exists_and_left exists_and_right
attribute [grind_norm] exists_const exists_or
-- Bool cond
@[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
@@ -115,7 +107,4 @@ attribute [grind_norm] Nat.le_zero_eq
-- GT GE
attribute [grind_norm] GT.gt GE.ge
-- Succ
attribute [grind_norm] Nat.succ_eq_add_one
end Lean.Grind

View File

@@ -1,132 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.Omega
namespace Lean.Grind
abbrev Var := Nat
abbrev Context := Lean.RArray Nat
def fixedVar := 100000000 -- Any big number should work here
def Var.denote (ctx : Context) (v : Var) : Nat :=
bif v == fixedVar then 1 else ctx.get v
structure Cnstr where
x : Var
y : Var
k : Nat := 0
l : Bool := true
deriving Repr, BEq, Inhabited
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
def trivialCnstr : Cnstr := { x := 0, y := 0, k := 0, l := true }
@[simp] theorem denote_trivial (ctx : Context) : trivialCnstr.denote ctx := by
simp [Cnstr.denote, trivialCnstr]
def Cnstr.trans (c₁ c₂ : Cnstr) : Cnstr :=
if c₁.y = c₂.x then
let { x, k := k₁, l := l₁, .. } := c₁
let { y, k := k₂, l := l₂, .. } := c₂
match l₁, l₂ with
| false, false =>
{ x, y, k := k₁ + k₂, l := false }
| false, true =>
if k₁ < k₂ then
{ x, y, k := k₂ - k₁, l := true }
else
{ x, y, k := k₁ - k₂, l := false }
| true, false =>
if k₁ < k₂ then
{ x, y, k := k₂ - k₁, l := false }
else
{ x, y, k := k₁ - k₂, l := true }
| true, true =>
{ x, y, k := k₁ + k₂, l := true }
else
trivialCnstr
@[simp] theorem Cnstr.denote_trans_easy (ctx : Context) (c₁ c₂ : Cnstr) (h : c₁.y c₂.x) : (c₁.trans c₂).denote ctx := by
simp [*, Cnstr.trans]
@[simp] theorem Cnstr.denote_trans (ctx : Context) (c₁ c₂ : Cnstr) : c₁.denote ctx c₂.denote ctx (c₁.trans c₂).denote ctx := by
by_cases c₁.y = c₂.x
case neg => simp [*]
simp [trans, *]
let { x, k := k₁, l := l₁, .. } := c₁
let { y, k := k₂, l := l₂, .. } := c₂
simp_all; split
· simp [denote]; omega
· split <;> simp [denote] <;> omega
· split <;> simp [denote] <;> omega
· simp [denote]; omega
def Cnstr.isTrivial (c : Cnstr) : Bool := c.x == c.y && c.k == 0
theorem Cnstr.of_isTrivial (ctx : Context) (c : Cnstr) : c.isTrivial = true c.denote ctx := by
cases c; simp [isTrivial]; intros; simp [*, denote]
def Cnstr.isFalse (c : Cnstr) : Bool := c.x == c.y && c.k != 0 && c.l == true
theorem Cnstr.of_isFalse (ctx : Context) {c : Cnstr} : c.isFalse = true ¬c.denote ctx := by
cases c; simp [isFalse]; intros; simp [*, denote]; omega
def Certificate := List Cnstr
def Certificate.denote' (ctx : Context) (c₁ : Cnstr) (c₂ : Certificate) : Prop :=
match c₂ with
| [] => c₁.denote ctx
| c::cs => c₁.denote ctx Certificate.denote' ctx c cs
theorem Certificate.denote'_trans (ctx : Context) (c₁ c : Cnstr) (cs : Certificate) : c₁.denote ctx denote' ctx c cs denote' ctx (c₁.trans c) cs := by
induction cs
next => simp [denote', *]; apply Cnstr.denote_trans
next c cs ih => simp [denote']; intros; simp [*]
def Certificate.trans' (c₁ : Cnstr) (c₂ : Certificate) : Cnstr :=
match c₂ with
| [] => c₁
| c::c₂ => trans' (c₁.trans c) c₂
@[simp] theorem Certificate.denote'_trans' (ctx : Context) (c₁ : Cnstr) (c₂ : Certificate) : denote' ctx c₁ c₂ (trans' c₁ c₂).denote ctx := by
induction c₂ generalizing c₁
next => intros; simp_all [trans', denote']
next c cs ih => simp [denote']; intros; simp [trans']; apply ih; apply denote'_trans <;> assumption
def Certificate.denote (ctx : Context) (c : Certificate) : Prop :=
match c with
| [] => True
| c::cs => denote' ctx c cs
def Certificate.trans (c : Certificate) : Cnstr :=
match c with
| [] => trivialCnstr
| c::cs => trans' c cs
theorem Certificate.denote_trans {ctx : Context} {c : Certificate} : c.denote ctx c.trans.denote ctx := by
cases c <;> simp [*, trans, Certificate.denote] <;> intros <;> simp [*]
def Certificate.isFalse (c : Certificate) : Bool :=
c.trans.isFalse
theorem Certificate.unsat (ctx : Context) (c : Certificate) : c.isFalse = true ¬ c.denote ctx := by
simp [isFalse]; intro h₁ h₂
have := Certificate.denote_trans h₂
have := Cnstr.of_isFalse ctx h₁
contradiction
theorem Certificate.imp (ctx : Context) (c : Certificate) : c.denote ctx c.trans.denote ctx := by
apply denote_trans
end Lean.Grind

View File

@@ -6,27 +6,20 @@ Authors: Leonardo de Moura
prelude
import Init.Tactics
namespace Lean.Parser.Attr
syntax grindEq := "="
syntax grindEqBoth := atomic("_" "=" "_")
syntax grindEqRhs := atomic("=" "_")
syntax grindBwd := ""
syntax grindFwd := ""
syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
end Lean.Parser.Attr
namespace Lean.Grind
/--
The configuration for `grind`.
Passed to `grind` using, for example, the `grind (config := { matchEqs := true })` syntax.
Passed to `grind` using, for example, the `grind (config := { eager := true })` syntax.
-/
structure Config where
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
splits : Nat := 5
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
/-- When `eager` is true (default: `false`), `grind` eagerly splits `if-then-else` and `match` expressions during internalization. -/
eager : Bool := false
/-- Maximum number of branches (i.e., case-splits) in the proof search tree. -/
splits : Nat := 100
/--
Maximum number of E-matching (aka heuristic theorem instantiation)
in a proof search tree branch.
-/
ematch : Nat := 5
/--
Maximum term generation.
@@ -35,16 +28,6 @@ structure Config where
gen : Nat := 5
/-- Maximum number of theorem instances generated using E-matching in a proof search tree branch. -/
instances : Nat := 1000
/-- If `matchEqs` is `true`, `grind` uses `match`-equations as E-matching theorems. -/
matchEqs : Bool := true
/-- If `splitMatch` is `true`, `grind` performs case-splitting on `match`-expressions during the search. -/
splitMatch : Bool := true
/-- If `splitIte` is `true`, `grind` performs case-splitting on `if-then-else` expressions during the search. -/
splitIte : Bool := true
/--
If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
splitIndPred : Bool := true
deriving Inhabited, BEq
end Lean.Grind

View File

@@ -11,22 +11,7 @@ namespace Lean.Grind
/-- A helper gadget for annotating nested proofs in goals. -/
def nestedProof (p : Prop) (h : p) : p := h
/--
Gadget for marking terms that should not be normalized by `grind`s simplifier.
`grind` uses a simproc to implement this feature.
We use it when adding instances of `match`-equations to prevent them from being simplified to true.
-/
def doNotSimp {α : Sort u} (a : α) : α := a
/-- Gadget for representing offsets `t+k` in patterns. -/
def offset (a b : Nat) : Nat := a + b
/--
Gadget for annotating the equalities in `match`-equations conclusions.
`_origin` is the term used to instantiate the `match`-equation using E-matching.
When `EqMatch a b origin` is `True`, we mark `origin` as a resolved case-split.
-/
def EqMatch (a b : α) {_origin : α} : Prop := a = b
set_option pp.proofs true
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

View File

@@ -4170,16 +4170,6 @@ def withRef [Monad m] [MonadRef m] {α} (ref : Syntax) (x : m α) : m α :=
let ref := replaceRef ref oldRef
MonadRef.withRef ref x
/--
If `ref? = some ref`, run `x : m α` with a modified value for the `ref` by calling `withRef`.
Otherwise, run `x` directly.
-/
@[always_inline, inline]
def withRef? [Monad m] [MonadRef m] {α} (ref? : Option Syntax) (x : m α) : m α :=
match ref? with
| some ref => withRef ref x
| _ => x
/-- A monad that supports syntax quotations. Syntax quotations (in term
position) are monadic values that when executed retrieve the current "macro
scope" from the monad and apply it to every identifier they introduce

View File

@@ -818,7 +818,7 @@ syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
After `with`, there is an optional tactic that runs on all branches, and
then a list of alternatives.
-/
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)*)
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
/--
Assuming `x` is a variable in the local context with an inductive type,

View File

@@ -11,22 +11,6 @@ import Init.Data.List.Impl
namespace Lean
namespace Json
set_option maxRecDepth 1024 in
/--
This table contains for each UTF-8 byte whether we need to escape a string that contains it.
-/
private def escapeTable : { xs : ByteArray // xs.size = 256 } :=
ByteArray.mk #[
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
], by rfl
private def escapeAux (acc : String) (c : Char) : String :=
-- escape ", \, \n and \r, keep all other characters ≥ 0x20 and render characters < 0x20 with \u
if c = '"' then -- hack to prevent emacs from regarding the rest of the file as a string: "
@@ -55,27 +39,8 @@ private def escapeAux (acc : String) (c : Char) : String :=
let d4 := Nat.digitChar (n % 16)
acc ++ "\\u" |>.push d1 |>.push d2 |>.push d3 |>.push d4
private def needEscape (s : String) : Bool :=
go s 0
where
go (s : String) (i : Nat) : Bool :=
if h : i < s.utf8ByteSize then
let byte := s.getUtf8Byte i h
have h1 : byte.toNat < 256 := UInt8.toNat_lt_size byte
have h2 : escapeTable.val.size = 256 := escapeTable.property
if escapeTable.val.get byte.toNat (Nat.lt_of_lt_of_eq h1 h2.symm) == 0 then
go s (i + 1)
else
true
else
false
def escape (s : String) (acc : String := "") : String :=
-- If we don't have any characters that need to be escaped we can just append right away.
if needEscape s then
s.foldl escapeAux acc
else
acc ++ s
s.foldl escapeAux acc
def renderString (s : String) (acc : String := "") : String :=
let acc := acc ++ "\""

View File

@@ -6,7 +6,6 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Lsp.Basic
import Lean.Data.Lsp.CancelParams
import Lean.Data.Lsp.Capabilities
import Lean.Data.Lsp.Client
import Lean.Data.Lsp.Communication

View File

@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.Json
import Lean.Data.JsonRpc
/-! Defines most of the 'Basic Structures' in the LSP specification
(https://microsoft.github.io/language-server-protocol/specifications/specification-current/),
@@ -18,6 +19,10 @@ namespace Lsp
open Json
structure CancelParams where
id : JsonRpc.RequestID
deriving Inhabited, BEq, ToJson, FromJson
abbrev DocumentUri := String
/-- We adopt the convention that zero-based UTF-16 positions as sent by LSP clients

View File

@@ -1,25 +0,0 @@
/-
Copyright (c) 2020 Marc Huisinga. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Lean.Data.JsonRpc
/-! # Defines `Lean.Lsp.CancelParams`.
This is separate from `Lean.Data.Lsp.Basic` to reduce transitive dependencies.
-/
namespace Lean
namespace Lsp
open Json
structure CancelParams where
id : JsonRpc.RequestID
deriving Inhabited, BEq, ToJson, FromJson
end Lsp
end Lean

View File

@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Init.Data.String
import Init.Data.Array
import Lean.Data.Lsp.Basic
import Lean.Data.Position
import Lean.DeclarationRange

View File

@@ -362,9 +362,9 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
| `(tactic| intro $h:term $hs:term*) => evalTactic ( `(tactic| intro $h:term; intro $hs:term*))
| _ => throwUnsupportedSyntax
where
introStep (ref? : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
introStep (ref : Option Syntax) (n : Name) (typeStx? : Option Syntax := none) : TacticM Unit := do
let fvarId liftMetaTacticAux fun mvarId => do
let (fvarId, mvarId) withRef? ref? <| mvarId.intro n
let (fvarId, mvarId) mvarId.intro n
pure (fvarId, [mvarId])
if let some typeStx := typeStx? then
withMainContext do
@@ -374,9 +374,9 @@ where
unless ( isDefEqGuarded type fvarType) do
throwError "type mismatch at `intro {fvar}`{← mkHasTypeButIsExpectedMsg fvarType type}"
liftMetaTactic fun mvarId => return [ mvarId.replaceLocalDeclDefEq fvarId type]
if let some ref := ref? then
if let some stx := ref then
withMainContext do
Term.addLocalVarInfo ref (mkFVar fvarId)
Term.addLocalVarInfo stx (mkFVar fvarId)
@[builtin_tactic Lean.Parser.Tactic.introMatch] def evalIntroMatch : Tactic := fun stx => do
let matchAlts := stx[1]

View File

@@ -24,8 +24,11 @@ def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t :
finally
modifyEnv Meta.instanceExtension.popScope
@[builtin_tactic Lean.Parser.Tactic.classical, builtin_incremental]
def evalClassical : Tactic := fun stx =>
classical <| Term.withNarrowedArgTacticReuse (argIdx := 1) Elab.Tactic.evalTactic stx
@[builtin_tactic Lean.Parser.Tactic.classical]
def evalClassical : Tactic := fun stx => do
match stx with
| `(tactic| classical $tacs:tacticSeq) =>
classical <| Elab.Tactic.evalTactic tacs
| _ => throwUnsupportedSyntax
end Lean.Elab.Tactic

View File

@@ -26,10 +26,8 @@ def elabGrindPattern : CommandElab := fun stx => do
let info getConstInfo declName
forallTelescope info.type fun xs _ => do
let patterns terms.getElems.mapM fun term => do
let pattern elabTerm term none
synthesizeSyntheticMVarsUsingDefault
let pattern instantiateMVars pattern
let pattern Grind.preprocessPattern pattern
let pattern instantiateMVars ( elabTerm term none)
let pattern Grind.unfoldReducible pattern
return pattern.abstract xs
Grind.addEMatchTheorem declName xs.size patterns.toList
| _ => throwUnsupportedSyntax

View File

@@ -258,11 +258,11 @@ private def saveAltVarsInfo (altMVarId : MVarId) (altStx : Syntax) (fvarIds : Ar
i := i + 1
open Language in
def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs? : Option (Array Syntax))
def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altStxs : Array Syntax)
(initialInfo : Info)
(numEqs : Nat := 0) (numGeneralized : Nat := 0) (toClear : Array FVarId := #[])
(toTag : Array (Ident × FVarId) := #[]) : TacticM Unit := do
let hasAlts := altStxs?.isSome
let hasAlts := altStxs.size > 0
if hasAlts then
-- default to initial state outside of alts
-- HACK: because this node has the same span as the original tactic,
@@ -274,7 +274,9 @@ def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altS
where
-- continuation in the correct info context
goWithInfo := do
if let some altStxs := altStxs? then
let hasAlts := altStxs.size > 0
if hasAlts then
if let some tacSnap := ( readThe Term.Context).tacSnap? then
-- incrementality: create a new promise for each alternative, resolve current snapshot to
-- them, eventually put each of them back in `Context.tacSnap?` in `applyAltStx`
@@ -307,8 +309,7 @@ where
-- continuation in the correct incrementality context
goWithIncremental (tacSnaps : Array (SnapshotBundle TacticParsedSnapshot)) := do
let hasAlts := altStxs?.isSome
let altStxs := altStxs?.getD #[]
let hasAlts := altStxs.size > 0
let mut alts := alts
-- initial sanity checks: named cases should be known, wildcards should be last
@@ -342,12 +343,12 @@ where
let altName := getAltName altStx
if let some i := alts.findFinIdx? (·.1 == altName) then
-- cover named alternative
applyAltStx tacSnaps altStxs altStxIdx altStx alts[i]
applyAltStx tacSnaps altStxIdx altStx alts[i]
alts := alts.eraseIdx i
else if !alts.isEmpty && isWildcard altStx then
-- cover all alternatives
for alt in alts do
applyAltStx tacSnaps altStxs altStxIdx altStx alt
applyAltStx tacSnaps altStxIdx altStx alt
alts := #[]
else
throwErrorAt altStx "unused alternative '{altName}'"
@@ -378,7 +379,7 @@ where
altMVarIds.forM fun mvarId => admitGoal mvarId
/-- Applies syntactic alternative to alternative goal. -/
applyAltStx tacSnaps altStxs altStxIdx altStx alt := withRef altStx do
applyAltStx tacSnaps altStxIdx altStx alt := withRef altStx do
let { name := altName, info, mvarId := altMVarId } := alt
-- also checks for unknown alternatives
let numFields getAltNumFields elimInfo altName
@@ -475,7 +476,7 @@ private def generalizeVars (mvarId : MVarId) (stx : Syntax) (targets : Array Exp
/--
Given `inductionAlts` of the form
```
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
```
Return an array containing its alternatives.
-/
@@ -485,30 +486,21 @@ private def getAltsOfInductionAlts (inductionAlts : Syntax) : Array Syntax :=
/--
Given `inductionAlts` of the form
```
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
```
runs `cont (some alts)` where `alts` is an array containing all `inductionAlt`s while disabling incremental
reuse if any other syntax changed. If there's no `with` clause, then runs `cont none`.
runs `cont alts` where `alts` is an array containing all `inductionAlt`s while disabling incremental
reuse if any other syntax changed.
-/
private def withAltsOfOptInductionAlts (optInductionAlts : Syntax)
(cont : Option (Array Syntax) TacticM α) : TacticM α :=
(cont : Array Syntax TacticM α) : TacticM α :=
Term.withNarrowedTacticReuse (stx := optInductionAlts) (fun optInductionAlts =>
if optInductionAlts.isNone then
-- if there are no alternatives, what to compare is irrelevant as there will be no reuse
(mkNullNode #[], mkNullNode #[])
else
-- if there are no alts, then use the `with` token for `inner` for a ref for messages
let altStxs := optInductionAlts[0].getArg 2
let inner := if altStxs.getNumArgs > 0 then altStxs else optInductionAlts[0][0]
-- `with` and tactic applied to all branches must be unchanged for reuse
(mkNullNode optInductionAlts[0].getArgs[:2], inner))
(fun alts? =>
if optInductionAlts.isNone then -- no `with` clause
cont none
else if alts?.isOfKind nullKind then -- has alts
cont (some alts?.getArgs)
else -- has `with` clause, but no alts
cont (some #[]))
(mkNullNode optInductionAlts[0].getArgs[:2], optInductionAlts[0].getArg 2))
(fun alts => cont alts.getArgs)
private def getOptPreTacOfOptInductionAlts (optInductionAlts : Syntax) : Syntax :=
if optInductionAlts.isNone then mkNullNode else optInductionAlts[0][1]
@@ -526,7 +518,7 @@ private def expandMultiAlt? (alt : Syntax) : Option (Array Syntax) := Id.run do
/--
Given `inductionAlts` of the form
```
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)*)
syntax inductionAlts := "with " (tactic)? withPosition( (colGe inductionAlt)+)
```
Return `some inductionAlts'` if one of the alternatives have multiple LHSs, in the new `inductionAlts'`
all alternatives have a single LHS.
@@ -708,10 +700,10 @@ def evalInduction : Tactic := fun stx =>
-- unchanged
-- everything up to the alternatives must be unchanged for reuse
Term.withNarrowedArgTacticReuse (stx := stx) (argIdx := 4) fun optInductionAlts => do
withAltsOfOptInductionAlts optInductionAlts fun alts? => do
withAltsOfOptInductionAlts optInductionAlts fun alts => do
let optPreTac := getOptPreTacOfOptInductionAlts optInductionAlts
mvarId.assign result.elimApp
ElimApp.evalAlts elimInfo result.alts optPreTac alts? initInfo (numGeneralized := n) (toClear := targetFVarIds)
ElimApp.evalAlts elimInfo result.alts optPreTac alts initInfo (numGeneralized := n) (toClear := targetFVarIds)
appendGoals result.others.toList
where
checkTargets (targets : Array Expr) : MetaM Unit := do

View File

@@ -680,7 +680,7 @@ def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do
/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This
`TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via
the tactic call `aesop (add 50% tactic Lean.Elab.Tactic.Omega.omegaDefault)`. -/
the tactic call `aesop (add 50% tactic Lean.Omega.omegaDefault)`. -/
def omegaDefault : TacticM Unit := omegaTactic {}
@[builtin_tactic Lean.Parser.Tactic.omega]

View File

@@ -507,7 +507,7 @@ partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a
match pat with
| `(rintroPat| $pat:rcasesPat) =>
let pat := ( RCasesPatt.parse pat).typed? ref ty?
let (v, g) withRef pat.ref <| g.intro (pat.name?.getD `_)
let (v, g) g.intro (pat.name?.getD `_)
rcasesCore g fs clears (.fvar v) a pat cont
| `(rintroPat| ($(pats)* $[: $ty?']?)) =>
let ref := if pats.size == 1 then pat.raw else .missing

View File

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
prelude
import Lean.Parser.Syntax
import Lean.Meta.Tactic.Simp.RegisterCommand
import Lean.Elab.Command
import Lean.Elab.SetOption

View File

@@ -33,7 +33,7 @@ private def mkEqAndProof (lhs rhs : Expr) : MetaM (Expr × Expr) := do
else
pure (mkApp4 (mkConst ``HEq [u]) lhsType lhs rhsType rhs, mkApp2 (mkConst ``HEq.refl [u]) lhsType lhs)
partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr Array Expr MetaM α) : MetaM α :=
private partial def withNewEqs (targets targetsNew : Array Expr) (k : Array Expr Array Expr MetaM α) : MetaM α :=
let rec loop (i : Nat) (newEqs : Array Expr) (newRefls : Array Expr) := do
if i < targets.size then
let (newEqType, newRefl) mkEqAndProof targets[i]! targetsNew[i]!
@@ -66,31 +66,30 @@ structure GeneralizeIndicesSubgoal where
numEqs : Nat
/--
Given a metavariable `mvarId` representing the goal
```
Ctx |- T
```
and an expression `e : I A j`, where `I A j` is an inductive datatype where `A` are parameters,
and `j` the indices. Generate the goal
```
Ctx, j' : J, h' : I A j' |- j == j' -> e == h' -> T
```
Remark: `(j == j' -> e == h')` is a "telescopic" equality.
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
The result contains the fields
- `mvarId`: the new goal
- `indicesFVarIds`: `j'` ids
- `fvarId`: `h'` id
- `numEqs`: number of equations in the target
If `varName?` is not none, it is used to name `h'`.
-/
def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := none) : MetaM GeneralizeIndicesSubgoal :=
Similar to `generalizeTargets` but customized for the `casesOn` motive.
Given a metavariable `mvarId` representing the
```
Ctx, h : I A j, D |- T
```
where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
and `j` the indices. Generate the goal
```
Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
```
Remark: `(j == j' -> h == h')` is a "telescopic" equality.
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
The result contains the fields
- `mvarId`: the new goal
- `indicesFVarIds`: `j'` ids
- `fvarId`: `h'` id
- `numEqs`: number of equations in the target -/
def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
mvarId.withContext do
let lctx getLCtx
let localInsts getLocalInstances
mvarId.checkNotAssigned `generalizeIndices
let type whnfD ( inferType e)
let fvarDecl fvarId.getDecl
let type whnf fvarDecl.type
type.withApp fun f args => matchConstInduct f (fun _ => throwTacticEx `generalizeIndices mvarId "inductive type expected") fun val _ => do
unless val.numIndices > 0 do throwTacticEx `generalizeIndices mvarId "indexed inductive type expected"
unless args.size == val.numIndices + val.numParams do throwTacticEx `generalizeIndices mvarId "ill-formed inductive datatype"
@@ -99,10 +98,9 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
let IAType inferType IA
forallTelescopeReducing IAType fun newIndices _ => do
let newType := mkAppN IA newIndices
let varName if let some varName := varName? then pure varName else mkFreshUserName `x
withLocalDeclD varName newType fun h' =>
withLocalDeclD fvarDecl.userName newType fun h' =>
withNewEqs indices newIndices fun newEqs newRefls => do
let (newEqType, newRefl) mkEqAndProof e h'
let (newEqType, newRefl) mkEqAndProof fvarDecl.toExpr h'
let newRefls := newRefls.push newRefl
withLocalDeclD `h newEqType fun newEq => do
let newEqs := newEqs.push newEq
@@ -114,7 +112,7 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
let auxType mkForallFVars newIndices auxType
let newMVar mkFreshExprMVarAt lctx localInsts auxType MetavarKind.syntheticOpaque tag
/- assign mvarId := newMVar indices h refls -/
mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) e) newRefls)
mvarId.assign (mkAppN (mkApp (mkAppN newMVar indices) fvarDecl.toExpr) newRefls)
let (indicesFVarIds, newMVarId) newMVar.mvarId!.introNP newIndices.size
let (fvarId, newMVarId) newMVarId.intro1P
return {
@@ -124,29 +122,6 @@ def generalizeIndices' (mvarId : MVarId) (e : Expr) (varName? : Option Name := n
numEqs := newEqs.size
}
/--
Similar to `generalizeTargets` but customized for the `casesOn` motive.
Given a metavariable `mvarId` representing the
```
Ctx, h : I A j, D |- T
```
where `fvarId` is `h`s id, and the type `I A j` is an inductive datatype where `A` are parameters,
and `j` the indices. Generate the goal
```
Ctx, h : I A j, D, j' : J, h' : I A j' |- j == j' -> h == h' -> T
```
Remark: `(j == j' -> h == h')` is a "telescopic" equality.
Remark: `j` is sequence of terms, and `j'` a sequence of free variables.
The result contains the fields
- `mvarId`: the new goal
- `indicesFVarIds`: `j'` ids
- `fvarId`: `h'` id
- `numEqs`: number of equations in the target -/
def generalizeIndices (mvarId : MVarId) (fvarId : FVarId) : MetaM GeneralizeIndicesSubgoal :=
mvarId.withContext do
let fvarDecl fvarId.getDecl
generalizeIndices' mvarId fvarDecl.toExpr fvarDecl.userName
structure CasesSubgoal extends InductionSubgoal where
ctorName : Name

View File

@@ -23,7 +23,7 @@ import Lean.Meta.Tactic.Grind.Parser
import Lean.Meta.Tactic.Grind.EMatchTheorem
import Lean.Meta.Tactic.Grind.EMatch
import Lean.Meta.Tactic.Grind.Main
import Lean.Meta.Tactic.Grind.CasesMatch
namespace Lean
@@ -34,14 +34,10 @@ builtin_initialize registerTraceClass `grind.eqc
builtin_initialize registerTraceClass `grind.internalize
builtin_initialize registerTraceClass `grind.ematch
builtin_initialize registerTraceClass `grind.ematch.pattern
builtin_initialize registerTraceClass `grind.ematch.pattern.search
builtin_initialize registerTraceClass `grind.ematch.instance
builtin_initialize registerTraceClass `grind.ematch.instance.assignment
builtin_initialize registerTraceClass `grind.issues
builtin_initialize registerTraceClass `grind.simp
builtin_initialize registerTraceClass `grind.split
builtin_initialize registerTraceClass `grind.split.candidate
builtin_initialize registerTraceClass `grind.split.resolved
/-! Trace options for `grind` developers -/
builtin_initialize registerTraceClass `grind.debug
@@ -51,7 +47,5 @@ builtin_initialize registerTraceClass `grind.debug.proof
builtin_initialize registerTraceClass `grind.debug.proj
builtin_initialize registerTraceClass `grind.debug.parent
builtin_initialize registerTraceClass `grind.debug.final
builtin_initialize registerTraceClass `grind.debug.forallPropagator
builtin_initialize registerTraceClass `grind.debug.split
end Lean

View File

@@ -22,7 +22,7 @@ to detect when two structurally different atoms are definitionally equal.
The `grind` tactic, on the other hand, uses congruence closure. Moreover, types, type formers, proofs, and instances
are considered supporting elements and are not factored into congruence detection.
This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they are instances,
This module minimizes the number of `isDefEq` checks by comparing two terms `a` and `b` only if they instances,
types, or type formers and are the `i`-th arguments of two different `f`-applications. This approach is
sufficient for the congruence closure procedure used by the `grind` tactic.
@@ -111,13 +111,22 @@ unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
visit e |>.run' mkPtrMap
where
visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
unless e.isApp || e.isForall do return e
-- Check whether it is cached
if let some r := ( get).find? e then
return r
let e' match e with
| .app .. => e.withApp fun f args => do
if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
match e with
| .bvar .. => unreachable!
-- Recall that `grind` treats `let`, `forall`, and `lambda` as atomic terms.
| .letE .. | .forallE .. | .lam ..
| .const .. | .lit .. | .mvar .. | .sort .. | .fvar ..
-- Recall that the `grind` preprocessor uses the `foldProjs` preprocessing step.
| .proj ..
-- Recall that the `grind` preprocessor uses the `eraseIrrelevantMData` preprocessing step.
| .mdata .. => return e
-- We only visit applications
| .app .. =>
-- Check whether it is cached
if let some r := ( get).find? e then
return r
e.withApp fun f args => do
let e' if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
let prop := args[0]!
let prop' visit prop
if let some r := ( getThe State).proofCanon.find? prop' then
@@ -129,28 +138,23 @@ where
else
let pinfos := ( getFunInfo f).paramInfo
let mut modified := false
let mut args := args.toVector
for h : i in [:args.size] do
let arg := args[i]
let mut args := args
for i in [:args.size] do
let arg := args[i]!
let arg' match ( shouldCanon pinfos i arg) with
| .canonType => canonType f i arg
| .canonInst => canonInst f i arg
| .visit => visit arg
unless ptrEq arg arg' do
args := args.set i arg'
args := args.set! i arg'
modified := true
pure <| if modified then mkAppN f args.toArray else e
| .forallE _ d b _ =>
-- Recall that we have `ForallProp.lean`.
let d' visit d
-- Remark: users may not want to convert `p → q` into `¬p q`
let b' if b.hasLooseBVars then pure b else visit b
pure <| e.updateForallE! d' b'
| _ => unreachable!
modify fun s => s.insert e e'
return e'
pure <| if modified then mkAppN f args else e
modify fun s => s.insert e e'
return e'
/-- Canonicalizes nested types, type formers, and instances in `e`. -/
/--
Canonicalizes nested types, type formers, and instances in `e`.
-/
def canon (e : Expr) : StateT State MetaM Expr :=
unsafe canonImpl e

View File

@@ -11,56 +11,52 @@ namespace Lean.Meta.Grind
The `grind` tactic includes an auxiliary `cases` tactic that is not intended for direct use by users.
This method implements it.
This tactic is automatically applied when introducing local declarations with a type tagged with `[grind_cases]`.
It is also used for "case-splitting" on terms during the search.
It differs from the user-facing Lean `cases` tactic in the following ways:
- It avoids unnecessary `revert` and `intro` operations.
- It does not introduce new local declarations for each minor premise. Instead, the `grind` tactic preprocessor is responsible for introducing them.
- It assumes that the major premise (i.e., the parameter `fvarId`) is the latest local declaration in the current goal.
- If the major premise type is an indexed family, auxiliary declarations and (heterogeneous) equalities are introduced.
However, these equalities are not resolved using `unifyEqs`. Instead, the `grind` tactic employs union-find and
congruence closure to process these auxiliary equalities. This approach avoids applying substitution to propositions
that have already been internalized by `grind`.
-/
def cases (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
def cases (mvarId : MVarId) (fvarId : FVarId) : MetaM (List MVarId) := mvarId.withContext do
let tag mvarId.getTag
let type whnf ( inferType e)
let type whnf ( fvarId.getType)
let .const declName _ := type.getAppFn | throwInductiveExpected type
let .inductInfo _ getConstInfo declName | throwInductiveExpected type
let recursorInfo mkRecursorInfo (mkCasesOnName declName)
let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array FVarId) : MetaM (List MVarId) := do
let indicesExpr := indices.map mkFVar
let recursor mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indicesExpr
let mut recursor := mkApp (mkAppN recursor indicesExpr) (mkFVar fvarId)
let k (mvarId : MVarId) (fvarId : FVarId) (indices : Array Expr) (clearMajor : Bool) : MetaM (List MVarId) := do
let recursor mkRecursorAppPrefix mvarId `grind.cases fvarId recursorInfo indices
let mut recursor := mkApp (mkAppN recursor indices) (mkFVar fvarId)
let mut recursorType inferType recursor
let mut mvarIdsNew := #[]
let mut idx := 1
for _ in [:recursorInfo.numMinors] do
let .forallE _ targetNew recursorTypeNew _ whnf recursorType
| throwTacticEx `grind.cases mvarId "unexpected recursor type"
recursorType := recursorTypeNew
let tagNew := if recursorInfo.numMinors > 1 then Name.num tag idx else tag
let mvar mkFreshExprSyntheticOpaqueMVar targetNew tagNew
let mvar mkFreshExprSyntheticOpaqueMVar targetNew tag
recursor := mkApp recursor mvar
let mvarIdNew mvar.mvarId!.tryClearMany (indices.push fvarId)
let mvarIdNew if clearMajor then
mvar.mvarId!.clear fvarId
else
pure mvar.mvarId!
mvarIdsNew := mvarIdsNew.push mvarIdNew
idx := idx + 1
mvarId.assign recursor
return mvarIdsNew.toList
if recursorInfo.numIndices > 0 then
let s generalizeIndices' mvarId e
let s generalizeIndices mvarId fvarId
s.mvarId.withContext do
k s.mvarId s.fvarId s.indicesFVarIds
else if let .fvar fvarId := e then
k mvarId fvarId #[]
k s.mvarId s.fvarId (s.indicesFVarIds.map mkFVar) (clearMajor := false)
else
let mvarId mvarId.assert ( mkFreshUserName `x) type e
let (fvarId, mvarId) mvarId.intro1
mvarId.withContext do k mvarId fvarId #[]
let indices getMajorTypeIndices mvarId `grind.cases recursorInfo type
k mvarId fvarId indices (clearMajor := true)
where
throwInductiveExpected {α} (type : Expr) : MetaM α := do
throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {e}{indentExpr type}"
throwTacticEx `grind.cases mvarId m!"(non-recursive) inductive type expected at {mkFVar fvarId}{indentExpr type}"
end Lean.Meta.Grind

View File

@@ -1,53 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Util
import Lean.Meta.Tactic.Cases
import Lean.Meta.Match.MatcherApp
namespace Lean.Meta.Grind
def casesMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
let some app matchMatcherApp? e
| throwTacticEx `grind.casesMatch mvarId m!"`match`-expression expected{indentExpr e}"
let (motive, eqRefls) mkMotiveAndRefls app
let target mvarId.getType
let mut us := app.matcherLevels
if let some i := app.uElimPos? then
us := us.set! i ( getLevel target)
let splitterName := ( Match.getEquationsFor app.matcherName).splitterName
let splitterApp := mkConst splitterName us.toList
let splitterApp := mkAppN splitterApp app.params
let splitterApp := mkApp splitterApp motive
let splitterApp := mkAppN splitterApp app.discrs
let (mvars, _, _) forallMetaBoundedTelescope ( inferType splitterApp) app.alts.size (kind := .syntheticOpaque)
let splitterApp := mkAppN splitterApp mvars
let val := mkAppN splitterApp eqRefls
mvarId.assign val
updateTags mvars
return mvars.toList.map (·.mvarId!)
where
mkMotiveAndRefls (app : MatcherApp) : MetaM (Expr × Array Expr) := do
let dummy := mkSort 0
let aux := mkApp (mkAppN e.getAppFn app.params) dummy
forallBoundedTelescope ( inferType aux) app.discrs.size fun xs _ => do
withNewEqs app.discrs xs fun eqs eqRefls => do
let type mvarId.getType
let type mkForallFVars eqs type
let motive mkLambdaFVars xs type
return (motive, eqRefls)
updateTags (mvars : Array Expr) : MetaM Unit := do
let tag mvarId.getTag
if mvars.size == 1 then
mvars[0]!.mvarId!.setTag tag
else
let mut idx := 1
for mvar in mvars do
mvar.mvarId!.setTag (Name.num tag idx)
idx := idx + 1
end Lean.Meta.Grind

View File

@@ -1,71 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
/-!
Combinators for manipulating `GrindTactic`s.
TODO: a proper tactic language for `grind`.
-/
def GrindTactic := Goal GrindM (Option (List Goal))
def GrindTactic.try (x : GrindTactic) : GrindTactic := fun g => do
let some gs x g | return some [g]
return some gs
def applyToAll (x : GrindTactic) (goals : List Goal) : GrindM (List Goal) := do
go goals []
where
go (goals : List Goal) (acc : List Goal) : GrindM (List Goal) := do
match goals with
| [] => return acc.reverse
| goal :: goals => match ( x goal) with
| none => go goals (goal :: acc)
| some goals' => go goals (goals' ++ acc)
partial def GrindTactic.andThen (x y : GrindTactic) : GrindTactic := fun goal => do
let some goals x goal | return none
applyToAll y goals
instance : AndThen GrindTactic where
andThen a b := GrindTactic.andThen a (b ())
partial def GrindTactic.iterate (x : GrindTactic) : GrindTactic := fun goal => do
go [goal] []
where
go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
match todo with
| [] => return result
| goal :: todo =>
if let some goalsNew x goal then
go (goalsNew ++ todo) result
else
go todo (goal :: result)
partial def GrindTactic.orElse (x y : GrindTactic) : GrindTactic := fun goal => do
let some goals x goal | y goal
return goals
instance : OrElse GrindTactic where
orElse a b := GrindTactic.andThen a (b ())
def toGrindTactic (f : GoalM Unit) : GrindTactic := fun goal => do
let goal GoalM.run' goal f
if goal.inconsistent then
return some []
else
return some [goal]
def GrindTactic' := Goal GrindM (List Goal)
def GrindTactic'.toGrindTactic (x : GrindTactic') : GrindTactic := fun goal => do
let goals x goal
return some goals
end Lean.Meta.Grind

View File

@@ -41,9 +41,8 @@ This is an auxiliary function performed while merging equivalence classes.
private def removeParents (root : Expr) : GoalM ParentSet := do
let parents getParentsAndReset root
for parent in parents do
-- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
if ( pure parent.isApp <&&> isCongrRoot parent) then
trace_goal[grind.debug.parent] "remove: {parent}"
if ( isCongrRoot parent) then
trace[grind.debug.parent] "remove: {parent}"
modify fun s => { s with congrTable := s.congrTable.erase { e := parent } }
return parents
@@ -53,8 +52,8 @@ This is an auxiliary function performed while merging equivalence classes.
-/
private def reinsertParents (parents : ParentSet) : GoalM Unit := do
for parent in parents do
if ( pure parent.isApp <&&> isCongrRoot parent) then
trace_goal[grind.debug.parent] "reinsert: {parent}"
if ( isCongrRoot parent) then
trace[grind.debug.parent] "reinsert: {parent}"
addCongrTable parent
/-- Closes the goal when `True` and `False` are in the same equivalence class. -/
@@ -91,9 +90,9 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
let rhsNode getENode rhs
if isSameExpr lhsNode.root rhsNode.root then
-- `lhs` and `rhs` are already in the same equivalence class.
trace_goal[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
trace[grind.debug] "{← ppENodeRef lhs} and {← ppENodeRef rhs} are already in the same equivalence class"
return ()
trace_goal[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
trace[grind.eqc] "{← if isHEq then mkHEq lhs rhs else mkEq lhs rhs}"
let lhsRoot getENode lhsNode.root
let rhsRoot getENode rhsNode.root
let mut valueInconsistency := false
@@ -118,11 +117,11 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
unless ( isInconsistent) do
if valueInconsistency then
closeGoalWithValuesEq lhsRoot.self rhsRoot.self
trace_goal[grind.debug] "after addEqStep, {← ppState}"
trace[grind.debug] "after addEqStep, {← ppState}"
checkInvariants
where
go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
trace_goal[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
trace[grind.debug] "adding {← ppENodeRef lhs} ↦ {← ppENodeRef rhs}"
/-
We have the following `target?/proof?`
`lhs -> ... -> lhsNode.root`
@@ -139,7 +138,7 @@ where
}
let parents removeParents lhsRoot.self
updateRoots lhs rhsNode.root
trace_goal[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
trace[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
reinsertParents parents
setENode lhsNode.root { ( getENode lhsRoot.self) with -- We must retrieve `lhsRoot` since it was updated.
next := rhsRoot.next
@@ -191,24 +190,17 @@ where
addEqStep lhs rhs proof isHEq
processTodo
/-- Adds a new equality `lhs = rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
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. -/
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
internalize lhs generation
internalize rhs generation
addEq lhs rhs proof
/-- Adds a new `fact` justified by the given proof and using the given generation. -/
/--
Adds a new `fact` justified by the given proof and using the given generation.
-/
def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
trace_goal[grind.assert] "{fact}"
trace[grind.assert] "{fact}"
if ( isInconsistent) then return ()
resetNewEqs
let_expr Not p := fact

View File

@@ -9,18 +9,14 @@ import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit := do
-- Remark: we must use `shareCommon` before using `pushEq` and `pushHEq`.
-- This is needed because the result type of the injection theorem may allocate
match_expr eqs with
| And left right =>
propagateInjEqs left (.proj ``And 0 proof)
propagateInjEqs right (.proj ``And 1 proof)
| Eq _ lhs rhs =>
pushEq ( shareCommon lhs) ( shareCommon rhs) proof
| HEq _ lhs _ rhs =>
pushHEq ( shareCommon lhs) ( shareCommon rhs) proof
| Eq _ lhs rhs => pushEq lhs rhs proof
| HEq _ lhs _ rhs => pushHEq lhs rhs proof
| _ =>
trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
trace[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
return ()
/--

View File

@@ -1,35 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Util
import Init.Simproc
import Lean.Meta.Tactic.Simp.Simproc
namespace Lean.Meta.Grind
/--
Returns `Grind.doNotSimp e`.
Recall that `Grind.doNotSimp` is an identity function, but the following simproc is used to prevent the term `e` from being simplified.
-/
def markAsDoNotSimp (e : Expr) : MetaM Expr :=
mkAppM ``Grind.doNotSimp #[e]
builtin_dsimproc_decl reduceDoNotSimp (Grind.doNotSimp _) := fun e => do
let_expr Grind.doNotSimp _ _ e | return .continue
return .done e
/-- Adds `reduceDoNotSimp` to `s` -/
def addDoNotSimp (s : Simprocs) : CoreM Simprocs := do
s.add ``reduceDoNotSimp (post := false)
/-- Erases `Grind.doNotSimp` annotations. -/
def eraseDoNotSimp (e : Expr) : CoreM Expr := do
let pre (e : Expr) := do
let_expr Grind.doNotSimp _ a := e | return .continue e
return .continue a
Core.transform e (pre := pre)
end Lean.Meta.Grind

View File

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
prelude
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Intro
import Lean.Meta.Tactic.Grind.DoNotSimp
namespace Lean.Meta.Grind
namespace EMatch
@@ -16,8 +15,6 @@ namespace EMatch
inductive Cnstr where
| /-- Matches pattern `pat` with term `e` -/
«match» (pat : Expr) (e : Expr)
| /-- Matches offset pattern `pat+k` with term `e` -/
offset (pat : Expr) (k : Nat) (e : Expr)
| /-- This constraint is used to encode multi-patterns. -/
«continue» (pat : Expr)
deriving Inhabited
@@ -51,8 +48,6 @@ structure Context where
useMT : Bool := true
/-- `EMatchTheorem` being processed. -/
thm : EMatchTheorem := default
/-- Initial application used to start E-matching -/
initApp : Expr := default
deriving Inhabited
/-- State for the E-matching monad -/
@@ -66,9 +61,6 @@ abbrev M := ReaderT Context $ StateRefT State GoalM
def M.run' (x : M α) : GoalM α :=
x {} |>.run' {}
@[inline] private abbrev withInitApp (e : Expr) (x : M α) : M α :=
withReader (fun ctx => { ctx with initApp := e }) x
/--
Assigns `bidx := e` in `c`. If `bidx` is already assigned in `c`, we check whether
`e` and `c.assignment[bidx]` are in the same equivalence class.
@@ -95,28 +87,6 @@ private def eqvFunctions (pFn eFn : Expr) : Bool :=
(pFn.isFVar && pFn == eFn)
|| (pFn.isConst && eFn.isConstOf pFn.constName!)
/-- Matches a pattern argument. See `matchArgs?`. -/
private def matchArg? (c : Choice) (pArg : Expr) (eArg : Expr) : OptionT GoalM Choice := do
if isPatternDontCare pArg then
return c
else if pArg.isBVar then
assign? c pArg.bvarIdx! eArg
else if let some pArg := groundPattern? pArg then
guard ( isEqv pArg eArg)
return c
else if let some (pArg, k) := isOffsetPattern? pArg then
assert! Option.isNone <| isOffsetPattern? pArg
assert! !isPatternDontCare pArg
return { c with cnstrs := .offset pArg k eArg :: c.cnstrs }
else
return { c with cnstrs := .match pArg eArg :: c.cnstrs }
private def Choice.updateGen (c : Choice) (gen : Nat) : Choice :=
{ c with gen := Nat.max gen c.gen }
private def pushChoice (c : Choice) : M Unit :=
modify fun s => { s with choiceStack := c :: s.choiceStack }
/--
Matches arguments of pattern `p` with term `e`. Returns `some` if successful,
and `none` otherwise. It may update `c`s assignment and list of contraints to be
@@ -126,8 +96,16 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
if !p.isApp then return c -- Done
let pArg := p.appArg!
let eArg := e.appArg!
let c matchArg? c pArg eArg
matchArgs? c p.appFn! e.appFn!
let goFn c := matchArgs? c p.appFn! e.appFn!
if isPatternDontCare pArg then
goFn c
else if pArg.isBVar then
goFn ( assign? c pArg.bvarIdx! eArg)
else if let some pArg := groundPattern? pArg then
guard ( isEqv pArg eArg)
goFn c
else
goFn { c with cnstrs := .match pArg eArg :: c.cnstrs }
/--
Matches pattern `p` with term `e` with respect to choice `c`.
@@ -142,46 +120,15 @@ private partial def processMatch (c : Choice) (p : Expr) (e : Expr) : M Unit :=
let mut curr := e
repeat
let n getENode curr
-- Remark: we use `<` because the instance generation is the maximum term generation + 1
if n.generation < maxGeneration
if n.generation <= maxGeneration
-- uses heterogeneous equality or is the root of its congruence class
&& (n.heqProofs || n.isCongrRoot)
&& eqvFunctions pFn curr.getAppFn
&& curr.getAppNumArgs == numArgs then
if let some c matchArgs? c p curr |>.run then
pushChoice (c.updateGen n.generation)
curr getNext curr
if isSameExpr curr e then break
/--
Matches offset pattern `pArg+k` with term `e` with respect to choice `c`.
-/
private partial def processOffset (c : Choice) (pArg : Expr) (k : Nat) (e : Expr) : M Unit := do
let maxGeneration getMaxGeneration
let mut curr := e
repeat
let n getENode curr
if n.generation < maxGeneration then
if let some (eArg, k') isOffset? curr |>.run then
if k' < k then
let c := c.updateGen n.generation
pushChoice { c with cnstrs := .offset pArg (k - k') eArg :: c.cnstrs }
else if k' == k then
if let some c matchArg? c pArg eArg |>.run then
pushChoice (c.updateGen n.generation)
else if k' > k then
let eArg' := mkNatAdd eArg (mkNatLit (k' - k))
let eArg' shareCommon ( canon eArg')
internalize eArg' (n.generation+1)
if let some c matchArg? c pArg eArg' |>.run then
pushChoice (c.updateGen n.generation)
else if let some k' evalNat curr |>.run then
if k' >= k then
let eArg' := mkNatLit (k' - k)
let eArg' shareCommon ( canon eArg')
internalize eArg' (n.generation+1)
if let some c matchArg? c pArg eArg' |>.run then
pushChoice (c.updateGen n.generation)
let gen := n.generation
let c := { c with gen := Nat.max gen c.gen }
modify fun s => { s with choiceStack := c :: s.choiceStack }
curr getNext curr
if isSameExpr curr e then break
@@ -192,26 +139,13 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
let maxGeneration getMaxGeneration
for app in apps do
let n getENode app
if n.generation < maxGeneration
if n.generation <= maxGeneration
&& (n.heqProofs || n.isCongrRoot) then
if let some c matchArgs? c p app |>.run then
let gen := n.generation
let c := { c with gen := Nat.max gen c.gen }
modify fun s => { s with choiceStack := c :: s.choiceStack }
/--
Helper function for marking parts of `match`-equation theorem as "do-not-simplify"
`initApp` is the match-expression used to instantiate the `match`-equation.
-/
private partial def annotateMatchEqnType (prop : Expr) (initApp : Expr) : M Expr := do
if let .forallE n d b bi := prop then
withLocalDecl n bi ( markAsDoNotSimp d) fun x => do
mkForallFVars #[x] ( annotateMatchEqnType (b.instantiate1 x) initApp)
else
let_expr f@Eq α lhs rhs := prop | return prop
-- See comment at `Grind.EqMatch`
return mkApp4 (mkConst ``Grind.EqMatch f.constLevels!) α ( markAsDoNotSimp lhs) rhs initApp
/--
Stores new theorem instance in the state.
Recall that new instances are internalized later, after a full round of ematching.
@@ -220,11 +154,9 @@ private def addNewInstance (origin : Origin) (proof : Expr) (generation : Nat) :
let proof instantiateMVars proof
if grind.debug.proofs.get ( getOptions) then
check proof
let mut prop inferType proof
if Match.isMatchEqnTheorem ( getEnv) origin.key then
prop annotateMatchEqnType prop ( read).initApp
trace_goal[grind.ematch.instance] "{← origin.pp}: {prop}"
addTheoremInstance proof prop (generation+1)
let prop inferType proof
trace[grind.ematch.instance] "{← origin.pp}: {prop}"
addTheoremInstance proof prop generation
/--
After processing a (multi-)pattern, use the choice assignment to instantiate the proof.
@@ -234,38 +166,36 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
let thm := ( read).thm
unless ( markTheoremInstance thm.proof c.assignment) do
return ()
trace_goal[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
trace[grind.ematch.instance.assignment] "{← thm.origin.pp}: {assignmentToMessageData c.assignment}"
let proof thm.getProofWithFreshMVarLevels
let numParams := thm.numParams
assert! c.assignment.size == numParams
let (mvars, bis, _) forallMetaBoundedTelescope ( inferType proof) numParams
if mvars.size != thm.numParams then
trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
trace[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
return ()
-- Apply assignment
for h : i in [:mvars.size] do
let v := c.assignment[numParams - i - 1]!
unless isSameExpr v unassigned do
let mvarId := mvars[i].mvarId!
let mvarIdType mvarId.getType
let vType inferType v
unless ( isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
unless ( isDefEq ( mvarId.getType) ( inferType v) <&&> mvarId.checkedAssign v) do
trace[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}"
return ()
-- Synthesize instances
for mvar in mvars, bi in bis do
if bi.isInstImplicit && !( mvar.mvarId!.isAssigned) then
let type inferType mvar
unless ( synthesizeInstance mvar type) do
trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
trace[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
return ()
let proof := mkAppN proof mvars
if ( mvars.allM (·.mvarId!.isAssigned)) then
addNewInstance thm.origin proof c.gen
addNewInstance thm.origin (mkAppN proof mvars) c.gen
else
let proof := mkAppN proof mvars
let mvars mvars.filterM fun mvar => return !( mvar.mvarId!.isAssigned)
if let some mvarBad mvars.findM? fun mvar => return !( isProof mvar) then
trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
trace[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
let proof mkLambdaFVars (binderInfoForMVars := .default) mvars ( instantiateMVars proof)
addNewInstance thm.origin proof c.gen
where
@@ -274,18 +204,16 @@ where
isDefEq x val
/-- Process choice stack until we don't have more choices to be processed. -/
private def processChoices : M Unit := do
let maxGeneration getMaxGeneration
while !( get).choiceStack.isEmpty do
private partial def processChoices : M Unit := do
unless ( get).choiceStack.isEmpty do
checkSystem "ematch"
if ( checkMaxInstancesExceeded) then return ()
let c modifyGet fun s : State => (s.choiceStack.head!, { s with choiceStack := s.choiceStack.tail! })
if c.gen < maxGeneration then
match c.cnstrs with
| [] => instantiateTheorem c
| .match p e :: cnstrs => processMatch { c with cnstrs } p e
| .offset p k e :: cnstrs => processOffset { c with cnstrs } p k e
| .continue p :: cnstrs => processContinue { c with cnstrs } p
match c.cnstrs with
| [] => instantiateTheorem c
| .match p e :: cnstrs => processMatch { c with cnstrs } p e
| .continue p :: cnstrs => processContinue { c with cnstrs } p
processChoices
private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
let some apps := ( getThe Goal).appMap.find? p.toHeadIndex
@@ -299,10 +227,9 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
let n getENode app
if (n.heqProofs || n.isCongrRoot) &&
(!useMT || n.mt == gmt) then
withInitApp app do
if let some c matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
modify fun s => { s with choiceStack := [c] }
processChoices
if let some c matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
modify fun s => { s with choiceStack := [c] }
processChoices
def ematchTheorem (thm : EMatchTheorem) : M Unit := do
if ( checkMaxInstancesExceeded) then return ()
@@ -341,7 +268,7 @@ def ematch : GoalM Unit := do
let go (thms newThms : PArray EMatchTheorem) : EMatch.M Unit := do
withReader (fun ctx => { ctx with useMT := true }) <| ematchTheorems thms
withReader (fun ctx => { ctx with useMT := false }) <| ematchTheorems newThms
if ( checkMaxInstancesExceeded <||> checkMaxEmatchExceeded) then
if ( checkMaxInstancesExceeded) then
return ()
else
go ( get).thms ( get).newThms |>.run'
@@ -349,18 +276,17 @@ def ematch : GoalM Unit := do
thms := s.thms ++ s.newThms
newThms := {}
gmt := s.gmt + 1
numEmatch := s.numEmatch + 1
}
/-- Performs one round of E-matching, and assert new instances. -/
def ematchAndAssert : GrindTactic := fun goal => do
def ematchAndAssert? (goal : Goal) : GrindM (Option (List Goal)) := do
let numInstances := goal.numInstances
let goal GoalM.run' goal ematch
if goal.numInstances == numInstances then
return none
assertAll goal
def ematchStar : GrindTactic :=
ematchAndAssert.iterate
def ematchStar (goal : Goal) : GrindM (List Goal) := do
iterate goal ematchAndAssert?
end Lean.Meta.Grind

View File

@@ -4,49 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Util
import Init.Grind.Tactics
import Lean.HeadIndex
import Lean.PrettyPrinter
import Lean.Util.FoldConsts
import Lean.Util.CollectFVars
import Lean.Meta.Basic
import Lean.Meta.InferType
import Lean.Meta.Eqns
import Lean.Meta.Tactic.Grind.Util
namespace Lean.Meta.Grind
def mkOffsetPattern (pat : Expr) (k : Nat) : Expr :=
mkApp2 (mkConst ``Grind.offset) pat (mkRawNatLit k)
private def detectOffsets (pat : Expr) : MetaM Expr := do
let pre (e : Expr) := do
if e == pat then
-- We only consider nested offset patterns
return .continue e
else match e with
| .letE .. | .lam .. | .forallE .. => return .done e
| _ =>
let some (e, k) isOffset? e
| return .continue e
if k == 0 then return .continue e
return .continue <| mkOffsetPattern e k
Core.transform pat (pre := pre)
def isOffsetPattern? (pat : Expr) : Option (Expr × Nat) := Id.run do
let_expr Grind.offset pat k := pat | none
let .lit (.natVal k) := k | none
return some (pat, k)
def preprocessPattern (pat : Expr) (normalizePattern := true) : MetaM Expr := do
let pat instantiateMVars pat
let pat unfoldReducible pat
let pat if normalizePattern then normalize pat else pure pat
let pat detectOffsets pat
let pat foldProjs pat
return pat
inductive Origin where
/-- A global declaration in the environment. -/
| decl (declName : Name)
@@ -57,29 +23,22 @@ inductive Origin where
is the provided grind argument. The `id` is a unique identifier for the call.
-/
| stx (id : Name) (ref : Syntax)
/-- It is local, but we don't have a local hypothesis for it. -/
| local (id : Name)
deriving Inhabited, Repr, BEq
| other
deriving Inhabited, Repr
/-- A unique identifier corresponding to the origin. -/
def Origin.key : Origin Name
| .decl declName => declName
| .fvar fvarId => fvarId.name
| .stx id _ => id
| .local id => id
| .other => `other
def Origin.pp [Monad m] [MonadEnv m] [MonadError m] (o : Origin) : m MessageData := do
match o with
| .decl declName => return MessageData.ofConst ( mkConstWithLevelParams declName)
| .fvar fvarId => return mkFVar fvarId
| .stx _ ref => return ref
| .local id => return id
instance : BEq Origin where
beq a b := a.key == b.key
instance : Hashable Origin where
hash a := hash a.key
| .other => return "[unknown]"
/-- A theorem for heuristic instantiation based on E-matching. -/
structure EMatchTheorem where
@@ -97,58 +56,17 @@ structure EMatchTheorem where
origin : Origin
deriving Inhabited
/-- Set of E-matching theorems. -/
structure EMatchTheorems where
/-- The key is a symbol from `EMatchTheorem.symbols`. -/
private map : PHashMap Name (List EMatchTheorem) := {}
/-- Set of theorem ids that have been inserted using `insert`. -/
private origins : PHashSet Origin := {}
/-- Theorems that have been marked as erased -/
private erased : PHashSet Origin := {}
deriving Inhabited
/-- The key is a symbol from `EMatchTheorem.symbols`. -/
abbrev EMatchTheorems := PHashMap Name (List EMatchTheorem)
/--
Inserts a `thm` with symbols `[s_1, ..., s_n]` to `s`.
We add `s_1 -> { thm with symbols := [s_2, ..., s_n] }`.
When `grind` internalizes a term containing symbol `s`, we
process all theorems `thm` associated with key `s`.
If their `thm.symbols` is empty, we say they are activated.
Otherwise, we reinsert into `map`.
-/
def EMatchTheorems.insert (s : EMatchTheorems) (thm : EMatchTheorem) : EMatchTheorems := Id.run do
let .const declName :: syms := thm.symbols
| unreachable!
let thm := { thm with symbols := syms }
let { map, origins, erased } := s
let origins := origins.insert thm.origin
let erased := erased.erase thm.origin
if let some thms := map.find? declName then
return { map := map.insert declName (thm::thms), origins, erased }
if let some thms := s.find? declName then
return PersistentHashMap.insert s declName (thm::thms)
else
return { map := map.insert declName [thm], origins, erased }
/-- Returns `true` if `s` contains a theorem with the given origin. -/
def EMatchTheorems.contains (s : EMatchTheorems) (origin : Origin) : Bool :=
s.origins.contains origin
/-- Mark the theorm with the given origin as `erased` -/
def EMatchTheorems.erase (s : EMatchTheorems) (origin : Origin) : EMatchTheorems :=
{ s with erased := s.erased.insert origin, origins := s.origins.erase origin }
/-- Returns true if the theorem has been marked as erased. -/
def EMatchTheorems.isErased (s : EMatchTheorems) (origin : Origin) : Bool :=
s.erased.contains origin
/--
Retrieves theorems from `s` associated with the given symbol. See `EMatchTheorem.insert`.
The theorems are removed from `s`.
-/
@[inline]
def EMatchTheorems.retrieve? (s : EMatchTheorems) (sym : Name) : Option (List EMatchTheorem × EMatchTheorems) :=
if let some thms := s.map.find? sym then
some (thms, { s with map := s.map.erase sym })
else
none
return PersistentHashMap.insert s declName [thm]
def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr := do
if thm.proof.isConst && thm.levelParams.isEmpty then
@@ -167,7 +85,7 @@ def EMatchTheorem.getProofWithFreshMVarLevels (thm : EMatchTheorem) : MetaM Expr
private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTheorem EMatchTheorems
registerSimpleScopedEnvExtension {
addEntry := EMatchTheorems.insert
initial := {}
initial := .empty
}
-- TODO: create attribute?
@@ -236,19 +154,17 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
| _ => none
/--
Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
- a type (that is not a proposition) or type former, or
Returns a bit-mask `mask` s.t. `mask[i]` is true if the the corresponding argument is
- a type or type former, or
- a proof, or
- an instance implicit argument
When `mask[i]`, we say the corresponding argument is a "support" argument.
-/
def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
private def getPatternFunMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
forallBoundedTelescope ( inferType f) numArgs fun xs _ => do
xs.mapM fun x => do
if ( isProp x) then
return false
else if ( isTypeFormer x <||> isProof x) then
if ( isTypeFormer x <||> isProof x) then
return true
else
return ( x.fvarId!.getDecl).binderInfo matches .instImplicit
@@ -256,26 +172,16 @@ def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
private partial def go (pattern : Expr) (root := false) : M Expr := do
if root && !pattern.hasLooseBVars then
throwError "invalid pattern, it does not have pattern variables"
if let some (e, k) := isOffsetPattern? pattern then
let e goArg e (isSupport := false)
if e == dontCare then
return dontCare
else
return mkOffsetPattern e k
let some f := getPatternFn? pattern
| throwError "invalid pattern, (non-forbidden) application expected{indentExpr pattern}"
| throwError "invalid pattern, (non-forbidden) application expected"
assert! f.isConst || f.isFVar
saveSymbol f.toHeadIndex
let mut args := pattern.getAppArgs.toVector
let supportMask getPatternSupportMask f args.size
for h : i in [:args.size] do
let arg := args[i]
let mut args := pattern.getAppArgs
let supportMask getPatternFunMask f args.size
for i in [:args.size] do
let arg := args[i]!
let isSupport := supportMask[i]?.getD false
args := args.set i ( goArg arg isSupport)
return mkAppN f args.toArray
where
goArg (arg : Expr) (isSupport : Bool) : M Expr := do
if !arg.hasLooseBVars then
let arg if !arg.hasLooseBVars then
if arg.hasMVar then
pure dontCare
else
@@ -294,14 +200,13 @@ where
go arg
else
pure dontCare
args := args.set! i arg
return mkAppN f args
def main (patterns : List Expr) : MetaM (List Expr × List HeadIndex × Std.HashSet Nat) := do
let (patterns, s) patterns.mapM go |>.run {}
return (patterns, s.symbols.toList, s.bvarsFound)
def normalizePattern (e : Expr) : M Expr := do
go e
end NormalizePattern
/--
@@ -415,8 +320,8 @@ private def checkCoverage (thmProof : Expr) (numParams : Nat) (bvarsFound : Std.
Given a theorem with proof `proof` and `numParams` parameters, returns a message
containing the parameters at positions `paramPos`.
-/
private def ppParamsAt (proof : Expr) (numParams : Nat) (paramPos : List Nat) : MetaM MessageData := do
forallBoundedTelescope ( inferType proof) numParams fun xs _ => do
private def ppParamsAt (proof : Expr) (numParms : Nat) (paramPos : List Nat) : MetaM MessageData := do
forallBoundedTelescope ( inferType proof) numParms fun xs _ => do
let mut msg := m!""
let mut first := true
for h : i in [:xs.size] do
@@ -426,300 +331,24 @@ private def ppParamsAt (proof : Expr) (numParams : Nat) (paramPos : List Nat) :
msg := msg ++ m!"{x} : {← inferType x}"
addMessageContextFull msg
/--
Creates an E-matching theorem for a theorem with proof `proof`, `numParams` parameters, and the given set of patterns.
Pattern variables are represented using de Bruijn indices.
-/
def mkEMatchTheoremCore (origin : Origin) (levelParams : Array Name) (numParams : Nat) (proof : Expr) (patterns : List Expr) : MetaM EMatchTheorem := do
def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
let .thmInfo info getConstInfo declName
| throwError "`{declName}` is not a theorem, you cannot assign patterns to non-theorems for the `grind` tactic"
let us := info.levelParams.map mkLevelParam
let proof := mkConst declName us
let (patterns, symbols, bvarFound) NormalizePattern.main patterns
trace[grind.ematch.pattern] "{MessageData.ofConst proof}: {patterns.map ppPattern}"
assert! symbols.all fun s => s matches .const _
trace[grind.ematch.pattern] "{declName}: {patterns.map ppPattern}"
if let .missing pos checkCoverage proof numParams bvarFound then
let pats : MessageData := m!"{patterns.map ppPattern}"
throwError "invalid pattern(s) for `{← origin.pp}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
return {
proof, patterns, numParams, symbols
levelParams, origin
throwError "invalid pattern(s) for `{declName}`{indentD pats}\nthe following theorem parameters cannot be instantiated:{indentD (← ppParamsAt proof numParams pos)}"
ematchTheoremsExt.add {
proof, patterns, numParams, symbols
levelParams := #[]
origin := .decl declName
}
private def getProofFor (declName : Name) : CoreM Expr := do
let .thmInfo info getConstInfo declName
| throwError "`{declName}` is not a theorem"
let us := info.levelParams.map mkLevelParam
return mkConst declName us
/--
Creates an E-matching theorem for `declName` with `numParams` parameters, and the given set of patterns.
Pattern variables are represented using de Bruijn indices.
-/
def mkEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM EMatchTheorem := do
mkEMatchTheoremCore (.decl declName) #[] numParams ( getProofFor declName) patterns
/--
Given a theorem with proof `proof` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the pattern.
-/
def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof : Expr) (normalizePattern : Bool) (useLhs : Bool) : MetaM EMatchTheorem := do
let (numParams, patterns) forallTelescopeReducing ( inferType proof) fun xs type => do
let (lhs, rhs) match_expr type with
| Eq _ lhs rhs => pure (lhs, rhs)
| Iff lhs rhs => pure (lhs, rhs)
| HEq _ lhs _ rhs => pure (lhs, rhs)
| _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
let pat := if useLhs then lhs else rhs
let pat preprocessPattern pat normalizePattern
return (xs.size, [pat.abstract xs])
mkEMatchTheoremCore origin levelParams numParams proof patterns
/--
Given theorem with name `declName` and type of the form `∀ (a_1 ... a_n), lhs = rhs`,
creates an E-matching pattern for it using `addEMatchTheorem n [lhs]`
If `normalizePattern` is true, it applies the `grind` simplification theorems and simprocs to the
pattern.
-/
def mkEMatchEqTheorem (declName : Name) (normalizePattern := true) (useLhs : Bool := true) : MetaM EMatchTheorem := do
mkEMatchEqTheoremCore (.decl declName) #[] ( getProofFor declName) normalizePattern useLhs
/--
Adds an E-matching theorem to the environment.
See `mkEMatchTheorem`.
-/
def addEMatchTheorem (declName : Name) (numParams : Nat) (patterns : List Expr) : MetaM Unit := do
ematchTheoremsExt.add ( mkEMatchTheorem declName numParams patterns)
/--
Adds an E-matching equality theorem to the environment.
See `mkEMatchEqTheorem`.
-/
def addEMatchEqTheorem (declName : Name) : MetaM Unit := do
ematchTheoremsExt.add ( mkEMatchEqTheorem declName)
/-- Returns the E-matching theorems registered in the environment. -/
def getEMatchTheorems : CoreM EMatchTheorems :=
return ematchTheoremsExt.getState ( getEnv)
private inductive TheoremKind where
| eqLhs | eqRhs | eqBoth | fwd | bwd | default
deriving Inhabited, BEq
private def TheoremKind.toAttribute : TheoremKind String
| .eqLhs => "[grind =]"
| .eqRhs => "[grind =_]"
| .eqBoth => "[grind _=_]"
| .fwd => "[grind →]"
| .bwd => "[grind ←]"
| .default => "[grind]"
private def TheoremKind.explainFailure : TheoremKind String
| .eqLhs => "failed to find pattern in the left-hand side of the theorem's conclusion"
| .eqRhs => "failed to find pattern in the right-hand side of the theorem's conclusion"
| .eqBoth => unreachable! -- eqBoth is a macro
| .fwd => "failed to find patterns in the antecedents of the theorem"
| .bwd => "failed to find patterns in the theorem's conclusion"
| .default => "failed to find patterns"
/-- Returns the types of `xs` that are propositions. -/
private def getPropTypes (xs : Array Expr) : MetaM (Array Expr) :=
xs.filterMapM fun x => do
let type inferType x
if ( isProp type) then return some type else return none
/-- State for the (pattern) `CollectorM` monad -/
private structure Collector.State where
/-- Pattern found so far. -/
patterns : Array Expr := #[]
done : Bool := false
private structure Collector.Context where
proof : Expr
xs : Array Expr
/-- Monad for collecting patterns for a theorem. -/
private abbrev CollectorM := ReaderT Collector.Context $ StateRefT Collector.State NormalizePattern.M
/-- Similar to `getPatternFn?`, but operates on expressions that do not contain loose de Bruijn variables. -/
private def isPatternFnCandidate (f : Expr) : CollectorM Bool := do
match f with
| .const declName _ => return !isForbidden declName
| .fvar .. => return !( read).xs.contains f
| _ => return false
private def addNewPattern (p : Expr) : CollectorM Unit := do
trace[grind.ematch.pattern.search] "found pattern: {ppPattern p}"
let bvarsFound := ( getThe NormalizePattern.State).bvarsFound
let done := ( checkCoverage ( read).proof ( read).xs.size bvarsFound) matches .ok
if done then
trace[grind.ematch.pattern.search] "found full coverage"
modify fun s => { s with patterns := s.patterns.push p, done }
private partial def collect (e : Expr) : CollectorM Unit := do
if ( get).done then return ()
match e with
| .app .. =>
let f := e.getAppFn
if ( isPatternFnCandidate f) then
let saved getThe NormalizePattern.State
try
trace[grind.ematch.pattern.search] "candidate: {e}"
let p := e.abstract ( read).xs
unless p.hasLooseBVars do
trace[grind.ematch.pattern.search] "skip, does not contain pattern variables"
return ()
let p NormalizePattern.normalizePattern p
if saved.bvarsFound.size < ( getThe NormalizePattern.State).bvarsFound.size then
addNewPattern p
return ()
trace[grind.ematch.pattern.search] "skip, no new variables covered"
-- restore state and continue search
set saved
catch _ =>
trace[grind.ematch.pattern.search] "skip, exception during normalization"
-- restore state and continue search
set saved
let args := e.getAppArgs
for arg in args, flag in ( NormalizePattern.getPatternSupportMask f args.size) do
unless flag do
collect arg
| .forallE _ d b _ =>
if ( pure e.isArrow <&&> isProp d <&&> isProp b) then
collect d
collect b
| _ => return ()
private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option (List Expr × List HeadIndex)) := do
let go : CollectorM (Option (List Expr)) := do
for place in searchPlaces do
let place preprocessPattern place
collect place
if ( get).done then
return some (( get).patterns.toList)
return none
let (some ps, s) go { proof, xs } |>.run' {} |>.run {}
| return none
return some (ps, s.symbols.toList)
def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
if kind == .eqLhs then
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := true))
else if kind == .eqRhs then
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := false))
let type inferType proof
forallTelescopeReducing type fun xs type => do
let searchPlaces match kind with
| .fwd =>
let ps getPropTypes xs
if ps.isEmpty then
throwError "invalid `grind` forward theorem, theorem `{← origin.pp}` does not have propositional hypotheses"
pure ps
| .bwd => pure #[type]
| .default => pure <| #[type] ++ ( getPropTypes xs)
| _ => unreachable!
go xs searchPlaces
where
go (xs : Array Expr) (searchPlaces : Array Expr) : MetaM (Option EMatchTheorem) := do
let some (patterns, symbols) collectPatterns? proof xs searchPlaces
| return none
let numParams := xs.size
trace[grind.ematch.pattern] "{← origin.pp}: {patterns.map ppPattern}"
return some {
proof, patterns, numParams, symbols
levelParams, origin
}
private def getKind (stx : Syntax) : TheoremKind :=
if stx[1].isNone then
.default
else if stx[1][0].getKind == ``Parser.Attr.grindEq then
.eqLhs
else if stx[1][0].getKind == ``Parser.Attr.grindFwd then
.fwd
else if stx[1][0].getKind == ``Parser.Attr.grindEqRhs then
.eqRhs
else if stx[1][0].getKind == ``Parser.Attr.grindEqBoth then
.eqBoth
else
.bwd
private def addGrindEqAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) (useLhs := true) : MetaM Unit := do
if ( getConstInfo declName).isTheorem then
ematchTheoremsExt.add ( mkEMatchEqTheorem declName (normalizePattern := true) (useLhs := useLhs)) attrKind
else if let some eqns getEqnsFor? declName then
unless useLhs do
throwError "`{declName}` is a definition, you must only use the left-hand side for extracting patterns"
for eqn in eqns do
ematchTheoremsExt.add ( mkEMatchEqTheorem eqn) attrKind
else
throwError s!"`{thmKind.toAttribute}` attribute can only be applied to equational theorems or function definitions"
private def addGrindAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) : MetaM Unit := do
if thmKind == .eqLhs then
addGrindEqAttr declName attrKind thmKind (useLhs := true)
else if thmKind == .eqRhs then
addGrindEqAttr declName attrKind thmKind (useLhs := false)
else if thmKind == .eqBoth then
addGrindEqAttr declName attrKind thmKind (useLhs := true)
addGrindEqAttr declName attrKind thmKind (useLhs := false)
else if !( getConstInfo declName).isTheorem then
addGrindEqAttr declName attrKind thmKind
else
let some thm mkEMatchTheoremWithKind? (.decl declName) #[] ( getProofFor declName) thmKind
| throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
ematchTheoremsExt.add thm attrKind
builtin_initialize
registerBuiltinAttribute {
name := `grind
descr :=
"The `[grind]` attribute is used to annotate declarations.\
\
When applied to an equational theorem, `[grind =]`, `[grind =_]`, or `[grind _=_]`\
will mark the theorem for use in heuristic instantiations by the `grind` tactic,
using respectively the left-hand side, the right-hand side, or both sides of the theorem.\
When applied to a function, `[grind =]` automatically annotates the equational theorems associated with that function.\
When applied to a theorem `[grind ←]` will instantiate the theorem whenever it encounters the conclusion of the theorem
(that is, it will use the theorem for backwards reasoning).\
When applied to a theorem `[grind →]` will instantiate the theorem whenever it encounters sufficiently many of the propositional hypotheses
(that is, it will use the theorem for forwards reasoning).\
\
The attribute `[grind]` by itself will effectively try `[grind ←]` (if the conclusion is sufficient for instantiation) and then `[grind →]`.\
\
The `grind` tactic utilizes annotated theorems to add instances of matching patterns into the local context during proof search.\
For example, if a theorem `@[grind =] theorem foo_idempotent : foo (foo x) = foo x` is annotated,\
`grind` will add an instance of this theorem to the local context whenever it encounters the pattern `foo (foo x)`."
applicationTime := .afterCompilation
add := fun declName stx attrKind => do
addGrindAttr declName attrKind (getKind stx) |>.run' {}
erase := fun declName => MetaM.run' do
/-
Remark: consider the following example
```
attribute [grind] foo -- ok
attribute [-grind] foo.eqn_2 -- ok
attribute [-grind] foo -- error
```
One may argue that the correct behavior should be
```
attribute [grind] foo -- ok
attribute [-grind] foo.eqn_2 -- error
attribute [-grind] foo -- ok
```
-/
let throwErr := throwError "`{declName}` is not marked with the `[grind]` attribute"
let info getConstInfo declName
if !info.isTheorem then
if let some eqns getEqnsFor? declName then
let s := ematchTheoremsExt.getState ( getEnv)
unless eqns.all fun eqn => s.contains (.decl eqn) do
throwErr
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s =>
eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
else
throwErr
else
unless ematchTheoremsExt.getState ( getEnv) |>.contains (.decl declName) do
throwErr
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s => s.erase (.decl declName)
}
end Lean.Meta.Grind

View File

@@ -15,81 +15,17 @@ If `parent` is a projection-application `proj_i c`,
check whether the root of the equivalence class containing `c` is a constructor-application `ctor ... a_i ...`.
If so, internalize the term `proj_i (ctor ... a_i ...)` and add the equality `proj_i (ctor ... a_i ...) = a_i`.
-/
def propagateForallPropUp (e : Expr) : GoalM Unit := do
let .forallE n p q bi := e | return ()
trace_goal[grind.debug.forallPropagator] "{e}"
if !q.hasLooseBVars then
propagateImpliesUp p q
else
unless ( isEqTrue p) do return
trace_goal[grind.debug.forallPropagator] "isEqTrue, {e}"
let h₁ mkEqTrueProof p
let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
let r simp qh₁
let q := mkLambda n bi p q
let q' := r.expr
internalize q' ( getGeneration e)
trace_goal[grind.debug.forallPropagator] "q': {q'} for{indentExpr e}"
let h₂ r.getProof
let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
pushEq e q' h
where
propagateImpliesUp (a b : Expr) : GoalM Unit := do
unless ( alreadyInternalized b) do return ()
if ( isEqFalse a) then
-- a = False → (a → b) = True
pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_false_left) a b ( mkEqFalseProof a)
else if ( isEqTrue a) then
-- a = True → (a → b) = b
pushEq e b <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_left) a b ( mkEqTrueProof a)
else if ( isEqTrue b) then
-- b = True → (a → b) = True
pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_right) a b ( mkEqTrueProof b)
private def isEqTrueHyp? (proof : Expr) : Option FVarId := Id.run do
let_expr eq_true _ p := proof | return none
let .fvar fvarId := p | return none
return some fvarId
private def addLocalEMatchTheorems (e : Expr) : GoalM Unit := do
let proof mkEqTrueProof e
let origin if let some fvarId := isEqTrueHyp? proof then
pure <| .fvar fvarId
else
let idx modifyGet fun s => (s.nextThmIdx, { s with nextThmIdx := s.nextThmIdx + 1 })
pure <| .local ((`local).appendIndexAfter idx)
let proof := mkApp2 (mkConst ``of_eq_true) e proof
let size := ( get).newThms.size
let gen getGeneration e
-- TODO: we should have a flag for collecting all unary patterns in a local theorem
if let some thm mkEMatchTheoremWithKind? origin #[] proof .fwd then
activateTheorem thm gen
if let some thm mkEMatchTheoremWithKind? origin #[] proof .bwd then
activateTheorem thm gen
if ( get).newThms.size == size then
if let some thm mkEMatchTheoremWithKind? origin #[] proof .default then
activateTheorem thm gen
if ( get).newThms.size == size then
trace[grind.issues] "failed to create E-match local theorem for{indentExpr e}"
def propagateForallPropDown (e : Expr) : GoalM Unit := do
let .forallE n a b bi := e | return ()
if ( isEqFalse e) then
if b.hasLooseBVars then
let α := a
let p := b
-- `e` is of the form `∀ x : α, p x`
-- Add fact `∃ x : α, ¬ p x`
let u getLevel α
let prop := mkApp2 (mkConst ``Exists [u]) α (mkLambda n bi α (mkNot p))
let proof := mkApp3 (mkConst ``Grind.of_forall_eq_false [u]) α (mkLambda n bi α p) ( mkEqFalseProof e)
addNewFact proof prop ( getGeneration e)
else
let h mkEqFalseProof e
pushEqTrue a <| mkApp3 (mkConst ``Grind.eq_true_of_imp_eq_false) a b h
pushEqFalse b <| mkApp3 (mkConst ``Grind.eq_false_of_imp_eq_false) a b h
else if ( isEqTrue e) then
if b.hasLooseBVars then
addLocalEMatchTheorems e
def propagateForallProp (parent : Expr) : GoalM Unit := do
let .forallE n p q bi := parent | return ()
unless ( isEqTrue p) do return ()
let h₁ mkEqTrueProof p
let qh₁ := q.instantiate1 (mkApp2 (mkConst ``of_eq_true) p h₁)
let r simp qh₁
let q := mkLambda n bi p q
let q' := r.expr
internalize q' ( getGeneration parent)
let h₂ r.getProof
let h := mkApp5 (mkConst ``Lean.Grind.forall_propagator) p q q' h₁ h₂
pushEq parent q' h
end Lean.Meta.Grind

View File

@@ -5,10 +5,7 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Util
import Init.Grind.Lemmas
import Lean.Meta.LitValues
import Lean.Meta.Match.MatcherInfo
import Lean.Meta.Match.MatchEqsExt
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Util
@@ -23,19 +20,15 @@ def addCongrTable (e : Expr) : GoalM Unit := do
let g := e'.getAppFn
unless isSameExpr f g do
unless ( hasSameType f g) do
trace_goal[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
trace[grind.issues] "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
return ()
trace_goal[grind.debug.congr] "{e} = {e'}"
trace[grind.debug.congr] "{e} = {e'}"
pushEqHEq e e' congrPlaceholderProof
let node getENode e
setENode e { node with congr := e' }
else
modify fun s => { s with congrTable := s.congrTable.insert { e } }
/--
Given an application `e` of the form `f a_1 ... a_n`,
adds entry `f ↦ e` to `appMap`. Recall that `appMap` is a multi-map.
-/
private def updateAppMap (e : Expr) : GoalM Unit := do
let key := e.toHeadIndex
modify fun s => { s with
@@ -45,50 +38,6 @@ private def updateAppMap (e : Expr) : GoalM Unit := do
s.appMap.insert key [e]
}
/-- Inserts `e` into the list of case-split candidates. -/
private def addSplitCandidate (e : Expr) : GoalM Unit := do
trace_goal[grind.split.candidate] "{e}"
modify fun s => { s with splitCandidates := e :: s.splitCandidates }
-- TODO: add attribute to make this extensible
private def forbiddenSplitTypes := [``Eq, ``HEq, ``True, ``False]
/-- 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 ( getConfig).splitMatch then
if ( isMatcherApp e) then
if let .reduced _ reduceMatcher? e then
-- When instantiating `match`-equations, we add `match`-applications that can be reduced,
-- and consequently don't need to be splitted.
return ()
else
addSplitCandidate e
return ()
let .const declName _ := e.getAppFn | return ()
if forbiddenSplitTypes.contains declName then return ()
-- We should have a mechanism for letting users to select types to case-split.
-- Right now, we just consider inductive predicates that are not in the forbidden list
if ( getConfig).splitIndPred then
if ( isInductivePredicate declName) then
addSplitCandidate e
/--
If `e` is a `cast`-like term (e.g., `cast h a`), add `HEq e a` to the to-do list.
It could be an E-matching theorem, but we want to ensure it is always applied since
we want to rely on the fact that `cast h a` and `a` are in the same equivalence class.
-/
private def pushCastHEqs (e : Expr) : GoalM Unit := do
match_expr e with
| f@cast α β h a => pushHEq e a (mkApp4 (mkConst ``cast_heq f.constLevels!) α β h a)
| f@Eq.rec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqRec_heq f.constLevels!) α a motive v b h)
| f@Eq.ndrec α a motive v b h => pushHEq e v (mkApp6 (mkConst ``Grind.eqNDRec_heq f.constLevels!) α a motive v b h)
| f@Eq.recOn α a motive b h v => pushHEq e v (mkApp6 (mkConst ``Grind.eqRecOn_heq f.constLevels!) α a motive b h v)
| _ => return ()
mutual
/-- Internalizes the nested ground terms in the given pattern. -/
private partial def internalizePattern (pattern : Expr) (generation : Nat) : GoalM Expr := do
@@ -101,74 +50,51 @@ private partial def internalizePattern (pattern : Expr) (generation : Nat) : Goa
else pattern.withApp fun f args => do
return mkAppN f ( args.mapM (internalizePattern · generation))
partial def activateTheorem (thm : EMatchTheorem) (generation : Nat) : GoalM Unit := do
-- Recall that we use the proof as part of the key for a set of instances found so far.
-- We don't want to use structural equality when comparing keys.
let proof shareCommon thm.proof
let thm := { thm with proof, patterns := ( thm.patterns.mapM (internalizePattern · generation)) }
trace_goal[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
modify fun s => { s with newThms := s.newThms.push thm }
/--
If `Config.matchEqs` is set to `true`, and `f` is `match`-auxiliary function,
adds its equations to `newThms`.
-/
private partial def addMatchEqns (f : Expr) (generation : Nat) : GoalM Unit := do
if !( getConfig).matchEqs then return ()
let .const declName _ := f | return ()
if !( isMatcher declName) then return ()
if ( get).matchEqNames.contains declName then return ()
modify fun s => { s with matchEqNames := s.matchEqNames.insert declName }
for eqn in ( Match.getEquationsFor declName).eqnNames do
-- We disable pattern normalization to prevent the `match`-expression to be reduced.
activateTheorem ( mkEMatchEqTheorem eqn (normalizePattern := false)) generation
private partial def activateTheoremPatterns (fName : Name) (generation : Nat) : GoalM Unit := do
if let some (thms, thmMap) := ( get).thmMap.retrieve? fName then
modify fun s => { s with thmMap }
if let some thms := ( get).thmMap.find? fName then
modify fun s => { s with thmMap := s.thmMap.erase fName }
let appMap := ( get).appMap
for thm in thms do
unless ( get).thmMap.isErased thm.origin do
let symbols := thm.symbols.filter fun sym => !appMap.contains sym
let thm := { thm with symbols }
match symbols with
| [] => activateTheorem thm generation
| _ =>
trace_goal[grind.ematch] "reinsert `{thm.origin.key}`"
modify fun s => { s with thmMap := s.thmMap.insert thm }
let symbols := thm.symbols.filter fun sym => !appMap.contains sym
let thm := { thm with symbols }
match symbols with
| [] =>
-- Recall that we use the proof as part of the key for a set of instances found so far.
-- We don't want to use structural equality when comparing keys.
let proof shareCommon thm.proof
let thm := { thm with proof, patterns := ( thm.patterns.mapM (internalizePattern · generation)) }
trace[grind.ematch] "activated `{thm.origin.key}`, {thm.patterns.map ppPattern}"
modify fun s => { s with newThms := s.newThms.push thm }
| _ =>
trace[grind.ematch] "reinsert `{thm.origin.key}`"
modify fun s => { s with thmMap := s.thmMap.insert thm }
partial def internalize (e : Expr) (generation : Nat) : GoalM Unit := do
if ( alreadyInternalized e) then return ()
trace_goal[grind.internalize] "{e}"
trace[grind.internalize] "{e}"
match e with
| .bvar .. => unreachable!
| .sort .. => return ()
| .fvar .. | .letE .. | .lam .. =>
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
| .forallE _ d b _ =>
| .forallE _ d _ _ =>
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
if ( isProp d <&&> isProp e) then
internalize d generation
registerParent e d
unless b.hasLooseBVars do
internalize b generation
registerParent e b
propagateUp e
| .lit .. | .const .. =>
mkENode e generation
| .mvar ..
| .mdata ..
| .proj .. =>
trace_goal[grind.issues] "unexpected term during internalization{indentExpr e}"
trace[grind.issues] "unexpected term during internalization{indentExpr e}"
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
| .app .. =>
if ( isLitValue e) then
-- We do not want to internalize the components of a literal value.
mkENode e generation
else e.withApp fun f args => do
checkAndAddSplitCandidate e
pushCastHEqs e
addMatchEqns f generation
if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
-- We only internalize the proposition. We can skip the proof because of
-- proof irrelevance

View File

@@ -11,7 +11,6 @@ import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Cases
import Lean.Meta.Tactic.Grind.Injection
import Lean.Meta.Tactic.Grind.Core
import Lean.Meta.Tactic.Grind.Combinators
namespace Lean.Meta.Grind
@@ -22,7 +21,7 @@ private inductive IntroResult where
| newLocal (fvarId : FVarId) (goal : Goal)
deriving Inhabited
private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := do
private def introNext (goal : Goal) : GrindM IntroResult := do
let target goal.mvarId.getType
if target.isArrow then
goal.mvarId.withContext do
@@ -50,7 +49,7 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
-- `p` and `p'` are definitionally equal
goal.mvarId.assign h
return .newHyp fvarId { goal with mvarId := mvarIdNew }
else if target.isLet || target.isForall || target.isLetFun then
else if target.isLet || target.isForall then
let (fvarId, mvarId) goal.mvarId.intro1P
mvarId.withContext do
let localDecl fvarId.getDecl
@@ -59,25 +58,17 @@ private def introNext (goal : Goal) (generation : Nat) : GrindM IntroResult := d
let mvarId mvarId.assert ( mkFreshUserName localDecl.userName) localDecl.type (mkFVar fvarId)
return .newDepHyp { goal with mvarId }
else
let goal := { goal with mvarId }
if target.isLet || target.isLetFun then
let v := ( fvarId.getDecl).value
let r simp v
let x shareCommon (mkFVar fvarId)
let goal GoalM.run' goal <| addNewEq x r.expr ( r.getProof) generation
return .newLocal fvarId goal
else
return .newLocal fvarId goal
return .newLocal fvarId { goal with mvarId }
else
return .done
private def isCasesCandidate (type : Expr) : MetaM Bool := do
let .const declName _ := type.getAppFn | return false
private def isCasesCandidate (fvarId : FVarId) : MetaM Bool := do
let .const declName _ := ( fvarId.getType).getAppFn | return false
isGrindCasesTarget declName
private def applyCases? (goal : Goal) (fvarId : FVarId) : MetaM (Option (List Goal)) := goal.mvarId.withContext do
if ( isCasesCandidate ( fvarId.getType)) then
let mvarIds cases goal.mvarId (mkFVar fvarId)
if ( isCasesCandidate fvarId) then
let mvarIds cases goal.mvarId fvarId
return mvarIds.map fun mvarId => { goal with mvarId }
else
return none
@@ -89,11 +80,11 @@ private def applyInjection? (goal : Goal) (fvarId : FVarId) : MetaM (Option Goal
return none
/-- Introduce new hypotheses (and apply `by_contra`) until goal is of the form `... ⊢ False` -/
partial def intros (generation : Nat) : GrindTactic' := fun goal => do
partial def intros (goal : Goal) (generation : Nat) : GrindM (List Goal) := do
let rec go (goal : Goal) : StateRefT (Array Goal) GrindM Unit := do
if goal.inconsistent then
return ()
match ( introNext goal generation) with
match ( introNext goal) with
| .done =>
if let some mvarId goal.mvarId.byContra? then
go { goal with mvarId }
@@ -117,27 +108,32 @@ partial def intros (generation : Nat) : GrindTactic' := fun goal => do
return goals.toList
/-- Asserts a new fact `prop` with proof `proof` to the given `goal`. -/
def assertAt (proof : Expr) (prop : Expr) (generation : Nat) : GrindTactic' := fun goal => do
if ( isCasesCandidate prop) then
let mvarId goal.mvarId.assert ( mkFreshUserName `h) prop proof
let goal := { goal with mvarId }
intros generation goal
else
let goal GoalM.run' goal do
let r simp prop
let prop' := r.expr
let proof' mkEqMP ( r.getProof) proof
add prop' proof' generation
if goal.inconsistent then return [] else return [goal]
def assertAt (goal : Goal) (proof : Expr) (prop : Expr) (generation : Nat) : GrindM (List Goal) := do
-- TODO: check whether `prop` may benefit from `intros` or not. If not, we should avoid the `assert`+`intros` step and use `Grind.add`
let mvarId goal.mvarId.assert ( mkFreshUserName `h) prop proof
let goal := { goal with mvarId }
intros goal generation
/-- Asserts next fact in the `goal` fact queue. -/
def assertNext : GrindTactic := fun goal => do
def assertNext? (goal : Goal) : GrindM (Option (List Goal)) := do
let some (fact, newFacts) := goal.newFacts.dequeue?
| return none
assertAt fact.proof fact.prop fact.generation { goal with newFacts }
assertAt { goal with newFacts } fact.proof fact.prop fact.generation
partial def iterate (goal : Goal) (f : Goal GrindM (Option (List Goal))) : GrindM (List Goal) := do
go [goal] []
where
go (todo : List Goal) (result : List Goal) : GrindM (List Goal) := do
match todo with
| [] => return result
| goal :: todo =>
if let some goalsNew f goal then
go (goalsNew ++ todo) result
else
go todo (goal :: result)
/-- Asserts all facts in the `goal` fact queue. -/
partial def assertAll : GrindTactic :=
assertNext.iterate
partial def assertAll (goal : Goal) : GrindM (List Goal) := do
iterate goal assertNext?
end Lean.Meta.Grind

View File

@@ -85,9 +85,9 @@ private def checkProofs : GoalM Unit := do
for b in eqc do
unless isSameExpr a b do
let p mkEqHEqProof a b
trace_goal[grind.debug.proofs] "{a} = {b}"
trace[grind.debug.proofs] "{a} = {b}"
check p
trace_goal[grind.debug.proofs] "checked: {← inferType p}"
trace[grind.debug.proofs] "checked: {← inferType p}"
/--
Checks basic invariants if `grind.debug` is enabled.

View File

@@ -14,8 +14,6 @@ import Lean.Meta.Tactic.Grind.Util
import Lean.Meta.Tactic.Grind.Inv
import Lean.Meta.Tactic.Grind.Intro
import Lean.Meta.Tactic.Grind.EMatch
import Lean.Meta.Tactic.Grind.Split
import Lean.Meta.Tactic.Grind.SimpUtil
namespace Lean.Meta.Grind
@@ -24,13 +22,12 @@ def mkMethods (fallback : Fallback) : CoreM Methods := do
return {
fallback
propagateUp := fun e => do
propagateForallPropUp e
propagateForallProp e
let .const declName _ := e.getAppFn | return ()
propagateProjEq e
if let some prop := builtinPropagators.up[declName]? then
prop e
propagateDown := fun e => do
propagateForallPropDown e
let .const declName _ := e.getAppFn | return ()
if let some prop := builtinPropagators.down[declName]? then
prop e
@@ -40,8 +37,12 @@ def GrindM.run (x : GrindM α) (mainDeclName : Name) (config : Grind.Config) (fa
let scState := ShareCommon.State.mk _
let (falseExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``False)
let (trueExpr, scState) := ShareCommon.State.shareCommon scState (mkConst ``True)
let simprocs Grind.getSimprocs
let simp Grind.getSimpContext
let thms grindNormExt.getTheorems
let simprocs := #[( grindNormSimprocExt.getSimprocs)]
let simp Simp.mkContext
(config := { arith := true })
(simpTheorems := #[thms])
(congrTheorems := ( getSimpCongrTheorems))
x ( mkMethods fallback).toMethodsRef { mainDeclName, config, simprocs, simp } |>.run' { scState, trueExpr, falseExpr }
private def mkGoal (mvarId : MVarId) : GrindM Goal := do
@@ -60,7 +61,6 @@ private def initCore (mvarId : MVarId) : GrindM (List Goal) := do
let mvarId mvarId.revertAll
let mvarId mvarId.unfoldReducible
let mvarId mvarId.betaReduce
appendTagSuffix mvarId `grind
let goals intros ( mkGoal mvarId) (generation := 0)
goals.forM (·.checkInvariants (expensive := true))
return goals.filter fun goal => !goal.inconsistent
@@ -70,7 +70,7 @@ def all (goals : List Goal) (f : Goal → GrindM (List Goal)) : GrindM (List Goa
/-- A very simple strategy -/
private def simple (goals : List Goal) : GrindM (List Goal) := do
applyToAll (assertAll >> ematchStar >> (splitNext >> assertAll >> ematchStar).iterate) goals
all goals ematchStar
def main (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Fallback) : MetaM (List MVarId) := do
let go : GrindM (List MVarId) := do

View File

@@ -24,37 +24,30 @@ where
let e' := mkApp2 (mkConst ``Lean.Grind.nestedProof) prop e
modify fun s => s.insert e e'
return e'
-- Remark: we have to process `Expr.proj` since we only
-- fold projections later during term internalization
unless e.isApp || e.isForall || e.isProj do
return e
-- Check whether it is cached
if let some r := ( get).find? e then
return r
let e' match e with
| .app .. => e.withApp fun f args => do
let mut modified := false
let mut args := args
for i in [:args.size] do
let arg := args[i]!
let arg' visit arg
unless ptrEq arg arg' do
args := args.set! i arg'
modified := true
if modified then
pure <| mkAppN f args
else
pure e
| .proj _ _ b =>
pure <| e.updateProj! ( visit b)
| .forallE _ d b _ =>
-- Recall that we have `ForallProp.lean`.
let d' visit d
let b' if b.hasLooseBVars then pure b else visit b
pure <| e.updateForallE! d' b'
| _ => unreachable!
modify fun s => s.insert e e'
return e'
else match e with
| .bvar .. => unreachable!
-- See comments on `Canon.lean` for why we do not visit these cases.
| .letE .. | .forallE .. | .lam ..
| .const .. | .lit .. | .mvar .. | .sort .. | .fvar .. => return e
| .proj _ _ b => return e.updateProj! ( visit b)
| .mdata _ b => return e.updateMData! ( visit b)
-- We only visit applications
| .app .. =>
-- Check whether it is cached
if let some r := ( get).find? e then
return r
e.withApp fun f args => do
let mut modified := false
let mut args := args
for i in [:args.size] do
let arg := args[i]!
let arg' visit arg
unless ptrEq arg arg' do
args := args.set! i arg'
modified := true
let e' := if modified then mkAppN f args else e
modify fun s => s.insert e e'
return e'
/--
Wrap nested proofs `e` with `Lean.Grind.nestedProof`-applications.

View File

@@ -30,7 +30,7 @@ def propagateProjEq (parent : Expr) : GoalM Unit := do
let parentNew shareCommon (mkApp parent.appFn! ctor)
internalize parentNew ( getGeneration parent)
pure parentNew
trace_goal[grind.debug.proj] "{parentNew}"
trace[grind.debug.proj] "{parentNew}"
let idx := info.numParams + info.i
unless idx < ctor.getAppNumArgs do return ()
let v := ctor.getArg! idx

View File

@@ -7,8 +7,6 @@ prelude
import Init.Grind
import Lean.Meta.Tactic.Grind.Proof
import Lean.Meta.Tactic.Grind.PropagatorAttr
import Lean.Meta.Tactic.Grind.Simp
import Lean.Meta.Tactic.Grind.Internalize
namespace Lean.Meta.Grind
@@ -99,8 +97,6 @@ builtin_grind_propagator propagateNotUp ↑Not := fun e => do
else if ( isEqTrue a) then
-- a = True → (Not a) = False
pushEqFalse e <| mkApp2 (mkConst ``Lean.Grind.not_eq_of_eq_true) a ( mkEqTrueProof a)
else if ( isEqv e a) then
closeGoal <| mkApp2 (mkConst ``Lean.Grind.false_of_not_eq_self) a ( mkEqProof e a)
/--
Propagates truth values downwards for a negation expression `Not a` based on the truth value of `Not a`.
@@ -134,13 +130,6 @@ builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
let_expr Eq _ a b := e | return ()
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 <| mkApp2 (mkConst ``of_eq_true) e ( mkEqTrueProof e)
/-- Propagates `HEq` downwards -/
builtin_grind_propagator propagateHEqDown HEq := fun e => do
if ( isEqTrue e) then
@@ -153,32 +142,4 @@ builtin_grind_propagator propagateHEqUp ↑HEq := fun e => do
if ( isEqv a b) then
pushEqTrue e <| mkApp2 (mkConst ``eq_true) e ( mkHEqProof a b)
/-- Propagates `ite` upwards -/
builtin_grind_propagator propagateIte ite := fun e => do
let_expr f@ite α c h a b := e | return ()
if ( isEqTrue c) then
pushEq e a <| mkApp6 (mkConst ``ite_cond_eq_true f.constLevels!) α c h a b ( mkEqTrueProof c)
else if ( isEqFalse c) then
pushEq e b <| mkApp6 (mkConst ``ite_cond_eq_false f.constLevels!) α c h a b ( mkEqFalseProof c)
/-- Propagates `dite` upwards -/
builtin_grind_propagator propagateDIte dite := fun e => do
let_expr f@dite α c h a b := e | return ()
if ( isEqTrue c) then
let h₁ mkEqTrueProof c
let ah₁ := mkApp a (mkApp2 (mkConst ``of_eq_true) c h₁)
let p simp ah₁
let r := p.expr
let h₂ p.getProof
internalize r ( getGeneration e)
pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_true' f.constLevels!) α c h a b r h₁ h₂
else if ( isEqFalse c) then
let h₁ mkEqFalseProof c
let bh₁ := mkApp b (mkApp2 (mkConst ``of_eq_false) c h₁)
let p simp bh₁
let r := p.expr
let h₂ p.getProof
internalize r ( getGeneration e)
pushEq e r <| mkApp8 (mkConst ``Grind.dite_cond_eq_false' f.constLevels!) α c h a b r h₁ h₂
end Lean.Meta.Grind

View File

@@ -9,7 +9,6 @@ import Lean.Meta.Tactic.Assert
import Lean.Meta.Tactic.Simp.Main
import Lean.Meta.Tactic.Grind.Util
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.DoNotSimp
import Lean.Meta.Tactic.Grind.MarkNestedProofs
namespace Lean.Meta.Grind
@@ -34,7 +33,6 @@ def simp (e : Expr) : GrindM Simp.Result := do
let e' eraseIrrelevantMData e'
let e' foldProjs e'
let e' normalizeLevels e'
let e' eraseDoNotSimp e'
let e' canon e'
let e' shareCommon e'
trace[grind.simp] "{e}\n===>\n{e'}"

View File

@@ -1,32 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Simp.Simproc
import Lean.Meta.Tactic.Grind.Simp
import Lean.Meta.Tactic.Grind.DoNotSimp
namespace Lean.Meta.Grind
/-- Returns the array of simprocs used by `grind`. -/
protected def getSimprocs : MetaM (Array Simprocs) := do
let s grindNormSimprocExt.getSimprocs
let s addDoNotSimp s
return #[s, ( Simp.getSEvalSimprocs)]
/-- Returns the simplification context used by `grind`. -/
protected def getSimpContext : MetaM Simp.Context := do
let thms grindNormExt.getTheorems
Simp.mkContext
(config := { arith := true })
(simpTheorems := #[thms])
(congrTheorems := ( getSimpCongrTheorems))
@[export lean_grind_normalize]
def normalizeImp (e : Expr) : MetaM Expr := do
let (r, _) Meta.simp e ( Grind.getSimpContext) ( Grind.getSimprocs)
return r.expr
end Lean.Meta.Grind

View File

@@ -1,126 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Intro
import Lean.Meta.Tactic.Grind.Cases
import Lean.Meta.Tactic.Grind.CasesMatch
namespace Lean.Meta.Grind
inductive CaseSplitStatus where
| resolved
| notReady
| ready
deriving Inhabited, BEq
private def checkCaseSplitStatus (e : Expr) : GoalM CaseSplitStatus := do
match_expr e with
| 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 ( isMatcherApp e) then
return .ready
let .const declName .. := e.getAppFn | unreachable!
if ( isInductivePredicate declName <&&> isEqTrue e) then
return .ready
return .notReady
/-- Returns the next case-split to be performed. It uses a very simple heuristic. -/
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? : Option Expr) (cs' : List Expr) : GoalM (Option Expr) := do
match cs with
| [] =>
modify fun s => { s with splitCandidates := cs'.reverse }
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 := 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 =>
match c? with
| 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')
/-- Constructs a major premise for the `cases` tactic used by `grind`. -/
private def mkCasesMajor (c : Expr) : GoalM Expr := do
match_expr c with
| And a b => return mkApp3 (mkConst ``Grind.or_of_and_eq_false) a b ( mkEqFalseProof c)
| ite _ c _ _ _ => return mkEM c
| dite _ c _ _ _ => return mkEM c
| _ => 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
match goals with
| [] => return acc.reverse
| goal::goals => introNewHyp goals (( intros generation goal) ++ acc) generation
/--
Selects a case-split from the list of candidates,
and returns a new list of goals if successful.
-/
def splitNext : GrindTactic := fun goal => do
let (goals?, _) GoalM.run goal do
let some c selectNextSplit?
| return none
let gen getGeneration c
trace_goal[grind.split] "{c}, generation: {gen}"
let mvarIds if ( isMatcherApp c) then
casesMatch ( get).mvarId c
else
let major mkCasesMajor c
cases ( get).mvarId major
let goal get
let goals := mvarIds.map fun mvarId => { goal with mvarId }
let goals introNewHyp goals [] (gen+1)
return some goals
return goals?
end Lean.Meta.Grind

View File

@@ -29,7 +29,7 @@ def congrPlaceholderProof := mkConst (Name.mkSimple "[congruence]")
/--
Returns `true` if `e` is `True`, `False`, or a literal value.
See `Lean.Meta.LitValues` for supported literals.
See `LitValues` for supported literals.
-/
def isInterpreted (e : Expr) : MetaM Bool := do
if e.isTrue || e.isFalse then return true
@@ -59,16 +59,16 @@ structure CongrTheoremCacheKey where
f : Expr
numArgs : Nat
-- We manually define `BEq` because we want to use pointer equality.
-- We manually define `BEq` because we wannt to use pointer equality.
instance : BEq CongrTheoremCacheKey where
beq a b := isSameExpr a.f b.f && a.numArgs == b.numArgs
-- We manually define `Hashable` because we want to use pointer equality.
-- We manually define `Hashable` because we wannt to use pointer equality.
instance : Hashable CongrTheoremCacheKey where
hash a := mixHash (unsafe ptrAddrUnsafe a.f).toUInt64 (hash a.numArgs)
/-- State for the `GrindM` monad. -/
structure State where
structure CoreState where
canon : Canon.State := {}
/-- `ShareCommon` (aka `Hashconsing`) state. -/
scState : ShareCommon.State.{0} ShareCommon.objectFactory := ShareCommon.State.mk _
@@ -83,17 +83,12 @@ structure State where
simpStats : Simp.Stats := {}
trueExpr : Expr
falseExpr : Expr
/--
Used to generate trace messages of the for `[grind] working on <tag>`,
and implement the macro `trace_goal`.
-/
lastTag : Name := .anonymous
private opaque MethodsRefPointed : NonemptyType.{0}
private def MethodsRef : Type := MethodsRefPointed.type
instance : Nonempty MethodsRef := MethodsRefPointed.property
abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT State MetaM
abbrev GrindM := ReaderT MethodsRef $ ReaderT Context $ StateRefT CoreState MetaM
/-- Returns the user-defined configuration options -/
def getConfig : GrindM Grind.Config :=
@@ -128,12 +123,12 @@ def abstractNestedProofs (e : Expr) : GrindM Expr := do
/--
Applies hash-consing to `e`. Recall that all expressions in a `grind` goal have
been hash-consed. We perform this step before we internalize expressions.
been hash-consing. We perform this step before we internalize expressions.
-/
def shareCommon (e : Expr) : GrindM Expr := do
modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag } =>
modifyGet fun { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats } =>
let (e, scState) := ShareCommon.State.shareCommon scState e
(e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats, lastTag })
(e, { canon, scState, nextThmIdx, congrThms, trueExpr, falseExpr, simpStats })
/--
Canonicalizes nested types, type formers, and instances in `e`.
@@ -198,7 +193,7 @@ structure ENode where
interpreted : Bool := false
/-- `ctor := true` if the head symbol is a constructor application. -/
ctor : Bool := false
/-- `hasLambdas := true` if the equivalence class contains lambda expressions. -/
/-- `hasLambdas := true` if equivalence class contains lambda expressions. -/
hasLambdas : Bool := false
/--
If `heqProofs := true`, then some proofs in the equivalence class are based
@@ -212,6 +207,7 @@ structure ENode where
generation : Nat := 0
/-- Modification time -/
mt : Nat := 0
-- TODO: see Lean 3 implementation
deriving Inhabited, Repr
def ENode.isCongrRoot (n : ENode) :=
@@ -379,22 +375,10 @@ structure Goal where
thmMap : EMatchTheorems
/-- Number of theorem instances generated so far -/
numInstances : Nat := 0
/-- Number of E-matching rounds performed in this goal since the last case-split. -/
numEmatch : Nat := 0
/-- (pre-)instances found so far. It includes instances that failed to be instantiated. -/
preInstances : PreInstanceSet := {}
/-- new facts to be processed. -/
newFacts : Std.Queue NewFact :=
/-- `match` auxiliary functions whose equations have already been created and activated. -/
matchEqNames : PHashSet Name := {}
/-- Case-split candidates. -/
splitCandidates : List Expr := []
/-- Number of splits performed to get to this goal. -/
numSplits : Nat := 0
/-- Case-splits that do not have to be performed anymore. -/
resolvedSplits : PHashSet ENodeKey := {}
/-- Next local E-match theorem idx. -/
nextThmIdx : Nat := 0
deriving Inhabited
def Goal.admit (goal : Goal) : MetaM Unit :=
@@ -408,25 +392,6 @@ abbrev GoalM := StateRefT Goal GrindM
@[inline] def GoalM.run' (goal : Goal) (x : GoalM Unit) : GrindM Goal :=
goal.mvarId.withContext do StateRefT'.run' (x *> get) goal
def updateLastTag : GoalM Unit := do
if ( isTracingEnabledFor `grind) then
let currTag ( get).mvarId.getTag
if currTag != ( getThe Grind.State).lastTag then
trace[grind] "working on goal `{currTag}`"
modifyThe Grind.State fun s => { s with lastTag := currTag }
/--
Macro similar to `trace[...]`, but it includes the trace message `trace[grind] "working on <current goal>"`
if the tag has changed since the last trace message.
-/
macro "trace_goal[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
let msg if s.raw.getKind == interpolatedStrKind then `(m! $(s)) else `(($(s) : MessageData))
`(doElem| do
let cls := $(quote id.getId.eraseMacroScopes)
if ( Lean.isTracingEnabledFor cls) then
updateLastTag
Lean.addTrace cls $msg)
/--
A helper function used to mark a theorem instance found by the E-matching module.
It returns `true` if it is a new instance and `false` otherwise.
@@ -451,14 +416,6 @@ def addTheoremInstance (proof : Expr) (prop : Expr) (generation : Nat) : GoalM U
def checkMaxInstancesExceeded : GoalM Bool := do
return ( get).numInstances >= ( getConfig).instances
/-- Returns `true` if the maximum number of case-splits has been reached. -/
def checkMaxCaseSplit : GoalM Bool := do
return ( get).numSplits >= ( getConfig).splits
/-- Returns `true` if the maximum number of E-matching rounds has been reached. -/
def checkMaxEmatchExceeded : GoalM Bool := do
return ( get).numEmatch >= ( getConfig).ematch
/--
Returns `some n` if `e` has already been "internalized" into the
Otherwise, returns `none`s.
@@ -678,9 +635,7 @@ def mkEqFalseProof (a : Expr) : GoalM Expr := do
/-- Marks current goal as inconsistent without assigning `mvarId`. -/
def markAsInconsistent : GoalM Unit := do
unless ( get).inconsistent do
trace[grind] "closed `{← (← get).mvarId.getTag}`"
modify fun s => { s with inconsistent := true }
modify fun s => { s with inconsistent := true }
/--
Closes the current goal using the given proof of `False` and
@@ -769,17 +724,4 @@ partial def getEqcs : GoalM (List (List Expr)) := do
r := ( getEqc node.self) :: r
return r
/-- Returns `true` if `e` is a case-split that does not need to be performed anymore. -/
def isResolvedCaseSplit (e : Expr) : GoalM Bool :=
return ( get).resolvedSplits.contains { expr := e }
/--
Mark `e` as a case-split that does not need to be performed anymore.
Remark: we currently use this feature to disable `match`-case-splits
-/
def markCaseSplitAsResolved (e : Expr) : GoalM Unit := do
unless ( isResolvedCaseSplit e) do
trace_goal[grind.split.resolved] "{e}"
modify fun s => { s with resolvedSplits := s.resolvedSplits.insert { expr := e } }
end Lean.Meta.Grind

View File

@@ -100,14 +100,12 @@ def _root_.Lean.MVarId.clearAuxDecls (mvarId : MVarId) : MetaM MVarId := mvarId.
/--
In the `grind` tactic, during `Expr` internalization, we don't expect to find `Expr.mdata`.
This function ensures `Expr.mdata` is not found during internalization.
Recall that we do not internalize `Expr.lam` children.
Recall that we still have to process `Expr.forallE` because of `ForallProp.lean`.
Moreover, we may not want to reduce `p → q` to `¬p q` when `(p q : Prop)`.
Recall that we do not internalize `Expr.forallE` and `Expr.lam` components.
-/
def eraseIrrelevantMData (e : Expr) : CoreM Expr := do
let pre (e : Expr) := do
match e with
| .letE .. | .lam .. => return .done e
| .letE .. | .lam .. | .forallE .. => return .done e
| .mdata _ e => return .continue e
| _ => return .continue e
Core.transform e (pre := pre)
@@ -118,14 +116,11 @@ Converts nested `Expr.proj`s into projection applications if possible.
def foldProjs (e : Expr) : MetaM Expr := do
let post (e : Expr) := do
let .proj structName idx s := e | return .done e
let some info := getStructureInfo? ( getEnv) structName |
trace[grind.issues] "found `Expr.proj` but `{structName}` is not marked as structure{indentExpr e}"
return .done e
let some info := getStructureInfo? ( getEnv) structName | return .done e
if h : idx < info.fieldNames.size then
let fieldName := info.fieldNames[idx]
return .done ( mkProjection s fieldName)
else
trace[grind.issues] "found `Expr.proj` with invalid field index `{idx}`{indentExpr e}"
return .done e
Meta.transform e (post := post)
@@ -140,11 +135,4 @@ def normalizeLevels (e : Expr) : CoreM Expr := do
| _ => return .continue
Core.transform e (pre := pre)
/--
Normalizes the given expression using the `grind` simplification theorems and simprocs.
This function is used for normalzing E-matching patterns. Note that it does not return a proof.
-/
@[extern "lean_grind_normalize"] -- forward definition
opaque normalize (e : Expr) : MetaM Expr
end Lean.Meta.Grind

View File

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Leonardo de Moura, Gabriel Ebner, Mario Carneiro
-/
prelude
import Lean.Parser
import Lean.PrettyPrinter.Delaborator.Attributes
import Lean.PrettyPrinter.Delaborator.Basic
import Lean.PrettyPrinter.Delaborator.SubExpr

View File

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Marc Huisinga
-/
prelude
import Lean.Server.Completion.CompletionCollectors
import Std.Data.HashMap
namespace Lean.Server.Completion
open Lsp

View File

@@ -5,8 +5,8 @@ Authors: Leonardo de Moura
-/
prelude
import Init.ShareCommon
import Std.Data.HashSet.Basic
import Std.Data.HashMap.Basic
import Std.Data.HashSet
import Std.Data.HashMap
import Lean.Data.PersistentHashMap
import Lean.Data.PersistentHashSet

View File

@@ -293,16 +293,13 @@ def registerTraceClass (traceClassName : Name) (inherited := false) (ref : Name
if inherited then
inheritedTraceOptions.modify (·.insert optionName)
def expandTraceMacro (id : Syntax) (s : Syntax) : MacroM (TSyntax `doElem) := do
let msg if s.getKind == interpolatedStrKind then `(m! $(s)) else `(($(s) : MessageData))
macro "trace[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
let msg if s.raw.getKind == interpolatedStrKind then `(m! $(s)) else `(($(s) : MessageData))
`(doElem| do
let cls := $(quote id.getId.eraseMacroScopes)
if ( Lean.isTracingEnabledFor cls) then
Lean.addTrace cls $msg)
macro "trace[" id:ident "]" s:(interpolatedStr(term) <|> term) : doElem => do
expandTraceMacro id s.raw
def bombEmoji := "💥️"
def checkEmoji := "✅️"
def crossEmoji := "❌️"

View File

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Data.HashMap
import Std.Data.HashSet
namespace Std

View File

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Josh Clune
-/
prelude
import Init.Data.Array
import Std.Tactic.BVDecide.LRAT.Internal.Formula.Class
import Std.Tactic.BVDecide.LRAT.Internal.Assignment
import Std.Sat.CNF.Basic

View File

@@ -156,7 +156,7 @@ theorem or_congr (lhs rhs lhs' rhs' : Bool) (h1 : lhs' = lhs) (h2 : rhs' = rhs)
theorem cond_congr (discr lhs rhs discr' lhs' rhs' : Bool) (h1 : discr' = discr) (h2 : lhs' = lhs)
(h3 : rhs' = rhs) :
(bif discr' then lhs' else rhs') = (bif discr then lhs else rhs) := by
(bif discr' = true then lhs' else rhs') = (bif discr = true then lhs else rhs) := by
simp[*]
theorem false_of_eq_true_of_eq_false (h₁ : x = true) (h₂ : x = false) : False := by

View File

@@ -5,6 +5,7 @@ Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal
import Init.Data.Int
import Init.System.IO
import Std.Time.Time
import Std.Time.Date

View File

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Init.Omega
import Init.Data.Int
namespace Std
namespace Time

View File

@@ -1,2 +1 @@
inductionParse.lean:4:14-4:18: error: alternative 'zero' has not been provided
inductionParse.lean:4:14-4:18: error: alternative 'succ' has not been provided
inductionParse.lean:4:18-5:6: error: unexpected identifier; expected '|'

View File

@@ -1,13 +0,0 @@
/-!
# `rintro` and `intro` error message should point to excess arg
Below, the errors should point to `h` because there is no lambda it binds.
The error should not point to `hn`; it would be OKish to underline the whole line. -/
example : ( n : Nat, n < 0) False := by
rintro n, hn h
--^ collectDiagnostics
example : ( n : Nat, n < 0) False := by
intro n, hn h
--^ collectDiagnostics

View File

@@ -1,22 +0,0 @@
{"version": 1,
"uri": "file:///5659.lean",
"diagnostics":
[{"source": "Lean 4",
"severity": 1,
"range":
{"start": {"line": 7, "character": 17}, "end": {"line": 7, "character": 18}},
"message":
"tactic 'introN' failed, insufficient number of binders\ncase intro\nn : Nat\nhn : n < 0\n⊢ False",
"fullRange":
{"start": {"line": 7, "character": 17},
"end": {"line": 7, "character": 18}}},
{"source": "Lean 4",
"severity": 1,
"range":
{"start": {"line": 11, "character": 16},
"end": {"line": 11, "character": 17}},
"message":
"tactic 'introN' failed, insufficient number of binders\nn : Nat\nhn : n < 0\n⊢ False",
"fullRange":
{"start": {"line": 11, "character": 16},
"end": {"line": 11, "character": 17}}}]}

View File

@@ -12,12 +12,11 @@ t 2
[{"source": "Lean 4",
"severity": 1,
"range":
{"start": {"line": 4, "character": 12}, "end": {"line": 4, "character": 13}},
{"start": {"line": 4, "character": 4}, "end": {"line": 4, "character": 13}},
"message":
"tactic 'introN' failed, insufficient number of binders\na n : Nat\n⊢ True",
"fullRange":
{"start": {"line": 4, "character": 12},
"end": {"line": 4, "character": 13}}},
{"start": {"line": 4, "character": 4}, "end": {"line": 4, "character": 13}}},
{"source": "Lean 4",
"severity": 1,
"range":

View File

@@ -1,43 +0,0 @@
import Lean
open Lean Meta Grind Elab Tactic in
elab "cases' " e:term : tactic => withMainContext do
let e elabTerm e none
setGoals ( Grind.cases ( getMainGoal) e)
inductive Vec (α : Type u) : Nat Type u
| nil : Vec α 0
| cons : α Vec α n Vec α (n+1)
def f (v : Vec α n) : Bool :=
match v with
| .nil => true
| .cons .. => false
/--
info: n : Nat
v : Vec Nat n
h : f v ≠ false
⊢ n + 1 = 0 → HEq (Vec.cons 10 v) Vec.nil → False
---
info: n : Nat
v : Vec Nat n
h : f v ≠ false
⊢ ∀ {n_1 : Nat} (a : Nat) (a_1 : Vec Nat n_1), n + 1 = n_1 + 1 → HEq (Vec.cons 10 v) (Vec.cons a a_1) → False
-/
#guard_msgs (info) in
example (v : Vec Nat n) (h : f v false) : False := by
cases' (Vec.cons 10 v)
next => trace_state; sorry
next => trace_state; sorry
/--
info: ⊢ False → False
---
info: ⊢ True → False
-/
#guard_msgs (info) in
example : False := by
cases' (Or.inr (a := False) True.intro)
next => trace_state; sorry
next => trace_state; sorry

View File

@@ -1,182 +0,0 @@
universe v v₁ v₂ v₃ u u₁ u₂ u₃
namespace CategoryTheory
macro "cat_tac" : tactic => `(tactic| (intros; (try ext); grind))
class Category (obj : Type u) : Type max u (v + 1) where
Hom : obj obj Type v
/-- The identity morphism on an object. -/
id : X : obj, Hom X X
/-- Composition of morphisms in a category, written `f ≫ g`. -/
comp : {X Y Z : obj}, (Hom X Y) (Hom Y Z) (Hom X Z)
/-- Identity morphisms are left identities for composition. -/
id_comp : {X Y : obj} (f : Hom X Y), comp (id X) f = f := by cat_tac
/-- Identity morphisms are right identities for composition. -/
comp_id : {X Y : obj} (f : Hom X Y), comp f (id Y) = f := by cat_tac
/-- Composition in a category is associative. -/
assoc : {W X Y Z : obj} (f : Hom W X) (g : Hom X Y) (h : Hom Y Z), comp (comp f g) h = comp f (comp g h) := by cat_tac
infixr:10 "" => Category.Hom
scoped notation "𝟙" => Category.id -- type as \b1
scoped infixr:80 "" => Category.comp
attribute [simp] Category.id_comp Category.comp_id Category.assoc
attribute [grind =] Category.id_comp Category.comp_id
attribute [grind _=_] Category.assoc
structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D] : Type max v₁ v₂ u₁ u₂ where
/-- The action of a functor on objects. -/
obj : C D
/-- The action of a functor on morphisms. -/
map : {X Y : C}, (X Y) ((obj X) (obj Y))
/-- A functor preserves identity morphisms. -/
map_id : X : C, map (𝟙 X) = 𝟙 (obj X) := by cat_tac
/-- A functor preserves composition. -/
map_comp : {X Y Z : C} (f : X Y) (g : Y Z), map (f g) = (map f) (map g) := by cat_tac
attribute [simp] Functor.map_id Functor.map_comp
attribute [grind =] Functor.map_id
attribute [grind _=_] Functor.map_comp
variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃} [Category.{v₃} E]
variable {F G H : Functor C D}
namespace Functor
def comp (F : Functor C D) (G : Functor D E) : Functor C E where
obj X := G.obj (F.obj X)
map f := G.map (F.map f)
-- Note `map_id` and `map_comp` are handled by `cat_tac`.
variable {X Y : C} {G : Functor D E}
@[simp, grind =] theorem comp_obj : (F.comp G).obj X = G.obj (F.obj X) := rfl
@[simp, grind =] theorem comp_map (f : X Y) : (F.comp G).map f = G.map (F.map f) := rfl
end Functor
@[ext]
structure NatTrans [Category.{v₁, u₁} C] [Category.{v₂, u₂} D] (F G : Functor C D) : Type max u₁ v₂ where
/-- The component of a natural transformation. -/
app : X : C, F.obj X G.obj X
/-- The naturality square for a given morphism. -/
naturality : X Y : C (f : X Y), F.map f app Y = app X G.map f := by cat_tac
attribute [simp, grind =] NatTrans.naturality
namespace NatTrans
variable {X : C}
protected def id (F : Functor C D) : NatTrans F F where app X := 𝟙 (F.obj X)
@[simp, grind =] theorem id_app : (NatTrans.id F).app X = 𝟙 (F.obj X) := rfl
protected def vcomp (α : NatTrans F G) (β : NatTrans G H) : NatTrans F H where
app X := α.app X β.app X
-- `naturality` is now handled by `grind`; in Mathlib this relies on `@[reassoc]` attributes.
-- Manual proof:
-- rw [← Category.assoc]
-- rw [α.naturality f]
-- rw [Category.assoc]
-- rw [β.naturality f]
-- rw [← Category.assoc]
@[simp, grind =] theorem vcomp_app (α : NatTrans F G) (β : NatTrans G H) (X : C) :
(α.vcomp β).app X = α.app X β.app X := rfl
end NatTrans
instance Functor.category : Category.{max u₁ v₂} (Functor C D) where
Hom F G := NatTrans F G
id F := NatTrans.id F
comp α β := NatTrans.vcomp α β
-- Here we're okay: all the proofs are handled by `cat_tac`.
@[simp, grind =]
theorem id_app (F : Functor C D) (X : C) : (𝟙 F : F F).app X = 𝟙 (F.obj X) := rfl
@[simp, grind _=_]
theorem comp_app {F G H : Functor C D} (α : F G) (β : G H) (X : C) :
(α β).app X = α.app X β.app X := rfl
theorem app_naturality {F G : Functor C (Functor D E)} (T : F G) (X : C) {Y Z : D} (f : Y Z) :
(F.obj X).map f (T.app X).app Z = (T.app X).app Y (G.obj X).map f := by
cat_tac
theorem naturality_app {F G : Functor C (Functor D E)} (T : F G) (Z : D) {X Y : C} (f : X Y) :
(F.map f).app Z (T.app Y).app Z = (T.app X).app Z (G.map f).app Z := by
cat_tac -- this is done manually in Mathlib!
-- rw [← comp_app]
-- rw [T.naturality f]
-- rw [comp_app]
open Category Functor NatTrans
def hcomp {H I : Functor D E} (α : F G) (β : H I) : F.comp H G.comp I where
app := fun X : C => β.app (F.obj X) I.map (α.app X)
-- `grind` can now handle `naturality`, while Mathlib does this manually:
-- rw [Functor.comp_map, Functor.comp_map, ← assoc, naturality, assoc, ← I.map_comp, naturality,
-- map_comp, assoc]
structure Iso {C : Type u} [Category.{v} C] (X Y : C) where
hom : X Y
inv : Y X
hom_inv_id : hom inv = 𝟙 X := by cat_tac
inv_hom_id : inv hom = 𝟙 Y := by cat_tac
attribute [grind =] Iso.hom_inv_id Iso.inv_hom_id
/-- Notation for an isomorphism in a category. -/
infixr:10 "" => Iso -- type as \cong or \iso
variable {C : Type u} [Category.{v} C] {X Y Z : C}
namespace Iso
@[ext]
theorem ext α β : X Y (w : α.hom = β.hom) : α = β :=
suffices α.inv = β.inv by
cases α
cases β
cases w
cases this
rfl
calc
α.inv = α.inv β.hom β.inv := by grind
_ = β.inv := by grind
/-- `LeftInverse g f` means that g is a left inverse to f. That is, `g ∘ f = id`. -/
def Function.LeftInverse (g : β α) (f : α β) : Prop :=
x, g (f x) = x
/-- `RightInverse g f` means that g is a right inverse to f. That is, `f ∘ g = id`. -/
def Function.RightInverse (g : β α) (f : α β) : Prop :=
LeftInverse f g
open Function
/-- `α ≃ β` is the type of functions from `α → β` with a two-sided inverse. -/
structure Equiv (α : Sort _) (β : Sort _) where
protected toFun : α β
protected invFun : β α
protected left_inv : LeftInverse invFun toFun
protected right_inv : RightInverse invFun toFun
@[inherit_doc]
infixl:25 "" => Equiv
attribute [local grind] Function.LeftInverse in
/-- The bijection `(Z ⟶ X) ≃ (Z ⟶ Y)` induced by `α : X ≅ Y`. -/
def homToEquiv (α : X Y) {Z : C} : (Z X) (Z Y) where
toFun f := f α.hom
invFun g := g α.inv
left_inv := by cat_tac
right_inv := sorry
end Iso
end CategoryTheory

View File

@@ -1,6 +1,5 @@
set_option trace.grind.ematch.pattern true
attribute [grind =] Array.size_set
grind_pattern Array.size_set => Array.set a i v h
set_option grind.debug true
@@ -22,10 +21,12 @@ example (as bs : Array α) (v : α)
set_option trace.grind.ematch.instance true
attribute [grind =] Array.get_set_ne
grind_pattern Array.get_set_eq => a.set i v h
grind_pattern Array.get_set_ne => (a.set i v hi)[j]
/--
info: [grind.ematch.instance] Array.size_set: (as.set i v ⋯).size = as.size
info: [grind.ematch.instance] Array.get_set_eq: (as.set i v ⋯)[i] = v
[grind.ematch.instance] Array.size_set: (as.set i v ⋯).size = as.size
[grind.ematch.instance] Array.get_set_ne: ∀ (hj : j < as.size), i ≠ j → (as.set i v ⋯)[j] = as[j]
-/
#guard_msgs (info) in
@@ -68,151 +69,3 @@ info: [grind.ematch.instance] Rtrans: R a d → R d e → R a e
#guard_msgs (info) in
example : R a b R b c R c d R d e R a d := by
grind
namespace using_grind_fwd
opaque S : Nat Nat Prop
/--
error: `@[grind →] theorem using_grind_fwd.StransBad` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
-/
#guard_msgs (error) in
@[grind] theorem StransBad (a b c d : Nat) : S a b R a b S b c S a c S b d := sorry
set_option trace.grind.ematch.pattern.search true in
/--
info: [grind.ematch.pattern.search] candidate: S a b
[grind.ematch.pattern.search] found pattern: S #4 #3
[grind.ematch.pattern.search] candidate: R a b
[grind.ematch.pattern.search] skip, no new variables covered
[grind.ematch.pattern.search] candidate: S b c
[grind.ematch.pattern.search] found pattern: S #3 #2
[grind.ematch.pattern.search] found full coverage
[grind.ematch.pattern] Strans: [S #4 #3, S #3 #2]
-/
#guard_msgs (info) in
@[grind] theorem Strans (a b c : Nat) : S a b R a b S b c S a c := sorry
/--
info: [grind.ematch.instance] Strans: S a b R a b → S b c → S a c
-/
#guard_msgs (info) in
example : S a b S b c S a c := by
grind
end using_grind_fwd
namespace using_grind_bwd
opaque P : Nat Prop
opaque Q : Nat Prop
opaque f : Nat Nat Nat
/--
info: [grind.ematch.pattern] pqf: [P (f #2 #1)]
-/
#guard_msgs (info) in
@[grind] theorem pqf : Q x P (f x y) := sorry
/--
info: [grind.ematch.instance] pqf: Q a → P (f a b)
-/
#guard_msgs (info) in
example : Q 0 Q 1 Q 2 Q 3 ¬ P (f a b) a = 1 False := by
grind
end using_grind_bwd
namespace using_grind_fwd2
opaque P : Nat Prop
opaque Q : Nat Prop
opaque f : Nat Nat Nat
/--
error: `@[grind →] theorem using_grind_fwd2.pqfBad` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
-/
#guard_msgs (error) in
@[grind] theorem pqfBad : Q x P (f x y) := sorry
/--
info: [grind.ematch.pattern] pqf: [Q #1]
-/
#guard_msgs (info) in
@[grind] theorem pqf : Q x P (f x x) := sorry
/--
info: [grind.ematch.instance] pqf: Q 3 → P (f 3 3)
[grind.ematch.instance] pqf: Q 2 → P (f 2 2)
[grind.ematch.instance] pqf: Q 1 → P (f 1 1)
[grind.ematch.instance] pqf: Q 0 → P (f 0 0)
-/
#guard_msgs (info) in
example : Q 0 Q 1 Q 2 Q 3 ¬ P (f a a) a = 1 False := by
grind
end using_grind_fwd2
namespace using_grind_mixed
opaque P : Nat Nat Prop
opaque Q : Nat Nat Prop
/--
error: `@[grind →] theorem using_grind_mixed.pqBad1` failed to find patterns in the antecedents of the theorem, consider using different options or the `grind_pattern` command
-/
#guard_msgs (error) in
@[grind] theorem pqBad1 : P x y Q x z := sorry
/--
error: `@[grind ←] theorem using_grind_mixed.pqBad2` failed to find patterns in the theorem's conclusion, consider using different options or the `grind_pattern` command
-/
#guard_msgs (error) in
@[grind] theorem pqBad2 : P x y Q x z := sorry
/--
info: [grind.ematch.pattern] pqBad: [Q #3 #1, P #3 #2]
-/
#guard_msgs (info) in
@[grind] theorem pqBad : P x y Q x z := sorry
example : P a b Q a c := by
grind
end using_grind_mixed
namespace using_grind_rhs
opaque f : Nat Nat
opaque g : Nat Nat Nat
/--
info: [grind.ematch.pattern] fq: [g #0 (f #0)]
-/
#guard_msgs (info) in
@[grind =_]
theorem fq : f x = g x (f x) := sorry
end using_grind_rhs
namespace using_grind_lhs_rhs
opaque f : Nat Nat
opaque g : Nat Nat Nat
/--
info: [grind.ematch.pattern] fq: [f #0]
[grind.ematch.pattern] fq: [g #0 (g #0 #0)]
-/
#guard_msgs (info) in
@[grind _=_]
theorem fq : f x = g x (g x x) := sorry
end using_grind_lhs_rhs
-- the following should still work
#check _=_

View File

@@ -1,4 +1,6 @@
attribute [grind =] Array.size_set Array.get_set_eq Array.get_set_ne
grind_pattern Array.size_set => Array.set a i v h
grind_pattern Array.get_set_eq => a.set i v h
grind_pattern Array.get_set_ne => (a.set i v hi)[j]
set_option grind.debug true
set_option trace.grind.ematch.pattern true
@@ -55,7 +57,8 @@ example (as bs cs ds : Array α) (v₁ v₂ v₃ : α)
grind
opaque f (a b : α) : α := a
@[grind =] theorem fx : f x (f x x) = x := sorry
theorem fx : f x (f x x) = x := sorry
grind_pattern fx => f x (f x x)
/--
info: [grind.ematch.instance] fx: f a (f a a) = a
@@ -63,30 +66,3 @@ info: [grind.ematch.instance] fx: f a (f a a) = a
#guard_msgs (info) in
example : a = b₁ c = f b₁ b₂ f a c a a = b₂ False := by
grind
namespace pattern_normalization
opaque g : Nat Nat
@[grind_norm] theorem gthm : g x = x := sorry
opaque f : Nat Nat Nat
theorem fthm : f (g x) x = x := sorry
-- The following pattern should be normalized by `grind`. Otherwise, we will not find any instance during E-matching.
/--
info: [grind.ematch.pattern] fthm: [f #0 #0]
-/
#guard_msgs (info) in
grind_pattern fthm => f (g x) x
/--
info: [grind.assert] f x y = b
[grind.assert] y = x
[grind.assert] ¬b = x
[grind.ematch.instance] fthm: f (g y) y = y
[grind.assert] f y y = y
-/
#guard_msgs (info) in
set_option trace.grind.assert true in
example : f (g x) y = b y = x b = x := by
grind
end pattern_normalization

View File

@@ -1,78 +0,0 @@
opaque g : Nat Nat
set_option trace.Meta.debug true
@[grind] def f (a : Nat) :=
match a with
| 0 => 10
| x+1 => g (f x)
set_option grind.debug true
set_option grind.debug.proofs true
set_option trace.grind.ematch.instance true
set_option trace.grind.assert true
/--
info: [grind.assert] f (y + 1) = a
[grind.assert] ¬a = g (f y)
[grind.ematch.instance] f.eq_2: f y.succ = g (f y)
[grind.assert] f (y + 1) = g (f y)
-/
#guard_msgs (info) in
example : f (y + 1) = a a = g (f y):= by
grind
@[grind] def app (xs ys : List α) :=
match xs with
| [] => ys
| x::xs => x :: app xs ys
/--
info: [grind.assert] app [1, 2] ys = xs
[grind.assert] ¬xs = 1 :: 2 :: ys
[grind.ematch.instance] app.eq_2: app [1, 2] ys = 1 :: app [2] ys
[grind.assert] app [1, 2] ys = 1 :: app [2] ys
[grind.ematch.instance] app.eq_2: app [2] ys = 2 :: app [] ys
[grind.assert] app [2] ys = 2 :: app [] ys
[grind.ematch.instance] app.eq_1: app [] ys = ys
[grind.assert] app [] ys = ys
-/
#guard_msgs (info) in
example : app [1, 2] ys = xs xs = 1::2::ys := by
grind
opaque p : Nat Nat Prop
opaque q : Nat Prop
@[grind =] theorem pq : p x x q x := by sorry
/--
info: [grind.assert] p a a
[grind.assert] ¬q a
[grind.ematch.instance] pq: p a a ↔ q a
[grind.assert] p a a = q a
-/
#guard_msgs (info) in
example : p a a q a := by
grind
opaque appV (xs : Vector α n) (ys : Vector α m) : Vector α (n + m) :=
Vector.append xs ys
@[grind =]
theorem appV_assoc (a : Vector α n) (b : Vector α m) (c : Vector α n') :
HEq (appV a (appV b c)) (appV (appV a b) c) := sorry
/--
info: [grind.assert] x1 = appV a b
[grind.assert] x2 = appV x1 c
[grind.assert] x3 = appV b c
[grind.assert] x4 = appV a x3
[grind.assert] ¬HEq x2 x4
[grind.ematch.instance] appV_assoc: HEq (appV a (appV b c)) (appV (appV a b) c)
[grind.assert] HEq (appV a (appV b c)) (appV (appV a b) c)
-/
#guard_msgs (info) in
example : x1 = appV a b x2 = appV x1 c x3 = appV b c x4 = appV a x3 HEq x2 x4 := by
grind

View File

@@ -1,83 +0,0 @@
opaque f : Nat Nat
@[grind] theorem fthm : f (f x) = f x := sorry
theorem fthm' : f (f x) = x := sorry
/--
error: `fthm'` is not marked with the `[grind]` attribute
-/
#guard_msgs in
attribute [-grind] fthm'
set_option trace.grind.assert true
/--
info: [grind.assert] ¬f (f (f a)) = f a
[grind.assert] f (f (f a)) = f (f a)
[grind.assert] f (f a) = f a
-/
#guard_msgs (info) in
example : f (f (f a)) = f a := by
grind
attribute [-grind] fthm
/--
error: `grind` failed
case grind
a : Nat
x✝ : ¬f (f (f a)) = f a
⊢ False
---
info: [grind.assert] ¬f (f (f a)) = f a
-/
#guard_msgs (info, error) in
example : f (f (f a)) = f a := by
grind
/--
error: `fthm` is not marked with the `[grind]` attribute
-/
#guard_msgs in
attribute [-grind] fthm
attribute [grind] fthm
example : f (f (f a)) = f a := by
grind
def g (x : Nat) :=
match x with
| 0 => 1
| x+1 => 2 * g x
attribute [grind] g
example : g a = b a = 0 b = 1 := by
grind
attribute [-grind] g
/--
error: `grind` failed
case grind
a b : Nat
a✝¹ : g a = b
a✝ : a = 0
x✝ : ¬b = 1
⊢ False
---
info: [grind.assert] g a = b
[grind.assert] a = 0
[grind.assert] ¬b = 1
-/
#guard_msgs (info, error) in
example : g a = b a = 0 b = 1 := by
grind
/--
error: `g` is not marked with the `[grind]` attribute
-/
#guard_msgs in
attribute [-grind] g

View File

@@ -1,87 +0,0 @@
set_option trace.grind.eqc true
set_option trace.grind.internalize true
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.eqc] (p → q) = True
[grind.eqc] p = True
[grind.eqc] (p → q) = q
[grind.eqc] q = False
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) p q := by
grind
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.eqc] (p → q) = True
[grind.eqc] q = False
[grind.eqc] p = True
[grind.eqc] (p → q) = q
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) ¬q ¬p := by
grind
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.internalize] r
[grind.eqc] (p → q) = r
[grind.eqc] p = False
[grind.eqc] (p → q) = True
[grind.eqc] r = False
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) = r ¬p r := by
grind
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.internalize] r
[grind.eqc] (p → q) = r
[grind.eqc] q = True
[grind.eqc] (p → q) = True
[grind.eqc] r = False
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) = r q r := by
grind
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.internalize] r
[grind.eqc] (p → q) = r
[grind.eqc] q = False
[grind.eqc] r = True
[grind.eqc] p = True
[grind.eqc] (p → q) = q
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) = r ¬q r ¬p := by
grind
/--
info: [grind.internalize] p → q
[grind.internalize] p
[grind.internalize] q
[grind.internalize] r
[grind.eqc] (p → q) = r
[grind.eqc] q = False
[grind.eqc] r = False
[grind.eqc] p = True
[grind.eqc] p = False
-/
#guard_msgs (info) in
example (p q : Prop) : (p q) = r ¬q ¬r p := by
grind

View File

@@ -1,67 +0,0 @@
def g (xs : List α) (ys : List α) :=
match xs, ys with
| [], _ => ys
| _::_::_, [ ] => []
| x::xs, ys => x :: g xs ys
attribute [simp] g
set_option trace.grind.assert true
set_option trace.grind.split.candidate true
set_option trace.grind.split.resolved true
/--
info: [grind.assert] (match as, bs with
| [], x => bs
| head :: head_1 :: tail, [] => []
| x :: xs, ys => x :: g xs ys) =
d
[grind.split.candidate] match as, bs with
| [], x => bs
| head :: head_1 :: tail, [] => []
| x :: xs, ys => x :: g xs ys
[grind.assert] bs = []
[grind.assert] a₁ :: f 0 = as
[grind.assert] f 0 = a₂ :: f 1
[grind.assert] ¬d = []
[grind.assert] Lean.Grind.EqMatch
(match a₁ :: a₂ :: f 1, [] with
| [], x => bs
| head :: head_1 :: tail, [] => []
| x :: xs, ys => x :: g xs ys)
[]
[grind.split.resolved] match as, bs with
| [], x => bs
| head :: head_1 :: tail, [] => []
| x :: xs, ys => x :: g xs ys
-/
#guard_msgs (info) in
example (f : Nat List Nat) : g as bs = d bs = [] a₁ :: f 0 = as f 0 = a₂ :: f 1 d = [] := by
unfold g
grind
example : g as bs = d as = [] d = bs := by
unfold g
grind
def f (x : List α) : Bool :=
match x with
| [] => true
| _::_ => false
example : f a = b a = [] b = true := by
unfold f
grind
def f' (x : List Nat) : Bool :=
match x with
| [] => true
| _::_ => false
attribute [simp] f'
#check f'.match_1.eq_1
example : f' a = b a = [] b = true := by
unfold f'
grind

View File

@@ -1,33 +0,0 @@
def g (a : α) (as : List α) : List α :=
match as with
| [] => [a]
| b::bs => a::a::b::bs
set_option trace.grind true in
set_option trace.grind.assert true in
example : ¬ (g a as).isEmpty := by
unfold List.isEmpty
unfold g
grind
def h (as : List Nat) :=
match as with
| [] => 1
| [_] => 2
| _::_::_ => 3
/--
info: [grind] closed `grind.1`
[grind] closed `grind.2`
[grind] closed `grind.3`
-/
#guard_msgs (info) in
set_option trace.grind true in
example : h as 0 := by
unfold h
grind
example : h as 0 := by
unfold h
fail_if_success grind (splitMatch := false)
sorry

View File

@@ -1,154 +0,0 @@
opaque g : Nat Nat
@[simp] def f (a : Nat) :=
match a with
| 0 => 10
| x+1 => g (f x)
set_option trace.grind.ematch.pattern true
set_option trace.grind.ematch.instance true
set_option trace.grind.assert true
/--
info: [grind.ematch.pattern] f.eq_2: [f (Lean.Grind.offset #0 (1))]
-/
#guard_msgs in
grind_pattern f.eq_2 => f (x + 1)
/--
info: [grind.assert] f (y + 1) = a
[grind.assert] ¬a = g (f y)
[grind.ematch.instance] f.eq_2: f y.succ = g (f y)
[grind.assert] f (y + 1) = g (f y)
-/
#guard_msgs (info) in
example : f (y + 1) = a a = g (f y):= by
grind
/--
info: [grind.assert] f 1 = a
[grind.assert] ¬a = g (f 0)
[grind.ematch.instance] f.eq_2: f (Nat.succ 0) = g (f 0)
[grind.assert] f 1 = g (f 0)
-/
#guard_msgs (info) in
example : f 1 = a a = g (f 0) := by
grind
/--
info: [grind.assert] f 10 = a
[grind.assert] ¬a = g (f 9)
[grind.ematch.instance] f.eq_2: f (Nat.succ 8) = g (f 8)
[grind.ematch.instance] f.eq_2: f (Nat.succ 9) = g (f 9)
[grind.assert] f 9 = g (f 8)
[grind.assert] f 10 = g (f 9)
-/
#guard_msgs (info) in
example : f 10 = a a = g (f 9) := by
grind
/--
info: [grind.assert] f (c + 2) = a
[grind.assert] ¬a = g (g (f c))
[grind.ematch.instance] f.eq_2: f (c + 1).succ = g (f (c + 1))
[grind.assert] f (c + 2) = g (f (c + 1))
[grind.ematch.instance] f.eq_2: f c.succ = g (f c)
[grind.assert] f (c + 1) = g (f c)
-/
#guard_msgs (info) in
example : f (c + 2) = a a = g (g (f c)) := by
grind
@[simp] def foo (a : Nat) :=
match a with
| 0 => 10
| 1 => 10
| a+2 => g (foo a)
/--
info: [grind.ematch.pattern] foo.eq_3: [foo (Lean.Grind.offset #0 (2))]
-/
#guard_msgs in
grind_pattern foo.eq_3 => foo (a_2 + 2)
-- The instance is correctly found in the following example.
-- TODO: to complete the proof, we need linear arithmetic support to prove that `b + 2 = c + 1`.
/--
info: [grind.assert] foo (c + 1) = a
[grind.assert] c = b + 1
[grind.assert] ¬a = g (foo b)
[grind.ematch.instance] foo.eq_3: foo b.succ.succ = g (foo b)
[grind.assert] foo (b + 2) = g (foo b)
-/
#guard_msgs (info) in
example : foo (c + 1) = a c = b + 1 a = g (foo b) := by
fail_if_success grind
sorry
set_option trace.grind.assert false
/--
info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
-/
#guard_msgs (info) in
example : f (x + 100) = a a = b := by
fail_if_success grind (ematch := 2)
sorry
/--
info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
[grind.ematch.instance] f.eq_2: f (x + 95).succ = g (f (x + 95))
-/
#guard_msgs (info) in
example : f (x + 100) = a a = b := by
fail_if_success grind (ematch := 5)
sorry
/--
info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
-/
#guard_msgs (info) in
example : f (x + 100) = a a = b := by
fail_if_success grind (ematch := 100) (instances := 4)
sorry
/--
info: [grind.ematch.instance] f.eq_2: f (y + 9).succ = g (f (y + 9))
[grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
[grind.ematch.instance] f.eq_2: f (y + 8).succ = g (f (y + 8))
[grind.ematch.instance] f.eq_2: f (y + 7).succ = g (f (y + 7))
-/
#guard_msgs (info) in
example : f (x + 100) = a f (y + 10) = c a = b := by
fail_if_success grind (ematch := 100) (instances := 5)
sorry
/--
info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
-/
#guard_msgs (info) in
example : f (x + 100) = a a = b := by
fail_if_success grind (gen := 2)
sorry
/--
info: [grind.ematch.instance] f.eq_2: f (x + 99).succ = g (f (x + 99))
[grind.ematch.instance] f.eq_2: f (x + 98).succ = g (f (x + 98))
[grind.ematch.instance] f.eq_2: f (x + 97).succ = g (f (x + 97))
[grind.ematch.instance] f.eq_2: f (x + 96).succ = g (f (x + 96))
[grind.ematch.instance] f.eq_2: f (x + 95).succ = g (f (x + 95))
-/
#guard_msgs (info) in
example : f (x + 100) = a a = b := by
fail_if_success grind (gen := 5)
sorry

View File

@@ -20,7 +20,7 @@ grind_pattern List.mem_concat_self => a ∈ xs ++ [a]
def foo (x : Nat) := x + x
/--
error: `foo` is not a theorem
error: `foo` is not a theorem, you cannot assign patterns to non-theorems for the `grind` tactic
-/
#guard_msgs in
grind_pattern foo => x + x
@@ -112,10 +112,3 @@ grind_pattern hThm1 => plus a c
/-- info: [grind.ematch.pattern] hThm1: [plus #2 #1, plus #2 #3] -/
#guard_msgs in
grind_pattern hThm1 => plus a c, plus a b
/--
error: invalid pattern, (non-forbidden) application expected
#4 ∧ #3
-/
#guard_msgs in
grind_pattern And.imp_left => a b

View File

@@ -1,47 +0,0 @@
universe v v₁ v₂ u u₁ u₂
namespace CategoryTheory
class Quiver (V : Type u) where
Hom : V V Sort v
infixr:10 "" => Quiver.Hom
class CategoryStruct (obj : Type u) extends Quiver.{v + 1} obj : Type max u (v + 1) where
/-- The identity morphism on an object. -/
id : X : obj, Hom X X
/-- Composition of morphisms in a category, written `f ≫ g`. -/
comp : {X Y Z : obj}, (X Y) (Y Z) (X Z)
notation "𝟙" => CategoryStruct.id -- type as \b1
infixr:80 "" => CategoryStruct.comp -- type as \gg
class Category (obj : Type u) extends CategoryStruct.{v} obj : Type max u (v + 1) where
id_comp : {X Y : obj} (f : X Y), 𝟙 X f = f
comp_id : {X Y : obj} (f : X Y), f 𝟙 Y = f
assoc : {W X Y Z : obj} (f : W X) (g : X Y) (h : Y Z), (f g) h = f g h
structure Prefunctor (V : Type u₁) [Quiver.{v₁} V] (W : Type u₂) [Quiver.{v₂} W] where
obj : V W
map : {X Y : V}, (X Y) (obj X obj Y)
structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D]
extends Prefunctor C D : Type max v₁ v₂ u₁ u₂ where
map_id : X : C, map (𝟙 X) = 𝟙 (obj X)
map_comp : {X Y Z : C} (f : X Y) (g : Y Z), map (f g) = map f map g
set_option trace.grind.ematch.pattern true
/--
info: [grind.ematch.pattern] Functor.map_id: [@Prefunctor.map #5 ? #3 ? (@Functor.toPrefunctor ? #4 ? #2 #1) #0 #0 (@CategoryStruct.id ? ? #0)]
-/
#guard_msgs in
grind_pattern Functor.map_id => self.map (𝟙 X)
/--
info: [grind.ematch.pattern] Functor.map_comp: [@Prefunctor.map #9 ? #7 ? (@Functor.toPrefunctor ? #8 ? #6 #5) #4 #2 (@CategoryStruct.comp ? ? #4 #3 #2 #1 #0)]
-/
#guard_msgs in
grind_pattern Functor.map_comp => self.map (f g)

View File

@@ -5,7 +5,6 @@ set_option grind.debug.proofs true
/--
error: `grind` failed
case grind.1.2
a b c : Bool
p q : Prop
left✝ : a = true
@@ -13,8 +12,6 @@ right✝ : b = true c = true
left : p
right : q
x✝ : b = false a = false
h✝ : b = false
h : c = true
⊢ False
-/
#guard_msgs (error) in
@@ -24,7 +21,6 @@ theorem ex (h : (f a && (b || f (f c))) = true) (h' : p ∧ q) : b && a := by
open Lean.Grind.Eager in
/--
error: `grind` failed
case grind.2.1
a b c : Bool
p q : Prop
left✝ : a = true
@@ -42,7 +38,6 @@ def g (i : Nat) (j : Nat) (_ : i > j := by omega) := i + j
/--
error: `grind` failed
case grind
i j : Nat
h : j + 1 < i + 1
h✝ : j + 1 ≤ i
@@ -59,7 +54,6 @@ structure Point where
/--
error: `grind` failed
case grind
a₁ : Point
a₂ : Nat
a₃ : Int
@@ -86,7 +80,6 @@ example (p : Prop) (a b c : Nat) : p → a = 0 → a = b → h a = h c → a = c
set_option trace.grind.debug.proof true
/--
error: `grind` failed
case grind
α : Type
a : α
p q r : Prop

View File

@@ -103,6 +103,3 @@ example (p q r : Prop) : p (q ↔ r) → ¬r → q → False := by
grind on_failure do
Lean.logInfo "hello world"
fallback
example (a b : Nat) : (a = b) = (b = a) := by
grind

View File

@@ -1,30 +0,0 @@
class One (α : Type u) where
one : α
instance (priority := 300) One.toOfNat1 {α} [One α] : OfNat α (nat_lit 1) where
ofNat := One α.1
class Shelf (α : Type u) where
act : α α α
self_distrib : {x y z : α}, act x (act y z) = act (act x y) (act x z)
class UnitalShelf (α : Type u) extends Shelf α, One α where
one_act : a : α, act 1 a = a
act_one : a : α, act a 1 = a
infixr:65 "" => Shelf.act
-- Mathlib proof from UnitalShelf.act_act_self_eq
example {S} [UnitalShelf S] (x y : S) : (x y) x = x y := by
have h : (x y) x = (x y) (x 1) := by rw [UnitalShelf.act_one]
rw [h, Shelf.self_distrib, UnitalShelf.act_one]
attribute [grind =] UnitalShelf.one_act UnitalShelf.act_one
-- We actually want the reverse direction of `Shelf.self_distrib`, so don't use the `grind_eq` attribute.
grind_pattern Shelf.self_distrib => self.act (self.act x y) (self.act x z)
-- Proof using `grind`:
example {S} [UnitalShelf S] (x y : S) : (x y) x = x y := by
have h : (x y) x = (x y) (x 1) := by grind
grind

View File

@@ -1,63 +0,0 @@
set_option trace.grind.split true
set_option trace.grind.eqc true
example (p q : Prop) : p q p ¬q ¬p q ¬p ¬q False := by
grind
opaque R : Nat Prop
/--
info: [grind] working on goal `grind`
[grind.eqc] (if p then a else b) = c
[grind.eqc] R a = True
[grind.eqc] R b = True
[grind.eqc] R c = False
[grind.split] if p then a else b, generation: 0
[grind] working on goal `grind.1`
[grind.eqc] p = True
[grind.eqc] (if p then a else b) = a
[grind.eqc] R a = R c
[grind] closed `grind.1`
[grind] working on goal `grind.2`
[grind.eqc] p = False
[grind.eqc] (if p then a else b) = b
[grind.eqc] R b = R c
[grind] closed `grind.2`
-/
#guard_msgs (info) in
set_option trace.grind true in
example (p : Prop) [Decidable p] (a b c : Nat) : (if p then a else b) = c R a R b R c := by
grind
example (p : Prop) [Decidable p] (a b c : Nat) : (if p then a else b) = c R a R b R c := by
fail_if_success grind (splitIte := false)
sorry
namespace grind_test_induct_pred
inductive Expr where
| nat : Nat Expr
| plus : Expr Expr Expr
| bool : Bool Expr
| and : Expr Expr Expr
deriving DecidableEq
inductive Ty where
| nat
| bool
deriving DecidableEq
inductive HasType : Expr Ty Prop
| nat : HasType (.nat v) .nat
| plus : HasType a .nat HasType b .nat HasType (.plus a b) .nat
| bool : HasType (.bool v) .bool
| and : HasType a .bool HasType b .bool HasType (.and a b) .bool
set_option trace.grind true
theorem HasType.det (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
grind
theorem HasType.det' (h₁ : HasType e t₁) (h₂ : HasType e t₂) : t₁ = t₂ := by
fail_if_success grind (splitIndPred := false)
sorry
end grind_test_induct_pred

View File

@@ -83,130 +83,3 @@ info: [grind.debug.proj] { a := b, b := v₁, c := v₂ }.a
set_option trace.grind.debug.proj true in
example (a b d e : Nat) (x y z : Boo Nat) (f : Nat Boo Nat) : (f d).1 a f d = b, v₁, v₂ x.1 = e y.1 = e z.1 = e f d = x f d = y f d = z b = a False := by
grind
example (f : Nat Nat) (a b c : Nat) : f (if a = b then x else y) = z a = c c = b f x = z := by
grind
example (f : Nat Nat) (a b c : Nat) : f (if a = b then x else y) = z a = c b c f y = z := by
grind
namespace dite_propagator_test
opaque R : Nat Nat Prop
opaque f (a : Nat) (b : Nat) (_ : R a b) : Nat
opaque g (a : Nat) (b : Nat) (_ : ¬ R a b) : Nat
open Classical
example (foo : Nat Nat)
(_ : foo (if h : R a c then f a c h else g a c h) = x)
(_ : R a b)
(_ : c = b) : foo (f a c (by grind)) = x := by
grind
example (foo : Nat Nat)
(_ : foo (if h : R a c then f a c h else g a c h) = x)
(_ : ¬ R a b)
(_ : c = b)
: foo (g a c (by grind)) = x := by
grind
end dite_propagator_test
/--
info: [grind.eqc] x = 2 * a
[grind.eqc] y = x
[grind.eqc] (y = 2 * a) = False
[grind.eqc] (y = 2 * a) = True
-/
#guard_msgs (info) in
set_option trace.grind.eqc true in
example (a : Nat) : let x := a + a; y = x y = a + a := by
grind
/--
info: [grind.eqc] x = 2 * a
[grind.eqc] y = x
[grind.eqc] (y = 2 * a) = False
[grind.eqc] (y = 2 * a) = True
-/
#guard_msgs (info) in
set_option trace.grind.eqc true in
example (a : Nat) : let_fun x := a + a; y = x y = a + a := by
grind
example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
(h₁ : α = β)
(h₂ : cast h₁ a₁ = b₁)
(h₃ : a₁ = a₂)
(h₄ : b₁ = b₂)
: HEq a₂ b₂ := by
grind
example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
(h₁ : α = β)
(h₂ : h₁ a₁ = b₁)
(h₃ : a₁ = a₂)
(h₄ : b₁ = b₂)
: HEq a₂ b₂ := by
grind
example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
(h₁ : α = β)
(h₂ : Eq.recOn h₁ a₁ = b₁)
(h₃ : a₁ = a₂)
(h₄ : b₁ = b₂)
: HEq a₂ b₂ := by
grind
example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
(h₁ : α = β)
(h₂ : Eq.ndrec (motive := id) a₁ h₁ = b₁)
(h₃ : a₁ = a₂)
(h₄ : b₁ = b₂)
: HEq a₂ b₂ := by
grind
example (α : Type) (β : Type) (a₁ a₂ : α) (b₁ b₂ : β)
(h₁ : α = β)
(h₂ : Eq.rec (motive := fun x _ => x) a₁ h₁ = b₁)
(h₃ : a₁ = a₂)
(h₄ : b₁ = b₂)
: HEq a₂ b₂ := by
grind
/--
info: [grind.assert] ∀ (a : α), a ∈ b → p a
[grind.ematch.pattern] h₁: [@Membership.mem `[α] `[List α] `[List.instMembership] `[b] #1]
[grind.ematch.pattern] h₁: [p #1]
[grind.assert] w ∈ b
[grind.assert] ¬p w
[grind.ematch.instance] h₁: w ∈ b → p w
[grind.assert] w ∈ b → p w
-/
#guard_msgs (info) in
set_option trace.grind.ematch.pattern true in
set_option trace.grind.ematch.instance true in
set_option trace.grind.assert true in
example (b : List α) (p : α Prop) (h₁ : a b, p a) (h₂ : a b, ¬p a) : False := by
grind
/--
info: [grind.assert] ∀ (x : α), Q x → P x
[grind.ematch.pattern] h₁: [Q #1]
[grind.ematch.pattern] h₁: [P #1]
[grind.assert] ∀ (x : α), R x → False = P x
[grind.ematch.pattern] h₂: [R #1]
[grind.ematch.pattern] h₂: [P #1]
[grind.assert] Q a
[grind.assert] R a
[grind.ematch.instance] h₁: Q a → P a
[grind.ematch.instance] h₂: R a → False = P a
[grind.assert] Q a → P a
[grind.assert] R a → False = P a
-/
#guard_msgs (info) in
set_option trace.grind.ematch.pattern true in
set_option trace.grind.ematch.instance true in
set_option trace.grind.assert true in
example (P Q R : α Prop) (h₁ : x, Q x P x) (h₂ : x, R x False = (P x)) : Q a R a False := by
grind