mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-30 00:34:07 +00:00
Compare commits
2 Commits
align_mapI
...
fvarsSubse
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
51cf8aa7a1 | ||
|
|
fcba0c7cba |
4
.github/workflows/ci.yml
vendored
4
.github/workflows/ci.yml
vendored
@@ -238,7 +238,7 @@ jobs:
|
||||
"name": "Linux 32bit",
|
||||
"os": "ubuntu-latest",
|
||||
// Use 32bit on stage0 and stage1 to keep oleans compatible
|
||||
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DPKG_CONFIG_EXECUTABLE=/usr/bin/i386-linux-gnu-pkg-config",
|
||||
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
|
||||
"cmultilib": true,
|
||||
"release": true,
|
||||
"check-level": 2,
|
||||
@@ -327,7 +327,7 @@ jobs:
|
||||
run: |
|
||||
sudo dpkg --add-architecture i386
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
|
||||
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386
|
||||
if: matrix.cmultilib
|
||||
- name: Cache
|
||||
uses: actions/cache@v4
|
||||
|
||||
@@ -18,9 +18,6 @@ foreach(var ${vars})
|
||||
if("${var}" MATCHES "LLVM*")
|
||||
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
|
||||
endif()
|
||||
if("${var}" MATCHES "PKG_CONFIG*")
|
||||
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
|
||||
endif()
|
||||
elseif(("${var}" MATCHES "CMAKE_.*") AND NOT ("${var}" MATCHES "CMAKE_BUILD_TYPE") AND NOT ("${var}" MATCHES "CMAKE_HOME_DIRECTORY"))
|
||||
list(APPEND PLATFORM_ARGS "-D${var}=${${var}}")
|
||||
endif()
|
||||
|
||||
1189
RELEASES.md
1189
RELEASES.md
File diff suppressed because it is too large
Load Diff
@@ -33,9 +33,6 @@ Format of the commit message
|
||||
- chore (maintain, ex: travis-ci)
|
||||
- perf (performance improvement, optimization, ...)
|
||||
|
||||
Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
|
||||
beginning with "This PR " that will be included in the changelog.
|
||||
|
||||
``<subject>`` has the following constraints:
|
||||
|
||||
- use imperative, present tense: "change" not "changed" nor "changes"
|
||||
@@ -47,7 +44,6 @@ beginning with "This PR " that will be included in the changelog.
|
||||
- just as in ``<subject>``, use imperative, present tense
|
||||
- includes motivation for the change and contrasts with previous
|
||||
behavior
|
||||
- If a `changelog-*` label is present, the body must begin with "This PR ".
|
||||
|
||||
``<footer>`` is optional and may contain two items:
|
||||
|
||||
@@ -64,21 +60,17 @@ Examples
|
||||
|
||||
fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
|
||||
|
||||
This PR adds declarations `operator<<` for raw printing.
|
||||
The actual implementation of these two operators is outside of the
|
||||
kernel. They are implemented in the file 'library/printer.cpp'.
|
||||
|
||||
We declare them in the kernel to prevent the following problem.
|
||||
Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
kernel. They are implemented in the file 'library/printer.cpp'. We
|
||||
declare them in the kernel to prevent the following problem. Suppose
|
||||
there is a file 'foo.cpp' that does not include 'library/printer.h',
|
||||
but contains
|
||||
```cpp
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
```
|
||||
|
||||
expr a;
|
||||
...
|
||||
std::cout << a << "\n";
|
||||
...
|
||||
|
||||
The compiler does not generate an error message. It silently uses the
|
||||
operator bool() to coerce the expression into a Boolean. This produces
|
||||
counter-intuitive behavior, and may confuse developers.
|
||||
|
||||
|
||||
@@ -49,9 +49,8 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
|
||||
is represented by the representation of that parameter's type.
|
||||
|
||||
For example, `{ x : α // p }`, the `Subtype` structure of a value of type `α` and an irrelevant proof, is represented by the representation of `α`.
|
||||
Similarly, the signed integer types `Int8`, ..., `Int64`, `ISize` are also represented by the unsigned C types `uint8_t`, ..., `uint64_t`, `size_t`, respectively, because they have a trivial structure.
|
||||
* `Nat` and `Int` are represented by `lean_object *`.
|
||||
Their runtime values is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number or integer (`lean_box`/`lean_unbox`).
|
||||
* `Nat` is represented by `lean_object *`.
|
||||
Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
|
||||
* A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
|
||||
* Any other type is represented by `lean_object *`.
|
||||
Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.
|
||||
|
||||
@@ -80,10 +80,3 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
|
||||
`prelude` keyword. This disables the automated import of `Init`, meaning that
|
||||
developers need to figure out their own subset of `Init` to import. This is done
|
||||
such that changing files in `Init` doesn't force a full rebuild of `Lean`.
|
||||
|
||||
### Testing against Mathlib/Batteries
|
||||
You can test a Lean PR against Mathlib and Batteries by rebasing your PR
|
||||
on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
|
||||
CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
|
||||
that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
|
||||
See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.
|
||||
|
||||
@@ -5,6 +5,11 @@ See below for the checklist for release candidates.
|
||||
|
||||
We'll use `v4.6.0` as the intended release version as a running example.
|
||||
|
||||
- One week before the planned release, ensure that
|
||||
(1) someone has written the release notes and
|
||||
(2) someone has written the first draft of the release blog post.
|
||||
If there is any material in `./releases_drafts/` on the `releases/v4.6.0` branch, then the release notes are not done.
|
||||
(See the section "Writing the release notes".)
|
||||
- `git checkout releases/v4.6.0`
|
||||
(This branch should already exist, from the release candidates.)
|
||||
- `git pull`
|
||||
@@ -37,32 +42,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 +66,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
|
||||
@@ -90,7 +86,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
|
||||
- Toolchain bump PR notes:
|
||||
- In addition to updating the `lean-toolchain` and `lakefile.lean`,
|
||||
in `.github/workflows/lean4checker.yml` update the line
|
||||
`git checkout v4.6.0` to the appropriate tag.
|
||||
`git checkout v4.6.0` to the appropriate tag.
|
||||
- Push the PR branch to the main Mathlib repository rather than a fork, or CI may not work reliably
|
||||
- Create and push the tag
|
||||
- Create a new branch from the tag, push it, and open a pull request against `stable`.
|
||||
@@ -102,7 +98,6 @@ We'll use `v4.6.0` as the intended release version as a running example.
|
||||
- Toolchain bump PR including updated Lake manifest
|
||||
- Create and push the tag
|
||||
- Merge the tag into `stable`
|
||||
- Run `scripts/release_checklist.py v4.6.0` to check that everything is in order.
|
||||
- The `v4.6.0` section of `RELEASES.md` is out of sync between
|
||||
`releases/v4.6.0` and `master`. This should be reconciled:
|
||||
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
|
||||
@@ -144,13 +139,16 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
|
||||
git checkout -b releases/v4.7.0
|
||||
```
|
||||
- In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
|
||||
- It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
|
||||
- We will rely on automatically generated release notes for release candidates,
|
||||
and the written release notes will be used for stable versions only.
|
||||
It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
|
||||
- In `src/CMakeLists.txt`,
|
||||
- verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
|
||||
- `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
|
||||
- Commit your changes to `src/CMakeLists.txt`, and push.
|
||||
- `git tag v4.7.0-rc1`
|
||||
- `git push origin v4.7.0-rc1`
|
||||
- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
|
||||
- Now wait, while CI runs.
|
||||
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
|
||||
- This step can take up to an hour.
|
||||
@@ -250,12 +248,15 @@ Please read https://leanprover-community.github.io/contribute/tags_and_branches.
|
||||
|
||||
# Writing the release notes
|
||||
|
||||
Release notes are automatically generated from the commit history, using `script/release_notes.py`.
|
||||
We are currently trying a system where release notes are compiled all at once from someone looking through the commit history.
|
||||
The exact steps are a work in progress.
|
||||
Here is the general idea:
|
||||
|
||||
Run this as `script/release_notes.py v4.6.0`, where `v4.6.0` is the *previous* release version. This will generate output
|
||||
for all commits since that tag. Note that there is output on both stderr, which should be manually reviewed,
|
||||
and on stdout, which should be manually copied to `RELEASES.md`.
|
||||
|
||||
There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
|
||||
* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
|
||||
The release notes for `v4.6.0` will later be copied to `master` when we begin a new development cycle.
|
||||
* There can be material for release notes entries in commit messages.
|
||||
* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
|
||||
See `./releases_drafts/README.md` for more information.
|
||||
* The release notes should be written from a downstream expert user's point of view.
|
||||
|
||||
This section will be updated when the next release notes are written (for `v4.10.0`).
|
||||
|
||||
@@ -32,13 +32,12 @@ following to use `g++`.
|
||||
cmake -DCMAKE_CXX_COMPILER=g++ ...
|
||||
```
|
||||
|
||||
## Required Packages: CMake, GMP, libuv, pkgconf
|
||||
## Required Packages: CMake, GMP, libuv
|
||||
|
||||
```bash
|
||||
brew install cmake
|
||||
brew install gmp
|
||||
brew install libuv
|
||||
brew install pkgconf
|
||||
```
|
||||
|
||||
## Recommended Packages: CCache
|
||||
|
||||
@@ -8,5 +8,5 @@ follow the [generic build instructions](index.md).
|
||||
## Basic packages
|
||||
|
||||
```bash
|
||||
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
|
||||
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang
|
||||
```
|
||||
|
||||
@@ -28,7 +28,7 @@
|
||||
stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
|
||||
} ({
|
||||
buildInputs = with pkgs; [
|
||||
cmake gmp libuv ccache cadical pkg-config
|
||||
cmake gmp libuv ccache cadical
|
||||
lean-packages.llvmPackages.llvm # llvm-symbolizer for asan/lsan
|
||||
gdb
|
||||
tree # for CI
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
{ src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
|
||||
stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
|
||||
stdenv, lib, cmake, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
|
||||
... } @ args:
|
||||
with builtins;
|
||||
lib.warn "The Nix-based build is deprecated" rec {
|
||||
inherit stdenv;
|
||||
sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
|
||||
buildCMake = args: stdenv.mkDerivation ({
|
||||
nativeBuildInputs = [ cmake pkg-config ];
|
||||
nativeBuildInputs = [ cmake ];
|
||||
buildInputs = [ gmp libuv llvmPackages.llvm ];
|
||||
# https://github.com/NixOS/nixpkgs/issues/60919
|
||||
hardeningDisable = [ "all" ];
|
||||
|
||||
16
releases_drafts/list_lex.md
Normal file
16
releases_drafts/list_lex.md
Normal 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.
|
||||
@@ -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
|
||||
|
||||
@@ -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=''"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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()
|
||||
@@ -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()
|
||||
@@ -1,145 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import sys
|
||||
import re
|
||||
import json
|
||||
import requests
|
||||
import subprocess
|
||||
from collections import defaultdict
|
||||
from git import Repo
|
||||
|
||||
def get_commits_since_tag(repo, tag):
|
||||
try:
|
||||
tag_commit = repo.commit(tag)
|
||||
commits = list(repo.iter_commits(f"{tag_commit.hexsha}..HEAD"))
|
||||
return [
|
||||
(commit.hexsha, commit.message.splitlines()[0], commit.message)
|
||||
for commit in commits
|
||||
]
|
||||
except Exception as e:
|
||||
sys.stderr.write(f"Error retrieving commits: {e}\n")
|
||||
sys.exit(1)
|
||||
|
||||
def check_pr_number(first_line):
|
||||
match = re.search(r"\(\#(\d+)\)$", first_line)
|
||||
if match:
|
||||
return int(match.group(1))
|
||||
return None
|
||||
|
||||
def fetch_pr_labels(pr_number):
|
||||
try:
|
||||
# Use gh CLI to fetch PR details
|
||||
result = subprocess.run([
|
||||
"gh", "api", f"repos/leanprover/lean4/pulls/{pr_number}"
|
||||
], capture_output=True, text=True, check=True)
|
||||
pr_data = result.stdout
|
||||
pr_json = json.loads(pr_data)
|
||||
return [label["name"] for label in pr_json.get("labels", [])]
|
||||
except subprocess.CalledProcessError as e:
|
||||
sys.stderr.write(f"Failed to fetch PR #{pr_number} using gh: {e.stderr}\n")
|
||||
return []
|
||||
|
||||
def format_section_title(label):
|
||||
title = label.replace("changelog-", "").capitalize()
|
||||
if title == "Doc":
|
||||
return "Documentation"
|
||||
elif title == "Pp":
|
||||
return "Pretty Printing"
|
||||
return title
|
||||
|
||||
def sort_sections_order():
|
||||
return [
|
||||
"Language",
|
||||
"Library",
|
||||
"Compiler",
|
||||
"Pretty Printing",
|
||||
"Documentation",
|
||||
"Server",
|
||||
"Lake",
|
||||
"Other",
|
||||
"Uncategorised"
|
||||
]
|
||||
|
||||
def format_markdown_description(pr_number, description):
|
||||
link = f"[#{pr_number}](https://github.com/leanprover/lean4/pull/{pr_number})"
|
||||
return f"{link} {description}"
|
||||
|
||||
def main():
|
||||
if len(sys.argv) != 2:
|
||||
sys.stderr.write("Usage: script.py <git-tag>\n")
|
||||
sys.exit(1)
|
||||
|
||||
tag = sys.argv[1]
|
||||
try:
|
||||
repo = Repo(".")
|
||||
except Exception as e:
|
||||
sys.stderr.write(f"Error opening Git repository: {e}\n")
|
||||
sys.exit(1)
|
||||
|
||||
commits = get_commits_since_tag(repo, tag)
|
||||
|
||||
sys.stderr.write(f"Found {len(commits)} commits since tag {tag}:\n")
|
||||
for commit_hash, first_line, _ in commits:
|
||||
sys.stderr.write(f"- {commit_hash}: {first_line}\n")
|
||||
|
||||
changelog = defaultdict(list)
|
||||
|
||||
for commit_hash, first_line, full_message in commits:
|
||||
# Skip commits with the specific first lines
|
||||
if first_line == "chore: update stage0" or first_line.startswith("chore: CI: bump "):
|
||||
continue
|
||||
|
||||
pr_number = check_pr_number(first_line)
|
||||
|
||||
if not pr_number:
|
||||
sys.stderr.write(f"No PR number found in {first_line}\n")
|
||||
continue
|
||||
|
||||
# Remove the first line from the full_message for further processing
|
||||
body = full_message[len(first_line):].strip()
|
||||
|
||||
paragraphs = body.split('\n\n')
|
||||
second_paragraph = paragraphs[0] if len(paragraphs) > 0 else ""
|
||||
|
||||
labels = fetch_pr_labels(pr_number)
|
||||
|
||||
# Skip entries with the "changelog-no" label
|
||||
if "changelog-no" in labels:
|
||||
continue
|
||||
|
||||
report_errors = first_line.startswith("feat:") or first_line.startswith("fix:")
|
||||
|
||||
if not second_paragraph.startswith("This PR "):
|
||||
if report_errors:
|
||||
sys.stderr.write(f"No PR description found in commit:\n{commit_hash}\n{first_line}\n{body}\n\n")
|
||||
fallback_description = re.sub(r":$", "", first_line.split(" ", 1)[1]).rsplit(" (#", 1)[0]
|
||||
markdown_description = format_markdown_description(pr_number, fallback_description)
|
||||
else:
|
||||
continue
|
||||
else:
|
||||
markdown_description = format_markdown_description(pr_number, second_paragraph.replace("This PR ", ""))
|
||||
|
||||
changelog_labels = [label for label in labels if label.startswith("changelog-")]
|
||||
if len(changelog_labels) > 1:
|
||||
sys.stderr.write(f"Warning: Multiple changelog-* labels found for PR #{pr_number}: {changelog_labels}\n")
|
||||
|
||||
if not changelog_labels:
|
||||
if report_errors:
|
||||
sys.stderr.write(f"Warning: No changelog-* label found for PR #{pr_number}\n")
|
||||
else:
|
||||
continue
|
||||
|
||||
for label in changelog_labels:
|
||||
changelog[label].append((pr_number, markdown_description))
|
||||
|
||||
section_order = sort_sections_order()
|
||||
sorted_changelog = sorted(changelog.items(), key=lambda item: section_order.index(format_section_title(item[0])) if format_section_title(item[0]) in section_order else len(section_order))
|
||||
|
||||
for label, entries in sorted_changelog:
|
||||
section_title = format_section_title(label) if label != "Uncategorised" else "Uncategorised"
|
||||
print(f"## {section_title}\n")
|
||||
for _, entry in sorted(entries, key=lambda x: x[0]):
|
||||
print(f"* {entry}\n")
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
@@ -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
|
||||
@@ -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)
|
||||
@@ -699,12 +698,12 @@ else()
|
||||
endif()
|
||||
|
||||
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
add_custom_target(lake_lib
|
||||
add_custom_target(lake_lib ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS leanshared
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Lake
|
||||
VERBATIM)
|
||||
add_custom_target(lake_shared
|
||||
add_custom_target(lake_shared ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS lake_lib
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make libLake_shared
|
||||
|
||||
@@ -37,4 +37,3 @@ import Init.MacroTrace
|
||||
import Init.Grind
|
||||
import Init.While
|
||||
import Init.Syntax
|
||||
import Init.Internal
|
||||
|
||||
@@ -150,10 +150,6 @@ See the `simp` tactic for more information. -/
|
||||
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
/-- `simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
|
||||
that would be sufficient to close the goal. See the `simp?` tactic for more information. -/
|
||||
syntax (name := simpTrace) "simp?" optConfig (discharger)? (&" only")? (simpArgs)? : conv
|
||||
|
||||
/--
|
||||
`dsimp` is the definitional simplifier in `conv`-mode. It differs from `simp` in that it only
|
||||
applies theorems that hold by reflexivity.
|
||||
@@ -171,9 +167,6 @@ example (a : Nat): (0 + 0) = a - a := by
|
||||
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
@[inherit_doc simpTrace]
|
||||
syntax (name := dsimpTrace) "dsimp?" optConfig (&" only")? (dsimpArgs)? : conv
|
||||
|
||||
/-- `simp_match` simplifies match expressions. For example,
|
||||
```
|
||||
match [a, b] with
|
||||
|
||||
@@ -244,7 +244,8 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
|
||||
def range (n : Nat) : Array Nat :=
|
||||
ofFn fun (i : Fin n) => i
|
||||
|
||||
@[inline] protected def singleton (v : α) : Array α := #[v]
|
||||
def singleton (v : α) : Array α :=
|
||||
mkArray 1 v
|
||||
|
||||
def back! [Inhabited α] (a : Array α) : α :=
|
||||
a[a.size - 1]!
|
||||
@@ -455,7 +456,7 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
|
||||
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
|
||||
@[inline]
|
||||
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
|
||||
(as : Array α) (f : (i : Nat) → α → (h : i < as.size) → m β) : m (Array β) :=
|
||||
(as : Array α) (f : Fin as.size → α → m β) : m (Array β) :=
|
||||
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
|
||||
match i, inv with
|
||||
| 0, _ => pure bs
|
||||
@@ -464,12 +465,12 @@ def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
|
||||
rw [← inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
|
||||
apply Nat.le_add_right
|
||||
have : i + (j + 1) = as.size := by rw [← inv, Nat.add_comm j 1, Nat.add_assoc]
|
||||
map i (j+1) this (bs.push (← f j (as.get j j_lt) j_lt))
|
||||
map i (j+1) this (bs.push (← f ⟨j, j_lt⟩ (as.get j j_lt)))
|
||||
map as.size 0 rfl (mkEmpty as.size)
|
||||
|
||||
@[inline]
|
||||
def mapIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : Nat → α → m β) (as : Array α) : m (Array β) :=
|
||||
as.mapFinIdxM fun i a _ => f i a
|
||||
as.mapFinIdxM fun i a => f i a
|
||||
|
||||
@[inline]
|
||||
def findSomeM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → m (Option β)) (as : Array α) : m (Option β) := do
|
||||
@@ -576,19 +577,13 @@ 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
|
||||
|
||||
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
|
||||
@[inline]
|
||||
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : (i : Nat) → α → (h : i < as.size) → β) : Array β :=
|
||||
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size → α → β) : Array β :=
|
||||
Id.run <| as.mapFinIdxM f
|
||||
|
||||
@[inline]
|
||||
|
||||
@@ -81,18 +81,12 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
|
||||
|
||||
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
|
||||
|
||||
@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
|
||||
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
|
||||
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
|
||||
|
||||
@[deprecated append_empty (since := "2025-01-13")]
|
||||
abbrev append_nil := @append_empty
|
||||
|
||||
@[simp] theorem empty_append (as : Array α) : #[] ++ as = as := by
|
||||
@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
|
||||
apply ext'; simp only [toList_append, toList_empty, List.nil_append]
|
||||
|
||||
@[deprecated empty_append (since := "2025-01-13")]
|
||||
abbrev nil_append := @empty_append
|
||||
|
||||
@[simp] theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
|
||||
apply ext'; simp only [toList_append, List.append_assoc]
|
||||
|
||||
|
||||
@@ -74,12 +74,12 @@ theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (
|
||||
|
||||
theorem getElem?_zero_flatten (L : Array (Array α)) :
|
||||
(flatten L)[0]? = L.findSome? fun l => l[0]? := by
|
||||
cases L using array₂_induction
|
||||
cases L using array_array_induction
|
||||
simp [← List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
|
||||
|
||||
theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
|
||||
(L.findSome? fun l => l[0]?).isSome := by
|
||||
cases L using array₂_induction
|
||||
cases L using array_array_induction
|
||||
simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
|
||||
List.findSome?_isSome_iff, isSome_getElem?]
|
||||
simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
|
||||
@@ -95,7 +95,7 @@ theorem getElem_zero_flatten {L : Array (Array α)} (h) :
|
||||
|
||||
theorem back?_flatten {L : Array (Array α)} :
|
||||
(flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
|
||||
cases L using array₂_induction
|
||||
cases L using array_array_induction
|
||||
simp [List.getLast?_flatten, ← List.map_reverse, List.findSome?_map, Function.comp_def]
|
||||
|
||||
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
|
||||
@@ -203,7 +203,7 @@ theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h ∈ xs := by
|
||||
|
||||
@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α → Bool) :
|
||||
xs.flatten.find? p = xs.findSome? (·.find? p) := by
|
||||
cases xs using array₂_induction
|
||||
cases xs using array_array_induction
|
||||
simp [List.findSome?_map, Function.comp_def]
|
||||
|
||||
theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α → Bool} :
|
||||
@@ -220,7 +220,7 @@ theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α → Bool} {a : α}
|
||||
p a ∧ ∃ (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
|
||||
xs = as.push (ys.push a ++ zs) ++ bs ∧
|
||||
(∀ a ∈ as, ∀ x ∈ a, !p x) ∧ (∀ x ∈ ys, !p x) := by
|
||||
cases xs using array₂_induction
|
||||
cases xs using array_array_induction
|
||||
simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
|
||||
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
|
||||
intro w
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -5,7 +5,6 @@ Authors: Mario Carneiro, Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.Lemmas
|
||||
import Init.Data.Array.Attach
|
||||
import Init.Data.List.MapIdx
|
||||
|
||||
namespace Array
|
||||
@@ -13,82 +12,81 @@ namespace Array
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
|
||||
theorem mapFinIdx_induction (as : Array α) (f : (i : Nat) → α → (h : i < as.size) → β)
|
||||
theorem mapFinIdx_induction (as : Array α) (f : Fin as.size → α → β)
|
||||
(motive : Nat → Prop) (h0 : motive 0)
|
||||
(p : (i : Nat) → β → (h : i < as.size) → Prop)
|
||||
(hs : ∀ i h, motive i → p i (f i as[i] h) h ∧ motive (i + 1)) :
|
||||
(p : Fin as.size → β → Prop)
|
||||
(hs : ∀ i, motive i.1 → p i (f i as[i]) ∧ motive (i + 1)) :
|
||||
motive as.size ∧ ∃ eq : (Array.mapFinIdx as f).size = as.size,
|
||||
∀ i h, p i ((Array.mapFinIdx as f)[i]) h := by
|
||||
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : ∀ i h h', p i bs[i] h) (hm : motive j) :
|
||||
∀ i h, p ⟨i, h⟩ ((Array.mapFinIdx as f)[i]) := by
|
||||
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : ∀ i h h', p ⟨i, h⟩ bs[i]) (hm : motive j) :
|
||||
let arr : Array β := Array.mapFinIdxM.map (m := Id) as f i j h bs
|
||||
motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p i arr[i] h := by
|
||||
motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i] := by
|
||||
induction i generalizing j bs with simp [mapFinIdxM.map]
|
||||
| zero =>
|
||||
have := (Nat.zero_add _).symm.trans h
|
||||
exact ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩
|
||||
| succ i ih =>
|
||||
apply @ih (bs.push (f j as[j] (by omega))) (j + 1) (by omega) (by simp; omega)
|
||||
apply @ih (bs.push (f ⟨j, by omega⟩ as[j])) (j + 1) (by omega) (by simp; omega)
|
||||
· intro i i_lt h'
|
||||
rw [getElem_push]
|
||||
split
|
||||
· apply h₂
|
||||
· simp only [size_push] at h'
|
||||
obtain rfl : i = j := by omega
|
||||
apply (hs i (by omega) hm).1
|
||||
· exact (hs j (by omega) hm).2
|
||||
apply (hs ⟨i, by omega⟩ hm).1
|
||||
· exact (hs ⟨j, by omega⟩ hm).2
|
||||
simp [mapFinIdx, mapFinIdxM]; exact go rfl nofun h0
|
||||
|
||||
theorem mapFinIdx_spec (as : Array α) (f : (i : Nat) → α → (h : i < as.size) → β)
|
||||
(p : (i : Nat) → β → (h : i < as.size) → Prop) (hs : ∀ i h, p i (f i as[i] h) h) :
|
||||
theorem mapFinIdx_spec (as : Array α) (f : Fin as.size → α → β)
|
||||
(p : Fin as.size → β → Prop) (hs : ∀ i, p i (f i as[i])) :
|
||||
∃ eq : (Array.mapFinIdx as f).size = as.size,
|
||||
∀ i h, p i ((Array.mapFinIdx as f)[i]) h :=
|
||||
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ _ => ⟨hs .., trivial⟩).2
|
||||
∀ i h, p ⟨i, h⟩ ((Array.mapFinIdx as f)[i]) :=
|
||||
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ => ⟨hs .., trivial⟩).2
|
||||
|
||||
@[simp] theorem size_mapFinIdx (a : Array α) (f : (i : Nat) → α → (h : i < a.size) → β) :
|
||||
(a.mapFinIdx f).size = a.size :=
|
||||
(mapFinIdx_spec (p := fun _ _ _ => True) (hs := fun _ _ => trivial)).1
|
||||
@[simp] theorem size_mapFinIdx (a : Array α) (f : Fin a.size → α → β) : (a.mapFinIdx f).size = a.size :=
|
||||
(mapFinIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
|
||||
|
||||
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
|
||||
Array.size_mapFinIdx _ _
|
||||
|
||||
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : (i : Nat) → α → (h : i < a.size) → β) (i : Nat)
|
||||
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : Fin a.size → α → β) (i : Nat)
|
||||
(h : i < (mapFinIdx a f).size) :
|
||||
(a.mapFinIdx f)[i] = f i (a[i]'(by simp_all)) (by simp_all) :=
|
||||
(mapFinIdx_spec _ _ (fun i b h => b = f i a[i] h) fun _ _ => rfl).2 i _
|
||||
(a.mapFinIdx f)[i] = f ⟨i, by simp_all⟩ (a[i]'(by simp_all)) :=
|
||||
(mapFinIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
|
||||
|
||||
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : (i : Nat) → α → (h : i < a.size) → β) (i : Nat) :
|
||||
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : Fin a.size → α → β) (i : Nat) :
|
||||
(a.mapFinIdx f)[i]? =
|
||||
a[i]?.pbind fun b h => f i b (getElem?_eq_some_iff.1 h).1 := by
|
||||
a[i]?.pbind fun b h => f ⟨i, (getElem?_eq_some_iff.1 h).1⟩ b := by
|
||||
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem toList_mapFinIdx (a : Array α) (f : (i : Nat) → α → (h : i < a.size) → β) :
|
||||
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a h => f i a (by simpa)) := by
|
||||
@[simp] theorem toList_mapFinIdx (a : Array α) (f : Fin a.size → α → β) :
|
||||
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a => f ⟨i, by simp⟩ a) := by
|
||||
apply List.ext_getElem <;> simp
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
theorem mapIdx_induction (f : Nat → α → β) (as : Array α)
|
||||
(motive : Nat → Prop) (h0 : motive 0)
|
||||
(p : (i : Nat) → β → (h : i < as.size) → Prop)
|
||||
(hs : ∀ i h, motive i → p i (f i as[i]) h ∧ motive (i + 1)) :
|
||||
(p : Fin as.size → β → Prop)
|
||||
(hs : ∀ i, motive i.1 → p i (f i as[i]) ∧ motive (i + 1)) :
|
||||
motive as.size ∧ ∃ eq : (as.mapIdx f).size = as.size,
|
||||
∀ i h, p i ((as.mapIdx f)[i]) h :=
|
||||
mapFinIdx_induction as (fun i a _ => f i a) motive h0 p hs
|
||||
∀ i h, p ⟨i, h⟩ ((as.mapIdx f)[i]) :=
|
||||
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
|
||||
|
||||
theorem mapIdx_spec (f : Nat → α → β) (as : Array α)
|
||||
(p : (i : Nat) → β → (h : i < as.size) → Prop) (hs : ∀ i h, p i (f i as[i]) h) :
|
||||
(p : Fin as.size → β → Prop) (hs : ∀ i, p i (f i as[i])) :
|
||||
∃ eq : (as.mapIdx f).size = as.size,
|
||||
∀ i h, p i ((as.mapIdx f)[i]) h :=
|
||||
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ _ => ⟨hs .., trivial⟩).2
|
||||
∀ i h, p ⟨i, h⟩ ((as.mapIdx f)[i]) :=
|
||||
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => ⟨hs .., trivial⟩).2
|
||||
|
||||
@[simp] theorem size_mapIdx (f : Nat → α → β) (as : Array α) : (as.mapIdx f).size = as.size :=
|
||||
(mapIdx_spec (p := fun _ _ _ => True) (hs := fun _ _ => trivial)).1
|
||||
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
|
||||
|
||||
@[simp] theorem getElem_mapIdx (f : Nat → α → β) (as : Array α) (i : Nat)
|
||||
(h : i < (as.mapIdx f).size) :
|
||||
(as.mapIdx f)[i] = f i (as[i]'(by simp_all)) :=
|
||||
(mapIdx_spec _ _ (fun i b h => b = f i as[i]) fun _ _ => rfl).2 i (by simp_all)
|
||||
(mapIdx_spec _ _ (fun i b => b = f i as[i]) fun _ => rfl).2 i (by simp_all)
|
||||
|
||||
@[simp] theorem getElem?_mapIdx (f : Nat → α → β) (as : Array α) (i : Nat) :
|
||||
(as.mapIdx f)[i]? =
|
||||
@@ -103,7 +101,7 @@ end Array
|
||||
|
||||
namespace List
|
||||
|
||||
@[simp] theorem mapFinIdx_toArray (l : List α) (f : (i : Nat) → α → (h : i < l.length) → β) :
|
||||
@[simp] theorem mapFinIdx_toArray (l : List α) (f : Fin l.length → α → β) :
|
||||
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
|
||||
ext <;> simp
|
||||
|
||||
@@ -112,293 +110,3 @@ namespace List
|
||||
ext <;> simp
|
||||
|
||||
end List
|
||||
|
||||
namespace Array
|
||||
|
||||
/-! ### zipWithIndex -/
|
||||
|
||||
@[simp] theorem getElem_zipWithIndex (a : Array α) (i : Nat) (h : i < a.zipWithIndex.size) :
|
||||
(a.zipWithIndex)[i] = (a[i]'(by simp_all), i) := by
|
||||
simp [zipWithIndex]
|
||||
|
||||
@[simp] theorem zipWithIndex_toArray {l : List α} :
|
||||
l.toArray.zipWithIndex = (l.enum.map fun (i, x) => (x, i)).toArray := by
|
||||
ext i hi₁ hi₂ <;> simp
|
||||
|
||||
@[simp] theorem toList_zipWithIndex (a : Array α) :
|
||||
a.zipWithIndex.toList = a.toList.enum.map (fun (i, a) => (a, i)) := by
|
||||
rcases a with ⟨a⟩
|
||||
simp
|
||||
|
||||
theorem mk_mem_zipWithIndex_iff_getElem? {x : α} {i : Nat} {l : Array α} :
|
||||
(x, i) ∈ l.zipWithIndex ↔ l[i]? = x := by
|
||||
rcases l with ⟨l⟩
|
||||
simp only [zipWithIndex_toArray, mem_toArray, List.mem_map, Prod.mk.injEq, Prod.exists,
|
||||
List.mk_mem_enum_iff_getElem?, List.getElem?_toArray]
|
||||
constructor
|
||||
· rintro ⟨a, b, h, rfl, rfl⟩
|
||||
exact h
|
||||
· intro h
|
||||
exact ⟨i, x, by simp [h]⟩
|
||||
|
||||
theorem mem_enum_iff_getElem? {x : α × Nat} {l : Array α} : x ∈ l.zipWithIndex ↔ l[x.2]? = some x.1 :=
|
||||
mk_mem_zipWithIndex_iff_getElem?
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
@[congr] theorem mapFinIdx_congr {xs ys : Array α} (w : xs = ys)
|
||||
(f : (i : Nat) → α → (h : i < xs.size) → β) :
|
||||
mapFinIdx xs f = mapFinIdx ys (fun i a h => f i a (by simp [w]; omega)) := by
|
||||
subst w
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_empty {f : (i : Nat) → α → (h : i < 0) → β} : mapFinIdx #[] f = #[] :=
|
||||
rfl
|
||||
|
||||
theorem mapFinIdx_eq_ofFn {as : Array α} {f : (i : Nat) → α → (h : i < as.size) → β} :
|
||||
as.mapFinIdx f = Array.ofFn fun i : Fin as.size => f i as[i] i.2 := by
|
||||
cases as
|
||||
simp [List.mapFinIdx_eq_ofFn]
|
||||
|
||||
theorem mapFinIdx_append {K L : Array α} {f : (i : Nat) → α → (h : i < (K ++ L).size) → β} :
|
||||
(K ++ L).mapFinIdx f =
|
||||
K.mapFinIdx (fun i a h => f i a (by simp; omega)) ++
|
||||
L.mapFinIdx (fun i a h => f (i + K.size) a (by simp; omega)) := by
|
||||
cases K
|
||||
cases L
|
||||
simp [List.mapFinIdx_append]
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_push {l : Array α} {a : α} {f : (i : Nat) → α → (h : i < (l.push a).size) → β} :
|
||||
mapFinIdx (l.push a) f =
|
||||
(mapFinIdx l (fun i a h => f i a (by simp; omega))).push (f l.size a (by simp)) := by
|
||||
simp [← append_singleton, mapFinIdx_append]
|
||||
|
||||
theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) → β} :
|
||||
#[a].mapFinIdx f = #[f 0 a (by simp)] := by
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_zipWithIndex_map {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f = l.zipWithIndex.attach.map
|
||||
fun ⟨⟨x, i⟩, m⟩ =>
|
||||
f i x (by simp [mk_mem_zipWithIndex_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
|
||||
ext <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_eq_empty_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f = #[] ↔ l = #[] := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_ne_empty_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f ≠ #[] ↔ l ≠ #[] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapFinIdx {b : β} {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β}
|
||||
(h : b ∈ l.mapFinIdx f) : ∃ (i : Nat) (h : i < l.size), f i l[i] h = b := by
|
||||
rcases l with ⟨l⟩
|
||||
exact List.exists_of_mem_mapFinIdx (by simpa using h)
|
||||
|
||||
@[simp] theorem mem_mapFinIdx {b : β} {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
b ∈ l.mapFinIdx f ↔ ∃ (i : Nat) (h : i < l.size), f i l[i] h = b := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f = l' ↔ ∃ h : l'.size = l.size, ∀ (i : Nat) (h : i < l.size), l'[i] = f i l[i] h := by
|
||||
rcases l with ⟨l⟩
|
||||
rcases l' with ⟨l'⟩
|
||||
simpa using List.mapFinIdx_eq_iff
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_singleton_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} {b : β} :
|
||||
l.mapFinIdx f = #[b] ↔ ∃ (a : α) (w : l = #[a]), f 0 a (by simp [w]) = b := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_append_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} {l₁ l₂ : Array β} :
|
||||
l.mapFinIdx f = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : Array α) (l₂' : Array α) (w : l = l₁' ++ l₂'),
|
||||
l₁'.mapFinIdx (fun i a h => f i a (by simp [w]; omega)) = l₁ ∧
|
||||
l₂'.mapFinIdx (fun i a h => f (i + l₁'.size) a (by simp [w]; omega)) = l₂ := by
|
||||
rcases l with ⟨l⟩
|
||||
rcases l₁ with ⟨l₁⟩
|
||||
rcases l₂ with ⟨l₂⟩
|
||||
simp only [List.mapFinIdx_toArray, List.append_toArray, mk.injEq, List.mapFinIdx_eq_append_iff,
|
||||
toArray_eq_append_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
|
||||
refine ⟨l₁.toArray, l₂.toArray, by simp_all⟩
|
||||
· rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
|
||||
simp [← toList_inj] at h₁ h₂
|
||||
obtain rfl := h₁
|
||||
obtain rfl := h₂
|
||||
refine ⟨l₁, l₂, by simp_all⟩
|
||||
|
||||
theorem mapFinIdx_eq_push_iff {l : Array α} {b : β} {f : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f = l₂.push b ↔
|
||||
∃ (l₁ : Array α) (a : α) (w : l = l₁.push a),
|
||||
l₁.mapFinIdx (fun i a h => f i a (by simp [w]; omega)) = l₂ ∧ b = f (l.size - 1) a (by simp [w]) := by
|
||||
rw [push_eq_append, mapFinIdx_eq_append_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, h₂⟩
|
||||
simp only [mapFinIdx_eq_singleton_iff, Nat.zero_add] at h₂
|
||||
obtain ⟨a, rfl, rfl⟩ := h₂
|
||||
exact ⟨l₁, a, by simp⟩
|
||||
· rintro ⟨l₁, a, rfl, rfl, rfl⟩
|
||||
exact ⟨l₁, #[a], by simp⟩
|
||||
|
||||
theorem mapFinIdx_eq_mapFinIdx_iff {l : Array α} {f g : (i : Nat) → α → (h : i < l.size) → β} :
|
||||
l.mapFinIdx f = l.mapFinIdx g ↔ ∀ (i : Nat) (h : i < l.size), f i l[i] h = g i l[i] h := by
|
||||
rw [eq_comm, mapFinIdx_eq_iff]
|
||||
simp
|
||||
|
||||
@[simp] theorem mapFinIdx_mapFinIdx {l : Array α}
|
||||
{f : (i : Nat) → α → (h : i < l.size) → β}
|
||||
{g : (i : Nat) → β → (h : i < (l.mapFinIdx f).size) → γ} :
|
||||
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i a h => g i (f i a h) (by simpa using h)) := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapFinIdx_eq_mkArray_iff {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} {b : β} :
|
||||
l.mapFinIdx f = mkArray l.size b ↔ ∀ (i : Nat) (h : i < l.size), f i l[i] h = b := by
|
||||
rcases l with ⟨l⟩
|
||||
rw [← toList_inj]
|
||||
simp [List.mapFinIdx_eq_replicate_iff]
|
||||
|
||||
@[simp] theorem mapFinIdx_reverse {l : Array α} {f : (i : Nat) → α → (h : i < l.reverse.size) → β} :
|
||||
l.reverse.mapFinIdx f = (l.mapFinIdx (fun i a h => f (l.size - 1 - i) a (by simp; omega))).reverse := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapFinIdx_reverse]
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_empty {f : Nat → α → β} : mapIdx f #[] = #[] :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_mapIdx {l : Array α} {f : (i : Nat) → α → (h : i < l.size) → β} {g : Nat → α → β}
|
||||
(h : ∀ (i : Nat) (h : i < l.size), f i l[i] h = g i l[i]) :
|
||||
l.mapFinIdx f = l.mapIdx g := by
|
||||
simp_all [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mapFinIdx {l : Array α} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
|
||||
simp [mapFinIdx_eq_mapIdx]
|
||||
|
||||
theorem mapIdx_eq_zipWithIndex_map {l : Array α} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.zipWithIndex.map fun ⟨a, i⟩ => f i a := by
|
||||
ext <;> simp
|
||||
|
||||
theorem mapIdx_append {K L : Array α} :
|
||||
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.size) := by
|
||||
rcases K with ⟨K⟩
|
||||
rcases L with ⟨L⟩
|
||||
simp [List.mapIdx_append]
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_push {l : Array α} {a : α} :
|
||||
mapIdx f (l.push a) = (mapIdx f l).push (f l.size a) := by
|
||||
simp [← append_singleton, mapIdx_append]
|
||||
|
||||
theorem mapIdx_singleton {a : α} : mapIdx f #[a] = #[f 0 a] := by
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_eq_empty_iff {l : Array α} : mapIdx f l = #[] ↔ l = #[] := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
theorem mapIdx_ne_empty_iff {l : Array α} :
|
||||
mapIdx f l ≠ #[] ↔ l ≠ #[] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapIdx {b : β} {l : Array α}
|
||||
(h : b ∈ mapIdx f l) : ∃ (i : Nat) (h : i < l.size), f i l[i] = b := by
|
||||
rw [mapIdx_eq_mapFinIdx] at h
|
||||
simpa [Fin.exists_iff] using exists_of_mem_mapFinIdx h
|
||||
|
||||
@[simp] theorem mem_mapIdx {b : β} {l : Array α} :
|
||||
b ∈ mapIdx f l ↔ ∃ (i : Nat) (h : i < l.size), f i l[i] = b := by
|
||||
constructor
|
||||
· intro h
|
||||
exact exists_of_mem_mapIdx h
|
||||
· rintro ⟨i, h, rfl⟩
|
||||
rw [mem_iff_getElem]
|
||||
exact ⟨i, by simpa using h, by simp⟩
|
||||
|
||||
theorem mapIdx_eq_push_iff {l : Array α} {b : β} :
|
||||
mapIdx f l = l₂.push b ↔
|
||||
∃ (a : α) (l₁ : Array α), l = l₁.push a ∧ mapIdx f l₁ = l₂ ∧ f l₁.size a = b := by
|
||||
rw [mapIdx_eq_mapFinIdx, mapFinIdx_eq_push_iff]
|
||||
simp only [mapFinIdx_eq_mapIdx, exists_and_left, exists_prop]
|
||||
constructor
|
||||
· rintro ⟨l₁, rfl, a, rfl, rfl⟩
|
||||
exact ⟨a, l₁, by simp⟩
|
||||
· rintro ⟨a, l₁, rfl, rfl, rfl⟩
|
||||
exact ⟨l₁, rfl, a, by simp⟩
|
||||
|
||||
@[simp] theorem mapIdx_eq_singleton_iff {l : Array α} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = #[b] ↔ ∃ (a : α), l = #[a] ∧ f 0 a = b := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapIdx_eq_singleton_iff]
|
||||
|
||||
theorem mapIdx_eq_append_iff {l : Array α} {f : Nat → α → β} {l₁ l₂ : Array β} :
|
||||
mapIdx f l = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : Array α) (l₂' : Array α), l = l₁' ++ l₂' ∧
|
||||
l₁'.mapIdx f = l₁ ∧
|
||||
l₂'.mapIdx (fun i => f (i + l₁'.size)) = l₂ := by
|
||||
rcases l with ⟨l⟩
|
||||
rcases l₁ with ⟨l₁⟩
|
||||
rcases l₂ with ⟨l₂⟩
|
||||
simp only [List.mapIdx_toArray, List.append_toArray, mk.injEq, List.mapIdx_eq_append_iff,
|
||||
toArray_eq_append_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
|
||||
exact ⟨l₁.toArray, l₂.toArray, by simp⟩
|
||||
· rintro ⟨⟨l₁⟩, ⟨l₂⟩, rfl, h₁, h₂⟩
|
||||
simp only [List.mapIdx_toArray, mk.injEq, size_toArray] at h₁ h₂
|
||||
obtain rfl := h₁
|
||||
obtain rfl := h₂
|
||||
exact ⟨l₁, l₂, by simp⟩
|
||||
|
||||
theorem mapIdx_eq_iff {l : Array α} : mapIdx f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map (f i) := by
|
||||
rcases l with ⟨l⟩
|
||||
rcases l' with ⟨l'⟩
|
||||
simp [List.mapIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mapIdx_iff {l : Array α} :
|
||||
mapIdx f l = mapIdx g l ↔ ∀ i : Nat, (h : i < l.size) → f i l[i] = g i l[i] := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapIdx_eq_mapIdx_iff]
|
||||
|
||||
@[simp] theorem mapIdx_set {l : Array α} {i : Nat} {h : i < l.size} {a : α} :
|
||||
(l.set i a).mapIdx f = (l.mapIdx f).set i (f i a) (by simpa) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapIdx_set]
|
||||
|
||||
@[simp] theorem mapIdx_setIfInBounds {l : Array α} {i : Nat} {a : α} :
|
||||
(l.setIfInBounds i a).mapIdx f = (l.mapIdx f).setIfInBounds i (f i a) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapIdx_set]
|
||||
|
||||
@[simp] theorem back?_mapIdx {l : Array α} {f : Nat → α → β} :
|
||||
(mapIdx f l).back? = (l.back?).map (f (l.size - 1)) := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.getLast?_mapIdx]
|
||||
|
||||
@[simp] theorem mapIdx_mapIdx {l : Array α} {f : Nat → α → β} {g : Nat → β → γ} :
|
||||
(l.mapIdx f).mapIdx g = l.mapIdx (fun i => g i ∘ f i) := by
|
||||
simp [mapIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mkArray_iff {l : Array α} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = mkArray l.size b ↔ ∀ (i : Nat) (h : i < l.size), f i l[i] = b := by
|
||||
rcases l with ⟨l⟩
|
||||
rw [← toList_inj]
|
||||
simp [List.mapIdx_eq_replicate_iff]
|
||||
|
||||
@[simp] theorem mapIdx_reverse {l : Array α} {f : Nat → α → β} :
|
||||
l.reverse.mapIdx f = (mapIdx (fun i => f (l.size - 1 - i)) l).reverse := by
|
||||
rcases l with ⟨l⟩
|
||||
simp [List.mapIdx_reverse]
|
||||
|
||||
end Array
|
||||
|
||||
@@ -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
|
||||
@@ -1294,6 +1261,11 @@ theorem allOnes_shiftLeft_or_shiftLeft {x : BitVec w} {n : Nat} :
|
||||
BitVec.allOnes w <<< n ||| x <<< n = BitVec.allOnes w <<< n := by
|
||||
simp [← shiftLeft_or_distrib]
|
||||
|
||||
@[deprecated shiftLeft_add (since := "2024-06-02")]
|
||||
theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
(x <<< n) <<< m = x <<< (n + m) := by
|
||||
rw [shiftLeft_add]
|
||||
|
||||
/-! ### shiftLeft reductions from BitVec to Nat -/
|
||||
|
||||
@[simp]
|
||||
@@ -1941,6 +1913,11 @@ theorem msb_shiftLeft {x : BitVec w} {n : Nat} :
|
||||
(x <<< n).msb = x.getMsbD n := by
|
||||
simp [BitVec.msb]
|
||||
|
||||
@[deprecated shiftRight_add (since := "2024-06-02")]
|
||||
theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
(x >>> n) >>> m = x >>> (n + m) := by
|
||||
rw [shiftRight_add]
|
||||
|
||||
/-! ### rev -/
|
||||
|
||||
theorem getLsbD_rev (x : BitVec w) (i : Fin w) :
|
||||
@@ -2305,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]
|
||||
@@ -2406,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
|
||||
@@ -2597,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
|
||||
@@ -2639,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} :
|
||||
@@ -2690,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]
|
||||
@@ -2721,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
|
||||
@@ -2926,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
|
||||
@@ -3075,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)`.
|
||||
@@ -3222,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
|
||||
@@ -3529,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]
|
||||
|
||||
@@ -70,3 +70,5 @@ theorem utf8Size_eq (c : Char) : c.utf8Size = 1 ∨ c.utf8Size = 2 ∨ c.utf8Siz
|
||||
rfl
|
||||
|
||||
end Char
|
||||
|
||||
@[deprecated Char.utf8Size (since := "2024-06-04")] abbrev String.csize := Char.utf8Size
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -258,6 +258,9 @@ theorem ext_get? : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n)
|
||||
have h0 : some a = some a' := h 0
|
||||
injection h0 with aa; simp only [aa, ext_get? fun n => h (n+1)]
|
||||
|
||||
/-- Deprecated alias for `ext_get?`. The preferred extensionality theorem is now `ext_getElem?`. -/
|
||||
@[deprecated ext_get? (since := "2024-06-07")] abbrev ext := @ext_get?
|
||||
|
||||
/-! ### getD -/
|
||||
|
||||
/--
|
||||
@@ -603,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
|
||||
@@ -616,6 +619,11 @@ set_option linter.missingDocs false in
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_cons (since := "2024-10-16")] abbrev cons_flatMap := @flatMap_cons
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_nil (since := "2024-06-15")] abbrev nil_bind := @flatMap_nil
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated flatMap_cons (since := "2024-06-15")] abbrev cons_bind := @flatMap_cons
|
||||
|
||||
/-! ### replicate -/
|
||||
|
||||
/--
|
||||
@@ -705,6 +713,11 @@ def elem [BEq α] (a : α) : List α → Bool
|
||||
theorem elem_cons [BEq α] {a : α} :
|
||||
(b::bs).elem a = match a == b with | true => true | false => bs.elem a := rfl
|
||||
|
||||
/-- `notElem a l` is `!(elem a l)`. -/
|
||||
@[deprecated "Use `!(elem a l)` instead."(since := "2024-06-15")]
|
||||
def notElem [BEq α] (a : α) (as : List α) : Bool :=
|
||||
!(as.elem a)
|
||||
|
||||
/-! ### contains -/
|
||||
|
||||
@[inherit_doc elem] abbrev contains [BEq α] (as : List α) (a : α) : Bool :=
|
||||
|
||||
@@ -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
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -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⟩
|
||||
|
||||
@@ -17,19 +17,18 @@ namespace List
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
|
||||
/--
|
||||
Given a list `as = [a₀, a₁, ...]` function `f : Fin as.length → α → β`, returns the list
|
||||
`[f 0 a₀, f 1 a₁, ...]`.
|
||||
-/
|
||||
@[inline] def mapFinIdx (as : List α) (f : (i : Nat) → α → (h : i < as.length) → β) : List β :=
|
||||
go as #[] (by simp)
|
||||
where
|
||||
@[inline] def mapFinIdx (as : List α) (f : Fin as.length → α → β) : List β := go as #[] (by simp) where
|
||||
/-- Auxiliary for `mapFinIdx`:
|
||||
`mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
|
||||
@[specialize] go : (bs : List α) → (acc : Array β) → bs.length + acc.size = as.length → List β
|
||||
| [], acc, h => acc.toList
|
||||
| a :: as, acc, h =>
|
||||
go as (acc.push (f acc.size a (by simp at h; omega))) (by simp at h ⊢; omega)
|
||||
go as (acc.push (f ⟨acc.size, by simp at h; omega⟩ a)) (by simp at h ⊢; omega)
|
||||
|
||||
/--
|
||||
Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁, ...]`, returns the list
|
||||
@@ -44,14 +43,8 @@ Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁,
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
@[congr] theorem mapFinIdx_congr {xs ys : List α} (w : xs = ys)
|
||||
(f : (i : Nat) → α → (h : i < xs.length) → β) :
|
||||
mapFinIdx xs f = mapFinIdx ys (fun i a h => f i a (by simp [w]; omega)) := by
|
||||
subst w
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_nil {f : (i : Nat) → α → (h : i < 0) → β} : mapFinIdx [] f = [] :=
|
||||
theorem mapFinIdx_nil {f : Fin 0 → α → β} : mapFinIdx [] f = [] :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem length_mapFinIdx_go :
|
||||
@@ -60,16 +53,13 @@ theorem mapFinIdx_nil {f : (i : Nat) → α → (h : i < 0) → β} : mapFinIdx
|
||||
| nil => simpa using h
|
||||
| cons _ _ ih => simp [mapFinIdx.go, ih]
|
||||
|
||||
@[simp] theorem length_mapFinIdx {as : List α} {f : (i : Nat) → α → (h : i < as.length) → β} :
|
||||
@[simp] theorem length_mapFinIdx {as : List α} {f : Fin as.length → α → β} :
|
||||
(as.mapFinIdx f).length = as.length := by
|
||||
simp [mapFinIdx, length_mapFinIdx_go]
|
||||
|
||||
theorem getElem_mapFinIdx_go {as : List α} {f : (i : Nat) → α → (h : i < as.length) → β} {i : Nat} {h} {w} :
|
||||
theorem getElem_mapFinIdx_go {as : List α} {f : Fin as.length → α → β} {i : Nat} {h} {w} :
|
||||
(mapFinIdx.go as f bs acc h)[i] =
|
||||
if w' : i < acc.size then
|
||||
acc[i]
|
||||
else
|
||||
f i (bs[i - acc.size]'(by simp at w; omega)) (by simp at w; omega) := by
|
||||
if w' : i < acc.size then acc[i] else f ⟨i, by simp at w; omega⟩ (bs[i - acc.size]'(by simp at w; omega)) := by
|
||||
induction bs generalizing acc with
|
||||
| nil =>
|
||||
simp only [length_mapFinIdx_go, length_nil, Nat.zero_add] at w h
|
||||
@@ -88,30 +78,29 @@ theorem getElem_mapFinIdx_go {as : List α} {f : (i : Nat) → α → (h : i < a
|
||||
· have h₃ : i - acc.size = (i - (acc.size + 1)) + 1 := by omega
|
||||
simp [h₃]
|
||||
|
||||
@[simp] theorem getElem_mapFinIdx {as : List α} {f : (i : Nat) → α → (h : i < as.length) → β} {i : Nat} {h} :
|
||||
(as.mapFinIdx f)[i] = f i (as[i]'(by simp at h; omega)) (by simp at h; omega) := by
|
||||
@[simp] theorem getElem_mapFinIdx {as : List α} {f : Fin as.length → α → β} {i : Nat} {h} :
|
||||
(as.mapFinIdx f)[i] = f ⟨i, by simp at h; omega⟩ (as[i]'(by simp at h; omega)) := by
|
||||
simp [mapFinIdx, getElem_mapFinIdx_go]
|
||||
|
||||
theorem mapFinIdx_eq_ofFn {as : List α} {f : (i : Nat) → α → (h : i < as.length) → β} :
|
||||
as.mapFinIdx f = List.ofFn fun i : Fin as.length => f i as[i] i.2 := by
|
||||
theorem mapFinIdx_eq_ofFn {as : List α} {f : Fin as.length → α → β} :
|
||||
as.mapFinIdx f = List.ofFn fun i : Fin as.length => f i as[i] := by
|
||||
apply ext_getElem <;> simp
|
||||
|
||||
@[simp] theorem getElem?_mapFinIdx {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} {i : Nat} :
|
||||
(l.mapFinIdx f)[i]? = l[i]?.pbind fun x m => f i x (by simp [getElem?_eq_some_iff] at m; exact m.1) := by
|
||||
@[simp] theorem getElem?_mapFinIdx {l : List α} {f : Fin l.length → α → β} {i : Nat} :
|
||||
(l.mapFinIdx f)[i]? = l[i]?.pbind fun x m => f ⟨i, by simp [getElem?_eq_some_iff] at m; exact m.1⟩ x := by
|
||||
simp only [getElem?_def, length_mapFinIdx, getElem_mapFinIdx]
|
||||
split <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_cons {l : List α} {a : α} {f : (i : Nat) → α → (h : i < l.length + 1) → β} :
|
||||
mapFinIdx (a :: l) f = f 0 a (by omega) :: mapFinIdx l (fun i a h => f (i + 1) a (by omega)) := by
|
||||
theorem mapFinIdx_cons {l : List α} {a : α} {f : Fin (l.length + 1) → α → β} :
|
||||
mapFinIdx (a :: l) f = f 0 a :: mapFinIdx l (fun i => f i.succ) := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· rintro (_|i) h₁ h₂ <;> simp
|
||||
|
||||
theorem mapFinIdx_append {K L : List α} {f : (i : Nat) → α → (h : i < (K ++ L).length) → β} :
|
||||
theorem mapFinIdx_append {K L : List α} {f : Fin (K ++ L).length → α → β} :
|
||||
(K ++ L).mapFinIdx f =
|
||||
K.mapFinIdx (fun i a h => f i a (by simp; omega)) ++
|
||||
L.mapFinIdx (fun i a h => f (i + K.length) a (by simp; omega)) := by
|
||||
K.mapFinIdx (fun i => f (i.castLE (by simp))) ++ L.mapFinIdx (fun i => f ((i.natAdd K.length).cast (by simp))) := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
@@ -119,57 +108,60 @@ theorem mapFinIdx_append {K L : List α} {f : (i : Nat) → α → (h : i < (K +
|
||||
simp only [getElem_mapFinIdx, length_mapFinIdx]
|
||||
split <;> rename_i h
|
||||
· rw [getElem_append_left]
|
||||
congr
|
||||
· simp only [Nat.not_lt] at h
|
||||
rw [getElem_append_right h]
|
||||
congr
|
||||
simp
|
||||
omega
|
||||
|
||||
@[simp] theorem mapFinIdx_concat {l : List α} {e : α} {f : (i : Nat) → α → (h : i < (l ++ [e]).length) → β}:
|
||||
(l ++ [e]).mapFinIdx f = l.mapFinIdx (fun i a h => f i a (by simp; omega)) ++ [f l.length e (by simp)] := by
|
||||
@[simp] theorem mapFinIdx_concat {l : List α} {e : α} {f : Fin (l ++ [e]).length → α → β}:
|
||||
(l ++ [e]).mapFinIdx f = l.mapFinIdx (fun i => f (i.castLE (by simp))) ++ [f ⟨l.length, by simp⟩ e] := by
|
||||
simp [mapFinIdx_append]
|
||||
congr
|
||||
|
||||
theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) → β} :
|
||||
[a].mapFinIdx f = [f 0 a (by simp)] := by
|
||||
theorem mapFinIdx_singleton {a : α} {f : Fin 1 → α → β} :
|
||||
[a].mapFinIdx f = [f ⟨0, by simp⟩ a] := by
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_enum_map {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
theorem mapFinIdx_eq_enum_map {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l.enum.attach.map
|
||||
fun ⟨⟨i, x⟩, m⟩ =>
|
||||
f i x (by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
|
||||
f ⟨i, by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1⟩ x := by
|
||||
apply ext_getElem <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_eq_nil_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
theorem mapFinIdx_eq_nil_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = [] ↔ l = [] := by
|
||||
rw [mapFinIdx_eq_enum_map, map_eq_nil_iff, attach_eq_nil_iff, enum_eq_nil_iff]
|
||||
|
||||
theorem mapFinIdx_ne_nil_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
theorem mapFinIdx_ne_nil_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f ≠ [] ↔ l ≠ [] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β}
|
||||
(h : b ∈ l.mapFinIdx f) : ∃ (i : Nat) (h : i < l.length), f i l[i] h = b := by
|
||||
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length → α → β}
|
||||
(h : b ∈ l.mapFinIdx f) : ∃ (i : Fin l.length), f i l[i] = b := by
|
||||
rw [mapFinIdx_eq_enum_map] at h
|
||||
replace h := exists_of_mem_map h
|
||||
simp only [mem_attach, true_and, Subtype.exists, Prod.exists, mk_mem_enum_iff_getElem?] at h
|
||||
obtain ⟨i, b, h, rfl⟩ := h
|
||||
rw [getElem?_eq_some_iff] at h
|
||||
obtain ⟨h', rfl⟩ := h
|
||||
exact ⟨i, h', rfl⟩
|
||||
exact ⟨⟨i, h'⟩, rfl⟩
|
||||
|
||||
@[simp] theorem mem_mapFinIdx {b : β} {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
b ∈ l.mapFinIdx f ↔ ∃ (i : Nat) (h : i < l.length), f i l[i] h = b := by
|
||||
@[simp] theorem mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length → α → β} :
|
||||
b ∈ l.mapFinIdx f ↔ ∃ (i : Fin l.length), f i l[i] = b := by
|
||||
constructor
|
||||
· intro h
|
||||
exact exists_of_mem_mapFinIdx h
|
||||
· rintro ⟨i, h, rfl⟩
|
||||
rw [mem_iff_getElem]
|
||||
exact ⟨i, by simpa using h, by simp⟩
|
||||
exact ⟨i, by simp⟩
|
||||
|
||||
theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = b :: l₂ ↔
|
||||
∃ (a : α) (l₁ : List α) (w : l = a :: l₁),
|
||||
f 0 a (by simp [w]) = b ∧ l₁.mapFinIdx (fun i a h => f (i + 1) a (by simp [w]; omega)) = l₂ := by
|
||||
∃ (a : α) (l₁ : List α) (h : l = a :: l₁),
|
||||
f ⟨0, by simp [h]⟩ a = b ∧ l₁.mapFinIdx (fun i => f (i.succ.cast (by simp [h]))) = l₂ := by
|
||||
cases l with
|
||||
| nil => simp
|
||||
| cons x l' =>
|
||||
@@ -177,91 +169,39 @@ theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : (i : Nat) → α → (
|
||||
exists_and_left]
|
||||
constructor
|
||||
· rintro ⟨rfl, rfl⟩
|
||||
refine ⟨x, l', ⟨rfl, rfl⟩, by simp⟩
|
||||
· rintro ⟨a, l', ⟨rfl, rfl⟩, ⟨rfl, rfl⟩⟩
|
||||
exact ⟨rfl, by simp⟩
|
||||
refine ⟨x, rfl, l', by simp⟩
|
||||
· rintro ⟨a, ⟨rfl, h⟩, ⟨_, ⟨rfl, rfl⟩, h⟩⟩
|
||||
exact ⟨rfl, h⟩
|
||||
|
||||
theorem mapFinIdx_eq_cons_iff' {l : List α} {b : β} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
theorem mapFinIdx_eq_cons_iff' {l : List α} {b : β} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = b :: l₂ ↔
|
||||
l.head?.pbind (fun x m => (f 0 x (by cases l <;> simp_all))) = some b ∧
|
||||
l.tail?.attach.map (fun ⟨t, m⟩ => t.mapFinIdx fun i a h => f (i + 1) a (by cases l <;> simp_all)) = some l₂ := by
|
||||
l.head?.pbind (fun x m => (f ⟨0, by cases l <;> simp_all⟩ x)) = some b ∧
|
||||
l.tail?.attach.map (fun ⟨t, m⟩ => t.mapFinIdx fun i => f (i.succ.cast (by cases l <;> simp_all))) = some l₂ := by
|
||||
cases l <;> simp
|
||||
|
||||
theorem mapFinIdx_eq_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
l.mapFinIdx f = l' ↔ ∃ h : l'.length = l.length, ∀ (i : Nat) (h : i < l.length), l'[i] = f i l[i] h := by
|
||||
theorem mapFinIdx_eq_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l' ↔ ∃ h : l'.length = l.length, ∀ (i : Nat) (h : i < l.length), l'[i] = f ⟨i, h⟩ l[i] := by
|
||||
constructor
|
||||
· rintro rfl
|
||||
simp
|
||||
· rintro ⟨h, w⟩
|
||||
apply ext_getElem <;> simp_all
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_singleton_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} {b : β} :
|
||||
l.mapFinIdx f = [b] ↔ ∃ (a : α) (w : l = [a]), f 0 a (by simp [w]) = b := by
|
||||
simp [mapFinIdx_eq_cons_iff]
|
||||
|
||||
theorem mapFinIdx_eq_append_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
l.mapFinIdx f = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : List α) (l₂' : List α) (w : l = l₁' ++ l₂'),
|
||||
l₁'.mapFinIdx (fun i a h => f i a (by simp [w]; omega)) = l₁ ∧
|
||||
l₂'.mapFinIdx (fun i a h => f (i + l₁'.length) a (by simp [w]; omega)) = l₂ := by
|
||||
rw [mapFinIdx_eq_iff]
|
||||
constructor
|
||||
· intro ⟨h, w⟩
|
||||
simp only [length_append] at h
|
||||
refine ⟨l.take l₁.length, l.drop l₁.length, by simp, ?_⟩
|
||||
constructor
|
||||
· apply ext_getElem
|
||||
· simp
|
||||
omega
|
||||
· intro i hi₁ hi₂
|
||||
simp only [getElem_mapFinIdx, getElem_take]
|
||||
specialize w i (by omega)
|
||||
rw [getElem_append_left hi₂] at w
|
||||
exact w.symm
|
||||
· apply ext_getElem
|
||||
· simp
|
||||
omega
|
||||
· intro i hi₁ hi₂
|
||||
simp only [getElem_mapFinIdx, getElem_take]
|
||||
simp only [length_take, getElem_drop]
|
||||
have : l₁.length ≤ l.length := by omega
|
||||
simp only [Nat.min_eq_left this, Nat.add_comm]
|
||||
specialize w (i + l₁.length) (by omega)
|
||||
rw [getElem_append_right (by omega)] at w
|
||||
simpa using w.symm
|
||||
· rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
|
||||
refine ⟨by simp, fun i h => ?_⟩
|
||||
rw [getElem_append]
|
||||
split <;> rename_i h'
|
||||
· simp [getElem_append_left (by simpa using h')]
|
||||
· simp only [length_mapFinIdx, Nat.not_lt] at h'
|
||||
have : i - l₁'.length + l₁'.length = i := by omega
|
||||
simp [getElem_append_right h', this]
|
||||
|
||||
theorem mapFinIdx_eq_mapFinIdx_iff {l : List α} {f g : (i : Nat) → α → (h : i < l.length) → β} :
|
||||
l.mapFinIdx f = l.mapFinIdx g ↔ ∀ (i : Nat) (h : i < l.length), f i l[i] h = g i l[i] h := by
|
||||
theorem mapFinIdx_eq_mapFinIdx_iff {l : List α} {f g : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l.mapFinIdx g ↔ ∀ (i : Fin l.length), f i l[i] = g i l[i] := by
|
||||
rw [eq_comm, mapFinIdx_eq_iff]
|
||||
simp [Fin.forall_iff]
|
||||
|
||||
@[simp] theorem mapFinIdx_mapFinIdx {l : List α}
|
||||
{f : (i : Nat) → α → (h : i < l.length) → β}
|
||||
{g : (i : Nat) → β → (h : i < (l.mapFinIdx f).length) → γ} :
|
||||
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i a h => g i (f i a h) (by simpa)) := by
|
||||
@[simp] theorem mapFinIdx_mapFinIdx {l : List α} {f : Fin l.length → α → β} {g : Fin _ → β → γ} :
|
||||
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i => g (i.cast (by simp)) ∘ f i) := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapFinIdx_eq_replicate_iff {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} {b : β} :
|
||||
l.mapFinIdx f = replicate l.length b ↔ ∀ (i : Nat) (h : i < l.length), f i l[i] h = b := by
|
||||
rw [eq_replicate_iff, length_mapFinIdx]
|
||||
simp only [mem_mapFinIdx, forall_exists_index, true_and]
|
||||
constructor
|
||||
· intro w i h
|
||||
exact w (f i l[i] h) i h rfl
|
||||
· rintro w b i h rfl
|
||||
exact w i h
|
||||
theorem mapFinIdx_eq_replicate_iff {l : List α} {f : Fin l.length → α → β} {b : β} :
|
||||
l.mapFinIdx f = replicate l.length b ↔ ∀ (i : Fin l.length), f i l[i] = b := by
|
||||
simp [eq_replicate_iff, length_mapFinIdx, mem_mapFinIdx, forall_exists_index, true_and]
|
||||
|
||||
@[simp] theorem mapFinIdx_reverse {l : List α} {f : (i : Nat) → α → (h : i < l.reverse.length) → β} :
|
||||
l.reverse.mapFinIdx f =
|
||||
(l.mapFinIdx (fun i a h => f (l.length - 1 - i) a (by simp; omega))).reverse := by
|
||||
@[simp] theorem mapFinIdx_reverse {l : List α} {f : Fin l.reverse.length → α → β} :
|
||||
l.reverse.mapFinIdx f = (l.mapFinIdx (fun i => f ⟨l.length - 1 - i, by simp; omega⟩)).reverse := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
intro i h
|
||||
congr
|
||||
@@ -322,13 +262,13 @@ theorem getElem?_mapIdx_go : ∀ {l : List α} {arr : Array β} {i : Nat},
|
||||
rw [← getElem?_eq_getElem, getElem?_mapIdx, getElem?_eq_getElem (by simpa using h)]
|
||||
simp
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_mapIdx {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} {g : Nat → α → β}
|
||||
(h : ∀ (i : Nat) (h : i < l.length), f i l[i] h = g i l[i]) :
|
||||
@[simp] theorem mapFinIdx_eq_mapIdx {l : List α} {f : Fin l.length → α → β} {g : Nat → α → β}
|
||||
(h : ∀ (i : Fin l.length), f i l[i] = g i l[i]) :
|
||||
l.mapFinIdx f = l.mapIdx g := by
|
||||
simp_all [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mapFinIdx {l : List α} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
|
||||
l.mapIdx f = l.mapFinIdx (fun i => f i) := by
|
||||
simp [mapFinIdx_eq_mapIdx]
|
||||
|
||||
theorem mapIdx_eq_enum_map {l : List α} :
|
||||
@@ -388,10 +328,6 @@ theorem mapIdx_eq_cons_iff' {l : List α} {b : β} :
|
||||
l.head?.map (f 0) = some b ∧ l.tail?.map (mapIdx fun i => f (i + 1)) = some l₂ := by
|
||||
cases l <;> simp
|
||||
|
||||
@[simp] theorem mapIdx_eq_singleton_iff {l : List α} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = [b] ↔ ∃ (a : α), l = [a] ∧ f 0 a = b := by
|
||||
simp [mapIdx_eq_cons_iff]
|
||||
|
||||
theorem mapIdx_eq_iff {l : List α} : mapIdx f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map (f i) := by
|
||||
constructor
|
||||
· intro w i
|
||||
@@ -400,19 +336,6 @@ theorem mapIdx_eq_iff {l : List α} : mapIdx f l = l' ↔ ∀ i : Nat, l'[i]? =
|
||||
ext1 i
|
||||
simp [w]
|
||||
|
||||
theorem mapIdx_eq_append_iff {l : List α} :
|
||||
mapIdx f l = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : List α) (l₂' : List α), l = l₁' ++ l₂' ∧
|
||||
mapIdx f l₁' = l₁ ∧
|
||||
mapIdx (fun i => f (i + l₁'.length)) l₂' = l₂ := by
|
||||
rw [mapIdx_eq_mapFinIdx, mapFinIdx_eq_append_iff]
|
||||
simp only [mapFinIdx_eq_mapIdx, exists_and_left, exists_prop]
|
||||
constructor
|
||||
· rintro ⟨l₁, rfl, l₂, rfl, h⟩
|
||||
refine ⟨l₁, l₂, by simp_all⟩
|
||||
· rintro ⟨l₁, l₂, rfl, rfl, rfl⟩
|
||||
refine ⟨l₁, rfl, l₂, by simp_all⟩
|
||||
|
||||
theorem mapIdx_eq_mapIdx_iff {l : List α} :
|
||||
mapIdx f l = mapIdx g l ↔ ∀ i : Nat, (h : i < l.length) → f i l[i] = g i l[i] := by
|
||||
constructor
|
||||
|
||||
@@ -47,16 +47,41 @@ length `> i`. Version designed to rewrite from the small list to the big list. -
|
||||
L[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
|
||||
rw [length_take, Nat.lt_min] at h; rw [getElem_take' L _ h.1]
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the big list to the small list. -/
|
||||
@[deprecated getElem_take' (since := "2024-06-12")]
|
||||
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
|
||||
get L ⟨i, hi⟩ = get (L.take j) ⟨i, length_take .. ▸ Nat.lt_min.mpr ⟨hj, hi⟩⟩ := by
|
||||
simp
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the small list to the big list. -/
|
||||
@[deprecated getElem_take (since := "2024-06-12")]
|
||||
theorem get_take' (L : List α) {j i} :
|
||||
get (L.take j) i =
|
||||
get L ⟨i.1, Nat.lt_of_lt_of_le i.2 (length_take_le' _ _)⟩ := by
|
||||
simp [getElem_take]
|
||||
|
||||
theorem getElem?_take_eq_none {l : List α} {n m : Nat} (h : n ≤ m) :
|
||||
(l.take n)[m]? = none :=
|
||||
getElem?_eq_none <| Nat.le_trans (length_take_le _ _) h
|
||||
|
||||
@[deprecated getElem?_take_eq_none (since := "2024-06-12")]
|
||||
theorem get?_take_eq_none {l : List α} {n m : Nat} (h : n ≤ m) :
|
||||
(l.take n).get? m = none := by
|
||||
simp [getElem?_take_eq_none h]
|
||||
|
||||
theorem getElem?_take {l : List α} {n m : Nat} :
|
||||
(l.take n)[m]? = if m < n then l[m]? else none := by
|
||||
split
|
||||
· next h => exact getElem?_take_of_lt h
|
||||
· next h => exact getElem?_take_eq_none (Nat.le_of_not_lt h)
|
||||
|
||||
@[deprecated getElem?_take (since := "2024-06-12")]
|
||||
theorem get?_take_eq_if {l : List α} {n m : Nat} :
|
||||
(l.take n).get? m = if m < n then l.get? m else none := by
|
||||
simp [getElem?_take]
|
||||
|
||||
theorem head?_take {l : List α} {n : Nat} :
|
||||
(l.take n).head? = if n = 0 then none else l.head? := by
|
||||
simp [head?_eq_getElem?, getElem?_take]
|
||||
@@ -201,6 +226,13 @@ theorem getElem_drop' (L : List α) {i j : Nat} (h : i + j < L.length) :
|
||||
· simp [Nat.min_eq_left this, Nat.add_sub_cancel_left]
|
||||
· simp [Nat.min_eq_left this, Nat.le_add_right]
|
||||
|
||||
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
|
||||
dropping the first `i` elements. Version designed to rewrite from the big list to the small list. -/
|
||||
@[deprecated getElem_drop' (since := "2024-06-12")]
|
||||
theorem get_drop (L : List α) {i j : Nat} (h : i + j < L.length) :
|
||||
get L ⟨i + j, h⟩ = get (L.drop i) ⟨j, lt_length_drop L h⟩ := by
|
||||
simp [getElem_drop']
|
||||
|
||||
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
|
||||
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
|
||||
@[simp] theorem getElem_drop (L : List α) {i : Nat} {j : Nat} {h : j < (L.drop i).length} :
|
||||
@@ -209,6 +241,15 @@ dropping the first `i` elements. Version designed to rewrite from the small list
|
||||
exact Nat.add_lt_of_lt_sub (length_drop i L ▸ h)) := by
|
||||
rw [getElem_drop']
|
||||
|
||||
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
|
||||
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
|
||||
@[deprecated getElem_drop' (since := "2024-06-12")]
|
||||
theorem get_drop' (L : List α) {i j} :
|
||||
get (L.drop i) j = get L ⟨i + j, by
|
||||
rw [Nat.add_comm]
|
||||
exact Nat.add_lt_of_lt_sub (length_drop i L ▸ j.2)⟩ := by
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem getElem?_drop (L : List α) (i j : Nat) : (L.drop i)[j]? = L[i + j]? := by
|
||||
ext
|
||||
@@ -220,6 +261,10 @@ theorem getElem?_drop (L : List α) (i j : Nat) : (L.drop i)[j]? = L[i + j]? :=
|
||||
rw [Nat.add_comm] at h
|
||||
apply Nat.lt_sub_of_add_lt h
|
||||
|
||||
@[deprecated getElem?_drop (since := "2024-06-12")]
|
||||
theorem get?_drop (L : List α) (i j : Nat) : get? (L.drop i) j = get? L (i + j) := by
|
||||
simp
|
||||
|
||||
theorem mem_take_iff_getElem {l : List α} {a : α} :
|
||||
a ∈ l.take n ↔ ∃ (i : Nat) (hm : i < min n l.length), l[i] = a := by
|
||||
rw [mem_iff_getElem]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -67,9 +67,17 @@ theorem getElem_cons_drop : ∀ (l : List α) (i : Nat) (h : i < l.length),
|
||||
| _::_, 0, _ => rfl
|
||||
| _::_, i+1, h => getElem_cons_drop _ i (Nat.add_one_lt_add_one_iff.mp h)
|
||||
|
||||
@[deprecated getElem_cons_drop (since := "2024-06-12")]
|
||||
theorem get_cons_drop (l : List α) (i) : get l i :: drop (i + 1) l = drop i l := by
|
||||
simp
|
||||
|
||||
theorem drop_eq_getElem_cons {n} {l : List α} (h : n < l.length) : drop n l = l[n] :: drop (n + 1) l :=
|
||||
(getElem_cons_drop _ n h).symm
|
||||
|
||||
@[deprecated drop_eq_getElem_cons (since := "2024-06-12")]
|
||||
theorem drop_eq_get_cons {n} {l : List α} (h) : drop n l = get l ⟨n, h⟩ :: drop (n + 1) l := by
|
||||
simp [drop_eq_getElem_cons]
|
||||
|
||||
@[simp]
|
||||
theorem getElem?_take_of_lt {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m]? = l[m]? := by
|
||||
induction n generalizing l m with
|
||||
@@ -83,6 +91,10 @@ theorem getElem?_take_of_lt {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m
|
||||
· simp
|
||||
· simpa using hn (Nat.lt_of_succ_lt_succ h)
|
||||
|
||||
@[deprecated getElem?_take_of_lt (since := "2024-06-12")]
|
||||
theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by
|
||||
simp [getElem?_take_of_lt, h]
|
||||
|
||||
theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? := by simp
|
||||
|
||||
@[simp] theorem drop_drop (n : Nat) : ∀ (m) (l : List α), drop n (drop m l) = drop (m + n) l
|
||||
@@ -99,6 +111,10 @@ theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (t
|
||||
| _, _, [] => by simp
|
||||
| _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
|
||||
|
||||
@[deprecated drop_drop (since := "2024-06-15")]
|
||||
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop n (drop m l) := by
|
||||
simp [drop_drop]
|
||||
|
||||
@[simp]
|
||||
theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) := by
|
||||
induction l generalizing n with
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -76,6 +76,15 @@ theorem getElem?_zip_eq_some {l₁ : List α} {l₂ : List β} {z : α × β} {i
|
||||
· rintro ⟨h₀, h₁⟩
|
||||
exact ⟨_, _, h₀, h₁, rfl⟩
|
||||
|
||||
@[deprecated getElem?_zipWith (since := "2024-06-12")]
|
||||
theorem get?_zipWith {f : α → β → γ} :
|
||||
(List.zipWith f as bs).get? i = match as.get? i, bs.get? i with
|
||||
| some a, some b => some (f a b) | _, _ => none := by
|
||||
simp [getElem?_zipWith]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_zipWith (since := "2024-06-07")] abbrev zipWith_get? := @get?_zipWith
|
||||
|
||||
theorem head?_zipWith {f : α → β → γ} :
|
||||
(List.zipWith f as bs).head? = match as.head?, bs.head? with
|
||||
| some a, some b => some (f a b) | _, _ => none := by
|
||||
@@ -194,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₂ =>
|
||||
@@ -250,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]
|
||||
@@ -360,6 +369,15 @@ theorem getElem?_zipWithAll {f : Option α → Option β → γ} {i : Nat} :
|
||||
cases i <;> simp_all
|
||||
| cons b bs => cases i <;> simp_all
|
||||
|
||||
@[deprecated getElem?_zipWithAll (since := "2024-06-12")]
|
||||
theorem get?_zipWithAll {f : Option α → Option β → γ} :
|
||||
(zipWithAll f as bs).get? i = match as.get? i, bs.get? i with
|
||||
| none, none => .none | a?, b? => some (f a? b?) := by
|
||||
simp [getElem?_zipWithAll]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_zipWithAll (since := "2024-06-07")] abbrev zipWithAll_get? := @get?_zipWithAll
|
||||
|
||||
theorem head?_zipWithAll {f : Option α → Option β → γ} :
|
||||
(zipWithAll f as bs).head? = match as.head?, bs.head? with
|
||||
| none, none => .none | a?, b? => some (f a? b?) := by
|
||||
|
||||
@@ -788,6 +788,9 @@ theorem not_eq_zero_of_lt (h : b < a) : a ≠ 0 := by
|
||||
theorem pred_lt_of_lt {n m : Nat} (h : m < n) : pred n < n :=
|
||||
pred_lt (not_eq_zero_of_lt h)
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated pred_lt_of_lt (since := "2024-06-01")] abbrev pred_lt' := @pred_lt_of_lt
|
||||
|
||||
theorem sub_one_lt_of_lt {n m : Nat} (h : m < n) : n - 1 < n :=
|
||||
sub_one_lt (not_eq_zero_of_lt h)
|
||||
|
||||
@@ -1071,6 +1074,9 @@ theorem pred_mul (n m : Nat) : pred n * m = n * m - m := by
|
||||
| zero => simp
|
||||
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated pred_mul (since := "2024-06-01")] abbrev mul_pred_left := @pred_mul
|
||||
|
||||
protected theorem sub_one_mul (n m : Nat) : (n - 1) * m = n * m - m := by
|
||||
cases n with
|
||||
| zero => simp
|
||||
@@ -1080,6 +1086,9 @@ protected theorem sub_one_mul (n m : Nat) : (n - 1) * m = n * m - m := by
|
||||
theorem mul_pred (n m : Nat) : n * pred m = n * m - n := by
|
||||
rw [Nat.mul_comm, pred_mul, Nat.mul_comm]
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated mul_pred (since := "2024-06-01")] abbrev mul_pred_right := @mul_pred
|
||||
|
||||
theorem mul_sub_one (n m : Nat) : n * (m - 1) = n * m - n := by
|
||||
rw [Nat.mul_comm, Nat.sub_one_mul , Nat.mul_comm]
|
||||
|
||||
|
||||
@@ -711,32 +711,6 @@ theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^
|
||||
rw [mod_two_eq_one_iff_testBit_zero, testBit_shiftLeft]
|
||||
simp
|
||||
|
||||
theorem testBit_mul_two_pow (x i n : Nat) :
|
||||
(x * 2 ^ n).testBit i = (decide (n ≤ i) && x.testBit (i - n)) := by
|
||||
rw [← testBit_shiftLeft, shiftLeft_eq]
|
||||
|
||||
theorem bitwise_mul_two_pow (of_false_false : f false false = false := by rfl) :
|
||||
(bitwise f x y) * 2 ^ n = bitwise f (x * 2 ^ n) (y * 2 ^ n) := by
|
||||
apply Nat.eq_of_testBit_eq
|
||||
simp only [testBit_mul_two_pow, testBit_bitwise of_false_false, Bool.if_false_right]
|
||||
intro i
|
||||
by_cases hn : n ≤ i
|
||||
· simp [hn]
|
||||
· simp [hn, of_false_false]
|
||||
|
||||
theorem shiftLeft_bitwise_distrib {a b : Nat} (of_false_false : f false false = false := by rfl) :
|
||||
(bitwise f a b) <<< i = bitwise f (a <<< i) (b <<< i) := by
|
||||
simp [shiftLeft_eq, bitwise_mul_two_pow of_false_false]
|
||||
|
||||
theorem shiftLeft_and_distrib {a b : Nat} : (a &&& b) <<< i = a <<< i &&& b <<< i :=
|
||||
shiftLeft_bitwise_distrib
|
||||
|
||||
theorem shiftLeft_or_distrib {a b : Nat} : (a ||| b) <<< i = a <<< i ||| b <<< i :=
|
||||
shiftLeft_bitwise_distrib
|
||||
|
||||
theorem shiftLeft_xor_distrib {a b : Nat} : (a ^^^ b) <<< i = a <<< i ^^^ b <<< i :=
|
||||
shiftLeft_bitwise_distrib
|
||||
|
||||
@[simp] theorem decide_shiftRight_mod_two_eq_one :
|
||||
decide (x >>> i % 2 = 1) = x.testBit i := by
|
||||
simp only [testBit, one_and_eq_mod_two, mod_two_bne_zero]
|
||||
|
||||
@@ -49,17 +49,4 @@ theorem lt_div_mul_self (h : 0 < k) (w : k ≤ x) : x - k < x / k * k := by
|
||||
have : x % k < k := mod_lt x h
|
||||
omega
|
||||
|
||||
theorem div_pos (hba : b ≤ a) (hb : 0 < b) : 0 < a / b := by
|
||||
cases b
|
||||
· contradiction
|
||||
· simp [Nat.pos_iff_ne_zero, div_eq_zero_iff_lt, hba]
|
||||
|
||||
theorem div_le_div_left (hcb : c ≤ b) (hc : 0 < c) : a / b ≤ a / c :=
|
||||
(Nat.le_div_iff_mul_le hc).2 <|
|
||||
Nat.le_trans (Nat.mul_le_mul_left _ hcb) (Nat.div_mul_le_self a b)
|
||||
|
||||
theorem div_add_le_right {z : Nat} (h : 0 < z) (x y : Nat) :
|
||||
x / (y + z) ≤ x / z :=
|
||||
div_le_div_left (Nat.le_add_left z y) h
|
||||
|
||||
end Nat
|
||||
|
||||
@@ -622,14 +622,6 @@ protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by
|
||||
0 < a * b ↔ 0 < a :=
|
||||
⟨Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h⟩
|
||||
|
||||
protected theorem pos_of_lt_mul_left {a b c : Nat} (h : a < b * c) : 0 < c := by
|
||||
replace h : 0 < b * c := by omega
|
||||
exact Nat.pos_of_mul_pos_left h
|
||||
|
||||
protected theorem pos_of_lt_mul_right {a b c : Nat} (h : a < b * c) : 0 < b := by
|
||||
replace h : 0 < b * c := by omega
|
||||
exact Nat.pos_of_mul_pos_right h
|
||||
|
||||
/-! ### div/mod -/
|
||||
|
||||
theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 ∨ n % 2 = 1 :=
|
||||
@@ -1003,6 +995,11 @@ theorem shiftLeft_add (m n : Nat) : ∀ k, m <<< (n + k) = (m <<< n) <<< k
|
||||
| 0 => rfl
|
||||
| k + 1 => by simp [← Nat.add_assoc, shiftLeft_add _ _ k, shiftLeft_succ]
|
||||
|
||||
@[deprecated shiftLeft_add (since := "2024-06-02")]
|
||||
theorem shiftLeft_shiftLeft (m n : Nat) : ∀ k, (m <<< n) <<< k = m <<< (n + k)
|
||||
| 0 => rfl
|
||||
| k + 1 => by simp [← Nat.add_assoc, shiftLeft_shiftLeft _ _ k, shiftLeft_succ]
|
||||
|
||||
@[simp] theorem shiftLeft_shiftRight (x n : Nat) : x <<< n >>> n = x := by
|
||||
rw [Nat.shiftLeft_eq, Nat.shiftRight_eq_div_pow, Nat.mul_div_cancel _ (Nat.two_pow_pos _)]
|
||||
|
||||
|
||||
@@ -208,15 +208,6 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
|
||||
|
||||
theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..
|
||||
|
||||
theorem map_inj_right {f : α → β} {o o' : Option α} (w : ∀ x y, f x = f y → x = y) :
|
||||
o.map f = o'.map f ↔ o = o' := by
|
||||
cases o with
|
||||
| none => cases o' <;> simp
|
||||
| some a =>
|
||||
cases o' with
|
||||
| none => simp
|
||||
| some a' => simpa using ⟨fun h => w _ _ h, fun h => congrArg f h⟩
|
||||
|
||||
@[simp] theorem map_if {f : α → β} [Decidable c] :
|
||||
(if c then some a else none).map f = if c then some (f a) else none := by
|
||||
split <;> rfl
|
||||
@@ -638,15 +629,6 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → a ∈ o → Option
|
||||
· rintro ⟨h, rfl⟩
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem pmap_eq_map (p : α → Prop) (f : α → β) (o : Option α) (H) :
|
||||
@pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
|
||||
cases o <;> simp
|
||||
|
||||
theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H) :
|
||||
Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
|
||||
cases o <;> simp
|
||||
|
||||
/-! ### pelim -/
|
||||
|
||||
@[simp] theorem pelim_none : pelim none b f = b := rfl
|
||||
|
||||
@@ -159,8 +159,6 @@ def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.toBitVec <<< (mod b 32).toBitVec⟩
|
||||
@[extern "lean_uint32_shift_right"]
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
|
||||
def UInt32.lt (a b : UInt32) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt32.le (a b : UInt32) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance : Add UInt32 := ⟨UInt32.add⟩
|
||||
instance : Sub UInt32 := ⟨UInt32.sub⟩
|
||||
@@ -171,8 +169,6 @@ set_option linter.deprecated false in
|
||||
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
|
||||
|
||||
instance : Div UInt32 := ⟨UInt32.div⟩
|
||||
instance : LT UInt32 := ⟨UInt32.lt⟩
|
||||
instance : LE UInt32 := ⟨UInt32.le⟩
|
||||
|
||||
@[extern "lean_uint32_complement"]
|
||||
def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
@@ -13,17 +13,11 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
|
||||
`(
|
||||
namespace $typeName
|
||||
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
|
||||
@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
|
||||
@[simp] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
|
||||
@[simp] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
|
||||
@[simp] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
|
||||
|
||||
@[simp] protected theorem toNat_and (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := by simp [toNat]
|
||||
@[simp] protected theorem toNat_or (a b : $typeName) : (a ||| b).toNat = a.toNat ||| b.toNat := by simp [toNat]
|
||||
@@ -43,31 +37,3 @@ declare_bitwise_uint_theorems UInt16 16
|
||||
declare_bitwise_uint_theorems UInt32 32
|
||||
declare_bitwise_uint_theorems UInt64 64
|
||||
declare_bitwise_uint_theorems USize System.Platform.numBits
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
theorem Bool.toBitVec_toUInt8 {b : Bool} :
|
||||
b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
|
||||
cases b <;> simp [toUInt8]
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
theorem Bool.toBitVec_toUInt16 {b : Bool} :
|
||||
b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
|
||||
cases b <;> simp [toUInt16]
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
theorem Bool.toBitVec_toUInt32 {b : Bool} :
|
||||
b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
|
||||
cases b <;> simp [toUInt32]
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
theorem Bool.toBitVec_toUInt64 {b : Bool} :
|
||||
b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
|
||||
cases b <;> simp [toUInt64]
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
theorem Bool.toBitVec_toUSize {b : Bool} :
|
||||
b.toUSize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
|
||||
cases b
|
||||
· simp [toUSize]
|
||||
· apply BitVec.eq_of_toNat_eq
|
||||
simp [toUSize]
|
||||
|
||||
@@ -41,9 +41,9 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
|
||||
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
|
||||
rw [toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
@[int_toBitVec] theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
|
||||
theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
|
||||
|
||||
@[int_toBitVec] theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
|
||||
theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
|
||||
|
||||
theorem le_iff_toNat_le {a b : $typeName} : a ≤ b ↔ a.toNat ≤ b.toNat := .rfl
|
||||
|
||||
@@ -74,11 +74,6 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
|
||||
protected theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec ↔ a = b :=
|
||||
Iff.intro eq_of_toBitVec_eq toBitVec_eq_of_eq
|
||||
|
||||
open $typeName (eq_of_toBitVec_eq toBitVec_eq_of_eq) in
|
||||
@[int_toBitVec]
|
||||
protected theorem eq_iff_toBitVec_eq {a b : $typeName} : a = b ↔ a.toBitVec = b.toBitVec :=
|
||||
Iff.intro toBitVec_eq_of_eq eq_of_toBitVec_eq
|
||||
|
||||
open $typeName (eq_of_toBitVec_eq) in
|
||||
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by
|
||||
rcases a with ⟨⟨_⟩⟩; rcases b with ⟨⟨_⟩⟩; simp_all [val]
|
||||
@@ -87,19 +82,10 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
|
||||
protected theorem val_inj {a b : $typeName} : a.val = b.val ↔ a = b :=
|
||||
Iff.intro eq_of_val_eq (congrArg val)
|
||||
|
||||
open $typeName (eq_of_toBitVec_eq) in
|
||||
protected theorem toBitVec_ne_of_ne {a b : $typeName} (h : a ≠ b) : a.toBitVec ≠ b.toBitVec :=
|
||||
fun h' => h (eq_of_toBitVec_eq h')
|
||||
|
||||
open $typeName (toBitVec_eq_of_eq) in
|
||||
protected theorem ne_of_toBitVec_ne {a b : $typeName} (h : a.toBitVec ≠ b.toBitVec) : a ≠ b :=
|
||||
fun h' => absurd (toBitVec_eq_of_eq h') h
|
||||
|
||||
open $typeName (ne_of_toBitVec_ne toBitVec_ne_of_ne) in
|
||||
@[int_toBitVec]
|
||||
protected theorem ne_iff_toBitVec_ne {a b : $typeName} : a ≠ b ↔ a.toBitVec ≠ b.toBitVec :=
|
||||
Iff.intro toBitVec_ne_of_ne ne_of_toBitVec_ne
|
||||
|
||||
open $typeName (ne_of_toBitVec_ne) in
|
||||
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := by
|
||||
apply ne_of_toBitVec_ne
|
||||
@@ -173,7 +159,7 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
|
||||
@[simp]
|
||||
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
|
||||
|
||||
@[simp, int_toBitVec]
|
||||
@[simp]
|
||||
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
|
||||
|
||||
@[simp]
|
||||
@@ -234,3 +220,23 @@ theorem UInt32.toNat_le_of_le {n : UInt32} {m : Nat} (h : m < size) : n ≤ ofNa
|
||||
|
||||
theorem UInt32.le_toNat_of_le {n : UInt32} {m : Nat} (h : m < size) : ofNat m ≤ n → m ≤ n.toNat := by
|
||||
simp [le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
@[deprecated UInt8.toNat_zero (since := "2024-06-23")] protected abbrev UInt8.zero_toNat := @UInt8.toNat_zero
|
||||
@[deprecated UInt8.toNat_div (since := "2024-06-23")] protected abbrev UInt8.div_toNat := @UInt8.toNat_div
|
||||
@[deprecated UInt8.toNat_mod (since := "2024-06-23")] protected abbrev UInt8.mod_toNat := @UInt8.toNat_mod
|
||||
|
||||
@[deprecated UInt16.toNat_zero (since := "2024-06-23")] protected abbrev UInt16.zero_toNat := @UInt16.toNat_zero
|
||||
@[deprecated UInt16.toNat_div (since := "2024-06-23")] protected abbrev UInt16.div_toNat := @UInt16.toNat_div
|
||||
@[deprecated UInt16.toNat_mod (since := "2024-06-23")] protected abbrev UInt16.mod_toNat := @UInt16.toNat_mod
|
||||
|
||||
@[deprecated UInt32.toNat_zero (since := "2024-06-23")] protected abbrev UInt32.zero_toNat := @UInt32.toNat_zero
|
||||
@[deprecated UInt32.toNat_div (since := "2024-06-23")] protected abbrev UInt32.div_toNat := @UInt32.toNat_div
|
||||
@[deprecated UInt32.toNat_mod (since := "2024-06-23")] protected abbrev UInt32.mod_toNat := @UInt32.toNat_mod
|
||||
|
||||
@[deprecated UInt64.toNat_zero (since := "2024-06-23")] protected abbrev UInt64.zero_toNat := @UInt64.toNat_zero
|
||||
@[deprecated UInt64.toNat_div (since := "2024-06-23")] protected abbrev UInt64.div_toNat := @UInt64.toNat_div
|
||||
@[deprecated UInt64.toNat_mod (since := "2024-06-23")] protected abbrev UInt64.mod_toNat := @UInt64.toNat_mod
|
||||
|
||||
@[deprecated USize.toNat_zero (since := "2024-06-23")] protected abbrev USize.zero_toNat := @USize.toNat_zero
|
||||
@[deprecated USize.toNat_div (since := "2024-06-23")] protected abbrev USize.div_toNat := @USize.toNat_div
|
||||
@[deprecated USize.toNat_mod (since := "2024-06-23")] protected abbrev USize.mod_toNat := @USize.toNat_mod
|
||||
|
||||
@@ -5,6 +5,3 @@ Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Vector.Basic
|
||||
import Init.Data.Vector.Lemmas
|
||||
import Init.Data.Vector.Lex
|
||||
import Init.Data.Vector.MapIdx
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Shreyas Srinivas, François G. Dorais, Kim Morrison
|
||||
|
||||
prelude
|
||||
import Init.Data.Array.Lemmas
|
||||
import Init.Data.Array.MapIdx
|
||||
import Init.Data.Range
|
||||
|
||||
/-!
|
||||
@@ -91,18 +90,20 @@ of bounds.
|
||||
/-- The last element of a vector. Panics if the vector is empty. -/
|
||||
@[inline] def back! [Inhabited α] (v : Vector α n) : α := v.toArray.back!
|
||||
|
||||
/-- The last element of a vector, or `none` if the vector is empty. -/
|
||||
/-- The last element of a vector, or `none` if the array is empty. -/
|
||||
@[inline] def back? (v : Vector α n) : Option α := v.toArray.back?
|
||||
|
||||
/-- The last element of a non-empty vector. -/
|
||||
@[inline] def back [NeZero n] (v : Vector α n) : α :=
|
||||
v[n - 1]'(Nat.sub_one_lt (NeZero.ne n))
|
||||
-- TODO: change to just `v[n]`
|
||||
have : Inhabited α := ⟨v[0]'(Nat.pos_of_neZero n)⟩
|
||||
v.back!
|
||||
|
||||
/-- The first element of a non-empty vector. -/
|
||||
@[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. -/
|
||||
@@ -135,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⟩
|
||||
@@ -169,25 +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⟩
|
||||
|
||||
/-- Maps elements of a vector using the function `f`, which also receives the index of the element. -/
|
||||
@[inline] def mapIdx (f : Nat → α → β) (v : Vector α n) : Vector β n :=
|
||||
⟨v.toArray.mapIdx f, by simp⟩
|
||||
|
||||
/-- Maps elements of a vector using the function `f`,
|
||||
which also receives the index of the element, and the fact that the index is less than the size of the vector. -/
|
||||
@[inline] def mapFinIdx (v : Vector α n) (f : (i : Nat) → α → (h : i < n) → β) : Vector β n :=
|
||||
⟨v.toArray.mapFinIdx (fun i a h => f i a (by simpa [v.size_toArray] using h)), 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']⟩
|
||||
|
||||
@[inline] def zipWithIndex (v : Vector α n) : Vector (α × Nat) n :=
|
||||
⟨v.toArray.zipWithIndex, by simp⟩
|
||||
|
||||
/-- 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⟩
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,333 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.MapIdx
|
||||
import Init.Data.Vector.Lemmas
|
||||
|
||||
namespace Vector
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
@[simp] theorem getElem_mapFinIdx (a : Vector α n) (f : (i : Nat) → α → (h : i < n) → β) (i : Nat)
|
||||
(h : i < n) :
|
||||
(a.mapFinIdx f)[i] = f i a[i] h := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem getElem?_mapFinIdx (a : Vector α n) (f : (i : Nat) → α → (h : i < n) → β) (i : Nat) :
|
||||
(a.mapFinIdx f)[i]? =
|
||||
a[i]?.pbind fun b h => f i b (getElem?_eq_some_iff.1 h).1 := by
|
||||
simp only [getElem?_def, getElem_mapFinIdx]
|
||||
split <;> simp_all
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
@[simp] theorem getElem_mapIdx (f : Nat → α → β) (a : Vector α n) (i : Nat) (h : i < n) :
|
||||
(a.mapIdx f)[i] = f i (a[i]'(by simp_all)) := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem getElem?_mapIdx (f : Nat → α → β) (a : Vector α n) (i : Nat) :
|
||||
(a.mapIdx f)[i]? = a[i]?.map (f i) := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
simp
|
||||
|
||||
end Vector
|
||||
|
||||
namespace Array
|
||||
|
||||
@[simp] theorem mapFinIdx_toVector (l : Array α) (f : (i : Nat) → α → (h : i < l.size) → β) :
|
||||
l.toVector.mapFinIdx f = (l.mapFinIdx f).toVector.cast (by simp) := by
|
||||
ext <;> simp
|
||||
|
||||
@[simp] theorem mapIdx_toVector (f : Nat → α → β) (l : Array α) :
|
||||
l.toVector.mapIdx f = (l.mapIdx f).toVector.cast (by simp) := by
|
||||
ext <;> simp
|
||||
|
||||
end Array
|
||||
|
||||
namespace Vector
|
||||
|
||||
/-! ### zipWithIndex -/
|
||||
|
||||
@[simp] theorem toList_zipWithIndex (a : Vector α n) :
|
||||
a.zipWithIndex.toList = a.toList.enum.map (fun (i, a) => (a, i)) := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem getElem_zipWithIndex (a : Vector α n) (i : Nat) (h : i < n) :
|
||||
(a.zipWithIndex)[i] = (a[i]'(by simp_all), i) := by
|
||||
rcases a with ⟨a, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem zipWithIndex_toVector {l : Array α} :
|
||||
l.toVector.zipWithIndex = l.zipWithIndex.toVector.cast (by simp) := by
|
||||
ext <;> simp
|
||||
|
||||
theorem mk_mem_zipWithIndex_iff_getElem? {x : α} {i : Nat} {l : Vector α n} :
|
||||
(x, i) ∈ l.zipWithIndex ↔ l[i]? = x := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.mk_mem_zipWithIndex_iff_getElem?]
|
||||
|
||||
theorem mem_enum_iff_getElem? {x : α × Nat} {l : Vector α n} :
|
||||
x ∈ l.zipWithIndex ↔ l[x.2]? = some x.1 :=
|
||||
mk_mem_zipWithIndex_iff_getElem?
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
@[congr] theorem mapFinIdx_congr {xs ys : Vector α n} (w : xs = ys)
|
||||
(f : (i : Nat) → α → (h : i < n) → β) :
|
||||
mapFinIdx xs f = mapFinIdx ys f := by
|
||||
subst w
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_empty {f : (i : Nat) → α → (h : i < 0) → β} : mapFinIdx #v[] f = #v[] :=
|
||||
rfl
|
||||
|
||||
theorem mapFinIdx_eq_ofFn {as : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} :
|
||||
as.mapFinIdx f = Vector.ofFn fun i : Fin n => f i as[i] i.2 := by
|
||||
rcases as with ⟨as, rfl⟩
|
||||
simp [Array.mapFinIdx_eq_ofFn]
|
||||
|
||||
theorem mapFinIdx_append {K : Vector α n} {L : Vector α m} {f : (i : Nat) → α → (h : i < n + m) → β} :
|
||||
(K ++ L).mapFinIdx f =
|
||||
K.mapFinIdx (fun i a h => f i a (by omega)) ++
|
||||
L.mapFinIdx (fun i a h => f (i + n) a (by omega)) := by
|
||||
rcases K with ⟨K, rfl⟩
|
||||
rcases L with ⟨L, rfl⟩
|
||||
simp [Array.mapFinIdx_append]
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_push {l : Vector α n} {a : α} {f : (i : Nat) → α → (h : i < n + 1) → β} :
|
||||
mapFinIdx (l.push a) f =
|
||||
(mapFinIdx l (fun i a h => f i a (by omega))).push (f l.size a (by simp)) := by
|
||||
simp [← append_singleton, mapFinIdx_append]
|
||||
|
||||
theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) → β} :
|
||||
#v[a].mapFinIdx f = #v[f 0 a (by simp)] := by
|
||||
simp
|
||||
|
||||
-- FIXME this lemma can't be stated until we've aligned `List/Array/Vector.attach`:
|
||||
-- theorem mapFinIdx_eq_zipWithIndex_map {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} :
|
||||
-- l.mapFinIdx f = l.zipWithIndex.attach.map
|
||||
-- fun ⟨⟨x, i⟩, m⟩ =>
|
||||
-- f i x (by simp [mk_mem_zipWithIndex_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
|
||||
-- ext <;> simp
|
||||
|
||||
theorem exists_of_mem_mapFinIdx {b : β} {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β}
|
||||
(h : b ∈ l.mapFinIdx f) : ∃ (i : Nat) (h : i < n), f i l[i] h = b := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
exact List.exists_of_mem_mapFinIdx (by simpa using h)
|
||||
|
||||
@[simp] theorem mem_mapFinIdx {b : β} {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} :
|
||||
b ∈ l.mapFinIdx f ↔ ∃ (i : Nat) (h : i < n), f i l[i] h = b := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_iff {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} :
|
||||
l.mapFinIdx f = l' ↔ ∀ (i : Nat) (h : i < n), l'[i] = f i l[i] h := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
rcases l' with ⟨l', h⟩
|
||||
simp [mapFinIdx_mk, eq_mk, getElem_mk, Array.mapFinIdx_eq_iff, h]
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_singleton_iff {l : Vector α 1} {f : (i : Nat) → α → (h : i < 1) → β} {b : β} :
|
||||
l.mapFinIdx f = #v[b] ↔ ∃ (a : α), l = #v[a] ∧ f 0 a (by omega) = b := by
|
||||
rcases l with ⟨l, h⟩
|
||||
simp only [mapFinIdx_mk, eq_mk, Array.mapFinIdx_eq_singleton_iff]
|
||||
constructor
|
||||
· rintro ⟨a, rfl, rfl⟩
|
||||
exact ⟨a, by simp⟩
|
||||
· rintro ⟨a, rfl, rfl⟩
|
||||
exact ⟨a, by simp⟩
|
||||
|
||||
theorem mapFinIdx_eq_append_iff {l : Vector α (n + m)} {f : (i : Nat) → α → (h : i < n + m) → β}
|
||||
{l₁ : Vector β n} {l₂ : Vector β m} :
|
||||
l.mapFinIdx f = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : Vector α n) (l₂' : Vector α m), l = l₁' ++ l₂' ∧
|
||||
l₁'.mapFinIdx (fun i a h => f i a (by omega)) = l₁ ∧
|
||||
l₂'.mapFinIdx (fun i a h => f (i + n) a (by omega)) = l₂ := by
|
||||
rcases l with ⟨l, h⟩
|
||||
rcases l₁ with ⟨l₁, rfl⟩
|
||||
rcases l₂ with ⟨l₂, rfl⟩
|
||||
simp only [mapFinIdx_mk, mk_append_mk, eq_mk, Array.mapFinIdx_eq_append_iff, toArray_mapFinIdx,
|
||||
mk_eq, toArray_append, exists_and_left, exists_prop]
|
||||
constructor
|
||||
· rintro ⟨l₁', l₂', rfl, h₁, h₂⟩
|
||||
have h₁' := congrArg Array.size h₁
|
||||
have h₂' := congrArg Array.size h₂
|
||||
simp only [Array.size_mapFinIdx] at h₁' h₂'
|
||||
exact ⟨⟨l₁', h₁'⟩, ⟨l₂', h₂'⟩, by simp_all⟩
|
||||
· rintro ⟨⟨l₁, s₁⟩, ⟨l₂, s₂⟩, rfl, h₁, h₂⟩
|
||||
refine ⟨l₁, l₂, by simp_all⟩
|
||||
|
||||
theorem mapFinIdx_eq_push_iff {l : Vector α (n + 1)} {b : β} {f : (i : Nat) → α → (h : i < n + 1) → β} {l₂ : Vector β n} :
|
||||
l.mapFinIdx f = l₂.push b ↔
|
||||
∃ (l₁ : Vector α n) (a : α), l = l₁.push a ∧
|
||||
l₁.mapFinIdx (fun i a h => f i a (by omega)) = l₂ ∧ b = f n a (by omega) := by
|
||||
rcases l with ⟨l, h⟩
|
||||
rcases l₂ with ⟨l₂, rfl⟩
|
||||
simp only [mapFinIdx_mk, push_mk, eq_mk, Array.mapFinIdx_eq_push_iff, mk_eq, toArray_push,
|
||||
toArray_mapFinIdx]
|
||||
constructor
|
||||
· rintro ⟨l₁, a, rfl, h₁, rfl⟩
|
||||
simp only [Array.size_push, Nat.add_right_cancel_iff] at h
|
||||
exact ⟨⟨l₁, h⟩, a, by simp_all⟩
|
||||
· rintro ⟨⟨l₁, h⟩, a, rfl, h₁, rfl⟩
|
||||
exact ⟨l₁, a, by simp_all⟩
|
||||
|
||||
theorem mapFinIdx_eq_mapFinIdx_iff {l : Vector α n} {f g : (i : Nat) → α → (h : i < n) → β} :
|
||||
l.mapFinIdx f = l.mapFinIdx g ↔ ∀ (i : Nat) (h : i < n), f i l[i] h = g i l[i] h := by
|
||||
rw [eq_comm, mapFinIdx_eq_iff]
|
||||
simp
|
||||
|
||||
@[simp] theorem mapFinIdx_mapFinIdx {l : Vector α n}
|
||||
{f : (i : Nat) → α → (h : i < n) → β}
|
||||
{g : (i : Nat) → β → (h : i < n) → γ} :
|
||||
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i a h => g i (f i a h) h) := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapFinIdx_eq_mkVector_iff {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} {b : β} :
|
||||
l.mapFinIdx f = mkVector n b ↔ ∀ (i : Nat) (h : i < n), f i l[i] h = b := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.mapFinIdx_eq_mkArray_iff]
|
||||
|
||||
@[simp] theorem mapFinIdx_reverse {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} :
|
||||
l.reverse.mapFinIdx f = (l.mapFinIdx (fun i a h => f (n - 1 - i) a (by omega))).reverse := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_empty {f : Nat → α → β} : mapIdx f #v[] = #v[] :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_mapIdx {l : Vector α n} {f : (i : Nat) → α → (h : i < n) → β} {g : Nat → α → β}
|
||||
(h : ∀ (i : Nat) (h : i < n), f i l[i] h = g i l[i]) :
|
||||
l.mapFinIdx f = l.mapIdx g := by
|
||||
simp_all [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mapFinIdx {l : Vector α n} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
|
||||
simp [mapFinIdx_eq_mapIdx]
|
||||
|
||||
theorem mapIdx_eq_zipWithIndex_map {l : Vector α n} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.zipWithIndex.map fun ⟨a, i⟩ => f i a := by
|
||||
ext <;> simp
|
||||
|
||||
theorem mapIdx_append {K : Vector α n} {L : Vector α m} :
|
||||
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.size) := by
|
||||
rcases K with ⟨K, rfl⟩
|
||||
rcases L with ⟨L, rfl⟩
|
||||
simp [Array.mapIdx_append]
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_push {l : Vector α n} {a : α} :
|
||||
mapIdx f (l.push a) = (mapIdx f l).push (f l.size a) := by
|
||||
simp [← append_singleton, mapIdx_append]
|
||||
|
||||
theorem mapIdx_singleton {a : α} : mapIdx f #v[a] = #v[f 0 a] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapIdx {b : β} {l : Vector α n}
|
||||
(h : b ∈ l.mapIdx f) : ∃ (i : Nat) (h : i < n), f i l[i] = b := by
|
||||
rw [mapIdx_eq_mapFinIdx] at h
|
||||
simpa [Fin.exists_iff] using exists_of_mem_mapFinIdx h
|
||||
|
||||
@[simp] theorem mem_mapIdx {b : β} {l : Vector α n} :
|
||||
b ∈ l.mapIdx f ↔ ∃ (i : Nat) (h : i < n), f i l[i] = b := by
|
||||
constructor
|
||||
· intro h
|
||||
exact exists_of_mem_mapIdx h
|
||||
· rintro ⟨i, h, rfl⟩
|
||||
rw [mem_iff_getElem]
|
||||
exact ⟨i, by simpa using h, by simp⟩
|
||||
|
||||
theorem mapIdx_eq_push_iff {l : Vector α (n + 1)} {b : β} :
|
||||
mapIdx f l = l₂.push b ↔
|
||||
∃ (a : α) (l₁ : Vector α n), l = l₁.push a ∧ mapIdx f l₁ = l₂ ∧ f l₁.size a = b := by
|
||||
rw [mapIdx_eq_mapFinIdx, mapFinIdx_eq_push_iff]
|
||||
simp only [mapFinIdx_eq_mapIdx, exists_and_left, exists_prop]
|
||||
constructor
|
||||
· rintro ⟨l₁, a, rfl, rfl, rfl⟩
|
||||
exact ⟨a, l₁, by simp⟩
|
||||
· rintro ⟨a, l₁, rfl, rfl, rfl⟩
|
||||
exact ⟨l₁, a, rfl, by simp⟩
|
||||
|
||||
@[simp] theorem mapIdx_eq_singleton_iff {l : Vector α 1} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = #v[b] ↔ ∃ (a : α), l = #v[a] ∧ f 0 a = b := by
|
||||
rcases l with ⟨l⟩
|
||||
simp
|
||||
|
||||
theorem mapIdx_eq_append_iff {l : Vector α (n + m)} {f : Nat → α → β} {l₁ : Vector β n} {l₂ : Vector β m} :
|
||||
mapIdx f l = l₁ ++ l₂ ↔
|
||||
∃ (l₁' : Vector α n) (l₂' : Vector α m), l = l₁' ++ l₂' ∧
|
||||
l₁'.mapIdx f = l₁ ∧
|
||||
l₂'.mapIdx (fun i => f (i + l₁'.size)) = l₂ := by
|
||||
rcases l with ⟨l, h⟩
|
||||
rcases l₁ with ⟨l₁, rfl⟩
|
||||
rcases l₂ with ⟨l₂, rfl⟩
|
||||
rw [mapIdx_eq_mapFinIdx, mapFinIdx_eq_append_iff]
|
||||
simp
|
||||
|
||||
theorem mapIdx_eq_iff {l : Vector α n} :
|
||||
mapIdx f l = l' ↔ ∀ (i : Nat) (h : i < n), f i l[i] = l'[i] := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
rcases l' with ⟨l', h⟩
|
||||
simp only [mapIdx_mk, eq_mk, Array.mapIdx_eq_iff, getElem_mk]
|
||||
constructor
|
||||
· rintro h' i h
|
||||
specialize h' i
|
||||
simp_all
|
||||
· intro h' i
|
||||
specialize h' i
|
||||
by_cases w : i < l.size
|
||||
· specialize h' w
|
||||
simp_all
|
||||
· simp only [Nat.not_lt] at w
|
||||
simp_all [Array.getElem?_eq_none_iff.mpr w]
|
||||
|
||||
theorem mapIdx_eq_mapIdx_iff {l : Vector α n} :
|
||||
mapIdx f l = mapIdx g l ↔ ∀ (i : Nat) (h : i < n), f i l[i] = g i l[i] := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.mapIdx_eq_mapIdx_iff]
|
||||
|
||||
@[simp] theorem mapIdx_set {l : Vector α n} {i : Nat} {h : i < n} {a : α} :
|
||||
(l.set i a).mapIdx f = (l.mapIdx f).set i (f i a) (by simpa) := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem mapIdx_setIfInBounds {l : Vector α n} {i : Nat} {a : α} :
|
||||
(l.setIfInBounds i a).mapIdx f = (l.mapIdx f).setIfInBounds i (f i a) := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem back?_mapIdx {l : Vector α n} {f : Nat → α → β} :
|
||||
(mapIdx f l).back? = (l.back?).map (f (l.size - 1)) := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem back_mapIdx [NeZero n] {l : Vector α n} {f : Nat → α → β} :
|
||||
(mapIdx f l).back = f (l.size - 1) (l.back) := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp
|
||||
|
||||
@[simp] theorem mapIdx_mapIdx {l : Vector α n} {f : Nat → α → β} {g : Nat → β → γ} :
|
||||
(l.mapIdx f).mapIdx g = l.mapIdx (fun i => g i ∘ f i) := by
|
||||
simp [mapIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mkVector_iff {l : Vector α n} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = mkVector n b ↔ ∀ (i : Nat) (h : i < n), f i l[i] = b := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.mapIdx_eq_mkArray_iff]
|
||||
|
||||
@[simp] theorem mapIdx_reverse {l : Vector α n} {f : Nat → α → β} :
|
||||
l.reverse.mapIdx f = (mapIdx (fun i => f (l.size - 1 - i)) l).reverse := by
|
||||
rcases l with ⟨l, rfl⟩
|
||||
simp [Array.mapIdx_reverse]
|
||||
|
||||
end Vector
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -5,112 +5,106 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.SimpLemmas
|
||||
import Init.PropLemmas
|
||||
import Init.Classical
|
||||
import Init.ByCases
|
||||
|
||||
namespace Lean.Grind
|
||||
/-!
|
||||
Normalization theorems for the `grind` tactic.
|
||||
|
||||
We are also going to use simproc's in the future.
|
||||
-/
|
||||
|
||||
theorem iff_eq (p q : Prop) : (p ↔ q) = (p = q) := by
|
||||
-- Not
|
||||
attribute [grind_norm] Classical.not_not
|
||||
|
||||
-- Ne
|
||||
attribute [grind_norm] ne_eq
|
||||
|
||||
-- Iff
|
||||
@[grind_norm] theorem iff_eq (p q : Prop) : (p ↔ q) = (p = q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
theorem eq_true_eq (p : Prop) : (p = True) = p := by simp
|
||||
theorem eq_false_eq (p : Prop) : (p = False) = ¬p := by simp
|
||||
theorem not_eq_prop (p q : Prop) : (¬(p = q)) = (p = ¬q) := by
|
||||
-- Eq
|
||||
attribute [grind_norm] eq_self heq_eq_eq
|
||||
|
||||
-- Prop equality
|
||||
@[grind_norm] theorem eq_true_eq (p : Prop) : (p = True) = p := by simp
|
||||
@[grind_norm] theorem eq_false_eq (p : Prop) : (p = False) = ¬p := by simp
|
||||
@[grind_norm] theorem not_eq_prop (p q : Prop) : (¬(p = q)) = (p = ¬q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
|
||||
-- Remark: we disabled the following normalization rule because we want this information when implementing splitting heuristics
|
||||
-- True
|
||||
attribute [grind_norm] not_true
|
||||
|
||||
-- False
|
||||
attribute [grind_norm] not_false_eq_true
|
||||
|
||||
-- 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 [*]
|
||||
|
||||
theorem true_imp_eq (p : Prop) : (True → p) = p := by simp
|
||||
theorem false_imp_eq (p : Prop) : (False → p) = True := by simp
|
||||
theorem imp_true_eq (p : Prop) : (p → True) = True := by simp
|
||||
theorem imp_false_eq (p : Prop) : (p → False) = ¬p := by simp
|
||||
theorem imp_self_eq (p : Prop) : (p → p) = True := by simp
|
||||
|
||||
theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
|
||||
-- And
|
||||
@[grind_norm↓] theorem not_and (p q : Prop) : (¬(p ∧ q)) = (¬p ∨ ¬q) := by
|
||||
by_cases p <;> by_cases q <;> simp [*]
|
||||
attribute [grind_norm] and_true true_and and_false false_and and_assoc
|
||||
|
||||
theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
|
||||
-- Or
|
||||
attribute [grind_norm↓] not_or
|
||||
attribute [grind_norm] or_true true_or or_false false_or or_assoc
|
||||
|
||||
-- ite
|
||||
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 [*]
|
||||
|
||||
theorem ite_true_false {_ : Decidable p} : (ite p True False) = 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
|
||||
|
||||
theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
|
||||
by_cases p <;> simp
|
||||
-- Exists
|
||||
@[grind_norm↓] theorem not_exists (p : α → Prop) : (¬∃ x, p x) = ∀ x, ¬p x := by simp
|
||||
attribute [grind_norm] exists_const exists_or
|
||||
|
||||
theorem not_forall (p : α → Prop) : (¬∀ x, p x) = ∃ x, ¬p x := by simp
|
||||
|
||||
theorem not_exists (p : α → Prop) : (¬∃ x, p x) = ∀ x, ¬p x := by simp
|
||||
|
||||
theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
|
||||
-- Bool cond
|
||||
@[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
|
||||
cases c <;> simp [*]
|
||||
|
||||
theorem Nat.lt_eq (a b : Nat) : (a < b) = (a + 1 ≤ b) := by
|
||||
-- Bool or
|
||||
attribute [grind_norm]
|
||||
Bool.or_false Bool.or_true Bool.false_or Bool.true_or Bool.or_eq_true Bool.or_assoc
|
||||
|
||||
-- Bool and
|
||||
attribute [grind_norm]
|
||||
Bool.and_false Bool.and_true Bool.false_and Bool.true_and Bool.and_eq_true Bool.and_assoc
|
||||
|
||||
-- Bool not
|
||||
attribute [grind_norm]
|
||||
Bool.not_not
|
||||
|
||||
-- beq
|
||||
attribute [grind_norm] beq_iff_eq
|
||||
|
||||
-- bne
|
||||
attribute [grind_norm] bne_iff_ne
|
||||
|
||||
-- Bool not eq true/false
|
||||
attribute [grind_norm] Bool.not_eq_true Bool.not_eq_false
|
||||
|
||||
-- decide
|
||||
attribute [grind_norm] decide_eq_true_eq decide_not not_decide_eq_true
|
||||
|
||||
-- Nat LE
|
||||
attribute [grind_norm] Nat.le_zero_eq
|
||||
|
||||
-- Nat/Int LT
|
||||
@[grind_norm] theorem Nat.lt_eq (a b : Nat) : (a < b) = (a + 1 ≤ b) := by
|
||||
simp [Nat.lt, LT.lt]
|
||||
|
||||
theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 ≤ b) := by
|
||||
@[grind_norm] theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 ≤ b) := by
|
||||
simp [Int.lt, LT.lt]
|
||||
|
||||
theorem ge_eq [LE α] (a b : α) : (a ≥ b) = (b ≤ a) := rfl
|
||||
theorem gt_eq [LT α] (a b : α) : (a > b) = (b < a) := rfl
|
||||
|
||||
init_grind_norm
|
||||
/- Pre theorems -/
|
||||
not_and not_or not_ite not_forall not_exists
|
||||
|
|
||||
/- Post theorems -/
|
||||
Classical.not_not
|
||||
ne_eq iff_eq eq_self heq_eq_eq
|
||||
-- Prop equality
|
||||
eq_true_eq eq_false_eq not_eq_prop
|
||||
-- True
|
||||
not_true
|
||||
-- False
|
||||
not_false_eq_true
|
||||
-- Implication
|
||||
true_imp_eq false_imp_eq imp_true_eq imp_false_eq imp_self_eq
|
||||
-- And
|
||||
and_true true_and and_false false_and and_assoc
|
||||
-- Or
|
||||
or_true true_or or_false false_or or_assoc
|
||||
-- ite
|
||||
ite_true ite_false ite_true_false ite_false_true
|
||||
-- Forall
|
||||
forall_and
|
||||
-- Exists
|
||||
exists_const exists_or exists_prop exists_and_left exists_and_right
|
||||
-- Bool cond
|
||||
cond_eq_ite
|
||||
-- Bool or
|
||||
Bool.or_false Bool.or_true Bool.false_or Bool.true_or Bool.or_eq_true Bool.or_assoc
|
||||
-- Bool and
|
||||
Bool.and_false Bool.and_true Bool.false_and Bool.true_and Bool.and_eq_true Bool.and_assoc
|
||||
-- Bool not
|
||||
Bool.not_not
|
||||
-- beq
|
||||
beq_iff_eq
|
||||
-- bne
|
||||
bne_iff_ne
|
||||
-- Bool not eq true/false
|
||||
Bool.not_eq_true Bool.not_eq_false
|
||||
-- decide
|
||||
decide_eq_true_eq decide_not not_decide_eq_true
|
||||
-- Nat LE
|
||||
Nat.le_zero_eq
|
||||
-- Nat/Int LT
|
||||
Nat.lt_eq
|
||||
-- Nat.succ
|
||||
Nat.succ_eq_add_one
|
||||
-- Int
|
||||
Int.lt_eq
|
||||
-- GT GE
|
||||
ge_eq gt_eq
|
||||
-- GT GE
|
||||
attribute [grind_norm] GT.gt GE.ge
|
||||
|
||||
end Lean.Grind
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -6,70 +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 grindThmMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd
|
||||
|
||||
syntax (name := grind) "grind" (grindThmMod)? : 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
|
||||
/-- If `ext` is `true`, `grind` uses extensionality theorems available in the environment. -/
|
||||
ext : Bool := true
|
||||
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.
|
||||
-/
|
||||
|
||||
syntax grindErase := "-" ident
|
||||
syntax grindLemma := (Attr.grindThmMod)? ident
|
||||
syntax grindParam := grindErase <|> grindLemma
|
||||
|
||||
syntax (name := grind)
|
||||
"grind" optConfig (&" only")?
|
||||
(" [" withoutPosition(grindParam,*) "]")?
|
||||
("on_failure " term)? : tactic
|
||||
|
||||
end Lean.Parser.Tactic
|
||||
end Lean.Grind
|
||||
|
||||
@@ -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
|
||||
@@ -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`)
|
||||
-/
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -150,9 +150,6 @@ It can also be written as `()`.
|
||||
/-- Marker for information that has been erased by the code generator. -/
|
||||
unsafe axiom lcErased : Type
|
||||
|
||||
/-- Marker for type dependency that has been erased by the code generator. -/
|
||||
unsafe axiom lcAny : Type
|
||||
|
||||
/--
|
||||
Auxiliary unsafe constant used by the Compiler when erasing proofs from code.
|
||||
|
||||
@@ -4173,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
|
||||
|
||||
@@ -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,
|
||||
@@ -1648,6 +1648,17 @@ If there are several with the same priority, it is uses the "most recent one". E
|
||||
-/
|
||||
syntax (name := simp) "simp" (Tactic.simpPre <|> Tactic.simpPost)? patternIgnore("← " <|> "<- ")? (ppSpace prio)? : attr
|
||||
|
||||
/--
|
||||
Theorems tagged with the `grind_norm` attribute are used by the `grind` tactic normalizer/pre-processor.
|
||||
-/
|
||||
syntax (name := grind_norm) "grind_norm" (Tactic.simpPre <|> Tactic.simpPost)? (ppSpace prio)? : attr
|
||||
|
||||
/--
|
||||
Simplification procedures tagged with the `grind_norm_proc` attribute are used by the `grind` tactic normalizer/pre-processor.
|
||||
-/
|
||||
syntax (name := grind_norm_proc) "grind_norm_proc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
|
||||
|
||||
|
||||
/-- The possible `norm_cast` kinds: `elim`, `move`, or `squash`. -/
|
||||
syntax normCastLabel := &"elim" <|> &"move" <|> &"squash"
|
||||
|
||||
|
||||
@@ -14,54 +14,26 @@ register_builtin_option debug.skipKernelTC : Bool := {
|
||||
descr := "skip kernel type checker. WARNING: setting this option to true may compromise soundness because your proofs will not be checked by the Lean kernel"
|
||||
}
|
||||
|
||||
/-- Adds given declaration to the environment, respecting `debug.skipKernelTC`. -/
|
||||
def Kernel.Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except Exception Environment :=
|
||||
def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment :=
|
||||
if debug.skipKernelTC.get opts then
|
||||
addDeclWithoutChecking env decl
|
||||
else
|
||||
addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
|
||||
|
||||
private def Environment.addDeclAux (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
|
||||
env.addDeclCore (Core.getMaxHeartbeats opts).toUSize decl cancelTk? (!debug.skipKernelTC.get opts)
|
||||
|
||||
@[deprecated "use `Lean.addDecl` instead to ensure new namespaces are registered" (since := "2024-12-03")]
|
||||
def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
|
||||
(cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
|
||||
Environment.addDeclAux env opts decl cancelTk?
|
||||
|
||||
private def isNamespaceName : Name → Bool
|
||||
| .str .anonymous _ => true
|
||||
| .str p _ => isNamespaceName p
|
||||
| _ => false
|
||||
|
||||
private def registerNamePrefixes (env : Environment) (name : Name) : Environment :=
|
||||
match name with
|
||||
| .str _ s =>
|
||||
if s.get 0 == '_' then
|
||||
-- Do not register namespaces that only contain internal declarations.
|
||||
env
|
||||
else
|
||||
go env name
|
||||
| _ => env
|
||||
where go env
|
||||
| .str p _ => if isNamespaceName p then go (env.registerNamespace p) p else env
|
||||
| _ => env
|
||||
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
|
||||
let mut env ← withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
|
||||
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
|
||||
if !(← MonadLog.hasErrors) && decl.hasSorry then
|
||||
logWarning "declaration uses 'sorry'"
|
||||
(← getEnv).addDeclAux (← getOptions) decl (← read).cancelTk? |> ofExceptKernelException
|
||||
|
||||
-- register namespaces for newly added constants; this used to be done by the kernel itself
|
||||
-- but that is incompatible with moving it to a separate task
|
||||
env := decl.getNames.foldl registerNamePrefixes env
|
||||
if let .inductDecl _ _ types _ := decl then
|
||||
env := types.foldl (registerNamePrefixes · <| ·.name ++ `rec) env
|
||||
setEnv env
|
||||
match (← getEnv).addDecl (← getOptions) decl (← read).cancelTk? with
|
||||
| .ok env => setEnv env
|
||||
| .error ex => throwKernelException ex
|
||||
|
||||
def addAndCompile (decl : Declaration) : CoreM Unit := do
|
||||
addDecl decl
|
||||
|
||||
@@ -144,7 +144,11 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
|
||||
let type := mkApp (mkConst `IO) (mkConst `Unit)
|
||||
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
|
||||
safety := DefinitionSafety.safe }
|
||||
addAndCompile decl
|
||||
IO.ofExcept (setBuiltinInitAttr (← getEnv) name) >>= setEnv
|
||||
match (← getEnv).addAndCompile {} decl with
|
||||
-- TODO: pretty print error
|
||||
| Except.error e => do
|
||||
let msg ← (e.toMessageData {}).toString
|
||||
throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
|
||||
| Except.ok env => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -74,6 +74,8 @@ partial def toMonoType (type : Expr) : CoreM Expr := do
|
||||
let type := type.headBeta
|
||||
if type.isErased then
|
||||
return erasedExpr
|
||||
else if type.isErased then
|
||||
return erasedExpr
|
||||
else if isTypeFormerType type then
|
||||
return erasedExpr
|
||||
else match type with
|
||||
|
||||
@@ -150,7 +150,18 @@ where
|
||||
|
||||
def toMono : Pass where
|
||||
name := `toMono
|
||||
run := (·.mapM (·.toMono))
|
||||
run := fun decls => do
|
||||
let decls ← decls.filterM fun decl => do
|
||||
if hasLocalInst decl.type then
|
||||
/-
|
||||
Declaration is a "template" for the code specialization pass.
|
||||
So, we should delete it before going to next phase.
|
||||
-/
|
||||
decl.erase
|
||||
return false
|
||||
else
|
||||
return true
|
||||
decls.mapM (·.toMono)
|
||||
phase := .base
|
||||
phaseOut := .mono
|
||||
|
||||
|
||||
@@ -53,3 +53,18 @@ def isUnsafeRecName? : Name → Option Name
|
||||
| _ => none
|
||||
|
||||
end Compiler
|
||||
|
||||
namespace Environment
|
||||
|
||||
/--
|
||||
Compile the given block of mutual declarations.
|
||||
Assumes the declarations have already been added to the environment using `addDecl`.
|
||||
-/
|
||||
@[extern "lean_compile_decls"]
|
||||
opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
|
||||
|
||||
/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
|
||||
def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
|
||||
compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
|
||||
|
||||
end Environment
|
||||
|
||||
@@ -514,19 +514,16 @@ 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 Kernel.Exception 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 (.other msg) =>
|
||||
| Except.error (KernelException.other msg) =>
|
||||
checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
|
||||
throwError msg
|
||||
| Except.error ex =>
|
||||
@@ -536,9 +533,9 @@ 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 (.other msg) =>
|
||||
| Except.error (KernelException.other msg) =>
|
||||
throwError msg
|
||||
| Except.error ex =>
|
||||
throwKernelException ex
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ++ "\""
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.String
|
||||
import Init.Data.Array
|
||||
import Lean.Data.Lsp.Basic
|
||||
import Lean.Data.Position
|
||||
import Lean.DeclarationRange
|
||||
|
||||
@@ -54,10 +54,6 @@ instance : EmptyCollection (NameTrie β) where
|
||||
def NameTrie.find? (t : NameTrie β) (k : Name) : Option β :=
|
||||
PrefixTree.find? t (toKey k)
|
||||
|
||||
@[inline, inherit_doc PrefixTree.findLongestPrefix?]
|
||||
def NameTrie.findLongestPrefix? (t : NameTrie β) (k : Name) : Option β :=
|
||||
PrefixTree.findLongestPrefix? t (toKey k)
|
||||
|
||||
@[inline]
|
||||
def NameTrie.foldMatchingM [Monad m] (t : NameTrie β) (k : Name) (init : σ) (f : β → σ → m σ) : m σ :=
|
||||
PrefixTree.foldMatchingM t (toKey k) init f
|
||||
|
||||
@@ -49,8 +49,3 @@ variable {_ : BEq α} {_ : Hashable α}
|
||||
|
||||
@[inline] def fold {β : Type v} (f : β → α → β) (init : β) (s : PersistentHashSet α) : β :=
|
||||
Id.run $ s.foldM f init
|
||||
|
||||
def toList (s : PersistentHashSet α) : List α :=
|
||||
s.set.toList.map (·.1)
|
||||
|
||||
end PersistentHashSet
|
||||
|
||||
@@ -48,17 +48,6 @@ partial def find? (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k :
|
||||
| some t => loop t ks
|
||||
loop t k
|
||||
|
||||
/-- Returns the the value of the longest key in `t` that is a prefix of `k`, if any. -/
|
||||
@[specialize]
|
||||
partial def findLongestPrefix? (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) : Option β :=
|
||||
let rec loop acc?
|
||||
| PrefixTreeNode.Node val _, [] => val <|> acc?
|
||||
| PrefixTreeNode.Node val m, k :: ks =>
|
||||
match RBNode.find cmp m k with
|
||||
| none => val
|
||||
| some t => loop (val <|> acc?) t ks
|
||||
loop none t k
|
||||
|
||||
@[specialize]
|
||||
partial def foldMatchingM [Monad m] (t : PrefixTreeNode α β) (cmp : α → α → Ordering) (k : List α) (init : σ) (f : β → σ → m σ) : m σ :=
|
||||
let rec fold : PrefixTreeNode α β → σ → m σ
|
||||
@@ -103,10 +92,6 @@ def PrefixTree.insert (t : PrefixTree α β p) (k : List α) (v : β) : PrefixTr
|
||||
def PrefixTree.find? (t : PrefixTree α β p) (k : List α) : Option β :=
|
||||
t.val.find? p k
|
||||
|
||||
@[inline, inherit_doc PrefixTreeNode.findLongestPrefix?]
|
||||
def PrefixTree.findLongestPrefix? (t : PrefixTree α β p) (k : List α) : Option β :=
|
||||
t.val.findLongestPrefix? p k
|
||||
|
||||
@[inline]
|
||||
def PrefixTree.foldMatchingM [Monad m] (t : PrefixTree α β p) (k : List α) (init : σ) (f : β → σ → m σ) : m σ :=
|
||||
t.val.foldMatchingM p k init f
|
||||
|
||||
@@ -193,19 +193,6 @@ def Declaration.definitionVal! : Declaration → DefinitionVal
|
||||
| .defnDecl val => val
|
||||
| _ => panic! "Expected a `Declaration.defnDecl`."
|
||||
|
||||
/--
|
||||
Returns all top-level names to be defined by adding this declaration to the environment. This does
|
||||
not include auxiliary definitions such as projections.
|
||||
-/
|
||||
def Declaration.getNames : Declaration → List Name
|
||||
| .axiomDecl val => [val.name]
|
||||
| .defnDecl val => [val.name]
|
||||
| .thmDecl val => [val.name]
|
||||
| .opaqueDecl val => [val.name]
|
||||
| .quotDecl => [``Quot, ``Quot.mk, ``Quot.lift, ``Quot.ind]
|
||||
| .mutualDefnDecl defns => defns.map (·.name)
|
||||
| .inductDecl _ _ types _ => types.map (·.name)
|
||||
|
||||
@[specialize] def Declaration.foldExprM {α} {m : Type → Type} [Monad m] (d : Declaration) (f : α → Expr → m α) (a : α) : m α :=
|
||||
match d with
|
||||
| .quotDecl => pure a
|
||||
@@ -482,10 +469,6 @@ def isInductive : ConstantInfo → Bool
|
||||
| .inductInfo _ => true
|
||||
| _ => false
|
||||
|
||||
def isDefinition : ConstantInfo → Bool
|
||||
| .defnInfo _ => true
|
||||
| _ => false
|
||||
|
||||
def isTheorem : ConstantInfo → Bool
|
||||
| .thmInfo _ => true
|
||||
| _ => false
|
||||
|
||||
@@ -1474,7 +1474,7 @@ where
|
||||
| field::fields, false => .fieldName field field.getId.getString! none fIdent :: toLVals fields false
|
||||
|
||||
/-- Resolve `(.$id:ident)` using the expected type to infer namespace. -/
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
|
||||
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Name := do
|
||||
tryPostponeIfNoneOrMVar expectedType?
|
||||
let some expectedType := expectedType?
|
||||
| throwError "invalid dotted identifier notation, expected type must be known"
|
||||
@@ -1489,7 +1489,7 @@ where
|
||||
withForallBody body k
|
||||
else
|
||||
k body
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
|
||||
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Name := do
|
||||
let resultType ← instantiateMVars resultType
|
||||
let resultTypeFn := resultType.cleanupAnnotations.getAppFn
|
||||
try
|
||||
@@ -1497,12 +1497,9 @@ where
|
||||
let .const declName .. := resultTypeFn.cleanupAnnotations
|
||||
| throwError "invalid dotted identifier notation, expected type is not of the form (... → C ...) where C is a constant{indentExpr expectedType}"
|
||||
let idNew := declName ++ id.getId.eraseMacroScopes
|
||||
if (← getEnv).contains idNew then
|
||||
mkConst idNew
|
||||
else if let some (fvar, []) ← resolveLocalName idNew then
|
||||
return fvar
|
||||
else
|
||||
unless (← getEnv).contains idNew do
|
||||
throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
|
||||
return idNew
|
||||
catch
|
||||
| ex@(.error ..) =>
|
||||
match (← unfoldDefinition? resultType) with
|
||||
@@ -1551,7 +1548,7 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
|
||||
| `(_) => throwError "placeholders '_' cannot be used where a function is expected"
|
||||
| `(.$id:ident) =>
|
||||
addCompletionInfo <| CompletionInfo.dotId f id.getId (← getLCtx) expectedType?
|
||||
let fConst ← resolveDotName id expectedType?
|
||||
let fConst ← mkConst (← resolveDotName id expectedType?)
|
||||
let s ← observing do
|
||||
-- Use (force := true) because we want to record the result of .ident resolution even in patterns
|
||||
let fConst ← addTermInfo f fConst expectedType? (force := true)
|
||||
|
||||
@@ -124,7 +124,9 @@ private partial def elabChoiceAux (cmds : Array Syntax) (i : Nat) : CommandElabM
|
||||
n[1].forArgsM addUnivLevel
|
||||
|
||||
@[builtin_command_elab «init_quot»] def elabInitQuot : CommandElab := fun _ => do
|
||||
liftCoreM <| addDecl Declaration.quotDecl
|
||||
match (← getEnv).addDecl (← getOptions) Declaration.quotDecl with
|
||||
| Except.ok env => setEnv env
|
||||
| Except.error ex => throwError (ex.toMessageData (← getOptions))
|
||||
|
||||
@[builtin_command_elab «export»] def elabExport : CommandElab := fun stx => do
|
||||
let `(export $ns ($ids*)) := stx | throwUnsupportedSyntax
|
||||
@@ -292,7 +294,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
|
||||
modify fun s => { s with messages := {} };
|
||||
pure messages
|
||||
let restoreMessages (prevMessages : MessageLog) : CommandElabM Unit := do
|
||||
modify fun s => { s with messages := prevMessages ++ s.messages.errorsToInfos }
|
||||
modify fun s => { s with messages := prevMessages ++ s.messages.errorsToWarnings }
|
||||
let prevMessages ← resetMessages
|
||||
let succeeded ← try
|
||||
x
|
||||
|
||||
@@ -131,18 +131,14 @@ def throwCalcFailure (steps : Array CalcStepView) (expectedType result : Expr) :
|
||||
if ← isDefEqGuarded r er then
|
||||
let mut failed := false
|
||||
unless ← isDefEqGuarded lhs elhs do
|
||||
let (lhs, elhs) ← addPPExplicitToExposeDiff lhs elhs
|
||||
let (lhsTy, elhsTy) ← addPPExplicitToExposeDiff (← inferType lhs) (← inferType elhs)
|
||||
logErrorAt steps[0]!.term m!"\
|
||||
invalid 'calc' step, left-hand side is{indentD m!"{lhs} : {lhsTy}"}\n\
|
||||
but is expected to be{indentD m!"{elhs} : {elhsTy}"}"
|
||||
invalid 'calc' step, left-hand side is{indentD m!"{lhs} : {← inferType lhs}"}\n\
|
||||
but is expected to be{indentD m!"{elhs} : {← inferType elhs}"}"
|
||||
failed := true
|
||||
unless ← isDefEqGuarded rhs erhs do
|
||||
let (rhs, erhs) ← addPPExplicitToExposeDiff rhs erhs
|
||||
let (rhsTy, erhsTy) ← addPPExplicitToExposeDiff (← inferType rhs) (← inferType erhs)
|
||||
logErrorAt steps.back!.term m!"\
|
||||
invalid 'calc' step, right-hand side is{indentD m!"{rhs} : {rhsTy}"}\n\
|
||||
but is expected to be{indentD m!"{erhs} : {erhsTy}"}"
|
||||
invalid 'calc' step, right-hand side is{indentD m!"{rhs} : {← inferType rhs}"}\n\
|
||||
but is expected to be{indentD m!"{erhs} : {← inferType erhs}"}"
|
||||
failed := true
|
||||
if failed then
|
||||
throwAbortTerm
|
||||
|
||||
@@ -38,7 +38,6 @@ def elabCheckTactic : CommandElab := fun stx => do
|
||||
| [next] => do
|
||||
let (val, _, _) ← matchCheckGoalType stx (←next.getType)
|
||||
if !(← Meta.withReducible <| isDefEq val expTerm) then
|
||||
let (val, expTerm) ← addPPExplicitToExposeDiff val expTerm
|
||||
throwErrorAt stx
|
||||
m!"Term reduces to{indentExpr val}\nbut is expected to reduce to {indentExpr expTerm}"
|
||||
| _ => do
|
||||
|
||||
@@ -16,4 +16,3 @@ import Lean.Elab.Deriving.FromToJson
|
||||
import Lean.Elab.Deriving.SizeOf
|
||||
import Lean.Elab.Deriving.Hashable
|
||||
import Lean.Elab.Deriving.Ord
|
||||
import Lean.Elab.Deriving.ToExpr
|
||||
|
||||
@@ -1,237 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kyle Miller
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Transform
|
||||
import Lean.Elab.Deriving.Basic
|
||||
import Lean.Elab.Deriving.Util
|
||||
import Lean.ToLevel
|
||||
import Lean.ToExpr
|
||||
|
||||
/-!
|
||||
# `ToExpr` deriving handler
|
||||
|
||||
This module defines a `ToExpr` deriving handler for inductive types.
|
||||
It supports mutually inductive types as well.
|
||||
|
||||
The `ToExpr` deriving handlers support universe level polymorphism, via the `Lean.ToLevel` class.
|
||||
To use `ToExpr` in places where there is universe polymorphism, make sure a `[ToLevel.{u}]` instance is available,
|
||||
though be aware that the `ToLevel` mechanism does not support `max` or `imax` expressions.
|
||||
|
||||
Implementation note: this deriving handler was initially modeled after the `Repr` deriving handler, but
|
||||
1. we need to account for universe levels,
|
||||
2. the `ToExpr` class has two fields rather than one, and
|
||||
3. we don't handle structures specially.
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.Deriving.ToExpr
|
||||
|
||||
open Lean Elab Parser.Term
|
||||
open Meta Command Deriving
|
||||
|
||||
/--
|
||||
Given `args := #[e₁, e₂, …, eₙ]`, constructs the syntax `Expr.app (… (Expr.app (Expr.app f e₁) e₂) …) eₙ`.
|
||||
-/
|
||||
def mkAppNTerm (f : Term) (args : Array Term) : MetaM Term :=
|
||||
args.foldlM (fun a b => ``(Expr.app $a $b)) f
|
||||
|
||||
/-- Fixes the output of `mkInductiveApp` to explicitly reference universe levels. -/
|
||||
def updateIndType (indVal : InductiveVal) (t : Term) : TermElabM Term :=
|
||||
let levels := indVal.levelParams.toArray.map mkIdent
|
||||
match t with
|
||||
| `(@$f $args*) => `(@$f.{$levels,*} $args*)
|
||||
| _ => throwError "(internal error) expecting output of `mkInductiveApp`"
|
||||
|
||||
/--
|
||||
Creates a term that evaluates to an expression representing the inductive type.
|
||||
Uses `toExpr` and `toTypeExpr` for the arguments to the type constructor.
|
||||
-/
|
||||
def mkToTypeExpr (indVal : InductiveVal) (argNames : Array Name) : TermElabM Term := do
|
||||
let levels ← indVal.levelParams.toArray.mapM (fun u => `(Lean.toLevel.{$(mkIdent u)}))
|
||||
forallTelescopeReducing indVal.type fun xs _ => do
|
||||
let mut args : Array Term := #[]
|
||||
for argName in argNames, x in xs do
|
||||
let a := mkIdent argName
|
||||
if ← Meta.isType x then
|
||||
args := args.push <| ← ``(toTypeExpr $a)
|
||||
else
|
||||
args := args.push <| ← ``(toExpr $a)
|
||||
mkAppNTerm (← ``(Expr.const $(quote indVal.name) [$levels,*])) args
|
||||
|
||||
/--
|
||||
Creates the body of the `toExpr` function for the `ToExpr` instance, which is a `match` expression
|
||||
that calls `toExpr` and `toTypeExpr` to assemble an expression for a given term.
|
||||
For recursive inductive types, `auxFunName` refers to the `ToExpr` instance for the current type.
|
||||
For mutually recursive types, we rely on the local instances set up by `mkLocalInstanceLetDecls`.
|
||||
-/
|
||||
def mkToExprBody (header : Header) (indVal : InductiveVal) (auxFunName : Name) (levelInsts : Array Term) :
|
||||
TermElabM Term := do
|
||||
let discrs ← mkDiscrs header indVal
|
||||
let alts ← mkAlts
|
||||
`(match $[$discrs],* with $alts:matchAlt*)
|
||||
where
|
||||
/-- Create the `match` cases, one per constructor. -/
|
||||
mkAlts : TermElabM (Array (TSyntax ``matchAlt)) := do
|
||||
let levels ← levelInsts.mapM fun inst => `($(inst).toLevel)
|
||||
let mut alts := #[]
|
||||
for ctorName in indVal.ctors do
|
||||
let ctorInfo ← getConstInfoCtor ctorName
|
||||
let alt ← forallTelescopeReducing ctorInfo.type fun xs _ => do
|
||||
let mut patterns := #[]
|
||||
-- add `_` pattern for indices, before the constructor's pattern
|
||||
for _ in [:indVal.numIndices] do
|
||||
patterns := patterns.push (← `(_))
|
||||
let mut ctorArgs := #[]
|
||||
let mut rhsArgs : Array Term := #[]
|
||||
let mkArg (x : Expr) (a : Term) : TermElabM Term := do
|
||||
if (← inferType x).isAppOf indVal.name then
|
||||
`($(mkIdent auxFunName) $levelInsts* $a)
|
||||
else if ← Meta.isType x then
|
||||
``(toTypeExpr $a)
|
||||
else
|
||||
``(toExpr $a)
|
||||
-- add `_` pattern for inductive parameters, which are inaccessible
|
||||
for i in [:ctorInfo.numParams] do
|
||||
let a := mkIdent header.argNames[i]!
|
||||
ctorArgs := ctorArgs.push (← `(_))
|
||||
rhsArgs := rhsArgs.push <| ← mkArg xs[i]! a
|
||||
for i in [:ctorInfo.numFields] do
|
||||
let a := mkIdent (← mkFreshUserName `a)
|
||||
ctorArgs := ctorArgs.push a
|
||||
rhsArgs := rhsArgs.push <| ← mkArg xs[ctorInfo.numParams + i]! a
|
||||
patterns := patterns.push (← `(@$(mkIdent ctorName):ident $ctorArgs:term*))
|
||||
let rhs : Term ← mkAppNTerm (← ``(Expr.const $(quote ctorInfo.name) [$levels,*])) rhsArgs
|
||||
`(matchAltExpr| | $[$patterns:term],* => $rhs)
|
||||
alts := alts.push alt
|
||||
return alts
|
||||
|
||||
/--
|
||||
For nested and mutually recursive inductive types, we define `partial` instances,
|
||||
and the strategy is to have local `ToExpr` instances in scope for the body of each instance.
|
||||
This way, each instance can freely use `toExpr` and `toTypeExpr` for each of the types in `ctx`.
|
||||
|
||||
This is a modified copy of `Lean.Elab.Deriving.mkLocalInstanceLetDecls`,
|
||||
since we need to include the `toTypeExpr` field in the `letDecl`
|
||||
Note that, for simplicity, each instance gets its own definition of each others' `toTypeExpr` fields.
|
||||
These are very simple fields, so avoiding the duplication is not worth it.
|
||||
-/
|
||||
def mkLocalInstanceLetDecls (ctx : Deriving.Context) (argNames : Array Name) (levelInsts : Array Term) :
|
||||
TermElabM (Array (TSyntax ``Parser.Term.letDecl)) := do
|
||||
let mut letDecls := #[]
|
||||
for indVal in ctx.typeInfos, auxFunName in ctx.auxFunNames do
|
||||
let currArgNames ← mkInductArgNames indVal
|
||||
let numParams := indVal.numParams
|
||||
let currIndices := currArgNames[numParams:]
|
||||
let binders ← mkImplicitBinders currIndices
|
||||
let argNamesNew := argNames[:numParams] ++ currIndices
|
||||
let indType ← mkInductiveApp indVal argNamesNew
|
||||
let instName ← mkFreshUserName `localinst
|
||||
let toTypeExpr ← mkToTypeExpr indVal argNames
|
||||
-- Recall that mutually inductive types all use the same universe levels, hence we pass the same ToLevel instances to each aux function.
|
||||
let letDecl ← `(Parser.Term.letDecl| $(mkIdent instName):ident $binders:implicitBinder* : ToExpr $indType :=
|
||||
{ toExpr := $(mkIdent auxFunName) $levelInsts*,
|
||||
toTypeExpr := $toTypeExpr })
|
||||
letDecls := letDecls.push letDecl
|
||||
return letDecls
|
||||
|
||||
open TSyntax.Compat in
|
||||
/--
|
||||
Makes a `toExpr` function for the given inductive type.
|
||||
The implementation of each `toExpr` function for a (mutual) inductive type is given as top-level private definitions.
|
||||
These are assembled into `ToExpr` instances in `mkInstanceCmds`.
|
||||
For mutual/nested inductive types, then each of the types' `ToExpr` instances are provided as local instances,
|
||||
to wire together the recursion (necessitating these auxiliary definitions being `partial`).
|
||||
-/
|
||||
def mkAuxFunction (ctx : Deriving.Context) (i : Nat) : TermElabM Command := do
|
||||
let auxFunName := ctx.auxFunNames[i]!
|
||||
let indVal := ctx.typeInfos[i]!
|
||||
let header ← mkHeader ``ToExpr 1 indVal
|
||||
/- We make the `ToLevel` instances be explicit here so that we can pass the instances from the instances to the
|
||||
aux functions. This lets us ensure universe level variables are being lined up,
|
||||
without needing to use `ident.{u₁,…,uₙ}` syntax, which could conditionally be incorrect
|
||||
depending on the ambient CommandElabM scope state.
|
||||
TODO(kmill): deriving handlers should run in a scope with no `universes` or `variables`. -/
|
||||
let (toLevelInsts, levelBinders) := Array.unzip <| ← indVal.levelParams.toArray.mapM fun u => do
|
||||
let inst := mkIdent (← mkFreshUserName `inst)
|
||||
return (inst, ← `(explicitBinderF| ($inst : ToLevel.{$(mkIdent u)})))
|
||||
let mut body ← mkToExprBody header indVal auxFunName toLevelInsts
|
||||
if ctx.usePartial then
|
||||
let letDecls ← mkLocalInstanceLetDecls ctx header.argNames toLevelInsts
|
||||
body ← mkLet letDecls body
|
||||
/- We need to alter the last binder (the one for the "target") to have explicit universe levels
|
||||
so that the `ToLevel` instance arguments can use them. -/
|
||||
let addLevels binder :=
|
||||
match binder with
|
||||
| `(bracketedBinderF| ($a : $ty)) => do `(bracketedBinderF| ($a : $(← updateIndType indVal ty)))
|
||||
| _ => throwError "(internal error) expecting inst binder"
|
||||
let binders := header.binders.pop ++ levelBinders ++ #[← addLevels header.binders.back!]
|
||||
if ctx.usePartial then
|
||||
`(private partial def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Expr := $body:term)
|
||||
else
|
||||
`(private def $(mkIdent auxFunName):ident $binders:bracketedBinder* : Expr := $body:term)
|
||||
|
||||
/--
|
||||
Creates all the auxiliary functions (using `mkAuxFunction`) for the (mutual) inductive type(s).
|
||||
Wraps the resulting definition commands in `mutual ... end`.
|
||||
-/
|
||||
def mkAuxFunctions (ctx : Deriving.Context) : TermElabM Syntax := do
|
||||
let mut auxDefs := #[]
|
||||
for i in [:ctx.typeInfos.size] do
|
||||
auxDefs := auxDefs.push (← mkAuxFunction ctx i)
|
||||
`(mutual $auxDefs:command* end)
|
||||
|
||||
open TSyntax.Compat in
|
||||
/--
|
||||
Assuming all of the auxiliary definitions exist,
|
||||
creates all the `instance` commands for the `ToExpr` instances for the (mutual) inductive type(s).
|
||||
This is a modified copy of `Lean.Elab.Deriving.mkInstanceCmds` to account for `ToLevel` instances.
|
||||
-/
|
||||
def mkInstanceCmds (ctx : Deriving.Context) (typeNames : Array Name) :
|
||||
TermElabM (Array Command) := do
|
||||
let mut instances := #[]
|
||||
for indVal in ctx.typeInfos, auxFunName in ctx.auxFunNames do
|
||||
if typeNames.contains indVal.name then
|
||||
let argNames ← mkInductArgNames indVal
|
||||
let binders ← mkImplicitBinders argNames
|
||||
let binders := binders ++ (← mkInstImplicitBinders ``ToExpr indVal argNames)
|
||||
let (toLevelInsts, levelBinders) := Array.unzip <| ← indVal.levelParams.toArray.mapM fun u => do
|
||||
let inst := mkIdent (← mkFreshUserName `inst)
|
||||
return (inst, ← `(instBinderF| [$inst : ToLevel.{$(mkIdent u)}]))
|
||||
let binders := binders ++ levelBinders
|
||||
let indType ← updateIndType indVal (← mkInductiveApp indVal argNames)
|
||||
let toTypeExpr ← mkToTypeExpr indVal argNames
|
||||
let instCmd ← `(instance $binders:implicitBinder* : ToExpr $indType where
|
||||
toExpr := $(mkIdent auxFunName) $toLevelInsts*
|
||||
toTypeExpr := $toTypeExpr)
|
||||
instances := instances.push instCmd
|
||||
return instances
|
||||
|
||||
/--
|
||||
Returns all the commands necessary to construct the `ToExpr` instances.
|
||||
-/
|
||||
def mkToExprInstanceCmds (declNames : Array Name) : TermElabM (Array Syntax) := do
|
||||
let ctx ← mkContext "toExpr" declNames[0]!
|
||||
let cmds := #[← mkAuxFunctions ctx] ++ (← mkInstanceCmds ctx declNames)
|
||||
trace[Elab.Deriving.toExpr] "\n{cmds}"
|
||||
return cmds
|
||||
|
||||
/--
|
||||
The main entry point to the `ToExpr` deriving handler.
|
||||
-/
|
||||
def mkToExprInstanceHandler (declNames : Array Name) : CommandElabM Bool := do
|
||||
if (← declNames.allM isInductive) && declNames.size > 0 then
|
||||
let cmds ← withFreshMacroScope <| liftTermElabM <| mkToExprInstanceCmds declNames
|
||||
-- Enable autoimplicits, used for universe levels.
|
||||
withScope (fun scope => { scope with opts := autoImplicit.set scope.opts true }) do
|
||||
elabCommand (mkNullNode cmds)
|
||||
return true
|
||||
else
|
||||
return false
|
||||
|
||||
builtin_initialize
|
||||
registerDerivingHandler ``Lean.ToExpr mkToExprInstanceHandler
|
||||
registerTraceClass `Elab.Deriving.toExpr
|
||||
|
||||
end Lean.Elab.Deriving.ToExpr
|
||||
@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
|
||||
-/
|
||||
prelude
|
||||
import Lean.Parser.Module
|
||||
import Lean.Util.Paths
|
||||
import Lean.Data.Json
|
||||
|
||||
namespace Lean.Elab
|
||||
|
||||
@@ -42,12 +42,4 @@ def printImports (input : String) (fileName : Option String) : IO Unit := do
|
||||
let fname ← findOLean dep.module
|
||||
IO.println fname
|
||||
|
||||
@[export lean_print_import_srcs]
|
||||
def printImportSrcs (input : String) (fileName : Option String) : IO Unit := do
|
||||
let sp ← initSrcSearchPath
|
||||
let (deps, _, _) ← parseImports input fileName
|
||||
for dep in deps do
|
||||
let fname ← findLean sp dep.module
|
||||
IO.println fname
|
||||
|
||||
end Lean.Elab
|
||||
|
||||
@@ -681,7 +681,7 @@ private partial def checkResultingUniversesForFields (fieldInfos : Array StructF
|
||||
throwErrorAt info.ref msg
|
||||
|
||||
@[extern "lean_mk_projections"]
|
||||
private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except Kernel.Exception Environment
|
||||
private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except KernelException Environment
|
||||
|
||||
private def addProjections (r : ElabHeaderResult) (fieldInfos : Array StructFieldInfo) : TermElabM Unit := do
|
||||
if r.type.isProp then
|
||||
@@ -691,9 +691,6 @@ private def addProjections (r : ElabHeaderResult) (fieldInfos : Array StructFiel
|
||||
let env ← getEnv
|
||||
let env ← ofExceptKernelException (mkProjections env r.view.declName projNames.toList r.view.isClass)
|
||||
setEnv env
|
||||
for fieldInfo in fieldInfos do
|
||||
if fieldInfo.isSubobject then
|
||||
addDeclarationRangesFromSyntax fieldInfo.declName r.view.ref fieldInfo.ref
|
||||
|
||||
private def registerStructure (structName : Name) (infos : Array StructFieldInfo) : TermElabM Unit := do
|
||||
let fields ← infos.filterMapM fun info => do
|
||||
@@ -778,14 +775,14 @@ private def setSourceInstImplicit (type : Expr) : Expr :=
|
||||
/--
|
||||
Creates a projection function to a non-subobject parent.
|
||||
-/
|
||||
private partial def mkCoercionToCopiedParent (levelParams : List Name) (params : Array Expr) (view : StructView) (source : Expr) (parent : StructParentInfo) (parentType : Expr) : MetaM StructureParentInfo := do
|
||||
private partial def mkCoercionToCopiedParent (levelParams : List Name) (params : Array Expr) (view : StructView) (source : Expr) (parentStructName : Name) (parentType : Expr) : MetaM StructureParentInfo := do
|
||||
let isProp ← Meta.isProp parentType
|
||||
let env ← getEnv
|
||||
let structName := view.declName
|
||||
let sourceFieldNames := getStructureFieldsFlattened env structName
|
||||
let binfo := if view.isClass && isClass env parent.structName then BinderInfo.instImplicit else BinderInfo.default
|
||||
let binfo := if view.isClass && isClass env parentStructName then BinderInfo.instImplicit else BinderInfo.default
|
||||
let mut declType ← instantiateMVars (← mkForallFVars params (← mkForallFVars #[source] parentType))
|
||||
if view.isClass && isClass env parent.structName then
|
||||
if view.isClass && isClass env parentStructName then
|
||||
declType := setSourceInstImplicit declType
|
||||
declType := declType.inferImplicit params.size true
|
||||
let rec copyFields (parentType : Expr) : MetaM Expr := do
|
||||
@@ -826,8 +823,7 @@ private partial def mkCoercionToCopiedParent (levelParams : List Name) (params :
|
||||
-- (Instances will get instance reducibility in `Lean.Elab.Command.addParentInstances`.)
|
||||
if !binfo.isInstImplicit && !(← Meta.isProp parentType) then
|
||||
setReducibleAttribute declName
|
||||
addDeclarationRangesFromSyntax declName view.ref parent.ref
|
||||
return { structName := parent.structName, subobject := false, projFn := declName }
|
||||
return { structName := parentStructName, subobject := false, projFn := declName }
|
||||
|
||||
private def mkRemainingProjections (levelParams : List Name) (params : Array Expr) (view : StructView)
|
||||
(parents : Array StructParentInfo) (fieldInfos : Array StructFieldInfo) : TermElabM (Array StructureParentInfo) := do
|
||||
@@ -848,7 +844,7 @@ private def mkRemainingProjections (levelParams : List Name) (params : Array Exp
|
||||
pure { structName := parent.structName, subobject := true, projFn := info.declName }
|
||||
else
|
||||
let parent_type := (← instantiateMVars parent.type).replace fun e => parentFVarToConst[e]?
|
||||
mkCoercionToCopiedParent levelParams params view source parent parent_type)
|
||||
mkCoercionToCopiedParent levelParams params view source parent.structName parent_type)
|
||||
parentInfos := parentInfos.push parentInfo
|
||||
if let some fvar := parent.fvar? then
|
||||
parentFVarToConst := parentFVarToConst.insert fvar <|
|
||||
|
||||
@@ -44,5 +44,3 @@ import Lean.Elab.Tactic.DiscrTreeKey
|
||||
import Lean.Elab.Tactic.BVDecide
|
||||
import Lean.Elab.Tactic.BoolToPropSimps
|
||||
import Lean.Elab.Tactic.Classical
|
||||
import Lean.Elab.Tactic.Grind
|
||||
import Lean.Elab.Tactic.Monotonicity
|
||||
|
||||
@@ -38,9 +38,6 @@ declare_config_elab elabBVDecideConfig Lean.Elab.Tactic.BVDecide.Frontend.BVDeci
|
||||
builtin_initialize bvNormalizeExt : Meta.SimpExtension ←
|
||||
Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"
|
||||
|
||||
builtin_initialize intToBitVecExt : Meta.SimpExtension ←
|
||||
Meta.registerSimpAttr `int_toBitVec "simp theorems used to convert UIntX/IntX statements into BitVec ones"
|
||||
|
||||
/-- Builtin `bv_normalize` simprocs. -/
|
||||
builtin_initialize builtinBVNormalizeSimprocsRef : IO.Ref Meta.Simp.Simprocs ← IO.mkRef {}
|
||||
|
||||
|
||||
@@ -82,7 +82,7 @@ instance : ToExpr Gate where
|
||||
| .and => mkConst ``Gate.and
|
||||
| .xor => mkConst ``Gate.xor
|
||||
| .beq => mkConst ``Gate.beq
|
||||
| .or => mkConst ``Gate.or
|
||||
| .imp => mkConst ``Gate.imp
|
||||
toTypeExpr := mkConst ``Gate
|
||||
|
||||
instance : ToExpr BVPred where
|
||||
|
||||
@@ -91,7 +91,7 @@ where
|
||||
| .and => ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
|
||||
| .xor => ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
|
||||
| .beq => ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
|
||||
| .or => ``Std.Tactic.BVDecide.Reflect.Bool.or_congr
|
||||
| .imp => ``Std.Tactic.BVDecide.Reflect.Bool.imp_congr
|
||||
|
||||
/--
|
||||
Construct the reified version of `Bool.not subExpr`.
|
||||
@@ -136,7 +136,7 @@ def mkIte (discr lhs rhs : ReifiedBVLogical) (discrExpr lhsExpr rhsExpr : Expr)
|
||||
lhsEvalExpr lhsProof?
|
||||
rhsEvalExpr rhsProof? | return none
|
||||
return mkApp9
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.Bool.cond_congr)
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.Bool.ite_congr)
|
||||
discrExpr lhsExpr rhsExpr
|
||||
discrEvalExpr lhsEvalExpr rhsEvalExpr
|
||||
discrProof lhsProof rhsProof
|
||||
|
||||
@@ -22,70 +22,67 @@ This function adds the two lemmas:
|
||||
- `discrExpr = false → atomExpr = rhsExpr`
|
||||
It assumes that `discrExpr`, `lhsExpr` and `rhsExpr` are the expressions corresponding to `discr`,
|
||||
`lhs` and `rhs`. Furthermore it assumes that `atomExpr` is of the form
|
||||
`bif discrExpr then lhsExpr else rhsExpr`.
|
||||
`if discrExpr = true then lhsExpr else rhsExpr`.
|
||||
-/
|
||||
def addCondLemmas (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
|
||||
def addIfLemmas (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
|
||||
(discrExpr atomExpr lhsExpr rhsExpr : Expr) : LemmaM Unit := do
|
||||
let some trueLemma ← mkCondTrueLemma discr atom lhs discrExpr atomExpr lhsExpr rhsExpr | return ()
|
||||
let some trueLemma ← mkIfTrueLemma discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
|
||||
LemmaM.addLemma trueLemma
|
||||
let some falseLemma ← mkCondFalseLemma discr atom rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
|
||||
let some falseLemma ← mkIfFalseLemma discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr | return ()
|
||||
LemmaM.addLemma falseLemma
|
||||
where
|
||||
mkCondTrueLemma (discr : ReifiedBVLogical) (atom lhs : ReifiedBVExpr)
|
||||
mkIfTrueLemma (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
|
||||
(discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) :=
|
||||
mkIfLemma true discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr
|
||||
|
||||
mkIfFalseLemma (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
|
||||
(discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) :=
|
||||
mkIfLemma false discr atom lhs rhs discrExpr atomExpr lhsExpr rhsExpr
|
||||
|
||||
mkIfLemma (discrVal : Bool) (discr : ReifiedBVLogical) (atom lhs rhs : ReifiedBVExpr)
|
||||
(discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) := do
|
||||
let resExpr := lhsExpr
|
||||
let resValExpr := lhs
|
||||
let lemmaName := ``Std.Tactic.BVDecide.Reflect.BitVec.cond_true
|
||||
let resExpr := if discrVal then lhsExpr else rhsExpr
|
||||
let resValExpr := if discrVal then lhs else rhs
|
||||
let lemmaName :=
|
||||
if discrVal then
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.if_true
|
||||
else
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.if_false
|
||||
let discrValExpr := toExpr discrVal
|
||||
let discrVal ← ReifiedBVLogical.mkBoolConst discrVal
|
||||
|
||||
|
||||
let notDiscrExpr := mkApp (mkConst ``Bool.not) discrExpr
|
||||
let notDiscr ← ReifiedBVLogical.mkNot discr discrExpr
|
||||
let eqDiscrExpr ← mkAppM ``BEq.beq #[discrExpr, discrValExpr]
|
||||
let eqDiscr ← ReifiedBVLogical.mkGate discr discrVal discrExpr discrValExpr .beq
|
||||
|
||||
let eqBVExpr ← mkAppM ``BEq.beq #[atomExpr, resExpr]
|
||||
let some eqBVPred ← ReifiedBVPred.mkBinPred atom resValExpr atomExpr resExpr .eq | return none
|
||||
let eqBV ← ReifiedBVLogical.ofPred eqBVPred
|
||||
|
||||
let imp ← ReifiedBVLogical.mkGate notDiscr eqBV notDiscrExpr eqBVExpr .or
|
||||
let imp ← ReifiedBVLogical.mkGate eqDiscr eqBV eqDiscrExpr eqBVExpr .imp
|
||||
|
||||
let proof := do
|
||||
let evalExpr ← ReifiedBVLogical.mkEvalExpr imp.expr
|
||||
let congrProof := (← imp.evalsAtAtoms).getD (ReifiedBVLogical.mkRefl evalExpr)
|
||||
let lemmaProof := mkApp4 (mkConst lemmaName) (toExpr lhs.width) discrExpr lhsExpr rhsExpr
|
||||
|
||||
-- !discr || (atom == rhs)
|
||||
let impExpr := mkApp2 (mkConst ``Bool.or) notDiscrExpr eqBVExpr
|
||||
let trueExpr := mkConst ``Bool.true
|
||||
let eqDiscrTrueExpr ← mkEq eqDiscrExpr trueExpr
|
||||
let eqBVExprTrueExpr ← mkEq eqBVExpr trueExpr
|
||||
let impExpr ← mkArrow eqDiscrTrueExpr eqBVExprTrueExpr
|
||||
-- construct a `Decidable` instance for the implication using forall_prop_decidable
|
||||
let decEqDiscrTrue := mkApp2 (mkConst ``instDecidableEqBool) eqDiscrExpr trueExpr
|
||||
let decEqBVExprTrue := mkApp2 (mkConst ``instDecidableEqBool) eqBVExpr trueExpr
|
||||
let impDecidable := mkApp4 (mkConst ``forall_prop_decidable)
|
||||
eqDiscrTrueExpr
|
||||
(.lam .anonymous eqDiscrTrueExpr eqBVExprTrueExpr .default)
|
||||
decEqDiscrTrue
|
||||
(.lam .anonymous eqDiscrTrueExpr decEqBVExprTrue .default)
|
||||
|
||||
let decideImpExpr := mkApp2 (mkConst ``Decidable.decide) impExpr impDecidable
|
||||
|
||||
return mkApp4
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.Bool.lemma_congr)
|
||||
impExpr
|
||||
evalExpr
|
||||
congrProof
|
||||
lemmaProof
|
||||
return some ⟨imp.bvExpr, proof, imp.expr⟩
|
||||
|
||||
mkCondFalseLemma (discr : ReifiedBVLogical) (atom rhs : ReifiedBVExpr)
|
||||
(discrExpr atomExpr lhsExpr rhsExpr : Expr) : M (Option SatAtBVLogical) := do
|
||||
let resExpr := rhsExpr
|
||||
let resValExpr := rhs
|
||||
let lemmaName := ``Std.Tactic.BVDecide.Reflect.BitVec.cond_false
|
||||
|
||||
let eqBVExpr ← mkAppM ``BEq.beq #[atomExpr, resExpr]
|
||||
let some eqBVPred ← ReifiedBVPred.mkBinPred atom resValExpr atomExpr resExpr .eq | return none
|
||||
let eqBV ← ReifiedBVLogical.ofPred eqBVPred
|
||||
|
||||
let imp ← ReifiedBVLogical.mkGate discr eqBV discrExpr eqBVExpr .or
|
||||
|
||||
let proof := do
|
||||
let evalExpr ← ReifiedBVLogical.mkEvalExpr imp.expr
|
||||
let congrProof := (← imp.evalsAtAtoms).getD (ReifiedBVLogical.mkRefl evalExpr)
|
||||
let lemmaProof := mkApp4 (mkConst lemmaName) (toExpr rhs.width) discrExpr lhsExpr rhsExpr
|
||||
|
||||
-- discr || (atom == rhs)
|
||||
let impExpr := mkApp2 (mkConst ``Bool.or) discrExpr eqBVExpr
|
||||
|
||||
return mkApp4
|
||||
(mkConst ``Std.Tactic.BVDecide.Reflect.Bool.lemma_congr)
|
||||
impExpr
|
||||
decideImpExpr
|
||||
evalExpr
|
||||
congrProof
|
||||
lemmaProof
|
||||
|
||||
@@ -220,12 +220,15 @@ where
|
||||
.rotateRight
|
||||
``BVUnOp.rotateRight
|
||||
``Std.Tactic.BVDecide.Reflect.BitVec.rotateRight_congr
|
||||
| cond _ discrExpr lhsExpr rhsExpr =>
|
||||
| ite _ discrExpr _ lhsExpr rhsExpr =>
|
||||
let_expr Eq α discrExpr val := discrExpr | return none
|
||||
let_expr Bool := α | return none
|
||||
let_expr Bool.true := val | return none
|
||||
let some atom ← ReifiedBVExpr.bitVecAtom x true | return none
|
||||
let some discr ← ReifiedBVLogical.of discrExpr | return none
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
addCondLemmas discr atom lhs rhs discrExpr x lhsExpr rhsExpr
|
||||
addIfLemmas discr atom lhs rhs discrExpr x lhsExpr rhsExpr
|
||||
return some atom
|
||||
| _ => return none
|
||||
|
||||
@@ -389,7 +392,10 @@ where
|
||||
| Bool => gateReflection lhsExpr rhsExpr .beq
|
||||
| BitVec _ => goPred t
|
||||
| _ => return none
|
||||
| cond _ discrExpr lhsExpr rhsExpr =>
|
||||
| ite _ discrExpr _ lhsExpr rhsExpr =>
|
||||
let_expr Eq α discrExpr val := discrExpr | return none
|
||||
let_expr Bool := α | return none
|
||||
let_expr Bool.true := val | return none
|
||||
let some discr ← goOrAtom discrExpr | return none
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
|
||||
@@ -4,28 +4,332 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.AppBuilder
|
||||
import Lean.Meta.Tactic.AC.Main
|
||||
import Lean.Elab.Tactic.Simp
|
||||
import Lean.Elab.Tactic.FalseOrByContra
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Simproc
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Rewrite
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
|
||||
import Std.Tactic.BVDecide.Normalize
|
||||
import Std.Tactic.BVDecide.Syntax
|
||||
|
||||
/-!
|
||||
This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
|
||||
It is in essence a (slightly reduced) version of the Bitwuzla preprocessor together with Lean
|
||||
specific details.
|
||||
This module contains the implementation of `bv_normalize` which is effectively a custom `bv_normalize`
|
||||
simp set that is called like this: `simp only [seval, bv_normalize]`. The rules in `bv_normalize`
|
||||
fulfill two goals:
|
||||
1. Turn all hypothesis involving `Bool` and `BitVec` into the form `x = true` where `x` only consists
|
||||
of a operations on `Bool` and `BitVec`. In particular no `Prop` should be contained. This makes
|
||||
the reflection procedure further down the pipeline much easier to implement.
|
||||
2. Apply simplification rules from the Bitwuzla SMT solver.
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.Tactic.BVDecide
|
||||
namespace Frontend.Normalize
|
||||
|
||||
open Lean.Meta
|
||||
open Std.Tactic.BVDecide.Normalize
|
||||
|
||||
def passPipeline : PreProcessM (List Pass) := do
|
||||
let mut passPipeline := [rewriteRulesPass]
|
||||
let cfg ← PreProcessM.getConfig
|
||||
builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
|
||||
let_expr Eq _ lhs rhs := e | return .continue
|
||||
match_expr rhs with
|
||||
| Bool.true => return .continue
|
||||
| _ =>
|
||||
let beqApp ← mkAppM ``BEq.beq #[lhs, rhs]
|
||||
let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
|
||||
let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
|
||||
return .done { expr := new, proof? := some proof }
|
||||
|
||||
builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
|
||||
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
|
||||
let some ⟨w, rhsValue⟩ ← getBitVecValue? rhs | return .continue
|
||||
if rhsValue == -1#w then
|
||||
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
|
||||
return .visit { expr := lhs, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
|
||||
builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
|
||||
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
|
||||
let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
|
||||
if lhsValue == -1#w then
|
||||
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
|
||||
return .visit { expr := rhs, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
|
||||
builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
|
||||
let_expr BitVec.ult _ lhs rhs := e | return .continue
|
||||
let some ⟨w, lhsValue⟩ ← getBitVecValue? lhs | return .continue
|
||||
if lhsValue == -1#w then
|
||||
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
|
||||
return .visit { expr := toExpr Bool.false, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
|
||||
-- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
|
||||
builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
|
||||
let_expr Neg.neg typ _ val := e | return .continue
|
||||
let_expr BitVec widthExpr := typ | return .continue
|
||||
let some w ← getNatValue? widthExpr | return .continue
|
||||
match ← getBitVecValue? val with
|
||||
| some _ => return .continue
|
||||
| none =>
|
||||
let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
|
||||
let expr ← mkAppM ``HAdd.hAdd #[← mkAppM ``Complement.complement #[val], (toExpr 1#w)]
|
||||
return .visit { expr := expr, proof? := some proof }
|
||||
|
||||
builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
|
||||
fun e => do
|
||||
let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
|
||||
let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
|
||||
let some ⟨w, exp1Val⟩ ← getBitVecValue? exp1 | return .continue
|
||||
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
|
||||
match ← getBitVecValue? exp2 with
|
||||
| some ⟨w', exp2Val⟩ =>
|
||||
if h : w = w' then
|
||||
let newLhs := exp1Val + h ▸ exp2Val
|
||||
let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
|
||||
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
|
||||
return .visit { expr := expr, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
| none =>
|
||||
let some ⟨w', exp3Val⟩ ← getBitVecValue? exp3 | return .continue
|
||||
if h : w = w' then
|
||||
let newLhs := exp1Val + h ▸ exp3Val
|
||||
let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
|
||||
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
|
||||
return .visit { expr := expr, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
|
||||
builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
|
||||
fun e => do
|
||||
let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
|
||||
let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
|
||||
let some ⟨w, exp3Val⟩ ← getBitVecValue? exp3 | return .continue
|
||||
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
|
||||
match ← getBitVecValue? exp1 with
|
||||
| some ⟨w', exp1Val⟩ =>
|
||||
if h : w = w' then
|
||||
let newLhs := exp3Val + h ▸ exp1Val
|
||||
let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
|
||||
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
|
||||
return .visit { expr := expr, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
| none =>
|
||||
let some ⟨w', exp2Val⟩ ← getBitVecValue? exp2 | return .continue
|
||||
if h : w = w' then
|
||||
let newLhs := exp3Val + h ▸ exp2Val
|
||||
let expr ← mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
|
||||
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
|
||||
return .visit { expr := expr, proof? := some proof }
|
||||
else
|
||||
return .continue
|
||||
|
||||
attribute [builtin_bv_normalize_proc↓] reduceIte
|
||||
|
||||
/-- Return a number `k` such that `2^k = n`. -/
|
||||
private def Nat.log2Exact (n : Nat) : Option Nat := do
|
||||
guard <| n ≠ 0
|
||||
let k := n.log2
|
||||
guard <| Nat.pow 2 k == n
|
||||
return k
|
||||
|
||||
-- Build an expression for `x ^ y`.
|
||||
def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
|
||||
|
||||
builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
|
||||
let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
|
||||
let some ⟨w, yVal⟩ ← getBitVecValue? y | return .continue
|
||||
let n := yVal.toNat
|
||||
-- BitVec.ofNat w n, where n =def= 2^k
|
||||
let some k := Nat.log2Exact n | return .continue
|
||||
-- check that k < w.
|
||||
if k ≥ w then return .continue
|
||||
let rhs ← mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
|
||||
-- 2^k = n
|
||||
let hk ← mkDecideProof (← mkEq (← mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
|
||||
-- k < w
|
||||
let hlt ← mkDecideProof (← mkLt (mkNatLit k) (mkNatLit w))
|
||||
let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
|
||||
#[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
|
||||
return .done {
|
||||
expr := rhs
|
||||
proof? := some proof
|
||||
}
|
||||
|
||||
/--
|
||||
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
|
||||
the goal fully, indicated by returning `none`.
|
||||
-/
|
||||
structure Pass where
|
||||
name : Name
|
||||
run : MVarId → MetaM (Option MVarId)
|
||||
|
||||
namespace Pass
|
||||
|
||||
/--
|
||||
Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
|
||||
the goal anymore.
|
||||
-/
|
||||
partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : MetaM (Option MVarId) := do
|
||||
let runPass (goal? : Option MVarId) (pass : Pass) : MetaM (Option MVarId) := do
|
||||
let some goal := goal? | return none
|
||||
withTraceNode `bv (fun _ => return s!"Running pass: {pass.name}") do
|
||||
pass.run goal
|
||||
|
||||
let some newGoal := ← passes.foldlM (init := some goal) runPass | return none
|
||||
if goal != newGoal then
|
||||
trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
|
||||
fixpointPipeline passes newGoal
|
||||
else
|
||||
trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
|
||||
return newGoal
|
||||
|
||||
/--
|
||||
Responsible for applying the Bitwuzla style rewrite rules.
|
||||
-/
|
||||
def rewriteRulesPass (maxSteps : Nat) : Pass where
|
||||
name := `rewriteRules
|
||||
run goal := do
|
||||
let bvThms ← bvNormalizeExt.getTheorems
|
||||
let bvSimprocs ← bvNormalizeSimprocExt.getSimprocs
|
||||
let sevalThms ← getSEvalTheorems
|
||||
let sevalSimprocs ← Simp.getSEvalSimprocs
|
||||
|
||||
let simpCtx ← Simp.mkContext
|
||||
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps })
|
||||
(simpTheorems := #[bvThms, sevalThms])
|
||||
(congrTheorems := (← getSimpCongrTheorems))
|
||||
|
||||
let hyps ← goal.getNondepPropHyps
|
||||
let ⟨result?, _⟩ ← simpGoal goal
|
||||
(ctx := simpCtx)
|
||||
(simprocs := #[bvSimprocs, sevalSimprocs])
|
||||
(fvarIdsToSimp := hyps)
|
||||
let some (_, newGoal) := result? | return none
|
||||
return newGoal
|
||||
|
||||
/--
|
||||
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
|
||||
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
|
||||
in embedded constraint substitution.
|
||||
-/
|
||||
partial def andFlatteningPass : Pass where
|
||||
name := `andFlattening
|
||||
run goal := do
|
||||
goal.withContext do
|
||||
let hyps ← goal.getNondepPropHyps
|
||||
let mut newHyps := #[]
|
||||
let mut oldHyps := #[]
|
||||
for fvar in hyps do
|
||||
let hyp : Hypothesis := {
|
||||
userName := (← fvar.getDecl).userName
|
||||
type := ← fvar.getType
|
||||
value := mkFVar fvar
|
||||
}
|
||||
let sizeBefore := newHyps.size
|
||||
newHyps ← splitAnds hyp newHyps
|
||||
if newHyps.size > sizeBefore then
|
||||
oldHyps := oldHyps.push fvar
|
||||
if newHyps.size == 0 then
|
||||
return goal
|
||||
else
|
||||
let (_, goal) ← goal.assertHypotheses newHyps
|
||||
-- Given that we collected the hypotheses in the correct order above the invariant is given
|
||||
let goal ← goal.tryClearMany oldHyps
|
||||
return goal
|
||||
where
|
||||
splitAnds (hyp : Hypothesis) (hyps : Array Hypothesis) (first : Bool := true) :
|
||||
MetaM (Array Hypothesis) := do
|
||||
match ← trySplit hyp with
|
||||
| some (left, right) =>
|
||||
let hyps ← splitAnds left hyps false
|
||||
splitAnds right hyps false
|
||||
| none =>
|
||||
if first then
|
||||
return hyps
|
||||
else
|
||||
return hyps.push hyp
|
||||
|
||||
trySplit (hyp : Hypothesis) : MetaM (Option (Hypothesis × Hypothesis)) := do
|
||||
let typ := hyp.type
|
||||
let_expr Eq α eqLhs eqRhs := typ | return none
|
||||
let_expr Bool.and lhs rhs := eqLhs | return none
|
||||
let_expr Bool.true := eqRhs | return none
|
||||
let_expr Bool := α | return none
|
||||
let mkEqTrue (lhs : Expr) : Expr :=
|
||||
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
|
||||
let leftHyp : Hypothesis := {
|
||||
userName := hyp.userName,
|
||||
type := mkEqTrue lhs,
|
||||
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
|
||||
}
|
||||
let rightHyp : Hypothesis := {
|
||||
userName := hyp.userName,
|
||||
type := mkEqTrue rhs,
|
||||
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
|
||||
}
|
||||
return some (leftHyp, rightHyp)
|
||||
|
||||
/--
|
||||
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
|
||||
them to substitute occurences of `x` within other hypotheses. Additionally this drops all
|
||||
redundant top level hypotheses.
|
||||
-/
|
||||
def embeddedConstraintPass (maxSteps : Nat) : Pass where
|
||||
name := `embeddedConstraintSubsitution
|
||||
run goal := do
|
||||
goal.withContext do
|
||||
let hyps ← goal.getNondepPropHyps
|
||||
let mut relevantHyps : SimpTheoremsArray := #[]
|
||||
let mut seen : Std.HashSet Expr := {}
|
||||
let mut duplicates : Array FVarId := #[]
|
||||
for hyp in hyps do
|
||||
let typ ← hyp.getType
|
||||
let_expr Eq α lhs rhs := typ | continue
|
||||
let_expr Bool.true := rhs | continue
|
||||
let_expr Bool := α | continue
|
||||
if seen.contains lhs then
|
||||
-- collect and later remove duplicates on the fly
|
||||
duplicates := duplicates.push hyp
|
||||
else
|
||||
seen := seen.insert lhs
|
||||
let localDecl ← hyp.getDecl
|
||||
let proof := localDecl.toExpr
|
||||
relevantHyps ← relevantHyps.addTheorem (.fvar hyp) proof
|
||||
|
||||
let goal ← goal.tryClearMany duplicates
|
||||
|
||||
let simpCtx ← Simp.mkContext
|
||||
(config := { failIfUnchanged := false, maxSteps })
|
||||
(simpTheorems := relevantHyps)
|
||||
(congrTheorems := (← getSimpCongrTheorems))
|
||||
|
||||
let ⟨result?, _⟩ ← simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := ← goal.getNondepPropHyps)
|
||||
let some (_, newGoal) := result? | return none
|
||||
return newGoal
|
||||
|
||||
/--
|
||||
Normalize with respect to Associativity and Commutativity.
|
||||
-/
|
||||
def acNormalizePass : Pass where
|
||||
name := `ac_nf
|
||||
run goal := do
|
||||
let mut newGoal := goal
|
||||
for hyp in (← goal.getNondepPropHyps) do
|
||||
let result ← Lean.Meta.AC.acNfHypMeta newGoal hyp
|
||||
|
||||
if let .some nextGoal := result then
|
||||
newGoal := nextGoal
|
||||
else
|
||||
return none
|
||||
|
||||
return newGoal
|
||||
|
||||
def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
|
||||
let mut passPipeline := [rewriteRulesPass cfg.maxSteps]
|
||||
|
||||
if cfg.acNf then
|
||||
passPipeline := passPipeline ++ [acNormalizePass]
|
||||
@@ -34,20 +338,18 @@ def passPipeline : PreProcessM (List Pass) := do
|
||||
passPipeline := passPipeline ++ [andFlatteningPass]
|
||||
|
||||
if cfg.embeddedConstraintSubst then
|
||||
passPipeline := passPipeline ++ [embeddedConstraintPass]
|
||||
passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
|
||||
|
||||
return passPipeline
|
||||
|
||||
def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
|
||||
withTraceNode `bv (fun _ => return "Preprocessing goal") do
|
||||
(go g).run cfg g
|
||||
where
|
||||
go (g : MVarId) : PreProcessM (Option MVarId) := do
|
||||
let some g ← g.falseOrByContra | return none
|
||||
end Pass
|
||||
|
||||
def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
|
||||
withTraceNode `bv (fun _ => return "Normalizing goal") do
|
||||
-- Contradiction proof
|
||||
let some g ← g.falseOrByContra | return none
|
||||
trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
|
||||
let pipeline ← passPipeline
|
||||
Pass.fixpointPipeline pipeline g
|
||||
Pass.fixpointPipeline (Pass.passPipeline cfg) g
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.bvNormalize]
|
||||
def evalBVNormalize : Tactic := fun
|
||||
|
||||
@@ -1,39 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
|
||||
import Lean.Meta.Tactic.AC.Main
|
||||
|
||||
/-!
|
||||
This module contains the implementation of the associativity and commutativity normalisation pass
|
||||
in the fixpoint pipeline.
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.Tactic.BVDecide
|
||||
namespace Frontend.Normalize
|
||||
|
||||
open Lean.Meta
|
||||
|
||||
/--
|
||||
Normalize with respect to Associativity and Commutativity.
|
||||
-/
|
||||
def acNormalizePass : Pass where
|
||||
name := `ac_nf
|
||||
run' goal := do
|
||||
let mut newGoal := goal
|
||||
for hyp in (← goal.getNondepPropHyps) do
|
||||
let result ← AC.acNfHypMeta newGoal hyp
|
||||
|
||||
if let .some nextGoal := result then
|
||||
newGoal := nextGoal
|
||||
else
|
||||
return none
|
||||
|
||||
return newGoal
|
||||
|
||||
|
||||
end Frontend.Normalize
|
||||
end Lean.Elab.Tactic.BVDecide
|
||||
@@ -1,99 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Std.Tactic.BVDecide.Normalize.Bool
|
||||
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
|
||||
import Lean.Meta.Tactic.Assert
|
||||
|
||||
/-!
|
||||
This module contains the implementation of the and flattening pass in the fixpoint pipeline, taking
|
||||
hypotheses of the form `h : x && y = true` and splitting them into `h1 : x = true` and
|
||||
`h2 : y = true` recursively.
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.Tactic.BVDecide
|
||||
namespace Frontend.Normalize
|
||||
|
||||
open Lean.Meta
|
||||
|
||||
structure AndFlattenState where
|
||||
hypsToDelete : Array FVarId := #[]
|
||||
hypsToAdd : Array Hypothesis := #[]
|
||||
cache : Std.HashSet Expr := {}
|
||||
|
||||
/--
|
||||
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
|
||||
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
|
||||
in embedded constraint substitution.
|
||||
-/
|
||||
partial def andFlatteningPass : Pass where
|
||||
name := `andFlattening
|
||||
run' goal := do
|
||||
let (_, { hypsToDelete, hypsToAdd, .. }) ← processGoal goal |>.run {}
|
||||
if hypsToAdd.isEmpty then
|
||||
return goal
|
||||
else
|
||||
let (_, goal) ← goal.assertHypotheses hypsToAdd
|
||||
-- Given that we collected the hypotheses in the correct order above the invariant is given
|
||||
let goal ← goal.tryClearMany hypsToDelete
|
||||
return goal
|
||||
where
|
||||
processGoal (goal : MVarId) : StateRefT AndFlattenState MetaM Unit := do
|
||||
goal.withContext do
|
||||
let hyps ← goal.getNondepPropHyps
|
||||
hyps.forM processFVar
|
||||
|
||||
processFVar (fvar : FVarId) : StateRefT AndFlattenState MetaM Unit := do
|
||||
let type ← fvar.getType
|
||||
if (← get).cache.contains type then
|
||||
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
|
||||
else
|
||||
let hyp := {
|
||||
userName := (← fvar.getDecl).userName
|
||||
type := type
|
||||
value := mkFVar fvar
|
||||
}
|
||||
let some (lhs, rhs) ← trySplit hyp | return ()
|
||||
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
|
||||
splitAnds [lhs, rhs]
|
||||
|
||||
splitAnds (worklist : List Hypothesis) : StateRefT AndFlattenState MetaM Unit := do
|
||||
match worklist with
|
||||
| [] => return ()
|
||||
| hyp :: worklist =>
|
||||
match ← trySplit hyp with
|
||||
| some (left, right) => splitAnds <| left :: right :: worklist
|
||||
| none =>
|
||||
modify (fun s => { s with hypsToAdd := s.hypsToAdd.push hyp })
|
||||
splitAnds worklist
|
||||
|
||||
trySplit (hyp : Hypothesis) :
|
||||
StateRefT AndFlattenState MetaM (Option (Hypothesis × Hypothesis)) := do
|
||||
let typ := hyp.type
|
||||
if (← get).cache.contains typ then
|
||||
return none
|
||||
else
|
||||
modify (fun s => { s with cache := s.cache.insert typ })
|
||||
let_expr Eq _ eqLhs eqRhs := typ | return none
|
||||
let_expr Bool.and lhs rhs := eqLhs | return none
|
||||
let_expr Bool.true := eqRhs | return none
|
||||
let mkEqTrue (lhs : Expr) : Expr :=
|
||||
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
|
||||
let leftHyp : Hypothesis := {
|
||||
userName := hyp.userName,
|
||||
type := mkEqTrue lhs,
|
||||
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
|
||||
}
|
||||
let rightHyp : Hypothesis := {
|
||||
userName := hyp.userName,
|
||||
type := mkEqTrue rhs,
|
||||
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
|
||||
}
|
||||
return some (leftHyp, rightHyp)
|
||||
|
||||
|
||||
end Frontend.Normalize
|
||||
end Lean.Elab.Tactic.BVDecide
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user