Compare commits

..

2 Commits

Author SHA1 Message Date
Kim Morrison
9b4b279ca0 update release_checklist.md 2025-01-04 12:15:49 +11:00
Kim Morrison
8cce6ac6aa feat: add script for generating release notes 2025-01-04 11:58:34 +11:00
641 changed files with 2576 additions and 25056 deletions

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

@@ -33,9 +33,6 @@ Format of the commit message
- chore (maintain, ex: travis-ci)
- perf (performance improvement, optimization, ...)
Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
beginning with "This PR " that will be included in the changelog.
``<subject>`` has the following constraints:
- use imperative, present tense: "change" not "changed" nor "changes"
@@ -47,7 +44,6 @@ beginning with "This PR " that will be included in the changelog.
- just as in ``<subject>``, use imperative, present tense
- includes motivation for the change and contrasts with previous
behavior
- If a `changelog-*` label is present, the body must begin with "This PR ".
``<footer>`` is optional and may contain two items:
@@ -64,21 +60,17 @@ Examples
fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
This PR adds declarations `operator<<` for raw printing.
The actual implementation of these two operators is outside of the
kernel. They are implemented in the file 'library/printer.cpp'.
We declare them in the kernel to prevent the following problem.
Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
kernel. They are implemented in the file 'library/printer.cpp'. We
declare them in the kernel to prevent the following problem. Suppose
there is a file 'foo.cpp' that does not include 'library/printer.h',
but contains
```cpp
expr a;
...
std::cout << a << "\n";
...
```
expr a;
...
std::cout << a << "\n";
...
The compiler does not generate an error message. It silently uses the
operator bool() to coerce the expression into a Boolean. This produces
counter-intuitive behavior, and may confuse developers.

View File

@@ -49,9 +49,8 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
is represented by the representation of that parameter's type.
For example, `{ x : α // p }`, the `Subtype` structure of a value of type `α` and an irrelevant proof, is represented by the representation of `α`.
Similarly, the signed integer types `Int8`, ..., `Int64`, `ISize` are also represented by the unsigned C types `uint8_t`, ..., `uint64_t`, `size_t`, respectively, because they have a trivial structure.
* `Nat` and `Int` are represented by `lean_object *`.
Their runtime values is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number or integer (`lean_box`/`lean_unbox`).
* `Nat` is represented by `lean_object *`.
Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
* A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
* Any other type is represented by `lean_object *`.
Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.

View File

@@ -80,10 +80,3 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
`prelude` keyword. This disables the automated import of `Init`, meaning that
developers need to figure out their own subset of `Init` to import. This is done
such that changing files in `Init` doesn't force a full rebuild of `Lean`.
### Testing against Mathlib/Batteries
You can test a Lean PR against Mathlib and Batteries by rebasing your PR
on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.

View File

