mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-22 12:54:06 +00:00
Compare commits
103 Commits
unattach_a
...
array_clea
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f172b32379 | ||
|
|
e4455947fb | ||
|
|
7c2425605c | ||
|
|
3f7854203a | ||
|
|
79583d63f3 | ||
|
|
741040d296 | ||
|
|
b69377cc42 | ||
|
|
ef05bdc449 | ||
|
|
50594aa932 | ||
|
|
032c0257c3 | ||
|
|
a2d2977228 | ||
|
|
b333de1a36 | ||
|
|
19e06acc65 | ||
|
|
a04b476431 | ||
|
|
eea953b94f | ||
|
|
dec1262697 | ||
|
|
487c2a937a | ||
|
|
831fa0899f | ||
|
|
94053c9b1b | ||
|
|
94b1e512da | ||
|
|
5a87b104f6 | ||
|
|
dc83a607b2 | ||
|
|
7234ab79ed | ||
|
|
c27e671036 | ||
|
|
94dd1d61bd | ||
|
|
4409e39c43 | ||
|
|
0bfe1a8c1a | ||
|
|
a026bc7edb | ||
|
|
36c2511b27 | ||
|
|
adfbc56f91 | ||
|
|
9f8ce47699 | ||
|
|
3d175ab25f | ||
|
|
9b6696be1d | ||
|
|
057482eb1c | ||
|
|
16e2a785aa | ||
|
|
2580694e26 | ||
|
|
9ec29b4e3a | ||
|
|
aa2360a41d | ||
|
|
65637b7683 | ||
|
|
20ea855e50 | ||
|
|
225e08965d | ||
|
|
7fd2aa04ae | ||
|
|
47e0430b07 | ||
|
|
5d6553029c | ||
|
|
1d8555fe0b | ||
|
|
068208091f | ||
|
|
a3bc4d2359 | ||
|
|
087219bf5d | ||
|
|
e5bbda1c3d | ||
|
|
742ca6afa7 | ||
|
|
fe0fbc6bf7 | ||
|
|
8e88e8061a | ||
|
|
96e996e16d | ||
|
|
4614b758e1 | ||
|
|
3930100b67 | ||
|
|
d10d41bc07 | ||
|
|
79930af11e | ||
|
|
b814be6d6a | ||
|
|
feb8185a83 | ||
|
|
7942b9eaae | ||
|
|
15bb8a26d5 | ||
|
|
a35e6f4af7 | ||
|
|
fdd5aec172 | ||
|
|
81743d80e5 | ||
|
|
248864c716 | ||
|
|
bd46319aee | ||
|
|
6cdede33fb | ||
|
|
f1d3527fe8 | ||
|
|
b2b450d7cb | ||
|
|
abae95e170 | ||
|
|
e9ea99f6c6 | ||
|
|
2ed7924bae | ||
|
|
4415a81f35 | ||
|
|
3e75d8f742 | ||
|
|
f1ff9cebf2 | ||
|
|
99a9d9b381 | ||
|
|
1914a2b3f2 | ||
|
|
6312787c30 | ||
|
|
ec5f206d80 | ||
|
|
d835616573 | ||
|
|
9dac514c2f | ||
|
|
c0617da18d | ||
|
|
a3ee11103c | ||
|
|
13e3a3839c | ||
|
|
0178f2b70d | ||
|
|
4f5f39294d | ||
|
|
d4fdb5d7c0 | ||
|
|
f9048c132d | ||
|
|
53c5470200 | ||
|
|
3584a62411 | ||
|
|
a4fda010f3 | ||
|
|
b7d6a4b222 | ||
|
|
341c64a306 | ||
|
|
a01166f045 | ||
|
|
14f80172bc | ||
|
|
8f88d94d97 | ||
|
|
09dfe1c71c | ||
|
|
1b115eea42 | ||
|
|
8da278e141 | ||
|
|
6a59a3a373 | ||
|
|
1329a264c8 | ||
|
|
478a34f174 | ||
|
|
952c086a92 |
4
.github/workflows/ci.yml
vendored
4
.github/workflows/ci.yml
vendored
@@ -257,7 +257,7 @@ jobs:
|
||||
"cross": true,
|
||||
"shell": "bash -euxo pipefail {0}",
|
||||
// Just a few selected tests because wasm is slow
|
||||
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_libuv\\.lean\""
|
||||
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
|
||||
}
|
||||
];
|
||||
console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
|
||||
@@ -452,7 +452,7 @@ jobs:
|
||||
run: ccache -s
|
||||
|
||||
# This job collects results from all the matrix jobs
|
||||
# This can be made the “required” job, instead of listing each
|
||||
# This can be made the "required" job, instead of listing each
|
||||
# matrix job separately
|
||||
all-done:
|
||||
name: Build matrix complete
|
||||
|
||||
2
.github/workflows/pr-release.yml
vendored
2
.github/workflows/pr-release.yml
vendored
@@ -340,7 +340,7 @@ jobs:
|
||||
# (This should no longer be possible once `nightly-testing-YYYY-MM-DD` is a tag, but it is still safe to merge.)
|
||||
git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories
|
||||
lake update batteries
|
||||
get add lake-manifest.json
|
||||
git add lake-manifest.json
|
||||
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
|
||||
fi
|
||||
|
||||
|
||||
@@ -181,7 +181,7 @@ v4.12.0
|
||||
* [#4953](https://github.com/leanprover/lean4/pull/4953) defines "and-inverter graphs" (AIGs) as described in section 3 of [Davis-Swords 2013](https://arxiv.org/pdf/1304.7861.pdf).
|
||||
|
||||
* **Parsec**
|
||||
* [#4774](https://github.com/leanprover/lean4/pull/4774) generalizes the `Parsec` library, allowing parsing of iterable data beyong `String` such as `ByteArray`. (See breaking changes.)
|
||||
* [#4774](https://github.com/leanprover/lean4/pull/4774) generalizes the `Parsec` library, allowing parsing of iterable data beyond `String` such as `ByteArray`. (See breaking changes.)
|
||||
* [#5115](https://github.com/leanprover/lean4/pull/5115) moves `Lean.Data.Parsec` to `Std.Internal.Parsec` for bootstrappng reasons.
|
||||
|
||||
* `Thunk`
|
||||
|
||||
@@ -18,14 +18,14 @@ the stdlib.
|
||||
## Installing dependencies
|
||||
|
||||
[The official webpage of MSYS2][msys2] provides one-click installers.
|
||||
Once installed, you should run the "MSYS2 MinGW 64-bit shell" from the start menu (the one that runs `mingw64.exe`).
|
||||
Do not run "MSYS2 MSYS" instead!
|
||||
MSYS2 has a package management system, [pacman][pacman], which is used in Arch Linux.
|
||||
Once installed, you should run the "MSYS2 CLANG64" shell from the start menu (the one that runs `clang64.exe`).
|
||||
Do not run "MSYS2 MSYS" or "MSYS2 MINGW64" instead!
|
||||
MSYS2 has a package management system, [pacman][pacman].
|
||||
|
||||
Here are the commands to install all dependencies needed to compile Lean on your machine.
|
||||
|
||||
```bash
|
||||
pacman -S make python mingw-w64-x86_64-cmake mingw-w64-x86_64-clang mingw-w64-x86_64-ccache mingw-w64-x86_64-libuv mingw-w64-x86_64-gmp git unzip diffutils binutils
|
||||
pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
|
||||
```
|
||||
|
||||
You should now be able to run these commands:
|
||||
@@ -61,8 +61,7 @@ If you want a version that can run independently of your MSYS install
|
||||
then you need to copy the following dependent DLL's from where ever
|
||||
they are installed in your MSYS setup:
|
||||
|
||||
- libgcc_s_seh-1.dll
|
||||
- libstdc++-6.dll
|
||||
- libc++.dll
|
||||
- libgmp-10.dll
|
||||
- libuv-1.dll
|
||||
- libwinpthread-1.dll
|
||||
@@ -82,6 +81,6 @@ version clang to your path.
|
||||
|
||||
**-bash: gcc: command not found**
|
||||
|
||||
Make sure `/mingw64/bin` is in your PATH environment. If it is not then
|
||||
check you launched the MSYS2 MinGW 64-bit shell from the start menu.
|
||||
(The one that runs `mingw64.exe`).
|
||||
Make sure `/clang64/bin` is in your PATH environment. If it is not then
|
||||
check you launched the MSYS2 CLANG64 shell from the start menu.
|
||||
(The one that runs `clang64.exe`).
|
||||
|
||||
14
flake.nix
14
flake.nix
@@ -39,7 +39,19 @@
|
||||
CTEST_OUTPUT_ON_FAILURE = 1;
|
||||
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
|
||||
GMP = pkgsDist.gmp.override { withStatic = true; };
|
||||
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: { configureFlags = ["--enable-static"]; });
|
||||
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: {
|
||||
configureFlags = ["--enable-static"];
|
||||
hardeningDisable = [ "stackprotector" ];
|
||||
# Sync version with CMakeLists.txt
|
||||
version = "1.48.0";
|
||||
src = pkgs.fetchFromGitHub {
|
||||
owner = "libuv";
|
||||
repo = "libuv";
|
||||
rev = "v1.48.0";
|
||||
sha256 = "100nj16fg8922qg4m2hdjh62zv4p32wyrllsvqr659hdhjc03bsk";
|
||||
};
|
||||
doCheck = false;
|
||||
});
|
||||
GLIBC = pkgsDist.glibc;
|
||||
GLIBC_DEV = pkgsDist.glibc.dev;
|
||||
GCC_LIB = pkgsDist.gcc.cc.lib;
|
||||
|
||||
@@ -48,6 +48,8 @@ $CP llvm-host/lib/*/lib{c++,c++abi,unwind}.* llvm-host/lib/
|
||||
$CP -r llvm/include/*-*-* llvm-host/include/
|
||||
# glibc: use for linking (so Lean programs don't embed newer symbol versions), but not for running (because libc.so, librt.so, and ld.so must be compatible)!
|
||||
$CP $GLIBC/lib/libc_nonshared.a stage1/lib/glibc
|
||||
# libpthread_nonshared.a must be linked in order to be able to use `pthread_atfork(3)`. LibUV uses this function.
|
||||
$CP $GLIBC/lib/libpthread_nonshared.a stage1/lib/glibc
|
||||
for f in $GLIBC/lib/lib{c,dl,m,rt,pthread}-*; do b=$(basename $f); cp $f stage1/lib/glibc/${b%-*}.so; done
|
||||
OPTIONS=()
|
||||
echo -n " -DLEAN_STANDALONE=ON"
|
||||
@@ -62,8 +64,8 @@ fi
|
||||
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
|
||||
# but do not change sysroot so users can still link against system libs
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='-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 -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
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 -lpthread -ldl -lrt -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 -Wl,--no-as-needed'"
|
||||
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
|
||||
echo -n " -DLEAN_TEST_VARS=''"
|
||||
|
||||
@@ -31,15 +31,15 @@ cp /clang64/lib/{crtbegin,crtend,crt2,dllcrt2}.o stage1/lib/
|
||||
# runtime
|
||||
(cd llvm; cp --parents lib/clang/*/lib/*/libclang_rt.builtins* ../stage1)
|
||||
# further dependencies
|
||||
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
|
||||
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase,psapi,iphlpapi,userenv,ws2_32,dbghelp,ole32}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
|
||||
echo -n " -DLEAN_STANDALONE=ON"
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=1 -DCMAKE_CXX_COMPILER=$PWD/llvm/bin/clang++.exe -DCMAKE_CXX_COMPILER_WORKS=1 -DLEAN_CXX_STDLIB='-lc++ -lc++abi'"
|
||||
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='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp -luv -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
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv -lucrtbase'"
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
echo -n " -DAUTO_THREAD_FINALIZATION=OFF -DSTAGE0_AUTO_THREAD_FINALIZATION=OFF"
|
||||
echo -n " -DLEAN_TEST_VARS=''"
|
||||
|
||||
@@ -243,11 +243,56 @@ if("${USE_GMP}" MATCHES "ON")
|
||||
endif()
|
||||
endif()
|
||||
|
||||
if(NOT "${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
|
||||
# LibUV
|
||||
# LibUV
|
||||
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
|
||||
# Only on WebAssembly we compile LibUV ourselves
|
||||
set(LIBUV_EMSCRIPTEN_FLAGS "${EMSCRIPTEN_SETTINGS}")
|
||||
|
||||
# LibUV does not compile on WebAssembly without modifications because
|
||||
# building LibUV on a platform requires including stub implementations
|
||||
# for features not present on the target platform. This patch includes
|
||||
# the minimum amount of stub implementations needed for successfully
|
||||
# running Lean on WebAssembly and using LibUV's temporary file support.
|
||||
# It still leaves several symbols completely undefined: uv__fs_event_close,
|
||||
# uv__hrtime, uv__io_check_fd, uv__io_fork, uv__io_poll, uv__platform_invalidate_fd
|
||||
# uv__platform_loop_delete, uv__platform_loop_init. Making additional
|
||||
# LibUV features available on WebAssembly might require adapting the
|
||||
# patch to include additional LibUV source files.
|
||||
set(LIBUV_PATCH_IN "
|
||||
diff --git a/CMakeLists.txt b/CMakeLists.txt
|
||||
index 5e8e0166..f3b29134 100644
|
||||
--- a/CMakeLists.txt
|
||||
+++ b/CMakeLists.txt
|
||||
@@ -317,6 +317,11 @@ if(CMAKE_SYSTEM_NAME STREQUAL \"GNU\")
|
||||
src/unix/hurd.c)
|
||||
endif()
|
||||
|
||||
+if(CMAKE_SYSTEM_NAME STREQUAL \"Emscripten\")
|
||||
+ list(APPEND uv_sources
|
||||
+ src/unix/no-proctitle.c)
|
||||
+endif()
|
||||
+
|
||||
if(CMAKE_SYSTEM_NAME STREQUAL \"Linux\")
|
||||
list(APPEND uv_defines _GNU_SOURCE _POSIX_C_SOURCE=200112)
|
||||
list(APPEND uv_libraries dl rt)
|
||||
")
|
||||
string(REPLACE "\n" "\\n" LIBUV_PATCH ${LIBUV_PATCH_IN})
|
||||
|
||||
ExternalProject_add(libuv
|
||||
PREFIX libuv
|
||||
GIT_REPOSITORY https://github.com/libuv/libuv
|
||||
# Sync version with flake.nix
|
||||
GIT_TAG v1.48.0
|
||||
CMAKE_ARGS -DCMAKE_BUILD_TYPE=Release -DLIBUV_BUILD_TESTS=OFF -DLIBUV_BUILD_SHARED=OFF -DCMAKE_AR=${CMAKE_AR} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -DCMAKE_POSITION_INDEPENDENT_CODE=ON -DCMAKE_C_FLAGS=${LIBUV_EMSCRIPTEN_FLAGS}
|
||||
PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
|
||||
BUILD_IN_SOURCE ON
|
||||
INSTALL_COMMAND "")
|
||||
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)
|
||||
include_directories(${LIBUV_INCLUDE_DIR})
|
||||
endif()
|
||||
include_directories(${LIBUV_INCLUDE_DIR})
|
||||
if(NOT LEAN_STANDALONE)
|
||||
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
|
||||
endif()
|
||||
@@ -522,6 +567,10 @@ if(${STAGE} GREATER 1)
|
||||
endif()
|
||||
else()
|
||||
add_subdirectory(runtime)
|
||||
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
|
||||
add_dependencies(leanrt libuv)
|
||||
add_dependencies(leanrt_initial-exec libuv)
|
||||
endif()
|
||||
|
||||
add_subdirectory(util)
|
||||
set(LEAN_OBJS ${LEAN_OBJS} $<TARGET_OBJECTS:util>)
|
||||
@@ -562,7 +611,10 @@ if (${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
|
||||
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
|
||||
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
|
||||
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
|
||||
# We set `ERROR_ON_UNDEFINED_SYMBOLS=0` because our build of LibUV does not
|
||||
# define all symbols, see the comment about LibUV on WebAssembly further up
|
||||
# in this file.
|
||||
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1 -s ERROR_ON_UNDEFINED_SYMBOLS=0")
|
||||
endif()
|
||||
|
||||
# Build the compiler using the bootstrapped C sources for stage0, and use
|
||||
|
||||
@@ -1385,6 +1385,7 @@ gen_injective_theorems% Except
|
||||
gen_injective_theorems% EStateM.Result
|
||||
gen_injective_theorems% Lean.Name
|
||||
gen_injective_theorems% Lean.Syntax
|
||||
gen_injective_theorems% BitVec
|
||||
|
||||
theorem Nat.succ.inj {m n : Nat} : m.succ = n.succ → m = n :=
|
||||
fun x => Nat.noConfusion x id
|
||||
@@ -1864,7 +1865,8 @@ section
|
||||
variable {α : Type u}
|
||||
variable (r : α → α → Prop)
|
||||
|
||||
instance {α : Sort u} {s : Setoid α} [d : ∀ (a b : α), Decidable (a ≈ b)] : DecidableEq (Quotient s) :=
|
||||
instance Quotient.decidableEq {α : Sort u} {s : Setoid α} [d : ∀ (a b : α), Decidable (a ≈ b)]
|
||||
: DecidableEq (Quotient s) :=
|
||||
fun (q₁ q₂ : Quotient s) =>
|
||||
Quotient.recOnSubsingleton₂ q₁ q₂
|
||||
fun a₁ a₂ =>
|
||||
|
||||
@@ -40,3 +40,4 @@ import Init.Data.ULift
|
||||
import Init.Data.PLift
|
||||
import Init.Data.Zero
|
||||
import Init.Data.NeZero
|
||||
import Init.Data.Function
|
||||
|
||||
@@ -63,29 +63,29 @@ If not, usually the right approach is `simp [Array.unattach, -Array.map_subtype]
|
||||
-/
|
||||
def unattach {α : Type _} {p : α → Prop} (l : Array { x // p x }) := l.map (·.val)
|
||||
|
||||
@[simp] theorem unattach_nil {α : Type _} {p : α → Prop} : (#[] : Array { x // p x }).unattach = #[] := rfl
|
||||
@[simp] theorem unattach_push {α : Type _} {p : α → Prop} {a : { x // p x }} {l : Array { x // p x }} :
|
||||
@[simp] theorem unattach_nil {p : α → Prop} : (#[] : Array { x // p x }).unattach = #[] := rfl
|
||||
@[simp] theorem unattach_push {p : α → Prop} {a : { x // p x }} {l : Array { x // p x }} :
|
||||
(l.push a).unattach = l.unattach.push a.1 := by
|
||||
simp [unattach]
|
||||
simp only [unattach, Array.map_push]
|
||||
|
||||
@[simp] theorem size_unattach {α : Type _} {p : α → Prop} {l : Array { x // p x }} :
|
||||
@[simp] theorem size_unattach {p : α → Prop} {l : Array { x // p x }} :
|
||||
l.unattach.size = l.size := by
|
||||
unfold unattach
|
||||
simp
|
||||
|
||||
@[simp] theorem _root_.List.unattach_toArray {α : Type _} {p : α → Prop} {l : List { x // p x }} :
|
||||
@[simp] theorem _root_.List.unattach_toArray {p : α → Prop} {l : List { x // p x }} :
|
||||
l.toArray.unattach = l.unattach.toArray := by
|
||||
simp [unattach, List.unattach]
|
||||
simp only [unattach, List.map_toArray, List.unattach]
|
||||
|
||||
@[simp] theorem toList_unattach {α : Type _} {p : α → Prop} {l : Array { x // p x }} :
|
||||
@[simp] theorem toList_unattach {p : α → Prop} {l : Array { x // p x }} :
|
||||
l.unattach.toList = l.toList.unattach := by
|
||||
simp [unattach, List.unattach]
|
||||
simp only [unattach, toList_map, List.unattach]
|
||||
|
||||
@[simp] theorem unattach_attach {α : Type _} (l : Array α) : l.attach.unattach = l := by
|
||||
@[simp] theorem unattach_attach {l : Array α} : l.attach.unattach = l := by
|
||||
cases l
|
||||
simp
|
||||
|
||||
@[simp] theorem unattach_attachWith {α : Type _} {p : α → Prop} {l : Array α}
|
||||
@[simp] theorem unattach_attachWith {p : α → Prop} {l : Array α}
|
||||
{H : ∀ a ∈ l, p a} :
|
||||
(l.attachWith p H).unattach = l := by
|
||||
cases l
|
||||
@@ -161,8 +161,6 @@ and simplifies these to the function directly taking the value.
|
||||
(l.filter f).unattach = l.unattach.filter g := by
|
||||
cases l
|
||||
simp [hf]
|
||||
rw [List.unattach_filter]
|
||||
simp [hf]
|
||||
|
||||
/-! ### Simp lemmas pushing `unattach` inwards. -/
|
||||
|
||||
|
||||
@@ -7,10 +7,11 @@ prelude
|
||||
import Init.WFTactics
|
||||
import Init.Data.Nat.Basic
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.Repr
|
||||
import Init.Data.ToString.Basic
|
||||
import Init.GetElem
|
||||
import Init.Data.List.ToArray
|
||||
universe u v w
|
||||
|
||||
/-! ### Array literal syntax -/
|
||||
@@ -215,7 +216,7 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
|
||||
if h : i < a.size then
|
||||
swapAt a ⟨i, h⟩ v
|
||||
else
|
||||
have : Inhabited α := ⟨v⟩
|
||||
have : Inhabited (α × Array α) := ⟨(v, a)⟩
|
||||
panic! ("index " ++ toString i ++ " out of bounds")
|
||||
|
||||
def shrink (a : Array α) (n : Nat) : Array α :=
|
||||
@@ -606,13 +607,17 @@ protected def appendList (as : Array α) (bs : List α) : Array α :=
|
||||
instance : HAppend (Array α) (List α) (Array α) := ⟨Array.appendList⟩
|
||||
|
||||
@[inline]
|
||||
def concatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β) :=
|
||||
def flatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β) :=
|
||||
as.foldlM (init := empty) fun bs a => do return bs ++ (← f a)
|
||||
|
||||
@[deprecated concatMapM (since := "2024-10-16")] abbrev concatMapM := @flatMapM
|
||||
|
||||
@[inline]
|
||||
def concatMap (f : α → Array β) (as : Array α) : Array β :=
|
||||
def flatMap (f : α → Array β) (as : Array α) : Array β :=
|
||||
as.foldl (init := empty) fun bs a => bs ++ f a
|
||||
|
||||
@[deprecated flatMap (since := "2024-10-16")] abbrev concatMap := @flatMap
|
||||
|
||||
/-- Joins array of array into a single array.
|
||||
|
||||
`flatten #[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` = `#[a₁, a₂, ⋯, b₁, b₂, ⋯]`
|
||||
|
||||
@@ -45,16 +45,6 @@ theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[
|
||||
rw [getElem?_eq]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
|
||||
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp
|
||||
|
||||
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
|
||||
(a.push x)[i] = a[i] := by
|
||||
@@ -77,7 +67,10 @@ namespace List
|
||||
|
||||
open Array
|
||||
|
||||
/-! ### Lemmas about `List.toArray`. -/
|
||||
/-! ### Lemmas about `List.toArray`.
|
||||
|
||||
We prefer to pull `List.toArray` outwards.
|
||||
-/
|
||||
|
||||
@[simp] theorem size_toArrayAux {a : List α} {b : Array α} :
|
||||
(a.toArrayAux b).size = b.size + a.length := by
|
||||
@@ -85,20 +78,11 @@ open Array
|
||||
|
||||
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
|
||||
a.toArray[i] = a[i]'(by simpa using h) := rfl
|
||||
|
||||
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
|
||||
|
||||
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
|
||||
theorem toArray_concat {as : List α} {x : α} :
|
||||
(as ++ [x]).toArray = as.toArray.push x := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
@@ -163,20 +147,12 @@ end List
|
||||
|
||||
namespace Array
|
||||
|
||||
attribute [simp] uset
|
||||
|
||||
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
|
||||
|
||||
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
|
||||
|
||||
@[deprecated length_toList (since := "2024-09-09")]
|
||||
abbrev data_length := @length_toList
|
||||
|
||||
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
|
||||
|
||||
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
|
||||
@@ -225,9 +201,6 @@ where
|
||||
induction l generalizing arr <;> simp [*]
|
||||
simp [H]
|
||||
|
||||
@[deprecated toList_map (since := "2024-09-09")]
|
||||
abbrev map_data := @toList_map
|
||||
|
||||
@[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by
|
||||
simp only [← length_toList]
|
||||
simp
|
||||
@@ -242,24 +215,16 @@ abbrev map_data := @toList_map
|
||||
cases arr
|
||||
simp
|
||||
|
||||
theorem foldl_toList_eq_bind (l : List α) (acc : Array β)
|
||||
theorem foldl_toList_eq_flatMap (l : List α) (acc : Array β)
|
||||
(F : Array β → α → Array β) (G : α → List β)
|
||||
(H : ∀ acc a, (F acc a).toList = acc.toList ++ G a) :
|
||||
(l.foldl F acc).toList = acc.toList ++ l.bind G := by
|
||||
induction l generalizing acc <;> simp [*, List.bind]
|
||||
|
||||
@[deprecated foldl_toList_eq_bind (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_bind := @foldl_toList_eq_bind
|
||||
(l.foldl F acc).toList = acc.toList ++ l.flatMap G := by
|
||||
induction l generalizing acc <;> simp [*, List.flatMap]
|
||||
|
||||
theorem foldl_toList_eq_map (l : List α) (acc : Array β) (G : α → β) :
|
||||
(l.foldl (fun acc a => acc.push (G a)) acc).toList = acc.toList ++ l.map G := by
|
||||
induction l generalizing acc <;> simp [*]
|
||||
|
||||
@[deprecated foldl_toList_eq_map (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_map := @foldl_toList_eq_map
|
||||
|
||||
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
|
||||
|
||||
theorem anyM_eq_anyM_loop [Monad m] (p : α → m Bool) (as : Array α) (start stop) :
|
||||
anyM p as start stop = anyM.loop p as (min stop as.size) (Nat.min_le_right ..) start := by
|
||||
simp only [anyM, Nat.min_def]; split <;> rfl
|
||||
@@ -274,6 +239,12 @@ theorem mem_def {a : α} {as : Array α} : a ∈ as ↔ a ∈ as.toList :=
|
||||
@[simp] theorem not_mem_empty (a : α) : ¬(a ∈ #[]) := by
|
||||
simp [mem_def]
|
||||
|
||||
/-! # uset -/
|
||||
|
||||
attribute [simp] uset
|
||||
|
||||
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
|
||||
|
||||
/-! # get -/
|
||||
|
||||
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
|
||||
@@ -393,6 +364,10 @@ termination_by n - i
|
||||
(ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ :=
|
||||
getElem_ofFn_go _ _ _ (by simp) (by simp) nofun
|
||||
|
||||
theorem getElem?_ofFn (f : Fin n → α) (i : Nat) :
|
||||
(ofFn f)[i]? = if h : i < n then some (f ⟨i, h⟩) else none := by
|
||||
simp [getElem?_def]
|
||||
|
||||
/-- # mkArray -/
|
||||
|
||||
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
|
||||
@@ -400,19 +375,17 @@ termination_by n - i
|
||||
|
||||
@[simp] theorem toList_mkArray (n : Nat) (v : α) : (mkArray n v).toList = List.replicate n v := rfl
|
||||
|
||||
@[deprecated toList_mkArray (since := "2024-09-09")]
|
||||
abbrev mkArray_data := @toList_mkArray
|
||||
|
||||
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
|
||||
(mkArray n v)[i] = v := by simp [Array.getElem_eq_getElem_toList]
|
||||
|
||||
theorem getElem?_mkArray (n : Nat) (v : α) (i : Nat) :
|
||||
(mkArray n v)[i]? = if i < n then some v else none := by
|
||||
simp [getElem?_def]
|
||||
|
||||
/-- # mem -/
|
||||
|
||||
theorem mem_toList {a : α} {l : Array α} : a ∈ l.toList ↔ a ∈ l := mem_def.symm
|
||||
|
||||
@[deprecated mem_toList (since := "2024-09-09")]
|
||||
abbrev mem_data := @mem_toList
|
||||
|
||||
theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun
|
||||
|
||||
theorem getElem_of_mem {a : α} {as : Array α} :
|
||||
@@ -422,6 +395,12 @@ theorem getElem_of_mem {a : α} {as : Array α} :
|
||||
exists i
|
||||
exists hbound
|
||||
|
||||
theorem getElem?_of_mem {a : α} {as : Array α} :
|
||||
a ∈ as → ∃ (n : Nat), as[n]? = some a := by
|
||||
intro ha
|
||||
rcases List.getElem?_of_mem ha.val with ⟨i, hi⟩
|
||||
exists i
|
||||
|
||||
@[simp] theorem mem_dite_empty_left {x : α} [Decidable p] {l : ¬ p → Array α} :
|
||||
(x ∈ if h : p then #[] else l h) ↔ ∃ h : ¬ p, x ∈ l h := by
|
||||
split <;> simp_all [mem_def]
|
||||
@@ -444,14 +423,11 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
|
||||
idx < a.size :=
|
||||
hidx
|
||||
|
||||
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] ∈ l := by
|
||||
theorem getElem_mem {l : Array α} {i : Nat} (h : i < l.size) : l[i] ∈ l := by
|
||||
erw [Array.mem_def, getElem_eq_getElem_toList]
|
||||
apply List.get_mem
|
||||
|
||||
theorem getElem_fin_eq_toList_get (a : Array α) (i : Fin _) : a[i] = a.toList.get i := rfl
|
||||
|
||||
@[deprecated getElem_fin_eq_toList_get (since := "2024-09-09")]
|
||||
abbrev getElem_fin_eq_data_get := @getElem_fin_eq_toList_get
|
||||
theorem getElem_fin_eq_getElem_toList (a : Array α) (i : Fin a.size) : a[i] = a.toList[i] := rfl
|
||||
|
||||
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
|
||||
a[i] = a[i.toNat] := rfl
|
||||
@@ -462,26 +438,8 @@ theorem get?_len_le (a : Array α) (i : Nat) (h : a.size ≤ i) : a[i]? = none :
|
||||
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] ∈ a.toList := by
|
||||
simp only [getElem_eq_getElem_toList, List.getElem_mem]
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
theorem getElem?_eq_toList_getElem? (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg]
|
||||
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-30")]
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
|
||||
set_option linter.deprecated false in
|
||||
theorem get?_eq_toList_get? (a : Array α) (i : Nat) : a.get? i = a.toList.get? i :=
|
||||
getElem?_eq_toList_get? ..
|
||||
|
||||
@[deprecated get?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev get?_eq_data_get? := @get?_eq_toList_get?
|
||||
theorem get?_eq_get?_toList (a : Array α) (i : Nat) : a.get? i = a.toList.get? i := by
|
||||
simp [getElem?_eq_getElem?_toList]
|
||||
|
||||
theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
|
||||
simp [get!_eq_getD]
|
||||
@@ -494,7 +452,7 @@ theorem getElem?_eq_some_iff {as : Array α} : as[n]? = some a ↔ ∃ h : n < a
|
||||
simp [back, back?]
|
||||
|
||||
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
|
||||
simp [back?, getElem?_eq_toList_getElem?]
|
||||
simp [back?, getElem?_eq_getElem?_toList]
|
||||
|
||||
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
|
||||
|
||||
@@ -525,9 +483,6 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el
|
||||
|
||||
@[simp] theorem toList_set (a : Array α) (i v) : (a.set i v).toList = a.toList.set i.1 v := rfl
|
||||
|
||||
@[deprecated toList_set (since := "2024-09-09")]
|
||||
abbrev data_set := @toList_set
|
||||
|
||||
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1] = v := by
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_self]
|
||||
@@ -568,12 +523,9 @@ theorem swap_def (a : Array α) (i j : Fin a.size) :
|
||||
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
(a.swap i j).toList = (a.toList.set i (a.get j)).set j (a.get i) := by simp [swap_def]
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
abbrev data_swap := @toList_swap
|
||||
|
||||
theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
|
||||
theorem getElem?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
|
||||
if j = k then some a[i.1] else if i = k then some a[j.1] else a[k]? := by
|
||||
simp [swap_def, get?_set, ← getElem_fin_eq_toList_get]
|
||||
simp [swap_def, get?_set, ← getElem_fin_eq_getElem_toList]
|
||||
|
||||
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
|
||||
a.swapAt i v = (a[i.1], a.set i v) := rfl
|
||||
@@ -582,10 +534,14 @@ theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]?
|
||||
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
|
||||
a.swapAt! i v = (a[i], a.set ⟨i, h⟩ v) := by simp [swapAt!, h]
|
||||
|
||||
@[simp] theorem toList_pop (a : Array α) : a.pop.toList = a.toList.dropLast := by simp [pop]
|
||||
@[simp] theorem size_swapAt! (a : Array α) (i : Nat) (v : α) :
|
||||
(a.swapAt! i v).2.size = a.size := by
|
||||
simp only [swapAt!]
|
||||
split
|
||||
· simp
|
||||
· rfl
|
||||
|
||||
@[deprecated toList_pop (since := "2024-09-09")]
|
||||
abbrev data_pop := @toList_pop
|
||||
@[simp] theorem toList_pop (a : Array α) : a.pop.toList = a.toList.dropLast := by simp [pop]
|
||||
|
||||
@[simp] theorem pop_empty : (#[] : Array α).pop = #[] := rfl
|
||||
|
||||
@@ -619,9 +575,6 @@ theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size ≠ 0) :
|
||||
|
||||
theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rfl
|
||||
|
||||
@[deprecated size_eq_length_toList (since := "2024-09-09")]
|
||||
abbrev size_eq_length_data := @size_eq_length_toList
|
||||
|
||||
@[simp] theorem size_swap! (a : Array α) (i j) :
|
||||
(a.swap! i j).size = a.size := by unfold swap!; split <;> (try split) <;> simp [size_swap]
|
||||
|
||||
@@ -646,14 +599,10 @@ abbrev size_eq_length_data := @size_eq_length_toList
|
||||
@[simp] theorem toList_range (n : Nat) : (range n).toList = List.range n := by
|
||||
induction n <;> simp_all [range, Nat.fold, flip, List.range_succ]
|
||||
|
||||
@[deprecated toList_range (since := "2024-09-09")]
|
||||
abbrev data_range := @toList_range
|
||||
|
||||
@[simp]
|
||||
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
|
||||
simp [getElem_eq_getElem_toList]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[simp] theorem toList_reverse (a : Array α) : a.reverse.toList = a.toList.reverse := by
|
||||
let rec go (as : Array α) (i j hj)
|
||||
(h : i + j + 1 = a.size) (h₂ : as.size = a.size)
|
||||
@@ -666,9 +615,9 @@ set_option linter.deprecated false in
|
||||
· rwa [Nat.add_right_comm i]
|
||||
· simp [size_swap, h₂]
|
||||
· intro k
|
||||
rw [← getElem?_eq_toList_getElem?, get?_swap]
|
||||
rw [← getElem?_eq_getElem?_toList, getElem?_swap]
|
||||
simp only [H, getElem_eq_getElem_toList, ← List.getElem?_eq_getElem, Nat.le_of_lt h₁,
|
||||
getElem?_eq_toList_getElem?]
|
||||
getElem?_eq_getElem?_toList]
|
||||
split <;> rename_i h₂
|
||||
· simp only [← h₂, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, and_false]
|
||||
exact (List.getElem?_reverse' (j+1) i (Eq.trans (by simp_arith) h)).symm
|
||||
@@ -695,9 +644,6 @@ set_option linter.deprecated false in
|
||||
true_and, Nat.not_lt] at h
|
||||
rw [List.getElem?_eq_none_iff.2 ‹_›, List.getElem?_eq_none_iff.2 (a.toList.length_reverse ▸ ‹_›)]
|
||||
|
||||
@[deprecated toList_reverse (since := "2024-09-30")]
|
||||
abbrev reverse_toList := @toList_reverse
|
||||
|
||||
/-! ### foldl / foldr -/
|
||||
|
||||
@[simp] theorem foldlM_loop_empty [Monad m] (f : β → α → m β) (init : β) (i j : Nat) :
|
||||
@@ -726,7 +672,7 @@ abbrev reverse_toList := @toList_reverse
|
||||
foldrM f init #[] start stop = return init := by
|
||||
simp [foldrM]
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM` in Batteries,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldl_induction
|
||||
{as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive 0 init) {f : β → α → β}
|
||||
@@ -742,7 +688,7 @@ theorem foldl_induction
|
||||
· next hj => exact Nat.le_antisymm h₁ (Nat.ge_of_not_lt hj) ▸ H
|
||||
simpa [foldl, foldlM] using go (Nat.zero_le _) (Nat.le_refl _) h0
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldrM`,
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldrM` in Batteries,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldr_induction
|
||||
{as : Array α} (motive : Nat → β → Prop) {init : β} (h0 : motive as.size init) {f : α → β → β}
|
||||
@@ -788,9 +734,6 @@ theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : A
|
||||
toList <$> arr.mapM f = arr.toList.mapM f := by
|
||||
simp [mapM_eq_mapM_toList]
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
|
||||
theorem mapM_map_eq_foldl (as : Array α) (f : α → β) (i) :
|
||||
mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
|
||||
unfold mapM.map
|
||||
@@ -862,6 +805,12 @@ theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Pro
|
||||
· simp only [getElem_map, get_push, size_map]
|
||||
split <;> rfl
|
||||
|
||||
@[simp] theorem map_pop {f : α → β} {as : Array α} :
|
||||
as.pop.map f = (as.map f).pop := by
|
||||
ext
|
||||
· simp
|
||||
· simp only [getElem_map, getElem_pop, size_map]
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
|
||||
@@ -935,12 +884,6 @@ theorem getElem_modify_of_ne {as : Array α} {i : Nat} (h : i ≠ j)
|
||||
(as.modify i f)[j] = as[j]'(by simpa using hj) := by
|
||||
simp [getElem_modify hj, h]
|
||||
|
||||
@[deprecated getElem_modify (since := "2024-08-08")]
|
||||
theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
(arr.modify x f).get ⟨i, h⟩ =
|
||||
if x = i then f (arr.get ⟨i, by simpa using h⟩) else arr.get ⟨i, by simpa using h⟩ := by
|
||||
simp [getElem_modify h]
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@[simp] theorem toList_filter (p : α → Bool) (l : Array α) :
|
||||
@@ -954,9 +897,6 @@ theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
induction l with simp
|
||||
| cons => split <;> simp [*]
|
||||
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[simp] theorem filter_filter (q) (l : Array α) :
|
||||
filter p (filter q l) = filter (fun a => p a && q a) l := by
|
||||
apply ext'
|
||||
@@ -990,9 +930,6 @@ theorem filter_congr {as bs : Array α} (h : as = bs)
|
||||
· simp_all [Id.run, List.filterMap_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[simp] theorem mem_filterMap {f : α → Option β} {l : Array α} {b : β} :
|
||||
b ∈ filterMap f l ↔ ∃ a, a ∈ l ∧ f a = some b := by
|
||||
simp only [mem_def, toList_filterMap, List.mem_filterMap]
|
||||
@@ -1010,9 +947,6 @@ theorem size_empty : (#[] : Array α).size = 0 := rfl
|
||||
|
||||
theorem toList_empty : (#[] : Array α).toList = [] := rfl
|
||||
|
||||
@[deprecated toList_empty (since := "2024-09-09")]
|
||||
abbrev empty_data := @toList_empty
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
theorem push_eq_append_singleton (as : Array α) (x) : as.push x = as ++ #[x] := rfl
|
||||
@@ -1035,9 +969,6 @@ theorem getElem_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt :
|
||||
conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
|
||||
apply List.get_of_eq; rw [toList_append]
|
||||
|
||||
@[deprecated getElem_append_left (since := "2024-09-30")]
|
||||
abbrev get_append_left := @getElem_append_left
|
||||
|
||||
theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size ≤ i)
|
||||
(hlt : i - as.size < bs.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) :
|
||||
(as ++ bs)[i] = bs[i - as.size] := by
|
||||
@@ -1046,9 +977,6 @@ theorem getElem_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle :
|
||||
conv => rhs; rw [← List.getElem_append_right (h₁ := hle) (h₂ := h')]
|
||||
apply List.get_of_eq; rw [toList_append]
|
||||
|
||||
@[deprecated getElem_append_right (since := "2024-09-30")]
|
||||
abbrev get_append_right := @getElem_append_right
|
||||
|
||||
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
|
||||
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
|
||||
|
||||
@@ -1060,7 +988,7 @@ theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) :
|
||||
|
||||
/-! ### flatten -/
|
||||
|
||||
@[simp] theorem toList_flatten {l : Array (Array α)} : l.flatten.toList = (l.toList.map toList).join := by
|
||||
@[simp] theorem toList_flatten {l : Array (Array α)} : l.flatten.toList = (l.toList.map toList).flatten := by
|
||||
dsimp [flatten]
|
||||
simp only [foldl_eq_foldl_toList]
|
||||
generalize l.toList = l
|
||||
@@ -1071,7 +999,7 @@ theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) :
|
||||
| cons h => induction h.toList <;> simp [*]
|
||||
|
||||
theorem mem_flatten : ∀ {L : Array (Array α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l := by
|
||||
simp only [mem_def, toList_flatten, List.mem_join, List.mem_map]
|
||||
simp only [mem_def, toList_flatten, List.mem_flatten, List.mem_map]
|
||||
intro l
|
||||
constructor
|
||||
· rintro ⟨_, ⟨s, m, rfl⟩, h⟩
|
||||
@@ -1291,9 +1219,6 @@ theorem any_toList {p : α → Bool} (as : Array α) : as.toList.any p = as.any
|
||||
rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get]
|
||||
exact ⟨fun ⟨_, ⟨i, rfl⟩, h⟩ => ⟨i, h⟩, fun ⟨i, h⟩ => ⟨_, ⟨i, rfl⟩, h⟩⟩
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.any_toList`" (since := "2024-09-30")]
|
||||
abbrev any_def := @any_toList
|
||||
|
||||
/-! ### all -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
@@ -1333,9 +1258,6 @@ theorem all_toList {p : α → Bool} (as : Array α) : as.toList.all p = as.all
|
||||
rw [← getElem_eq_getElem_toList]
|
||||
exact w ⟨r, h⟩
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.all_toList`" (since := "2024-09-30")]
|
||||
abbrev all_def := @all_toList
|
||||
|
||||
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p ↔ ∀ x, x ∈ l → p x := by
|
||||
simp only [← all_toList, List.all_eq_true, mem_def]
|
||||
|
||||
@@ -1405,33 +1327,8 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
|
||||
· split <;> simp_all
|
||||
· split <;> simp_all
|
||||
|
||||
@[deprecated getElem_extract_loop_lt_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt_aux := @getElem_extract_loop_lt_aux
|
||||
@[deprecated getElem_extract_loop_lt (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt := @getElem_extract_loop_lt
|
||||
@[deprecated getElem_extract_loop_ge_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge_aux := @getElem_extract_loop_ge_aux
|
||||
@[deprecated getElem_extract_loop_ge (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge := @getElem_extract_loop_ge
|
||||
@[deprecated getElem_extract_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_aux := @getElem_extract_aux
|
||||
@[deprecated getElem_extract (since := "2024-09-30")]
|
||||
abbrev get_extract := @getElem_extract
|
||||
|
||||
@[deprecated getElem_swap_right (since := "2024-09-30")]
|
||||
abbrev get_swap_right := @getElem_swap_right
|
||||
@[deprecated getElem_swap_left (since := "2024-09-30")]
|
||||
abbrev get_swap_left := @getElem_swap_left
|
||||
@[deprecated getElem_swap_of_ne (since := "2024-09-30")]
|
||||
abbrev get_swap_of_ne := @getElem_swap_of_ne
|
||||
@[deprecated getElem_swap (since := "2024-09-30")]
|
||||
abbrev get_swap := @getElem_swap
|
||||
@[deprecated getElem_swap' (since := "2024-09-30")]
|
||||
abbrev get_swap' := @getElem_swap'
|
||||
|
||||
end Array
|
||||
|
||||
|
||||
open Array
|
||||
|
||||
namespace List
|
||||
@@ -1567,7 +1464,7 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
|
||||
l.toArray.filterMap f = (l.filterMap f).toArray := by
|
||||
simp
|
||||
|
||||
@[simp] theorem flatten_toArray (l : List (List α)) : (l.toArray.map List.toArray).flatten = l.join.toArray := by
|
||||
@[simp] theorem flatten_toArray (l : List (List α)) : (l.toArray.map List.toArray).flatten = l.flatten.toArray := by
|
||||
apply ext'
|
||||
simp [Function.comp_def]
|
||||
|
||||
@@ -1576,3 +1473,158 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
|
||||
simp
|
||||
|
||||
end List
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
namespace List
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
|
||||
theorem toArray_concat {as : List α} {x : α} :
|
||||
(as ++ [x]).toArray = as.toArray.push x := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
end List
|
||||
|
||||
namespace Array
|
||||
|
||||
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
|
||||
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[deprecated length_toList (since := "2024-09-09")]
|
||||
abbrev data_length := @length_toList
|
||||
|
||||
@[deprecated toList_map (since := "2024-09-09")]
|
||||
abbrev map_data := @toList_map
|
||||
|
||||
@[deprecated foldl_toList_eq_flatMap (since := "2024-10-16")]
|
||||
abbrev foldl_toList_eq_bind := @foldl_toList_eq_flatMap
|
||||
|
||||
@[deprecated foldl_toList_eq_flatMap (since := "2024-10-16")]
|
||||
abbrev foldl_data_eq_bind := @foldl_toList_eq_flatMap
|
||||
|
||||
@[deprecated foldl_toList_eq_map (since := "2024-09-09")]
|
||||
abbrev foldl_data_eq_map := @foldl_toList_eq_map
|
||||
|
||||
@[deprecated toList_mkArray (since := "2024-09-09")]
|
||||
abbrev mkArray_data := @toList_mkArray
|
||||
|
||||
@[deprecated mem_toList (since := "2024-09-09")]
|
||||
abbrev mem_data := @mem_toList
|
||||
|
||||
@[deprecated getElem_mem (since := "2024-10-17")]
|
||||
abbrev getElem?_mem := @getElem_mem
|
||||
|
||||
@[deprecated getElem_fin_eq_getElem_toList (since := "2024-10-17")]
|
||||
abbrev getElem_fin_eq_toList_get := @getElem_fin_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_fin_eq_getElem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_fin_eq_data_get := @getElem_fin_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
@[deprecated getElem?_eq_getElem?_toList (since := "2024-10-17")]
|
||||
abbrev getElem?_eq_toList_getElem? := @getElem?_eq_getElem?_toList
|
||||
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-30")]
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
|
||||
@[deprecated get?_eq_get?_toList (since := "2024-10-17")]
|
||||
abbrev get?_eq_toList_get? := @get?_eq_get?_toList
|
||||
|
||||
@[deprecated get?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev get?_eq_data_get? := @get?_eq_get?_toList
|
||||
|
||||
@[deprecated toList_set (since := "2024-09-09")]
|
||||
abbrev data_set := @toList_set
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
abbrev data_swap := @toList_swap
|
||||
|
||||
@[deprecated getElem?_swap (since := "2024-10-17")] abbrev get?_swap := @getElem?_swap
|
||||
|
||||
@[deprecated toList_pop (since := "2024-09-09")] abbrev data_pop := @toList_pop
|
||||
|
||||
@[deprecated size_eq_length_toList (since := "2024-09-09")]
|
||||
abbrev size_eq_length_data := @size_eq_length_toList
|
||||
|
||||
@[deprecated toList_range (since := "2024-09-09")]
|
||||
abbrev data_range := @toList_range
|
||||
|
||||
@[deprecated toList_reverse (since := "2024-09-30")]
|
||||
abbrev reverse_toList := @toList_reverse
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
|
||||
@[deprecated getElem_modify (since := "2024-08-08")]
|
||||
theorem get_modify {arr : Array α} {x i} (h : i < (arr.modify x f).size) :
|
||||
(arr.modify x f).get ⟨i, h⟩ =
|
||||
if x = i then f (arr.get ⟨i, by simpa using h⟩) else arr.get ⟨i, by simpa using h⟩ := by
|
||||
simp [getElem_modify h]
|
||||
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[deprecated toList_empty (since := "2024-09-09")]
|
||||
abbrev empty_data := @toList_empty
|
||||
|
||||
@[deprecated getElem_append_left (since := "2024-09-30")]
|
||||
abbrev get_append_left := @getElem_append_left
|
||||
|
||||
@[deprecated getElem_append_right (since := "2024-09-30")]
|
||||
abbrev get_append_right := @getElem_append_right
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.any_toList`" (since := "2024-09-30")]
|
||||
abbrev any_def := @any_toList
|
||||
|
||||
@[deprecated "Use the reverse direction of `Array.all_toList`" (since := "2024-09-30")]
|
||||
abbrev all_def := @all_toList
|
||||
|
||||
@[deprecated getElem_extract_loop_lt_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt_aux := @getElem_extract_loop_lt_aux
|
||||
@[deprecated getElem_extract_loop_lt (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_lt := @getElem_extract_loop_lt
|
||||
@[deprecated getElem_extract_loop_ge_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge_aux := @getElem_extract_loop_ge_aux
|
||||
@[deprecated getElem_extract_loop_ge (since := "2024-09-30")]
|
||||
abbrev get_extract_loop_ge := @getElem_extract_loop_ge
|
||||
@[deprecated getElem_extract_aux (since := "2024-09-30")]
|
||||
abbrev get_extract_aux := @getElem_extract_aux
|
||||
@[deprecated getElem_extract (since := "2024-09-30")]
|
||||
abbrev get_extract := @getElem_extract
|
||||
|
||||
@[deprecated getElem_swap_right (since := "2024-09-30")]
|
||||
abbrev get_swap_right := @getElem_swap_right
|
||||
@[deprecated getElem_swap_left (since := "2024-09-30")]
|
||||
abbrev get_swap_left := @getElem_swap_left
|
||||
@[deprecated getElem_swap_of_ne (since := "2024-09-30")]
|
||||
abbrev get_swap_of_ne := @getElem_swap_of_ne
|
||||
@[deprecated getElem_swap (since := "2024-09-30")]
|
||||
abbrev get_swap := @getElem_swap
|
||||
@[deprecated getElem_swap' (since := "2024-09-30")]
|
||||
abbrev get_swap' := @getElem_swap'
|
||||
|
||||
end Array
|
||||
|
||||
@@ -1,19 +1,20 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
|
||||
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed, Siddharth Bhat
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.Nat.Bitwise.Lemmas
|
||||
import Init.Data.Nat.Power2
|
||||
import Init.Data.Int.Bitwise
|
||||
import Init.Data.BitVec.BasicAux
|
||||
|
||||
/-!
|
||||
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
|
||||
(Lean has special support for `Nat`), alignment with `UIntXY` types which are also represented
|
||||
with `Fin`, and the fact that bitwise operations on `Fin` are already defined. Some other possible
|
||||
representations are `List Bool`, `{ l : List Bool // l.length = w }`, `Fin w → Bool`.
|
||||
We define the basic algebraic structure of bitvectors. We choose the `Fin` representation over
|
||||
others for its relative efficiency (Lean has special support for `Nat`), and the fact that bitwise
|
||||
operations on `Fin` are already defined. Some other possible representations are `List Bool`,
|
||||
`{ l : List Bool // l.length = w }`, `Fin w → Bool`.
|
||||
|
||||
We define many of the bitvector operations from the
|
||||
[`QF_BV` logic](https://smtlib.cs.uiowa.edu/logics-all.shtml#QF_BV).
|
||||
@@ -22,60 +23,12 @@ of SMT-LIBv2.
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
/--
|
||||
A bitvector of the specified width.
|
||||
|
||||
This is represented as the underlying `Nat` number in both the runtime
|
||||
and the kernel, inheriting all the special support for `Nat`.
|
||||
-/
|
||||
structure BitVec (w : Nat) where
|
||||
/-- Construct a `BitVec w` from a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
ofFin ::
|
||||
/-- Interpret a bitvector as a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
toFin : Fin (2^w)
|
||||
|
||||
/--
|
||||
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
|
||||
-/
|
||||
-- We manually derive the `DecidableEq` instances for `BitVec` because
|
||||
-- we want to have builtin support for bit-vector literals, and we
|
||||
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
|
||||
def BitVec.decEq (x y : BitVec n) : Decidable (x = y) :=
|
||||
match x, y with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
if h : n = m then
|
||||
isTrue (h ▸ rfl)
|
||||
else
|
||||
isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h))
|
||||
|
||||
instance : DecidableEq (BitVec n) := BitVec.decEq
|
||||
|
||||
namespace BitVec
|
||||
|
||||
section Nat
|
||||
|
||||
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
|
||||
toFin := ⟨i, p⟩
|
||||
|
||||
/-- The `BitVec` with value `i mod 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
|
||||
toFin := Fin.ofNat' (2^n) i
|
||||
|
||||
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
|
||||
instance natCastInst : NatCast (BitVec w) := ⟨BitVec.ofNat w⟩
|
||||
|
||||
/-- Given a bitvector `x`, return the underlying `Nat`. This is O(1) because `BitVec` is a
|
||||
(zero-cost) wrapper around a `Nat`. -/
|
||||
protected def toNat (x : BitVec n) : Nat := x.toFin.val
|
||||
|
||||
/-- Return the bound in terms of toNat. -/
|
||||
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
|
||||
|
||||
@[deprecated isLt (since := "2024-03-12")]
|
||||
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
|
||||
|
||||
@@ -238,22 +191,6 @@ end repr_toString
|
||||
|
||||
section arithmetic
|
||||
|
||||
/--
|
||||
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
|
||||
modulo `2^n`.
|
||||
|
||||
SMT-Lib name: `bvadd`.
|
||||
-/
|
||||
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
|
||||
instance : Add (BitVec n) := ⟨BitVec.add⟩
|
||||
|
||||
/--
|
||||
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
|
||||
modulo `2^n`.
|
||||
-/
|
||||
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
|
||||
instance : Sub (BitVec n) := ⟨BitVec.sub⟩
|
||||
|
||||
/--
|
||||
Negation for bit vectors. This can be interpreted as either signed or unsigned negation
|
||||
modulo `2^n`.
|
||||
@@ -387,10 +324,6 @@ SMT-Lib name: `bvult`.
|
||||
-/
|
||||
protected def ult (x y : BitVec n) : Bool := x.toNat < y.toNat
|
||||
|
||||
instance : LT (BitVec n) where lt := (·.toNat < ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (x < y) :=
|
||||
inferInstanceAs (Decidable (x.toNat < y.toNat))
|
||||
|
||||
/--
|
||||
Unsigned less-than-or-equal-to for bit vectors.
|
||||
|
||||
@@ -398,10 +331,6 @@ SMT-Lib name: `bvule`.
|
||||
-/
|
||||
protected def ule (x y : BitVec n) : Bool := x.toNat ≤ y.toNat
|
||||
|
||||
instance : LE (BitVec n) where le := (·.toNat ≤ ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (x ≤ y) :=
|
||||
inferInstanceAs (Decidable (x.toNat ≤ y.toNat))
|
||||
|
||||
/--
|
||||
Signed less-than for bit vectors.
|
||||
|
||||
@@ -718,6 +647,8 @@ section normalization_eqs
|
||||
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
|
||||
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
|
||||
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
|
||||
@[simp] theorem udiv_eq (x y : BitVec w) : BitVec.udiv x y = x / y := rfl
|
||||
@[simp] theorem umod_eq (x y : BitVec w) : BitVec.umod x y = x % y := rfl
|
||||
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
|
||||
end normalization_eqs
|
||||
|
||||
|
||||
52
src/Init/Data/BitVec/BasicAux.lean
Normal file
52
src/Init/Data/BitVec/BasicAux.lean
Normal file
@@ -0,0 +1,52 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
/-!
|
||||
This module exists to provide the very basic `BitVec` definitions required for
|
||||
`Init.Data.UInt.BasicAux`.
|
||||
-/
|
||||
|
||||
namespace BitVec
|
||||
|
||||
section Nat
|
||||
|
||||
/-- The `BitVec` with value `i mod 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
|
||||
toFin := Fin.ofNat' (2^n) i
|
||||
|
||||
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
|
||||
|
||||
/-- Return the bound in terms of toNat. -/
|
||||
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
|
||||
|
||||
end Nat
|
||||
|
||||
section arithmetic
|
||||
|
||||
/--
|
||||
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
|
||||
modulo `2^n`.
|
||||
|
||||
SMT-Lib name: `bvadd`.
|
||||
-/
|
||||
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
|
||||
instance : Add (BitVec n) := ⟨BitVec.add⟩
|
||||
|
||||
/--
|
||||
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
|
||||
modulo `2^n`.
|
||||
-/
|
||||
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
|
||||
instance : Sub (BitVec n) := ⟨BitVec.sub⟩
|
||||
|
||||
end arithmetic
|
||||
|
||||
end BitVec
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
|
||||
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix, Siddharth Bhat
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.BitVec.Folds
|
||||
@@ -18,6 +18,80 @@ as vectors of bits into proofs about Lean `BitVec` values.
|
||||
The module is named for the bit-blasting operation in an SMT solver that converts bitvector
|
||||
expressions into expressions about individual bits in each vector.
|
||||
|
||||
### Example: How bitblasting works for multiplication
|
||||
|
||||
We explain how the lemmas here are used for bitblasting,
|
||||
by using multiplication as a prototypical example.
|
||||
Other bitblasters for other operations follow the same pattern.
|
||||
To bitblast a multiplication of the form `x * y`,
|
||||
we must unfold the above into a form that the SAT solver understands.
|
||||
|
||||
We assume that the solver already knows how to bitblast addition.
|
||||
This is known to `bv_decide`, by exploiting the lemma `add_eq_adc`,
|
||||
which says that `x + y : BitVec w` equals `(adc x y false).2`,
|
||||
where `adc` builds an add-carry circuit in terms of the primitive operations
|
||||
(bitwise and, bitwise or, bitwise xor) that bv_decide already understands.
|
||||
In this way, we layer bitblasters on top of each other,
|
||||
by reducing the multiplication bitblaster to an addition operation.
|
||||
|
||||
The core lemma is given by `getLsbD_mul`:
|
||||
|
||||
```lean
|
||||
x y : BitVec w ⊢ (x * y).getLsbD i = (mulRec x y w).getLsbD i
|
||||
```
|
||||
|
||||
Which says that the `i`th bit of `x * y` can be obtained by
|
||||
evaluating the `i`th bit of `(mulRec x y w)`.
|
||||
Once again, we assume that `bv_decide` knows how to implement `getLsbD`,
|
||||
given that `mulRec` can be understood by `bv_decide`.
|
||||
|
||||
We write two lemmas to enable `bv_decide` to unfold `(mulRec x y w)`
|
||||
into a complete circuit, **when `w` is a known constant**`.
|
||||
This is given by two recurrence lemmas, `mulRec_zero_eq` and `mulRec_succ_eq`,
|
||||
which are applied repeatedly when the width is `0` and when the width is `w' + 1`:
|
||||
|
||||
```lean
|
||||
mulRec_zero_eq :
|
||||
mulRec x y 0 =
|
||||
if y.getLsbD 0 then x else 0
|
||||
|
||||
mulRec_succ_eq
|
||||
mulRec x y (s + 1) =
|
||||
mulRec x y s +
|
||||
if y.getLsbD (s + 1) then (x <<< (s + 1)) else 0 := rfl
|
||||
```
|
||||
|
||||
By repeatedly applying the lemmas `mulRec_zero_eq` and `mulRec_succ_eq`,
|
||||
one obtains a circuit for multiplication.
|
||||
Note that this circuit uses `BitVec.add`, `BitVec.getLsbD`, `BitVec.shiftLeft`.
|
||||
Here, `BitVec.add` and `BitVec.shiftLeft` are (recursively) bitblasted by `bv_decide`,
|
||||
using the lemmas `add_eq_adc` and `shiftLeft_eq_shiftLeftRec`,
|
||||
and `BitVec.getLsbD` is a primitive that `bv_decide` knows how to reduce to SAT.
|
||||
|
||||
The two lemmas, `mulRec_zero_eq`, and `mulRec_succ_eq`,
|
||||
are used in `Std.Tactic.BVDecide.BVExpr.bitblast.blastMul`
|
||||
to prove the correctness of the circuit that is built by `bv_decide`.
|
||||
|
||||
```lean
|
||||
def blastMul (aig : AIG BVBit) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry BVBit w
|
||||
theorem denote_blastMul (aig : AIG BVBit) (lhs rhs : BitVec w) (assign : Assignment) :
|
||||
...
|
||||
⟦(blastMul aig input).aig, (blastMul aig input).vec.get idx hidx, assign.toAIGAssignment⟧
|
||||
=
|
||||
(lhs * rhs).getLsbD idx
|
||||
```
|
||||
|
||||
The definition and theorem above are internal to `bv_decide`,
|
||||
and use `mulRec_{zero,succ}_eq` to prove that the circuit built by `bv_decide`
|
||||
computes the correct value for multiplication.
|
||||
|
||||
To zoom out, therefore, we follow two steps:
|
||||
First, we prove bitvector lemmas to unfold a high-level operation (such as multiplication)
|
||||
into already bitblastable operations (such as addition and left shift).
|
||||
We then use these lemmas to prove the correctness of the circuit that `bv_decide` builds.
|
||||
|
||||
We use this workflow to implement bitblasting for all SMT-LIB2 operations.
|
||||
|
||||
## Main results
|
||||
* `x + y : BitVec w` is `(adc x y false).2`.
|
||||
|
||||
@@ -193,6 +267,21 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
|
||||
|
||||
/-! ### add -/
|
||||
|
||||
theorem getMsbD_add {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
getMsbD (x + y) i =
|
||||
Bool.xor (getMsbD x i) (Bool.xor (getMsbD y i) (carry (w - 1 - i) x y false)) := by
|
||||
simp [getMsbD, getLsbD_add, i_lt, show w - 1 - i < w by omega]
|
||||
|
||||
theorem msb_add {w : Nat} {x y: BitVec w} :
|
||||
(x + y).msb =
|
||||
Bool.xor x.msb (Bool.xor y.msb (carry (w - 1) x y false)) := by
|
||||
simp only [BitVec.msb, BitVec.getMsbD]
|
||||
by_cases h : w ≤ 0
|
||||
· simp [h, show w = 0 by omega]
|
||||
· rw [getLsbD_add (x := x)]
|
||||
simp [show w > 0 by omega]
|
||||
omega
|
||||
|
||||
/-- Adding a bitvector to its own complement yields the all ones bitpattern -/
|
||||
@[simp] theorem add_not_self (x : BitVec w) : x + ~~~x = allOnes w := by
|
||||
rw [add_eq_adc, adc, iunfoldr_replace (fun _ => false) (allOnes w)]
|
||||
@@ -218,6 +307,26 @@ theorem add_eq_or_of_and_eq_zero {w : Nat} (x y : BitVec w)
|
||||
simp_all [hx]
|
||||
· by_cases hx : x.getLsbD i <;> simp_all [hx]
|
||||
|
||||
/-! ### Sub-/
|
||||
|
||||
theorem getLsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
(x - y).getLsbD i
|
||||
= (x.getLsbD i ^^ ((~~~y + 1#w).getLsbD i ^^ carry i x (~~~y + 1#w) false)) := by
|
||||
rw [sub_toAdd, BitVec.neg_eq_not_add, getLsbD_add]
|
||||
omega
|
||||
|
||||
theorem getMsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
|
||||
(x - y).getMsbD i =
|
||||
(x.getMsbD i ^^ ((~~~y + 1).getMsbD i ^^ carry (w - 1 - i) x (~~~y + 1) false)) := by
|
||||
rw [sub_toAdd, neg_eq_not_add, getMsbD_add]
|
||||
· rfl
|
||||
· omega
|
||||
|
||||
theorem msb_sub {x y: BitVec w} :
|
||||
(x - y).msb
|
||||
= (x.msb ^^ ((~~~y + 1#w).msb ^^ carry (w - 1 - 0) x (~~~y + 1#w) false)) := by
|
||||
simp [sub_toAdd, BitVec.neg_eq_not_add, msb_add]
|
||||
|
||||
/-! ### Negation -/
|
||||
|
||||
theorem bit_not_testBit (x : BitVec w) (i : Fin w) :
|
||||
@@ -497,7 +606,7 @@ then `n.udiv d = q`. -/
|
||||
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
|
||||
(hrd : r < d)
|
||||
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
|
||||
n.udiv d = q := by
|
||||
n / d = q := by
|
||||
apply BitVec.eq_of_toNat_eq
|
||||
rw [toNat_udiv]
|
||||
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
|
||||
@@ -513,7 +622,7 @@ theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
|
||||
then `n.umod d = r`. -/
|
||||
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
|
||||
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
|
||||
n.umod d = r := by
|
||||
n % d = r := by
|
||||
apply BitVec.eq_of_toNat_eq
|
||||
rw [toNat_umod]
|
||||
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
|
||||
@@ -614,7 +723,7 @@ quotient has been correctly computed.
|
||||
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
|
||||
(h_lawful : DivModState.Lawful {n, d} qr)
|
||||
(h_final : qr.wn = 0) :
|
||||
n.udiv d = qr.q := by
|
||||
n / d = qr.q := by
|
||||
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
|
||||
have hdiv := h_lawful.hdiv
|
||||
simp only [h_final] at *
|
||||
@@ -627,7 +736,7 @@ remainder has been correctly computed.
|
||||
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
|
||||
(h : DivModState.Lawful {n, d} qr)
|
||||
(h_final : qr.wn = 0) :
|
||||
n.umod d = qr.r := by
|
||||
n % d = qr.r := by
|
||||
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
|
||||
have hdiv := h.hdiv
|
||||
simp only [shiftRight_zero] at hdiv
|
||||
@@ -693,7 +802,7 @@ theorem DivModState.toNat_shiftRight_sub_one_eq
|
||||
omega
|
||||
|
||||
/--
|
||||
This is used when proving the correctness of the divison algorithm,
|
||||
This is used when proving the correctness of the division algorithm,
|
||||
where we know that `r < d`.
|
||||
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
|
||||
In arithmetic, this is the same as showing that
|
||||
@@ -801,7 +910,7 @@ theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
|
||||
/-- The result of `udiv` agrees with the result of the division recurrence. -/
|
||||
theorem udiv_eq_divRec (hd : 0#w < d) :
|
||||
let out := divRec w {n, d} (DivModState.init w)
|
||||
n.udiv d = out.q := by
|
||||
n / d = out.q := by
|
||||
have := DivModState.lawful_init {n, d} hd
|
||||
have := lawful_divRec this
|
||||
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
|
||||
@@ -809,7 +918,7 @@ theorem udiv_eq_divRec (hd : 0#w < d) :
|
||||
/-- The result of `umod` agrees with the result of the division recurrence. -/
|
||||
theorem umod_eq_divRec (hd : 0#w < d) :
|
||||
let out := divRec w {n, d} (DivModState.init w)
|
||||
n.umod d = out.r := by
|
||||
n % d = out.r := by
|
||||
have := DivModState.lawful_init {n, d} hd
|
||||
have := lawful_divRec this
|
||||
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed,
|
||||
Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed, Siddharth Bhat
|
||||
|
||||
-/
|
||||
prelude
|
||||
@@ -219,9 +219,25 @@ theorem getMsbD_of_zero_length (h : w = 0) (x : BitVec w) : x.getMsbD i = false
|
||||
theorem msb_of_zero_length (h : w = 0) (x : BitVec w) : x.msb = false := by
|
||||
subst h; simp [msb_zero_length]
|
||||
|
||||
theorem ofFin_ofNat (n : Nat) :
|
||||
ofFin (no_index (OfNat.ofNat n : Fin (2^w))) = OfNat.ofNat n := by
|
||||
simp only [OfNat.ofNat, Fin.ofNat', BitVec.ofNat, Nat.and_pow_two_sub_one_eq_mod]
|
||||
|
||||
theorem eq_of_toFin_eq : ∀ {x y : BitVec w}, x.toFin = y.toFin → x = y
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
|
||||
theorem toFin_inj {x y : BitVec w} : x.toFin = y.toFin ↔ x = y := by
|
||||
apply Iff.intro
|
||||
case mp =>
|
||||
exact @eq_of_toFin_eq w x y
|
||||
case mpr =>
|
||||
intro h
|
||||
simp [toFin, h]
|
||||
|
||||
theorem toFin_zero : toFin (0 : BitVec w) = 0 := rfl
|
||||
theorem toFin_one : toFin (1 : BitVec w) = 1 := by
|
||||
rw [toFin_inj]; simp only [ofNat_eq_ofNat, ofFin_ofNat]
|
||||
|
||||
@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
|
||||
cases b <;> rfl
|
||||
|
||||
@@ -270,6 +286,19 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
|
||||
|
||||
@[simp] theorem getMsbD_zero : (0#w).getMsbD i = false := by simp [getMsbD]
|
||||
|
||||
@[simp] theorem getLsbD_one : (1#w).getLsbD i = (decide (0 < w) && decide (i = 0)) := by
|
||||
simp only [getLsbD, toNat_ofNat, Nat.testBit_mod_two_pow]
|
||||
by_cases h : i = 0
|
||||
<;> simp [h, Nat.testBit_to_div_mod, Nat.div_eq_of_lt]
|
||||
|
||||
@[simp] theorem getElem_one (h : i < w) : (1#w)[i] = decide (i = 0) := by
|
||||
simp [← getLsbD_eq_getElem, getLsbD_one, h, show 0 < w by omega]
|
||||
|
||||
/-- The msb at index `w-1` is the least significant bit, and is true when the width is nonzero. -/
|
||||
@[simp] theorem getMsbD_one : (1#w).getMsbD i = (decide (i = w - 1) && decide (0 < w)) := by
|
||||
simp only [getMsbD]
|
||||
by_cases h : 0 < w <;> by_cases h' : i = w - 1 <;> simp [h, h'] <;> omega
|
||||
|
||||
@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat :=
|
||||
Nat.mod_eq_of_lt x.isLt
|
||||
|
||||
@@ -331,6 +360,10 @@ theorem getElem_ofBool {b : Bool} {i : Nat} : (ofBool b)[0] = b := by
|
||||
|
||||
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
|
||||
|
||||
@[simp] theorem msb_one : (1#w).msb = decide (w = 1) := by
|
||||
simp [BitVec.msb, getMsbD_one, ← Bool.decide_and]
|
||||
omega
|
||||
|
||||
theorem msb_eq_getLsbD_last (x : BitVec w) :
|
||||
x.msb = x.getLsbD (w - 1) := by
|
||||
simp only [BitVec.msb, getMsbD]
|
||||
@@ -434,7 +467,7 @@ theorem toInt_inj {x y : BitVec n} : x.toInt = y.toInt ↔ x = y :=
|
||||
theorem toInt_ne {x y : BitVec n} : x.toInt ≠ y.toInt ↔ x ≠ y := by
|
||||
rw [Ne, toInt_inj]
|
||||
|
||||
@[simp] theorem toNat_ofInt {n : Nat} (i : Int) :
|
||||
@[simp, bv_toNat] theorem toNat_ofInt {n : Nat} (i : Int) :
|
||||
(BitVec.ofInt n i).toNat = (i % (2^n : Nat)).toNat := by
|
||||
unfold BitVec.ofInt
|
||||
simp
|
||||
@@ -919,6 +952,21 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
_ ≤ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w
|
||||
· simp
|
||||
|
||||
@[simp] theorem ofInt_negSucc_eq_not_ofNat {w n : Nat} :
|
||||
BitVec.ofInt w (Int.negSucc n) = ~~~.ofNat w n := by
|
||||
simp only [BitVec.ofInt, Int.toNat, Int.ofNat_eq_coe, toNat_eq, toNat_ofNatLt, toNat_not,
|
||||
toNat_ofNat]
|
||||
cases h : Int.negSucc n % ((2 ^ w : Nat) : Int)
|
||||
case ofNat =>
|
||||
rw [Int.ofNat_eq_coe, Int.negSucc_emod] at h
|
||||
· dsimp only
|
||||
omega
|
||||
· omega
|
||||
case negSucc a =>
|
||||
have neg := Int.negSucc_lt_zero a
|
||||
have _ : 0 ≤ Int.negSucc n % ((2 ^ w : Nat) : Int) := Int.emod_nonneg _ (by omega)
|
||||
omega
|
||||
|
||||
@[simp] theorem toFin_not (x : BitVec w) :
|
||||
(~~~x).toFin = x.toFin.rev := by
|
||||
apply Fin.val_inj.mp
|
||||
@@ -961,6 +1009,15 @@ theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
|
||||
ext i
|
||||
simp
|
||||
|
||||
theorem not_eq_comm {x y : BitVec w} : ~~~ x = y ↔ x = ~~~ y := by
|
||||
constructor
|
||||
· intro h
|
||||
rw [← h]
|
||||
simp
|
||||
· intro h
|
||||
rw [h]
|
||||
simp
|
||||
|
||||
@[simp] theorem getMsb_not {x : BitVec w} :
|
||||
(~~~x).getMsbD i = (decide (i < w) && !(x.getMsbD i)) := by
|
||||
simp only [getMsbD]
|
||||
@@ -1183,6 +1240,28 @@ theorem toNat_ushiftRight_lt (x : BitVec w) (n : Nat) (hn : n ≤ w) :
|
||||
· apply hn
|
||||
· apply Nat.pow_pos (by decide)
|
||||
|
||||
@[simp]
|
||||
theorem getMsbD_ushiftRight {x : BitVec w} {i n : Nat} :
|
||||
(x >>> n).getMsbD i = (decide (i < w) && (!decide (i < n) && x.getMsbD (i - n))) := by
|
||||
simp only [getMsbD, getLsbD_ushiftRight]
|
||||
by_cases h : i < n
|
||||
· simp [getLsbD_ge, show w ≤ (n + (w - 1 - i)) by omega]
|
||||
omega
|
||||
· by_cases h₁ : i < w
|
||||
· simp only [h, ushiftRight_eq, getLsbD_ushiftRight, show i - n < w by omega]
|
||||
congr
|
||||
omega
|
||||
· simp [h, h₁]
|
||||
|
||||
@[simp]
|
||||
theorem msb_ushiftRight {x : BitVec w} {n : Nat} :
|
||||
(x >>> n).msb = (!decide (0 < n) && x.msb) := by
|
||||
induction n
|
||||
case zero =>
|
||||
simp
|
||||
case succ nn ih =>
|
||||
simp [BitVec.ushiftRight_eq, getMsbD_ushiftRight, BitVec.msb, ih, show nn + 1 > 0 by omega]
|
||||
|
||||
/-! ### ushiftRight reductions from BitVec to Nat -/
|
||||
|
||||
@[simp]
|
||||
@@ -1287,7 +1366,8 @@ theorem sshiftRight_or_distrib (x y : BitVec w) (n : Nat) :
|
||||
<;> simp [*]
|
||||
|
||||
/-- The msb after arithmetic shifting right equals the original msb. -/
|
||||
theorem sshiftRight_msb_eq_msb {n : Nat} {x : BitVec w} :
|
||||
@[simp]
|
||||
theorem msb_sshiftRight {n : Nat} {x : BitVec w} :
|
||||
(x.sshiftRight n).msb = x.msb := by
|
||||
rw [msb_eq_getLsbD_last, getLsbD_sshiftRight, msb_eq_getLsbD_last]
|
||||
by_cases hw₀ : w = 0
|
||||
@@ -1314,7 +1394,7 @@ theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
|
||||
by_cases h₃ : m + (n + ↑i) < w
|
||||
· simp [h₃]
|
||||
omega
|
||||
· simp [h₃, sshiftRight_msb_eq_msb]
|
||||
· simp [h₃, msb_sshiftRight]
|
||||
|
||||
theorem not_sshiftRight {b : BitVec w} :
|
||||
~~~b.sshiftRight n = (~~~b).sshiftRight n := by
|
||||
@@ -1332,98 +1412,55 @@ theorem not_sshiftRight_not {x : BitVec w} {n : Nat} :
|
||||
~~~((~~~x).sshiftRight n) = x.sshiftRight n := by
|
||||
simp [not_sshiftRight]
|
||||
|
||||
@[simp]
|
||||
theorem getMsbD_sshiftRight {x : BitVec w} {i n : Nat} :
|
||||
getMsbD (x.sshiftRight n) i = (decide (i < w) && if i < n then x.msb else getMsbD x (i - n)) := by
|
||||
simp only [getMsbD, BitVec.getLsbD_sshiftRight]
|
||||
by_cases h : i < w
|
||||
· simp only [h, decide_True, Bool.true_and]
|
||||
by_cases h₁ : w ≤ w - 1 - i
|
||||
· simp [h₁]
|
||||
omega
|
||||
· simp only [h₁, decide_False, Bool.not_false, Bool.true_and]
|
||||
by_cases h₂ : i < n
|
||||
· simp only [h₂, ↓reduceIte, ite_eq_right_iff]
|
||||
omega
|
||||
· simp only [show i - n < w by omega, h₂, ↓reduceIte, decide_True, Bool.true_and]
|
||||
by_cases h₄ : n + (w - 1 - i) < w <;> (simp only [h₄, ↓reduceIte]; congr; omega)
|
||||
· simp [h]
|
||||
|
||||
/-! ### sshiftRight reductions from BitVec to Nat -/
|
||||
|
||||
@[simp]
|
||||
theorem sshiftRight_eq' (x : BitVec w) : x.sshiftRight' y = x.sshiftRight y.toNat := rfl
|
||||
|
||||
/-! ### udiv -/
|
||||
@[simp]
|
||||
theorem getLsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
|
||||
getLsbD (x.sshiftRight' y) i =
|
||||
(!decide (w ≤ i) && if y.toNat + i < w then x.getLsbD (y.toNat + i) else x.msb) := by
|
||||
simp only [BitVec.sshiftRight', BitVec.getLsbD_sshiftRight]
|
||||
|
||||
theorem udiv_eq {x y : BitVec n} : x.udiv y = BitVec.ofNat n (x.toNat / y.toNat) := by
|
||||
have h : x.toNat / y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
|
||||
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_udiv {x y : BitVec n} : (x.udiv y).toNat = x.toNat / y.toNat := by
|
||||
simp only [udiv_eq]
|
||||
by_cases h : y = 0
|
||||
@[simp]
|
||||
theorem getMsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
|
||||
(x.sshiftRight y.toNat).getMsbD i = (decide (i < w) && if i < y.toNat then x.msb else x.getMsbD (i - y.toNat)) := by
|
||||
simp only [BitVec.sshiftRight', getMsbD, BitVec.getLsbD_sshiftRight]
|
||||
by_cases h : i < w
|
||||
· simp only [h, decide_True, Bool.true_and]
|
||||
by_cases h₁ : w ≤ w - 1 - i
|
||||
· simp [h₁]
|
||||
omega
|
||||
· simp only [h₁, decide_False, Bool.not_false, Bool.true_and]
|
||||
by_cases h₂ : i < y.toNat
|
||||
· simp only [h₂, ↓reduceIte, ite_eq_right_iff]
|
||||
omega
|
||||
· simp only [show i - y.toNat < w by omega, h₂, ↓reduceIte, decide_True, Bool.true_and]
|
||||
by_cases h₄ : y.toNat + (w - 1 - i) < w <;> (simp only [h₄, ↓reduceIte]; congr; omega)
|
||||
· simp [h]
|
||||
· rw [toNat_ofNat, Nat.mod_eq_of_lt]
|
||||
exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
|
||||
|
||||
/-! ### umod -/
|
||||
|
||||
theorem umod_eq {x y : BitVec n} :
|
||||
x.umod y = BitVec.ofNat n (x.toNat % y.toNat) := by
|
||||
have h : x.toNat % y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt
|
||||
simp [umod, bv_toNat, Nat.mod_eq_of_lt h]
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_umod {x y : BitVec n} :
|
||||
(x.umod y).toNat = x.toNat % y.toNat := rfl
|
||||
|
||||
/-! ### sdiv -/
|
||||
|
||||
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
|
||||
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => udiv x y
|
||||
| false, true => - (x.udiv (- y))
|
||||
| true, false => - ((- x).udiv y)
|
||||
| true, true => (- x).udiv (- y) := by
|
||||
rw [BitVec.sdiv]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (udiv x y).toNat
|
||||
| false, true => (- (x.udiv (- y))).toNat
|
||||
| true, false => (- ((- x).udiv y)).toNat
|
||||
| true, true => ((- x).udiv (- y)).toNat := by
|
||||
simp only [sdiv_eq, toNat_udiv]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
|
||||
|
||||
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
|
||||
have hx : x = 0#1 ∨ x = 1#1 := by bv_omega
|
||||
have hy : y = 0#1 ∨ y = 1#1 := by bv_omega
|
||||
rcases hx with rfl | rfl <;>
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
/-! ### smod -/
|
||||
|
||||
/-- Equation theorem for `smod` in terms of `umod`. -/
|
||||
theorem smod_eq (x y : BitVec w) : x.smod y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => x.umod y
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u else u + y)
|
||||
| true, false =>
|
||||
let u := umod (- x) y
|
||||
(if u = 0#w then u else y - u)
|
||||
| true, true => - ((- x).umod (- y)) := by
|
||||
rw [BitVec.smod]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (x.umod y).toNat
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u.toNat else (u + y).toNat)
|
||||
| true, false =>
|
||||
let u := (-x).umod y
|
||||
(if u = 0#w then u.toNat else (y - u).toNat)
|
||||
| true, true => (- ((- x).umod (- y))).toNat := by
|
||||
simp only [smod_eq, toNat_umod]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb
|
||||
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
|
||||
<;> simp only [h, h', h'', h''']
|
||||
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
|
||||
<;> simp [h'', h''']
|
||||
@[simp]
|
||||
theorem msb_sshiftRight' {x y: BitVec w} :
|
||||
(x.sshiftRight' y).msb = x.msb := by
|
||||
simp [BitVec.sshiftRight', BitVec.msb_sshiftRight]
|
||||
|
||||
/-! ### signExtend -/
|
||||
|
||||
@@ -1640,6 +1677,11 @@ theorem shiftLeft_ushiftRight {x : BitVec w} {n : Nat}:
|
||||
· simp [hi₂]
|
||||
· simp [Nat.lt_one_iff, hi₂, show 1 + (i.val - 1) = i by omega]
|
||||
|
||||
@[simp]
|
||||
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
|
||||
@@ -2014,7 +2056,7 @@ theorem negOne_eq_allOnes : -1#w = allOnes w := by
|
||||
have r : (2^w - 1) < 2^w := by omega
|
||||
simp [Nat.mod_eq_of_lt q, Nat.mod_eq_of_lt r]
|
||||
|
||||
theorem neg_eq_not_add (x : BitVec w) : -x = ~~~x + 1 := by
|
||||
theorem neg_eq_not_add (x : BitVec w) : -x = ~~~x + 1#w := by
|
||||
apply eq_of_toNat_eq
|
||||
simp only [toNat_neg, ofNat_eq_ofNat, toNat_add, toNat_not, toNat_ofNat, Nat.add_mod_mod]
|
||||
congr
|
||||
@@ -2034,11 +2076,41 @@ theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x ≠ y ↔ x ≠ -y := by
|
||||
subst h'
|
||||
simp at h
|
||||
|
||||
@[simp]
|
||||
theorem neg_eq_zero_iff {x : BitVec w} : -x = 0#w ↔ x = 0#w := by
|
||||
constructor
|
||||
· intro h
|
||||
have : - (- x) = - 0 := by simp [h]
|
||||
simpa using this
|
||||
· intro h
|
||||
simp [h]
|
||||
|
||||
theorem sub_eq_xor {a b : BitVec 1} : a - b = a ^^^ b := by
|
||||
have ha : a = 0 ∨ a = 1 := eq_zero_or_eq_one _
|
||||
have hb : b = 0 ∨ b = 1 := eq_zero_or_eq_one _
|
||||
rcases ha with h | h <;> (rcases hb with h' | h' <;> (simp [h, h']))
|
||||
|
||||
@[simp]
|
||||
theorem sub_eq_self {x : BitVec 1} : -x = x := by
|
||||
have ha : x = 0 ∨ x = 1 := eq_zero_or_eq_one _
|
||||
rcases ha with h | h <;> simp [h]
|
||||
|
||||
theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
|
||||
rcases w with _ | w
|
||||
· apply Subsingleton.elim
|
||||
· rw [BitVec.not_eq_comm]
|
||||
apply BitVec.eq_of_toNat_eq
|
||||
simp only [BitVec.toNat_neg, BitVec.toNat_not, BitVec.toNat_add, BitVec.toNat_ofNat,
|
||||
Nat.add_mod_mod]
|
||||
by_cases hx : x.toNat = 0
|
||||
· simp [hx]
|
||||
· rw [show (_ - 1 % _) = _ by rw [Nat.mod_eq_of_lt (by omega)],
|
||||
show _ + (_ - 1) = (x.toNat - 1) + 2^(w + 1) by omega,
|
||||
Nat.add_mod_right,
|
||||
show (x.toNat - 1) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)],
|
||||
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
|
||||
omega
|
||||
|
||||
/-! ### abs -/
|
||||
|
||||
@[simp, bv_toNat]
|
||||
@@ -2173,7 +2245,7 @@ protected theorem ne_of_lt {x y : BitVec n} : x < y → x ≠ y := by
|
||||
simp only [lt_def, ne_eq, toNat_eq]
|
||||
apply Nat.ne_of_lt
|
||||
|
||||
protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x.umod y < y := by
|
||||
protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x % y < y := by
|
||||
simp only [ofNat_eq_ofNat, lt_def, toNat_ofNat, Nat.zero_mod, umod, toNat_ofNatLt]
|
||||
apply Nat.mod_lt
|
||||
|
||||
@@ -2181,6 +2253,191 @@ theorem not_lt_iff_le {x y : BitVec w} : (¬ x < y) ↔ y ≤ x := by
|
||||
constructor <;>
|
||||
(intro h; simp only [lt_def, Nat.not_lt, le_def] at h ⊢; omega)
|
||||
|
||||
/-! ### udiv -/
|
||||
|
||||
theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) := by
|
||||
have h : x.toNat / y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
|
||||
rw [← udiv_eq]
|
||||
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_udiv {x y : BitVec n} : (x / y).toNat = x.toNat / y.toNat := by
|
||||
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
|
||||
simp [bv_toNat]
|
||||
|
||||
@[simp]
|
||||
theorem udiv_zero {x : BitVec n} : x / 0#n = 0#n := by
|
||||
simp [udiv_def]
|
||||
|
||||
@[simp]
|
||||
theorem udiv_one {x : BitVec w} : x / 1#w = x := by
|
||||
simp only [udiv_eq, toNat_eq, toNat_udiv, toNat_ofNat]
|
||||
cases w
|
||||
· simp [eq_nil x]
|
||||
· simp
|
||||
|
||||
@[simp]
|
||||
theorem udiv_eq_and {x y : BitVec 1} :
|
||||
x / y = (x &&& y) := by
|
||||
have hx : x = 0#1 ∨ x = 1#1 := by bv_omega
|
||||
have hy : y = 0#1 ∨ y = 1#1 := by bv_omega
|
||||
rcases hx with rfl | rfl <;>
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem udiv_self {x : BitVec w} :
|
||||
x / x = if x == 0#w then 0#w else 1#w := by
|
||||
by_cases h : x = 0#w
|
||||
· simp [h]
|
||||
· simp only [toNat_eq, toNat_ofNat, Nat.zero_mod] at h
|
||||
simp only [udiv_eq, beq_iff_eq, toNat_eq, toNat_ofNat, Nat.zero_mod, h,
|
||||
↓reduceIte, toNat_udiv]
|
||||
rw [Nat.div_self (by omega), Nat.mod_eq_of_lt (by omega)]
|
||||
|
||||
/-! ### umod -/
|
||||
|
||||
theorem umod_def {x y : BitVec n} :
|
||||
x % y = BitVec.ofNat n (x.toNat % y.toNat) := by
|
||||
rw [← umod_eq]
|
||||
have h : x.toNat % y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt
|
||||
simp [umod, bv_toNat, Nat.mod_eq_of_lt h]
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_umod {x y : BitVec n} :
|
||||
(x % y).toNat = x.toNat % y.toNat := rfl
|
||||
|
||||
@[simp]
|
||||
theorem umod_zero {x : BitVec n} : x % 0#n = x := by
|
||||
simp [umod_def]
|
||||
|
||||
@[simp]
|
||||
theorem zero_umod {x : BitVec w} : (0#w) % x = 0#w := by
|
||||
simp [bv_toNat]
|
||||
|
||||
@[simp]
|
||||
theorem umod_one {x : BitVec w} : x % (1#w) = 0#w := by
|
||||
simp only [toNat_eq, toNat_umod, toNat_ofNat, Nat.zero_mod]
|
||||
cases w
|
||||
· simp [eq_nil x]
|
||||
· simp [Nat.mod_one]
|
||||
|
||||
@[simp]
|
||||
theorem umod_self {x : BitVec w} : x % x = 0#w := by
|
||||
simp [bv_toNat]
|
||||
|
||||
@[simp]
|
||||
theorem umod_eq_and {x y : BitVec 1} : x % y = x &&& (~~~y) := by
|
||||
have hx : x = 0#1 ∨ x = 1#1 := by bv_omega
|
||||
have hy : y = 0#1 ∨ y = 1#1 := by bv_omega
|
||||
rcases hx with rfl | rfl <;>
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
/-! ### sdiv -/
|
||||
|
||||
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
|
||||
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => udiv x y
|
||||
| false, true => - (x.udiv (- y))
|
||||
| true, false => - ((- x).udiv y)
|
||||
| true, true => (- x).udiv (- y) := by
|
||||
rw [BitVec.sdiv]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (udiv x y).toNat
|
||||
| false, true => (- (x.udiv (- y))).toNat
|
||||
| true, false => (- ((- x).udiv y)).toNat
|
||||
| true, true => ((- x).udiv (- y)).toNat := by
|
||||
simp only [sdiv_eq, toNat_udiv]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
|
||||
|
||||
@[simp]
|
||||
theorem zero_sdiv {x : BitVec w} : (0#w).sdiv x = 0#w := by
|
||||
simp only [sdiv_eq]
|
||||
rcases x.msb with msb | msb <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem sdiv_zero {x : BitVec n} : x.sdiv 0#n = 0#n := by
|
||||
simp only [sdiv_eq, msb_zero]
|
||||
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem sdiv_one {x : BitVec w} : x.sdiv 1#w = x := by
|
||||
simp only [sdiv_eq]
|
||||
· by_cases h : w = 1
|
||||
· subst h
|
||||
rcases x.msb with msb | msb <;> simp
|
||||
· rcases x.msb with msb | msb <;> simp [h]
|
||||
|
||||
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
|
||||
have hx : x = 0#1 ∨ x = 1#1 := by bv_omega
|
||||
have hy : y = 0#1 ∨ y = 1#1 := by bv_omega
|
||||
rcases hx with rfl | rfl <;>
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem sdiv_self {x : BitVec w} :
|
||||
x.sdiv x = if x == 0#w then 0#w else 1#w := by
|
||||
simp [sdiv_eq]
|
||||
· by_cases h : w = 1
|
||||
· subst h
|
||||
rcases x.msb with msb | msb <;> simp
|
||||
· rcases x.msb with msb | msb <;> simp [h]
|
||||
|
||||
/-! ### smod -/
|
||||
|
||||
/-- Equation theorem for `smod` in terms of `umod`. -/
|
||||
theorem smod_eq (x y : BitVec w) : x.smod y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => x.umod y
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u else u + y)
|
||||
| true, false =>
|
||||
let u := umod (- x) y
|
||||
(if u = 0#w then u else y - u)
|
||||
| true, true => - ((- x).umod (- y)) := by
|
||||
rw [BitVec.smod]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (x.umod y).toNat
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u.toNat else (u + y).toNat)
|
||||
| true, false =>
|
||||
let u := (-x).umod y
|
||||
(if u = 0#w then u.toNat else (y - u).toNat)
|
||||
| true, true => (- ((- x).umod (- y))).toNat := by
|
||||
simp only [smod_eq, toNat_umod]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb
|
||||
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
|
||||
<;> simp only [h, h', h'', h''']
|
||||
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
|
||||
<;> simp [h'', h''']
|
||||
|
||||
@[simp]
|
||||
theorem smod_zero {x : BitVec n} : x.smod 0#n = x := by
|
||||
simp only [smod_eq, msb_zero]
|
||||
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq
|
||||
· simp
|
||||
· by_cases h : x = 0#n <;> simp [h]
|
||||
|
||||
/-! ### ofBoolList -/
|
||||
|
||||
@[simp] theorem getMsbD_ofBoolListBE : (ofBoolListBE bs).getMsbD i = bs.getD i false := by
|
||||
@@ -2440,14 +2697,6 @@ theorem twoPow_zero {w : Nat} : twoPow w 0 = 1#w := by
|
||||
apply eq_of_toNat_eq
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem getLsbD_one {w i : Nat} : (1#w).getLsbD i = (decide (0 < w) && decide (0 = i)) := by
|
||||
rw [← twoPow_zero, getLsbD_twoPow]
|
||||
|
||||
@[simp]
|
||||
theorem getElem_one {w i : Nat} (h : i < w) : (1#w)[i] = decide (i = 0) := by
|
||||
rw [← twoPow_zero, getElem_twoPow]
|
||||
|
||||
theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
|
||||
x <<< n = x * (BitVec.twoPow w n) := by
|
||||
ext i
|
||||
@@ -2467,7 +2716,6 @@ theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
|
||||
@[simp] theorem zero_concat_true : concat 0#w true = 1#(w + 1) := by
|
||||
ext
|
||||
simp [getLsbD_concat]
|
||||
omega
|
||||
|
||||
/- ### setWidth, setWidth, and bitwise operations -/
|
||||
|
||||
@@ -2508,7 +2756,7 @@ theorem and_one_eq_setWidth_ofBool_getLsbD {x : BitVec w} :
|
||||
ext i
|
||||
simp only [getLsbD_and, getLsbD_one, getLsbD_setWidth, Fin.is_lt, decide_True, getLsbD_ofBool,
|
||||
Bool.true_and]
|
||||
by_cases h : (0 = (i : Nat)) <;> simp [h] <;> omega
|
||||
by_cases h : ((i : Nat) = 0) <;> simp [h] <;> omega
|
||||
|
||||
@[simp]
|
||||
theorem replicate_zero_eq {x : BitVec w} : x.replicate 0 = 0#0 := by
|
||||
@@ -2680,6 +2928,31 @@ theorem toNat_mul_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_mul, Nat.mod_eq_of_lt h]
|
||||
|
||||
|
||||
/--
|
||||
`x ≤ y + z` if and only if `x - z ≤ y`
|
||||
when `x - z` and `y + z` do not overflow.
|
||||
-/
|
||||
theorem le_add_iff_sub_le {x y z : BitVec w}
|
||||
(hxz : z ≤ x) (hbz : y.toNat + z.toNat < 2^w) :
|
||||
x ≤ y + z ↔ x - z ≤ y := by
|
||||
simp_all only [BitVec.le_def]
|
||||
rw [BitVec.toNat_sub_of_le (by rw [BitVec.le_def]; omega),
|
||||
BitVec.toNat_add_of_lt (by omega)]
|
||||
omega
|
||||
|
||||
/--
|
||||
`x - z ≤ y - z` if and only if `x ≤ y`
|
||||
when `x - z` and `y - z` do not overflow.
|
||||
-/
|
||||
theorem sub_le_sub_iff_le {x y z : BitVec w} (hxz : z ≤ x) (hyz : z ≤ y) :
|
||||
(x - z ≤ y - z) ↔ x ≤ y := by
|
||||
simp_all only [BitVec.le_def]
|
||||
rw [BitVec.toNat_sub_of_le (by rw [BitVec.le_def]; omega),
|
||||
BitVec.toNat_sub_of_le (by rw [BitVec.le_def]; omega)]
|
||||
omega
|
||||
|
||||
|
||||
/-! ### Decidable quantifiers -/
|
||||
|
||||
theorem forall_zero_iff {P : BitVec 0 → Prop} :
|
||||
@@ -2884,4 +3157,7 @@ abbrev zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true
|
||||
@[deprecated and_one_eq_setWidth_ofBool_getLsbD (since := "2024-09-18")]
|
||||
abbrev and_one_eq_zeroExtend_ofBool_getLsbD := @and_one_eq_setWidth_ofBool_getLsbD
|
||||
|
||||
@[deprecated msb_sshiftRight (since := "2024-10-03")]
|
||||
abbrev sshiftRight_msb_eq_msb := @msb_sshiftRight
|
||||
|
||||
end BitVec
|
||||
|
||||
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
|
||||
/-- Determines if the given integer is a valid [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).
|
||||
|
||||
@@ -42,8 +42,10 @@ theorem isValidUInt32 (n : Nat) (h : isValidCharNat n) : n < UInt32.size := by
|
||||
|
||||
theorem isValidChar_of_isValidCharNat (n : Nat) (h : isValidCharNat n) : isValidChar (UInt32.ofNat' n (isValidUInt32 n h)) :=
|
||||
match h with
|
||||
| Or.inl h => Or.inl h
|
||||
| Or.inr ⟨h₁, h₂⟩ => Or.inr ⟨h₁, h₂⟩
|
||||
| Or.inl h =>
|
||||
Or.inl (UInt32.ofNat'_lt_of_lt _ (by decide) h)
|
||||
| Or.inr ⟨h₁, h₂⟩ =>
|
||||
Or.inr ⟨UInt32.lt_ofNat'_of_lt _ (by decide) h₁, UInt32.ofNat'_lt_of_lt _ (by decide) h₂⟩
|
||||
|
||||
theorem isValidChar_zero : isValidChar 0 :=
|
||||
Or.inl (by decide)
|
||||
@@ -57,7 +59,7 @@ theorem isValidChar_zero : isValidChar 0 :=
|
||||
c.val.toUInt8
|
||||
|
||||
/-- The numbers from 0 to 256 are all valid UTF-8 characters, so we can embed one in the other. -/
|
||||
def ofUInt8 (n : UInt8) : Char := ⟨n.toUInt32, .inl (Nat.lt_trans n.1.2 (by decide))⟩
|
||||
def ofUInt8 (n : UInt8) : Char := ⟨n.toUInt32, .inl (Nat.lt_trans n.toBitVec.isLt (by decide))⟩
|
||||
|
||||
instance : Inhabited Char where
|
||||
default := 'A'
|
||||
|
||||
@@ -244,9 +244,13 @@ theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.siz
|
||||
|
||||
theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl
|
||||
|
||||
@[simp] protected theorem zero_add {n : Nat} [NeZero n] (i : Fin n) : (0 : Fin n) + i = i := by
|
||||
@[simp] protected theorem zero_add [NeZero n] (k : Fin n) : (0 : Fin n) + k = k := by
|
||||
ext
|
||||
simp [Fin.add_def, Nat.mod_eq_of_lt i.2]
|
||||
simp [Fin.add_def, Nat.mod_eq_of_lt k.2]
|
||||
|
||||
@[simp] protected theorem add_zero [NeZero n] (k : Fin n) : k + 0 = k := by
|
||||
ext
|
||||
simp [add_def, Nat.mod_eq_of_lt k.2]
|
||||
|
||||
theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by
|
||||
match n with
|
||||
|
||||
35
src/Init/Data/Function.lean
Normal file
35
src/Init/Data/Function.lean
Normal file
@@ -0,0 +1,35 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
|
||||
prelude
|
||||
import Init.Core
|
||||
|
||||
namespace Function
|
||||
|
||||
@[inline]
|
||||
def curry : (α × β → φ) → α → β → φ := fun f a b => f (a, b)
|
||||
|
||||
/-- Interpret a function with two arguments as a function on `α × β` -/
|
||||
@[inline]
|
||||
def uncurry : (α → β → φ) → α × β → φ := fun f a => f a.1 a.2
|
||||
|
||||
@[simp]
|
||||
theorem curry_uncurry (f : α → β → φ) : curry (uncurry f) = f :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem uncurry_curry (f : α × β → φ) : uncurry (curry f) = f :=
|
||||
funext fun ⟨_a, _b⟩ => rfl
|
||||
|
||||
@[simp]
|
||||
theorem uncurry_apply_pair {α β γ} (f : α → β → γ) (x : α) (y : β) : uncurry f (x, y) = f x y :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem curry_apply {α β γ} (f : α × β → γ) (x : α) (y : β) : curry f x y = f (x, y) :=
|
||||
rfl
|
||||
|
||||
end Function
|
||||
@@ -23,3 +23,5 @@ import Init.Data.List.TakeDrop
|
||||
import Init.Data.List.Zip
|
||||
import Init.Data.List.Perm
|
||||
import Init.Data.List.Sort
|
||||
import Init.Data.List.ToArray
|
||||
import Init.Data.List.MapIdx
|
||||
|
||||
@@ -568,22 +568,22 @@ If not, usually the right approach is `simp [List.unattach, -List.map_subtype]`
|
||||
-/
|
||||
def unattach {α : Type _} {p : α → Prop} (l : List { x // p x }) := l.map (·.val)
|
||||
|
||||
@[simp] theorem unattach_nil {α : Type _} {p : α → Prop} : ([] : List { x // p x }).unattach = [] := rfl
|
||||
@[simp] theorem unattach_cons {α : Type _} {p : α → Prop} {a : { x // p x }} {l : List { x // p x }} :
|
||||
@[simp] theorem unattach_nil {p : α → Prop} : ([] : List { x // p x }).unattach = [] := rfl
|
||||
@[simp] theorem unattach_cons {p : α → Prop} {a : { x // p x }} {l : List { x // p x }} :
|
||||
(a :: l).unattach = a.val :: l.unattach := rfl
|
||||
|
||||
@[simp] theorem length_unattach {α : Type _} {p : α → Prop} {l : List { x // p x }} :
|
||||
@[simp] theorem length_unattach {p : α → Prop} {l : List { x // p x }} :
|
||||
l.unattach.length = l.length := by
|
||||
unfold unattach
|
||||
simp
|
||||
|
||||
@[simp] theorem unattach_attach {α : Type _} (l : List α) : l.attach.unattach = l := by
|
||||
@[simp] theorem unattach_attach {l : List α} : l.attach.unattach = l := by
|
||||
unfold unattach
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih, Function.comp_def]
|
||||
|
||||
@[simp] theorem unattach_attachWith {α : Type _} {p : α → Prop} {l : List α}
|
||||
@[simp] theorem unattach_attachWith {p : α → Prop} {l : List α}
|
||||
{H : ∀ a ∈ l, p a} :
|
||||
(l.attachWith p H).unattach = l := by
|
||||
unfold unattach
|
||||
@@ -639,14 +639,16 @@ and simplifies these to the function directly taking the value.
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih, hf, filterMap_cons]
|
||||
|
||||
@[simp] theorem bind_subtype {p : α → Prop} {l : List { x // p x }}
|
||||
@[simp] theorem flatMap_subtype {p : α → Prop} {l : List { x // p x }}
|
||||
{f : { x // p x } → List β} {g : α → List β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(l.bind f) = l.unattach.bind g := by
|
||||
(l.flatMap f) = l.unattach.flatMap g := by
|
||||
unfold unattach
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih, hf]
|
||||
|
||||
@[deprecated flatMap_subtype (since := "2024-10-16")] abbrev bind_subtype := @flatMap_subtype
|
||||
|
||||
@[simp] theorem unattach_filter {p : α → Prop} {l : List { x // p x }}
|
||||
{f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(l.filter f).unattach = l.unattach.filter g := by
|
||||
@@ -666,11 +668,13 @@ and simplifies these to the function directly taking the value.
|
||||
(l₁ ++ l₂).unattach = l₁.unattach ++ l₂.unattach := by
|
||||
simp [unattach, -map_subtype]
|
||||
|
||||
@[simp] theorem unattach_join {p : α → Prop} {l : List (List { x // p x })} :
|
||||
l.join.unattach = (l.map unattach).join := by
|
||||
@[simp] theorem unattach_flatten {p : α → Prop} {l : List (List { x // p x })} :
|
||||
l.flatten.unattach = (l.map unattach).flatten := by
|
||||
unfold unattach
|
||||
induction l <;> simp_all
|
||||
|
||||
@[deprecated unattach_flatten (since := "2024-10-14")] abbrev unattach_join := @unattach_flatten
|
||||
|
||||
@[simp] theorem unattach_replicate {p : α → Prop} {n : Nat} {x : { x // p x }} :
|
||||
(List.replicate n x).unattach = List.replicate n x.1 := by
|
||||
simp [unattach, -map_subtype]
|
||||
|
||||
@@ -29,9 +29,10 @@ The operations are organized as follow:
|
||||
* Lexicographic ordering: `lt`, `le`, and instances.
|
||||
* Head and tail operators: `head`, `head?`, `headD?`, `tail`, `tail?`, `tailD`.
|
||||
* Basic operations:
|
||||
`map`, `filter`, `filterMap`, `foldr`, `append`, `join`, `pure`, `bind`, `replicate`, and
|
||||
`map`, `filter`, `filterMap`, `foldr`, `append`, `flatten`, `pure`, `bind`, `replicate`, and
|
||||
`reverse`.
|
||||
* Additional functions defined in terms of these: `leftpad`, `rightPad`, and `reduceOption`.
|
||||
* Operations using indexes: `mapIdx`.
|
||||
* List membership: `isEmpty`, `elem`, `contains`, `mem` (and the `∈` notation),
|
||||
and decidability for predicates quantifying over membership in a `List`.
|
||||
* Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
|
||||
@@ -368,7 +369,7 @@ def tailD (list fallback : List α) : List α :=
|
||||
/-! ## Basic `List` operations.
|
||||
|
||||
We define the basic functional programming operations on `List`:
|
||||
`map`, `filter`, `filterMap`, `foldr`, `append`, `join`, `pure`, `bind`, `replicate`, and `reverse`.
|
||||
`map`, `filter`, `filterMap`, `foldr`, `append`, `flatten`, `pure`, `bind`, `replicate`, and `reverse`.
|
||||
-/
|
||||
|
||||
/-! ### map -/
|
||||
@@ -542,41 +543,53 @@ theorem reverseAux_eq_append (as bs : List α) : reverseAux as bs = reverseAux a
|
||||
simp [reverse, reverseAux]
|
||||
rw [← reverseAux_eq_append]
|
||||
|
||||
/-! ### join -/
|
||||
/-! ### flatten -/
|
||||
|
||||
/--
|
||||
`O(|join L|)`. `join L` concatenates all the lists in `L` into one list.
|
||||
* `join [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
|
||||
`O(|flatten L|)`. `join L` concatenates all the lists in `L` into one list.
|
||||
* `flatten [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
|
||||
-/
|
||||
def join : List (List α) → List α
|
||||
def flatten : List (List α) → List α
|
||||
| [] => []
|
||||
| a :: as => a ++ join as
|
||||
| a :: as => a ++ flatten as
|
||||
|
||||
@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl
|
||||
@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl
|
||||
@[simp] theorem flatten_nil : List.flatten ([] : List (List α)) = [] := rfl
|
||||
@[simp] theorem flatten_cons : (l :: ls).flatten = l ++ ls.flatten := rfl
|
||||
|
||||
/-! ### pure -/
|
||||
@[deprecated flatten (since := "2024-10-14"), inherit_doc flatten] abbrev join := @flatten
|
||||
|
||||
/-- `pure x = [x]` is the `pure` operation of the list monad. -/
|
||||
@[inline] protected def pure {α : Type u} (a : α) : List α := [a]
|
||||
/-! ### singleton -/
|
||||
|
||||
/-! ### bind -/
|
||||
/-- `singleton x = [x]`. -/
|
||||
@[inline] protected def singleton {α : Type u} (a : α) : List α := [a]
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated singleton (since := "2024-10-16")] protected abbrev pure := @singleton
|
||||
|
||||
/-! ### flatMap -/
|
||||
|
||||
/--
|
||||
`bind xs f` is the bind operation of the list monad. It applies `f` to each element of `xs`
|
||||
`flatMap xs f` applies `f` to each element of `xs`
|
||||
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] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := join (map b a)
|
||||
@[inline] def flatMap {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := flatten (map b a)
|
||||
|
||||
@[simp] theorem bind_nil (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind]
|
||||
@[simp] theorem bind_cons x xs (f : α → List β) :
|
||||
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind]
|
||||
@[simp] theorem flatMap_nil (f : α → List β) : List.flatMap [] f = [] := by simp [flatten, List.flatMap]
|
||||
@[simp] theorem flatMap_cons x xs (f : α → List β) :
|
||||
List.flatMap (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated bind_nil (since := "2024-06-15")] abbrev nil_bind := @bind_nil
|
||||
@[deprecated flatMap (since := "2024-10-16")] abbrev bind := @flatMap
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated bind_cons (since := "2024-06-15")] abbrev cons_bind := @bind_cons
|
||||
@[deprecated flatMap_nil (since := "2024-10-16")] abbrev nil_flatMap := @flatMap_nil
|
||||
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 -/
|
||||
|
||||
@@ -1395,8 +1408,17 @@ def unzip : List (α × β) → List α × List β
|
||||
|
||||
/-! ## Ranges and enumeration -/
|
||||
|
||||
/-- Sum of a list.
|
||||
|
||||
`List.sum [a, b, c] = a + (b + (c + 0))` -/
|
||||
def sum {α} [Add α] [Zero α] : List α → α :=
|
||||
foldr (· + ·) 0
|
||||
|
||||
@[simp] theorem sum_nil [Add α] [Zero α] : ([] : List α).sum = 0 := rfl
|
||||
@[simp] theorem sum_cons [Add α] [Zero α] {a : α} {l : List α} : (a::l).sum = a + l.sum := rfl
|
||||
|
||||
/-- Sum of a list of natural numbers. -/
|
||||
-- This is not in the `List` namespace as later `List.sum` will be defined polymorphically.
|
||||
-- We intend to subsequently deprecate this in favor of `List.sum`.
|
||||
protected def _root_.Nat.sum (l : List Nat) : Nat := l.foldr (·+·) 0
|
||||
|
||||
@[simp] theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
|
||||
@@ -1527,7 +1549,7 @@ def intersperse (sep : α) : List α → List α
|
||||
* `intercalate sep [a, b, c] = a ++ sep ++ b ++ sep ++ c`
|
||||
-/
|
||||
def intercalate (sep : List α) (xs : List (List α)) : List α :=
|
||||
join (intersperse sep xs)
|
||||
(intersperse sep xs).flatten
|
||||
|
||||
/-! ### eraseDups -/
|
||||
|
||||
|
||||
@@ -153,13 +153,15 @@ theorem countP_filterMap (p : β → Bool) (f : α → Option β) (l : List α)
|
||||
simp only [length_filterMap_eq_countP]
|
||||
congr
|
||||
ext a
|
||||
simp (config := { contextual := true }) [Option.getD_eq_iff]
|
||||
simp (config := { contextual := true }) [Option.getD_eq_iff, Option.isSome_eq_isSome]
|
||||
|
||||
@[simp] theorem countP_join (l : List (List α)) :
|
||||
countP p l.join = Nat.sum (l.map (countP p)) := by
|
||||
simp only [countP_eq_length_filter, filter_join]
|
||||
@[simp] theorem countP_flatten (l : List (List α)) :
|
||||
countP p l.flatten = (l.map (countP p)).sum := by
|
||||
simp only [countP_eq_length_filter, filter_flatten]
|
||||
simp [countP_eq_length_filter']
|
||||
|
||||
@[deprecated countP_flatten (since := "2024-10-14")] abbrev countP_join := @countP_flatten
|
||||
|
||||
@[simp] theorem countP_reverse (l : List α) : countP p l.reverse = countP p l := by
|
||||
simp [countP_eq_length_filter, filter_reverse]
|
||||
|
||||
@@ -230,8 +232,10 @@ theorem count_singleton (a b : α) : count a [b] = if b == a then 1 else 0 := by
|
||||
@[simp] theorem count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
|
||||
countP_append _
|
||||
|
||||
theorem count_join (a : α) (l : List (List α)) : count a l.join = Nat.sum (l.map (count a)) := by
|
||||
simp only [count_eq_countP, countP_join, count_eq_countP']
|
||||
theorem count_flatten (a : α) (l : List (List α)) : count a l.flatten = (l.map (count a)).sum := by
|
||||
simp only [count_eq_countP, countP_flatten, count_eq_countP']
|
||||
|
||||
@[deprecated count_flatten (since := "2024-10-14")] abbrev count_join := @count_flatten
|
||||
|
||||
@[simp] theorem count_reverse (a : α) (l : List α) : count a l.reverse = count a l := by
|
||||
simp only [count_eq_countP, countP_eq_length_filter, filter_reverse, length_reverse]
|
||||
|
||||
@@ -132,14 +132,14 @@ theorem findSome?_append {l₁ l₂ : List α} : (l₁ ++ l₂).findSome? f = (l
|
||||
simp only [cons_append, findSome?]
|
||||
split <;> simp_all
|
||||
|
||||
theorem head_join {L : List (List α)} (h : ∃ l, l ∈ L ∧ l ≠ []) :
|
||||
(join L).head (by simpa using h) = (L.findSome? fun l => l.head?).get (by simpa using h) := by
|
||||
simp [head_eq_iff_head?_eq_some, head?_join]
|
||||
theorem head_flatten {L : List (List α)} (h : ∃ l, l ∈ L ∧ l ≠ []) :
|
||||
(flatten L).head (by simpa using h) = (L.findSome? fun l => l.head?).get (by simpa using h) := by
|
||||
simp [head_eq_iff_head?_eq_some, head?_flatten]
|
||||
|
||||
theorem getLast_join {L : List (List α)} (h : ∃ l, l ∈ L ∧ l ≠ []) :
|
||||
(join L).getLast (by simpa using h) =
|
||||
theorem getLast_flatten {L : List (List α)} (h : ∃ l, l ∈ L ∧ l ≠ []) :
|
||||
(flatten L).getLast (by simpa using h) =
|
||||
(L.reverse.findSome? fun l => l.getLast?).get (by simpa using h) := by
|
||||
simp [getLast_eq_iff_getLast_eq_some, getLast?_join]
|
||||
simp [getLast_eq_iff_getLast_eq_some, getLast?_flatten]
|
||||
|
||||
theorem findSome?_replicate : findSome? f (replicate n a) = if n = 0 then none else f a := by
|
||||
cases n with
|
||||
@@ -326,35 +326,35 @@ theorem get_find?_mem (xs : List α) (p : α → Bool) (h) : (xs.find? p).get h
|
||||
simp only [cons_append, find?]
|
||||
by_cases h : p x <;> simp [h, ih]
|
||||
|
||||
@[simp] theorem find?_join (xs : List (List α)) (p : α → Bool) :
|
||||
xs.join.find? p = xs.findSome? (·.find? p) := by
|
||||
@[simp] theorem find?_flatten (xs : List (List α)) (p : α → Bool) :
|
||||
xs.flatten.find? p = xs.findSome? (·.find? p) := by
|
||||
induction xs with
|
||||
| nil => simp
|
||||
| cons x xs ih =>
|
||||
simp only [join_cons, find?_append, findSome?_cons, ih]
|
||||
simp only [flatten_cons, find?_append, findSome?_cons, ih]
|
||||
split <;> simp [*]
|
||||
|
||||
theorem find?_join_eq_none {xs : List (List α)} {p : α → Bool} :
|
||||
xs.join.find? p = none ↔ ∀ ys ∈ xs, ∀ x ∈ ys, !p x := by
|
||||
theorem find?_flatten_eq_none {xs : List (List α)} {p : α → Bool} :
|
||||
xs.flatten.find? p = none ↔ ∀ ys ∈ xs, ∀ x ∈ ys, !p x := by
|
||||
simp
|
||||
|
||||
/--
|
||||
If `find? p` returns `some a` from `xs.join`, then `p a` holds, and
|
||||
If `find? p` returns `some a` from `xs.flatten`, then `p a` holds, and
|
||||
some list in `xs` contains `a`, and no earlier element of that list satisfies `p`.
|
||||
Moreover, no earlier list in `xs` has an element satisfying `p`.
|
||||
-/
|
||||
theorem find?_join_eq_some {xs : List (List α)} {p : α → Bool} {a : α} :
|
||||
xs.join.find? p = some a ↔
|
||||
theorem find?_flatten_eq_some {xs : List (List α)} {p : α → Bool} {a : α} :
|
||||
xs.flatten.find? p = some a ↔
|
||||
p a ∧ ∃ as ys zs bs, xs = as ++ (ys ++ a :: zs) :: bs ∧
|
||||
(∀ a ∈ as, ∀ x ∈ a, !p x) ∧ (∀ x ∈ ys, !p x) := by
|
||||
rw [find?_eq_some]
|
||||
constructor
|
||||
· rintro ⟨h, ⟨ys, zs, h₁, h₂⟩⟩
|
||||
refine ⟨h, ?_⟩
|
||||
rw [join_eq_append_iff] at h₁
|
||||
rw [flatten_eq_append_iff] at h₁
|
||||
obtain (⟨as, bs, rfl, rfl, h₁⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, h₁⟩) := h₁
|
||||
· replace h₁ := h₁.symm
|
||||
rw [join_eq_cons_iff] at h₁
|
||||
rw [flatten_eq_cons_iff] at h₁
|
||||
obtain ⟨bs, cs, ds, rfl, h₁, rfl⟩ := h₁
|
||||
refine ⟨as ++ bs, [], cs, ds, by simp, ?_⟩
|
||||
simp
|
||||
@@ -371,21 +371,25 @@ theorem find?_join_eq_some {xs : List (List α)} {p : α → Bool} {a : α} :
|
||||
· intro x m
|
||||
simpa using h₂ x (by simpa using .inr m)
|
||||
· rintro ⟨h, ⟨as, ys, zs, bs, rfl, h₁, h₂⟩⟩
|
||||
refine ⟨h, as.join ++ ys, zs ++ bs.join, by simp, ?_⟩
|
||||
refine ⟨h, as.flatten ++ ys, zs ++ bs.flatten, by simp, ?_⟩
|
||||
intro a m
|
||||
simp at m
|
||||
obtain ⟨l, ml, m⟩ | m := m
|
||||
· exact h₁ l ml a m
|
||||
· exact h₂ a m
|
||||
|
||||
@[simp] theorem find?_bind (xs : List α) (f : α → List β) (p : β → Bool) :
|
||||
(xs.bind f).find? p = xs.findSome? (fun x => (f x).find? p) := by
|
||||
simp [bind_def, findSome?_map]; rfl
|
||||
@[simp] theorem find?_flatMap (xs : List α) (f : α → List β) (p : β → Bool) :
|
||||
(xs.flatMap f).find? p = xs.findSome? (fun x => (f x).find? p) := by
|
||||
simp [flatMap_def, findSome?_map]; rfl
|
||||
|
||||
theorem find?_bind_eq_none {xs : List α} {f : α → List β} {p : β → Bool} :
|
||||
(xs.bind f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
|
||||
@[deprecated find?_flatMap (since := "2024-10-16")] abbrev find?_bind := @find?_flatMap
|
||||
|
||||
theorem find?_flatMap_eq_none {xs : List α} {f : α → List β} {p : β → Bool} :
|
||||
(xs.flatMap f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
|
||||
simp
|
||||
|
||||
@[deprecated find?_flatMap_eq_none (since := "2024-10-16")] abbrev find?_bind_eq_none := @find?_flatMap_eq_none
|
||||
|
||||
theorem find?_replicate : find? p (replicate n a) = if n = 0 then none else if p a then some a else none := by
|
||||
cases n
|
||||
· simp
|
||||
@@ -786,15 +790,15 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
|
||||
induction xs with simp
|
||||
| cons _ _ _ => split <;> simp_all [Option.map_or', Option.map_map]; rfl
|
||||
|
||||
theorem findIdx?_join {l : List (List α)} {p : α → Bool} :
|
||||
l.join.findIdx? p =
|
||||
theorem findIdx?_flatten {l : List (List α)} {p : α → Bool} :
|
||||
l.flatten.findIdx? p =
|
||||
(l.findIdx? (·.any p)).map
|
||||
fun i => Nat.sum ((l.take i).map List.length) +
|
||||
fun i => ((l.take i).map List.length).sum +
|
||||
(l[i]?.map fun xs => xs.findIdx p).getD 0 := by
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons xs l ih =>
|
||||
simp only [join, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
|
||||
simp only [flatten, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
|
||||
findIdx?_succ]
|
||||
split
|
||||
· simp only [Option.map_some', take_zero, sum_nil, length_cons, zero_lt_succ,
|
||||
@@ -976,4 +980,13 @@ theorem IsInfix.lookup_eq_none {l₁ l₂ : List (α × β)} (h : l₁ <:+: l₂
|
||||
|
||||
end lookup
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
@[deprecated head_flatten (since := "2024-10-14")] abbrev head_join := @head_flatten
|
||||
@[deprecated getLast_flatten (since := "2024-10-14")] abbrev getLast_join := @getLast_flatten
|
||||
@[deprecated find?_flatten (since := "2024-10-14")] abbrev find?_join := @find?_flatten
|
||||
@[deprecated find?_flatten_eq_none (since := "2024-10-14")] abbrev find?_join_eq_none := @find?_flatten_eq_none
|
||||
@[deprecated find?_flatten_eq_some (since := "2024-10-14")] abbrev find?_join_eq_some := @find?_flatten_eq_some
|
||||
@[deprecated findIdx?_flatten (since := "2024-10-14")] abbrev findIdx?_join := @findIdx?_flatten
|
||||
|
||||
end List
|
||||
|
||||
@@ -93,29 +93,29 @@ The following operations are given `@[csimp]` replacements below:
|
||||
@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by
|
||||
funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_toList, -Array.size_toArray]
|
||||
|
||||
/-! ### bind -/
|
||||
/-! ### flatMap -/
|
||||
|
||||
/-- Tail recursive version of `List.bind`. -/
|
||||
@[inline] def bindTR (as : List α) (f : α → List β) : List β := go as #[] where
|
||||
/-- Auxiliary for `bind`: `bind.go f as = acc.toList ++ bind f as` -/
|
||||
/-- Tail recursive version of `List.flatMap`. -/
|
||||
@[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 bind_eq_bindTR : @List.bind = @bindTR := by
|
||||
@[csimp] theorem flatMap_eq_flatMapTR : @List.flatMap = @flatMapTR := by
|
||||
funext α β as f
|
||||
let rec go : ∀ as acc, bindTR.go f as acc = acc.toList ++ as.bind f
|
||||
| [], acc => by simp [bindTR.go, bind]
|
||||
| x::xs, acc => by simp [bindTR.go, bind, go xs]
|
||||
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]
|
||||
exact (go as #[]).symm
|
||||
|
||||
/-! ### join -/
|
||||
/-! ### flatten -/
|
||||
|
||||
/-- Tail recursive version of `List.join`. -/
|
||||
@[inline] def joinTR (l : List (List α)) : List α := bindTR l id
|
||||
/-- Tail recursive version of `List.flatten`. -/
|
||||
@[inline] def flattenTR (l : List (List α)) : List α := flatMapTR l id
|
||||
|
||||
@[csimp] theorem join_eq_joinTR : @join = @joinTR := by
|
||||
funext α l; rw [← List.bind_id, List.bind_eq_bindTR]; rfl
|
||||
@[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
|
||||
funext α l; rw [← List.flatMap_id, List.flatMap_eq_flatMapTR]; rfl
|
||||
|
||||
/-! ## Sublists -/
|
||||
|
||||
@@ -322,7 +322,7 @@ where
|
||||
| [_] => simp
|
||||
| x::y::xs =>
|
||||
let rec go {acc x} : ∀ xs,
|
||||
intercalateTR.go sep.toArray x xs acc = acc.toList ++ join (intersperse sep (x::xs))
|
||||
intercalateTR.go sep.toArray x xs acc = acc.toList ++ flatten (intersperse sep (x::xs))
|
||||
| [] => by simp [intercalateTR.go]
|
||||
| _::_ => by simp [intercalateTR.go, go]
|
||||
simp [intersperse, go]
|
||||
|
||||
@@ -1343,12 +1343,12 @@ theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
|
||||
simp
|
||||
|
||||
@[simp] theorem head_map (f : α → β) (l : List α) (w) :
|
||||
head (map f l) w = f (head l (by simpa using w)) := by
|
||||
(map f l).head w = f (l.head (by simpa using w)) := by
|
||||
cases l
|
||||
· simp at w
|
||||
· simp_all
|
||||
|
||||
@[simp] theorem head?_map (f : α → β) (l : List α) : head? (map f l) = (head? l).map f := by
|
||||
@[simp] theorem head?_map (f : α → β) (l : List α) : (map f l).head? = l.head?.map f := by
|
||||
cases l <;> rfl
|
||||
|
||||
@[simp] theorem map_tail? (f : α → β) (l : List α) : (tail? l).map (map f) = tail? (map f l) := by
|
||||
@@ -2068,106 +2068,97 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∨ ∃ L b, l = concat L b
|
||||
| _, .inl rfl => .inr ⟨[], a, rfl⟩
|
||||
| _, .inr ⟨L, b, rfl⟩ => .inr ⟨a::L, b, rfl⟩
|
||||
|
||||
/-! ### join -/
|
||||
/-! ### flatten -/
|
||||
|
||||
@[simp] theorem length_join (L : List (List α)) : (join L).length = Nat.sum (L.map length) := by
|
||||
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
|
||||
induction L with
|
||||
| nil => rfl
|
||||
| cons =>
|
||||
simp [join, length_append, *]
|
||||
simp [flatten, length_append, *]
|
||||
|
||||
theorem join_singleton (l : List α) : [l].join = l := by simp
|
||||
theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
|
||||
|
||||
@[simp] theorem mem_join : ∀ {L : List (List α)}, a ∈ L.join ↔ ∃ l, l ∈ L ∧ a ∈ l
|
||||
@[simp] theorem mem_flatten : ∀ {L : List (List α)}, a ∈ L.flatten ↔ ∃ l, l ∈ L ∧ a ∈ l
|
||||
| [] => by simp
|
||||
| b :: l => by simp [mem_join, or_and_right, exists_or]
|
||||
| b :: l => by simp [mem_flatten, or_and_right, exists_or]
|
||||
|
||||
@[simp] theorem join_eq_nil_iff {L : List (List α)} : L.join = [] ↔ ∀ l ∈ L, l = [] := by
|
||||
@[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] ↔ ∀ l ∈ L, l = [] := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@[deprecated join_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @join_eq_nil_iff
|
||||
|
||||
theorem join_ne_nil_iff {xs : List (List α)} : xs.join ≠ [] ↔ ∃ x, x ∈ xs ∧ x ≠ [] := by
|
||||
theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten ≠ [] ↔ ∃ x, x ∈ xs ∧ x ≠ [] := by
|
||||
simp
|
||||
|
||||
@[deprecated join_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @join_ne_nil_iff
|
||||
theorem exists_of_mem_flatten : a ∈ flatten L → ∃ l, l ∈ L ∧ a ∈ l := mem_flatten.1
|
||||
|
||||
theorem exists_of_mem_join : a ∈ join L → ∃ l, l ∈ L ∧ a ∈ l := mem_join.1
|
||||
theorem mem_flatten_of_mem (lL : l ∈ L) (al : a ∈ l) : a ∈ flatten L := mem_flatten.2 ⟨l, lL, al⟩
|
||||
|
||||
theorem mem_join_of_mem (lL : l ∈ L) (al : a ∈ l) : a ∈ join L := mem_join.2 ⟨l, lL, al⟩
|
||||
|
||||
theorem forall_mem_join {p : α → Prop} {L : List (List α)} :
|
||||
(∀ (x) (_ : x ∈ join L), p x) ↔ ∀ (l) (_ : l ∈ L) (x) (_ : x ∈ l), p x := by
|
||||
simp only [mem_join, forall_exists_index, and_imp]
|
||||
theorem forall_mem_flatten {p : α → Prop} {L : List (List α)} :
|
||||
(∀ (x) (_ : x ∈ flatten L), p x) ↔ ∀ (l) (_ : l ∈ L) (x) (_ : x ∈ l), p x := by
|
||||
simp only [mem_flatten, forall_exists_index, and_imp]
|
||||
constructor <;> (intros; solve_by_elim)
|
||||
|
||||
theorem join_eq_bind {L : List (List α)} : join L = L.bind id := by
|
||||
induction L <;> simp [List.bind]
|
||||
theorem flatten_eq_flatMap {L : List (List α)} : flatten L = L.flatMap id := by
|
||||
induction L <;> simp [List.flatMap]
|
||||
|
||||
theorem head?_join {L : List (List α)} : (join L).head? = L.findSome? fun l => l.head? := by
|
||||
theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun l => l.head? := by
|
||||
induction L with
|
||||
| nil => rfl
|
||||
| cons =>
|
||||
simp only [findSome?_cons]
|
||||
split <;> simp_all
|
||||
|
||||
-- `getLast?_join` is proved later, after the `reverse` section.
|
||||
-- `head_join` and `getLast_join` are proved in `Init.Data.List.Find`.
|
||||
-- `getLast?_flatten` is proved later, after the `reverse` section.
|
||||
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
|
||||
|
||||
theorem foldl_join (f : β → α → β) (b : β) (L : List (List α)) :
|
||||
(join L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
|
||||
theorem foldl_flatten (f : β → α → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
|
||||
induction L generalizing b <;> simp_all
|
||||
|
||||
theorem foldr_join (f : α → β → β) (b : β) (L : List (List α)) :
|
||||
(join L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
|
||||
theorem foldr_flatten (f : α → β → β) (b : β) (L : List (List α)) :
|
||||
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@[simp] theorem map_join (f : α → β) (L : List (List α)) : map f (join L) = join (map (map f) L) := by
|
||||
@[simp] theorem map_flatten (f : α → β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
|
||||
induction L <;> simp_all
|
||||
|
||||
@[simp] theorem filterMap_join (f : α → Option β) (L : List (List α)) :
|
||||
filterMap f (join L) = join (map (filterMap f) L) := by
|
||||
@[simp] theorem filterMap_flatten (f : α → Option β) (L : List (List α)) :
|
||||
filterMap f (flatten L) = flatten (map (filterMap f) L) := by
|
||||
induction L <;> simp [*, filterMap_append]
|
||||
|
||||
@[simp] theorem filter_join (p : α → Bool) (L : List (List α)) :
|
||||
filter p (join L) = join (map (filter p) L) := by
|
||||
@[simp] theorem filter_flatten (p : α → Bool) (L : List (List α)) :
|
||||
filter p (flatten L) = flatten (map (filter p) L) := by
|
||||
induction L <;> simp [*, filter_append]
|
||||
|
||||
theorem join_filter_not_isEmpty :
|
||||
∀ {L : List (List α)}, join (L.filter fun l => !l.isEmpty) = L.join
|
||||
theorem flatten_filter_not_isEmpty :
|
||||
∀ {L : List (List α)}, flatten (L.filter fun l => !l.isEmpty) = L.flatten
|
||||
| [] => rfl
|
||||
| [] :: L
|
||||
| (a :: l) :: L => by
|
||||
simp [join_filter_not_isEmpty (L := L)]
|
||||
simp [flatten_filter_not_isEmpty (L := L)]
|
||||
|
||||
theorem join_filter_ne_nil [DecidablePred fun l : List α => l ≠ []] {L : List (List α)} :
|
||||
join (L.filter fun l => l ≠ []) = L.join := by
|
||||
theorem flatten_filter_ne_nil [DecidablePred fun l : List α => l ≠ []] {L : List (List α)} :
|
||||
flatten (L.filter fun l => l ≠ []) = L.flatten := by
|
||||
simp only [ne_eq, ← isEmpty_iff, Bool.not_eq_true, Bool.decide_eq_false,
|
||||
join_filter_not_isEmpty]
|
||||
flatten_filter_not_isEmpty]
|
||||
|
||||
@[deprecated filter_join (since := "2024-08-26")]
|
||||
theorem join_map_filter (p : α → Bool) (l : List (List α)) :
|
||||
(l.map (filter p)).join = (l.join).filter p := by
|
||||
rw [filter_join]
|
||||
|
||||
@[simp] theorem join_append (L₁ L₂ : List (List α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ := by
|
||||
@[simp] theorem flatten_append (L₁ L₂ : List (List α)) : flatten (L₁ ++ L₂) = flatten L₁ ++ flatten L₂ := by
|
||||
induction L₁ <;> simp_all
|
||||
|
||||
theorem join_concat (L : List (List α)) (l : List α) : join (L ++ [l]) = join L ++ l := by
|
||||
theorem flatten_concat (L : List (List α)) (l : List α) : flatten (L ++ [l]) = flatten L ++ l := by
|
||||
simp
|
||||
|
||||
theorem join_join {L : List (List (List α))} : join (join L) = join (map join L) := by
|
||||
theorem flatten_flatten {L : List (List (List α))} : flatten (flatten L) = flatten (map flatten L) := by
|
||||
induction L <;> simp_all
|
||||
|
||||
theorem join_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
|
||||
xs.join = y :: ys ↔
|
||||
∃ as bs cs, xs = as ++ (y :: bs) :: cs ∧ (∀ l, l ∈ as → l = []) ∧ ys = bs ++ cs.join := by
|
||||
theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
|
||||
xs.flatten = y :: ys ↔
|
||||
∃ as bs cs, xs = as ++ (y :: bs) :: cs ∧ (∀ l, l ∈ as → l = []) ∧ ys = bs ++ cs.flatten := by
|
||||
constructor
|
||||
· induction xs with
|
||||
| nil => simp
|
||||
| cons x xs ih =>
|
||||
intro h
|
||||
simp only [join_cons] at h
|
||||
simp only [flatten_cons] at h
|
||||
replace h := h.symm
|
||||
rw [cons_eq_append_iff] at h
|
||||
obtain (⟨rfl, h⟩ | ⟨z⟩) := h
|
||||
@@ -2178,23 +2169,23 @@ theorem join_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
|
||||
refine ⟨[], a', xs, ?_⟩
|
||||
simp
|
||||
· rintro ⟨as, bs, cs, rfl, h₁, rfl⟩
|
||||
simp [join_eq_nil_iff.mpr h₁]
|
||||
simp [flatten_eq_nil_iff.mpr h₁]
|
||||
|
||||
theorem join_eq_append_iff {xs : List (List α)} {ys zs : List α} :
|
||||
xs.join = ys ++ zs ↔
|
||||
(∃ as bs, xs = as ++ bs ∧ ys = as.join ∧ zs = bs.join) ∨
|
||||
∃ as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ∧ ys = as.join ++ bs ∧
|
||||
zs = c :: cs ++ ds.join := by
|
||||
theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
|
||||
xs.flatten = ys ++ zs ↔
|
||||
(∃ as bs, xs = as ++ bs ∧ ys = as.flatten ∧ zs = bs.flatten) ∨
|
||||
∃ as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ∧ ys = as.flatten ++ bs ∧
|
||||
zs = c :: cs ++ ds.flatten := by
|
||||
constructor
|
||||
· induction xs generalizing ys with
|
||||
| nil =>
|
||||
simp only [join_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
|
||||
simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
|
||||
exists_false, or_false, and_imp, List.cons_ne_nil]
|
||||
rintro rfl rfl
|
||||
exact ⟨[], [], by simp⟩
|
||||
| cons x xs ih =>
|
||||
intro h
|
||||
simp only [join_cons] at h
|
||||
simp only [flatten_cons] at h
|
||||
rw [append_eq_append_iff] at h
|
||||
obtain (⟨ys, rfl, h⟩ | ⟨c', rfl, h⟩) := h
|
||||
· obtain (⟨as, bs, rfl, rfl, rfl⟩ | ⟨as, bs, c, cs, ds, rfl, rfl, rfl⟩) := ih h
|
||||
@@ -2208,18 +2199,15 @@ theorem join_eq_append_iff {xs : List (List α)} {ys zs : List α} :
|
||||
· simp
|
||||
· simp
|
||||
|
||||
@[deprecated join_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @join_eq_cons_iff
|
||||
@[deprecated join_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @join_eq_append_iff
|
||||
|
||||
/-- Two lists of sublists are equal iff their joins coincide, as well as the lengths of the
|
||||
/-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
|
||||
sublists. -/
|
||||
theorem eq_iff_join_eq : ∀ {L L' : List (List α)},
|
||||
L = L' ↔ L.join = L'.join ∧ map length L = map length L'
|
||||
theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
|
||||
L = L' ↔ L.flatten = L'.flatten ∧ map length L = map length L'
|
||||
| _, [] => by simp_all
|
||||
| [], x' :: L' => by simp_all
|
||||
| x :: L, x' :: L' => by
|
||||
simp
|
||||
rw [eq_iff_join_eq]
|
||||
rw [eq_iff_flatten_eq]
|
||||
constructor
|
||||
· rintro ⟨rfl, h₁, h₂⟩
|
||||
simp_all
|
||||
@@ -2227,86 +2215,86 @@ theorem eq_iff_join_eq : ∀ {L L' : List (List α)},
|
||||
obtain ⟨rfl, h⟩ := append_inj h₁ h₂
|
||||
exact ⟨rfl, h, h₃⟩
|
||||
|
||||
/-! ### bind -/
|
||||
/-! ### flatMap -/
|
||||
|
||||
theorem bind_def (l : List α) (f : α → List β) : l.bind f = join (map f l) := by rfl
|
||||
theorem flatMap_def (l : List α) (f : α → List β) : l.flatMap f = flatten (map f l) := by rfl
|
||||
|
||||
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [bind_def]
|
||||
@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
|
||||
|
||||
@[simp] theorem mem_bind {f : α → List β} {b} {l : List α} : b ∈ l.bind f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
|
||||
simp [bind_def, mem_join]
|
||||
@[simp] theorem mem_flatMap {f : α → List β} {b} {l : List α} : b ∈ l.flatMap f ↔ ∃ a, a ∈ l ∧ b ∈ f a := by
|
||||
simp [flatMap_def, mem_flatten]
|
||||
exact ⟨fun ⟨_, ⟨a, h₁, rfl⟩, h₂⟩ => ⟨a, h₁, h₂⟩, fun ⟨a, h₁, h₂⟩ => ⟨_, ⟨a, h₁, rfl⟩, h₂⟩⟩
|
||||
|
||||
theorem exists_of_mem_bind {b : β} {l : List α} {f : α → List β} :
|
||||
b ∈ l.bind f → ∃ a, a ∈ l ∧ b ∈ f a := mem_bind.1
|
||||
theorem exists_of_mem_flatMap {b : β} {l : List α} {f : α → List β} :
|
||||
b ∈ l.flatMap f → ∃ a, a ∈ l ∧ b ∈ f a := mem_flatMap.1
|
||||
|
||||
theorem mem_bind_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
|
||||
b ∈ l.bind f := mem_bind.2 ⟨a, al, h⟩
|
||||
theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a ∈ l) (h : b ∈ f a) :
|
||||
b ∈ l.flatMap f := mem_flatMap.2 ⟨a, al, h⟩
|
||||
|
||||
@[simp]
|
||||
theorem bind_eq_nil_iff {l : List α} {f : α → List β} : List.bind l f = [] ↔ ∀ x ∈ l, f x = [] :=
|
||||
join_eq_nil_iff.trans <| by
|
||||
theorem flatMap_eq_nil_iff {l : List α} {f : α → List β} : List.flatMap l f = [] ↔ ∀ x ∈ l, f x = [] :=
|
||||
flatten_eq_nil_iff.trans <| by
|
||||
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
|
||||
|
||||
@[deprecated bind_eq_nil_iff (since := "2024-09-05")] abbrev bind_eq_nil := @bind_eq_nil_iff
|
||||
@[deprecated flatMap_eq_nil_iff (since := "2024-09-05")] abbrev bind_eq_nil := @flatMap_eq_nil_iff
|
||||
|
||||
theorem forall_mem_bind {p : β → Prop} {l : List α} {f : α → List β} :
|
||||
(∀ (x) (_ : x ∈ l.bind f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
|
||||
simp only [mem_bind, forall_exists_index, and_imp]
|
||||
theorem forall_mem_flatMap {p : β → Prop} {l : List α} {f : α → List β} :
|
||||
(∀ (x) (_ : x ∈ l.flatMap f), p x) ↔ ∀ (a) (_ : a ∈ l) (b) (_ : b ∈ f a), p b := by
|
||||
simp only [mem_flatMap, forall_exists_index, and_imp]
|
||||
constructor <;> (intros; solve_by_elim)
|
||||
|
||||
theorem bind_singleton (f : α → List β) (x : α) : [x].bind f = f x :=
|
||||
theorem flatMap_singleton (f : α → List β) (x : α) : [x].flatMap f = f x :=
|
||||
append_nil (f x)
|
||||
|
||||
@[simp] theorem bind_singleton' (l : List α) : (l.bind fun x => [x]) = l := by
|
||||
@[simp] theorem flatMap_singleton' (l : List α) : (l.flatMap fun x => [x]) = l := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem head?_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).head? = l.findSome? fun a => (f a).head? := by
|
||||
theorem head?_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).head? = l.findSome? fun a => (f a).head? := by
|
||||
induction l with
|
||||
| nil => rfl
|
||||
| cons =>
|
||||
simp only [findSome?_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem bind_append (xs ys : List α) (f : α → List β) :
|
||||
(xs ++ ys).bind f = xs.bind f ++ ys.bind f := by
|
||||
induction xs; {rfl}; simp_all [bind_cons, append_assoc]
|
||||
@[simp] theorem flatMap_append (xs ys : List α) (f : α → List β) :
|
||||
(xs ++ ys).flatMap f = xs.flatMap f ++ ys.flatMap f := by
|
||||
induction xs; {rfl}; simp_all [flatMap_cons, append_assoc]
|
||||
|
||||
@[deprecated bind_append (since := "2024-07-24")] abbrev append_bind := @bind_append
|
||||
@[deprecated flatMap_append (since := "2024-07-24")] abbrev append_bind := @flatMap_append
|
||||
|
||||
theorem bind_assoc {α β} (l : List α) (f : α → List β) (g : β → List γ) :
|
||||
(l.bind f).bind g = l.bind fun x => (f x).bind g := by
|
||||
theorem flatMap_assoc {α β} (l : List α) (f : α → List β) (g : β → List γ) :
|
||||
(l.flatMap f).flatMap g = l.flatMap fun x => (f x).flatMap g := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem map_bind (f : β → γ) (g : α → List β) :
|
||||
∀ l : List α, (l.bind g).map f = l.bind fun a => (g a).map f
|
||||
theorem map_flatMap (f : β → γ) (g : α → List β) :
|
||||
∀ l : List α, (l.flatMap g).map f = l.flatMap fun a => (g a).map f
|
||||
| [] => rfl
|
||||
| a::l => by simp only [bind_cons, map_append, map_bind _ _ l]
|
||||
| a::l => by simp only [flatMap_cons, map_append, map_flatMap _ _ l]
|
||||
|
||||
theorem bind_map (f : α → β) (g : β → List γ) (l : List α) :
|
||||
(map f l).bind g = l.bind (fun a => g (f a)) := by
|
||||
induction l <;> simp [bind_cons, *]
|
||||
theorem flatMap_map (f : α → β) (g : β → List γ) (l : List α) :
|
||||
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
|
||||
induction l <;> simp [flatMap_cons, *]
|
||||
|
||||
theorem map_eq_bind {α β} (f : α → β) (l : List α) : map f l = l.bind fun x => [f x] := by
|
||||
theorem map_eq_flatMap {α β} (f : α → β) (l : List α) : map f l = l.flatMap fun x => [f x] := by
|
||||
simp only [← map_singleton]
|
||||
rw [← bind_singleton' l, map_bind, bind_singleton']
|
||||
rw [← flatMap_singleton' l, map_flatMap, flatMap_singleton']
|
||||
|
||||
theorem filterMap_bind {β γ} (l : List α) (g : α → List β) (f : β → Option γ) :
|
||||
(l.bind g).filterMap f = l.bind fun a => (g a).filterMap f := by
|
||||
theorem filterMap_flatMap {β γ} (l : List α) (g : α → List β) (f : β → Option γ) :
|
||||
(l.flatMap g).filterMap f = l.flatMap fun a => (g a).filterMap f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem filter_bind (l : List α) (g : α → List β) (f : β → Bool) :
|
||||
(l.bind g).filter f = l.bind fun a => (g a).filter f := by
|
||||
theorem filter_flatMap (l : List α) (g : α → List β) (f : β → Bool) :
|
||||
(l.flatMap g).filter f = l.flatMap fun a => (g a).filter f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem bind_eq_foldl (f : α → List β) (l : List α) :
|
||||
l.bind f = l.foldl (fun acc a => acc ++ f a) [] := by
|
||||
suffices ∀ l', l' ++ l.bind f = l.foldl (fun acc a => acc ++ f a) l' by simpa using this []
|
||||
theorem flatMap_eq_foldl (f : α → List β) (l : List α) :
|
||||
l.flatMap f = l.foldl (fun acc a => acc ++ f a) [] := by
|
||||
suffices ∀ l', l' ++ l.flatMap f = l.foldl (fun acc a => acc ++ f a) l' by simpa using this []
|
||||
intro l'
|
||||
induction l generalizing l'
|
||||
· simp
|
||||
· next ih => rw [bind_cons, ← append_assoc, ih, foldl_cons]
|
||||
· next ih => rw [flatMap_cons, ← append_assoc, ih, foldl_cons]
|
||||
|
||||
/-! ### replicate -/
|
||||
|
||||
@@ -2483,23 +2471,23 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
|
||||
(replicate n a).filterMap f = [] := by
|
||||
simp [filterMap_replicate, h]
|
||||
|
||||
@[simp] theorem join_replicate_nil : (replicate n ([] : List α)).join = [] := by
|
||||
@[simp] theorem flatten_replicate_nil : (replicate n ([] : List α)).flatten = [] := by
|
||||
induction n <;> simp_all [replicate_succ]
|
||||
|
||||
@[simp] theorem join_replicate_singleton : (replicate n [a]).join = replicate n a := by
|
||||
@[simp] theorem flatten_replicate_singleton : (replicate n [a]).flatten = replicate n a := by
|
||||
induction n <;> simp_all [replicate_succ]
|
||||
|
||||
@[simp] theorem join_replicate_replicate : (replicate n (replicate m a)).join = replicate (n * m) a := by
|
||||
@[simp] theorem flatten_replicate_replicate : (replicate n (replicate m a)).flatten = replicate (n * m) a := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
| succ n ih =>
|
||||
simp only [replicate_succ, join_cons, ih, append_replicate_replicate, replicate_inj, or_true,
|
||||
simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
|
||||
and_true, add_one_mul, Nat.add_comm]
|
||||
|
||||
theorem bind_replicate {β} (f : α → List β) : (replicate n a).bind f = (replicate n (f a)).join := by
|
||||
theorem flatMap_replicate {β} (f : α → List β) : (replicate n a).flatMap f = (replicate n (f a)).flatten := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
| succ n ih => simp only [replicate_succ, bind_cons, ih, join_cons]
|
||||
| succ n ih => simp only [replicate_succ, flatMap_cons, ih, flatten_cons]
|
||||
|
||||
@[simp] theorem isEmpty_replicate : (replicate n a).isEmpty = decide (n = 0) := by
|
||||
cases n <;> simp [replicate_succ]
|
||||
@@ -2674,20 +2662,20 @@ theorem reverse_eq_concat {xs ys : List α} {a : α} :
|
||||
xs.reverse = ys ++ [a] ↔ xs = a :: ys.reverse := by
|
||||
rw [reverse_eq_iff, reverse_concat]
|
||||
|
||||
/-- Reversing a join is the same as reversing the order of parts and reversing all parts. -/
|
||||
theorem reverse_join (L : List (List α)) :
|
||||
L.join.reverse = (L.map reverse).reverse.join := by
|
||||
/-- Reversing a flatten is the same as reversing the order of parts and reversing all parts. -/
|
||||
theorem reverse_flatten (L : List (List α)) :
|
||||
L.flatten.reverse = (L.map reverse).reverse.flatten := by
|
||||
induction L <;> simp_all
|
||||
|
||||
/-- Joining a reverse is the same as reversing all parts and reversing the joined result. -/
|
||||
theorem join_reverse (L : List (List α)) :
|
||||
L.reverse.join = (L.map reverse).join.reverse := by
|
||||
/-- Flattening a reverse is the same as reversing all parts and reversing the flattened result. -/
|
||||
theorem flatten_reverse (L : List (List α)) :
|
||||
L.reverse.flatten = (L.map reverse).flatten.reverse := by
|
||||
induction L <;> simp_all
|
||||
|
||||
theorem reverse_bind {β} (l : List α) (f : α → List β) : (l.bind f).reverse = l.reverse.bind (reverse ∘ f) := by
|
||||
theorem reverse_flatMap {β} (l : List α) (f : α → List β) : (l.flatMap f).reverse = l.reverse.flatMap (reverse ∘ f) := by
|
||||
induction l <;> simp_all
|
||||
|
||||
theorem bind_reverse {β} (l : List α) (f : α → List β) : (l.reverse.bind f) = (l.bind (reverse ∘ f)).reverse := by
|
||||
theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.flatMap f) = (l.flatMap (reverse ∘ f)).reverse := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
|
||||
@@ -2795,15 +2783,15 @@ theorem getLast_filterMap_of_eq_some {f : α → Option β} {l : List α} {w : l
|
||||
rw [head_filterMap_of_eq_some (by simp_all)]
|
||||
simp_all
|
||||
|
||||
theorem getLast?_bind {L : List α} {f : α → List β} :
|
||||
(L.bind f).getLast? = L.reverse.findSome? fun a => (f a).getLast? := by
|
||||
simp only [← head?_reverse, reverse_bind]
|
||||
rw [head?_bind]
|
||||
theorem getLast?_flatMap {L : List α} {f : α → List β} :
|
||||
(L.flatMap f).getLast? = L.reverse.findSome? fun a => (f a).getLast? := by
|
||||
simp only [← head?_reverse, reverse_flatMap]
|
||||
rw [head?_flatMap]
|
||||
rfl
|
||||
|
||||
theorem getLast?_join {L : List (List α)} :
|
||||
(join L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
|
||||
simp [← bind_id, getLast?_bind]
|
||||
theorem getLast?_flatten {L : List (List α)} :
|
||||
(flatten L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
|
||||
simp [← flatMap_id, getLast?_flatMap]
|
||||
|
||||
theorem getLast?_replicate (a : α) (n : Nat) : (replicate n a).getLast? = if n = 0 then none else some a := by
|
||||
simp only [← head?_reverse, reverse_replicate, head?_replicate]
|
||||
@@ -3302,18 +3290,22 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
|
||||
| nil => rfl
|
||||
| cons h t ih => simp_all [Bool.and_assoc]
|
||||
|
||||
@[simp] theorem any_join {l : List (List α)} : l.join.any f = l.any (any · f) := by
|
||||
@[simp] theorem any_flatten {l : List (List α)} : l.flatten.any f = l.any (any · f) := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem all_join {l : List (List α)} : l.join.all f = l.all (all · f) := by
|
||||
@[deprecated any_flatten (since := "2024-10-14")] abbrev any_join := @any_flatten
|
||||
|
||||
@[simp] theorem all_flatten {l : List (List α)} : l.flatten.all f = l.all (all · f) := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem any_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).any p = l.any fun a => (f a).any p := by
|
||||
@[deprecated all_flatten (since := "2024-10-14")] abbrev all_join := @all_flatten
|
||||
|
||||
@[simp] theorem any_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).any p = l.any fun a => (f a).any p := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem all_bind {l : List α} {f : α → List β} :
|
||||
(l.bind f).all p = l.all fun a => (f a).all p := by
|
||||
@[simp] theorem all_flatMap {l : List α} {f : α → List β} :
|
||||
(l.flatMap f).all p = l.all fun a => (f a).all p := by
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem any_reverse {l : List α} : l.reverse.any f = l.any f := by
|
||||
@@ -3338,4 +3330,72 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
|
||||
(l.insert a).all f = (f a && l.all f) := by
|
||||
simp [all_eq]
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
|
||||
@[deprecated flatten_nil (since := "2024-10-14")] abbrev join_nil := @flatten_nil
|
||||
@[deprecated flatten_cons (since := "2024-10-14")] abbrev join_cons := @flatten_cons
|
||||
@[deprecated length_flatten (since := "2024-10-14")] abbrev length_join := @length_flatten
|
||||
@[deprecated flatten_singleton (since := "2024-10-14")] abbrev join_singleton := @flatten_singleton
|
||||
@[deprecated mem_flatten (since := "2024-10-14")] abbrev mem_join := @mem_flatten
|
||||
@[deprecated flatten_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @flatten_eq_nil_iff
|
||||
@[deprecated flatten_eq_nil_iff (since := "2024-10-14")] abbrev join_eq_nil_iff := @flatten_eq_nil_iff
|
||||
@[deprecated flatten_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @flatten_ne_nil_iff
|
||||
@[deprecated flatten_ne_nil_iff (since := "2024-10-14")] abbrev join_ne_nil_iff := @flatten_ne_nil_iff
|
||||
@[deprecated exists_of_mem_flatten (since := "2024-10-14")] abbrev exists_of_mem_join := @exists_of_mem_flatten
|
||||
@[deprecated mem_flatten_of_mem (since := "2024-10-14")] abbrev mem_join_of_mem := @mem_flatten_of_mem
|
||||
@[deprecated forall_mem_flatten (since := "2024-10-14")] abbrev forall_mem_join := @forall_mem_flatten
|
||||
@[deprecated flatten_eq_flatMap (since := "2024-10-14")] abbrev join_eq_bind := @flatten_eq_flatMap
|
||||
@[deprecated head?_flatten (since := "2024-10-14")] abbrev head?_join := @head?_flatten
|
||||
@[deprecated foldl_flatten (since := "2024-10-14")] abbrev foldl_join := @foldl_flatten
|
||||
@[deprecated foldr_flatten (since := "2024-10-14")] abbrev foldr_join := @foldr_flatten
|
||||
@[deprecated map_flatten (since := "2024-10-14")] abbrev map_join := @map_flatten
|
||||
@[deprecated filterMap_flatten (since := "2024-10-14")] abbrev filterMap_join := @filterMap_flatten
|
||||
@[deprecated filter_flatten (since := "2024-10-14")] abbrev filter_join := @filter_flatten
|
||||
@[deprecated flatten_filter_not_isEmpty (since := "2024-10-14")] abbrev join_filter_not_isEmpty := @flatten_filter_not_isEmpty
|
||||
@[deprecated flatten_filter_ne_nil (since := "2024-10-14")] abbrev join_filter_ne_nil := @flatten_filter_ne_nil
|
||||
@[deprecated filter_flatten (since := "2024-08-26")]
|
||||
theorem join_map_filter (p : α → Bool) (l : List (List α)) :
|
||||
(l.map (filter p)).flatten = (l.flatten).filter p := by
|
||||
rw [filter_flatten]
|
||||
@[deprecated flatten_append (since := "2024-10-14")] abbrev join_append := @flatten_append
|
||||
@[deprecated flatten_concat (since := "2024-10-14")] abbrev join_concat := @flatten_concat
|
||||
@[deprecated flatten_flatten (since := "2024-10-14")] abbrev join_join := @flatten_flatten
|
||||
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons_iff := @flatten_eq_cons_iff
|
||||
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @flatten_eq_cons_iff
|
||||
@[deprecated flatten_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @flatten_eq_append_iff
|
||||
@[deprecated flatten_eq_append_iff (since := "2024-10-14")] abbrev join_eq_append_iff := @flatten_eq_append_iff
|
||||
@[deprecated eq_iff_flatten_eq (since := "2024-10-14")] abbrev eq_iff_join_eq := @eq_iff_flatten_eq
|
||||
@[deprecated flatten_replicate_nil (since := "2024-10-14")] abbrev join_replicate_nil := @flatten_replicate_nil
|
||||
@[deprecated flatten_replicate_singleton (since := "2024-10-14")] abbrev join_replicate_singleton := @flatten_replicate_singleton
|
||||
@[deprecated flatten_replicate_replicate (since := "2024-10-14")] abbrev join_replicate_replicate := @flatten_replicate_replicate
|
||||
@[deprecated reverse_flatten (since := "2024-10-14")] abbrev reverse_join := @reverse_flatten
|
||||
@[deprecated flatten_reverse (since := "2024-10-14")] abbrev join_reverse := @flatten_reverse
|
||||
@[deprecated getLast?_flatten (since := "2024-10-14")] abbrev getLast?_join := @getLast?_flatten
|
||||
@[deprecated flatten_eq_flatMap (since := "2024-10-16")] abbrev flatten_eq_bind := @flatten_eq_flatMap
|
||||
@[deprecated flatMap_def (since := "2024-10-16")] abbrev bind_def := @flatMap_def
|
||||
@[deprecated flatMap_id (since := "2024-10-16")] abbrev bind_id := @flatMap_id
|
||||
@[deprecated mem_flatMap (since := "2024-10-16")] abbrev mem_bind := @mem_flatMap
|
||||
@[deprecated exists_of_mem_flatMap (since := "2024-10-16")] abbrev exists_of_mem_bind := @exists_of_mem_flatMap
|
||||
@[deprecated mem_flatMap_of_mem (since := "2024-10-16")] abbrev mem_bind_of_mem := @mem_flatMap_of_mem
|
||||
@[deprecated flatMap_eq_nil_iff (since := "2024-10-16")] abbrev bind_eq_nil_iff := @flatMap_eq_nil_iff
|
||||
@[deprecated forall_mem_flatMap (since := "2024-10-16")] abbrev forall_mem_bind := @forall_mem_flatMap
|
||||
@[deprecated flatMap_singleton (since := "2024-10-16")] abbrev bind_singleton := @flatMap_singleton
|
||||
@[deprecated flatMap_singleton' (since := "2024-10-16")] abbrev bind_singleton' := @flatMap_singleton'
|
||||
@[deprecated head?_flatMap (since := "2024-10-16")] abbrev head_bind := @head?_flatMap
|
||||
@[deprecated flatMap_append (since := "2024-10-16")] abbrev bind_append := @flatMap_append
|
||||
@[deprecated flatMap_assoc (since := "2024-10-16")] abbrev bind_assoc := @flatMap_assoc
|
||||
@[deprecated map_flatMap (since := "2024-10-16")] abbrev map_bind := @map_flatMap
|
||||
@[deprecated flatMap_map (since := "2024-10-16")] abbrev bind_map := @flatMap_map
|
||||
@[deprecated map_eq_flatMap (since := "2024-10-16")] abbrev map_eq_bind := @map_eq_flatMap
|
||||
@[deprecated filterMap_flatMap (since := "2024-10-16")] abbrev filterMap_bind := @filterMap_flatMap
|
||||
@[deprecated filter_flatMap (since := "2024-10-16")] abbrev filter_bind := @filter_flatMap
|
||||
@[deprecated flatMap_eq_foldl (since := "2024-10-16")] abbrev bind_eq_foldl := @flatMap_eq_foldl
|
||||
@[deprecated flatMap_replicate (since := "2024-10-16")] abbrev bind_replicate := @flatMap_replicate
|
||||
@[deprecated reverse_flatMap (since := "2024-10-16")] abbrev reverse_bind := @reverse_flatMap
|
||||
@[deprecated flatMap_reverse (since := "2024-10-16")] abbrev bind_reverse := @flatMap_reverse
|
||||
@[deprecated getLast?_flatMap (since := "2024-10-16")] abbrev getLast?_bind := @getLast?_flatMap
|
||||
@[deprecated any_flatMap (since := "2024-10-16")] abbrev any_bind := @any_flatMap
|
||||
@[deprecated all_flatMap (since := "2024-10-16")] abbrev all_bind := @all_flatMap
|
||||
|
||||
end List
|
||||
|
||||
248
src/Init/Data/List/MapIdx.lean
Normal file
248
src/Init/Data/List/MapIdx.lean
Normal file
@@ -0,0 +1,248 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison, Mario Carneiro
|
||||
-/
|
||||
|
||||
prelude
|
||||
import Init.Data.Array.Lemmas
|
||||
import Init.Data.List.Nat.Range
|
||||
|
||||
namespace List
|
||||
|
||||
/-! ## Operations using indexes -/
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
/--
|
||||
Given a function `f : Nat → α → β` and `as : list α`, `as = [a₀, a₁, ...]`, returns the list
|
||||
`[f 0 a₀, f 1 a₁, ...]`.
|
||||
-/
|
||||
@[inline] def mapIdx (f : Nat → α → β) (as : List α) : List β := go as #[] where
|
||||
/-- Auxiliary for `mapIdx`:
|
||||
`mapIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/
|
||||
@[specialize] go : List α → Array β → List β
|
||||
| [], acc => acc.toList
|
||||
| a :: as, acc => go as (acc.push (f acc.size a))
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_nil {f : Nat → α → β} : mapIdx f [] = [] :=
|
||||
rfl
|
||||
|
||||
theorem mapIdx_go_append {l₁ l₂ : List α} {arr : Array β} :
|
||||
mapIdx.go f (l₁ ++ l₂) arr = mapIdx.go f l₂ (List.toArray (mapIdx.go f l₁ arr)) := by
|
||||
generalize h : (l₁ ++ l₂).length = len
|
||||
induction len generalizing l₁ arr with
|
||||
| zero =>
|
||||
have l₁_nil : l₁ = [] := by
|
||||
cases l₁
|
||||
· rfl
|
||||
· contradiction
|
||||
have l₂_nil : l₂ = [] := by
|
||||
cases l₂
|
||||
· rfl
|
||||
· rw [List.length_append] at h; contradiction
|
||||
rw [l₁_nil, l₂_nil]; simp only [mapIdx.go, List.toArray_toList]
|
||||
| succ len ih =>
|
||||
cases l₁ with
|
||||
| nil =>
|
||||
simp only [mapIdx.go, nil_append, List.toArray_toList]
|
||||
| cons head tail =>
|
||||
simp only [mapIdx.go, List.append_eq]
|
||||
rw [ih]
|
||||
· simp only [cons_append, length_cons, length_append, Nat.succ.injEq] at h
|
||||
simp only [length_append, h]
|
||||
|
||||
theorem mapIdx_go_length {arr : Array β} :
|
||||
length (mapIdx.go f l arr) = length l + arr.size := by
|
||||
induction l generalizing arr with
|
||||
| nil => simp only [mapIdx.go, length_nil, Nat.zero_add]
|
||||
| cons _ _ ih =>
|
||||
simp only [mapIdx.go, ih, Array.size_push, Nat.add_succ, length_cons, Nat.add_comm]
|
||||
|
||||
@[simp] theorem mapIdx_concat {l : List α} {e : α} :
|
||||
mapIdx f (l ++ [e]) = mapIdx f l ++ [f l.length e] := by
|
||||
unfold mapIdx
|
||||
rw [mapIdx_go_append]
|
||||
simp only [mapIdx.go, Array.size_toArray, mapIdx_go_length, length_nil, Nat.add_zero,
|
||||
Array.push_toList]
|
||||
|
||||
@[simp] theorem mapIdx_singleton {a : α} : mapIdx f [a] = [f 0 a] := by
|
||||
simpa using mapIdx_concat (l := [])
|
||||
|
||||
theorem length_mapIdx_go : ∀ {l : List α} {arr : Array β},
|
||||
(mapIdx.go f l arr).length = l.length + arr.size
|
||||
| [], _ => by simp [mapIdx.go]
|
||||
| a :: l, _ => by
|
||||
simp only [mapIdx.go, length_cons]
|
||||
rw [length_mapIdx_go]
|
||||
simp
|
||||
omega
|
||||
|
||||
@[simp] theorem length_mapIdx {l : List α} : (l.mapIdx f).length = l.length := by
|
||||
simp [mapIdx, length_mapIdx_go]
|
||||
|
||||
theorem getElem?_mapIdx_go : ∀ {l : List α} {arr : Array β} {i : Nat},
|
||||
(mapIdx.go f l arr)[i]? =
|
||||
if h : i < arr.size then some arr[i] else Option.map (f i) l[i - arr.size]?
|
||||
| [], arr, i => by
|
||||
simp only [mapIdx.go, Array.toListImpl_eq, getElem?_eq, Array.length_toList,
|
||||
Array.getElem_eq_getElem_toList, length_nil, Nat.not_lt_zero, ↓reduceDIte, Option.map_none']
|
||||
| a :: l, arr, i => by
|
||||
rw [mapIdx.go, getElem?_mapIdx_go]
|
||||
simp only [Array.size_push]
|
||||
split <;> split
|
||||
· simp only [Option.some.injEq]
|
||||
rw [Array.getElem_eq_getElem_toList]
|
||||
simp only [Array.push_toList]
|
||||
rw [getElem_append_left, Array.getElem_eq_getElem_toList]
|
||||
· have : i = arr.size := by omega
|
||||
simp_all
|
||||
· omega
|
||||
· have : i - arr.size = i - (arr.size + 1) + 1 := by omega
|
||||
simp_all
|
||||
|
||||
@[simp] theorem getElem?_mapIdx {l : List α} {i : Nat} :
|
||||
(l.mapIdx f)[i]? = Option.map (f i) l[i]? := by
|
||||
simp [mapIdx, getElem?_mapIdx_go]
|
||||
|
||||
@[simp] theorem getElem_mapIdx {l : List α} {f : Nat → α → β} {i : Nat} {h : i < (l.mapIdx f).length} :
|
||||
(l.mapIdx f)[i] = f i (l[i]'(by simpa using h)) := by
|
||||
apply Option.some_inj.mp
|
||||
rw [← getElem?_eq_getElem, getElem?_mapIdx, getElem?_eq_getElem (by simpa using h)]
|
||||
simp
|
||||
|
||||
theorem mapIdx_eq_enum_map {l : List α} :
|
||||
l.mapIdx f = l.enum.map (Function.uncurry f) := by
|
||||
ext1 i
|
||||
simp only [getElem?_mapIdx, Option.map, getElem?_map, getElem?_enum]
|
||||
split <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_cons {l : List α} {a : α} :
|
||||
mapIdx f (a :: l) = f 0 a :: mapIdx (fun i => f (i + 1)) l := by
|
||||
simp [mapIdx_eq_enum_map, enum_eq_zip_range, map_uncurry_zip_eq_zipWith,
|
||||
range_succ_eq_map, zipWith_map_left]
|
||||
|
||||
theorem mapIdx_append {K L : List α} :
|
||||
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.length) := by
|
||||
induction K generalizing f with
|
||||
| nil => rfl
|
||||
| cons _ _ ih => simp [ih (f := fun i => f (i + 1)), Nat.add_assoc]
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_eq_nil_iff {l : List α} : List.mapIdx f l = [] ↔ l = [] := by
|
||||
rw [List.mapIdx_eq_enum_map, List.map_eq_nil_iff, List.enum_eq_nil]
|
||||
|
||||
theorem mapIdx_ne_nil_iff {l : List α} :
|
||||
List.mapIdx f l ≠ [] ↔ l ≠ [] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapIdx {b : β} {l : List α}
|
||||
(h : b ∈ mapIdx f l) : ∃ (i : Nat) (h : i < l.length), f i l[i] = b := by
|
||||
rw [mapIdx_eq_enum_map] at h
|
||||
replace h := exists_of_mem_map h
|
||||
simp only [Prod.exists, mk_mem_enum_iff_getElem?, Function.uncurry_apply_pair] at h
|
||||
obtain ⟨i, b, h, rfl⟩ := h
|
||||
rw [getElem?_eq_some_iff] at h
|
||||
obtain ⟨h, rfl⟩ := h
|
||||
exact ⟨i, h, rfl⟩
|
||||
|
||||
@[simp] theorem mem_mapIdx {b : β} {l : List α} :
|
||||
b ∈ mapIdx f l ↔ ∃ (i : Nat) (h : i < l.length), 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_cons_iff {l : List α} {b : β} :
|
||||
mapIdx f l = b :: l₂ ↔
|
||||
∃ (a : α) (l₁ : List α), l = a :: l₁ ∧ f 0 a = b ∧ mapIdx (fun i => f (i + 1)) l₁ = l₂ := by
|
||||
cases l <;> simp [and_assoc]
|
||||
|
||||
theorem mapIdx_eq_cons_iff' {l : List α} {b : β} :
|
||||
mapIdx f l = b :: l₂ ↔
|
||||
l.head?.map (f 0) = some b ∧ l.tail?.map (mapIdx fun i => f (i + 1)) = some l₂ := by
|
||||
cases l <;> simp
|
||||
|
||||
theorem mapIdx_eq_iff {l : List α} : mapIdx f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map (f i) := by
|
||||
constructor
|
||||
· intro w i
|
||||
simpa using congrArg (fun l => l[i]?) w.symm
|
||||
· intro w
|
||||
ext1 i
|
||||
simp [w]
|
||||
|
||||
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
|
||||
· intro w i h
|
||||
simpa [h] using congrArg (fun l => l[i]?) w
|
||||
· intro w
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
simp [w]
|
||||
|
||||
@[simp] theorem mapIdx_set {l : List α} {i : Nat} {a : α} :
|
||||
(l.set i a).mapIdx f = (l.mapIdx f).set i (f i a) := by
|
||||
simp only [mapIdx_eq_iff, getElem?_set, length_mapIdx, getElem?_mapIdx]
|
||||
intro i
|
||||
split
|
||||
· split <;> simp_all
|
||||
· rfl
|
||||
|
||||
@[simp] theorem head_mapIdx {l : List α} {f : Nat → α → β} {w : mapIdx f l ≠ []} :
|
||||
(mapIdx f l).head w = f 0 (l.head (by simpa using w)) := by
|
||||
cases l with
|
||||
| nil => simp at w
|
||||
| cons _ _ => simp
|
||||
|
||||
@[simp] theorem head?_mapIdx {l : List α} {f : Nat → α → β} : (mapIdx f l).head? = l.head?.map (f 0) := by
|
||||
cases l <;> simp
|
||||
|
||||
@[simp] theorem getLast_mapIdx {l : List α} {f : Nat → α → β} {h} :
|
||||
(mapIdx f l).getLast h = f (l.length - 1) (l.getLast (by simpa using h)) := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons _ _ =>
|
||||
simp only [← getElem_cons_length _ _ _ rfl]
|
||||
simp only [mapIdx_cons]
|
||||
simp only [← getElem_cons_length _ _ _ rfl]
|
||||
simp only [← mapIdx_cons, getElem_mapIdx]
|
||||
simp
|
||||
|
||||
@[simp] theorem getLast?_mapIdx {l : List α} {f : Nat → α → β} :
|
||||
(mapIdx f l).getLast? = (getLast? l).map (f (l.length - 1)) := by
|
||||
cases l
|
||||
· simp
|
||||
· rw [getLast?_eq_getLast, getLast?_eq_getLast, getLast_mapIdx] <;> simp
|
||||
|
||||
@[simp] theorem mapIdx_mapIdx {l : List α} {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_replicate_iff {l : List α} {f : Nat → α → β} {b : β} :
|
||||
mapIdx f l = replicate l.length b ↔ ∀ (i : Nat) (h : i < l.length), f i l[i] = b := by
|
||||
simp only [eq_replicate_iff, length_mapIdx, mem_mapIdx, forall_exists_index, true_and]
|
||||
constructor
|
||||
· intro w i h
|
||||
apply w _ _ _ rfl
|
||||
· rintro w _ i h rfl
|
||||
exact w i h
|
||||
|
||||
@[simp] theorem mapIdx_reverse {l : List α} {f : Nat → α → β} :
|
||||
l.reverse.mapIdx f = (mapIdx (fun i => f (l.length - 1 - i)) l).reverse := by
|
||||
simp [mapIdx_eq_iff]
|
||||
intro i
|
||||
by_cases h : i < l.length
|
||||
· simp [getElem?_reverse, h]
|
||||
congr
|
||||
omega
|
||||
· simp at h
|
||||
rw [getElem?_eq_none (by simp [h]), getElem?_eq_none (by simp [h])]
|
||||
simp
|
||||
|
||||
end List
|
||||
@@ -20,20 +20,28 @@ open Nat
|
||||
|
||||
@[simp] theorem min?_nil [Min α] : ([] : List α).min? = none := rfl
|
||||
|
||||
-- We don't put `@[simp]` on `min?_cons`,
|
||||
-- We don't put `@[simp]` on `min?_cons'`,
|
||||
-- because the definition in terms of `foldl` is not useful for proofs.
|
||||
theorem min?_cons [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
|
||||
theorem min?_cons' [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
|
||||
|
||||
@[simp] theorem min?_cons [Min α] [Std.Associative (min : α → α → α)] {xs : List α} :
|
||||
(x :: xs).min? = some (xs.min?.elim x (min x)) := by
|
||||
cases xs <;> simp [min?_cons', foldl_assoc]
|
||||
|
||||
@[simp] theorem min?_eq_none_iff {xs : List α} [Min α] : xs.min? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [min?]
|
||||
|
||||
theorem isSome_min?_of_mem {l : List α} [Min α] {a : α} (h : a ∈ l) :
|
||||
l.min?.isSome := by
|
||||
cases l <;> simp_all [List.min?_cons']
|
||||
|
||||
theorem min?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
|
||||
{xs : List α} → xs.min? = some a → a ∈ xs := by
|
||||
intro xs
|
||||
match xs with
|
||||
| nil => simp
|
||||
| x :: xs =>
|
||||
simp only [min?_cons, Option.some.injEq, List.mem_cons]
|
||||
simp only [min?_cons', Option.some.injEq, List.mem_cons]
|
||||
intro eq
|
||||
induction xs generalizing x with
|
||||
| nil =>
|
||||
@@ -85,23 +93,35 @@ theorem min?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
|
||||
(replicate n a).min? = if n = 0 then none else some a := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons]
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons']
|
||||
|
||||
@[simp] theorem min?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
|
||||
(replicate n a).min? = some a := by
|
||||
simp [min?_replicate, Nat.ne_of_gt h, w]
|
||||
|
||||
theorem foldl_min [Min α] [Std.IdempotentOp (min : α → α → α)] [Std.Associative (min : α → α → α)]
|
||||
{l : List α} {a : α} : l.foldl (init := a) min = min a (l.min?.getD a) := by
|
||||
cases l <;> simp [min?, foldl_assoc, Std.IdempotentOp.idempotent]
|
||||
|
||||
/-! ### max? -/
|
||||
|
||||
@[simp] theorem max?_nil [Max α] : ([] : List α).max? = none := rfl
|
||||
|
||||
-- We don't put `@[simp]` on `max?_cons`,
|
||||
-- We don't put `@[simp]` on `max?_cons'`,
|
||||
-- because the definition in terms of `foldl` is not useful for proofs.
|
||||
theorem max?_cons [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
|
||||
theorem max?_cons' [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
|
||||
|
||||
@[simp] theorem max?_cons [Max α] [Std.Associative (max : α → α → α)] {xs : List α} :
|
||||
(x :: xs).max? = some (xs.max?.elim x (max x)) := by
|
||||
cases xs <;> simp [max?_cons', foldl_assoc]
|
||||
|
||||
@[simp] theorem max?_eq_none_iff {xs : List α} [Max α] : xs.max? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [max?]
|
||||
|
||||
theorem isSome_max?_of_mem {l : List α} [Max α] {a : α} (h : a ∈ l) :
|
||||
l.max?.isSome := by
|
||||
cases l <;> simp_all [List.max?_cons']
|
||||
|
||||
theorem max?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) :
|
||||
{xs : List α} → xs.max? = some a → a ∈ xs
|
||||
| nil => by simp
|
||||
@@ -144,12 +164,16 @@ theorem max?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
|
||||
(replicate n a).max? = if n = 0 then none else some a := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons]
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons']
|
||||
|
||||
@[simp] theorem max?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
|
||||
(replicate n a).max? = some a := by
|
||||
simp [max?_replicate, Nat.ne_of_gt h, w]
|
||||
|
||||
theorem foldl_max [Max α] [Std.IdempotentOp (max : α → α → α)] [Std.Associative (max : α → α → α)]
|
||||
{l : List α} {a : α} : l.foldl (init := a) max = max a (l.max?.getD a) := by
|
||||
cases l <;> simp [max?, foldl_assoc, Std.IdempotentOp.idempotent]
|
||||
|
||||
@[deprecated min?_nil (since := "2024-09-29")] abbrev minimum?_nil := @min?_nil
|
||||
@[deprecated min?_cons (since := "2024-09-29")] abbrev minimum?_cons := @min?_cons
|
||||
@[deprecated min?_eq_none_iff (since := "2024-09-29")] abbrev mininmum?_eq_none_iff := @min?_eq_none_iff
|
||||
|
||||
@@ -96,75 +96,22 @@ theorem min?_eq_some_iff' {xs : List Nat} :
|
||||
(min_eq_or := fun _ _ => Nat.min_def .. ▸ by split <;> simp)
|
||||
(le_min_iff := fun _ _ _ => Nat.le_min)
|
||||
|
||||
-- This could be generalized,
|
||||
-- but will first require further work on order typeclasses in the core repository.
|
||||
theorem min?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).min? = some (match l.min? with
|
||||
| none => a
|
||||
| some m => min a m) := by
|
||||
rw [min?_eq_some_iff']
|
||||
split <;> rename_i h m
|
||||
· simp_all
|
||||
· rw [min?_eq_some_iff'] at m
|
||||
obtain ⟨m, le⟩ := m
|
||||
rw [Nat.min_def]
|
||||
constructor
|
||||
· split
|
||||
· exact mem_cons_self a l
|
||||
· exact mem_cons_of_mem a m
|
||||
· intro b m
|
||||
cases List.mem_cons.1 m with
|
||||
| inl => split <;> omega
|
||||
| inr h =>
|
||||
specialize le b h
|
||||
split <;> omega
|
||||
|
||||
theorem foldl_min
|
||||
{α : Type _} [Min α] [Std.IdempotentOp (min : α → α → α)] [Std.Associative (min : α → α → α)]
|
||||
{l : List α} {a : α} :
|
||||
l.foldl (init := a) min = min a (l.min?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [min?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
|
||||
theorem foldl_min_right {α β : Type _}
|
||||
[Min β] [Std.IdempotentOp (min : β → β → β)] [Std.Associative (min : β → β → β)]
|
||||
{l : List α} {b : β} {f : α → β} :
|
||||
(l.foldl (init := b) fun acc a => min acc (f a)) = min b ((l.map f).min?.getD b) := by
|
||||
rw [← foldl_map, foldl_min]
|
||||
|
||||
theorem foldl_min_le {l : List Nat} {a : Nat} : l.foldl (init := a) min ≤ a := by
|
||||
induction l generalizing a with
|
||||
| nil => simp
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
exact Nat.le_trans ih (Nat.min_le_left _ _)
|
||||
|
||||
theorem foldl_min_min_of_le {l : List Nat} {a b : Nat} (h : a ≤ b) :
|
||||
l.foldl (init := a) min ≤ b :=
|
||||
Nat.le_trans (foldl_min_le) h
|
||||
|
||||
theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
l.min?.getD k ≤ a := by
|
||||
cases l with
|
||||
theorem min?_get_le_of_mem {l : List Nat} {a : Nat} (h : a ∈ l) :
|
||||
l.min?.get (isSome_min?_of_mem h) ≤ a := by
|
||||
induction l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [min?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact foldl_min_le
|
||||
· induction l generalizing b with
|
||||
| nil => simp_all
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact foldl_min_min_of_le (Nat.min_le_right _ _)
|
||||
· exact ih _ h
|
||||
| cons b t ih =>
|
||||
simp only [min?_cons, Option.get_some] at ih ⊢
|
||||
rcases mem_cons.1 h with (rfl|h)
|
||||
· cases t.min? with
|
||||
| none => simp
|
||||
| some b => simpa using Nat.min_le_left _ _
|
||||
· obtain ⟨q, hq⟩ := Option.isSome_iff_exists.1 (isSome_min?_of_mem h)
|
||||
simp only [hq, Option.elim_some] at ih ⊢
|
||||
exact Nat.le_trans (Nat.min_le_right _ _) (ih h)
|
||||
|
||||
theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) : l.min?.getD k ≤ a :=
|
||||
Option.get_eq_getD _ ▸ min?_get_le_of_mem h
|
||||
|
||||
/-! ### max? -/
|
||||
|
||||
@@ -176,75 +123,23 @@ theorem max?_eq_some_iff' {xs : List Nat} :
|
||||
(max_eq_or := fun _ _ => Nat.max_def .. ▸ by split <;> simp)
|
||||
(max_le_iff := fun _ _ _ => Nat.max_le)
|
||||
|
||||
-- This could be generalized,
|
||||
-- but will first require further work on order typeclasses in the core repository.
|
||||
theorem max?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).max? = some (match l.max? with
|
||||
| none => a
|
||||
| some m => max a m) := by
|
||||
rw [max?_eq_some_iff']
|
||||
split <;> rename_i h m
|
||||
· simp_all
|
||||
· rw [max?_eq_some_iff'] at m
|
||||
obtain ⟨m, le⟩ := m
|
||||
rw [Nat.max_def]
|
||||
constructor
|
||||
· split
|
||||
· exact mem_cons_of_mem a m
|
||||
· exact mem_cons_self a l
|
||||
· intro b m
|
||||
cases List.mem_cons.1 m with
|
||||
| inl => split <;> omega
|
||||
| inr h =>
|
||||
specialize le b h
|
||||
split <;> omega
|
||||
|
||||
theorem foldl_max
|
||||
{α : Type _} [Max α] [Std.IdempotentOp (max : α → α → α)] [Std.Associative (max : α → α → α)]
|
||||
{l : List α} {a : α} :
|
||||
l.foldl (init := a) max = max a (l.max?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [max?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
|
||||
theorem foldl_max_right {α β : Type _}
|
||||
[Max β] [Std.IdempotentOp (max : β → β → β)] [Std.Associative (max : β → β → β)]
|
||||
{l : List α} {b : β} {f : α → β} :
|
||||
(l.foldl (init := b) fun acc a => max acc (f a)) = max b ((l.map f).max?.getD b) := by
|
||||
rw [← foldl_map, foldl_max]
|
||||
|
||||
theorem le_foldl_max {l : List Nat} {a : Nat} : a ≤ l.foldl (init := a) max := by
|
||||
induction l generalizing a with
|
||||
| nil => simp
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
exact Nat.le_trans (Nat.le_max_left _ _) ih
|
||||
|
||||
theorem le_foldl_max_of_le {l : List Nat} {a b : Nat} (h : a ≤ b) :
|
||||
a ≤ l.foldl (init := b) max :=
|
||||
Nat.le_trans h (le_foldl_max)
|
||||
theorem le_max?_get_of_mem {l : List Nat} {a : Nat} (h : a ∈ l) :
|
||||
a ≤ l.max?.get (isSome_max?_of_mem h) := by
|
||||
induction l with
|
||||
| nil => simp at h
|
||||
| cons b t ih =>
|
||||
simp only [max?_cons, Option.get_some] at ih ⊢
|
||||
rcases mem_cons.1 h with (rfl|h)
|
||||
· cases t.max? with
|
||||
| none => simp
|
||||
| some b => simpa using Nat.le_max_left _ _
|
||||
· obtain ⟨q, hq⟩ := Option.isSome_iff_exists.1 (isSome_max?_of_mem h)
|
||||
simp only [hq, Option.elim_some] at ih ⊢
|
||||
exact Nat.le_trans (ih h) (Nat.le_max_right _ _)
|
||||
|
||||
theorem le_max?_getD_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
a ≤ l.max?.getD k := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [max?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact le_foldl_max
|
||||
· induction l generalizing b with
|
||||
| nil => simp_all
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact le_foldl_max_of_le (Nat.le_max_right b a)
|
||||
· exact ih _ h
|
||||
a ≤ l.max?.getD k :=
|
||||
Option.get_eq_getD _ ▸ le_max?_get_of_mem h
|
||||
|
||||
@[deprecated min?_eq_some_iff' (since := "2024-09-29")] abbrev minimum?_eq_some_iff' := @min?_eq_some_iff'
|
||||
@[deprecated min?_cons' (since := "2024-09-29")] abbrev minimum?_cons' := @min?_cons'
|
||||
|
||||
@@ -500,4 +500,13 @@ theorem enum_eq_zip_range (l : List α) : l.enum = (range l.length).zip l :=
|
||||
theorem unzip_enum_eq_prod (l : List α) : l.enum.unzip = (range l.length, l) := by
|
||||
simp only [enum_eq_zip_range, unzip_zip, length_range]
|
||||
|
||||
theorem enum_eq_cons_iff {l : List α} :
|
||||
l.enum = x :: l' ↔ ∃ a as, l = a :: as ∧ x = (0, a) ∧ l' = enumFrom 1 as := by
|
||||
rw [enum, enumFrom_eq_cons_iff]
|
||||
|
||||
theorem enum_eq_append_iff {l : List α} :
|
||||
l.enum = l₁ ++ l₂ ↔
|
||||
∃ l₁' l₂', l = l₁' ++ l₂' ∧ l₁ = l₁'.enum ∧ l₂ = l₂'.enumFrom l₁'.length := by
|
||||
simp [enum, enumFrom_eq_append_iff]
|
||||
|
||||
end List
|
||||
|
||||
@@ -160,21 +160,25 @@ theorem pairwise_middle {R : α → α → Prop} (s : ∀ {x y}, R x y → R y x
|
||||
rw [← append_assoc, pairwise_append, @pairwise_append _ _ ([a] ++ l₁), pairwise_append_comm s]
|
||||
simp only [mem_append, or_comm]
|
||||
|
||||
theorem pairwise_join {L : List (List α)} :
|
||||
Pairwise R (join L) ↔
|
||||
theorem pairwise_flatten {L : List (List α)} :
|
||||
Pairwise R (flatten L) ↔
|
||||
(∀ l ∈ L, Pairwise R l) ∧ Pairwise (fun l₁ l₂ => ∀ x ∈ l₁, ∀ y ∈ l₂, R x y) L := by
|
||||
induction L with
|
||||
| nil => simp
|
||||
| cons l L IH =>
|
||||
simp only [join, pairwise_append, IH, mem_join, exists_imp, and_imp, forall_mem_cons,
|
||||
simp only [flatten, pairwise_append, IH, mem_flatten, exists_imp, and_imp, forall_mem_cons,
|
||||
pairwise_cons, and_assoc, and_congr_right_iff]
|
||||
rw [and_comm, and_congr_left_iff]
|
||||
intros; exact ⟨fun h a b c d e => h c d e a b, fun h c d e a b => h a b c d e⟩
|
||||
|
||||
theorem pairwise_bind {R : β → β → Prop} {l : List α} {f : α → List β} :
|
||||
List.Pairwise R (l.bind f) ↔
|
||||
@[deprecated pairwise_flatten (since := "2024-10-14")] abbrev pairwise_join := @pairwise_flatten
|
||||
|
||||
theorem pairwise_flatMap {R : β → β → Prop} {l : List α} {f : α → List β} :
|
||||
List.Pairwise R (l.flatMap f) ↔
|
||||
(∀ a ∈ l, Pairwise R (f a)) ∧ Pairwise (fun a₁ a₂ => ∀ x ∈ f a₁, ∀ y ∈ f a₂, R x y) l := by
|
||||
simp [List.bind, pairwise_join, pairwise_map]
|
||||
simp [List.flatMap, pairwise_flatten, pairwise_map]
|
||||
|
||||
@[deprecated pairwise_flatMap (since := "2024-10-14")] abbrev pairwise_bind := @pairwise_flatMap
|
||||
|
||||
theorem pairwise_reverse {l : List α} :
|
||||
l.reverse.Pairwise R ↔ l.Pairwise (fun a b => R b a) := by
|
||||
|
||||
@@ -461,15 +461,19 @@ theorem Perm.nodup {l l' : List α} (hl : l ~ l') (hR : l.Nodup) : l'.Nodup := h
|
||||
theorem Perm.nodup_iff {l₁ l₂ : List α} : l₁ ~ l₂ → (Nodup l₁ ↔ Nodup l₂) :=
|
||||
Perm.pairwise_iff <| @Ne.symm α
|
||||
|
||||
theorem Perm.join {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.join ~ l₂.join := by
|
||||
theorem Perm.flatten {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.flatten ~ l₂.flatten := by
|
||||
induction h with
|
||||
| nil => rfl
|
||||
| cons _ _ ih => simp only [join_cons, perm_append_left_iff, ih]
|
||||
| swap => simp only [join_cons, ← append_assoc, perm_append_right_iff]; exact perm_append_comm ..
|
||||
| cons _ _ ih => simp only [flatten_cons, perm_append_left_iff, ih]
|
||||
| swap => simp only [flatten_cons, ← append_assoc, perm_append_right_iff]; exact perm_append_comm ..
|
||||
| trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂
|
||||
|
||||
theorem Perm.bind_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f :=
|
||||
(p.map _).join
|
||||
@[deprecated Perm.flatten (since := "2024-10-14")] abbrev Perm.join := @Perm.flatten
|
||||
|
||||
theorem Perm.flatMap_right {l₁ l₂ : List α} (f : α → List β) (p : l₁ ~ l₂) : l₁.flatMap f ~ l₂.flatMap f :=
|
||||
(p.map _).flatten
|
||||
|
||||
@[deprecated Perm.flatMap_right (since := "2024-10-16")] abbrev Perm.bind_right := @Perm.flatMap_right
|
||||
|
||||
theorem Perm.eraseP (f : α → Bool) {l₁ l₂ : List α}
|
||||
(H : Pairwise (fun a b => f a → f b → False) l₁) (p : l₁ ~ l₂) : eraseP f l₁ ~ eraseP f l₂ := by
|
||||
|
||||
@@ -20,7 +20,6 @@ open Nat
|
||||
|
||||
/-! ## Ranges and enumeration -/
|
||||
|
||||
|
||||
/-! ### range' -/
|
||||
|
||||
theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step) n step := by
|
||||
|
||||
@@ -483,30 +483,30 @@ theorem sublist_replicate_iff : l <+ replicate m a ↔ ∃ n, n ≤ m ∧ l = re
|
||||
rw [w]
|
||||
exact (replicate_sublist_replicate a).2 le
|
||||
|
||||
theorem sublist_join_of_mem {L : List (List α)} {l} (h : l ∈ L) : l <+ L.join := by
|
||||
theorem sublist_flatten_of_mem {L : List (List α)} {l} (h : l ∈ L) : l <+ L.flatten := by
|
||||
induction L with
|
||||
| nil => cases h
|
||||
| cons l' L ih =>
|
||||
rcases mem_cons.1 h with (rfl | h)
|
||||
· simp [h]
|
||||
· simp [ih h, join_cons, sublist_append_of_sublist_right]
|
||||
· simp [ih h, flatten_cons, sublist_append_of_sublist_right]
|
||||
|
||||
theorem sublist_join_iff {L : List (List α)} {l} :
|
||||
l <+ L.join ↔
|
||||
∃ L' : List (List α), l = L'.join ∧ ∀ i (_ : i < L'.length), L'[i] <+ L[i]?.getD [] := by
|
||||
theorem sublist_flatten_iff {L : List (List α)} {l} :
|
||||
l <+ L.flatten ↔
|
||||
∃ L' : List (List α), l = L'.flatten ∧ ∀ i (_ : i < L'.length), L'[i] <+ L[i]?.getD [] := by
|
||||
induction L generalizing l with
|
||||
| nil =>
|
||||
constructor
|
||||
· intro w
|
||||
simp only [join_nil, sublist_nil] at w
|
||||
simp only [flatten_nil, sublist_nil] at w
|
||||
subst w
|
||||
exact ⟨[], by simp, fun i x => by cases x⟩
|
||||
· rintro ⟨L', rfl, h⟩
|
||||
simp only [join_nil, sublist_nil, join_eq_nil_iff]
|
||||
simp only [flatten_nil, sublist_nil, flatten_eq_nil_iff]
|
||||
simp only [getElem?_nil, Option.getD_none, sublist_nil] at h
|
||||
exact (forall_getElem (p := (· = []))).1 h
|
||||
| cons l' L ih =>
|
||||
simp only [join_cons, sublist_append_iff, ih]
|
||||
simp only [flatten_cons, sublist_append_iff, ih]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, s, L', rfl, h⟩
|
||||
refine ⟨l₁ :: L', by simp, ?_⟩
|
||||
@@ -517,21 +517,21 @@ theorem sublist_join_iff {L : List (List α)} {l} :
|
||||
| nil =>
|
||||
exact ⟨[], [], by simp, by simp, [], by simp, fun i x => by cases x⟩
|
||||
| cons l₁ L' =>
|
||||
exact ⟨l₁, L'.join, by simp, by simpa using h 0 (by simp), L', rfl,
|
||||
exact ⟨l₁, L'.flatten, by simp, by simpa using h 0 (by simp), L', rfl,
|
||||
fun i lt => by simpa using h (i+1) (Nat.add_lt_add_right lt 1)⟩
|
||||
|
||||
theorem join_sublist_iff {L : List (List α)} {l} :
|
||||
L.join <+ l ↔
|
||||
∃ L' : List (List α), l = L'.join ∧ ∀ i (_ : i < L.length), L[i] <+ L'[i]?.getD [] := by
|
||||
theorem flatten_sublist_iff {L : List (List α)} {l} :
|
||||
L.flatten <+ l ↔
|
||||
∃ L' : List (List α), l = L'.flatten ∧ ∀ i (_ : i < L.length), L[i] <+ L'[i]?.getD [] := by
|
||||
induction L generalizing l with
|
||||
| nil =>
|
||||
constructor
|
||||
· intro _
|
||||
exact ⟨[l], by simp, fun i x => by cases x⟩
|
||||
· rintro ⟨L', rfl, _⟩
|
||||
simp only [join_nil, nil_sublist]
|
||||
simp only [flatten_nil, nil_sublist]
|
||||
| cons l' L ih =>
|
||||
simp only [join_cons, append_sublist_iff, ih]
|
||||
simp only [flatten_cons, append_sublist_iff, ih]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, rfl, s, L', rfl, h⟩
|
||||
refine ⟨l₁ :: L', by simp, ?_⟩
|
||||
@@ -543,7 +543,7 @@ theorem join_sublist_iff {L : List (List α)} {l} :
|
||||
exact ⟨[], [], by simp, by simpa using h 0 (by simp), [], by simp,
|
||||
fun i x => by simpa using h (i+1) (Nat.add_lt_add_right x 1)⟩
|
||||
| cons l₁ L' =>
|
||||
exact ⟨l₁, L'.join, by simp, by simpa using h 0 (by simp), L', rfl,
|
||||
exact ⟨l₁, L'.flatten, by simp, by simpa using h 0 (by simp), L', rfl,
|
||||
fun i lt => by simpa using h (i+1) (Nat.add_lt_add_right lt 1)⟩
|
||||
|
||||
@[simp] theorem isSublist_iff_sublist [BEq α] [LawfulBEq α] {l₁ l₂ : List α} :
|
||||
@@ -938,14 +938,14 @@ theorem isInfix_replicate_iff {n} {a : α} {l : List α} :
|
||||
· simpa using Nat.sub_add_cancel h
|
||||
· simpa using w
|
||||
|
||||
theorem infix_of_mem_join : ∀ {L : List (List α)}, l ∈ L → l <:+: join L
|
||||
theorem infix_of_mem_flatten : ∀ {L : List (List α)}, l ∈ L → l <:+: flatten L
|
||||
| l' :: _, h =>
|
||||
match h with
|
||||
| List.Mem.head .. => infix_append [] _ _
|
||||
| List.Mem.tail _ hlMemL =>
|
||||
IsInfix.trans (infix_of_mem_join hlMemL) <| (suffix_append _ _).isInfix
|
||||
IsInfix.trans (infix_of_mem_flatten hlMemL) <| (suffix_append _ _).isInfix
|
||||
|
||||
theorem prefix_append_right_inj (l) : l ++ l₁ <+: l ++ l₂ ↔ l₁ <+: l₂ :=
|
||||
@[simp] theorem prefix_append_right_inj (l) : l ++ l₁ <+: l ++ l₂ ↔ l₁ <+: l₂ :=
|
||||
exists_congr fun r => by rw [append_assoc, append_right_inj]
|
||||
|
||||
theorem prefix_cons_inj (a) : a :: l₁ <+: a :: l₂ ↔ l₁ <+: l₂ :=
|
||||
@@ -976,7 +976,7 @@ theorem mem_of_mem_drop {n} {l : List α} (h : a ∈ l.drop n) : a ∈ l :=
|
||||
drop_subset _ _ h
|
||||
|
||||
theorem drop_suffix_drop_left (l : List α) {m n : Nat} (h : m ≤ n) : drop n l <:+ drop m l := by
|
||||
rw [← Nat.sub_add_cancel h, ← drop_drop]
|
||||
rw [← Nat.sub_add_cancel h, Nat.add_comm, ← drop_drop]
|
||||
apply drop_suffix
|
||||
|
||||
-- See `Init.Data.List.Nat.TakeDrop` for `take_prefix_take_left`.
|
||||
@@ -1087,4 +1087,11 @@ theorem prefix_iff_eq_take : l₁ <+: l₂ ↔ l₁ = take (length l₁) l₂ :=
|
||||
|
||||
-- See `Init.Data.List.Nat.Sublist` for `suffix_iff_eq_append`, `prefix_take_iff`, and `suffix_iff_eq_drop`.
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
@[deprecated sublist_flatten_of_mem (since := "2024-10-14")] abbrev sublist_join_of_mem := @sublist_flatten_of_mem
|
||||
@[deprecated sublist_flatten_iff (since := "2024-10-14")] abbrev sublist_join_iff := @sublist_flatten_iff
|
||||
@[deprecated flatten_sublist_iff (since := "2024-10-14")] abbrev flatten_join_iff := @flatten_sublist_iff
|
||||
@[deprecated infix_of_mem_flatten (since := "2024-10-14")] abbrev infix_of_mem_join := @infix_of_mem_flatten
|
||||
|
||||
end List
|
||||
|
||||
@@ -97,14 +97,14 @@ theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.
|
||||
|
||||
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 (n + m) l
|
||||
@[simp] theorem drop_drop (n : Nat) : ∀ (m) (l : List α), drop n (drop m l) = drop (m + n) l
|
||||
| m, [] => by simp
|
||||
| 0, l => by simp
|
||||
| m + 1, a :: l =>
|
||||
calc
|
||||
drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
|
||||
_ = drop (n + m) l := drop_drop n m l
|
||||
_ = drop (n + (m + 1)) (a :: l) := rfl
|
||||
_ = drop (m + n) l := drop_drop n m l
|
||||
_ = drop ((m + 1) + n) (a :: l) := by rw [Nat.add_right_comm]; rfl
|
||||
|
||||
theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
|
||||
| 0, _, _ => by simp
|
||||
@@ -112,7 +112,7 @@ theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (t
|
||||
| _+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 m (drop n l) := by
|
||||
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop n (drop m l) := by
|
||||
simp [drop_drop]
|
||||
|
||||
@[simp]
|
||||
@@ -126,7 +126,7 @@ theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) :=
|
||||
|
||||
@[simp]
|
||||
theorem drop_tail (l : List α) (n : Nat) : l.tail.drop n = l.drop (n + 1) := by
|
||||
rw [← drop_drop, drop_one]
|
||||
rw [Nat.add_comm, ← drop_drop, drop_one]
|
||||
|
||||
@[simp]
|
||||
theorem drop_eq_nil_iff {l : List α} {k : Nat} : l.drop k = [] ↔ l.length ≤ k := by
|
||||
|
||||
23
src/Init/Data/List/ToArray.lean
Normal file
23
src/Init/Data/List/ToArray.lean
Normal file
@@ -0,0 +1,23 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Basic
|
||||
|
||||
/--
|
||||
Auxiliary definition for `List.toArray`.
|
||||
`List.toArrayAux as r = r ++ as.toArray`
|
||||
-/
|
||||
@[inline_if_reduce]
|
||||
def List.toArrayAux : List α → Array α → Array α
|
||||
| nil, r => r
|
||||
| cons a as, r => toArrayAux as (r.push a)
|
||||
|
||||
/-- Convert a `List α` into an `Array α`. This is O(n) in the length of the list. -/
|
||||
-- This function is exported to C, where it is called by `Array.mk`
|
||||
-- (the constructor) to implement this functionality.
|
||||
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
|
||||
def List.toArrayImpl (as : List α) : Array α :=
|
||||
as.toArrayAux (Array.mkEmpty as.length)
|
||||
@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.TakeDrop
|
||||
import Init.Data.Function
|
||||
|
||||
/-!
|
||||
# Lemmas about `List.zip`, `List.zipWith`, `List.zipWithAll`, and `List.unzip`.
|
||||
@@ -238,6 +239,14 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
|
||||
| zero => rfl
|
||||
| succ n ih => simp [replicate_succ, ih]
|
||||
|
||||
theorem map_uncurry_zip_eq_zipWith (f : α → β → γ) (l : List α) (l' : List β) :
|
||||
map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
|
||||
rw [zip]
|
||||
induction l generalizing l' with
|
||||
| nil => simp
|
||||
| cons hl tl ih =>
|
||||
cases l' <;> simp [ih]
|
||||
|
||||
/-! ### zip -/
|
||||
|
||||
theorem zip_eq_zipWith : ∀ (l₁ : List α) (l₂ : List β), zip l₁ l₂ = zipWith Prod.mk l₁ l₂
|
||||
|
||||
@@ -131,7 +131,7 @@ theorem or_exists_add_one : p 0 ∨ (Exists fun n => p (n + 1)) ↔ Exists p :=
|
||||
@[simp] theorem blt_eq : (Nat.blt x y = true) = (x < y) := propext <| Iff.intro Nat.le_of_ble_eq_true Nat.ble_eq_true_of_le
|
||||
|
||||
instance : LawfulBEq Nat where
|
||||
eq_of_beq h := Nat.eq_of_beq_eq_true h
|
||||
eq_of_beq h := by simpa using h
|
||||
rfl := by simp [BEq.beq]
|
||||
|
||||
theorem beq_eq_true_eq (a b : Nat) : ((a == b) = true) = (a = b) := by simp
|
||||
@@ -796,6 +796,8 @@ theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
|
||||
| zero => cases h
|
||||
| succ n => simp [Nat.pow_succ]
|
||||
|
||||
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
|
||||
|
||||
instance {n m : Nat} [NeZero n] : NeZero (n^m) :=
|
||||
⟨Nat.ne_zero_iff_zero_lt.mpr (Nat.pos_pow_of_pos m (pos_of_neZero _))⟩
|
||||
|
||||
|
||||
@@ -8,8 +8,6 @@ import Init.Data.Nat.Linear
|
||||
|
||||
namespace Nat
|
||||
|
||||
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
|
||||
|
||||
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
|
||||
have : power * 2 = power + power := by simp_arith
|
||||
rw [this, Nat.sub_add_eq]
|
||||
|
||||
@@ -175,4 +175,68 @@ theorem filter_attach {o : Option α} {p : {x // x ∈ o} → Bool} :
|
||||
o.attach.filter p = o.pbind fun a h => if p ⟨a, h⟩ then some ⟨a, h⟩ else none := by
|
||||
cases o <;> simp [filter_some]
|
||||
|
||||
/-! ## unattach
|
||||
|
||||
`Option.unattach` is the (one-sided) inverse of `Option.attach`. It is a synonym for `Option.map Subtype.val`.
|
||||
|
||||
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
|
||||
functions applied to `l : Option { x // p x }` which only depend on the value, not the predicate, and rewrite these
|
||||
in terms of a simpler function applied to `l.unattach`.
|
||||
|
||||
Further, we provide simp lemmas that push `unattach` inwards.
|
||||
-/
|
||||
|
||||
/--
|
||||
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
|
||||
It is introduced as an intermediate step by lemmas such as `map_subtype`,
|
||||
and is ideally subsequently simplified away by `unattach_attach`.
|
||||
|
||||
If not, usually the right approach is `simp [Option.unattach, -Option.map_subtype]` to unfold.
|
||||
-/
|
||||
def unattach {α : Type _} {p : α → Prop} (o : Option { x // p x }) := o.map (·.val)
|
||||
|
||||
@[simp] theorem unattach_none {p : α → Prop} : (none : Option { x // p x }).unattach = none := rfl
|
||||
@[simp] theorem unattach_some {p : α → Prop} {a : { x // p x }} :
|
||||
(some a).unattach = a.val := rfl
|
||||
|
||||
@[simp] theorem isSome_unattach {p : α → Prop} {o : Option { x // p x }} :
|
||||
o.unattach.isSome = o.isSome := by
|
||||
simp [unattach]
|
||||
|
||||
@[simp] theorem isNone_unattach {p : α → Prop} {o : Option { x // p x }} :
|
||||
o.unattach.isNone = o.isNone := by
|
||||
simp [unattach]
|
||||
|
||||
@[simp] theorem unattach_attach (o : Option α) : o.attach.unattach = o := by
|
||||
cases o <;> simp
|
||||
|
||||
@[simp] theorem unattach_attachWith {p : α → Prop} {o : Option α}
|
||||
{H : ∀ a ∈ o, p a} :
|
||||
(o.attachWith p H).unattach = o := by
|
||||
cases o <;> simp
|
||||
|
||||
/-! ### Recognizing higher order functions on subtypes using a function that only depends on the value. -/
|
||||
|
||||
/--
|
||||
This lemma identifies maps over lists of subtypes, where the function only depends on the value, not the proposition,
|
||||
and simplifies these to the function directly taking the value.
|
||||
-/
|
||||
@[simp] theorem map_subtype {p : α → Prop} {o : Option { x // p x }}
|
||||
{f : { x // p x } → β} {g : α → β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
o.map f = o.unattach.map g := by
|
||||
cases o <;> simp [hf]
|
||||
|
||||
@[simp] theorem bind_subtype {p : α → Prop} {o : Option { x // p x }}
|
||||
{f : { x // p x } → Option β} {g : α → Option β} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(o.bind f) = o.unattach.bind g := by
|
||||
cases o <;> simp [hf]
|
||||
|
||||
@[simp] theorem unattach_filter {p : α → Prop} {o : Option { x // p x }}
|
||||
{f : { x // p x } → Bool} {g : α → Bool} {hf : ∀ x h, f ⟨x, h⟩ = g x} :
|
||||
(o.filter f).unattach = o.unattach.filter g := by
|
||||
cases o
|
||||
· simp
|
||||
· simp only [filter_some, hf, unattach_some]
|
||||
split <;> simp
|
||||
|
||||
end Option
|
||||
|
||||
@@ -79,7 +79,7 @@ theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o :=
|
||||
|
||||
theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> simp [isSome]
|
||||
|
||||
@[simp] theorem isSome_eq_isSome : (isSome x = isSome y) ↔ (x = none ↔ y = none) := by
|
||||
theorem isSome_eq_isSome : (isSome x = isSome y) ↔ (x = none ↔ y = none) := by
|
||||
cases x <;> cases y <;> simp
|
||||
|
||||
@[simp] theorem isNone_none : @isNone α none = true := rfl
|
||||
|
||||
@@ -7,6 +7,8 @@ prelude
|
||||
import Init.SimpLemmas
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Prod
|
||||
|
||||
instance [BEq α] [BEq β] [LawfulBEq α] [LawfulBEq β] : LawfulBEq (α × β) where
|
||||
eq_of_beq {a b} (h : a.1 == b.1 && a.2 == b.2) := by
|
||||
cases a; cases b
|
||||
@@ -14,9 +16,65 @@ instance [BEq α] [BEq β] [LawfulBEq α] [LawfulBEq β] : LawfulBEq (α × β)
|
||||
rfl {a} := by cases a; simp [BEq.beq, LawfulBEq.rfl]
|
||||
|
||||
@[simp]
|
||||
protected theorem Prod.forall {p : α × β → Prop} : (∀ x, p x) ↔ ∀ a b, p (a, b) :=
|
||||
protected theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ ∀ a b, p (a, b) :=
|
||||
⟨fun h a b ↦ h (a, b), fun h ⟨a, b⟩ ↦ h a b⟩
|
||||
|
||||
@[simp]
|
||||
protected theorem Prod.exists {p : α × β → Prop} : (∃ x, p x) ↔ ∃ a b, p (a, b) :=
|
||||
protected theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ ∃ a b, p (a, b) :=
|
||||
⟨fun ⟨⟨a, b⟩, h⟩ ↦ ⟨a, b, h⟩, fun ⟨a, b, h⟩ ↦ ⟨⟨a, b⟩, h⟩⟩
|
||||
|
||||
@[simp] theorem map_id : Prod.map (@id α) (@id β) = id := rfl
|
||||
|
||||
@[simp] theorem map_id' : Prod.map (fun a : α => a) (fun b : β => b) = fun x ↦ x := rfl
|
||||
|
||||
/--
|
||||
Composing a `Prod.map` with another `Prod.map` is equal to
|
||||
a single `Prod.map` of composed functions.
|
||||
-/
|
||||
theorem map_comp_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
|
||||
Prod.map g g' ∘ Prod.map f f' = Prod.map (g ∘ f) (g' ∘ f') :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
Composing a `Prod.map` with another `Prod.map` is equal to
|
||||
a single `Prod.map` of composed functions, fully applied.
|
||||
-/
|
||||
theorem map_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
|
||||
Prod.map g g' (Prod.map f f' x) = Prod.map (g ∘ f) (g' ∘ f') x :=
|
||||
rfl
|
||||
|
||||
/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
|
||||
def swap : α × β → β × α := fun p => (p.2, p.1)
|
||||
|
||||
@[simp]
|
||||
theorem swap_swap : ∀ x : α × β, swap (swap x) = x
|
||||
| ⟨_, _⟩ => rfl
|
||||
|
||||
@[simp]
|
||||
theorem fst_swap {p : α × β} : (swap p).1 = p.2 :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem snd_swap {p : α × β} : (swap p).2 = p.1 :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) :=
|
||||
rfl
|
||||
|
||||
@[simp]
|
||||
theorem swap_swap_eq : swap ∘ swap = @id (α × β) :=
|
||||
funext swap_swap
|
||||
|
||||
@[simp]
|
||||
theorem swap_inj {p q : α × β} : swap p = swap q ↔ p = q := by
|
||||
cases p; cases q; simp [and_comm]
|
||||
|
||||
/--
|
||||
For two functions `f` and `g`, the composition of `Prod.map f g` with `Prod.swap`
|
||||
is equal to the composition of `Prod.swap` with `Prod.map g f`.
|
||||
-/
|
||||
theorem map_comp_swap (f : α → β) (g : γ → δ) :
|
||||
Prod.map f g ∘ Prod.swap = Prod.swap ∘ Prod.map g f := rfl
|
||||
|
||||
end Prod
|
||||
|
||||
@@ -7,7 +7,7 @@ prelude
|
||||
import Init.Data.Format.Basic
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Control.Id
|
||||
open Sum Subtype Nat
|
||||
|
||||
|
||||
@@ -317,6 +317,9 @@ theorem _root_.Char.utf8Size_le_four (c : Char) : c.utf8Size ≤ 4 := by
|
||||
|
||||
@[simp] theorem pos_add_char (p : Pos) (c : Char) : (p + c).byteIdx = p.byteIdx + c.utf8Size := rfl
|
||||
|
||||
protected theorem Pos.ne_zero_of_lt : {a b : Pos} → a < b → b ≠ 0
|
||||
| _, _, hlt, rfl => Nat.not_lt_zero _ hlt
|
||||
|
||||
theorem lt_next (s : String) (i : Pos) : i.1 < (s.next i).1 :=
|
||||
Nat.add_lt_add_left (Char.utf8Size_pos _) _
|
||||
|
||||
@@ -1021,6 +1024,66 @@ instance hasBeq : BEq Substring := ⟨beq⟩
|
||||
def sameAs (ss1 ss2 : Substring) : Bool :=
|
||||
ss1.startPos == ss2.startPos && ss1 == ss2
|
||||
|
||||
/--
|
||||
Returns the longest common prefix of two substrings.
|
||||
The returned substring will use the same underlying string as `s`.
|
||||
-/
|
||||
def commonPrefix (s t : Substring) : Substring :=
|
||||
{ s with stopPos := loop s.startPos t.startPos }
|
||||
where
|
||||
/-- Returns the ending position of the common prefix, working up from `spos, tpos`. -/
|
||||
loop spos tpos :=
|
||||
if h : spos < s.stopPos ∧ tpos < t.stopPos then
|
||||
if s.str.get spos == t.str.get tpos then
|
||||
have := Nat.sub_lt_sub_left h.1 (s.str.lt_next spos)
|
||||
loop (s.str.next spos) (t.str.next tpos)
|
||||
else
|
||||
spos
|
||||
else
|
||||
spos
|
||||
termination_by s.stopPos.byteIdx - spos.byteIdx
|
||||
|
||||
/--
|
||||
Returns the longest common suffix of two substrings.
|
||||
The returned substring will use the same underlying string as `s`.
|
||||
-/
|
||||
def commonSuffix (s t : Substring) : Substring :=
|
||||
{ s with startPos := loop s.stopPos t.stopPos }
|
||||
where
|
||||
/-- Returns the starting position of the common prefix, working down from `spos, tpos`. -/
|
||||
loop spos tpos :=
|
||||
if h : s.startPos < spos ∧ t.startPos < tpos then
|
||||
let spos' := s.str.prev spos
|
||||
let tpos' := t.str.prev tpos
|
||||
if s.str.get spos' == t.str.get tpos' then
|
||||
have : spos' < spos := s.str.prev_lt_of_pos spos (String.Pos.ne_zero_of_lt h.1)
|
||||
loop spos' tpos'
|
||||
else
|
||||
spos
|
||||
else
|
||||
spos
|
||||
termination_by spos.byteIdx
|
||||
|
||||
/--
|
||||
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
|
||||
-/
|
||||
def dropPrefix? (s : Substring) (pre : Substring) : Option Substring :=
|
||||
let t := s.commonPrefix pre
|
||||
if t.bsize = pre.bsize then
|
||||
some { s with startPos := t.stopPos }
|
||||
else
|
||||
none
|
||||
|
||||
/--
|
||||
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
|
||||
-/
|
||||
def dropSuffix? (s : Substring) (suff : Substring) : Option Substring :=
|
||||
let t := s.commonSuffix suff
|
||||
if t.bsize = suff.bsize then
|
||||
some { s with stopPos := t.startPos }
|
||||
else
|
||||
none
|
||||
|
||||
end Substring
|
||||
|
||||
namespace String
|
||||
@@ -1082,6 +1145,28 @@ namespace String
|
||||
@[inline] def decapitalize (s : String) :=
|
||||
s.set 0 <| s.get 0 |>.toLower
|
||||
|
||||
/--
|
||||
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
|
||||
-/
|
||||
def dropPrefix? (s : String) (pre : Substring) : Option Substring :=
|
||||
s.toSubstring.dropPrefix? pre
|
||||
|
||||
/--
|
||||
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
|
||||
-/
|
||||
def dropSuffix? (s : String) (suff : Substring) : Option Substring :=
|
||||
s.toSubstring.dropSuffix? suff
|
||||
|
||||
/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there,
|
||||
or otherwise return `s`. -/
|
||||
def stripPrefix (s : String) (pre : Substring) : String :=
|
||||
s.dropPrefix? pre |>.map Substring.toString |>.getD s
|
||||
|
||||
/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there,
|
||||
or otherwise return `s`. -/
|
||||
def stripSuffix (s : String) (suff : Substring) : String :=
|
||||
s.dropSuffix? suff |>.map Substring.toString |>.getD s
|
||||
|
||||
end String
|
||||
|
||||
namespace Char
|
||||
|
||||
@@ -5,6 +5,7 @@ Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.ByteArray
|
||||
import Init.Data.UInt.Lemmas
|
||||
|
||||
namespace String
|
||||
|
||||
@@ -20,14 +21,14 @@ def toNat! (s : String) : Nat :=
|
||||
def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
let c ← a[i]?
|
||||
if c &&& 0x80 == 0 then
|
||||
some ⟨c.toUInt32, .inl (Nat.lt_trans c.1.2 (by decide))⟩
|
||||
some ⟨c.toUInt32, .inl (Nat.lt_trans c.toBitVec.isLt (by decide))⟩
|
||||
else if c &&& 0xe0 == 0xc0 then
|
||||
let c1 ← a[i+1]?
|
||||
guard (c1 &&& 0xc0 == 0x80)
|
||||
let r := ((c &&& 0x1f).toUInt32 <<< 6) ||| (c1 &&& 0x3f).toUInt32
|
||||
guard (0x80 ≤ r)
|
||||
-- TODO: Prove h from the definition of r once we have the necessary lemmas
|
||||
if h : r < 0xd800 then some ⟨r, .inl h⟩ else none
|
||||
if h : r < 0xd800 then some ⟨r, .inl (UInt32.toNat_lt_of_lt (by decide) h)⟩ else none
|
||||
else if c &&& 0xf0 == 0xe0 then
|
||||
let c1 ← a[i+1]?
|
||||
let c2 ← a[i+2]?
|
||||
@@ -38,7 +39,14 @@ def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
(c2 &&& 0x3f).toUInt32
|
||||
guard (0x800 ≤ r)
|
||||
-- TODO: Prove `r < 0x110000` from the definition of r once we have the necessary lemmas
|
||||
if h : r < 0xd800 ∨ 0xdfff < r ∧ r < 0x110000 then some ⟨r, h⟩ else none
|
||||
if h : r < 0xd800 ∨ 0xdfff < r ∧ r < 0x110000 then
|
||||
have :=
|
||||
match h with
|
||||
| .inl h => Or.inl (UInt32.toNat_lt_of_lt (by decide) h)
|
||||
| .inr h => Or.inr ⟨UInt32.lt_toNat_of_lt (by decide) h.left, UInt32.toNat_lt_of_lt (by decide) h.right⟩
|
||||
some ⟨r, this⟩
|
||||
else
|
||||
none
|
||||
else if c &&& 0xf8 == 0xf0 then
|
||||
let c1 ← a[i+1]?
|
||||
let c2 ← a[i+2]?
|
||||
@@ -50,7 +58,7 @@ def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
|
||||
((c2 &&& 0x3f).toUInt32 <<< 6) |||
|
||||
(c3 &&& 0x3f).toUInt32
|
||||
if h : 0x10000 ≤ r ∧ r < 0x110000 then
|
||||
some ⟨r, .inr ⟨Nat.lt_of_lt_of_le (by decide) h.1, h.2⟩⟩
|
||||
some ⟨r, .inr ⟨Nat.lt_of_lt_of_le (by decide) (UInt32.le_toNat_of_le (by decide) h.left), UInt32.toNat_lt_of_lt (by decide) h.right⟩⟩
|
||||
else none
|
||||
else
|
||||
none
|
||||
@@ -117,11 +125,11 @@ def utf8EncodeChar (c : Char) : List UInt8 :=
|
||||
/-- Converts the given `String` to a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded byte array. -/
|
||||
@[extern "lean_string_to_utf8"]
|
||||
def toUTF8 (a : @& String) : ByteArray :=
|
||||
⟨⟨a.data.bind utf8EncodeChar⟩⟩
|
||||
⟨⟨a.data.flatMap utf8EncodeChar⟩⟩
|
||||
|
||||
@[simp] theorem size_toUTF8 (s : String) : s.toUTF8.size = s.utf8ByteSize := by
|
||||
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.bind]
|
||||
induction s.data <;> simp [List.map, List.join, utf8ByteSize.go, Nat.add_comm, *]
|
||||
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.flatMap]
|
||||
induction s.data <;> simp [List.map, List.flatten, utf8ByteSize.go, Nat.add_comm, *]
|
||||
|
||||
/-- Accesses a byte in the UTF-8 encoding of the `String`. O(1) -/
|
||||
@[extern "lean_string_get_byte_fast"]
|
||||
|
||||
@@ -5,7 +5,7 @@ Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.String.Basic
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.Repr
|
||||
import Init.Data.Int.Basic
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.UInt.Log2
|
||||
import Init.Data.UInt.Lemmas
|
||||
|
||||
@@ -4,52 +4,50 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.UInt.BasicAux
|
||||
import Init.Data.BitVec.Basic
|
||||
|
||||
open Nat
|
||||
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt8 := UInt8.ofNat
|
||||
@[extern "lean_uint8_to_nat"]
|
||||
def UInt8.toNat (n : UInt8) : Nat := n.val.val
|
||||
@[extern "lean_uint8_add"]
|
||||
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.val + b.val⟩
|
||||
def UInt8.add (a b : UInt8) : UInt8 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint8_sub"]
|
||||
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.val - b.val⟩
|
||||
def UInt8.sub (a b : UInt8) : UInt8 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint8_mul"]
|
||||
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.val * b.val⟩
|
||||
def UInt8.mul (a b : UInt8) : UInt8 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint8_div"]
|
||||
def UInt8.div (a b : UInt8) : UInt8 := ⟨a.val / b.val⟩
|
||||
def UInt8.div (a b : UInt8) : UInt8 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint8_mod"]
|
||||
def UInt8.mod (a b : UInt8) : UInt8 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint8_modn"]
|
||||
def UInt8.mod (a b : UInt8) : UInt8 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint8_modn", deprecated UInt8.mod (since := "2024-09-23")]
|
||||
def UInt8.modn (a : UInt8) (n : @& Nat) : UInt8 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint8_land"]
|
||||
def UInt8.land (a b : UInt8) : UInt8 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt8.land (a b : UInt8) : UInt8 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint8_lor"]
|
||||
def UInt8.lor (a b : UInt8) : UInt8 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt8.lor (a b : UInt8) : UInt8 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint8_xor"]
|
||||
def UInt8.xor (a b : UInt8) : UInt8 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt8.xor (a b : UInt8) : UInt8 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint8_shift_left"]
|
||||
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.val <<< (modn b 8).val⟩
|
||||
def UInt8.shiftLeft (a b : UInt8) : UInt8 := ⟨a.toBitVec <<< (mod b 8).toBitVec⟩
|
||||
@[extern "lean_uint8_shift_right"]
|
||||
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.val >>> (modn b 8).val⟩
|
||||
def UInt8.lt (a b : UInt8) : Prop := a.val < b.val
|
||||
def UInt8.le (a b : UInt8) : Prop := a.val ≤ b.val
|
||||
def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.toBitVec >>> (mod b 8).toBitVec⟩
|
||||
def UInt8.lt (a b : UInt8) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt8.le (a b : UInt8) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt8.instOfNat : OfNat UInt8 n := ⟨UInt8.ofNat n⟩
|
||||
instance : Add UInt8 := ⟨UInt8.add⟩
|
||||
instance : Sub UInt8 := ⟨UInt8.sub⟩
|
||||
instance : Mul UInt8 := ⟨UInt8.mul⟩
|
||||
instance : Mod UInt8 := ⟨UInt8.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt8 Nat UInt8 := ⟨UInt8.modn⟩
|
||||
|
||||
instance : Div UInt8 := ⟨UInt8.div⟩
|
||||
instance : LT UInt8 := ⟨UInt8.lt⟩
|
||||
instance : LE UInt8 := ⟨UInt8.le⟩
|
||||
|
||||
@[extern "lean_uint8_complement"]
|
||||
def UInt8.complement (a:UInt8) : UInt8 := 0-(a+1)
|
||||
def UInt8.complement (a : UInt8) : UInt8 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt8 := ⟨UInt8.complement⟩
|
||||
instance : AndOp UInt8 := ⟨UInt8.land⟩
|
||||
@@ -58,69 +56,58 @@ instance : Xor UInt8 := ⟨UInt8.xor⟩
|
||||
instance : ShiftLeft UInt8 := ⟨UInt8.shiftLeft⟩
|
||||
instance : ShiftRight UInt8 := ⟨UInt8.shiftRight⟩
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint8_dec_lt"]
|
||||
def UInt8.decLt (a b : UInt8) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint8_dec_le"]
|
||||
def UInt8.decLe (a b : UInt8) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt8) : Decidable (a < b) := UInt8.decLt a b
|
||||
instance (a b : UInt8) : Decidable (a ≤ b) := UInt8.decLe a b
|
||||
instance : Max UInt8 := maxOfLe
|
||||
instance : Min UInt8 := minOfLe
|
||||
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt16 := UInt16.ofNat
|
||||
@[extern "lean_uint16_to_nat"]
|
||||
def UInt16.toNat (n : UInt16) : Nat := n.val.val
|
||||
@[extern "lean_uint16_add"]
|
||||
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.val + b.val⟩
|
||||
def UInt16.add (a b : UInt16) : UInt16 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint16_sub"]
|
||||
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.val - b.val⟩
|
||||
def UInt16.sub (a b : UInt16) : UInt16 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint16_mul"]
|
||||
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.val * b.val⟩
|
||||
def UInt16.mul (a b : UInt16) : UInt16 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint16_div"]
|
||||
def UInt16.div (a b : UInt16) : UInt16 := ⟨a.val / b.val⟩
|
||||
def UInt16.div (a b : UInt16) : UInt16 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint16_mod"]
|
||||
def UInt16.mod (a b : UInt16) : UInt16 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint16_modn"]
|
||||
def UInt16.mod (a b : UInt16) : UInt16 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint16_modn", deprecated UInt16.mod (since := "2024-09-23")]
|
||||
def UInt16.modn (a : UInt16) (n : @& Nat) : UInt16 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint16_land"]
|
||||
def UInt16.land (a b : UInt16) : UInt16 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt16.land (a b : UInt16) : UInt16 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint16_lor"]
|
||||
def UInt16.lor (a b : UInt16) : UInt16 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt16.lor (a b : UInt16) : UInt16 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint16_xor"]
|
||||
def UInt16.xor (a b : UInt16) : UInt16 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt16.xor (a b : UInt16) : UInt16 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint16_shift_left"]
|
||||
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.val <<< (modn b 16).val⟩
|
||||
@[extern "lean_uint16_to_uint8"]
|
||||
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint8_to_uint16"]
|
||||
def UInt8.toUInt16 (a : UInt8) : UInt16 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.toBitVec <<< (mod b 16).toBitVec⟩
|
||||
@[extern "lean_uint16_shift_right"]
|
||||
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.val >>> (modn b 16).val⟩
|
||||
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
|
||||
def UInt16.le (a b : UInt16) : Prop := a.val ≤ b.val
|
||||
def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.toBitVec >>> (mod b 16).toBitVec⟩
|
||||
def UInt16.lt (a b : UInt16) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt16.le (a b : UInt16) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt16.instOfNat : OfNat UInt16 n := ⟨UInt16.ofNat n⟩
|
||||
instance : Add UInt16 := ⟨UInt16.add⟩
|
||||
instance : Sub UInt16 := ⟨UInt16.sub⟩
|
||||
instance : Mul UInt16 := ⟨UInt16.mul⟩
|
||||
instance : Mod UInt16 := ⟨UInt16.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt16 Nat UInt16 := ⟨UInt16.modn⟩
|
||||
|
||||
instance : Div UInt16 := ⟨UInt16.div⟩
|
||||
instance : LT UInt16 := ⟨UInt16.lt⟩
|
||||
instance : LE UInt16 := ⟨UInt16.le⟩
|
||||
|
||||
@[extern "lean_uint16_complement"]
|
||||
def UInt16.complement (a:UInt16) : UInt16 := 0-(a+1)
|
||||
def UInt16.complement (a : UInt16) : UInt16 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt16 := ⟨UInt16.complement⟩
|
||||
instance : AndOp UInt16 := ⟨UInt16.land⟩
|
||||
@@ -132,74 +119,53 @@ instance : ShiftRight UInt16 := ⟨UInt16.shiftRight⟩
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint16_dec_lt"]
|
||||
def UInt16.decLt (a b : UInt16) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint16_dec_le"]
|
||||
def UInt16.decLe (a b : UInt16) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt16) : Decidable (a < b) := UInt16.decLt a b
|
||||
instance (a b : UInt16) : Decidable (a ≤ b) := UInt16.decLe a b
|
||||
instance : Max UInt16 := maxOfLe
|
||||
instance : Min UInt16 := minOfLe
|
||||
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨Fin.ofNat n⟩
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨⟨n, h⟩⟩
|
||||
/--
|
||||
Converts the given natural number to `UInt32`, but returns `2^32 - 1` for natural numbers `>= 2^32`.
|
||||
-/
|
||||
def UInt32.ofNatTruncate (n : Nat) : UInt32 :=
|
||||
if h : n < UInt32.size then
|
||||
UInt32.ofNat' n h
|
||||
else
|
||||
UInt32.ofNat' (UInt32.size - 1) (by decide)
|
||||
abbrev Nat.toUInt32 := UInt32.ofNat
|
||||
@[extern "lean_uint32_add"]
|
||||
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.val + b.val⟩
|
||||
def UInt32.add (a b : UInt32) : UInt32 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint32_sub"]
|
||||
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.val - b.val⟩
|
||||
def UInt32.sub (a b : UInt32) : UInt32 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint32_mul"]
|
||||
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.val * b.val⟩
|
||||
def UInt32.mul (a b : UInt32) : UInt32 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint32_div"]
|
||||
def UInt32.div (a b : UInt32) : UInt32 := ⟨a.val / b.val⟩
|
||||
def UInt32.div (a b : UInt32) : UInt32 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint32_mod"]
|
||||
def UInt32.mod (a b : UInt32) : UInt32 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint32_modn"]
|
||||
def UInt32.mod (a b : UInt32) : UInt32 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint32_modn", deprecated UInt32.mod (since := "2024-09-23")]
|
||||
def UInt32.modn (a : UInt32) (n : @& Nat) : UInt32 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint32_land"]
|
||||
def UInt32.land (a b : UInt32) : UInt32 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt32.land (a b : UInt32) : UInt32 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint32_lor"]
|
||||
def UInt32.lor (a b : UInt32) : UInt32 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt32.lor (a b : UInt32) : UInt32 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint32_xor"]
|
||||
def UInt32.xor (a b : UInt32) : UInt32 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt32.xor (a b : UInt32) : UInt32 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint32_shift_left"]
|
||||
def UInt32.shiftLeft (a b : UInt32) : UInt32 := ⟨a.val <<< (modn b 32).val⟩
|
||||
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.val >>> (modn b 32).val⟩
|
||||
@[extern "lean_uint32_to_uint8"]
|
||||
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint32_to_uint16"]
|
||||
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint8_to_uint32"]
|
||||
def UInt8.toUInt32 (a : UInt8) : UInt32 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint16_to_uint32"]
|
||||
def UInt16.toUInt32 (a : UInt16) : UInt32 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt32.shiftRight (a b : UInt32) : UInt32 := ⟨a.toBitVec >>> (mod b 32).toBitVec⟩
|
||||
|
||||
instance UInt32.instOfNat : OfNat UInt32 n := ⟨UInt32.ofNat n⟩
|
||||
instance : Add UInt32 := ⟨UInt32.add⟩
|
||||
instance : Sub UInt32 := ⟨UInt32.sub⟩
|
||||
instance : Mul UInt32 := ⟨UInt32.mul⟩
|
||||
instance : Mod UInt32 := ⟨UInt32.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt32 Nat UInt32 := ⟨UInt32.modn⟩
|
||||
|
||||
instance : Div UInt32 := ⟨UInt32.div⟩
|
||||
|
||||
@[extern "lean_uint32_complement"]
|
||||
def UInt32.complement (a:UInt32) : UInt32 := 0-(a+1)
|
||||
def UInt32.complement (a : UInt32) : UInt32 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt32 := ⟨UInt32.complement⟩
|
||||
instance : AndOp UInt32 := ⟨UInt32.land⟩
|
||||
@@ -208,60 +174,45 @@ instance : Xor UInt32 := ⟨UInt32.xor⟩
|
||||
instance : ShiftLeft UInt32 := ⟨UInt32.shiftLeft⟩
|
||||
instance : ShiftRight UInt32 := ⟨UInt32.shiftRight⟩
|
||||
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨Fin.ofNat n⟩
|
||||
abbrev Nat.toUInt64 := UInt64.ofNat
|
||||
@[extern "lean_uint64_to_nat"]
|
||||
def UInt64.toNat (n : UInt64) : Nat := n.val.val
|
||||
@[extern "lean_uint64_add"]
|
||||
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.val + b.val⟩
|
||||
def UInt64.add (a b : UInt64) : UInt64 := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_uint64_sub"]
|
||||
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.val - b.val⟩
|
||||
def UInt64.sub (a b : UInt64) : UInt64 := ⟨a.toBitVec - b.toBitVec⟩
|
||||
@[extern "lean_uint64_mul"]
|
||||
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.val * b.val⟩
|
||||
def UInt64.mul (a b : UInt64) : UInt64 := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_uint64_div"]
|
||||
def UInt64.div (a b : UInt64) : UInt64 := ⟨a.val / b.val⟩
|
||||
def UInt64.div (a b : UInt64) : UInt64 := ⟨BitVec.udiv a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint64_mod"]
|
||||
def UInt64.mod (a b : UInt64) : UInt64 := ⟨a.val % b.val⟩
|
||||
@[extern "lean_uint64_modn"]
|
||||
def UInt64.mod (a b : UInt64) : UInt64 := ⟨BitVec.umod a.toBitVec b.toBitVec⟩
|
||||
@[extern "lean_uint64_modn", deprecated UInt64.mod (since := "2024-09-23")]
|
||||
def UInt64.modn (a : UInt64) (n : @& Nat) : UInt64 := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_uint64_land"]
|
||||
def UInt64.land (a b : UInt64) : UInt64 := ⟨Fin.land a.val b.val⟩
|
||||
def UInt64.land (a b : UInt64) : UInt64 := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_uint64_lor"]
|
||||
def UInt64.lor (a b : UInt64) : UInt64 := ⟨Fin.lor a.val b.val⟩
|
||||
def UInt64.lor (a b : UInt64) : UInt64 := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_uint64_xor"]
|
||||
def UInt64.xor (a b : UInt64) : UInt64 := ⟨Fin.xor a.val b.val⟩
|
||||
def UInt64.xor (a b : UInt64) : UInt64 := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_uint64_shift_left"]
|
||||
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.val <<< (modn b 64).val⟩
|
||||
def UInt64.shiftLeft (a b : UInt64) : UInt64 := ⟨a.toBitVec <<< (mod b 64).toBitVec⟩
|
||||
@[extern "lean_uint64_shift_right"]
|
||||
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.val >>> (modn b 64).val⟩
|
||||
def UInt64.lt (a b : UInt64) : Prop := a.val < b.val
|
||||
def UInt64.le (a b : UInt64) : Prop := a.val ≤ b.val
|
||||
@[extern "lean_uint64_to_uint8"]
|
||||
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint64_to_uint16"]
|
||||
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint64_to_uint32"]
|
||||
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
|
||||
@[extern "lean_uint8_to_uint64"]
|
||||
def UInt8.toUInt64 (a : UInt8) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint16_to_uint64"]
|
||||
def UInt16.toUInt64 (a : UInt16) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
@[extern "lean_uint32_to_uint64"]
|
||||
def UInt32.toUInt64 (a : UInt32) : UInt64 := ⟨a.val, Nat.lt_trans a.1.2 (by decide)⟩
|
||||
def UInt64.shiftRight (a b : UInt64) : UInt64 := ⟨a.toBitVec >>> (mod b 64).toBitVec⟩
|
||||
def UInt64.lt (a b : UInt64) : Prop := a.toBitVec < b.toBitVec
|
||||
def UInt64.le (a b : UInt64) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance UInt64.instOfNat : OfNat UInt64 n := ⟨UInt64.ofNat n⟩
|
||||
instance : Add UInt64 := ⟨UInt64.add⟩
|
||||
instance : Sub UInt64 := ⟨UInt64.sub⟩
|
||||
instance : Mul UInt64 := ⟨UInt64.mul⟩
|
||||
instance : Mod UInt64 := ⟨UInt64.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod UInt64 Nat UInt64 := ⟨UInt64.modn⟩
|
||||
|
||||
instance : Div UInt64 := ⟨UInt64.div⟩
|
||||
instance : LT UInt64 := ⟨UInt64.lt⟩
|
||||
instance : LE UInt64 := ⟨UInt64.le⟩
|
||||
|
||||
@[extern "lean_uint64_complement"]
|
||||
def UInt64.complement (a:UInt64) : UInt64 := 0-(a+1)
|
||||
def UInt64.complement (a : UInt64) : UInt64 := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement UInt64 := ⟨UInt64.complement⟩
|
||||
instance : AndOp UInt64 := ⟨UInt64.land⟩
|
||||
@@ -273,79 +224,52 @@ instance : ShiftRight UInt64 := ⟨UInt64.shiftRight⟩
|
||||
@[extern "lean_bool_to_uint64"]
|
||||
def Bool.toUInt64 (b : Bool) : UInt64 := if b then 1 else 0
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint64_dec_lt"]
|
||||
def UInt64.decLt (a b : UInt64) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_uint64_dec_le"]
|
||||
def UInt64.decLe (a b : UInt64) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : UInt64) : Decidable (a < b) := UInt64.decLt a b
|
||||
instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
|
||||
instance : Max UInt64 := maxOfLe
|
||||
instance : Min UInt64 := minOfLe
|
||||
|
||||
-- This instance would interfere with the global instance `NeZero (n + 1)`,
|
||||
-- so we only enable it locally.
|
||||
@[local instance]
|
||||
private def instNeZeroUSizeSize : NeZero USize.size := ⟨add_one_ne_zero _⟩
|
||||
|
||||
@[deprecated (since := "2024-09-16")]
|
||||
theorem usize_size_gt_zero : USize.size > 0 :=
|
||||
Nat.zero_lt_succ ..
|
||||
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' _ n⟩
|
||||
abbrev Nat.toUSize := USize.ofNat
|
||||
@[extern "lean_usize_to_nat"]
|
||||
def USize.toNat (n : USize) : Nat := n.val.val
|
||||
@[extern "lean_usize_add"]
|
||||
def USize.add (a b : USize) : USize := ⟨a.val + b.val⟩
|
||||
@[extern "lean_usize_sub"]
|
||||
def USize.sub (a b : USize) : USize := ⟨a.val - b.val⟩
|
||||
@[extern "lean_usize_mul"]
|
||||
def USize.mul (a b : USize) : USize := ⟨a.val * b.val⟩
|
||||
def USize.mul (a b : USize) : USize := ⟨a.toBitVec * b.toBitVec⟩
|
||||
@[extern "lean_usize_div"]
|
||||
def USize.div (a b : USize) : USize := ⟨a.val / b.val⟩
|
||||
def USize.div (a b : USize) : USize := ⟨a.toBitVec / b.toBitVec⟩
|
||||
@[extern "lean_usize_mod"]
|
||||
def USize.mod (a b : USize) : USize := ⟨a.val % b.val⟩
|
||||
@[extern "lean_usize_modn"]
|
||||
def USize.mod (a b : USize) : USize := ⟨a.toBitVec % b.toBitVec⟩
|
||||
@[extern "lean_usize_modn", deprecated USize.mod (since := "2024-09-23")]
|
||||
def USize.modn (a : USize) (n : @& Nat) : USize := ⟨Fin.modn a.val n⟩
|
||||
@[extern "lean_usize_land"]
|
||||
def USize.land (a b : USize) : USize := ⟨Fin.land a.val b.val⟩
|
||||
def USize.land (a b : USize) : USize := ⟨a.toBitVec &&& b.toBitVec⟩
|
||||
@[extern "lean_usize_lor"]
|
||||
def USize.lor (a b : USize) : USize := ⟨Fin.lor a.val b.val⟩
|
||||
def USize.lor (a b : USize) : USize := ⟨a.toBitVec ||| b.toBitVec⟩
|
||||
@[extern "lean_usize_xor"]
|
||||
def USize.xor (a b : USize) : USize := ⟨Fin.xor a.val b.val⟩
|
||||
def USize.xor (a b : USize) : USize := ⟨a.toBitVec ^^^ b.toBitVec⟩
|
||||
@[extern "lean_usize_shift_left"]
|
||||
def USize.shiftLeft (a b : USize) : USize := ⟨a.val <<< (modn b System.Platform.numBits).val⟩
|
||||
def USize.shiftLeft (a b : USize) : USize := ⟨a.toBitVec <<< (mod b (USize.ofNat System.Platform.numBits)).toBitVec⟩
|
||||
@[extern "lean_usize_shift_right"]
|
||||
def USize.shiftRight (a b : USize) : USize := ⟨a.val >>> (modn b System.Platform.numBits).val⟩
|
||||
def USize.shiftRight (a b : USize) : USize := ⟨a.toBitVec >>> (mod b (USize.ofNat System.Platform.numBits)).toBitVec⟩
|
||||
@[extern "lean_uint32_to_usize"]
|
||||
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.val a.1.2
|
||||
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.toBitVec.toNat a.toBitVec.isLt
|
||||
@[extern "lean_usize_to_uint32"]
|
||||
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32
|
||||
|
||||
def USize.lt (a b : USize) : Prop := a.val < b.val
|
||||
def USize.le (a b : USize) : Prop := a.val ≤ b.val
|
||||
|
||||
instance USize.instOfNat : OfNat USize n := ⟨USize.ofNat n⟩
|
||||
instance : Add USize := ⟨USize.add⟩
|
||||
instance : Sub USize := ⟨USize.sub⟩
|
||||
instance : Mul USize := ⟨USize.mul⟩
|
||||
instance : Mod USize := ⟨USize.mod⟩
|
||||
|
||||
set_option linter.deprecated false in
|
||||
instance : HMod USize Nat USize := ⟨USize.modn⟩
|
||||
|
||||
instance : Div USize := ⟨USize.div⟩
|
||||
instance : LT USize := ⟨USize.lt⟩
|
||||
instance : LE USize := ⟨USize.le⟩
|
||||
|
||||
@[extern "lean_usize_complement"]
|
||||
def USize.complement (a:USize) : USize := 0-(a+1)
|
||||
def USize.complement (a : USize) : USize := ⟨~~~a.toBitVec⟩
|
||||
|
||||
instance : Complement USize := ⟨USize.complement⟩
|
||||
instance : AndOp USize := ⟨USize.land⟩
|
||||
@@ -354,19 +278,5 @@ instance : Xor USize := ⟨USize.xor⟩
|
||||
instance : ShiftLeft USize := ⟨USize.shiftLeft⟩
|
||||
instance : ShiftRight USize := ⟨USize.shiftRight⟩
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_usize_dec_lt"]
|
||||
def USize.decLt (a b : USize) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n < m))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_usize_dec_le"]
|
||||
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (n <= m))
|
||||
|
||||
instance (a b : USize) : Decidable (a < b) := USize.decLt a b
|
||||
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b
|
||||
instance : Max USize := maxOfLe
|
||||
instance : Min USize := minOfLe
|
||||
|
||||
132
src/Init/Data/UInt/BasicAux.lean
Normal file
132
src/Init/Data/UInt/BasicAux.lean
Normal file
@@ -0,0 +1,132 @@
|
||||
/-
|
||||
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.BitVec.BasicAux
|
||||
|
||||
/-!
|
||||
This module exists to provide the very basic `UInt8` etc. definitions required for
|
||||
`Init.Data.Char.Basic` and `Init.Data.Array.Basic`. These are very important as they are used in
|
||||
meta code that is then (transitively) used in `Init.Data.UInt.Basic` and `Init.Data.BitVec.Basic`.
|
||||
This file thus breaks the import cycle that would be created by this dependency.
|
||||
-/
|
||||
|
||||
open Nat
|
||||
|
||||
def UInt8.val (x : UInt8) : Fin UInt8.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNat (n : @& Nat) : UInt8 := ⟨BitVec.ofNat 8 n⟩
|
||||
abbrev Nat.toUInt8 := UInt8.ofNat
|
||||
@[extern "lean_uint8_to_nat"]
|
||||
def UInt8.toNat (n : UInt8) : Nat := n.toBitVec.toNat
|
||||
|
||||
instance UInt8.instOfNat : OfNat UInt8 n := ⟨UInt8.ofNat n⟩
|
||||
|
||||
def UInt16.val (x : UInt16) : Fin UInt16.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNat (n : @& Nat) : UInt16 := ⟨BitVec.ofNat 16 n⟩
|
||||
abbrev Nat.toUInt16 := UInt16.ofNat
|
||||
@[extern "lean_uint16_to_nat"]
|
||||
def UInt16.toNat (n : UInt16) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_uint16_to_uint8"]
|
||||
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint8_to_uint16"]
|
||||
def UInt8.toUInt16 (a : UInt8) : UInt16 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt16.instOfNat : OfNat UInt16 n := ⟨UInt16.ofNat n⟩
|
||||
|
||||
def UInt32.val (x : UInt32) : Fin UInt32.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat (n : @& Nat) : UInt32 := ⟨BitVec.ofNat 32 n⟩
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := ⟨BitVec.ofNatLt n h⟩
|
||||
/--
|
||||
Converts the given natural number to `UInt32`, but returns `2^32 - 1` for natural numbers `>= 2^32`.
|
||||
-/
|
||||
def UInt32.ofNatTruncate (n : Nat) : UInt32 :=
|
||||
if h : n < UInt32.size then
|
||||
UInt32.ofNat' n h
|
||||
else
|
||||
UInt32.ofNat' (UInt32.size - 1) (by decide)
|
||||
abbrev Nat.toUInt32 := UInt32.ofNat
|
||||
@[extern "lean_uint32_to_uint8"]
|
||||
def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint32_to_uint16"]
|
||||
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint8_to_uint32"]
|
||||
def UInt8.toUInt32 (a : UInt8) : UInt32 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint16_to_uint32"]
|
||||
def UInt16.toUInt32 (a : UInt16) : UInt32 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt32.instOfNat : OfNat UInt32 n := ⟨UInt32.ofNat n⟩
|
||||
|
||||
theorem UInt32.ofNat'_lt_of_lt {n m : Nat} (h1 : n < UInt32.size) (h2 : m < UInt32.size) :
|
||||
n < m → UInt32.ofNat' n h1 < UInt32.ofNat m := by
|
||||
simp only [(· < ·), BitVec.toNat, ofNat', BitVec.ofNatLt, ofNat, BitVec.ofNat, Fin.ofNat',
|
||||
Nat.mod_eq_of_lt h2, imp_self]
|
||||
|
||||
theorem UInt32.lt_ofNat'_of_lt {n m : Nat} (h1 : n < UInt32.size) (h2 : m < UInt32.size) :
|
||||
m < n → UInt32.ofNat m < UInt32.ofNat' n h1 := by
|
||||
simp only [(· < ·), BitVec.toNat, ofNat', BitVec.ofNatLt, ofNat, BitVec.ofNat, Fin.ofNat',
|
||||
Nat.mod_eq_of_lt h2, imp_self]
|
||||
|
||||
def UInt64.val (x : UInt64) : Fin UInt64.size := x.toBitVec.toFin
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNat (n : @& Nat) : UInt64 := ⟨BitVec.ofNat 64 n⟩
|
||||
abbrev Nat.toUInt64 := UInt64.ofNat
|
||||
@[extern "lean_uint64_to_nat"]
|
||||
def UInt64.toNat (n : UInt64) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_uint64_to_uint8"]
|
||||
def UInt64.toUInt8 (a : UInt64) : UInt8 := a.toNat.toUInt8
|
||||
@[extern "lean_uint64_to_uint16"]
|
||||
def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
|
||||
@[extern "lean_uint64_to_uint32"]
|
||||
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
|
||||
@[extern "lean_uint8_to_uint64"]
|
||||
def UInt8.toUInt64 (a : UInt8) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint16_to_uint64"]
|
||||
def UInt16.toUInt64 (a : UInt16) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
@[extern "lean_uint32_to_uint64"]
|
||||
def UInt32.toUInt64 (a : UInt32) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBitVec.isLt (by decide)⟩⟩
|
||||
|
||||
instance UInt64.instOfNat : OfNat UInt64 n := ⟨UInt64.ofNat n⟩
|
||||
|
||||
theorem usize_size_gt_zero : USize.size > 0 := by
|
||||
cases usize_size_eq with
|
||||
| inl h => rw [h]; decide
|
||||
| inr h => rw [h]; decide
|
||||
|
||||
def USize.val (x : USize) : Fin USize.size := x.toBitVec.toFin
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨BitVec.ofNat _ n⟩
|
||||
abbrev Nat.toUSize := USize.ofNat
|
||||
@[extern "lean_usize_to_nat"]
|
||||
def USize.toNat (n : USize) : Nat := n.toBitVec.toNat
|
||||
@[extern "lean_usize_add"]
|
||||
def USize.add (a b : USize) : USize := ⟨a.toBitVec + b.toBitVec⟩
|
||||
@[extern "lean_usize_sub"]
|
||||
def USize.sub (a b : USize) : USize := ⟨a.toBitVec - b.toBitVec⟩
|
||||
|
||||
def USize.lt (a b : USize) : Prop := a.toBitVec < b.toBitVec
|
||||
def USize.le (a b : USize) : Prop := a.toBitVec ≤ b.toBitVec
|
||||
|
||||
instance USize.instOfNat : OfNat USize n := ⟨USize.ofNat n⟩
|
||||
|
||||
instance : Add USize := ⟨USize.add⟩
|
||||
instance : Sub USize := ⟨USize.sub⟩
|
||||
instance : LT USize := ⟨USize.lt⟩
|
||||
instance : LE USize := ⟨USize.le⟩
|
||||
|
||||
@[extern "lean_usize_dec_lt"]
|
||||
def USize.decLt (a b : USize) : Decidable (a < b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
|
||||
|
||||
@[extern "lean_usize_dec_le"]
|
||||
def USize.decLe (a b : USize) : Decidable (a ≤ b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec ≤ b.toBitVec))
|
||||
|
||||
instance (a b : USize) : Decidable (a < b) := USize.decLt a b
|
||||
instance (a b : USize) : Decidable (a ≤ b) := USize.decLe a b
|
||||
@@ -6,13 +6,14 @@ Authors: Markus Himmel
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.Fin.Bitwise
|
||||
import Init.Data.BitVec.Lemmas
|
||||
|
||||
set_option hygiene false in
|
||||
macro "declare_bitwise_uint_theorems" typeName:ident : command =>
|
||||
`(
|
||||
namespace $typeName
|
||||
|
||||
@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := Fin.and_val ..
|
||||
@[simp] protected theorem and_toNat (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := BitVec.toNat_and ..
|
||||
|
||||
end $typeName
|
||||
)
|
||||
|
||||
@@ -6,6 +6,8 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.UInt.Basic
|
||||
import Init.Data.Fin.Lemmas
|
||||
import Init.Data.BitVec.Lemmas
|
||||
import Init.Data.BitVec.Bitblast
|
||||
|
||||
set_option hygiene false in
|
||||
macro "declare_uint_theorems" typeName:ident : command =>
|
||||
@@ -17,50 +19,111 @@ instance : Inhabited $typeName where
|
||||
|
||||
theorem zero_def : (0 : $typeName) = ⟨0⟩ := rfl
|
||||
theorem one_def : (1 : $typeName) = ⟨1⟩ := rfl
|
||||
theorem sub_def (a b : $typeName) : a - b = ⟨a.val - b.val⟩ := rfl
|
||||
theorem mul_def (a b : $typeName) : a * b = ⟨a.val * b.val⟩ := rfl
|
||||
theorem mod_def (a b : $typeName) : a % b = ⟨a.val % b.val⟩ := rfl
|
||||
theorem add_def (a b : $typeName) : a + b = ⟨a.val + b.val⟩ := rfl
|
||||
theorem sub_def (a b : $typeName) : a - b = ⟨a.toBitVec - b.toBitVec⟩ := rfl
|
||||
theorem mul_def (a b : $typeName) : a * b = ⟨a.toBitVec * b.toBitVec⟩ := rfl
|
||||
theorem mod_def (a b : $typeName) : a % b = ⟨a.toBitVec % b.toBitVec⟩ := rfl
|
||||
theorem add_def (a b : $typeName) : a + b = ⟨a.toBitVec + b.toBitVec⟩ := rfl
|
||||
|
||||
@[simp] theorem mk_val_eq : ∀ (a : $typeName), mk a.val = a
|
||||
@[simp] theorem mk_toBitVec_eq : ∀ (a : $typeName), mk a.toBitVec = a
|
||||
| ⟨_, _⟩ => rfl
|
||||
theorem val_eq_of_lt {a : Nat} : a < size → ((ofNat a).val : Nat) = a :=
|
||||
Nat.mod_eq_of_lt
|
||||
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
|
||||
rw [toNat, val_eq_of_lt h]
|
||||
|
||||
theorem le_def {a b : $typeName} : a ≤ b ↔ a.1 ≤ b.1 := .rfl
|
||||
theorem lt_def {a b : $typeName} : a < b ↔ a.1 < b.1 := .rfl
|
||||
theorem lt_iff_val_lt_val {a b : $typeName} : a < b ↔ a.val < b.val := .rfl
|
||||
@[simp] protected theorem not_le {a b : $typeName} : ¬ a ≤ b ↔ b < a := Fin.not_le
|
||||
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b ↔ b ≤ a := Fin.not_lt
|
||||
theorem toBitVec_eq_of_lt {a : Nat} : a < size → (ofNat a).toBitVec.toNat = a :=
|
||||
Nat.mod_eq_of_lt
|
||||
|
||||
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
|
||||
rw [toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
|
||||
|
||||
theorem lt_def {a b : $typeName} : a < b ↔ a.toBitVec < b.toBitVec := .rfl
|
||||
|
||||
@[simp] protected theorem not_le {a b : $typeName} : ¬ a ≤ b ↔ b < a := by simp [le_def, lt_def]
|
||||
|
||||
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b ↔ b ≤ a := by simp [le_def, lt_def]
|
||||
|
||||
@[simp] protected theorem le_refl (a : $typeName) : a ≤ a := by simp [le_def]
|
||||
|
||||
@[simp] protected theorem lt_irrefl (a : $typeName) : ¬ a < a := by simp
|
||||
protected theorem le_trans {a b c : $typeName} : a ≤ b → b ≤ c → a ≤ c := Fin.le_trans
|
||||
protected theorem lt_trans {a b c : $typeName} : a < b → b < c → a < c := Fin.lt_trans
|
||||
protected theorem le_total (a b : $typeName) : a ≤ b ∨ b ≤ a := Fin.le_total a.1 b.1
|
||||
protected theorem lt_asymm {a b : $typeName} (h : a < b) : ¬ b < a := Fin.lt_asymm h
|
||||
protected theorem val_eq_of_eq {a b : $typeName} (h : a = b) : a.val = b.val := h ▸ rfl
|
||||
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by cases a; cases b; simp at h; simp [h]
|
||||
open $typeName (val_eq_of_eq) in
|
||||
protected theorem ne_of_val_ne {a b : $typeName} (h : a.val ≠ b.val) : a ≠ b := fun h' => absurd (val_eq_of_eq h') h
|
||||
open $typeName (ne_of_val_ne) in
|
||||
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := ne_of_val_ne (Fin.ne_of_lt h)
|
||||
|
||||
protected theorem le_trans {a b c : $typeName} : a ≤ b → b ≤ c → a ≤ c := BitVec.le_trans
|
||||
|
||||
protected theorem lt_trans {a b c : $typeName} : a < b → b < c → a < c := BitVec.lt_trans
|
||||
|
||||
protected theorem le_total (a b : $typeName) : a ≤ b ∨ b ≤ a := BitVec.le_total ..
|
||||
|
||||
protected theorem lt_asymm {a b : $typeName} : a < b → ¬ b < a := BitVec.lt_asymm
|
||||
|
||||
protected theorem toBitVec_eq_of_eq {a b : $typeName} (h : a = b) : a.toBitVec = b.toBitVec := h ▸ rfl
|
||||
|
||||
protected theorem eq_of_toBitVec_eq {a b : $typeName} (h : a.toBitVec = b.toBitVec) : a = b := by
|
||||
cases a; cases b; simp_all
|
||||
|
||||
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]
|
||||
|
||||
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) in
|
||||
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a ≠ b := by
|
||||
apply ne_of_toBitVec_ne
|
||||
apply BitVec.ne_of_lt
|
||||
simpa [lt_def] using h
|
||||
|
||||
@[simp] protected theorem toNat_zero : (0 : $typeName).toNat = 0 := Nat.zero_mod _
|
||||
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := Fin.mod_val ..
|
||||
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := Fin.div_val ..
|
||||
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b ≤ a → (a - b).toNat = a.toNat - b.toNat := Fin.sub_val_of_le
|
||||
@[simp] protected theorem toNat_modn (a : $typeName) (b : Nat) : (a.modn b).toNat = a.toNat % b := Fin.modn_val ..
|
||||
protected theorem modn_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % m) < m
|
||||
| ⟨u⟩, h => Fin.modn_lt u h
|
||||
open $typeName (modn_lt) in
|
||||
protected theorem mod_lt (a b : $typeName) (h : 0 < b) : a % b < b := modn_lt _ (by simp [lt_def] at h; exact h)
|
||||
|
||||
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := BitVec.toNat_umod ..
|
||||
|
||||
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := BitVec.toNat_udiv ..
|
||||
|
||||
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b ≤ a → (a - b).toNat = a.toNat - b.toNat := BitVec.toNat_sub_of_le
|
||||
|
||||
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.toBitVec.isLt
|
||||
|
||||
open $typeName (toNat_mod toNat_lt_size) in
|
||||
protected theorem toNat_mod_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % ofNat m) < m := by
|
||||
intro u h1
|
||||
by_cases h2 : m < size
|
||||
· rw [toNat_mod, toNat_ofNat_of_lt h2]
|
||||
apply Nat.mod_lt _ h1
|
||||
· apply Nat.lt_of_lt_of_le
|
||||
· apply toNat_lt_size
|
||||
· simpa using h2
|
||||
|
||||
open $typeName (toNat_mod_lt) in
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated toNat_mod_lt (since := "2024-09-24")]
|
||||
protected theorem modn_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % m) < m := by
|
||||
intro u
|
||||
simp only [(· % ·)]
|
||||
simp only [gt_iff_lt, toNat, modn, Fin.modn_val, BitVec.natCast_eq_ofNat, BitVec.toNat_ofNat,
|
||||
Nat.reducePow]
|
||||
rw [Nat.mod_eq_of_lt]
|
||||
· apply Nat.mod_lt
|
||||
· apply Nat.lt_of_le_of_lt
|
||||
· apply Nat.mod_le
|
||||
· apply Fin.is_lt
|
||||
|
||||
protected theorem mod_lt (a : $typeName) {b : $typeName} : 0 < b → a % b < b := by
|
||||
simp only [lt_def, mod_def]
|
||||
apply BitVec.umod_lt
|
||||
|
||||
protected theorem toNat.inj : ∀ {a b : $typeName}, a.toNat = b.toNat → a = b
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.1.2
|
||||
|
||||
@[simp] protected theorem ofNat_one : ofNat 1 = 1 := rfl
|
||||
|
||||
@[simp]
|
||||
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
|
||||
|
||||
@[simp]
|
||||
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
|
||||
|
||||
@[simp]
|
||||
theorem mk_ofNat (n : Nat) : mk (BitVec.ofNat _ n) = OfNat.ofNat n := rfl
|
||||
|
||||
end $typeName
|
||||
)
|
||||
|
||||
@@ -70,27 +133,34 @@ declare_uint_theorems UInt32
|
||||
declare_uint_theorems UInt64
|
||||
declare_uint_theorems USize
|
||||
|
||||
theorem UInt32.toNat_lt_of_lt {n : UInt32} {m : Nat} (h : m < size) : n < ofNat m → n.toNat < m := by
|
||||
simp [lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem UInt32.lt_toNat_of_lt {n : UInt32} {m : Nat} (h : m < size) : ofNat m < n → m < n.toNat := by
|
||||
simp [lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
theorem UInt32.toNat_le_of_le {n : UInt32} {m : Nat} (h : m < size) : n ≤ ofNat m → n.toNat ≤ m := by
|
||||
simp [le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
|
||||
|
||||
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 (since := "2024-06-23")] protected abbrev UInt8.zero_toNat := @UInt8.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.div_toNat := @UInt8.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.mod_toNat := @UInt8.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.modn_toNat := @UInt8.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.zero_toNat := @UInt16.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.div_toNat := @UInt16.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.mod_toNat := @UInt16.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.modn_toNat := @UInt16.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.zero_toNat := @UInt32.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.div_toNat := @UInt32.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.mod_toNat := @UInt32.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.modn_toNat := @UInt32.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.zero_toNat := @UInt64.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.div_toNat := @UInt64.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.mod_toNat := @UInt64.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.modn_toNat := @UInt64.toNat_modn
|
||||
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.zero_toNat := @USize.toNat_zero
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.div_toNat := @USize.toNat_div
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.mod_toNat := @USize.toNat_mod
|
||||
@[deprecated (since := "2024-06-23")] protected abbrev USize.modn_toNat := @USize.toNat_modn
|
||||
|
||||
@@ -7,16 +7,16 @@ prelude
|
||||
import Init.Data.Fin.Log2
|
||||
|
||||
@[extern "lean_uint8_log2"]
|
||||
def UInt8.log2 (a : UInt8) : UInt8 := ⟨Fin.log2 a.val⟩
|
||||
def UInt8.log2 (a : UInt8) : UInt8 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint16_log2"]
|
||||
def UInt16.log2 (a : UInt16) : UInt16 := ⟨Fin.log2 a.val⟩
|
||||
def UInt16.log2 (a : UInt16) : UInt16 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint32_log2"]
|
||||
def UInt32.log2 (a : UInt32) : UInt32 := ⟨Fin.log2 a.val⟩
|
||||
def UInt32.log2 (a : UInt32) : UInt32 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_uint64_log2"]
|
||||
def UInt64.log2 (a : UInt64) : UInt64 := ⟨Fin.log2 a.val⟩
|
||||
def UInt64.log2 (a : UInt64) : UInt64 := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@[extern "lean_usize_log2"]
|
||||
def USize.log2 (a : USize) : USize := ⟨Fin.log2 a.val⟩
|
||||
def USize.log2 (a : USize) : USize := ⟨⟨Fin.log2 a.val⟩⟩
|
||||
|
||||
@@ -535,24 +535,21 @@ syntax (name := includeStr) "include_str " term : term
|
||||
|
||||
/--
|
||||
The `run_cmd doSeq` command executes code in `CommandElabM Unit`.
|
||||
This is almost the same as `#eval show CommandElabM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
This is the same as `#eval show CommandElabM Unit from discard do doSeq`.
|
||||
-/
|
||||
syntax (name := runCmd) "run_cmd " doSeq : command
|
||||
|
||||
/--
|
||||
The `run_elab doSeq` command executes code in `TermElabM Unit`.
|
||||
This is almost the same as `#eval show TermElabM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
This is the same as `#eval show TermElabM Unit from discard do doSeq`.
|
||||
-/
|
||||
syntax (name := runElab) "run_elab " doSeq : command
|
||||
|
||||
/--
|
||||
The `run_meta doSeq` command executes code in `MetaM Unit`.
|
||||
This is almost the same as `#eval show MetaM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
This is the same as `#eval show MetaM Unit from do discard doSeq`.
|
||||
|
||||
(This is effectively a synonym for `run_elab`.)
|
||||
(This is effectively a synonym for `run_elab` since `MetaM` lifts to `TermElabM`.)
|
||||
-/
|
||||
syntax (name := runMeta) "run_meta " doSeq : command
|
||||
|
||||
@@ -675,6 +672,13 @@ Message ordering:
|
||||
|
||||
For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and drop
|
||||
everything else.
|
||||
|
||||
The command elaborator has special support for `#guard_msgs` for linting.
|
||||
The `#guard_msgs` itself wants to capture linter warnings,
|
||||
so it elaborates the command it is attached to as if it were a top-level command.
|
||||
However, the command elaborator runs linters for *all* top-level commands,
|
||||
which would include `#guard_msgs` itself, and would cause duplicate and/or uncaptured linter warnings.
|
||||
The top-level command elaborator only runs the linters if `#guard_msgs` is not present.
|
||||
-/
|
||||
syntax (name := guardMsgsCmd)
|
||||
(docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command
|
||||
|
||||
@@ -223,38 +223,6 @@ end Lean
|
||||
| `($_ $array $index) => `($array[$index]?)
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr1] def unexpandMkStr1 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr2] def unexpandMkStr2 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr3] def unexpandMkStr3 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr4] def unexpandMkStr4 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str $a4:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr5] def unexpandMkStr5 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr6] def unexpandMkStr6 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr7] def unexpandMkStr7 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str $a7:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString ++ "." ++ a7.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Name.mkStr8] def unexpandMkStr8 : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str $a7:str $a8:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString ++ "." ++ a7.getString ++ "." ++ a8.getString)]
|
||||
| _ => throw ()
|
||||
|
||||
@[app_unexpander Array.empty] def unexpandArrayEmpty : Lean.PrettyPrinter.Unexpander
|
||||
| _ => `(#[])
|
||||
|
||||
|
||||
@@ -1592,9 +1592,6 @@ def Nat.beq : (@& Nat) → (@& Nat) → Bool
|
||||
| succ _, zero => false
|
||||
| succ n, succ m => beq n m
|
||||
|
||||
instance : BEq Nat where
|
||||
beq := Nat.beq
|
||||
|
||||
theorem Nat.eq_of_beq_eq_true : {n m : Nat} → Eq (beq n m) true → Eq n m
|
||||
| zero, zero, _ => rfl
|
||||
| zero, succ _, h => Bool.noConfusion h
|
||||
@@ -1869,6 +1866,52 @@ instance {n} : LE (Fin n) where
|
||||
instance Fin.decLt {n} (a b : Fin n) : Decidable (LT.lt a b) := Nat.decLt ..
|
||||
instance Fin.decLe {n} (a b : Fin n) : Decidable (LE.le a b) := Nat.decLe ..
|
||||
|
||||
/--
|
||||
A bitvector of the specified width.
|
||||
|
||||
This is represented as the underlying `Nat` number in both the runtime
|
||||
and the kernel, inheriting all the special support for `Nat`.
|
||||
-/
|
||||
structure BitVec (w : Nat) where
|
||||
/-- Construct a `BitVec w` from a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
ofFin ::
|
||||
/-- Interpret a bitvector as a number less than `2^w`.
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
toFin : Fin (hPow 2 w)
|
||||
|
||||
/--
|
||||
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
|
||||
-/
|
||||
-- We manually derive the `DecidableEq` instances for `BitVec` because
|
||||
-- we want to have builtin support for bit-vector literals, and we
|
||||
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
|
||||
def BitVec.decEq (x y : BitVec n) : Decidable (Eq x y) :=
|
||||
match x, y with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq (BitVec n) := BitVec.decEq
|
||||
|
||||
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def BitVec.ofNatLt {n : Nat} (i : Nat) (p : LT.lt i (hPow 2 n)) : BitVec n where
|
||||
toFin := ⟨i, p⟩
|
||||
|
||||
/-- Given a bitvector `x`, return the underlying `Nat`. This is O(1) because `BitVec` is a
|
||||
(zero-cost) wrapper around a `Nat`. -/
|
||||
protected def BitVec.toNat (x : BitVec n) : Nat := x.toFin.val
|
||||
|
||||
instance : LT (BitVec n) where lt := (LT.lt ·.toNat ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (LT.lt x y) :=
|
||||
inferInstanceAs (Decidable (LT.lt x.toNat y.toNat))
|
||||
|
||||
instance : LE (BitVec n) where le := (LE.le ·.toNat ·.toNat)
|
||||
instance (x y : BitVec n) : Decidable (LE.le x y) :=
|
||||
inferInstanceAs (Decidable (LE.le x.toNat y.toNat))
|
||||
|
||||
/-- The size of type `UInt8`, that is, `2^8 = 256`. -/
|
||||
abbrev UInt8.size : Nat := 256
|
||||
|
||||
@@ -1877,12 +1920,12 @@ The type of unsigned 8-bit integers. This type has special support in the
|
||||
compiler to make it actually 8 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt8 where
|
||||
/-- Unpack a `UInt8` as a `Nat` less than `2^8`.
|
||||
/-- Unpack a `UInt8` as a `BitVec 8`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt8.size
|
||||
toBitVec : BitVec 8
|
||||
|
||||
attribute [extern "lean_uint8_of_nat_mk"] UInt8.mk
|
||||
attribute [extern "lean_uint8_to_nat"] UInt8.val
|
||||
attribute [extern "lean_uint8_to_nat"] UInt8.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^8` into a `UInt8`.
|
||||
@@ -1890,7 +1933,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint8_of_nat"]
|
||||
def UInt8.ofNatCore (n : @& Nat) (h : LT.lt n UInt8.size) : UInt8 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1901,7 +1944,9 @@ This function is overridden with a native implementation.
|
||||
def UInt8.decEq (a b : UInt8) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt8.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt8.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt8 := UInt8.decEq
|
||||
|
||||
@@ -1916,12 +1961,12 @@ The type of unsigned 16-bit integers. This type has special support in the
|
||||
compiler to make it actually 16 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt16 where
|
||||
/-- Unpack a `UInt16` as a `Nat` less than `2^16`.
|
||||
/-- Unpack a `UInt16` as a `BitVec 16`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt16.size
|
||||
toBitVec : BitVec 16
|
||||
|
||||
attribute [extern "lean_uint16_of_nat_mk"] UInt16.mk
|
||||
attribute [extern "lean_uint16_to_nat"] UInt16.val
|
||||
attribute [extern "lean_uint16_to_nat"] UInt16.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^16` into a `UInt16`.
|
||||
@@ -1929,7 +1974,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint16_of_nat"]
|
||||
def UInt16.ofNatCore (n : @& Nat) (h : LT.lt n UInt16.size) : UInt16 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1940,7 +1985,9 @@ This function is overridden with a native implementation.
|
||||
def UInt16.decEq (a b : UInt16) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt16.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt16.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt16 := UInt16.decEq
|
||||
|
||||
@@ -1955,12 +2002,12 @@ The type of unsigned 32-bit integers. This type has special support in the
|
||||
compiler to make it actually 32 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt32 where
|
||||
/-- Unpack a `UInt32` as a `Nat` less than `2^32`.
|
||||
/-- Unpack a `UInt32` as a `BitVec 32.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt32.size
|
||||
toBitVec : BitVec 32
|
||||
|
||||
attribute [extern "lean_uint32_of_nat_mk"] UInt32.mk
|
||||
attribute [extern "lean_uint32_to_nat"] UInt32.val
|
||||
attribute [extern "lean_uint32_to_nat"] UInt32.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^32` into a `UInt32`.
|
||||
@@ -1968,14 +2015,14 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def UInt32.ofNatCore (n : @& Nat) (h : LT.lt n UInt32.size) : UInt32 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
/--
|
||||
Unpack a `UInt32` as a `Nat`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_to_nat"]
|
||||
def UInt32.toNat (n : UInt32) : Nat := n.val.val
|
||||
def UInt32.toNat (n : UInt32) : Nat := n.toBitVec.toNat
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -1994,30 +2041,26 @@ instance : Inhabited UInt32 where
|
||||
default := UInt32.ofNatCore 0 (by decide)
|
||||
|
||||
instance : LT UInt32 where
|
||||
lt a b := LT.lt a.val b.val
|
||||
lt a b := LT.lt a.toBitVec b.toBitVec
|
||||
|
||||
instance : LE UInt32 where
|
||||
le a b := LE.le a.val b.val
|
||||
le a b := LE.le a.toBitVec b.toBitVec
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
Decides less-equal on `UInt32`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_dec_lt"]
|
||||
def UInt32.decLt (a b : UInt32) : Decidable (LT.lt a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (LT.lt n m))
|
||||
inferInstanceAs (Decidable (LT.lt a.toBitVec b.toBitVec))
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
Decides less-than on `UInt32`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_dec_le"]
|
||||
def UInt32.decLe (a b : UInt32) : Decidable (LE.le a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ => inferInstanceAs (Decidable (LE.le n m))
|
||||
inferInstanceAs (Decidable (LE.le a.toBitVec b.toBitVec))
|
||||
|
||||
instance (a b : UInt32) : Decidable (LT.lt a b) := UInt32.decLt a b
|
||||
instance (a b : UInt32) : Decidable (LE.le a b) := UInt32.decLe a b
|
||||
@@ -2031,12 +2074,12 @@ The type of unsigned 64-bit integers. This type has special support in the
|
||||
compiler to make it actually 64 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure UInt64 where
|
||||
/-- Unpack a `UInt64` as a `Nat` less than `2^64`.
|
||||
/-- Unpack a `UInt64` as a `BitVec 64`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin UInt64.size
|
||||
toBitVec: BitVec 64
|
||||
|
||||
attribute [extern "lean_uint64_of_nat_mk"] UInt64.mk
|
||||
attribute [extern "lean_uint64_to_nat"] UInt64.val
|
||||
attribute [extern "lean_uint64_to_nat"] UInt64.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `2^64` into a `UInt64`.
|
||||
@@ -2044,7 +2087,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint64_of_nat"]
|
||||
def UInt64.ofNatCore (n : @& Nat) (h : LT.lt n UInt64.size) : UInt64 where
|
||||
val := { val := n, isLt := h }
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -2055,36 +2098,20 @@ This function is overridden with a native implementation.
|
||||
def UInt64.decEq (a b : UInt64) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h => isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => UInt64.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => UInt64.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq UInt64 := UInt64.decEq
|
||||
|
||||
instance : Inhabited UInt64 where
|
||||
default := UInt64.ofNatCore 0 (by decide)
|
||||
|
||||
/--
|
||||
The size of type `USize`, that is, `2^System.Platform.numBits`, which may
|
||||
be either `2^32` or `2^64` depending on the platform's architecture.
|
||||
|
||||
Remark: we define `USize.size` using `(2^numBits - 1) + 1` to ensure the
|
||||
Lean unifier can solve constraints such as `?m + 1 = USize.size`. Recall that
|
||||
`numBits` does not reduce to a numeral in the Lean kernel since it is platform
|
||||
specific. Without this trick, the following definition would be rejected by the
|
||||
Lean type checker.
|
||||
```
|
||||
def one: Fin USize.size := 1
|
||||
```
|
||||
Because Lean would fail to synthesize instance `OfNat (Fin USize.size) 1`.
|
||||
Recall that the `OfNat` instance for `Fin` is
|
||||
```
|
||||
instance : OfNat (Fin (n+1)) i where
|
||||
ofNat := Fin.ofNat i
|
||||
```
|
||||
-/
|
||||
abbrev USize.size : Nat := hAdd (hSub (hPow 2 System.Platform.numBits) 1) 1
|
||||
/-- The size of type `USize`, that is, `2^System.Platform.numBits`. -/
|
||||
abbrev USize.size : Nat := (hPow 2 System.Platform.numBits)
|
||||
|
||||
theorem usize_size_eq : Or (Eq USize.size 4294967296) (Eq USize.size 18446744073709551616) :=
|
||||
show Or (Eq (Nat.succ (Nat.sub (hPow 2 System.Platform.numBits) 1)) 4294967296) (Eq (Nat.succ (Nat.sub (hPow 2 System.Platform.numBits) 1)) 18446744073709551616) from
|
||||
show Or (Eq (hPow 2 System.Platform.numBits) 4294967296) (Eq (hPow 2 System.Platform.numBits) 18446744073709551616) from
|
||||
match System.Platform.numBits, System.Platform.numBits_eq with
|
||||
| _, Or.inl rfl => Or.inl (by decide)
|
||||
| _, Or.inr rfl => Or.inr (by decide)
|
||||
@@ -2097,21 +2124,20 @@ For example, if running on a 32-bit machine, USize is equivalent to UInt32.
|
||||
Or on a 64-bit machine, UInt64.
|
||||
-/
|
||||
structure USize where
|
||||
/-- Unpack a `USize` as a `Nat` less than `USize.size`.
|
||||
/-- Unpack a `USize` as a `BitVec System.Platform.numBits`.
|
||||
This function is overridden with a native implementation. -/
|
||||
val : Fin USize.size
|
||||
toBitVec : BitVec System.Platform.numBits
|
||||
|
||||
attribute [extern "lean_usize_of_nat_mk"] USize.mk
|
||||
attribute [extern "lean_usize_to_nat"] USize.val
|
||||
attribute [extern "lean_usize_to_nat"] USize.toBitVec
|
||||
|
||||
/--
|
||||
Pack a `Nat` less than `USize.size` into a `USize`.
|
||||
This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNatCore (n : @& Nat) (h : LT.lt n USize.size) : USize := {
|
||||
val := { val := n, isLt := h }
|
||||
}
|
||||
def USize.ofNatCore (n : @& Nat) (h : LT.lt n USize.size) : USize where
|
||||
toBitVec := BitVec.ofNatLt n h
|
||||
|
||||
set_option bootstrap.genMatcherCode false in
|
||||
/--
|
||||
@@ -2122,7 +2148,9 @@ This function is overridden with a native implementation.
|
||||
def USize.decEq (a b : USize) : Decidable (Eq a b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
dite (Eq n m) (fun h =>isTrue (h ▸ rfl)) (fun h => isFalse (fun h' => USize.noConfusion h' (fun h' => absurd h' h)))
|
||||
dite (Eq n m)
|
||||
(fun h => isTrue (h ▸ rfl))
|
||||
(fun h => isFalse (fun h' => USize.noConfusion h' (fun h' => absurd h' h)))
|
||||
|
||||
instance : DecidableEq USize := USize.decEq
|
||||
|
||||
@@ -2138,12 +2166,12 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat32 (n : @& Nat) (h : LT.lt n 4294967296) : USize where
|
||||
val := {
|
||||
val := n
|
||||
isLt := match USize.size, usize_size_eq with
|
||||
toBitVec :=
|
||||
BitVec.ofNatLt n (
|
||||
match System.Platform.numBits, System.Platform.numBits_eq with
|
||||
| _, Or.inl rfl => h
|
||||
| _, Or.inr rfl => Nat.lt_trans h (by decide)
|
||||
}
|
||||
)
|
||||
|
||||
/--
|
||||
A `Nat` denotes a valid unicode codepoint if it is less than `0x110000`, and
|
||||
@@ -2178,7 +2206,7 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_uint32_of_nat"]
|
||||
def Char.ofNatAux (n : @& Nat) (h : n.isValidChar) : Char :=
|
||||
{ val := ⟨{ val := n, isLt := isValidChar_UInt32 h }⟩, valid := h }
|
||||
{ val := ⟨BitVec.ofNatLt n (isValidChar_UInt32 h)⟩, valid := h }
|
||||
|
||||
/--
|
||||
Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scalar value,
|
||||
@@ -2188,7 +2216,7 @@ Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scal
|
||||
def Char.ofNat (n : Nat) : Char :=
|
||||
dite (n.isValidChar)
|
||||
(fun h => Char.ofNatAux n h)
|
||||
(fun _ => { val := ⟨{ val := 0, isLt := by decide }⟩, valid := Or.inl (by decide) })
|
||||
(fun _ => { val := ⟨BitVec.ofNatLt 0 (by decide)⟩, valid := Or.inl (by decide) })
|
||||
|
||||
theorem Char.eq_of_val_eq : ∀ {c d : Char}, Eq c.val d.val → Eq c d
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
@@ -2716,28 +2744,6 @@ def Array.extract (as : Array α) (start stop : Nat) : Array α :=
|
||||
let sz' := Nat.sub (min stop as.size) start
|
||||
loop sz' start (mkEmpty sz')
|
||||
|
||||
/--
|
||||
Auxiliary definition for `List.toArray`.
|
||||
`List.toArrayAux as r = r ++ as.toArray`
|
||||
-/
|
||||
@[inline_if_reduce]
|
||||
def List.toArrayAux : List α → Array α → Array α
|
||||
| nil, r => r
|
||||
| cons a as, r => toArrayAux as (r.push a)
|
||||
|
||||
/-- A non-tail-recursive version of `List.length`, used for `List.toArray`. -/
|
||||
@[inline_if_reduce]
|
||||
def List.redLength : List α → Nat
|
||||
| nil => 0
|
||||
| cons _ as => as.redLength.succ
|
||||
|
||||
/-- Convert a `List α` into an `Array α`. This is O(n) in the length of the list. -/
|
||||
-- This function is exported to C, where it is called by `Array.mk`
|
||||
-- (the constructor) to implement this functionality.
|
||||
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
|
||||
def List.toArrayImpl (as : List α) : Array α :=
|
||||
as.toArrayAux (Array.mkEmpty as.redLength)
|
||||
|
||||
/-- The typeclass which supplies the `>>=` "bind" function. See `Monad`. -/
|
||||
class Bind (m : Type u → Type v) where
|
||||
/-- If `x : m α` and `f : α → m β`, then `x >>= f : m β` represents the
|
||||
@@ -2891,6 +2897,32 @@ instance (m n o) [MonadLift n o] [MonadLiftT m n] : MonadLiftT m o where
|
||||
instance (m) : MonadLiftT m m where
|
||||
monadLift x := x
|
||||
|
||||
/--
|
||||
Typeclass used for adapting monads. This is similar to `MonadLift`, but instances are allowed to
|
||||
make use of default state for the purpose of synthesizing such an instance, if necessary.
|
||||
Every `MonadLift` instance gives a `MonadEval` instance.
|
||||
|
||||
The purpose of this class is for the `#eval` command,
|
||||
which looks for a `MonadEval m CommandElabM` or `MonadEval m IO` instance.
|
||||
-/
|
||||
class MonadEval (m : semiOutParam (Type u → Type v)) (n : Type u → Type w) where
|
||||
/-- Evaluates a value from monad `m` into monad `n`. -/
|
||||
monadEval : {α : Type u} → m α → n α
|
||||
|
||||
instance [MonadLift m n] : MonadEval m n where
|
||||
monadEval := MonadLift.monadLift
|
||||
|
||||
/-- The transitive closure of `MonadEval`. -/
|
||||
class MonadEvalT (m : Type u → Type v) (n : Type u → Type w) where
|
||||
/-- Evaluates a value from monad `m` into monad `n`. -/
|
||||
monadEval : {α : Type u} → m α → n α
|
||||
|
||||
instance (m n o) [MonadEval n o] [MonadEvalT m n] : MonadEvalT m o where
|
||||
monadEval x := MonadEval.monadEval (m := n) (MonadEvalT.monadEval x)
|
||||
|
||||
instance (m) : MonadEvalT m m where
|
||||
monadEval x := x
|
||||
|
||||
/--
|
||||
A functor in the category of monads. Can be used to lift monad-transforming functions.
|
||||
Based on [`MFunctor`] from the `pipes` Haskell package, but not restricted to
|
||||
@@ -3444,15 +3476,13 @@ This function is overridden with a native implementation.
|
||||
-/
|
||||
@[extern "lean_usize_to_uint64"]
|
||||
def USize.toUInt64 (u : USize) : UInt64 where
|
||||
val := {
|
||||
val := u.val.val
|
||||
isLt :=
|
||||
let ⟨n, h⟩ := u
|
||||
show LT.lt n _ from
|
||||
match USize.size, usize_size_eq, h with
|
||||
| _, Or.inl rfl, h => Nat.lt_trans h (by decide)
|
||||
| _, Or.inr rfl, h => h
|
||||
}
|
||||
toBitVec := BitVec.ofNatLt u.toBitVec.toNat (
|
||||
let ⟨⟨n, h⟩⟩ := u
|
||||
show LT.lt n _ from
|
||||
match System.Platform.numBits, System.Platform.numBits_eq, h with
|
||||
| _, Or.inl rfl, h => Nat.lt_trans h (by decide)
|
||||
| _, Or.inr rfl, h => h
|
||||
)
|
||||
|
||||
/-- An opaque hash mixing operation, used to implement hashing for tuples. -/
|
||||
@[extern "lean_uint64_mix_hash"]
|
||||
|
||||
@@ -67,6 +67,7 @@ deriving instance SizeOf for PLift
|
||||
deriving instance SizeOf for ULift
|
||||
deriving instance SizeOf for Decidable
|
||||
deriving instance SizeOf for Fin
|
||||
deriving instance SizeOf for BitVec
|
||||
deriving instance SizeOf for UInt8
|
||||
deriving instance SizeOf for UInt16
|
||||
deriving instance SizeOf for UInt32
|
||||
|
||||
@@ -11,22 +11,25 @@ import Init.Data.Nat.Linear
|
||||
@[simp] protected theorem Fin.sizeOf (a : Fin n) : sizeOf a = a.val + 1 := by
|
||||
cases a; simp_arith
|
||||
|
||||
@[simp] protected theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt8.toNat]
|
||||
@[simp] protected theorem BitVec.sizeOf (a : BitVec w) : sizeOf a = sizeOf a.toFin + 1 := by
|
||||
cases a; simp_arith
|
||||
|
||||
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt16.toNat]
|
||||
@[simp] protected theorem UInt8.sizeOf (a : UInt8) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt8.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt32.toNat]
|
||||
@[simp] protected theorem UInt16.sizeOf (a : UInt16) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt16.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [UInt64.toNat]
|
||||
@[simp] protected theorem UInt32.sizeOf (a : UInt32) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt32.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 2 := by
|
||||
cases a; simp_arith [USize.toNat]
|
||||
@[simp] protected theorem UInt64.sizeOf (a : UInt64) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [UInt64.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 3 := by
|
||||
@[simp] protected theorem USize.sizeOf (a : USize) : sizeOf a = a.toNat + 3 := by
|
||||
cases a; simp_arith [USize.toNat, BitVec.toNat]
|
||||
|
||||
@[simp] protected theorem Char.sizeOf (a : Char) : sizeOf a = a.toNat + 4 := by
|
||||
cases a; simp_arith [Char.toNat]
|
||||
|
||||
@[simp] protected theorem Subtype.sizeOf {α : Sort u_1} {p : α → Prop} (s : Subtype p) : sizeOf s = sizeOf s.val + 1 := by
|
||||
|
||||
@@ -928,41 +928,6 @@ def withIsolatedStreams [Monad m] [MonadFinally m] [MonadLiftT BaseIO m] (x : m
|
||||
end FS
|
||||
end IO
|
||||
|
||||
universe u
|
||||
|
||||
namespace Lean
|
||||
|
||||
/-- Typeclass used for presenting the output of an `#eval` command. -/
|
||||
class Eval (α : Type u) where
|
||||
-- We default `hideUnit` to `true`, but set it to `false` in the direct call from `#eval`
|
||||
-- so that `()` output is hidden in chained instances such as for some `IO Unit`.
|
||||
-- We take `Unit → α` instead of `α` because ‵α` may contain effectful debugging primitives (e.g., `dbg_trace`)
|
||||
eval : (Unit → α) → (hideUnit : Bool := true) → IO Unit
|
||||
|
||||
instance instEval [ToString α] : Eval α where
|
||||
eval a _ := IO.println (toString (a ()))
|
||||
|
||||
instance [Repr α] : Eval α where
|
||||
eval a _ := IO.println (repr (a ()))
|
||||
|
||||
instance : Eval Unit where
|
||||
eval u hideUnit := if hideUnit then pure () else IO.println (repr (u ()))
|
||||
|
||||
instance [Eval α] : Eval (IO α) where
|
||||
eval x _ := do
|
||||
let a ← x ()
|
||||
Eval.eval fun _ => a
|
||||
|
||||
instance [Eval α] : Eval (BaseIO α) where
|
||||
eval x _ := do
|
||||
let a ← x ()
|
||||
Eval.eval fun _ => a
|
||||
|
||||
def runEval [Eval α] (a : Unit → α) : IO (String × Except IO.Error Unit) :=
|
||||
IO.FS.withIsolatedStreams (Eval.eval a false |>.toBaseIO)
|
||||
|
||||
end Lean
|
||||
|
||||
syntax "println! " (interpolatedStr(term) <|> term) : term
|
||||
|
||||
macro_rules
|
||||
|
||||
@@ -375,12 +375,12 @@ The same as `rfl`, but without trying `eq_refl` at the end.
|
||||
-/
|
||||
syntax (name := applyRfl) "apply_rfl" : tactic
|
||||
|
||||
-- We try `apply_rfl` first, beause it produces a nice error message
|
||||
-- We try `apply_rfl` first, because it produces a nice error message
|
||||
macro_rules | `(tactic| rfl) => `(tactic| apply_rfl)
|
||||
|
||||
-- But, mostly for backward compatibility, we try `eq_refl` too (reduces more aggressively)
|
||||
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
|
||||
-- Als for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
|
||||
-- Also for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
|
||||
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
|
||||
/--
|
||||
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
|
||||
@@ -399,19 +399,6 @@ example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by ac_rfl
|
||||
-/
|
||||
syntax (name := acRfl) "ac_rfl" : tactic
|
||||
|
||||
/--
|
||||
`ac_nf` normalizes equalities up to application of an associative and commutative operator.
|
||||
```
|
||||
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
|
||||
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
|
||||
|
||||
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by
|
||||
ac_nf
|
||||
-- goal: a + (b + (c + d)) = a + (b + (c + d))
|
||||
```
|
||||
-/
|
||||
syntax (name := acNf) "ac_nf" : tactic
|
||||
|
||||
/--
|
||||
The `sorry` tactic closes the goal using `sorryAx`. This is intended for stubbing out incomplete
|
||||
parts of a proof while still having a syntactically correct proof skeleton. Lean will give
|
||||
@@ -923,6 +910,15 @@ macro_rules | `(tactic| trivial) => `(tactic| simp)
|
||||
-/
|
||||
syntax "trivial" : tactic
|
||||
|
||||
/--
|
||||
`classical tacs` runs `tacs` in a scope where `Classical.propDecidable` is a low priority
|
||||
local instance.
|
||||
|
||||
Note that `classical` is a scoping tactic: it adds the instance only within the
|
||||
scope of the tactic.
|
||||
-/
|
||||
syntax (name := classical) "classical" ppDedent(tacticSeq) : tactic
|
||||
|
||||
/--
|
||||
The `split` tactic is useful for breaking nested if-then-else and `match` expressions into separate cases.
|
||||
For a `match` expression with `n` cases, the `split` tactic generates at most `n` subgoals.
|
||||
@@ -1172,6 +1168,9 @@ Currently the preprocessor is implemented as `try simp only [bv_toNat] at *`.
|
||||
-/
|
||||
macro "bv_omega" : tactic => `(tactic| (try simp only [bv_toNat] at *) <;> omega)
|
||||
|
||||
/-- Implementation of `ac_nf` (the full `ac_nf` calls `trivial` afterwards). -/
|
||||
syntax (name := acNf0) "ac_nf0" (location)? : tactic
|
||||
|
||||
/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/
|
||||
syntax (name := normCast0) "norm_cast0" (location)? : tactic
|
||||
|
||||
@@ -1222,6 +1221,24 @@ See also `push_cast`, which moves casts inwards rather than lifting them outward
|
||||
macro "norm_cast" loc:(location)? : tactic =>
|
||||
`(tactic| norm_cast0 $[$loc]? <;> try trivial)
|
||||
|
||||
/--
|
||||
`ac_nf` normalizes equalities up to application of an associative and commutative operator.
|
||||
- `ac_nf` normalizes all hypotheses and the goal target of the goal.
|
||||
- `ac_nf at l` normalizes at location(s) `l`, where `l` is either `*` or a
|
||||
list of hypotheses in the local context. In the latter case, a turnstile `⊢` or `|-`
|
||||
can also be used, to signify the target of the goal.
|
||||
```
|
||||
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
|
||||
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
|
||||
|
||||
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by
|
||||
ac_nf
|
||||
-- goal: a + (b + (c + d)) = a + (b + (c + d))
|
||||
```
|
||||
-/
|
||||
macro "ac_nf" loc:(location)? : tactic =>
|
||||
`(tactic| ac_nf0 $[$loc]? <;> try trivial)
|
||||
|
||||
/--
|
||||
`push_cast` rewrites the goal to move certain coercions (*casts*) inward, toward the leaf nodes.
|
||||
This uses `norm_cast` lemmas in the forward direction.
|
||||
|
||||
@@ -20,7 +20,6 @@ import Lean.MetavarContext
|
||||
import Lean.AuxRecursor
|
||||
import Lean.Meta
|
||||
import Lean.Util
|
||||
import Lean.Eval
|
||||
import Lean.Structure
|
||||
import Lean.PrettyPrinter
|
||||
import Lean.CoreM
|
||||
@@ -38,3 +37,4 @@ import Lean.Linter
|
||||
import Lean.SubExpr
|
||||
import Lean.LabelAttribute
|
||||
import Lean.AddDecl
|
||||
import Lean.Replay
|
||||
|
||||
@@ -7,7 +7,6 @@ prelude
|
||||
import Lean.Util.RecDepth
|
||||
import Lean.Util.Trace
|
||||
import Lean.Log
|
||||
import Lean.Eval
|
||||
import Lean.ResolveName
|
||||
import Lean.Elab.InfoTree.Types
|
||||
import Lean.MonadEnv
|
||||
@@ -277,12 +276,6 @@ def mkFreshUserName (n : Name) : CoreM Name :=
|
||||
| Except.error (Exception.internal id _) => throw <| IO.userError <| "internal exception #" ++ toString id.idx
|
||||
| Except.ok a => return a
|
||||
|
||||
instance [MetaEval α] : MetaEval (CoreM α) where
|
||||
eval env opts x _ := do
|
||||
let x : CoreM α := do try x finally printTraces
|
||||
let (a, s) ← (withConsistentCtx x).toIO { fileName := "<CoreM>", fileMap := default, options := opts } { env := env }
|
||||
MetaEval.eval s.env opts a (hideUnit := true)
|
||||
|
||||
-- withIncRecDepth for a monad `m` such that `[MonadControlT CoreM n]`
|
||||
protected def withIncRecDepth [Monad m] [MonadControlT CoreM m] (x : m α) : m α :=
|
||||
controlAt CoreM fun runInBase => withIncRecDepth (runInBase x)
|
||||
@@ -309,7 +302,7 @@ register_builtin_option debug.moduleNameAtTimeout : Bool := {
|
||||
def throwMaxHeartbeat (moduleName : Name) (optionName : Name) (max : Nat) : CoreM Unit := do
|
||||
let includeModuleName := debug.moduleNameAtTimeout.get (← getOptions)
|
||||
let atModuleName := if includeModuleName then s!" at `{moduleName}`" else ""
|
||||
throw <| Exception.error (← getRef) m!"\
|
||||
throw <| Exception.error (← getRef) <| .tagged `runtime.maxHeartbeats m!"\
|
||||
(deterministic) timeout{atModuleName}, maximum number of heartbeats ({max/1000}) has been reached\n\
|
||||
Use `set_option {optionName} <num>` to set the limit.\
|
||||
{useDiagnosticMsg}"
|
||||
@@ -395,10 +388,7 @@ export Core (CoreM mkFreshUserName checkSystem withCurrHeartbeats)
|
||||
This function is a bit hackish. The heartbeat exception should probably be an internal exception.
|
||||
We used a similar hack at `Exception.isMaxRecDepth` -/
|
||||
def Exception.isMaxHeartbeat (ex : Exception) : Bool :=
|
||||
match ex with
|
||||
| Exception.error _ (MessageData.ofFormatWithInfos ⟨Std.Format.text msg, _⟩) =>
|
||||
"(deterministic) timeout".isPrefixOf msg
|
||||
| _ => false
|
||||
ex matches Exception.error _ (.tagged `runtime.maxHeartbeats _)
|
||||
|
||||
/-- Creates the expression `d → b` -/
|
||||
def mkArrow (d b : Expr) : CoreM Expr :=
|
||||
|
||||
@@ -46,7 +46,7 @@ private def mkIdx {sz : Nat} (hash : UInt64) (h : sz.isPowerOfTwo) : { u : USize
|
||||
if h' : u.toNat < sz then
|
||||
⟨u, h'⟩
|
||||
else
|
||||
⟨0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
⟨0, by simp; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
|
||||
@[inline] def reinsertAux (hashFn : α → UInt64) (data : HashMapBucket α β) (a : α) (b : β) : HashMapBucket α β :=
|
||||
let ⟨i, h⟩ := mkIdx (hashFn a) data.property
|
||||
|
||||
@@ -42,7 +42,7 @@ private def mkIdx {sz : Nat} (hash : UInt64) (h : sz.isPowerOfTwo) : { u : USize
|
||||
if h' : u.toNat < sz then
|
||||
⟨u, h'⟩
|
||||
else
|
||||
⟨0, by simp [USize.toNat, OfNat.ofNat, USize.ofNat]; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
⟨0, by simp; apply Nat.pos_of_isPowerOfTwo h⟩
|
||||
|
||||
@[inline] def reinsertAux (hashFn : α → UInt64) (data : HashSetBucket α) (a : α) : HashSetBucket α :=
|
||||
let ⟨i, h⟩ := mkIdx (hashFn a) data.property
|
||||
|
||||
@@ -54,7 +54,7 @@ structure WorkspaceEditClientCapabilities where
|
||||
deriving ToJson, FromJson
|
||||
|
||||
structure WorkspaceClientCapabilities where
|
||||
applyEdit: Bool
|
||||
applyEdit? : Option Bool := none
|
||||
workspaceEdit? : Option WorkspaceEditClientCapabilities := none
|
||||
deriving ToJson, FromJson
|
||||
|
||||
|
||||
@@ -41,6 +41,18 @@ structure InsertReplaceEdit where
|
||||
replace : Range
|
||||
deriving FromJson, ToJson
|
||||
|
||||
inductive CompletionItemTag where
|
||||
| deprecated
|
||||
deriving Inhabited, DecidableEq, Repr
|
||||
|
||||
instance : ToJson CompletionItemTag where
|
||||
toJson t := toJson (t.toCtorIdx + 1)
|
||||
|
||||
instance : FromJson CompletionItemTag where
|
||||
fromJson? v := do
|
||||
let i : Nat ← fromJson? v
|
||||
return CompletionItemTag.ofNat (i-1)
|
||||
|
||||
structure CompletionItem where
|
||||
label : String
|
||||
detail? : Option String := none
|
||||
@@ -49,8 +61,8 @@ structure CompletionItem where
|
||||
textEdit? : Option InsertReplaceEdit := none
|
||||
sortText? : Option String := none
|
||||
data? : Option Json := none
|
||||
tags? : Option (Array CompletionItemTag) := none
|
||||
/-
|
||||
tags? : CompletionItemTag[]
|
||||
deprecated? : boolean
|
||||
preselect? : boolean
|
||||
filterText? : string
|
||||
@@ -59,7 +71,8 @@ structure CompletionItem where
|
||||
insertTextMode? : InsertTextMode
|
||||
additionalTextEdits? : TextEdit[]
|
||||
commitCharacters? : string[]
|
||||
command? : Command -/
|
||||
command? : Command
|
||||
-/
|
||||
deriving FromJson, ToJson, Inhabited
|
||||
|
||||
structure CompletionList where
|
||||
|
||||
@@ -7,6 +7,7 @@ prelude
|
||||
import Init.Data.Array.Basic
|
||||
import Init.NotationExtra
|
||||
import Init.Data.ToString.Macro
|
||||
import Init.Data.UInt.Basic
|
||||
|
||||
universe u v w
|
||||
|
||||
|
||||
@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.Array.BasicAux
|
||||
import Init.Data.ToString.Macro
|
||||
import Init.Data.UInt.Basic
|
||||
|
||||
namespace Lean
|
||||
universe u v w w'
|
||||
|
||||
@@ -76,7 +76,7 @@ partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :
|
||||
let c := s.getUtf8Byte i h
|
||||
if c == c'
|
||||
then node1 v c' (loop (i + 1) t')
|
||||
else
|
||||
else
|
||||
let t := insertEmpty (i + 1)
|
||||
node v (.mk #[c, c']) #[t, t']
|
||||
else
|
||||
@@ -190,7 +190,7 @@ private partial def toStringAux {α : Type} : Trie α → List Format
|
||||
| node1 _ c t =>
|
||||
[ format (repr c), Format.group $ Format.nest 4 $ flip Format.joinSep Format.line $ toStringAux t ]
|
||||
| node _ cs ts =>
|
||||
List.join $ List.zipWith (fun c t =>
|
||||
List.flatten $ List.zipWith (fun c t =>
|
||||
[ format (repr c), (Format.group $ Format.nest 4 $ flip Format.joinSep Format.line $ toStringAux t) ]
|
||||
) cs.toList ts.toList
|
||||
|
||||
|
||||
@@ -459,7 +459,7 @@ mutual
|
||||
|
||||
let z ← optional (Content.Character <$> CharData)
|
||||
pure #[y, z]
|
||||
let xs := #[x] ++ xs.concatMap id |>.filterMap id
|
||||
let xs := #[x] ++ xs.flatMap id |>.filterMap id
|
||||
let mut res := #[]
|
||||
for x in xs do
|
||||
if res.size > 0 then
|
||||
|
||||
@@ -42,8 +42,9 @@ builtin_initialize declRangeExt : MapDeclarationExtension DeclarationRanges ←
|
||||
def addBuiltinDeclarationRanges (declName : Name) (declRanges : DeclarationRanges) : IO Unit :=
|
||||
builtinDeclRanges.modify (·.insert declName declRanges)
|
||||
|
||||
def addDeclarationRanges [MonadEnv m] (declName : Name) (declRanges : DeclarationRanges) : m Unit :=
|
||||
modifyEnv fun env => declRangeExt.insert env declName declRanges
|
||||
def addDeclarationRanges [Monad m] [MonadEnv m] (declName : Name) (declRanges : DeclarationRanges) : m Unit := do
|
||||
unless declRangeExt.contains (← getEnv) declName do
|
||||
modifyEnv fun env => declRangeExt.insert env declName declRanges
|
||||
|
||||
def findDeclarationRangesCore? [Monad m] [MonadEnv m] (declName : Name) : m (Option DeclarationRanges) :=
|
||||
return declRangeExt.find? (← getEnv) declName
|
||||
|
||||
@@ -16,7 +16,7 @@ import Init.Data.String.Extra
|
||||
namespace Lean
|
||||
|
||||
private builtin_initialize builtinDocStrings : IO.Ref (NameMap String) ← IO.mkRef {}
|
||||
private builtin_initialize docStringExt : MapDeclarationExtension String ← mkMapDeclarationExtension
|
||||
builtin_initialize docStringExt : MapDeclarationExtension String ← mkMapDeclarationExtension
|
||||
|
||||
def addBuiltinDocString (declName : Name) (docString : String) : IO Unit :=
|
||||
builtinDocStrings.modify (·.insert declName docString.removeLeadingSpaces)
|
||||
|
||||
@@ -42,6 +42,7 @@ import Lean.Elab.Notation
|
||||
import Lean.Elab.Mixfix
|
||||
import Lean.Elab.MacroRules
|
||||
import Lean.Elab.BuiltinCommand
|
||||
import Lean.Elab.BuiltinEvalCommand
|
||||
import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.Eval
|
||||
import Lean.Elab.Calc
|
||||
|
||||
@@ -528,7 +528,7 @@ mutual
|
||||
main
|
||||
|
||||
/--
|
||||
Create a fresh metavariable for the implicit argument, add it to `f`, and thn execute the main loop.
|
||||
Create a fresh metavariable for the implicit argument, add it to `f`, and then execute the main loop.
|
||||
-/
|
||||
private partial def addImplicitArg (argName : Name) : M Expr := do
|
||||
let argType ← getArgExpectedType
|
||||
@@ -777,7 +777,7 @@ def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
|
||||
forallTelescopeReducing elimType fun xs type => do
|
||||
let motive := type.getAppFn
|
||||
let motiveArgs := type.getAppArgs
|
||||
unless motive.isFVar do
|
||||
unless motive.isFVar && motiveArgs.size > 0 do
|
||||
throwError "unexpected eliminator resulting type{indentExpr type}"
|
||||
let motiveType ← inferType motive
|
||||
forallTelescopeReducing motiveType fun motiveParams motiveResultType => do
|
||||
@@ -1118,9 +1118,17 @@ where
|
||||
|
||||
/-- Auxiliary inductive datatype that represents the resolution of an `LVal`. -/
|
||||
inductive LValResolution where
|
||||
/-- When applied to `f`, effectively expands to `BaseStruct.fieldName (self := Struct.toBase f)`.
|
||||
This is a special named argument where it suppresses any explicit arguments depending on it so that type parameters don't need to be supplied. -/
|
||||
| projFn (baseStructName : Name) (structName : Name) (fieldName : Name)
|
||||
/-- Similar to `projFn`, but for extracting field indexed by `idx`. Works for structure-like inductive types in general. -/
|
||||
| projIdx (structName : Name) (idx : Nat)
|
||||
/-- When applied to `f`, effectively expands to `constName ... (Struct.toBase f)`, with the argument placed in the correct
|
||||
positional argument if possible, or otherwise as a named argument. The `Struct.toBase` is not present if `baseStructName == structName`,
|
||||
in which case these do not need to be structures. Supports generalized field notation. -/
|
||||
| const (baseStructName : Name) (structName : Name) (constName : Name)
|
||||
/-- Like `const`, but with `fvar` instead of `constName`.
|
||||
The `fullName` is the name of the recursive function, and `baseName` is the base name of the type to search for in the parameter list. -/
|
||||
| localRec (baseName : Name) (fullName : Name) (fvar : Expr)
|
||||
|
||||
private def throwLValError (e : Expr) (eType : Expr) (msg : MessageData) : TermElabM α :=
|
||||
@@ -1290,45 +1298,70 @@ private def typeMatchesBaseName (type : Expr) (baseName : Name) : MetaM Bool :=
|
||||
else
|
||||
return (← whnfR type).isAppOf baseName
|
||||
|
||||
/-- Auxiliary method for field notation. It tries to add `e` as a new argument to `args` or `namedArgs`.
|
||||
This method first finds the parameter with a type of the form `(baseName ...)`.
|
||||
When the parameter is found, if it an explicit one and `args` is big enough, we add `e` to `args`.
|
||||
Otherwise, if there isn't another parameter with the same name, we add `e` to `namedArgs`.
|
||||
/--
|
||||
Auxiliary method for field notation. Tries to add `e` as a new argument to `args` or `namedArgs`.
|
||||
This method first finds the parameter with a type of the form `(baseName ...)`.
|
||||
When the parameter is found, if it an explicit one and `args` is big enough, we add `e` to `args`.
|
||||
Otherwise, if there isn't another parameter with the same name, we add `e` to `namedArgs`.
|
||||
|
||||
Remark: `fullName` is the name of the resolved "field" access function. It is used for reporting errors -/
|
||||
private def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (fType : Expr)
|
||||
: TermElabM (Array Arg × Array NamedArg) :=
|
||||
forallTelescopeReducing fType fun xs _ => do
|
||||
let mut argIdx := 0 -- position of the next explicit argument
|
||||
let mut remainingNamedArgs := namedArgs
|
||||
for h : i in [:xs.size] do
|
||||
let x := xs[i]
|
||||
let xDecl ← x.fvarId!.getDecl
|
||||
/- If there is named argument with name `xDecl.userName`, then we skip it. -/
|
||||
match remainingNamedArgs.findIdx? (fun namedArg => namedArg.name == xDecl.userName) with
|
||||
| some idx =>
|
||||
Remark: `fullName` is the name of the resolved "field" access function. It is used for reporting errors
|
||||
-/
|
||||
private partial def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (f : Expr) :
|
||||
MetaM (Array Arg × Array NamedArg) := do
|
||||
withoutModifyingState <| go f (← inferType f) 0 namedArgs (namedArgs.map (·.name)) true
|
||||
where
|
||||
/--
|
||||
* `argIdx` is the position into `args` for the next place an explicit argument can be inserted.
|
||||
* `remainingNamedArgs` keeps track of named arguments that haven't been visited yet,
|
||||
for handling the case where multiple parameters have the same name.
|
||||
* `unusableNamedArgs` keeps track of names that can't be used as named arguments. This is initialized with user-provided named arguments.
|
||||
* `allowNamed` is whether or not to allow using named arguments.
|
||||
Disabled after using `CoeFun` since those parameter names unlikely to be meaningful,
|
||||
and otherwise whether dot notation works or not could feel random.
|
||||
-/
|
||||
go (f fType : Expr) (argIdx : Nat) (remainingNamedArgs : Array NamedArg) (unusableNamedArgs : Array Name) (allowNamed : Bool) := withIncRecDepth do
|
||||
/- Use metavariables (rather than `forallTelescope`) to prevent `coerceToFunction?` from succeeding when multiple instances could apply -/
|
||||
let (xs, bInfos, fType') ← forallMetaTelescope fType
|
||||
let mut argIdx := argIdx
|
||||
let mut remainingNamedArgs := remainingNamedArgs
|
||||
let mut unusableNamedArgs := unusableNamedArgs
|
||||
for x in xs, bInfo in bInfos do
|
||||
let xDecl ← x.mvarId!.getDecl
|
||||
if let some idx := remainingNamedArgs.findIdx? (·.name == xDecl.userName) then
|
||||
/- If there is named argument with name `xDecl.userName`, then it is accounted for and we can't make use of it. -/
|
||||
remainingNamedArgs := remainingNamedArgs.eraseIdx idx
|
||||
| none =>
|
||||
let type := xDecl.type
|
||||
if (← typeMatchesBaseName type baseName) then
|
||||
else
|
||||
if (← typeMatchesBaseName xDecl.type baseName) then
|
||||
/- We found a type of the form (baseName ...).
|
||||
First, we check if the current argument is an explicit one,
|
||||
and the current explicit position "fits" at `args` (i.e., it must be ≤ arg.size) -/
|
||||
if argIdx ≤ args.size && xDecl.binderInfo.isExplicit then
|
||||
/- We insert `e` as an explicit argument -/
|
||||
and if the current explicit position "fits" at `args` (i.e., it must be ≤ arg.size) -/
|
||||
if argIdx ≤ args.size && bInfo.isExplicit then
|
||||
/- We can insert `e` as an explicit argument -/
|
||||
return (args.insertAt! argIdx (Arg.expr e), namedArgs)
|
||||
/- If we can't add `e` to `args`, we try to add it using a named argument, but this is only possible
|
||||
if there isn't an argument with the same name occurring before it. -/
|
||||
for j in [:i] do
|
||||
let prev := xs[j]!
|
||||
let prevDecl ← prev.fvarId!.getDecl
|
||||
if prevDecl.userName == xDecl.userName then
|
||||
throwError "invalid field notation, function '{fullName}' has argument with the expected type{indentExpr type}\nbut it cannot be used"
|
||||
return (args, namedArgs.push { name := xDecl.userName, val := Arg.expr e })
|
||||
if xDecl.binderInfo.isExplicit then
|
||||
-- advance explicit argument position
|
||||
else
|
||||
/- If we can't add `e` to `args`, we try to add it using a named argument, but this is only possible
|
||||
if there isn't an argument with the same name occurring before it. -/
|
||||
if !allowNamed || unusableNamedArgs.contains xDecl.userName then
|
||||
throwError "\
|
||||
invalid field notation, function '{fullName}' has argument with the expected type\
|
||||
{indentExpr xDecl.type}\n\
|
||||
but it cannot be used"
|
||||
else
|
||||
return (args, namedArgs.push { name := xDecl.userName, val := Arg.expr e })
|
||||
/- Advance `argIdx` and update seen named arguments. -/
|
||||
if bInfo.isExplicit then
|
||||
argIdx := argIdx + 1
|
||||
throwError "invalid field notation, function '{fullName}' does not have argument with type ({baseName} ...) that can be used, it must be explicit or implicit with a unique name"
|
||||
unusableNamedArgs := unusableNamedArgs.push xDecl.userName
|
||||
/- If named arguments aren't allowed, then it must still be possible to pass the value as an explicit argument.
|
||||
Otherwise, we can abort now. -/
|
||||
if allowNamed || argIdx ≤ args.size then
|
||||
if let fType'@(.forallE ..) ← whnf fType' then
|
||||
return ← go (mkAppN f xs) fType' argIdx remainingNamedArgs unusableNamedArgs allowNamed
|
||||
if let some f' ← coerceToFunction? (mkAppN f xs) then
|
||||
return ← go f' (← inferType f') argIdx remainingNamedArgs unusableNamedArgs false
|
||||
throwError "\
|
||||
invalid field notation, function '{fullName}' does not have argument with type ({baseName} ...) that can be used, \
|
||||
it must be explicit or implicit with a unique name"
|
||||
|
||||
/-- Adds the `TermInfo` for the field of a projection. See `Lean.Parser.Term.identProjKind`. -/
|
||||
private def addProjTermInfo
|
||||
@@ -1375,8 +1408,7 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
|
||||
let projFn ← mkConst constName
|
||||
let projFn ← addProjTermInfo lval.getRef projFn
|
||||
if lvals.isEmpty then
|
||||
let projFnType ← inferType projFn
|
||||
let (args, namedArgs) ← addLValArg baseStructName constName f args namedArgs projFnType
|
||||
let (args, namedArgs) ← addLValArg baseStructName constName f args namedArgs projFn
|
||||
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
|
||||
else
|
||||
let f ← elabAppArgs projFn #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
@@ -1384,8 +1416,7 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
|
||||
| LValResolution.localRec baseName fullName fvar =>
|
||||
let fvar ← addProjTermInfo lval.getRef fvar
|
||||
if lvals.isEmpty then
|
||||
let fvarType ← inferType fvar
|
||||
let (args, namedArgs) ← addLValArg baseName fullName f args namedArgs fvarType
|
||||
let (args, namedArgs) ← addLValArg baseName fullName f args namedArgs fvar
|
||||
elabAppArgs fvar namedArgs args expectedType? explicit ellipsis
|
||||
else
|
||||
let f ← elabAppArgs fvar #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
@@ -1394,8 +1425,6 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
|
||||
|
||||
private def elabAppLVals (f : Expr) (lvals : List LVal) (namedArgs : Array NamedArg) (args : Array Arg)
|
||||
(expectedType? : Option Expr) (explicit ellipsis : Bool) : TermElabM Expr := do
|
||||
if !lvals.isEmpty && explicit then
|
||||
throwError "invalid use of field notation with `@` modifier"
|
||||
elabAppLValsAux namedArgs args expectedType? explicit ellipsis f lvals
|
||||
|
||||
def elabExplicitUnivs (lvls : Array Syntax) : TermElabM (List Level) := do
|
||||
@@ -1494,19 +1523,21 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
|
||||
withReader (fun ctx => { ctx with errToSorry := false }) do
|
||||
f.getArgs.foldlM (init := acc) fun acc f => elabAppFn f lvals namedArgs args expectedType? explicit ellipsis true acc
|
||||
else
|
||||
let elabFieldName (e field : Syntax) := do
|
||||
let elabFieldName (e field : Syntax) (explicit : Bool) := do
|
||||
let newLVals := field.identComponents.map fun comp =>
|
||||
-- We use `none` in `suffix?` since `field` can't be part of a composite name
|
||||
LVal.fieldName comp comp.getId.getString! none f
|
||||
elabAppFn e (newLVals ++ lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
|
||||
let elabFieldIdx (e idxStx : Syntax) := do
|
||||
let elabFieldIdx (e idxStx : Syntax) (explicit : Bool) := do
|
||||
let some idx := idxStx.isFieldIdx? | throwError "invalid field index"
|
||||
elabAppFn e (LVal.fieldIdx idxStx idx :: lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
|
||||
match f with
|
||||
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx
|
||||
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx
|
||||
| `($(e).$field:ident) => elabFieldName e field
|
||||
| `($e |>.$field:ident) => elabFieldName e field
|
||||
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx explicit
|
||||
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx explicit
|
||||
| `($(e).$field:ident) => elabFieldName e field explicit
|
||||
| `($e |>.$field:ident) => elabFieldName e field explicit
|
||||
| `(@$(e).$idx:fieldIdx) => elabFieldIdx e idx (explicit := true)
|
||||
| `(@$(e).$field:ident) => elabFieldName e field (explicit := true)
|
||||
| `($_:ident@$_:term) =>
|
||||
throwError "unexpected occurrence of named pattern"
|
||||
| `($id:ident) => do
|
||||
@@ -1663,8 +1694,10 @@ private def elabAtom : TermElab := fun stx expectedType? => do
|
||||
|
||||
@[builtin_term_elab explicit] def elabExplicit : TermElab := fun stx expectedType? =>
|
||||
match stx with
|
||||
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
|
||||
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
|
||||
| `(@$_:ident.{$_us,*}) => elabAtom stx expectedType?
|
||||
| `(@$(_).$_:fieldIdx) => elabAtom stx expectedType?
|
||||
| `(@$(_).$_:ident) => elabAtom stx expectedType?
|
||||
| `(@($t)) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
|
||||
| `(@$t) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@@ -229,7 +229,7 @@ private def replaceBinderAnnotation (binder : TSyntax ``Parser.Term.bracketedBin
|
||||
|
||||
@[builtin_command_elab «variable»] def elabVariable : CommandElab
|
||||
| `(variable $binders*) => do
|
||||
let binders ← binders.concatMapM replaceBinderAnnotation
|
||||
let binders ← binders.flatMapM replaceBinderAnnotation
|
||||
-- Try to elaborate `binders` for sanity checking
|
||||
runTermElabM fun _ => Term.withSynthesize <| Term.withAutoBoundImplicit <|
|
||||
Term.elabBinders binders fun _ => pure ()
|
||||
@@ -311,167 +311,6 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
|
||||
failIfSucceeds <| elabCheckCore (ignoreStuckTC := false) (← `(#check $term))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
private def mkEvalInstCore (evalClassName : Name) (e : Expr) : MetaM Expr := do
|
||||
let α ← inferType e
|
||||
let u ← getDecLevel α
|
||||
let inst := mkApp (Lean.mkConst evalClassName [u]) α
|
||||
try
|
||||
synthInstance inst
|
||||
catch _ =>
|
||||
-- Put `α` in WHNF and try again
|
||||
try
|
||||
let α ← whnf α
|
||||
synthInstance (mkApp (Lean.mkConst evalClassName [u]) α)
|
||||
catch _ =>
|
||||
-- Fully reduce `α` and try again
|
||||
try
|
||||
let α ← reduce (skipTypes := false) α
|
||||
synthInstance (mkApp (Lean.mkConst evalClassName [u]) α)
|
||||
catch _ =>
|
||||
throwError "expression{indentExpr e}\nhas type{indentExpr α}\nbut instance{indentExpr inst}\nfailed to be synthesized, this instance instructs Lean on how to display the resulting value, recall that any type implementing the `Repr` class also implements the `{evalClassName}` class"
|
||||
|
||||
private def mkRunMetaEval (e : Expr) : MetaM Expr :=
|
||||
withLocalDeclD `env (mkConst ``Lean.Environment) fun env =>
|
||||
withLocalDeclD `opts (mkConst ``Lean.Options) fun opts => do
|
||||
let α ← inferType e
|
||||
let u ← getDecLevel α
|
||||
let instVal ← mkEvalInstCore ``Lean.MetaEval e
|
||||
let e := mkAppN (mkConst ``Lean.runMetaEval [u]) #[α, instVal, env, opts, e]
|
||||
instantiateMVars (← mkLambdaFVars #[env, opts] e)
|
||||
|
||||
private def mkRunEval (e : Expr) : MetaM Expr := do
|
||||
let α ← inferType e
|
||||
let u ← getDecLevel α
|
||||
let instVal ← mkEvalInstCore ``Lean.Eval e
|
||||
instantiateMVars (mkAppN (mkConst ``Lean.runEval [u]) #[α, instVal, mkSimpleThunk e])
|
||||
|
||||
unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax): CommandElabM Unit := do
|
||||
let declName := `_eval
|
||||
let addAndCompile (value : Expr) : TermElabM Unit := do
|
||||
let value ← Term.levelMVarToParam (← instantiateMVars value)
|
||||
let type ← inferType value
|
||||
let us := collectLevelParams {} value |>.params
|
||||
let value ← instantiateMVars value
|
||||
let decl := Declaration.defnDecl {
|
||||
name := declName
|
||||
levelParams := us.toList
|
||||
type := type
|
||||
value := value
|
||||
hints := ReducibilityHints.opaque
|
||||
safety := DefinitionSafety.unsafe
|
||||
}
|
||||
Term.ensureNoUnassignedMVars decl
|
||||
addAndCompile decl
|
||||
-- Check for sorry axioms
|
||||
let checkSorry (declName : Name) : MetaM Unit := do
|
||||
unless bang do
|
||||
let axioms ← collectAxioms declName
|
||||
if axioms.contains ``sorryAx then
|
||||
throwError ("cannot evaluate expression that depends on the `sorry` axiom.\nUse `#eval!` to " ++
|
||||
"evaluate nevertheless (which may cause lean to crash).")
|
||||
-- Elaborate `term`
|
||||
let elabEvalTerm : TermElabM Expr := do
|
||||
let e ← Term.elabTerm term none
|
||||
Term.synthesizeSyntheticMVarsNoPostponing
|
||||
if (← Term.logUnassignedUsingErrorInfos (← getMVars e)) then throwAbortTerm
|
||||
if (← isProp e) then
|
||||
mkDecide e
|
||||
else
|
||||
return e
|
||||
-- Evaluate using term using `MetaEval` class.
|
||||
let elabMetaEval : CommandElabM Unit := do
|
||||
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
|
||||
-- we don't pollute the environment with auxliary declarations.
|
||||
-- We have special support for `CommandElabM` to ensure `#eval` can be used to execute commands
|
||||
-- that modify `CommandElabM` state not just the `Environment`.
|
||||
let act : Sum (CommandElabM Unit) (Environment → Options → IO (String × Except IO.Error Environment)) ←
|
||||
runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
|
||||
let e ← elabEvalTerm
|
||||
let eType ← instantiateMVars (← inferType e)
|
||||
if eType.isAppOfArity ``CommandElabM 1 then
|
||||
let mut stx ← Term.exprToSyntax e
|
||||
unless (← isDefEq eType.appArg! (mkConst ``Unit)) do
|
||||
stx ← `($stx >>= fun v => IO.println (repr v))
|
||||
let act ← Lean.Elab.Term.evalTerm (CommandElabM Unit) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) stx
|
||||
pure <| Sum.inl act
|
||||
else
|
||||
let e ← mkRunMetaEval e
|
||||
addAndCompile e
|
||||
checkSorry declName
|
||||
let act ← evalConst (Environment → Options → IO (String × Except IO.Error Environment)) declName
|
||||
pure <| Sum.inr act
|
||||
match act with
|
||||
| .inl act => act
|
||||
| .inr act =>
|
||||
let (out, res) ← act (← getEnv) (← getOptions)
|
||||
logInfoAt tk out
|
||||
match res with
|
||||
| Except.error e => throwError e.toString
|
||||
| Except.ok env => setEnv env; pure ()
|
||||
-- Evaluate using term using `Eval` class.
|
||||
let elabEval : CommandElabM Unit := runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
|
||||
-- fall back to non-meta eval if MetaEval hasn't been defined yet
|
||||
-- modify e to `runEval e`
|
||||
let e ← mkRunEval (← elabEvalTerm)
|
||||
addAndCompile e
|
||||
checkSorry declName
|
||||
let act ← evalConst (IO (String × Except IO.Error Unit)) declName
|
||||
let (out, res) ← liftM (m := IO) act
|
||||
logInfoAt tk out
|
||||
match res with
|
||||
| Except.error e => throwError e.toString
|
||||
| Except.ok _ => pure ()
|
||||
if (← getEnv).contains ``Lean.MetaEval then do
|
||||
elabMetaEval
|
||||
else
|
||||
elabEval
|
||||
|
||||
@[implemented_by elabEvalCoreUnsafe]
|
||||
opaque elabEvalCore (bang : Bool) (tk term : Syntax): CommandElabM Unit
|
||||
|
||||
@[builtin_command_elab «eval»]
|
||||
def elabEval : CommandElab
|
||||
| `(#eval%$tk $term) => elabEvalCore false tk term
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab evalBang]
|
||||
def elabEvalBang : CommandElab
|
||||
| `(Parser.Command.evalBang|#eval!%$tk $term) => elabEvalCore true tk term
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
private def checkImportsForRunCmds : CommandElabM Unit := do
|
||||
unless (← getEnv).contains ``CommandElabM do
|
||||
throwError "to use this command, include `import Lean.Elab.Command`"
|
||||
|
||||
@[builtin_command_elab runCmd]
|
||||
def elabRunCmd : CommandElab
|
||||
| `(run_cmd $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
(← liftTermElabM <| Term.withDeclName `_run_cmd <|
|
||||
unsafe Term.evalTerm (CommandElabM Unit)
|
||||
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
|
||||
(← `(discard do $elems)))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runElab]
|
||||
def elabRunElab : CommandElab
|
||||
| `(run_elab $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
(← liftTermElabM <| Term.withDeclName `_run_elab <|
|
||||
unsafe Term.evalTerm (CommandElabM Unit)
|
||||
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
|
||||
(← `(Command.liftTermElabM <| discard do $elems)))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runMeta]
|
||||
def elabRunMeta : CommandElab := fun stx =>
|
||||
match stx with
|
||||
| `(run_meta $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
let stxNew ← `(command| run_elab (show Lean.Meta.MetaM Unit from do $elems))
|
||||
withMacroExpansion stx stxNew do elabCommand stxNew
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab «synth»] def elabSynth : CommandElab := fun stx => do
|
||||
let term := stx[1]
|
||||
withoutModifyingEnv <| runTermElabM fun _ => Term.withDeclName `_synth_cmd do
|
||||
@@ -509,7 +348,7 @@ def elabRunMeta : CommandElab := fun stx =>
|
||||
@[builtin_command_elab Lean.Parser.Command.include] def elabInclude : CommandElab
|
||||
| `(Lean.Parser.Command.include| include $ids*) => do
|
||||
let sc ← getScope
|
||||
let vars ← sc.varDecls.concatMapM getBracketedBinderIds
|
||||
let vars ← sc.varDecls.flatMapM getBracketedBinderIds
|
||||
let mut uids := #[]
|
||||
for id in ids do
|
||||
if let some idx := vars.findIdx? (· == id.getId) then
|
||||
|
||||
277
src/Lean/Elab/BuiltinEvalCommand.lean
Normal file
277
src/Lean/Elab/BuiltinEvalCommand.lean
Normal file
@@ -0,0 +1,277 @@
|
||||
/-
|
||||
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.Util.CollectAxioms
|
||||
import Lean.Elab.Deriving.Basic
|
||||
import Lean.Elab.MutualDef
|
||||
|
||||
/-!
|
||||
# Implementation of `#eval` command
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.Command
|
||||
open Meta
|
||||
|
||||
register_builtin_option eval.pp : Bool := {
|
||||
defValue := true
|
||||
descr := "('#eval' command) enables using 'ToExpr' instances to pretty print the result, \
|
||||
otherwise uses 'Repr' or 'ToString' instances"
|
||||
}
|
||||
|
||||
register_builtin_option eval.type : Bool := {
|
||||
defValue := false -- TODO: set to 'true'
|
||||
descr := "('#eval' command) enables pretty printing the type of the result"
|
||||
}
|
||||
|
||||
register_builtin_option eval.derive.repr : Bool := {
|
||||
defValue := true
|
||||
descr := "('#eval' command) enables auto-deriving 'Repr' instances as a fallback"
|
||||
}
|
||||
|
||||
builtin_initialize
|
||||
registerTraceClass `Elab.eval
|
||||
|
||||
/--
|
||||
Elaborates the term, ensuring the result has no expression metavariables.
|
||||
If there would be unsolved-for metavariables, tries hinting that the resulting type
|
||||
is a monadic value with the `CommandElabM`, `TermElabM`, or `IO` monads.
|
||||
Throws errors if the term is a proof or a type, but lifts props to `Bool` using `mkDecide`.
|
||||
-/
|
||||
private def elabTermForEval (term : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
|
||||
let ty ← expectedType?.getDM mkFreshTypeMVar
|
||||
let e ← Term.elabTermEnsuringType term ty
|
||||
synthesizeWithHinting ty
|
||||
let e ← instantiateMVars e
|
||||
if (← Term.logUnassignedUsingErrorInfos (← getMVars e)) then throwAbortTerm
|
||||
if ← isProof e then
|
||||
throwError m!"cannot evaluate, proofs are not computationally relevant"
|
||||
let e ← if (← isProp e) then mkDecide e else pure e
|
||||
if ← isType e then
|
||||
throwError m!"cannot evaluate, types are not computationally relevant"
|
||||
trace[Elab.eval] "elaborated term:{indentExpr e}"
|
||||
return e
|
||||
where
|
||||
/-- Try different strategies to make `Term.synthesizeSyntheticMVarsNoPostponing` succeed. -/
|
||||
synthesizeWithHinting (ty : Expr) : TermElabM Unit := do
|
||||
Term.synthesizeSyntheticMVarsUsingDefault
|
||||
let s ← saveState
|
||||
try
|
||||
Term.synthesizeSyntheticMVarsNoPostponing
|
||||
catch ex =>
|
||||
let exS ← saveState
|
||||
-- Try hinting that `ty` is a monad application.
|
||||
for m in #[``CommandElabM, ``TermElabM, ``IO] do
|
||||
s.restore true
|
||||
try
|
||||
if ← isDefEq ty (← mkFreshMonadApp m) then
|
||||
Term.synthesizeSyntheticMVarsNoPostponing
|
||||
return
|
||||
catch _ => pure ()
|
||||
-- None of the hints worked, so throw the original error.
|
||||
exS.restore true
|
||||
throw ex
|
||||
mkFreshMonadApp (n : Name) : MetaM Expr := do
|
||||
let m ← mkConstWithFreshMVarLevels n
|
||||
let (args, _, _) ← forallMetaBoundedTelescope (← inferType m) 1
|
||||
return mkAppN m args
|
||||
|
||||
private def addAndCompileExprForEval (declName : Name) (value : Expr) (allowSorry := false) : TermElabM Unit := do
|
||||
-- Use the `elabMutualDef` machinery to be able to support `let rec`.
|
||||
-- Hack: since we are using the `TermElabM` version, we can insert the `value` as a metavariable via `exprToSyntax`.
|
||||
-- An alternative design would be to make `elabTermForEval` into a term elaborator and elaborate the command all at once
|
||||
-- with `unsafe def _eval := term_for_eval% $t`, which we did try, but unwanted error messages
|
||||
-- such as "failed to infer definition type" can surface.
|
||||
let defView := mkDefViewOfDef { isUnsafe := true }
|
||||
(← `(Parser.Command.definition|
|
||||
def $(mkIdent <| `_root_ ++ declName) := $(← Term.exprToSyntax value)))
|
||||
Term.elabMutualDef #[] { header := "" } #[defView]
|
||||
unless allowSorry do
|
||||
let axioms ← collectAxioms declName
|
||||
if axioms.contains ``sorryAx then
|
||||
throwError "\
|
||||
aborting evaluation since the expression depends on the 'sorry' axiom, \
|
||||
which can lead to runtime instability and crashes.\n\n\
|
||||
To attempt to evaluate anyway despite the risks, use the '#eval!' command."
|
||||
|
||||
/--
|
||||
Try to make a `@projFn ty inst e` application, even if it takes unfolding the type `ty` of `e` to synthesize the instance `inst`.
|
||||
-/
|
||||
private partial def mkDeltaInstProj (inst projFn : Name) (e : Expr) (ty? : Option Expr := none) (tryReduce : Bool := true) : MetaM Expr := do
|
||||
let ty ← ty?.getDM (inferType e)
|
||||
if let .some inst ← trySynthInstance (← mkAppM inst #[ty]) then
|
||||
mkAppOptM projFn #[ty, inst, e]
|
||||
else
|
||||
let ty ← whnfCore ty
|
||||
let some ty ← unfoldDefinition? ty
|
||||
| guard tryReduce
|
||||
-- Reducing the type is a strategy `#eval` used before the refactor of #5627.
|
||||
-- The test lean/run/hlistOverload.lean depends on it, so we preserve the behavior.
|
||||
let ty ← reduce (skipTypes := false) ty
|
||||
mkDeltaInstProj inst projFn e ty (tryReduce := false)
|
||||
mkDeltaInstProj inst projFn e ty tryReduce
|
||||
|
||||
/-- Try to make a `toString e` application, even if it takes unfolding the type of `e` to find a `ToString` instance. -/
|
||||
private def mkToString (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
|
||||
mkDeltaInstProj ``ToString ``toString e ty?
|
||||
|
||||
/-- Try to make a `repr e` application, even if it takes unfolding the type of `e` to find a `Repr` instance. -/
|
||||
private def mkRepr (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
|
||||
mkDeltaInstProj ``Repr ``repr e ty?
|
||||
|
||||
/-- Try to make a `toExpr e` application, even if it takes unfolding the type of `e` to find a `ToExpr` instance. -/
|
||||
private def mkToExpr (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
|
||||
mkDeltaInstProj ``ToExpr ``toExpr e ty?
|
||||
|
||||
/--
|
||||
Returns a representation of `e` using `Format`, or else fails.
|
||||
If the `eval.derive.repr` option is true, then tries automatically deriving a `Repr` instance first.
|
||||
Currently auto-derivation does not attempt to derive recursively.
|
||||
-/
|
||||
private def mkFormat (e : Expr) : MetaM Expr := do
|
||||
mkRepr e <|> (do mkAppM ``Std.Format.text #[← mkToString e])
|
||||
<|> do
|
||||
if eval.derive.repr.get (← getOptions) then
|
||||
if let .const name _ := (← whnf (← inferType e)).getAppFn then
|
||||
try
|
||||
trace[Elab.eval] "Attempting to derive a 'Repr' instance for '{MessageData.ofConstName name}'"
|
||||
liftCommandElabM do applyDerivingHandlers ``Repr #[name] none
|
||||
resetSynthInstanceCache
|
||||
return ← mkRepr e
|
||||
catch ex =>
|
||||
trace[Elab.eval] "Failed to use derived 'Repr' instance. Exception: {ex.toMessageData}"
|
||||
throwError m!"could not synthesize a 'Repr' or 'ToString' instance for type{indentExpr (← inferType e)}"
|
||||
|
||||
/--
|
||||
Returns a representation of `e` using `MessageData`, or else fails.
|
||||
Tries `mkFormat` if a `ToExpr` instance can't be synthesized.
|
||||
-/
|
||||
private def mkMessageData (e : Expr) : MetaM Expr := do
|
||||
(do guard <| eval.pp.get (← getOptions); mkAppM ``MessageData.ofExpr #[← mkToExpr e])
|
||||
<|> (return mkApp (mkConst ``MessageData.ofFormat) (← mkFormat e))
|
||||
<|> do throwError m!"could not synthesize a 'ToExpr', 'Repr', or 'ToString' instance for type{indentExpr (← inferType e)}"
|
||||
|
||||
private structure EvalAction where
|
||||
eval : CommandElabM MessageData
|
||||
/-- Whether to print the result of evaluation.
|
||||
If `some`, the expression is what type to use for the type ascription when `pp.type` is true. -/
|
||||
printVal : Option Expr
|
||||
|
||||
unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax) (expectedType? : Option Expr) : CommandElabM Unit := withRef tk do
|
||||
let declName := `_eval
|
||||
-- `t` is either `MessageData` or `Format`, and `mkT` is for synthesizing an expression that yields a `t`.
|
||||
-- The `toMessageData` function adapts `t` to `MessageData`.
|
||||
let mkAct {t : Type} [Inhabited t] (toMessageData : t → MessageData) (mkT : Expr → MetaM Expr) (e : Expr) : TermElabM EvalAction := do
|
||||
-- Create a monadic action given the name of the monad `mc`, the monad `m` itself,
|
||||
-- and an expression `e` to evaluate in this monad.
|
||||
-- A trick here is that `mkMAct?` makes use of `MonadEval` instances are currently available in this stage,
|
||||
-- and we do not need them to be available in the target environment.
|
||||
let mkMAct? (mc : Name) (m : Type → Type) [Monad m] [MonadEvalT m CommandElabM] (e : Expr) : TermElabM (Option EvalAction) := do
|
||||
let some e ← observing? (mkAppOptM ``MonadEvalT.monadEval #[none, mkConst mc, none, none, e])
|
||||
| return none
|
||||
let eType := e.appFn!.appArg!
|
||||
if ← isDefEq eType (mkConst ``Unit) then
|
||||
addAndCompileExprForEval declName e (allowSorry := bang)
|
||||
let mf : m Unit ← evalConst (m Unit) declName
|
||||
return some { eval := do MonadEvalT.monadEval mf; pure "", printVal := none }
|
||||
else
|
||||
let rf ← withLocalDeclD `x eType fun x => do mkLambdaFVars #[x] (← mkT x)
|
||||
let r ← mkAppM ``Functor.map #[rf, e]
|
||||
addAndCompileExprForEval declName r (allowSorry := bang)
|
||||
let mf : m t ← evalConst (m t) declName
|
||||
return some { eval := toMessageData <$> MonadEvalT.monadEval mf, printVal := some eType }
|
||||
if let some act ← mkMAct? ``CommandElabM CommandElabM e
|
||||
-- Fallbacks in case we are in the Lean package but don't have `CommandElabM` yet
|
||||
<||> mkMAct? ``TermElabM TermElabM e <||> mkMAct? ``MetaM MetaM e <||> mkMAct? ``CoreM CoreM e
|
||||
-- Fallback in case nothing is imported
|
||||
<||> mkMAct? ``IO IO e then
|
||||
return act
|
||||
else
|
||||
-- Otherwise, assume this is a pure value.
|
||||
-- There is no need to adapt pure values to `CommandElabM`.
|
||||
-- This enables `#eval` to work on pure values even when `CommandElabM` is not available.
|
||||
let r ← try mkT e catch ex => do
|
||||
-- Diagnose whether the value is monadic for a representable value, since it's better to mention `MonadEval` in that case.
|
||||
try
|
||||
let some (m, ty) ← isTypeApp? (← inferType e) | failure
|
||||
guard <| (← isMonad? m).isSome
|
||||
-- Verify that there is a way to form some representation:
|
||||
discard <| withLocalDeclD `x ty fun x => mkT x
|
||||
catch _ =>
|
||||
throw ex
|
||||
throwError m!"unable to synthesize '{MessageData.ofConstName ``MonadEval}' instance \
|
||||
to adapt{indentExpr (← inferType e)}\n\
|
||||
to '{MessageData.ofConstName ``IO}' or '{MessageData.ofConstName ``CommandElabM}'."
|
||||
addAndCompileExprForEval declName r (allowSorry := bang)
|
||||
-- `evalConst` may emit IO, but this is collected by `withIsolatedStreams` below.
|
||||
let r ← toMessageData <$> evalConst t declName
|
||||
return { eval := pure r, printVal := some (← inferType e) }
|
||||
let (output, exOrRes) ← IO.FS.withIsolatedStreams do
|
||||
try
|
||||
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
|
||||
-- we don't pollute the environment with auxiliary declarations.
|
||||
let act : EvalAction ← liftTermElabM do Term.withDeclName declName do withoutModifyingEnv do
|
||||
let e ← elabTermForEval term expectedType?
|
||||
-- If there is an elaboration error, don't evaluate!
|
||||
if e.hasSyntheticSorry then throwAbortTerm
|
||||
-- We want `#eval` to work even in the core library, so if `ofFormat` isn't available,
|
||||
-- we fall back on a `Format`-based approach.
|
||||
if (← getEnv).contains ``Lean.MessageData.ofFormat then
|
||||
mkAct id (mkMessageData ·) e
|
||||
else
|
||||
mkAct Lean.MessageData.ofFormat (mkFormat ·) e
|
||||
let res ← act.eval
|
||||
return Sum.inr (res, act.printVal)
|
||||
catch ex =>
|
||||
return Sum.inl ex
|
||||
if !output.isEmpty then logInfoAt tk output
|
||||
match exOrRes with
|
||||
| .inl ex => logException ex
|
||||
| .inr (_, none) => pure ()
|
||||
| .inr (res, some type) =>
|
||||
if eval.type.get (← getOptions) then
|
||||
logInfo m!"{res} : {type}"
|
||||
else
|
||||
logInfo res
|
||||
|
||||
@[implemented_by elabEvalCoreUnsafe]
|
||||
opaque elabEvalCore (bang : Bool) (tk term : Syntax) (expectedType? : Option Expr) : CommandElabM Unit
|
||||
|
||||
@[builtin_command_elab «eval»]
|
||||
def elabEval : CommandElab
|
||||
| `(#eval%$tk $term) => elabEvalCore false tk term none
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab evalBang]
|
||||
def elabEvalBang : CommandElab
|
||||
| `(#eval!%$tk $term) => elabEvalCore true tk term none
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runCmd]
|
||||
def elabRunCmd : CommandElab
|
||||
| `(run_cmd%$tk $elems:doSeq) => do
|
||||
unless (← getEnv).contains ``CommandElabM do
|
||||
throwError "to use this command, include `import Lean.Elab.Command`"
|
||||
elabEvalCore false tk (← `(discard do $elems)) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runElab]
|
||||
def elabRunElab : CommandElab
|
||||
| `(run_elab%$tk $elems:doSeq) => do
|
||||
unless (← getEnv).contains ``TermElabM do
|
||||
throwError "to use this command, include `import Lean.Elab.Term`"
|
||||
elabEvalCore false tk (← `(discard do $elems)) (mkApp (mkConst ``TermElabM) (mkConst ``Unit))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runMeta]
|
||||
def elabRunMeta : CommandElab := fun stx =>
|
||||
match stx with
|
||||
| `(run_meta%$tk $elems:doSeq) => do
|
||||
unless (← getEnv).contains ``MetaM do
|
||||
throwError "to use this command, include `import Lean.Meta.Basic`"
|
||||
elabEvalCore false tk (← `(discard do $elems)) (mkApp (mkConst ``MetaM) (mkConst ``Unit))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Command
|
||||
@@ -103,9 +103,11 @@ private def elabOptLevel (stx : Syntax) : TermElabM Level :=
|
||||
@[builtin_term_elab Lean.Parser.Term.omission] def elabOmission : TermElab := fun stx expectedType? => do
|
||||
logWarning m!"\
|
||||
The '⋯' token is used by the pretty printer to indicate omitted terms, and it should not be used directly. \
|
||||
It logs this warning and then elaborates like `_`.\
|
||||
\n\nThe presence of `⋯` in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
|
||||
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
|
||||
It logs this warning and then elaborates like '_'.\
|
||||
\n\n\
|
||||
The presence of '⋯' in pretty printing output is controlled by the 'pp.maxSteps', 'pp.deepTerms' and 'pp.proofs' options. \
|
||||
These options can be further adjusted using 'pp.deepTerms.threshold' and 'pp.proofs.threshold'. \
|
||||
If this '⋯' was copied from the Infoview, the hover there for the original '⋯' explains which of these options led to the omission."
|
||||
elabHole stx expectedType?
|
||||
|
||||
@[builtin_term_elab «letMVar»] def elabLetMVar : TermElab := fun stx expectedType? => do
|
||||
|
||||
@@ -520,19 +520,24 @@ def elabCommandTopLevel (stx : Syntax) : CommandElabM Unit := withRef stx do pro
|
||||
-- recovery more coarse. In particular, If `c` in `set_option ... in $c` fails, the remaining
|
||||
-- `end` command of the `in` macro would be skipped and the option would be leaked to the outside!
|
||||
elabCommand stx
|
||||
withLogging do
|
||||
runLinters stx
|
||||
-- Run the linters, unless `#guard_msgs` is present, which is special and runs `elabCommandTopLevel` itself,
|
||||
-- so it is a "super-top-level" command. This is the only command that does this, so we just special case it here
|
||||
-- rather than engineer a general solution.
|
||||
unless (stx.find? (·.isOfKind ``Lean.guardMsgsCmd)).isSome do
|
||||
withLogging do
|
||||
runLinters stx
|
||||
finally
|
||||
-- note the order: first process current messages & info trees, then add back old messages & trees,
|
||||
-- then convert new traces to messages
|
||||
let mut msgs := (← get).messages
|
||||
for tree in (← getInfoTrees) do
|
||||
trace[Elab.info] (← tree.format)
|
||||
if let some snap := (← read).snap? then
|
||||
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
|
||||
-- should be true iff the command supports incrementality
|
||||
if (← IO.hasFinished snap.new.result) then
|
||||
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
|
||||
if (← isTracingEnabledFor `Elab.snapshotTree) then
|
||||
if let some snap := (← read).snap? then
|
||||
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
|
||||
-- should be true iff the command supports incrementality
|
||||
if (← IO.hasFinished snap.new.result) then
|
||||
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
|
||||
modify fun st => { st with
|
||||
messages := initMsgs ++ msgs
|
||||
infoState := { st.infoState with trees := initInfoTrees ++ st.infoState.trees }
|
||||
@@ -567,7 +572,7 @@ def getBracketedBinderIds : Syntax → CommandElabM (Array Name)
|
||||
private def mkTermContext (ctx : Context) (s : State) : CommandElabM Term.Context := do
|
||||
let scope := s.scopes.head!
|
||||
let mut sectionVars := {}
|
||||
for id in (← scope.varDecls.concatMapM getBracketedBinderIds), uid in scope.varUIds do
|
||||
for id in (← scope.varDecls.flatMapM getBracketedBinderIds), uid in scope.varUIds do
|
||||
sectionVars := sectionVars.insert id uid
|
||||
return {
|
||||
macroStack := ctx.macroStack
|
||||
@@ -615,6 +620,9 @@ def liftTermElabM (x : TermElabM α) : CommandElabM α := do
|
||||
let ((ea, _), _) ← runCore x
|
||||
MonadExcept.ofExcept ea
|
||||
|
||||
instance : MonadEval TermElabM CommandElabM where
|
||||
monadEval := liftTermElabM
|
||||
|
||||
/--
|
||||
Execute the monadic action `elabFn xs` as a `CommandElabM` monadic action, where `xs` are free variables
|
||||
corresponding to all active scoped variables declared using the `variable` command.
|
||||
@@ -707,7 +715,7 @@ def expandDeclId (declId : Syntax) (modifiers : Modifiers) : CommandElabM Expand
|
||||
let currNamespace ← getCurrNamespace
|
||||
let currLevelNames ← getLevelNames
|
||||
let r ← Elab.expandDeclId currNamespace currLevelNames declId modifiers
|
||||
for id in (← (← getScope).varDecls.concatMapM getBracketedBinderIds) do
|
||||
for id in (← (← getScope).varDecls.flatMapM getBracketedBinderIds) do
|
||||
if id == r.shortName then
|
||||
throwError "invalid declaration name '{r.shortName}', there is a section variable with the same name"
|
||||
return r
|
||||
@@ -723,6 +731,12 @@ Commands that modify the processing of subsequent commands,
|
||||
such as `open` and `namespace` commands,
|
||||
only have an effect for the remainder of the `CommandElabM` computation passed here,
|
||||
and do not affect subsequent commands.
|
||||
|
||||
*Warning:* when using this from `MetaM` monads, the caches are *not* reset.
|
||||
If the command defines new instances for example, you should use `Lean.Meta.resetSynthInstanceCache`
|
||||
to reset the instance cache.
|
||||
While the `modifyEnv` function for `MetaM` clears its caches entirely,
|
||||
`liftCommandElabM` has no way to reset these caches.
|
||||
-/
|
||||
def liftCommandElabM (cmd : CommandElabM α) : CoreM α := do
|
||||
let (a, commandState) ←
|
||||
|
||||
@@ -136,8 +136,8 @@ def elabAxiom (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
|
||||
Term.applyAttributesAt declName modifiers.attrs AttributeApplicationTime.afterCompilation
|
||||
|
||||
/-
|
||||
leading_parser "inductive " >> declId >> optDeclSig >> optional ":=" >> many ctor
|
||||
leading_parser atomic (group ("class " >> "inductive ")) >> declId >> optDeclSig >> optional ":=" >> many ctor >> optDeriving
|
||||
leading_parser "inductive " >> declId >> optDeclSig >> optional ("where" <|> ":=") >> many ctor
|
||||
leading_parser atomic (group ("class " >> "inductive ")) >> declId >> optDeclSig >> optional ("where" <|> ":=") >> many ctor >> optDeriving
|
||||
-/
|
||||
private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : CommandElabM InductiveView := do
|
||||
checkValidInductiveModifier modifiers
|
||||
@@ -167,6 +167,10 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : Comm
|
||||
let computedFields ← (decl[5].getOptional?.map (·[1].getArgs) |>.getD #[]).mapM fun cf => withRef cf do
|
||||
return { ref := cf, modifiers := cf[0], fieldId := cf[1].getId, type := ⟨cf[3]⟩, matchAlts := ⟨cf[4]⟩ }
|
||||
let classes ← liftCoreM <| getOptDerivingClasses decl[6]
|
||||
if decl[3][0].isToken ":=" then
|
||||
-- https://github.com/leanprover/lean4/issues/5236
|
||||
withRef decl[0] <| Linter.logLintIf Linter.linter.deprecated decl[3]
|
||||
"'inductive ... :=' has been deprecated in favor of 'inductive ... where'."
|
||||
return {
|
||||
ref := decl
|
||||
shortDeclName := name
|
||||
@@ -382,19 +386,28 @@ def elabMutual : CommandElab := fun stx => do
|
||||
for attrName in toErase do
|
||||
Attribute.erase declName attrName
|
||||
|
||||
@[builtin_macro Lean.Parser.Command.«initialize»] def expandInitialize : Macro
|
||||
@[builtin_command_elab Lean.Parser.Command.«initialize»] def elabInitialize : CommandElab
|
||||
| stx@`($declModifiers:declModifiers $kw:initializeKeyword $[$id? : $type? ←]? $doSeq) => do
|
||||
let attrId := mkIdentFrom stx <| if kw.raw[0].isToken "initialize" then `init else `builtin_init
|
||||
if let (some id, some type) := (id?, type?) then
|
||||
let `(Parser.Command.declModifiersT| $[$doc?:docComment]? $[@[$attrs?,*]]? $(vis?)? $[unsafe%$unsafe?]?) := stx[0]
|
||||
| Macro.throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
|
||||
`($[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% ?$id do $doSeq
|
||||
$[$doc?:docComment]? @[$attrId:ident initFn, $(attrs?.getD ∅),*] $(vis?)? opaque $id : $type)
|
||||
| throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
|
||||
let defStx ← `($[$doc?:docComment]? @[$attrId:ident initFn, $(attrs?.getD ∅),*] $(vis?)? opaque $id : $type)
|
||||
let mut fullId := (← getCurrNamespace) ++ id.getId
|
||||
if vis?.any (·.raw.isOfKind ``Parser.Command.private) then
|
||||
fullId := mkPrivateName (← getEnv) fullId
|
||||
-- We need to add `id`'s ranges *before* elaborating `initFn` (and then `id` itself) as
|
||||
-- otherwise the info context created by `with_decl_name` will be incomplete and break the
|
||||
-- call hierarchy
|
||||
addDeclarationRanges fullId defStx
|
||||
elabCommand (← `(
|
||||
$[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% $(mkIdent fullId) do $doSeq
|
||||
$defStx:command))
|
||||
else
|
||||
let `(Parser.Command.declModifiersT| $[$doc?:docComment]? ) := declModifiers
|
||||
| Macro.throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
|
||||
`($[$doc?:docComment]? @[$attrId:ident] def initFn : IO Unit := do $doSeq)
|
||||
| _ => Macro.throwUnsupported
|
||||
| throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
|
||||
elabCommand (← `($[$doc?:docComment]? @[$attrId:ident] def initFn : IO Unit := do $doSeq))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
builtin_initialize
|
||||
registerTraceClass `Elab.axiom
|
||||
|
||||
@@ -36,7 +36,7 @@ def mkToJsonBodyForStruct (header : Header) (indName : Name) : TermElabM Term :=
|
||||
let target := mkIdent header.targetNames[0]!
|
||||
if isOptField then ``(opt $nm $target.$(mkIdent field))
|
||||
else ``([($nm, toJson ($target).$(mkIdent field))])
|
||||
`(mkObj <| List.join [$fields,*])
|
||||
`(mkObj <| List.flatten [$fields,*])
|
||||
|
||||
def mkToJsonBodyForInduct (ctx : Context) (header : Header) (indName : Name) : TermElabM Term := do
|
||||
let indVal ← getConstInfoInduct indName
|
||||
|
||||
@@ -151,7 +151,7 @@ def runFrontend
|
||||
snaps.runAndReport opts jsonOutput
|
||||
|
||||
if let some ileanFileName := ileanFileName? then
|
||||
let trees := snaps.getAll.concatMap (match ·.infoTree? with | some t => #[t] | _ => #[])
|
||||
let trees := snaps.getAll.flatMap (match ·.infoTree? with | some t => #[t] | _ => #[])
|
||||
let references := Lean.Server.findModuleRefs inputCtx.fileMap trees (localVars := false)
|
||||
let ilean := { module := mainModuleName, references := ← references.toLspModuleRefs : Lean.Server.Ilean }
|
||||
IO.FS.writeFile ileanFileName $ Json.compress $ toJson ilean
|
||||
|
||||
@@ -140,6 +140,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
|
||||
|>.trim |> removeTrailingWhitespaceMarker
|
||||
let (whitespace, ordering, specFn) ← parseGuardMsgsSpec spec?
|
||||
let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} })
|
||||
-- The `#guard_msgs` command is special-cased in `elabCommandTopLevel` to ensure linters only run once.
|
||||
elabCommandTopLevel cmd
|
||||
let msgs := (← get).messages
|
||||
let mut toCheck : MessageLog := .empty
|
||||
|
||||
@@ -425,9 +425,9 @@ where
|
||||
levelMVarToParam' (type : Expr) : TermElabM Expr := do
|
||||
Term.levelMVarToParam type (except := fun mvarId => univToInfer? == some mvarId)
|
||||
|
||||
def mkResultUniverse (us : Array Level) (rOffset : Nat) : Level :=
|
||||
def mkResultUniverse (us : Array Level) (rOffset : Nat) (preferProp : Bool) : Level :=
|
||||
if us.isEmpty && rOffset == 0 then
|
||||
levelOne
|
||||
if preferProp then levelZero else levelOne
|
||||
else
|
||||
let r := Level.mkNaryMax us.toList
|
||||
if rOffset == 0 && !r.isZero && !r.isNeverZero then
|
||||
@@ -512,6 +512,31 @@ where
|
||||
for ctorParam in ctorParams[numParams:] do
|
||||
accLevelAtCtor ctor ctorParam r rOffset
|
||||
|
||||
/--
|
||||
Decides whether the inductive type should be `Prop`-valued when the universe is not given
|
||||
and when the universe inference algorithm `collectUniverses` determines
|
||||
that the inductive type could naturally be `Prop`-valued.
|
||||
Recall: the natural universe level is the mimimum universe level for all the types of all the constructor parameters.
|
||||
|
||||
Heuristic:
|
||||
- We want `Prop` when each inductive type is a syntactic subsingleton.
|
||||
That's to say, when each inductive type has at most one constructor.
|
||||
Such types carry no data anyway.
|
||||
- Exception: if no inductive type has any constructors, these are likely stubbed-out declarations,
|
||||
so we prefer `Type` instead.
|
||||
- Exception: if each constructor has no parameters, then these are likely partially-written enumerations,
|
||||
so we prefer `Type` instead.
|
||||
-/
|
||||
private def isPropCandidate (numParams : Nat) (indTypes : List InductiveType) : MetaM Bool := do
|
||||
unless indTypes.foldl (fun n indType => max n indType.ctors.length) 0 == 1 do
|
||||
return false
|
||||
for indType in indTypes do
|
||||
for ctor in indType.ctors do
|
||||
let cparams ← forallTelescopeReducing ctor.type fun ctorParams _ => pure (ctorParams.size - numParams)
|
||||
unless cparams == 0 do
|
||||
return true
|
||||
return false
|
||||
|
||||
private def updateResultingUniverse (views : Array InductiveView) (numParams : Nat) (indTypes : List InductiveType) : TermElabM (List InductiveType) := do
|
||||
let r ← getResultingUniverse indTypes
|
||||
let rOffset : Nat := r.getOffset
|
||||
@@ -520,7 +545,7 @@ private def updateResultingUniverse (views : Array InductiveView) (numParams : N
|
||||
throwError "failed to compute resulting universe level of inductive datatype, provide universe explicitly: {r}"
|
||||
let us ← collectUniverses views r rOffset numParams indTypes
|
||||
trace[Elab.inductive] "updateResultingUniverse us: {us}, r: {r}, rOffset: {rOffset}"
|
||||
let rNew := mkResultUniverse us rOffset
|
||||
let rNew := mkResultUniverse us rOffset (← isPropCandidate numParams indTypes)
|
||||
assignLevelMVar r.mvarId! rNew
|
||||
indTypes.mapM fun indType => do
|
||||
let type ← instantiateMVars indType.type
|
||||
@@ -745,7 +770,7 @@ private partial def fixedIndicesToParams (numParams : Nat) (indTypes : Array Ind
|
||||
forallBoundedTelescope indTypes[0]!.type numParams fun params type => do
|
||||
let otherTypes ← indTypes[1:].toArray.mapM fun indType => do whnfD (← instantiateForall indType.type params)
|
||||
let ctorTypes ← indTypes.toList.mapM fun indType => indType.ctors.mapM fun ctor => do whnfD (← instantiateForall ctor.type params)
|
||||
let typesToCheck := otherTypes.toList ++ ctorTypes.join
|
||||
let typesToCheck := otherTypes.toList ++ ctorTypes.flatten
|
||||
let rec go (i : Nat) (type : Expr) (typesToCheck : List Expr) : MetaM Nat := do
|
||||
if i < mask.size then
|
||||
if !masks.all fun mask => i < mask.size && mask[i]! then
|
||||
|
||||
@@ -83,7 +83,7 @@ inductive CompletionInfo where
|
||||
| namespaceId (stx : Syntax)
|
||||
| option (stx : Syntax)
|
||||
| endSection (stx : Syntax) (scopeNames : List String)
|
||||
| tactic (stx : Syntax) (goals : List MVarId)
|
||||
| tactic (stx : Syntax)
|
||||
-- TODO `import`
|
||||
|
||||
/-- Info for an option reference (e.g. in `set_option`). -/
|
||||
|
||||
@@ -226,7 +226,7 @@ def allCombinations (xss : Array (Array α)) : Option (Array (Array α)) :=
|
||||
else
|
||||
let rec go i acc : Array (Array α):=
|
||||
if h : i < xss.size then
|
||||
xss[i].concatMap fun x => go (i + 1) (acc.push x)
|
||||
xss[i].flatMap fun x => go (i + 1) (acc.push x)
|
||||
else
|
||||
#[acc]
|
||||
some (go 0 #[])
|
||||
|
||||
@@ -473,7 +473,10 @@ private def getFieldIdx (structName : Name) (fieldNames : Array Name) (fieldName
|
||||
def mkProjStx? (s : Syntax) (structName : Name) (fieldName : Name) : TermElabM (Option Syntax) := do
|
||||
if (findField? (← getEnv) structName fieldName).isNone then
|
||||
return none
|
||||
return some <| mkNode ``Parser.Term.proj #[s, mkAtomFrom s ".", mkIdentFrom s fieldName]
|
||||
return some <|
|
||||
mkNode ``Parser.Term.explicit
|
||||
#[mkAtomFrom s "@",
|
||||
mkNode ``Parser.Term.proj #[s, mkAtomFrom s ".", mkIdentFrom s fieldName]]
|
||||
|
||||
def findField? (fields : Fields) (fieldName : Name) : Option (Field Struct) :=
|
||||
fields.find? fun field =>
|
||||
@@ -685,7 +688,7 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
|
||||
let type := (d.getArg! 0).consumeTypeAnnotations
|
||||
let mvar ← mkTacticMVar type stx (.fieldAutoParam fieldName s.structName)
|
||||
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
|
||||
-- (See the aformentioned `processExplicitArg` for a comment about this.)
|
||||
-- (See the aforementioned `processExplicitArg` for a comment about this.)
|
||||
addTermInfo' stx mvar
|
||||
cont mvar field
|
||||
| _ =>
|
||||
|
||||
@@ -137,7 +137,12 @@ def structSimpleBinder := leading_parser atomic (declModifiers true >> ident)
|
||||
def structFields := leading_parser many (structExplicitBinder <|> structImplicitBinder <|> structInstBinder)
|
||||
```
|
||||
-/
|
||||
private def expandFields (structStx : Syntax) (structModifiers : Modifiers) (structDeclName : Name) : TermElabM (Array StructFieldView) :=
|
||||
private def expandFields (structStx : Syntax) (structModifiers : Modifiers) (structDeclName : Name) : TermElabM (Array StructFieldView) := do
|
||||
if structStx[5][0].isToken ":=" then
|
||||
-- https://github.com/leanprover/lean4/issues/5236
|
||||
let cmd := if structStx[0].getKind == ``Parser.Command.classTk then "class" else "structure"
|
||||
withRef structStx[0] <| Linter.logLintIf Linter.linter.deprecated structStx[5][0]
|
||||
s!"{cmd} ... :=' has been deprecated in favor of '{cmd} ... where'."
|
||||
let fieldBinders := if structStx[5].isNone then #[] else structStx[5][2][0].getArgs
|
||||
fieldBinders.foldlM (init := #[]) fun (views : Array StructFieldView) fieldBinder => withRef fieldBinder do
|
||||
let mut fieldBinder := fieldBinder
|
||||
@@ -632,6 +637,19 @@ where
|
||||
msg := msg ++ "\nrecall that Lean only infers the resulting universe level automatically when there is a unique solution for the universe level constraints, consider explicitly providing the structure resulting universe level"
|
||||
throwError msg
|
||||
|
||||
/--
|
||||
Decides whether the structure should be `Prop`-valued when the universe is not given
|
||||
and when the universe inference algorithm `collectUniversesFromFields` determines
|
||||
that the inductive type could naturally be `Prop`-valued.
|
||||
|
||||
See `Lean.Elab.Command.isPropCandidate` for an explanation.
|
||||
Specialized to structures, the heuristic is that we prefer a `Prop` instead of a `Type` structure
|
||||
when it could be a syntactic subsingleton.
|
||||
Exception: no-field structures are `Type` since they are likely stubbed-out declarations.
|
||||
-/
|
||||
private def isPropCandidate (fieldInfos : Array StructFieldInfo) : Bool :=
|
||||
!fieldInfos.isEmpty
|
||||
|
||||
private def updateResultingUniverse (fieldInfos : Array StructFieldInfo) (type : Expr) : TermElabM Expr := do
|
||||
let r ← getResultUniverse type
|
||||
let rOffset : Nat := r.getOffset
|
||||
@@ -639,7 +657,7 @@ private def updateResultingUniverse (fieldInfos : Array StructFieldInfo) (type :
|
||||
match r with
|
||||
| Level.mvar mvarId =>
|
||||
let us ← collectUniversesFromFields r rOffset fieldInfos
|
||||
let rNew := mkResultUniverse us rOffset
|
||||
let rNew := mkResultUniverse us rOffset (isPropCandidate fieldInfos)
|
||||
assignLevelMVar mvarId rNew
|
||||
instantiateMVars type
|
||||
| _ => throwError "failed to compute resulting universe level of structure, provide universe explicitly"
|
||||
@@ -866,7 +884,8 @@ private def elabStructureView (view : StructView) : TermElabM Unit := do
|
||||
addDefaults lctx defaultAuxDecls
|
||||
|
||||
/-
|
||||
leading_parser (structureTk <|> classTk) >> declId >> many Term.bracketedBinder >> optional «extends» >> Term.optType >> " := " >> optional structCtor >> structFields >> optDeriving
|
||||
leading_parser (structureTk <|> classTk) >> declId >> many Term.bracketedBinder >> optional «extends» >> Term.optType >>
|
||||
optional (("where" <|> ":=") >> optional structCtor >> structFields) >> optDeriving
|
||||
|
||||
where
|
||||
def «extends» := leading_parser " extends " >> sepBy1 termParser ", "
|
||||
|
||||
@@ -43,3 +43,4 @@ import Lean.Elab.Tactic.Rewrites
|
||||
import Lean.Elab.Tactic.DiscrTreeKey
|
||||
import Lean.Elab.Tactic.BVDecide
|
||||
import Lean.Elab.Tactic.BoolToPropSimps
|
||||
import Lean.Elab.Tactic.Classical
|
||||
|
||||
@@ -169,8 +169,9 @@ def satQuery (solverPath : System.FilePath) (problemPath : System.FilePath) (pro
|
||||
let out? ← runInterruptible timeout { cmd, args, stdin := .piped, stdout := .piped, stderr := .null }
|
||||
match out? with
|
||||
| .timeout =>
|
||||
let mut err := "The SAT solver timed out while solving the problem."
|
||||
err := err ++ "\nConsider increasing the timeout with `set_option sat.timeout <sec>`"
|
||||
let mut err := "The SAT solver timed out while solving the problem.\n"
|
||||
err := err ++ "Consider increasing the timeout with `set_option sat.timeout <sec>`.\n"
|
||||
err := err ++ "If solving your problem relies inherently on using associativity or commutativity, consider enabling the `bv.ac_nf` option."
|
||||
throwError err
|
||||
| .success { exitCode := exitCode, stdout := stdout, stderr := stderr} =>
|
||||
if exitCode == 255 then
|
||||
|
||||
@@ -52,6 +52,11 @@ register_builtin_option debug.bv.graphviz : Bool := {
|
||||
descr := "Output the AIG of bv_decide as graphviz into a file called aig.gv in the working directory of the Lean process."
|
||||
}
|
||||
|
||||
register_builtin_option bv.ac_nf : Bool := {
|
||||
defValue := false
|
||||
descr := "Canonicalize with respect to associativity and commutativitiy."
|
||||
}
|
||||
|
||||
builtin_initialize bvNormalizeExt : Meta.SimpExtension ←
|
||||
Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"
|
||||
|
||||
|
||||
@@ -41,7 +41,7 @@ def lratChecker (cfg : TacticContext) (bvExpr : BVLogicalExpr) : MetaM Expr := d
|
||||
|
||||
@[inherit_doc Lean.Parser.Tactic.bvCheck]
|
||||
def bvCheck (g : MVarId) (cfg : TacticContext) : MetaM Unit := do
|
||||
let unsatProver : UnsatProver := fun reflectionResult _ => do
|
||||
let unsatProver : UnsatProver := fun _ reflectionResult _ => do
|
||||
withTraceNode `sat (fun _ => return "Preparing LRAT reflection term") do
|
||||
let proof ← lratChecker cfg reflectionResult.bvExpr
|
||||
return .ok ⟨proof, ""⟩
|
||||
@@ -60,8 +60,8 @@ def evalBvCheck : Tactic := fun
|
||||
| some g' => bvCheck g' cfg
|
||||
| none =>
|
||||
let bvNormalizeStx ← `(tactic| bv_normalize)
|
||||
logWarning m!"This goal can be closed by only applying bv_normalize, no need to keep the LRAT proof around."
|
||||
TryThis.addSuggestion tk bvNormalizeStx (origSpan? := ← getRef)
|
||||
throwError m!"This goal can be closed by only applying bv_normalize, no need to keep the LRAT proof around."
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Frontend.BVCheck
|
||||
|
||||
@@ -83,6 +83,10 @@ structure ReflectionResult where
|
||||
A counter example generated from the bitblaster.
|
||||
-/
|
||||
structure CounterExample where
|
||||
/--
|
||||
The goal in which to interpret this counter example.
|
||||
-/
|
||||
goal : MVarId
|
||||
/--
|
||||
The set of unused but potentially relevant hypotheses. Useful for diagnosing spurious counter
|
||||
examples.
|
||||
@@ -97,7 +101,7 @@ structure UnsatProver.Result where
|
||||
proof : Expr
|
||||
lratCert : LratCert
|
||||
|
||||
abbrev UnsatProver := ReflectionResult → Std.HashMap Nat (Nat × Expr) →
|
||||
abbrev UnsatProver := MVarId → ReflectionResult → Std.HashMap Nat (Nat × Expr) →
|
||||
MetaM (Except CounterExample UnsatProver.Result)
|
||||
|
||||
/--
|
||||
@@ -112,8 +116,9 @@ abbrev DiagnosisM : Type → Type := ReaderT CounterExample <| StateRefT Diagnos
|
||||
namespace DiagnosisM
|
||||
|
||||
def run (x : DiagnosisM Unit) (counterExample : CounterExample) : MetaM Diagnosis := do
|
||||
let (_, issues) ← ReaderT.run x counterExample |>.run {}
|
||||
return issues
|
||||
counterExample.goal.withContext do
|
||||
let (_, issues) ← ReaderT.run x counterExample |>.run {}
|
||||
return issues
|
||||
|
||||
def unusedHyps : DiagnosisM (Std.HashSet FVarId) := do
|
||||
return (← read).unusedHypotheses
|
||||
@@ -177,7 +182,7 @@ def explainCounterExampleQuality (counterExample : CounterExample) : MetaM Messa
|
||||
err := err ++ m!"Consider the following assignment:\n"
|
||||
return err
|
||||
|
||||
def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
def lratBitblaster (goal : MVarId) (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
|
||||
MetaM (Except CounterExample UnsatProver.Result) := do
|
||||
let bvExpr := reflectionResult.bvExpr
|
||||
@@ -206,11 +211,13 @@ def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
|
||||
match res with
|
||||
| .ok cert =>
|
||||
trace[Meta.Tactic.sat] "SAT solver found a proof."
|
||||
let proof ← cert.toReflectionProof cfg bvExpr ``verifyBVExpr ``unsat_of_verifyBVExpr_eq_true
|
||||
return .ok ⟨proof, cert⟩
|
||||
| .error assignment =>
|
||||
trace[Meta.Tactic.sat] "SAT solver found a counter example."
|
||||
let equations := reconstructCounterExample map assignment aigSize atomsAssignment
|
||||
return .error { unusedHypotheses := reflectionResult.unusedHypotheses, equations }
|
||||
return .error { goal, unusedHypotheses := reflectionResult.unusedHypotheses, equations }
|
||||
|
||||
|
||||
def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
|
||||
@@ -248,7 +255,7 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
|
||||
|
||||
let atomsPairs := (← getThe State).atoms.toList.map (fun (expr, ⟨width, ident⟩) => (ident, (width, expr)))
|
||||
let atomsAssignment := Std.HashMap.ofList atomsPairs
|
||||
match ← unsatProver reflectionResult atomsAssignment with
|
||||
match ← unsatProver g reflectionResult atomsAssignment with
|
||||
| .ok ⟨bvExprUnsat, cert⟩ =>
|
||||
let proveFalse ← reflectionResult.proveFalse bvExprUnsat
|
||||
g.assign proveFalse
|
||||
@@ -256,9 +263,9 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
|
||||
| .error counterExample => return .error counterExample
|
||||
|
||||
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample LratCert) := M.run do
|
||||
let unsatProver : UnsatProver := fun reflectionResult atomsAssignment => do
|
||||
let unsatProver : UnsatProver := fun g reflectionResult atomsAssignment => do
|
||||
withTraceNode `bv (fun _ => return "Preparing LRAT reflection term") do
|
||||
lratBitblaster cfg reflectionResult atomsAssignment
|
||||
lratBitblaster g cfg reflectionResult atomsAssignment
|
||||
closeWithBVReflection g unsatProver
|
||||
|
||||
/--
|
||||
@@ -289,9 +296,11 @@ def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
|
||||
match ← bvDecide' g cfg with
|
||||
| .ok result => return result
|
||||
| .error counterExample =>
|
||||
let error ← explainCounterExampleQuality counterExample
|
||||
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
|
||||
throwError counterExample.equations.foldl (init := error) folder
|
||||
counterExample.goal.withContext do
|
||||
let error ← explainCounterExampleQuality counterExample
|
||||
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
|
||||
let errorMessage := counterExample.equations.foldl (init := error) folder
|
||||
throwError (← addMessageContextFull errorMessage)
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.bvDecide]
|
||||
def evalBvTrace : Tactic := fun
|
||||
|
||||
@@ -27,6 +27,8 @@ instance : ToExpr BVBinOp where
|
||||
| .xor => mkConst ``BVBinOp.xor
|
||||
| .add => mkConst ``BVBinOp.add
|
||||
| .mul => mkConst ``BVBinOp.mul
|
||||
| .udiv => mkConst ``BVBinOp.udiv
|
||||
| .umod => mkConst ``BVBinOp.umod
|
||||
toTypeExpr := mkConst ``BVBinOp
|
||||
|
||||
instance : ToExpr BVUnOp where
|
||||
|
||||
@@ -80,6 +80,10 @@ partial def of (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
|
||||
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
|
||||
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
|
||||
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
|
||||
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
|
||||
| Complement.complement _ _ innerExpr =>
|
||||
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
|
||||
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>
|
||||
|
||||
@@ -105,7 +105,7 @@ instance : ToExpr LRAT.IntAction where
|
||||
mkApp3 (mkConst ``LRAT.Action.del [.zero, .zero]) beta alpha (toExpr ids)
|
||||
toTypeExpr := mkConst ``LRAT.IntAction
|
||||
|
||||
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : MetaM LratCert := do
|
||||
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
|
||||
let proofInput ← IO.FS.readBinFile lratPath
|
||||
let proof ←
|
||||
withTraceNode `sat (fun _ => return s!"Parsing LRAT file") do
|
||||
@@ -139,8 +139,8 @@ Run an external SAT solver on the `CNF` to obtain an LRAT proof.
|
||||
This will obtain an `LratCert` if the formula is UNSAT and throw errors otherwise.
|
||||
-/
|
||||
def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.FilePath)
|
||||
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool)
|
||||
: MetaM (Except (Array (Bool × Nat)) LratCert) := do
|
||||
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool) :
|
||||
CoreM (Except (Array (Bool × Nat)) LratCert) := do
|
||||
IO.FS.withTempFile fun cnfHandle cnfPath => do
|
||||
withTraceNode `sat (fun _ => return "Serializing SAT problem to DIMACS file") do
|
||||
-- lazyPure to prevent compiler lifting
|
||||
@@ -162,7 +162,7 @@ def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.Fi
|
||||
/--
|
||||
Add an auxiliary declaration. Only used to create constants that appear in our reflection proof.
|
||||
-/
|
||||
def mkAuxDecl (name : Name) (value type : Expr) : MetaM Unit :=
|
||||
def mkAuxDecl (name : Name) (value type : Expr) : CoreM Unit :=
|
||||
addAndCompile <| .defnDecl {
|
||||
name := name,
|
||||
levelParams := [],
|
||||
@@ -181,8 +181,7 @@ function together with a correctness theorem for it.
|
||||
`∀ (b : α) (c : LratCert), verifier b c = true → unsat b`
|
||||
-/
|
||||
def LratCert.toReflectionProof [ToExpr α] (cert : LratCert) (cfg : TacticContext) (reflected : α)
|
||||
(verifier : Name) (unsat_of_verifier_eq_true : Name) :
|
||||
MetaM Expr := do
|
||||
(verifier : Name) (unsat_of_verifier_eq_true : Name) : MetaM Expr := do
|
||||
withTraceNode `sat (fun _ => return "Compiling expr term") do
|
||||
mkAuxDecl cfg.exprDef (toExpr reflected) (toTypeExpr α)
|
||||
|
||||
@@ -198,13 +197,20 @@ def LratCert.toReflectionProof [ToExpr α] (cert : LratCert) (cfg : TacticContex
|
||||
let auxValue := mkApp2 (mkConst verifier) reflectedExpr certExpr
|
||||
mkAuxDecl cfg.reflectionDef auxValue (mkConst ``Bool)
|
||||
|
||||
let nativeProof :=
|
||||
let auxType ← mkEq (mkConst cfg.reflectionDef) (toExpr true)
|
||||
let auxProof :=
|
||||
mkApp3
|
||||
(mkConst ``Lean.ofReduceBool)
|
||||
(mkConst cfg.reflectionDef)
|
||||
(toExpr true)
|
||||
(← mkEqRefl (toExpr true))
|
||||
return mkApp3 (mkConst unsat_of_verifier_eq_true) reflectedExpr certExpr nativeProof
|
||||
try
|
||||
let auxLemma ←
|
||||
withTraceNode `sat (fun _ => return "Verifying LRAT certificate") do
|
||||
mkAuxLemma [] auxType auxProof
|
||||
return mkApp3 (mkConst unsat_of_verifier_eq_true) reflectedExpr certExpr (mkConst auxLemma)
|
||||
catch e =>
|
||||
throwError m!"Failed to check the LRAT certificate in the kernel:\n{e.toMessageData}"
|
||||
|
||||
|
||||
end Frontend
|
||||
|
||||
@@ -5,6 +5,7 @@ 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.Attr
|
||||
@@ -64,6 +65,69 @@ builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _))
|
||||
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
|
||||
-- TODO
|
||||
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
|
||||
|
||||
/--
|
||||
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
|
||||
the goal fully, indicated by returning `none`.
|
||||
@@ -112,11 +176,36 @@ def rewriteRulesPass : Pass := fun goal => do
|
||||
let some (_, newGoal) := result? | return none
|
||||
return newGoal
|
||||
|
||||
/--
|
||||
Normalize with respect to Associativity and Commutativity.
|
||||
-/
|
||||
def acNormalizePass : Pass := fun 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
|
||||
|
||||
/--
|
||||
The normalization passes used by `bv_normalize` and thus `bv_decide`.
|
||||
-/
|
||||
def defaultPipeline : List Pass := [rewriteRulesPass]
|
||||
|
||||
def passPipeline : MetaM (List Pass) := do
|
||||
let opts ← getOptions
|
||||
|
||||
let mut passPipeline := defaultPipeline
|
||||
|
||||
if bv.ac_nf.get opts then
|
||||
passPipeline := passPipeline ++ [acNormalizePass]
|
||||
|
||||
return passPipeline
|
||||
|
||||
end Pass
|
||||
|
||||
def bvNormalize (g : MVarId) : MetaM (Option MVarId) := do
|
||||
@@ -124,7 +213,7 @@ def bvNormalize (g : MVarId) : MetaM (Option MVarId) := do
|
||||
-- Contradiction proof
|
||||
let some g ← g.falseOrByContra | return none
|
||||
trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
|
||||
Pass.fixpointPipeline Pass.defaultPipeline g
|
||||
Pass.fixpointPipeline (← Pass.passPipeline) g
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.bvNormalize]
|
||||
def evalBVNormalize : Tactic := fun
|
||||
@@ -137,5 +226,3 @@ def evalBVNormalize : Tactic := fun
|
||||
|
||||
end Frontend.Normalize
|
||||
end Lean.Elab.Tactic.BVDecide
|
||||
|
||||
|
||||
|
||||
@@ -52,6 +52,7 @@ instance : Monad TacticM :=
|
||||
instance : Inhabited (TacticM α) where
|
||||
default := fun _ _ => default
|
||||
|
||||
/-- Returns the list of goals. Goals may or may not already be assigned. -/
|
||||
def getGoals : TacticM (List MVarId) :=
|
||||
return (← get).goals
|
||||
|
||||
@@ -300,13 +301,22 @@ instance : MonadBacktrack SavedState TacticM where
|
||||
saveState := Tactic.saveState
|
||||
restoreState b := b.restore
|
||||
|
||||
/--
|
||||
Non-backtracking `try`/`catch`.
|
||||
-/
|
||||
@[inline] protected def tryCatch {α} (x : TacticM α) (h : Exception → TacticM α) : TacticM α := do
|
||||
try x catch ex => h ex
|
||||
|
||||
/--
|
||||
Backtracking `try`/`catch`. This is used for the `MonadExcept` instance for `TacticM`.
|
||||
-/
|
||||
@[inline] protected def tryCatchRestore {α} (x : TacticM α) (h : Exception → TacticM α) : TacticM α := do
|
||||
let b ← saveState
|
||||
try x catch ex => b.restore; h ex
|
||||
|
||||
instance : MonadExcept Exception TacticM where
|
||||
throw := throw
|
||||
tryCatch := Tactic.tryCatch
|
||||
tryCatch := Tactic.tryCatchRestore
|
||||
|
||||
/-- Execute `x` with error recovery disabled -/
|
||||
def withoutRecover (x : TacticM α) : TacticM α :=
|
||||
@@ -342,12 +352,26 @@ def adaptExpander (exp : Syntax → TacticM Syntax) : Tactic := fun stx => do
|
||||
let stx' ← exp stx
|
||||
withMacroExpansion stx stx' $ evalTactic stx'
|
||||
|
||||
/-- Add the given goals at the end of the current goals collection. -/
|
||||
/-- Add the given goal to the front of the current list of goals. -/
|
||||
def pushGoal (mvarId : MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := mvarId :: s.goals }
|
||||
|
||||
/-- Add the given goals to the front of the current list of goals. -/
|
||||
def pushGoals (mvarIds : List MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := mvarIds ++ s.goals }
|
||||
|
||||
/-- Add the given goals at the end of the current list of goals. -/
|
||||
def appendGoals (mvarIds : List MVarId) : TacticM Unit :=
|
||||
modify fun s => { s with goals := s.goals ++ mvarIds }
|
||||
|
||||
/-- Discard the first goal and replace it by the given list of goals,
|
||||
keeping the other goals. -/
|
||||
/--
|
||||
Discard the first goal and replace it by the given list of goals,
|
||||
keeping the other goals. This is used in conjunction with `getMainGoal`.
|
||||
|
||||
Contract: between `getMainGoal` and `replaceMainGoal`, nothing manipulates the goal list.
|
||||
|
||||
See also `Lean.Elab.Tactic.popMainGoal` and `Lean.Elab.Tactic.pushGoal`/`Lean.Elab.Tactic.pushGoal` for another interface.
|
||||
-/
|
||||
def replaceMainGoal (mvarIds : List MVarId) : TacticM Unit := do
|
||||
let (_ :: mvarIds') ← getGoals | throwNoGoalsToBeSolved
|
||||
modify fun _ => { goals := mvarIds ++ mvarIds' }
|
||||
@@ -365,6 +389,16 @@ where
|
||||
setGoals (mvarId :: mvarIds)
|
||||
return mvarId
|
||||
|
||||
/--
|
||||
Return the first goal, and remove it from the goal list.
|
||||
|
||||
See also: `Lean.Elab.Tactic.pushGoal` and `Lean.Elab.Tactic.pushGoals`.
|
||||
-/
|
||||
def popMainGoal : TacticM MVarId := do
|
||||
let mvarId ← getMainGoal
|
||||
replaceMainGoal []
|
||||
return mvarId
|
||||
|
||||
/-- Return the main goal metavariable declaration. -/
|
||||
def getMainDecl : TacticM MetavarDecl := do
|
||||
(← getMainGoal).getDecl
|
||||
|
||||
@@ -313,7 +313,7 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
|
||||
@[builtin_tactic skip] def evalSkip : Tactic := fun _ => pure ()
|
||||
|
||||
@[builtin_tactic unknown] def evalUnknown : Tactic := fun stx => do
|
||||
addCompletionInfo <| CompletionInfo.tactic stx (← getGoals)
|
||||
addCompletionInfo <| CompletionInfo.tactic stx
|
||||
|
||||
@[builtin_tactic failIfSuccess] def evalFailIfSuccess : Tactic := fun stx =>
|
||||
Term.withoutErrToSorry <| withoutRecover do
|
||||
|
||||
@@ -14,9 +14,9 @@ open Meta
|
||||
@[builtin_tactic Lean.calcTactic]
|
||||
def evalCalc : Tactic := fun stx => withMainContext do
|
||||
let steps : TSyntax ``calcSteps := ⟨stx[1]⟩
|
||||
let (val, mvarIds) ← withCollectingNewGoalsFrom (tagSuffix := `calc) do
|
||||
let target := (← getMainTarget).consumeMData
|
||||
let tag ← getMainTag
|
||||
let target := (← getMainTarget).consumeMData
|
||||
let tag ← getMainTag
|
||||
let (val, mvarIds) ← withCollectingNewGoalsFrom (parentTag := tag) (tagSuffix := `calc) do
|
||||
runTermElab do
|
||||
let mut val ← Term.elabCalcSteps steps
|
||||
let mut valType ← instantiateMVars (← inferType val)
|
||||
|
||||
34
src/Lean/Elab/Tactic/Classical.lean
Normal file
34
src/Lean/Elab/Tactic/Classical.lean
Normal file
@@ -0,0 +1,34 @@
|
||||
/-
|
||||
Copyright (c) 2021 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.Basic
|
||||
|
||||
/-! # `classical` tactic -/
|
||||
|
||||
namespace Lean.Elab.Tactic
|
||||
open Lean Meta Elab.Tactic
|
||||
|
||||
/--
|
||||
`classical t` runs `t` in a scope where `Classical.propDecidable` is a low priority
|
||||
local instance.
|
||||
-/
|
||||
def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t : m α) :
|
||||
m α := do
|
||||
modifyEnv Meta.instanceExtension.pushScope
|
||||
Meta.addInstance ``Classical.propDecidable .local 10
|
||||
try
|
||||
t
|
||||
finally
|
||||
modifyEnv Meta.instanceExtension.popScope
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.classical]
|
||||
def evalClassical : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| classical $tacs:tacticSeq) =>
|
||||
classical <| Elab.Tactic.evalTactic tacs
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user