Compare commits

..

6 Commits

Author SHA1 Message Date
Kim Morrison
2b60531bdc fix 2025-05-03 17:54:51 +02:00
Kim Morrison
b74b0a5ee8 undeprecate 2025-05-02 19:15:53 +02:00
Kim Morrison
f4e8aaf969 cleanup deprecations 2025-05-02 00:30:23 +02:00
Kim Morrison
51672c0ae8 undo deprecation 2025-05-02 00:23:42 +02:00
Kim Morrison
11c429f799 suggestions from review 2025-05-01 18:53:20 +02:00
Kim Morrison
7a2bf0b3bd chore: consistently add @[simp] to getKey_eq map lemmas 2025-04-30 19:28:50 +02:00
746 changed files with 4045 additions and 10505 deletions

View File

@@ -174,9 +174,8 @@ jobs:
// just a secondary build job for now until false positives can be excluded
"secondary": true,
"CMAKE_OPTIONS": "-DUSE_LAKE=ON",
// TODO: importStructure is not compatible with .olean caching
// TODO: why does scopedMacros fail?
"CTEST_OPTIONS": "-E 'scopedMacros|importStructure'"
// TODO: why does this fail?
"CTEST_OPTIONS": "-E 'scopedMacros'"
},
{
"name": "Linux",

View File

@@ -5,7 +5,7 @@ option(USE_MIMALLOC "use mimalloc" ON)
# store all variables passed on the command line into CL_ARGS so we can pass them to the stage builds
# https://stackoverflow.com/a/48555098/161659
# MUST be done before call to 'project'
# Use standard release build (discarding LEAN_EXTRA_CXX_FLAGS etc.) for stage0 by default since it is assumed to be "good", but still pass through CMake platform arguments (compiler, toolchain file, ..).
# Use standard release build (discarding LEAN_CXX_EXTRA_FLAGS etc.) for stage0 by default since it is assumed to be "good", but still pass through CMake platform arguments (compiler, toolchain file, ..).
# Use `STAGE0_` prefix to pass variables to stage0 explicitly.
get_cmake_property(vars CACHE_VARIABLES)
foreach(var ${vars})
@@ -39,14 +39,10 @@ endif()
# Don't do anything with cadical on wasm
if (NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# On CI Linux, we source cadical from Nix instead; see flake.nix
find_program(CADICAL cadical)
if(NOT CADICAL)
set(CADICAL_CXX c++)
if (CADICAL_USE_CUSTOM_CXX)
set(CADICAL_CXX ${CMAKE_CXX_COMPILER})
set(CADICAL_CXXFLAGS "${LEAN_EXTRA_CXX_FLAGS}")
set(CADICAL_LDFLAGS "-Wl,-rpath=\\$$ORIGIN/../lib")
endif()
find_program(CCACHE ccache)
if(CCACHE)
set(CADICAL_CXX "${CCACHE} ${CADICAL_CXX}")
@@ -61,11 +57,8 @@ if (NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
GIT_REPOSITORY https://github.com/arminbiere/cadical
GIT_TAG rel-2.1.2
CONFIGURE_COMMAND ""
BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk
CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX}
CXX=${CADICAL_CXX}
CXXFLAGS=${CADICAL_CXXFLAGS}
LDFLAGS=${CADICAL_LDFLAGS}
# https://github.com/arminbiere/cadical/blob/master/BUILD.md#manual-build
BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX} CXX=${CADICAL_CXX} CXXFLAGS=${CADICAL_CXXFLAGS}
BUILD_IN_SOURCE ON
INSTALL_COMMAND "")
set(CADICAL ${CMAKE_BINARY_DIR}/cadical/cadical${CMAKE_EXECUTABLE_SUFFIX} CACHE FILEPATH "path to cadical binary" FORCE)

View File

@@ -7,9 +7,8 @@
/.github/ @kim-em
/RELEASES.md @kim-em
/src/kernel/ @leodemoura
/src/library/compiler/ @zwarich
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura @zwarich
/src/Lean/Compiler/ @leodemoura
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @kim-em
/src/Lean/Elab/Tactic/ @kim-em

View File

@@ -144,10 +144,6 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
- Run `script/release_steps.py v4.7.0-rc1 <repo>` (e.g. replacing `<repo>` with `batteries`), which will walk you through the following steps:
- Create a new branch off `master`/`main` (as specified in the `branch` field), called `bump_to_v4.7.0-rc1`.
- Merge `origin/bump/v4.7.0` if relevant (i.e. `bump-branch: true` appears in `release_repos.yml`).
- Otherwise, you *may* need to merge `origin/nightly-testing`.
- Note that for `verso` and `reference-manual` development happens on `nightly-testing`, so
we will merge that branch into `bump_to_v4.7.0-rc1`, but it is essential in the GitHub interface that we do a rebase merge,
in order to preserve the history.
- Update the contents of `lean-toolchain` to `leanprover/lean4:v4.7.0-rc1`.
- In the `lakefile.toml` or `lakefile.lean`, if there are dependencies on `nightly-testing`, `bump/v4.7.0`, or specific version tags, update them to the new tag.
If they depend on `main` or `master`, don't change this; you've just updated the dependency, so `lake update` will take care of modifying the manifest.
@@ -155,7 +151,7 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
- Run `lake build && if lake check-test; then lake test; fi` to check things are working.
- Commit the changes as `chore: bump toolchain to v4.7.0-rc1` and push.
- Create a PR with title "chore: bump toolchain to v4.7.0-rc1".
- Merge the PR once CI completes. (Recall: for `verso` and `reference-manual` you will need to do a rebase merge.)
- Merge the PR once CI completes.
- Re-running `script/release_checklist.py` will then create the tag `v4.7.0-rc1` from `master`/`main` and push it (unless `toolchain-tag: false` in the `release_repos.yml` file)
- We do this for the same list of repositories as for stable releases, see above for notes about special cases.
As above, there are dependencies between these, and so the process above is iterative.

File diff suppressed because it is too large Load Diff

View File

@@ -47,10 +47,10 @@ def run_command(command, check=True, capture_output=True):
def clone_repo(repo, temp_dir):
"""Clone the repository to a temporary directory."""
print(f"Cloning {repo}...")
# Remove shallow clone for better merge detection
clone_result = run_command(f"gh repo clone {repo} {temp_dir}", check=False)
"""Clone the repository to a temporary directory using shallow clone."""
print(f"Shallow cloning {repo}...")
# Keep the shallow clone for efficiency
clone_result = run_command(f"gh repo clone {repo} {temp_dir} -- --depth=1", check=False)
if clone_result.returncode != 0:
print(f"Failed to clone repository {repo}.")
print(f"Error: {clone_result.stderr}")
@@ -95,16 +95,26 @@ def check_and_merge(repo, branch, tag, temp_dir):
if checkout_result.returncode != 0:
return False
# Try merging the tag directly
print(f"Merging {tag} into {branch}...")
merge_result = run_command(f"git merge {tag} --no-edit", check=False)
# Try merging the tag in a dry-run to check if it can be merged cleanly
print(f"Checking if {tag} can be merged cleanly into {branch}...")
merge_check = run_command(f"git merge --no-commit --no-ff {tag}", check=False)
if merge_result.returncode != 0:
if merge_check.returncode != 0:
print(f"Cannot merge {tag} cleanly into {branch}.")
print("Merge conflicts would occur. Aborting merge.")
run_command("git merge --abort")
return False
# Abort the test merge
run_command("git reset --hard HEAD")
# Now perform the actual merge and push to remote
print(f"Merging {tag} into {branch}...")
merge_result = run_command(f"git merge {tag} --no-edit")
if merge_result.returncode != 0:
print(f"Failed to merge {tag} into {branch}.")
return False
print(f"Pushing changes to remote...")
push_result = run_command(f"git push origin {branch}")
if push_result.returncode != 0:

View File

@@ -55,8 +55,7 @@ $CP $GLIBC/lib/libc_nonshared.a stage1/lib/glibc
$CP $GLIBC/lib/libpthread_nonshared.a stage1/lib/glibc
for f in $GLIBC/lib/{ld,lib{c,dl,m,rt,pthread}}-*; do b=$(basename $f); cp $f stage1/lib/glibc/${b%-*}.so; done
OPTIONS=()
# We build cadical using the custom toolchain on Linux to avoid glibc versioning issues
echo -n " -DLEAN_STANDALONE=ON -DCADICAL_USE_CUSTOM_CXX=ON"
echo -n " -DLEAN_STANDALONE=ON"
echo -n " -DCMAKE_CXX_COMPILER=$PWD/llvm-host/bin/clang++ -DLEAN_CXX_STDLIB='-Wl,-Bstatic -lc++ -lc++abi -Wl,-Bdynamic'"
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter $GLIBC_DEV/include ${EXTRA_FLAGS:-}'"
# use target compiler directly when not cross-compiling
@@ -68,9 +67,8 @@ 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"
# ld.so is usually included by the libc.so linker script but we discard those. Make sure it is linked to only after `libc.so` like in the original
# linker script so that no libc symbols are bound to it instead.
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc -lc -lc_nonshared -Wl,--as-needed -l:ld.so -Wl,--no-as-needed -lpthread_nonshared -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
# ld.so is usually included by the libc.so linker script but we discard those
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 ROOT/lib/glibc/ld.so -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

@@ -7,7 +7,6 @@ import base64
import subprocess
import sys
import os
import re # Import re module
# Import run_command from merge_remote.py
from merge_remote import run_command
@@ -59,29 +58,13 @@ def release_page_exists(repo_url, tag_name, github_token):
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def get_release_notes(tag_name):
"""Fetch release notes page title from lean-lang.org."""
# Strip -rcX suffix if present for the URL
base_tag = tag_name.split('-')[0]
reference_url = f"https://lean-lang.org/doc/reference/latest/releases/{base_tag}/"
try:
response = requests.get(reference_url)
response.raise_for_status() # Raise HTTPError for bad responses (4xx or 5xx)
# Extract title using regex
match = re.search(r"<title>(.*?)</title>", response.text, re.IGNORECASE | re.DOTALL)
if match:
return match.group(1).strip()
else:
print(f" ⚠️ Could not find <title> tag in {reference_url}")
return None
except requests.exceptions.RequestException as e:
print(f" ❌ Error fetching release notes from {reference_url}: {e}")
return None
except Exception as e:
print(f" ❌ An unexpected error occurred while processing release notes: {e}")
return None
def get_release_notes(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
return response.json().get("body", "").strip()
return None
def get_branch_content(repo_url, branch, file_path, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
@@ -272,7 +255,6 @@ def main():
branch_name = f"releases/v{version_major}.{version_minor}.0"
if not branch_exists(lean_repo_url, branch_name, github_token):
print(f" ❌ Branch {branch_name} does not exist")
print(f" 🟡 After creating the branch, we'll need to check CMake version settings.")
lean4_success = False
else:
print(f" ✅ Branch {branch_name} exists")
@@ -292,22 +274,14 @@ def main():
lean4_success = False
else:
print(f" ✅ Release page for {toolchain} exists")
# Check the actual release notes page title
actual_title = get_release_notes(toolchain)
expected_title_prefix = f"Lean {toolchain.lstrip('v')}" # e.g., "Lean 4.19.0" or "Lean 4.19.0-rc1"
if actual_title is None:
# Error already printed by get_release_notes
lean4_success = False
elif not actual_title.startswith(expected_title_prefix):
# Construct URL for the error message (using the base tag)
base_tag = toolchain.split('-')[0]
check_url = f"https://lean-lang.org/doc/reference/latest/releases/{base_tag}/"
print(f" ❌ Release notes page title mismatch. Expected prefix '{expected_title_prefix}', got '{actual_title}'. Check {check_url}")
lean4_success = False
else:
print(f" ✅ Release notes page title looks good ('{actual_title}').")
release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
if not (release_notes and toolchain in release_notes.splitlines()[0].strip()):
previous_minor_version = version_minor - 1
previous_release = f"v{version_major}.{previous_minor_version}.0"
print(f" ❌ Release notes not published. Please run `script/release_notes.py --since {previous_release}` on branch `{branch_name}`.")
lean4_success = False
else:
print(f" ✅ Release notes look good.")
repo_status["lean4"] = lean4_success
@@ -386,24 +360,10 @@ def main():
if check_stable and not is_release_candidate(toolchain):
if not is_merged_into_stable(url, toolchain, "stable", github_token, verbose):
org_repo = extract_org_repo_from_url(url)
if args.dry_run:
print(f" ❌ Tag {toolchain} is not merged into stable")
print(f" Run `script/merge_remote.py {org_repo} stable {toolchain}` to merge it")
repo_status[name] = False
continue
else:
print(f" … Tag {toolchain} is not merged into stable. Running `script/merge_remote.py {org_repo} stable {toolchain}`...")
# Run the script to merge the tag
subprocess.run(["script/merge_remote.py", org_repo, "stable", toolchain])
# Check again if the tag is merged now
if not is_merged_into_stable(url, toolchain, "stable", github_token, verbose):
print(f" ❌ Manual intervention required.")
repo_status[name] = False
continue
# This will print in all successful cases - whether tag was merged initially or was merged successfully
print(f" ❌ Tag {toolchain} is not merged into stable")
print(f" Run `script/merge_remote.py {org_repo} stable {toolchain}` to merge it")
repo_status[name] = False
continue
print(f" ✅ Tag {toolchain} is merged into stable")
if check_bump:

View File

@@ -21,19 +21,12 @@ repositories:
branch: master
dependencies: []
- name: lean4-cli
url: https://github.com/leanprover/lean4-cli
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: doc-gen4
url: https://github.com/leanprover/doc-gen4
toolchain-tag: true
stable-branch: false
branch: main
dependencies: [lean4-cli]
dependencies: []
- name: verso
url: https://github.com/leanprover/verso
@@ -49,13 +42,20 @@ repositories:
branch: main
dependencies: [verso]
- name: lean4-cli
url: https://github.com/leanprover/lean4-cli
toolchain-tag: true
stable-branch: false
branch: main
dependencies: []
- name: ProofWidgets4
url: https://github.com/leanprover-community/ProofWidgets4
toolchain-tag: false
stable-branch: false
branch: main
dependencies:
- batteries
- Batteries
- name: aesop
url: https://github.com/leanprover-community/aesop
@@ -63,7 +63,7 @@ repositories:
stable-branch: true
branch: master
dependencies:
- batteries
- Batteries
- name: import-graph
url: https://github.com/leanprover-community/import-graph
@@ -71,8 +71,8 @@ repositories:
stable-branch: false
branch: main
dependencies:
- lean4-cli
- batteries
- Cli
- Batteries
- name: plausible
url: https://github.com/leanprover-community/plausible
@@ -88,11 +88,10 @@ repositories:
branch: master
bump-branch: true
dependencies:
- aesop
- Aesop
- ProofWidgets4
- lean4checker
- batteries
- lean4-cli
- Batteries
- doc-gen4
- import-graph
- plausible
@@ -103,4 +102,4 @@ repositories:
stable-branch: true
branch: master
dependencies:
- mathlib4
- Mathlib

View File

@@ -68,7 +68,7 @@ def generate_script(repo, version, config):
]
# Special cases for specific repositories
if repo_name == "repl":
if repo_name == "REPL":
script_lines.extend([
"lake update",
"cd test/Mathlib",
@@ -79,7 +79,7 @@ def generate_script(repo, version, config):
"./test.sh"
])
elif dependencies:
script_lines.append('perl -pi -e \'s/"v4\\.[0-9]+(\\.[0-9]+)?(-rc[0-9]+)?"/"' + version + '"/g\' lakefile.*')
script_lines.append('echo "Please update the dependencies in lakefile.{lean,toml}"')
script_lines.append("lake update")
script_lines.append("")
@@ -89,20 +89,13 @@ def generate_script(repo, version, config):
""
])
if re.search(r'rc\d+$', version) and repo_name in ["batteries", "mathlib4"]:
if re.search(r'rc\d+$', version) and repo_name in ["Batteries", "Mathlib"]:
script_lines.extend([
"echo 'This repo has nightly-testing infrastructure'",
f"git merge origin/bump/{version.split('-rc')[0]}",
"echo 'Please resolve any conflicts.'",
""
])
if re.search(r'rc\d+$', version) and repo_name in ["verso", "reference-manual"]:
script_lines.extend([
"echo 'This repo does development on nightly-testing: remember to rebase merge the PR.'",
f"git merge origin/nightly-testing",
"echo 'Please resolve any conflicts.'",
""
])
if repo_name != "Mathlib":
script_lines.extend([
"lake build && if lake check-test; then lake test; fi",
@@ -111,7 +104,7 @@ def generate_script(repo, version, config):
script_lines.extend([
'gh pr create --title "chore: bump toolchain to ' + version + '" --body ""',
"echo 'Please review the PR and merge or rebase it.'",
"echo 'Please review the PR and merge it.'",
""
])

View File

@@ -10,7 +10,7 @@ endif()
include(ExternalProject)
project(LEAN CXX C)
set(LEAN_VERSION_MAJOR 4)
set(LEAN_VERSION_MINOR 21)
set(LEAN_VERSION_MINOR 20)
set(LEAN_VERSION_PATCH 0)
set(LEAN_VERSION_IS_RELEASE 0) # This number is 1 in the release revision, and 0 otherwise.
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
@@ -511,10 +511,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
# import libraries created by the stdlib.make targets
string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared_1 -lleanshared")
elseif("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin")
# The second flag is necessary to even *load* dylibs without resolved symbols, as can happen
# if a Lake `extern_lib` depends on a symbols defined by the Lean library but is loaded even
# before definition.
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup -Wl,-no_fixup_chains")
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup")
endif()
# Linux ignores undefined symbols in shared libraries by default

View File

@@ -56,15 +56,15 @@ well-founded recursion mechanism to prove that the function terminates.
-/
@[inline] def attach (xs : Array α) : Array {x // x xs} := xs.attachWith _ fun _ => id
@[simp, grind =] theorem _root_.List.attachWith_toArray {l : List α} {P : α Prop} {H : x l.toArray, P x} :
@[simp] theorem _root_.List.attachWith_toArray {l : List α} {P : α Prop} {H : x l.toArray, P x} :
l.toArray.attachWith P H = (l.attachWith P (by simpa using H)).toArray := by
simp [attachWith]
@[simp, grind =] theorem _root_.List.attach_toArray {l : List α} :
@[simp] theorem _root_.List.attach_toArray {l : List α} :
l.toArray.attach = (l.attachWith (· l.toArray) (by simp)).toArray := by
simp [attach]
@[simp, grind =] theorem _root_.List.pmap_toArray {l : List α} {P : α Prop} {f : a, P a β} {H : a l.toArray, P a} :
@[simp] theorem _root_.List.pmap_toArray {l : List α} {P : α Prop} {f : a, P a β} {H : a l.toArray, P a} :
l.toArray.pmap f H = (l.pmap f (by simpa using H)).toArray := by
simp [pmap]
@@ -590,7 +590,7 @@ def unattach {α : Type _} {p : α → Prop} (xs : Array { x // p x }) : Array
unfold unattach
simp
@[simp, grind =] theorem _root_.List.unattach_toArray {p : α Prop} {xs : List { x // p x }} :
@[simp] theorem _root_.List.unattach_toArray {p : α Prop} {xs : List { x // p x }} :
xs.toArray.unattach = xs.unattach.toArray := by
simp only [unattach, List.map_toArray, List.unattach]

View File

@@ -88,11 +88,11 @@ theorem ext' {xs ys : Array α} (h : xs.toList = ys.toList) : xs = ys := by
@[simp] theorem toArrayAux_eq {as : List α} {acc : Array α} : (as.toArrayAux acc).toList = acc.toList ++ as := by
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
@[simp, grind =] theorem toArray_toList {xs : Array α} : xs.toList.toArray = xs := rfl
@[simp] theorem toArray_toList {xs : Array α} : xs.toList.toArray = xs := rfl
@[simp, grind =] theorem getElem_toList {xs : Array α} {i : Nat} (h : i < xs.size) : xs.toList[i] = xs[i] := rfl
@[simp] theorem getElem_toList {xs : Array α} {i : Nat} (h : i < xs.size) : xs.toList[i] = xs[i] := rfl
@[simp, grind =] theorem getElem?_toList {xs : Array α} {i : Nat} : xs.toList[i]? = xs[i]? := by
@[simp] theorem getElem?_toList {xs : Array α} {i : Nat} : xs.toList[i]? = xs[i]? := by
simp [getElem?_def]
/-- `a ∈ as` is a predicate which asserts that `a` is in the array `as`. -/
@@ -107,7 +107,7 @@ instance : Membership α (Array α) where
theorem mem_def {a : α} {as : Array α} : a as a as.toList :=
fun | .mk h => h, Array.Mem.mk
@[simp, grind =] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
@[simp] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
simp [mem_def]
@[simp, grind] theorem getElem_mem {xs : Array α} {i : Nat} (h : i < xs.size) : xs[i] xs := by
@@ -127,18 +127,18 @@ theorem toList_toArray {as : List α} : as.toArray.toList = as := rfl
@[deprecated toList_toArray (since := "2025-02-17")]
abbrev _root_.Array.toList_toArray := @List.toList_toArray
@[simp, grind] theorem size_toArray {as : List α} : as.toArray.size = as.length := by simp [Array.size]
@[simp] theorem size_toArray {as : List α} : as.toArray.size = as.length := by simp [Array.size]
@[deprecated size_toArray (since := "2025-02-17")]
abbrev _root_.Array.size_toArray := @List.size_toArray
@[simp, grind =] theorem getElem_toArray {xs : List α} {i : Nat} (h : i < xs.toArray.size) :
@[simp] theorem getElem_toArray {xs : List α} {i : Nat} (h : i < xs.toArray.size) :
xs.toArray[i] = xs[i]'(by simpa using h) := rfl
@[simp, grind =] theorem getElem?_toArray {xs : List α} {i : Nat} : xs.toArray[i]? = xs[i]? := by
@[simp] theorem getElem?_toArray {xs : List α} {i : Nat} : xs.toArray[i]? = xs[i]? := by
simp [getElem?_def]
@[simp, grind =] theorem getElem!_toArray [Inhabited α] {xs : List α} {i : Nat} :
@[simp] theorem getElem!_toArray [Inhabited α] {xs : List α} {i : Nat} :
xs.toArray[i]! = xs[i]! := by
simp [getElem!_def]
@@ -2158,15 +2158,13 @@ Examples:
/-! ### Repr and ToString -/
protected def Array.repr {α : Type u} [Repr α] (xs : Array α) : Std.Format :=
let _ : Std.ToFormat α := repr
if xs.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
instance {α : Type u} [Repr α] : Repr (Array α) where
reprPrec xs _ := Array.repr xs
reprPrec xs _ :=
let _ : Std.ToFormat α := repr
if xs.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
instance [ToString α] : ToString (Array α) where
toString xs := "#" ++ toString xs.toList

View File

@@ -55,12 +55,12 @@ theorem foldlM_toList.aux [Monad m]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
@[simp, grind =] theorem foldlM_toList [Monad m]
@[simp] theorem foldlM_toList [Monad m]
{f : β α m β} {init : β} {xs : Array α} :
xs.toList.foldlM f init = xs.foldlM f init := by
simp [foldlM, foldlM_toList.aux]
@[simp, grind =] theorem foldl_toList (f : β α β) {init : β} {xs : Array α} :
@[simp] theorem foldl_toList (f : β α β) {init : β} {xs : Array α} :
xs.toList.foldl f init = xs.foldl f init :=
List.foldl_eq_foldlM .. foldlM_toList ..
@@ -79,32 +79,32 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] {f : α → β → m β} {init
match xs, this with | _, .inl rfl => rfl | xs, .inr h => ?_
simp [foldrM, h, foldrM_eq_reverse_foldlM_toList.aux, List.take_length]
@[simp, grind =] theorem foldrM_toList [Monad m]
@[simp] theorem foldrM_toList [Monad m]
{f : α β m β} {init : β} {xs : Array α} :
xs.toList.foldrM f init = xs.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList, List.foldlM_reverse]
@[simp, grind =] theorem foldr_toList (f : α β β) {init : β} {xs : Array α} :
@[simp] theorem foldr_toList (f : α β β) {init : β} {xs : Array α} :
xs.toList.foldr f init = xs.foldr f init :=
List.foldr_eq_foldrM .. foldrM_toList ..
@[simp, grind =] theorem push_toList {xs : Array α} {a : α} : (xs.push a).toList = xs.toList ++ [a] := by
@[simp] theorem push_toList {xs : Array α} {a : α} : (xs.push a).toList = xs.toList ++ [a] := by
simp [push, List.concat_eq_append]
@[simp, grind =] theorem toListAppend_eq {xs : Array α} {l : List α} : xs.toListAppend l = xs.toList ++ l := by
@[simp] theorem toListAppend_eq {xs : Array α} {l : List α} : xs.toListAppend l = xs.toList ++ l := by
simp [toListAppend, foldr_toList]
@[simp, grind =] theorem toListImpl_eq {xs : Array α} : xs.toListImpl = xs.toList := by
@[simp] theorem toListImpl_eq {xs : Array α} : xs.toListImpl = xs.toList := by
simp [toListImpl, foldr_toList]
@[simp, grind =] theorem toList_pop {xs : Array α} : xs.pop.toList = xs.toList.dropLast := rfl
@[simp] theorem toList_pop {xs : Array α} : xs.pop.toList = xs.toList.dropLast := rfl
@[deprecated toList_pop (since := "2025-02-17")]
abbrev pop_toList := @Array.toList_pop
@[simp] theorem append_eq_append {xs ys : Array α} : xs.append ys = xs ++ ys := rfl
@[simp, grind =] theorem toList_append {xs ys : Array α} :
@[simp] theorem toList_append {xs ys : Array α} :
(xs ++ ys).toList = xs.toList ++ ys.toList := by
rw [ append_eq_append]; unfold Array.append
rw [ foldl_toList]
@@ -112,13 +112,13 @@ abbrev pop_toList := @Array.toList_pop
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[simp, grind =] theorem append_empty {xs : Array α} : xs ++ #[] = xs := by
@[simp, grind] theorem append_empty {xs : Array α} : xs ++ #[] = xs := by
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
@[deprecated append_empty (since := "2025-01-13")]
abbrev append_nil := @append_empty
@[simp, grind =] theorem empty_append {xs : Array α} : #[] ++ xs = xs := by
@[simp, grind] theorem empty_append {xs : Array α} : #[] ++ xs = xs := by
apply ext'; simp only [toList_append, toList_empty, List.nil_append]
@[deprecated empty_append (since := "2025-01-13")]
@@ -129,7 +129,7 @@ abbrev nil_append := @empty_append
@[simp] theorem appendList_eq_append {xs : Array α} {l : List α} : xs.appendList l = xs ++ l := rfl
@[simp, grind =] theorem toList_appendList {xs : Array α} {l : List α} :
@[simp] theorem toList_appendList {xs : Array α} {l : List α} :
(xs ++ l).toList = xs.toList ++ l := by
rw [ appendList_eq_append]; unfold Array.appendList
induction l generalizing xs <;> simp [*]

View File

@@ -25,7 +25,7 @@ section countP
variable {p q : α Bool}
@[simp, grind =] theorem _root_.List.countP_toArray {l : List α} : countP p l.toArray = l.countP p := by
@[simp] theorem _root_.List.countP_toArray {l : List α} : countP p l.toArray = l.countP p := by
simp [countP]
induction l with
| nil => rfl
@@ -33,7 +33,7 @@ variable {p q : α → Bool}
simp only [List.foldr_cons, ih, List.countP_cons]
split <;> simp_all
@[simp, grind =] theorem countP_toList {xs : Array α} : xs.toList.countP p = countP p xs := by
@[simp] theorem countP_toList {xs : Array α} : xs.toList.countP p = countP p xs := by
cases xs
simp
@@ -164,10 +164,10 @@ section count
variable [BEq α]
@[simp, grind =] theorem _root_.List.count_toArray {l : List α} {a : α} : count a l.toArray = l.count a := by
@[simp] theorem _root_.List.count_toArray {l : List α} {a : α} : count a l.toArray = l.count a := by
simp [count, List.count_eq_countP]
@[simp, grind =] theorem count_toList {xs : Array α} {a : α} : xs.toList.count a = xs.count a := by
@[simp] theorem count_toList {xs : Array α} {a : α} : xs.toList.count a = xs.count a := by
cases xs
simp

View File

@@ -68,7 +68,7 @@ theorem isEqv_eq_decide (xs ys : Array α) (r) :
Bool.not_eq_true]
simpa [isEqv_iff_rel] using h'
@[simp, grind =] theorem isEqv_toList [BEq α] (xs ys : Array α) : (xs.toList.isEqv ys.toList r) = (xs.isEqv ys r) := by
@[simp] theorem isEqv_toList [BEq α] (xs ys : Array α) : (xs.toList.isEqv ys.toList r) = (xs.isEqv ys r) := by
simp [isEqv_eq_decide, List.isEqv_eq_decide]
theorem eq_of_isEqv [DecidableEq α] (xs ys : Array α) (h : Array.isEqv xs ys (fun x y => x = y)) : xs = ys := by
@@ -99,17 +99,17 @@ theorem beq_eq_decide [BEq α] (xs ys : Array α) :
decide ( (i : Nat) (h' : i < xs.size), xs[i] == ys[i]'(h h')) else false := by
simp [BEq.beq, isEqv_eq_decide]
@[simp, grind =] theorem beq_toList [BEq α] (xs ys : Array α) : (xs.toList == ys.toList) = (xs == ys) := by
@[simp] theorem beq_toList [BEq α] (xs ys : Array α) : (xs.toList == ys.toList) = (xs == ys) := by
simp [beq_eq_decide, List.beq_eq_decide]
end Array
namespace List
@[simp, grind =] theorem isEqv_toArray [BEq α] (as bs : List α) : (as.toArray.isEqv bs.toArray r) = (as.isEqv bs r) := by
@[simp] theorem isEqv_toArray [BEq α] (as bs : List α) : (as.toArray.isEqv bs.toArray r) = (as.isEqv bs r) := by
simp [isEqv_eq_decide, Array.isEqv_eq_decide]
@[simp, grind =] theorem beq_toArray [BEq α] (as bs : List α) : (as.toArray == bs.toArray) = (as == bs) := by
@[simp] theorem beq_toArray [BEq α] (as bs : List α) : (as.toArray == bs.toArray) = (as == bs) := by
simp [beq_eq_decide, Array.beq_eq_decide]
end List

View File

@@ -39,10 +39,10 @@ namespace Array
@[simp] theorem toList_eq_nil_iff {xs : Array α} : xs.toList = [] xs = #[] := by
cases xs <;> simp
@[simp, grind =] theorem mem_toList_iff {a : α} {xs : Array α} : a xs.toList a xs := by
@[simp] theorem mem_toList_iff {a : α} {xs : Array α} : a xs.toList a xs := by
cases xs <;> simp
@[simp, grind =] theorem length_toList {xs : Array α} : xs.toList.length = xs.size := rfl
@[simp] theorem length_toList {xs : Array α} : xs.toList.length = xs.size := rfl
theorem eq_toArray : xs = List.toArray as xs.toList = as := by
cases xs
@@ -78,7 +78,6 @@ theorem ne_empty_of_size_pos (h : 0 < xs.size) : xs ≠ #[] := by
cases xs
simpa using List.ne_nil_of_length_pos h
@[grind]
theorem size_eq_zero_iff : xs.size = 0 xs = #[] :=
eq_empty_of_size_eq_zero, fun h => h rfl
@@ -528,7 +527,7 @@ theorem forall_getElem {xs : Array α} {p : α → Prop} :
rcases xs with xs
simp
@[simp, grind =] theorem isEmpty_toList {xs : Array α} : xs.toList.isEmpty = xs.isEmpty := by
@[simp] theorem isEmpty_toList {xs : Array α} : xs.toList.isEmpty = xs.isEmpty := by
rcases xs with _ | _ <;> simp
theorem isEmpty_eq_false_iff_exists_mem {xs : Array α} :
@@ -593,7 +592,7 @@ theorem anyM_loop_cons [Monad m] {p : α → m Bool} {a : α} {as : List α} {st
· rw [dif_neg]
omega
@[simp, grind =] theorem anyM_toList [Monad m] {p : α m Bool} {as : Array α} :
@[simp] theorem anyM_toList [Monad m] {p : α m Bool} {as : Array α} :
as.toList.anyM p = as.anyM p :=
match as with
| [] => by simp [anyM, anyM.loop]
@@ -652,7 +651,7 @@ theorem any_iff_exists {p : α → Bool} {as : Array α} {start stop} :
rw [Bool.eq_false_iff, Ne, any_eq_true]
simp
@[simp, grind =] theorem any_toList {p : α Bool} {as : Array α} : as.toList.any p = as.any p := by
@[simp] theorem any_toList {p : α Bool} {as : Array α} : as.toList.any p = as.any p := by
rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]
simp only [List.mem_iff_getElem, getElem_toList]
exact fun _, i, w, rfl, h => i, w, h, fun i, w, h => _, i, w, rfl, h
@@ -662,7 +661,7 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] {p : α → m Bool} {as :
dsimp [allM, anyM]
simp
@[simp, grind =] theorem allM_toList [Monad m] [LawfulMonad m] {p : α m Bool} {as : Array α} :
@[simp] theorem allM_toList [Monad m] [LawfulMonad m] {p : α m Bool} {as : Array α} :
as.toList.allM p = as.allM p := by
rw [allM_eq_not_anyM_not]
rw [ anyM_toList]
@@ -691,7 +690,7 @@ theorem all_iff_forall {p : α → Bool} {as : Array α} {start stop} :
rw [Bool.eq_false_iff, Ne, all_eq_true]
simp
@[simp, grind =] theorem all_toList {p : α Bool} {as : Array α} : as.toList.all p = as.all p := by
@[simp] theorem all_toList {p : α Bool} {as : Array α} : as.toList.all p = as.all p := by
rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]
simp only [List.mem_iff_getElem, getElem_toList]
constructor
@@ -731,18 +730,18 @@ theorem all_eq_true_iff_forall_mem {xs : Array α} : xs.all p ↔ ∀ x, x ∈ x
subst h
rw [all_toList]
@[grind] theorem _root_.List.anyM_toArray [Monad m] [LawfulMonad m] {p : α m Bool} {l : List α} :
theorem _root_.List.anyM_toArray [Monad m] [LawfulMonad m] {p : α m Bool} {l : List α} :
l.toArray.anyM p = l.anyM p := by
rw [ anyM_toList]
@[grind] theorem _root_.List.any_toArray {p : α Bool} {l : List α} : l.toArray.any p = l.any p := by
theorem _root_.List.any_toArray {p : α Bool} {l : List α} : l.toArray.any p = l.any p := by
rw [any_toList]
@[grind] theorem _root_.List.allM_toArray [Monad m] [LawfulMonad m] {p : α m Bool} {l : List α} :
theorem _root_.List.allM_toArray [Monad m] [LawfulMonad m] {p : α m Bool} {l : List α} :
l.toArray.allM p = l.allM p := by
rw [ allM_toList]
@[grind] theorem _root_.List.all_toArray {p : α Bool} {l : List α} : l.toArray.all p = l.all p := by
theorem _root_.List.all_toArray {p : α Bool} {l : List α} : l.toArray.all p = l.all p := by
rw [all_toList]
/-- Variant of `any_eq_true` in terms of membership rather than an array index. -/
@@ -808,7 +807,7 @@ theorem decide_forall_mem {xs : Array α} {p : α → Prop} [DecidablePred p] :
decide ( x, x xs p x) = xs.all p := by
simp [all_eq']
@[simp, grind =] theorem _root_.List.contains_toArray [BEq α] {l : List α} {a : α} :
@[simp] theorem _root_.List.contains_toArray [BEq α] {l : List α} {a : α} :
l.toArray.contains a = l.contains a := by
simp [Array.contains, List.any_beq]
@@ -1206,7 +1205,7 @@ where
induction l generalizing xs <;> simp [*]
simp [H]
@[simp, grind =] theorem _root_.List.map_toArray {f : α β} {l : List α} :
@[simp] theorem _root_.List.map_toArray {f : α β} {l : List α} :
l.toArray.map f = (l.map f).toArray := by
apply ext'
simp
@@ -1429,7 +1428,7 @@ theorem filter_congr {xs ys : Array α} (h : xs = ys)
induction xs with simp
| cons => split <;> simp [*]
@[grind] theorem toList_filter {p : α Bool} {xs : Array α} :
theorem toList_filter {p : α Bool} {xs : Array α} :
(xs.filter p).toList = xs.toList.filter p := by
simp
@@ -1438,7 +1437,7 @@ theorem filter_congr {xs ys : Array α} (h : xs = ys)
apply ext'
simp [h]
@[grind] theorem _root_.List.filter_toArray {p : α Bool} {l : List α} :
theorem _root_.List.filter_toArray {p : α Bool} {l : List α} :
l.toArray.filter p = (l.filter p).toArray := by
simp
@@ -1603,7 +1602,7 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
· simp_all [Id.run, List.filterMap_cons]
split <;> simp_all
@[grind] theorem toList_filterMap {f : α Option β} {xs : Array α} :
theorem toList_filterMap {f : α Option β} {xs : Array α} :
(xs.filterMap f).toList = xs.toList.filterMap f := by
simp [toList_filterMap']
@@ -1613,7 +1612,7 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
apply ext'
simp [h]
@[grind] theorem _root_.List.filterMap_toArray {f : α Option β} {l : List α} :
theorem _root_.List.filterMap_toArray {f : α Option β} {l : List α} :
l.toArray.filterMap f = (l.filterMap f).toArray := by
simp
@@ -2098,7 +2097,7 @@ theorem append_eq_map_iff {f : α → β} :
@[simp, grind] theorem flatten_empty : (#[] : Array (Array α)).flatten = #[] := by simp [flatten]; rfl
@[simp, grind] theorem toList_flatten {xss : Array (Array α)} :
@[simp] theorem toList_flatten {xss : Array (Array α)} :
xss.flatten.toList = (xss.toList.map toList).flatten := by
dsimp [flatten]
simp only [ foldl_toList]
@@ -2125,7 +2124,7 @@ theorem append_eq_map_iff {f : α → β} :
apply ext'
simp
@[simp, grind] theorem size_flatten {xss : Array (Array α)} : xss.flatten.size = (xss.map size).sum := by
@[simp] theorem size_flatten {xss : Array (Array α)} : xss.flatten.size = (xss.map size).sum := by
cases xss using array₂_induction
simp [Function.comp_def]
@@ -2308,7 +2307,7 @@ theorem flatMap_toList {xs : Array α} {f : α → List β} :
rcases xs with l
simp
@[simp, grind =] theorem toList_flatMap {xs : Array α} {f : α Array β} :
@[simp] theorem toList_flatMap {xs : Array α} {f : α Array β} :
(xs.flatMap f).toList = xs.toList.flatMap fun a => (f a).toList := by
rcases xs with l
simp
@@ -2323,7 +2322,7 @@ theorem flatMap_toArray_cons {β} {f : α → Array β} {a : α} {as : List α}
intro cs
induction as generalizing cs <;> simp_all
@[simp, grind =] theorem flatMap_toArray {β} {f : α Array β} {as : List α} :
@[simp] theorem flatMap_toArray {β} {f : α Array β} {as : List α} :
as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
induction as with
| nil => simp
@@ -2653,7 +2652,6 @@ abbrev sum_mkArray_nat := @sum_replicate_nat
/-! ### Preliminaries about `swap` needed for `reverse`. -/
@[grind]
theorem getElem?_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i j hi hj)[k]? =
if j = k then some xs[i] else if i = k then some xs[j] else xs[k]? := by
simp [swap_def, getElem?_set]
@@ -2712,15 +2710,15 @@ theorem getElem?_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i
true_and, Nat.not_lt] at h
rw [List.getElem?_eq_none_iff.2 _, List.getElem?_eq_none_iff.2 (xs.toList.length_reverse _)]
@[simp, grind =] theorem _root_.List.reverse_toArray {l : List α} : l.toArray.reverse = l.reverse.toArray := by
@[simp] theorem _root_.List.reverse_toArray {l : List α} : l.toArray.reverse = l.reverse.toArray := by
apply ext'
simp only [toList_reverse]
@[simp, grind =] theorem reverse_push {xs : Array α} {a : α} : (xs.push a).reverse = #[a] ++ xs.reverse := by
@[simp, grind] theorem reverse_push {xs : Array α} {a : α} : (xs.push a).reverse = #[a] ++ xs.reverse := by
cases xs
simp
@[simp, grind =] theorem mem_reverse {x : α} {xs : Array α} : x xs.reverse x xs := by
@[simp, grind] theorem mem_reverse {x : α} {xs : Array α} : x xs.reverse x xs := by
cases xs
simp
@@ -2884,7 +2882,7 @@ theorem size_extract_loop {xs ys : Array α} {size start : Nat} :
have h := Nat.le_of_not_gt h
rw [extract_loop_of_ge (h:=h), Nat.sub_eq_zero_of_le h, Nat.min_zero, Nat.add_zero]
@[simp, grind =] theorem size_extract {xs : Array α} {start stop : Nat} :
@[simp, grind] theorem size_extract {xs : Array α} {start stop : Nat} :
(xs.extract start stop).size = min stop xs.size - start := by
simp only [extract, Nat.sub_eq, emptyWithCapacity_eq]
rw [size_extract_loop, size_empty, Nat.zero_add, Nat.sub_min_sub_right, Nat.min_assoc,
@@ -2950,7 +2948,7 @@ theorem getElem_extract_aux {xs : Array α} {start stop : Nat} (h : i < (xs.extr
rw [size_extract] at h; apply Nat.add_lt_of_lt_sub'; apply Nat.lt_of_lt_of_le h
apply Nat.sub_le_sub_right; apply Nat.min_le_right
@[simp, grind =] theorem getElem_extract {xs : Array α} {start stop : Nat}
@[simp] theorem getElem_extract {xs : Array α} {start stop : Nat}
(h : i < (xs.extract start stop).size) :
(xs.extract start stop)[i] = xs[start + i]'(getElem_extract_aux h) :=
show (extract.loop xs (min stop xs.size - start) start #[])[i]
@@ -3005,7 +3003,7 @@ theorem extract_empty_of_size_le_start {xs : Array α} {start stop : Nat} (h : x
· simp
· simp at h₁
@[simp, grind =] theorem _root_.List.extract_toArray {l : List α} {start stop : Nat} :
@[simp] theorem _root_.List.extract_toArray {l : List α} {start stop : Nat} :
l.toArray.extract start stop = (l.extract start stop).toArray := by
apply ext'
simp
@@ -3744,25 +3742,25 @@ theorem contains_iff_mem [BEq α] [LawfulBEq α] {xs : Array α} {a : α} :
xs.contains a a xs := by
simp
@[simp, grind =]
@[simp, grind]
theorem contains_toList [BEq α] {xs : Array α} {x : α} :
xs.toList.contains x = xs.contains x := by
rcases xs with xs
simp
@[simp, grind =]
@[simp, grind]
theorem contains_map [BEq β] {xs : Array α} {x : β} {f : α β} :
(xs.map f).contains x = xs.any (fun a => x == f a) := by
rcases xs with xs
simp
@[simp, grind =]
@[simp, grind]
theorem contains_filter [BEq α] {xs : Array α} {x : α} {p : α Bool} :
(xs.filter p).contains x = xs.any (fun a => x == a && p a) := by
rcases xs with xs
simp
@[simp, grind =]
@[simp, grind]
theorem contains_filterMap [BEq β] {xs : Array α} {x : β} {f : α Option β} :
(xs.filterMap f).contains x = xs.any (fun a => (f a).any fun b => x == b) := by
rcases xs with xs
@@ -3775,19 +3773,19 @@ theorem contains_append [BEq α] {xs ys : Array α} {x : α} :
rcases ys with ys
simp
@[simp, grind =]
@[simp, grind]
theorem contains_flatten [BEq α] {xs : Array (Array α)} {x : α} :
(xs.flatten).contains x = xs.any fun xs => xs.contains x := by
rcases xs with xs
simp [Function.comp_def]
@[simp, grind =]
@[simp, grind]
theorem contains_reverse [BEq α] {xs : Array α} {x : α} :
(xs.reverse).contains x = xs.contains x := by
rcases xs with xs
simp
@[simp, grind =]
@[simp, grind]
theorem contains_flatMap [BEq β] {xs : Array α} {f : α Array β} {x : β} :
(xs.flatMap f).contains x = xs.any fun a => (f a).contains x := by
rcases xs with xs
@@ -3800,7 +3798,7 @@ theorem pop_append {xs ys : Array α} :
(xs ++ ys).pop = if ys.isEmpty then xs.pop else xs ++ ys.pop := by
split <;> simp_all
@[simp, grind =] theorem pop_replicate {n : Nat} {a : α} : (replicate n a).pop = replicate (n - 1) a := by
@[simp] theorem pop_replicate {n : Nat} {a : α} : (replicate n a).pop = replicate (n - 1) a := by
ext <;> simp
@[deprecated pop_replicate (since := "2025-03-18")]
@@ -4098,7 +4096,6 @@ theorem getElem_swap' {xs : Array α} {i j : Nat} {hi hj} {k : Nat} (hk : k < xs
· simp_all only [getElem_swap_left]
· split <;> simp_all
@[grind]
theorem getElem_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} (hk : k < (xs.swap i j hi hj).size) :
(xs.swap i j hi hj)[k] = if k = i then xs[j] else if k = j then xs[i] else xs[k]'(by simp_all) := by
apply getElem_swap'
@@ -4364,10 +4361,7 @@ theorem foldl_toList_eq_map {l : List α} {acc : Array β} {G : α → β} :
/-! # uset -/
-- For verification purposes, we use `simp` to replace `uset` with `set`.
@[simp, grind =] theorem uset_eq_set {xs : Array α} {v : α} {i : USize} (h : i.toNat < xs.size) :
uset xs i v h = set xs i.toNat v h := by
simp [uset]
attribute [simp] uset
theorem size_uset {xs : Array α} {v : α} {i : USize} (h : i.toNat < xs.size) :
(uset xs i v h).size = xs.size := by
@@ -4384,7 +4378,7 @@ theorem getElem!_eq_getD [Inhabited α] {xs : Array α} {i} : xs[i]! = xs.getD i
/-! # mem -/
@[simp, grind =] theorem mem_toList {a : α} {xs : Array α} : a xs.toList a xs := mem_def.symm
@[simp] theorem mem_toList {a : α} {xs : Array α} : a xs.toList a xs := mem_def.symm
@[deprecated not_mem_empty (since := "2025-03-25")]
theorem not_mem_nil (a : α) : ¬ a #[] := nofun
@@ -4427,12 +4421,12 @@ theorem getElem?_push_eq {xs : Array α} {x : α} : (xs.push x)[xs.size]? = some
/-! ### forIn -/
@[simp, grind =] theorem forIn_toList [Monad m] {xs : Array α} {b : β} {f : α β m (ForInStep β)} :
@[simp] theorem forIn_toList [Monad m] {xs : Array α} {b : β} {f : α β m (ForInStep β)} :
forIn xs.toList b f = forIn xs b f := by
cases xs
simp
@[simp, grind =] theorem forIn'_toList [Monad m] {xs : Array α} {b : β} {f : (a : α) a xs.toList β m (ForInStep β)} :
@[simp] theorem forIn'_toList [Monad m] {xs : Array α} {b : β} {f : (a : α) a xs.toList β m (ForInStep β)} :
forIn' xs.toList b f = forIn' xs b (fun a m b => f a (mem_toList.mpr m) b) := by
cases xs
simp
@@ -4445,7 +4439,7 @@ abbrev contains_def [DecidableEq α] {a : α} {xs : Array α} : xs.contains a
/-! ### isPrefixOf -/
@[simp, grind =] theorem isPrefixOf_toList [BEq α] {xs ys : Array α} :
@[simp] theorem isPrefixOf_toList [BEq α] {xs ys : Array α} :
xs.toList.isPrefixOf ys.toList = xs.isPrefixOf ys := by
cases xs
cases ys
@@ -4486,32 +4480,32 @@ abbrev contains_def [DecidableEq α] {a : α} {xs : Array α} : xs.contains a
/-! ### findSomeM?, findM?, findSome?, find? -/
@[simp, grind =] theorem findSomeM?_toList [Monad m] [LawfulMonad m] {p : α m (Option β)} {xs : Array α} :
@[simp] theorem findSomeM?_toList [Monad m] [LawfulMonad m] {p : α m (Option β)} {xs : Array α} :
xs.toList.findSomeM? p = xs.findSomeM? p := by
cases xs
simp
@[simp, grind =] theorem findM?_toList [Monad m] [LawfulMonad m] {p : α m Bool} {xs : Array α} :
@[simp] theorem findM?_toList [Monad m] [LawfulMonad m] {p : α m Bool} {xs : Array α} :
xs.toList.findM? p = xs.findM? p := by
cases xs
simp
@[simp, grind =] theorem findSome?_toList {p : α Option β} {xs : Array α} :
@[simp] theorem findSome?_toList {p : α Option β} {xs : Array α} :
xs.toList.findSome? p = xs.findSome? p := by
cases xs
simp
@[simp, grind =] theorem find?_toList {p : α Bool} {xs : Array α} :
@[simp] theorem find?_toList {p : α Bool} {xs : Array α} :
xs.toList.find? p = xs.find? p := by
cases xs
simp
@[simp, grind =] theorem finIdxOf?_toList [BEq α] {a : α} {xs : Array α} :
@[simp] theorem finIdxOf?_toList [BEq α] {a : α} {xs : Array α} :
xs.toList.finIdxOf? a = (xs.finIdxOf? a).map (Fin.cast (by simp)) := by
cases xs
simp
@[simp, grind =] theorem findFinIdx?_toList {p : α Bool} {xs : Array α} :
@[simp] theorem findFinIdx?_toList {p : α Bool} {xs : Array α} :
xs.toList.findFinIdx? p = (xs.findFinIdx? p).map (Fin.cast (by simp)) := by
cases xs
simp
@@ -4530,10 +4524,10 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
theorem toListRev_toArray {l : List α} : l.toArray.toListRev = l.reverse := by simp
@[simp, grind =] theorem take_toArray {l : List α} {i : Nat} : l.toArray.take i = (l.take i).toArray := by
@[simp] theorem take_toArray {l : List α} {i : Nat} : l.toArray.take i = (l.take i).toArray := by
apply Array.ext <;> simp
@[simp, grind =] theorem mapM_toArray [Monad m] [LawfulMonad m] {f : α m β} {l : List α} :
@[simp] theorem mapM_toArray [Monad m] [LawfulMonad m] {f : α m β} {l : List α} :
l.toArray.mapM f = List.toArray <$> l.mapM f := by
simp only [ mapM'_eq_mapM, mapM_eq_foldlM]
suffices xs : Array β,
@@ -4550,12 +4544,12 @@ theorem toListRev_toArray {l : List α} : l.toArray.toListRev = l.reverse := by
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
@[simp, grind =] theorem modify_toArray {f : α α} {l : List α} {i : Nat} :
@[simp] theorem modify_toArray {f : α α} {l : List α} {i : Nat} :
l.toArray.modify i f = (l.modify i f).toArray := by
apply ext'
simp
@[simp, grind =] theorem flatten_toArray {L : List (List α)} :
@[simp] theorem flatten_toArray {L : List (List α)} :
(L.toArray.map List.toArray).flatten = L.flatten.toArray := by
apply ext'
simp [Function.comp_def]
@@ -4630,11 +4624,11 @@ end Array
namespace List
@[simp, grind =] theorem unzip_toArray {as : List (α × β)} :
@[simp] theorem unzip_toArray {as : List (α × β)} :
as.toArray.unzip = Prod.map List.toArray List.toArray as.unzip := by
ext1 <;> simp
@[simp, grind =] theorem firstM_toArray [Alternative m] {as : List α} {f : α m β} :
@[simp] theorem firstM_toArray [Alternative m] {as : List α} {f : α m β} :
as.toArray.firstM f = as.firstM f := by
unfold Array.firstM
suffices i, i as.length firstM.go f as.toArray (as.length - i) = firstM f (as.drop (as.length - i)) by

View File

@@ -16,11 +16,11 @@ namespace Array
/-! ### Lexicographic ordering -/
@[simp, grind =] theorem _root_.List.lt_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray < l₂.toArray l₁ < l₂ := Iff.rfl
@[simp, grind =] theorem _root_.List.le_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray l₂.toArray l₁ l₂ := Iff.rfl
@[simp] theorem _root_.List.lt_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray < l₂.toArray l₁ < l₂ := Iff.rfl
@[simp] theorem _root_.List.le_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray l₂.toArray l₁ l₂ := Iff.rfl
@[simp, grind =] theorem lt_toList [LT α] {xs ys : Array α} : xs.toList < ys.toList xs < ys := Iff.rfl
@[simp, grind =] theorem le_toList [LT α] {xs ys : Array α} : xs.toList ys.toList xs ys := Iff.rfl
@[simp] theorem lt_toList [LT α] {xs ys : Array α} : xs.toList < ys.toList xs < ys := Iff.rfl
@[simp] theorem le_toList [LT α] {xs ys : Array α} : xs.toList ys.toList xs ys := Iff.rfl
protected theorem not_lt_iff_ge [LT α] {l₁ l₂ : List α} : ¬ l₁ < l₂ l₂ l₁ := Iff.rfl
protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : List α} :
@@ -47,7 +47,7 @@ private theorem cons_lex_cons [BEq α] {lt : αα → Bool} {a b : α} {xs
cases a == b <;> simp
· simp
@[simp, grind =] theorem _root_.List.lex_toArray [BEq α] {lt : α α Bool} {l₁ l₂ : List α} :
@[simp] theorem _root_.List.lex_toArray [BEq α] {lt : α α Bool} {l₁ l₂ : List α} :
l₁.toArray.lex l₂.toArray lt = l₁.lex l₂ lt := by
induction l₁ generalizing l₂ with
| nil => cases l₂ <;> simp [lex, Id.run]
@@ -57,7 +57,7 @@ private theorem cons_lex_cons [BEq α] {lt : αα → Bool} {a b : α} {xs
| cons y l₂ =>
rw [List.toArray_cons, List.toArray_cons y, cons_lex_cons, List.lex, ih]
@[simp, grind =] theorem lex_toList [BEq α] {lt : α α Bool} {xs ys : Array α} :
@[simp] theorem lex_toList [BEq α] {lt : α α Bool} {xs ys : Array α} :
xs.toList.lex ys.toList lt = xs.lex ys lt := by
cases xs <;> cases ys <;> simp

View File

@@ -111,11 +111,11 @@ end Array
namespace List
@[simp, grind =] theorem mapFinIdx_toArray {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
@[simp] theorem mapFinIdx_toArray {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
ext <;> simp
@[simp, grind =] theorem mapIdx_toArray {f : Nat α β} {l : List α} :
@[simp] theorem mapIdx_toArray {f : Nat α β} {l : List α} :
l.toArray.mapIdx f = (l.mapIdx f).toArray := by
ext <;> simp
@@ -132,7 +132,7 @@ namespace Array
@[deprecated getElem_zipIdx (since := "2025-01-21")]
abbrev getElem_zipWithIndex := @getElem_zipIdx
@[simp, grind =] theorem zipIdx_toArray {l : List α} {k : Nat} :
@[simp] theorem zipIdx_toArray {l : List α} {k : Nat} :
l.toArray.zipIdx k = (l.zipIdx k).toArray := by
ext i hi₁ hi₂ <;> simp [Nat.add_comm]
@@ -454,7 +454,7 @@ end Array
namespace List
@[grind] theorem mapFinIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
theorem mapFinIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
{f : (i : Nat) α (h : i < l.length) m β} :
l.toArray.mapFinIdxM f = toArray <$> l.mapFinIdxM f := by
let rec go (i : Nat) (acc : Array β) (inv : i + acc.size = l.length) :
@@ -475,7 +475,7 @@ namespace List
simp only [Array.mapFinIdxM, mapFinIdxM]
exact go _ #[] _
@[grind] theorem mapIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
theorem mapIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
{f : Nat α m β} :
l.toArray.mapIdxM f = toArray <$> l.mapIdxM f := by
let rec go (bs : List α) (acc : Array β) (inv : bs.length + acc.size = l.length) :

View File

@@ -264,7 +264,7 @@ end Array
namespace List
@[grind =] theorem filterM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α m Bool} :
theorem filterM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α m Bool} :
l.toArray.filterM p = toArray <$> l.filterM p := by
simp only [Array.filterM, filterM, foldlM_toArray, bind_pure_comp, Functor.map_map]
conv => lhs; rw [ reverse_nil]
@@ -284,7 +284,7 @@ namespace List
subst w
rw [filterM_toArray]
@[grind =] theorem filterRevM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α m Bool} :
theorem filterRevM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α m Bool} :
l.toArray.filterRevM p = toArray <$> l.filterRevM p := by
simp [Array.filterRevM, filterRevM]
rw [ foldlM_reverse, foldlM_toArray, Array.filterM, filterM_toArray]
@@ -296,7 +296,7 @@ namespace List
subst w
rw [filterRevM_toArray]
@[grind =] theorem filterMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α m (Option β)} :
theorem filterMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α m (Option β)} :
l.toArray.filterMapM f = toArray <$> l.filterMapM f := by
simp [Array.filterMapM, filterMapM]
conv => lhs; rw [ reverse_nil]
@@ -314,7 +314,7 @@ namespace List
subst w
rw [filterMapM_toArray]
@[simp, grind =] theorem flatMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α m (Array β)} :
@[simp] theorem flatMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α m (Array β)} :
l.toArray.flatMapM f = toArray <$> l.flatMapM (fun a => Array.toList <$> f a) := by
simp only [Array.flatMapM, bind_pure_comp, foldlM_toArray, flatMapM]
conv => lhs; arg 2; change [].reverse.flatten.toArray

View File

@@ -464,12 +464,8 @@ instance : Append (Subarray α) where
let a := x.toArray ++ y.toArray
a.toSubarray 0 a.size
/-- `Subarray` representation. -/
protected def Subarray.repr [Repr α] (s : Subarray α) : Std.Format :=
repr s.toArray ++ ".toSubarray"
instance [Repr α] : Repr (Subarray α) where
reprPrec s _ := Subarray.repr s
reprPrec s _ := repr s.toArray ++ ".toSubarray"
instance [ToString α] : ToString (Subarray α) where
toString s := toString s.toArray

View File

@@ -199,13 +199,7 @@ protected def toHex {n : Nat} (x : BitVec n) : String :=
let t := (List.replicate ((n+3) / 4 - s.length) '0').asString
t ++ s
/-- `BitVec` representation. -/
protected def BitVec.repr (a : BitVec n) : Std.Format :=
"0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
instance : Repr (BitVec n) where
reprPrec a _ := BitVec.repr a
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
instance : ToString (BitVec n) where toString a := toString (repr a)
end repr_toString

View File

@@ -1501,6 +1501,7 @@ theorem sdiv_intMin {x : BitVec w} :
by_cases h : x = intMin w
· subst h
simp
omega
· simp only [sdiv_eq, msb_intMin, show 0 < w by omega, h]
have := Nat.two_pow_pos (w-1)
by_cases hx : x.msb

View File

@@ -518,10 +518,6 @@ theorem getElem_ofBool {b : Bool} {h : i < 1}: (ofBool b)[i] = b := by
· rintro rfl
simp
/-- `0#w = 1#w` iff the width is zero. -/
@[simp] theorem zero_eq_one_iff (w : Nat) : (0#w = 1#w) (w = 0) := by
rw [ one_eq_zero_iff, eq_comm]
/-! ### msb -/
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
@@ -5316,14 +5312,6 @@ theorem msb_eq_toNat {x : BitVec w}:
x.msb = decide (x.toNat 2 ^ (w - 1)) := by
simp only [msb_eq_decide, ge_iff_le]
/-- Negating a bitvector created from a natural number equals
creating a bitvector from the the negative of that number.
-/
theorem neg_ofNat_eq_ofInt_neg {w : Nat} {x : Nat} :
- BitVec.ofNat w x = BitVec.ofInt w (- x) := by
apply BitVec.eq_of_toInt_eq
simp [BitVec.toInt_neg, BitVec.toInt_ofNat]
/-! ### abs -/
theorem abs_eq (x : BitVec w) : x.abs = if x.msb then -x else x := by rfl

View File

@@ -174,13 +174,13 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) :
@[simp] theorem mk_zero : (0, Nat.succ_pos n : Fin (n + 1)) = 0 := rfl
@[simp] theorem zero_le [NeZero n] (a : Fin n) : 0 a := Nat.zero_le a.val
@[simp] theorem zero_le (a : Fin (n + 1)) : 0 a := Nat.zero_le a.val
theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one
@[simp] theorem not_lt_zero [NeZero n] (a : Fin n) : ¬a < 0 := nofun
@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun
theorem pos_iff_ne_zero [NeZero n] {a : Fin n} : 0 < a a 0 := by
theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a a 0 := by
rw [lt_def, val_zero, Nat.pos_iff_ne_zero, val_ne_iff]; rfl
theorem eq_zero_or_eq_succ {n : Nat} : i : Fin (n + 1), i = 0 j : Fin n, i = j.succ
@@ -506,17 +506,17 @@ theorem castSucc_inj {a b : Fin n} : a.castSucc = b.castSucc ↔ a = b := by sim
theorem castSucc_lt_last (a : Fin n) : a.castSucc < last n := a.is_lt
@[simp] theorem castSucc_zero [NeZero n] : castSucc (0 : Fin n) = 0 := rfl
@[simp] theorem castSucc_zero : castSucc (0 : Fin (n + 1)) = 0 := rfl
@[simp] theorem castSucc_one {n : Nat} : castSucc (1 : Fin (n + 2)) = 1 := rfl
/-- `castSucc i` is positive when `i` is positive -/
theorem castSucc_pos [NeZero n] {i : Fin n} (h : 0 < i) : 0 < i.castSucc := by
theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < i.castSucc := by
simpa [lt_def] using h
@[simp] theorem castSucc_eq_zero_iff [NeZero n] {a : Fin n} : a.castSucc = 0 a = 0 := by simp [Fin.ext_iff]
@[simp] theorem castSucc_eq_zero_iff {a : Fin (n + 1)} : a.castSucc = 0 a = 0 := by simp [Fin.ext_iff]
theorem castSucc_ne_zero_iff [NeZero n] {a : Fin n} : a.castSucc 0 a 0 :=
theorem castSucc_ne_zero_iff {a : Fin (n + 1)} : a.castSucc 0 a 0 :=
not_congr <| castSucc_eq_zero_iff
theorem castSucc_fin_succ (n : Nat) (j : Fin n) :
@@ -1002,12 +1002,10 @@ theorem val_mul {n : Nat} : ∀ a b : Fin n, (a * b).val = a.val * b.val % n
theorem coe_mul {n : Nat} : a b : Fin n, ((a * b : Fin n) : Nat) = a * b % n
| _, _, _, _ => rfl
protected theorem mul_one [i : NeZero n] (k : Fin n) : k * 1 = k := by
match n, i with
| n + 1, _ =>
match n with
| 0 => exact Subsingleton.elim (α := Fin 1) ..
| n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by
match n with
| 0 => exact Subsingleton.elim (α := Fin 1) ..
| n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
Fin.ext <| by rw [mul_def, mul_def, Nat.mul_comm]
@@ -1020,17 +1018,15 @@ protected theorem mul_assoc (a b c : Fin n) : a * b * c = a * (b * c) := by
simp only [ Nat.mul_mod, Nat.mul_assoc]
instance : Std.Associative (α := Fin n) (· * ·) := Fin.mul_assoc
protected theorem one_mul [NeZero n] (k : Fin n) : (1 : Fin n) * k = k := by
protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by
rw [Fin.mul_comm, Fin.mul_one]
instance [NeZero n] : Std.LawfulIdentity (α := Fin n) (· * ·) 1 where
instance : Std.LawfulIdentity (α := Fin (n + 1)) (· * ·) 1 where
left_id := Fin.one_mul
right_id := Fin.mul_one
protected theorem mul_zero [NeZero n] (k : Fin n) : k * 0 = 0 := by
simp [Fin.ext_iff, mul_def]
protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [Fin.ext_iff, mul_def]
protected theorem zero_mul [NeZero n] (k : Fin n) : (0 : Fin n) * k = 0 := by
protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by
simp [Fin.ext_iff, mul_def]
end Fin

View File

@@ -291,11 +291,8 @@ implementation.
instance : Inhabited Float where
default := UInt64.toFloat 0
protected def Float.repr (n : Float) (prec : Nat) : Std.Format :=
if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
instance : Repr Float where
reprPrec := Float.repr
reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
instance : ReprAtom Float :=

View File

@@ -292,11 +292,8 @@ implementation.
instance : Inhabited Float32 where
default := UInt64.toFloat32 0
protected def Float32.repr (n : Float32) (prec : Nat) : Std.Format :=
if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
instance : Repr Float32 where
reprPrec := Float32.repr
reprPrec n prec := if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
instance : ReprAtom Float32 :=

View File

@@ -44,7 +44,7 @@ Integer division that uses the E-rounding convention. Usually accessed via the `
Division by zero is defined to be zero, rather than an error.
In the E-rounding convention (Euclidean division), `Int.emod x y` satisfies `0 ≤ Int.emod x y < Int.natAbs y`
for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.ediv x y) * y = x`
for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.edivx y) * y = x`
for `y ≠ 0`.
This means that `Int.ediv x y` is `⌊x / y⌋` when `y > 0` and `⌈x / y⌉` when `y < 0`.
@@ -76,7 +76,7 @@ def ediv : (@& Int) → (@& Int) → Int
Integer modulus that uses the E-rounding convention. Usually accessed via the `%` operator.
In the E-rounding convention (Euclidean division), `Int.emod x y` satisfies `0 ≤ Int.emod x y < Int.natAbs y`
for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.ediv x y) * y = x`
for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.edivx y) * y = x`
for `y ≠ 0`.
This function is overridden by the compiler with an efficient implementation. This definition is

View File

@@ -92,9 +92,7 @@ open Nat
/-! ### length -/
-- Note: this is not a good `grind` candidate,
-- as in some circumstances it results in many case splits.
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
@[grind ] theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
theorem ne_nil_of_length_eq_add_one (_ : length l = n + 1) : l [] := fun _ => nomatch l
@@ -241,17 +239,15 @@ theorem getElem!_eq_getElem?_getD [Inhabited α] {l : List α} {i : Nat} :
@[simp, grind =] theorem getElem?_nil {i : Nat} : ([] : List α)[i]? = none := rfl
@[grind =]
theorem getElem_cons {l : List α} (w : i < (a :: l).length) :
(a :: l)[i] =
if h : i = 0 then a else l[i-1]'(match i, h with | i+1, _ => succ_lt_succ_iff.mp w) := by
cases i <;> simp
theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := rfl
@[grind =] theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := rfl
@[simp] theorem getElem?_cons_succ {l : List α} : (a::l)[i+1]? = l[i]? := rfl
@[simp, grind =] theorem getElem?_cons_succ {l : List α} : (a::l)[i+1]? = l[i]? := rfl
@[grind =]
theorem getElem?_cons : (a :: l)[i]? = if i = 0 then some a else l[i-1]? := by
cases i <;> simp [getElem?_cons_zero]
@@ -317,7 +313,7 @@ theorem getElem_zero {l : List α} (h : 0 < l.length) : l[0] = l.head (length_po
match l, h with
| _ :: _, _ => rfl
@[ext] theorem ext_getElem? {l₁ l₂ : List α} (h : i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ :=
@[ext, grind ext] theorem ext_getElem? {l₁ l₂ : List α} (h : i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ :=
match l₁, l₂, h with
| [], [], _ => rfl
| _ :: _, [], h => by simpa using h 0

View File

@@ -27,7 +27,7 @@ open Nat
/-! ### take -/
@[simp, grind =] theorem length_take : {i : Nat} {l : List α}, (take i l).length = min i l.length
@[simp] theorem length_take : {i : Nat} {l : List α}, (take i l).length = min i l.length
| 0, l => by simp [Nat.zero_min]
| succ n, [] => by simp [Nat.min_zero]
| succ n, _ :: l => by simp [Nat.succ_min_succ, length_take]
@@ -47,7 +47,7 @@ theorem getElem_take' {xs : List α} {i j : Nat} (hi : i < xs.length) (hj : i <
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
@[simp, grind =] theorem getElem_take {xs : List α} {j i : Nat} {h : i < (xs.take j).length} :
@[simp] theorem getElem_take {xs : List α} {j i : Nat} {h : i < (xs.take j).length} :
(xs.take j)[i] =
xs[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
rw [length_take, Nat.lt_min] at h; rw [getElem_take' (xs := xs) _ h.1]
@@ -56,7 +56,7 @@ theorem getElem?_take_eq_none {l : List α} {i j : Nat} (h : i ≤ j) :
(l.take i)[j]? = none :=
getElem?_eq_none <| Nat.le_trans (length_take_le _ _) h
@[grind =]theorem getElem?_take {l : List α} {i j : Nat} :
theorem getElem?_take {l : List α} {i j : Nat} :
(l.take i)[j]? = if j < i then l[j]? else none := by
split
· next h => exact getElem?_take_of_lt h
@@ -232,7 +232,7 @@ theorem getElem_drop' {xs : List α} {i j : Nat} (h : i + j < xs.length) :
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
@[simp, grind =] theorem getElem_drop {xs : List α} {i : Nat} {j : Nat} {h : j < (xs.drop i).length} :
@[simp] theorem getElem_drop {xs : List α} {i : Nat} {j : Nat} {h : j < (xs.drop i).length} :
(xs.drop i)[j] = xs[i + j]'(by
rw [Nat.add_comm]
exact Nat.add_lt_of_lt_sub (length_drop h)) := by

View File

@@ -40,7 +40,7 @@ theorem drop_one : ∀ {l : List α}, l.drop 1 = l.tail
| _ + 1, [] => rfl
| _ + 1, x :: _ => congrArg (cons x) (take_append_drop ..)
@[simp, grind =] theorem length_drop : {i : Nat} {l : List α}, (drop i l).length = l.length - i
@[simp] theorem length_drop : {i : Nat} {l : List α}, (drop i l).length = l.length - i
| 0, _ => rfl
| succ i, [] => Eq.symm (Nat.zero_sub (succ i))
| succ i, x :: l => calc

View File

@@ -66,7 +66,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
apply ext'
simp
@[simp, grind =] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
apply ext'
simp
@@ -75,37 +75,37 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
funext a
simp
@[simp, grind =] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
cases l <;> simp [Array.isEmpty]
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
@[simp, grind =] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
@[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
simp only [back!, size_toArray, getElem!_toArray, getLast!_eq_getElem!]
@[simp, grind =] theorem back?_toArray (l : List α) : l.toArray.back? = l.getLast? := by
@[simp] theorem back?_toArray (l : List α) : l.toArray.back? = l.getLast? := by
simp [back?, List.getLast?_eq_getElem?]
@[simp, grind =] theorem back_toArray (l : List α) (h) :
@[simp] theorem back_toArray (l : List α) (h) :
l.toArray.back = l.getLast (by simp at h; exact ne_nil_of_length_pos h) := by
simp [back, List.getLast_eq_getElem]
@[simp, grind =] theorem _root_.Array.getLast!_toList [Inhabited α] (xs : Array α) :
@[simp] theorem _root_.Array.getLast!_toList [Inhabited α] (xs : Array α) :
xs.toList.getLast! = xs.back! := by
rcases xs with xs
simp
@[simp, grind =] theorem _root_.Array.getLast?_toList (xs : Array α) :
@[simp] theorem _root_.Array.getLast?_toList (xs : Array α) :
xs.toList.getLast? = xs.back? := by
rcases xs with xs
simp
@[simp, grind =] theorem _root_.Array.getLast_toList (xs : Array α) (h) :
@[simp] theorem _root_.Array.getLast_toList (xs : Array α) (h) :
xs.toList.getLast h = xs.back (by simpa [ne_nil_iff_length_pos] using h) := by
rcases xs with xs
simp
@[simp, grind =] theorem set_toArray (l : List α) (i : Nat) (a : α) (h : i < l.length) :
@[simp] theorem set_toArray (l : List α) (i : Nat) (a : α) (h : i < l.length) :
(l.toArray.set i a) = (l.set i a).toArray := rfl
@[simp] theorem forIn'_loop_toArray [Monad m] (l : List α) (f : (a : α) a l.toArray β m (ForInStep β)) (i : Nat)
@@ -126,30 +126,30 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
simp only [t]
congr
@[simp, grind =] theorem forIn'_toArray [Monad m] (l : List α) (b : β) (f : (a : α) a l.toArray β m (ForInStep β)) :
@[simp] theorem forIn'_toArray [Monad m] (l : List α) (b : β) (f : (a : α) a l.toArray β m (ForInStep β)) :
forIn' l.toArray b f = forIn' l b (fun a m b => f a (mem_toArray.mpr m) b) := by
change Array.forIn' _ _ _ = List.forIn' _ _ _
rw [Array.forIn', forIn'_loop_toArray]
simp
@[simp, grind =] theorem forIn_toArray [Monad m] (l : List α) (b : β) (f : α β m (ForInStep β)) :
@[simp] theorem forIn_toArray [Monad m] (l : List α) (b : β) (f : α β m (ForInStep β)) :
forIn l.toArray b f = forIn l b f := by
simpa using forIn'_toArray l b fun a m b => f a b
@[grind =] theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
l.toArray.foldrM f init = l.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList]
simp
@[grind =] theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
l.toArray.foldlM f init = l.foldlM f init := by
rw [foldlM_toList]
@[grind =] theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
l.toArray.foldr f init = l.foldr f init := by
rw [foldr_toList]
@[grind =] theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
l.toArray.foldl f init = l.foldl f init := by
rw [foldl_toList]
@@ -176,7 +176,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
simp only [size_toArray, foldlM_toArray']
induction l <;> simp_all
@[simp, grind =]
@[simp]
theorem forM_toArray [Monad m] (l : List α) (f : α m PUnit) :
(forM l.toArray f) = l.forM f :=
forM_toArray' l f rfl
@@ -195,15 +195,15 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
subst h
rw [foldl_toList]
@[simp, grind =] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
@[simp] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
simp [Array.sum, List.sum]
@[simp, grind =] theorem append_toArray (l₁ l₂ : List α) :
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp] theorem push_append_toArray {as : Array α} {a : α} {bs : List α} : as.push a ++ bs.toArray = as ++ (a :: bs).toArray := by
@[simp] theorem push_append_toArray {as : Array α} {a : α} {bs : List α} : as.push a ++ bs.toArray = as ++ (a ::bs).toArray := by
cases as
simp
@@ -213,7 +213,7 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
@[simp] theorem foldr_push {l : List α} {as : Array α} : l.foldr (fun a bs => push bs a) as = as ++ l.reverse.toArray := by
rw [foldr_eq_foldl_reverse, foldl_push]
@[simp, grind =] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α m (Option β)) (l : List α) :
@[simp] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α m (Option β)) (l : List α) :
l.toArray.findSomeM? f = l.findSomeM? f := by
rw [Array.findSomeM?]
simp only [bind_pure_comp, map_pure, forIn_toArray]
@@ -246,7 +246,7 @@ theorem findRevM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : Lis
l.toArray.findRevM? f = l.reverse.findM? f := by
rw [Array.findRevM?, findSomeRevM?_toArray, findM?_eq_findSomeM?]
@[simp, grind =] theorem findM?_toArray [Monad m] [LawfulMonad m] (f : α m Bool) (l : List α) :
@[simp] theorem findM?_toArray [Monad m] [LawfulMonad m] (f : α m Bool) (l : List α) :
l.toArray.findM? f = l.findM? f := by
rw [Array.findM?]
simp only [bind_pure_comp, map_pure, forIn_toArray]
@@ -257,11 +257,11 @@ theorem findRevM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : Lis
congr
ext1 (_|_) <;> simp [ih]
@[simp, grind =] theorem findSome?_toArray (f : α Option β) (l : List α) :
@[simp] theorem findSome?_toArray (f : α Option β) (l : List α) :
l.toArray.findSome? f = l.findSome? f := by
rw [Array.findSome?, findSomeM?_id, findSomeM?_toArray, Id.run]
@[simp, grind =] theorem find?_toArray (f : α Bool) (l : List α) :
@[simp] theorem find?_toArray (f : α Bool) (l : List α) :
l.toArray.find? f = l.find? f := by
rw [Array.find?]
simp only [Id.run, Id, Id.pure_eq, Id.bind_eq, forIn_toArray]
@@ -297,12 +297,12 @@ private theorem findFinIdx?_loop_toArray (w : l' = l.drop j) :
simp
termination_by l.length - j
@[simp, grind =] theorem findFinIdx?_toArray (p : α Bool) (l : List α) :
@[simp] theorem findFinIdx?_toArray (p : α Bool) (l : List α) :
l.toArray.findFinIdx? p = l.findFinIdx? p := by
rw [Array.findFinIdx?, findFinIdx?, findFinIdx?_loop_toArray]
simp
@[simp, grind =] theorem findIdx?_toArray (p : α Bool) (l : List α) :
@[simp] theorem findIdx?_toArray (p : α Bool) (l : List α) :
l.toArray.findIdx? p = l.findIdx? p := by
rw [Array.findIdx?_eq_map_findFinIdx?_val, findIdx?_eq_map_findFinIdx?_val]
simp
@@ -334,21 +334,21 @@ private theorem idxAuxOf_toArray [BEq α] (a : α) (l : List α) (j : Nat) (w :
simp
termination_by l.length - j
@[simp, grind =] theorem finIdxOf?_toArray [BEq α] (a : α) (l : List α) :
@[simp] theorem finIdxOf?_toArray [BEq α] (a : α) (l : List α) :
l.toArray.finIdxOf? a = l.finIdxOf? a := by
rw [Array.finIdxOf?, finIdxOf?, findFinIdx?]
simp [idxAuxOf_toArray]
@[simp, grind =] theorem idxOf?_toArray [BEq α] (a : α) (l : List α) :
@[simp] theorem idxOf?_toArray [BEq α] (a : α) (l : List α) :
l.toArray.idxOf? a = l.idxOf? a := by
rw [Array.idxOf?, idxOf?]
simp [finIdxOf?, findIdx?_eq_map_findFinIdx?_val]
@[simp, grind =] theorem findIdx_toArray {as : List α} {p : α Bool} :
@[simp] theorem findIdx_toArray {as : List α} {p : α Bool} :
as.toArray.findIdx p = as.findIdx p := by
rw [Array.findIdx, findIdx?_toArray, findIdx_eq_getD_findIdx?]
@[simp, grind =] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
@[simp] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
as.toArray.idxOf a = as.idxOf a := by
rw [Array.idxOf, findIdx_toArray, idxOf]
@@ -383,7 +383,7 @@ theorem isPrefixOfAux_toArray_zero [BEq α] (l₁ l₂ : List α) (hle : l₁.le
| a::l₁, b::l₂ =>
simp [isPrefixOf_cons₂, isPrefixOfAux_toArray_succ', isPrefixOfAux_toArray_zero]
@[simp, grind =] theorem isPrefixOf_toArray [BEq α] (l₁ l₂ : List α) :
@[simp] theorem isPrefixOf_toArray [BEq α] (l₁ l₂ : List α) :
l₁.toArray.isPrefixOf l₂.toArray = l₁.isPrefixOf l₂ := by
rw [Array.isPrefixOf]
split <;> rename_i h
@@ -429,12 +429,12 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
| a :: as, b :: bs =>
simp [zipWith_cons_cons, zipWithAux_toArray_succ', zipWithAux_toArray_zero, push_append_toArray]
@[simp, grind =] theorem zipWith_toArray (as : List α) (bs : List β) (f : α β γ) :
@[simp] theorem zipWith_toArray (as : List α) (bs : List β) (f : α β γ) :
Array.zipWith f as.toArray bs.toArray = (List.zipWith f as bs).toArray := by
rw [Array.zipWith]
simp [zipWithAux_toArray_zero]
@[simp, grind =] theorem zip_toArray (as : List α) (bs : List β) :
@[simp] theorem zip_toArray (as : List α) (bs : List β) :
Array.zip as.toArray bs.toArray = (List.zip as bs).toArray := by
simp [Array.zip, zipWith_toArray, zip]
@@ -472,16 +472,16 @@ theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α → O
termination_by max as.length bs.length - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[simp, grind =] theorem zipWithAll_toArray (f : Option α Option β γ) (as : List α) (bs : List β) :
@[simp] theorem zipWithAll_toArray (f : Option α Option β γ) (as : List α) (bs : List β) :
Array.zipWithAll f as.toArray bs.toArray = (List.zipWithAll f as bs).toArray := by
simp [Array.zipWithAll, zipWithAll_go_toArray]
@[simp, grind =] theorem toArray_appendList (l₁ l₂ : List α) :
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp, grind =] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
apply ext'
simp
@@ -513,7 +513,7 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
split <;> simp_all
· simp_all [drop_eq_nil_of_le]
@[simp, grind =] theorem takeWhile_toArray (p : α Bool) (l : List α) :
@[simp] theorem takeWhile_toArray (p : α Bool) (l : List α) :
l.toArray.takeWhile p = (l.takeWhile p).toArray := by
simp [Array.takeWhile, takeWhile_go_toArray]
@@ -528,11 +528,11 @@ private theorem popWhile_toArray_aux (p : α → Bool) (l : List α) :
· rfl
· simp
@[simp, grind =] theorem popWhile_toArray (p : α Bool) (l : List α) :
@[simp] theorem popWhile_toArray (p : α Bool) (l : List α) :
l.toArray.popWhile p = (l.reverse.dropWhile p).reverse.toArray := by
simp [ popWhile_toArray_aux]
@[simp, grind =] theorem setIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
@[simp] theorem setIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
l.toArray.setIfInBounds i a = (l.set i a).toArray := by
apply ext'
simp only [setIfInBounds]
@@ -540,7 +540,7 @@ private theorem popWhile_toArray_aux (p : α → Bool) (l : List α) :
· simp
· simp_all [List.set_eq_of_length_le]
@[simp, grind =] theorem toArray_replicate (n : Nat) (v : α) :
@[simp] theorem toArray_replicate (n : Nat) (v : α) :
(List.replicate n v).toArray = Array.replicate n v := rfl
theorem _root_.Array.replicate_eq_toArray_replicate :
@@ -550,7 +550,7 @@ theorem _root_.Array.replicate_eq_toArray_replicate :
@[deprecated _root_.Array.replicate_eq_toArray_replicate (since := "2025-03-18")]
abbrev _root_.Array.mkArray_eq_toArray_replicate := @_root_.Array.replicate_eq_toArray_replicate
@[simp, grind =] theorem flatMap_empty {β} (f : α Array β) : (#[] : Array α).flatMap f = #[] := rfl
@[simp] theorem flatMap_empty {β} (f : α Array β) : (#[] : Array α).flatMap f = #[] := rfl
theorem flatMap_toArray_cons {β} (f : α Array β) (a : α) (as : List α) :
(a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
@@ -562,7 +562,7 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
intro xs
induction as generalizing xs <;> simp_all
@[simp, grind =] theorem flatMap_toArray {β} (f : α Array β) (as : List α) :
@[simp] theorem flatMap_toArray {β} (f : α Array β) (as : List α) :
as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
induction as with
| nil => simp
@@ -570,12 +570,12 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
apply ext'
simp [ih, flatMap_toArray_cons]
@[simp, grind =] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
apply ext'
simp
@[simp, grind =] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
rw [Array.eraseIdx]
split <;> rename_i h'
@@ -593,19 +593,19 @@ decreasing_by
simp
omega
@[simp, grind =] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
rw [Array.eraseIdxIfInBounds]
split
· simp
· simp_all [eraseIdx_eq_self.2]
@[simp, grind =] theorem eraseP_toArray {as : List α} {p : α Bool} :
@[simp] theorem eraseP_toArray {as : List α} {p : α Bool} :
as.toArray.eraseP p = (as.eraseP p).toArray := by
rw [Array.eraseP, List.eraseP_eq_eraseIdx, findFinIdx?_toArray]
split <;> simp [*, findIdx?_eq_map_findFinIdx?_val]
@[simp, grind =] theorem erase_toArray [BEq α] {as : List α} {a : α} :
@[simp] theorem erase_toArray [BEq α] {as : List α} {a : α} :
as.toArray.erase a = (as.erase a).toArray := by
rw [Array.erase, finIdxOf?_toArray, List.erase_eq_eraseIdx]
rw [idxOf?_eq_map_finIdxOf?_val]
@@ -635,7 +635,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
subst this
simp
@[simp, grind =] theorem insertIdx_toArray (l : List α) (i : Nat) (a : α) (h : i l.toArray.size):
@[simp] theorem insertIdx_toArray (l : List α) (i : Nat) (a : α) (h : i l.toArray.size):
l.toArray.insertIdx i a = (l.insertIdx i a).toArray := by
rw [Array.insertIdx]
rw [insertIdx_loop_toArray (h := h)]
@@ -658,7 +658,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
congr
omega
@[simp, grind =] theorem insertIdxIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
@[simp] theorem insertIdxIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
l.toArray.insertIdxIfInBounds i a = (l.insertIdx i a).toArray := by
rw [Array.insertIdxIfInBounds]
split <;> rename_i h'
@@ -666,7 +666,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
· simp only [size_toArray, Nat.not_le] at h'
rw [List.insertIdx_of_length_lt (h := h')]
@[simp, grind =]
@[simp]
theorem replace_toArray [BEq α] [LawfulBEq α] (l : List α) (a b : α) :
l.toArray.replace a b = (l.replace a b).toArray := by
rw [Array.replace]
@@ -700,11 +700,11 @@ theorem replace_toArray [BEq α] [LawfulBEq α] (l : List α) (a b : α) :
exact i, by omega, h.1
· rfl
@[simp, grind =] theorem leftpad_toArray (n : Nat) (a : α) (l : List α) :
@[simp] theorem leftpad_toArray (n : Nat) (a : α) (l : List α) :
Array.leftpad n a l.toArray = (leftpad n a l).toArray := by
simp [leftpad, Array.leftpad, toArray_replicate]
@[simp, grind =] theorem rightpad_toArray (n : Nat) (a : α) (l : List α) :
@[simp] theorem rightpad_toArray (n : Nat) (a : α) (l : List α) :
Array.rightpad n a l.toArray = (rightpad n a l).toArray := by
simp [rightpad, Array.rightpad, toArray_replicate]

View File

@@ -138,7 +138,7 @@ theorem toList_attach (o : Option α) :
o.attach.toList = o.toList.attach.map fun x, h => x, by simpa using h := by
cases o <;> simp
@[simp, grind =] theorem attach_toList (o : Option α) :
@[simp] theorem attach_toList (o : Option α) :
o.toList.attach = (o.attach.map fun a, h => a, by simpa using h).toList := by
cases o <;> simp
@@ -195,7 +195,7 @@ theorem attach_filter {o : Option α} {p : α → Bool} :
| some a =>
simp only [filter_some, attach_some]
ext
simp only [attach_eq_some_iff, ite_none_right_eq_some, some.injEq, bind_some,
simp only [attach_eq_some_iff, ite_none_right_eq_some, some.injEq, some_bind,
dite_none_right_eq_some]
constructor
· rintro h, w

View File

@@ -13,20 +13,11 @@ namespace Option
deriving instance DecidableEq for Option
deriving instance BEq for Option
@[simp, grind] theorem getD_none : getD none a = a := rfl
@[simp, grind] theorem getD_some : getD (some a) b = a := rfl
@[simp, grind] theorem map_none (f : α β) : none.map f = none := rfl
@[simp, grind] theorem map_some (a) (f : α β) : (some a).map f = some (f a) := rfl
/-- Lifts an optional value to any `Alternative`, sending `none` to `failure`. -/
def getM [Alternative m] : Option α m α
| none => failure
| some a => pure a
@[simp, grind] theorem getM_none [Alternative m] : getM none = (failure : m α) := rfl
@[simp, grind] theorem getM_some [Alternative m] {a : α} : getM (some a) = (pure a : m α) := rfl
/-- Returns `true` on `some x` and `false` on `none`. -/
@[inline] def isSome : Option α Bool
| some _ => true
@@ -84,14 +75,6 @@ Examples:
| none, _ => none
| some a, f => f a
@[simp, grind] theorem bind_none (f : α Option β) : none.bind f = none := rfl
@[simp, grind] theorem bind_some (a) (f : α Option β) : (some a).bind f = f a := rfl
@[deprecated bind_none (since := "2025-05-03")]
abbrev none_bind := @bind_none
@[deprecated bind_some (since := "2025-05-03")]
abbrev some_bind := @bind_some
/--
Runs the monadic action `f` on `o`'s value, if any, and returns the result, or `none` if there is
no value.
@@ -119,9 +102,6 @@ This function only requires `m` to be an applicative functor. An alias `Option.m
| none => pure none
| some x => some <$> f x
@[simp, grind] theorem mapM_none [Applicative m] (f : α m β) : none.mapM f = pure none := rfl
@[simp, grind] theorem mapM_some [Applicative m] (x) (f : α m β) : (some x).mapM f = some <$> f x := rfl
/--
Applies a function in some applicative functor to an optional value, returning `none` with no
effects if the value is missing.
@@ -131,10 +111,6 @@ This is an alias for `Option.mapM`, which already works for applicative functors
@[inline] protected def mapA [Applicative m] (f : α m β) : Option α m (Option β) :=
Option.mapM f
/-- For verification purposes, we replace `mapA` with `mapM`. -/
@[simp, grind] theorem mapA_eq_mapM [Applicative m] {f : α m β} : Option.mapA f o = Option.mapM f o := rfl
@[simp, grind]
theorem map_id : (Option.map id : Option α Option α) = id :=
funext (fun o => match o with | none => rfl | some _ => rfl)
@@ -166,9 +142,6 @@ Examples:
| some a => p a
| none => true
@[simp, grind] theorem all_none : Option.all p none = true := rfl
@[simp, grind] theorem all_some : Option.all p (some x) = p x := rfl
/--
Checks whether an optional value is not `none` and satisfies a Boolean predicate.
@@ -181,9 +154,6 @@ Examples:
| some a => p a
| none => false
@[simp, grind] theorem any_none : Option.any p none = false := rfl
@[simp, grind] theorem any_some : Option.any p (some x) = p x := rfl
/--
Implementation of `OrElse`'s `<|>` syntax for `Option`. If the first argument is `some a`, returns
`some a`, otherwise evaluates and returns the second argument.
@@ -194,9 +164,6 @@ See also `or` for a version that is strict in the second argument.
| some a, _ => some a
| none, b => b ()
@[simp, grind] theorem orElse_some : (some a).orElse b = some a := rfl
@[simp, grind] theorem orElse_none : none.orElse b = b () := rfl
instance : OrElse (Option α) where
orElse := Option.orElse
@@ -263,6 +230,15 @@ def merge (fn : ααα) : Option α → Option α → Option α
| none , some y => some y
| some x, some y => some <| fn x y
@[simp, grind] theorem getD_none : getD none a = a := rfl
@[simp, grind] theorem getD_some : getD (some a) b = a := rfl
@[simp, grind] theorem map_none (f : α β) : none.map f = none := rfl
@[simp, grind] theorem map_some (a) (f : α β) : (some a).map f = some (f a) := rfl
@[simp, grind] theorem none_bind (f : α Option β) : none.bind f = none := rfl
@[simp, grind] theorem some_bind (a) (f : α Option β) : (some a).bind f = f a := rfl
/--
A case analysis function for `Option`.
@@ -286,9 +262,9 @@ Extracts the value from an option that can be proven to be `some`.
@[inline] def get {α : Type u} : (o : Option α) isSome o α
| some x, _ => x
@[simp, grind] theorem some_get : {x : Option α} (h : isSome x), some (x.get h) = x
@[simp] theorem some_get : {x : Option α} (h : isSome x), some (x.get h) = x
| some _, _ => rfl
@[simp, grind] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
/--
Returns `none` if a value doesn't satisfy a Boolean predicate, or the value itself otherwise.
@@ -366,9 +342,6 @@ Examples:
-/
@[simp, inline] def join (x : Option (Option α)) : Option α := x.bind id
@[simp, grind] theorem join_none : (none : Option (Option α)).join = none := rfl
@[simp, grind] theorem join_some : (some o).join = o := rfl
/--
Converts an optional monadic computation into a monadic computation of an optional value.
@@ -390,10 +363,7 @@ some "world"
-/
@[inline] def sequence [Applicative m] {α : Type u} : Option (m α) m (Option α)
| none => pure none
| some f => some <$> f
@[simp, grind] theorem sequence_none [Applicative m] : (none : Option (m α)).sequence = pure none := rfl
@[simp, grind] theorem sequence_some [Applicative m] (f : m (Option α)) : (some f).sequence = some <$> f := rfl
| some fn => some <$> fn
/--
A monadic case analysis function for `Option`.
@@ -418,9 +388,6 @@ This is the monadic analogue of `Option.getD`.
| some a => pure a
| none => y
@[simp, grind] theorem getDM_none [Pure m] (y : m α) : (none : Option α).getDM y = y := rfl
@[simp, grind] theorem getDM_some [Pure m] (a : α) (y : m α) : (some a).getDM y = pure a := rfl
instance (α) [BEq α] [ReflBEq α] : ReflBEq (Option α) where
rfl {x} :=
match x with
@@ -433,6 +400,12 @@ instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where
| some x, some y => rw [LawfulBEq.eq_of_beq (α := α) h]
| none, none => rfl
@[simp, grind] theorem all_none : Option.all p none = true := rfl
@[simp, grind] theorem all_some : Option.all p (some x) = p x := rfl
@[simp, grind] theorem any_none : Option.any p none = false := rfl
@[simp, grind] theorem any_some : Option.any p (some x) = p x := rfl
/--
The minimum of two optional values, with `none` treated as the least element. This function is
usually accessed through the `Min (Option α)` instance, rather than directly.
@@ -455,10 +428,10 @@ protected def min [Min α] : Option α → Option α → Option α
instance [Min α] : Min (Option α) where min := Option.min
@[simp, grind] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl
@[simp, grind] theorem min_some_none [Min α] {a : α} : min (some a) none = none := rfl
@[simp, grind] theorem min_none_some [Min α] {b : α} : min none (some b) = none := rfl
@[simp, grind] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl
@[simp] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl
@[simp] theorem min_some_none [Min α] {a : α} : min (some a) none = none := rfl
@[simp] theorem min_none_some [Min α] {b : α} : min none (some b) = none := rfl
@[simp] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl
/--
The maximum of two optional values.
@@ -480,10 +453,10 @@ protected def max [Max α] : Option α → Option α → Option α
instance [Max α] : Max (Option α) where max := Option.max
@[simp, grind] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl
@[simp, grind] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl
@[simp, grind] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl
@[simp, grind] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl
@[simp] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl
@[simp] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl
@[simp] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl
@[simp] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl
end Option
@@ -508,7 +481,6 @@ instance : Alternative Option where
failure := Option.none
orElse := Option.orElse
-- This is a duplicate of `Option.getM`; one may be deprecated in the future.
def liftOption [Alternative m] : Option α m α
| some a => pure a
| none => failure

View File

@@ -12,7 +12,7 @@ universe u v
namespace Option
theorem eq_of_eq_some {α : Type u} : {x y : Option α}, ( z, x = some z y = some z) x = y
theorem eq_of_eq_some {α : Type u} : {x y : Option α}, (z, x = some z y = some z) x = y
| none, none, _ => rfl
| none, some z, h => Option.noConfusion ((h z).2 rfl)
| some z, none, h => Option.noConfusion ((h z).1 rfl)

View File

@@ -91,6 +91,8 @@ theorem eq_some_unique {o : Option α} {a b : α} (ha : o = some a) (hb : o = so
| some _, _, H => ((H _).1 rfl).symm
| _, some _, H => (H _).2 rfl
set_option Elab.async false
theorem eq_none_iff_forall_ne_some : o = none a, o some a := by
cases o <;> simp
@@ -172,15 +174,15 @@ theorem forall_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x)
@[deprecated forall_ne_none (since := "2025-04-04")]
abbrev ball_ne_none := @forall_ne_none
@[simp, grind] theorem pure_def : pure = @some α := rfl
@[simp] theorem pure_def : pure = @some α := rfl
@[simp, grind] theorem bind_eq_bind : bind = @Option.bind α β := rfl
@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl
@[simp, grind] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
@[simp] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
@[simp, grind] theorem bind_fun_some (x : Option α) : x.bind some = x := by cases x <;> rfl
@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl
@[simp] theorem bind_fun_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
@[simp] theorem bind_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
cases x <;> rfl
theorem bind_eq_some_iff : x.bind f = some b a, x = some a f a = some b := by
@@ -199,7 +201,7 @@ theorem bind_eq_none' {o : Option α} {f : α → Option β} :
o.bind f = none b a, o = some a f a some b := by
cases o <;> simp [eq_none_iff_forall_ne_some]
@[grind] theorem mem_bind_iff {o : Option α} {f : α Option β} :
theorem mem_bind_iff {o : Option α} {f : α Option β} :
b o.bind f a, a o b f a := by
cases o <;> simp
@@ -207,7 +209,6 @@ theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β)
(a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
cases a <;> cases b <;> rfl
@[grind]
theorem bind_assoc (x : Option α) (f : α Option β) (g : β Option γ) :
(x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl
@@ -215,16 +216,10 @@ theorem bind_congr {α β} {o : Option α} {f g : α → Option β} :
(h : a, o = some a f a = g a) o.bind f = o.bind g := by
cases o <;> simp
@[grind]
theorem isSome_bind {α β : Type _} (x : Option α) (f : α Option β) :
(x.bind f).isSome = x.any (fun x => (f x).isSome) := by
cases x <;> rfl
@[grind]
theorem isNone_bind {α β : Type _} (x : Option α) (f : α Option β) :
(x.bind f).isNone = x.all (fun x => (f x).isNone) := by
cases x <;> rfl
theorem isSome_of_isSome_bind {α β : Type _} {x : Option α} {f : α Option β}
(h : (x.bind f).isSome) : x.isSome := by
cases x <;> trivial
@@ -233,7 +228,7 @@ theorem isSome_apply_of_isSome_bind {α β : Type _} {x : Option α} {f : α
(h : (x.bind f).isSome) : (f (x.get (isSome_of_isSome_bind h))).isSome := by
cases x <;> trivial
@[simp, grind] theorem get_bind {α β : Type _} {x : Option α} {f : α Option β} (h : (x.bind f).isSome) :
@[simp] theorem get_bind {α β : Type _} {x : Option α} {f : α Option β} (h : (x.bind f).isSome) :
(x.bind f).get h = (f (x.get (isSome_of_isSome_bind h))).get
(isSome_apply_of_isSome_bind h) := by
cases x <;> trivial
@@ -256,9 +251,9 @@ theorem join_eq_none_iff : o.join = none ↔ o = none o = some none :=
@[deprecated join_eq_none_iff (since := "2025-04-10")]
abbrev join_eq_none := @join_eq_none_iff
@[grind] theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
@[simp, grind] theorem map_eq_map : Functor.map f = Option.map f := rfl
@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl
@[deprecated map_none (since := "2025-04-10")]
abbrev map_none' := @map_none
@@ -300,28 +295,28 @@ theorem map_congr {x : Option α} (h : ∀ a, x = some a → f a = g a) :
x.map f = x.map g := by
cases x <;> simp only [map_none, map_some, h]
@[simp, grind] theorem map_id_fun {α : Type u} : Option.map (id : α α) = id := by
@[simp] theorem map_id_fun {α : Type u} : Option.map (id : α α) = id := by
funext; simp [map_id]
theorem map_id' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
@[simp, grind] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
@[simp] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
funext; simp [map_id']
@[simp, grind] theorem get_map {f : α β} {o : Option α} {h : (o.map f).isSome} :
theorem get_map {f : α β} {o : Option α} {h : (o.map f).isSome} :
(o.map f).get h = f (o.get (by simpa using h)) := by
cases o with
| none => simp at h
| some a => simp
@[simp, grind _=_] theorem map_map (h : β γ) (g : α β) (x : Option α) :
@[simp] theorem map_map (h : β γ) (g : α β) (x : Option α) :
(x.map g).map h = x.map (h g) := by
cases x <;> simp only [map_none, map_some, ··]
theorem comp_map (h : β γ) (g : α β) (x : Option α) : x.map (h g) = (x.map g).map h :=
(map_map ..).symm
@[simp, grind _=_] theorem map_comp_map (f : α β) (g : β γ) :
@[simp] theorem map_comp_map (f : α β) (g : β γ) :
Option.map g Option.map f = Option.map (g f) := by funext x; simp
theorem mem_map_of_mem (g : α β) (h : a x) : g a Option.map g x := h.symm map_some ..
@@ -378,7 +373,6 @@ abbrev filter_eq_none := @filter_eq_none_iff
@[deprecated filter_eq_some_iff (since := "2025-04-10")]
abbrev filter_eq_some := @filter_eq_some_iff
@[grind]
theorem mem_filter_iff {p : α Bool} {a : α} {o : Option α} :
a o.filter p a o p a := by
simp
@@ -387,12 +381,12 @@ theorem filter_eq_bind (x : Option α) (p : α → Bool) :
x.filter p = x.bind (Option.guard p) := by
cases x <;> rfl
@[simp, grind] theorem all_guard (a : α) :
@[simp] theorem all_guard (a : α) :
Option.all q (guard p a) = (!p a || q a) := by
simp only [guard]
split <;> simp_all
@[simp, grind] theorem any_guard (a : α) : Option.any q (guard p a) = (p a && q a) := by
@[simp] theorem any_guard (a : α) : Option.any q (guard p a) = (p a && q a) := by
simp only [guard]
split <;> simp_all
@@ -431,41 +425,33 @@ theorem any_eq_false_iff_get (p : α → Bool) (x : Option α) :
theorem isSome_of_any {x : Option α} {p : α Bool} (h : x.any p) : x.isSome := by
cases x <;> trivial
@[grind]
theorem any_map {α β : Type _} {x : Option α} {f : α β} {p : β Bool} :
(x.map f).any p = x.any (fun a => p (f a)) := by
cases x <;> rfl
@[grind]
theorem all_map {α β : Type _} {x : Option α} {f : α β} {p : β Bool} :
(x.map f).all p = x.all (fun a => p (f a)) := by
cases x <;> rfl
theorem bind_map_comm {α β} {x : Option (Option α)} {f : α β} :
x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
@[grind] theorem bind_map {f : α β} {g : β Option γ} {x : Option α} :
theorem bind_map {f : α β} {g : β Option γ} {x : Option α} :
(x.map f).bind g = x.bind (g f) := by cases x <;> simp
@[simp, grind] theorem map_bind {f : α Option β} {g : β γ} {x : Option α} :
@[simp] theorem map_bind {f : α Option β} {g : β γ} {x : Option α} :
(x.bind f).map g = x.bind (Option.map g f) := by cases x <;> simp
@[grind] theorem join_map_eq_map_join {f : α β} {x : Option (Option α)} :
theorem join_map_eq_map_join {f : α β} {x : Option (Option α)} :
(x.map (Option.map f)).join = x.join.map f := by cases x <;> simp
@[grind _=_] theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
cases x <;> simp
theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a x.join) : some a x :=
h.symm join_eq_some_iff.1 h
@[deprecated orElse_some (since := "2025-05-03")]
theorem some_orElse (a : α) (f) : (some a).orElse f = some a := rfl
@[simp, grind] theorem some_orElse (a : α) (f) : (some a).orElse f = some a := rfl
@[deprecated orElse_none (since := "2025-05-03")]
theorem none_orElse (f : Unit Option α) : none.orElse f = f () := rfl
@[simp, grind] theorem none_orElse (f : Unit Option α) : none.orElse f = f () := rfl
@[simp] theorem orElse_fun_none (x : Option α) : x.orElse (fun _ => none) = x := by cases x <;> rfl
@[simp] theorem orElse_none (x : Option α) : x.orElse (fun _ => none) = x := by cases x <;> rfl
theorem orElse_eq_some_iff (o : Option α) (f) (x : α) :
(o.orElse f) = some x o = some x o = none f () = some x := by
@@ -474,7 +460,7 @@ theorem orElse_eq_some_iff (o : Option α) (f) (x : α) :
theorem orElse_eq_none_iff (o : Option α) (f) : (o.orElse f) = none o = none f () = none := by
cases o <;> simp
@[grind] theorem map_orElse {x : Option α} {y} :
theorem map_orElse {x : Option α} {y} :
(x.orElse y).map f = (x.map f).orElse (fun _ => (y ()).map f) := by
cases x <;> simp
@@ -518,7 +504,7 @@ theorem guard_comp {p : α → Bool} {f : β → α} :
ext1 b
simp [guard]
@[grind] theorem bind_guard (x : Option α) (p : α Bool) :
theorem bind_guard (x : Option α) (p : α Bool) :
x.bind (Option.guard p) = x.filter p := by
simp only [Option.filter_eq_bind, decide_eq_true_eq]
@@ -527,7 +513,6 @@ theorem guard_eq_map (p : α → Bool) :
funext x
simp [Option.guard]
@[grind]
theorem guard_def (p : α Bool) :
Option.guard p = fun x => if p x then some x else none := rfl
@@ -614,10 +599,8 @@ abbrev choice_isSome_iff_nonempty := @isSome_choice_iff_nonempty
end choice
@[simp, grind] theorem toList_some (a : α) : (some a).toList = [a] := rfl
@[simp, grind] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
@[simp, grind] theorem toArray_some (a : α) : (some a).toArray = #[a] := rfl
@[simp, grind] theorem toArray_none (α : Type _) : (none : Option α).toArray = #[] := rfl
@[simp, grind] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
-- See `Init.Data.Option.List` for lemmas about `toList`.
@@ -627,15 +610,10 @@ end choice
theorem or_eq_right_of_none {o o' : Option α} (h : o = none) : o.or o' = o' := by
cases h; simp
@[deprecated some_or (since := "2024-11-03")] theorem or_some : (some a).or o = some a := rfl
/-- This will be renamed to `or_some` once the existing deprecated lemma is removed. -/
@[simp, grind] theorem or_some {o : Option α} : o.or (some a) = some (o.getD a) := by
cases o <;> rfl
@[deprecated or_some (since := "2025-05-03")]
abbrev or_some' := @or_some
@[simp, grind]
theorem or_none : or o none = o := by
@[simp, grind] theorem or_some' {o : Option α} : o.or (some a) = some (o.getD a) := by
cases o <;> rfl
theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
@@ -659,10 +637,14 @@ abbrev or_eq_none := @or_eq_none_iff
@[deprecated or_eq_some_iff (since := "2025-04-10")]
abbrev or_eq_some := @or_eq_some_iff
@[grind] theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
cases o₁ <;> cases o₂ <;> rfl
instance : Std.Associative (or (α := α)) := @or_assoc _
@[simp, grind]
theorem or_none : or o none = o := by
cases o <;> rfl
theorem or_eq_left_of_none {o o' : Option α} (h : o' = none) : o.or o' = o := by
cases h; simp
@@ -692,25 +674,16 @@ theorem or_of_isNone {o o' : Option α} (h : o.isNone) : o.or o' = o' := by
match o, h with
| none, _ => simp
@[simp, grind]
theorem getD_or {o o' : Option α} {fallback : α} :
(o.or o').getD fallback = o.getD (o'.getD fallback) := by
cases o <;> simp
/-! ### beq -/
section beq
variable [BEq α]
@[simp, grind] theorem none_beq_none : ((none : Option α) == none) = true := rfl
@[simp, grind] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
@[simp, grind] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
@[simp, grind] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
/-- We simplify away `isEqSome` in terms of `==`. -/
@[simp, grind] theorem isEqSome_eq_beq_some {o : Option α} : isEqSome o y = (o == some y) := by
cases o <;> simp [isEqSome]
@[simp] theorem none_beq_none : ((none : Option α) == none) = true := rfl
@[simp] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
@[simp] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
@[simp] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
@[simp] theorem reflBEq_iff : ReflBEq (Option α) ReflBEq α := by
constructor
@@ -824,14 +797,14 @@ theorem mem_ite_none_right {x : α} {_ : Decidable p} {l : Option α} :
end ite
@[grind] theorem isSome_filter {α : Type _} {x : Option α} {f : α Bool} :
theorem isSome_filter {α : Type _} {x : Option α} {f : α Bool} :
(x.filter f).isSome = x.any f := by
cases x
· rfl
· rw [Bool.eq_iff_iff]
simp only [Option.any_some, Option.filter, Option.isSome_ite]
@[simp, grind] theorem get_filter {α : Type _} {x : Option α} {f : α Bool} (h : (x.filter f).isSome) :
@[simp] theorem get_filter {α : Type _} {x : Option α} {f : α Bool} (h : (x.filter f).isSome) :
(x.filter f).get h = x.get (isSome_of_isSome_filter f x h) := by
cases x
· contradiction
@@ -843,16 +816,16 @@ end ite
@[simp, grind] theorem pbind_none : pbind none f = none := rfl
@[simp, grind] theorem pbind_some : pbind (some a) f = f a rfl := rfl
@[simp, grind] theorem map_pbind {o : Option α} {f : (a : α) o = some a Option β}
@[simp] theorem map_pbind {o : Option α} {f : (a : α) o = some a Option β}
{g : β γ} : (o.pbind f).map g = o.pbind (fun a h => (f a h).map g) := by
cases o <;> rfl
@[simp, grind] theorem pbind_map {α β γ : Type _} (o : Option α)
@[simp] theorem pbind_map {α β γ : Type _} (o : Option α)
(f : α β) (g : (x : β) o.map f = some x Option γ) :
(o.map f).pbind g = o.pbind (fun x h => g (f x) (h rfl)) := by
cases o <;> rfl
@[simp, grind] theorem pbind_eq_bind {α β : Type _} (o : Option α)
@[simp] theorem pbind_eq_bind {α β : Type _} (o : Option α)
(f : α Option β) : o.pbind (fun x _ => f x) = o.bind f := by
cases o <;> rfl
@@ -912,16 +885,16 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → o = some a → Optio
· rintro h, rfl
rfl
@[simp, grind]
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (o : Option α) (H) :
@pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
cases o <;> simp
@[grind] theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (o H) :
theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (o H) :
Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
cases o <;> simp
@[grind] theorem pmap_map (o : Option α) (f : α β) {p : β Prop} (g : b, p b γ) (H) :
theorem pmap_map (o : Option α) (f : α β) {p : β Prop} (g : b, p b γ) (H) :
pmap g (o.map f) H =
pmap (fun a h => g (f a) h) o (fun a m => H (f a) (map_eq_some_iff.2 _, m, rfl)) := by
cases o <;> simp
@@ -960,10 +933,10 @@ theorem pmap_congr {α : Type u} {β : Type v}
@[simp, grind] theorem pelim_none : pelim none b f = b := rfl
@[simp, grind] theorem pelim_some : pelim (some a) b f = f a rfl := rfl
@[simp, grind] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
@[simp] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
cases o <;> simp
@[simp, grind] theorem elim_pmap {p : α Prop} (f : (a : α) p a β) (o : Option α)
@[simp] theorem elim_pmap {p : α Prop} (f : (a : α) p a β) (o : Option α)
(H : (a : α), o = some a p a) (g : γ) (g' : β γ) :
(o.pmap f H).elim g g' =
o.pelim g (fun a h => g' (f a (H a h))) := by
@@ -1000,7 +973,7 @@ theorem isSome_of_isSome_pfilter {α : Type _} {o : Option α} {p : (a : α) →
(h : (o.pfilter p).isSome) : o.isSome :=
(isSome_pfilter_iff_get.mp h).1
@[simp, grind] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) o = some a Bool}
@[simp] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) o = some a Bool}
(h : (o.pfilter p).isSome) :
(o.pfilter p).get h = o.get (isSome_of_isSome_pfilter h) := by
cases o <;> simp
@@ -1018,7 +991,7 @@ theorem pfilter_eq_some_iff {α : Type _} {o : Option α} {p : (a : α) → o =
· rintro h, rfl, h'
exact o.get h, h, rfl, h', rfl
@[simp, grind] theorem pfilter_eq_filter {α : Type _} {o : Option α} {p : α Bool} :
@[simp] theorem pfilter_eq_filter {α : Type _} {o : Option α} {p : α Bool} :
o.pfilter (fun a _ => p a) = o.filter p := by
cases o with
| none => rfl
@@ -1034,13 +1007,13 @@ theorem pfilter_eq_pbind_ite {α : Type _} {o : Option α}
/-! ### LT and LE -/
@[simp, grind] theorem not_lt_none [LT α] {a : Option α} : ¬ a < none := by cases a <;> simp [LT.lt, Option.lt]
@[simp, grind] theorem none_lt_some [LT α] {a : α} : none < some a := by simp [LT.lt, Option.lt]
@[simp, grind] theorem some_lt_some [LT α] {a b : α} : some a < some b a < b := by simp [LT.lt, Option.lt]
@[simp] theorem not_lt_none [LT α] {a : Option α} : ¬ a < none := by cases a <;> simp [LT.lt, Option.lt]
@[simp] theorem none_lt_some [LT α] {a : α} : none < some a := by simp [LT.lt, Option.lt]
@[simp] theorem some_lt_some [LT α] {a b : α} : some a < some b a < b := by simp [LT.lt, Option.lt]
@[simp, grind] theorem none_le [LE α] {a : Option α} : none a := by cases a <;> simp [LE.le, Option.le]
@[simp, grind] theorem not_some_le_none [LE α] {a : α} : ¬ some a none := by simp [LE.le, Option.le]
@[simp, grind] theorem some_le_some [LE α] {a b : α} : some a some b a b := by simp [LE.le, Option.le]
@[simp] theorem none_le [LE α] {a : Option α} : none a := by cases a <;> simp [LE.le, Option.le]
@[simp] theorem not_some_le_none [LE α] {a : α} : ¬ some a none := by simp [LE.le, Option.le]
@[simp] theorem some_le_some [LE α] {a b : α} : some a some b a b := by simp [LE.le, Option.le]
/-! ### min and max -/

View File

@@ -10,38 +10,62 @@ import Init.Data.List.Lemmas
namespace Option
@[simp, grind] theorem mem_toList {a : α} {o : Option α} : a o.toList o = some a := by
@[simp] theorem mem_toList {a : α} {o : Option α} : a o.toList o = some a := by
cases o <;> simp [eq_comm]
@[simp, grind] theorem forIn'_toList [Monad m] (o : Option α) (b : β) (f : (a : α) a o.toList β m (ForInStep β)) :
@[simp] theorem forIn'_none [Monad m] (b : β) (f : (a : α) a none β m (ForInStep β)) :
forIn' none b f = pure b := by
rfl
@[simp] theorem forIn'_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : (a' : α) a' some a β m (ForInStep β)) :
forIn' (some a) b f = bind (f a rfl b) (fun r => pure (ForInStep.value r)) := by
simp only [forIn', bind_pure_comp]
rw [map_eq_pure_bind]
congr
funext x
split <;> rfl
@[simp] theorem forIn_none [Monad m] (b : β) (f : α β m (ForInStep β)) :
forIn none b f = pure b := by
rfl
@[simp] theorem forIn_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : α β m (ForInStep β)) :
forIn (some a) b f = bind (f a b) (fun r => pure (ForInStep.value r)) := by
simp only [forIn, forIn', bind_pure_comp]
rw [map_eq_pure_bind]
congr
funext x
split <;> rfl
@[simp] theorem forIn'_toList [Monad m] (o : Option α) (b : β) (f : (a : α) a o.toList β m (ForInStep β)) :
forIn' o.toList b f = forIn' o b fun a m b => f a (by simpa using m) b := by
cases o <;> rfl
@[simp, grind] theorem forIn_toList [Monad m] (o : Option α) (b : β) (f : α β m (ForInStep β)) :
@[simp] theorem forIn_toList [Monad m] (o : Option α) (b : β) (f : α β m (ForInStep β)) :
forIn o.toList b f = forIn o b f := by
cases o <;> rfl
@[simp, grind] theorem foldlM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : α β m α) :
@[simp] theorem foldlM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : α β m α) :
o.toList.foldlM f a = o.elim (pure a) (fun b => f a b) := by
cases o <;> simp
@[simp, grind] theorem foldrM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : β α m α) :
@[simp] theorem foldrM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : β α m α) :
o.toList.foldrM f a = o.elim (pure a) (fun b => f b a) := by
cases o <;> simp
@[simp, grind] theorem foldl_toList (o : Option β) (a : α) (f : α β α) :
@[simp] theorem foldl_toList (o : Option β) (a : α) (f : α β α) :
o.toList.foldl f a = o.elim a (fun b => f a b) := by
cases o <;> simp
@[simp, grind] theorem foldr_toList (o : Option β) (a : α) (f : β α α) :
@[simp] theorem foldr_toList (o : Option β) (a : α) (f : β α α) :
o.toList.foldr f a = o.elim a (fun b => f b a) := by
cases o <;> simp
@[simp, grind]
@[simp]
theorem pairwise_toList {P : α α Prop} {o : Option α} : o.toList.Pairwise P := by
cases o <;> simp
@[simp, grind]
@[simp]
theorem head?_toList {o : Option α} : o.toList.head? = o := by
cases o <;> simp

View File

@@ -12,47 +12,16 @@ import Init.Control.Lawful.Basic
namespace Option
@[simp, grind] theorem bindM_none [Monad m] (f : α m (Option β)) : none.bindM f = pure none := rfl
@[simp, grind] theorem bindM_some [Monad m] [LawfulMonad m] (a) (f : α m (Option β)) : (some a).bindM f = f a := by
simp [Option.bindM]
@[simp] theorem forM_none [Monad m] (f : α m PUnit) :
none.forM f = pure .unit := rfl
-- We simplify `Option.forM` to `forM`.
@[simp] theorem forM_eq_forM [Monad m] : @Option.forM m α _ = forM := rfl
@[simp] theorem forM_some [Monad m] (f : α m PUnit) (a : α) :
(some a).forM f = f a := rfl
@[simp, grind] theorem forM_none [Monad m] (f : α m PUnit) :
forM none f = pure .unit := rfl
@[simp, grind] theorem forM_some [Monad m] (f : α m PUnit) (a : α) :
forM (some a) f = f a := rfl
@[simp, grind] theorem forM_map [Monad m] [LawfulMonad m] (o : Option α) (g : α β) (f : β m PUnit) :
forM (o.map g) f = forM o (fun a => f (g a)) := by
@[simp] theorem forM_map [Monad m] [LawfulMonad m] (o : Option α) (g : α β) (f : β m PUnit) :
(o.map g).forM f = o.forM (fun a => f (g a)) := by
cases o <;> simp
@[simp, grind] theorem forIn'_none [Monad m] (b : β) (f : (a : α) a none β m (ForInStep β)) :
forIn' none b f = pure b := by
rfl
@[simp, grind] theorem forIn'_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : (a' : α) a' some a β m (ForInStep β)) :
forIn' (some a) b f = bind (f a rfl b) (fun r => pure (ForInStep.value r)) := by
simp only [forIn', bind_pure_comp]
rw [map_eq_pure_bind]
congr
funext x
split <;> rfl
@[simp, grind] theorem forIn_none [Monad m] (b : β) (f : α β m (ForInStep β)) :
forIn none b f = pure b := by
rfl
@[simp, grind] theorem forIn_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : α β m (ForInStep β)) :
forIn (some a) b f = bind (f a b) (fun r => pure (ForInStep.value r)) := by
simp only [forIn, forIn', bind_pure_comp]
rw [map_eq_pure_bind]
congr
funext x
split <;> rfl
@[congr] theorem forIn'_congr [Monad m] [LawfulMonad m] {as bs : Option α} (w : as = bs)
{b b' : β} (hb : b = b')
{f : (a' : α) a' as β m (ForInStep β)}
@@ -91,7 +60,7 @@ theorem forIn'_eq_pelim [Monad m] [LawfulMonad m]
o.pelim b (fun a h => f a h b) := by
cases o <;> simp
@[simp, grind] theorem forIn'_map [Monad m] [LawfulMonad m]
@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
(o : Option α) (g : α β) (f : (b : β) b o.map g γ m (ForInStep γ)) :
forIn' (o.map g) init f = forIn' o init fun a h y => f (g a) (mem_map_of_mem g h) y := by
cases o <;> simp
@@ -120,9 +89,11 @@ theorem forIn_eq_elim [Monad m] [LawfulMonad m]
o.elim b (fun a => f a b) := by
cases o <;> simp
@[simp, grind] theorem forIn_map [Monad m] [LawfulMonad m]
@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
(o : Option α) (g : α β) (f : β γ m (ForInStep γ)) :
forIn (o.map g) init f = forIn o init fun a y => f (g a) y := by
cases o <;> simp
@[simp] theorem mapA_eq_mapM : @Option.mapA = @Option.mapM := rfl
end Option

View File

@@ -55,12 +55,10 @@ This instance allows us to use `Empty` as a type parameter without causing insta
instance : Repr Empty where
reprPrec := nofun
protected def Bool.repr : Bool Nat Format
| true, _ => "true"
| false, _ => "false"
instance : Repr Bool where
reprPrec := Bool.repr
reprPrec
| true, _ => "true"
| false, _ => "false"
def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
if prec >= max_prec then
@@ -68,12 +66,10 @@ def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
else
f
protected def Decidable.repr : Decidable p Nat Format
| .isTrue _, prec => Repr.addAppParen "isTrue _" prec
| .isFalse _, prec => Repr.addAppParen "isFalse _" prec
instance : Repr (Decidable p) where
reprPrec := Decidable.repr
reprPrec
| Decidable.isTrue _, prec => Repr.addAppParen "isTrue _" prec
| Decidable.isFalse _, prec => Repr.addAppParen "isFalse _" prec
instance : Repr PUnit.{u+1} where
reprPrec _ _ := "PUnit.unit"
@@ -113,11 +109,8 @@ export ReprTuple (reprTuple)
instance [Repr α] : ReprTuple α where
reprTuple a xs := repr a :: xs
protected def Prod.reprTuple [Repr α] [ReprTuple β] : α × β List Format List Format
| (a, b), xs => reprTuple b (repr a :: xs)
instance [Repr α] [ReprTuple β] : ReprTuple (α × β) where
reprTuple := Prod.reprTuple
reprTuple | (a, b), xs => reprTuple b (repr a :: xs)
protected def Prod.repr [Repr α] [ReprTuple β] : α × β Nat Format
| (a, b), _ => Format.bracket "(" (Format.joinSep (reprTuple b [repr a]).reverse ("," ++ Format.line)) ")"
@@ -125,11 +118,8 @@ protected def Prod.repr [Repr α] [ReprTuple β] : α × β → Nat → Format
instance [Repr α] [ReprTuple β] : Repr (α × β) where
reprPrec := Prod.repr
protected def Sigma.repr {β : α Type v} [Repr α] [(x : α) Repr (β x)] : Sigma β Nat Format
| a, b, _ => Format.bracket "" (repr a ++ ", " ++ repr b) ""
instance {β : α Type v} [Repr α] [(x : α) Repr (β x)] : Repr (Sigma β) where
reprPrec := Sigma.repr
reprPrec | a, b, _ => Format.bracket "" (repr a ++ ", " ++ repr b) ""
instance {p : α Prop} [Repr α] : Repr (Subtype p) where
reprPrec s prec := reprPrec s.val prec

View File

@@ -29,7 +29,7 @@ structure Vector (α : Type u) (n : Nat) extends Array α where
size_toArray : toArray.size = n
deriving Repr, DecidableEq
attribute [simp, grind] Vector.size_toArray
attribute [simp] Vector.size_toArray
/--
Converts an array to a vector. The resulting vector's size is the array's size.

View File

@@ -58,7 +58,7 @@ theorem beq_eq_decide [BEq α] (xs ys : Vector α n) :
(mk xs ha == mk ys hb) = (xs == ys) := by
simp [BEq.beq]
@[simp, grind =] theorem beq_toArray [BEq α] (xs ys : Vector α n) : (xs.toArray == ys.toArray) = (xs == ys) := by
@[simp] theorem beq_toArray [BEq α] (xs ys : Vector α n) : (xs.toArray == ys.toArray) = (xs == ys) := by
simp [beq_eq_decide, Array.beq_eq_decide]
@[simp] theorem beq_toList [BEq α] (xs ys : Vector α n) : (xs.toList == ys.toList) = (xs == ys) := by

View File

@@ -263,57 +263,57 @@ abbrev zipWithIndex_mk := @zipIdx_mk
/-! ### toArray lemmas -/
@[simp, grind] theorem getElem_toArray {α n} {xs : Vector α n} {i : Nat} (h : i < xs.toArray.size) :
@[simp] theorem getElem_toArray {α n} {xs : Vector α n} {i : Nat} (h : i < xs.toArray.size) :
xs.toArray[i] = xs[i]'(by simpa using h) := by
cases xs
simp
@[simp, grind] theorem getElem?_toArray {α n} {xs : Vector α n} {i : Nat} :
@[simp] theorem getElem?_toArray {α n} {xs : Vector α n} {i : Nat} :
xs.toArray[i]? = xs[i]? := by
cases xs
simp
@[simp, grind _=_] theorem toArray_append {xs : Vector α m} {ys : Vector α n} :
@[simp] theorem toArray_append {xs : Vector α m} {ys : Vector α n} :
(xs ++ ys).toArray = xs.toArray ++ ys.toArray := rfl
@[simp, grind] theorem toArray_drop {xs : Vector α n} {i} :
@[simp] theorem toArray_drop {xs : Vector α n} {i} :
(xs.drop i).toArray = xs.toArray.extract i xs.size := rfl
@[simp, grind] theorem toArray_empty : (#v[] : Vector α 0).toArray = #[] := rfl
@[simp] theorem toArray_empty : (#v[] : Vector α 0).toArray = #[] := rfl
@[simp, grind] theorem toArray_emptyWithCapacity {cap} :
@[simp] theorem toArray_emptyWithCapacity {cap} :
(Vector.emptyWithCapacity (α := α) cap).toArray = Array.emptyWithCapacity cap := rfl
@[deprecated toArray_emptyWithCapacity (since := "2025-03-12")]
abbrev toArray_mkEmpty := @toArray_emptyWithCapacity
@[simp, grind] theorem toArray_eraseIdx {xs : Vector α n} {i} (h) :
@[simp] theorem toArray_eraseIdx {xs : Vector α n} {i} (h) :
(xs.eraseIdx i h).toArray = xs.toArray.eraseIdx i (by simp [h]) := rfl
@[simp, grind] theorem toArray_eraseIdx! {xs : Vector α n} {i} (hi : i < n) :
@[simp] theorem toArray_eraseIdx! {xs : Vector α n} {i} (hi : i < n) :
(xs.eraseIdx! i).toArray = xs.toArray.eraseIdx! i := by
cases xs; simp_all [Array.eraseIdx!]
@[simp, grind] theorem toArray_insertIdx {xs : Vector α n} {i x} (h) :
@[simp] theorem toArray_insertIdx {xs : Vector α n} {i x} (h) :
(xs.insertIdx i x h).toArray = xs.toArray.insertIdx i x (by simp [h]) := rfl
@[simp, grind] theorem toArray_insertIdx! {xs : Vector α n} {i x} (hi : i n) :
@[simp] theorem toArray_insertIdx! {xs : Vector α n} {i x} (hi : i n) :
(xs.insertIdx! i x).toArray = xs.toArray.insertIdx! i x := by
cases xs; simp_all [Array.insertIdx!]
@[simp, grind] theorem toArray_cast {xs : Vector α n} (h : n = m) :
@[simp] theorem toArray_cast {xs : Vector α n} (h : n = m) :
(xs.cast h).toArray = xs.toArray := rfl
@[simp, grind] theorem toArray_extract {xs : Vector α n} {start stop} :
@[simp] theorem toArray_extract {xs : Vector α n} {start stop} :
(xs.extract start stop).toArray = xs.toArray.extract start stop := rfl
@[simp, grind] theorem toArray_map {f : α β} {xs : Vector α n} :
@[simp] theorem toArray_map {f : α β} {xs : Vector α n} :
(xs.map f).toArray = xs.toArray.map f := rfl
@[simp, grind] theorem toArray_mapIdx {f : Nat α β} {xs : Vector α n} :
@[simp] theorem toArray_mapIdx {f : Nat α β} {xs : Vector α n} :
(xs.mapIdx f).toArray = xs.toArray.mapIdx f := rfl
@[simp, grind] theorem toArray_mapFinIdx {f : (i : Nat) α (h : i < n) β} {xs : Vector α n} :
@[simp] theorem toArray_mapFinIdx {f : (i : Nat) α (h : i < n) β} {xs : Vector α n} :
(xs.mapFinIdx f).toArray =
xs.toArray.mapFinIdx (fun i a h => f i a (by simpa [xs.size_toArray] using h)) :=
rfl
@@ -331,145 +331,145 @@ theorem toArray_mapM_go [Monad m] [LawfulMonad m] {f : α → m β} {xs : Vector
rfl
· simp
@[simp, grind] theorem toArray_mapM [Monad m] [LawfulMonad m] {f : α m β} {xs : Vector α n} :
@[simp] theorem toArray_mapM [Monad m] [LawfulMonad m] {f : α m β} {xs : Vector α n} :
toArray <$> xs.mapM f = xs.toArray.mapM f := by
rcases xs with xs, rfl
unfold mapM
rw [toArray_mapM_go]
rfl
@[simp, grind] theorem toArray_ofFn {f : Fin n α} : (Vector.ofFn f).toArray = Array.ofFn f := rfl
@[simp] theorem toArray_ofFn {f : Fin n α} : (Vector.ofFn f).toArray = Array.ofFn f := rfl
@[simp, grind] theorem toArray_pop {xs : Vector α n} : xs.pop.toArray = xs.toArray.pop := rfl
@[simp] theorem toArray_pop {xs : Vector α n} : xs.pop.toArray = xs.toArray.pop := rfl
@[simp, grind] theorem toArray_push {xs : Vector α n} {x} : (xs.push x).toArray = xs.toArray.push x := rfl
@[simp] theorem toArray_push {xs : Vector α n} {x} : (xs.push x).toArray = xs.toArray.push x := rfl
@[simp, grind] theorem toArray_beq_toArray [BEq α] {xs : Vector α n} {ys : Vector α n} :
@[simp] theorem toArray_beq_toArray [BEq α] {xs : Vector α n} {ys : Vector α n} :
(xs.toArray == ys.toArray) = (xs == ys) := by
simp [instBEq, isEqv, Array.instBEq, Array.isEqv, xs.2, ys.2]
@[simp, grind] theorem toArray_range : (Vector.range n).toArray = Array.range n := rfl
@[simp] theorem toArray_range : (Vector.range n).toArray = Array.range n := rfl
@[simp, grind] theorem toArray_reverse (xs : Vector α n) : xs.reverse.toArray = xs.toArray.reverse := rfl
@[simp] theorem toArray_reverse (xs : Vector α n) : xs.reverse.toArray = xs.toArray.reverse := rfl
@[simp, grind] theorem toArray_set {xs : Vector α n} {i x} (h) :
@[simp] theorem toArray_set {xs : Vector α n} {i x} (h) :
(xs.set i x).toArray = xs.toArray.set i x (by simpa using h):= rfl
@[simp, grind] theorem toArray_set! {xs : Vector α n} {i x} :
@[simp] theorem toArray_set! {xs : Vector α n} {i x} :
(xs.set! i x).toArray = xs.toArray.set! i x := rfl
@[simp, grind] theorem toArray_setIfInBounds {xs : Vector α n} {i x} :
@[simp] theorem toArray_setIfInBounds {xs : Vector α n} {i x} :
(xs.setIfInBounds i x).toArray = xs.toArray.setIfInBounds i x := rfl
@[simp, grind] theorem toArray_singleton {x : α} : (Vector.singleton x).toArray = #[x] := rfl
@[simp] theorem toArray_singleton {x : α} : (Vector.singleton x).toArray = #[x] := rfl
@[simp, grind] theorem toArray_swap {xs : Vector α n} {i j} (hi hj) : (xs.swap i j).toArray =
@[simp] theorem toArray_swap {xs : Vector α n} {i j} (hi hj) : (xs.swap i j).toArray =
xs.toArray.swap i j (by simp [hi, hj]) (by simp [hi, hj]) := rfl
@[simp, grind] theorem toArray_swapIfInBounds {xs : Vector α n} {i j} :
@[simp] theorem toArray_swapIfInBounds {xs : Vector α n} {i j} :
(xs.swapIfInBounds i j).toArray = xs.toArray.swapIfInBounds i j := rfl
theorem toArray_swapAt {xs : Vector α n} {i x} (h) :
@[simp] theorem toArray_swapAt {xs : Vector α n} {i x} (h) :
((xs.swapAt i x).fst, (xs.swapAt i x).snd.toArray) =
((xs.toArray.swapAt i x (by simpa using h)).fst,
(xs.toArray.swapAt i x (by simpa using h)).snd) := rfl
theorem toArray_swapAt! {xs : Vector α n} {i x} :
@[simp] theorem toArray_swapAt! {xs : Vector α n} {i x} :
((xs.swapAt! i x).fst, (xs.swapAt! i x).snd.toArray) =
((xs.toArray.swapAt! i x).fst, (xs.toArray.swapAt! i x).snd) := rfl
@[simp, grind] theorem toArray_take {xs : Vector α n} {i} : (xs.take i).toArray = xs.toArray.take i := rfl
@[simp] theorem toArray_take {xs : Vector α n} {i} : (xs.take i).toArray = xs.toArray.take i := rfl
@[simp, grind] theorem toArray_zipIdx {xs : Vector α n} (k : Nat := 0) :
@[simp] theorem toArray_zipIdx {xs : Vector α n} (k : Nat := 0) :
(xs.zipIdx k).toArray = xs.toArray.zipIdx k := rfl
@[simp, grind] theorem toArray_zipWith {f : α β γ} {as : Vector α n} {bs : Vector β n} :
@[simp] theorem toArray_zipWith {f : α β γ} {as : Vector α n} {bs : Vector β n} :
(Vector.zipWith f as bs).toArray = Array.zipWith f as.toArray bs.toArray := rfl
@[simp, grind] theorem anyM_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
@[simp] theorem anyM_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
xs.toArray.anyM p = xs.anyM p := by
cases xs
simp
@[simp, grind] theorem allM_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
@[simp] theorem allM_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
xs.toArray.allM p = xs.allM p := by
cases xs
simp
@[simp, grind] theorem any_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem any_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.any p = xs.any p := by
cases xs
simp
@[simp, grind] theorem all_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem all_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.all p = xs.all p := by
cases xs
simp
@[simp, grind] theorem countP_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem countP_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.countP p = xs.countP p := by
cases xs
simp
@[simp, grind] theorem count_toArray [BEq α] {a : α} {xs : Vector α n} :
@[simp] theorem count_toArray [BEq α] {a : α} {xs : Vector α n} :
xs.toArray.count a = xs.count a := by
cases xs
simp
@[simp, grind] theorem replace_toArray [BEq α] {xs : Vector α n} {a b} :
@[simp] theorem replace_toArray [BEq α] {xs : Vector α n} {a b} :
xs.toArray.replace a b = (xs.replace a b).toArray := rfl
@[simp, grind] theorem find?_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem find?_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.find? p = xs.find? p := by
cases xs
simp
@[simp, grind] theorem findSome?_toArray {f : α Option β} {xs : Vector α n} :
@[simp] theorem findSome?_toArray {f : α Option β} {xs : Vector α n} :
xs.toArray.findSome? f = xs.findSome? f := by
cases xs
simp
@[simp, grind] theorem findRev?_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem findRev?_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.findRev? p = xs.findRev? p := by
cases xs
simp
@[simp, grind] theorem findSomeRev?_toArray {f : α Option β} {xs : Vector α n} :
@[simp] theorem findSomeRev?_toArray {f : α Option β} {xs : Vector α n} :
xs.toArray.findSomeRev? f = xs.findSomeRev? f := by
cases xs
simp
@[simp, grind] theorem findM?_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
@[simp] theorem findM?_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
xs.toArray.findM? p = xs.findM? p := by
cases xs
simp
@[simp, grind] theorem findSomeM?_toArray [Monad m] {f : α m (Option β)} {xs : Vector α n} :
@[simp] theorem findSomeM?_toArray [Monad m] {f : α m (Option β)} {xs : Vector α n} :
xs.toArray.findSomeM? f = xs.findSomeM? f := by
cases xs
simp
@[simp, grind] theorem findRevM?_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
@[simp] theorem findRevM?_toArray [Monad m] {p : α m Bool} {xs : Vector α n} :
xs.toArray.findRevM? p = xs.findRevM? p := by
rcases xs with xs, rfl
simp
@[simp, grind] theorem findSomeRevM?_toArray [Monad m] {f : α m (Option β)} {xs : Vector α n} :
@[simp] theorem findSomeRevM?_toArray [Monad m] {f : α m (Option β)} {xs : Vector α n} :
xs.toArray.findSomeRevM? f = xs.findSomeRevM? f := by
rcases xs with xs, rfl
simp
@[simp, grind] theorem finIdxOf?_toArray [BEq α] {a : α} {xs : Vector α n} :
@[simp] theorem finIdxOf?_toArray [BEq α] {a : α} {xs : Vector α n} :
xs.toArray.finIdxOf? a = (xs.finIdxOf? a).map (Fin.cast xs.size_toArray.symm) := by
rcases xs with xs, rfl
simp
@[simp, grind] theorem findFinIdx?_toArray {p : α Bool} {xs : Vector α n} :
@[simp] theorem findFinIdx?_toArray {p : α Bool} {xs : Vector α n} :
xs.toArray.findFinIdx? p = (xs.findFinIdx? p).map (Fin.cast xs.size_toArray.symm) := by
rcases xs with xs, rfl
simp
@[simp, grind] theorem toArray_replicate : (replicate n a).toArray = Array.replicate n a := rfl
@[simp] theorem toArray_replicate : (replicate n a).toArray = Array.replicate n a := rfl
@[deprecated toArray_replicate (since := "2025-03-18")]
abbrev toArray_mkVector := @toArray_replicate
@@ -483,7 +483,7 @@ abbrev toArray_mkVector := @toArray_replicate
`Vector.ext` is an extensionality theorem.
Vectors `a` and `b` are equal to each other if their elements are equal for each valid index.
-/
@[ext]
@[ext, grind ext]
protected theorem ext {xs ys : Vector α n} (h : (i : Nat) (_ : i < n) xs[i] = ys[i]) : xs = ys := by
apply Vector.toArray_inj.1
apply Array.ext
@@ -3082,7 +3082,7 @@ set_option linter.indexVariables false in
/-! ### swap -/
@[grind] theorem getElem_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} (hk : k < n) :
theorem getElem_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} (hk : k < n) :
(xs.swap i j hi hj)[k] = if k = i then xs[j] else if k = j then xs[i] else xs[k] := by
cases xs
simp_all [Array.getElem_swap]
@@ -3099,13 +3099,6 @@ set_option linter.indexVariables false in
(hi' : k i) (hj' : k j) : (xs.swap i j hi hj)[k] = xs[k] := by
simp_all [getElem_swap]
@[grind]
theorem getElem?_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i j hi hj)[k]? =
if j = k then some xs[i] else if i = k then some xs[j] else xs[k]? := by
rcases xs with xs, rfl
simp [Array.getElem?_swap]
@[simp] theorem swap_swap {xs : Vector α n} {i j : Nat} (hi hj) :
(xs.swap i j hi hj).swap i j hi hj = xs := by
cases xs
@@ -3119,14 +3112,14 @@ theorem swap_comm {xs : Vector α n} {i j : Nat} (hi hj) :
/-! ### take -/
@[simp, grind =] theorem getElem_take {xs : Vector α n} {j : Nat} (hi : i < min j n) :
@[simp] theorem getElem_take {xs : Vector α n} {j : Nat} (hi : i < min j n) :
(xs.take j)[i] = xs[i] := by
cases xs
simp
/-! ### drop -/
@[simp, grind =] theorem getElem_drop {xs : Vector α n} {j : Nat} (hi : i < n - j) :
@[simp] theorem getElem_drop {xs : Vector α n} {j : Nat} (hi : i < n - j) :
(xs.drop j)[i] = xs[j + i] := by
cases xs
simp

View File

@@ -18,8 +18,8 @@ namespace Vector
/-! ### Lexicographic ordering -/
@[simp, grind =] theorem lt_toArray [LT α] {xs ys : Vector α n} : xs.toArray < ys.toArray xs < ys := Iff.rfl
@[simp, grind =] theorem le_toArray [LT α] {xs ys : Vector α n} : xs.toArray ys.toArray xs ys := Iff.rfl
@[simp] theorem lt_toArray [LT α] {xs ys : Vector α n} : xs.toArray < ys.toArray xs < ys := Iff.rfl
@[simp] theorem le_toArray [LT α] {xs ys : Vector α n} : xs.toArray ys.toArray xs ys := Iff.rfl
@[simp] theorem lt_toList [LT α] {xs ys : Vector α n} : xs.toList < ys.toList xs < ys := Iff.rfl
@[simp] theorem le_toList [LT α] {xs ys : Vector α n} : xs.toList ys.toList xs ys := Iff.rfl
@@ -40,7 +40,7 @@ protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] {xs ys
simp [Vector.lex, Array.lex, n₁, n₂]
rfl
@[simp, grind =] theorem lex_toArray [BEq α] {lt : α α Bool} {xs ys : Vector α n} :
@[simp] theorem lex_toArray [BEq α] {lt : α α Bool} {xs ys : Vector α n} :
xs.toArray.lex ys.toArray lt = xs.lex ys lt := by
cases xs
cases ys

View File

@@ -81,6 +81,7 @@ end Lean
attribute [ext] Prod PProd Sigma PSigma
attribute [ext] funext propext Subtype.eq Array.ext
attribute [grind ext] Array.ext
@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
protected theorem Unit.ext (x y : Unit) : x = y := rfl

View File

@@ -1006,44 +1006,6 @@ def unsat_eq {α} [CommRing α] (ctx : Context α) [IsCharP α 0] (p : Poly) (k
simp [h] at this
assumption
theorem d_init {α} [CommRing α] (ctx : Context α) (p : Poly) : (1:Int) * p.denote ctx = p.denote ctx := by
rw [intCast_one, one_mul]
def d_step1_cert (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly) : Bool :=
p == p₁.combine (p₂.mulMon k₂ m₂)
theorem d_step1 {α} [CommRing α] (ctx : Context α) (k : Int) (init : Poly) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly)
: d_step1_cert p₁ k₂ m₂ p₂ p k * init.denote ctx = p₁.denote ctx p₂.denote ctx = 0 k * init.denote ctx = p.denote ctx := by
simp [d_step1_cert]; intro _ h₁ h₂; subst p
simp [Poly.denote_combine, Poly.denote_mulMon, h₂, mul_zero, add_zero, h₁]
def d_stepk_cert (k₁ : Int) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly) : Bool :=
p == (p₁.mulConst k₁).combine (p₂.mulMon k₂ m₂)
theorem d_stepk {α} [CommRing α] (ctx : Context α) (k₁ : Int) (k : Int) (init : Poly) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly)
: d_stepk_cert k₁ p₁ k₂ m₂ p₂ p k * init.denote ctx = p₁.denote ctx p₂.denote ctx = 0 (k₁*k : Int) * init.denote ctx = p.denote ctx := by
simp [d_stepk_cert]; intro _ h₁ h₂; subst p
simp [Poly.denote_combine, Poly.denote_mulMon, Poly.denote_mulConst, h₂, mul_zero, add_zero]
rw [intCast_mul, mul_assoc, h₁]
def imp_1eq_cert (lhs rhs : Expr) (p₁ p₂ : Poly) : Bool :=
(lhs.sub rhs).toPoly == p₁ && p₂ == .num 0
theorem imp_1eq {α} [CommRing α] (ctx : Context α) (lhs rhs : Expr) (p₁ p₂ : Poly)
: imp_1eq_cert lhs rhs p₁ p₂ (1:Int) * p₁.denote ctx = p₂.denote ctx lhs.denote ctx = rhs.denote ctx := by
simp [imp_1eq_cert, intCast_one, one_mul]; intro _ _; subst p₁ p₂
simp [Expr.denote_toPoly, Expr.denote, sub_eq_zero_iff, Poly.denote, intCast_zero]
def imp_keq_cert (lhs rhs : Expr) (k : Int) (p₁ p₂ : Poly) : Bool :=
k != 0 && (lhs.sub rhs).toPoly == p₁ && p₂ == .num 0
theorem imp_keq {α} [CommRing α] (ctx : Context α) [NoNatZeroDivisors α] (k : Int) (lhs rhs : Expr) (p₁ p₂ : Poly)
: imp_keq_cert lhs rhs k p₁ p₂ k * p₁.denote ctx = p₂.denote ctx lhs.denote ctx = rhs.denote ctx := by
simp [imp_keq_cert, intCast_one, one_mul]; intro hnz _ _; subst p₁ p₂
simp [Expr.denote_toPoly, Expr.denote, Poly.denote, intCast_zero]
intro h; replace h := no_int_zero_divisors hnz h
rw [ sub_eq_zero_iff, h]
def core_certC (lhs rhs : Expr) (p : Poly) (c : Nat) : Bool :=
(lhs.sub rhs).toPolyC c == p
@@ -1096,41 +1058,6 @@ def unsat_eqC {α c} [CommRing α] [IsCharP α c] (ctx : Context α) (p : Poly)
simp [h] at this
assumption
def d_step1_certC (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly) (c : Nat) : Bool :=
p == p₁.combineC (p₂.mulMonC k₂ m₂ c) c
theorem d_step1C {α c} [CommRing α] [IsCharP α c] (ctx : Context α) (k : Int) (init : Poly) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly)
: d_step1_certC p₁ k₂ m₂ p₂ p c k * init.denote ctx = p₁.denote ctx p₂.denote ctx = 0 k * init.denote ctx = p.denote ctx := by
simp [d_step1_certC]; intro _ h₁ h₂; subst p
simp [Poly.denote_combineC, Poly.denote_mulMonC, h₂, mul_zero, add_zero, h₁]
def d_stepk_certC (k₁ : Int) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly) (c : Nat) : Bool :=
p == (p₁.mulConstC k₁ c).combineC (p₂.mulMonC k₂ m₂ c) c
theorem d_stepkC {α c} [CommRing α] [IsCharP α c] (ctx : Context α) (k₁ : Int) (k : Int) (init : Poly) (p₁ : Poly) (k₂ : Int) (m₂ : Mon) (p₂ : Poly) (p : Poly)
: d_stepk_certC k₁ p₁ k₂ m₂ p₂ p c k * init.denote ctx = p₁.denote ctx p₂.denote ctx = 0 (k₁*k : Int) * init.denote ctx = p.denote ctx := by
simp [d_stepk_certC]; intro _ h₁ h₂; subst p
simp [Poly.denote_combineC, Poly.denote_mulMonC, Poly.denote_mulConstC, h₂, mul_zero, add_zero]
rw [intCast_mul, mul_assoc, h₁]
def imp_1eq_certC (lhs rhs : Expr) (p₁ p₂ : Poly) (c : Nat) : Bool :=
(lhs.sub rhs).toPolyC c == p₁ && p₂ == .num 0
theorem imp_1eqC {α c} [CommRing α] [IsCharP α c] (ctx : Context α) (lhs rhs : Expr) (p₁ p₂ : Poly)
: imp_1eq_certC lhs rhs p₁ p₂ c (1:Int) * p₁.denote ctx = p₂.denote ctx lhs.denote ctx = rhs.denote ctx := by
simp [imp_1eq_certC, intCast_one, one_mul]; intro _ _; subst p₁ p₂
simp [Expr.denote_toPolyC, Expr.denote, sub_eq_zero_iff, Poly.denote, intCast_zero]
def imp_keq_certC (lhs rhs : Expr) (k : Int) (p₁ p₂ : Poly) (c : Nat) : Bool :=
k != 0 && (lhs.sub rhs).toPolyC c == p₁ && p₂ == .num 0
theorem imp_keqC {α c} [CommRing α] [IsCharP α c] (ctx : Context α) [NoNatZeroDivisors α] (k : Int) (lhs rhs : Expr) (p₁ p₂ : Poly)
: imp_keq_certC lhs rhs k p₁ p₂ c k * p₁.denote ctx = p₂.denote ctx lhs.denote ctx = rhs.denote ctx := by
simp [imp_keq_certC, intCast_one, one_mul]; intro hnz _ _; subst p₁ p₂
simp [Expr.denote_toPolyC, Expr.denote, Poly.denote, intCast_zero]
intro h; replace h := no_int_zero_divisors hnz h
rw [ sub_eq_zero_iff, h]
end Stepwise
end CommRing

View File

@@ -621,6 +621,9 @@ This is the same as `#eval show MetaM Unit from do discard doSeq`.
-/
syntax (name := runMeta) "run_meta " doSeq : command
set_option linter.missingDocs false in
syntax guardMsgsFilterSeverity := &"info" <|> &"warning" <|> &"error" <|> &"all"
/--
`#reduce <expression>` reduces the expression `<expression>` to its normal form. This
involves applying reduction rules until no further reduction is possible.
@@ -637,27 +640,15 @@ of expressions.
-/
syntax (name := reduceCmd) "#reduce " (atomic("(" &"proofs" " := " &"true" ")"))? (atomic("(" &"types" " := " &"true" ")"))? term : command
set_option linter.missingDocs false in
syntax guardMsgsFilterAction := &"check" <|> &"drop" <|> &"pass"
set_option linter.missingDocs false in
syntax guardMsgsFilterSeverity := &"trace" <|> &"info" <|> &"warning" <|> &"error" <|> &"all"
/--
A message filter specification for `#guard_msgs`.
- `info`, `warning`, `error`: capture (non-trace) messages with the given severity level.
- `trace`: captures trace messages
- `all`: capture all messages.
The filters can be prefixed with
- `check` (the default): capture and check the message
- `drop`: drop the message
- `pass`: let the message pass through
If no filter is specified, `check all` is assumed. Otherwise, these filters are processed in
left-to-right order, with an implicit `pass all` at the end.
- `info`, `warning`, `error`: capture messages with the given severity level.
- `all`: capture all messages (the default).
- `drop info`, `drop warning`, `drop error`: drop messages with the given severity level.
- `drop all`: drop every message.
These filters are processed in left-to-right order.
-/
syntax guardMsgsFilter := guardMsgsFilterAction ? guardMsgsFilterSeverity
syntax guardMsgsFilter := &"drop"? guardMsgsFilterSeverity
set_option linter.missingDocs false in
syntax guardMsgsWhitespaceArg := &"exact" <|> &"normalized" <|> &"lax"
@@ -728,20 +719,13 @@ In general, `#guard_msgs` accepts a comma-separated list of configuration clause
```
#guard_msgs (configElt,*) in cmd
```
By default, the configuration list is `(check all, whitespace := normalized, ordering := exact)`.
By default, the configuration list is `(all, whitespace := normalized, ordering := exact)`.
Message filters select messages by severity:
- `info`, `warning`, `error`: (non-trace) messages with the given severity level.
- `trace`: trace messages
- `all`: all messages.
The filters can be prefixed with the action to take:
- `check` (the default): capture and check the message
- `drop`: drop the message
- `pass`: let the message pass through
If no filter is specified, `check all` is assumed. Otherwise, these filters are processed in
left-to-right order, with an implicit `pass all` at the end.
Message filters (processed in left-to-right order):
- `info`, `warning`, `error`: capture messages with the given severity level.
- `all`: capture all messages (the default).
- `drop info`, `drop warning`, `drop error`: drop messages with the given severity level.
- `drop all`: drop every message.
Whitespace handling (after trimming leading and trailing whitespace):
- `whitespace := exact` requires an exact whitespace match.

View File

@@ -969,7 +969,7 @@ syntax (name := funInduction) "fun_induction " term
(" generalizing" (ppSpace colGt term:max)+)? (inductionAlts)? : tactic
/--
The `fun_cases` tactic is a convenience wrapper of the `cases` tactic when using a functional
The `fun_cass` tactic is a convenience wrapper of the `cases` tactic when using a functional
cases principle.
The tactic invocation

View File

@@ -93,13 +93,9 @@ def addDecl (decl : Declaration) : CoreM Unit := do
let mut exportedKind? := none
let (name, info, kind) match decl with
| .thmDecl thm =>
let exportProof := !( getEnv).header.isModule ||
-- We should preserve rfl theorems but also we should not override a decision to hide by the
-- MutualDef elaborator via `withoutExporting`
( getEnv).isExporting && isSimpleRflProof thm.value ||
-- TODO: this is horrible...
looksLikeRelevantTheoremProofType thm.type
if !exportProof then
if ( getEnv).header.isModule && !isSimpleRflProof thm.value &&
-- TODO: this is horrible...
!looksLikeRelevantTheoremProofType thm.type then
exportedInfo? := some <| .axiomInfo { thm with isUnsafe := false }
exportedKind? := some .axiom
pure (thm.name, .thmInfo thm, .thm)

View File

@@ -22,7 +22,6 @@ import Lean.Compiler.IR.ElimDeadBranches
import Lean.Compiler.IR.EmitC
import Lean.Compiler.IR.CtorLayout
import Lean.Compiler.IR.Sorry
import Lean.Compiler.IR.ToIR
-- The following imports are not required by the compiler. They are here to ensure that there
-- are no orphaned modules.

View File

@@ -1,412 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Cameron Zwarich
-/
prelude
import Lean.Compiler.LCNF.Basic
import Lean.Compiler.LCNF.CompilerM
import Lean.Compiler.LCNF.PhaseExt
import Lean.Compiler.IR.Basic
import Lean.Compiler.IR.CompilerM
import Lean.Compiler.IR.CtorLayout
import Lean.CoreM
import Lean.Environment
namespace Lean.IR
open Lean.Compiler (LCNF.AltCore LCNF.Arg LCNF.Code LCNF.Decl LCNF.DeclValue LCNF.LCtx LCNF.LetDecl
LCNF.LetValue LCNF.LitValue LCNF.Param LCNF.getMonoDecl?)
namespace ToIR
inductive FVarClassification where
| var (id : VarId)
| joinPoint (id : JoinPointId)
| erased
structure BuilderState where
fvars : Std.HashMap FVarId FVarClassification := {}
nextId : Nat := 1
abbrev M := StateRefT BuilderState CoreM
def M.run (x : M α) : CoreM α := do
x.run' {}
def bindVar (fvarId : FVarId) : M VarId := do
modifyGet fun s =>
let varId := { idx := s.nextId }
varId, { s with fvars := s.fvars.insertIfNew fvarId (.var varId),
nextId := s.nextId + 1 }
def bindVarToVarId (fvarId : FVarId) (varId : VarId) : M Unit := do
modify fun s => { s with fvars := s.fvars.insertIfNew fvarId (.var varId) }
def newVar : M VarId := do
modifyGet fun s =>
let varId := { idx := s.nextId }
varId, { s with nextId := s.nextId + 1 }
def bindJoinPoint (fvarId : FVarId) : M JoinPointId := do
modifyGet fun s =>
let joinPointId := { idx := s.nextId }
joinPointId, { s with fvars := s.fvars.insertIfNew fvarId (.joinPoint joinPointId),
nextId := s.nextId + 1 }
def bindErased (fvarId : FVarId) : M Unit := do
modify fun s => { s with fvars := s.fvars.insertIfNew fvarId .erased }
def findDecl (n : Name) : M (Option Decl) :=
return findEnvDecl ( Lean.getEnv) n
def addDecl (d : Decl) : M Unit :=
Lean.modifyEnv fun env => declMapExt.addEntry (env.addExtraName d.name) d
def lowerLitValue (v : LCNF.LitValue) : LitVal :=
match v with
| .natVal n => .num n
| .strVal s => .str s
-- TODO: This should be cached.
def lowerEnumToScalarType (name : Name) : M (Option IRType) := do
let env Lean.getEnv
let some (.inductInfo inductiveVal) := env.find? name | return none
let ctorNames := inductiveVal.ctors
let numCtors := ctorNames.length
for ctorName in ctorNames do
let some (.ctorInfo ctorVal) := env.find? ctorName | panic! "expected valid constructor name"
if ctorVal.type.isForall then return none
return if numCtors == 1 then
none
else if numCtors < Nat.pow 2 8 then
some .uint8
else if numCtors < Nat.pow 2 16 then
some .uint16
else if numCtors < Nat.pow 2 32 then
some .uint32
else
none
def lowerType (e : Lean.Expr) : M IRType := do
match e with
| .const name .. =>
match name with
| ``UInt8 | ``Bool => return .uint8
| ``UInt16 => return .uint16
| ``UInt32 => return .uint32
| ``UInt64 => return .uint64
| ``USize => return .usize
| ``Float => return .float
| ``Float32 => return .float32
| ``lcErased => return .irrelevant
| _ =>
if let some scalarType lowerEnumToScalarType name then
return scalarType
else
return .object
| .app f _ =>
if let .const name _ := f.headBeta then
if let some scalarType lowerEnumToScalarType name then
return scalarType
else
return .object
else
return .object
| .forallE .. => return .object
| _ => panic! "invalid type"
-- TODO: This should be cached.
def getCtorInfo (name : Name) : M (CtorInfo × (Array CtorFieldInfo)) := do
match getCtorLayout ( Lean.getEnv) name with
| .ok ctorLayout =>
return {
name,
cidx := ctorLayout.cidx,
size := ctorLayout.numObjs,
usize := ctorLayout.numUSize,
ssize := ctorLayout.scalarSize
}, ctorLayout.fieldInfo.toArray
| .error .. => panic! "unrecognized constructor"
def lowerArg (a : LCNF.Arg) : M Arg := do
match a with
| .fvar fvarId =>
match ( get).fvars[fvarId]? with
| some (.var varId) => return .var varId
| some .erased => return .irrelevant
| some (.joinPoint ..) | none => panic! "unexpected value"
| .erased | .type .. => return .irrelevant
inductive TranslatedProj where
| expr (e : Expr)
| erased
deriving Inhabited
def lowerProj (base : VarId) (ctorInfo : CtorInfo) (field : CtorFieldInfo)
: TranslatedProj × IRType :=
match field with
| .object i => .expr (.proj i base), .object
| .usize i => .expr (.uproj i base), .usize
| .scalar _ offset irType => .expr (.sproj (ctorInfo.size + ctorInfo.usize) offset base), irType
| .irrelevant => .erased, .irrelevant
def lowerParam (p : LCNF.Param) : M Param := do
let x bindVar p.fvarId
let ty lowerType p.type
return { x, borrow := p.borrow, ty }
mutual
partial def lowerCode (c : LCNF.Code) : M FnBody := do
match c with
| .let decl k => lowerLet decl k
| .jp decl k =>
let joinPoint bindJoinPoint decl.fvarId
let params decl.params.mapM lowerParam
let body lowerCode decl.value
return .jdecl joinPoint params body ( lowerCode k)
| .jmp fvarId args =>
match ( get).fvars[fvarId]? with
| some (.joinPoint joinPointId) =>
return .jmp joinPointId ( args.mapM lowerArg)
| some (.var ..) | some .erased | none => panic! "unexpected value"
| .cases cases =>
match ( get).fvars[cases.discr]? with
| some (.var varId) =>
return .case cases.typeName
varId
( lowerType cases.resultType)
( cases.alts.mapM (lowerAlt varId))
| some (.joinPoint ..) | some .erased | none => panic! "unexpected value"
| .return fvarId =>
let arg := match ( get).fvars[fvarId]? with
| some (.var varId) => .var varId
| some .erased => .irrelevant
| some (.joinPoint ..) | none => panic! "unexpected value"
return .ret arg
| .unreach .. => return .unreachable
| .fun .. => panic! "all local functions should be λ-lifted"
partial def lowerLet (decl : LCNF.LetDecl) (k : LCNF.Code) : M FnBody := do
-- temporary fix: the old compiler inlines these too much as regular `let`s
let rec mkVar (v : VarId) : M FnBody := do
bindVarToVarId decl.fvarId v
lowerCode k
let rec mkExpr (e : Expr) : M FnBody := do
let var bindVar decl.fvarId
let type match e with
| .ctor .. | .pap .. | .proj .. => pure <| .object
| _ => lowerType decl.type
return .vdecl var type e ( lowerCode k)
let rec mkErased (_ : Unit) : M FnBody := do
bindErased decl.fvarId
lowerCode k
let rec mkPartialApp (e : Expr) (restArgs : Array Arg) : M FnBody := do
let var bindVar decl.fvarId
let tmpVar newVar
let type match e with
| .ctor .. | .pap .. | .proj .. => pure <| .object
| _ => lowerType decl.type
return .vdecl tmpVar .object e (.vdecl var type (.ap tmpVar restArgs) ( lowerCode k))
let rec tryIrDecl? (name : Name) (args : Array Arg) : M (Option FnBody) := do
if let some decl LCNF.getMonoDecl? name then
let numArgs := args.size
let numParams := decl.params.size
if numArgs < numParams then
return some ( mkExpr (.pap name args))
else if numArgs == numParams then
return some ( mkExpr (.fap name args))
else
let firstArgs := args.extract 0 numParams
let restArgs := args.extract numParams numArgs
return some ( mkPartialApp (.fap name firstArgs) restArgs)
else
return none
match decl.value with
| .value litValue =>
mkExpr (.lit (lowerLitValue litValue))
| .proj typeName i fvarId =>
match ( get).fvars[fvarId]? with
| some (.var varId) =>
-- TODO: have better pattern matching here
let some (.inductInfo { ctors, .. }) := ( Lean.getEnv).find? typeName
| panic! "projection of non-inductive type"
let ctorName := ctors[0]!
let ctorInfo, fields getCtorInfo ctorName
let result, type := lowerProj varId ctorInfo fields[i]!
match result with
| .expr e =>
let var bindVar decl.fvarId
return .vdecl var type e ( lowerCode k)
| .erased =>
bindErased decl.fvarId
lowerCode k
| some .erased =>
bindErased decl.fvarId
lowerCode k
| some (.joinPoint ..) | none => panic! "unexpected value"
| .const ``Nat.succ _ args =>
let irArgs args.mapM lowerArg
let var bindVar decl.fvarId
let tmpVar newVar
let k := (.vdecl var .object (.fap ``Nat.add #[irArgs[0]!, (.var tmpVar)]) ( lowerCode k))
return .vdecl tmpVar .object (.lit (.num 1)) k
| .const name _ args =>
let irArgs args.mapM lowerArg
if let some code tryIrDecl? name irArgs then
return code
else
let env Lean.getEnv
match env.find? name with
| some (.ctorInfo ctorVal) =>
if isExtern env name then
if let some code tryIrDecl? name irArgs then
return code
else
mkExpr (.fap name irArgs)
else
let ctorInfo, fields getCtorInfo name
let args := args.extract (start := ctorVal.numParams)
let objArgs : Array Arg do
let mut result : Array Arg := #[]
for i in [0:fields.size] do
match args[i]! with
| .fvar fvarId =>
if let some (.var varId) := ( get).fvars[fvarId]? then
if fields[i]! matches .object .. then
result := result.push (.var varId)
| .type _ | .erased =>
if fields[i]! matches .object .. then
result := result.push .irrelevant
pure result
let objVar bindVar decl.fvarId
let rec lowerNonObjectFields (_ : Unit) : M FnBody :=
let rec loop (usizeCount : Nat) (i : Nat) : M FnBody := do
match args[i]? with
| some (.fvar fvarId) =>
match ( get).fvars[fvarId]? with
| some (.var varId) =>
match fields[i]! with
| .usize .. =>
let k loop (usizeCount + 1) (i + 1)
return .uset objVar (ctorInfo.size + usizeCount) varId k
| .scalar _ offset argType =>
let k loop usizeCount (i + 1)
return .sset objVar (ctorInfo.size + ctorInfo.usize) offset varId argType k
| .object .. | .irrelevant => loop usizeCount (i + 1)
| _ => loop usizeCount (i + 1)
| some (.type _) | some .erased => loop usizeCount (i + 1)
| none => lowerCode k
loop 0 0
return .vdecl objVar .object (.ctor ctorInfo objArgs) ( lowerNonObjectFields ())
| some (.axiomInfo ..) =>
if name == ``Quot.lcInv then
match irArgs[2]! with
| .var varId => mkVar varId
| .irrelevant => mkErased ()
else if name == ``lcUnreachable then
return .unreachable
else if let some irDecl findDecl name then
let numArgs := irArgs.size
let numParams := irDecl.params.size
if numArgs < numParams then
mkExpr (.pap name irArgs)
else if numArgs == numParams then
mkExpr (.fap name irArgs)
else
let firstArgs := irArgs.extract 0 numParams
let restArgs := irArgs.extract numParams irArgs.size
mkPartialApp (.fap name firstArgs) restArgs
else
throwError f!"axiom '{name}' not supported by code generator; consider marking definition as 'noncomputable'"
| some (.quotInfo ..) =>
if name == ``Quot.mk then
match irArgs[2]! with
| .var varId => mkVar varId
| .irrelevant => mkErased ()
else
throwError f!"quot {name} unsupported by code generator"
| some (.defnInfo ..) | some (.opaqueInfo ..) =>
if let some code tryIrDecl? name irArgs then
return code
else
mkExpr (.fap name irArgs)
| some (.recInfo ..) =>
throwError f!"code generator does not support recursor '{name}' yet, consider using 'match ... with' and/or structural recursion"
| some (.inductInfo ..) => panic! "induct unsupported by code generator"
| some (.thmInfo ..) => panic! "thm unsupported by code generator"
| none => panic! "reference to unbound name"
| .fvar fvarId args =>
match ( get).fvars[fvarId]? with
| some (.var id) =>
let irArgs args.mapM lowerArg
mkExpr (.ap id irArgs)
| some .erased => mkErased ()
| some (.joinPoint ..) | none => panic! "unexpected value"
| .erased => mkErased ()
partial def lowerAlt (discr : VarId) (a : LCNF.AltCore LCNF.Code) : M (AltCore FnBody) := do
match a with
| .alt ctorName params code =>
let ctorInfo, fields getCtorInfo ctorName
let lowerParams (params : Array LCNF.Param) (fields : Array CtorFieldInfo) : M FnBody := do
let rec loop (i : Nat) : M FnBody := do
match params[i]?, fields[i]? with
| some param, some field =>
let result, type := lowerProj discr ctorInfo field
match result with
| .expr e =>
return .vdecl ( bindVar param.fvarId)
type
e
( loop (i + 1))
| .erased =>
bindErased param.fvarId
loop (i + 1)
| none, none => lowerCode code
| _, _ => panic! "mismatched fields and params"
loop 0
let body lowerParams params fields
return .ctor ctorInfo body
| .default code =>
return .default ( lowerCode code)
end
def lowerResultType (type : Lean.Expr) (arity : Nat) : M IRType :=
lowerType (resultTypeForArity type arity)
where resultTypeForArity (type : Lean.Expr) (arity : Nat) : Lean.Expr :=
if arity == 0 then
type
else
match type with
| .forallE _ _ b _ => resultTypeForArity b (arity - 1)
| .const ``lcErased _ => mkConst ``lcErased
| _ => panic! "invalid arity"
def lowerDecl (d : LCNF.Decl) : M (Option Decl) := do
let params d.params.mapM lowerParam
let resultType lowerResultType d.type d.params.size
match d.value with
| .code code =>
let body lowerCode code
pure <| some <| .fdecl d.name params resultType body {}
| .extern externAttrData =>
if externAttrData.entries.isEmpty then
-- TODO: This matches the behavior of the old compiler, but we should
-- find a better way to handle this.
addDecl (mkDummyExternDecl d.name params resultType)
pure <| none
else
pure <| some <| .extern d.name params resultType externAttrData
end ToIR
def toIR (decls: Array LCNF.Decl) : CoreM (Array Decl) := do
let mut irDecls := #[]
for decl in decls do
if let some irDecl ToIR.lowerDecl decl |>.run then
irDecls := irDecls.push irDecl
return irDecls
end Lean.IR

View File

@@ -29,10 +29,6 @@ structure Context where
Remark: the lambda lifting pass abstracts all `let`/`fun`-declarations.
-/
abstract : FVarId Bool
/--
Indicates whether we are processing terms beneath a binder.
-/
isUnderBinder : Bool
/--
State for the `ClosureM` monad.
@@ -97,11 +93,7 @@ mutual
-/
partial def collectCode (c : Code) : ClosureM Unit := do
match c with
| .let decl k =>
collectType decl.type
withReader (fun ctx => { ctx with isUnderBinder := ctx.isUnderBinder || decl.type.isForall })
do collectLetValue decl.value
collectCode k
| .let decl k => collectType decl.type; collectLetValue decl.value; collectCode k
| .fun decl k | .jp decl k => collectFunDecl decl; collectCode k
| .cases c =>
collectType c.resultType
@@ -118,8 +110,7 @@ mutual
partial def collectFunDecl (decl : FunDecl) : ClosureM Unit := do
collectType decl.type
collectParams decl.params
withReader (fun ctx => { ctx with isUnderBinder := true }) do
collectCode decl.value
collectCode decl.value
/--
Process the given free variable.
@@ -128,11 +119,10 @@ mutual
partial def collectFVar (fvarId : FVarId) : ClosureM Unit := do
unless ( get).visited.contains fvarId do
markVisited fvarId
let ctx read
if ctx.inScope fvarId then
if ( read).inScope fvarId then
/- We only collect the variables in the scope of the function application being specialized. -/
if let some funDecl findFunDecl? fvarId then
if ctx.isUnderBinder || ctx.abstract funDecl.fvarId then
if ( read).abstract funDecl.fvarId then
modify fun s => { s with params := s.params.push <| { funDecl with borrow := false } }
else
collectFunDecl funDecl
@@ -142,7 +132,7 @@ mutual
modify fun s => { s with params := s.params.push param }
else if let some letDecl findLetDecl? fvarId then
collectType letDecl.type
if ctx.isUnderBinder || ctx.abstract letDecl.fvarId then
if ( read).abstract letDecl.fvarId then
modify fun s => { s with params := s.params.push <| { letDecl with borrow := false } }
else
collectLetValue letDecl.value
@@ -157,16 +147,9 @@ mutual
end
def run (x : ClosureM α) (inScope : FVarId Bool) (abstract : FVarId Bool := fun _ => true) : CompilerM (α × Array Param × Array CodeDecl) := do
let (a, s) x { inScope, abstract, isUnderBinder := false } |>.run {}
-- If we've abstracted an fvar into a param, exclude its definition. Note that this still allows
-- for other decls the removed decl depends upon to be included, but they will be removed later
-- for having no users.
let mut paramFVars : FVarIdSet := {}
for param in s.params do
paramFVars := paramFVars.insert param.fvarId
let filteredDecls := s.decls.filter fun decl => !(paramFVars.contains decl.fvarId)
return (a, s.params, filteredDecls)
let (a, s) x { inScope, abstract } |>.run {}
return (a, s.params, s.decls)
end Closure
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -6,10 +6,6 @@ Authors: Leonardo de Moura
prelude
import Lean.Compiler.Options
import Lean.Compiler.ExternAttr
import Lean.Compiler.IR
import Lean.Compiler.IR.Basic
import Lean.Compiler.IR.Checker
import Lean.Compiler.IR.ToIR
import Lean.Compiler.LCNF.PassManager
import Lean.Compiler.LCNF.Passes
import Lean.Compiler.LCNF.PrettyPrinter
@@ -66,7 +62,7 @@ def checkpoint (stepName : Name) (decls : Array Decl) : CompilerM Unit := do
namespace PassManager
def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRecDepth 8192 do
def run (declNames : Array Name) : CompilerM (Array Decl) := withAtLeastMaxRecDepth 8192 do
/-
Note: we need to increase the recursion depth because we currently do to save phase1
declarations in .olean files. Then, we have to recursively compile all dependencies,
@@ -87,25 +83,11 @@ def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRe
-- We display the declaration saved in the environment because the names have been normalized
let some decl' getDeclAt? decl.name .mono | unreachable!
Lean.addTrace `Compiler.result m!"size: {decl.size}\n{← ppDecl' decl'}"
let opts getOptions
-- If the new compiler is disabled, then all of the saved IR was built with the old compiler,
-- which causes IR type mismatches with IR generated by the new compiler.
if !(compiler.enableNew.get opts) then
return #[]
let irDecls IR.toIR decls
let env getEnv
let log, res := IR.compile env opts irDecls
for msg in log do
addTrace `Compiler.IR m!"{msg}"
match res with
| .ok env =>
setEnv env
return irDecls
| .error s => throwError s
return decls
end PassManager
def compile (declNames : Array Name) : CoreM (Array IR.Decl) :=
def compile (declNames : Array Name) : CoreM (Array Decl) :=
CompilerM.run <| PassManager.run declNames
def showDecl (phase : Phase) (declName : Name) : CoreM Format := do

View File

@@ -77,7 +77,7 @@ def getCtorArity? (declName : Name) : CoreM (Option Nat) := do
/--
List of types that have builtin runtime support
-/
def builtinRuntimeTypes : Array Name := #[
def builtinRuntimeTypes : List Name := [
``String,
``UInt8, ``UInt16, ``UInt32, ``UInt64, ``USize,
``Float, ``Float32,

View File

@@ -612,21 +612,20 @@ where doCompile := do
return
let opts getOptions
if compiler.enableNew.get opts then
try compileDeclsNew decls catch e =>
if logErrors then throw e else return ()
else
let res withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
return compileDeclsOld ( getEnv) opts decls
match res with
| Except.ok env => setEnv env
| Except.error (.other msg) =>
if logErrors then
if let some decl := ref? then
checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
throwError msg
| Except.error ex =>
if logErrors then
throwKernelException ex
compileDeclsNew decls
let res withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
return compileDeclsOld ( getEnv) opts decls
match res with
| Except.ok env => setEnv env
| Except.error (.other msg) =>
if logErrors then
if let some decl := ref? then
checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
throwError msg
| Except.error ex =>
if logErrors then
throwKernelException ex
def compileDecl (decl : Declaration) (logErrors := true) : CoreM Unit := do
compileDecls (Compiler.getDeclNamesForCodeGen decl) decl logErrors

View File

@@ -47,97 +47,54 @@ instance : ToJson String := ⟨fun s => s⟩
instance : FromJson System.FilePath := fun j => System.FilePath.mk <$> Json.getStr? j
instance : ToJson System.FilePath := fun p => p.toString
protected def _root_.Array.fromJson? [FromJson α] : Json Except String (Array α)
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
instance [FromJson α] : FromJson (Array α) where
fromJson? := Array.fromJson?
fromJson?
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
protected def _root_.Array.toJson [ToJson α] (a : Array α) : Json :=
Json.arr (a.map toJson)
instance [ToJson α] : ToJson (Array α) where
toJson := Array.toJson
protected def _root_.List.fromJson? [FromJson α] (j : Json) : Except String (List α) :=
(fromJson? j (α := Array α)).map Array.toList
instance [ToJson α] : ToJson (Array α) :=
fun a => Json.arr (a.map toJson)
instance [FromJson α] : FromJson (List α) where
fromJson? := List.fromJson?
protected def _root_.List.toJson [ToJson α] (a : List α) : Json :=
toJson a.toArray
fromJson? j := (fromJson? j (α := Array α)).map Array.toList
instance [ToJson α] : ToJson (List α) where
toJson := List.toJson
protected def _root_.Option.fromJson? [FromJson α] : Json Except String (Option α)
| Json.null => Except.ok none
| j => some <$> fromJson? j
toJson xs := toJson xs.toArray
instance [FromJson α] : FromJson (Option α) where
fromJson? := Option.fromJson?
fromJson?
| Json.null => Except.ok none
| j => some <$> fromJson? j
protected def _root_.Option.toJson [ToJson α] : Option α Json
| none => Json.null
| some a => toJson a
instance [ToJson α] : ToJson (Option α) where
toJson := Option.toJson
protected def _root_.Prod.fromJson? {α : Type u} {β : Type v} [FromJson α] [FromJson β] : Json Except String (α × β)
| Json.arr #[ja, jb] => do
let a : ULift.{v} α := (fromJson? ja).map ULift.up
let b : ULift.{u} β := (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
instance [ToJson α] : ToJson (Option α) :=
fun
| none => Json.null
| some a => toJson a
instance {α : Type u} {β : Type v} [FromJson α] [FromJson β] : FromJson (α × β) where
fromJson? := Prod.fromJson?
protected def _root_.Prod.toJson [ToJson α] [ToJson β] : α × β Json
| (a, b) => Json.arr #[toJson a, toJson b]
fromJson?
| Json.arr #[ja, jb] => do
let a : ULift.{v} α := (fromJson? ja).map ULift.up
let b : ULift.{u} β := (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
instance [ToJson α] [ToJson β] : ToJson (α × β) where
toJson := Prod.toJson
protected def Name.fromJson? (j : Json) : Except String Name := do
let s j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
toJson := fun (a, b) => Json.arr #[toJson a, toJson b]
instance : FromJson Name where
fromJson? := Name.fromJson?
fromJson? j := do
let s j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
instance : ToJson Name where
toJson n := toString n
protected def NameMap.fromJson? [FromJson α] : Json Except String (NameMap α)
| .obj obj => obj.foldM (init := {}) fun m k v => do
if k == "[anonymous]" then
return m.insert .anonymous ( fromJson? v)
else
let n := k.toName
if n.isAnonymous then
throw s!"expected a `Name`, got '{k}'"
else
return m.insert n ( fromJson? v)
| j => throw s!"expected a `NameMap`, got '{j}'"
instance [FromJson α] : FromJson (NameMap α) where
fromJson? := NameMap.fromJson?
protected def NameMap.toJson [ToJson α] (m : NameMap α) : Json :=
Json.obj <| m.fold (fun n k v => n.insert compare k.toString (toJson v)) .leaf
instance [ToJson α] : ToJson (NameMap α) where
toJson := NameMap.toJson
/-- Note that `USize`s and `UInt64`s are stored as strings because JavaScript
cannot represent 64-bit numbers. -/
def bignumFromJson? (j : Json) : Except String Nat := do
@@ -149,77 +106,58 @@ def bignumFromJson? (j : Json) : Except String Nat := do
def bignumToJson (n : Nat) : Json :=
toString n
protected def _root_.USize.fromJson? (j : Json) : Except String USize := do
let n bignumFromJson? j
if n USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
instance : FromJson USize where
fromJson? := USize.fromJson?
fromJson? j := do
let n bignumFromJson? j
if n USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
instance : ToJson USize where
toJson v := bignumToJson (USize.toNat v)
protected def _root_.UInt64.fromJson? (j : Json) : Except String UInt64 := do
let n bignumFromJson? j
if n UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
instance : FromJson UInt64 where
fromJson? := UInt64.fromJson?
fromJson? j := do
let n bignumFromJson? j
if n UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
instance : ToJson UInt64 where
toJson v := bignumToJson (UInt64.toNat v)
protected def _root_.Float.toJson (x : Float) : Json :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
instance : ToJson Float where
toJson := Float.toJson
protected def _root_.Float.fromJson? : Json Except String Float
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
toJson x :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
instance : FromJson Float where
fromJson? := Float.fromJson?
protected def RBMap.toJson [ToJson α] (m : RBMap String α cmp) : Json :=
Json.obj <| RBNode.map (fun _ => toJson) <| m.val
fromJson? := fun
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
instance [ToJson α] : ToJson (RBMap String α cmp) where
toJson := RBMap.toJson
protected def RBMap.fromJson? [FromJson α] (j : Json) : Except String (RBMap String α cmp) := do
let o j.getObj?
o.foldM (fun x k v => x.insert k <$> fromJson? v)
toJson m := Json.obj <| RBNode.map (fun _ => toJson) <| m.val
instance {cmp} [FromJson α] : FromJson (RBMap String α cmp) where
fromJson? := RBMap.fromJson?
fromJson? j := do
let o j.getObj?
o.foldM (fun x k v => x.insert k <$> fromJson? v)
namespace Json
protected def Structured.fromJson? : Json Except String Structured
| .arr a => return Structured.arr a
| .obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
instance : FromJson Structured := fun
| arr a => return Structured.arr a
| obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
instance : FromJson Structured where
fromJson? := Structured.fromJson?
protected def Structured.toJson : Structured Json
| .arr a => .arr a
| .obj o => .obj o
instance : ToJson Structured where
toJson := Structured.toJson
instance : ToJson Structured := fun
| Structured.arr a => arr a
| Structured.obj o => obj o
def toStructured? [ToJson α] (v : α) : Except String Structured :=
fromJson? (toJson v)

View File

@@ -18,8 +18,6 @@ def NameMap (α : Type) := RBMap Name α Name.quickCmp
namespace NameMap
variable {α : Type}
instance [Repr α] : Repr (NameMap α) := inferInstanceAs (Repr (RBMap Name α Name.quickCmp))
instance (α : Type) : EmptyCollection (NameMap α) := mkNameMap α
instance (α : Type) : Inhabited (NameMap α) where

View File

@@ -25,34 +25,25 @@ namespace Lean.Elab.Command
modifyEnv fun env => addMainModuleDoc env doc, range
| _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
private def addScope (isNewNamespace : Bool) (header : String) (newNamespace : Name)
(isNoncomputable : Bool := false) (attrs : List (TSyntax ``Parser.Term.attrInstance) := []) :
CommandElabM Unit := do
private def addScope (isNewNamespace : Bool) (isNoncomputable : Bool) (header : String) (newNamespace : Name) : CommandElabM Unit := do
modify fun s => { s with
env := s.env.registerNamespace newNamespace,
scopes := { s.scopes.head! with
header := header, currNamespace := newNamespace
isNoncomputable := s.scopes.head!.isNoncomputable || isNoncomputable
attrs := s.scopes.head!.attrs ++ attrs
} :: s.scopes
scopes := { s.scopes.head! with header := header, currNamespace := newNamespace, isNoncomputable := s.scopes.head!.isNoncomputable || isNoncomputable } :: s.scopes
}
pushScope
if isNewNamespace then
activateScoped newNamespace
private def addScopes (header : Name) (isNewNamespace : Bool) (isNoncomputable : Bool := false)
(attrs : List (TSyntax ``Parser.Term.attrInstance) := []) : CommandElabM Unit :=
go header
where go
private def addScopes (isNewNamespace : Bool) (isNoncomputable : Bool) : Name CommandElabM Unit
| .anonymous => pure ()
| .str p header => do
go p
addScopes isNewNamespace isNoncomputable p
let currNamespace getCurrNamespace
addScope isNewNamespace header (if isNewNamespace then Name.mkStr currNamespace header else currNamespace) isNoncomputable attrs
addScope isNewNamespace isNoncomputable header (if isNewNamespace then Name.mkStr currNamespace header else currNamespace)
| _ => throwError "invalid scope"
private def addNamespace (header : Name) : CommandElabM Unit :=
addScopes (isNewNamespace := true) (isNoncomputable := false) (attrs := []) header
addScopes (isNewNamespace := true) (isNoncomputable := false) header
def withNamespace {α} (ns : Name) (elabFn : CommandElabM α) : CommandElabM α := do
addNamespace ns
@@ -85,16 +76,14 @@ private def checkEndHeader : Name → List Scope → Option Name
@[builtin_command_elab «section»] def elabSection : CommandElab := fun stx => do
match stx with
| `($[@[expose%$expTk]]? $[noncomputable%$ncTk]? section $(header?)?) =>
-- TODO: allow more attributes?
let attrs if expTk.isSome then
pure [ `(Parser.Term.attrInstance| expose)]
else
pure []
if let some header := header? then
addScopes (isNewNamespace := false) (isNoncomputable := ncTk.isSome) (attrs := attrs) header.getId
else
addScope (isNewNamespace := false) (isNoncomputable := ncTk.isSome) (attrs := attrs) "" ( getCurrNamespace)
| `(section $header:ident) => addScopes (isNewNamespace := false) (isNoncomputable := false) header.getId
| `(section) => addScope (isNewNamespace := false) (isNoncomputable := false) "" ( getCurrNamespace)
| _ => throwUnsupportedSyntax
@[builtin_command_elab noncomputableSection] def elabNonComputableSection : CommandElab := fun stx => do
match stx with
| `(noncomputable section $header:ident) => addScopes (isNewNamespace := false) (isNoncomputable := true) header.getId
| `(noncomputable section) => addScope (isNewNamespace := false) (isNoncomputable := true) "" ( getCurrNamespace)
| _ => throwUnsupportedSyntax
@[builtin_command_elab «end»] def elabEnd : CommandElab := fun stx => do
@@ -459,7 +448,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
let mut msg : Array MessageData := #[]
-- Noncomputable
if scope.isNoncomputable then
msg := msg.push <| `(Parser.Command.section| noncomputable section)
msg := msg.push <| `(command| noncomputable section)
-- Namespace
if !scope.currNamespace.isAnonymous then
msg := msg.push <| `(command| namespace $(mkIdent scope.currNamespace))

View File

@@ -74,11 +74,6 @@ structure Scope where
so all sections and namespaces nested within a `noncomputable` section also have this flag set.
-/
isNoncomputable : Bool := false
/--
Attributes that should be applied to all matching declaration in the section. Inherited from
parent scopes.
-/
attrs : List (TSyntax ``Parser.Term.attrInstance) := []
deriving Inhabited
structure State where

View File

@@ -145,7 +145,6 @@ def runFrontend
(errorOnKinds : Array Name := #[])
(plugins : Array System.FilePath := #[])
(printStats : Bool := false)
(setupFileName? : Option System.FilePath := none)
: IO (Option Environment) := do
let startTime := ( IO.monoNanosNow).toFloat / 1000000000
let inputCtx := Parser.mkInputContext input fileName
@@ -153,28 +152,8 @@ def runFrontend
-- default to async elaboration; see also `Elab.async` docs
let opts := Elab.async.setIfNotSet opts true
let ctx := { inputCtx with }
let setup stx := do
if let some file := setupFileName? then
let setup ModuleSetup.load file
liftM <| setup.dynlibs.forM Lean.loadDynlib
return .ok {
trustLevel
mainModuleName := setup.name
isModule := setup.isModule
imports := setup.imports
plugins := plugins ++ setup.plugins
modules := setup.modules
-- override cmdline options with header options
opts := opts.mergeBy (fun _ _ hOpt => hOpt) setup.options.toOptions
}
else
return .ok {
imports := stx.imports
isModule := stx.isModule
mainModuleName, opts, trustLevel, plugins
}
let processor := Language.Lean.process
let snap processor setup none ctx
let snap processor (fun _ => pure <| .ok { mainModuleName, opts, trustLevel, plugins }) none ctx
let snaps := Language.toSnapshotTree snap
let severityOverrides := errorOnKinds.foldl (·.insert · .error) {}

View File

@@ -31,13 +31,10 @@ private def messageToStringWithoutPos (msg : Message) : BaseIO String := do
unless msg.caption == "" do
str := msg.caption ++ ":\n" ++ str
if !("\n".isPrefixOf str) then str := " " ++ str
if msg.isTrace then
str := "trace:" ++ str
else
match msg.severity with
| MessageSeverity.information => str := "info:" ++ str
| MessageSeverity.warning => str := "warning:" ++ str
| MessageSeverity.error => str := "error:" ++ str
match msg.severity with
| MessageSeverity.information => str := "info:" ++ str
| MessageSeverity.warning => str := "warning:" ++ str
| MessageSeverity.error => str := "error:" ++ str
if str.isEmpty || str.back != '\n' then
str := str ++ "\n"
return str
@@ -49,7 +46,7 @@ inductive SpecResult
/-- Drop the message and delete it. -/
| drop
/-- Do not capture the message. -/
| pass
| passthrough
/-- The method to use when normalizing whitespace, after trimming. -/
inductive WhitespaceMode
@@ -67,25 +64,6 @@ inductive MessageOrdering
/-- Sort the produced messages. -/
| sorted
def parseGuardMsgsFilterAction (action? : Option (TSyntax ``guardMsgsFilterAction)) :
CommandElabM SpecResult := do
if let some action := action? then
match action with
| `(guardMsgsFilterAction| check) => pure .check
| `(guardMsgsFilterAction| drop) => pure .drop
| `(guardMsgsFilterAction| pass) => pure .pass
| _ => throwUnsupportedSyntax
else
pure .check
def parseGuardMsgsFilterSeverity : TSyntax ``guardMsgsFilterSeverity CommandElabM (Message Bool)
| `(guardMsgsFilterSeverity| trace) => pure fun msg => msg.isTrace
| `(guardMsgsFilterSeverity| info) => pure fun msg => !msg.isTrace && msg.severity == .information
| `(guardMsgsFilterSeverity| warning) => pure fun msg => !msg.isTrace && msg.severity == .warning
| `(guardMsgsFilterSeverity| error) => pure fun msg => !msg.isTrace && msg.severity == .error
| `(guardMsgsFilterSeverity| all) => pure fun _ => true
| _ => throwUnsupportedSyntax
/-- Parses a `guardMsgsSpec`.
- No specification: check everything.
- With a specification: interpret the spec, and if nothing applies pass it through. -/
@@ -101,23 +79,24 @@ def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) :
let mut whitespace : WhitespaceMode := .normalized
let mut ordering : MessageOrdering := .exact
let mut p? : Option (Message SpecResult) := none
let pushP (action : SpecResult) (msgP : Message Bool) (p? : Option (Message SpecResult))
let pushP (s : MessageSeverity) (drop : Bool) (p? : Option (Message SpecResult))
(msg : Message) : SpecResult :=
if msgP msg then
action
else
(p?.getD fun _ => .pass) msg
let p := p?.getD fun _ => .passthrough
if msg.severity == s then if drop then .drop else .check
else p msg
for elt in elts.reverse do
match elt with
| `(guardMsgsSpecElt| $[$action?]? $sev) => p? := pushP ( parseGuardMsgsFilterAction action?) ( parseGuardMsgsFilterSeverity sev) p?
| `(guardMsgsSpecElt| $[drop%$drop?]? info) => p? := pushP .information drop?.isSome p?
| `(guardMsgsSpecElt| $[drop%$drop?]? warning) => p? := pushP .warning drop?.isSome p?
| `(guardMsgsSpecElt| $[drop%$drop?]? error) => p? := pushP .error drop?.isSome p?
| `(guardMsgsSpecElt| $[drop%$drop?]? all) => p? := some fun _ => if drop?.isSome then .drop else .check
| `(guardMsgsSpecElt| whitespace := exact) => whitespace := .exact
| `(guardMsgsSpecElt| whitespace := normalized) => whitespace := .normalized
| `(guardMsgsSpecElt| whitespace := lax) => whitespace := .lax
| `(guardMsgsSpecElt| ordering := exact) => ordering := .exact
| `(guardMsgsSpecElt| ordering := sorted) => ordering := .sorted
| _ => throwUnsupportedSyntax
let defaultP := fun _ => .check
return (whitespace, ordering, p?.getD defaultP)
return (whitespace, ordering, p?.getD fun _ => .check)
/-- An info tree node corresponding to a failed `#guard_msgs` invocation,
used for code action support. -/
@@ -178,7 +157,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
match specFn msg with
| .check => toCheck := toCheck.add msg
| .drop => pure ()
| pass => toPassthrough := toPassthrough.add msg
| .passthrough => toPassthrough := toPassthrough.add msg
let strings toCheck.toList.mapM (messageToStringWithoutPos ·)
let strings := ordering.apply strings
let res := "---\n".intercalate strings |>.trim

View File

@@ -10,15 +10,7 @@ import Lean.CoreM
namespace Lean.Elab
abbrev HeaderSyntax := TSyntax ``Parser.Module.header
def HeaderSyntax.startPos (header : HeaderSyntax) : String.Pos :=
header.raw.getPos?.getD 0
def HeaderSyntax.isModule (header : HeaderSyntax) : Bool :=
!header.raw[0].isNone
def HeaderSyntax.imports : HeaderSyntax Array Import
def headerToImports : TSyntax ``Parser.Module.header Array Import
| `(Parser.Module.header| $[module%$moduleTk]? $[prelude%$preludeTk]? $importsStx*) =>
let imports := if preludeTk.isNone then #[{ module := `Init : Import }] else #[]
imports ++ importsStx.map fun
@@ -27,14 +19,17 @@ def HeaderSyntax.imports : HeaderSyntax → Array Import
| _ => unreachable!
| _ => unreachable!
abbrev headerToImports := @HeaderSyntax.imports
/--
Elaborates the given header syntax into an environment.
def processHeaderCore
(startPos : String.Pos) (imports : Array Import) (isModule : Bool)
(opts : Options) (messages : MessageLog) (inputCtx : Parser.InputContext)
(trustLevel : UInt32 := 0) (plugins : Array System.FilePath := #[]) (leakEnv := false)
(mainModule := Name.anonymous) (arts : NameMap ModuleArtifacts := {})
If `mainModule` is not given, `Environment.setMainModule` should be called manually. This is a
backwards compatibility measure not compatible with the module system.
-/
def processHeader (header : TSyntax ``Parser.Module.header) (opts : Options) (messages : MessageLog)
(inputCtx : Parser.InputContext) (trustLevel : UInt32 := 0)
(plugins : Array System.FilePath := #[]) (leakEnv := false) (mainModule := Name.anonymous)
: IO (Environment × MessageLog) := do
let isModule := !header.raw[0].isNone
let level := if isModule then
if Elab.inServer.get opts then
.server
@@ -43,6 +38,7 @@ def processHeaderCore
else
.private
let (env, messages) try
let imports := headerToImports header
for i in imports do
if !isModule && i.importAll then
throw <| .userError "cannot use `import all` without `module`"
@@ -51,30 +47,15 @@ def processHeaderCore
if !isModule && !i.isExported then
throw <| .userError "cannot use `private import` without `module`"
let env
importModules (leakEnv := leakEnv) (loadExts := true) (level := level)
imports opts trustLevel plugins arts
importModules (leakEnv := leakEnv) (loadExts := true) (level := level) imports opts trustLevel plugins
pure (env, messages)
catch e =>
let env mkEmptyEnvironment
let pos := inputCtx.fileMap.toPosition startPos
let spos := header.raw.getPos?.getD 0
let pos := inputCtx.fileMap.toPosition spos
pure (env, messages.add { fileName := inputCtx.fileName, data := toString e, pos := pos })
return (env.setMainModule mainModule, messages)
/--
Elaborates the given header syntax into an environment.
If `mainModule` is not given, `Environment.setMainModule` should be called manually. This is a
backwards compatibility measure not compatible with the module system.
-/
@[inline] def processHeader
(header : HeaderSyntax)
(opts : Options) (messages : MessageLog) (inputCtx : Parser.InputContext)
(trustLevel : UInt32 := 0) (plugins : Array System.FilePath := #[]) (leakEnv := false)
(mainModule := Name.anonymous)
: IO (Environment × MessageLog) := do
processHeaderCore header.startPos header.imports header.isModule
opts messages inputCtx trustLevel plugins leakEnv mainModule
def parseImports (input : String) (fileName : Option String := none) : IO (Array Import × Position × MessageLog) := do
let fileName := fileName.getD "<input>"
let inputCtx := Parser.mkInputContext input fileName

View File

@@ -25,16 +25,6 @@ open Language
builtin_initialize
registerTraceClass `Meta.instantiateMVars
private builtin_initialize exposeAttr : TagAttribute
registerTagAttribute
`expose
"(module system) Make bodies of definitions available to importing modules."
(validate := fun c => do
if let some info := ( getEnv).setExporting false |>.findAsync? c then
if info.kind == .defn then
return
throwError "Invalid use of `expose` attribute, it can only be used on definitions")
def instantiateMVarsProfiling (e : Expr) : MetaM Expr := do
profileitM Exception s!"instantiate metavars" ( getOptions) do
withTraceNode `Meta.instantiateMVars (fun _ => pure e) do
@@ -99,15 +89,8 @@ private def check (prevHeaders : Array DefViewElabHeader) (newHeader : DefViewEl
else
pure ()
private def registerFailedToInferDefTypeInfo (type : Expr) (ref : Syntax) (view : DefView) : TermElabM Unit :=
let msg := if view.kind.isExample then
m!"failed to infer type of example"
else if view.kind matches .instance then
-- TODO: instances are sometime named. We should probably include the name if available.
m!"failed to infer type of instance"
else
m!"failed to infer type of `{view.declId}`"
registerCustomErrorIfMVar type ref msg
private def registerFailedToInferDefTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit :=
registerCustomErrorIfMVar type ref "failed to infer definition type"
/--
Return `some [b, c]` if the given `views` are representing a declaration of the form
@@ -123,17 +106,14 @@ private def isMultiConstant? (views : Array DefView) : Option (List Name) :=
else
none
private def getPendingMVarErrorMessage (views : Array DefView) : MessageData :=
private def getPendingMVarErrorMessage (views : Array DefView) : String :=
match isMultiConstant? views with
| some ids =>
let idsStr := ", ".intercalate <| ids.map fun id => s!"`{id}`"
let paramsStr := ", ".intercalate <| ids.map fun id => s!"`({id} : _)`"
MessageData.note m!"Recall that you cannot declare multiple constants in a single declaration. The identifier(s) {idsStr} are being interpreted as parameters {paramsStr}."
s!"\nrecall that you cannot declare multiple constants in a single declaration. The identifier(s) {idsStr} are being interpreted as parameters {paramsStr}"
| none =>
if views.all fun view => view.kind.isTheorem then
MessageData.note "All holes (e.g., `_`) in the header of a theorem are resolved before the proof is processed; information from the proof cannot be used to infer what these values should be"
else
MessageData.note "When the resulting type of a declaration is explicitly provided, all holes (e.g., `_`) in the header are resolved before the declaration body is processed"
"\nwhen the resulting type of a declaration is explicitly provided, all holes (e.g., `_`) in the header are resolved before the declaration body is processed"
/--
Convert terms of the form `OfNat <type> (OfNat.ofNat Nat <num> ..)` into `OfNat <type> <num>`.
@@ -208,13 +188,13 @@ private def elabHeaders (views : Array DefView) (expandedDeclIds : Array ExpandD
let mut type match view.type? with
| some typeStx =>
let type elabType typeStx
registerFailedToInferDefTypeInfo type typeStx view
registerFailedToInferDefTypeInfo type typeStx
pure type
| none =>
let hole := mkHole refForElabFunType
let type elabType hole
trace[Elab.definition] ">> type: {type}\n{type.mvarId!}"
registerFailedToInferDefTypeInfo type refForElabFunType view
registerFailedToInferDefTypeInfo type refForElabFunType
pure type
Term.synthesizeSyntheticMVarsNoPostponing
if view.isInstance then
@@ -386,11 +366,9 @@ Runs `k` with a restricted local context where only section variables from `vars
* are instance-implicit variables that only reference section variables included by these rules AND
are not listed in `sc.omittedVars` (via `omit`; note that `omit` also subtracts from
`sc.includedVars`).
If `check` is false, no exceptions will be produced.
-/
private def withHeaderSecVars {α} (vars : Array Expr) (sc : Command.Scope) (headers : Array DefViewElabHeader)
(k : Array Expr TermElabM α) (check := true) : TermElabM α := do
(k : Array Expr TermElabM α) : TermElabM α := do
let mut revSectionFVars : Std.HashMap FVarId Name := {}
for (uid, var) in ( read).sectionFVars do
revSectionFVars := revSectionFVars.insert var.fvarId! uid
@@ -408,11 +386,10 @@ where
modify (·.add var.fvarId!)
-- transitively referenced
get >>= (·.addDependencies) >>= set
if check then
for var in ( get).fvarIds do
if let some uid := revSectionFVars[var]? then
if sc.omittedVars.contains uid then
throwError "cannot omit referenced section variable '{Expr.fvar var}'"
for var in ( get).fvarIds do
if let some uid := revSectionFVars[var]? then
if sc.omittedVars.contains uid then
throwError "cannot omit referenced section variable '{Expr.fvar var}'"
-- instances (`addDependencies` unnecessary as by definition they may only reference variables
-- already included)
for var in vars do
@@ -1067,39 +1044,27 @@ where
Term.expandDeclId ( getCurrNamespace) ( getLevelNames) view.declId view.modifiers
let headers elabHeaders views expandedDeclIds bodyPromises tacPromises
let headers levelMVarToParamHeaders views headers
-- If the decl looks like a `rfl` theorem, we elaborate is synchronously as we need to wait for
-- the type before we can decide whether the theorem body should be exported and then waiting
-- for the body as well should not add any significant overhead.
let isRflLike := headers.all (·.value matches `(declVal| := rfl))
-- elaborate body in parallel when all stars align
if let (#[view], #[declId]) := (views, expandedDeclIds) then
if Elab.async.get ( getOptions) && view.kind.isTheorem && !isRflLike &&
if Elab.async.get ( getOptions) && view.kind.isTheorem &&
!deprecated.oldSectionVars.get ( getOptions) &&
-- holes in theorem types is not a fatal error, but it does make parallelism impossible
!headers[0]!.type.hasMVar then
elabAsync headers[0]! view declId
else elabSync headers isRflLike
else elabSync headers isRflLike
else elabSync headers
else elabSync headers
for view in views, declId in expandedDeclIds do
-- NOTE: this should be the full `ref`, and thus needs to be done after any snapshotting
-- that depends only on a part of the ref
addDeclarationRangesForBuiltin declId.declName view.modifiers.stx view.ref
elabSync headers isRflLike := do
-- If the reflexivity holds publically as well (we're still inside `withExporting` here), export
-- the body even if it is a theorem so that it is recognized as a rfl theorem even without
-- `import all`.
let rflPublic pure isRflLike <&&> pure ( getEnv).header.isModule <&&>
forallTelescopeReducing headers[0]!.type fun _ type => do
let some (_, lhs, rhs) := type.eq? | pure false
try
isDefEq lhs rhs
catch _ => pure false
withExporting (isExporting := rflPublic) do
finishElab headers
elabSync headers := do
finishElab headers
processDeriving headers
elabAsync header view declId := do
let env getEnv
let async env.addConstAsync declId.declName .thm (exportedKind := .axiom)
-- HACK: should be replaced by new `[dsimp]` attribute
let isRflLike := header.value matches `(declVal| := rfl)
let async env.addConstAsync declId.declName .thm (exportedKind := if isRflLike then .thm else .axiom)
setEnv async.mainEnv
-- TODO: parallelize header elaboration as well? Would have to refactor auto implicits catch,
@@ -1138,8 +1103,7 @@ where
(cancelTk? := cancelTk) fun _ => do profileitM Exception "elaboration" ( getOptions) do
setEnv async.asyncEnv
try
withoutExporting do
finishElab #[header]
finishElab #[header]
finally
reportDiag
-- must introduce node to fill `infoHole` with multiple info trees
@@ -1157,7 +1121,7 @@ where
Core.logSnapshotTask { stx? := none, task := ( BaseIO.asTask (act ())), cancelTk? := cancelTk }
applyAttributesAt declId.declName view.modifiers.attrs .afterTypeChecking
applyAttributesAt declId.declName view.modifiers.attrs .afterCompilation
finishElab headers := withFunLocalDecls headers fun funFVars => do
finishElab headers := withFunLocalDecls headers fun funFVars => withoutExporting do
for view in views, funFVar in funFVars do
addLocalVarInfo view.declId funFVar
let values try
@@ -1171,10 +1135,7 @@ where
let letRecsToLift getLetRecsToLift
let letRecsToLift letRecsToLift.mapM instantiateMVarsAtLetRecToLift
checkLetRecsToLiftTypes funFVars letRecsToLift
(if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get ( getOptions) then
-- do not repeat checks already done in `elabFunValues`
withHeaderSecVars (check := false) vars sc headers
else withUsed vars headers values letRecsToLift) fun vars => do
(if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get ( getOptions) then withHeaderSecVars vars sc headers else withUsed vars headers values letRecsToLift) fun vars => do
let preDefs MutualClosure.main vars headers funFVars values letRecsToLift
checkAllDeclNamesDistinct preDefs
for preDef in preDefs do
@@ -1204,7 +1165,7 @@ is error-free and contains no syntactical `sorry`s.
-/
private def logGoalsAccomplishedSnapshotTask (views : Array DefView)
(defsParsedSnap : DefsParsedSnapshot) : TermElabM Unit := do
if ! Lean.Elab.inServer.get ( getOptions) then
if Lean.Elab.inServer.get ( getOptions) then
-- Skip 'goals accomplished' task if we are on the command line.
-- These messages are only used in the language server.
return

View File

@@ -225,11 +225,11 @@ where
throwError m!"Value for Int64 was not 64 bit but {value.w} bit"
| _ =>
match var with
| .app (.const (.str p s) levels) arg =>
| .app (.const (.str p s) []) arg =>
if s == Normalize.enumToBitVecSuffix then
let .inductInfo inductiveInfo getConstInfo p | unreachable!
let ctors := inductiveInfo.ctors
let enumVal := mkConst ctors[value.bv.toNat]! levels
let enumVal := mkConst ctors[value.bv.toNat]!
return (arg, enumVal)
else
return (var, toExpr value.bv)
@@ -365,12 +365,11 @@ def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
else
unusedHypotheses := unusedHypotheses.insert hyp
if h : sats.size = 0 then
let mut error := "None of the hypotheses are in the supported BitVec fragment after applying preprocessing.\n"
error := error ++ "There are three potential reasons for this:\n"
let mut error := "None of the hypotheses are in the supported BitVec fragment.\n"
error := error ++ "There are two potential fixes for this:\n"
error := error ++ "1. If you are using custom BitVec constructs simplify them to built-in ones.\n"
error := error ++ "2. If your problem is using only built-in ones it might currently be out of reach.\n"
error := error ++ " Consider expressing it in terms of different operations that are better supported.\n"
error := error ++ "3. The original goal was reduced to False and is thus invalid."
error := error ++ " Consider expressing it in terms of different operations that are better supported."
throwError error
else
let sat := sats[1:].foldl (init := sats[0]) SatAtBVLogical.and

View File

@@ -56,8 +56,7 @@ where
let cfg PreProcessM.getConfig
if cfg.structures || cfg.enums then
let some g' typeAnalysisPass.run g | return none
g := g'
g := ( typeAnalysisPass.run g).get!
/-
There is a tension between the structures and enums pass at play:

View File

@@ -54,13 +54,11 @@ def getEnumToBitVecFor (declName : Name) : MetaM Name := do
let domainSize := inductiveInfo.ctors.length
let bvSize := getBitVecSize domainSize
let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
let levelParamNames := inductiveInfo.levelParams
let levelParams := inductiveInfo.levelParams.map mkLevelParam
let declType := mkConst declName levelParams
let declType := mkConst declName
let translator
withLocalDeclD `x declType fun x => do
let motive := mkLambda .anonymous .default declType bvType
let recOn := mkApp2 (mkConst (mkRecOnName declName) (1 :: levelParams)) motive x
let recOn := mkApp2 (mkConst (mkRecOnName declName) [1]) motive x
let translator :=
Nat.fold
domainSize
@@ -70,7 +68,7 @@ def getEnumToBitVecFor (declName : Name) : MetaM Name := do
addDecl <| .defnDecl {
name := enumToBitVecName
type := ( mkArrow declType bvType)
levelParams := levelParamNames
levelParams := []
value := translator
hints := .regular (getMaxHeight env translator + 1)
safety := .safe
@@ -83,15 +81,15 @@ Create a `cond` chain in `Sort u` of the form:
bif input = discrs 0 then values[0] else bif input = discrs 1 then values 1 else ...
```
-/
private def mkCondChain {w : Nat} (input : Expr) (retType : Expr)
private def mkCondChain {w : Nat} (u : Level) (input : Expr) (retType : Expr)
(discrs : Nat BitVec w) (values : List Expr) (acc : Expr) : MetaM Expr := do
let instBEq synthInstance (mkApp (mkConst ``BEq [0]) (toTypeExpr <| BitVec w))
go input retType instBEq discrs values 0 acc
let instBEq synthInstance (mkApp (mkConst ``BEq [0]) (mkApp (mkConst ``BitVec) (toExpr w)))
return go u input retType instBEq discrs values 0 acc
where
go {w : Nat} (input : Expr) (retType : Expr) (instBEq : Expr)
(discrs : Nat BitVec w) (values : List Expr) (counter : Nat) (acc : Expr) : MetaM Expr := do
go {w : Nat} (u : Level) (input : Expr) (retType : Expr) (instBEq : Expr)
(discrs : Nat BitVec w) (values : List Expr) (counter : Nat) (acc : Expr) : Expr :=
match values with
| [] => return acc
| [] => acc
| value :: values =>
let eq :=
mkApp4
@@ -100,16 +98,16 @@ where
instBEq
input
(toExpr <| discrs counter)
let acc mkAppM ``cond #[eq, value, acc]
go input retType instBEq discrs values (counter + 1) acc
let acc := mkApp4 (mkConst ``cond [u]) retType eq value acc
go u input retType instBEq discrs values (counter + 1) acc
/--
Build `declName.recOn.{0} (motive := motive) value (f context[0]) (f context[1]) ...`
-/
private def enumCases (declName : Name) (motive : Expr)
(value : Expr) (context : List α) (f : α MetaM Expr) : MetaM Expr := do
let args context.toArray.mapM (fun c => do return some ( f c))
mkAppOptM (mkRecOnName declName) (#[some motive, some value] ++ args)
private def enumCases (declName : Name) (motive : Expr) (value : Expr) (context : List α)
(f : α MetaM Expr) : MetaM Expr := do
let recOn := mkApp2 (mkConst (mkRecOnName declName) [0]) motive value
List.foldlM (init := recOn) (fun acc a => mkApp acc <$> f a) context
/--
Assuming that `declName` is an enum inductive, construct a proof of
@@ -122,22 +120,25 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
We prove the lemma by constructing an inverse to `enumToBitVec` and use the fact that all
invertible functions respect equality.
-/
let enumToBitVec := mkConst ( getEnumToBitVecFor declName)
let .inductInfo inductiveInfo getConstInfo declName | unreachable!
let levelParamNames := inductiveInfo.levelParams
let levelParams := inductiveInfo.levelParams.map mkLevelParam
let enumToBitVec := mkConst ( getEnumToBitVecFor declName) levelParams
let ctors := inductiveInfo.ctors
let domainSize := ctors.length
let bvSize := getBitVecSize domainSize
let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
let declType := mkConst declName levelParams
let declType := mkConst declName
-- ∀ (x y : declName), x = y ↔ enumToBitVec x = enumToBitVec y
let type
withLocalDeclD `x declType fun x =>
withLocalDeclD `y declType fun y => do
let lhs mkEq x y
let rhs mkEq (mkApp enumToBitVec x) (mkApp enumToBitVec y)
let lhs := mkApp3 (mkConst ``Eq [1]) declType x y
let rhs :=
mkApp3
(mkConst ``Eq [1])
bvType
(mkApp enumToBitVec x)
(mkApp enumToBitVec y)
let statement := mkApp2 (mkConst ``Iff) lhs rhs
mkForallFVars #[x, y] statement
@@ -145,8 +146,8 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
-- the inverse of enumToBitVec
let inverseValue
withLocalDeclD `x bvType fun x => do
let ctors := ctors.map (mkConst · levelParams)
let inv mkCondChain x declType (BitVec.ofNat bvSize) ctors ctors.head!
let ctors := ctors.map mkConst
let inv mkCondChain 1 x declType (BitVec.ofNat bvSize) ctors ctors.head!
mkLambdaFVars #[x] inv
let value
@@ -155,19 +156,27 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
withLocalDeclD `x declType fun x => do
let toBvToEnum e := mkApp inv (mkApp enumToBitVec e)
let motive
withLocalDeclD `y declType fun y => do
mkLambdaFVars #[y] ( mkEq (toBvToEnum y) y)
withLocalDeclD `y declType fun y =>
mkLambdaFVars #[y] <| mkApp3 (mkConst ``Eq [1]) declType (toBvToEnum y) y
let case ctor := mkEqRefl (toBvToEnum (mkConst ctor levelParams))
let case ctor := do
return mkApp2 (mkConst ``Eq.refl [1]) declType (toBvToEnum (mkConst ctor))
let proof enumCases declName motive x ctors case
mkLambdaFVars #[x] proof
let value mkAppM ``BitVec.eq_iff_eq_of_inv #[enumToBitVec, inv, invProof]
let value :=
mkApp5
(mkConst ``BitVec.eq_iff_eq_of_inv [1])
declType
(toExpr bvSize)
enumToBitVec
inv
invProof
mkLetFVars #[inv] value
addDecl <| .thmDecl {
name := eqIffEnumToBitVecEqName
levelParams := levelParamNames
levelParams := []
type := type
value := value
}
@@ -181,15 +190,13 @@ constructors of `declName`.
def getEnumToBitVecLeFor (declName : Name) : MetaM Name := do
let enumToBitVecLeName := Name.str declName enumToBitVecLeSuffix
realizeConst declName enumToBitVecLeName do
let enumToBitVec := mkConst ( getEnumToBitVecFor declName)
let .inductInfo inductiveInfo getConstInfo declName | unreachable!
let levelParamNames := inductiveInfo.levelParams
let levelParams := inductiveInfo.levelParams.map mkLevelParam
let enumToBitVec := mkConst ( getEnumToBitVecFor declName) levelParams
let ctors := inductiveInfo.ctors
let domainSize := ctors.length
let bvSize := getBitVecSize domainSize
let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
let declType := mkConst declName levelParams
let declType := mkConst declName
let maxValue := toExpr (BitVec.ofNat bvSize (domainSize - 1))
let instLe synthInstance (mkApp (mkConst ``LE [0]) bvType)
let mkStatement e := mkApp4 (mkConst ``LE.le [0]) bvType instLe (mkApp enumToBitVec e) maxValue
@@ -200,14 +207,14 @@ def getEnumToBitVecLeFor (declName : Name) : MetaM Name := do
let statement := mkStatement x
let motive mkLambdaFVars #[x] statement
let case ctor := do
let statement := mkStatement (mkConst ctor levelParams)
let statement := mkStatement (mkConst ctor)
mkDecideProof statement
let cases enumCases declName motive x ctors case
return ( mkForallFVars #[x] statement, mkLambdaFVars #[x] cases)
addDecl <| .thmDecl {
name := enumToBitVecLeName
levelParams := levelParamNames
levelParams := []
type := type
value := value
}
@@ -232,32 +239,30 @@ private partial def getMatchEqCondForAux (declName : Name) (kind : MatchKind) :
where
handleSimpleEnum (declName : Name) (thmName : Name) (inductiveInfo : InductiveVal)
(ctors : Array ConstructorVal) : MetaM Declaration := do
let matchConstInfo getConstInfo declName
let levelParamNames := matchConstInfo.levelParams
let u := mkLevelParam levelParamNames.getLast!
let levelParams := levelParamNames.map mkLevelParam
let .forallE _ (.forallE _ discrType ..) .. := matchConstInfo.type | unreachable!
let uName := `u
let u := .param uName
let (type, value)
withLocalDeclD `a (.sort u) fun a => do
withLocalDeclD `x discrType fun x => do
withLocalDeclD `x (mkConst inductiveInfo.name) fun x => do
let hType mkArrow (mkConst ``Unit) a
let hBinders := ctors.foldl (init := #[]) (fun acc _ => acc.push (`h, hType))
withLocalDeclsDND hBinders fun hs => do
let args := #[mkLambda `x .default discrType a , x] ++ hs
let lhs := mkAppN (mkConst declName levelParams) args
let enumToBitVec getEnumToBitVecFor inductiveInfo.name
let args := #[mkLambda `x .default (mkConst inductiveInfo.name) a , x] ++ hs
let lhs := mkAppN (mkConst declName [u]) args
let enumToBitVec := mkConst ( getEnumToBitVecFor inductiveInfo.name)
let domainSize := inductiveInfo.ctors.length
let bvSize := getBitVecSize domainSize
let appliedHs := hs.toList.map (mkApp · (mkConst ``Unit.unit))
let getBitVec i := BitVec.ofNat bvSize ctors[i]!.cidx
let rhs mkCondChain ( mkAppM enumToBitVec #[x]) a getBitVec appliedHs appliedHs[0]!
let type mkEq lhs rhs
let rhs mkCondChain u (mkApp enumToBitVec x) a getBitVec appliedHs appliedHs[0]!
let type := mkApp3 (mkConst ``Eq [u]) a lhs rhs
let motive mkLambdaFVars #[x] type
let sortedHs :=
hs
|>.mapIdx (fun i h => (ctors[i]!.cidx, h))
|>.qsort (·.1 < ·.1)
let case h := mkEqRefl (mkApp h.2 (mkConst ``Unit.unit))
let case h := do
return mkApp2 (mkConst ``Eq.refl [u]) a (mkApp h.2 (mkConst ``Unit.unit))
let cases enumCases inductiveInfo.name motive x sortedHs.toList case
let fvars := #[a, x] ++ hs
@@ -265,28 +270,25 @@ where
return .thmDecl {
name := thmName
levelParams := levelParamNames
levelParams := [uName]
type := type
value := value
}
handleEnumWithDefault (declName : Name) (thmName : Name) (inductiveInfo : InductiveVal)
(ctors : Array ConstructorVal) : MetaM Declaration := do
let matchConstInfo getConstInfo declName
let levelParamNames := matchConstInfo.levelParams
let u := mkLevelParam levelParamNames.getLast!
let levelParams := levelParamNames.map mkLevelParam
let .forallE _ (.forallE _ discrType ..) .. := matchConstInfo.type | unreachable!
let uName := `u
let u := .param uName
let (type, value)
withLocalDeclD `a (.sort u) fun a => do
withLocalDeclD `x discrType fun x => do
withLocalDeclD `x (mkConst inductiveInfo.name) fun x => do
let hType mkArrow (mkConst ``Unit) a
let mut hBinders := ctors.foldl (init := #[]) (fun acc _ => acc.push (`h, hType))
hBinders := hBinders.push <| (`h, mkArrow discrType a)
hBinders := hBinders.push <| (`h, mkArrow (mkConst inductiveInfo.name) a)
withLocalDeclsDND hBinders fun hs => do
let args := #[mkLambda `x .default discrType a , x] ++ hs
let lhs := mkAppN (mkConst declName levelParams) args
let enumToBitVec getEnumToBitVecFor inductiveInfo.name
let args := #[mkLambda `x .default (mkConst inductiveInfo.name) a , x] ++ hs
let lhs := mkAppN (mkConst declName [u]) args
let enumToBitVec := mkConst ( getEnumToBitVecFor inductiveInfo.name)
let domainSize := inductiveInfo.ctors.length
let bvSize := getBitVecSize domainSize
let hdefault := hs.back!
@@ -294,8 +296,8 @@ where
let appliedDefault := mkApp hdefault x
let appliedConcrete := concrete.toList.map (mkApp · (mkConst ``Unit.unit))
let getBitVec i := BitVec.ofNat bvSize ctors[i]!.cidx
let rhs mkCondChain ( mkAppM enumToBitVec #[x]) a getBitVec appliedConcrete appliedDefault
let type mkEq lhs rhs
let rhs mkCondChain u (mkApp enumToBitVec x) a getBitVec appliedConcrete appliedDefault
let type := mkApp3 (mkConst ``Eq [u]) a lhs rhs
let motive mkLambdaFVars #[x] type
let sortedConcreteHs :=
concrete
@@ -303,27 +305,25 @@ where
|>.qsort (·.1 < ·.1)
|>.toList
let discrParams := discrType.constLevels!
let rec intersperseDefault hs idx acc := do
let rec intersperseDefault hs idx acc :=
if idx == inductiveInfo.numCtors then
return acc.reverse
acc.reverse
else
match hs with
| [] =>
let ctor := mkConst inductiveInfo.ctors[idx]! discrParams
let new := (idx, mkApp hdefault ctor)
let new := (idx, mkApp hdefault (mkConst (inductiveInfo.ctors[idx]!)))
intersperseDefault hs (idx + 1) (new :: acc)
| hs@((cidx, h) :: tail) =>
if cidx == idx then
let new := (idx, mkApp h (mkConst ``Unit.unit))
intersperseDefault tail (idx + 1) (new :: acc)
else
let ctor := mkConst inductiveInfo.ctors[idx]! discrParams
let new := (idx, mkApp hdefault ctor)
let new := (idx, mkApp hdefault (mkConst (inductiveInfo.ctors[idx]!)))
intersperseDefault hs (idx + 1) (new :: acc)
let caseProofs intersperseDefault sortedConcreteHs 0 []
let case h := mkEqRefl h.2
let caseProofs := intersperseDefault sortedConcreteHs 0 []
let case h := do
return mkApp2 (mkConst ``Eq.refl [u]) a h.2
let cases enumCases inductiveInfo.name motive x caseProofs case
let fvars := #[a, x] ++ hs
@@ -331,7 +331,7 @@ where
return .thmDecl {
name := thmName
levelParams := levelParamNames
levelParams := [uName]
type := type
value := value
}
@@ -379,7 +379,7 @@ It will check if `x` is a constructor and if that is the case constant fold it t
`BitVec` value.
-/
def enumToBitVecCtor : Simp.Simproc := fun e => do
let .app (.const fn ..) (.const arg ..) := e | return .continue
let .app (.const fn []) (.const arg []) := e | return .continue
let .str p s := fn | return .continue
if s != enumToBitVecSuffix then return .continue
if !( isEnumType p) then return .continue
@@ -413,6 +413,7 @@ partial def enumsPass : Pass where
let mut simprocs : Simprocs := {}
let mut relevantLemmas : SimpTheoremsArray := #[]
relevantLemmas relevantLemmas.addTheorem (.decl ``ne_eq) (mkConst ``ne_eq)
for type in interestingEnums do
let lemma getEqIffEnumToBitVecEqFor type
relevantLemmas relevantLemmas.addTheorem (.decl lemma) (mkConst lemma)
@@ -435,7 +436,6 @@ partial def enumsPass : Pass where
-- structures. Thus we must also re run lemmas that handle structure projections in the
-- presence of control flow.
let cfg PreProcessM.getConfig
relevantLemmas addDefaultTypeAnalysisLemmas relevantLemmas
if cfg.structures then
(simprocs, relevantLemmas) addStructureSimpLemmas simprocs relevantLemmas
@@ -464,7 +464,7 @@ where
postprocess (goal : MVarId) : StateRefT PostProcessState MetaM MVarId :=
goal.withContext do
let filter e :=
if let .app (.const (.str _ s) ..) _ := e then
if let .app (.const (.str _ s) []) _ := e then
s == enumToBitVecSuffix && !e.hasLooseBVars
else
false
@@ -477,8 +477,9 @@ where
hypotheses for it.
-/
if ( get).seen.contains e then return ()
let .app (.const (.str enumType _) ..) val := e | unreachable!
let value mkAppM ( getEnumToBitVecLeFor enumType) #[val]
let .app (.const (.str enumType _) []) val := e | unreachable!
let lemma := mkConst ( getEnumToBitVecLeFor enumType)
let value := mkApp lemma val
let type inferType value
let hyp := { userName := .anonymous, type, value }
modify fun s => { s with hyps := s.hyps.push hyp, seen := s.seen.insert e }

View File

@@ -19,231 +19,6 @@ namespace Frontend.Normalize
open Lean.Meta
open Std.Tactic.BVDecide.Normalize
section SimpleUnifiers
builtin_simproc [bv_normalize] bv_and ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd ty _ _ _ lhs rhs := e | return .continue
let_expr BitVec wExpr := ty | return .continue
if lhs == rhs then
return .visit { expr := lhs, proof? := some <| mkApp2 (mkConst ``BitVec.and_self) wExpr lhs }
else
let some w getNatValue? wExpr | return .continue
let tryIt (notSide other : Expr) : Bool :=
let_expr Complement.complement _ _ notSide := notSide | false
notSide == other
if tryIt lhs rhs then
let proof := mkApp2 (mkConst ``BitVec.and_contra') wExpr rhs
return .visit { expr := toExpr 0#w, proof? := some proof }
else if tryIt rhs lhs then
let proof := mkApp2 (mkConst ``BitVec.and_contra) wExpr lhs
return .visit { expr := toExpr 0#w, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] bv_add ((_ : BitVec _) + (_ : BitVec _)) := fun e => do
let_expr HAdd.hAdd ty _ _ _ lhs rhs := e | return .continue
let_expr BitVec wExpr := ty | return .continue
let some w getNatValue? wExpr | return .continue
if lhs == rhs then
let expr mkMul lhs (toExpr 2#w)
return .visit { expr , proof? := some <| mkApp2 (mkConst ``BitVec.add_same) wExpr lhs }
else
let notAdd : MetaM (Option Simp.Step) := do
let_expr Complement.complement _ _ lhs := lhs | return none
if lhs != rhs then return none
let proof := mkApp2 (mkConst ``BitVec.not_add) wExpr rhs
return some <| .visit { expr := toExpr (-1#w) , proof? := some proof }
let addNot : MetaM (Option Simp.Step) := do
let_expr Complement.complement _ _ rhs := rhs | return none
if lhs != rhs then return none
let proof := mkApp2 (mkConst ``BitVec.add_not) wExpr lhs
return some <| .visit { expr := toExpr (-1#w) , proof? := some proof }
let addNeg : MetaM (Option Simp.Step) := do
let_expr HAdd.hAdd _ _ _ _ rlhs rrhs := rhs | return none
let some w', rrhsVal getBitVecValue? rrhs | return none
if rrhsVal != 1#w' then return none
let_expr Complement.complement _ _ rlhs := rlhs | return none
if rlhs != lhs then return none
let proof := mkApp2 (mkConst ``BitVec.add_neg) wExpr lhs
return some <| .visit { expr := toExpr 0#w, proof? := some proof }
let negAdd : MetaM (Option Simp.Step) := do
let_expr HAdd.hAdd _ _ _ _ llhs lrhs := lhs | return none
let some w', lrhsVal getBitVecValue? lrhs | return none
if lrhsVal != 1#w' then return none
let_expr Complement.complement _ _ llhs := llhs | return none
if llhs != rhs then return none
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.neg_add) wExpr rhs
return some <| .visit { expr := toExpr 0#w, proof? := some proof }
let addNegMul : MetaM (Option Simp.Step) := do
let some w', rhsVal getBitVecValue? rhs | return none
if rhsVal != 1#w' then return none
let_expr Complement.complement _ _ lhs := lhs | return none
let_expr HAdd.hAdd _ _ _ _ llhs lrhs := lhs | return none
if llhs.isAppOf ``HMul.hMul then
let_expr HMul.hMul _ _ _ _ lllhs llrhs := llhs | return none
if lllhs == lrhs then
let newRhs mkAppM ``Complement.complement #[llrhs]
let expr mkMul lllhs newRhs
let proof := mkApp3 (mkConst ``BitVec.add_neg_mul'') wExpr lllhs llrhs
return some <| .visit { expr := expr, proof? := some proof }
else if llrhs == lrhs then
let newLhs mkAppM ``Complement.complement #[lllhs]
let expr mkMul newLhs llrhs
let proof := mkApp3 (mkConst ``BitVec.add_neg_mul''') wExpr llrhs lllhs
return some <| .visit { expr := expr, proof? := some proof }
else
return none
else if lrhs.isAppOf ``HMul.hMul then
let_expr HMul.hMul _ _ _ _ lrlhs lrrhs := lrhs | return none
if llhs == lrlhs then
let newRhs mkAppM ``Complement.complement #[lrrhs]
let expr mkMul lrlhs newRhs
let proof := mkApp3 (mkConst ``BitVec.add_neg_mul) wExpr lrlhs lrrhs
return some <| .visit { expr := expr, proof? := some proof }
else if llhs == lrrhs then
let newLhs mkAppM ``Complement.complement #[lrlhs]
let expr mkMul newLhs lrrhs
let proof := mkApp3 (mkConst ``BitVec.add_neg_mul') wExpr lrrhs lrlhs
return some <| .visit { expr := expr, proof? := some proof }
else
return none
else
return none
let addShiftLeft : MetaM (Option Simp.Step) := do
let_expr HShiftLeft.hShiftLeft _ _ _ _ rlhs rrhs := rhs | return none
if lhs != rrhs then return none
let expr mkAppM ``HOr.hOr #[lhs, rhs]
let proof := mkApp3 (mkConst ``BitVec.add_shiftLeft_eq_or_shiftLeft) wExpr lhs rlhs
return some <| .visit { expr := expr, proof? := some proof }
let shiftLeftAdd : MetaM (Option Simp.Step) := do
let_expr HShiftLeft.hShiftLeft _ _ _ _ llhs lrhs := lhs | return none
if rhs != lrhs then return none
let expr mkAppM ``HOr.hOr #[lhs, rhs]
let proof := mkApp3 (mkConst ``BitVec.shiftLeft_add_eq_shiftLeft_or) wExpr rhs llhs
return some <| .visit { expr := expr, proof? := some proof }
if let some step notAdd then return step
else if let some step addNot then return step
else if let some step addNeg then return step
else if let some step negAdd then return step
else if let some step addNegMul then return step
else if let some step addShiftLeft then return step
else if let some step shiftLeftAdd then return step
else return .continue
builtin_simproc [bv_normalize] shiftRight_self ((_ : BitVec _) >>> (_ : BitVec _)) := fun e => do
let_expr HShiftRight.hShiftRight ty _ _ _ lhs rhs := e | return .continue
let_expr BitVec wExpr := ty | return .continue
let some w getNatValue? wExpr | return .continue
if lhs != rhs then return .continue
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ushiftRight_self) wExpr lhs
return .visit { expr := toExpr 0#w, proof? := some proof }
builtin_simproc [bv_normalize] extract_full (BitVec.extractLsb' _ _ _) := fun e => do
let_expr BitVec.extractLsb' wExpr startExpr lenExpr targetExpr := e | return .continue
let some w getNatValue? wExpr | return .continue
let some start getNatValue? startExpr | return .continue
let some len getNatValue? lenExpr | return .continue
if start != 0 then return .continue
if len != w then return .continue
let proof := mkApp2 (mkConst ``BitVec.extractLsb'_eq_self) wExpr targetExpr
return .visit { expr := targetExpr, proof? := some proof }
def eqSelfProc : Simp.Simproc := fun e => do
let_expr Eq ty lhs rhs := e | return .continue
if lhs != rhs then return .continue
let proof := mkApp2 (mkConst ``eq_self [1]) ty lhs
return .visit { expr := mkConst ``True, proof? := some proof }
builtin_simproc [bv_normalize] bv_eq_self ((_ : BitVec _) = (_ : BitVec _)) := eqSelfProc
builtin_simproc [bv_normalize] bool_eq_self ((_ : Bool) = (_ : Bool)) := eqSelfProc
builtin_simproc [bv_normalize] bool_and ((_ : Bool) && (_ : Bool)) := fun e => do
let_expr Bool.and lhs rhs := e | return .continue
if lhs == rhs then
return .visit { expr := lhs, proof? := some (mkApp (mkConst ``Bool.and_self) lhs) }
else
let andNotSelf : MetaM (Option Simp.Step) := do
let_expr Bool.not rhs := rhs | return none
if lhs != rhs then return none
let proof := mkApp (mkConst ``Bool.and_not_self) lhs
return some <| .visit { expr := toExpr false, proof? := some proof }
let notAndSelf : MetaM (Option Simp.Step) := do
let_expr Bool.not lhs := lhs | return none
if lhs != rhs then return none
let proof := mkApp (mkConst ``Bool.not_and_self) lhs
return some <| .visit { expr := toExpr false, proof? := some proof }
let andSelfLeft : MetaM (Option Simp.Step) := do
let_expr Bool.and rlhs rrhs := rhs | return none
if lhs != rlhs then return none
let expr := mkApp2 (mkConst ``Bool.and) lhs rrhs
let proof := mkApp2 (mkConst ``Bool.and_self_left) lhs rrhs
return some <| .visit { expr := expr, proof? := some proof }
let andSelfRight : MetaM (Option Simp.Step) := do
let_expr Bool.and llhs lrhs := lhs | return none
if rhs != lrhs then return none
let expr := mkApp2 (mkConst ``Bool.and) llhs rhs
let proof := mkApp2 (mkConst ``Bool.and_self_right) llhs rhs
return some <| .visit { expr := expr, proof? := some proof }
if let some step andNotSelf then return step
else if let some step notAndSelf then return step
else if let some step andSelfLeft then return step
else if let some step andSelfRight then return step
else return .continue
builtin_simproc [bv_normalize] bv_beq_self ((_ : BitVec _) == (_ : BitVec _)) := fun e => do
let_expr BEq.beq _ _ lhs rhs := e | return .continue
if lhs != rhs then return .continue
return .visit { expr := toExpr true, proof? := some ( mkAppM ``beq_self_eq_true #[lhs]) }
builtin_simproc [bv_normalize] bool_beq ((_ : Bool) == (_ : Bool)) := fun e => do
let_expr BEq.beq _ _ lhs rhs := e | return .continue
if lhs == rhs then
return .visit { expr := toExpr true, proof? := some ( mkAppM ``beq_self_eq_true #[lhs]) }
else
let notSelf : MetaM (Option Simp.Step) := do
let_expr Bool.not rhs := rhs | return none
if lhs != rhs then return none
let proof := mkApp (mkConst ``Bool.beq_not_self) lhs
return some <| .visit { expr := toExpr false, proof? := some proof }
let selfNot : MetaM (Option Simp.Step) := do
let_expr Bool.not lhs := lhs | return none
if lhs != rhs then return none
let proof := mkApp (mkConst ``Bool.not_beq_self) lhs
return some <| .visit { expr := toExpr false, proof? := some proof }
let selfLeft : MetaM (Option Simp.Step) := do
let_expr BEq.beq _ _ rlhs rrhs := rhs | return none
if lhs != rlhs then return none
let proof := mkApp2 (mkConst ``Bool.beq_self_left) lhs rrhs
return some <| .visit { expr := rrhs, proof? := some proof }
let selfRight : MetaM (Option Simp.Step) := do
let_expr BEq.beq _ _ llhs lrhs := lhs | return none
if rhs != lrhs then return none
let proof := mkApp2 (mkConst ``Bool.beq_self_right) llhs rhs
return some <| .visit { expr := llhs, proof? := some proof }
if let some step notSelf then return step
else if let some step selfNot then return step
else if let some step selfLeft then return step
else if let some step selfRight then return step
else return .continue
end SimpleUnifiers
builtin_simproc [bv_normalize] reduceCond (cond _ _ _) := fun e => do
let_expr f@cond α c tb eb := e | return .continue
let r Simp.simp c

View File

@@ -6,7 +6,6 @@ Authors: Henrik Böving
prelude
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.ApplyControlFlow
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.TypeAnalysis
import Lean.Meta.Tactic.Cases
import Lean.Meta.Tactic.Simp
import Lean.Meta.Injective
@@ -79,8 +78,8 @@ where
goal.withContext do
let mut simprocs : Simprocs := {}
let mut relevantLemmas : SimpTheoremsArray := #[]
relevantLemmas relevantLemmas.addTheorem (.decl ``ne_eq) ( mkConstWithLevelParams ``ne_eq)
(simprocs, relevantLemmas) addStructureSimpLemmas simprocs relevantLemmas
relevantLemmas addDefaultTypeAnalysisLemmas relevantLemmas
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := {

View File

@@ -5,7 +5,6 @@ Authors: Henrik Böving
-/
prelude
import Init.Data.SInt.Basic
import Std.Tactic.BVDecide.Normalize.BitVec
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
/-!
@@ -39,7 +38,7 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
-- Check that motive is `EnumInductive → Sort u`
let motive := xs[0]!
let motiveType inferType motive
let some (.const domTypeName .., (.sort (.param ..))) := motiveType.arrow? | return none
let some (.const domTypeName [], (.sort (.param ..))) := motiveType.arrow? | return none
if domTypeName != discrTypeName then return none
-- Check that resulting type is `motive discr`
@@ -79,7 +78,7 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
let mut handledCtors := Array.mkEmpty (xs.size - 3)
for i in [0:numConcreteCases] do
let argType inferType xs[i + 2]!
let some (.const ``Unit [], (.app m (.const c ..))) := argType.arrow? | return none
let some (.const ``Unit [], (.app m (.const c []))) := argType.arrow? | return none
if m != motive then return none
let .ctorInfo ctorInfo getConstInfo c | return none
handledCtors := handledCtors.push ctorInfo
@@ -105,7 +104,7 @@ where
let mut handledCtors := Array.mkEmpty numCtors
for i in [0:numCtors] do
let argType inferType xs[i + 2]!
let some (.const ``Unit [], (.app m (.const c ..))) := argType.arrow? | return none
let some (.const ``Unit [], (.app m (.const c []))) := argType.arrow? | return none
if m != motive then return none
let .ctorInfo ctorInfo getConstInfo c | return none
handledCtors := handledCtors.push ctorInfo
@@ -140,7 +139,7 @@ where
-- remaining arguments are of the form `(h_n Unit.unit)`
for i in [0:inductiveInfo.numCtors] do
let .app fn (.const ``Unit.unit []) := args[i + 2]! | return false
let some (_, .app _ (.const relevantCtor ..)) := ( inferType fn).arrow? | unreachable!
let some (_, .app _ (.const relevantCtor [])) := ( inferType fn).arrow? | unreachable!
let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
if fn != params[ctorIdx + 2]! then return false
@@ -158,9 +157,9 @@ where
- `(h_n InductiveEnum.ctor)` if the constructor is handled as part of the default case
-/
for i in [0:inductiveInfo.numCtors] do
let .app fn (.const argName ..) := args[i + 2]! | return false
let .app fn (.const argName []) := args[i + 2]! | return false
if argName == ``Unit.unit then
let some (_, .app _ (.const relevantCtor ..)) := ( inferType fn).arrow? | unreachable!
let some (_, .app _ (.const relevantCtor [])) := ( inferType fn).arrow? | unreachable!
let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
if fn != params[ctorIdx + 2]! then return false
else
@@ -178,19 +177,6 @@ def builtinTypes : Array Name :=
@[inline]
def isBuiltIn (n : Name) : Bool := builtinTypes.contains n
def addDefaultTypeAnalysisLemmas (lemmas : SimpTheoremsArray) : PreProcessM SimpTheoremsArray := do
let mut lemmas := lemmas
let relevantNames := #[
``ne_eq,
``dif_eq_if,
``Std.Tactic.BVDecide.Normalize.BitVec.getElem_eq_getLsbD,
]
for name in relevantNames do
lemmas lemmas.addTheorem (.decl name) (mkConst name)
return lemmas
partial def typeAnalysisPass : Pass where
name := `typeAnalysis
run' goal := do

View File

@@ -11,10 +11,10 @@ namespace Lean.Elab
open Meta
/-- Assign `mvarId := sorry` -/
def admitGoal (mvarId : MVarId) (synthetic : Bool := true): MetaM Unit :=
def admitGoal (mvarId : MVarId) : MetaM Unit :=
mvarId.withContext do
let mvarType inferType (mkMVar mvarId)
mvarId.assign ( mkLabeledSorry mvarType (synthetic := synthetic) (unique := true))
mvarId.assign ( mkLabeledSorry mvarType (synthetic := true) (unique := true))
def goalsToMessageData (goals : List MVarId) : MessageData :=
MessageData.joinSep (goals.map MessageData.ofGoal) m!"\n\n"

View File

@@ -293,7 +293,7 @@ def evalApplyLikeTactic (tac : MVarId → Expr → MetaM (List MVarId)) (e : Syn
@[builtin_tactic Lean.Parser.Tactic.apply] def evalApply : Tactic := fun stx =>
match stx with
| `(tactic| apply $e) => evalApplyLikeTactic (·.apply (term? := some m!"`{e}`")) e
| `(tactic| apply $e) => evalApplyLikeTactic (·.apply) e
| _ => throwUnsupportedSyntax
@[builtin_tactic Lean.Parser.Tactic.constructor] def evalConstructor : Tactic := fun _ =>
@@ -342,7 +342,7 @@ def elabAsFVar (stx : Syntax) (userName? : Option Name := none) : TacticM FVarId
let fvarId withoutModifyingState <| withNewMCtxDepth <| withoutRecover do
let type elabTerm typeStx none (mayPostpone := true)
let fvarId? ( getLCtx).findDeclRevM? fun localDecl => do
if !localDecl.isImplementationDetail && ( isDefEq type localDecl.type) then return localDecl.fvarId else return none
if ( isDefEq type localDecl.type) then return localDecl.fvarId else return none
match fvarId? with
| none => throwError "failed to find a hypothesis with type{indentExpr type}"
| some fvarId => return fvarId

View File

@@ -135,11 +135,10 @@ structure Result where
complexArgs : Array Expr
/--
Construct the an eliminator/recursor application. `targets` contains the explicit and implicit
targets for the eliminator, not yet generalized.
For example, the indices of builtin recursors are considered implicit targets.
Remark: the method `addImplicitTargets` may be used to compute the sequence of implicit and
explicit targets from the explicit ones.
Construct the an eliminator/recursor application. `targets` contains the explicit and implicit targets for
the eliminator. For example, the indices of builtin recursors are considered implicit targets.
Remark: the method `addImplicitTargets` may be used to compute the sequence of implicit and explicit targets
from the explicit ones.
-/
partial def mkElimApp (elimInfo : ElimInfo) (targets : Array Expr) (tag : Name) : TermElabM Result := do
let rec loop : M Unit := do
@@ -214,37 +213,24 @@ partial def mkElimApp (elimInfo : ElimInfo) (targets : Array Expr) (tag : Name)
/--
Given a goal `... targets ... |- C[targets, complexArgs]` associated with `mvarId`,
where `complexArgs` are the the complex (i.e. non-target) arguments to the motive in the conclusion
of the eliminator, construct `motiveArg := fun targets rs => C[targets, rs]`
This checks if the type of the complex arguments match what's expected by the motive, and
ignores them otherwise. This limits the ability of `cases` to use unfolding function
principles with dependent types, because after generalization of the targets, the types do
no longer match. This can likely be improved.
of the eliminator, construct `motiveArg := fun targets xs => C[targets, xs]`
-/
def setMotiveArg (mvarId : MVarId) (motiveArg : MVarId) (targets : Array FVarId) (complexArgs : Array Expr := #[]) : MetaM Unit := do
let type inferType (mkMVar mvarId)
let motiveType inferType (mkMVar motiveArg)
let exptComplexArgTypes arrowDomainsN complexArgs.size ( instantiateForall motiveType (targets.map mkFVar))
let mut absType := type
for complexArg in complexArgs.reverse, exptComplexArgType in exptComplexArgTypes.reverse do
trace[Elab.induction] "setMotiveArg: trying to abstract over {complexArg}, expected type {exptComplexArgType}"
let complexArgType inferType complexArg
if ( isDefEq complexArgType exptComplexArgType) then
let absType' kabstract absType complexArg
let absType' := .lam ( mkFreshUserName `x) complexArgType absType' .default
if ( isTypeCorrect absType') then
absType := absType'
else
trace[Elab.induction] "Not abstracing goal over {complexArg}, resulting term is not type correct:{indentExpr absType'} }"
absType := .lam ( mkFreshUserName `x) complexArgType absType .default
for complexArg in complexArgs.reverse do
let complexTypeArg inferType complexArg
let absType' kabstract absType complexArg
let absType' := .lam ( mkFreshUserName `x) complexTypeArg absType' .default
if ( isTypeCorrect absType') then
absType := absType'
else
trace[Elab.induction] "Not abstracing goal over {complexArg}, its type {complexArgType} does not match the expected {exptComplexArgType}"
absType := .lam ( mkFreshUserName `x) exptComplexArgType absType .default
trace[Elab.induction] "Not abstracing goal over {complexArg}, resulting term is not type correct:{indentExpr absType'} }"
absType := .lam ( mkFreshUserName `x) complexTypeArg absType .default
let motive mkLambdaFVars (targets.map mkFVar) absType
let motiverInferredType inferType motive
let motiveType inferType (mkMVar motiveArg)
unless ( isDefEqGuarded motiverInferredType motiveType) do
throwError "type mismatch when assigning motive{indentExpr motive}\n{← mkHasTypeButIsExpectedMsg motiverInferredType motiveType}"
motiveArg.assign motive
@@ -275,7 +261,7 @@ private def checkAltNames (alts : Array Alt) (altsSyntax : Array Syntax) : Tacti
if unhandledAlts.isEmpty then
m!"invalid alternative name '{altName}', no unhandled alternatives"
else
let unhandledAltsMessages := unhandledAlts.map (m!"'{·.name}'")
let unhandledAltsMessages := unhandledAlts.map (m!"{·.name}")
let unhandledAlts := MessageData.orList unhandledAltsMessages.toList
m!"invalid alternative name '{altName}', expected {unhandledAlts}"
throwErrorAt altStx msg

View File

@@ -48,7 +48,7 @@ def exact? (ref : Syntax) (required : Option (Array (TSyntax `term))) (requireCl
addExactSuggestion ref ( instantiateMVars (mkMVar mvar)).headBeta
(checkState? := initialState) (addSubgoalsMsg := true) (tacticErrorAsInfo := true)
if suggestions.isEmpty then logError "apply? didn't find any relevant lemmas"
admitGoal goal (synthetic := false)
admitGoal goal
@[builtin_tactic Lean.Parser.Tactic.exact?]
def evalExact : Tactic := fun stx => do

View File

@@ -11,7 +11,6 @@ import Init.System.Promise
import Lean.ImportingFlag
import Lean.Data.NameTrie
import Lean.Data.SMap
import Lean.Setup
import Lean.Declaration
import Lean.LocalContext
import Lean.Util.Path
@@ -94,6 +93,18 @@ instance : GetElem? (Array α) ModuleIdx α (fun a i => i.toNat < a.size) where
abbrev ConstMap := SMap Name ConstantInfo
structure Import where
module : Name
/-- `import all`; whether to import and expose all data saved by the module. -/
importAll : Bool := false
/-- Whether to activate this import when the current module itself is imported. -/
isExported : Bool := true
deriving Repr, Inhabited
instance : Coe Name Import := ({module := ·})
instance : ToString Import := fun imp => toString imp.module
/--
A compacted region holds multiple Lean objects in a contiguous memory region, which can be read/written to/from disk.
Objects inside the region do not have reference counters and cannot be freed individually. The contents of .olean
@@ -1652,14 +1663,10 @@ def mkModuleData (env : Environment) (level : OLeanLevel := .private) : IO Modul
let kenv := env.toKernelEnv
let env := env.setExporting (level != .private)
let constNames := kenv.constants.foldStage2 (fun names name _ => names.push name) #[]
-- not all kernel constants may be exported at `level < .private`
let constants := if level == .private then
-- (this branch makes very sure all kernel constants are exported eventually)
kenv.constants.foldStage2 (fun cs _ c => cs.push c) #[]
else
constNames.filterMap fun n =>
env.find? n <|>
guard (looksLikeOldCodegenName n) *> kenv.find? n
-- not all kernel constants may be exported
let constants := constNames.filterMap fun n =>
env.find? n <|>
guard (looksLikeOldCodegenName n) *> kenv.find? n
let constNames := constants.map (·.name)
return { env.header with
extraConstNames := env.checked.get.extraConstNames.toArray
@@ -1787,35 +1794,7 @@ abbrev ImportStateM := StateRefT ImportState IO
@[inline] nonrec def ImportStateM.run (x : ImportStateM α) (s : ImportState := {}) : IO (α × ImportState) :=
x.run s
def ModuleArtifacts.oleanParts (arts : ModuleArtifacts) : Array System.FilePath := Id.run do
let mut fnames := #[]
-- Opportunistically load all available parts.
-- Producer (e.g., Lake) should limit parts to the proper import level.
if let some mFile := arts.olean? then
fnames := fnames.push mFile
if let some sFile := arts.oleanServer? then
fnames := fnames.push sFile
if let some pFile := arts.oleanPrivate? then
fnames := fnames.push pFile
return fnames
private def findOLeanParts (mod : Name) : IO (Array System.FilePath) := do
let mFile findOLean mod
unless ( mFile.pathExists) do
throw <| IO.userError s!"object file '{mFile}' of module {mod} does not exist"
let mut fnames := #[mFile]
-- Opportunistically load all available parts.
-- Necessary because the import level may be upgraded a later import.
let sFile := OLeanLevel.server.adjustFileName mFile
if ( sFile.pathExists) then
fnames := fnames.push sFile
let pFile := OLeanLevel.private.adjustFileName mFile
if ( pFile.pathExists) then
fnames := fnames.push pFile
return fnames
partial def importModulesCore
(imports : Array Import) (forceImportAll := true) (arts : NameMap ModuleArtifacts := {}) :
partial def importModulesCore (imports : Array Import) (forceImportAll := true) :
ImportStateM Unit := go
where go := do
for i in imports do
@@ -1832,14 +1811,19 @@ where go := do
if let some mod := mod.mainModule? then
importModulesCore (forceImportAll := true) mod.imports
continue
let fnames
if let some arts := arts.find? i.module then
let fnames := arts.oleanParts
if fnames.isEmpty then
findOLeanParts i.module
else pure fnames
else
findOLeanParts i.module
let mFile findOLean i.module
unless ( mFile.pathExists) do
throw <| IO.userError s!"object file '{mFile}' of module {i.module} does not exist"
let mut fnames := #[mFile]
-- opportunistically load all available parts in case `importPrivate` is upgraded by a later
-- import
-- TODO: use Lake data to retrieve ultimate import level immediately
let sFile := OLeanLevel.server.adjustFileName mFile
if ( sFile.pathExists) then
fnames := fnames.push sFile
let pFile := OLeanLevel.private.adjustFileName mFile
if ( pFile.pathExists) then
fnames := fnames.push pFile
let parts readModuleDataParts fnames
-- `imports` is identical for each part
let some (baseMod, _) := parts[0]? | unreachable!
@@ -2011,14 +1995,13 @@ as if no `module` annotations were present in the imports.
-/
def importModules (imports : Array Import) (opts : Options) (trustLevel : UInt32 := 0)
(plugins : Array System.FilePath := #[]) (leakEnv := false) (loadExts := false)
(level := OLeanLevel.private) (arts : NameMap ModuleArtifacts := {})
: IO Environment := profileitIO "import" opts do
(level := OLeanLevel.private) : IO Environment := profileitIO "import" opts do
for imp in imports do
if imp.module matches .anonymous then
throw <| IO.userError "import failed, trying to import module with anonymous name"
withImporting do
plugins.forM Lean.loadPlugin
let (_, s) importModulesCore (forceImportAll := level == .private) imports arts |>.run
let (_, s) importModulesCore (forceImportAll := level == .private) imports |>.run
finalizeImport (leakEnv := leakEnv) (loadExts := loadExts) (level := level)
s imports opts trustLevel

View File

@@ -283,16 +283,10 @@ simple uses, these can be computed eagerly without looking at the imports.
structure SetupImportsResult where
/-- Module name of the file being processed. -/
mainModuleName : Name
/-- Whether the file is participating in the module system. -/
isModule : Bool := false
/-- Direct imports of the file being processed. -/
imports : Array Import
/-- Options provided outside of the file content, e.g. on the cmdline or in the lakefile. -/
opts : Options
/-- Kernel trust level. -/
trustLevel : UInt32 := 0
/-- Pre-resolved artifacts of related modules (e.g., this module's transitive imports). -/
modules : NameMap ModuleArtifacts := {}
/-- Lean plugins to load as part of the environment setup. -/
plugins : Array System.FilePath := #[]
@@ -373,7 +367,7 @@ General notes:
the `sync` parameter on `parseCmd` and spawn an elaboration task when we leave it.
-/
partial def process
(setupImports : HeaderSyntax ProcessingT IO (Except HeaderProcessedSnapshot SetupImportsResult))
(setupImports : TSyntax ``Parser.Module.header ProcessingT IO (Except HeaderProcessedSnapshot SetupImportsResult))
(old? : Option InitialSnapshot) : ProcessingM InitialSnapshot := do
parseHeader old? |>.run (old?.map (·.ictx))
where
@@ -459,7 +453,7 @@ where
}
}
processHeader (stx : HeaderSyntax) (parserState : Parser.ModuleParserState) :
processHeader (stx : TSyntax ``Parser.Module.header) (parserState : Parser.ModuleParserState) :
LeanProcessingM (SnapshotTask HeaderProcessedSnapshot) := do
let ctx read
SnapshotTask.ofIO stx none (some 0, ctx.input.endPos) <|
@@ -477,9 +471,9 @@ where
if !stx.raw[0].isNone && !experimental.module.get opts then
throw <| IO.Error.userError "`module` keyword is experimental and not enabled here"
-- allows `headerEnv` to be leaked, which would live until the end of the process anyway
let (headerEnv, msgLog) Elab.processHeaderCore (leakEnv := true)
stx.startPos setup.imports setup.isModule setup.opts .empty ctx.toInputContext
setup.trustLevel setup.plugins setup.mainModuleName setup.modules
let (headerEnv, msgLog) Elab.processHeader (leakEnv := true)
(mainModule := setup.mainModuleName) stx opts .empty ctx.toInputContext setup.trustLevel
setup.plugins
let stopTime := ( IO.monoNanosNow).toFloat / 1000000000
let diagnostics := ( Snapshot.Diagnostics.ofMessageLog msgLog)
if msgLog.hasErrors then

View File

@@ -107,12 +107,11 @@ Lazy message data production, with access to the context as given by
a surrounding `MessageData.withContext` (which is expected to exist).
-/
def lazy (f : PPContext BaseIO MessageData)
(hasSyntheticSorry : MetavarContext Bool := fun _ => false)
(onMissingContext : Unit BaseIO MessageData :=
fun _ => pure (.ofFormat "(invalid MessageData.lazy, missing context)")) : MessageData :=
(hasSyntheticSorry : MetavarContext Bool := fun _ => false) : MessageData :=
.ofLazy (hasSyntheticSorry := hasSyntheticSorry) fun ctx? => do
let msg match ctx? with
| .none => onMissingContext ()
| .none =>
pure (.ofFormat "(invalid MessageData.lazy, missing context)") -- see `addMessageContext`
| .some ctx => f ctx
return Dynamic.mk msg
@@ -147,13 +146,6 @@ def kind : MessageData → Name
| tagged n _ => n
| _ => .anonymous
def isTrace : MessageData Bool
| withContext _ msg => msg.isTrace
| withNamingContext _ msg => msg.isTrace
| tagged _ msg => msg.isTrace
| .trace _ _ _ => true
| _ => false
/-- An empty message. -/
def nil : MessageData :=
ofFormat Format.nil
@@ -321,45 +313,22 @@ def ofList : List MessageData → MessageData
def ofArray (msgs : Array MessageData) : MessageData :=
ofList msgs.toList
/--
Puts `MessageData` into a comma-separated list with `"or"` at the back (with the serial comma).
Best used on non-empty lists; returns `" none "` for an empty list.
-/
/-- Puts `MessageData` into a comma-separated list with `"or"` at the back (no Oxford comma).
Best used on non-empty lists; returns `" none "` for an empty list. -/
def orList (xs : List MessageData) : MessageData :=
match xs with
| [] => " none "
| [x] => x
| [x₀, x] => x₀ ++ " or " ++ x
| _ => joinSep xs.dropLast ", " ++ ", or " ++ xs.getLast!
| [x] => "'" ++ x ++ "'"
| _ => joinSep (xs.dropLast.map (fun x => "'" ++ x ++ "'")) ", " ++ " or '" ++ xs.getLast! ++ "'"
/--
Puts `MessageData` into a comma-separated list with `"and"` at the back (with the serial comma).
Best used on non-empty lists; returns `" none "` for an empty list.
-/
/-- Puts `MessageData` into a comma-separated list with `"and"` at the back (no Oxford comma).
Best used on non-empty lists; returns `" none "` for an empty list. -/
def andList (xs : List MessageData) : MessageData :=
match xs with
| [] => " none "
| [x] => x
| [x₀, x₁] => x₀ ++ " and " ++ x
| _ => joinSep xs.dropLast ", " ++ ", and " ++ xs.getLast!
| _ => joinSep xs.dropLast ", " ++ " and " ++ xs.getLast!
/--
Produces a labeled note that can be appended to an error message.
-/
def note (note : MessageData) : MessageData :=
-- Note: we do not use the built-in string coercion because it can prevent proper line breaks
.tagged `note <| .compose (.ofFormat .line) <| .compose (.ofFormat .line) <|
.compose "Note: " note
/--
Produces a labeled hint without an associated code action (non-monadic variant of
`MessageData.hint`).
-/
def hint' (hint : MessageData) : MessageData :=
.tagged `hint <| .compose (.ofFormat .line) <| .compose (.ofFormat .line) <|
.compose "Hint: " hint
instance : Coe (List MessageData) MessageData := ofList
instance : Coe (List Expr) MessageData := fun es => ofList <| es.map ofExpr
@@ -431,9 +400,6 @@ namespace Message
@[inherit_doc MessageData.kind] abbrev kind (msg : Message) :=
msg.data.kind
def isTrace (msg : Message) : Bool :=
msg.data.isTrace
/-- Serializes the message, converting its data into a string and saving its kind. -/
@[inline] def serialize (msg : Message) : BaseIO SerialMessage := do
return {msg with kind := msg.kind, data := msg.data.toString}
@@ -539,38 +505,6 @@ def indentD (msg : MessageData) : MessageData :=
def indentExpr (e : Expr) : MessageData :=
indentD e
/--
Returns the character length of the message when rendered.
Note: this is a potentially expensive operation that is only relevant to message data that are
actually rendered. Consider using this function in lazy message data to avoid unnecessary
computation for messages that are not displayed.
-/
private def MessageData.formatLength (ctx : PPContext) (msg : MessageData) : BaseIO Nat := do
let { env, mctx, lctx, opts, ..} := ctx
let fmt msg.format (some { env, mctx, lctx, opts })
return fmt.pretty.length
/--
Renders an expression `e` inline in a message unless it will exceed `maxInlineLength` characters, in
which case the expression is indented on a new line.
Note that the output of this function is formatted with preceding and trailing space included. Thus,
in `m₁ ++ inlineExpr e ++ m₂`, `m₁` should not end with a space or new line, nor should `m₂` begin
with one.
-/
def inlineExpr (e : Expr) (maxInlineLength := 30) : MessageData :=
.lazy
(fun ctx => do
let msg := MessageData.ofExpr e
if ( msg.formatLength ctx) > maxInlineLength then
return indentD msg ++ "\n"
else
return " " ++ msg ++ " ")
(fun mctx => instantiateMVarsCore mctx e |>.1.hasSyntheticSorry)
(fun () => return " " ++ MessageData.ofExpr e ++ " ")
/-- Atom quotes -/
def aquote (msg : MessageData) : MessageData :=
"" ++ msg ++ ""
@@ -673,9 +607,4 @@ def toMessageData (e : Kernel.Exception) (opts : Options) : MessageData :=
| interrupted => "(kernel) interrupted"
end Kernel.Exception
/-- Helper functions for creating a `MessageData` with the given header and elements. -/
def toTraceElem [ToMessageData α] (e : α) (cls : Name := Name.mkSimple "_") : MessageData :=
.trace { cls } (toMessageData e) #[]
end Lean

View File

@@ -52,5 +52,3 @@ import Lean.Meta.CheckTactic
import Lean.Meta.Canonicalizer
import Lean.Meta.Diagnostics
import Lean.Meta.BinderNameHint
import Lean.Meta.TryThis
import Lean.Meta.Hint

View File

@@ -15,8 +15,7 @@ structure State where
mctx : MetavarContext
nextParamIdx : Nat := 0
paramNames : Array Name := #[]
fvars : Array Expr := #[]
mvars : Array Expr := #[]
fvars : Array Expr := #[]
lmap : Std.HashMap LMVarId Level := {}
emap : Std.HashMap MVarId Expr := {}
abstractLevels : Bool -- whether to abstract level mvars
@@ -101,9 +100,8 @@ partial def abstractExprMVars (e : Expr) : M Expr := do
pure decl.userName
modify fun s => {
s with
emap := s.emap.insert mvarId fvar
fvars := s.fvars.push fvar
mvars := s.mvars.push e
emap := s.emap.insert mvarId fvar,
fvars := s.fvars.push fvar,
lctx := s.lctx.mkLocalDecl fvarId userName type }
return fvar
@@ -113,7 +111,7 @@ end AbstractMVars
Abstract (current depth) metavariables occurring in `e`.
The result contains
- An array of universe level parameters that replaced universe metavariables occurring in `e`.
- The metavariables that have been abstracted.
- The number of (expr) metavariables abstracted.
- And an expression of the form `fun (m_1 : A_1) ... (m_k : A_k) => e'`, where
`k` equal to the number of (expr) metavariables abstracted, and `e'` is `e` after we
replace the metavariables.
@@ -128,10 +126,7 @@ end AbstractMVars
If `levels := false`, then level metavariables are not abstracted.
Application: we use this method to cache the results of type class resolution.
Application: tactic `MVarId.abstractMVars`
-/
Application: we use this method to cache the results of type class resolution. -/
def abstractMVars (e : Expr) (levels : Bool := true): MetaM AbstractMVarsResult := do
let e instantiateMVars e
let (e, s) := AbstractMVars.abstractExprMVars e
@@ -139,7 +134,7 @@ def abstractMVars (e : Expr) (levels : Bool := true): MetaM AbstractMVarsResult
setNGen s.ngen
setMCtx s.mctx
let e := s.lctx.mkLambda s.fvars e
pure { paramNames := s.paramNames, mvars := s.mvars, expr := e }
pure { paramNames := s.paramNames, numMVars := s.fvars.size, expr := e }
def openAbstractMVarsResult (a : AbstractMVarsResult) : MetaM (Array Expr × Array BinderInfo × Expr) := do
let us a.paramNames.mapM fun _ => mkFreshLevelMVar

View File

@@ -317,13 +317,10 @@ structure SynthInstanceCacheKey where
/-- Resulting type for `abstractMVars` -/
structure AbstractMVarsResult where
paramNames : Array Name
mvars : Array Expr
numMVars : Nat
expr : Expr
deriving Inhabited, BEq
def AbstractMVarsResult.numMVars (r : AbstractMVarsResult) : Nat :=
r.mvars.size
abbrev SynthInstanceCache := PersistentHashMap SynthInstanceCacheKey (Option AbstractMVarsResult)
-- Key for `InferType` and `WHNF` caches

View File

@@ -84,17 +84,6 @@ where
| _, .mdata _ b' =>
let (a, b') visit a b'
return (a, b.updateMData! b')
| .const nm _, .const nm' _ =>
if nm != nm' then
return (a, b)
else
return (a.setPPUniverses true, b.setPPUniverses true)
| .proj _ i a', .proj _ j b' =>
if i != j then
return (a, b)
else
let (a', b') visit a' b'
return (a.updateProj! a', b.updateProj! b')
| .app .., .app .. =>
if a.getAppNumArgs != b.getAppNumArgs then
return (a, b)
@@ -209,7 +198,7 @@ def throwAppTypeMismatch (f a : Expr) : MetaM α := do
unless binfo.isExplicit do
e := e.setAppPPExplicit
let aType inferType a
throwError "Application type mismatch: In the application{indentExpr e}\nthe final argument{indentExpr a}\n{← mkHasTypeButIsExpectedMsg aType expectedType}"
throwError "application type mismatch{indentExpr e}\nargument{indentExpr a}\n{← mkHasTypeButIsExpectedMsg aType expectedType}"
def checkApp (f a : Expr) : MetaM Unit := do
let fType inferType f

View File

@@ -1,180 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Rotella
-/
prelude
import Lean.CoreM
import Lean.Data.Lsp.Utf16
import Lean.Message
import Lean.Meta.TryThis
import Lean.Util.Diff
import Lean.Widget.Types
import Lean.PrettyPrinter
namespace Lean.Meta.Hint
open Elab Tactic PrettyPrinter TryThis
/--
A widget for rendering code action suggestions in error messages. Generally, this widget should not
be used directly; instead, use `MessageData.hint`. Note that this widget is intended only for use
within message data; it may not display line breaks properly if rendered as a panel widget.
The props to this widget are of the following form:
```json
{
"diff": [
{"type": "unchanged", "text": "h"},
{"type": "deletion", "text": "ello"},
{"type": "insertion", "text": "i"}
]
}
```
Note: we cannot add the `builtin_widget_module` attribute here because that would require importing
`Lean.Widget.UserWidget`, which in turn imports much of `Lean.Elab` -- the module where we want to
be able to use this widget. Instead, we register the attribute post-hoc when we declare the regular
"Try This" widget in `Lean.Meta.Tactic.TryThis`.
-/
def tryThisDiffWidget : Widget.Module where
javascript := "
import * as React from 'react';
import { EditorContext, EnvPosContext } from '@leanprover/infoview';
const e = React.createElement;
export default function ({ diff, range, suggestion }) {
const pos = React.useContext(EnvPosContext)
const editorConnection = React.useContext(EditorContext)
const insStyle = { className: 'information' }
const delStyle = {
style: { color: 'var(--vscode-errorForeground)', textDecoration: 'line-through' }
}
const defStyle = {
style: { color: 'var(--vscode-textLink-foreground)' }
}
function onClick() {
editorConnection.api.applyEdit({
changes: { [pos.uri]: [{ range, newText: suggestion }] }
})
}
const spans = diff.map (comp =>
comp.type === 'deletion' ? e('span', delStyle, comp.text) :
comp.type === 'insertion' ? e('span', insStyle, comp.text) :
e('span', defStyle, comp.text)
)
const fullDiff = e('span',
{ onClick, title: 'Apply suggestion', className: 'link pointer dim font-code', },
spans)
return fullDiff
}"
/--
Converts an array of diff actions into corresponding JSON interpretable by `tryThisDiffWidget`.
-/
private def mkDiffJson (ds : Array (Diff.Action × Char)) :=
-- Avoid cluttering the DOM by grouping "runs" of the same action
let unified : List (Diff.Action × List Char) := ds.foldr (init := []) fun
| (act, c), [] => [(act, [c])]
| (act, c), (act', cs) :: acc =>
if act == act' then
(act, c :: cs) :: acc
else
(act, [c]) :: (act', cs) :: acc
toJson <| unified.map fun
| (.insert, s) => json% { type: "insertion", text: $(String.mk s) }
| (.delete, s) => json% { type: "deletion", text: $(String.mk s) }
| (.skip , s) => json% { type: "unchanged", text: $(String.mk s) }
/--
Converts an array of diff actions into a Unicode string that visually depicts the diff.
Note that this function does not return the string that results from applying the diff to some
input; rather, it returns a string representation of the actions that the diff itself comprises, such as `b̵a̵c̲h̲e̲e̲rs̲`.
-/
private def mkDiffString (ds : Array (Diff.Action × Char)) : String :=
let rangeStrs := ds.map fun
| (.insert, s) => String.mk [s, '\u0332'] -- U+0332 Combining Low Line
| (.delete, s) => String.mk [s, '\u0335'] -- U+0335 Combining Short Stroke Overlay
| (.skip , s) => String.mk [s]
rangeStrs.foldl (· ++ ·) ""
/--
A code action suggestion associated with a hint in a message.
Refer to `TryThis.Suggestion`; this extends that structure with a `span?` field, allowing a single
hint to suggest modifications at different locations. If `span?` is not specified, then the `ref`
for the containing `Suggestions` value is used.
-/
structure Suggestion extends TryThis.Suggestion where
span? : Option Syntax := none
instance : Coe TryThis.SuggestionText Suggestion where
coe t := { suggestion := t }
instance : ToMessageData Suggestion where
toMessageData s := toMessageData s.toSuggestion
/--
A collection of code action suggestions to be included in a hint in a diagnostic message.
Contains the following fields:
* `ref`: the syntax location for the code action suggestions. Will be overridden by the `span?`
field on any suggestions that specify it.
* `suggestions`: the suggestions to display.
* `codeActionPrefix?`: if specified, text to display in place of "Try this: " in the code action
label
-/
structure Suggestions where
ref : Syntax
suggestions : Array Suggestion
codeActionPrefix? : Option String := none
/--
Creates message data corresponding to a `HintSuggestions` collection and adds the corresponding info
leaf.
-/
def Suggestions.toHintMessage (suggestions : Suggestions) : CoreM MessageData := do
let { ref, codeActionPrefix?, suggestions } := suggestions
let mut msg := m!""
for suggestion in suggestions do
if let some range := (suggestion.span?.getD ref).getRange? then
let { info, suggestions := suggestionArr, range := lspRange } processSuggestions ref range
#[suggestion.toSuggestion] codeActionPrefix?
pushInfoLeaf info
let suggestionText := suggestionArr[0]!.2.1
let map getFileMap
let rangeContents := Substring.mk map.source range.start range.stop |>.toString
let split (s : String) := s.toList.toArray
let edits := Diff.diff (split rangeContents) (split suggestionText)
let diff := mkDiffJson edits
let json := json% {
diff: $diff,
suggestion: $suggestionText,
range: $lspRange
}
let preInfo := suggestion.preInfo?.getD ""
let postInfo := suggestion.postInfo?.getD ""
let widget := MessageData.ofWidget {
id := ``tryThisDiffWidget
javascriptHash := tryThisDiffWidget.javascriptHash
props := return json
} (suggestion.messageData?.getD (mkDiffString edits))
let widgetMsg := m!"{preInfo}{widget}{postInfo}"
let suggestionMsg := if suggestions.size == 1 then m!"\n{widgetMsg}" else m!"\n• {widgetMsg}"
msg := msg ++ MessageData.nestD suggestionMsg
return msg
/--
Appends a hint `hint` to `msg`. If `suggestions?` is non-`none`, will also append an inline
suggestion widget.
-/
def _root_.Lean.MessageData.hint (hint : MessageData) (suggestions? : Option Suggestions := none)
: CoreM MessageData := do
let mut hintMsg := m!"\n\nHint: {hint}"
if let some suggestions := suggestions? then
hintMsg := hintMsg ++ ( suggestions.toHintMessage)
return .tagged `hint hintMsg

View File

@@ -98,68 +98,9 @@ def unfoldNamedPattern (e : Expr) : MetaM Expr := do
1. Eliminates arguments for named parameters and the associated equation proofs.
2. Instantiate the `Unit` parameter of an otherwise argumentless alternative.
It does not handle the equality parameters associated with the `h : discr` notation.
The continuation `k` takes four arguments `ys args mask type`.
- `ys` are variables for the hypotheses that have not been eliminated.
- `args` are the arguments for the alternative `alt` that has type `altType`. `ys.size <= args.size`
- `mask[i]` is true if the hypotheses has not been eliminated. `mask.size == args.size`.
- `type` is the resulting type for `altType`.
We use the `mask` to build the splitter proof. See `mkSplitterProof`.
This can be used to use the alternative of a match expression in its splitter.
-/
partial def forallAltVarsTelescope (altType : Expr) (altNumParams numDiscrEqs : Nat)
(k : (patVars : Array Expr) (args : Array Expr) (mask : Array Bool) (type : Expr) MetaM α) : MetaM α := do
go #[] #[] #[] 0 altType
where
go (ys : Array Expr) (args : Array Expr) (mask : Array Bool) (i : Nat) (type : Expr) : MetaM α := do
let type whnfForall type
if i < altNumParams - numDiscrEqs then
let Expr.forallE n d b .. := type
| throwError "expecting {altNumParams} parameters, excluding {numDiscrEqs} equalities, but found type{indentExpr altType}"
-- Handle the special case of `Unit` parameters.
if i = 0 && altNumParams - numDiscrEqs = 1 && d.isConstOf ``Unit && !b.hasLooseBVars then
return k #[] #[mkConst ``Unit.unit] #[false] b
let d Match.unfoldNamedPattern d
withLocalDeclD n d fun y => do
let typeNew := b.instantiate1 y
if let some (_, lhs, rhs) matchEq? d then
if lhs.isFVar && ys.contains lhs && args.contains lhs && isNamedPatternProof typeNew y then
let some j := ys.finIdxOf? lhs | unreachable!
let ys := ys.eraseIdx j
let some k := args.idxOf? lhs | unreachable!
let mask := mask.set! k false
let args := args.map fun arg => if arg == lhs then rhs else arg
let arg mkEqRefl rhs
let typeNew := typeNew.replaceFVar lhs rhs
return withReplaceFVarId lhs.fvarId! rhs do
withReplaceFVarId y.fvarId! arg do
go ys (args.push arg) (mask.push false) (i+1) typeNew
go (ys.push y) (args.push y) (mask.push true) (i+1) typeNew
else
let type Match.unfoldNamedPattern type
k ys args mask type
isNamedPatternProof (type : Expr) (h : Expr) : Bool :=
Option.isSome <| type.find? fun e =>
if let some e := Match.isNamedPattern? e then
e.appArg! == h
else
false
/--
Extension of `forallAltTelescope` that continues further:
Equality parameters associated with the `h : discr` notation are replaced with `rfl` proofs.
Recall that this kind of parameter always occurs after the parameters corresponding to pattern
variables.
2. Equality parameters associated with the `h : discr` notation are replaced with `rfl` proofs.
Recall that this kind of parameter always occurs after the parameters correspoting to pattern variables.
`numNonEqParams` is the size of the prefix.
The continuation `k` takes four arguments `ys args mask type`.
- `ys` are variables for the hypotheses that have not been eliminated.
@@ -175,45 +116,57 @@ where
partial def forallAltTelescope (altType : Expr) (altNumParams numDiscrEqs : Nat)
(k : (ys : Array Expr) (eqs : Array Expr) (args : Array Expr) (mask : Array Bool) (type : Expr) MetaM α)
: MetaM α := do
forallAltVarsTelescope altType altNumParams numDiscrEqs fun ys args mask altType => do
go ys #[] args mask 0 altType
go #[] #[] #[] #[] 0 altType
where
go (ys : Array Expr) (eqs : Array Expr) (args : Array Expr) (mask : Array Bool) (i : Nat) (type : Expr) : MetaM α := do
let type whnfForall type
if i < numDiscrEqs then
if i < altNumParams then
let Expr.forallE n d b .. := type
| throwError "expecting {altNumParams} parameters, including {numDiscrEqs} equalities, but found type{indentExpr altType}"
let arg if let some (_, _, rhs) matchEq? d then
mkEqRefl rhs
else if let some (_, _, _, rhs) matchHEq? d then
mkHEqRefl rhs
if i < altNumParams - numDiscrEqs then
let d unfoldNamedPattern d
withLocalDeclD n d fun y => do
let typeNew := b.instantiate1 y
if let some (_, lhs, rhs) matchEq? d then
if lhs.isFVar && ys.contains lhs && args.contains lhs && isNamedPatternProof typeNew y then
let some j := ys.finIdxOf? lhs | unreachable!
let ys := ys.eraseIdx j
let some k := args.idxOf? lhs | unreachable!
let mask := mask.set! k false
let args := args.map fun arg => if arg == lhs then rhs else arg
let arg mkEqRefl rhs
let typeNew := typeNew.replaceFVar lhs rhs
return withReplaceFVarId lhs.fvarId! rhs do
withReplaceFVarId y.fvarId! arg do
go ys eqs (args.push arg) (mask.push false) (i+1) typeNew
go (ys.push y) eqs (args.push y) (mask.push true) (i+1) typeNew
else
throwError "unexpected match alternative type{indentExpr altType}"
withLocalDeclD n d fun eq => do
let typeNew := b.instantiate1 eq
go ys (eqs.push eq) (args.push arg) (mask.push false) (i+1) typeNew
let arg if let some (_, _, rhs) matchEq? d then
mkEqRefl rhs
else if let some (_, _, _, rhs) matchHEq? d then
mkHEqRefl rhs
else
throwError "unexpected match alternative type{indentExpr altType}"
withLocalDeclD n d fun eq => do
let typeNew := b.instantiate1 eq
go ys (eqs.push eq) (args.push arg) (mask.push false) (i+1) typeNew
else
let type unfoldNamedPattern type
/- Recall that alternatives that do not have variables have a `Unit` parameter to ensure
they are not eagerly evaluated. -/
if ys.size == 1 then
if ( inferType ys[0]!).isConstOf ``Unit && !( dependsOn type ys[0]!.fvarId!) then
let rhs := mkConst ``Unit.unit
return withReplaceFVarId ys[0]!.fvarId! rhs do
return ( k #[] #[] #[rhs] #[false] type)
k ys eqs args mask type
/--
Given an application of an matcher arm `alt` that is expecting the `numDiscrEqs`, and
an array of `discr = pattern` equalities (one for each discriminant), apply those that
are expected by the alternative.
-/
partial def mkAppDiscrEqs (alt : Expr) (heqs : Array Expr) (numDiscrEqs : Nat) : MetaM Expr := do
go alt ( inferType alt) 0
where
go e ty i := do
if i < numDiscrEqs then
let Expr.forallE n d b .. := ty
| throwError "expecting {numDiscrEqs} equalities, but found type{indentExpr alt}"
for heq in heqs do
if ( isDefEq ( inferType heq) d) then
return go (mkApp e heq) (b.instantiate1 heq) (i+1)
throwError "Could not find equation {n} : {d} among {heqs}"
else
return e
isNamedPatternProof (type : Expr) (h : Expr) : Bool :=
Option.isSome <| type.find? fun e =>
if let some e := isNamedPattern? e then
e.appArg! == h
else
false
namespace SimpH
@@ -375,33 +328,21 @@ private def unfoldElimOffset (mvarId : MVarId) : MetaM MVarId := do
mvarId.deltaTarget (· == ``Nat.elimOffset)
/--
Helper method for proving a conditional equational theorem associated with an alternative of
the `match`-eliminator `matchDeclName`. `type` contains the type of the theorem.
The `heqPos`/`heqNum` arguments indicate that these hypotheses are `Eq`/`HEq` hypotheses
to substitute first; this is used for the generalized match equations.
-/
partial def proveCondEqThm (matchDeclName : Name) (type : Expr)
(heqPos : Nat := 0) (heqNum : Nat := 0) : MetaM Expr := withLCtx {} {} do
Helper method for proving a conditional equational theorem associated with an alternative of
the `match`-eliminator `matchDeclName`. `type` contains the type of the theorem. -/
partial def proveCondEqThm (matchDeclName : Name) (type : Expr) : MetaM Expr := withLCtx {} {} do
let type instantiateMVars type
let mvar0 mkFreshExprSyntheticOpaqueMVar type
trace[Meta.Match.matchEqs] "proveCondEqThm {mvar0.mvarId!}"
let mut mvarId := mvar0.mvarId!
if heqNum > 0 then
mvarId := ( mvarId.introN heqPos).2
for _ in [:heqNum] do
let (h, mvarId') mvarId.intro1
mvarId subst mvarId' h
trace[Meta.Match.matchEqs] "proveCondEqThm after subst{mvarId}"
mvarId := ( mvarId.intros).2
mvarId mvarId.deltaTarget (· == matchDeclName)
mvarId mvarId.heqOfEq
go mvarId 0
instantiateMVars mvar0
forallTelescope type fun ys target => do
let mvar0 mkFreshExprSyntheticOpaqueMVar target
trace[Meta.Match.matchEqs] "proveCondEqThm {mvar0.mvarId!}"
let mvarId mvar0.mvarId!.deltaTarget (· == matchDeclName)
withDefault <| go mvarId 0
mkLambdaFVars ys ( instantiateMVars mvar0)
where
go (mvarId : MVarId) (depth : Nat) : MetaM Unit := withIncRecDepth do
trace[Meta.Match.matchEqs] "proveCondEqThm.go {mvarId}"
let mvarId mvarId.modifyTargetEqLHS whnfCore
let mvarId' mvarId.modifyTargetEqLHS whnfCore
let mvarId := mvarId'
let subgoals
(do mvarId.refl; return #[])
<|>
@@ -775,7 +716,6 @@ where go baseName splitterName := withConfig (fun c => { c with etaStruct := .no
hs := hs.push h
trace[Meta.Match.matchEqs] "hs: {hs}"
let splitterAltType mkForallFVars ys ( hs.foldrM (init := ( mkForallFVars eqs altResultType)) (mkArrow · ·))
let splitterAltType unfoldNamedPattern splitterAltType
let splitterAltNumParam := hs.size + ys.size
-- Create a proposition for representing terms that do not match `patterns`
let mut notAlt := mkConst ``False
@@ -827,121 +767,21 @@ where go baseName splitterName := withConfig (fun c => { c with etaStruct := .no
let result := { eqnNames, splitterName, splitterAltNumParams }
registerMatchEqns matchDeclName result
def congrEqnThmSuffixBase := "congr_eq"
def congrEqnThmSuffixBasePrefix := congrEqnThmSuffixBase ++ "_"
def congrEqn1ThmSuffix := congrEqnThmSuffixBasePrefix ++ "1"
example : congrEqn1ThmSuffix = "congr_eq_1" := rfl
/-- Returns `true` if `s` is of the form `congr_eq_<idx>` -/
def iscongrEqnReservedNameSuffix (s : String) : Bool :=
congrEqnThmSuffixBasePrefix.isPrefixOf s && (s.drop congrEqnThmSuffixBasePrefix.length).isNat
/- We generate the equations and splitter on demand, and do not save them on .olean files. -/
builtin_initialize matchCongrEqnsExt : EnvExtension (PHashMap Name (Array Name))
-- Using `local` allows us to use the extension in `realizeConst` without specifying `replay?`.
-- The resulting state can still be accessed on the generated declarations using `findStateAsync`;
-- see below
registerEnvExtension (pure {}) (asyncMode := .local)
def registerMatchcongrEqns (matchDeclName : Name) (eqnNames : Array Name) : CoreM Unit := do
modifyEnv fun env => matchCongrEqnsExt.modifyState env fun map =>
map.insert matchDeclName eqnNames
/--
Generate the congruence equations for the given match auxiliary declaration.
The congruence equations have a completely unrestriced left-hand side (arbitrary discriminants),
and take propositional equations relating the discriminants to the patterns as arguments. In this
sense they combine a congruence lemma with the regular equation lemma.
Since the motive depends on the discriminants, they are `HEq` equations.
The code duplicates a fair bit of the logic above, and has to repeat the calculation of the
`notAlts`. One could avoid that and generate the generalized equations eagerly above, but they are
not always needed, so for now we live with the code duplication.
-/
def genMatchCongrEqns (matchDeclName : Name) : MetaM (Array Name) := do
let baseName := mkPrivateName ( getEnv) matchDeclName
let firstEqnName := .str baseName congrEqn1ThmSuffix
realizeConst matchDeclName firstEqnName (go baseName)
return matchCongrEqnsExt.findStateAsync ( getEnv) firstEqnName |>.find! matchDeclName
where go baseName := withConfig (fun c => { c with etaStruct := .none }) do
withConfig (fun c => { c with etaStruct := .none }) do
let constInfo getConstInfo matchDeclName
let us := constInfo.levelParams.map mkLevelParam
let some matchInfo getMatcherInfo? matchDeclName | throwError "'{matchDeclName}' is not a matcher function"
let numDiscrEqs := matchInfo.getNumDiscrEqs
forallTelescopeReducing constInfo.type fun xs _matchResultType => do
let mut eqnNames := #[]
let params := xs[:matchInfo.numParams]
let motive := xs[matchInfo.getMotivePos]!
let alts := xs[xs.size - matchInfo.numAlts:]
let firstDiscrIdx := matchInfo.numParams + 1
let discrs := xs[firstDiscrIdx : firstDiscrIdx + matchInfo.numDiscrs]
let mut notAlts := #[]
let mut idx := 1
for i in [:alts.size] do
let altNumParams := matchInfo.altNumParams[i]!
let thmName := (Name.str baseName congrEqnThmSuffixBase).appendIndexAfter idx
eqnNames := eqnNames.push thmName
let notAlt do
let alt := alts[i]!
Match.forallAltVarsTelescope ( inferType alt) altNumParams numDiscrEqs fun altVars args _mask altResultType => do
let patterns forallTelescope altResultType fun _ t => pure t.getAppArgs
let mut heqsTypes := #[]
assert! patterns.size == discrs.size
for discr in discrs, pattern in patterns do
let heqType mkEqHEq discr pattern
heqsTypes := heqsTypes.push ((`heq).appendIndexAfter (heqsTypes.size + 1), heqType)
withLocalDeclsDND heqsTypes fun heqs => do
let rhs Match.mkAppDiscrEqs (mkAppN alt args) heqs numDiscrEqs
let mut hs := #[]
for notAlt in notAlts do
let h instantiateForall notAlt patterns
if let some h Match.simpH? h patterns.size then
hs := hs.push h
trace[Meta.Match.matchEqs] "hs: {hs}"
let mut notAlt := mkConst ``False
for discr in discrs.toArray.reverse, pattern in patterns.reverse do
notAlt mkArrow ( mkEqHEq discr pattern) notAlt
notAlt mkForallFVars (discrs ++ altVars) notAlt
let lhs := mkAppN (mkConst constInfo.name us) (params ++ #[motive] ++ discrs ++ alts)
let thmType mkHEq lhs rhs
let thmType hs.foldrM (init := thmType) (mkArrow · ·)
let thmType mkForallFVars (params ++ #[motive] ++ discrs ++ alts ++ altVars ++ heqs) thmType
let thmType Match.unfoldNamedPattern thmType
-- Here we prove the theorem from scratch. One could likely also use the (non-generalized)
-- match equation theorem after subst'ing the `heqs`.
let thmVal Match.proveCondEqThm matchDeclName thmType
(heqPos := params.size + 1 + discrs.size + alts.size + altVars.size) (heqNum := heqs.size)
unless ( getEnv).contains thmName do
addDecl <| Declaration.thmDecl {
name := thmName
levelParams := constInfo.levelParams
type := thmType
value := thmVal
}
return notAlt
notAlts := notAlts.push notAlt
idx := idx + 1
registerMatchcongrEqns matchDeclName eqnNames
builtin_initialize registerTraceClass `Meta.Match.matchEqs
private def isMatchEqName? (env : Environment) (n : Name) : Option (Name × Bool) := do
private def isMatchEqName? (env : Environment) (n : Name) : Option Name := do
let .str p s := n | failure
guard <| isEqnReservedNameSuffix s || s == "splitter" || iscongrEqnReservedNameSuffix s
guard <| isEqnReservedNameSuffix s || s == "splitter"
let p privateToUserName? p
guard <| isMatcherCore env p
return (p, iscongrEqnReservedNameSuffix s)
return p
builtin_initialize registerReservedNamePredicate (isMatchEqName? · · |>.isSome)
builtin_initialize registerReservedNameAction fun name => do
let some (p, isGenEq) := isMatchEqName? ( getEnv) name |
let some p := isMatchEqName? ( getEnv) name |
return false
if isGenEq then
let _ MetaM.run' <| genMatchCongrEqns p
else
let _ MetaM.run' <| getEquationsFor p
let _ MetaM.run' <| getEquationsFor p
return true
end Lean.Meta.Match

View File

@@ -190,8 +190,8 @@ private def forallAltTelescope'
{α} (origAltType : Expr) (numParams numDiscrEqs : Nat)
(k : Array Expr Array Expr n α) : n α := do
map2MetaM (fun k =>
Match.forallAltVarsTelescope origAltType numParams numDiscrEqs
fun ys args _mask _bodyType => k ys args
Match.forallAltTelescope origAltType (numParams - numDiscrEqs) 0
fun ys _eqs args _mask _bodyType => k ys args
) k
/--
@@ -222,7 +222,7 @@ def transform
(addEqualities : Bool := false)
(onParams : Expr n Expr := pure)
(onMotive : Array Expr Expr n Expr := fun _ e => pure e)
(onAlt : Nat Expr Expr n Expr := fun _ _ e => pure e)
(onAlt : Expr Expr n Expr := fun _ e => pure e)
(onRemaining : Array Expr n (Array Expr) := pure) :
n MatcherApp := do
@@ -282,8 +282,8 @@ def transform
let aux1 := mkApp aux1 motive'
let aux1 := mkAppN aux1 discrs'
unless ( isTypeCorrect aux1) do
mapError (f := (m!"failed to transform matcher, type error when constructing new pre-splitter motive:{indentExpr aux1}\n{indentD ·}")) do
check aux1
logError m!"failed to transform matcher, type error when constructing new pre-splitter motive:{indentExpr aux1}"
check aux1
let origAltTypes inferArgumentTypesN matcherApp.alts.size aux1
-- We replace the matcher with the splitter
@@ -294,13 +294,12 @@ def transform
let aux2 := mkApp aux2 motive'
let aux2 := mkAppN aux2 discrs'
unless ( isTypeCorrect aux2) do
mapError (f := (m!"failed to transform matcher, type error when constructing splitter motive:{indentExpr aux2}\n{indentD ·}")) do
check aux2
logError m!"failed to transform matcher, type error when constructing splitter motive:{indentExpr aux2}"
check aux2
let altTypes inferArgumentTypesN matcherApp.alts.size aux2
let mut alts' := #[]
for altIdx in [:matcherApp.alts.size],
alt in matcherApp.alts,
for alt in matcherApp.alts,
numParams in matcherApp.altNumParams,
splitterNumParams in matchEqns.splitterAltNumParams,
origAltType in origAltTypes,
@@ -314,7 +313,7 @@ def transform
forallBoundedTelescope altType extraEqualities fun ys4 altType => do
let alt try instantiateLambda alt (args ++ ys3)
catch _ => throwError "unexpected matcher application, insufficient number of parameters in alternative"
let alt' onAlt altIdx altType alt
let alt' onAlt altType alt
mkLambdaFVars (ys ++ ys2 ++ ys3 ++ ys4) alt'
alts' := alts'.push alt'
@@ -340,8 +339,7 @@ def transform
let altTypes inferArgumentTypesN matcherApp.alts.size aux
let mut alts' := #[]
for altIdx in [:matcherApp.alts.size],
alt in matcherApp.alts,
for alt in matcherApp.alts,
numParams in matcherApp.altNumParams,
altType in altTypes do
let alt' forallBoundedTelescope altType numParams fun xs altType => do
@@ -350,7 +348,7 @@ def transform
let names lambdaTelescope alt fun xs _ => xs.mapM (·.fvarId!.getUserName)
withUserNames xs names do
let alt instantiateLambda alt xs
let alt' onAlt altIdx altType alt
let alt' onAlt altType alt
mkLambdaFVars (xs ++ ys4) alt'
alts' := alts'.push alt'
@@ -424,7 +422,7 @@ def inferMatchType (matcherApp : MatcherApp) : MetaM MatcherApp := do
}
mkArrowN extraParams typeMatcherApp.toExpr
)
(onAlt := fun _altIdx expAltType alt => do
(onAlt := fun expAltType alt => do
let altType inferType alt
let eq mkEq expAltType altType
let proof mkFreshExprSyntheticOpaqueMVar eq

View File

@@ -771,7 +771,7 @@ private def cacheResult (cacheKey : SynthInstanceCacheKey) (abstResult? : Option
if abstResult.numMVars == 0 && abstResult.paramNames.isEmpty then
-- See `applyCachedAbstractResult?` If new metavariables have **not** been introduced,
-- we don't need to perform extra checks again when reusing result.
modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some { expr := result, paramNames := #[], mvars := #[] }) }
modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some { expr := result, paramNames := #[], numMVars := 0 }) }
else
modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some abstResult) }

View File

@@ -23,16 +23,11 @@ def getExpectedNumArgs (e : Expr) : MetaM Nat := do
let (numArgs, _) getExpectedNumArgsAux e
pure numArgs
private def throwApplyError {α} (mvarId : MVarId)
(eType : Expr) (conclusionType? : Option Expr) (targetType : Expr)
(term? : Option MessageData) : MetaM α := do
throwTacticEx `apply mvarId <| MessageData.ofLazyM (es := #[eType, targetType]) do
let conclusionType := conclusionType?.getD eType
let note := if conclusionType?.isSome then .note m!"The full type of {term?.getD "the term"} is{indentExpr eType}" else m!""
let (conclusionType, targetType) addPPExplicitToExposeDiff conclusionType targetType
let conclusion := if conclusionType?.isNone then "type" else "conclusion"
return m!"could not unify the {conclusion} of {term?.getD "the term"}{indentExpr conclusionType}\n\
with the goal{indentExpr targetType}{note}"
private def throwApplyError {α} (mvarId : MVarId) (eType : Expr) (targetType : Expr) : MetaM α := do
let explanation := MessageData.ofLazyM (es := #[eType, targetType]) do
let (eType, targetType) addPPExplicitToExposeDiff eType targetType
return m!"{indentExpr eType}\nwith{indentExpr targetType}"
throwTacticEx `apply mvarId m!"failed to unify{explanation}"
def synthAppInstances (tacticName : Name) (mvarId : MVarId) (mvarsNew : Array Expr) (binderInfos : Array BinderInfo)
(synthAssignedInstances : Bool) (allowSynthFailures : Bool) : MetaM Unit := do
@@ -164,8 +159,7 @@ private def isDefEqApply (cfg : ApplyConfig) (a b : Expr) : MetaM Bool := do
/--
Close the given goal using `apply e`.
-/
def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {})
(term? : Option MessageData := none) : MetaM (List MVarId) :=
def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
mvarId.withContext do
mvarId.checkNotAssigned `apply
let targetType mvarId.getType
@@ -207,13 +201,8 @@ def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig :=
s.restore
go (i+1)
else
let conclusionType? if rangeNumArgs.start = 0 then
pure none
else
let (_, _, r) forallMetaTelescopeReducing eType (some rangeNumArgs.start)
pure (some r)
throwApplyError mvarId eType conclusionType? targetType term?
let (_, _, eType) forallMetaTelescopeReducing eType (some rangeNumArgs.start)
throwApplyError mvarId eType targetType
termination_by rangeNumArgs.stop - i
let (newMVars, binderInfos) go rangeNumArgs.start
postprocessAppMVars `apply mvarId newMVars binderInfos cfg.synthAssignedInstances cfg.allowSynthFailures
@@ -229,7 +218,7 @@ def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig :=
/-- Short-hand for applying a constant to the goal. -/
def _root_.Lean.MVarId.applyConst (mvar : MVarId) (c : Name) (cfg : ApplyConfig := {}) : MetaM (List MVarId) := do
mvar.apply ( mkConstWithFreshMVarLevels c) cfg (term? := m!"'{.ofConstName c}'")
mvar.apply ( mkConstWithFreshMVarLevels c) cfg
end Meta

View File

@@ -203,6 +203,8 @@ something goes wrong, one still gets a useful induction principle, just maybe wi
not fully simplified.
-/
set_option autoImplicit false
namespace Lean.Tactic.FunInd
open Lean Elab Meta
@@ -325,7 +327,7 @@ partial def foldAndCollect (oldIH newIH : FVarId) (isRecCall : Expr → Option E
-- statement and the inferred alt types
let dummyGoal := mkConst ``True []
mkArrow eTypeAbst dummyGoal)
(onAlt := fun _altIdx altType alt => do
(onAlt := fun altType alt => do
lambdaTelescope1 alt fun oldIH' alt => do
forallBoundedTelescope altType (some 1) fun newIH' _goal' => do
let #[newIH'] := newIH' | unreachable!
@@ -343,7 +345,7 @@ partial def foldAndCollect (oldIH newIH : FVarId) (isRecCall : Expr → Option E
(onMotive := fun _motiveArgs motiveBody => do
let some (_extra, body) := motiveBody.arrow? | throwError "motive not an arrow"
M.eval (foldAndCollect oldIH newIH isRecCall body))
(onAlt := fun _altIdx altType alt => do
(onAlt := fun altType alt => do
lambdaTelescope1 alt fun oldIH' alt => do
-- We don't have suitable newIH around here, but we don't care since
-- we just want to fold calls. So lets create a fake one.
@@ -605,7 +607,8 @@ def rwIfWith (hc : Expr) (e : Expr) : MetaM Simp.Result := do
expr := f
proof? := (mkAppN (mkConst ``if_neg us) #[c, h, hc, α, t, f])
}
return { expr := e}
else
return { expr := e}
| dite@dite α c h t f =>
let us := dite.constLevels!
if ( isDefEq c ( inferType hc)) then
@@ -618,22 +621,10 @@ def rwIfWith (hc : Expr) (e : Expr) : MetaM Simp.Result := do
expr := f.beta #[hc]
proof? := (mkAppN (mkConst ``dif_neg us) #[c, h, hc, α, t, f])
}
return { expr := e }
| cond@cond α c t f =>
let us := cond.constLevels!
if ( isDefEq ( inferType hc) ( mkEq c (mkConst ``Bool.true))) then
return {
expr := t
proof? := (mkAppN (mkConst ``Bool.cond_pos us) #[α, c, t, f, hc])
}
if ( isDefEq ( inferType hc) ( mkEq c (mkConst ``Bool.false))) then
return {
expr := f
proof? := (mkAppN (mkConst ``Bool.cond_neg us) #[α, c, t, f, hc])
}
return { expr := e }
else
return { expr := e }
| _ =>
return { expr := e }
return { expr := e }
def rwLetWith (h : Expr) (e : Expr) : MetaM Simp.Result := do
if e.isLet then
@@ -659,7 +650,7 @@ def rwFun (names : Array Name) (e : Expr) : MetaM Simp.Result := do
else
return { expr := e }
def rwMatcher (altIdx : Nat) (e : Expr) : MetaM Simp.Result := do
def rwMatcher (e : Expr) : MetaM Simp.Result := do
if e.isAppOf ``PSum.casesOn || e.isAppOf ``PSigma.casesOn then
let mut e := e
while true do
@@ -673,67 +664,10 @@ def rwMatcher (altIdx : Nat) (e : Expr) : MetaM Simp.Result := do
break
return { expr := e }
else
unless ( isMatcherApp e) do
return { expr := e }
let matcherDeclName := e.getAppFn.constName!
let eqns Match.genMatchCongrEqns matcherDeclName
unless altIdx < eqns.size do
trace[Tactic.FunInd] "When trying to reduce arm {altIdx}, only {eqns.size} equations for {.ofConstName matcherDeclName}"
return { expr := e }
let eqnThm := eqns[altIdx]!
try
withTraceNode `Meta.FunInd (pure m!"{exceptEmoji ·} rewriting with {.ofConstName eqnThm} in{indentExpr e}") do
let eqProof := mkAppN (mkConst eqnThm e.getAppFn.constLevels!) e.getAppArgs
let (hyps, _, eqType) forallMetaTelescope ( inferType eqProof)
trace[Meta.FunInd] "eqProof has type{indentExpr eqType}"
let proof := mkAppN eqProof hyps
let hyps := hyps.map (·.mvarId!)
let (isHeq, lhs, rhs) do
if let some (_, lhs, _, rhs) := eqType.heq? then pure (true, lhs, rhs) else
if let some (_, lhs, rhs) := eqType.eq? then pure (false, lhs, rhs) else
throwError m!"Type of {.ofConstName eqnThm} is not an equality"
if !( isDefEq e lhs) then
throwError m!"Left-hand side {lhs} of {.ofConstName eqnThm} does not apply to {e}"
/-
Here we instantiate the hypotheses of the congruence equation theorem
There are two sets of hypotheses to instantiate:
- `Eq` or `HEq` that relate the discriminants to the patterns
Solving these should instantiate the pattern variables.
- Overlap hypotheses (`isEqnThmHypothesis`)
With more book keeping we could maybe do this very precisely, knowing exactly
which facts provided by the splitter should go where, but it's tedious.
So for now let's use heuristics and try `assumption` and `rfl`.
-/
for h in hyps do
unless ( h.isAssigned) do
let hType h.getType
if Simp.isEqnThmHypothesis hType then
-- Using unrestricted h.substVars here does not work well; it could
-- even introduce a dependency on the `oldIH` we want to eliminate
h.assumption <|> throwError "Failed to discharge {h}"
else if hType.isEq then
h.assumption <|> h.refl <|> throwError m!"Failed to resolve {h}"
else if hType.isHEq then
h.assumption <|> h.hrefl <|> throwError m!"Failed to resolve {h}"
let unassignedHyps hyps.filterM fun h => return !( h.isAssigned)
unless unassignedHyps.isEmpty do
throwError m!"Not all hypotheses of {.ofConstName eqnThm} could be discharged: {unassignedHyps}"
let rhs instantiateMVars rhs
let proof instantiateMVars proof
let proof if isHeq then
try mkEqOfHEq proof
catch e => throwError m!"Could not un-HEq {proof}:{indentD e.toMessageData} "
else
pure proof
return {
expr := rhs
proof? := proof
}
catch ex =>
trace[Meta.FunInd] "Failed to apply {.ofConstName eqnThm}:{indentD ex.toMessageData}"
return { expr := e }
Split.simpMatch e
/--
Builds an expression of type `goal` by replicating the expression `e` into its tail-call-positions,
where it calls `buildInductionCase`. Collects the cases of the final induction hypothesis
as `MVars` as it goes.
@@ -775,39 +709,16 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
return mkApp5 (mkConst ``dite [u]) goal c' h' t' f'
| cond _α c t f =>
let c' foldAndCollect oldIH newIH isRecCall c
let t' withLocalDecl `h .default ( mkEq c' (mkConst ``Bool.true)) fun h => M2.branch do
let t' withRewrittenMotiveArg goal (rwIfWith h) fun goal' =>
buildInductionBody toErase toClear goal' oldIH newIH isRecCall t
mkLambdaFVars #[h] t'
let f' withLocalDecl `h .default ( mkEq c' (mkConst ``Bool.false)) fun h => M2.branch do
let t' withRewrittenMotiveArg goal (rwIfWith h) fun goal' =>
buildInductionBody toErase toClear goal' oldIH newIH isRecCall f
let t' withLocalDecl `h .default ( mkEq c' (toExpr true)) fun h => M2.branch do
let t' buildInductionBody toErase toClear goal oldIH newIH isRecCall t
mkLambdaFVars #[h] t'
let f' withLocalDecl `h .default ( mkEq c' (toExpr false)) fun h => M2.branch do
let f' buildInductionBody toErase toClear goal oldIH newIH isRecCall f
mkLambdaFVars #[h] f'
let u getLevel goal
return mkApp4 (mkConst ``Bool.dcond [u]) goal c' t' f'
| _ =>
-- Check for unreachable cases. We look for the kind of expressions that `by contradiction`
-- produces
match_expr e with
| False.elim _ h => do
return mkFalseElim goal h
| absurd _ _ h₁ h₂ => do
return mkAbsurd goal h₁ h₂
| _ => pure ()
if e.isApp && e.getAppFn.isConst && isNoConfusion ( getEnv) e.getAppFn.constName! then
let arity := ( inferType e.getAppFn).getNumHeadForalls -- crucially not reducing the noConfusionType in the type
let h := e.getArg! (arity - 1)
let hType inferType h
-- The following duplicates a bit of code from the contradiction tactic, maybe worth extracting
-- into a common helper at some point
if let some (_, lhs, rhs) matchEq? hType then
if let some lhsCtor matchConstructorApp? lhs then
if let some rhsCtor matchConstructorApp? rhs then
if lhsCtor.name != rhsCtor.name then
return ( mkNoConfusion goal h)
-- we look in to `PProd.mk`, as it occurs in the mutual structural recursion construction
match_expr goal with
| And goal₁ goal₂ => match_expr e with
@@ -835,13 +746,13 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
(addEqualities := true)
(onParams := (foldAndCollect oldIH newIH isRecCall ·))
(onMotive := fun xs _body => pure (absMotiveBody.beta (maskArray mask xs)))
(onAlt := fun altIdx expAltType alt => M2.branch do
(onAlt := fun expAltType alt => M2.branch do
lambdaTelescope1 alt fun oldIH' alt => do
forallBoundedTelescope expAltType (some 1) fun newIH' goal' => do
let #[newIH'] := newIH' | unreachable!
let toErase' := toErase ++ #[oldIH', newIH'.fvarId!]
let toClear' := toClear ++ matcherApp.discrs.filterMap (·.fvarId?)
let alt' withRewrittenMotiveArg goal' (rwMatcher altIdx) fun goal'' => do
let alt' withRewrittenMotiveArg goal' rwMatcher fun goal'' => do
-- logInfo m!"rwMatcher after {matcherApp.matcherName} on{indentExpr goal'}\nyields{indentExpr goal''}"
buildInductionBody toErase' toClear' goal'' oldIH' newIH'.fvarId! isRecCall alt
mkLambdaFVars #[newIH'] alt')
@@ -858,8 +769,8 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
(addEqualities := true)
(onParams := (foldAndCollect oldIH newIH isRecCall ·))
(onMotive := fun xs _body => pure (absMotiveBody.beta (maskArray mask xs)))
(onAlt := fun altIdx expAltType alt => M2.branch do
withRewrittenMotiveArg expAltType (rwMatcher altIdx) fun expAltType' =>
(onAlt := fun expAltType alt => M2.branch do
withRewrittenMotiveArg expAltType Split.simpMatch fun expAltType' =>
buildInductionBody toErase toClear expAltType' oldIH newIH isRecCall alt)
return matcherApp'.toExpr

View File

@@ -42,6 +42,7 @@ 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.eqResolution
@@ -70,7 +71,6 @@ builtin_initialize registerTraceClass `grind.debug.final
builtin_initialize registerTraceClass `grind.debug.forallPropagator
builtin_initialize registerTraceClass `grind.debug.split
builtin_initialize registerTraceClass `grind.debug.canon
builtin_initialize registerTraceClass `grind.debug.ematch.activate
builtin_initialize registerTraceClass `grind.debug.ematch.pattern
builtin_initialize registerTraceClass `grind.debug.beta
builtin_initialize registerTraceClass `grind.debug.internalize
@@ -81,6 +81,7 @@ builtin_initialize registerTraceClass `grind.debug.mbtc
builtin_initialize registerTraceClass `grind.debug.ematch
builtin_initialize registerTraceClass `grind.debug.proveEq
builtin_initialize registerTraceClass `grind.debug.pushNewFact
builtin_initialize registerTraceClass `grind.debug.ematch.activate
builtin_initialize registerTraceClass `grind.debug.appMap
builtin_initialize registerTraceClass `grind.debug.ext

View File

@@ -16,7 +16,6 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.EqCnstr
import Lean.Meta.Tactic.Grind.Arith.CommRing.Proof
import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
import Lean.Meta.Tactic.Grind.Arith.CommRing.Inv
import Lean.Meta.Tactic.Grind.Arith.CommRing.PP
namespace Lean
@@ -27,7 +26,6 @@ builtin_initialize registerTraceClass `grind.ring.assert.unsat (inherited := tru
builtin_initialize registerTraceClass `grind.ring.assert.trivial (inherited := true)
builtin_initialize registerTraceClass `grind.ring.assert.queue (inherited := true)
builtin_initialize registerTraceClass `grind.ring.assert.basis (inherited := true)
builtin_initialize registerTraceClass `grind.ring.assert.store (inherited := true)
builtin_initialize registerTraceClass `grind.ring.assert.discard (inherited := true)
builtin_initialize registerTraceClass `grind.ring.simp
builtin_initialize registerTraceClass `grind.ring.superpose
@@ -37,6 +35,5 @@ builtin_initialize registerTraceClass `grind.debug.ring.simp
builtin_initialize registerTraceClass `grind.debug.ring.proof
builtin_initialize registerTraceClass `grind.debug.ring.check
builtin_initialize registerTraceClass `grind.debug.ring.impEq
builtin_initialize registerTraceClass `grind.debug.ring.simpBasis
end Lean

View File

@@ -12,9 +12,7 @@ namespace Lean.Meta.Grind.Arith.CommRing
Helper functions for converting reified terms back into their denotations.
-/
variable [Monad M] [MonadGetRing M]
private def denoteNum (k : Int) : M Expr := do
private def denoteNum (k : Int) : RingM Expr := do
let ring getRing
let n := mkRawNatLit k.natAbs
let ofNatInst := mkApp3 (mkConst ``Grind.CommRing.ofNat [ring.u]) ring.type ring.commRingInst n
@@ -24,44 +22,44 @@ private def denoteNum (k : Int) : M Expr := do
else
return n
def _root_.Lean.Grind.CommRing.Power.denoteExpr (pw : Power) : M Expr := do
def _root_.Lean.Grind.CommRing.Power.denoteExpr (pw : Power) : RingM Expr := do
let x := ( getRing).vars[pw.x]!
if pw.k == 1 then
return x
else
return mkApp2 ( getRing).powFn x (toExpr pw.k)
def _root_.Lean.Grind.CommRing.Mon.denoteExpr (m : Mon) : M Expr := do
def _root_.Lean.Grind.CommRing.Mon.denoteExpr (m : Mon) : RingM Expr := do
match m with
| .unit => denoteNum 1
| .mult pw m => go m ( pw.denoteExpr)
where
go (m : Mon) (acc : Expr) : M Expr := do
go (m : Mon) (acc : Expr) : RingM Expr := do
match m with
| .unit => return acc
| .mult pw m => go m (mkApp2 ( getRing).mulFn acc ( pw.denoteExpr))
def _root_.Lean.Grind.CommRing.Poly.denoteExpr (p : Poly) : M Expr := do
def _root_.Lean.Grind.CommRing.Poly.denoteExpr (p : Poly) : RingM Expr := do
match p with
| .num k => denoteNum k
| .add k m p => go p ( denoteTerm k m)
where
denoteTerm (k : Int) (m : Mon) : M Expr := do
denoteTerm (k : Int) (m : Mon) : RingM Expr := do
if k == 1 then
m.denoteExpr
else
return mkApp2 ( getRing).mulFn ( denoteNum k) ( m.denoteExpr)
go (p : Poly) (acc : Expr) : M Expr := do
go (p : Poly) (acc : Expr) : RingM Expr := do
match p with
| .num 0 => return acc
| .num k => return mkApp2 ( getRing).addFn acc ( denoteNum k)
| .add k m p => go p (mkApp2 ( getRing).addFn acc ( denoteTerm k m))
def _root_.Lean.Grind.CommRing.Expr.denoteExpr (e : RingExpr) : M Expr := do
def _root_.Lean.Grind.CommRing.Expr.denoteExpr (e : RingExpr) : RingM Expr := do
go e
where
go : RingExpr M Expr
go : RingExpr RingM Expr
| .num k => denoteNum k
| .var x => return ( getRing).vars[x]!
| .add a b => return mkApp2 ( getRing).addFn ( go a) ( go b)
@@ -70,17 +68,13 @@ where
| .pow a k => return mkApp2 ( getRing).powFn ( go a) (toExpr k)
| .neg a => return mkApp ( getRing).negFn ( go a)
private def mkEq (a b : Expr) : M Expr := do
let r getRing
return mkApp3 (mkConst ``Eq [r.u.succ]) r.type a b
def EqCnstr.denoteExpr (c : EqCnstr) : M Expr := do
def EqCnstr.denoteExpr (c : EqCnstr) : RingM Expr := do
mkEq ( c.p.denoteExpr) ( denoteNum 0)
def PolyDerivation.denoteExpr (d : PolyDerivation) : M Expr := do
def PolyDerivation.denoteExpr (d : PolyDerivation) : RingM Expr := do
d.p.denoteExpr
def DiseqCnstr.denoteExpr (c : DiseqCnstr) : M Expr := do
def DiseqCnstr.denoteExpr (c : DiseqCnstr) : RingM Expr := do
return mkNot ( mkEq ( c.d.denoteExpr) ( denoteNum 0))
end Lean.Meta.Grind.Arith.CommRing

View File

@@ -89,26 +89,16 @@ def PolyDerivation.simplify (d : PolyDerivation) : RingM PolyDerivation := do
return d
/-- Simplifies `c₁` using `c₂`. -/
def EqCnstr.simplifyWithCore (c₁ c₂ : EqCnstr) : RingM (Option EqCnstr) := do
let some r := c₁.p.simp? c₂.p ( nonzeroChar?) | return none
def EqCnstr.simplifyWith (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
let some r := c₁.p.simp? c₂.p ( nonzeroChar?) | return c₁
let c := { c₁ with
p := r.p
h := .simp r.k₁ c₁ r.k₂ r.m₂ c₂
}
incSteps
trace_goal[grind.ring.simp] "{← c.p.denoteExpr}"
return some c
/-- Simplifies `c₁` using `c₂`. -/
def EqCnstr.simplifyWith (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
let some c c₁.simplifyWithCore c₂ | return c₁
return c
/-- Simplifies `c₁` using `c₂` exhaustively. -/
partial def EqCnstr.simplifyWithExhaustively (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
let some c c₁.simplifyWithCore c₂ | return c₁
c.simplifyWithExhaustively c₂
/-- Simplify the given equation constraint using the current basis. -/
def EqCnstr.simplify (c : EqCnstr) : RingM EqCnstr := do
let mut c := c
@@ -160,6 +150,22 @@ def addToBasisCore (c : EqCnstr) : RingM Unit := do
recheck := true
}
def EqCnstr.simplifyBasis (c : EqCnstr) : RingM Unit := do
let .add _ m _ := c.p | return ()
let .mult pw _ := m | return ()
let x := pw.x
let cs := ( getRing).varToBasis[x]!
if cs.isEmpty then return ()
modifyRing fun s => { s with varToBasis := s.varToBasis.set x {} }
for c' in cs do
let .add _ m' _ := c'.p | pure ()
if m.divides m' then
let c'' c'.simplifyWith c
unless ( c''.checkConstant) do
addToBasisCore c''
else
addToBasisCore c'
def EqCnstr.addToQueue (c : EqCnstr) : RingM Unit := do
if ( checkMaxSteps) then return ()
trace_goal[grind.ring.assert.queue] "{← c.denoteExpr}"
@@ -212,29 +218,6 @@ def EqCnstr.toMonic (c : EqCnstr) : RingM EqCnstr := do
return { c with p := c.p.mulConst (-1), h := .mul (-1) c }
return c
def EqCnstr.simplifyBasis (c : EqCnstr) : RingM Unit := do
trace[grind.debug.ring.simpBasis] "using: {← c.denoteExpr}"
let .add _ m _ := c.p | return ()
let rec go (m' : Mon) : RingM Unit := do
match m' with
| .unit => return ()
| .mult pw m' => goVar m pw.x; go m'
go m
where
goVar (m : Mon) (x : Var) : RingM Unit := do
let cs := ( getRing).varToBasis[x]!
if cs.isEmpty then return ()
modifyRing fun s => { s with varToBasis := s.varToBasis.set x {} }
for c' in cs do
trace[grind.debug.ring.simpBasis] "target: {← c'.denoteExpr}"
let .add _ m' _ := c'.p | pure ()
if m.divides m' then
let c'' c'.simplifyWithExhaustively c
trace[grind.debug.ring.simpBasis] "simplified: {← c''.denoteExpr}"
addToQueue c''
else
addToBasisCore c'
def EqCnstr.addToBasisAfterSimp (c : EqCnstr) : RingM Unit := do
let c c.toMonic
c.simplifyBasis

View File

@@ -1,56 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
namespace Lean.Meta.Grind.Arith.CommRing
instance : MonadGetRing (ReaderT Ring MetaM) where
getRing := read
private def M := ReaderT Goal (StateT (Array MessageData) MetaM)
private def toOption (cls : Name) (header : Thunk MessageData) (msgs : Array MessageData) : Option MessageData :=
if msgs.isEmpty then
none
else
some (.trace {cls} header.get msgs)
private def push (msgs : Array MessageData) (msg? : Option MessageData) : Array MessageData :=
if let some msg := msg? then msgs.push msg else msgs
def ppBasis? : ReaderT Ring MetaM (Option MessageData) := do
let mut basis := #[]
for cs in ( getRing).varToBasis do
for c in cs do
basis := basis.push (toTraceElem ( c.denoteExpr))
return toOption `basis "Basis" basis
def ppDiseqs? : ReaderT Ring MetaM (Option MessageData) := do
let mut diseqs := #[]
for d in ( getRing).diseqs do
diseqs := diseqs.push (toTraceElem ( d.denoteExpr))
return toOption `diseqs "Disequalities" diseqs
def ppRing? : ReaderT Ring MetaM (Option MessageData) := do
let msgs := #[]
let msgs := push msgs ( ppBasis?)
let msgs := push msgs ( ppDiseqs?)
return toOption `ring m!"Ring `{(← getRing).type}`" msgs
def pp? (goal : Goal) : MetaM (Option MessageData) := do
let mut msgs := #[]
for ring in goal.arith.ring.rings do
let some msg ppRing? ring | pure ()
msgs := msgs.push msg
if msgs.isEmpty then
return none
else if h : msgs.size = 1 then
return some msgs[0]
else
return some (.trace { cls := `ring } "Rings" msgs)
end Lean.Meta.Grind.Arith.CommRing

View File

@@ -297,7 +297,6 @@ the derivation.
structure ProofM.State where
cache : Std.HashMap UInt64 Expr := {}
polyMap : Std.HashMap Poly Expr := {}
monMap : Std.HashMap Mon Expr := {}
exprMap : Std.HashMap RingExpr Expr := {}
structure ProofM.Context where
@@ -332,25 +331,13 @@ def mkExprDecl (e : RingExpr) : ProofM Expr := do
modify fun s => { s with exprMap := s.exprMap.insert e x }
return x
def mkMonDecl (m : Mon) : ProofM Expr := do
if let some x := ( get).monMap[m]? then
return x
let x := mkFVar ( mkFreshFVarId)
modify fun s => { s with monMap := s.monMap.insert m x }
return x
private def mkStepBasicPrefix (declName : Name) : ProofM Expr := do
private def mkStepPrefix (declName declNameC : Name) : ProofM Expr := do
let ctx getContext
let ring getRing
return mkApp3 (mkConst declName [ring.u]) ring.type ring.commRingInst ctx
private def mkStepPrefix (declName declNameC : Name) : ProofM Expr := do
if let some (charInst, char) nonzeroCharInst? then
let ctx getContext
let ring getRing
return mkApp5 (mkConst declNameC [ring.u]) ring.type (toExpr char) ring.commRingInst charInst ctx
else
mkStepBasicPrefix declName
return mkApp3 (mkConst declName [ring.u]) ring.type ring.commRingInst ctx
open Lean.Grind.CommRing in
partial def _root_.Lean.Meta.Grind.Arith.CommRing.EqCnstr.toExprProof (c : EqCnstr) : ProofM Expr := caching c do
@@ -361,14 +348,14 @@ partial def _root_.Lean.Meta.Grind.Arith.CommRing.EqCnstr.toExprProof (c : EqCns
| .superpose k₁ m₁ c₁ k₂ m₂ c₂ =>
let h mkStepPrefix ``Stepwise.superpose ``Stepwise.superposeC
return mkApp10 h
(toExpr k₁) ( mkMonDecl m₁) ( mkPolyDecl c₁.p)
(toExpr k₂) ( mkMonDecl m₂) ( mkPolyDecl c₂.p)
(toExpr k₁) (toExpr m₁) ( mkPolyDecl c₁.p)
(toExpr k₂) (toExpr m₂) ( mkPolyDecl c₂.p)
( mkPolyDecl c.p) reflBoolTrue ( toExprProof c₁) ( toExprProof c₂)
| .simp k₁ c₁ k₂ m₂ c₂ =>
let h mkStepPrefix ``Stepwise.simp ``Stepwise.simpC
return mkApp9 h
(toExpr k₁) ( mkPolyDecl c₁.p)
(toExpr k₂) ( mkMonDecl m₂) ( mkPolyDecl c₂.p)
(toExpr k₂) (toExpr m₂) ( mkPolyDecl c₂.p)
( mkPolyDecl c.p) reflBoolTrue ( toExprProof c₁) ( toExprProof c₂)
| .mul k c₁ =>
let h mkStepPrefix ``Stepwise.mul ``Stepwise.mulC
@@ -379,44 +366,6 @@ partial def _root_.Lean.Meta.Grind.Arith.CommRing.EqCnstr.toExprProof (c : EqCns
| throwNoNatZeroDivisors
return mkApp6 h nzInst ( mkPolyDecl c₁.p) (toExpr k) ( mkPolyDecl c.p) reflBoolTrue ( toExprProof c₁)
open Lean.Grind.CommRing in
/--
Given a polynomial derivation, returns `(k, p₀, h)` where `h` is a proof that
`k*p₀ = d.p`
-/
private def derivToExprProof (d : PolyDerivation) : ProofM (Int × Poly × Expr) := do
match d with
| .input p₀ =>
let h := mkApp ( mkStepBasicPrefix ``Stepwise.d_init) ( mkPolyDecl p₀)
return (1, p₀, h)
| .step p k₁ d k₂ m₂ c₂ =>
let (k, p₀, h₁) derivToExprProof d
let h₂ c₂.toExprProof
let h if k₁ == 1 then
mkStepPrefix ``Stepwise.d_step1 ``Stepwise.d_step1C
else
pure <| mkApp ( mkStepPrefix ``Stepwise.d_stepk ``Stepwise.d_stepkC) (toExpr k₁)
let h := mkApp10 h
(toExpr k) ( mkPolyDecl p₀) ( mkPolyDecl d.p)
(toExpr k₂) ( mkMonDecl m₂) ( mkPolyDecl c₂.p) ( mkPolyDecl p)
reflBoolTrue h₁ h₂
return (k₁*k, p₀, h)
open Lean.Grind.CommRing in
/--
Given a derivation `d` for `k * p = 0` where `lhs - rhs = p`, returns a proof for `lhs = rhs`.
-/
private def mkImpEqExprProof (lhs rhs : RingExpr) (d : PolyDerivation) : ProofM Expr := do
assert! d.p matches .num 0
let (k, p₀, h₁) derivToExprProof d
let h if k == 1 then
mkStepPrefix ``Stepwise.imp_1eq ``Stepwise.imp_1eqC
else
let some nzInst noZeroDivisorsInst?
| throwNoNatZeroDivisors
pure <| mkApp2 ( mkStepPrefix ``Stepwise.imp_keq ``Stepwise.imp_keqC) nzInst (toExpr k)
return mkApp6 h ( mkExprDecl lhs) ( mkExprDecl rhs) ( mkPolyDecl p₀) ( mkPolyDecl d.p) reflBoolTrue h₁
private abbrev withProofContext (x : ProofM Expr) : RingM Expr := do
let ring getRing
withLetDecl `ctx (mkApp (mkConst ``RArray [ring.u]) ring.type) ( toContextExpr) fun ctx =>
@@ -425,32 +374,18 @@ where
go : ProofM Expr := do
let h x
let h mkLetOfMap ( get).polyMap h `p (mkConst ``Grind.CommRing.Poly) toExpr
let h mkLetOfMap ( get).monMap h `m (mkConst ``Grind.CommRing.Mon) toExpr
let h mkLetOfMap ( get).exprMap h `e (mkConst ``Grind.CommRing.Expr) toExpr
mkLetFVars #[( getContext)] h
open Lean.Grind.CommRing in
def setEqUnsat (c : EqCnstr) : RingM Unit := do
let h withProofContext do
def setEqUnsat (c : EqCnstr) : RingM Expr := do
withProofContext do
let mut h mkStepPrefix ``Stepwise.unsat_eq ``Stepwise.unsat_eqC
let (charInst, char) getCharInst
if char == 0 then
h := mkApp h charInst
let k getPolyConst c.p
return mkApp4 h ( mkPolyDecl c.p) (toExpr k) reflBoolTrue ( c.toExprProof)
closeGoal h
def setDiseqUnsat (c : DiseqCnstr) : RingM Unit := do
let heq withProofContext do
mkImpEqExprProof c.rlhs c.rrhs c.d
closeGoal <| mkApp ( mkDiseqProof c.lhs c.rhs) heq
def propagateEq (a b : Expr) (ra rb : RingExpr) (d : PolyDerivation) : RingM Unit := do
let heq withProofContext do
mkImpEqExprProof ra rb d
let ring getRing
let eq := mkApp3 (mkConst ``Eq [.succ ring.u]) ring.type a b
pushEq a b <| mkExpectedPropHint heq eq
end Stepwise
@@ -458,18 +393,14 @@ def EqCnstr.setUnsat (c : EqCnstr) : RingM Unit := do
if ( getConfig).ringNull then
Null.setEqUnsat c
else
Stepwise.setEqUnsat c
closeGoal ( Stepwise.setEqUnsat c)
def DiseqCnstr.setUnsat (c : DiseqCnstr) : RingM Unit := do
if ( getConfig).ringNull then
Null.setDiseqUnsat c
else
Stepwise.setDiseqUnsat c
Null.setDiseqUnsat c
-- TODO: stepwise support
def propagateEq (a b : Expr) (ra rb : RingExpr) (d : PolyDerivation) : RingM Unit := do
if ( getConfig).ringNull then
Null.propagateEq a b ra rb d
else
Stepwise.propagateEq a b ra rb d
Null.propagateEq a b ra rb d
-- TODO: stepwise support
end Lean.Meta.Grind.Arith.CommRing

View File

@@ -36,15 +36,6 @@ structure RingM.Context where
-/
checkCoeffDvd : Bool := false
class MonadGetRing (m : Type Type) where
getRing : m Ring
export MonadGetRing (getRing)
@[always_inline]
instance (m n) [MonadLift m n] [MonadGetRing m] : MonadGetRing n where
getRing := liftM (getRing : m Ring)
/-- We don't want to keep carrying the `RingId` around. -/
abbrev RingM := ReaderT RingM.Context GoalM
@@ -54,7 +45,7 @@ abbrev RingM.run (ringId : Nat) (x : RingM α) : GoalM α :=
abbrev getRingId : RingM Nat :=
return ( read).ringId
protected def RingM.getRing : RingM Ring := do
def getRing : RingM Ring := do
let s get'
let ringId getRingId
if h : ringId < s.rings.size then
@@ -62,9 +53,6 @@ protected def RingM.getRing : RingM Ring := do
else
throwError "`grind` internal error, invalid ringId"
instance : MonadGetRing RingM where
getRing := RingM.getRing
@[inline] def modifyRing (f : Ring Ring) : RingM Unit := do
let ringId getRingId
modify' fun s => { s with rings := s.rings.modify ringId f }
@@ -87,14 +75,14 @@ def setTermRingId (e : Expr) : RingM Unit := do
modify' fun s => { s with exprToRingId := s.exprToRingId.insert { expr := e } ringId }
/-- Returns `some c` if the current ring has a nonzero characteristic `c`. -/
def nonzeroChar? [Monad m] [MonadGetRing m] : m (Option Nat) := do
def nonzeroChar? : RingM (Option Nat) := do
if let some (_, c) := ( getRing).charInst? then
if c != 0 then
return some c
return none
/-- Returns `some (charInst, c)` if the current ring has a nonzero characteristic `c`. -/
def nonzeroCharInst? [Monad m] [MonadGetRing m] : m (Option (Expr × Nat)) := do
def nonzeroCharInst? : RingM (Option (Expr × Nat)) := do
if let some (inst, c) := ( getRing).charInst? then
if c != 0 then
return some (inst, c)

View File

@@ -92,25 +92,23 @@ def mkModel (goal : Goal) : MetaM (Array (Expr × Rat)) := do
let mut used : Std.HashSet Int := {}
let mut nextVal : Int := 0
let mut model := {}
let nodes := goal.getENodes
-- Assign on expressions associated with cutsat terms or interpreted terms
for e in goal.exprs do
let node goal.getENode e
for node in nodes do
if isSameExpr node.root node.self then
if ( isIntNatENode node) then
if let some v getAssignment? goal node.self then
if v.den == 1 then used := used.insert v.num
model := assignEqc goal node.self v model
-- Assign cast terms
for e in goal.exprs do
let node goal.getENode e
for node in nodes do
let i := node.self
let some n := natCast? i | pure ()
if model[n]?.isNone then
let some v := model[i]? | pure ()
model := assignEqc goal n v model
-- Assign the remaining ones with values not used by cutsat
for e in goal.exprs do
let node goal.getENode e
for node in nodes do
if isSameExpr node.root node.self then
if ( isIntNatENode node) then
if model[node.self]?.isNone then

View File

@@ -65,6 +65,19 @@ def mkNatExprDecl (e : Int.OfNat.Expr) : ProofM Expr := do
modify fun s => { s with natExprMap := s.natExprMap.insert e x }
return x
private def mkLetOfMap {_ : Hashable α} {_ : BEq α} (m : Std.HashMap α Expr) (e : Expr)
(varPrefix : Name) (varType : Expr) (toExpr : α Expr) : GoalM Expr := do
if m.isEmpty then
return e
else
let as := m.toArray
let mut e := e.abstract <| as.map (·.2)
let mut i := as.size
for (p, _) in as.reverse do
e := mkLet (varPrefix.appendIndexAfter i) varType (toExpr p) e
i := i - 1
return e
private def toContextExprCore (vars : PArray Expr) (type : Expr) : MetaM Expr :=
if h : 0 < vars.size then
RArray.toExpr type id (RArray.ofFn (vars[·]) h)

View File

@@ -37,12 +37,6 @@ where
proof? := proofNew?
}
/--
Returns `true` if the parent is relevant for congruence closure.
-/
private def isCongrRelevant (parent : Expr) : Bool :=
parent.isApp || parent.isArrow
/--
Removes `root` parents from the congruence table.
This is an auxiliary function performed while merging equivalence classes.
@@ -51,7 +45,7 @@ private def removeParents (root : Expr) : GoalM ParentSet := do
let parents getParents root
for parent in parents do
-- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
if ( pure (isCongrRelevant parent) <&&> isCongrRoot parent) then
if ( pure parent.isApp <&&> isCongrRoot parent) then
trace_goal[grind.debug.parent] "remove: {parent}"
modify fun s => { s with congrTable := s.congrTable.erase { e := parent } }
return parents
@@ -62,7 +56,7 @@ 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 (isCongrRelevant parent) <&&> isCongrRoot parent) then
if ( pure parent.isApp <&&> isCongrRoot parent) then
trace_goal[grind.debug.parent] "reinsert: {parent}"
addCongrTable parent
@@ -96,116 +90,75 @@ private partial def updateMT (root : Expr) : GoalM Unit := do
updateMT parent
/--
Equalities or disequalities to be propagated to a theory solver **after**
two equivalence classes have been merged.
Some solvers (e.g. `cutsat`) require the core data structures to satisfy
their invariants. During the merge operations some of these invariants do not hold.
Thus, we first *record* the facts that must be propagated in a `PendingTheoryPropagation` value,
complete the merge, and only then perform the propagation.
We now use this workflow for *all* theory solvers, even when a particular
solver does not rely on these invariants. This keeps the core
solver-agnostic and lets us modify solvers without further adjustments.
Helper function for combining `ENode.offset?` fields and propagating equalities
to the offset constraint module.
-/
inductive PendingTheoryPropagation where
| /-- Nothing to propagate. -/
none
| /-- Propagate the equality `lhs = rhs`. -/
eq (lhs rhs : Expr)
|
/--
Propagate the literal equality `lhs = lit`.
This is needed because some solvers do not internalize literal values.
Remark: we may remove this optimization in the future because it adds complexity
for a small performance gain.
-/
eqLit (lhs lit : Expr)
| /-- Propagate the disequalities in `ps`. -/
diseqs (ps : ParentSet)
/--
Helper function for combining `ENode.offset?` fields and detecting what needs
to be propagated to the offset constraint module.
-/
private def checkOffsetEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
private def propagateOffsetEq (rhsRoot lhsRoot : ENode) : GoalM Unit := do
match lhsRoot.offset? with
| some lhsOffset =>
if let some rhsOffset := rhsRoot.offset? then
return .eq lhsOffset rhsOffset
Arith.Offset.processNewEq lhsOffset rhsOffset
else if isNatNum rhsRoot.self then
return .eqLit lhsOffset rhsRoot.self
Arith.Offset.processNewEqLit lhsOffset rhsRoot.self
else
-- We have to retrieve the node because other fields have been updated
let rhsRoot getENode rhsRoot.self
setENode rhsRoot.self { rhsRoot with offset? := lhsOffset }
return .none
| none =>
if isNatNum lhsRoot.self then
if let some rhsOffset := rhsRoot.offset? then
return .eqLit rhsOffset lhsRoot.self
return .none
def propagateOffset : PendingTheoryPropagation GoalM Unit
| .eq lhs rhs => Arith.Offset.processNewEq lhs rhs
| .eqLit lhs lit => Arith.Offset.processNewEqLit lhs lit
| _ => return ()
if let some rhsOffset := rhsRoot.offset? then
Arith.Offset.processNewEqLit rhsOffset lhsRoot.self
/--
Helper function for combining `ENode.cutsat?` fields and detecting what needs
to be propagated to the cutsat module.
Helper function for combining `ENode.cutsat?` fields and propagating equalities
to the cutsat module.
It returns a set of parents that should be traversed for disequality propagation.
-/
private def checkCutsatEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
private def propagateCutsatEq (rhsRoot lhsRoot : ENode) : GoalM ParentSet := do
match lhsRoot.cutsat? with
| some lhsCutsat =>
if let some rhsCutsat := rhsRoot.cutsat? then
return .eq lhsCutsat rhsCutsat
Arith.Cutsat.processNewEq lhsCutsat rhsCutsat
return {}
else if isNum rhsRoot.self then
return .eqLit lhsCutsat rhsRoot.self
Arith.Cutsat.processNewEqLit lhsCutsat rhsRoot.self
return {}
else
-- We have to retrieve the node because other fields have been updated
let rhsRoot getENode rhsRoot.self
setENode rhsRoot.self { rhsRoot with cutsat? := lhsCutsat }
return .diseqs ( getParents rhsRoot.self)
getParents rhsRoot.self
| none =>
if let some rhsCutsat := rhsRoot.cutsat? then
if isNum lhsRoot.self then
return .eqLit rhsCutsat lhsRoot.self
Arith.Cutsat.processNewEqLit rhsCutsat lhsRoot.self
return {}
else
return .diseqs ( getParents lhsRoot.self)
getParents lhsRoot.self
else
return .none
def propagateCutsat : PendingTheoryPropagation GoalM Unit
| .eq lhs rhs => Arith.Cutsat.processNewEq lhs rhs
| .eqLit lhs lit => Arith.Cutsat.processNewEqLit lhs lit
| .diseqs ps => propagateCutsatDiseqs ps
| .none => return ()
return {}
/--
Helper function for combining `ENode.ring?` fields and detecting what needs to be
progagated to the commutative ring module.
Helper function for combining `ENode.ring?` fields and propagating equalities
to the commutative ring module.
It returns a set of parents that should be traversed for disequality propagation.
-/
private def checkCommRingEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
private def propagateCommRingEq (rhsRoot lhsRoot : ENode) : GoalM ParentSet := do
match lhsRoot.ring? with
| some lhsRing =>
if let some rhsRing := rhsRoot.ring? then
return .eq lhsRing rhsRing
Arith.CommRing.processNewEq lhsRing rhsRing
return {}
else
-- We have to retrieve the node because other fields have been updated
let rhsRoot getENode rhsRoot.self
setENode rhsRoot.self { rhsRoot with ring? := lhsRing }
return .diseqs ( getParents rhsRoot.self)
getParents rhsRoot.self
| none =>
if rhsRoot.ring?.isSome then
return .diseqs ( getParents lhsRoot.self)
getParents lhsRoot.self
else
return .none
def propagateCommRing : PendingTheoryPropagation GoalM Unit
| .eq lhs rhs => Arith.CommRing.processNewEq lhs rhs
| .diseqs ps => propagateCommRingDiseqs ps
| _ => return ()
return {}
/--
Tries to apply beta-reductiong using the parent applications of the functions in `fns` with
@@ -309,9 +262,9 @@ where
}
propagateBeta lams₁ fns₁
propagateBeta lams₂ fns₂
let offsetTodo checkOffsetEq rhsRoot lhsRoot
let cutsatTodo checkCutsatEq rhsRoot lhsRoot
let ringTodo checkCommRingEq rhsRoot lhsRoot
propagateOffsetEq rhsRoot lhsRoot
let parentsToPropagateCutsatDiseqs propagateCutsatEq rhsRoot lhsRoot
let parentsToPropagateRingDiseqs propagateCommRingEq rhsRoot lhsRoot
resetParentsOf lhsRoot.self
copyParentsTo parents rhsNode.root
unless ( isInconsistent) do
@@ -321,9 +274,8 @@ where
propagateUp parent
for e in toPropagateDown do
propagateDown e
propagateOffset offsetTodo
propagateCutsat cutsatTodo
propagateCommRing ringTodo
propagateCutsatDiseqs parentsToPropagateCutsatDiseqs
propagateCommRingDiseqs parentsToPropagateRingDiseqs
updateRoots (lhs : Expr) (rootNew : Expr) : GoalM Unit := do
traverseEqc lhs fun n =>
setENode n.self { n with root := rootNew }

View File

@@ -300,7 +300,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
let report : M Unit := do
reportIssue! "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
unless ( withDefault <| isDefEq mvarIdType vType) do
let some heq withoutReportingMVarIssues <| proveEq? vType mvarIdType (abstract := true)
let some heq proveEq? vType mvarIdType
| report
return ()
/-

View File

@@ -337,54 +337,35 @@ private def foundBVar (idx : Nat) : M Bool :=
private def saveBVar (idx : Nat) : M Unit := do
modify fun s => { s with bvarsFound := s.bvarsFound.insert idx }
inductive PatternArgKind where
| /-- Argument is relevant for E-matching. -/
relevant
| /-- Instance implicit arguments are considered support and handled using `isDefEq`. -/
instImplicit
| /-- Proofs are ignored during E-matching. Lean is proof irrelevant. -/
proof
| /--
Types and type formers are mostly ignored during E-matching, and processed using
`isDefEq`. However, if the argument is of the form `C ..` where `C` is inductive type
we process it as part of the pattern. Suppose we have `as bs : List α`, and a pattern
candidate expression `as ++ bs`, i.e., `@HAppend.hAppend (List α) (List α) (List α) inst as bs`.
If we completely ignore the types, the pattern will just be
```
@HAppend.hAppend _ _ _ _ #1 #0
```
This is not ideal because the E-matcher will try it in any goal that contains `++`,
even if it does not even mention lists.
-/
typeFormer
deriving Repr
def PatternArgKind.isSupport : PatternArgKind Bool
| .relevant => false
| _ => true
private def getPatternFn? (pattern : Expr) : Option Expr :=
if !pattern.isApp && !pattern.isConst then
none
else match pattern.getAppFn with
| f@(.const declName _) => if isForbidden declName then none else some f
| f@(.fvar _) => some f
| _ => none
/--
Returns an array `kinds` s.ts `kinds[i]` is the kind of the corresponding argument.
Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
- a type (that is not a proposition) or type former (which has forward dependencies) or
- a proof, or
- an instance implicit argument
When `kinds[i].isSupport` is `true`, we say the corresponding argument is a "support" argument.
When `mask[i]`, we say the corresponding argument is a "support" argument.
-/
def getPatternArgKinds (f : Expr) (numArgs : Nat) : MetaM (Array PatternArgKind) := do
def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
let pinfos := ( getFunInfoNArgs f numArgs).paramInfo
forallBoundedTelescope ( inferType f) numArgs fun xs _ => do
xs.mapIdxM fun idx x => do
if ( isProp x) then
return .relevant
return false
else if ( isProof x) then
return .proof
return true
else if ( isTypeFormer x) then
if h : idx < pinfos.size then
/-
We originally wanted to ignore types and type formers in `grind` and treat them as supporting elements.
Thus, we wanted to always return `.typeFormer`. However, we changed our heuristic because of the following example:
Thus, we would always return `true`. However, we changed our heuristic because of the following example:
```
example {α} (f : α → Type) (a : α) (h : ∀ x, Nonempty (f x)) : Nonempty (f a) := by
grind
@@ -393,53 +374,33 @@ def getPatternArgKinds (f : Expr) (numArgs : Nat) : MetaM (Array PatternArgKind)
a type or type former is considered a supporting element only if it has forward dependencies.
Note that this is not the case for `Nonempty`.
-/
if pinfos[idx].hasFwdDeps then return .typeFormer else return .relevant
return pinfos[idx].hasFwdDeps
else
return .typeFormer
else if ( x.fvarId!.getDecl).binderInfo matches .instImplicit then
return .instImplicit
return true
else
return .relevant
return ( x.fvarId!.getDecl).binderInfo matches .instImplicit
private def getPatternFn? (pattern : Expr) (inSupport : Bool) (argKind : PatternArgKind) : MetaM (Option Expr) := do
if !pattern.isApp && !pattern.isConst then
return none
else match pattern.getAppFn with
| f@(.const declName _) =>
if isForbidden declName then
return none
if inSupport then
if argKind matches .typeFormer | .relevant then
if ( isInductive declName) then
return some f
return none
return some f
| f@(.fvar _) =>
if inSupport then return none else return some f
| _ =>
return none
private partial def go (pattern : Expr) (inSupport : Bool) : M Expr := do
private partial def go (pattern : Expr) : M Expr := do
if let some (e, k) := isOffsetPattern? pattern then
let e goArg e inSupport .relevant
let e goArg e (isSupport := false)
if e == dontCare then
return dontCare
else
return mkOffsetPattern e k
let some f getPatternFn? pattern inSupport .relevant
let some f := getPatternFn? pattern
| throwError "invalid pattern, (non-forbidden) application expected{indentExpr pattern}"
assert! f.isConst || f.isFVar
unless f.isConstOf ``Grind.eqBwdPattern do
saveSymbol f.toHeadIndex
saveSymbol f.toHeadIndex
let mut args := pattern.getAppArgs.toVector
let patternArgKinds getPatternArgKinds f args.size
let supportMask getPatternSupportMask f args.size
for h : i in [:args.size] do
let arg := args[i]
let argKind := patternArgKinds[i]?.getD .relevant
args := args.set i ( goArg arg (inSupport || argKind.isSupport) argKind)
let isSupport := supportMask[i]?.getD false
args := args.set i ( goArg arg isSupport)
return mkAppN f args.toArray
where
goArg (arg : Expr) (inSupport : Bool) (argKind : PatternArgKind) : M Expr := do
goArg (arg : Expr) (isSupport : Bool) : M Expr := do
if !arg.hasLooseBVars then
if arg.hasMVar then
pure dontCare
@@ -447,23 +408,25 @@ where
pure <| mkGroundPattern arg
else match arg with
| .bvar idx =>
if inSupport && ( foundBVar idx) then
if isSupport && ( foundBVar idx) then
pure dontCare
else
saveBVar idx
pure arg
| _ =>
if let some _ getPatternFn? arg inSupport argKind then
go arg inSupport
if isSupport then
pure dontCare
else if let some _ := getPatternFn? arg then
go arg
else
pure dontCare
def main (patterns : List Expr) : MetaM (List Expr × List HeadIndex × Std.HashSet Nat) := do
let (patterns, s) patterns.mapM (go (inSupport := false)) |>.run {}
let (patterns, s) patterns.mapM go |>.run {}
return (patterns, s.symbols.toList, s.bvarsFound)
def normalizePattern (e : Expr) : M Expr := do
go e (inSupport := false)
go e
end NormalizePattern
@@ -705,11 +668,11 @@ private def isPatternFnCandidate (f : Expr) : CollectorM Bool := do
| _ => return false
private def addNewPattern (p : Expr) : CollectorM Unit := do
trace[grind.debug.ematch.pattern] "found pattern: {ppPattern p}"
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.debug.ematch.pattern] "found full coverage"
trace[grind.ematch.pattern.search] "found full coverage"
modify fun s => { s with patterns := s.patterns.push p, done }
/-- Collect the pattern (i.e., de Bruijn) variables in the given pattern. -/
@@ -733,11 +696,10 @@ Returns `true` if pattern `p` contains a child `c` such that
3- `c` is not an offset pattern.
4- `c` is not a bound variable.
-/
private def hasChildWithSameNewBVars (p : Expr)
(argKinds : Array NormalizePattern.PatternArgKind) (alreadyFound : Std.HashSet Nat) : CoreM Bool := do
private def hasChildWithSameNewBVars (p : Expr) (supportMask : Array Bool) (alreadyFound : Std.HashSet Nat) : CoreM Bool := do
let s := diff (collectPatternBVars p) alreadyFound
for arg in p.getAppArgs, argKind in argKinds do
unless argKind.isSupport do
for arg in p.getAppArgs, support in supportMask do
unless support do
unless arg.isBVar do
unless isOffsetPattern? arg |>.isSome do
let sArg := diff (collectPatternBVars arg) alreadyFound
@@ -749,33 +711,31 @@ private partial def collect (e : Expr) : CollectorM Unit := do
if ( get).done then return ()
match e with
| .app .. =>
trace[grind.debug.ematch.pattern] "collect: {e}"
let f := e.getAppFn
let argKinds NormalizePattern.getPatternArgKinds f e.getAppNumArgs
let supportMask NormalizePattern.getPatternSupportMask f e.getAppNumArgs
if ( isPatternFnCandidate f) then
let saved getThe NormalizePattern.State
try
trace[grind.debug.ematch.pattern] "candidate: {e}"
trace[grind.ematch.pattern.search] "candidate: {e}"
let p := e.abstract ( read).xs
unless p.hasLooseBVars do
trace[grind.debug.ematch.pattern] "skip, does not contain pattern variables"
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
unless ( hasChildWithSameNewBVars p argKinds saved.bvarsFound) do
unless ( hasChildWithSameNewBVars p supportMask saved.bvarsFound) do
addNewPattern p
return ()
trace[grind.debug.ematch.pattern] "skip, no new variables covered"
trace[grind.ematch.pattern.search] "skip, no new variables covered"
-- restore state and continue search
set saved
catch ex =>
trace[grind.debug.ematch.pattern] "skip, exception during normalization{indentD ex.toMessageData}"
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, argKind in argKinds do
trace[grind.debug.ematch.pattern] "arg: {arg}, support: {argKind.isSupport}"
unless argKind.isSupport do
for arg in args, support in supportMask do
unless support do
collect arg
| .forallE _ d b _ =>
if ( pure e.isArrow <&&> isProp d <&&> isProp b) then
@@ -786,7 +746,6 @@ private partial def collect (e : Expr) : CollectorM Unit := do
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
trace[grind.debug.ematch.pattern] "place: {place}"
let place preprocessPattern place
collect place
if ( get).done then
@@ -823,8 +782,8 @@ where
return some e
else
let args := e.getAppArgs
for arg in args, argKind in ( NormalizePattern.getPatternArgKinds f args.size) do
unless argKind.isSupport do
for arg in args, flag in ( NormalizePattern.getPatternSupportMask f args.size) do
unless flag do
if let some r visit? arg then
return r
return none

View File

@@ -37,13 +37,13 @@ def propagateForallPropUp (e : Expr) : GoalM Unit := do
where
propagateImpliesUp (a b : Expr) : GoalM Unit := do
unless ( alreadyInternalized b) do return ()
if ( isEqFalse a <&&> isProp b) then
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 <&&> isProp b) then
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 <&&> isProp a) then
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)
else if ( isEqFalse b <&&> isEqTrue e <&&> isProp a) then

View File

@@ -23,13 +23,12 @@ def addCongrTable (e : Expr) : GoalM Unit := do
if let some { e := e' } := ( get).congrTable.find? { e } then
-- `f` and `g` must have the same type.
-- See paper: Congruence Closure in Intensional Type Theory
if e.isApp then
let f := e.getAppFn
let g := e'.getAppFn
unless isSameExpr f g do
unless ( hasSameType f g) do
reportIssue! "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
return ()
let f := e.getAppFn
let g := e'.getAppFn
unless isSameExpr f g do
unless ( hasSameType f g) do
reportIssue! "found congruence between{indentExpr e}\nand{indentExpr e'}\nbut functions have different types"
return ()
trace_goal[grind.debug.congr] "{e} = {e'}"
pushEqHEq e e' congrPlaceholderProof
let node getENode e
@@ -115,7 +114,7 @@ private def pushCastHEqs (e : Expr) : GoalM Unit := do
| _ => return ()
private def preprocessGroundPattern (e : Expr) : GoalM Expr := do
shareCommon ( canon ( normalizeLevels ( foldProjs ( eraseIrrelevantMData ( unfoldReducible e)))))
shareCommon ( canon ( normalizeLevels ( eraseIrrelevantMData ( unfoldReducible e))))
private def mkENode' (e : Expr) (generation : Nat) : GoalM Unit :=
mkENodeCore e (ctor := false) (interpreted := false) (generation := generation)
@@ -300,13 +299,12 @@ private partial def internalizeImpl (e : Expr) (generation : Nat) (parent? : Opt
mkENode' e generation
| .forallE _ d b _ =>
mkENode' e generation
internalizeImpl d generation e
registerParent e d
unless b.hasLooseBVars do
internalizeImpl b generation e
registerParent e b
addCongrTable e
if ( isProp d <&&> isProp e) then
internalizeImpl d generation e
registerParent e d
unless b.hasLooseBVars do
internalizeImpl b generation e
registerParent e b
propagateUp e
checkAndAddSplitCandidate e
| .lit .. =>
@@ -315,8 +313,7 @@ private partial def internalizeImpl (e : Expr) (generation : Nat) (parent? : Opt
mkENode e generation
activateTheoremPatterns declName generation
| .mvar .. =>
if ( reportMVarInternalization) then
reportIssue! "unexpected metavariable during internalization{indentExpr e}\n`grind` is not supposed to be used in goals containing metavariables."
reportIssue! "unexpected metavariable during internalization{indentExpr e}\n`grind` is not supposed to be used in goals containing metavariables."
mkENode' e generation
| .mdata .. =>
reportIssue! "unexpected metadata found during internalization{indentExpr e}\n`grind` uses a pre-processing step that eliminates metadata"

View File

@@ -94,15 +94,15 @@ private def checkParents (e : Expr) : GoalM Unit := do
assert! ( getParents e).isEmpty
private def checkPtrEqImpliesStructEq : GoalM Unit := do
let exprs getExprs
for h₁ : i in [: exprs.size] do
let e := exprs[i]
for h₂ : j in [i+1 : exprs.size] do
let e := exprs[j]
let nodes getENodes
for h₁ : i in [: nodes.size] do
let n := nodes[i]
for h₂ : j in [i+1 : nodes.size] do
let n := nodes[j]
-- We don't have multiple nodes for the same expression
assert! !isSameExpr e₁ e₂
assert! !isSameExpr n₁.self n₂.self
-- and the two expressions must not be structurally equal
assert! !Expr.equal e₁ e₂
assert! !Expr.equal n₁.self n₂.self
private def checkProofs : GoalM Unit := do
let eqcs getEqcs
@@ -120,8 +120,7 @@ Checks basic invariants if `grind.debug` is enabled.
-/
def checkInvariants (expensive := false) : GoalM Unit := do
if grind.debug.get ( getOptions) then
for e in ( getExprs) do
let node getENode e
for (_, node) in ( get).enodes do
checkParents node.self
if isSameExpr node.self node.root then
checkEqc node

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