@@ -37,32 +37,16 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Create the tag `v4.6.0` from `master`/`main` and push it.
- Merge the tag `v4.6.0` into the `stable` branch and push it.
- We do this for the repositories:
- [Batteries](https://github.com/leanprover-community/batteries)
- No dependencies
- Toolchain bump PR
- Create and push the tag
- Merge the tag into `stable`
- [lean4checker](https://github.com/leanprover/lean4checker)
- No dependencies
- Toolchain bump PR
- Create and push the tag
- Merge the tag into `stable`
- [doc-gen4](https://github.com/leanprover/doc-gen4)
- Dependencies: exist, but they're not part of the release workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Verso](https://github.com/leanprover/verso)
- Dependencies: exist, but they're not part of the release workflow
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Cli](https://github.com/leanprover/lean4-cli)
- [Batteries](https://github.com/leanprover-community/batteries)
- No dependencies
- Toolchain bump PR
- Create and push the tag
- There is no `stable` branch; skip this step
- Merge the tag into `stable`
- [ProofWidgets4](https://github.com/leanprover-community/ProofWidgets4)
- Dependencies: `Batteries`
- Note on versions and branches:
@@ -77,11 +61,18 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- [import-graph](https://github.com/leanprover-community/import-graph)
- [doc-gen4](https://github.com/leanprover/doc-gen4)
- Dependencies: exist, but they're not part of the release workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [plausible](https://github.com/leanprover-community/plausible)
- [Verso](https://github.com/leanprover/verso)
- Dependencies: exist, but they're not part of the release workflow
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [import-graph](https://github.com/leanprover-community/import-graph)
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
@@ -102,7 +93,6 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- Run `scripts/release_checklist.py v4.6.0` to check that everything is in order.
- The `v4.6.0` section of `RELEASES.md` is out of sync between
`releases/v4.6.0` and `master`. This should be reconciled:
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,227 +0,0 @@
#!/usr/bin/env python3
import argparse
import yaml
import requests
import base64
import subprocess
import sys
import os
def parse_repos_config(file_path):
with open(file_path, "r") as f:
return yaml.safe_load(f)["repositories"]
def get_github_token():
try:
import subprocess
result = subprocess.run(['gh', 'auth', 'token'], capture_output=True, text=True)
if result.returncode == 0:
return result.stdout.strip()
except FileNotFoundError:
print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
return None
def strip_rc_suffix(toolchain):
"""Remove -rcX suffix from the toolchain."""
return toolchain.split("-")[0]
def branch_exists(repo_url, branch, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/branches/{branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def tag_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def release_page_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def get_release_notes(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
return response.json().get("body", "").strip()
return None
def get_branch_content(repo_url, branch, file_path, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
content = response.json().get("content", "")
content = content.replace("\n", "")
try:
return base64.b64decode(content).decode('utf-8').strip()
except Exception:
return None
return None
def parse_version(version_str):
# Remove 'v' prefix and extract version and release candidate suffix
if ':' in version_str:
version_str = version_str.split(':')[1]
version = version_str.lstrip('v')
parts = version.split('-')
base_version = tuple(map(int, parts[0].split('.')))
rc_part = parts[1] if len(parts) > 1 and parts[1].startswith('rc') else None
rc_number = int(rc_part[2:]) if rc_part else float('inf') # Treat non-rc as higher than rc
return base_version + (rc_number,)
def is_version_gte(version1, version2):
"""Check if version1 >= version2, including proper handling of release candidates."""
return parse_version(version1) >= parse_version(version2)
def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
# First get the commit SHA for the tag
api_base = repo_url.replace("https://github.com/", "https://api.github.com/repos/")
headers = {'Authorization': f'token {github_token}'} if github_token else {}
# Get tag's commit SHA
tag_response = requests.get(f"{api_base}/git/refs/tags/{tag_name}", headers=headers)
if tag_response.status_code != 200:
return False
tag_sha = tag_response.json()['object']['sha']
# Get commits on stable branch containing this SHA
commits_response = requests.get(
f"{api_base}/commits?sha={stable_branch}&per_page=100",
headers=headers
)
if commits_response.status_code != 200:
return False
# Check if any commit in stable's history matches our tag's SHA
stable_commits = [commit['sha'] for commit in commits_response.json()]
return tag_sha in stable_commits
def is_release_candidate(version):
return "-rc" in version
def check_cmake_version(repo_url, branch, version_major, version_minor, github_token):
"""Verify the CMake version settings in src/CMakeLists.txt."""
cmake_file_path = "src/CMakeLists.txt"
content = get_branch_content(repo_url, branch, cmake_file_path, github_token)
if content is None:
print(f" ❌ Could not retrieve {cmake_file_path} from {branch}")
return False
expected_lines = [
f"set(LEAN_VERSION_MAJOR {version_major})",
f"set(LEAN_VERSION_MINOR {version_minor})",
f"set(LEAN_VERSION_PATCH 0)",
f"set(LEAN_VERSION_IS_RELEASE 1)"
]
for line in expected_lines:
if not any(l.strip().startswith(line) for l in content.splitlines()):
print(f" ❌ Missing or incorrect line in {cmake_file_path}: {line}")
return False
print(f" ✅ CMake version settings are correct in {cmake_file_path}")
return True
def extract_org_repo_from_url(repo_url):
"""Extract the 'org/repo' part from a GitHub URL."""
if repo_url.startswith("https://github.com/"):
return repo_url.replace("https://github.com/", "").rstrip("/")
return repo_url
def main():
github_token = get_github_token()
if len(sys.argv) != 2:
print("Usage: python3 release_checklist.py <toolchain>")
sys.exit(1)
toolchain = sys.argv[1]
stripped_toolchain = strip_rc_suffix(toolchain)
lean_repo_url = "https://github.com/leanprover/lean4"
# Preliminary checks
print("\nPerforming preliminary checks...")
# Check for branch releases/v4.Y.0
version_major, version_minor, _ = map(int, stripped_toolchain.lstrip('v').split('.'))
branch_name = f"releases/v{version_major}.{version_minor}.0"
if branch_exists(lean_repo_url, branch_name, github_token):
print(f" ✅ Branch {branch_name} exists")
# Check CMake version settings
check_cmake_version(lean_repo_url, branch_name, version_major, version_minor, github_token)
else:
print(f" ❌ Branch {branch_name} does not exist")
# Check for tag v4.X.Y(-rcZ)
if tag_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Tag {toolchain} exists")
else:
print(f" ❌ Tag {toolchain} does not exist.")
# Check for release page
if release_page_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Release page for {toolchain} exists")
# Check the first line of the release notes
release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
if release_notes and release_notes.splitlines()[0].strip() == toolchain:
print(f" ✅ Release notes look good.")
else:
previous_minor_version = version_minor - 1
previous_stable_branch = f"releases/v{version_major}.{previous_minor_version}.0"
previous_release = f"v{version_major}.{previous_minor_version}.0"
print(f" ❌ Release notes not published. Please run `script/release_notes.py {previous_release}` on branch `{previous_stable_branch}`.")
else:
print(f" ❌ Release page for {toolchain} does not exist")
# Load repositories and perform further checks
print("\nChecking repositories...")
with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
repos = yaml.safe_load(f)["repositories"]
for repo in repos:
name = repo["name"]
url = repo["url"]
branch = repo["branch"]
check_stable = repo["stable-branch"]
check_tag = repo.get("toolchain-tag", True)
print(f"\nRepository: {name}")
# Check if branch is on at least the target toolchain
lean_toolchain_content = get_branch_content(url, branch, "lean-toolchain", github_token)
if lean_toolchain_content is None:
print(f" ❌ No lean-toolchain file found in {branch} branch")
continue
on_target_toolchain = is_version_gte(lean_toolchain_content.strip(), toolchain)
if not on_target_toolchain:
print(f" ❌ Not on target toolchain (needs ≥ {toolchain}, but {branch} is on {lean_toolchain_content.strip()})")
continue
print(f" ✅ On compatible toolchain (>= {toolchain})")
# Only check for tag if toolchain-tag is true
if check_tag:
if not tag_exists(url, toolchain, github_token):
print(f" ❌ Tag {toolchain} does not exist. Run `script/push_repo_release_tag.py {extract_org_repo_from_url(url)} {branch} {toolchain}`.")
continue
print(f" ✅ Tag {toolchain} exists")
# Only check merging into stable if stable-branch is true and not a release candidate
if check_stable and not is_release_candidate(toolchain):
if not is_merged_into_stable(url, toolchain, "stable", github_token):
print(f" ❌ Tag {toolchain} is not merged into stable")
continue
print(f" ✅ Tag {toolchain} is merged into stable")
if __name__ == "__main__":
main()

View File

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

View File

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

View File

@@ -37,4 +37,3 @@ import Init.MacroTrace
import Init.Grind
import Init.While
import Init.Syntax
import Init.Internal

View File

@@ -150,10 +150,6 @@ See the `simp` tactic for more information. -/
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
/-- `simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
that would be sufficient to close the goal. See the `simp?` tactic for more information. -/
syntax (name := simpTrace) "simp?" optConfig (discharger)? (&" only")? (simpArgs)? : conv
/--
`dsimp` is the definitional simplifier in `conv`-mode. It differs from `simp` in that it only
applies theorems that hold by reflexivity.
@@ -171,9 +167,6 @@ example (a : Nat): (0 + 0) = a - a := by
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
@[inherit_doc simpTrace]
syntax (name := dsimpTrace) "dsimp?" optConfig (&" only")? (dsimpArgs)? : conv
/-- `simp_match` simplifies match expressions. For example,
```
match [a, b] with

View File

@@ -244,7 +244,8 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
def range (n : Nat) : Array Nat :=
ofFn fun (i : Fin n) => i
@[inline] protected def singleton (v : α) : Array α := #[v]
def singleton (v : α) : Array α :=
mkArray 1 v
def back! [Inhabited α] (a : Array α) : α :=
a[a.size - 1]!
@@ -576,12 +577,6 @@ def foldl {α : Type u} {β : Type v} (f : β → α → β) (init : β) (as : A
def foldr {α : Type u} {β : Type v} (f : α β β) (init : β) (as : Array α) (start := as.size) (stop := 0) : β :=
Id.run <| as.foldrM f init start stop
/-- Sum of an array.
`Array.sum #[a, b, c] = a + (b + (c + 0))` -/
def sum {α} [Add α] [Zero α] : Array α α :=
foldr (· + ·) 0
@[inline]
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

@@ -17,8 +17,8 @@ namespace Array
@[simp] theorem lt_toList [LT α] (l₁ l₂ : Array α) : l₁.toList < l₂.toList l₁ < l₂ := Iff.rfl
@[simp] theorem le_toList [LT α] (l₁ l₂ : Array α) : l₁.toList l₂.toList l₁ l₂ := 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 α) :
theorem not_lt_iff_ge [LT α] (l₁ l₂ : List α) : ¬ l₁ < l₂ l₂ l₁ := Iff.rfl
theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : List α) :
¬ l₁ l₂ l₂ < l₁ :=
Decidable.not_not
@@ -135,7 +135,7 @@ protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
{l₁ l₂ : Array α} (h : l₁ < l₂) : l₁ l₂ :=
List.le_of_lt h
protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
[Std.Total (¬ · < · : α α Prop)]
@@ -211,7 +211,7 @@ theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : αα
cases l₂
simp_all [List.lex_eq_false_iff_exists]
protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Array α} :
theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Array α} :
l₁ < l₂
(l₁ = l₂.take l₁.size l₁.size < l₂.size)
( (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
@@ -221,7 +221,7 @@ protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁
cases l₂
simp [List.lt_iff_exists]
protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)] {l₁ l₂ : Array α} :
@@ -258,14 +258,14 @@ theorem le_append_left [LT α] [Std.Irrefl (· < · : αα → Prop)]
cases l₂
simpa using List.le_append_left
protected theorem map_lt [LT α] [LT β]
theorem map_lt [LT α] [LT β]
{l₁ l₂ : Array α} {f : α β} (w : x y, x < y f x < f y) (h : l₁ < l₂) :
map f l₁ < map f l₂ := by
cases l₁
cases l₂
simpa using List.map_lt w h
protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]

View File

@@ -9,9 +9,7 @@ import Init.Data.Bool
import Init.Data.BitVec.Basic
import Init.Data.Fin.Lemmas
import Init.Data.Nat.Lemmas
import Init.Data.Nat.Div.Lemmas
import Init.Data.Nat.Mod
import Init.Data.Nat.Div.Lemmas
import Init.Data.Int.Bitwise.Lemmas
import Init.Data.Int.Pow
@@ -100,12 +98,6 @@ theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by
theorem eq_of_toNat_eq {n} : {x y : BitVec n}, x.toNat = y.toNat x = y
| _, _, _, _, rfl => rfl
/-- Prove nonequality of bitvectors in terms of nat operations. -/
theorem toNat_ne_iff_ne {n} {x y : BitVec n} : x.toNat y.toNat x y := by
constructor
· rintro h rfl; apply h rfl
· intro h h_eq; apply h <| eq_of_toNat_eq h_eq
@[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl
@[bv_toNat] theorem toNat_eq {x y : BitVec n} : x = y x.toNat = y.toNat :=
@@ -450,10 +442,6 @@ theorem toInt_eq_toNat_cond (x : BitVec n) :
(x.toNat : Int) - (2^n : Nat) :=
rfl
theorem toInt_eq_toNat_of_lt {x : BitVec n} (h : 2 * x.toNat < 2^n) :
x.toInt = x.toNat := by
simp [toInt_eq_toNat_cond, h]
theorem msb_eq_false_iff_two_mul_lt {x : BitVec w} : x.msb = false 2 * x.toNat < 2^w := by
cases w <;> simp [Nat.pow_succ, Nat.mul_comm _ 2, msb_eq_decide, toNat_of_zero_length]
@@ -466,9 +454,6 @@ theorem toInt_eq_msb_cond (x : BitVec w) :
simp only [BitVec.toInt, msb_eq_false_iff_two_mul_lt]
cases x.msb <;> rfl
theorem toInt_eq_toNat_of_msb {x : BitVec w} (h : x.msb = false) :
x.toInt = x.toNat := by
simp [toInt_eq_msb_cond, h]
theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) := by
simp only [toInt_eq_toNat_cond]
@@ -800,19 +785,6 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
unfold allOnes
simp
@[simp] theorem toInt_allOnes : (allOnes w).toInt = if 0 < w then -1 else 0 := by
norm_cast
by_cases h : w = 0
· subst h
simp
· have : 1 < 2 ^ w := by simp [h]
simp [BitVec.toInt]
omega
@[simp] theorem toFin_allOnes : (allOnes w).toFin = Fin.ofNat' (2^w) (2^w - 1) := by
ext
simp
@[simp] theorem getLsbD_allOnes : (allOnes v).getLsbD i = decide (i < v) := by
simp [allOnes]
@@ -1170,16 +1142,11 @@ theorem getMsb_not {x : BitVec w} :
/-! ### shiftLeft -/
@[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
(x <<< n).toNat = x.toNat <<< n % 2^v :=
BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v :=
BitVec.toNat_ofNat _ _
@[simp] theorem toInt_shiftLeft {x : BitVec w} :
(x <<< n).toInt = (x.toNat <<< n : Int).bmod (2^w) := by
rw [toInt_eq_toNat_bmod, toNat_shiftLeft, Nat.shiftLeft_eq]
simp
@[simp] theorem toFin_shiftLeft {n : Nat} (x : BitVec w) :
(x <<< n).toFin = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
BitVec.toFin (x <<< n) = Fin.ofNat' (2^w) (x.toNat <<< n) := rfl
@[simp]
theorem shiftLeft_zero (x : BitVec w) : x <<< 0 = x := by
@@ -2315,12 +2282,6 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
@[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
simp [Neg.neg, BitVec.neg]
theorem toNat_neg_of_pos {x : BitVec n} (h : 0#n < x) :
(- x).toNat = 2^n - x.toNat := by
change 0 < x.toNat at h
rw [toNat_neg, Nat.mod_eq_of_lt]
omega
theorem toInt_neg {x : BitVec w} :
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
rw [ BitVec.zero_sub, toInt_sub]
@@ -2416,54 +2377,6 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
omega
/-! ### fill -/
@[simp]
theorem getLsbD_fill {w i : Nat} {v : Bool} :
(fill w v).getLsbD i = (v && decide (i < w)) := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem getMsbD_fill {w i : Nat} {v : Bool} :
(fill w v).getMsbD i = (v && decide (i < w)) := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem getElem_fill {w i : Nat} {v : Bool} (h : i < w) :
(fill w v)[i] = v := by
by_cases h : v
<;> simp [h, BitVec.fill, BitVec.negOne_eq_allOnes]
@[simp]
theorem msb_fill {w : Nat} {v : Bool} :
(fill w v).msb = (v && decide (0 < w)) := by
simp [BitVec.msb]
theorem fill_eq {w : Nat} {v : Bool} : fill w v = if v = true then allOnes w else 0#w := by
by_cases h : v <;> (simp only [h] ; ext ; simp)
@[simp]
theorem fill_true {w : Nat} : fill w true = allOnes w := by
simp [fill_eq]
@[simp]
theorem fill_false {w : Nat} : fill w false = 0#w := by
simp [fill_eq]
@[simp] theorem fill_toNat {w : Nat} {v : Bool} :
(fill w v).toNat = if v = true then 2^w - 1 else 0 := by
by_cases h : v <;> simp [h]
@[simp] theorem fill_toInt {w : Nat} {v : Bool} :
(fill w v).toInt = if v = true && 0 < w then -1 else 0 := by
by_cases h : v <;> simp [h]
@[simp] theorem fill_toFin {w : Nat} {v : Bool} :
(fill w v).toFin = if v = true then (allOnes w).toFin else Fin.ofNat' (2 ^ w) 0 := by
by_cases h : v <;> simp [h]
/-! ### mul -/
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
@@ -2607,13 +2520,13 @@ theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) :
rw [ udiv_eq]
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
@[simp]
theorem toFin_udiv {x y : BitVec n} : (x / y).toFin = x.toFin / y.toFin := by
rfl
@[simp, bv_toNat]
theorem toNat_udiv {x y : BitVec n} : (x / y).toNat = x.toNat / y.toNat := by
rfl
rw [udiv_def]
by_cases h : y = 0
· simp [h]
· rw [toNat_ofNat, Nat.mod_eq_of_lt]
exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
@[simp]
theorem zero_udiv {x : BitVec w} : (0#w) / x = 0#w := by
@@ -2649,45 +2562,6 @@ theorem udiv_self {x : BitVec w} :
reduceIte, toNat_udiv]
rw [Nat.div_self (by omega), Nat.mod_eq_of_lt (by omega)]
theorem msb_udiv (x y : BitVec w) :
(x / y).msb = (x.msb && y == 1#w) := by
cases msb_x : x.msb
· suffices x.toNat / y.toNat < 2 ^ (w - 1) by simpa [msb_eq_decide]
calc
x.toNat / y.toNat x.toNat := by apply Nat.div_le_self
_ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
. rcases w with _|w
· contradiction
· have : (y == 1#_) = decide (y.toNat = 1) := by
simp [(· == ·), toNat_eq]
simp only [this, Bool.true_and]
match hy : y.toNat with
| 0 =>
obtain rfl : y = 0#_ := eq_of_toNat_eq hy
simp
| 1 =>
obtain rfl : y = 1#_ := eq_of_toNat_eq (by simp [hy])
simpa using msb_x
| y + 2 =>
suffices x.toNat / (y + 2) < 2 ^ w by
simp_all [msb_eq_decide, hy]
calc
x.toNat / (y + 2)
x.toNat / 2 := by apply Nat.div_add_le_right (by omega)
_ < 2 ^ w := by omega
theorem msb_udiv_eq_false_of {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
(x / y).msb = false := by
simp [msb_udiv, h]
/--
If `x` is nonnegative (i.e., does not have its msb set),
then `x / y` is nonnegative, thus `toInt` and `toNat` coincide.
-/
theorem toInt_udiv_of_msb {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
(x / y).toInt = x.toNat / y.toNat := by
simp [toInt_eq_msb_cond, msb_udiv_eq_false_of h]
/-! ### umod -/
theorem umod_def {x y : BitVec n} :
@@ -2700,10 +2574,6 @@ theorem umod_def {x y : BitVec n} :
theorem toNat_umod {x y : BitVec n} :
(x % y).toNat = x.toNat % y.toNat := rfl
@[simp]
theorem toFin_umod {x y : BitVec w} :
(x % y).toFin = x.toFin % y.toFin := rfl
@[simp]
theorem umod_zero {x : BitVec n} : x % 0#n = x := by
simp [umod_def]
@@ -2731,55 +2601,6 @@ theorem umod_eq_and {x y : BitVec 1} : x % y = x &&& (~~~y) := by
rcases hy with rfl | rfl <;>
rfl
theorem umod_eq_of_lt {x y : BitVec w} (h : x < y) :
x % y = x := by
apply eq_of_toNat_eq
simp [Nat.mod_eq_of_lt h]
@[simp]
theorem msb_umod {x y : BitVec w} :
(x % y).msb = (x.msb && (x < y || y == 0#w)) := by
rw [msb_eq_decide, toNat_umod]
cases msb_x : x.msb
· suffices x.toNat % y.toNat < 2 ^ (w - 1) by simpa
calc
x.toNat % y.toNat x.toNat := by apply Nat.mod_le
_ < 2 ^ (w - 1) := by simpa [msb_eq_decide] using msb_x
. by_cases hy : y = 0
· simp_all [msb_eq_decide]
· suffices 2 ^ (w - 1) x.toNat % y.toNat x < y by simp_all
by_cases x_lt_y : x < y
. simp_all [Nat.mod_eq_of_lt x_lt_y, msb_eq_decide]
· suffices x.toNat % y.toNat < 2 ^ (w - 1) by
simpa [x_lt_y]
have y_le_x : y.toNat x.toNat := by
simpa using x_lt_y
replace hy : y.toNat 0 :=
toNat_ne_iff_ne.mpr hy
by_cases msb_y : y.toNat < 2 ^ (w - 1)
· have : x.toNat % y.toNat < y.toNat := Nat.mod_lt _ (by omega)
omega
· rcases w with _|w
· contradiction
simp only [Nat.add_one_sub_one]
replace msb_y : 2 ^ w y.toNat := by
simpa using msb_y
have : y.toNat y.toNat * (x.toNat / y.toNat) := by
apply Nat.le_mul_of_pos_right
apply Nat.div_pos y_le_x
omega
have : x.toNat % y.toNat x.toNat - y.toNat := by
rw [Nat.mod_eq_sub]; omega
omega
theorem toInt_umod {x y : BitVec w} :
(x % y).toInt = (x.toNat % y.toNat : Int).bmod (2 ^ w) := by
simp [toInt_eq_toNat_bmod]
theorem toInt_umod_of_msb {x y : BitVec w} (h : x.msb = false) :
(x % y).toInt = x.toInt % y.toNat := by
simp [toInt_eq_msb_cond, h]
/-! ### smtUDiv -/
theorem smtUDiv_eq (x y : BitVec w) : smtUDiv x y = if y = 0#w then allOnes w else x / y := by
@@ -2936,12 +2757,7 @@ theorem smod_zero {x : BitVec n} : x.smod 0#n = x := by
/-! # Rotate Left -/
/--`rotateLeft` is defined in terms of left and right shifts. -/
theorem rotateLeft_def {x : BitVec w} {r : Nat} :
x.rotateLeft r = (x <<< (r % w)) ||| (x >>> (w - r % w)) := by
simp only [rotateLeft, rotateLeftAux]
/-- `rotateLeft` is invariant under `mod` by the bitwidth. -/
/-- rotateLeft is invariant under `mod` by the bitwidth. -/
@[simp]
theorem rotateLeft_mod_eq_rotateLeft {x : BitVec w} {r : Nat} :
x.rotateLeft (r % w) = x.rotateLeft r := by
@@ -3085,18 +2901,8 @@ theorem msb_rotateLeft {m w : Nat} {x : BitVec w} :
· simp
omega
@[simp]
theorem toNat_rotateLeft {x : BitVec w} {r : Nat} :
(x.rotateLeft r).toNat = (x.toNat <<< (r % w)) % (2^w) ||| x.toNat >>> (w - r % w) := by
simp only [rotateLeft_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
/-! ## Rotate Right -/
/-- `rotateRight` is defined in terms of left and right shifts. -/
theorem rotateRight_def {x : BitVec w} {r : Nat} :
x.rotateRight r = (x >>> (r % w)) ||| (x <<< (w - r % w)) := by
simp only [rotateRight, rotateRightAux]
/--
Accessing bits in `x.rotateRight r` the range `[0, w-r)` is equal to
accessing bits `x` in the range `[r, w)`.
@@ -3232,11 +3038,6 @@ theorem msb_rotateRight {r w : Nat} {x : BitVec w} :
simp [h₁]
· simp [show w = 0 by omega]
@[simp]
theorem toNat_rotateRight {x : BitVec w} {r : Nat} :
(x.rotateRight r).toNat = (x.toNat >>> (r % w)) ||| x.toNat <<< (w - r % w) % (2^w) := by
simp only [rotateRight_def, toNat_shiftLeft, toNat_ushiftRight, toNat_or]
/- ## twoPow -/
theorem twoPow_eq (w : Nat) (i : Nat) : twoPow w i = 1#w <<< i := by
@@ -3539,7 +3340,7 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
/-! ### Non-overflow theorems -/
/-- If `x.toNat + y.toNat < 2^w`, then the addition `(x + y)` does not overflow. -/
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
(x + y).toNat = x.toNat + y.toNat := by
rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]

View File

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

View File

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

View File

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

View File

@@ -1,8 +1,7 @@
/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
Kim Morrison
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.Bool
@@ -758,6 +757,207 @@ theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l
| nil => simp
| cons b l₂ => simp [isEqv, ih]
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β α m β) (b) :
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : List α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
induction l generalizing b <;> simp [*]
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α β m β) (b) :
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
simp only [foldrM]
induction l <;> simp_all
theorem foldl_eq_foldlM (f : β α β) (b) (l : List α) :
l.foldl f b = l.foldlM (m := Id) f b := by
induction l generalizing b <;> simp [*, foldl]
theorem foldr_eq_foldrM (f : α β β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : List α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : List α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
induction l <;> simp [*]
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
induction l generalizing l' <;> simp [*]
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
theorem foldl_map (f : β₁ β₂) (g : α β₂ α) (l : List β₁) (init : α) :
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
induction l generalizing init <;> simp [*]
theorem foldr_map (f : α₁ α₂) (g : α₂ β β) (l : List α₁) (init : β) :
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
induction l generalizing init <;> simp [*]
theorem foldl_filterMap (f : α Option β) (g : γ β γ) (l : List α) (init : γ) :
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldl_cons]
cases f a <;> simp [ih]
theorem foldr_filterMap (f : α Option β) (g : β γ γ) (l : List α) (init : γ) :
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldr_cons]
cases f a <;> simp [ih]
theorem foldl_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldr_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldl_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldl_cons, ha.assoc]
rw [foldl_assoc]
theorem foldr_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldr_cons, ha.assoc]
rw [foldr_assoc]
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : List β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
induction l generalizing init <;> simp [*, H]
theorem foldr_hom (f : β₁ β₂) (g₁ : α β₁ β₁) (g₂ : α β₂ β₂) (l : List α) (init : β₁)
(H : x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
induction l <;> simp [*, H]
/--
Prove a proposition about the result of `List.foldl`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldlRecOn {motive : β Sort _} : (l : List α) (op : β α β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op b a)), motive (List.foldl op b l)
| [], _, _, hb, _ => hb
| hd :: tl, op, b, hb, hl =>
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
@[simp] theorem foldlRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op b a)) :
foldlRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldlRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op b a)) :
foldlRecOn (x :: l) op b hb hl =
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
rfl
/--
Prove a proposition about the result of `List.foldr`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldrRecOn {motive : β Sort _} : (l : List α) (op : α β β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op a b)), motive (List.foldr op b l)
| nil, _, _, hb, _ => hb
| x :: l, op, b, hb, hl =>
hl (foldr op b l)
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
@[simp] theorem foldrRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op a b)) :
foldrRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldrRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op a b)) :
foldrRecOn (x :: l) op b hb hl =
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
x (mem_cons_self x l) :=
rfl
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldl_rel {l : List α} {f g : β α β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f c a) (g c' a)) :
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldl_cons]
apply ih
· simp_all
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldr_rel {l : List α} {f g : α β β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f a c) (g a c')) :
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldr_cons]
apply h'
· simp
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
l.foldl (fun x _ => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
Nat.add_comm a]
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
l.foldr (fun _ x => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
/-! ### getLast -/
theorem getLast_eq_getElem : (l : List α) (h : l []),
@@ -1016,6 +1216,27 @@ theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then n
/-! ### map -/
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : List α) : map (id : α α) l = l := by
induction l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : List α) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f [a] = [f a] := rfl
@[simp] theorem length_map (as : List α) (f : α β) : (as.map f).length = as.length := by
induction as with
| nil => simp [List.map]
@@ -1041,27 +1262,6 @@ theorem get_map (f : α → β) {l i} :
get (map f l) i = f (get l i, length_map l f i.2) := by
simp
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : List α) : map (id : α α) l = l := by
induction l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : List α) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : List α) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f [a] = [f a] := rfl
@[simp] theorem mem_map {f : α β} : {l : List α}, b l.map f a, a l f a = b
| [] => by simp
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
@@ -1076,31 +1276,9 @@ theorem forall_mem_map {f : α → β} {l : List α} {P : β → Prop} :
@[deprecated forall_mem_map (since := "2024-07-25")] abbrev forall_mem_map_iff := @forall_mem_map
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
induction l <;> simp_all
theorem map_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
induction l generalizing l' with
| nil => simp
| cons a l ih =>
simp only [map_cons]
cases l' with
| nil => simp
| cons a' l' =>
simp only [map_cons, cons.injEq, ih, and_congr_left_iff]
intro h
constructor
· apply w
· simp +contextual
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
@@ -1109,6 +1287,14 @@ theorem map_inj : map f = map g ↔ f = g := by
· intro h; ext a; replace h := congrFun h [a]; simpa using h
· intro h; subst h; rfl
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
theorem map_eq_cons_iff {f : α β} {l : List α} :
map f l = b :: l₂ a l₁, l = a :: l₁ f a = b map f l₁ = l₂ := by
cases l
@@ -1129,10 +1315,6 @@ theorem map_eq_cons_iff' {f : α → β} {l : List α} :
@[deprecated map_eq_cons' (since := "2024-09-05")] abbrev map_eq_cons' := @map_eq_cons_iff'
@[simp] theorem map_eq_singleton_iff {f : α β} {l : List α} {b : β} :
map f l = [b] a, l = [a] f a = b := by
simp [map_eq_cons_iff]
theorem map_eq_map_iff : map f l = map g l a l, f a = g a := by
induction l <;> simp
@@ -1299,7 +1481,7 @@ theorem map_filter_eq_foldr (f : α → β) (p : α → Bool) (as : List α) :
@[simp] theorem filter_append {p : α Bool} :
(l₁ l₂ : List α), filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂
| [], _ => rfl
| a :: l₁, l₂ => by simp only [cons_append, filter]; split <;> simp [filter_append l₁]
| a :: l₁, l₂ => by simp [filter]; split <;> simp [filter_append l₁]
theorem filter_eq_cons_iff {l} {a} {as} :
filter p l = a :: as
@@ -1508,34 +1690,6 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
@[simp] theorem cons_append_fun (a : α) (as : List α) :
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
@[simp] theorem mem_append {a : α} {s t : List α} : a s ++ t a s a t := by
induction s <;> simp_all [or_assoc]
theorem not_mem_append {a : α} {s t : List α} (h₁ : a s) (h₂ : a t) : a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
@[deprecated mem_append (since := "2025-01-13")]
theorem mem_append_eq (a : α) (s t : List α) : (a s ++ t) = (a s a t) :=
propext mem_append
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
/--
See also `eq_append_cons_of_mem`, which proves a stronger version
in which the initial list must not contain the element.
-/
theorem append_of_mem {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t
| .head l => [], l, rfl
| .tail b h => let s, t, h' := append_of_mem h; b::s, t, by rw [h', cons_append]
theorem mem_iff_append {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t :=
append_of_mem, fun s, t, e => e by simp
theorem forall_mem_append {p : α Prop} {l₁ l₂ : List α} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem getElem_append {l₁ l₂ : List α} (i : Nat) (h : i < (l₁ ++ l₂).length) :
(l₁ ++ l₂)[i] = if h' : i < l₁.length then l₁[i] else l₂[i - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
split <;> rename_i h'
@@ -1603,6 +1757,14 @@ theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.lengt
l.get i, get_of_append_proof eq h = a := Option.some.inj <| by
rw [ get?_eq_get, eq, get?_append_right (h Nat.le_refl _), h, Nat.sub_self]; rfl
/--
See also `eq_append_cons_of_mem`, which proves a stronger version
in which the initial list must not contain the element.
-/
theorem append_of_mem {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t
| .head l => [], l, rfl
| .tail b h => let s, t, h' := append_of_mem h; b::s, t, by rw [h', cons_append]
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
theorem append_inj :
@@ -1619,8 +1781,8 @@ theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = le
/-- Variant of `append_inj` instead requiring equality of the lengths of the second lists. -/
theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ t₁ = t₂ :=
append_inj h <| @Nat.add_right_cancel _ t₁.length _ <| by
let hap := congrArg length h; simp only [length_append, hl] at hap; exact hap
append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
let hap := congrArg length h; simp only [length_append, hl] at hap; exact hap
/-- Variant of `append_inj_right` instead requiring equality of the lengths of the second lists. -/
theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
@@ -1648,6 +1810,9 @@ theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s
@[simp] theorem self_eq_append_right {x y : List α} : x = x ++ y y = [] := by
rw [eq_comm, append_right_eq_self]
@[simp] theorem append_eq_nil : p ++ q = [] p = [] q = [] := by
cases p <;> simp
theorem getLast_concat {a : α} : (l : List α), getLast (l ++ [a]) (by simp) = a
| [] => rfl
| a::t => by
@@ -1673,54 +1838,6 @@ theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
(l₁ ++ l₂).get? n = l₁.get? n := by
simp [getElem?_append_left hn]
@[simp] theorem append_eq_nil_iff : p ++ q = [] p = [] q = [] := by
cases p <;> simp
@[deprecated append_eq_nil_iff (since := "2025-01-13")] abbrev append_eq_nil := @append_eq_nil_iff
@[simp] theorem nil_eq_append_iff : [] = a ++ b a = [] b = [] := by
rw [eq_comm, append_eq_nil_iff]
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
theorem append_ne_nil_of_right_ne_nil (s : List α) : t [] s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_right (s : List α) : t [] s ++ t [] := by simp_all
theorem append_eq_cons_iff :
a ++ b = x :: c (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
cases a with simp | cons a as => ?_
exact fun h => as, by simp [h], fun a', aeq, aseq, h => aeq, by rw [aseq, h]
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
theorem cons_eq_append_iff :
x :: c = a ++ b (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
rw [eq_comm, append_eq_cons_iff]
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
theorem append_eq_singleton_iff :
a ++ b = [x] (a = [] b = [x]) (a = [x] b = []) := by
cases a <;> cases b <;> simp
theorem singleton_eq_append_iff :
[x] = a ++ b (a = [] b = [x]) (a = [x] b = []) := by
cases a <;> cases b <;> simp [eq_comm]
theorem append_eq_append_iff {a b c d : List α} :
a ++ b = c ++ d ( a', c = a ++ a' b = a' ++ d) c', a = c ++ c' d = c' ++ b := by
induction a generalizing c with
| nil => simp_all
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
@[simp] theorem head_append_of_ne_nil {l : List α} {w₁} (w₂) :
head (l ++ l') w₁ = head l w₂ := by
match l, w₂ with
@@ -1770,6 +1887,60 @@ theorem tail_append {l l' : List α} : (l ++ l').tail = if l.isEmpty then l'.tai
@[deprecated tail_append_of_ne_nil (since := "2024-07-24")] abbrev tail_append_left := @tail_append_of_ne_nil
theorem nil_eq_append_iff : [] = a ++ b a = [] b = [] := by
rw [eq_comm, append_eq_nil]
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
theorem append_ne_nil_of_right_ne_nil (s : List α) : t [] s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_right (s : List α) : t [] s ++ t [] := by simp_all
theorem append_eq_cons_iff :
a ++ b = x :: c (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
cases a with simp | cons a as => ?_
exact fun h => as, by simp [h], fun a', aeq, aseq, h => aeq, by rw [aseq, h]
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
theorem cons_eq_append_iff :
x :: c = a ++ b (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
rw [eq_comm, append_eq_cons_iff]
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
theorem append_eq_append_iff {a b c d : List α} :
a ++ b = c ++ d ( a', c = a ++ a' b = a' ++ d) c', a = c ++ c' d = c' ++ b := by
induction a generalizing c with
| nil => simp_all
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
@[simp] theorem mem_append {a : α} {s t : List α} : a s ++ t a s a t := by
induction s <;> simp_all [or_assoc]
theorem not_mem_append {a : α} {s t : List α} (h₁ : a s) (h₂ : a t) : a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
theorem mem_append_eq (a : α) (s t : List α) : (a s ++ t) = (a s a t) :=
propext mem_append
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
theorem mem_iff_append {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t :=
append_of_mem, fun s, t, e => e by simp
theorem forall_mem_append {p : α Prop} {l₁ l₂ : List α} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem set_append {s t : List α} :
(s ++ t).set i x = if i < s.length then s.set i x ++ t else s ++ t.set (i - s.length) x := by
induction s generalizing i with
@@ -1790,6 +1961,16 @@ theorem set_append {s t : List α} :
(s ++ t).set i x = s ++ t.set (i - s.length) x := by
rw [set_append, if_neg (by simp_all)]
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α β m β) (b) (l l' : List α) :
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
induction l <;> simp [*]
@[simp] theorem foldl_append {β : Type _} (f : β α β) (b) (l l' : List α) :
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
@[simp] theorem foldr_append (f : α β β) (b) (l l' : List α) :
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
theorem filterMap_eq_append_iff {f : α Option β} :
filterMap f l = L₁ ++ L₂ l₁ l₂, l = l₁ ++ l₂ filterMap f l₁ = L₁ filterMap f l₂ = L₂ := by
constructor
@@ -1898,7 +2079,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∃ L b, l = concat L b
/-! ### flatten -/
@[simp] theorem length_flatten (L : List (List α)) : L.flatten.length = (L.map length).sum := by
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
induction L with
| nil => rfl
| cons =>
@@ -1913,9 +2094,6 @@ theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
@[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] l L, l = [] := by
induction L <;> simp_all
@[simp] theorem nil_eq_flatten_iff {L : List (List α)} : [] = L.flatten l L, l = [] := by
rw [eq_comm, flatten_eq_nil_iff]
theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten [] x, x xs x [] := by
simp
@@ -1941,8 +2119,15 @@ theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun
-- `getLast?_flatten` is proved later, after the `reverse` section.
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
@[simp] theorem map_flatten (f : α β) (L : List (List α)) :
(flatten L).map f = (map (map f) L).flatten := by
theorem foldl_flatten (f : β α β) (b : β) (L : List (List α)) :
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
induction L generalizing b <;> simp_all
theorem foldr_flatten (f : α β β) (b : β) (L : List (List α)) :
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
induction L <;> simp_all
@[simp] theorem map_flatten (f : α β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
induction L <;> simp_all
@[simp] theorem filterMap_flatten (f : α Option β) (L : List (List α)) :
@@ -1995,26 +2180,6 @@ theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
· rintro as, bs, cs, rfl, h₁, rfl
simp [flatten_eq_nil_iff.mpr h₁]
theorem cons_eq_flatten_iff {xs : List (List α)} {y : α} {ys : List α} :
y :: ys = xs.flatten
as bs cs, xs = as ++ (y :: bs) :: cs ( l, l as l = []) ys = bs ++ cs.flatten := by
rw [eq_comm, flatten_eq_cons_iff]
theorem flatten_eq_singleton_iff {xs : List (List α)} {y : α} :
xs.flatten = [y] as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [flatten_eq_cons_iff]
constructor
· rintro as, bs, cs, rfl, h₁, h₂
simp at h₂
obtain rfl, h₂ := h₂
exact as, cs, by simp, h₁, h₂
· rintro as, bs, rfl, h₁, h₂
exact as, [], bs, rfl, h₁, by simpa
theorem singleton_eq_flatten_iff {xs : List (List α)} {y : α} :
[y] = xs.flatten as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [eq_comm, flatten_eq_singleton_iff]
theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
xs.flatten = ys ++ zs
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
@@ -2023,8 +2188,8 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
constructor
· induction xs generalizing ys with
| nil =>
simp only [flatten_nil, nil_eq, append_eq_nil_iff, and_false, cons_append, false_and,
exists_const, exists_false, or_false, and_imp, List.cons_ne_nil]
simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
exists_false, or_false, and_imp, List.cons_ne_nil]
rintro rfl rfl
exact [], [], by simp
| cons x xs ih =>
@@ -2043,13 +2208,6 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
· simp
· simp
theorem append_eq_flatten_iff {xs : List (List α)} {ys zs : List α} :
ys ++ zs = xs.flatten
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ys = as.flatten ++ bs
zs = c :: cs ++ ds.flatten := by
rw [eq_comm, flatten_eq_append_iff]
/-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_flatten_eq : {L L' : List (List α)},
@@ -2070,14 +2228,12 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
theorem flatMap_def (l : List α) (f : α List β) : l.flatMap f = flatten (map f l) := by rfl
@[simp] theorem flatMap_id (l : List (List α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : List (List α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
@[simp]
theorem length_flatMap (l : List α) (f : α List β) :
length (l.flatMap f) = sum (map (fun a => (f a).length) l) := by
rw [List.flatMap, length_flatten, map_map, Function.comp_def]
length (l.flatMap f) = sum (map (length f) l) := by
rw [List.flatMap, length_flatten, map_map]
@[simp] theorem mem_flatMap {f : α List β} {b} {l : List α} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
@@ -2090,7 +2246,7 @@ theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al :
b l.flatMap f := mem_flatMap.2 a, al, h
@[simp]
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : l.flatMap f = [] x l, f x = [] :=
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : List.flatMap l f = [] x l, f x = [] :=
flatten_eq_nil_iff.trans <| by
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
@@ -2274,7 +2430,7 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
· intro i h₁ h₂
simp [getElem_set]
@[simp] theorem replicate_append_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
rw [eq_replicate_iff]
constructor
· simp
@@ -2282,9 +2438,6 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
simp only [mem_append, mem_replicate, ne_eq]
rintro (-, rfl | _, rfl) <;> rfl
@[deprecated replicate_append_replicate (since := "2025-01-16")]
abbrev append_replicate_replicate := @replicate_append_replicate
theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
l₁ ++ l₂ = replicate n a
l₁.length + l₂.length = n l₁ = replicate l₁.length a l₂ = replicate l₂.length a := by
@@ -2295,11 +2448,6 @@ theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
@[deprecated append_eq_replicate_iff (since := "2024-09-05")] abbrev append_eq_replicate := @append_eq_replicate_iff
theorem replicate_eq_append_iff {l₁ l₂ : List α} {a : α} :
replicate n a = l₁ ++ l₂
l₁.length + l₂.length = n l₁ = replicate l₁.length a l₂ = replicate l₂.length a := by
rw [eq_comm, append_eq_replicate_iff]
@[simp] theorem map_replicate : (replicate n a).map f = replicate n (f a) := by
ext1 n
simp only [getElem?_map, getElem?_replicate]
@@ -2351,7 +2499,7 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
induction n with
| zero => simp
| succ n ih =>
simp only [replicate_succ, flatten_cons, ih, replicate_append_replicate, replicate_inj, or_true,
simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
and_true, add_one_mul, Nat.add_comm]
theorem flatMap_replicate {β} (f : α List β) : (replicate n a).flatMap f = (replicate n (f a)).flatten := by
@@ -2403,9 +2551,6 @@ theorem replicateRecOn {α : Type _} {p : List α → Prop} (m : List α)
exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
termination_by m.length
@[simp] theorem sum_replicate_nat (n : Nat) (a : Nat) : (replicate n a).sum = n * a := by
induction n <;> simp_all [replicate_succ, Nat.add_mul, Nat.add_comm]
/-! ### reverse -/
@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
@@ -2554,114 +2699,10 @@ theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.fla
@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
reverseAux_eq_append ..
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
eq_replicate_iff.2
by rw [length_reverse, length_replicate],
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : List α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
induction l generalizing b <;> simp [*]
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α β m β) (b) :
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
simp only [foldrM]
induction l <;> simp_all
theorem foldl_eq_foldlM (f : β α β) (b) (l : List α) :
l.foldl f b = l.foldlM (m := Id) f b := by
induction l generalizing b <;> simp [*, foldl]
theorem foldr_eq_foldrM (f : α β β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : List α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : List α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β α m β) (b) :
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α β m β) (b) :
l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
(foldlM_reverse ..).symm.trans <| by simp
/-! ### foldl and foldr -/
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
induction l <;> simp [*]
@[deprecated foldr_cons_eq_append (since := "2024-08-22")] abbrev foldr_self_append := @foldr_cons_eq_append
@[simp] theorem foldl_flip_cons_eq_append (l : List α) : l.foldl (fun x y => y :: x) l' = l.reverse ++ l' := by
induction l generalizing l' <;> simp [*]
theorem foldr_cons_nil (l : List α) : l.foldr cons [] = l := by simp
@[deprecated foldr_cons_nil (since := "2024-09-04")] abbrev foldr_self := @foldr_cons_nil
theorem foldl_map (f : β₁ β₂) (g : α β₂ α) (l : List β₁) (init : α) :
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
induction l generalizing init <;> simp [*]
theorem foldr_map (f : α₁ α₂) (g : α₂ β β) (l : List α₁) (init : β) :
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
induction l generalizing init <;> simp [*]
theorem foldl_filterMap (f : α Option β) (g : γ β γ) (l : List α) (init : γ) :
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldl_cons]
cases f a <;> simp [ih]
theorem foldr_filterMap (f : α Option β) (g : β γ γ) (l : List α) (init : γ) :
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
induction l generalizing init with
| nil => rfl
| cons a l ih =>
simp only [filterMap_cons, foldr_cons]
cases f a <;> simp [ih]
theorem foldl_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
induction l generalizing a
· simp
· simp [*, h]
theorem foldr_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
induction l generalizing a
· simp
· simp [*, h]
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α β m β) (b) (l l' : List α) :
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
induction l <;> simp [*]
@[simp] theorem foldl_append {β : Type _} (f : β α β) (b) (l l' : List α) :
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
@[simp] theorem foldr_append (f : α β β) (b) (l l' : List α) :
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
theorem foldl_flatten (f : β α β) (b : β) (L : List (List α)) :
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
induction L generalizing b <;> simp_all
theorem foldr_flatten (f : α β β) (b : β) (L : List (List α)) :
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
induction L <;> simp_all
@[simp] theorem foldl_reverse (l : List α) (f : β α β) (b) :
l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
@@ -2675,127 +2716,10 @@ theorem foldl_eq_foldr_reverse (l : List α) (f : β → α → β) (b) :
theorem foldr_eq_foldl_reverse (l : List α) (f : α β β) (b) :
l.foldr f b = l.reverse.foldl (fun x y => f y x) b := by simp
theorem foldl_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldl_cons, ha.assoc]
rw [foldl_assoc]
theorem foldr_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldr_cons, ha.assoc]
rw [foldr_assoc]
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : List β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
induction l generalizing init <;> simp [*, H]
theorem foldr_hom (f : β₁ β₂) (g₁ : α β₁ β₁) (g₂ : α β₂ β₂) (l : List α) (init : β₁)
(H : x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
induction l <;> simp [*, H]
/--
Prove a proposition about the result of `List.foldl`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldlRecOn {motive : β Sort _} : (l : List α) (op : β α β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op b a)), motive (List.foldl op b l)
| [], _, _, hb, _ => hb
| hd :: tl, op, b, hb, hl =>
foldlRecOn tl op (op b hd) (hl b hb hd (mem_cons_self hd tl))
fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
@[simp] theorem foldlRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op b a)) :
foldlRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldlRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op b a)) :
foldlRecOn (x :: l) op b hb hl =
foldlRecOn l op (op b x) (hl b hb x (mem_cons_self x l))
(fun b c a m => hl b c a (mem_cons_of_mem x m)) :=
rfl
/--
Prove a proposition about the result of `List.foldr`,
by proving it for the initial data,
and the implication that the operation applied to any element of the list preserves the property.
The motive can take values in `Sort _`, so this may be used to construct data,
as well as to prove propositions.
-/
def foldrRecOn {motive : β Sort _} : (l : List α) (op : α β β) (b : β) (_ : motive b)
(_ : (b : β) (_ : motive b) (a : α) (_ : a l), motive (op a b)), motive (List.foldr op b l)
| nil, _, _, hb, _ => hb
| x :: l, op, b, hb, hl =>
hl (foldr op b l)
(foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x (mem_cons_self x l)
@[simp] theorem foldrRecOn_nil {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a []), motive (op a b)) :
foldrRecOn [] op b hb hl = hb := rfl
@[simp] theorem foldrRecOn_cons {motive : β Sort _} (hb : motive b)
(hl : (b : β) (_ : motive b) (a : α) (_ : a x :: l), motive (op a b)) :
foldrRecOn (x :: l) op b hb hl =
hl _ (foldrRecOn l op b hb fun b c a m => hl b c a (mem_cons_of_mem x m))
x (mem_cons_self x l) :=
rfl
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldl_rel {l : List α} {f g : β α β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f c a) (g c' a)) :
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldl_cons]
apply ih
· simp_all
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldr_rel {l : List α} {f g : α β β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f a c) (g a c')) :
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldr_cons]
apply h'
· simp
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
@[simp] theorem foldl_add_const (l : List α) (a b : Nat) :
l.foldl (fun x _ => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldl_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc,
Nat.add_comm a]
@[simp] theorem foldr_add_const (l : List α) (a b : Nat) :
l.foldr (fun _ x => x + a) b = b + a * l.length := by
induction l generalizing b with
| nil => simp
| cons y l ih =>
simp only [foldr_cons, ih, length_cons, Nat.mul_add, Nat.mul_one, Nat.add_assoc]
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
eq_replicate_iff.2
by rw [length_reverse, length_replicate],
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)
/-! #### Further results about `getLast` and `getLast?` -/

View File

@@ -14,8 +14,8 @@ namespace List
@[simp] theorem lex_lt [LT α] (l₁ l₂ : List α) : Lex (· < ·) l₁ l₂ l₁ < l₂ := Iff.rfl
@[simp] theorem not_lex_lt [LT α] (l₁ l₂ : List α) : ¬ Lex (· < ·) l₁ l₂ l₂ l₁ := 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 α) :
theorem not_lt_iff_ge [LT α] (l₁ l₂ : List α) : ¬ l₁ < l₂ l₂ l₁ := Iff.rfl
theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : List α) :
¬ l₁ l₂ l₂ < l₁ :=
Decidable.not_not
@@ -260,7 +260,7 @@ protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
· exfalso
exact h' h
protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
[Std.Total (¬ · < · : α α Prop)]
@@ -333,7 +333,7 @@ theorem lex_eq_true_iff_exists [BEq α] (lt : αα → Bool) :
cases l₂ with
| nil => simp [lex]
| cons b l₂ =>
simp [lex_cons_cons, Bool.or_eq_true, Bool.and_eq_true, ih, isEqv, length_cons]
simp only [lex_cons_cons, Bool.or_eq_true, Bool.and_eq_true, ih, isEqv, length_cons]
constructor
· rintro (hab | hab, h₁, h₂ | i, h₁, h₂, w₁, w₂)
· exact .inr 0, by simp [hab]
@@ -397,7 +397,7 @@ theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : αα
cases l₂ with
| nil => simp [lex]
| cons b l₂ =>
simp [lex_cons_cons, Bool.or_eq_false_iff, Bool.and_eq_false_imp, ih, isEqv,
simp only [lex_cons_cons, Bool.or_eq_false_iff, Bool.and_eq_false_imp, ih, isEqv,
Bool.and_eq_true, length_cons]
constructor
· rintro hab, h
@@ -435,7 +435,7 @@ theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : αα
simpa using w₁ (j + 1) (by simpa)
· simpa using w₂
protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : List α} :
theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : List α} :
l₁ < l₂
(l₁ = l₂.take l₁.length l₁.length < l₂.length)
( (i : Nat) (h₁ : i < l₁.length) (h₂ : i < l₂.length),
@@ -444,7 +444,7 @@ protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁
rw [ lex_eq_true_iff_lt, lex_eq_true_iff_exists]
simp
protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)] {l₁ l₂ : List α} :
@@ -489,7 +489,7 @@ theorem IsPrefix.le [LT α] [Std.Irrefl (· < · : αα → Prop)]
rcases h with _, rfl
apply le_append_left
protected theorem map_lt [LT α] [LT β]
theorem map_lt [LT α] [LT β]
{l₁ l₂ : List α} {f : α β} (w : x y, x < y f x < f y) (h : l₁ < l₂) :
map f l₁ < map f l₂ := by
match l₁, l₂, h with
@@ -497,11 +497,11 @@ protected theorem map_lt [LT α] [LT β]
| nil, cons b l₂, h => simp
| cons a l₁, nil, h => simp at h
| cons a l₁, cons _ l₂, .cons h =>
simp [cons_lt_cons_iff, List.map_lt w (by simpa using h)]
simp [cons_lt_cons_iff, map_lt w (by simpa using h)]
| cons a l₁, cons b l₂, .rel h =>
simp [cons_lt_cons_iff, w, h]
protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
@@ -510,7 +510,7 @@ protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq
[Std.Antisymm (¬ · < · : β β Prop)]
{l₁ l₂ : List α} {f : α β} (w : x y, x < y f x < f y) (h : l₁ l₂) :
map f l₁ map f l₂ := by
rw [List.le_iff_exists] at h
rw [le_iff_exists] at h
obtain (h | i, h₁, h₂, w₁, w₂) := h
· left
rw [h]

View File

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

View File

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

View File

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

View File

@@ -203,11 +203,11 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
cases l₂ with
| nil =>
constructor
· simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, exists_and_left, and_imp]
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
rintro rfl rfl
exact [], x₁ :: l₁, [], by simp
· rintro w, x, y, z, h₁, _, h₃, rfl, rfl
simp only [nil_eq, append_eq_nil_iff] at h₃
simp only [nil_eq, append_eq_nil] at h₃
obtain rfl, rfl := h₃
simp
| cons x₂ l₂ =>
@@ -259,7 +259,7 @@ theorem zip_map (f : αγ) (g : β → δ) :
| [], _ => rfl
| _, [] => by simp only [map, zip_nil_right]
| _ :: _, _ :: _ => by
simp only [map, zip_cons_cons, zip_map, Prod.map]; try constructor -- TODO: remove try constructor after update stage0
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
theorem zip_map_left (f : α γ) (l₁ : List α) (l₂ : List β) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]

View File

@@ -49,17 +49,4 @@ theorem lt_div_mul_self (h : 0 < k) (w : k ≤ x) : x - k < x / k * k := by
have : x % k < k := mod_lt x h
omega
theorem div_pos (hba : b a) (hb : 0 < b) : 0 < a / b := by
cases b
· contradiction
· simp [Nat.pos_iff_ne_zero, div_eq_zero_iff_lt, hba]
theorem div_le_div_left (hcb : c b) (hc : 0 < c) : a / b a / c :=
(Nat.le_div_iff_mul_le hc).2 <|
Nat.le_trans (Nat.mul_le_mul_left _ hcb) (Nat.div_mul_le_self a b)
theorem div_add_le_right {z : Nat} (h : 0 < z) (x y : Nat) :
x / (y + z) x / z :=
div_le_div_left (Nat.le_add_left z y) h
end Nat

View File

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

View File

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

View File

@@ -159,8 +159,6 @@ def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
def UInt32.shiftLeft (a b : UInt32) : UInt32 := a.toBitVec <<< (mod b 32).toBitVec
@[extern "lean_uint32_shift_right"]
def UInt32.shiftRight (a b : UInt32) : UInt32 := a.toBitVec >>> (mod b 32).toBitVec
def UInt32.lt (a b : UInt32) : Prop := a.toBitVec < b.toBitVec
def UInt32.le (a b : UInt32) : Prop := a.toBitVec b.toBitVec
instance : Add UInt32 := UInt32.add
instance : Sub UInt32 := UInt32.sub
@@ -171,8 +169,6 @@ set_option linter.deprecated false in
instance : HMod UInt32 Nat UInt32 := UInt32.modn
instance : Div UInt32 := UInt32.div
instance : LT UInt32 := UInt32.lt
instance : LE UInt32 := UInt32.le
@[extern "lean_uint32_complement"]
def UInt32.complement (a : UInt32) : UInt32 := ~~~a.toBitVec

View File

@@ -13,17 +13,11 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
`(
namespace $typeName
@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
@[simp] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
@[simp] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
@[simp] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
@[simp] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
@[simp] protected theorem toNat_and (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := by simp [toNat]
@[simp] protected theorem toNat_or (a b : $typeName) : (a ||| b).toNat = a.toNat ||| b.toNat := by simp [toNat]
@@ -43,31 +37,3 @@ declare_bitwise_uint_theorems UInt16 16
declare_bitwise_uint_theorems UInt32 32
declare_bitwise_uint_theorems UInt64 64
declare_bitwise_uint_theorems USize System.Platform.numBits
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt8 {b : Bool} :
b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
cases b <;> simp [toUInt8]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt16 {b : Bool} :
b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
cases b <;> simp [toUInt16]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt32 {b : Bool} :
b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
cases b <;> simp [toUInt32]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt64 {b : Bool} :
b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
cases b <;> simp [toUInt64]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUSize {b : Bool} :
b.toUSize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
cases b
· simp [toUSize]
· apply BitVec.eq_of_toNat_eq
simp [toUSize]

View File

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

View File

@@ -103,7 +103,7 @@ of bounds.
@[inline] def head [NeZero n] (v : Vector α n) := v[0]'(Nat.pos_of_neZero n)
/-- Push an element `x` to the end of a vector. -/
@[inline] def push (v : Vector α n) (x : α) : Vector α (n + 1) :=
@[inline] def push (x : α) (v : Vector α n) : Vector α (n + 1) :=
v.toArray.push x, by simp
/-- Remove the last element of a vector. -/
@@ -136,18 +136,6 @@ This will perform the update destructively provided that the vector has a refere
@[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
v.toArray.set! i x, by simp
@[inline] def foldlM [Monad m] (f : β α m β) (b : β) (v : Vector α n) : m β :=
v.toArray.foldlM f b
@[inline] def foldrM [Monad m] (f : α β m β) (b : β) (v : Vector α n) : m β :=
v.toArray.foldrM f b
@[inline] def foldl (f : β α β) (b : β) (v : Vector α n) : β :=
v.toArray.foldl f b
@[inline] def foldr (f : α β β) (b : β) (v : Vector α n) : β :=
v.toArray.foldr f b
/-- Append two vectors. -/
@[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) :=
v.toArray ++ w.toArray, by simp
@@ -170,13 +158,6 @@ result is empty. If `stop` is greater than the size of the vector, the size is u
@[inline] def map (f : α β) (v : Vector α n) : Vector β n :=
v.toArray.map f, by simp
@[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
(v.toArray.map Vector.toArray).flatten,
by rcases v; simp_all [Function.comp_def, Array.map_const']
@[inline] def flatMap (v : Vector α n) (f : α Vector β m) : Vector β (n * m) :=
v.toArray.flatMap fun a => (f a).toArray, by simp [Array.map_const']
/-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α β φ) : Vector φ n :=
Array.zipWith a.toArray b.toArray f, by simp

View File

@@ -1,11 +1,10 @@
/-
Copyright (c) 2024 Shreyas Srinivas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
Authors: Shreyas Srinivas, Francois Dorais
-/
prelude
import Init.Data.Vector.Basic
import Init.Data.Array.Attach
/-!
## Vectors
@@ -28,9 +27,6 @@ namespace Vector
theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a := rfl
@[simp] theorem mk_toArray (v : Vector α n) : mk v.toArray v.2 = v := by
rfl
@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) :
(Vector.mk data size)[i] = data[i] := rfl
@@ -70,18 +66,6 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem back?_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).back? = a.back? := rfl
@[simp] theorem foldlM_mk [Monad m] (f : β α m β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldlM f b = a.foldlM f b := rfl
@[simp] theorem foldrM_mk [Monad m] (f : α β m β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldrM f b = a.foldrM f b := rfl
@[simp] theorem foldl_mk (f : β α β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldl f b = a.foldl f b := rfl
@[simp] theorem foldr_mk (f : α β β) (b : β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).foldr f b = a.foldr f b := rfl
@[simp] theorem drop_mk (a : Array α) (h : a.size = n) (m) :
(Vector.mk a h).drop m = Vector.mk (a.extract m a.size) (by simp [h]) := rfl
@@ -157,14 +141,6 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem all_mk (p : α Bool) (a : Array α) (h : a.size = n) :
(Vector.mk a h).all p = a.all p := rfl
@[simp] theorem eq_mk : v = Vector.mk a h v.toArray = a := by
cases v
simp
@[simp] theorem mk_eq : Vector.mk a h = v a = v.toArray := by
cases v
simp
/-! ### toArray lemmas -/
@[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) :
@@ -475,7 +451,7 @@ theorem singleton_inj : #v[a] = #v[b] ↔ a = b := by
theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
simp [mkVector, Array.mkArray_succ]
@[simp] theorem mkVector_inj : mkVector n a = mkVector n b n = 0 a = b := by
theorem mkVector_inj : mkVector n a = mkVector n b n = 0 a = b := by
simp [ toArray_inj, toArray_mkVector, Array.mkArray_inj]
/-! ## L[i] and L[i]? -/
@@ -697,24 +673,6 @@ theorem forall_getElem {l : Vector α n} {p : α → Prop} :
rcases l with l, rfl
simp [Array.forall_getElem]
/-! ### cast -/
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
(a.cast h)[i] = a[i] := by
cases a
simp
@[simp] theorem getElem?_cast {l : Vector α n} {m : Nat} {w : n = m} {i : Nat} :
(l.cast w)[i]? = l[i]? := by
rcases l with l, rfl
simp
@[simp] theorem mem_cast {a : α} {l : Vector α n} {m : Nat} {w : n = m} :
a l.cast w a l := by
rcases l with l, rfl
simp
/-! ### Decidability of bounded quantifiers -/
instance {xs : Vector α n} {p : α Prop} [DecidablePred p] :
@@ -1065,12 +1023,11 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
cases l₂
simp
/-! ### map -/
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
@[simp] theorem getElem_map (f : α β) (a : Vector α n) (i : Nat) (hi : i < n) :
(a.map f)[i] = f a[i] := by
cases a
simp
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
/-- The empty vector maps to the empty vector. -/
@[simp]
@@ -1078,680 +1035,6 @@ theorem map_empty (f : α → β) : map f #v[] = #v[] := by
rw [map, mk.injEq]
exact Array.map_empty f
@[simp] theorem map_push {f : α β} {as : Vector α n} {x : α} :
(as.push x).map f = (as.map f).push (f x) := by
cases as
simp
@[simp] theorem map_id_fun : map (n := n) (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (n := n) (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (l : Vector α n) : map (id : α α) l = l := by
cases l <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (l : Vector α n) : map (fun (a : α) => a) l = l := map_id l
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (l : Vector α n) : map f l = l := by
simp [show f = id from funext h]
theorem map_singleton (f : α β) (a : α) : map f #v[a] = #v[f a] := rfl
@[simp] theorem mem_map {f : α β} {l : Vector α n} : b l.map f a, a l f a = b := by
cases l
simp
theorem exists_of_mem_map (h : b map f l) : a, a l f a = b := mem_map.1 h
theorem mem_map_of_mem (f : α β) (h : a l) : f a map f l := mem_map.2 _, h, rfl
theorem forall_mem_map {f : α β} {l : Vector α n} {P : β Prop} :
( (i) (_ : i l.map f), P i) (j) (_ : j l), P (f j) := by
simp
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
cases l <;> simp_all
theorem map_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
cases l
cases l'
simp [Array.map_inj_right w]
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
theorem map_inj [NeZero n] : map (n := n) f = map g f = g := by
constructor
· intro h
ext a
replace h := congrFun h (mkVector n a)
simp only [mkVector, map_mk, mk.injEq, Array.map_inj_left, Array.mem_mkArray, and_imp,
forall_eq_apply_imp_iff] at h
exact h (NeZero.ne n)
· intro h; subst h; rfl
theorem map_eq_push_iff {f : α β} {l : Vector α (n + 1)} {l₂ : Vector β n} {b : β} :
map f l = l₂.push b l₁ a, l = l₁.push a map f l₁ = l₂ f a = b := by
rcases l with l, h
rcases l₂ with l₂, rfl
simp only [map_mk, push_mk, mk.injEq, Array.map_eq_push_iff]
constructor
· rintro l₁, a, rfl, rfl, rfl
refine l₁, by simp, a, by simp
· rintro l₁, a, h₁, h₂, rfl
refine l₁.toArray, a, by simp_all
@[simp] theorem map_eq_singleton_iff {f : α β} {l : Vector α 1} {b : β} :
map f l = #v[b] a, l = #v[a] f a = b := by
cases l
simp
theorem map_eq_map_iff {f g : α β} {l : Vector α n} :
map f l = map g l a l, f a = g a := by
cases l <;> simp_all
theorem map_eq_iff {f : α β} {l : Vector α n} {l' : Vector β n} :
map f l = l' i (h : i < n), l'[i] = f l[i] := by
rcases l with l, rfl
rcases l' with l', h'
simp only [map_mk, eq_mk, Array.map_eq_iff, getElem_mk]
constructor
· intro w i h
simpa [h, h'] using w i
· intro w i
if h : i < l.size then
simpa [h, h'] using w i h
else
rw [getElem?_neg, getElem?_neg, Option.map_none'] <;> omega
@[simp] theorem map_set {f : α β} {l : Vector α n} {i : Nat} {h : i < n} {a : α} :
(l.set i a).map f = (l.map f).set i (f a) (by simpa using h) := by
cases l
simp
@[simp] theorem map_setIfInBounds {f : α β} {l : Vector α n} {i : Nat} {a : α} :
(l.setIfInBounds i a).map f = (l.map f).setIfInBounds i (f a) := by
cases l
simp
@[simp] theorem map_pop {f : α β} {l : Vector α n} : l.pop.map f = (l.map f).pop := by
cases l
simp
@[simp] theorem back?_map {f : α β} {l : Vector α n} : (l.map f).back? = l.back?.map f := by
cases l
simp
@[simp] theorem map_map {f : α β} {g : β γ} {as : Vector α n} :
(as.map f).map g = as.map (g f) := by
cases as
simp
/--
Use this as `induction ass using vector₂_induction` on a hypothesis of the form `ass : Vector (Vector α n) m`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array α)`
along with additional hypotheses `h₁ : ass.size = m` and `h₂ : ∀ xs ∈ ass, xs.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk xs ⋯)) ⋯`.
-/
-- We can't use `@[cases_eliminator]` here as
-- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
theorem vector₂_induction (P : Vector (Vector α n) m Prop)
(of : (xss : Array (Array α)) (h₁ : xss.size = m) (h₂ : xs xss, xs.size = n),
P (mk (xss.attach.map (fun xs, m => mk xs (h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector α n) m) : P ass := by
specialize of (ass.map toArray).toArray (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/--
Use this as `induction ass using vector₃_induction` on a hypothesis of the form `ass : Vector (Vector (Vector α n) m) k`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array (Array α))`
along with additional hypotheses `h₁ : ass.size = k`, `h₂ : ∀ xs ∈ ass, xs.size = m`,
and `h₃ : ∀ xs ∈ ass, ∀ x ∈ xs, x.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk (xs.attach.map (fun ⟨x, m'⟩ => Vector.mk x ⋯)) ⋯)) ⋯`.
-/
theorem vector₃_induction (P : Vector (Vector (Vector α n) m) k Prop)
(of : (xss : Array (Array (Array α))) (h₁ : xss.size = k) (h₂ : xs xss, xs.size = m)
(h₃ : xs xss, x xs, x.size = n),
P (mk (xss.attach.map (fun xs, m =>
mk (xs.attach.map (fun x, m' =>
mk x (h₃ xs m x m'))) (by simpa using h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector (Vector α n) m) k) : P ass := by
specialize of (ass.map (fun as => (as.map toArray).toArray)).toArray (by simp) (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/-! ### singleton -/
@[simp] theorem singleton_def (v : α) : Vector.singleton v = #v[v] := rfl
/-! ### append -/
@[simp] theorem append_push {as : Vector α n} {bs : Vector α m} {a : α} :
as ++ bs.push a = (as ++ bs).push a := by
cases as
cases bs
simp
theorem singleton_eq_toVector_singleton (a : α) : #v[a] = #[a].toVector := rfl
@[simp] theorem mem_append {a : α} {s : Vector α n} {t : Vector α m} :
a s ++ t a s a t := by
cases s
cases t
simp
theorem mem_append_left {a : α} {s : Vector α n} {t : Vector α m} (h : a s) : a s ++ t :=
mem_append.2 (Or.inl h)
theorem mem_append_right {a : α} {s : Vector α n} {t : Vector α m} (h : a t) : a s ++ t :=
mem_append.2 (Or.inr h)
theorem not_mem_append {a : α} {s : Vector α n} {t : Vector α m} (h₁ : a s) (h₂ : a t) :
a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
/--
See also `eq_push_append_of_mem`, which proves a stronger version
in which the initial array must not contain the element.
-/
theorem append_of_mem {a : α} {l : Vector α n} (h : a l) :
(m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
l = (s.push a ++ t).cast w := by
rcases l with l, rfl
obtain s, t, rfl := Array.append_of_mem (by simpa using h)
refine _, _, by simp, s.toVector, t.toVector, by simp_all
theorem mem_iff_append {a : α} {l : Vector α n} :
a l (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
l = (s.push a ++ t).cast w :=
append_of_mem, by rintro m, k, rfl, s, t, rfl; simp
theorem forall_mem_append {p : α Prop} {l₁ : Vector α n} {l₂ : Vector α m} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem empty_append (as : Vector α n) : (#v[] : Vector α 0) ++ as = as.cast (by omega) := by
rcases as with as, rfl
simp
theorem append_empty (as : Vector α n) : as ++ (#v[] : Vector α 0) = as := by
rw [ toArray_inj, toArray_append, Array.append_empty]
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
rcases a with a, rfl
rcases b with b, rfl
simp [Array.getElem_append, hi]
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n i) :
(a ++ b)[i] = b[i - n] := by
rw [getElem_append, dif_neg (by omega)]
theorem getElem?_append_left {as : Vector α n} {bs : Vector α m} {i : Nat} (hn : i < n) :
(as ++ bs)[i]? = as[i]? := by
have hn' : i < n + m := by omega
simp_all [getElem?_eq_getElem, getElem_append]
theorem getElem?_append_right {as : Vector α n} {bs : Vector α m} {i : Nat} (h : n i) :
(as ++ bs)[i]? = bs[i - n]? := by
rcases as with as, rfl
rcases bs with bs, rfl
simp [Array.getElem?_append_right, h]
theorem getElem?_append {as : Vector α n} {bs : Vector α m} {i : Nat} :
(as ++ bs)[i]? = if i < n then as[i]? else bs[i - n]? := by
split <;> rename_i h
· exact getElem?_append_left h
· exact getElem?_append_right (by simpa using h)
/-- Variant of `getElem_append_left` useful for rewriting from the small array to the big array. -/
theorem getElem_append_left' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < m) :
l₁[i] = (l₁ ++ l₂)[i] := by
rw [getElem_append_left] <;> simp
/-- Variant of `getElem_append_right` useful for rewriting from the small array to the big array. -/
theorem getElem_append_right' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < n) :
l₂[i] = (l₁ ++ l₂)[i + m] := by
rw [getElem_append_right] <;> simp [*, Nat.le_add_left]
theorem getElem_of_append {l : Vector α n} {l₁ : Vector α m} {l₂ : Vector α k}
(w : m + 1 + k = n) (eq : l = (l₁.push a ++ l₂).cast w) :
l[m] = a := Option.some.inj <| by
rw [ getElem?_eq_getElem, eq, getElem?_cast, getElem?_append_left (by simp)]
simp
@[simp 1100] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
cases as
simp
theorem append_inj {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m} (h : s₁ ++ t₁ = s₂ ++ t₂) :
s₁ = s₂ t₁ = t₂ := by
rcases s₁ with s₁, rfl
rcases s₂ with s₂, hs
rcases t₁ with t₁, rfl
rcases t₂ with t₂, ht
simpa using Array.append_inj (by simpa using h) (by omega)
theorem append_inj_right {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
(h : s₁ ++ t₁ = s₂ ++ t₂) : t₁ = t₂ :=
(append_inj h).right
theorem append_inj_left {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
(h : s₁ ++ t₁ = s₂ ++ t₂) : s₁ = s₂ :=
(append_inj h).left
theorem append_right_inj {t₁ t₂ : Vector α m} (s : Vector α n) : s ++ t₁ = s ++ t₂ t₁ = t₂ :=
fun h => append_inj_right h, congrArg _
theorem append_left_inj {s₁ s₂ : Vector α n} (t : Vector α m) : s₁ ++ t = s₂ ++ t s₁ = s₂ :=
fun h => append_inj_left h, congrArg (· ++ _)
theorem append_eq_append_iff {a : Vector α n} {b : Vector α m} {c : Vector α k} {d : Vector α l}
(w : k + l = n + m) :
a ++ b = (c ++ d).cast w
if h : n k then
a' : Vector α (k - n), c = (a ++ a').cast (by omega) b = (a' ++ d).cast (by omega)
else
c' : Vector α (n - k), a = (c ++ c').cast (by omega) d = (c' ++ b).cast (by omega) := by
rcases a with a, rfl
rcases b with b, rfl
rcases c with c, rfl
rcases d with d, rfl
simp only [mk_append_mk, Array.append_eq_append_iff, mk_eq, toArray_cast]
constructor
· rintro (a', rfl, rfl | c', rfl, rfl)
· rw [dif_pos (by simp)]
exact a'.toVector.cast (by simp; omega), by simp
· split <;> rename_i h
· have hc : c'.size = 0 := by simp at h; omega
simp at hc
exact #v[].cast (by simp; omega), by simp_all
· exact c'.toVector.cast (by simp; omega), by simp
· split <;> rename_i h
· rintro a', hc, rfl
left
refine a'.toArray, hc, rfl
· rintro c', ha, rfl
right
refine c'.toArray, ha, rfl
theorem set_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n + m) :
(s ++ t).set i x =
if h' : i < n then
s.set i x ++ t
else
s ++ t.set (i - n) x := by
rcases s with s, rfl
rcases t with t, rfl
simp only [mk_append_mk, set_mk, Array.set_append]
split <;> simp
@[simp] theorem set_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
(s ++ t).set i x = s.set i x ++ t := by
simp [set_append, h]
@[simp] theorem set_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
(h' : i < n + m) (h : n i) :
(s ++ t).set i x = s ++ t.set (i - n) x := by
rw [set_append, dif_neg (by omega)]
theorem setIfInBounds_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} :
(s ++ t).setIfInBounds i x =
if i < n then
s.setIfInBounds i x ++ t
else
s ++ t.setIfInBounds (i - n) x := by
rcases s with s, rfl
rcases t with t, rfl
simp only [mk_append_mk, setIfInBounds_mk, Array.setIfInBounds_append]
split <;> simp
@[simp] theorem setIfInBounds_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
(s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
simp [setIfInBounds_append, h]
@[simp] theorem setIfInBounds_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
(h : n i) :
(s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - n) x := by
rw [setIfInBounds_append, if_neg (by omega)]
@[simp] theorem map_append (f : α β) (l₁ : Vector α n) (l₂ : Vector α m) :
map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, rfl
simp
theorem map_eq_append_iff {f : α β} :
map f l = L₁ ++ L₂ l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rcases l with l, h
rcases L₁ with L₁, rfl
rcases L₂ with L₂, rfl
simp only [map_mk, mk_append_mk, eq_mk, Array.map_eq_append_iff, mk_eq, toArray_append,
toArray_map]
constructor
· rintro l₁, l₂, rfl, rfl, rfl
exact l₁.toVector.cast (by simp), l₂.toVector.cast (by simp), by simp
· rintro l₁, l₂, rfl, h₁, h₂
exact l₁, l₂, by simp_all
theorem append_eq_map_iff {f : α β} :
L₁ ++ L₂ = map f l l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rw [eq_comm, map_eq_append_iff]
/-! ### flatten -/
@[simp] theorem flatten_mk (L : Array (Vector α n)) (h : L.size = m) :
(mk L h).flatten =
mk (L.map toArray).flatten (by simp [Function.comp_def, Array.map_const', h]) := by
simp [flatten]
@[simp] theorem getElem_flatten (l : Vector (Vector β m) n) (i : Nat) (hi : i < n * m) :
l.flatten[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
l[i / m][i % m] := by
rcases l with l, rfl
simp only [flatten_mk, List.map_toArray, getElem_mk, List.getElem_toArray, Array.flatten_toArray]
induction l generalizing i with
| nil => simp at hi
| cons a l ih =>
simp only [List.map_cons, List.map_map, List.flatten_cons]
by_cases h : i < m
· rw [List.getElem_append_left (by simpa)]
have h₁ : i / m = 0 := Nat.div_eq_of_lt h
have h₂ : i % m = i := Nat.mod_eq_of_lt h
simp [h₁, h₂]
· have h₁ : a.toList.length i := by simp; omega
rw [List.getElem_append_right h₁]
simp only [Array.length_toList, size_toArray]
specialize ih (i - m) (by simp_all [Nat.add_one_mul]; omega)
have h₂ : i / m = (i - m) / m + 1 := by
conv => lhs; rw [show i = i - m + m by omega]
rw [Nat.add_div_right]
exact Nat.pos_of_lt_mul_left hi
simp only [Array.length_toList, size_toArray] at h₁
have h₃ : (i - m) % m = i % m := (Nat.mod_eq_sub_mod h₁).symm
simp_all
theorem getElem?_flatten (l : Vector (Vector β m) n) (i : Nat) :
l.flatten[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some l[i / m][i % m]
else
none := by
simp [getElem?_def]
@[simp] theorem flatten_singleton (l : Vector α n) : #v[l].flatten = l.cast (by simp) := by
simp [flatten]
theorem mem_flatten {L : Vector (Vector α n) m} : a L.flatten l, l L a l := by
rcases L with L, rfl
simp [Array.mem_flatten]
constructor
· rintro _, l, h₁, rfl, h₂
exact l, h₁, by simpa using h₂
· rintro l, h₁, h₂
exact l.toArray, l, h₁, rfl, by simpa using h₂
theorem exists_of_mem_flatten : a flatten L l, l L a l := mem_flatten.1
theorem mem_flatten_of_mem (lL : l L) (al : a l) : a flatten L := mem_flatten.2 l, lL, al
theorem forall_mem_flatten {p : α Prop} {L : Vector (Vector α n) m} :
( (x) (_ : x flatten L), p x) (l) (_ : l L) (x) (_ : x l), p x := by
simp only [mem_flatten, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
@[simp] theorem map_flatten (f : α β) (L : Vector (Vector α n) m) :
(flatten L).map f = (map (map f) L).flatten := by
induction L using vector₂_induction with
| of xss h₁ h₂ => simp
@[simp] theorem flatten_append (L₁ : Vector (Vector α n) m₁) (L₂ : Vector (Vector α n) m₂) :
flatten (L₁ ++ L₂) = (flatten L₁ ++ flatten L₂).cast (by simp [Nat.add_mul]) := by
induction L₁ using vector₂_induction
induction L₂ using vector₂_induction
simp
theorem flatten_push (L : Vector (Vector α n) m) (l : Vector α n) :
flatten (L.push l) = (flatten L ++ l).cast (by simp [Nat.add_mul]) := by
induction L using vector₂_induction
rcases l with l
simp [Array.flatten_push]
theorem flatten_flatten {L : Vector (Vector (Vector α n) m) k} :
flatten (flatten L) = (flatten (map flatten L)).cast (by simp [Nat.mul_assoc]) := by
induction L using vector₃_induction with
| of xss h₁ h₂ h₃ =>
-- simp [Array.flatten_flatten] -- FIXME: `simp` produces a bad proof here!
simp [Array.map_attach, Array.flatten_flatten, Array.map_pmap]
/-- Two vectors of constant length vectors are equal iff their flattens coincide. -/
theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
L = L' L.flatten = L'.flatten := by
induction L using vector₂_induction with | of L h₁ h₂ =>
induction L' using vector₂_induction with | of L' h₁' h₂' =>
simp only [eq_mk, flatten_mk, Array.map_map, Function.comp_apply, Array.map_subtype,
Array.unattach_attach, Array.map_id_fun', id_eq]
constructor
· intro h
suffices L = L' by simp_all
apply Array.ext_getElem?
intro i
replace h := congrArg (fun x => x[i]?.map (fun x => x.toArray)) h
simpa [Option.map_pmap] using h
· intro h
have w : L.map Array.size = L'.map Array.size := by
ext i h h'
· simp_all
· simp only [Array.getElem_map]
rw [h₂ _ (by simp), h₂' _ (by simp)]
have := Array.eq_iff_flatten_eq.mpr h, w
subst this
rfl
/-! ### flatMap -/
@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α Vector β n) :
(mk l h).flatMap f =
mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
simp [flatMap]
@[simp] theorem flatMap_toArray (l : Vector α n) (f : α Vector β m) :
l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
rcases l with l, rfl
simp
theorem flatMap_def (l : Vector α n) (f : α Vector β m) : l.flatMap f = flatten (map f l) := by
rcases l with l, rfl
simp [Array.flatMap_def, Function.comp_def]
@[simp] theorem getElem_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) (hi : i < n * m) :
(l.flatMap f)[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
(f (l[i / m]))[i % m] := by
rw [flatMap_def, getElem_flatten, getElem_map]
theorem getElem?_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) :
(l.flatMap f)[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some ((f (l[i / m]))[i % m])
else
none := by
simp [getElem?_def]
@[simp] theorem flatMap_id (l : Vector (Vector α m) n) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : Vector (Vector α m) n) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp] theorem mem_flatMap {f : α Vector β m} {b} {l : Vector α n} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
exact fun _, a, h₁, rfl, h₂ => a, h₁, h₂, fun a, h₁, h₂ => _, a, h₁, rfl, h₂
theorem exists_of_mem_flatMap {b : β} {l : Vector α n} {f : α Vector β m} :
b l.flatMap f a, a l b f a := mem_flatMap.1
theorem mem_flatMap_of_mem {b : β} {l : Vector α n} {f : α Vector β m} {a} (al : a l) (h : b f a) :
b l.flatMap f := mem_flatMap.2 a, al, h
theorem forall_mem_flatMap {p : β Prop} {l : Vector α n} {f : α Vector β m} :
( (x) (_ : x l.flatMap f), p x) (a) (_ : a l) (b) (_ : b f a), p b := by
simp only [mem_flatMap, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
theorem flatMap_singleton (f : α Vector β m) (x : α) : #v[x].flatMap f = (f x).cast (by simp) := by
simp [flatMap_def]
@[simp] theorem flatMap_singleton' (l : Vector α n) : (l.flatMap fun x => #v[x]) = l.cast (by simp) := by
rcases l with l, rfl
simp
@[simp] theorem flatMap_append (xs ys : Vector α n) (f : α Vector β m) :
(xs ++ ys).flatMap f = (xs.flatMap f ++ ys.flatMap f).cast (by simp [Nat.add_mul]) := by
rcases xs with xs
rcases ys with ys
simp [flatMap_def, flatten_append]
theorem flatMap_assoc {α β} (l : Vector α n) (f : α Vector β m) (g : β Vector γ k) :
(l.flatMap f).flatMap g = (l.flatMap fun x => (f x).flatMap g).cast (by simp [Nat.mul_assoc]) := by
rcases l with l, rfl
simp [Array.flatMap_assoc]
theorem map_flatMap (f : β γ) (g : α Vector β m) (l : Vector α n) :
(l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
rcases l with l, rfl
simp [Array.map_flatMap]
theorem flatMap_map (f : α β) (g : β Vector γ k) (l : Vector α n) :
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
rcases l with l, rfl
simp [Array.flatMap_map]
theorem map_eq_flatMap {α β} (f : α β) (l : Vector α n) :
map f l = (l.flatMap fun x => #v[f x]).cast (by simp) := by
rcases l with l, rfl
simp [Array.map_eq_flatMap]
/-! ### mkVector -/
@[simp] theorem mkVector_one : mkVector 1 a = #v[a] := rfl
/-- Variant of `mkVector_succ` that prepends `a` at the beginning of the vector. -/
theorem mkVector_succ' : mkVector (n + 1) a = (#v[a] ++ mkVector n a).cast (by omega) := by
rw [ toArray_inj]
simp [Array.mkArray_succ']
@[simp] theorem mem_mkVector {a b : α} {n} : b mkVector n a n 0 b = a := by
unfold mkVector
simp
theorem eq_of_mem_mkVector {a b : α} {n} (h : b mkVector n a) : b = a := (mem_mkVector.1 h).2
theorem forall_mem_mkVector {p : α Prop} {a : α} {n} :
( b, b mkVector n a p b) n = 0 p a := by
cases n <;> simp [mem_mkVector]
@[simp] theorem getElem_mkVector (a : α) (n i : Nat) (h : i < n) : (mkVector n a)[i] = a := by
simp [mkVector]
theorem getElem?_mkVector (a : α) (n i : Nat) : (mkVector n a)[i]? = if i < n then some a else none := by
simp [getElem?_def]
@[simp] theorem getElem?_mkVector_of_lt {n : Nat} {m : Nat} (h : m < n) : (mkVector n a)[m]? = some a := by
simp [getElem?_mkVector, h]
theorem eq_mkVector_of_mem {a : α} {l : Vector α n} (h : (b) (_ : b l), b = a) : l = mkVector n a := by
rw [ toArray_inj]
simpa using Array.eq_mkArray_of_mem (l := l.toArray) (by simpa using h)
theorem eq_mkVector_iff {a : α} {n} {l : Vector α n} :
l = mkVector n a (b) (_ : b l), b = a := by
rw [ toArray_inj]
simpa using Array.eq_mkArray_iff (l := l.toArray) (n := n)
theorem map_eq_mkVector_iff {l : Vector α n} {f : α β} {b : β} :
l.map f = mkVector n b x l, f x = b := by
simp [eq_mkVector_iff]
@[simp] theorem map_const (l : Vector α n) (b : β) : map (Function.const α b) l = mkVector n b :=
map_eq_mkVector_iff.mpr fun _ _ => rfl
@[simp] theorem map_const_fun (x : β) : map (n := n) (Function.const α x) = fun _ => mkVector n x := by
funext l
simp
/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
-- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
theorem map_const' (l : Vector α n) (b : β) : map (fun _ => b) l = mkVector n b :=
map_const l b
@[simp] theorem set_mkVector_self : (mkVector n a).set i a h = mkVector n a := by
rw [ toArray_inj]
simp
@[simp] theorem setIfInBounds_mkVector_self : (mkVector n a).setIfInBounds i a = mkVector n a := by
rw [ toArray_inj]
simp
@[simp] theorem mkVector_append_mkVector : mkVector n a ++ mkVector m a = mkVector (n + m) a := by
rw [ toArray_inj]
simp
theorem append_eq_mkVector_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
l₁ ++ l₂ = mkVector (n + m) a l₁ = mkVector n a l₂ = mkVector m a := by
simp [ toArray_inj, Array.append_eq_mkArray_iff]
theorem mkVector_eq_append_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
mkVector (n + m) a = l₁ ++ l₂ l₁ = mkVector n a l₂ = mkVector m a := by
rw [eq_comm, append_eq_mkVector_iff]
@[simp] theorem map_mkVector : (mkVector n a).map f = mkVector n (f a) := by
rw [ toArray_inj]
simp
@[simp] theorem flatten_mkVector_empty : (mkVector n (#v[] : Vector α 0)).flatten = #v[] := by
rw [ toArray_inj]
simp
@[simp] theorem flatten_mkVector_singleton : (mkVector n #v[a]).flatten = (mkVector n a).cast (by simp) := by
ext i h
simp [h]
@[simp] theorem flatten_mkVector_mkVector : (mkVector n (mkVector m a)).flatten = mkVector (n * m) a := by
ext i h
simp [h]
theorem flatMap_mkArray {β} (f : α Vector β m) : (mkVector n a).flatMap f = (mkVector n (f a)).flatten := by
ext i h
simp [h]
@[simp] theorem sum_mkArray_nat (n : Nat) (a : Nat) : (mkVector n a).sum = n * a := by
simp [toArray_mkVector]
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
@[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
rcases v with data, rfl
simp
@@ -1776,6 +1059,28 @@ defeq issues in the implicit size argument.
subst h
simp [pop, back, back!, Array.eq_push_pop_back!_of_size_ne_zero]
/-! ### append -/
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
rcases a with a, rfl
rcases b with b, rfl
simp [Array.getElem_append, hi]
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n i) :
(a ++ b)[i] = b[i - n] := by
rw [getElem_append, dif_neg (by omega)]
/-! ### cast -/
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
(a.cast h)[i] = a[i] := by
cases a
simp
/-! ### extract -/
@[simp] theorem getElem_extract (a : Vector α n) (start stop) (i : Nat) (hi : i < min stop n - start) :
@@ -1783,6 +1088,13 @@ defeq issues in the implicit size argument.
cases a
simp
/-! ### map -/
@[simp] theorem getElem_map (f : α β) (a : Vector α n) (i : Nat) (hi : i < n) :
(a.map f)[i] = f a[i] := by
cases a
simp
/-! ### zipWith -/
@[simp] theorem getElem_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) (i : Nat)
@@ -1791,37 +1103,6 @@ defeq issues in the implicit size argument.
cases b
simp
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l : Vector α n) (l' : Vector α n') :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
cases l
cases l'
simp
@[simp] theorem foldrM_push [Monad m] (f : α β m β) (init : β) (l : Vector α n) (a : α) :
(l.push a).foldrM f init = f a init >>= l.foldrM f := by
cases l
simp
theorem foldl_eq_foldlM (f : β α β) (b) (l : Vector α n) :
l.foldl f b = l.foldlM (m := Id) f b := by
cases l
simp [Array.foldl_eq_foldlM]
theorem foldr_eq_foldrM (f : α β β) (b) (l : Vector α n) :
l.foldr f b = l.foldrM (m := Id) f b := by
cases l
simp [Array.foldr_eq_foldrM]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : Vector α n) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : Vector α n) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
/-! ### take -/
@[simp] theorem take_size (a : Vector α n) : a.take n = a.cast (by simp) := by

View File

@@ -19,11 +19,6 @@ namespace Vector
@[simp] theorem lt_toList [LT α] (l₁ l₂ : Vector α n) : l₁.toList < l₂.toList l₁ < l₂ := Iff.rfl
@[simp] theorem le_toList [LT α] (l₁ l₂ : Vector α n) : l₁.toList l₂.toList l₁ l₂ := Iff.rfl
protected theorem not_lt_iff_ge [LT α] (l₁ l₂ : Vector α n) : ¬ l₁ < l₂ l₂ l₁ := Iff.rfl
protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : Vector α n) :
¬ l₁ l₂ l₂ < l₁ :=
Decidable.not_not
@[simp] theorem mk_lt_mk [LT α] :
Vector.mk (α := α) (n := n) data₁ size₁ < Vector.mk data₂ size₂ data₁ < data₂ := Iff.rfl
@@ -138,7 +133,7 @@ protected theorem le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
{l₁ l₂ : Vector α n} (h : l₁ < l₂) : l₁ l₂ :=
Array.le_of_lt h
protected theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_lt_or_eq [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
[Std.Total (¬ · < · : α α Prop)]
@@ -205,14 +200,14 @@ theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : αα
rcases l₂ with l₂, n₂
simp_all [Array.lex_eq_false_iff_exists, n₂]
protected theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Vector α n} :
theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Vector α n} :
l₁ < l₂
( (i : Nat) (h : i < n), ( j, (hj : j < i) l₁[j] = l₂[j]) l₁[i] < l₂[i]) := by
cases l₁
cases l₂
simp_all [Array.lt_iff_exists]
protected theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)] {l₁ l₂ : Vector α n} :
@@ -235,12 +230,12 @@ theorem append_left_le [DecidableEq α] [LT α] [DecidableLT α]
l₁ ++ l₂ l₁ ++ l₃ := by
simpa using Array.append_left_le h
protected theorem map_lt [LT α] [LT β]
theorem map_lt [LT α] [LT β]
{l₁ l₂ : Vector α n} {f : α β} (w : x y, x < y f x < f y) (h : l₁ < l₂) :
map f l₁ < map f l₂ := by
simpa using Array.map_lt w h
protected theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
theorem map_le [DecidableEq α] [LT α] [DecidableLT α] [DecidableEq β] [LT β] [DecidableLT β]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]

View File

@@ -8,7 +8,3 @@ import Init.Grind.Norm
import Init.Grind.Tactics
import Init.Grind.Lemmas
import Init.Grind.Cases
import Init.Grind.Propagator
import Init.Grind.Util
import Init.Grind.Offset
import Init.Grind.PP

View File

@@ -5,105 +5,10 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.SimpLemmas
import Init.Classical
import Init.ByCases
import Init.Grind.Util
namespace Lean.Grind
theorem rfl_true : true = true :=
rfl
theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' q) : p q :=
fun hp => h (he.mp hp)
/-! And -/
theorem and_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a b) = b := by simp [h]
theorem and_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a b) = a := by simp [h]
theorem and_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a b) = False := by simp [h]
theorem and_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a b) = False := by simp [h]
theorem eq_true_of_and_eq_true_left {a b : Prop} (h : (a b) = True) : a = True := by simp_all
theorem eq_true_of_and_eq_true_right {a b : Prop} (h : (a b) = True) : b = True := by simp_all
theorem or_of_and_eq_false {a b : Prop} (h : (a b) = False) : (¬a ¬b) := by
by_cases a <;> by_cases b <;> simp_all
/-! Or -/
theorem or_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a b) = True := by simp [h]
theorem or_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a b) = True := by simp [h]
theorem or_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a b) = b := by simp [h]
theorem or_eq_of_eq_false_right {a b : Prop} (h : b = False) : (a b) = a := by simp [h]
theorem eq_false_of_or_eq_false_left {a b : Prop} (h : (a b) = False) : a = False := by simp_all
theorem eq_false_of_or_eq_false_right {a b : Prop} (h : (a b) = False) : b = False := by simp_all
/-! Implies -/
theorem imp_eq_of_eq_false_left {a b : Prop} (h : a = False) : (a b) = True := by simp [h]
theorem imp_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a b) = True := by simp [h]
theorem imp_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a b) = b := by simp [h]
theorem eq_true_of_imp_eq_false {a b : Prop} (h : (a b) = False) : a = True := by simp_all
theorem eq_false_of_imp_eq_false {a b : Prop} (h : (a b) = False) : b = False := by simp_all
/-! Not -/
theorem not_eq_of_eq_true {a : Prop} (h : a = True) : (Not a) = False := by simp [h]
theorem not_eq_of_eq_false {a : Prop} (h : a = False) : (Not a) = True := by simp [h]
theorem eq_false_of_not_eq_true {a : Prop} (h : (Not a) = True) : a = False := by simp_all
theorem eq_true_of_not_eq_false {a : Prop} (h : (Not a) = False) : a = True := by simp_all
theorem false_of_not_eq_self {a : Prop} (h : (Not a) = a) : False := by
by_cases a <;> simp_all
/-! Eq -/
theorem eq_eq_of_eq_true_left {a b : Prop} (h : a = True) : (a = b) = b := by simp [h]
theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by simp [h]
theorem eq_congr {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
/- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a b) (¬b a) := by
by_cases a <;> by_cases b <;> simp_all
theorem of_eq_eq_false {a b : Prop} (h : (a = b) = False) : (¬a ¬b) (b a) := by
by_cases a <;> by_cases b <;> simp_all
/-! Forall -/
theorem forall_propagator (p : Prop) (q : p Prop) (q' : Prop) (h₁ : p = True) (h₂ : q (of_eq_true h₁) = q') : ( hp : p, q hp) = q' := by
apply propext; apply Iff.intro
· intro h'; exact Eq.mp h₂ (h' (of_eq_true h₁))
· intro h'; intros; exact Eq.mpr h₂ h'
theorem of_forall_eq_false (α : Sort u) (p : α Prop) (h : ( x : α, p x) = False) : x : α, ¬ p x := by simp_all
/-! dite -/
theorem dite_cond_eq_true' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c α} {b : ¬ c α} {r : α} (h₁ : c = True) (h₂ : a (of_eq_true h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
theorem dite_cond_eq_false' {α : Sort u} {c : Prop} {_ : Decidable c} {a : c α} {b : ¬ c α} {r : α} (h₁ : c = False) (h₂ : b (of_eq_false h₁) = r) : (dite c a b) = r := by simp [h₁, h₂]
/-! Casts -/
theorem eqRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : (x : α) a = x Sort u_1} (v : motive a (Eq.refl a)) {b : α} (h : a = b)
: HEq (@Eq.rec α a motive v b h) v := by
subst h; rfl
theorem eqRecOn_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : (x : α) a = x Sort u_1} {b : α} (h : a = b) (v : motive a (Eq.refl a))
: HEq (@Eq.recOn α a motive b h v) v := by
subst h; rfl
theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
{motive : α Sort u_1} (v : motive a) {b : α} (h : a = b)
: HEq (@Eq.ndrec α a motive v b h) v := by
subst h; rfl
end Lean.Grind

View File

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

View File

@@ -1,92 +0,0 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.Omega
namespace Lean.Grind
abbrev isLt (x y : Nat) : Bool := x < y
abbrev isLE (x y : Nat) : Bool := x y
/-! Theorems for transitivity. -/
theorem Nat.le_ro (u w v k : Nat) : u w w v + k u v + k := by
omega
theorem Nat.le_lo (u w v k : Nat) : u w w + k v u + k v := by
omega
theorem Nat.lo_le (u w v k : Nat) : u + k w w v u + k v := by
omega
theorem Nat.lo_lo (u w v k₁ k₂ : Nat) : u + k₁ w w + k₂ v u + (k₁ + k₂) v := by
omega
theorem Nat.lo_ro_1 (u w v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ w w v + k₂ u + (k₁ - k₂) v := by
simp [isLt]; omega
theorem Nat.lo_ro_2 (u w v k₁ k₂ : Nat) : u + k₁ w w v + k₂ u v + (k₂ - k₁) := by
omega
theorem Nat.ro_le (u w v k : Nat) : u w + k w v u v + k := by
omega
theorem Nat.ro_lo_1 (u w v k₁ k₂ : Nat) : u w + k₁ w + k₂ v u v + (k₁ - k₂) := by
omega
theorem Nat.ro_lo_2 (u w v k₁ k₂ : Nat) : isLt k₁ k₂ = true u w + k₁ w + k₂ v u + (k₂ - k₁) v := by
simp [isLt]; omega
theorem Nat.ro_ro (u w v k₁ k₂ : Nat) : u w + k₁ w v + k₂ u v + (k₁ + k₂) := by
omega
/-! Theorems for negating constraints. -/
theorem Nat.of_le_eq_false (u v : Nat) : ((u v) = False) v + 1 u := by
simp; omega
theorem Nat.of_lo_eq_false_1 (u v : Nat) : ((u + 1 v) = False) v u := by
simp; omega
theorem Nat.of_lo_eq_false (u v k : Nat) : ((u + k v) = False) v u + (k-1) := by
simp; omega
theorem Nat.of_ro_eq_false (u v k : Nat) : ((u v + k) = False) v + (k+1) u := by
simp; omega
/-! Theorems for closing a goal. -/
theorem Nat.unsat_le_lo (u v k : Nat) : isLt 0 k = true u v v + k u False := by
simp [isLt]; omega
theorem Nat.unsat_lo_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true u + k₁ v v + k₂ u False := by
simp [isLt]; omega
theorem Nat.unsat_lo_ro (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ v v u + k₂ False := by
simp [isLt]; omega
/-! Theorems for propagating constraints to `True` -/
theorem Nat.lo_eq_true_of_lo (u v k₁ k₂ : Nat) : isLE k₂ k₁ = true u + k₁ v (u + k₂ v) = True :=
by simp [isLt]; omega
theorem Nat.le_eq_true_of_lo (u v k : Nat) : u + k v (u v) = True :=
by simp; omega
theorem Nat.le_eq_true_of_le (u v : Nat) : u v (u v) = True :=
by simp
theorem Nat.ro_eq_true_of_lo (u v k₁ k₂ : Nat) : u + k₁ v (u v + k₂) = True :=
by simp; omega
theorem Nat.ro_eq_true_of_le (u v k : Nat) : u v (u v + k) = True :=
by simp; omega
theorem Nat.ro_eq_true_of_ro (u v k₁ k₂ : Nat) : isLE k₁ k₂ = true u v + k₁ (u v + k₂) = True :=
by simp [isLE]; omega
/-!
Theorems for propagating constraints to `False`.
They are variants of the theorems for closing a goal.
-/
theorem Nat.lo_eq_false_of_le (u v k : Nat) : isLt 0 k = true u v (v + k u) = False := by
simp [isLt]; omega
theorem Nat.le_eq_false_of_lo (u v k : Nat) : isLt 0 k = true u + k v (v u) = False := by
simp [isLt]; omega
theorem Nat.lo_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true u + k₁ v (v + k₂ u) = False := by
simp [isLt]; omega
theorem Nat.ro_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ v (v u + k₂) = False := by
simp [isLt]; omega
theorem Nat.lo_eq_false_of_ro (u v k₁ k₂ : Nat) : isLt k₁ k₂ = true u v + k₁ (v + k₂ u) = False := by
simp [isLt]; omega
/-!
Helper theorems for equality propagation
-/
theorem Nat.le_of_eq_1 (u v : Nat) : u = v u v := by omega
theorem Nat.le_of_eq_2 (u v : Nat) : u = v v u := by omega
theorem Nat.eq_of_le_of_le (u v : Nat) : u v v u u = v := by omega
theorem Nat.le_offset (a k : Nat) : k a + k := by omega
end Lean.Grind

View File

@@ -1,30 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.NotationExtra
namespace Lean.Grind
/-!
This is a hackish module for hovering node information in the `grind` tactic state.
-/
inductive NodeDef where
| unit
set_option linter.unusedVariables false in
def node_def (_ : Nat) {α : Sort u} {a : α} : NodeDef := .unit
@[app_unexpander node_def]
def nodeDefUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $id:num) => return mkIdent <| Name.mkSimple $ "#" ++ toString id.getNat
| _ => throw ()
@[app_unexpander NodeDef]
def NodeDefUnexpander : PrettyPrinter.Unexpander := fun _ => do
return mkIdent <| Name.mkSimple "NodeDef"
end Lean.Grind

View File

@@ -1,27 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.NotationExtra
namespace Lean.Parser
/-- A user-defined propagator for the `grind` tactic. -/
-- TODO: not implemented yet
syntax (docComment)? "grind_propagator " (Tactic.simpPre <|> Tactic.simpPost) ident " (" ident ")" " := " term : command
/-- A builtin propagator for the `grind` tactic. -/
syntax (docComment)? "builtin_grind_propagator " ident (Tactic.simpPre <|> Tactic.simpPost) ident " := " term : command
/-- Auxiliary attribute for builtin `grind` propagators. -/
syntax (name := grindPropagatorBuiltinAttr) "builtin_grind_propagator" (Tactic.simpPre <|> Tactic.simpPost) ident : attr
macro_rules
| `($[$doc?:docComment]? builtin_grind_propagator $propagatorName:ident $direction $op:ident := $body) => do
let propagatorType := `Lean.Meta.Grind.Propagator
`($[$doc?:docComment]? def $propagatorName:ident : $(mkIdent propagatorType) := $body
attribute [builtin_grind_propagator $direction $op] $propagatorName)
end Lean.Parser

View File

@@ -6,60 +6,20 @@ Authors: Leonardo de Moura
prelude
import Init.Tactics
namespace Lean.Parser.Attr
syntax grindEq := "="
syntax grindEqBoth := atomic("_" "=" "_")
syntax grindEqRhs := atomic("=" "_")
syntax grindBwd := ""
syntax grindFwd := ""
syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
end Lean.Parser.Attr
namespace Lean.Grind
/--
The configuration for `grind`.
Passed to `grind` using, for example, the `grind (config := { matchEqs := true })` syntax.
Passed to `grind` using, for example, the `grind (config := { eager := true })` syntax.
-/
structure Config where
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
splits : Nat := 8
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
ematch : Nat := 5
/--
Maximum term generation.
The input goal terms have generation 0. When we instantiate a theorem using a term from generation `n`,
the new terms have generation `n+1`. Thus, this parameter limits the length of an instantiation chain. -/
gen : Nat := 5
/-- Maximum number of theorem instances generated using E-matching in a proof search tree branch. -/
instances : Nat := 1000
/-- If `matchEqs` is `true`, `grind` uses `match`-equations as E-matching theorems. -/
matchEqs : Bool := true
/-- If `splitMatch` is `true`, `grind` performs case-splitting on `match`-expressions during the search. -/
splitMatch : Bool := true
/-- If `splitIte` is `true`, `grind` performs case-splitting on `if-then-else` expressions during the search. -/
splitIte : Bool := true
/--
If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
splitIndPred : Bool := true
/-- By default, `grind` halts as soon as it encounters a sub-goal where no further progress can be made. -/
failures : Nat := 1
/-- Maximum number of heartbeats (in thousands) the canonicalizer can spend per definitional equality test. -/
canonHeartbeats : Nat := 1000
When `eager` is true (default: `false`), `grind` eagerly splits `if-then-else` and `match`
expressions.
-/
eager : Bool := false
deriving Inhabited, BEq
end Lean.Grind
namespace Lean.Parser.Tactic
/-!
`grind` tactic and related tactics.
-/
-- TODO: parameters
syntax (name := grind) "grind" optConfig ("on_failure " term)? : tactic
end Lean.Parser.Tactic
end Lean.Grind

View File

@@ -1,34 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
namespace Lean.Grind
/-- A helper gadget for annotating nested proofs in goals. -/
def nestedProof (p : Prop) {h : p} : p := h
/--
Gadget for marking terms that should not be normalized by `grind`s simplifier.
`grind` uses a simproc to implement this feature.
We use it when adding instances of `match`-equations to prevent them from being simplified to true.
-/
def doNotSimp {α : Sort u} (a : α) : α := a
/-- Gadget for representing offsets `t+k` in patterns. -/
def offset (a b : Nat) : Nat := a + b
/--
Gadget for annotating the equalities in `match`-equations conclusions.
`_origin` is the term used to instantiate the `match`-equation using E-matching.
When `EqMatch a b origin` is `True`, we mark `origin` as a resolved case-split.
-/
def EqMatch (a b : α) {_origin : α} : Prop := a = b
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
subst h; apply HEq.refl
end Lean.Grind

View File

@@ -1,13 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.Internal.Order
/-!
This directory is used for components of the standard library that are either considered
implementation details or not yet ready for public consumption, and that should be available
without explicit import (in contrast to `Std.Internal`)
-/

View File

@@ -1,8 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.Internal.Order.Basic
import Init.Internal.Order.Tactic

View File

@@ -1,693 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.ByCases
import Init.RCases
/-!
This module contains some basic definitions and results from domain theory, intended to be used as
the underlying construction of the `partial_fixpoint` feature. It is not meant to be used as a
general purpose library for domain theory, but can be of interest to users who want to extend
the `partial_fixpoint` machinery (e.g. mark more functions as monotone or register more monads).
This follows the corresponding
[Isabelle development](https://isabelle.in.tum.de/library/HOL/HOL/Partial_Function.html), as also
described in [Alexander Krauss: Recursive Definitions of Monadic Functions](https://www21.in.tum.de/~krauss/papers/mrec.pdf).
-/
universe u v w
namespace Lean.Order
/--
A partial order is a reflexive, transitive and antisymmetric relation.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
class PartialOrder (α : Sort u) where
/--
A “less-or-equal-to” or “approximates” relation.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
rel : α α Prop
rel_refl : {x}, rel x x
rel_trans : {x y z}, rel x y rel y z rel x z
rel_antisymm : {x y}, rel x y rel y x x = y
@[inherit_doc] scoped infix:50 "" => PartialOrder.rel
section PartialOrder
variable {α : Sort u} [PartialOrder α]
theorem PartialOrder.rel_of_eq {x y : α} (h : x = y) : x y := by cases h; apply rel_refl
/--
A chain is a totally ordered set (representing a set as a predicate).
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def chain (c : α Prop) : Prop := x y , c x c y x y y x
end PartialOrder
section CCPO
/--
A chain-complete partial order (CCPO) is a partial order where every chain a least upper bound.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
class CCPO (α : Sort u) extends PartialOrder α where
/--
The least upper bound of a chain.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
csup : (α Prop) α
csup_spec {c : α Prop} (hc : chain c) : csup c x ( y, c y y x)
open PartialOrder CCPO
variable {α : Sort u} [CCPO α]
theorem csup_le {c : α Prop} (hchain : chain c) : ( y, c y y x) csup c x :=
(csup_spec hchain).mpr
theorem le_csup {c : α Prop} (hchain : chain c) {y : α} (hy : c y) : y csup c :=
(csup_spec hchain).mp rel_refl y hy
/--
The bottom element is the least upper bound of the empty chain.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def bot : α := csup (fun _ => False)
scoped notation "" => bot
theorem bot_le (x : α) : x := by
apply csup_le
· intro x y hx hy; contradiction
· intro x hx; contradiction
end CCPO
section monotone
variable {α : Sort u} [PartialOrder α]
variable {β : Sort v} [PartialOrder β]
/--
A function is monotone if if it maps related elements to releated elements.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def monotone (f : α β) : Prop := x y, x y f x f y
theorem monotone_const (c : β) : monotone (fun (_ : α) => c) :=
fun _ _ _ => PartialOrder.rel_refl
theorem monotone_id : monotone (fun (x : α) => x) :=
fun _ _ hxy => hxy
theorem monotone_compose
{γ : Sort w} [PartialOrder γ]
{f : α β} {g : β γ}
(hf : monotone f) (hg : monotone g) :
monotone (fun x => g (f x)) := fun _ _ hxy => hg _ _ (hf _ _ hxy)
end monotone
section admissibility
variable {α : Sort u} [CCPO α]
open PartialOrder CCPO
/--
A predicate is admissable if it can be transferred from the elements of a chain to the chains least
upper bound. Such predicates can be used in fixpoint induction.
This definition implies `P ⊥`. Sometimes (e.g. in Isabelle) the empty chain is excluded
from this definition, and `P ⊥` is a separate condition of the induction predicate.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def admissible (P : α Prop) :=
(c : α Prop), chain c ( x, c x P x) P (csup c)
theorem admissible_const_true : admissible (fun (_ : α) => True) :=
fun _ _ _ => trivial
theorem admissible_and (P Q : α Prop)
(hadm₁ : admissible P) (hadm₂ : admissible Q) : admissible (fun x => P x Q x) :=
fun c hchain h =>
hadm₁ c hchain fun x hx => (h x hx).1,
hadm₂ c hchain fun x hx => (h x hx).2
theorem chain_conj (c P : α Prop) (hchain : chain c) : chain (fun x => c x P x) := by
intro x y hcx, _ hcy, _
exact hchain x y hcx hcy
theorem csup_conj (c P : α Prop) (hchain : chain c) (h : x, c x y, c y x y P y) :
csup c = csup (fun x => c x P x) := by
apply rel_antisymm
· apply csup_le hchain
intro x hcx
obtain y, hcy, hxy, hPy := h x hcx
apply rel_trans hxy; clear x hcx hxy
apply le_csup (chain_conj _ _ hchain) hcy, hPy
· apply csup_le (chain_conj _ _ hchain)
intro x hcx, hPx
apply le_csup hchain hcx
theorem admissible_or (P Q : α Prop)
(hadm₁ : admissible P) (hadm₂ : admissible Q) : admissible (fun x => P x Q x) := by
intro c hchain h
have : ( x, c x y, c y x y P y) ( x, c x y, c y x y Q y) := by
open Classical in
apply Decidable.or_iff_not_imp_left.mpr
intro h'
simp only [not_forall, not_imp, not_exists, not_and] at h'
obtain x, hcx, hx := h'
intro y hcy
cases hchain x y hcx hcy with
| inl hxy =>
refine y, hcy, rel_refl, ?_
cases h y hcy with
| inl hPy => exfalso; apply hx y hcy hxy hPy
| inr hQy => assumption
| inr hyx =>
refine x, hcx, hyx , ?_
cases h x hcx with
| inl hPx => exfalso; apply hx x hcx rel_refl hPx
| inr hQx => assumption
cases this with
| inl hP =>
left
rw [csup_conj (h := hP) (hchain := hchain)]
apply hadm₁ _ (chain_conj _ _ hchain)
intro x hcx, hPx
exact hPx
| inr hQ =>
right
rw [csup_conj (h := hQ) (hchain := hchain)]
apply hadm₂ _ (chain_conj _ _ hchain)
intro x hcx, hQx
exact hQx
def admissible_pi (P : α β Prop)
(hadm₁ : y, admissible (fun x => P x y)) : admissible (fun x => y, P x y) :=
fun c hchain h y => hadm₁ y c hchain fun x hx => h x hx y
end admissibility
section fix
open PartialOrder CCPO
variable {α : Sort u} [CCPO α]
variable {c : α Prop} (hchain : chain c)
/--
The transfinite iteration of a function `f` is a set that is `⊥ ` and is closed under application
of `f` and `csup`.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
inductive iterates (f : α α) : α Prop where
| step : iterates f x iterates f (f x)
| sup {c : α Prop} (hc : chain c) (hi : x, c x iterates f x) : iterates f (csup c)
theorem chain_iterates {f : α α} (hf : monotone f) : chain (iterates f) := by
intros x y hx hy
induction hx generalizing y
case step x hx ih =>
induction hy
case step y hy _ =>
cases ih y hy
· left; apply hf; assumption
· right; apply hf; assumption
case sup c hchain hi ih2 =>
show f x csup c csup c f x
by_cases h : z, c z f x z
· left
obtain z, hz, hfz := h
apply rel_trans hfz
apply le_csup hchain hz
· right
apply csup_le hchain _
intro z hz
rw [not_exists] at h
specialize h z
rw [not_and] at h
specialize h hz
cases ih2 z hz
next => contradiction
next => assumption
case sup c hchain hi ih =>
show rel (csup c) y rel y (csup c)
by_cases h : z, c z rel y z
· right
obtain z, hz, hfz := h
apply rel_trans hfz
apply le_csup hchain hz
· left
apply csup_le hchain _
intro z hz
rw [not_exists] at h
specialize h z
rw [not_and] at h
specialize h hz
cases ih z hz y hy
next => assumption
next => contradiction
theorem rel_f_of_iterates {f : α α} (hf : monotone f) {x : α} (hx : iterates f x) : x f x := by
induction hx
case step ih =>
apply hf
assumption
case sup c hchain hi ih =>
apply csup_le hchain
intro y hy
apply rel_trans (ih y hy)
apply hf
apply le_csup hchain hy
set_option linter.unusedVariables false in
/--
The least fixpoint of a monotone function is the least upper bound of its transfinite iteration.
The `monotone f` assumption is not strictly necessarily for the definition, but without this the
definition is not very meaningful and it simplifies applying theorems like `fix_eq` if every use of
`fix` already has the monotonicty requirement.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def fix (f : α α) (hmono : monotone f) := csup (iterates f)
/--
The main fixpoint theorem for fixedpoints of monotone functions in chain-complete partial orders.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
theorem fix_eq {f : α α} (hf : monotone f) : fix f hf = f (fix f hf) := by
apply rel_antisymm
· apply rel_f_of_iterates hf
apply iterates.sup (chain_iterates hf)
exact fun _ h => h
· apply le_csup (chain_iterates hf)
apply iterates.step
apply iterates.sup (chain_iterates hf)
intro y hy
exact hy
/--
The fixpoint induction theme: An admissible predicate holds for a least fixpoint if it is preserved
by the fixpoint's function.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
theorem fix_induct {f : α α} (hf : monotone f)
(motive : α Prop) (hadm: admissible motive)
(h : x, motive x motive (f x)) : motive (fix f hf) := by
apply hadm _ (chain_iterates hf)
intro x hiterates
induction hiterates with
| @step x hiter ih => apply h x ih
| @sup c hchain hiter ih => apply hadm c hchain ih
end fix
section fun_order
open PartialOrder
variable {α : Sort u}
variable {β : α Sort v}
variable {γ : Sort w}
instance instOrderPi [ x, PartialOrder (β x)] : PartialOrder ( x, β x) where
rel f g := x, f x g x
rel_refl _ := rel_refl
rel_trans hf hg x := rel_trans (hf x) (hg x)
rel_antisymm hf hg := funext (fun x => rel_antisymm (hf x) (hg x))
theorem monotone_of_monotone_apply [PartialOrder γ] [ x, PartialOrder (β x)] (f : γ ( x, β x))
(h : y, monotone (fun x => f x y)) : monotone f :=
fun x y hxy z => h z x y hxy
theorem monotone_apply [PartialOrder γ] [ x, PartialOrder (β x)] (a : α) (f : γ x, β x)
(h : monotone f) :
monotone (fun x => f x a) := fun _ _ hfg => h _ _ hfg a
theorem chain_apply [ x, PartialOrder (β x)] {c : ( x, β x) Prop} (hc : chain c) (x : α) :
chain (fun y => f, c f f x = y) := by
intro _ _ f, hf, hfeq g, hg, hgeq
subst hfeq; subst hgeq
cases hc f g hf hg
next h => left; apply h x
next h => right; apply h x
def fun_csup [ x, CCPO (β x)] (c : ( x, β x) Prop) (x : α) :=
CCPO.csup (fun y => f, c f f x = y)
instance instCCPOPi [ x, CCPO (β x)] : CCPO ( x, β x) where
csup := fun_csup
csup_spec := by
intro f c hc
constructor
next =>
intro hf g hg x
apply rel_trans _ (hf x); clear hf
apply le_csup (chain_apply hc x)
exact g, hg, rfl
next =>
intro h x
apply csup_le (chain_apply hc x)
intro y z, hz, hyz
subst y
apply h z hz
def admissible_apply [ x, CCPO (β x)] (P : x, β x Prop) (x : α)
(hadm : admissible (P x)) : admissible (fun (f : x, β x) => P x (f x)) := by
intro c hchain h
apply hadm _ (chain_apply hchain x)
rintro _ f, hcf, rfl
apply h _ hcf
def admissible_pi_apply [ x, CCPO (β x)] (P : x, β x Prop) (hadm : x, admissible (P x)) :
admissible (fun (f : x, β x) => x, P x (f x)) := by
apply admissible_pi
intro
apply admissible_apply
apply hadm
end fun_order
section monotone_lemmas
theorem monotone_letFun
{α : Sort u} {β : Sort v} {γ : Sort w} [PartialOrder α] [PartialOrder β]
(v : γ) (k : α γ β)
(hmono : y, monotone (fun x => k x y)) :
monotone fun (x : α) => letFun v (k x) := hmono v
theorem monotone_ite
{α : Sort u} {β : Sort v} [PartialOrder α] [PartialOrder β]
(c : Prop) [Decidable c]
(k₁ : α β) (k₂ : α β)
(hmono₁ : monotone k₁) (hmono₂ : monotone k₂) :
monotone fun x => if c then k₁ x else k₂ x := by
split
· apply hmono₁
· apply hmono₂
theorem monotone_dite
{α : Sort u} {β : Sort v} [PartialOrder α] [PartialOrder β]
(c : Prop) [Decidable c]
(k₁ : α c β) (k₂ : α ¬ c β)
(hmono₁ : monotone k₁) (hmono₂ : monotone k₂) :
monotone fun x => dite c (k₁ x) (k₂ x) := by
split
· apply monotone_apply _ _ hmono₁
· apply monotone_apply _ _ hmono₂
end monotone_lemmas
section pprod_order
open PartialOrder
variable {α : Sort u}
variable {β : Sort v}
variable {γ : Sort w}
instance [PartialOrder α] [PartialOrder β] : PartialOrder (α ×' β) where
rel a b := a.1 b.1 a.2 b.2
rel_refl := rel_refl, rel_refl
rel_trans ha hb := rel_trans ha.1 hb.1, rel_trans ha.2 hb.2
rel_antisymm := fun {a} {b} ha hb => by
cases a; cases b;
dsimp at *
rw [rel_antisymm ha.1 hb.1, rel_antisymm ha.2 hb.2]
theorem monotone_pprod [PartialOrder α] [PartialOrder β] [PartialOrder γ]
{f : γ α} {g : γ β} (hf : monotone f) (hg : monotone g) :
monotone (fun x => PProd.mk (f x) (g x)) :=
fun _ _ h12 => hf _ _ h12, hg _ _ h12
theorem monotone_pprod_fst [PartialOrder α] [PartialOrder β] [PartialOrder γ]
{f : γ α ×' β} (hf : monotone f) : monotone (fun x => (f x).1) :=
fun _ _ h12 => (hf _ _ h12).1
theorem monotone_pprod_snd [PartialOrder α] [PartialOrder β] [PartialOrder γ]
{f : γ α ×' β} (hf : monotone f) : monotone (fun x => (f x).2) :=
fun _ _ h12 => (hf _ _ h12).2
def chain_pprod_fst [CCPO α] [CCPO β] (c : α ×' β Prop) : α Prop := fun a => b, c a, b
def chain_pprod_snd [CCPO α] [CCPO β] (c : α ×' β Prop) : β Prop := fun b => a, c a, b
theorem chain.pprod_fst [CCPO α] [CCPO β] (c : α ×' β Prop) (hchain : chain c) :
chain (chain_pprod_fst c) := by
intro a₁ a₂ b₁, h₁ b₂, h₂
cases hchain a₁, b₁ a₂, b₂ h₁ h₂
case inl h => left; exact h.1
case inr h => right; exact h.1
theorem chain.pprod_snd [CCPO α] [CCPO β] (c : α ×' β Prop) (hchain : chain c) :
chain (chain_pprod_snd c) := by
intro b₁ b₂ a₁, h₁ a₂, h₂
cases hchain a₁, b₁ a₂, b₂ h₁ h₂
case inl h => left; exact h.2
case inr h => right; exact h.2
instance [CCPO α] [CCPO β] : CCPO (α ×' β) where
csup c := CCPO.csup (chain_pprod_fst c), CCPO.csup (chain_pprod_snd c)
csup_spec := by
intro a, b c hchain
dsimp
constructor
next =>
intro h₁, h₂ a', b' cab
constructor <;> dsimp at *
· apply rel_trans ?_ h₁
apply le_csup hchain.pprod_fst
exact b', cab
· apply rel_trans ?_ h₂
apply le_csup hchain.pprod_snd
exact a', cab
next =>
intro h
constructor <;> dsimp
· apply csup_le hchain.pprod_fst
intro a' b', hcab
apply (h _ hcab).1
· apply csup_le hchain.pprod_snd
intro b' a', hcab
apply (h _ hcab).2
theorem admissible_pprod_fst {α : Sort u} {β : Sort v} [CCPO α] [CCPO β] (P : α Prop)
(hadm : admissible P) : admissible (fun (x : α ×' β) => P x.1) := by
intro c hchain h
apply hadm _ hchain.pprod_fst
intro x y, hxy
apply h x,y hxy
theorem admissible_pprod_snd {α : Sort u} {β : Sort v} [CCPO α] [CCPO β] (P : β Prop)
(hadm : admissible P) : admissible (fun (x : α ×' β) => P x.2) := by
intro c hchain h
apply hadm _ hchain.pprod_snd
intro y x, hxy
apply h x,y hxy
end pprod_order
section flat_order
variable {α : Sort u}
set_option linter.unusedVariables false in
/--
`FlatOrder b` wraps the type `α` with the flat partial order generated by `∀ x, b ⊑ x`.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
def FlatOrder {α : Sort u} (b : α) := α
variable {b : α}
/--
The flat partial order generated by `∀ x, b ⊑ x`.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
inductive FlatOrder.rel : (x y : FlatOrder b) Prop where
| bot : rel b x
| refl : rel x x
instance FlatOrder.instOrder : PartialOrder (FlatOrder b) where
rel := rel
rel_refl := .refl
rel_trans {x y z : α} (hxy : rel x y) (hyz : rel y z) := by
cases hxy <;> cases hyz <;> constructor
rel_antisymm {x y : α} (hxy : rel x y) (hyz : rel y x) : x = y := by
cases hxy <;> cases hyz <;> constructor
open Classical in
private theorem Classical.some_spec₂ {α : Sort _} {p : α Prop} {h : a, p a} (q : α Prop)
(hpq : a, p a q a) : q (choose h) := hpq _ <| choose_spec _
noncomputable def flat_csup (c : FlatOrder b Prop) : FlatOrder b := by
by_cases h : (x : FlatOrder b), c x x b
· exact Classical.choose h
· exact b
noncomputable instance FlatOrder.instCCPO : CCPO (FlatOrder b) where
csup := flat_csup
csup_spec := by
intro x c hc
unfold flat_csup
split
next hex =>
apply Classical.some_spec₂ (q := (· x ( y, c y y x)))
clear hex
intro z hz, hnb
constructor
· intro h y hy
apply PartialOrder.rel_trans _ h; clear h
cases hc y z hy hz
next => assumption
next h =>
cases h
· contradiction
· constructor
· intro h
cases h z hz
· contradiction
· constructor
next hnotex =>
constructor
· intro h y hy; clear h
suffices y = b by rw [this]; exact rel.bot
rw [not_exists] at hnotex
specialize hnotex y
rw [not_and] at hnotex
specialize hnotex hy
rw [@Classical.not_not] at hnotex
assumption
· intro; exact rel.bot
theorem admissible_flatOrder (P : FlatOrder b Prop) (hnot : P b) : admissible P := by
intro c hchain h
by_cases h' : (x : FlatOrder b), c x x b
· simp [CCPO.csup, flat_csup, h']
apply Classical.some_spec₂ (q := (P ·))
intro x hcx, hneb
apply h x hcx
· simp [CCPO.csup, flat_csup, h', hnot]
end flat_order
section mono_bind
/--
The class `MonoBind m` indicates that every `m α` has a `PartialOrder`, and that the bind operation
on `m` is monotone in both arguments with regard to that order.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
class MonoBind (m : Type u Type v) [Bind m] [ α, PartialOrder (m α)] where
bind_mono_left {a₁ a₂ : m α} {f : α m b} (h : a₁ a₂) : a₁ >>= f a₂ >>= f
bind_mono_right {a : m α} {f₁ f₂ : α m b} (h : x, f₁ x f₂ x) : a >>= f₁ a >>= f₂
theorem monotone_bind
(m : Type u Type v) [Bind m] [ α, PartialOrder (m α)] [MonoBind m]
{α β : Type u}
{γ : Type w} [PartialOrder γ]
(f : γ m α) (g : γ α m β)
(hmono₁ : monotone f)
(hmono₂ : monotone g) :
monotone (fun (x : γ) => f x >>= g x) := by
intro x₁ x₂ hx₁₂
apply PartialOrder.rel_trans
· apply MonoBind.bind_mono_left (hmono₁ _ _ hx₁₂)
· apply MonoBind.bind_mono_right (fun y => monotone_apply y _ hmono₂ _ _ hx₁₂)
instance : PartialOrder (Option α) := inferInstanceAs (PartialOrder (FlatOrder none))
noncomputable instance : CCPO (Option α) := inferInstanceAs (CCPO (FlatOrder none))
noncomputable instance : MonoBind Option where
bind_mono_left h := by
cases h
· exact FlatOrder.rel.bot
· exact FlatOrder.rel.refl
bind_mono_right h := by
cases Option _
· exact FlatOrder.rel.refl
· exact h _
theorem admissible_eq_some (P : Prop) (y : α) :
admissible (fun (x : Option α) => x = some y P) := by
apply admissible_flatOrder; simp
instance [Monad m] [inst : α, PartialOrder (m α)] : PartialOrder (ExceptT ε m α) := inst _
instance [Monad m] [ α, PartialOrder (m α)] [inst : α, CCPO (m α)] : CCPO (ExceptT ε m α) := inst _
instance [Monad m] [ α, PartialOrder (m α)] [ α, CCPO (m α)] [MonoBind m] : MonoBind (ExceptT ε m) where
bind_mono_left h₁₂ := by
apply MonoBind.bind_mono_left (m := m)
exact h₁₂
bind_mono_right h₁₂ := by
apply MonoBind.bind_mono_right (m := m)
intro x
cases x
· apply PartialOrder.rel_refl
· apply h₁₂
end mono_bind
namespace Example
def findF (P : Nat Bool) (rec : Nat Option Nat) (x : Nat) : Option Nat :=
if P x then
some x
else
rec (x + 1)
noncomputable def find (P : Nat Bool) : Nat Option Nat := fix (findF P) <| by
unfold findF
apply monotone_of_monotone_apply
intro n
split
· apply monotone_const
· apply monotone_apply
apply monotone_id
theorem find_eq : find P = findF P (find P) := fix_eq ..
theorem find_spec : n m, find P n = some m n m P m := by
unfold find
refine fix_induct (motive := fun (f : Nat Option Nat) => n m, f n = some m n m P m) _ ?hadm ?hstep
case hadm =>
-- apply admissible_pi_apply does not work well, hard to infer everything
exact admissible_pi_apply _ (fun n => admissible_pi _ (fun m => admissible_eq_some _ m))
case hstep =>
intro f ih n m heq
simp only [findF] at heq
split at heq
· simp_all
· obtain ih1, ih2 := ih _ _ heq
constructor
· exact Nat.le_trans (Nat.le_add_right _ _ ) ih1
· exact ih2
end Example
end Lean.Order

View File

@@ -1,20 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.Notation
namespace Lean.Order
/--
`monotonicity` performs one compositional step solving `monotone` goals,
using lemma tagged with `@[partial_fixpoint_monotone]`.
This tactic is mostly used internally by lean in `partial_fixpoint` definitions, but
can be useful on its own for debugging or when proving new `@[partial_fixpoint_monotone]` lemmas.
-/
scoped syntax (name := monotonicity) "monotonicity" : tactic
end Lean.Order

View File

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

View File

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

View File

@@ -21,6 +21,11 @@ def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration
else
addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
let env addDecl env opts decl cancelTk?
compileDecl env opts decl
def addDecl (decl : Declaration) : CoreM Unit := do
profileitM Exception "type checking" ( getOptions) do
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do

View File

@@ -18,7 +18,6 @@ inductive ExternEntry where
| inline (backend : Name) (pattern : String)
| standard (backend : Name) (fn : String)
| foreign (backend : Name) (fn : String)
deriving BEq, Hashable
/--
- `@[extern]`
@@ -37,7 +36,7 @@ inductive ExternEntry where
structure ExternAttrData where
arity? : Option Nat := none
entries : List ExternEntry
deriving Inhabited, BEq, Hashable
deriving Inhabited
-- def externEntry := leading_parser optional ident >> optional (nonReservedSymbol "inline ") >> strLit
-- @[builtin_attr_parser] def extern := leading_parser nonReservedSymbol "extern " >> optional numLit >> many externEntry

View File

@@ -144,7 +144,11 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
let type := mkApp (mkConst `IO) (mkConst `Unit)
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
safety := DefinitionSafety.safe }
addAndCompile decl
IO.ofExcept (setBuiltinInitAttr ( getEnv) name) >>= setEnv
match ( getEnv).addAndCompile {} decl with
-- TODO: pretty print error
| Except.error e => do
let msg (e.toMessageData {}).toString
throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
| Except.ok env => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
end Lean

View File

@@ -7,7 +7,6 @@ prelude
import Init.Data.List.BasicAux
import Lean.Expr
import Lean.Meta.Instances
import Lean.Compiler.ExternAttr
import Lean.Compiler.InlineAttrs
import Lean.Compiler.Specialize
import Lean.Compiler.LCNF.Types
@@ -430,80 +429,6 @@ where
| .cases c => c.alts.forM fun alt => go alt.getCode
| .unreach .. | .return .. | .jmp .. => return ()
partial def Code.instantiateValueLevelParams (code : Code) (levelParams : List Name) (us : List Level) : Code :=
instCode code
where
instLevel (u : Level) :=
u.instantiateParams levelParams us
instExpr (e : Expr) :=
e.instantiateLevelParamsNoCache levelParams us
instParams (ps : Array Param) :=
ps.mapMono fun p => p.updateCore (instExpr p.type)
instAlt (alt : Alt) :=
match alt with
| .default k => alt.updateCode (instCode k)
| .alt _ ps k => alt.updateAlt! (instParams ps) (instCode k)
instArg (arg : Arg) : Arg :=
match arg with
| .type e => arg.updateType! (instExpr e)
| .fvar .. | .erased => arg
instLetValue (e : LetValue) : LetValue :=
match e with
| .const declName vs args => e.updateConst! declName (vs.mapMono instLevel) (args.mapMono instArg)
| .fvar fvarId args => e.updateFVar! fvarId (args.mapMono instArg)
| .proj .. | .value .. | .erased => e
instLetDecl (decl : LetDecl) :=
decl.updateCore (instExpr decl.type) (instLetValue decl.value)
instFunDecl (decl : FunDecl) :=
decl.updateCore (instExpr decl.type) (instParams decl.params) (instCode decl.value)
instCode (code : Code) :=
match code with
| .let decl k => code.updateLet! (instLetDecl decl) (instCode k)
| .jp decl k | .fun decl k => code.updateFun! (instFunDecl decl) (instCode k)
| .cases c => code.updateCases! (instExpr c.resultType) c.discr (c.alts.mapMono instAlt)
| .jmp fvarId args => code.updateJmp! fvarId (args.mapMono instArg)
| .return .. => code
| .unreach type => code.updateUnreach! (instExpr type)
inductive DeclValue where
| code (code : Code)
| extern (externAttrData : ExternAttrData)
deriving Inhabited, BEq
partial def DeclValue.size : DeclValue Nat
| .code c => c.size
| .extern .. => 0
def DeclValue.mapCode (f : Code Code) : DeclValue DeclValue :=
fun
| .code c => .code (f c)
| .extern e => .extern e
def DeclValue.mapCodeM [Monad m] (f : Code m Code) : DeclValue m DeclValue :=
fun v => do
match v with
| .code c => return .code ( f c)
| .extern .. => return v
def DeclValue.forCodeM [Monad m] (f : Code m Unit) : DeclValue m Unit :=
fun v => do
match v with
| .code c => f c
| .extern .. => return ()
def DeclValue.isCodeAndM [Monad m] (v : DeclValue) (f : Code m Bool) : m Bool :=
match v with
| .code c => f c
| .extern .. => pure false
/--
Declaration being processed by the Lean to Lean compiler passes.
-/
@@ -530,7 +455,7 @@ structure Decl where
The body of the declaration, usually changes as it progresses
through compiler passes.
-/
value : DeclValue
value : Code
/--
We set this flag to true during LCNF conversion. When we receive
a block of functions to be compiled, we set this flag to `true`
@@ -611,9 +536,7 @@ We use this function to decide whether we should inline a declaration tagged wit
`[inline_if_reduce]` or not.
-/
def Decl.isCasesOnParam? (decl : Decl) : Option Nat :=
match decl.value with
| .code c => go c
| .extern .. => none
go decl.value
where
go (code : Code) : Option Nat :=
match code with
@@ -627,6 +550,49 @@ def Decl.instantiateTypeLevelParams (decl : Decl) (us : List Level) : Expr :=
def Decl.instantiateParamsLevelParams (decl : Decl) (us : List Level) : Array Param :=
decl.params.mapMono fun param => param.updateCore (param.type.instantiateLevelParamsNoCache decl.levelParams us)
partial def Decl.instantiateValueLevelParams (decl : Decl) (us : List Level) : Code :=
instCode decl.value
where
instLevel (u : Level) :=
u.instantiateParams decl.levelParams us
instExpr (e : Expr) :=
e.instantiateLevelParamsNoCache decl.levelParams us
instParams (ps : Array Param) :=
ps.mapMono fun p => p.updateCore (instExpr p.type)
instAlt (alt : Alt) :=
match alt with
| .default k => alt.updateCode (instCode k)
| .alt _ ps k => alt.updateAlt! (instParams ps) (instCode k)
instArg (arg : Arg) : Arg :=
match arg with
| .type e => arg.updateType! (instExpr e)
| .fvar .. | .erased => arg
instLetValue (e : LetValue) : LetValue :=
match e with
| .const declName vs args => e.updateConst! declName (vs.mapMono instLevel) (args.mapMono instArg)
| .fvar fvarId args => e.updateFVar! fvarId (args.mapMono instArg)
| .proj .. | .value .. | .erased => e
instLetDecl (decl : LetDecl) :=
decl.updateCore (instExpr decl.type) (instLetValue decl.value)
instFunDecl (decl : FunDecl) :=
decl.updateCore (instExpr decl.type) (instParams decl.params) (instCode decl.value)
instCode (code : Code) :=
match code with
| .let decl k => code.updateLet! (instLetDecl decl) (instCode k)
| .jp decl k | .fun decl k => code.updateFun! (instFunDecl decl) (instCode k)
| .cases c => code.updateCases! (instExpr c.resultType) c.discr (c.alts.mapMono instAlt)
| .jmp fvarId args => code.updateJmp! fvarId (args.mapMono instArg)
| .return .. => code
| .unreach type => code.updateUnreach! (instExpr type)
/--
Return `true` if the arrow type contains an instance implicit argument.
-/
@@ -727,7 +693,7 @@ where
visit k
go : StateM NameSet Unit :=
decls.forM (·.value.forCodeM visit)
decls.forM fun decl => visit decl.value
def instantiateRangeArgs (e : Expr) (beginIdx endIdx : Nat) (args : Array Arg) : Expr :=
if !e.hasLooseBVars then

View File

@@ -123,10 +123,7 @@ def FunDeclCore.etaExpand (decl : FunDecl) : CompilerM FunDecl := do
decl.update decl.type params value
def Decl.etaExpand (decl : Decl) : CompilerM Decl := do
match decl.value with
| .code code =>
let some (params, newCode) etaExpandCore? decl.type decl.params code | return decl
return { decl with params, value := .code newCode}
| .extern .. => return decl
let some (params, value) etaExpandCore? decl.type decl.params decl.value | return decl
return { decl with params, value }
end Lean.Compiler.LCNF

View File

@@ -102,7 +102,7 @@ end CSE
Common sub-expression elimination
-/
def Decl.cse (decl : Decl) : CompilerM Decl := do
let value decl.value.mapCodeM (·.cse)
let value decl.value.cse
return { decl with value }
def cse (phase : Phase := .base) (occurrence := 0) : Pass :=

View File

@@ -261,7 +261,7 @@ def run (x : CheckM α) : CompilerM α :=
end Check
def Decl.check (decl : Decl) : CompilerM Unit := do
Check.run do decl.value.forCodeM (Check.checkFunDeclCore decl.name decl.params decl.type)
Check.run do Check.checkFunDeclCore decl.name decl.params decl.type decl.value
/--
Check whether every local declaration in the local context is used in one of given `decls`.
@@ -299,7 +299,7 @@ where
visitDecl (decl : Decl) : StateM FVarIdHashSet Unit := do
visitParams decl.params
decl.value.forCodeM visitCode
visitCode decl.value
visitDecls (decls : Array Decl) : StateM FVarIdHashSet Unit :=
decls.forM visitDecl

View File

@@ -148,7 +148,7 @@ def eraseCodeDecls (decls : Array CodeDecl) : CompilerM Unit := do
def eraseDecl (decl : Decl) : CompilerM Unit := do
eraseParams decl.params
decl.value.forCodeM eraseCode
eraseCode decl.value
abbrev Decl.erase (decl : Decl) : CompilerM Unit :=
eraseDecl decl

View File

@@ -38,7 +38,6 @@ end
instance : Hashable Code where
hash c := hashCode c
deriving instance Hashable for DeclValue
deriving instance Hashable for Decl
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -95,6 +95,6 @@ def Code.elimDead (code : Code) : CompilerM Code :=
ElimDead.elimDead code |>.run' {}
def Decl.elimDead (decl : Decl) : CompilerM Decl := do
return { decl with value := ( decl.value.mapCodeM Code.elimDead) }
return { decl with value := ( decl.value.elimDead) }
end Lean.Compiler.LCNF

View File

@@ -513,7 +513,7 @@ def inferStep : InterpM Bool := do
let currentVal getFunVal idx
withReader (fun ctx => { ctx with currFnIdx := idx }) do
decl.params.forM fun p => updateVarAssignment p.fvarId .top
decl.value.forCodeM interpCode
interpCode decl.value
let newVal getFunVal idx
if currentVal != newVal then
return true
@@ -538,7 +538,7 @@ Use the information produced by the abstract interpreter to:
-/
partial def elimDead (assignment : Assignment) (decl : Decl) : CompilerM Decl := do
trace[Compiler.elimDeadBranches] s!"Eliminating {decl.name} with {repr (← assignment.toArray |>.mapM (fun (name, val) => do return (toString (← getBinderName name), val)))}"
return { decl with value := ( decl.value.mapCodeM go) }
return { decl with value := ( go decl.value) }
where
go (code : Code) : CompilerM Code := do
match code with

View File

@@ -141,9 +141,8 @@ partial def evalApp (declName : Name) (args : Array Arg) : FixParamM Unit := do
let key := (declName, values)
unless ( get).visited.contains key do
modify fun s => { s with visited := s.visited.insert key }
decl.value.forCodeM fun c =>
let assignment := mkAssignment decl values
withReader (fun ctx => { ctx with assignment }) <| evalCode c
let assignment := mkAssignment decl values
withReader (fun ctx => { ctx with assignment }) <| evalCode decl.value
end
@@ -170,12 +169,8 @@ def mkFixedParamsMap (decls : Array Decl) : NameMap (Array Bool) := Id.run do
let values := mkInitialValues decl.params.size
let assignment := mkAssignment decl values
let fixed := Array.mkArray decl.params.size true
match decl.value with
| .code c =>
match evalCode c |>.run { main := decl, decls, assignment } |>.run { fixed } with
| .ok _ s | .error _ s => result := result.insert decl.name s.fixed
| .extern .. =>
result := result.insert decl.name fixed
match evalCode decl.value |>.run { main := decl, decls, assignment } |>.run { fixed } with
| .ok _ s | .error _ s => result := result.insert decl.name s.fixed
return result
end Lean.Compiler.LCNF

View File

@@ -239,7 +239,7 @@ Iterate through `decl`, pushing local declarations that are only used in one
control flow arm into said arm in order to avoid useless computations.
-/
partial def floatLetIn (decl : Decl) : CompilerM Decl := do
let newValue decl.value.mapCodeM go |>.run {}
let newValue go decl.value |>.run {}
return { decl with value := newValue }
where
/--

View File

@@ -108,7 +108,7 @@ where
go (decl : Decl) : InternalizeM Decl := do
let type normExpr decl.type
let params decl.params.mapM internalizeParam
let value decl.value.mapCodeM internalizeCode
let value internalizeCode decl.value
return { decl with type, params, value }
/--

View File

@@ -133,7 +133,7 @@ this. This is because otherwise the calls to `myjp` in `f` and `g` would
produce out of scope join point jumps.
-/
partial def find (decl : Decl) : CompilerM FindState := do
let (_, candidates) decl.value.forCodeM go |>.run none |>.run {} |>.run' {}
let (_, candidates) go decl.value |>.run none |>.run {} |>.run' {}
return candidates
where
go : Code FindM Unit
@@ -178,7 +178,7 @@ and all calls to them with `jmp`s.
partial def replace (decl : Decl) (state : FindState) : CompilerM Decl := do
let mapper := fun acc cname _ => do return acc.insert cname ( mkFreshJpName)
let replaceCtx : ReplaceCtx state.candidates.foldM (init := .empty) mapper
let newValue decl.value.mapCodeM go |>.run replaceCtx
let newValue go decl.value |>.run replaceCtx
return { decl with value := newValue }
where
go (code : Code) : ReplaceM Code := do
@@ -389,7 +389,7 @@ position within the code so we can pull them out as far as possible, hopefully
enabling new inlining possibilities in the next simplifier run.
-/
partial def extend (decl : Decl) : CompilerM Decl := do
let newValue decl.value.mapCodeM go |>.run {} |>.run' {} |>.run' {}
let newValue go decl.value |>.run {} |>.run' {} |>.run' {}
let decl := { decl with value := newValue }
decl.pullFunDecls
where
@@ -510,8 +510,8 @@ After we have performed all of these optimizations we can take away the
code that has as little arguments as possible in the join points.
-/
partial def reduce (decl : Decl) : CompilerM Decl := do
let (_, analysis) decl.value.forCodeM goAnalyze |>.run {} |>.run {} |>.run' {}
let newValue decl.value.mapCodeM goReduce |>.run analysis
let (_, analysis) goAnalyze decl.value |>.run {} |>.run {} |>.run' {}
let newValue goReduce decl.value |>.run analysis
return { decl with value := newValue }
where
goAnalyzeFunDecl (fn : FunDecl) : ReduceAnalysisM Unit := do

View File

@@ -108,10 +108,9 @@ def mkAuxDecl (closure : Array Param) (decl : FunDecl) : LiftM LetDecl := do
where
go (nameNew : Name) (safe : Bool) (inlineAttr? : Option InlineAttributeKind) : InternalizeM Decl := do
let params := ( closure.mapM internalizeParam) ++ ( decl.params.mapM internalizeParam)
let code internalizeCode decl.value
let type code.inferType
let value internalizeCode decl.value
let type value.inferType
let type mkForallParams params type
let value := .code code
let decl := { name := nameNew, levelParams := [], params, type, value, safe, inlineAttr?, recursive := false : Decl }
return decl.setLevelParams
@@ -150,7 +149,7 @@ mutual
end
def main (decl : Decl) : LiftM Decl := do
let value withParams decl.params <| decl.value.mapCodeM visitCode
let value withParams decl.params <| visitCode decl.value
return { decl with value }
end LambdaLifting

View File

@@ -139,10 +139,6 @@ mutual
| .jmp _ args => visitArgs args
end
def visitDeclValue : DeclValue Visitor
| .code c => visitCode c
| .extern .. => id
end CollectLevelParams
open Lean.CollectLevelParams
@@ -153,7 +149,7 @@ Collect universe level parameters collecting in the type, parameters, and value,
set `decl.levelParams` with the resulting value.
-/
def Decl.setLevelParams (decl : Decl) : Decl :=
let levelParams := (visitDeclValue decl.value visitParams decl.params visitType decl.type) {} |>.params.toList
let levelParams := (visitCode decl.value visitParams decl.params visitType decl.type) {} |>.params.toList
{ decl with levelParams }
end Lean.Compiler.LCNF

View File

@@ -28,10 +28,10 @@ and `[specialize]` since they can be partially applied.
-/
def shouldGenerateCode (declName : Name) : CoreM Bool := do
if ( isCompIrrelevant |>.run') then return false
let env getEnv
if isExtern env declName then return true
let some info getDeclInfo? declName | return false
unless info.hasValue (allowOpaque := true) do return false
let env getEnv
if isExtern env declName then return false
if hasMacroInlineAttribute env declName then return false
if ( Meta.isMatcher declName) then return false
if isCasesOnRecursor env declName then return false

View File

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

View File

@@ -105,11 +105,6 @@ mutual
return f!"⊥ : {← ppExpr type}"
else
return ""
partial def ppDeclValue (b : DeclValue) : M Format := do
match b with
| .code c => ppCode c
| .extern .. => return "extern"
end
def run (x : M α) : CompilerM α :=
@@ -126,7 +121,7 @@ def ppLetValue (e : LetValue) : CompilerM Format :=
def ppDecl (decl : Decl) : CompilerM Format :=
PP.run do
return f!"def {decl.name}{← PP.ppParams decl.params} : {← PP.ppExpr (← PP.getFunType decl.params decl.type)} :={indentD (← PP.ppDeclValue decl.value)}"
return f!"def {decl.name}{← PP.ppParams decl.params} : {← PP.ppExpr (← PP.getFunType decl.params decl.type)} :={indentD (← PP.ppCode decl.value)}"
def ppFunDecl (decl : FunDecl) : CompilerM Format :=
PP.run do

View File

@@ -57,7 +57,7 @@ where
| .cases (cases : CasesCore Code) => cases.alts.forM (go ·.getCode)
| .jmp .. | .return .. | .unreach .. => return ()
start (decls : Array Decl) : StateRefT (Array LetValue) CompilerM Unit :=
decls.forM (·.value.forCodeM go)
decls.forM (go ·.value)
partial def getJps : Probe Decl FunDecl := fun decls => do
let (_, res) start decls |>.run #[]
@@ -72,10 +72,10 @@ where
| .jmp .. | .return .. | .unreach .. => return ()
start (decls : Array Decl) : StateRefT (Array FunDecl) CompilerM Unit :=
decls.forM (·.value.forCodeM go)
decls.forM fun decl => go decl.value
partial def filterByLet (f : LetDecl CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let decl k => do if ( f decl) then return true else go k
@@ -84,7 +84,7 @@ where
| .jmp .. | .return .. | .unreach .. => return false
partial def filterByFun (f : FunDecl CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k | .jp _ k => go k
@@ -93,7 +93,7 @@ where
| .jmp .. | .return .. | .unreach .. => return false
partial def filterByJp (f : FunDecl CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k
@@ -103,7 +103,7 @@ where
| .jmp .. | .return .. | .unreach .. => return false
partial def filterByFunDecl (f : FunDecl CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k
@@ -112,7 +112,7 @@ where
| .jmp .. | .return .. | .unreach .. => return false
partial def filterByCases (f : Cases CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k
@@ -121,7 +121,7 @@ where
| .jmp .. | .return .. | .unreach .. => return false
partial def filterByJmp (f : FVarId Array Arg CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k
@@ -131,7 +131,7 @@ where
| .return .. | .unreach .. => return false
partial def filterByReturn (f : FVarId CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k
@@ -141,7 +141,7 @@ where
| .return var => f var
partial def filterByUnreach (f : Expr CompilerM Bool) : Probe Decl Decl :=
filter (·.value.isCodeAndM go)
filter (fun decl => go decl.value)
where
go : Code CompilerM Bool
| .let _ k => go k

View File

@@ -172,8 +172,8 @@ open PullFunDecls
Pull local function declarations and join points in the given declaration.
-/
def Decl.pullFunDecls (decl : Decl) : CompilerM Decl := do
let (value, ps) decl.value.mapCodeM pull |>.run []
let value := value.mapCode (attach ps.toArray)
let (value, ps) pull decl.value |>.run []
let value := attach ps.toArray value
return { decl with value }
def pullFunDecls : Pass :=

View File

@@ -96,8 +96,8 @@ open PullLetDecls
def Decl.pullLetDecls (decl : Decl) (isCandidateFn : LetDecl FVarIdSet CompilerM Bool) : CompilerM Decl := do
PullM.run (isCandidateFn := isCandidateFn) do
withParams decl.params do
let value decl.value.mapCodeM pullDecls
let value value.mapCodeM attachToPull
let value pullDecls decl.value
let value attachToPull value
return { decl with value }
def Decl.pullInstances (decl : Decl) : CompilerM Decl :=

View File

@@ -108,7 +108,7 @@ partial def visit (code : Code) : FindUsedM Unit := do
def collectUsedParams (decl : Decl) : CompilerM FVarIdSet := do
let params := decl.params.foldl (init := {}) fun s p => s.insert p.fvarId
let (_, { used, .. }) decl.value.forCodeM visit |>.run { decl, params } |>.run {}
let (_, { used, .. }) visit decl.value |>.run { decl, params } |>.run {}
return used
end FindUsed
@@ -146,40 +146,37 @@ end ReduceArity
open FindUsed ReduceArity Internalize
def Decl.reduceArity (decl : Decl) : CompilerM (Array Decl) := do
match decl.value with
| .code code =>
let used collectUsedParams decl
if used.size == decl.params.size then
return #[decl] -- Declarations uses all parameters
else
trace[Compiler.reduceArity] "{decl.name}, used params: {used.toList.map mkFVar}"
let mask := decl.params.map fun param => used.contains param.fvarId
let auxName := decl.name ++ `_redArg
let mkAuxDecl : CompilerM Decl := do
let params := decl.params.filter fun param => used.contains param.fvarId
let value decl.value.mapCodeM reduce |>.run { declName := decl.name, auxDeclName := auxName, paramMask := mask }
let type code.inferType
let type mkForallParams params type
let auxDecl := { decl with name := auxName, levelParams := [], type, params, value }
auxDecl.saveMono
return auxDecl
let updateDecl : InternalizeM Decl := do
let params decl.params.mapM internalizeParam
let mut args := #[]
for used in mask, param in params do
if used then
args := args.push param.toArg
let letDecl mkAuxLetDecl (.const auxName [] args)
let value := .code (.let letDecl (.return letDecl.fvarId))
let decl := { decl with params, value, inlineAttr? := some .inline, recursive := false }
decl.saveMono
return decl
let unusedParams := decl.params.filter fun param => !used.contains param.fvarId
let auxDecl mkAuxDecl
let decl updateDecl |>.run' {}
eraseParams unusedParams
return #[auxDecl, decl]
| .extern .. => return #[decl]
let used collectUsedParams decl
if used.size == decl.params.size then
return #[decl] -- Declarations uses all parameters
else
trace[Compiler.reduceArity] "{decl.name}, used params: {used.toList.map mkFVar}"
let mask := decl.params.map fun param => used.contains param.fvarId
let auxName := decl.name ++ `_redArg
let mkAuxDecl : CompilerM Decl := do
let params := decl.params.filter fun param => used.contains param.fvarId
let value reduce decl.value |>.run { declName := decl.name, auxDeclName := auxName, paramMask := mask }
let type value.inferType
let type mkForallParams params type
let auxDecl := { decl with name := auxName, levelParams := [], type, params, value }
auxDecl.saveMono
return auxDecl
let updateDecl : InternalizeM Decl := do
let params decl.params.mapM internalizeParam
let mut args := #[]
for used in mask, param in params do
if used then
args := args.push param.toArg
let letDecl mkAuxLetDecl (.const auxName [] args)
let value := .let letDecl (.return letDecl.fvarId)
let decl := { decl with params, value, inlineAttr? := some .inline, recursive := false }
decl.saveMono
return decl
let unusedParams := decl.params.filter fun param => !used.contains param.fvarId
let auxDecl mkAuxDecl
let decl updateDecl |>.run' {}
eraseParams unusedParams
return #[auxDecl, decl]
def reduceArity : Pass where
phase := .mono
@@ -190,4 +187,4 @@ def reduceArity : Pass where
builtin_initialize
registerTraceClass `Compiler.reduceArity (inherited := true)
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -68,7 +68,7 @@ open ReduceJpArity
Try to reduce arity of join points
-/
def Decl.reduceJpArity (decl : Decl) : CompilerM Decl := do
let value decl.value.mapCodeM reduce |>.run {}
let value reduce decl.value |>.run {}
return { decl with value }
def reduceJpArity (phase := Phase.base) : Pass :=

View File

@@ -55,7 +55,7 @@ def Decl.applyRenaming (decl : Decl) (r : Renaming) : CompilerM Decl := do
return decl
else
let params decl.params.mapMonoM (·.applyRenaming r)
let value decl.value.mapCodeM (·.applyRenaming r)
let value decl.value.applyRenaming r
return { decl with params, value }
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -22,20 +22,19 @@ namespace Lean.Compiler.LCNF
open Simp
def Decl.simp? (decl : Decl) : SimpM (Option Decl) := do
let .code code := decl.value | return none
updateFunDeclInfo code
updateFunDeclInfo decl.value
traceM `Compiler.simp.inline.info do return m!"{decl.name}:{Format.nest 2 (← (← get).funDeclInfoMap.format)}"
traceM `Compiler.simp.step do ppDecl decl
let code simp code
let value simp decl.value
let s get
let code code.applyRenaming s.binderRenaming
traceM `Compiler.simp.step.new do return m!"{decl.name} :=\n{← ppCode code}"
trace[Compiler.simp.stat] "{decl.name}, size: {code.size}, # visited: {s.visited}, # inline: {s.inline}, # inline local: {s.inlineLocal}"
if let some code simpJpCases? code then
let decl := { decl with value := .code code }
let value value.applyRenaming s.binderRenaming
traceM `Compiler.simp.step.new do return m!"{decl.name} :=\n{← ppCode value}"
trace[Compiler.simp.stat] "{decl.name}, size: {value.size}, # visited: {s.visited}, # inline: {s.inline}, # inline local: {s.inlineLocal}"
if let some value simpJpCases? value then
let decl := { decl with value }
decl.reduceJpArity
else if ( get).simplified then
return some { decl with value := .code code }
return some { decl with value }
else
return none

View File

@@ -43,7 +43,6 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
unless ( read).config.inlineDefs do
return none
let some decl getDecl? declName | return none
let .code code := decl.value | return none
let shouldInline : SimpM Bool := do
if !decl.inlineIfReduceAttr && decl.recursive then return false
if mustInline then return true
@@ -64,8 +63,9 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
if decl.alwaysInlineAttr then return true
-- TODO: check inlining quota
if decl.inlineAttr || decl.inlineIfReduceAttr then return true
if decl.noinlineAttr then return false
isSmall code
unless decl.noinlineAttr do
if ( isSmall decl.value) then return true
return false
unless ( shouldInline) do return none
/- check arity -/
let arity := decl.getArity
@@ -77,7 +77,7 @@ def inlineCandidate? (e : LetValue) : SimpM (Option InlineCandidateInfo) := do
let arg := args[paramIdx]!
unless ( arg.isConstructorApp) do return none
let params := decl.instantiateParamsLevelParams us
let value := code.instantiateValueLevelParams decl.levelParams us
let value := decl.instantiateValueLevelParams us
let type := decl.instantiateTypeLevelParams us
incInline
return some {

View File

@@ -69,14 +69,11 @@ where
visit fvarId projs
else
let some decl getDecl? declName | failure
match decl.value with
| .code code =>
guard (decl.getArity == args.size)
let params := decl.instantiateParamsLevelParams us
let code := code.instantiateValueLevelParams decl.levelParams us
let code betaReduce params code args (mustInline := true)
visitCode code projs
| .extern .. => failure
guard (decl.getArity == args.size)
let params := decl.instantiateParamsLevelParams us
let code := decl.instantiateValueLevelParams us
let code betaReduce params code args (mustInline := true)
visitCode code projs
visitCode (code : Code) (projs : List Nat) : OptionT (StateRefT (Array CodeDecl) SimpM) FVarId := do
match code with

View File

@@ -222,7 +222,6 @@ def mkSpecDecl (decl : Decl) (us : List Level) (argMask : Array (Option Arg)) (p
eraseDecl decl
where
go (decl : Decl) (nameNew : Name) : InternalizeM Decl := do
let .code code := decl.value | panic! "can only specialize decls with code"
let mut params params.mapM internalizeParam
let decls decls.mapM internalizeCodeDecl
for param in decl.params, arg in argMask do
@@ -236,12 +235,11 @@ where
for param in decl.params[argMask.size:] do
let param := { param with type := param.type.instantiateLevelParamsNoCache decl.levelParams us }
params := params.push ( internalizeParam param)
let code := code.instantiateValueLevelParams decl.levelParams us
let code internalizeCode code
let code := attachCodeDecls decls code
let type code.inferType
let value := decl.instantiateValueLevelParams us
let value internalizeCode value
let value := attachCodeDecls decls value
let type value.inferType
let type mkForallParams params type
let value := .code code
let safe := decl.safe
let recursive := decl.recursive
let decl := { name := nameNew, levelParams := levelParamsNew, params, type, value, safe, recursive, inlineAttr? := none : Decl }
@@ -270,7 +268,6 @@ mutual
let some paramsInfo getSpecParamInfo? declName | return none
unless ( shouldSpecialize paramsInfo args) do return none
let some decl getDecl? declName | return none
let .code _ := decl.value | return none
trace[Compiler.specialize.candidate] "{e.toExpr}, {paramsInfo}"
let (argMask, params, decls) Collector.collect paramsInfo args
let keyBody := .const declName us (argMask.filterMap id)
@@ -293,7 +290,7 @@ mutual
let specDecl specDecl.simp {}
let specDecl specDecl.simp { etaPoly := true, inlinePartial := true, implementedBy := true }
let value withReader (fun _ => { declName := specDecl.name }) do
withParams specDecl.params <| specDecl.value.mapCodeM visitCode
withParams specDecl.params <| visitCode specDecl.value
let specDecl := { specDecl with value }
modify fun s => { s with decls := s.decls.push specDecl }
return some (.const specDecl.name usNew argsNew)
@@ -328,7 +325,7 @@ def main (decl : Decl) : SpecializeM Decl := do
if ( decl.isTemplateLike) then
return decl
else
let value withParams decl.params <| decl.value.mapCodeM visitCode
let value withParams decl.params <| visitCode decl.value
return { decl with value }
end Specialize

View File

@@ -235,17 +235,12 @@ Assert that the pass under test produces `Decl`s that do not contain
`Expr.const constName` in their `Code.let` values anymore.
-/
def assertDoesNotContainConstAfter (constName : Name) (msg : String) : TestInstaller :=
assertForEachDeclAfterEachOccurrence
fun _ decl =>
match decl.value with
| .code c => !c.containsConst constName
| .extern .. => true
msg
assertForEachDeclAfterEachOccurrence (fun _ decl => !decl.value.containsConst constName) msg
def assertNoFun : TestInstaller :=
assertAfter do
for decl in ( getDecls) do
decl.value.forCodeM fun
decl.value.forM fun
| .fun .. => throwError "declaration `{decl.name}` contains a local function declaration"
| _ => return ()

View File

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
prelude
import Lean.Meta.Transform
import Lean.Meta.Match.MatcherInfo
import Lean.Compiler.ExternAttr
import Lean.Compiler.ImplementedByAttr
import Lean.Compiler.LCNF.ToLCNF
@@ -97,48 +96,31 @@ The steps for this are roughly:
def toDecl (declName : Name) : CompilerM Decl := do
let declName := if let some name := isUnsafeRecName? declName then name else declName
let some info getDeclInfo? declName | throwError "declaration `{declName}` not found"
let some value := info.value? (allowOpaque := true) | throwError "declaration `{declName}` does not have a value"
let (type, value) Meta.MetaM.run' do
let type toLCNFType info.type
let value Meta.lambdaTelescope value fun xs body => do Meta.mkLambdaFVars xs ( Meta.etaExpand body)
let value replaceUnsafeRecNames value
let value macroInline value
/- Recall that some declarations tagged with `macro_inline` contain matchers. -/
let value inlineMatchers value
/- Recall that `inlineMatchers` may have exposed `ite`s and `dite`s which are tagged as `[macro_inline]`. -/
let value macroInline value
/-
Remark: we have disabled the following transformatbion, we will perform it at phase 2, after code specialization.
It prevents many optimizations (e.g., "cases-of-ctor").
-/
-- let value ← applyCasesOnImplementedBy value
return (type, value)
let value toLCNF value
let safe := !info.isPartial && !info.isUnsafe
let inlineAttr? := getInlineAttribute? ( getEnv) declName
if let some externAttrData := getExternAttrData? ( getEnv) declName then
let paramsFromTypeBinders (expr : Expr) : CompilerM (Array Param) := do
let mut params := #[]
let mut currentExpr := expr
repeat
match currentExpr with
| .forallE binderName type body _ =>
let borrow := isMarkedBorrowed type
params := params.push ( mkParam binderName type borrow)
currentExpr := body
| _ => break
return params
let type Meta.MetaM.run' (toLCNFType info.type)
let params paramsFromTypeBinders type
return { name := declName, params, type, value := .extern externAttrData, levelParams := info.levelParams, safe, inlineAttr? }
let decl if let .fun decl (.return _) := value then
eraseFunDecl decl (recursive := false)
pure { name := declName, params := decl.params, type, value := decl.value, levelParams := info.levelParams, safe, inlineAttr? : Decl }
else
let some value := info.value? (allowOpaque := true) | throwError "declaration `{declName}` does not have a value"
let (type, value) Meta.MetaM.run' do
let type toLCNFType info.type
let value Meta.lambdaTelescope value fun xs body => do Meta.mkLambdaFVars xs ( Meta.etaExpand body)
let value replaceUnsafeRecNames value
let value macroInline value
/- Recall that some declarations tagged with `macro_inline` contain matchers. -/
let value inlineMatchers value
/- Recall that `inlineMatchers` may have exposed `ite`s and `dite`s which are tagged as `[macro_inline]`. -/
let value macroInline value
/-
Remark: we have disabled the following transformatbion, we will perform it at phase 2, after code specialization.
It prevents many optimizations (e.g., "cases-of-ctor").
-/
-- let value ← applyCasesOnImplementedBy value
return (type, value)
let code toLCNF value
let decl if let .fun decl (.return _) := code then
eraseFunDecl decl (recursive := false)
pure { name := declName, params := decl.params, type, value := .code decl.value, levelParams := info.levelParams, safe, inlineAttr? : Decl }
else
pure { name := declName, params := #[], type, value := .code code, levelParams := info.levelParams, safe, inlineAttr? }
/- `toLCNF` may eta-reduce simple declarations. -/
decl.etaExpand
pure { name := declName, params := #[], type, value, levelParams := info.levelParams, safe, inlineAttr? }
/- `toLCNF` may eta-reduce simple declarations. -/
decl.etaExpand
end Lean.Compiler.LCNF

View File

@@ -110,4 +110,7 @@ def Code.toExpr (code : Code) (xs : Array FVarId := #[]) : Expr :=
def FunDeclCore.toExpr (decl : FunDecl) (xs : Array FVarId := #[]) : Expr :=
run' decl.toExprM xs
def Decl.toExpr (decl : Decl) : Expr :=
run do withParams decl.params do mkLambdaM decl.params ( decl.value.toExprM)
end Lean.Compiler.LCNF

View File

@@ -143,7 +143,7 @@ where
go : ToMonoM Decl := do
let type toMonoType decl.type
let params decl.params.mapM (·.toMono)
let value decl.value.mapCodeM (·.toMono)
let value decl.value.toMono
let decl := { decl with type, params, value, levelParams := [] }
decl.saveMono
return decl

View File

@@ -53,3 +53,18 @@ def isUnsafeRecName? : Name → Option Name
| _ => none
end Compiler
namespace Environment
/--
Compile the given block of mutual declarations.
Assumes the declarations have already been added to the environment using `addDecl`.
-/
@[extern "lean_compile_decls"]
opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
end Environment

View File

@@ -514,16 +514,13 @@ register_builtin_option compiler.enableNew : Bool := {
@[extern "lean_lcnf_compile_decls"]
opaque compileDeclsNew (declNames : List Name) : CoreM Unit
@[extern "lean_compile_decls"]
opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
def compileDecl (decl : Declaration) : CoreM Unit := do
let opts getOptions
let decls := Compiler.getDeclNamesForCodeGen decl
if compiler.enableNew.get opts then
compileDeclsNew decls
let res withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
return compileDeclsOld ( getEnv) opts decls
return ( getEnv).compileDecl opts decl
match res with
| Except.ok env => setEnv env
| Except.error (KernelException.other msg) =>
@@ -536,7 +533,7 @@ def compileDecls (decls : List Name) : CoreM Unit := do
let opts getOptions
if compiler.enableNew.get opts then
compileDeclsNew decls
match compileDeclsOld ( getEnv) opts decls with
match ( getEnv).compileDecls opts decls with
| Except.ok env => setEnv env
| Except.error (KernelException.other msg) =>
throwError msg

View File

@@ -24,7 +24,7 @@ abbrev empty : AssocList α β :=
instance : EmptyCollection (AssocList α β) := empty
abbrev insertNew (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
abbrev insert (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
m.cons k v
def isEmpty : AssocList α β Bool
@@ -77,12 +77,6 @@ def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β
| true => cons a b es
| false => cons k v (replace a b es)
def insert [BEq α] (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
if m.contains k then
m.replace k v
else
m.insertNew k v
def erase [BEq α] (a : α) : AssocList α β AssocList α β
| nil => nil
| cons k v es => match k == a with

View File

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

View File

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

View File

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

View File

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

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