mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-23 05:14:09 +00:00
Compare commits
114 Commits
withLocati
...
seval
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
66799f190e | ||
|
|
d1c2d0bd9c | ||
|
|
8475ec7e36 | ||
|
|
4497aba1a9 | ||
|
|
cddc8089bc | ||
|
|
ce15b43798 | ||
|
|
430f4d28e4 | ||
|
|
d279a4871f | ||
|
|
f208d7b50f | ||
|
|
df18f3f1ff | ||
|
|
fbcfe6596e | ||
|
|
b5b664e570 | ||
|
|
2f216b5255 | ||
|
|
d4dca3baac | ||
|
|
de7d78a9f1 | ||
|
|
6a629f7d7f | ||
|
|
f74516a032 | ||
|
|
78200b309f | ||
|
|
b120080b85 | ||
|
|
4b8c342833 | ||
|
|
fa26d222cb | ||
|
|
e2f957109f | ||
|
|
20dd63aabf | ||
|
|
c656e71eb8 | ||
|
|
104c92d4f3 | ||
|
|
5cd90f5826 | ||
|
|
178ab8ef2e | ||
|
|
e6c0484074 | ||
|
|
dd42a0919d | ||
|
|
1b2bbe717d | ||
|
|
00359a0347 | ||
|
|
c474dff38c | ||
|
|
f2a92f3331 | ||
|
|
bcbcf50442 | ||
|
|
ec8811a75a | ||
|
|
b3a85631d8 | ||
|
|
5d35e9496e | ||
|
|
d4f10bc07e | ||
|
|
feb0cb6fc4 | ||
|
|
d6c81f8594 | ||
|
|
17825bf81d | ||
|
|
9290b491bb | ||
|
|
c91ece4f58 | ||
|
|
93a6279025 | ||
|
|
5c2292a923 | ||
|
|
14296ae720 | ||
|
|
6d23450642 | ||
|
|
92f1755e9b | ||
|
|
465f0feb2d | ||
|
|
24466a25f3 | ||
|
|
e4eff3bc6e | ||
|
|
66cb44c53c | ||
|
|
8be3897a8b | ||
|
|
bd89787a87 | ||
|
|
a5af90c724 | ||
|
|
5937f4208a | ||
|
|
ea5b55b8f2 | ||
|
|
0fca41ddb2 | ||
|
|
f356d8830e | ||
|
|
5b6e4faacd | ||
|
|
0ad611cf2f | ||
|
|
3a0edd05e6 | ||
|
|
99331219f9 | ||
|
|
18459cb537 | ||
|
|
e4f2c39ab2 | ||
|
|
3025a4a9a1 | ||
|
|
367ac01279 | ||
|
|
4f2f704962 | ||
|
|
34264a4b1d | ||
|
|
5d22145b83 | ||
|
|
0a6aed61e9 | ||
|
|
6c7a765abb | ||
|
|
c1f6daf1ac | ||
|
|
ffbea840bf | ||
|
|
190ac50994 | ||
|
|
c20d65771c | ||
|
|
cbba783bcf | ||
|
|
a4aaabf396 | ||
|
|
984d55c962 | ||
|
|
0249a8c15e | ||
|
|
6592df52cc | ||
|
|
9769ad6572 | ||
|
|
79251f5fa2 | ||
|
|
f142d9f798 | ||
|
|
7ff7cf9b5a | ||
|
|
5639302989 | ||
|
|
5f5d579986 | ||
|
|
681fca1f8f | ||
|
|
e34656ce75 | ||
|
|
5a68ad9ef4 | ||
|
|
a422f3f2c9 | ||
|
|
260eaebf4e | ||
|
|
dede354e77 | ||
|
|
5eb4a007a6 | ||
|
|
54dd588fc2 | ||
|
|
9efdde23e0 | ||
|
|
91917516f1 | ||
|
|
fb30932ca7 | ||
|
|
0adca630cc | ||
|
|
37362658ab | ||
|
|
66aa2c46a8 | ||
|
|
b97b0ad2aa | ||
|
|
fbefbce8c7 | ||
|
|
f1b274279b | ||
|
|
6a33afb745 | ||
|
|
9800e066bc | ||
|
|
5858549037 | ||
|
|
4d39a0b0e3 | ||
|
|
9bf0f5116b | ||
|
|
8b86beeb07 | ||
|
|
8881517018 | ||
|
|
0668544a35 | ||
|
|
1362268472 | ||
|
|
65d08fdcdd |
33
.github/workflows/changelog.yml
vendored
33
.github/workflows/changelog.yml
vendored
@@ -1,33 +0,0 @@
|
||||
name: add PR to changelog
|
||||
|
||||
on:
|
||||
# needs read/write GH token, do *not* execute arbitrary code from PR
|
||||
pull_request_target:
|
||||
types: [closed]
|
||||
|
||||
jobs:
|
||||
update-changelog:
|
||||
if: |
|
||||
github.event.pull_request.merged == true &&
|
||||
contains(github.event.pull_request.labels.*.name, 'changelog') &&
|
||||
github.base_ref == 'master'
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
with:
|
||||
# needs sufficiently elevated token to override branch protection rules
|
||||
token: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
|
||||
- name: Update changelog
|
||||
run: |
|
||||
set -euxo pipefail
|
||||
escaped_link=$(sed -e 's/[\/&]/\\&/g' <<'EOF'
|
||||
[${{ github.event.pull_request.title}}](${{ github.event.pull_request.html_url }})
|
||||
EOF
|
||||
)
|
||||
# insert link below first dashes line (https://stackoverflow.com/a/9453461/161659)
|
||||
sed -i "0,/^---*/s/^---*/\0\n\n* $escaped_link./" RELEASES.md
|
||||
# commit as github-actions bot (https://github.com/orgs/community/discussions/26560#discussioncomment-3252339)
|
||||
git config user.email "41898282+github-actions[bot]@users.noreply.github.com"
|
||||
git config user.name "github-actions[bot]"
|
||||
git commit -i RELEASES.md -m "doc: update changelog"
|
||||
git push
|
||||
360
.github/workflows/ci.yml
vendored
360
.github/workflows/ci.yml
vendored
@@ -6,8 +6,8 @@ on:
|
||||
tags:
|
||||
- '*'
|
||||
pull_request:
|
||||
branches:
|
||||
- master
|
||||
types: [opened, synchronize, reopened, labeled]
|
||||
merge_group:
|
||||
schedule:
|
||||
- cron: '0 7 * * *' # 8AM CET/11PM PT
|
||||
|
||||
@@ -16,18 +16,185 @@ concurrency:
|
||||
cancel-in-progress: true
|
||||
|
||||
jobs:
|
||||
set-nightly:
|
||||
|
||||
# This job determines various settings for the following CI runs; see the `outputs` for details
|
||||
configure:
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
nightly: ${{ steps.set.outputs.nightly }}
|
||||
# Should we run only a quick CI? Yes on a pull request without the full-ci label
|
||||
quick: ${{ steps.set-quick.outputs.quick }}
|
||||
# The build matrix, dynamically generated here
|
||||
matrix: ${{ steps.set-matrix.outputs.result }}
|
||||
# Should we make a nightly release? If so, this output contains the lean version string, else it is empty
|
||||
nightly: ${{ steps.set-nightly.outputs.nightly }}
|
||||
# Should this be the CI for a tagged release?
|
||||
# Yes only if a tag is pushed to the `leanprover` repository, and the tag is "v" followed by a valid semver.
|
||||
# It sets `set-release.outputs.RELEASE_TAG` to the tag
|
||||
# and sets `set-release.outputs.{LEAN_VERSION_MAJOR,LEAN_VERSION_MINOR,LEAN_VERSION_PATCH,LEAN_SPECIAL_VERSION_DESC}`
|
||||
# to the semver components parsed via regex.
|
||||
LEAN_VERSION_MAJOR: ${{ steps.set-release.outputs.LEAN_VERSION_MAJOR }}
|
||||
LEAN_VERSION_MINOR: ${{ steps.set-release.outputs.LEAN_VERSION_MINOR }}
|
||||
LEAN_VERSION_PATCH: ${{ steps.set-release.outputs.LEAN_VERSION_PATCH }}
|
||||
LEAN_SPECIAL_VERSION_DESC: ${{ steps.set-release.outputs.LEAN_SPECIAL_VERSION_DESC }}
|
||||
RELEASE_TAG: ${{ steps.set-release.outputs.RELEASE_TAG }}
|
||||
|
||||
steps:
|
||||
- name: Run quick CI?
|
||||
id: set-quick
|
||||
env:
|
||||
quick: ${{
|
||||
github.event_name == 'pull_request' && !contains( github.event.pull_request.labels.*.name, 'full-ci')
|
||||
}}
|
||||
run: |
|
||||
echo "quick=${{env.quick}}" >> $GITHUB_OUTPUT
|
||||
|
||||
- name: Configure build matrix
|
||||
id: set-matrix
|
||||
uses: actions/github-script@v7
|
||||
with:
|
||||
script: |
|
||||
const quick = ${{ steps.set-quick.outputs.quick }};
|
||||
console.log(`quick: ${quick}`)
|
||||
let matrix = [
|
||||
{
|
||||
// portable release build: use channel with older glibc (2.27)
|
||||
"name": "Linux LLVM",
|
||||
"os": "ubuntu-latest",
|
||||
"release": false,
|
||||
"quick": false,
|
||||
"shell": "nix-shell --arg pkgsDist \"import (fetchTarball \\\"channel:nixos-19.03\\\") {{}}\" --run \"bash -euxo pipefail {0}\"",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst",
|
||||
"prepare-llvm": "../script/prepare-llvm-linux.sh lean-llvm*",
|
||||
"binary-check": "ldd -v",
|
||||
// foreign code may be linked against more recent glibc
|
||||
// reverse-ffi needs to be updated to link to LLVM libraries
|
||||
"CTEST_OPTIONS": "-E 'foreign|leanlaketest_reverse-ffi'",
|
||||
"CMAKE_OPTIONS": "-DLLVM=ON -DLLVM_CONFIG=${GITHUB_WORKSPACE}/build/llvm-host/bin/llvm-config"
|
||||
},
|
||||
{
|
||||
"name": "Linux release",
|
||||
"os": "ubuntu-latest",
|
||||
"release": true,
|
||||
"quick": true,
|
||||
"shell": "nix-shell --arg pkgsDist \"import (fetchTarball \\\"channel:nixos-19.03\\\") {{}}\" --run \"bash -euxo pipefail {0}\"",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst",
|
||||
"prepare-llvm": "../script/prepare-llvm-linux.sh lean-llvm*",
|
||||
"binary-check": "ldd -v",
|
||||
// foreign code may be linked against more recent glibc
|
||||
"CTEST_OPTIONS": "-E 'foreign'"
|
||||
},
|
||||
{
|
||||
"name": "Linux",
|
||||
"os": "ubuntu-latest",
|
||||
"check-stage3": true,
|
||||
"test-speedcenter": true,
|
||||
"quick": false,
|
||||
},
|
||||
{
|
||||
"name": "Linux Debug",
|
||||
"os": "ubuntu-latest",
|
||||
"quick": false,
|
||||
"CMAKE_OPTIONS": "-DCMAKE_BUILD_TYPE=Debug",
|
||||
// exclude seriously slow tests
|
||||
"CTEST_OPTIONS": "-E 'interactivetest|leanpkgtest|laketest|benchtest'"
|
||||
},
|
||||
{
|
||||
"name": "Linux fsanitize",
|
||||
"os": "ubuntu-latest",
|
||||
"quick": false,
|
||||
// turn off custom allocator & symbolic functions to make LSAN do its magic
|
||||
"CMAKE_OPTIONS": "-DLEAN_EXTRA_CXX_FLAGS=-fsanitize=address,undefined -DLEANC_EXTRA_FLAGS='-fsanitize=address,undefined -fsanitize-link-c++-runtime' -DSMALL_ALLOCATOR=OFF -DBSYMBOLIC=OFF",
|
||||
// exclude seriously slow/problematic tests (laketests crash)
|
||||
"CTEST_OPTIONS": "-E 'interactivetest|leanpkgtest|laketest|benchtest'"
|
||||
},
|
||||
{
|
||||
"name": "macOS",
|
||||
"os": "macos-latest",
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"shell": "bash -euxo pipefail {0}",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-apple-darwin.tar.zst",
|
||||
"prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm*",
|
||||
"binary-check": "otool -L",
|
||||
"tar": "gtar" // https://github.com/actions/runner-images/issues/2619
|
||||
},
|
||||
{
|
||||
"name": "macOS aarch64",
|
||||
"os": "macos-latest",
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"cross": true,
|
||||
"shell": "bash -euxo pipefail {0}",
|
||||
"CMAKE_OPTIONS": "-DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-apple-darwin.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-apple-darwin.tar.zst",
|
||||
"prepare-llvm": "EXTRA_FLAGS=--target=aarch64-apple-darwin ../script/prepare-llvm-macos.sh lean-llvm-aarch64-* lean-llvm-x86_64-*",
|
||||
"binary-check": "otool -L",
|
||||
"tar": "gtar" // https://github.com/actions/runner-images/issues/2619
|
||||
},
|
||||
{
|
||||
"name": "Windows",
|
||||
"os": "windows-2022",
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"shell": "msys2 {0}",
|
||||
"CMAKE_OPTIONS": "-G \"Unix Makefiles\" -DUSE_GMP=OFF",
|
||||
// for reasons unknown, interactivetests are flaky on Windows
|
||||
"CTEST_OPTIONS": "--repeat until-pass:2",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-w64-windows-gnu.tar.zst",
|
||||
"prepare-llvm": "../script/prepare-llvm-mingw.sh lean-llvm*",
|
||||
"binary-check": "ldd"
|
||||
},
|
||||
{
|
||||
"name": "Linux aarch64",
|
||||
"os": "ubuntu-latest",
|
||||
"CMAKE_OPTIONS": "-DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-linux_aarch64",
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"cross": true,
|
||||
"shell": "nix-shell --arg pkgsDist \"import (fetchTarball \\\"channel:nixos-19.03\\\") {{ localSystem.config = \\\"aarch64-unknown-linux-gnu\\\"; }}\" --run \"bash -euxo pipefail {0}\"",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-linux-gnu.tar.zst",
|
||||
"prepare-llvm": "EXTRA_FLAGS=--target=aarch64-unknown-linux-gnu ../script/prepare-llvm-linux.sh lean-llvm-aarch64-* lean-llvm-x86_64-*"
|
||||
},
|
||||
{
|
||||
"name": "Linux 32bit",
|
||||
"os": "ubuntu-latest",
|
||||
// Use 32bit on stage0 and stage1 to keep oleans compatible
|
||||
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86",
|
||||
"cmultilib": true,
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"cross": true,
|
||||
"shell": "bash -euxo pipefail {0}"
|
||||
},
|
||||
{
|
||||
"name": "Web Assembly",
|
||||
"os": "ubuntu-latest",
|
||||
// Build a native 32bit binary in stage0 and use it to compile the oleans and the wasm build
|
||||
"CMAKE_OPTIONS": "-DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX=\"\" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32",
|
||||
"wasm": true,
|
||||
"cmultilib": true,
|
||||
"release": true,
|
||||
"quick": false,
|
||||
"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\""
|
||||
}
|
||||
];
|
||||
console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
|
||||
if (quick) {
|
||||
return matrix.filter((job) => job.quick)
|
||||
} else {
|
||||
return matrix
|
||||
}
|
||||
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
# don't schedule nightlies on forks
|
||||
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
|
||||
- name: Set Nightly
|
||||
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
|
||||
id: set
|
||||
id: set-nightly
|
||||
run: |
|
||||
if [[ -n '${{ secrets.PUSH_NIGHTLY_TOKEN }}' ]]; then
|
||||
git remote add nightly https://foo:'${{ secrets.PUSH_NIGHTLY_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-nightly.git
|
||||
@@ -39,26 +206,9 @@ jobs:
|
||||
fi
|
||||
fi
|
||||
|
||||
# This job determines if this CI build is for a tagged release.
|
||||
# It only runs when a tag is pushed to the `leanprover` repository.
|
||||
# It sets `set-release.outputs.RELEASE_TAG` to the tag, if the tag is "v" followed by a valid semver,
|
||||
# and sets `set-release.outputs.{LEAN_VERSION_MAJOR,LEAN_VERSION_MINOR,LEAN_VERSION_PATCH,LEAN_SPECIAL_VERSION_DESC}`
|
||||
# to the semver components parsed via regex.
|
||||
set-release:
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
LEAN_VERSION_MAJOR: ${{ steps.set.outputs.LEAN_VERSION_MAJOR }}
|
||||
LEAN_VERSION_MINOR: ${{ steps.set.outputs.LEAN_VERSION_MINOR }}
|
||||
LEAN_VERSION_PATCH: ${{ steps.set.outputs.LEAN_VERSION_PATCH }}
|
||||
LEAN_SPECIAL_VERSION_DESC: ${{ steps.set.outputs.LEAN_SPECIAL_VERSION_DESC }}
|
||||
RELEASE_TAG: ${{ steps.set.outputs.RELEASE_TAG }}
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
if: startsWith(github.ref, 'refs/tags/') && github.repository == 'leanprover/lean4'
|
||||
- name: Check for official release
|
||||
if: startsWith(github.ref, 'refs/tags/') && github.repository == 'leanprover/lean4'
|
||||
id: set
|
||||
id: set-release
|
||||
run: |
|
||||
TAG_NAME=${GITHUB_REF##*/}
|
||||
|
||||
@@ -87,108 +237,17 @@ jobs:
|
||||
fi
|
||||
|
||||
build:
|
||||
needs: [set-nightly, set-release]
|
||||
needs: [configure]
|
||||
if: github.event_name != 'schedule' || github.repository == 'leanprover/lean4'
|
||||
strategy:
|
||||
matrix:
|
||||
include: ${{fromJson(needs.configure.outputs.matrix)}}
|
||||
# complete all jobs
|
||||
fail-fast: false
|
||||
runs-on: ${{ matrix.os }}
|
||||
defaults:
|
||||
run:
|
||||
shell: ${{ matrix.shell || 'nix-shell --run "bash -euxo pipefail {0}"' }}
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
# portable release build: use channel with older glibc (2.27)
|
||||
- name: Linux LLVM
|
||||
os: ubuntu-latest
|
||||
release: false
|
||||
shell: nix-shell --arg pkgsDist "import (fetchTarball \"channel:nixos-19.03\") {{}}" --run "bash -euxo pipefail {0}"
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst
|
||||
prepare-llvm: ../script/prepare-llvm-linux.sh lean-llvm*
|
||||
binary-check: ldd -v
|
||||
# foreign code may be linked against more recent glibc
|
||||
# reverse-ffi needs to be updated to link to LLVM libraries
|
||||
CTEST_OPTIONS: -E 'foreign|leanlaketest_reverse-ffi'
|
||||
CMAKE_OPTIONS: -DLLVM=ON -DLLVM_CONFIG=${GITHUB_WORKSPACE}/build/llvm-host/bin/llvm-config
|
||||
- name: Linux release
|
||||
os: ubuntu-latest
|
||||
release: true
|
||||
shell: nix-shell --arg pkgsDist "import (fetchTarball \"channel:nixos-19.03\") {{}}" --run "bash -euxo pipefail {0}"
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst
|
||||
prepare-llvm: ../script/prepare-llvm-linux.sh lean-llvm*
|
||||
binary-check: ldd -v
|
||||
# foreign code may be linked against more recent glibc
|
||||
CTEST_OPTIONS: -E 'foreign'
|
||||
- name: Linux
|
||||
os: ubuntu-latest
|
||||
check-stage3: true
|
||||
test-speedcenter: true
|
||||
- name: Linux Debug
|
||||
os: ubuntu-latest
|
||||
CMAKE_OPTIONS: -DCMAKE_BUILD_TYPE=Debug
|
||||
# exclude seriously slow tests
|
||||
CTEST_OPTIONS: -E 'interactivetest|leanpkgtest|laketest|benchtest'
|
||||
- name: Linux fsanitize
|
||||
os: ubuntu-latest
|
||||
# turn off custom allocator & symbolic functions to make LSAN do its magic
|
||||
CMAKE_OPTIONS: -DLEAN_EXTRA_CXX_FLAGS=-fsanitize=address,undefined -DLEANC_EXTRA_FLAGS='-fsanitize=address,undefined -fsanitize-link-c++-runtime' -DSMALL_ALLOCATOR=OFF -DBSYMBOLIC=OFF
|
||||
# exclude seriously slow/problematic tests (laketests crash)
|
||||
CTEST_OPTIONS: -E 'interactivetest|leanpkgtest|laketest|benchtest'
|
||||
- name: macOS
|
||||
os: macos-latest
|
||||
release: true
|
||||
shell: bash -euxo pipefail {0}
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-apple-darwin.tar.zst
|
||||
prepare-llvm: ../script/prepare-llvm-macos.sh lean-llvm*
|
||||
binary-check: otool -L
|
||||
tar: gtar # https://github.com/actions/runner-images/issues/2619
|
||||
- name: macOS aarch64
|
||||
os: macos-latest
|
||||
release: true
|
||||
cross: true
|
||||
shell: bash -euxo pipefail {0}
|
||||
CMAKE_OPTIONS: -DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-darwin_aarch64
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-apple-darwin.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-apple-darwin.tar.zst
|
||||
prepare-llvm: EXTRA_FLAGS=--target=aarch64-apple-darwin ../script/prepare-llvm-macos.sh lean-llvm-aarch64-* lean-llvm-x86_64-*
|
||||
binary-check: otool -L
|
||||
tar: gtar # https://github.com/actions/runner-images/issues/2619
|
||||
- name: Windows
|
||||
os: windows-2022
|
||||
release: true
|
||||
shell: msys2 {0}
|
||||
CMAKE_OPTIONS: -G "Unix Makefiles" -DUSE_GMP=OFF
|
||||
# for reasons unknown, interactivetests are flaky on Windows
|
||||
CTEST_OPTIONS: --repeat until-pass:2
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-w64-windows-gnu.tar.zst
|
||||
prepare-llvm: ../script/prepare-llvm-mingw.sh lean-llvm*
|
||||
binary-check: ldd
|
||||
- name: Linux aarch64
|
||||
os: ubuntu-latest
|
||||
CMAKE_OPTIONS: -DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-linux_aarch64
|
||||
release: true
|
||||
cross: true
|
||||
shell: nix-shell --arg pkgsDist "import (fetchTarball \"channel:nixos-19.03\") {{ localSystem.config = \"aarch64-unknown-linux-gnu\"; }}" --run "bash -euxo pipefail {0}"
|
||||
llvm-url: https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-linux-gnu.tar.zst
|
||||
prepare-llvm: EXTRA_FLAGS=--target=aarch64-unknown-linux-gnu ../script/prepare-llvm-linux.sh lean-llvm-aarch64-* lean-llvm-x86_64-*
|
||||
- name: Linux 32bit
|
||||
os: ubuntu-latest
|
||||
# Use 32bit on stage0 and stage1 to keep oleans compatible
|
||||
CMAKE_OPTIONS: -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86
|
||||
cmultilib: true
|
||||
release: true
|
||||
cross: true
|
||||
shell: bash -euxo pipefail {0}
|
||||
- name: Web Assembly
|
||||
os: ubuntu-latest
|
||||
# Build a native 32bit binary in stage0 and use it to compile the oleans and the wasm build
|
||||
CMAKE_OPTIONS: -DCMAKE_C_COMPILER_WORKS=1 -DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_CMAKE_CXX_COMPILER=clang++ -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_EXECUTABLE_SUFFIX="" -DUSE_GMP=OFF -DMMAP=OFF -DSTAGE0_MMAP=OFF -DCMAKE_AR=../emsdk/emsdk-main/upstream/emscripten/emar -DCMAKE_TOOLCHAIN_FILE=../emsdk/emsdk-main/upstream/emscripten/cmake/Modules/Platform/Emscripten.cmake -DLEAN_INSTALL_SUFFIX=-linux_wasm32
|
||||
wasm: true
|
||||
cmultilib: true
|
||||
release: true
|
||||
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"
|
||||
# complete all jobs
|
||||
fail-fast: false
|
||||
name: ${{ matrix.name }}
|
||||
env:
|
||||
# must be inside workspace
|
||||
@@ -260,21 +319,23 @@ jobs:
|
||||
mkdir build
|
||||
cd build
|
||||
ulimit -c unlimited # coredumps
|
||||
OPTIONS=()
|
||||
# this also enables githash embedding into stage 1 library
|
||||
OPTIONS=(-DCHECK_OLEAN_VERSION=ON)
|
||||
OPTIONS+=(-DLEAN_EXTRA_MAKE_OPTS=-DwarningAsError=true)
|
||||
if [[ -n '${{ matrix.prepare-llvm }}' ]]; then
|
||||
wget -q ${{ matrix.llvm-url }}
|
||||
PREPARE="$(${{ matrix.prepare-llvm }})"
|
||||
eval "OPTIONS+=($PREPARE)"
|
||||
fi
|
||||
if [[ -n '${{ matrix.release }}' && -n '${{ needs.set-nightly.outputs.nightly }}' ]]; then
|
||||
OPTIONS+=(-DLEAN_SPECIAL_VERSION_DESC=${{ needs.set-nightly.outputs.nightly }})
|
||||
if [[ -n '${{ matrix.release }}' && -n '${{ needs.configure.outputs.nightly }}' ]]; then
|
||||
OPTIONS+=(-DLEAN_SPECIAL_VERSION_DESC=${{ needs.configure.outputs.nightly }})
|
||||
fi
|
||||
if [[ -n '${{ matrix.release }}' && -n '${{ needs.set-release.outputs.RELEASE_TAG }}' ]]; then
|
||||
OPTIONS+=(-DLEAN_VERSION_MAJOR=${{ needs.set-release.outputs.LEAN_VERSION_MAJOR }})
|
||||
OPTIONS+=(-DLEAN_VERSION_MINOR=${{ needs.set-release.outputs.LEAN_VERSION_MINOR }})
|
||||
OPTIONS+=(-DLEAN_VERSION_PATCH=${{ needs.set-release.outputs.LEAN_VERSION_PATCH }})
|
||||
if [[ -n '${{ matrix.release }}' && -n '${{ needs.configure.outputs.RELEASE_TAG }}' ]]; then
|
||||
OPTIONS+=(-DLEAN_VERSION_MAJOR=${{ needs.configure.outputs.LEAN_VERSION_MAJOR }})
|
||||
OPTIONS+=(-DLEAN_VERSION_MINOR=${{ needs.configure.outputs.LEAN_VERSION_MINOR }})
|
||||
OPTIONS+=(-DLEAN_VERSION_PATCH=${{ needs.configure.outputs.LEAN_VERSION_PATCH }})
|
||||
OPTIONS+=(-DLEAN_VERSION_IS_RELEASE=1)
|
||||
OPTIONS+=(-DLEAN_SPECIAL_VERSION_DESC=${{ needs.set-release.outputs.LEAN_SPECIAL_VERSION_DESC }})
|
||||
OPTIONS+=(-DLEAN_SPECIAL_VERSION_DESC=${{ needs.configure.outputs.LEAN_SPECIAL_VERSION_DESC }})
|
||||
fi
|
||||
# contortion to support empty OPTIONS with old macOS bash
|
||||
cmake .. ${{ matrix.CMAKE_OPTIONS }} ${OPTIONS[@]+"${OPTIONS[@]}"} -DLEAN_INSTALL_PREFIX=$PWD/..
|
||||
@@ -285,13 +346,13 @@ jobs:
|
||||
- name: List Install Tree
|
||||
run: |
|
||||
# omit contents of Init/, ...
|
||||
tree --du -h lean-* | grep -E ' (Init|Lean|Lake|LICENSE|[a-z])'
|
||||
tree --du -h lean-*-* | grep -E ' (Init|Lean|Lake|LICENSE|[a-z])'
|
||||
- name: Pack
|
||||
run: |
|
||||
dir=$(echo lean-*)
|
||||
dir=$(echo lean-*-*)
|
||||
mkdir pack
|
||||
# high-compression tar.zst + zip for release, fast tar.zst otherwise
|
||||
if [[ '${{ startsWith(github.ref, 'refs/tags/') && matrix.release }}' == true || -n '${{ needs.set-nightly.outputs.nightly }}' || -n '${{ needs.set-release.outputs.RELEASE_TAG }}' ]]; then
|
||||
if [[ '${{ startsWith(github.ref, 'refs/tags/') && matrix.release }}' == true || -n '${{ needs.configure.outputs.nightly }}' || -n '${{ needs.configure.outputs.RELEASE_TAG }}' ]]; then
|
||||
${{ matrix.tar || 'tar' }} cf - $dir | zstd -T0 --no-progress -19 -o pack/$dir.tar.zst
|
||||
zip -rq pack/$dir.zip $dir
|
||||
else
|
||||
@@ -312,22 +373,22 @@ jobs:
|
||||
ulimit -c unlimited # coredumps
|
||||
# exclude nonreproducible test
|
||||
ctest -j4 --output-on-failure ${{ matrix.CTEST_OPTIONS }} < /dev/null
|
||||
if: matrix.wasm || !matrix.cross
|
||||
if: (matrix.wasm || !matrix.cross) && needs.configure.outputs.quick == 'false'
|
||||
- name: Check Test Binary
|
||||
run: ${{ matrix.binary-check }} tests/compiler/534.lean.out
|
||||
if: ${{ !matrix.cross }}
|
||||
if: ${{ !matrix.cross && needs.configure.outputs.quick == 'false' }}
|
||||
- name: Build Stage 2
|
||||
run: |
|
||||
cd build
|
||||
ulimit -c unlimited # coredumps
|
||||
make -j4 stage2
|
||||
if: matrix.build-stage2 || matrix.check-stage3
|
||||
if: matrix.test-speedcenter
|
||||
- name: Check Stage 3
|
||||
run: |
|
||||
cd build
|
||||
ulimit -c unlimited # coredumps
|
||||
make -j4 check-stage3
|
||||
if: matrix.check-stage3
|
||||
if: matrix.test-speedcenter
|
||||
- name: Test Speedcenter Benchmarks
|
||||
run: |
|
||||
echo -1 | sudo tee /proc/sys/kernel/perf_event_paranoid
|
||||
@@ -340,7 +401,7 @@ jobs:
|
||||
cd build
|
||||
ulimit -c unlimited # coredumps
|
||||
make update-stage0 && make -j4
|
||||
if: matrix.name == 'Linux'
|
||||
if: matrix.name == 'Linux' && needs.configure.outputs.quick == 'false'
|
||||
- name: CCache stats
|
||||
run: ccache -s
|
||||
- name: Show stacktrace for coredumps
|
||||
@@ -364,6 +425,21 @@ jobs:
|
||||
./build/stage2/bin/lean
|
||||
./build/stage2/lib/lean/libleanshared.so
|
||||
|
||||
# This job collects results from all the matrix jobs
|
||||
# This can be made the “required” job, instead of listing each
|
||||
# matrix job separately
|
||||
all-done:
|
||||
name: Build matrix complete
|
||||
runs-on: ubuntu-latest
|
||||
needs: build
|
||||
if: ${{ always() }}
|
||||
steps:
|
||||
- if: contains(needs.*.result, 'failure') || contains(needs.*.result, 'cancelled')
|
||||
uses: actions/github-script@v7
|
||||
with:
|
||||
script: |
|
||||
core.setFailed('Some jobs failed')
|
||||
|
||||
# This job creates releases from tags
|
||||
# (whether they are "unofficial" releases for experiments, or official releases when the tag is "v" followed by a semver string.)
|
||||
# We do not attempt to automatically construct a changelog here:
|
||||
@@ -387,8 +463,8 @@ jobs:
|
||||
# This job creates nightly releases during the cron job.
|
||||
# It is responsible for creating the tag, and automatically generating a changelog.
|
||||
release-nightly:
|
||||
needs: [set-nightly, build]
|
||||
if: needs.set-nightly.outputs.nightly
|
||||
needs: [configure, build]
|
||||
if: needs.configure.outputs.nightly
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
@@ -404,9 +480,9 @@ jobs:
|
||||
run: |
|
||||
git remote add nightly https://foo:'${{ secrets.PUSH_NIGHTLY_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-nightly.git
|
||||
git fetch nightly --tags
|
||||
git tag ${{ needs.set-nightly.outputs.nightly }}
|
||||
git push nightly ${{ needs.set-nightly.outputs.nightly }}
|
||||
git push -f origin refs/tags/${{ needs.set-nightly.outputs.nightly }}:refs/heads/nightly
|
||||
git tag ${{ needs.configure.outputs.nightly }}
|
||||
git push nightly ${{ needs.configure.outputs.nightly }}
|
||||
git push -f origin refs/tags/${{ needs.configure.outputs.nightly }}:refs/heads/nightly
|
||||
last_tag=$(git log HEAD^ --simplify-by-decoration --pretty="format:%d" | grep -o "nightly-[-0-9]*" | head -n 1)
|
||||
echo -e "*Changes since ${last_tag}:*\n\n" > diff.md
|
||||
git show $last_tag:RELEASES.md > old.md
|
||||
@@ -421,7 +497,7 @@ jobs:
|
||||
prerelease: true
|
||||
files: artifacts/*/*
|
||||
fail_on_unmatched_files: true
|
||||
tag_name: ${{ needs.set-nightly.outputs.nightly }}
|
||||
tag_name: ${{ needs.configure.outputs.nightly }}
|
||||
repository: ${{ github.repository_owner }}/lean4-nightly
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
|
||||
|
||||
2
.github/workflows/labels-from-comments.yml
vendored
2
.github/workflows/labels-from-comments.yml
vendored
@@ -15,7 +15,7 @@ jobs:
|
||||
|
||||
steps:
|
||||
- name: Add label based on comment
|
||||
uses: actions/github-script@v6
|
||||
uses: actions/github-script@v7
|
||||
with:
|
||||
github-token: ${{ secrets.GITHUB_TOKEN }}
|
||||
script: |
|
||||
|
||||
23
.github/workflows/nix-ci.yml
vendored
23
.github/workflows/nix-ci.yml
vendored
@@ -6,8 +6,7 @@ on:
|
||||
tags:
|
||||
- '*'
|
||||
pull_request:
|
||||
branches:
|
||||
- master
|
||||
merge_group:
|
||||
|
||||
concurrency:
|
||||
group: ${{ github.workflow }}-${{ github.ref }}
|
||||
@@ -18,7 +17,7 @@ jobs:
|
||||
runs-on: ${{ matrix.os }}
|
||||
defaults:
|
||||
run:
|
||||
shell: nix -v --experimental-features "nix-command flakes" run .#ciShell -- bash -euxo pipefail {0}
|
||||
shell: nix run .#ciShell -- bash -euxo pipefail {0}
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
@@ -30,21 +29,13 @@ jobs:
|
||||
fail-fast: false
|
||||
name: ${{ matrix.name }}
|
||||
env:
|
||||
NIX_BUILD_ARGS: -v --print-build-logs --fallback
|
||||
NIX_BUILD_ARGS: --print-build-logs --fallback
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
# the default is to use a virtual merge commit between the PR and master: just use the PR
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
- name: Install Nix
|
||||
uses: cachix/install-nix-action@v18
|
||||
with:
|
||||
# https://github.com/NixOS/nix/issues/6572
|
||||
install_url: https://releases.nixos.org/nix/nix-2.7.0/install
|
||||
extra_nix_config: |
|
||||
extra-sandbox-paths = /nix/var/cache/ccache
|
||||
substituters = file://${{ github.workspace }}/nix-store-cache-copy?priority=10&trusted=true https://cache.nixos.org
|
||||
- name: Set Up Nix Cache
|
||||
uses: actions/cache@v3
|
||||
with:
|
||||
@@ -58,8 +49,13 @@ jobs:
|
||||
run: |
|
||||
# Nix seems to mutate the cache, so make a copy
|
||||
cp -r nix-store-cache nix-store-cache-copy || true
|
||||
- name: Install Nix
|
||||
uses: DeterminateSystems/nix-installer-action@main
|
||||
with:
|
||||
extra-conf: |
|
||||
extra-sandbox-paths = /nix/var/cache/ccache?
|
||||
substituters = file://${{ github.workspace }}/nix-store-cache-copy?priority=10&trusted=true https://cache.nixos.org
|
||||
- name: Prepare CCache Cache
|
||||
shell: bash -euxo pipefail {0}
|
||||
run: |
|
||||
sudo mkdir -m0770 -p /nix/var/cache/ccache
|
||||
sudo chown -R $USER /nix/var/cache/ccache
|
||||
@@ -72,7 +68,6 @@ jobs:
|
||||
restore-keys: |
|
||||
${{ matrix.name }}-nix-ccache
|
||||
- name: Further Set Up CCache Cache
|
||||
shell: bash -euxo pipefail {0}
|
||||
run: |
|
||||
sudo chown -R root:nixbld /nix/var/cache
|
||||
sudo chmod -R 770 /nix/var/cache
|
||||
|
||||
57
.github/workflows/pr-release.yml
vendored
57
.github/workflows/pr-release.yml
vendored
@@ -16,27 +16,16 @@ on:
|
||||
jobs:
|
||||
on-success:
|
||||
runs-on: ubuntu-latest
|
||||
if: github.event.workflow_run.conclusion == 'success' && github.repository == 'leanprover/lean4'
|
||||
if: github.event.workflow_run.conclusion == 'success' && github.event.workflow_run.event == 'pull_request' && github.repository == 'leanprover/lean4'
|
||||
steps:
|
||||
- name: Retrieve information about the original workflow
|
||||
uses: potiuk/get-workflow-origin@v1_1 # https://github.com/marketplace/actions/get-workflow-origin
|
||||
# This action is deprecated and archived, but it seems hard to find a better solution for getting the PR number
|
||||
# see https://github.com/orgs/community/discussions/25220 for some discussion
|
||||
id: workflow-info
|
||||
with:
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
sourceRunId: ${{ github.event.workflow_run.id }}
|
||||
- name: Checkout
|
||||
# Only proceed if the previous workflow had a pull request number.
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
token: ${{ secrets.PR_RELEASES_TOKEN }}
|
||||
# Since `workflow_run` runs on master, we need to specify which commit to check out,
|
||||
# so that we tag the PR.
|
||||
# It's important that we use `sourceHeadSha` here, not `targetCommitSha`
|
||||
# as we *don't* want the synthetic merge with master.
|
||||
ref: ${{ steps.workflow-info.outputs.sourceHeadSha }}
|
||||
# We need a full checkout, so that we can push the PR commits to the `lean4-pr-releases` repo.
|
||||
fetch-depth: 0
|
||||
|
||||
- name: Download artifact from the previous workflow.
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
@@ -47,14 +36,22 @@ jobs:
|
||||
path: artifacts
|
||||
name: build-.*
|
||||
name_is_regexp: true
|
||||
- name: Prepare release
|
||||
|
||||
- name: Push branch and tag
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
run: |
|
||||
git init --bare lean4.git
|
||||
git -C lean4.git remote add origin https://github.com/${{ github.repository_owner }}/lean4.git
|
||||
git -C lean4.git fetch -n origin master
|
||||
git -C lean4.git fetch -n origin "${{ steps.workflow-info.outputs.sourceHeadSha }}"
|
||||
git -C lean4.git tag -f pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }} "${{ steps.workflow-info.outputs.sourceHeadSha }}"
|
||||
git -C lean4.git remote add pr-releases https://foo:'${{ secrets.PR_RELEASES_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-pr-releases.git
|
||||
git -C lean4.git push -f pr-releases pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}
|
||||
- name: Delete existing release if present
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
run: |
|
||||
git remote add pr-releases https://foo:'${{ secrets.PR_RELEASES_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-pr-releases.git
|
||||
# Try to delete any existing release for the current PR.
|
||||
gh release delete --repo ${{ github.repository_owner }}/lean4-pr-releases pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }} -y || true
|
||||
git tag -f pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}
|
||||
git push -f pr-releases pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}
|
||||
env:
|
||||
GH_TOKEN: ${{ secrets.PR_RELEASES_TOKEN }}
|
||||
- name: Release
|
||||
@@ -74,18 +71,22 @@ jobs:
|
||||
|
||||
- name: Add label
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
uses: actions-ecosystem/action-add-labels@v1
|
||||
uses: actions/github-script@v7
|
||||
with:
|
||||
number: ${{ steps.workflow-info.outputs.pullRequestNumber }}
|
||||
labels: toolchain-available
|
||||
script: |
|
||||
await github.rest.issues.addLabels({
|
||||
issue_number: ${{ steps.workflow-info.outputs.pullRequestNumber }},
|
||||
owner: context.repo.owner,
|
||||
repo: context.repo.repo,
|
||||
labels: ['toolchain-available']
|
||||
})
|
||||
|
||||
# Next, determine the most recent nightly release in this PR's history.
|
||||
- name: Find most recent nightly
|
||||
id: most-recent-nightly-tag
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
run: |
|
||||
git remote add nightly https://foo:'${{ secrets.PUSH_NIGHTLY_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-nightly.git
|
||||
echo "MOST_RECENT_NIGHTLY=$(script/most-recent-nightly-tag.sh)" >> $GITHUB_ENV
|
||||
git ls-remote https://github.com/leanprover/lean4-nightly.git 'refs/tags/nightly-*' --sort version:refname |tail -n1| sed 's,.*refs/tags/nightly-,MOST_RECENT_NIGHTLY=,' >> $GITHUB_ENV
|
||||
|
||||
- name: 'Setup jq'
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
@@ -97,9 +98,9 @@ jobs:
|
||||
id: ready
|
||||
run: |
|
||||
echo "Most recent nightly: $MOST_RECENT_NIGHTLY"
|
||||
NIGHTLY_SHA=$(git rev-parse nightly-$MOST_RECENT_NIGHTLY^{commit})
|
||||
NIGHTLY_SHA=$(git ls-remote https://github.com/leanprover/lean4-nightly.git "nightly-$MOST_RECENT_NIGHTLY"|cut -f1)
|
||||
echo "SHA of most recent nightly: $NIGHTLY_SHA"
|
||||
MERGE_BASE_SHA=$(git merge-base origin/master HEAD)
|
||||
MERGE_BASE_SHA=$(git -C lean4.git merge-base origin/master "${{ steps.workflow-info.outputs.sourceHeadSha }}")
|
||||
echo "SHA of merge-base: $MERGE_BASE_SHA"
|
||||
if [ "$NIGHTLY_SHA" = "$MERGE_BASE_SHA" ]; then
|
||||
echo "Most recent nightly tag agrees with the merge base."
|
||||
@@ -117,7 +118,7 @@ jobs:
|
||||
else
|
||||
echo "The most recently nightly tag on this branch has SHA: $NIGHTLY_SHA"
|
||||
echo "but 'git merge-base origin/master HEAD' reported: $MERGE_BASE_SHA"
|
||||
git log -10
|
||||
git -C lean4.git log -10 origin/master
|
||||
|
||||
MESSAGE="- ❗ Mathlib CI will not be attempted unless you rebase your PR onto the 'nightly' branch."
|
||||
fi
|
||||
@@ -163,9 +164,9 @@ jobs:
|
||||
else
|
||||
echo "The message already exists in the comment body."
|
||||
fi
|
||||
echo "::set-output name=mathlib_ready::false"
|
||||
echo "mathlib_ready=false" >> $GITHUB_OUTPUT
|
||||
else
|
||||
echo "::set-output name=mathlib_ready::true"
|
||||
echo "mathlib_ready=true" >> $GITHUB_OUTPUT
|
||||
fi
|
||||
|
||||
# We next automatically create a Mathlib branch using this toolchain.
|
||||
|
||||
20
.github/workflows/pr-title.yml
vendored
Normal file
20
.github/workflows/pr-title.yml
vendored
Normal file
@@ -0,0 +1,20 @@
|
||||
name: Check PR title for commit convention
|
||||
|
||||
on:
|
||||
merge_group:
|
||||
pull_request:
|
||||
types: [opened, synchronize, reopened, edited]
|
||||
|
||||
jobs:
|
||||
check-pr-title:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Check PR title
|
||||
uses: actions/github-script@v7
|
||||
with:
|
||||
script: |
|
||||
const msg = context.payload.pull_request? context.payload.pull_request.title : context.payload.merge_group.head_commit.message;
|
||||
console.log(`Message: ${msg}`)
|
||||
if (!/^(feat|fix|doc|style|refactor|test|chore|perf): .*[^.]($|\n\n)/.test(msg)) {
|
||||
core.setFailed('PR title does not follow the Commit Convention (https://leanprover.github.io/lean4/doc/dev/commit_convention.html).');
|
||||
}
|
||||
31
.github/workflows/pr.yml
vendored
31
.github/workflows/pr.yml
vendored
@@ -1,31 +0,0 @@
|
||||
name: sanity-check opened PRs
|
||||
|
||||
on:
|
||||
# needs read/write GH token, do *not* execute arbitrary code from PR
|
||||
pull_request_target:
|
||||
types: [opened]
|
||||
|
||||
jobs:
|
||||
check-pr:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Check Commit Message
|
||||
uses: actions/github-script@v6
|
||||
with:
|
||||
github-token: ${{ secrets.GITHUB_TOKEN }}
|
||||
script: |
|
||||
const { data: commits } = await github.rest.pulls.listCommits({
|
||||
owner: context.repo.owner,
|
||||
repo: context.repo.repo,
|
||||
pull_number: context.issue.number,
|
||||
});
|
||||
console.log(commits[0].commit.message);
|
||||
// check first commit only (and only once) since later commits might be intended to be squashed away
|
||||
if (!/^(feat|fix|doc|style|refactor|test|chore|perf): .*[^.]($|\n\n)/.test(commits[0].commit.message)) {
|
||||
await github.rest.issues.createComment({
|
||||
owner: context.repo.owner,
|
||||
repo: context.repo.repo,
|
||||
issue_number: context.issue.number,
|
||||
body: 'Thanks for your contribution! Please make sure to follow our [Commit Convention](https://leanprover.github.io/lean4/doc/dev/commit_convention.html).',
|
||||
});
|
||||
}
|
||||
64
.github/workflows/update-stage0.yml
vendored
Normal file
64
.github/workflows/update-stage0.yml
vendored
Normal file
@@ -0,0 +1,64 @@
|
||||
name: Update stage0
|
||||
|
||||
# This action will update stage0 on master as soon as
|
||||
# src/stdlib_flags.h and stage0/src/stdlib_flags.h
|
||||
# are out of sync there, or when manually triggered.
|
||||
# The update bypasses the merge queue to be quick.
|
||||
# Also see <doc/dev/bootstrap.md>.
|
||||
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- 'master'
|
||||
workflow_dispatch:
|
||||
|
||||
concurrency:
|
||||
group: stage0
|
||||
cancel-in-progress: true
|
||||
|
||||
jobs:
|
||||
update-stage0:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
# This action should push to an otherwise protected branch, so it
|
||||
# uses a deploy key with write permissions, as suggested at
|
||||
# https://stackoverflow.com/a/76135647/946226
|
||||
- uses: actions/checkout@v3
|
||||
with:
|
||||
ssh-key: ${{secrets.STAGE0_SSH_KEY}}
|
||||
- run: echo "should_update_stage0=yes" >> "$GITHUB_ENV"
|
||||
- name: Check if automatic update is needed
|
||||
if: github.event_name == 'push'
|
||||
run: |
|
||||
if diff -u src/stdlib_flags.h stage0/src/stdlib_flags.h
|
||||
then
|
||||
echo "src/stdlib_flags.h and stage0/src/stdlib_flags.h agree, nothing to do"
|
||||
echo "should_update_stage0=no" >> "$GITHUB_ENV"
|
||||
fi
|
||||
- name: Setup git user
|
||||
if: env.should_update_stage0 == 'yes'
|
||||
run: |
|
||||
git config --global user.name "Lean stage0 autoupdater"
|
||||
git config --global user.email "<>"
|
||||
- if: env.should_update_stage0 == 'yes'
|
||||
uses: DeterminateSystems/nix-installer-action@main
|
||||
# Would be nice, but does not work yet:
|
||||
# https://github.com/DeterminateSystems/magic-nix-cache/issues/39
|
||||
# This action does not run that often and building runs in a few minutes, so ok for now
|
||||
#- if: env.should_update_stage0 == 'yes'
|
||||
# uses: DeterminateSystems/magic-nix-cache-action@v2
|
||||
- if: env.should_update_stage0 == 'yes'
|
||||
name: Install Cachix
|
||||
uses: cachix/cachix-action@v12
|
||||
with:
|
||||
name: lean4
|
||||
- if: env.should_update_stage0 == 'yes'
|
||||
run: nix run .#update-stage0-commit
|
||||
- if: env.should_update_stage0 == 'yes'
|
||||
run: git show --stat
|
||||
- if: env.should_update_stage0 == 'yes' && github.event_name == 'push'
|
||||
name: Sanity check # to avoid loops
|
||||
run: |
|
||||
diff -u src/stdlib_flags.h stage0/src/stdlib_flags.h || exit 1
|
||||
- if: env.should_update_stage0 == 'yes'
|
||||
run: git push origin
|
||||
7
.vscode/settings.json
vendored
7
.vscode/settings.json
vendored
@@ -1,7 +0,0 @@
|
||||
{
|
||||
"files.insertFinalNewline": true,
|
||||
"files.trimTrailingWhitespace": true,
|
||||
"[markdown]": {
|
||||
"rewrap.wrappingColumn": 70
|
||||
}
|
||||
}
|
||||
@@ -11,7 +11,7 @@ foreach(var ${vars})
|
||||
list(APPEND STAGE0_ARGS "-D${CMAKE_MATCH_1}=${${var}}")
|
||||
elseif("${currentHelpString}" MATCHES "No help, variable specified on the command line." OR "${currentHelpString}" STREQUAL "")
|
||||
list(APPEND CL_ARGS "-D${var}=${${var}}")
|
||||
if("${var}" STREQUAL "USE_GMP")
|
||||
if("${var}" MATCHES "USE_GMP|CHECK_OLEAN_VERSION")
|
||||
# must forward options that generate incompatible .olean format
|
||||
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
|
||||
endif()
|
||||
@@ -35,6 +35,8 @@ ExternalProject_add(stage0
|
||||
SOURCE_SUBDIR src
|
||||
BINARY_DIR stage0
|
||||
# do not rebuild stage0 when git hash changes; it's not from this commit anyway
|
||||
# (however, `CHECK_OLEAN_VERSION=ON` in CI will override this as we need to
|
||||
# embed the githash into the stage 1 library built by stage 0)
|
||||
CMAKE_ARGS -DSTAGE=0 -DUSE_GITHASH=OFF ${PLATFORM_ARGS} ${STAGE0_ARGS}
|
||||
BUILD_ALWAYS ON # cmake doesn't auto-detect changes without a download method
|
||||
INSTALL_COMMAND "" # skip install
|
||||
|
||||
@@ -12,9 +12,11 @@
|
||||
/src/lake/ @tydeu
|
||||
/src/Lean/Compiler/ @leodemoura
|
||||
/src/Lean/Data/Lsp/ @mhuisi
|
||||
/src/Lean/Elab/Deriving/ @semorrison
|
||||
/src/Lean/Elab/Tactic/ @semorrison
|
||||
/src/Lean/Meta/Tactic/ @leodemoura
|
||||
/src/Lean/Parser/ @Kha
|
||||
/src/Lean/PrettyPrinter/ @Kha
|
||||
/src/Lean/Server/ @mhuisi
|
||||
/src/Lean/Widget/ @Vtec234
|
||||
/src/runtime/io.cpp @joehendrix
|
||||
|
||||
@@ -52,6 +52,10 @@ PR Submission:
|
||||
|
||||
**Descriptive Title and Summary**: The PR title should briefly explain the purpose of the PR. The summary should give more detailed information on what changes are made and why. Links to Zulip threads are not acceptable as a summary. You are responsible for summarizing the discussion, and getting support for it.
|
||||
|
||||
**Follow the commit convention**: Pull requests are squash merged, and the
|
||||
commit message is taken from the pull request title and body, so make sure they adhere to the [commit convention](https://github.com/leanprover/lean4/blob/master/doc/dev/commit_convention.md). Put questions and extra information, which should not be part of the final commit message, into a first comment rather than the Pull Request description.
|
||||
Because the change will be squashed, there is no need to polish the commit messages and history on the branch.
|
||||
|
||||
**Link to Relevant Issues**: Reference any issues that your PR addresses to provide context.
|
||||
|
||||
**Stay Responsive**: Once the PR is submitted, stay responsive to feedback and be prepared to make necessary revisions. We will close any PR that has been inactive (no response or updates from the submitter) for more than a month.
|
||||
|
||||
71
RELEASES.md
71
RELEASES.md
@@ -8,11 +8,80 @@ This file contains work-in-progress notes for the upcoming release, as well as p
|
||||
Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
|
||||
of each version.
|
||||
|
||||
v4.4.0 (development in progress)
|
||||
v4.5.0 (development in progress)
|
||||
---------
|
||||
|
||||
* Modify the lexical syntax of string literals to have string gaps, which are escape sequences of the form `"\" newline whitespace*`.
|
||||
These have the interpetation of an empty string and allow a string to flow across multiple lines without introducing additional whitespace.
|
||||
The following is equivalent to `"this is a string"`.
|
||||
```lean
|
||||
"this is \
|
||||
a string"
|
||||
```
|
||||
[PR #2821](https://github.com/leanprover/lean4/pull/2821) and [RFC #2838](https://github.com/leanprover/lean4/issues/2838).
|
||||
|
||||
* The low-level `termination_by'` clause is no longer supported.
|
||||
|
||||
Migration guide: Use `termination_by` instead, e.g.:
|
||||
```diff
|
||||
-termination_by' measure (fun ⟨i, _⟩ => as.size - i)
|
||||
+termination_by go i _ => as.size - i
|
||||
```
|
||||
|
||||
If the well-founded relation you want to use is not the one that the
|
||||
`WellFoundedRelation` type class would infer for your termination argument,
|
||||
you can use `WellFounded.wrap` from the std libarary to explicitly give one:
|
||||
```diff
|
||||
-termination_by' ⟨r, hwf⟩
|
||||
+termination_by _ x => hwf.wrap x
|
||||
```
|
||||
|
||||
v4.4.0
|
||||
---------
|
||||
|
||||
* Lake and the language server now support per-package server options using the `moreServerOptions` config field, as well as options that apply to both the language server and `lean` using the `leanOptions` config field. Setting either of these fields instead of `moreServerArgs` ensures that viewing files from a dependency uses the options for that dependency. Additionally, `moreServerArgs` is being deprecated in favor of the `moreGlobalServerArgs` field. See PR [#2858](https://github.com/leanprover/lean4/pull/2858).
|
||||
|
||||
A Lakefile with the following deprecated package declaration:
|
||||
```lean
|
||||
def moreServerArgs := #[
|
||||
"-Dpp.unicode.fun=true"
|
||||
]
|
||||
def moreLeanArgs := moreServerArgs
|
||||
|
||||
package SomePackage where
|
||||
moreServerArgs := moreServerArgs
|
||||
moreLeanArgs := moreLeanArgs
|
||||
```
|
||||
|
||||
... can be updated to the following package declaration to use per-package options:
|
||||
```lean
|
||||
package SomePackage where
|
||||
leanOptions := #[⟨`pp.unicode.fun, true⟩]
|
||||
```
|
||||
* [Rename request handler](https://github.com/leanprover/lean4/pull/2462).
|
||||
* [Import auto-completion](https://github.com/leanprover/lean4/pull/2904).
|
||||
* [`pp.beta`` to apply beta reduction when pretty printing](https://github.com/leanprover/lean4/pull/2864).
|
||||
* [Embed and check githash in .olean](https://github.com/leanprover/lean4/pull/2766).
|
||||
* [Guess lexicographic order for well-founded recursion](https://github.com/leanprover/lean4/pull/2874).
|
||||
* [Allow trailing comma in tuples, lists, and tactics](https://github.com/leanprover/lean4/pull/2643).
|
||||
|
||||
Bug fixes for [#2628](https://github.com/leanprover/lean4/issues/2628), [#2883](https://github.com/leanprover/lean4/issues/2883),
|
||||
[#2810](https://github.com/leanprover/lean4/issues/2810), [#2925](https://github.com/leanprover/lean4/issues/2925), and [#2914](https://github.com/leanprover/lean4/issues/2914).
|
||||
|
||||
**Lake:**
|
||||
|
||||
* `lake init .` and a bare `lake init` and will now use the current directory as the package name. [#2890](https://github.com/leanprover/lean4/pull/2890)
|
||||
* `lake new` and `lake init` will now produce errors on invalid package names such as `..`, `foo/bar`, `Init`, `Lean`, `Lake`, and `Main`. See issue [#2637](https://github.com/leanprover/lean4/issues/2637) and PR [#2890](https://github.com/leanprover/lean4/pull/2890).
|
||||
* `lean_lib` no longer converts its name to upper camel case (e.g., `lean_lib bar` will include modules named `bar.*` rather than `Bar.*`). See issue [#2567](https://github.com/leanprover/lean4/issues/2567) and PR [#2889](https://github.com/leanprover/lean4/pull/2889).
|
||||
* Lean and Lake now properly support non-identifier library names (e.g., `lake new 123-hello` and `import «123Hello»` now work correctly). See issue [#2865](https://github.com/leanprover/lean4/issues/2865) and PR [#2889](https://github.com/leanprover/lean4/pull/2888).
|
||||
* Lake now filters the environment extensions loaded from a compiled configuration (`lakefile.olean`) to include only those relevant to Lake's workspace loading process. This resolves segmentation faults caused by environment extension type mismatches (e.g., when defining custom elaborators via `elab` in configurations). See issue [#2632](https://github.com/leanprover/lean4/issues/2632) and PR [#2896](https://github.com/leanprover/lean4/pull/2896).
|
||||
* Cloud releases will now properly be re-unpacked if the build directory is removed. See PR [#2928](https://github.com/leanprover/lean4/pull/2928).
|
||||
* Lake's `math` template has been simplified. See PR [#2930](https://github.com/leanprover/lean4/pull/2930).
|
||||
* `lake exe <target>` now parses `target` like a build target (as the help text states it should) rather than as a basic name. For example, `lake exe @mathlib/runLinter` should now work. See PR [#2932](https://github.com/leanprover/lean4/pull/2932).
|
||||
* `lake new foo.bar [std]` now generates executables named `foo-bar` and `lake new foo.bar exe` properly creates `foo/bar.lean`. See PR [#2932](https://github.com/leanprover/lean4/pull/2932).
|
||||
* Later packages and libraries in the dependency tree are now preferred over earlier ones. That is, the later ones "shadow" the earlier ones. Such an ordering is more consistent with how declarations generally work in programming languages. This will break any package that relied on the previous ordering. See issue [#2548](https://github.com/leanprover/lean4/issues/2548) and PR [#2937](https://github.com/leanprover/lean4/pull/2937).
|
||||
* Executable roots are no longer mistakenly treated as importable. They will no longer be picked up by `findModule?`. See PR [#2937](https://github.com/leanprover/lean4/pull/2937).
|
||||
|
||||
v4.3.0
|
||||
---------
|
||||
|
||||
|
||||
@@ -4,7 +4,6 @@
|
||||
- [Tour of Lean](./tour.md)
|
||||
- [Setting Up Lean](./quickstart.md)
|
||||
- [Extended Setup Notes](./setup.md)
|
||||
- [Nix Setup](./setup/nix.md)
|
||||
- [Theorem Proving in Lean](./tpil.md)
|
||||
- [Functional Programming in Lean](fplean.md)
|
||||
- [Examples](./examples.md)
|
||||
@@ -86,7 +85,6 @@
|
||||
- [macOS Setup](./make/osx-10.9.md)
|
||||
- [Windows MSYS2 Setup](./make/msys2.md)
|
||||
- [Windows with WSL](./make/wsl.md)
|
||||
- [Nix Setup (*Experimental*)](./make/nix.md)
|
||||
- [Bootstrapping](./dev/bootstrap.md)
|
||||
- [Testing](./dev/testing.md)
|
||||
- [Debugging](./dev/debugging.md)
|
||||
|
||||
@@ -65,16 +65,36 @@ You now have a Lean binary and library that include your changes, though their
|
||||
own compilation was not influenced by them, that you can use to test your
|
||||
changes on test programs whose compilation *will* be influenced by the changes.
|
||||
|
||||
Finally, when we want to use new language features in the library, we need to
|
||||
update the stage 0 compiler, which can be done via `make -C stageN update-stage0`.
|
||||
`make update-stage0` without `-C` defaults to stage1.
|
||||
## Updating stage0
|
||||
|
||||
Updates to `stage0` should be their own commits in the Git history. In
|
||||
other words, before running `make update-stage0`, please commit your
|
||||
work. Then, commit the updated `stage0` compiler code with the commit message:
|
||||
Finally, when we want to use new language features in the library, we need to
|
||||
update the archived C source code of the stage 0 compiler in `stage0/src`.
|
||||
|
||||
The github repository will automatically update stage0 on `master` once
|
||||
`src/stdlib_flags.h` and `stage0/src/stdlib_flags.h` are out of sync.
|
||||
|
||||
If you have write access to the lean4 repository, you can also also manually
|
||||
trigger that process, for example to be able to use new features in the compiler itself.
|
||||
You can do that on <https://github.com/nomeata/lean4/actions/workflows/update-stage0.yml>
|
||||
or using Github CLI with
|
||||
```
|
||||
gh workflow run update-stage0.yml
|
||||
```
|
||||
|
||||
Leaving stage0 updates to the CI automation is preferrable, but should you need
|
||||
to do it locally, you can use `make update-stage0` in `build/release`, to
|
||||
update `stage0` from `stage1`, `make -C stageN update-stage0` to update from
|
||||
another stage, or `nix run .#update-stage0-commit` to update using nix.
|
||||
|
||||
Updates to `stage0` should be their own commits in the Git history. So should
|
||||
you have to include the stage0 update in your PR (rather than using above
|
||||
automation after merging changes), commit your work before running `make
|
||||
update-stage0`, commit the updated `stage0` compiler code with the commit
|
||||
message:
|
||||
```
|
||||
chore: update stage0
|
||||
```
|
||||
and coordinate with the admins to not squash your PR.
|
||||
|
||||
## Further Bootstrapping Complications
|
||||
|
||||
|
||||
@@ -1,10 +1,15 @@
|
||||
Git Commit Convention
|
||||
=====================
|
||||
|
||||
We are using the following convention for writing git-commit messages.
|
||||
It is based on the one from AngularJS project([doc][angularjs-doc],
|
||||
We are using the following convention for writing git commit messages. For pull
|
||||
requests, make sure the pull request title and description follow this
|
||||
convention, as the squash-merge commit will inherit title and body from the
|
||||
pull request.
|
||||
|
||||
This convention is based on the one from the AngularJS project ([doc][angularjs-doc],
|
||||
[commits][angularjs-git]).
|
||||
|
||||
|
||||
[angularjs-git]: https://github.com/angular/angular.js/commits/master
|
||||
[angularjs-doc]: https://docs.google.com/document/d/1QrDFcIiPjSLDn3EL15IJygNPiHORgU1_OOAqWjiDU5Y/edit#
|
||||
|
||||
|
||||
@@ -30,20 +30,14 @@ powershell -f elan-init.ps1 --default-toolchain none
|
||||
del elan-init.ps1
|
||||
```
|
||||
|
||||
You can use `elan toolchain link` to give a specific stage build
|
||||
directory a reference name, then use `elan override set` to associate
|
||||
such a name to the current directory. We usually want to use `stage0`
|
||||
for editing files in `src` and `stage1` for everything else (e.g.
|
||||
tests).
|
||||
The `lean-toolchain` files in the Lean 4 repository are set up to use the `lean4-stage0`
|
||||
toolchain for editing files in `src` and the `lean4` toolchain for editing files in `tests`.
|
||||
|
||||
Run the following commands to make `lean4` point at `stage1` and `lean4-stage0` point at `stage0`:
|
||||
```bash
|
||||
# in the Lean rootdir
|
||||
elan toolchain link lean4 build/release/stage1
|
||||
elan toolchain link lean4-stage0 build/release/stage0
|
||||
# make `lean` etc. point to stage1 in the rootdir and subdirs
|
||||
elan override set lean4
|
||||
cd src
|
||||
# make `lean` etc. point to stage0 anywhere inside `src`
|
||||
elan override set lean4-stage0
|
||||
```
|
||||
|
||||
You can also use the `+toolchain` shorthand (e.g. `lean +lean4-debug`) to switch
|
||||
@@ -65,6 +59,15 @@ If you push `my-tag` to a fork in your github account `my_name`,
|
||||
you can then put `my_name/lean4:my-tag` in your `lean-toolchain` file in a project using `lake`.
|
||||
(You must use a tag name that does not start with a numeral, or contain `_`).
|
||||
|
||||
### VS Code
|
||||
|
||||
There is a `lean.code-workspace` file that correctly sets up VS Code with workspace roots for the stage0/stage1 setup described above as well as with other settings.
|
||||
You should always load it when working on Lean, such as by invoking
|
||||
```
|
||||
code lean.code-workspace
|
||||
```
|
||||
on the command line.
|
||||
|
||||
### `ccache`
|
||||
|
||||
Lean's build process uses [`ccache`](https://ccache.dev/) if it is
|
||||
|
||||
@@ -5,7 +5,6 @@ After [building Lean](../make/index.md) you can run all the tests using
|
||||
cd build/release
|
||||
make test ARGS=-j4
|
||||
```
|
||||
|
||||
Change the 4 to the maximum number of parallel tests you want to
|
||||
allow. The best choice is the number of CPU cores on your machine as
|
||||
the tests are mostly CPU bound. You can find the number of processors
|
||||
@@ -17,6 +16,12 @@ adding the `-C stageN` argument. The default when run as above is stage 1. The
|
||||
Lean tests will automatically use that stage's corresponding Lean
|
||||
executables
|
||||
|
||||
Running `make test` will not pick up new test files; run
|
||||
```bash
|
||||
cmake build/release/stage1
|
||||
```
|
||||
to update the list of tests.
|
||||
|
||||
You can also use `ctest` directly if you are in the right folder. So
|
||||
to run stage1 tests with a 300 second timeout run this:
|
||||
|
||||
@@ -24,6 +29,9 @@ to run stage1 tests with a 300 second timeout run this:
|
||||
cd build/release/stage1
|
||||
ctest -j 4 --output-on-failure --timeout 300
|
||||
```
|
||||
Useful `ctest` flags are `-R <name of test>` to run a single test, and
|
||||
`--rerun-failed` to run all tests that failed during the last run.
|
||||
You can also pass `ctest` flags via `make test ARGS="--rerun-failed"`.
|
||||
|
||||
To get verbose output from ctest pass the `--verbose` command line
|
||||
option. Test output is normally suppressed and only summary
|
||||
@@ -124,8 +132,3 @@ outputs. `meld` can also be used to repair the problems.
|
||||
|
||||
In Emacs, we can also execute `M-x lean4-diff-test-file` to check/diff the file of the current buffer.
|
||||
To mass-copy all `.produced.out` files to the respective `.expected.out` file, use `tests/lean/copy-produced`.
|
||||
When using the Nix setup, add `--keep-failed` to the `nix build` call and then call
|
||||
```sh
|
||||
tests/lean/copy-produced <build-dir>/source/tests/lean
|
||||
```
|
||||
instead where `<build-dir>` is the path printed out by `nix build`.
|
||||
|
||||
BIN
doc/images/setup_guide.png
Normal file
BIN
doc/images/setup_guide.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 57 KiB |
BIN
doc/images/show-setup-guide.png
Normal file
BIN
doc/images/show-setup-guide.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 23 KiB |
@@ -79,15 +79,19 @@ special characters:
|
||||
[Unicode table](https://unicode-table.com/en/) so "\xA9 Copyright 2021" is "© Copyright 2021".
|
||||
- `\uHHHH` puts the character represented by the 4 digit hexadecimal into the string, so the following
|
||||
string "\u65e5\u672c" will become "日本" which means "Japan".
|
||||
- `\` followed by a newline and then any amount of whitespace is a "gap" that is equivalent to the empty string,
|
||||
useful for letting a string literal span across multiple lines. Gaps spanning multiple lines can be confusing,
|
||||
so the parser raises an error if the trailing whitespace contains any newlines.
|
||||
|
||||
So the complete syntax is:
|
||||
|
||||
```
|
||||
string : '"' string_item '"'
|
||||
string_item : string_char | string_escape
|
||||
string_char : [^\\]
|
||||
string_escape: "\" ("\" | '"' | "'" | "n" | "t" | "x" hex_char{2} | "u" hex_char{4} )
|
||||
string_item : string_char | char_escape | string_gap
|
||||
string_char : [^"\\]
|
||||
char_escape : "\" ("\" | '"' | "'" | "n" | "t" | "x" hex_char{2} | "u" hex_char{4})
|
||||
hex_char : [0-9a-fA-F]
|
||||
string_gap : "\" newline whitespace*
|
||||
```
|
||||
|
||||
Char Literals
|
||||
@@ -96,7 +100,9 @@ Char Literals
|
||||
Char literals are enclosed by single quotes (``'``).
|
||||
|
||||
```
|
||||
char: "'" string_item "'"
|
||||
char : "'" char_item "'"
|
||||
char_item : char_char | char_escape
|
||||
char_char : [^'\\]
|
||||
```
|
||||
|
||||
Numeric Literals
|
||||
|
||||
@@ -14,8 +14,6 @@ Platform-Specific Setup
|
||||
- [Windows (WSL)](wsl.md)
|
||||
- [macOS (homebrew)](osx-10.9.md)
|
||||
- Linux/macOS/WSL via [Nix](https://nixos.org/nix/): Call `nix-shell` in the project root. That's it.
|
||||
- There is also an [**experimental** setup based purely on Nix](nix.md) that works fundamentally differently from the
|
||||
make/CMake setup described on this page.
|
||||
|
||||
Generic Build Instructions
|
||||
--------------------------
|
||||
|
||||
110
doc/make/nix.md
110
doc/make/nix.md
@@ -1,110 +0,0 @@
|
||||
# Building with Nix
|
||||
|
||||
While [Nix](https://nixos.org/nix/) can be used to quickly open a shell with all dependencies for the [standard setup](index.md) installed, the user-facing [Nix Setup](../setup.md#nix-setup) can also be used to work *on* Lean.
|
||||
|
||||
## Setup
|
||||
|
||||
Follow the setup in the link above; to open the Lean shell inside a Lean checkout, you can also use
|
||||
```bash
|
||||
# in the Lean root directory
|
||||
$ nix-shell -A nix
|
||||
```
|
||||
|
||||
On top of the local and remote Nix cache, we do still rely on CCache as well to make C/C++ build steps incremental, which are atomic steps from Nix's point of view.
|
||||
To enable CCache, add the following line to the config file mentioned in the setup:
|
||||
```bash
|
||||
extra-sandbox-paths = /nix/var/cache/ccache
|
||||
```
|
||||
Then set up that directory as follows:
|
||||
```bash
|
||||
sudo mkdir -m0770 -p /nix/var/cache/ccache
|
||||
# macOS standard chown doesn't support --reference
|
||||
nix shell .#nixpkgs.coreutils -c sudo chown --reference=/nix/store /nix/var/cache/ccache
|
||||
```
|
||||
|
||||
## Basic Build Commands
|
||||
|
||||
From the Lean root directory inside the Lean shell:
|
||||
```bash
|
||||
nix build .#stage1 # build this stage's stdlib & executable
|
||||
nix build .#stage1.test # run all tests
|
||||
nix run .#stage1.update-stage0 # update ./stage0 from this stage
|
||||
nix run .#stage1.update-stage0-commit # ...and commit the results
|
||||
```
|
||||
The `stage1.` part in each command is optional:
|
||||
```bash
|
||||
nix build .#test # run tests for stage 1
|
||||
nix build . # build stage 1
|
||||
nix build # ditto
|
||||
```
|
||||
|
||||
## Build Process Description
|
||||
|
||||
The Nix build process conceptually works the same as described in [Lean Build Pipeline](index.md#lean-build-pipeline).
|
||||
However, there are two important differences in practice apart from the standard Nix properties (hermeneutic, reproducible builds stored in a global hash-indexed store etc.):
|
||||
* Only files tracked by git (using `git add` or at least `git add --intent-to-add`) are compiled.
|
||||
This is actually a general property of Nix flakes, and has the benefit of making it basically impossible to forget to commit a file (at least in `src/`).
|
||||
* Only files reachable from `src/Lean.lean` are compiled.
|
||||
This is because modules are discovered not from a directory listing anymore but by recursively compiling all dependencies of that top module.
|
||||
|
||||
## Editor Integration
|
||||
|
||||
As in the standard Nix setup.
|
||||
After adding `src/` as an LSP workspace, it should automatically fall back to using stage 0 in there.
|
||||
|
||||
Note that the UX of `{emacs,vscode}-dev` is quite different from the Make-based setup regarding the compilation of dependencies:
|
||||
there is no mutable directory incrementally filled by the build that we could point the editor at for .olean files.
|
||||
Instead, `emacs-dev` will gather the individual dependency outputs from the Nix store when checking a file -- and build them on the fly when necessary.
|
||||
However, it will only ever load changes saved to disk, not ones opened in other buffers.
|
||||
|
||||
The absence of a mutable output directory also means that the Lean server will not automatically pick up `.ilean` metadata from newly compiled files.
|
||||
Instead, you can run `nix run .#link-ilean` to symlink the `.ilean` tree of the stdlib state at that point in time to `src/build/lib`, where the server should automatically find them.
|
||||
|
||||
## Other Fun Stuff to Do with Nix
|
||||
|
||||
Open Emacs with Lean set up from an arbitrary commit (without even cloning Lean beforehand... if your Nix is new enough):
|
||||
```bash
|
||||
nix run github:leanprover/lean4/7e4edeb#emacs-package
|
||||
```
|
||||
|
||||
Open a shell with `lean` and `LEAN_PATH` set up for compiling a specific module (this is exactly what `emacs-dev` is doing internally):
|
||||
```bash
|
||||
nix develop .#mods.\"Lean.Parser.Basic\"
|
||||
# alternatively, directly pass a command to execute:
|
||||
nix develop .#stage2.mods.\"Init.Control.Basic\" -c bash -c 'lean $src -Dtrace.Elab.command=true'
|
||||
```
|
||||
|
||||
Not sure what you just broke? Run Lean from (e.g.) the previous commit on a file:
|
||||
```bash
|
||||
nix run .\?rev=$(git rev-parse @^) scratch.lean
|
||||
```
|
||||
|
||||
Work on two adjacent stages at the same time without the need for repeatedly updating and reverting `stage0/`:
|
||||
```bash
|
||||
# open an editor that will use only committed changes (so first commit them when changing files)
|
||||
nix run .#HEAD-as-stage1.emacs-dev&
|
||||
# open a second editor that will use those committed changes as stage 0
|
||||
# (so don't commit changes done here until you are done and ran a final `update-stage0-commit`)
|
||||
nix run .#HEAD-as-stage0.emacs-dev&
|
||||
```
|
||||
To run `nix build` on the second stage outside of the second editor, use
|
||||
```bash
|
||||
nix build .#stage0-from-input --override-input lean-stage0 .\?rev=$(git rev-parse HEAD)
|
||||
```
|
||||
This setup will inadvertently change your `flake.lock` file, which you can revert when you are done.
|
||||
|
||||
...more surely to come...
|
||||
|
||||
## Debugging
|
||||
|
||||
Since Nix copies all source files before compilation, you will need to map debug symbols back to the original path using `set substitute-path` in GDB.
|
||||
For example, for a build on Linux with the Nix sandbox activated:
|
||||
```bash
|
||||
(gdb) f
|
||||
#1 0x0000000000d23a4f in lean_inc (o=0x1) at /build/source/build/include/lean/lean.h:562
|
||||
562 /build/source/build/include/lean/lean.h: No such file or directory.
|
||||
(gdb) set substitute-path /build/source/build src
|
||||
(gdb) f
|
||||
#1 0x0000000000d23a4f in lean_inc (o=0x1) at /build/source/build/include/lean/lean.h:562
|
||||
562 static inline void lean_inc(lean_object * o) { if (!lean_is_scalar(o)) lean_inc_ref(o); }
|
||||
```
|
||||
@@ -1,55 +1,18 @@
|
||||
# Quickstart
|
||||
|
||||
These instructions will walk you through setting up Lean using the "basic" setup and VS Code as the editor.
|
||||
See [Setup](./setup.md) for other ways, supported platforms, and more details on setting up Lean.
|
||||
|
||||
See quick [walkthrough demo video](https://www.youtube.com/watch?v=yZo6k48L0VY).
|
||||
These instructions will walk you through setting up Lean 4 together with VS Code as an editor for Lean 4.
|
||||
See [Setup](./setup.md) for supported platforms and other ways to set up Lean 4.
|
||||
|
||||
1. Install [VS Code](https://code.visualstudio.com/).
|
||||
|
||||
1. Launch VS Code and install the `lean4` extension.
|
||||
1. Launch VS Code and install the `lean4` extension by clicking on the "Extensions" sidebar entry and searching for "lean4".
|
||||
|
||||

|
||||
|
||||
1. Create a new file using "File > New Text File" (`Ctrl+N`). Click the `Select a language` prompt, type in `lean4`, and hit ENTER. You should see the following popup:
|
||||

|
||||
1. Open the Lean 4 setup guide by creating a new text file using "File > New Text File" (`Ctrl+N`), clicking on the ∀-symbol in the top right and selecting "Documentation… > Setup: Show Setup Guide".
|
||||
|
||||
Click the "Install Lean using Elan" button. You should see some progress output like this:
|
||||

|
||||
|
||||
```
|
||||
info: syncing channel updates for 'stable'
|
||||
info: latest update on stable, lean version v4.0.0
|
||||
info: downloading component 'lean'
|
||||
```
|
||||
If there is no popup, you probably have Elan installed already.
|
||||
You may want to make sure that your default toolchain is Lean 4 in this case by running `elan default leanprover/lean4:stable` and reopen the file, as the next step will fail otherwise.
|
||||
1. Follow the Lean 4 setup guide. It will walk you through learning resources for Lean 4, teach you how to set up Lean's dependencies on your platform, install Lean 4 for you at the click of a button and help you set up your first project.
|
||||
|
||||
1. While it is installing, you can paste the following Lean program into the new file:
|
||||
|
||||
```lean
|
||||
#eval Lean.versionString
|
||||
```
|
||||
|
||||
When the installation has finished, the Lean Language Server should start automatically and you should get syntax-highlighting and a "Lean Infoview" popping up on the right. You will see the output of the `#eval` statement when
|
||||
you place your cursor at the end of the statement.
|
||||
|
||||

|
||||
|
||||
You are set up!
|
||||
|
||||
## Create a Lean Project
|
||||
|
||||
*If your goal is to contribute to [mathlib4](https://github.com/leanprover-community/mathlib4) or use it as a dependency, please see its readme for specific instructions on how to do that.*
|
||||
|
||||
You can now create a Lean project in a new folder. Run `lake init foo` from "View > Terminal" to create a package, followed by `lake build` to get an executable version of your Lean program.
|
||||
On Linux/macOS, you first have to follow the instructions printed by the Lean installation or log out and in again for the Lean executables to be available in you terminal.
|
||||
|
||||
Note: Packages **have** to be opened using "File > Open Folder..." for imports to work.
|
||||
Saved changes are visible in other files after running "Lean 4: Refresh File Dependencies" (`Ctrl+Shift+X`).
|
||||
|
||||
## Troubleshooting
|
||||
|
||||
**The InfoView says "Waiting for Lean server to start..." forever.**
|
||||
|
||||
Check that the VS Code Terminal is not showing some installation errors from `elan`.
|
||||
If that doesn't work, try also running the VS Code command `Developer: Reload Window`.
|
||||

|
||||
|
||||
@@ -1,71 +0,0 @@
|
||||
# Nix Setup
|
||||
|
||||
An alternative setup based on Nix provides a perfectly reproducible development environment for your project from the Lean version down to the editor and Lean extension.
|
||||
However, it is still experimental and subject to change; in particular, it is heavily based on an unreleased version of Nix enabling [Nix Flakes](https://www.tweag.io/blog/2020-05-25-flakes/). The setup has been tested on NixOS, other Linux distributions, and macOS.
|
||||
|
||||
After installing (any version of) Nix (<https://nixos.org/download.html>), you can easily open a shell with the particular pre-release version of Nix needed by and tested with our setup (called the "Lean shell" from here on):
|
||||
```bash
|
||||
$ nix-shell https://github.com/leanprover/lean4/archive/master.tar.gz -A nix
|
||||
```
|
||||
While this shell is sufficient for executing the steps below, it is recommended to also set the following options in `/etc/nix/nix.conf` (`nix.extraOptions` in NixOS):
|
||||
```
|
||||
max-jobs = auto # Allow building multiple derivations in parallel
|
||||
keep-outputs = true # Do not garbage-collect build time-only dependencies (e.g. clang)
|
||||
# Allow fetching build results from the Lean Cachix cache
|
||||
trusted-substituters = https://lean4.cachix.org/
|
||||
trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= lean4.cachix.org-1:mawtxSxcaiWE24xCXXgh3qnvlTkyU7evRRnGeAhD4Wk=
|
||||
```
|
||||
On a multi-user installation of Nix (the default), you need to restart the Nix daemon afterwards:
|
||||
```bash
|
||||
sudo pkill nix-daemon
|
||||
```
|
||||
|
||||
The [Cachix](https://cachix.org/) integration will magically beam any build steps already executed by the CI right onto your machine when calling Nix commands in the shell opened above.
|
||||
It can be set up analogously as a cache for your own project.
|
||||
|
||||
Note: Your system Nix might print warnings about not knowing some of the settings used by the Lean shell Nix, which can be ignored.
|
||||
|
||||
## Basic Commands
|
||||
|
||||
From a Lean shell, run
|
||||
```bash
|
||||
$ nix flake new mypkg -t github:leanprover/lean4
|
||||
```
|
||||
to create a new Lean package in directory `mypkg` using the latest commit of Lean 4.
|
||||
Such packages follow the same directory layout as described in the standard setup, except for a `lakefile.lean` replaced by a `flake.nix` file set up so you can run Nix commands on it, for example:
|
||||
```bash
|
||||
$ nix build # build package and all dependencies
|
||||
$ nix build .#executable # compile `main` definition into executable (after you've added one)
|
||||
$ nix run .#emacs-dev # open a pinned version of Emacs with lean4-mode fully set up
|
||||
$ nix run .#emacs-dev MyPackage.lean # arguments can be passed as well, e.g. the file to open
|
||||
$ nix run .#vscode-dev MyPackage.lean # ditto, using VS Code
|
||||
```
|
||||
Note that if you rename `MyPackage.lean`, you also have to adjust the `name` attribute in `flake.nix` accordingly.
|
||||
Also note that if you turn the package into a Git repository, only tracked files will be visible to Nix.
|
||||
|
||||
As in the standard setup, changes need to be saved to be visible in other files, which have then to be invalidated via an editor command.
|
||||
|
||||
If you don't want to or cannot start the pinned editor from Nix, e.g. because you're running Lean inside WSL/a container/on a different machine, you can manually point your editor at the `lean` wrapper script the commands above use internally:
|
||||
```bash
|
||||
$ nix build .#lean-dev -o result-lean-dev
|
||||
```
|
||||
The resulting `./result-lean-dev/bin/lean` script essentially runs `nix run .#lean` in the current project's root directory when you open a Lean file or use the "refresh dependencies" command such that the correct Lean version for that project is executed.
|
||||
This includes selecting the correct stage of Lean (which it will compile on the fly, though without progress output) if you are [working on Lean itself](./make/nix.md#editor-integration).
|
||||
|
||||
Package dependencies can be added as further input flakes and passed to the `deps` list of `buildLeanPackage`. Example: <https://github.com/Kha/testpkg2/blob/master/flake.nix#L5>
|
||||
|
||||
For hacking, it can be useful to temporarily override an input with a local checkout/different version of a dependency:
|
||||
```bash
|
||||
$ nix build --override-input somedep path/to/somedep
|
||||
```
|
||||
|
||||
On a build error, Nix will show the last 10 lines of the output by default. You can pass `-L` to `nix build` to show all lines, or pass the shown `*.drv` path to `nix log` to show the full log after the fact.
|
||||
|
||||
Keeping all outputs ever built on a machine alive can accumulate to quite impressive amounts of disk space, so you might want to trigger the Nix GC when `/nix/store/` has grown too large:
|
||||
```bash
|
||||
nix-collect-garbage
|
||||
```
|
||||
This will remove everything not reachable from "GC roots" such as the `./result` symlink created by `nix build`.
|
||||
|
||||
Note that the package information in `flake.nix` is currently completely independent from `lakefile.lean` used in the standard setup.
|
||||
Unifying the two formats is TBD.
|
||||
@@ -67,6 +67,9 @@ theorem funext {f₁ f₂ : ∀ (x : α), β x} (h : ∀ x, f₁ x = f₂ x) : f
|
||||
\end{document}
|
||||
```
|
||||
|
||||
If your version of `minted` is v2.7 or newer, but before v3.0,
|
||||
you will additionally need to follow the workaround described in https://github.com/gpoore/minted/issues/360.
|
||||
|
||||
You can then compile `test.tex` by executing the following command:
|
||||
|
||||
```bash
|
||||
|
||||
1
lean-toolchain
Normal file
1
lean-toolchain
Normal file
@@ -0,0 +1 @@
|
||||
lean4
|
||||
57
lean.code-workspace
Normal file
57
lean.code-workspace
Normal file
@@ -0,0 +1,57 @@
|
||||
{
|
||||
"folders": [
|
||||
{
|
||||
"path": "."
|
||||
},
|
||||
{
|
||||
"path": "src"
|
||||
},
|
||||
{
|
||||
"path": "tests"
|
||||
}
|
||||
],
|
||||
"settings": {
|
||||
"files.insertFinalNewline": true,
|
||||
"files.trimTrailingWhitespace": true,
|
||||
"cmake.buildDirectory": "${workspaceFolder}/build/release",
|
||||
"cmake.generator": "Unix Makefiles",
|
||||
"[markdown]": {
|
||||
"rewrap.wrappingColumn": 70
|
||||
},
|
||||
"[lean4]": {
|
||||
"editor.rulers": [
|
||||
100
|
||||
]
|
||||
}
|
||||
},
|
||||
"tasks": {
|
||||
"version": "2.0.0",
|
||||
"tasks": [
|
||||
{
|
||||
"label": "build",
|
||||
"type": "shell",
|
||||
"command": "make -C build/release -j$(nproc 2>/dev/null || sysctl -n hw.logicalcpu 2>/dev/null || echo 4)",
|
||||
"problemMatcher": [],
|
||||
"group": {
|
||||
"kind": "build",
|
||||
"isDefault": true
|
||||
}
|
||||
},
|
||||
{
|
||||
"label": "test",
|
||||
"type": "shell",
|
||||
"command": "NPROC=$(nproc 2>/dev/null || sysctl -n hw.logicalcpu 2>/dev/null || echo 4); CTEST_OUTPUT_ON_FAILURE=1 make -C build/release test -j$NPROC ARGS=\"-j$NPROC\"",
|
||||
"problemMatcher": [],
|
||||
"group": {
|
||||
"kind": "test",
|
||||
"isDefault": true
|
||||
}
|
||||
}
|
||||
]
|
||||
},
|
||||
"extensions": {
|
||||
"recommendations": [
|
||||
"leanprover.lean4"
|
||||
]
|
||||
}
|
||||
}
|
||||
@@ -83,13 +83,13 @@ rec {
|
||||
# use same stage for retrieving dependencies
|
||||
lean-leanDeps = stage0;
|
||||
lean-final = self;
|
||||
leanFlags = [ "-DwarningAsError=true" ];
|
||||
} ({
|
||||
src = src + "/src";
|
||||
roots = [ { mod = args.name; glob = "andSubmodules"; } ];
|
||||
fullSrc = src;
|
||||
srcPath = "$PWD/src:$PWD/src/lake";
|
||||
inherit debug;
|
||||
leanFlags = [ "-DwarningAsError=true" ];
|
||||
} // args);
|
||||
Init' = build { name = "Init"; deps = []; };
|
||||
Lean' = build { name = "Lean"; deps = [ Init' ]; };
|
||||
|
||||
@@ -10,7 +10,7 @@ function pebkac() {
|
||||
[[ $# -gt 0 ]] || pebkac
|
||||
case $1 in
|
||||
--version)
|
||||
# minimum version for `lake server` with fallback
|
||||
# minimum version for `lake serve` with fallback
|
||||
echo 3.1.0
|
||||
;;
|
||||
print-paths)
|
||||
|
||||
@@ -1,19 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Name of the remote repository
|
||||
remote_name="nightly"
|
||||
|
||||
# Prefix for tags to search for
|
||||
tag_prefix="nightly-"
|
||||
|
||||
# Fetch all tags from the remote repository
|
||||
git fetch $remote_name --tags > /dev/null
|
||||
|
||||
# Get the most recent commit that has a matching tag
|
||||
tag_name=$(git tag --merged HEAD --list "${tag_prefix}*" | sort -rV | head -n 1 | sed "s/^$tag_prefix//")
|
||||
|
||||
if [ -z "$tag_name" ]; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
echo "$tag_name"
|
||||
@@ -9,7 +9,7 @@ endif()
|
||||
include(ExternalProject)
|
||||
project(LEAN CXX C)
|
||||
set(LEAN_VERSION_MAJOR 4)
|
||||
set(LEAN_VERSION_MINOR 4)
|
||||
set(LEAN_VERSION_MINOR 5)
|
||||
set(LEAN_VERSION_PATCH 0)
|
||||
set(LEAN_VERSION_IS_RELEASE 0) # This number is 1 in the release revision, and 0 otherwise.
|
||||
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
|
||||
@@ -64,7 +64,7 @@ option(BSYMBOLIC "Link with -Bsymbolic to reduce call overhead in shared librari
|
||||
option(USE_GMP "USE_GMP" ON)
|
||||
|
||||
# development-specific options
|
||||
option(CHECK_OLEAN_VERSION "Only load .olean files compiled with the current version of Lean" ON)
|
||||
option(CHECK_OLEAN_VERSION "Only load .olean files compiled with the current version of Lean" OFF)
|
||||
|
||||
set(LEAN_EXTRA_MAKE_OPTS "" CACHE STRING "extra options to lean --make")
|
||||
set(LEANC_CC ${CMAKE_C_COMPILER} CACHE STRING "C compiler to use in `leanc`")
|
||||
@@ -93,8 +93,9 @@ if ("${RUNTIME_STATS}" MATCHES "ON")
|
||||
string(APPEND LEAN_EXTRA_CXX_FLAGS " -D LEAN_RUNTIME_STATS")
|
||||
endif()
|
||||
|
||||
if (NOT("${CHECK_OLEAN_VERSION}" MATCHES "ON"))
|
||||
string(APPEND LEAN_EXTRA_CXX_FLAGS " -D LEAN_IGNORE_OLEAN_VERSION")
|
||||
if ("${CHECK_OLEAN_VERSION}" MATCHES "ON")
|
||||
set(USE_GITHASH ON)
|
||||
string(APPEND LEAN_EXTRA_CXX_FLAGS " -D LEAN_CHECK_OLEAN_VERSION")
|
||||
endif()
|
||||
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
@@ -401,26 +402,17 @@ if(MULTI_THREAD AND NOT MSVC AND (NOT ("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin"))
|
||||
endif()
|
||||
|
||||
# Git HASH
|
||||
set(LEAN_PACKAGE_VERSION "NOT-FOUND")
|
||||
if(USE_GITHASH)
|
||||
include(GetGitRevisionDescription)
|
||||
get_git_head_revision(GIT_REFSPEC GIT_SHA1)
|
||||
if(${GIT_SHA1} MATCHES "GITDIR-NOTFOUND")
|
||||
message(STATUS "Failed to read git_sha1")
|
||||
set(GIT_SHA1 "")
|
||||
if(EXISTS "${LEAN_SOURCE_DIR}/bin/package_version")
|
||||
file(STRINGS "${LEAN_SOURCE_DIR}/bin/package_version" LEAN_PACKAGE_VERSION)
|
||||
message(STATUS "Package version detected: ${LEAN_PACKAGE_VERSION}")
|
||||
endif()
|
||||
else()
|
||||
message(STATUS "git commit sha1: ${GIT_SHA1}")
|
||||
endif()
|
||||
else()
|
||||
set(GIT_SHA1 "")
|
||||
if(EXISTS "${LEAN_SOURCE_DIR}/bin/package_version")
|
||||
file(STRINGS "${LEAN_SOURCE_DIR}/bin/package_version" LEAN_PACKAGE_VERSION)
|
||||
message(STATUS "Package version detected: ${LEAN_PACKAGE_VERSION}")
|
||||
endif()
|
||||
endif()
|
||||
configure_file("${LEAN_SOURCE_DIR}/githash.h.in" "${LEAN_BINARY_DIR}/githash.h")
|
||||
|
||||
@@ -447,12 +439,13 @@ include_directories(${LEAN_SOURCE_DIR})
|
||||
include_directories(${CMAKE_BINARY_DIR}) # version.h etc., "private" headers
|
||||
include_directories(${CMAKE_BINARY_DIR}/include) # config.h etc., "public" headers
|
||||
|
||||
# Use CMake profile C++ flags for building Lean libraries, but do not embed in `leanc`
|
||||
string(TOUPPER "${CMAKE_BUILD_TYPE}" uppercase_CMAKE_BUILD_TYPE)
|
||||
# These are used in lean.mk (and libleanrt) and passed through by stdlib.make
|
||||
# They are not embedded into `leanc` since they are build profile/machine specific
|
||||
string(APPEND LEANC_OPTS " ${CMAKE_CXX_FLAGS_${uppercase_CMAKE_BUILD_TYPE}}")
|
||||
|
||||
# Do embed flag for finding system libraries in dev builds
|
||||
if(CMAKE_OSX_SYSROOT AND NOT LEAN_STANDALONE)
|
||||
string(APPEND LEANC_OPTS " ${CMAKE_CXX_SYSROOT_FLAG}${CMAKE_OSX_SYSROOT}")
|
||||
string(APPEND LEANC_EXTRA_FLAGS " ${CMAKE_CXX_SYSROOT_FLAG}${CMAKE_OSX_SYSROOT}")
|
||||
endif()
|
||||
|
||||
if(${STAGE} GREATER 1)
|
||||
|
||||
@@ -468,6 +468,9 @@ def elem [BEq α] (a : α) (as : Array α) : Bool :=
|
||||
else
|
||||
(true, r)
|
||||
|
||||
/-- Convert a `Array α` into an `List α`. This is O(n) in the size of the array. -/
|
||||
-- This function is exported to C, where it is called by `Array.data`
|
||||
-- (the projection) to implement this functionality.
|
||||
@[export lean_array_to_list]
|
||||
def toList (as : Array α) : List α :=
|
||||
as.foldr List.cons []
|
||||
|
||||
@@ -81,7 +81,7 @@ def isEmpty (s : ByteArray) : Bool :=
|
||||
If `exact` is `false`, the capacity will be doubled when grown. -/
|
||||
@[extern "lean_byte_array_copy_slice"]
|
||||
def copySlice (src : @& ByteArray) (srcOff : Nat) (dest : ByteArray) (destOff len : Nat) (exact : Bool := true) : ByteArray :=
|
||||
⟨dest.data.extract 0 destOff ++ src.data.extract srcOff (srcOff + len) ++ dest.data.extract (destOff + len) dest.data.size⟩
|
||||
⟨dest.data.extract 0 destOff ++ src.data.extract srcOff (srcOff + len) ++ dest.data.extract (destOff + min len (src.data.size - srcOff)) dest.data.size⟩
|
||||
|
||||
def extract (a : ByteArray) (b e : Nat) : ByteArray :=
|
||||
a.copySlice b empty 0 (e - b)
|
||||
|
||||
@@ -557,16 +557,22 @@ def takeWhile (p : α → Bool) : (xs : List α) → List α
|
||||
/--
|
||||
`O(|l|)`. Returns true if `p` is true for any element of `l`.
|
||||
* `any p [a, b, c] = p a || p b || p c`
|
||||
|
||||
Short-circuits upon encountering the first `true`.
|
||||
-/
|
||||
@[inline] def any (l : List α) (p : α → Bool) : Bool :=
|
||||
foldr (fun a r => p a || r) false l
|
||||
def any : List α -> (α → Bool) -> Bool
|
||||
| [], _ => false
|
||||
| h :: t, p => p h || any t p
|
||||
|
||||
/--
|
||||
`O(|l|)`. Returns true if `p` is true for every element of `l`.
|
||||
* `all p [a, b, c] = p a && p b && p c`
|
||||
|
||||
Short-circuits upon encountering the first `false`.
|
||||
-/
|
||||
@[inline] def all (l : List α) (p : α → Bool) : Bool :=
|
||||
foldr (fun a r => p a && r) true l
|
||||
def all : List α -> (α → Bool) -> Bool
|
||||
| [], _ => true
|
||||
| h :: t, p => p h && all t p
|
||||
|
||||
/--
|
||||
`O(|l|)`. Returns true if `true` is an element of the list of booleans `l`.
|
||||
|
||||
@@ -773,6 +773,16 @@ def decodeQuotedChar (s : String) (i : String.Pos) : Option (Char × String.Pos)
|
||||
else
|
||||
none
|
||||
|
||||
/--
|
||||
Decodes a valid string gap after the `\`.
|
||||
Note that this function matches `"\" whitespace+` rather than
|
||||
the more restrictive `"\" newline whitespace*` since this simplifies the implementation.
|
||||
Justification: this does not overlap with any other sequences beginning with `\`.
|
||||
-/
|
||||
def decodeStringGap (s : String) (i : String.Pos) : Option String.Pos := do
|
||||
guard <| (s.get i).isWhitespace
|
||||
s.nextWhile Char.isWhitespace (s.next i)
|
||||
|
||||
partial def decodeStrLitAux (s : String) (i : String.Pos) (acc : String) : Option String := do
|
||||
let c := s.get i
|
||||
let i := s.next i
|
||||
@@ -781,8 +791,12 @@ partial def decodeStrLitAux (s : String) (i : String.Pos) (acc : String) : Optio
|
||||
else if s.atEnd i then
|
||||
none
|
||||
else if c == '\\' then do
|
||||
let (c, i) ← decodeQuotedChar s i
|
||||
decodeStrLitAux s i (acc.push c)
|
||||
if let some (c, i) := decodeQuotedChar s i then
|
||||
decodeStrLitAux s i (acc.push c)
|
||||
else if let some i := decodeStringGap s i then
|
||||
decodeStrLitAux s i acc
|
||||
else
|
||||
none
|
||||
else
|
||||
decodeStrLitAux s i (acc.push c)
|
||||
|
||||
@@ -1162,8 +1176,12 @@ private partial def decodeInterpStrLit (s : String) : Option String :=
|
||||
else if s.atEnd i then
|
||||
none
|
||||
else if c == '\\' then do
|
||||
let (c, i) ← decodeInterpStrQuotedChar s i
|
||||
loop i (acc.push c)
|
||||
if let some (c, i) := decodeInterpStrQuotedChar s i then
|
||||
loop i (acc.push c)
|
||||
else if let some i := decodeStringGap s i then
|
||||
loop i acc
|
||||
else
|
||||
none
|
||||
else
|
||||
loop i (acc.push c)
|
||||
loop ⟨1⟩ ""
|
||||
|
||||
@@ -21,7 +21,14 @@ structure Module where
|
||||
namespace Meta
|
||||
|
||||
inductive TransparencyMode where
|
||||
| all | default | reducible | instances
|
||||
/-- unfold all constants, even those tagged as `@[irreducible]`. -/
|
||||
| all
|
||||
/-- unfold all constants except those tagged as `@[irreducible]`. -/
|
||||
| default
|
||||
/-- unfold only constants tagged with the `@[reducible]` attribute. -/
|
||||
| reducible
|
||||
/-- unfold reducible constants and constants tagged with the `@[instance]` attribute. -/
|
||||
| instances
|
||||
deriving Inhabited, BEq
|
||||
|
||||
inductive EtaStructMode where
|
||||
|
||||
@@ -926,7 +926,9 @@ or derive `i < arr.size` from some other proposition that we are checking in the
|
||||
return `t` or `e` depending on whether `c` is true or false. The explicit argument
|
||||
`c : Prop` does not have any actual computational content, but there is an additional
|
||||
`[Decidable c]` argument synthesized by typeclass inference which actually
|
||||
determines how to evaluate `c` to true or false.
|
||||
determines how to evaluate `c` to true or false. Write `if h : c then t else e`
|
||||
instead for a "dependent if-then-else" `dite`, which allows `t`/`e` to use the fact
|
||||
that `c` is true/false.
|
||||
|
||||
Because lean uses a strict (call-by-value) evaluation strategy, the signature of this
|
||||
function is problematic in that it would require `t` and `e` to be evaluated before
|
||||
@@ -2211,9 +2213,10 @@ returns `a` if `opt = some a` and `dflt` otherwise.
|
||||
This function is `@[macro_inline]`, so `dflt` will not be evaluated unless
|
||||
`opt` turns out to be `none`.
|
||||
-/
|
||||
@[macro_inline] def Option.getD : Option α → α → α
|
||||
| some x, _ => x
|
||||
| none, e => e
|
||||
@[macro_inline] def Option.getD (opt : Option α) (dflt : α) : α :=
|
||||
match opt with
|
||||
| some x => x
|
||||
| none => dflt
|
||||
|
||||
/--
|
||||
Map a function over an `Option` by applying the function to the contained
|
||||
@@ -2546,13 +2549,22 @@ is not observable from lean code. Arrays perform best when unshared; as long
|
||||
as they are used "linearly" all updates will be performed destructively on the
|
||||
array, so it has comparable performance to mutable arrays in imperative
|
||||
programming languages.
|
||||
|
||||
From the point of view of proofs `Array α` is just a wrapper around `List α`.
|
||||
-/
|
||||
structure Array (α : Type u) where
|
||||
/-- Convert a `List α` into an `Array α`. This function is overridden
|
||||
to `List.toArray` and is O(n) in the length of the list. -/
|
||||
/--
|
||||
Converts a `List α` into an `Array α`.
|
||||
|
||||
At runtime, this constructor is implemented by `List.toArray` and is O(n) in the length of the
|
||||
list.
|
||||
-/
|
||||
mk ::
|
||||
/-- Convert an `Array α` into a `List α`. This function is overridden
|
||||
to `Array.toList` and is O(n) in the length of the list. -/
|
||||
/--
|
||||
Converts a `Array α` into an `List α`.
|
||||
|
||||
At runtime, this projection is implemented by `Array.toList` and is O(n) in the length of the
|
||||
array. -/
|
||||
data : List α
|
||||
|
||||
attribute [extern "lean_array_data"] Array.data
|
||||
@@ -2700,12 +2712,9 @@ 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.
|
||||
-/
|
||||
/-- 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, export lean_list_to_array]
|
||||
def List.toArray (as : List α) : Array α :=
|
||||
as.toArrayAux (Array.mkEmpty as.redLength)
|
||||
|
||||
@@ -250,7 +250,7 @@ macro:1 x:tactic tk:" <;> " y:tactic:2 : tactic => `(tactic|
|
||||
all_goals $y:tactic)
|
||||
|
||||
/-- `eq_refl` is equivalent to `exact rfl`, but has a few optimizations. -/
|
||||
syntax (name := refl) "eq_refl" : tactic
|
||||
syntax (name := eqRefl) "eq_refl" : tactic
|
||||
|
||||
/--
|
||||
`rfl` tries to close the current goal using reflexivity.
|
||||
@@ -452,6 +452,12 @@ definitionally equal to the input.
|
||||
syntax (name := dsimp) "dsimp" (config)? (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*,?) "]")? (location)? : tactic
|
||||
|
||||
/--
|
||||
The `seval` tactic is a symbolic evaluator. It reduces nested ground terms.
|
||||
**WARNING**: This tactic is under development. Do not use it in your project unless you are working with the tactic developer.
|
||||
-/
|
||||
syntax (name := seval) "seval" : tactic
|
||||
|
||||
/--
|
||||
`delta id1 id2 ...` delta-expands the definitions `id1`, `id2`, ....
|
||||
This is a low-level tactic, it will expose how recursive definitions have been
|
||||
|
||||
46
src/Lean/Data/Array.lean
Normal file
46
src/Lean/Data/Array.lean
Normal file
@@ -0,0 +1,46 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joachim Breitner
|
||||
-/
|
||||
|
||||
import Init.Data.Array
|
||||
|
||||
namespace Array
|
||||
|
||||
/-!
|
||||
This module contains utility functions involving Arrays that are useful in a few places
|
||||
of the lean code base, but too specialized to live in `Init.Data.Array`, which arguably
|
||||
is part of the public, user-facing standard library.
|
||||
-/
|
||||
|
||||
/--
|
||||
Given an array `a`, runs `f xᵢ xⱼ` for all `i < j`, removes those entries for which `f` returns
|
||||
`false` (and will subsequently skip pairs if one element is removed), and returns the array of
|
||||
remaining elements.
|
||||
|
||||
This can be used to remove elements from an array where a “better” element, in some partial
|
||||
order, exists in the array.
|
||||
-/
|
||||
def filterPairsM {m} [Monad m] {α} (a : Array α) (f : α → α → m (Bool × Bool)) :
|
||||
m (Array α) := do
|
||||
let mut removed := Array.mkArray a.size false
|
||||
let mut numRemoved := 0
|
||||
for h1 : i in [:a.size] do for h2 : j in [i+1:a.size] do
|
||||
unless removed[i]! || removed[j]! do
|
||||
let xi := a[i]'h1.2
|
||||
let xj := a[j]'h2.2
|
||||
let (keepi, keepj) ← f xi xj
|
||||
unless keepi do
|
||||
numRemoved := numRemoved + 1
|
||||
removed := removed.set! i true
|
||||
unless keepj do
|
||||
numRemoved := numRemoved + 1
|
||||
removed := removed.set! j true
|
||||
let mut a' := Array.mkEmpty numRemoved
|
||||
for h : i in [:a.size] do
|
||||
unless removed[i]! do
|
||||
a' := a'.push (a[i]'h.2)
|
||||
return a'
|
||||
|
||||
end Array
|
||||
@@ -190,6 +190,16 @@ def subsetAux : List (Name × DataValue) → KVMap → Bool
|
||||
def subset : KVMap → KVMap → Bool
|
||||
| ⟨m₁⟩, m₂ => subsetAux m₁ m₂
|
||||
|
||||
def mergeBy (mergeFn : Name → DataValue → DataValue → DataValue) (l r : KVMap)
|
||||
: KVMap := Id.run do
|
||||
let mut result := l
|
||||
for ⟨k, vᵣ⟩ in r do
|
||||
if let some vₗ := result.find k then
|
||||
result := result.insert k (mergeFn k vₗ vᵣ)
|
||||
else
|
||||
result := result.insert k vᵣ
|
||||
return result
|
||||
|
||||
def eqv (m₁ m₂ : KVMap) : Bool :=
|
||||
subset m₁ m₂ && subset m₂ m₁
|
||||
|
||||
|
||||
@@ -206,7 +206,7 @@ instance : FromJson DocumentChange where
|
||||
[reference](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspaceEdit) -/
|
||||
structure WorkspaceEdit where
|
||||
/-- Changes to existing resources. -/
|
||||
changes : RBMap DocumentUri TextEditBatch compare := ∅
|
||||
changes? : Option (RBMap DocumentUri TextEditBatch compare) := none
|
||||
/-- Depending on the client capability
|
||||
`workspace.workspaceEdit.resourceOperations` document changes are either
|
||||
an array of `TextDocumentEdit`s to express changes to n different text
|
||||
@@ -220,14 +220,14 @@ structure WorkspaceEdit where
|
||||
If a client neither supports `documentChanges` nor
|
||||
`workspace.workspaceEdit.resourceOperations` then only plain `TextEdit`s
|
||||
using the `changes` property are supported. -/
|
||||
documentChanges : Array DocumentChange := ∅
|
||||
documentChanges? : Option (Array DocumentChange) := none
|
||||
/-- A map of change annotations that can be referenced in
|
||||
`AnnotatedTextEdit`s or create, rename and delete file / folder
|
||||
operations.
|
||||
|
||||
Whether clients honor this property depends on the client capability
|
||||
`workspace.changeAnnotationSupport`. -/
|
||||
changeAnnotations : RBMap String ChangeAnnotation compare := ∅
|
||||
changeAnnotations? : Option (RBMap String ChangeAnnotation compare) := none
|
||||
deriving ToJson, FromJson
|
||||
|
||||
namespace WorkspaceEdit
|
||||
@@ -236,13 +236,22 @@ instance : EmptyCollection WorkspaceEdit := ⟨{}⟩
|
||||
|
||||
instance : Append WorkspaceEdit where
|
||||
append x y := {
|
||||
changes := x.changes.mergeBy (fun _ v₁ v₂ => v₁ ++ v₂) y.changes
|
||||
documentChanges := x.documentChanges ++ y.documentChanges
|
||||
changeAnnotations := x.changeAnnotations.mergeBy (fun _ _v₁ v₂ => v₂) y.changeAnnotations
|
||||
changes? :=
|
||||
match x.changes?, y.changes? with
|
||||
| v, none | none, v => v
|
||||
| some x, some y => x.mergeBy (fun _ v₁ v₂ => v₁ ++ v₂) y
|
||||
documentChanges? :=
|
||||
match x.documentChanges?, y.documentChanges? with
|
||||
| v, none | none, v => v
|
||||
| some x, some y => x ++ y
|
||||
changeAnnotations? :=
|
||||
match x.changeAnnotations?, y.changeAnnotations? with
|
||||
| v, none | none, v => v
|
||||
| some x, some y => x.mergeBy (fun _ _v₁ v₂ => v₂) y
|
||||
}
|
||||
|
||||
def ofTextDocumentEdit (e : TextDocumentEdit) : WorkspaceEdit :=
|
||||
{ documentChanges := #[DocumentChange.edit e]}
|
||||
{ documentChanges? := #[DocumentChange.edit e]}
|
||||
|
||||
def ofTextEdit (doc : VersionedTextDocumentIdentifier) (te : TextEdit) : WorkspaceEdit :=
|
||||
ofTextDocumentEdit { textDocument := doc, edits := #[te]}
|
||||
|
||||
@@ -74,6 +74,7 @@ structure ServerCapabilities where
|
||||
declarationProvider : Bool := false
|
||||
typeDefinitionProvider : Bool := false
|
||||
referencesProvider : Bool := false
|
||||
renameProvider? : Option RenameOptions := none
|
||||
workspaceSymbolProvider : Bool := false
|
||||
foldingRangeProvider : Bool := false
|
||||
semanticTokensProvider? : Option SemanticTokensOptions := none
|
||||
|
||||
@@ -351,5 +351,16 @@ structure FoldingRange where
|
||||
kind? : Option FoldingRangeKind := none
|
||||
deriving ToJson
|
||||
|
||||
structure RenameOptions where
|
||||
prepareProvider : Bool := false
|
||||
deriving FromJson, ToJson
|
||||
|
||||
structure RenameParams extends TextDocumentPositionParams where
|
||||
newName : String
|
||||
deriving FromJson, ToJson
|
||||
|
||||
structure PrepareRenameParams extends TextDocumentPositionParams
|
||||
deriving FromJson, ToJson
|
||||
|
||||
end Lsp
|
||||
end Lean
|
||||
|
||||
@@ -62,21 +62,24 @@ end String
|
||||
namespace Lean
|
||||
namespace FileMap
|
||||
|
||||
private def lineStartPos (text : FileMap) (line : Nat) : String.Pos :=
|
||||
if h : line < text.positions.size then
|
||||
text.positions.get ⟨line, h⟩
|
||||
else if text.positions.isEmpty then
|
||||
0
|
||||
else
|
||||
text.positions.back
|
||||
|
||||
/-- Computes an UTF-8 offset into `text.source`
|
||||
from an LSP-style 0-indexed (ln, col) position. -/
|
||||
def lspPosToUtf8Pos (text : FileMap) (pos : Lsp.Position) : String.Pos :=
|
||||
let colPos :=
|
||||
if h : pos.line < text.positions.size then
|
||||
text.positions.get ⟨pos.line, h⟩
|
||||
else if text.positions.isEmpty then
|
||||
0
|
||||
else
|
||||
text.positions.back
|
||||
let chr := text.source.utf16PosToCodepointPosFrom pos.character colPos
|
||||
text.source.codepointPosToUtf8PosFrom colPos chr
|
||||
let lineStartPos := lineStartPos text pos.line
|
||||
let chr := text.source.utf16PosToCodepointPosFrom pos.character lineStartPos
|
||||
text.source.codepointPosToUtf8PosFrom lineStartPos chr
|
||||
|
||||
def leanPosToLspPos (text : FileMap) : Lean.Position → Lsp.Position
|
||||
| ⟨ln, col⟩ => ⟨ln-1, text.source.codepointPosToUtf16PosFrom col (text.positions.get! $ ln - 1)⟩
|
||||
| ⟨line, col⟩ =>
|
||||
⟨line - 1, text.source.codepointPosToUtf16PosFrom col (lineStartPos text (line - 1))⟩
|
||||
|
||||
def utf8PosToLspPos (text : FileMap) (pos : String.Pos) : Lsp.Position :=
|
||||
text.leanPosToLspPos (text.toPosition pos)
|
||||
|
||||
@@ -69,4 +69,10 @@ def NameTrie.forMatchingM [Monad m] (t : NameTrie β) (k : Name) (f : β → m U
|
||||
def NameTrie.forM [Monad m] (t : NameTrie β) (f : β → m Unit) : m Unit :=
|
||||
t.forMatchingM Name.anonymous f
|
||||
|
||||
def NameTrie.matchingToArray (t : NameTrie β) (k : Name) : Array β :=
|
||||
Id.run <| t.foldMatchingM k #[] fun v acc => acc.push v
|
||||
|
||||
def NameTrie.toArray (t : NameTrie β) : Array β :=
|
||||
Id.run <| t.foldM #[] fun v acc => acc.push v
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -97,7 +97,7 @@ def toList (m : SMap α β) : List (α × β) :=
|
||||
|
||||
end SMap
|
||||
|
||||
def List.toSMap [BEq α] [Hashable α] (es : List (α × β)) : SMap α β :=
|
||||
def _root_.List.toSMap [BEq α] [Hashable α] (es : List (α × β)) : SMap α β :=
|
||||
es.foldl (init := {}) fun s (a, b) => s.insert a b
|
||||
|
||||
instance {_ : BEq α} {_ : Hashable α} [Repr α] [Repr β] : Repr (SMap α β) where
|
||||
|
||||
@@ -348,7 +348,7 @@ def elabMutual : CommandElab := fun stx => do
|
||||
throwErrorAt bad "invalid 'decreasing_by' in 'mutual' block, it must be used after the 'end' keyword"
|
||||
elabMutualDef stx[1].getArgs hints
|
||||
else
|
||||
throwError "invalid mutual block"
|
||||
throwError "invalid mutual block: either all elements of the block must be inductive declarations, or they must all be definitions/theorems/abbrevs"
|
||||
|
||||
/- leading_parser "attribute " >> "[" >> sepBy1 (eraseAttr <|> Term.attrInstance) ", " >> "]" >> many1 ident -/
|
||||
@[builtin_command_elab «attribute»] def elabAttr : CommandElab := fun stx => do
|
||||
|
||||
@@ -24,15 +24,15 @@ where
|
||||
| [] => ``(isTrue rfl)
|
||||
| (a, b, recField, isProof) :: todo => withFreshMacroScope do
|
||||
let rhs ← if isProof then
|
||||
`(have h : $a = $b := rfl; by subst h; exact $(← mkSameCtorRhs todo):term)
|
||||
`(have h : @$a = @$b := rfl; by subst h; exact $(← mkSameCtorRhs todo):term)
|
||||
else
|
||||
`(if h : $a = $b then
|
||||
`(if h : @$a = @$b then
|
||||
by subst h; exact $(← mkSameCtorRhs todo):term
|
||||
else
|
||||
isFalse (by intro n; injection n; apply h _; assumption))
|
||||
if let some auxFunName := recField then
|
||||
-- add local instance for `a = b` using the function being defined `auxFunName`
|
||||
`(let inst := $(mkIdent auxFunName) $a $b; $rhs)
|
||||
`(let inst := $(mkIdent auxFunName) @$a @$b; $rhs)
|
||||
else
|
||||
return rhs
|
||||
|
||||
|
||||
@@ -146,7 +146,6 @@ partial def collect (stx : Syntax) : M Syntax := withRef stx <| withFreshMacroSc
|
||||
```
|
||||
def namedPattern := check... >> trailing_parser "@" >> optional (atomic (ident >> ":")) >> termParser
|
||||
```
|
||||
TODO: pattern variable for equality proof
|
||||
-/
|
||||
let id := stx[0]
|
||||
discard <| processVar id
|
||||
|
||||
@@ -100,8 +100,8 @@ def addPreDefinitions (preDefs : Array PreDefinition) (hints : TerminationHints)
|
||||
let preDefs ← preDefs.mapM ensureNoUnassignedMVarsAtPreDef
|
||||
let preDefs ← betaReduceLetRecApps preDefs
|
||||
let cliques := partitionPreDefs preDefs
|
||||
let mut terminationBy ← liftMacroM <| WF.expandTerminationBy hints.terminationBy? (cliques.map fun ds => ds.map (·.declName))
|
||||
let mut decreasingBy ← liftMacroM <| WF.expandTerminationHint hints.decreasingBy? (cliques.map fun ds => ds.map (·.declName))
|
||||
let mut terminationBy ← liftMacroM <| WF.expandTerminationBy? hints.terminationBy? (cliques.map fun ds => ds.map (·.declName))
|
||||
let mut decreasingBy ← liftMacroM <| WF.expandDecreasingBy? hints.decreasingBy? (cliques.map fun ds => ds.map (·.declName))
|
||||
let mut hasErrors := false
|
||||
for preDefs in cliques do
|
||||
trace[Elab.definition.scc] "{preDefs.map (·.declName)}"
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Transform
|
||||
import Lean.Elab.RecAppSyntax
|
||||
|
||||
namespace Lean.Elab.Structural
|
||||
open Meta
|
||||
@@ -15,21 +16,39 @@ private def shouldBetaReduce (e : Expr) (recFnName : Name) : Bool :=
|
||||
false
|
||||
|
||||
/--
|
||||
Beta reduce terms where the recursive function occurs in the lambda term.
|
||||
This is useful to improve the effectiveness of `elimRecursion`.
|
||||
Preprocesses the expessions to improve the effectiveness of `elimRecursion`.
|
||||
|
||||
* Beta reduce terms where the recursive function occurs in the lambda term.
|
||||
Example:
|
||||
```
|
||||
def f : Nat → Nat
|
||||
| 0 => 1
|
||||
| i+1 => (fun x => f x) i
|
||||
```
|
||||
|
||||
* Floats out the RecApp markers.
|
||||
Example:
|
||||
```
|
||||
def f : Nat → Nat
|
||||
| 0 => 1
|
||||
| i+1 => (f x) i
|
||||
```
|
||||
-/
|
||||
def preprocess (e : Expr) (recFnName : Name) : CoreM Expr :=
|
||||
Core.transform e
|
||||
fun e =>
|
||||
if shouldBetaReduce e recFnName then
|
||||
return .visit e.headBeta
|
||||
else
|
||||
return .continue
|
||||
(pre := fun e =>
|
||||
if shouldBetaReduce e recFnName then
|
||||
return .visit e.headBeta
|
||||
else
|
||||
return .continue)
|
||||
(post := fun e =>
|
||||
match e with
|
||||
| .app (.mdata m f) a =>
|
||||
if m.isRecApp then
|
||||
return .done (.mdata m (.app f a))
|
||||
else
|
||||
return .done e
|
||||
| _ => return .done e)
|
||||
|
||||
|
||||
end Lean.Elab.Structural
|
||||
|
||||
@@ -13,28 +13,25 @@ import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
import Lean.Elab.PreDefinition.Structural.Basic
|
||||
import Lean.Elab.PreDefinition.Structural.BRecOn
|
||||
import Lean.Data.Array
|
||||
|
||||
namespace Lean.Elab.WF
|
||||
open Meta
|
||||
|
||||
private def applyDefaultDecrTactic (mvarId : MVarId) : TermElabM Unit := do
|
||||
let remainingGoals ← Tactic.run mvarId do
|
||||
Tactic.evalTactic (← `(tactic| decreasing_tactic))
|
||||
remainingGoals.forM fun mvarId => Term.reportUnsolvedGoals [mvarId]
|
||||
|
||||
private def mkDecreasingProof (decreasingProp : Expr) (decrTactic? : Option Syntax) : TermElabM Expr := do
|
||||
let mvar ← mkFreshExprSyntheticOpaqueMVar decreasingProp
|
||||
/-
|
||||
Creates a subgoal for a recursive call, as an unsolved `MVar`. The goal is cleaned up, and
|
||||
the current syntax reference is stored in the `MVar`’s type as a `RecApp` marker, for
|
||||
use by `solveDecreasingGoals` below.
|
||||
-/
|
||||
private def mkDecreasingProof (decreasingProp : Expr) : TermElabM Expr := do
|
||||
-- We store the current Ref in the MVar as a RecApp annotation around the type
|
||||
let ref ← getRef
|
||||
let mvar ← mkFreshExprSyntheticOpaqueMVar (mkRecAppWithSyntax decreasingProp ref)
|
||||
let mvarId := mvar.mvarId!
|
||||
let mvarId ← mvarId.cleanup
|
||||
match decrTactic? with
|
||||
| none => applyDefaultDecrTactic mvarId
|
||||
| some decrTactic =>
|
||||
-- make info from `runTactic` available
|
||||
pushInfoTree (.hole mvarId)
|
||||
Term.runTactic mvarId decrTactic
|
||||
instantiateMVars mvar
|
||||
let _mvarId ← mvarId.cleanup
|
||||
return mvar
|
||||
|
||||
private partial def replaceRecApps (recFnName : Name) (fixedPrefixSize : Nat) (decrTactic? : Option Syntax) (F : Expr) (e : Expr) : TermElabM Expr := do
|
||||
private partial def replaceRecApps (recFnName : Name) (fixedPrefixSize : Nat) (F : Expr) (e : Expr) : TermElabM Expr := do
|
||||
trace[Elab.definition.wf] "replaceRecApps:{indentExpr e}"
|
||||
trace[Elab.definition.wf] "{F} : {← inferType F}"
|
||||
loop F e |>.run' {}
|
||||
@@ -46,7 +43,7 @@ where
|
||||
let args := e.getAppArgs
|
||||
let r := mkApp F (← loop F args[fixedPrefixSize]!)
|
||||
let decreasingProp := (← whnf (← inferType r)).bindingDomain!
|
||||
let r := mkApp r (← mkDecreasingProof decreasingProp decrTactic?)
|
||||
let r := mkApp r (← mkDecreasingProof decreasingProp)
|
||||
return mkAppN r (← args[fixedPrefixSize+1:].toArray.mapM (loop F))
|
||||
|
||||
processApp (F : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) TermElabM Expr := do
|
||||
@@ -163,6 +160,47 @@ private partial def processPSigmaCasesOn (x F val : Expr) (k : (F : Expr) → (v
|
||||
else
|
||||
k F val
|
||||
|
||||
private def applyDefaultDecrTactic (mvarId : MVarId) : TermElabM Unit := do
|
||||
let remainingGoals ← Tactic.run mvarId do
|
||||
Tactic.evalTactic (← `(tactic| decreasing_tactic))
|
||||
unless remainingGoals.isEmpty do
|
||||
Term.reportUnsolvedGoals remainingGoals
|
||||
|
||||
/-
|
||||
Given an array of MVars, assign MVars with equal type and subsumed local context to each other.
|
||||
Returns those MVar that did not get assigned.
|
||||
-/
|
||||
def assignSubsumed (mvars : Array MVarId) : MetaM (Array MVarId) :=
|
||||
mvars.filterPairsM fun mv₁ mv₂ => do
|
||||
let mvdecl₁ ← mv₁.getDecl
|
||||
let mvdecl₂ ← mv₂.getDecl
|
||||
if mvdecl₁.type == mvdecl₂.type then
|
||||
-- same goals; check contexts.
|
||||
if mvdecl₁.lctx.isSubPrefixOf mvdecl₂.lctx then
|
||||
-- mv₁ is better
|
||||
mv₂.assign (.mvar mv₁)
|
||||
return (true, false)
|
||||
if mvdecl₂.lctx.isSubPrefixOf mvdecl₁.lctx then
|
||||
-- mv₂ is better
|
||||
mv₁.assign (.mvar mv₂)
|
||||
return (false, true)
|
||||
return (true, true)
|
||||
|
||||
def solveDecreasingGoals (decrTactic? : Option Syntax) (value : Expr) : MetaM Expr := do
|
||||
let goals ← getMVarsNoDelayed value
|
||||
let goals ← assignSubsumed goals
|
||||
goals.forM fun goal => Lean.Elab.Term.TermElabM.run' <|
|
||||
match decrTactic? with
|
||||
| none => do
|
||||
let some ref := getRecAppSyntax? (← goal.getType)
|
||||
| throwError "MVar does not look like like a recursive call"
|
||||
withRef ref <| applyDefaultDecrTactic goal
|
||||
| some decrTactic => do
|
||||
-- make info from `runTactic` available
|
||||
pushInfoTree (.hole goal)
|
||||
Term.runTactic goal decrTactic
|
||||
instantiateMVars value
|
||||
|
||||
def mkFix (preDef : PreDefinition) (prefixArgs : Array Expr) (wfRel : Expr) (decrTactic? : Option Syntax) : TermElabM Expr := do
|
||||
let type ← instantiateForall preDef.type prefixArgs
|
||||
let (wfFix, varName) ← forallBoundedTelescope type (some 1) fun x type => do
|
||||
@@ -185,7 +223,8 @@ def mkFix (preDef : PreDefinition) (prefixArgs : Array Expr) (wfRel : Expr) (dec
|
||||
let F := xs[1]!
|
||||
let val := preDef.value.beta (prefixArgs.push x)
|
||||
let val ← processSumCasesOn x F val fun x F val => do
|
||||
processPSigmaCasesOn x F val (replaceRecApps preDef.declName prefixArgs.size decrTactic?)
|
||||
processPSigmaCasesOn x F val (replaceRecApps preDef.declName prefixArgs.size)
|
||||
let val ← solveDecreasingGoals decrTactic? val
|
||||
mkLambdaFVars prefixArgs (mkApp wfFix (← mkLambdaFVars #[x, F] val))
|
||||
|
||||
end Lean.Elab.WF
|
||||
|
||||
743
src/Lean/Elab/PreDefinition/WF/GuessLex.lean
Normal file
743
src/Lean/Elab/PreDefinition/WF/GuessLex.lean
Normal file
@@ -0,0 +1,743 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joachim Breitner
|
||||
-/
|
||||
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.CasesOn
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Meta.Tactic.Cleanup
|
||||
import Lean.Meta.Tactic.Refl
|
||||
import Lean.Elab.Quotation
|
||||
import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
import Lean.Elab.PreDefinition.Structural.Basic
|
||||
import Lean.Elab.PreDefinition.WF.TerminationHint
|
||||
import Lean.Data.Array
|
||||
|
||||
|
||||
/-!
|
||||
This module finds lexicographic termination arguments for well-founded recursion.
|
||||
|
||||
Starting with basic measures (`sizeOf xᵢ` for all parameters `xᵢ`), it tries all combinations
|
||||
until it finds one where all proof obligations go through with the given tactic (`decerasing_by`),
|
||||
if given, or the default `decreasing_tactic`.
|
||||
|
||||
For mutual recursion, a single measure is not just one parameter, but one from each recursive
|
||||
function. Enumerating these can lead to a combinatoric explosion, so we bound
|
||||
the nubmer of measures tried.
|
||||
|
||||
In addition to measures derived from `sizeOf xᵢ`, it also considers measures
|
||||
that assign an order to the functions themselves. This way we can support mutual
|
||||
function definitions where no arguments decrease from one function to another.
|
||||
|
||||
The result of this module is a `TerminationWF`, which is then passed on to `wfRecursion`; this
|
||||
design is crucial so that whatever we infer in this module could also be written manually by the
|
||||
user. It would be bad if there are function definitions that can only be processed with the
|
||||
guessed lexicographic order.
|
||||
|
||||
The following optimizations are applied to make this feasible:
|
||||
|
||||
1. The crucial optimiziation is to look at each argument of each recursive call
|
||||
_once_, try to prove `<` and (if that fails `≤`), and then look at that table to
|
||||
pick a suitable measure.
|
||||
|
||||
2. The next-crucial optimization is to fill that table lazily. This way, we run the (likely
|
||||
expensive) tactics as few times as possible, while still being able to consider a possibly
|
||||
large number of combinations.
|
||||
|
||||
3. Before we even try to prove `<`, we check if the arguments are equal (`=`). No well-founded
|
||||
measure will relate equal terms, likely this check is faster than firing up the tactic engine,
|
||||
and it adds more signal to the output.
|
||||
|
||||
4. Instead of traversing the whole function body over and over, we traverse it once and store
|
||||
the arguments (in unpacked form) and the local `MetaM` state at each recursive call
|
||||
(see `collectRecCalls`), which we then re-use for the possibly many proof attempts.
|
||||
|
||||
The logic here is based on “Finding Lexicographic Orders for Termination Proofs in Isabelle/HOL”
|
||||
by Lukas Bulwahn, Alexander Krauss, and Tobias Nipkow, 10.1007/978-3-540-74591-4_5
|
||||
<https://www21.in.tum.de/~nipkow/pubs/tphols07.pdf>.
|
||||
-/
|
||||
|
||||
set_option autoImplicit false
|
||||
|
||||
open Lean Meta Elab
|
||||
|
||||
namespace Lean.Elab.WF.GuessLex
|
||||
|
||||
register_builtin_option showInferredTerminationBy : Bool := {
|
||||
defValue := false
|
||||
descr := "In recursive definitions, show the inferred `termination_by` measure."
|
||||
}
|
||||
|
||||
/--
|
||||
Given a predefinition, find good variable names for its parameters.
|
||||
Use user-given parameter names if present; use x1...xn otherwise.
|
||||
|
||||
The length of the returned array is also used to determine the arity
|
||||
of the function, so it should match what `packDomain` does.
|
||||
|
||||
The names ought to accessible (no macro scopes) and still fresh wrt to the current environment,
|
||||
so that with `showInferredTerminationBy` we can print them to the user reliably.
|
||||
We do that by appending `'` as needed.
|
||||
-/
|
||||
partial
|
||||
def naryVarNames (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Array Name):= do
|
||||
lambdaTelescope preDef.value fun xs _ => do
|
||||
let xs := xs.extract fixedPrefixSize xs.size
|
||||
let mut ns : Array Name := #[]
|
||||
for h : i in [:xs.size] do
|
||||
let n ← (xs[i]'h.2).fvarId!.getUserName
|
||||
let n := if n.hasMacroScopes then .mkSimple s!"x{i+1}" else n
|
||||
ns := ns.push (← freshen ns n)
|
||||
return ns
|
||||
where
|
||||
freshen (ns : Array Name) (n : Name): MetaM Name := do
|
||||
if !(ns.elem n) && (← resolveGlobalName n).isEmpty then
|
||||
return n
|
||||
else
|
||||
freshen ns (n.appendAfter "'")
|
||||
|
||||
|
||||
/-- Internal monad used by `withRecApps` -/
|
||||
abbrev M (recFnName : Name) (α β : Type) : Type :=
|
||||
StateRefT (Array α) (StateRefT (HasConstCache recFnName) MetaM) β
|
||||
|
||||
/--
|
||||
Traverses the given expression `e`, and invokes the continuation `k`
|
||||
at every saturated call to `recFnName`.
|
||||
|
||||
The expression `param` is passed along, and refined when going under a matcher
|
||||
or `casesOn` application.
|
||||
-/
|
||||
partial def withRecApps {α} (recFnName : Name) (fixedPrefixSize : Nat) (param : Expr) (e : Expr)
|
||||
(k : Expr → Array Expr → MetaM α) : MetaM (Array α) := do
|
||||
trace[Elab.definition.wf] "withRecApps: {indentExpr e}"
|
||||
let (_, as) ← loop param e |>.run #[] |>.run' {}
|
||||
return as
|
||||
where
|
||||
processRec (param : Expr) (e : Expr) : M recFnName α Unit := do
|
||||
if e.getAppNumArgs < fixedPrefixSize + 1 then
|
||||
loop param (← etaExpand e)
|
||||
else
|
||||
let a ← k param e.getAppArgs
|
||||
modifyThe (Array α) (·.push a)
|
||||
|
||||
processApp (param : Expr) (e : Expr) : M recFnName α Unit := do
|
||||
e.withApp fun f args => do
|
||||
args.forM (loop param)
|
||||
if f.isConstOf recFnName then
|
||||
processRec param e
|
||||
else
|
||||
loop param f
|
||||
|
||||
containsRecFn (e : Expr) : M recFnName α Bool := do
|
||||
modifyGetThe (HasConstCache recFnName) (·.contains e)
|
||||
|
||||
loop (param : Expr) (e : Expr) : M recFnName α Unit := do
|
||||
if !(← containsRecFn e) then
|
||||
return
|
||||
match e with
|
||||
| Expr.lam n d b c =>
|
||||
loop param d
|
||||
withLocalDecl n c d fun x => do
|
||||
loop param (b.instantiate1 x)
|
||||
| Expr.forallE n d b c =>
|
||||
loop param d
|
||||
withLocalDecl n c d fun x => do
|
||||
loop param (b.instantiate1 x)
|
||||
| Expr.letE n type val body _ =>
|
||||
loop param type
|
||||
loop param val
|
||||
withLetDecl n type val fun x => do
|
||||
loop param (body.instantiate1 x)
|
||||
| Expr.mdata _d b =>
|
||||
if let some stx := getRecAppSyntax? e then
|
||||
withRef stx <| loop param b
|
||||
else
|
||||
loop param b
|
||||
| Expr.proj _n _i e => loop param e
|
||||
| Expr.const .. => if e.isConstOf recFnName then processRec param e
|
||||
| Expr.app .. =>
|
||||
match (← matchMatcherApp? e) with
|
||||
| some matcherApp =>
|
||||
if !Structural.recArgHasLooseBVarsAt recFnName fixedPrefixSize e then
|
||||
processApp param e
|
||||
else
|
||||
if let some altParams ← matcherApp.refineThrough? param then
|
||||
(Array.zip matcherApp.alts (Array.zip matcherApp.altNumParams altParams)).forM
|
||||
fun (alt, altNumParam, altParam) =>
|
||||
lambdaTelescope altParam fun xs altParam => do
|
||||
-- TODO: Use boundedLambdaTelescope
|
||||
unless altNumParam = xs.size do
|
||||
throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let altBody := alt.beta xs
|
||||
loop altParam altBody
|
||||
else
|
||||
processApp param e
|
||||
| none =>
|
||||
match (← toCasesOnApp? e) with
|
||||
| some casesOnApp =>
|
||||
if !Structural.recArgHasLooseBVarsAt recFnName fixedPrefixSize e then
|
||||
processApp param e
|
||||
else
|
||||
if let some altParams ← casesOnApp.refineThrough? param then
|
||||
(Array.zip casesOnApp.alts (Array.zip casesOnApp.altNumParams altParams)).forM
|
||||
fun (alt, altNumParam, altParam) =>
|
||||
lambdaTelescope altParam fun xs altParam => do
|
||||
-- TODO: Use boundedLambdaTelescope
|
||||
unless altNumParam = xs.size do
|
||||
throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let altBody := alt.beta xs
|
||||
loop altParam altBody
|
||||
else
|
||||
processApp param e
|
||||
| none => processApp param e
|
||||
| e => do
|
||||
let _ ← ensureNoRecFn recFnName e
|
||||
|
||||
/--
|
||||
A `SavedLocalContext` captures the state and local context of a `MetaM`, to be continued later.
|
||||
-/
|
||||
structure SavedLocalContext where
|
||||
savedLocalContext : LocalContext
|
||||
savedLocalInstances : LocalInstances
|
||||
savedState : Meta.SavedState
|
||||
|
||||
/-- Capture the `MetaM` state including local context. -/
|
||||
def SavedLocalContext.create : MetaM SavedLocalContext := do
|
||||
let savedLocalContext ← getLCtx
|
||||
let savedLocalInstances ← getLocalInstances
|
||||
let savedState ← saveState
|
||||
return { savedLocalContext, savedLocalInstances, savedState }
|
||||
|
||||
/-- Run a `MetaM` action in the saved state. -/
|
||||
def SavedLocalContext.run {α} (slc : SavedLocalContext) (k : MetaM α) :
|
||||
MetaM α :=
|
||||
withoutModifyingState $ do
|
||||
withLCtx slc.savedLocalContext slc.savedLocalInstances do
|
||||
slc.savedState.restore
|
||||
k
|
||||
|
||||
/-- A `RecCallWithContext` focuses on a single recursive call in a unary predefinition,
|
||||
and runs the given action in the context of that call. -/
|
||||
structure RecCallWithContext where
|
||||
/-- Syntax location of reursive call -/
|
||||
ref : Syntax
|
||||
/-- Function index of caller -/
|
||||
caller : Nat
|
||||
/-- Parameters of caller -/
|
||||
params : Array Expr
|
||||
/-- Function index of callee -/
|
||||
callee : Nat
|
||||
/-- Arguments to callee -/
|
||||
args : Array Expr
|
||||
ctxt : SavedLocalContext
|
||||
|
||||
/-- Store the current recursive call and its context. -/
|
||||
def RecCallWithContext.create (ref : Syntax) (caller : Nat) (params : Array Expr) (callee : Nat)
|
||||
(args : Array Expr) : MetaM RecCallWithContext := do
|
||||
return { ref, caller, params, callee, args, ctxt := (← SavedLocalContext.create) }
|
||||
|
||||
|
||||
/--
|
||||
The elaborator is prone to duplicate terms, including recursive calls, even if the user
|
||||
only wrote a single one. This duplication is wasteful if we run the tactics on duplicated
|
||||
calls, and confusing in the output of GuessLex. So prune the list of recursive calls,
|
||||
and remove those where another call exists that has the same goal and context that is no more
|
||||
specific.
|
||||
-/
|
||||
def filterSubsumed (rcs : Array RecCallWithContext ) : Array RecCallWithContext := Id.run do
|
||||
rcs.filterPairsM fun rci rcj => do
|
||||
if rci.caller == rcj.caller && rci.callee == rcj.callee &&
|
||||
rci.params == rcj.params && rci.args == rcj.args then
|
||||
-- same goals; check contexts.
|
||||
let lci := rci.ctxt.savedLocalContext
|
||||
let lcj := rcj.ctxt.savedLocalContext
|
||||
if lci.isSubPrefixOf lcj then
|
||||
-- rci is better
|
||||
return (true, false)
|
||||
else if lcj.isSubPrefixOf lci then
|
||||
-- rcj is better
|
||||
return (false, true)
|
||||
return (true, true)
|
||||
|
||||
/-- Given the packed argument of a (possibly) mutual and (possibly) nary call,
|
||||
return the function index that is called and the arguments individually.
|
||||
|
||||
We expect precisely the expressions produced by `packMutual`, with manifest
|
||||
`PSum.inr`, `PSum.inl` and `PSigma.mk` constructors, and thus take them apart
|
||||
rather than using projectinos. -/
|
||||
def unpackArg {m} [Monad m] [MonadError m] (arities : Array Nat) (e : Expr) :
|
||||
m (Nat × Array Expr) := do
|
||||
-- count PSum injections to find out which function is doing the call
|
||||
let mut funidx := 0
|
||||
let mut e := e
|
||||
while funidx + 1 < arities.size do
|
||||
if e.isAppOfArity ``PSum.inr 3 then
|
||||
e := e.getArg! 2
|
||||
funidx := funidx + 1
|
||||
else if e.isAppOfArity ``PSum.inl 3 then
|
||||
e := e.getArg! 2
|
||||
break
|
||||
else
|
||||
throwError "Unexpected expression while unpacking mutual argument"
|
||||
|
||||
-- now unpack PSigmas
|
||||
let arity := arities[funidx]!
|
||||
let mut args := #[]
|
||||
while args.size + 1 < arity do
|
||||
if e.isAppOfArity ``PSigma.mk 4 then
|
||||
args := args.push (e.getArg! 2)
|
||||
e := e.getArg! 3
|
||||
else
|
||||
throwError "Unexpected expression while unpacking n-ary argument"
|
||||
args := args.push e
|
||||
return (funidx, args)
|
||||
|
||||
/-- Traverse a unary PreDefinition, and returns a `WithRecCall` closure for each recursive
|
||||
call site.
|
||||
-/
|
||||
def collectRecCalls (unaryPreDef : PreDefinition) (fixedPrefixSize : Nat) (arities : Array Nat)
|
||||
: MetaM (Array RecCallWithContext) := withoutModifyingState do
|
||||
addAsAxiom unaryPreDef
|
||||
lambdaTelescope unaryPreDef.value fun xs body => do
|
||||
unless xs.size == fixedPrefixSize + 1 do
|
||||
-- Maybe cleaner to have lambdaBoundedTelescope?
|
||||
throwError "Unexpected number of lambdas in unary pre-definition"
|
||||
-- trace[Elab.definition.wf] "collectRecCalls: {xs} {body}"
|
||||
let param := xs[fixedPrefixSize]!
|
||||
withRecApps unaryPreDef.declName fixedPrefixSize param body fun param args => do
|
||||
unless args.size ≥ fixedPrefixSize + 1 do
|
||||
throwError "Insufficient arguments in recursive call"
|
||||
let arg := args[fixedPrefixSize]!
|
||||
let (caller, params) ← unpackArg arities param
|
||||
let (callee, args) ← unpackArg arities arg
|
||||
RecCallWithContext.create (← getRef) caller params callee args
|
||||
|
||||
/-- A `GuessLexRel` described how a recursive call affects a measure; whether it
|
||||
decreases strictly, non-strictly, is equal, or else. -/
|
||||
inductive GuessLexRel | lt | eq | le | no_idea
|
||||
deriving Repr, DecidableEq
|
||||
|
||||
instance : ToString GuessLexRel where
|
||||
toString | .lt => "<"
|
||||
| .eq => "="
|
||||
| .le => "≤"
|
||||
| .no_idea => "?"
|
||||
|
||||
instance : ToFormat GuessLexRel where
|
||||
format r := toString r
|
||||
|
||||
/-- Given a `GuessLexRel`, produce a binary `Expr` that relates two `Nat` values accordingly. -/
|
||||
def GuessLexRel.toNatRel : GuessLexRel → Expr
|
||||
| lt => mkAppN (mkConst ``LT.lt [levelZero]) #[mkConst ``Nat, mkConst ``instLTNat]
|
||||
| eq => mkAppN (mkConst ``Eq [levelOne]) #[mkConst ``Nat]
|
||||
| le => mkAppN (mkConst ``LE.le [levelZero]) #[mkConst ``Nat, mkConst ``instLENat]
|
||||
| no_idea => unreachable!
|
||||
|
||||
/-- Given an expression `e`, produce `sizeOf e` with a suitable instance. -/
|
||||
def mkSizeOf (e : Expr) : MetaM Expr := do
|
||||
let ty ← inferType e
|
||||
let lvl ← getLevel ty
|
||||
let inst ← synthInstance (mkAppN (mkConst ``SizeOf [lvl]) #[ty])
|
||||
let res := mkAppN (mkConst ``sizeOf [lvl]) #[ty, inst, e]
|
||||
check res
|
||||
return res
|
||||
|
||||
/--
|
||||
For a given recursive call, and a choice of parameter and argument index,
|
||||
try to prove equality, < or ≤.
|
||||
-/
|
||||
def evalRecCall (decrTactic? : Option Syntax) (rcc : RecCallWithContext) (paramIdx argIdx : Nat) :
|
||||
MetaM GuessLexRel := do
|
||||
rcc.ctxt.run do
|
||||
let param := rcc.params[paramIdx]!
|
||||
let arg := rcc.args[argIdx]!
|
||||
trace[Elab.definition.wf] "inspectRecCall: {rcc.caller} ({param}) → {rcc.callee} ({arg})"
|
||||
let arg ← mkSizeOf rcc.args[argIdx]!
|
||||
let param ← mkSizeOf rcc.params[paramIdx]!
|
||||
for rel in [GuessLexRel.eq, .lt, .le] do
|
||||
let goalExpr := mkAppN rel.toNatRel #[arg, param]
|
||||
trace[Elab.definition.wf] "Goal for {rel}: {goalExpr}"
|
||||
check goalExpr
|
||||
|
||||
let mvar ← mkFreshExprSyntheticOpaqueMVar goalExpr
|
||||
let mvarId := mvar.mvarId!
|
||||
let mvarId ← mvarId.cleanup
|
||||
-- logInfo m!"Remaining goals: {goalsToMessageData [mvarId]}"
|
||||
try
|
||||
if rel = .eq then
|
||||
MVarId.refl mvarId
|
||||
else do
|
||||
Lean.Elab.Term.TermElabM.run' do
|
||||
match decrTactic? with
|
||||
| none =>
|
||||
let remainingGoals ← Tactic.run mvarId do
|
||||
Tactic.evalTactic (← `(tactic| decreasing_tactic))
|
||||
remainingGoals.forM fun mvarId => Term.reportUnsolvedGoals [mvarId]
|
||||
-- trace[Elab.definition.wf] "Found {rel} proof: {← instantiateMVars mvar}"
|
||||
pure ()
|
||||
| some decrTactic => Term.withoutErrToSorry do
|
||||
-- make info from `runTactic` available
|
||||
pushInfoTree (.hole mvarId)
|
||||
Term.runTactic mvarId decrTactic
|
||||
-- trace[Elab.definition.wf] "Found {rel} proof: {← instantiateMVars mvar}"
|
||||
pure ()
|
||||
trace[Elab.definition.wf] "inspectRecCall: success!"
|
||||
return rel
|
||||
catch _e =>
|
||||
trace[Elab.definition.wf] "Did not find {rel} proof: {goalsToMessageData [mvarId]}"
|
||||
continue
|
||||
return .no_idea
|
||||
|
||||
/- A cache for `evalRecCall` -/
|
||||
structure RecCallCache where mk'' ::
|
||||
decrTactic? : Option Syntax
|
||||
rcc : RecCallWithContext
|
||||
cache : IO.Ref (Array (Array (Option GuessLexRel)))
|
||||
|
||||
/-- Create a cache to memoize calls to `evalRecCall descTactic? rcc` -/
|
||||
def RecCallCache.mk (decrTactic? : Option Syntax) (rcc : RecCallWithContext) :
|
||||
BaseIO RecCallCache := do
|
||||
let cache ← IO.mkRef <| Array.mkArray rcc.params.size (Array.mkArray rcc.args.size Option.none)
|
||||
return { decrTactic?, rcc, cache }
|
||||
|
||||
/-- Run `evalRecCall` and cache there result -/
|
||||
def RecCallCache.eval (rc: RecCallCache) (paramIdx argIdx : Nat) : MetaM GuessLexRel := do
|
||||
-- Check the cache first
|
||||
if let Option.some res := (← rc.cache.get)[paramIdx]![argIdx]! then
|
||||
return res
|
||||
else
|
||||
let res ← evalRecCall rc.decrTactic? rc.rcc paramIdx argIdx
|
||||
rc.cache.modify (·.modify paramIdx (·.set! argIdx res))
|
||||
return res
|
||||
|
||||
|
||||
/-- Print a single cache entry as a string, without forcing it -/
|
||||
def RecCallCache.prettyEntry (rcc : RecCallCache) (paramIdx argIdx : Nat) : MetaM String := do
|
||||
let cachedEntries ← rcc.cache.get
|
||||
return match cachedEntries[paramIdx]![argIdx]! with
|
||||
| .some rel => toString rel
|
||||
| .none => "_"
|
||||
|
||||
/-- The measures that we order lexicographically can be comparing arguments,
|
||||
or numbering the functions -/
|
||||
inductive MutualMeasure where
|
||||
/-- For every function, the given argument index -/
|
||||
| args : Array Nat → MutualMeasure
|
||||
/-- The given function index is assigned 1, the rest 0 -/
|
||||
| func : Nat → MutualMeasure
|
||||
|
||||
/-- Evaluate a recursive call at a given `MutualMeasure` -/
|
||||
def inspectCall (rc : RecCallCache) : MutualMeasure → MetaM GuessLexRel
|
||||
| .args argIdxs => do
|
||||
let paramIdx := argIdxs[rc.rcc.caller]!
|
||||
let argIdx := argIdxs[rc.rcc.callee]!
|
||||
rc.eval paramIdx argIdx
|
||||
| .func funIdx => do
|
||||
if rc.rcc.caller == funIdx && rc.rcc.callee != funIdx then
|
||||
return .lt
|
||||
if rc.rcc.caller != funIdx && rc.rcc.callee == funIdx then
|
||||
return .no_idea
|
||||
else
|
||||
return .eq
|
||||
|
||||
/--
|
||||
Given a predefinition with value `fun (x_₁ ... xₙ) (y_₁ : α₁)... (yₘ : αₘ) => ...`,
|
||||
where `n = fixedPrefixSize`, return an array `A` s.t. `i ∈ A` iff `sizeOf yᵢ` reduces to a literal.
|
||||
This is the case for types such as `Prop`, `Type u`, etc.
|
||||
These arguments should not be considered when guessing a well-founded relation.
|
||||
See `generateCombinations?`
|
||||
-/
|
||||
def getForbiddenByTrivialSizeOf (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Array Nat) :=
|
||||
lambdaTelescope preDef.value fun xs _ => do
|
||||
let mut result := #[]
|
||||
for x in xs[fixedPrefixSize:], i in [:xs.size] do
|
||||
try
|
||||
let sizeOf ← whnfD (← mkAppM ``sizeOf #[x])
|
||||
if sizeOf.isLit then
|
||||
result := result.push i
|
||||
catch _ =>
|
||||
result := result.push i
|
||||
return result
|
||||
|
||||
|
||||
/--
|
||||
Generate all combination of arguments, skipping those that are forbidden.
|
||||
|
||||
Sorts the uniform combinations ([0,0,0], [1,1,1]) to the front; they are commonly most useful to
|
||||
try first, when the mutually recursive functions have similar argument structures
|
||||
-/
|
||||
partial def generateCombinations? (forbiddenArgs : Array (Array Nat)) (numArgs : Array Nat)
|
||||
(threshold : Nat := 32) : Option (Array (Array Nat)) :=
|
||||
(do goUniform 0; go 0 #[]) |>.run #[] |>.2
|
||||
where
|
||||
isForbidden (fidx : Nat) (argIdx : Nat) : Bool :=
|
||||
if h : fidx < forbiddenArgs.size then
|
||||
forbiddenArgs[fidx] |>.contains argIdx
|
||||
else
|
||||
false
|
||||
|
||||
-- Enumerate all permissible uniform combinations
|
||||
goUniform (argIdx : Nat) : OptionT (StateM (Array (Array Nat))) Unit := do
|
||||
if numArgs.all (argIdx < ·) then
|
||||
unless forbiddenArgs.any (·.contains argIdx) do
|
||||
modify (·.push (Array.mkArray numArgs.size argIdx))
|
||||
goUniform (argIdx + 1)
|
||||
|
||||
-- Enumerate all other permissible combinations
|
||||
go (fidx : Nat) : OptionT (ReaderT (Array Nat) (StateM (Array (Array Nat)))) Unit := do
|
||||
if h : fidx < numArgs.size then
|
||||
let n := numArgs[fidx]
|
||||
for argIdx in [:n] do
|
||||
unless isForbidden fidx argIdx do
|
||||
withReader (·.push argIdx) (go (fidx + 1))
|
||||
else
|
||||
let comb ← read
|
||||
unless comb.all (· == comb[0]!) do
|
||||
modify (·.push comb)
|
||||
if (← get).size > threshold then
|
||||
failure
|
||||
|
||||
|
||||
/--
|
||||
Enumerate all meausures we want to try: All arguments (resp. combinations thereof) and
|
||||
possible orderings of functions (if more than one)
|
||||
-/
|
||||
def generateMeasures (forbiddenArgs : Array (Array Nat)) (arities : Array Nat) :
|
||||
MetaM (Array MutualMeasure) := do
|
||||
let some arg_measures := generateCombinations? forbiddenArgs arities
|
||||
| throwError "Too many combinations"
|
||||
|
||||
let func_measures :=
|
||||
if arities.size > 1 then
|
||||
(List.range arities.size).toArray
|
||||
else
|
||||
#[]
|
||||
|
||||
return arg_measures.map .args ++ func_measures.map .func
|
||||
|
||||
/--
|
||||
The core logic of guessing the lexicographic order
|
||||
Given a matrix that for each call and measure indicates whether that measure is
|
||||
decreasing, equal, less-or-equal or unknown, It finds a sequence of measures
|
||||
that is lexicographically decreasing.
|
||||
|
||||
The matrix is implemented here as an array of monadic query methods only so that
|
||||
we can fill is lazily. Morally, this is a pure function
|
||||
-/
|
||||
partial def solve {m} {α} [Monad m] (measures : Array α)
|
||||
(calls : Array (α → m GuessLexRel)) : m (Option (Array α)) := do
|
||||
go measures calls #[]
|
||||
where
|
||||
go (measures : Array α) (calls : Array (α → m GuessLexRel)) (acc : Array α) := do
|
||||
if calls.isEmpty then return .some acc
|
||||
|
||||
-- Find the first measure that has at least one < and otherwise only = or <=
|
||||
for h : measureIdx in [:measures.size] do
|
||||
let measure := measures[measureIdx]'h.2
|
||||
let mut has_lt := false
|
||||
let mut all_le := true
|
||||
let mut todo := #[]
|
||||
for call in calls do
|
||||
let entry ← call measure
|
||||
if entry = .lt then
|
||||
has_lt := true
|
||||
else
|
||||
todo := todo.push call
|
||||
if entry != .le && entry != .eq then
|
||||
all_le := false
|
||||
break
|
||||
-- No progress here? Try the next measure
|
||||
if not (has_lt && all_le) then continue
|
||||
-- We found a suitable measure, remove it from the list (mild optimization)
|
||||
let measures' := measures.eraseIdx measureIdx
|
||||
return ← go measures' todo (acc.push measure)
|
||||
-- None found, we have to give up
|
||||
return .none
|
||||
|
||||
/--
|
||||
Create Tuple syntax (`()` if the array is empty, and just the value if its a singleton)
|
||||
-/
|
||||
def mkTupleSyntax : Array Term → MetaM Term
|
||||
| #[] => `(())
|
||||
| #[e] => return e
|
||||
| es => `(($(es[0]!), $(es[1:]),*))
|
||||
|
||||
/--
|
||||
Given an array of `MutualMeasures`, creates a `TerminationWF` that specifies the lexicographic
|
||||
combination of these measures.
|
||||
-/
|
||||
def buildTermWF (declNames : Array Name) (varNamess : Array (Array Name))
|
||||
(measures : Array MutualMeasure) : MetaM TerminationWF := do
|
||||
let mut termByElements := #[]
|
||||
for h : funIdx in [:varNamess.size] do
|
||||
let vars := (varNamess[funIdx]'h.2).map mkIdent
|
||||
let body ← mkTupleSyntax (← measures.mapM fun
|
||||
| .args varIdxs => do
|
||||
let v := vars.get! (varIdxs[funIdx]!)
|
||||
let sizeOfIdent := mkIdent (← unresolveNameGlobal ``sizeOf)
|
||||
`($sizeOfIdent $v)
|
||||
| .func funIdx' => if funIdx' == funIdx then `(1) else `(0)
|
||||
)
|
||||
let declName := declNames[funIdx]!
|
||||
|
||||
termByElements := termByElements.push
|
||||
{ ref := .missing
|
||||
declName, vars, body,
|
||||
implicit := true
|
||||
}
|
||||
return termByElements
|
||||
|
||||
|
||||
/--
|
||||
Given a matrix (row-major) of strings, arranges them in tabular form.
|
||||
First column is left-aligned, others right-aligned.
|
||||
Single space as column separator.
|
||||
-/
|
||||
def formatTable : Array (Array String) → String := fun xss => Id.run do
|
||||
let mut colWidths := xss[0]!.map (fun _ => 0)
|
||||
for i in [:xss.size] do
|
||||
for j in [:xss[i]!.size] do
|
||||
if xss[i]![j]!.length > colWidths[j]! then
|
||||
colWidths := colWidths.set! j xss[i]![j]!.length
|
||||
let mut str := ""
|
||||
for i in [:xss.size] do
|
||||
for j in [:xss[i]!.size] do
|
||||
let s := xss[i]![j]!
|
||||
if j > 0 then -- right-align
|
||||
for _ in [:colWidths[j]! - s.length] do
|
||||
str := str ++ " "
|
||||
str := str ++ s
|
||||
if j = 0 then -- left-align
|
||||
for _ in [:colWidths[j]! - s.length] do
|
||||
str := str ++ " "
|
||||
if j + 1 < xss[i]!.size then
|
||||
str := str ++ " "
|
||||
if i + 1 < xss.size then
|
||||
str := str ++ "\n"
|
||||
return str
|
||||
|
||||
/-- Concise textual representation of the source location of a recursive call -/
|
||||
def RecCallWithContext.posString (rcc : RecCallWithContext) : MetaM String := do
|
||||
let fileMap ← getFileMap
|
||||
let .some pos := rcc.ref.getPos? | return ""
|
||||
let position := fileMap.toPosition pos
|
||||
let endPosStr := match rcc.ref.getTailPos? with
|
||||
| some endPos =>
|
||||
let endPosition := fileMap.toPosition endPos
|
||||
if endPosition.line = position.line then
|
||||
s!"-{endPosition.column}"
|
||||
else
|
||||
s!"-{endPosition.line}:{endPosition.column}"
|
||||
| none => ""
|
||||
return s!"{position.line}:{position.column}{endPosStr}"
|
||||
|
||||
|
||||
/-- Explain what we found out about the recursive calls (non-mutual case) -/
|
||||
def explainNonMutualFailure (varNames : Array Name) (rcs : Array RecCallCache) : MetaM Format := do
|
||||
let header := varNames.map (·.eraseMacroScopes.toString)
|
||||
let mut table : Array (Array String) := #[#[""] ++ header]
|
||||
for i in [:rcs.size], rc in rcs do
|
||||
let mut row := #[s!"{i+1}) {← rc.rcc.posString}"]
|
||||
for argIdx in [:varNames.size] do
|
||||
row := row.push (← rc.prettyEntry argIdx argIdx)
|
||||
table := table.push row
|
||||
|
||||
return formatTable table
|
||||
|
||||
/-- Explain what we found out about the recursive calls (mutual case) -/
|
||||
def explainMutualFailure (declNames : Array Name) (varNamess : Array (Array Name))
|
||||
(rcs : Array RecCallCache) : MetaM Format := do
|
||||
let mut r := Format.nil
|
||||
|
||||
for rc in rcs do
|
||||
let caller := rc.rcc.caller
|
||||
let callee := rc.rcc.callee
|
||||
r := r ++ f!"Call from {declNames[caller]!} to {declNames[callee]!} " ++
|
||||
f!"at {← rc.rcc.posString}:\n"
|
||||
|
||||
let header := varNamess[caller]!.map (·.eraseMacroScopes.toString)
|
||||
let mut table : Array (Array String) := #[#[""] ++ header]
|
||||
if caller = callee then
|
||||
-- For self-calls, only the diagonal is interesting, so put it into one row
|
||||
let mut row := #[""]
|
||||
for argIdx in [:varNamess[caller]!.size] do
|
||||
row := row.push (← rc.prettyEntry argIdx argIdx)
|
||||
table := table.push row
|
||||
else
|
||||
for argIdx in [:varNamess[callee]!.size] do
|
||||
let mut row := #[]
|
||||
row := row.push varNamess[callee]![argIdx]!.eraseMacroScopes.toString
|
||||
for paramIdx in [:varNamess[caller]!.size] do
|
||||
row := row.push (← rc.prettyEntry paramIdx argIdx)
|
||||
table := table.push row
|
||||
r := r ++ formatTable table ++ "\n"
|
||||
|
||||
return r
|
||||
|
||||
def explainFailure (declNames : Array Name) (varNamess : Array (Array Name))
|
||||
(rcs : Array RecCallCache) : MetaM Format := do
|
||||
let mut r : Format := "The arguments relate at each recursive call as follows:\n" ++
|
||||
"(<, ≤, =: relation proved, ? all proofs failed, _: no proof attempted)\n"
|
||||
if declNames.size = 1 then
|
||||
r := r ++ (← explainNonMutualFailure varNamess[0]! rcs)
|
||||
else
|
||||
r := r ++ (← explainMutualFailure declNames varNamess rcs)
|
||||
return r
|
||||
|
||||
end Lean.Elab.WF.GuessLex
|
||||
|
||||
namespace Lean.Elab.WF
|
||||
|
||||
open Lean.Elab.WF.GuessLex
|
||||
|
||||
/--
|
||||
Main entry point of this module:
|
||||
|
||||
Try to find a lexicographic ordering of the arguments for which the recursive definition
|
||||
terminates. See the module doc string for a high-level overview.
|
||||
-/
|
||||
def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
|
||||
(fixedPrefixSize : Nat) (decrTactic? : Option Syntax) :
|
||||
MetaM TerminationWF := do
|
||||
let varNamess ← preDefs.mapM (naryVarNames fixedPrefixSize ·)
|
||||
let arities := varNamess.map (·.size)
|
||||
trace[Elab.definition.wf] "varNames is: {varNamess}"
|
||||
|
||||
let forbiddenArgs ← preDefs.mapM fun preDef =>
|
||||
getForbiddenByTrivialSizeOf fixedPrefixSize preDef
|
||||
|
||||
-- The list of measures, including the measures that order functions.
|
||||
-- The function ordering measures come last
|
||||
let measures ← generateMeasures forbiddenArgs arities
|
||||
|
||||
-- If there is only one plausible measure, use that
|
||||
if let #[solution] := measures then
|
||||
return ← buildTermWF (preDefs.map (·.declName)) varNamess #[solution]
|
||||
|
||||
-- Collect all recursive calls and extract their context
|
||||
let recCalls ← collectRecCalls unaryPreDef fixedPrefixSize arities
|
||||
let recCalls := filterSubsumed recCalls
|
||||
let rcs ← recCalls.mapM (RecCallCache.mk decrTactic? ·)
|
||||
let callMatrix := rcs.map (inspectCall ·)
|
||||
|
||||
match ← liftMetaM <| solve measures callMatrix with
|
||||
| .some solution => do
|
||||
let wf ← buildTermWF (preDefs.map (·.declName)) varNamess solution
|
||||
|
||||
let wfStx ← withoutModifyingState do
|
||||
preDefs.forM (addAsAxiom ·)
|
||||
wf.unexpand
|
||||
|
||||
if showInferredTerminationBy.get (← getOptions) then
|
||||
logInfo m!"Inferred termination argument:{wfStx}"
|
||||
|
||||
return wf
|
||||
| .none =>
|
||||
let explanation ← explainFailure (preDefs.map (·.declName)) varNamess rcs
|
||||
Lean.throwError <| "Could not find a decreasing measure.\n" ++
|
||||
explanation ++ "\n" ++
|
||||
"Please use `termination_by` to specify a decreasing measure."
|
||||
@@ -7,10 +7,12 @@ import Lean.Elab.PreDefinition.Basic
|
||||
import Lean.Elab.PreDefinition.WF.TerminationHint
|
||||
import Lean.Elab.PreDefinition.WF.PackDomain
|
||||
import Lean.Elab.PreDefinition.WF.PackMutual
|
||||
import Lean.Elab.PreDefinition.WF.Preprocess
|
||||
import Lean.Elab.PreDefinition.WF.Rel
|
||||
import Lean.Elab.PreDefinition.WF.Fix
|
||||
import Lean.Elab.PreDefinition.WF.Eqns
|
||||
import Lean.Elab.PreDefinition.WF.Ite
|
||||
import Lean.Elab.PreDefinition.WF.GuessLex
|
||||
|
||||
namespace Lean.Elab
|
||||
open WF
|
||||
@@ -79,6 +81,7 @@ private def isOnlyOneUnaryDef (preDefs : Array PreDefinition) (fixedPrefixSize :
|
||||
return false
|
||||
|
||||
def wfRecursion (preDefs : Array PreDefinition) (wf? : Option TerminationWF) (decrTactic? : Option Syntax) : TermElabM Unit := do
|
||||
let preDefs ← preDefs.mapM fun preDef => return { preDef with value := (← preprocess preDef.value) }
|
||||
let (unaryPreDef, fixedPrefixSize) ← withoutModifyingEnv do
|
||||
for preDef in preDefs do
|
||||
addAsAxiom preDef
|
||||
@@ -87,10 +90,17 @@ def wfRecursion (preDefs : Array PreDefinition) (wf? : Option TerminationWF) (de
|
||||
let preDefsDIte ← preDefs.mapM fun preDef => return { preDef with value := (← iteToDIte preDef.value) }
|
||||
let unaryPreDefs ← packDomain fixedPrefixSize preDefsDIte
|
||||
return (← packMutual fixedPrefixSize preDefs unaryPreDefs, fixedPrefixSize)
|
||||
|
||||
let wf ←
|
||||
if let .some wf := wf? then
|
||||
pure wf
|
||||
else
|
||||
guessLex preDefs unaryPreDef fixedPrefixSize decrTactic?
|
||||
|
||||
let preDefNonRec ← forallBoundedTelescope unaryPreDef.type fixedPrefixSize fun prefixArgs type => do
|
||||
let type ← whnfForall type
|
||||
let packedArgType := type.bindingDomain!
|
||||
elabWFRel preDefs unaryPreDef.declName fixedPrefixSize packedArgType wf? fun wfRel => do
|
||||
elabWFRel preDefs unaryPreDef.declName fixedPrefixSize packedArgType wf fun wfRel => do
|
||||
trace[Elab.definition.wf] "wfRel: {wfRel}"
|
||||
let (value, envNew) ← withoutModifyingEnv' do
|
||||
addAsAxiom unaryPreDef
|
||||
|
||||
@@ -124,7 +124,8 @@ where
|
||||
let args := e.getAppArgs
|
||||
let fNew := mkConst preDefsNew[funIdx]!.declName f.constLevels!
|
||||
let fNew := mkAppN fNew args[:fixedPrefix]
|
||||
let Expr.forallE _ d .. ← inferType fNew | unreachable!
|
||||
let Expr.forallE _ d .. ← whnf (← inferType fNew) | unreachable!
|
||||
-- NB: Use whnf in case the type is not a manifest forall, but a definition around it
|
||||
let argNew ← mkUnaryArg d args[fixedPrefix:]
|
||||
return mkApp fNew argNew
|
||||
let rec
|
||||
|
||||
@@ -51,13 +51,13 @@ private partial def mkNewCoDomain (preDefsOriginal : Array PreDefinition) (preDe
|
||||
let casesOn := mkAppN casesOn xTypeArgs -- parameters
|
||||
let casesOn := mkApp casesOn (← mkLambdaFVars #[x] (mkSort u)) -- motive
|
||||
let casesOn := mkApp casesOn x -- major
|
||||
let minor1 ← withLocalDeclD (← mkFreshUserName `_x) xTypeArgs[0]! fun x =>
|
||||
mkLambdaFVars #[x] (preDefTypes[i]!.bindingBody!.instantiate1 x)
|
||||
let minor1 ← withLocalDeclD (← mkFreshUserName `_x) xTypeArgs[0]! fun x => do
|
||||
mkLambdaFVars #[x] ((← whnf preDefTypes[i]!).bindingBody!.instantiate1 x)
|
||||
let minor2 ← withLocalDeclD (← mkFreshUserName `_x) xTypeArgs[1]! fun x => do
|
||||
mkLambdaFVars #[x] (← go x (i+1))
|
||||
return mkApp2 casesOn minor1 minor2
|
||||
else
|
||||
return preDefTypes[i]!.bindingBody!.instantiate1 x
|
||||
return (← whnf preDefTypes[i]!).bindingBody!.instantiate1 x
|
||||
go x 0
|
||||
|
||||
/--
|
||||
@@ -90,34 +90,52 @@ private partial def packValues (x : Expr) (codomain : Expr) (preDefValues : Arra
|
||||
go mvar.mvarId! x.fvarId! 0
|
||||
instantiateMVars mvar
|
||||
|
||||
/--
|
||||
Pass the first `n` arguments of `e` to the continuation, and apply the result to the
|
||||
remaining arguments. If `e` does not have enough arguments, it is eta-expanded as needed.
|
||||
|
||||
Unlike `Meta.etaExpand` does not use `withDefault`.
|
||||
-/
|
||||
def withAppN (n : Nat) (e : Expr) (k : Array Expr → MetaM Expr) : MetaM Expr := do
|
||||
let args := e.getAppArgs
|
||||
if n ≤ args.size then
|
||||
let e' ← k args[:n]
|
||||
return mkAppN e' args[n:]
|
||||
else
|
||||
let missing := n - args.size
|
||||
forallBoundedTelescope (← inferType e) missing fun xs _ => do
|
||||
if xs.size < missing then
|
||||
throwError "Failed to eta-expand partial application"
|
||||
let e' ← k (args ++ xs)
|
||||
mkLambdaFVars xs e'
|
||||
|
||||
/--
|
||||
Auxiliary function for replacing nested `preDefs` recursive calls in `e` with the new function `newFn`.
|
||||
See: `packMutual`
|
||||
-/
|
||||
private partial def post (fixedPrefix : Nat) (preDefs : Array PreDefinition) (domain : Expr) (newFn : Name) (e : Expr) : MetaM TransformStep := do
|
||||
if e.getAppNumArgs != fixedPrefix + 1 then
|
||||
return TransformStep.done e
|
||||
let f := e.getAppFn
|
||||
if !f.isConst then
|
||||
return TransformStep.done e
|
||||
let declName := f.constName!
|
||||
let us := f.constLevels!
|
||||
if let some fidx := preDefs.findIdx? (·.declName == declName) then
|
||||
let args := e.getAppArgs
|
||||
let fixedArgs := args[:fixedPrefix]
|
||||
let arg := args.back
|
||||
let rec mkNewArg (i : Nat) (type : Expr) : MetaM Expr := do
|
||||
if i == preDefs.size - 1 then
|
||||
return arg
|
||||
else
|
||||
(← whnfD type).withApp fun f args => do
|
||||
assert! args.size == 2
|
||||
if i == fidx then
|
||||
return mkApp3 (mkConst ``PSum.inl f.constLevels!) args[0]! args[1]! arg
|
||||
else
|
||||
let r ← mkNewArg (i+1) args[1]!
|
||||
return mkApp3 (mkConst ``PSum.inr f.constLevels!) args[0]! args[1]! r
|
||||
return TransformStep.done <| mkApp (mkAppN (mkConst newFn us) fixedArgs) (← mkNewArg 0 domain)
|
||||
let e' ← withAppN (fixedPrefix + 1) e fun args => do
|
||||
let fixedArgs := args[:fixedPrefix]
|
||||
let arg := args[fixedPrefix]!
|
||||
let rec mkNewArg (i : Nat) (type : Expr) : MetaM Expr := do
|
||||
if i == preDefs.size - 1 then
|
||||
return arg
|
||||
else
|
||||
(← whnfD type).withApp fun f args => do
|
||||
assert! args.size == 2
|
||||
if i == fidx then
|
||||
return mkApp3 (mkConst ``PSum.inl f.constLevels!) args[0]! args[1]! arg
|
||||
else
|
||||
let r ← mkNewArg (i+1) args[1]!
|
||||
return mkApp3 (mkConst ``PSum.inr f.constLevels!) args[0]! args[1]! r
|
||||
return mkApp (mkAppN (mkConst newFn us) fixedArgs) (← mkNewArg 0 domain)
|
||||
return TransformStep.done e'
|
||||
return TransformStep.done e
|
||||
|
||||
partial def withFixedPrefix (fixedPrefix : Nat) (preDefs : Array PreDefinition) (k : Array Expr → Array Expr → Array Expr → MetaM α) : MetaM α :=
|
||||
@@ -174,7 +192,7 @@ where
|
||||
def packMutual (fixedPrefix : Nat) (preDefsOriginal : Array PreDefinition) (preDefs : Array PreDefinition) : MetaM PreDefinition := do
|
||||
if preDefs.size == 1 then return preDefs[0]!
|
||||
withFixedPrefix fixedPrefix preDefs fun ys types vals => do
|
||||
let domains := types.map fun type => type.bindingDomain!
|
||||
let domains ← types.mapM fun type => do pure (← whnf type).bindingDomain!
|
||||
let domain ← mkNewDomain domains
|
||||
withLocalDeclD (← mkFreshUserName `_x) domain fun x => do
|
||||
let codomain ← mkNewCoDomain preDefsOriginal types x
|
||||
@@ -183,7 +201,7 @@ def packMutual (fixedPrefix : Nat) (preDefsOriginal : Array PreDefinition) (preD
|
||||
let newFn := preDefs[0]!.declName ++ `_mutual
|
||||
let preDefNew := { preDefs[0]! with declName := newFn, type, value }
|
||||
addAsAxiom preDefNew
|
||||
let value ← transform value (post := post fixedPrefix preDefs domain newFn)
|
||||
let value ← transform value (skipConstInApp := true) (post := post fixedPrefix preDefs domain newFn)
|
||||
let value ← mkLambdaFVars (ys.push x) value
|
||||
return { preDefNew with value }
|
||||
|
||||
|
||||
37
src/Lean/Elab/PreDefinition/WF/Preprocess.lean
Normal file
37
src/Lean/Elab/PreDefinition/WF/Preprocess.lean
Normal file
@@ -0,0 +1,37 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Transform
|
||||
import Lean.Elab.RecAppSyntax
|
||||
|
||||
namespace Lean.Elab.WF
|
||||
open Meta
|
||||
|
||||
/--
|
||||
Preprocesses the expessions to improve the effectiveness of `wfRecursion`.
|
||||
|
||||
* Floats out the RecApp markers.
|
||||
Example:
|
||||
```
|
||||
def f : Nat → Nat
|
||||
| 0 => 1
|
||||
| i+1 => (f x) i
|
||||
```
|
||||
|
||||
Unlike `Lean.Elab.Structural.preprocess`, do _not_ beta-reduce, as it could
|
||||
remove `let_fun`-lambdas that contain explicit termination proofs.
|
||||
-/
|
||||
def preprocess (e : Expr) : CoreM Expr :=
|
||||
Core.transform e
|
||||
(post := fun e =>
|
||||
match e with
|
||||
| .app (.mdata m f) a =>
|
||||
if m.isRecApp then
|
||||
return .done (.mdata m (.app f a))
|
||||
else
|
||||
return .done e
|
||||
| _ => return .done e)
|
||||
|
||||
end Lean.Elab.WF
|
||||
@@ -34,10 +34,10 @@ private partial def unpackUnary (preDef : PreDefinition) (prefixSize : Nat) (mva
|
||||
let mut varNames ← xs.mapM fun x => x.fvarId!.getUserName
|
||||
if element.vars.size > varNames.size then
|
||||
throwErrorAt element.vars[varNames.size]! "too many variable names"
|
||||
for i in [:element.vars.size] do
|
||||
let varStx := element.vars[i]!
|
||||
if varStx.isIdent then
|
||||
varNames := varNames.set! (varNames.size - element.vars.size + i) varStx.getId
|
||||
for h : i in [:element.vars.size] do
|
||||
let varStx := element.vars[i]'h.2
|
||||
if let `($ident:ident) := varStx then
|
||||
varNames := varNames.set! (varNames.size - element.vars.size + i) ident.getId
|
||||
return varNames
|
||||
let mut mvarId := mvarId
|
||||
for localDecl in (← Term.getMVarDecl mvarId).lctx, varName in varNames[:prefixSize] do
|
||||
@@ -53,112 +53,25 @@ private partial def unpackUnary (preDef : PreDefinition) (prefixSize : Nat) (mva
|
||||
mvarId.rename fvarId varNames.back
|
||||
go 0 mvarId fvarId
|
||||
|
||||
def getNumCandidateArgs (fixedPrefixSize : Nat) (preDefs : Array PreDefinition) : MetaM (Array Nat) := do
|
||||
preDefs.mapM fun preDef =>
|
||||
lambdaTelescope preDef.value fun xs _ =>
|
||||
return xs.size - fixedPrefixSize
|
||||
|
||||
/--
|
||||
Given a predefinition with value `fun (x_₁ ... xₙ) (y_₁ : α₁)... (yₘ : αₘ) => ...`,
|
||||
where `n = fixedPrefixSize`, return an array `A` s.t. `i ∈ A` iff `sizeOf yᵢ` reduces to a literal.
|
||||
This is the case for types such as `Prop`, `Type u`, etc.
|
||||
This arguments should not be considered when guessing a well-founded relation.
|
||||
See `generateCombinations?`
|
||||
-/
|
||||
def getForbiddenByTrivialSizeOf (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Array Nat) :=
|
||||
lambdaTelescope preDef.value fun xs _ => do
|
||||
let mut result := #[]
|
||||
for x in xs[fixedPrefixSize:], i in [:xs.size] do
|
||||
try
|
||||
let sizeOf ← whnfD (← mkAppM ``sizeOf #[x])
|
||||
if sizeOf.isLit then
|
||||
result := result.push i
|
||||
catch _ =>
|
||||
result := result.push i
|
||||
return result
|
||||
|
||||
def generateCombinations? (forbiddenArgs : Array (Array Nat)) (numArgs : Array Nat) (threshold : Nat := 32) : Option (Array (Array Nat)) :=
|
||||
go 0 #[] |>.run #[] |>.2
|
||||
where
|
||||
isForbidden (fidx : Nat) (argIdx : Nat) : Bool :=
|
||||
if h : fidx < forbiddenArgs.size then
|
||||
forbiddenArgs.get ⟨fidx, h⟩ |>.contains argIdx
|
||||
else
|
||||
false
|
||||
|
||||
go (fidx : Nat) : OptionT (ReaderT (Array Nat) (StateM (Array (Array Nat)))) Unit := do
|
||||
if h : fidx < numArgs.size then
|
||||
let n := numArgs.get ⟨fidx, h⟩
|
||||
for argIdx in [:n] do
|
||||
unless isForbidden fidx argIdx do
|
||||
withReader (·.push argIdx) (go (fidx + 1))
|
||||
else
|
||||
modify (·.push (← read))
|
||||
if (← get).size > threshold then
|
||||
failure
|
||||
termination_by _ fidx => numArgs.size - fidx
|
||||
|
||||
def elabWFRel (preDefs : Array PreDefinition) (unaryPreDefName : Name) (fixedPrefixSize : Nat) (argType : Expr) (wf? : Option TerminationWF) (k : Expr → TermElabM α) : TermElabM α := do
|
||||
def elabWFRel (preDefs : Array PreDefinition) (unaryPreDefName : Name) (fixedPrefixSize : Nat)
|
||||
(argType : Expr) (wf : TerminationWF) (k : Expr → TermElabM α) : TermElabM α := do
|
||||
let α := argType
|
||||
let u ← getLevel α
|
||||
let expectedType := mkApp (mkConst ``WellFoundedRelation [u]) α
|
||||
trace[Elab.definition.wf] "elabWFRel start: {(← mkFreshTypeMVar).mvarId!}"
|
||||
match wf? with
|
||||
| some (TerminationWF.core wfStx) => withDeclName unaryPreDefName do
|
||||
let wfRel ← instantiateMVars (← withSynthesize <| elabTermEnsuringType wfStx expectedType)
|
||||
let pendingMVarIds ← getMVars wfRel
|
||||
discard <| logUnassignedUsingErrorInfos pendingMVarIds
|
||||
k wfRel
|
||||
| some (TerminationWF.ext elements) => go expectedType elements
|
||||
| none => guess expectedType
|
||||
where
|
||||
go (expectedType : Expr) (elements : Array TerminationByElement) : TermElabM α :=
|
||||
withDeclName unaryPreDefName <| withRef (getRefFromElems elements) do
|
||||
let mainMVarId := (← mkFreshExprSyntheticOpaqueMVar expectedType).mvarId!
|
||||
let [fMVarId, wfRelMVarId, _] ← mainMVarId.apply (← mkConstWithFreshMVarLevels ``invImage) | throwError "failed to apply 'invImage'"
|
||||
let (d, fMVarId) ← fMVarId.intro1
|
||||
let subgoals ← unpackMutual preDefs fMVarId d
|
||||
for (d, mvarId) in subgoals, element in elements, preDef in preDefs do
|
||||
let mvarId ← unpackUnary preDef fixedPrefixSize mvarId d element
|
||||
mvarId.withContext do
|
||||
let value ← Term.withSynthesize <| elabTermEnsuringType element.body (← mvarId.getType)
|
||||
mvarId.assign value
|
||||
let wfRelVal ← synthInstance (← inferType (mkMVar wfRelMVarId))
|
||||
wfRelMVarId.assign wfRelVal
|
||||
k (← instantiateMVars (mkMVar mainMVarId))
|
||||
|
||||
generateElements (numArgs : Array Nat) (argCombination : Array Nat) : TermElabM (Array TerminationByElement) := do
|
||||
let mut result := #[]
|
||||
let var ← `(x)
|
||||
let hole ← `(_)
|
||||
for preDef in preDefs, numArg in numArgs, argIdx in argCombination, i in [:preDefs.size] do
|
||||
let mut vars := #[var]
|
||||
for _ in [:numArg - argIdx - 1] do
|
||||
vars := vars.push hole
|
||||
-- TODO: improve this.
|
||||
-- The following trick allows a function `f` in a mutual block to invoke `g` appearing before it with the input argument.
|
||||
-- We should compute the "right" order (if there is one) in the future.
|
||||
let body ← if preDefs.size > 1 then `((sizeOf x, $(quote i))) else `(sizeOf x)
|
||||
result := result.push {
|
||||
ref := preDef.ref
|
||||
declName := preDef.declName
|
||||
vars := vars
|
||||
body := body
|
||||
implicit := false
|
||||
}
|
||||
return result
|
||||
|
||||
guess (expectedType : Expr) : TermElabM α := do
|
||||
-- TODO: add support for lex
|
||||
let numArgs ← getNumCandidateArgs fixedPrefixSize preDefs
|
||||
-- TODO: include in `forbiddenArgs` arguments that are fixed but are not in the fixed prefix
|
||||
let forbiddenArgs ← preDefs.mapM fun preDef => getForbiddenByTrivialSizeOf fixedPrefixSize preDef
|
||||
-- TODO: add option to control the maximum number of cases to try
|
||||
if let some combs := generateCombinations? forbiddenArgs numArgs then
|
||||
for comb in combs do
|
||||
let elements ← generateElements numArgs comb
|
||||
if let some r ← observing? (go expectedType elements) then
|
||||
return r
|
||||
throwError "failed to prove termination, use `termination_by` to specify a well-founded relation"
|
||||
withDeclName unaryPreDefName do
|
||||
withRef (getRefFromElems wf) do
|
||||
let mainMVarId := (← mkFreshExprSyntheticOpaqueMVar expectedType).mvarId!
|
||||
let [fMVarId, wfRelMVarId, _] ← mainMVarId.apply (← mkConstWithFreshMVarLevels ``invImage) | throwError "failed to apply 'invImage'"
|
||||
let (d, fMVarId) ← fMVarId.intro1
|
||||
let subgoals ← unpackMutual preDefs fMVarId d
|
||||
for (d, mvarId) in subgoals, element in wf, preDef in preDefs do
|
||||
let mvarId ← unpackUnary preDef fixedPrefixSize mvarId d element
|
||||
mvarId.withContext do
|
||||
let value ← Term.withSynthesize <| elabTermEnsuringType element.body (← mvarId.getType)
|
||||
mvarId.assign value
|
||||
let wfRelVal ← synthInstance (← inferType (mkMVar wfRelMVarId))
|
||||
wfRelMVarId.assign wfRelVal
|
||||
k (← instantiateMVars (mkMVar mainMVarId))
|
||||
|
||||
end Lean.Elab.WF
|
||||
|
||||
@@ -5,130 +5,160 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Parser.Command
|
||||
|
||||
set_option autoImplicit false
|
||||
|
||||
namespace Lean.Elab.WF
|
||||
|
||||
/-! # Support for `decreasing_by` and `termination_by'` notations -/
|
||||
/-! # Support for `decreasing_by` -/
|
||||
|
||||
structure TerminationHintValue where
|
||||
structure DecreasingByTactic where
|
||||
ref : Syntax
|
||||
value : Syntax
|
||||
value : Lean.TSyntax `Lean.Parser.Tactic.tacticSeq
|
||||
deriving Inhabited
|
||||
|
||||
inductive TerminationHint where
|
||||
inductive DecreasingBy where
|
||||
| none
|
||||
| one (val : TerminationHintValue)
|
||||
| many (map : NameMap TerminationHintValue)
|
||||
| one (val : DecreasingByTactic)
|
||||
| many (map : NameMap DecreasingByTactic)
|
||||
deriving Inhabited
|
||||
|
||||
def expandTerminationHint (terminationHint? : Option Syntax) (cliques : Array (Array Name)) : MacroM TerminationHint := do
|
||||
if let some terminationHint := terminationHint? then
|
||||
let ref := terminationHint
|
||||
let terminationHint := terminationHint[1]
|
||||
if terminationHint.getKind == ``Parser.Command.terminationHint1 then
|
||||
return TerminationHint.one { ref, value := terminationHint[0] }
|
||||
else if terminationHint.getKind == ``Parser.Command.terminationHintMany then
|
||||
let m ← terminationHint[0].getArgs.foldlM (init := {}) fun m arg =>
|
||||
let declName? := cliques.findSome? fun clique => clique.findSome? fun declName =>
|
||||
if arg[0].getId.isSuffixOf declName then some declName else none
|
||||
match declName? with
|
||||
| none => Macro.throwErrorAt arg[0] s!"function '{arg[0].getId}' not found in current declaration"
|
||||
| some declName => return m.insert declName { ref := arg, value := arg[2] }
|
||||
for clique in cliques do
|
||||
let mut found? := Option.none
|
||||
for declName in clique do
|
||||
if let some { ref, .. } := m.find? declName then
|
||||
if let some found := found? then
|
||||
Macro.throwErrorAt ref s!"invalid termination hint element, '{declName}' and '{found}' are in the same clique"
|
||||
found? := some declName
|
||||
return TerminationHint.many m
|
||||
else
|
||||
Macro.throwUnsupported
|
||||
else
|
||||
return TerminationHint.none
|
||||
open Parser.Command in
|
||||
/--
|
||||
This function takes a user-specified `decreasing_by` clause (as `Sytnax`).
|
||||
If it is a `decreasingByMany` (a set of clauses guarded by the function name) then
|
||||
* checks that all mentioned names exist in the current declaration
|
||||
* check that at most one function from each clique is mentioned
|
||||
and sort the entries by function name.
|
||||
-/
|
||||
def expandDecreasingBy? (decreasingBy? : Option Syntax) (cliques : Array (Array Name)) : MacroM DecreasingBy := do
|
||||
let some decreasingBy := decreasingBy? | return DecreasingBy.none
|
||||
let ref := decreasingBy
|
||||
match decreasingBy with
|
||||
| `(decreasingBy|decreasing_by $hint1:tacticSeq) =>
|
||||
return DecreasingBy.one { ref, value := hint1 }
|
||||
| `(decreasingBy|decreasing_by $hints:decreasingByMany) => do
|
||||
let m ← hints.raw[0].getArgs.foldlM (init := {}) fun m arg => do
|
||||
let arg : TSyntax `decreasingByElement := ⟨arg⟩ -- cannot use syntax pattern match with lookahead
|
||||
let `(decreasingByElement| $declId:ident => $tac:tacticSeq) := arg | Macro.throwUnsupported
|
||||
let declName? := cliques.findSome? fun clique => clique.findSome? fun declName =>
|
||||
if declId.getId.isSuffixOf declName then some declName else none
|
||||
match declName? with
|
||||
| none => Macro.throwErrorAt declId s!"function '{declId.getId}' not found in current declaration"
|
||||
| some declName => return m.insert declName { ref := arg, value := tac }
|
||||
for clique in cliques do
|
||||
let mut found? := Option.none
|
||||
for declName in clique do
|
||||
if let some { ref, .. } := m.find? declName then
|
||||
if let some found := found? then
|
||||
Macro.throwErrorAt ref s!"invalid termination hint element, '{declName}' and '{found}' are in the same clique"
|
||||
found? := some declName
|
||||
return DecreasingBy.many m
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
def TerminationHint.markAsUsed (t : TerminationHint) (clique : Array Name) : TerminationHint :=
|
||||
def DecreasingBy.markAsUsed (t : DecreasingBy) (clique : Array Name) : DecreasingBy :=
|
||||
match t with
|
||||
| TerminationHint.none => TerminationHint.none
|
||||
| TerminationHint.one .. => TerminationHint.none
|
||||
| TerminationHint.many m => Id.run do
|
||||
| DecreasingBy.none => DecreasingBy.none
|
||||
| DecreasingBy.one .. => DecreasingBy.none
|
||||
| DecreasingBy.many m => Id.run do
|
||||
for declName in clique do
|
||||
if m.contains declName then
|
||||
let m := m.erase declName
|
||||
if m.isEmpty then
|
||||
return TerminationHint.none
|
||||
return DecreasingBy.none
|
||||
else
|
||||
return TerminationHint.many m
|
||||
return DecreasingBy.many m
|
||||
return t
|
||||
|
||||
def TerminationHint.find? (t : TerminationHint) (clique : Array Name) : Option TerminationHintValue :=
|
||||
def DecreasingBy.find? (t : DecreasingBy) (clique : Array Name) : Option DecreasingByTactic :=
|
||||
match t with
|
||||
| TerminationHint.none => Option.none
|
||||
| TerminationHint.one v => some v
|
||||
| TerminationHint.many m => clique.findSome? m.find?
|
||||
| DecreasingBy.none => Option.none
|
||||
| DecreasingBy.one v => some v
|
||||
| DecreasingBy.many m => clique.findSome? m.find?
|
||||
|
||||
def TerminationHint.ensureAllUsed (t : TerminationHint) : MacroM Unit := do
|
||||
def DecreasingBy.ensureAllUsed (t : DecreasingBy) : MacroM Unit := do
|
||||
match t with
|
||||
| TerminationHint.one v => Macro.throwErrorAt v.ref "unused termination hint element"
|
||||
| TerminationHint.many m => m.forM fun _ v => Macro.throwErrorAt v.ref "unused termination hint element"
|
||||
| DecreasingBy.one v => Macro.throwErrorAt v.ref "unused termination hint element"
|
||||
| DecreasingBy.many m => m.forM fun _ v => Macro.throwErrorAt v.ref "unused termination hint element"
|
||||
| _ => pure ()
|
||||
|
||||
/-! # Support for `termination_by` notation -/
|
||||
|
||||
/-- A single `termination_by` clause -/
|
||||
structure TerminationByElement where
|
||||
ref : Syntax
|
||||
declName : Name
|
||||
vars : Array Syntax
|
||||
body : Syntax
|
||||
vars : TSyntaxArray [`ident, ``Lean.Parser.Term.hole]
|
||||
body : Term
|
||||
implicit : Bool
|
||||
deriving Inhabited
|
||||
|
||||
/-- `termination_by` clauses, grouped by clique -/
|
||||
structure TerminationByClique where
|
||||
elements : Array TerminationByElement
|
||||
used : Bool := false
|
||||
|
||||
inductive TerminationBy where
|
||||
| core (hint : TerminationHint)
|
||||
| ext (cliques : Array TerminationByClique)
|
||||
/--
|
||||
A `termination_by` hint, as specified by the user
|
||||
-/
|
||||
structure TerminationBy where
|
||||
cliques : Array TerminationByClique
|
||||
deriving Inhabited
|
||||
|
||||
inductive TerminationWF where
|
||||
| core (stx : Syntax)
|
||||
| ext (clique : Array TerminationByElement)
|
||||
/--
|
||||
A `termination_by` hint, as applicable to a single clique
|
||||
-/
|
||||
abbrev TerminationWF := Array TerminationByElement
|
||||
|
||||
/-
|
||||
open Parser.Command in
|
||||
/--
|
||||
Expands the syntax for a `termination_by` clause, checking that
|
||||
* each function is mentioned once
|
||||
* each function mentioned actually occurs in the current declaration
|
||||
* if anything is specified, then all functions have a clause
|
||||
* the else-case (`_`) occurs only once, and only when needed
|
||||
|
||||
NB:
|
||||
```
|
||||
def terminationByElement := leading_parser ppLine >> (ident <|> hole) >> many (ident <|> hole) >> " => " >> termParser >> optional ";"
|
||||
def terminationBy := leading_parser ppLine >> "termination_by " >> many1chIndent terminationByElement
|
||||
```
|
||||
-/
|
||||
private def expandTerminationByNonCore (hint : Syntax) (cliques : Array (Array Name)) : MacroM TerminationBy := do
|
||||
let elementStxs := hint[1].getArgs
|
||||
def expandTerminationBy? (hint? : Option Syntax) (cliques : Array (Array Name)) :
|
||||
MacroM TerminationBy := do
|
||||
let some hint := hint? | return { cliques := #[] }
|
||||
let `(terminationBy|termination_by $elementStxs*) := hint | Macro.throwUnsupported
|
||||
let mut alreadyFound : NameSet := {}
|
||||
let mut elseElemStx? := none
|
||||
for elementStx in elementStxs do
|
||||
let declStx := elementStx[0]
|
||||
if declStx.isIdent then
|
||||
let declSuffix := declStx.getId
|
||||
match elementStx with
|
||||
| `(terminationByElement|$ident:ident $_* => $_) =>
|
||||
let declSuffix := ident.getId
|
||||
if alreadyFound.contains declSuffix then
|
||||
withRef elementStx <| Macro.throwError s!"invalid `termination_by` syntax, `{declSuffix}` case has already been provided"
|
||||
alreadyFound := alreadyFound.insert declSuffix
|
||||
if cliques.all fun clique => clique.all fun declName => !declSuffix.isSuffixOf declName then
|
||||
withRef elementStx <| Macro.throwError s!"function '{declSuffix}' not found in current declaration"
|
||||
else if elseElemStx?.isSome then
|
||||
withRef elementStx <| Macro.throwError "invalid `termination_by` syntax, the else-case (i.e., `_ ... => ...`) has already been specified"
|
||||
else
|
||||
elseElemStx? := some elementStx
|
||||
let toElement (declName : Name) (elementStx : Syntax) : TerminationByElement :=
|
||||
let vars := elementStx[1].getArgs
|
||||
let implicit := !elementStx[0].isIdent
|
||||
let body := elementStx[3]
|
||||
| `(terminationByElement|_ $_vars* => $_term) =>
|
||||
if elseElemStx?.isSome then
|
||||
withRef elementStx <| Macro.throwError "invalid `termination_by` syntax, the else-case (i.e., `_ ... => ...`) has already been specified"
|
||||
else
|
||||
elseElemStx? := some elementStx
|
||||
| _ => Macro.throwUnsupported
|
||||
let toElement (declName : Name) (elementStx : TSyntax ``terminationByElement) : TerminationByElement :=
|
||||
match elementStx with
|
||||
| `(terminationByElement|$ioh $vars* => $body:term) =>
|
||||
let implicit := !ioh.raw.isIdent
|
||||
{ ref := elementStx, declName, vars, implicit, body }
|
||||
| _ => unreachable!
|
||||
let elementAppliesTo (declName : Name) : TSyntax ``terminationByElement → Bool
|
||||
| `(terminationByElement|$ident:ident $_* => $_) => ident.getId.isSuffixOf declName
|
||||
| _ => false
|
||||
let mut result := #[]
|
||||
let mut usedElse := false
|
||||
for clique in cliques do
|
||||
let mut elements := #[]
|
||||
for declName in clique do
|
||||
if let some elementStx := elementStxs.find? fun elementStx => elementStx[0].isIdent && elementStx[0].getId.isSuffixOf declName then
|
||||
if let some elementStx := elementStxs.find? (elementAppliesTo declName) then
|
||||
elements := elements.push (toElement declName elementStx)
|
||||
else if let some elseElemStx := elseElemStx? then
|
||||
elements := elements.push (toElement declName elseElemStx)
|
||||
@@ -139,37 +169,28 @@ private def expandTerminationByNonCore (hint : Syntax) (cliques : Array (Array N
|
||||
result := result.push { elements }
|
||||
if !usedElse && elseElemStx?.isSome then
|
||||
withRef elseElemStx?.get! <| Macro.throwError s!"invalid `termination_by` syntax, unnecessary else-case"
|
||||
return TerminationBy.ext result
|
||||
return ⟨result⟩
|
||||
|
||||
def expandTerminationBy (hint? : Option Syntax) (cliques : Array (Array Name)) : MacroM TerminationBy :=
|
||||
if let some hint := hint? then
|
||||
if hint.isOfKind ``Parser.Command.terminationByCore then
|
||||
return TerminationBy.core (← expandTerminationHint hint? cliques)
|
||||
else if hint.isOfKind ``Parser.Command.terminationBy then
|
||||
expandTerminationByNonCore hint cliques
|
||||
else
|
||||
Macro.throwUnsupported
|
||||
else
|
||||
return TerminationBy.core TerminationHint.none
|
||||
open Parser.Command in
|
||||
def TerminationWF.unexpand (elements : TerminationWF) : MetaM Syntax := do
|
||||
let elementStxs ← elements.mapM fun element => do
|
||||
let fn : Ident := mkIdent (← unresolveNameGlobal element.declName)
|
||||
`(terminationByElement|$fn $element.vars* => $element.body)
|
||||
`(terminationBy|termination_by $elementStxs*)
|
||||
|
||||
def TerminationBy.markAsUsed (t : TerminationBy) (cliqueNames : Array Name) : TerminationBy :=
|
||||
match t with
|
||||
| core hint => core (hint.markAsUsed cliqueNames)
|
||||
| ext cliques => ext <| cliques.map fun clique =>
|
||||
.mk <| t.cliques.map fun clique =>
|
||||
if cliqueNames.any fun name => clique.elements.any fun elem => elem.declName == name then
|
||||
{ clique with used := true }
|
||||
else
|
||||
clique
|
||||
|
||||
def TerminationBy.find? (t : TerminationBy) (cliqueNames : Array Name) : Option TerminationWF :=
|
||||
match t with
|
||||
| core hint => hint.find? cliqueNames |>.map fun v => TerminationWF.core v.value
|
||||
| ext cliques =>
|
||||
cliques.findSome? fun clique =>
|
||||
if cliqueNames.any fun name => clique.elements.any fun elem => elem.declName == name then
|
||||
some <| TerminationWF.ext clique.elements
|
||||
else
|
||||
none
|
||||
t.cliques.findSome? fun clique =>
|
||||
if cliqueNames.any fun name => clique.elements.any fun elem => elem.declName == name then
|
||||
some <| clique.elements
|
||||
else
|
||||
none
|
||||
|
||||
def TerminationByClique.allImplicit (c : TerminationByClique) : Bool :=
|
||||
c.elements.all fun elem => elem.implicit
|
||||
@@ -177,19 +198,16 @@ def TerminationByClique.allImplicit (c : TerminationByClique) : Bool :=
|
||||
def TerminationByClique.getExplicitElement? (c : TerminationByClique) : Option TerminationByElement :=
|
||||
c.elements.find? (!·.implicit)
|
||||
|
||||
def TerminationBy.ensureAllUsed (t : TerminationBy) : MacroM Unit :=
|
||||
match t with
|
||||
| core hint => hint.ensureAllUsed
|
||||
| ext cliques => do
|
||||
let hasUsedAllImplicit := cliques.any fun c => c.allImplicit && c.used
|
||||
let mut reportedAllImplicit := true
|
||||
for clique in cliques do
|
||||
unless clique.used do
|
||||
if let some explicitElem := clique.getExplicitElement? then
|
||||
Macro.throwErrorAt explicitElem.ref "unused termination hint element"
|
||||
else if !hasUsedAllImplicit then
|
||||
unless reportedAllImplicit do
|
||||
reportedAllImplicit := true
|
||||
Macro.throwErrorAt clique.elements[0]!.ref "unused termination hint element"
|
||||
def TerminationBy.ensureAllUsed (t : TerminationBy) : MacroM Unit := do
|
||||
let hasUsedAllImplicit := t.cliques.any fun c => c.allImplicit && c.used
|
||||
let mut reportedAllImplicit := true
|
||||
for clique in t.cliques do
|
||||
unless clique.used do
|
||||
if let some explicitElem := clique.getExplicitElement? then
|
||||
Macro.throwErrorAt explicitElem.ref "unused termination hint element"
|
||||
else if !hasUsedAllImplicit then
|
||||
unless reportedAllImplicit do
|
||||
reportedAllImplicit := true
|
||||
Macro.throwErrorAt clique.elements[0]!.ref "unused termination hint element"
|
||||
|
||||
end Lean.Elab.WF
|
||||
|
||||
@@ -27,4 +27,10 @@ def getRecAppSyntax? (e : Expr) : Option Syntax :=
|
||||
| _ => none
|
||||
| _ => none
|
||||
|
||||
/--
|
||||
Checks if the `MData` is for a recursive applciation.
|
||||
-/
|
||||
def MData.isRecApp (d : MData) : Bool :=
|
||||
d.contains recAppKey
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -101,8 +101,9 @@ leading_parser try (declModifiers >> ident >> " :: ")
|
||||
private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (structDeclName : Name) : TermElabM StructCtorView := do
|
||||
let useDefault := do
|
||||
let declName := structDeclName ++ defaultCtorName
|
||||
addAuxDeclarationRanges declName structStx[2] structStx[2]
|
||||
pure { ref := structStx, modifiers := {}, name := defaultCtorName, declName }
|
||||
let ref := structStx[1].mkSynthetic
|
||||
addAuxDeclarationRanges declName ref ref
|
||||
pure { ref, modifiers := {}, name := defaultCtorName, declName }
|
||||
if structStx[5].isNone then
|
||||
useDefault
|
||||
else
|
||||
@@ -123,7 +124,7 @@ private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (struc
|
||||
let declName ← applyVisibility ctorModifiers.visibility declName
|
||||
addDocString' declName ctorModifiers.docString?
|
||||
addAuxDeclarationRanges declName ctor[1] ctor[1]
|
||||
pure { ref := ctor, name, modifiers := ctorModifiers, declName }
|
||||
pure { ref := ctor[1], name, modifiers := ctorModifiers, declName }
|
||||
|
||||
def checkValidFieldModifier (modifiers : Modifiers) : TermElabM Unit := do
|
||||
if modifiers.isNoncomputable then
|
||||
@@ -840,8 +841,8 @@ private def elabStructureView (view : StructView) : TermElabM Unit := do
|
||||
pure (info.isSubobject && decl.binderInfo.isInstImplicit)
|
||||
withSaveInfoContext do -- save new env
|
||||
Term.addLocalVarInfo view.ref[1] (← mkConstWithLevelParams view.declName)
|
||||
if let some _ := view.ctor.ref[1].getPos? (canonicalOnly := true) then
|
||||
Term.addTermInfo' view.ctor.ref[1] (← mkConstWithLevelParams view.ctor.declName) (isBinder := true)
|
||||
if let some _ := view.ctor.ref.getPos? (canonicalOnly := true) then
|
||||
Term.addTermInfo' view.ctor.ref (← mkConstWithLevelParams view.ctor.declName) (isBinder := true)
|
||||
for field in view.fields do
|
||||
-- may not exist if overriding inherited field
|
||||
if (← getEnv).contains field.declName then
|
||||
|
||||
@@ -22,3 +22,4 @@ import Lean.Elab.Tactic.Unfold
|
||||
import Lean.Elab.Tactic.Cache
|
||||
import Lean.Elab.Tactic.Calc
|
||||
import Lean.Elab.Tactic.Congr
|
||||
import Lean.Elab.Tactic.SEval
|
||||
|
||||
@@ -240,7 +240,7 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
|
||||
@[builtin_tactic Lean.Parser.Tactic.contradiction] def evalContradiction : Tactic := fun _ =>
|
||||
liftMetaTactic fun mvarId => do mvarId.contradiction; pure []
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.refl] def evalRefl : Tactic := fun _ =>
|
||||
@[builtin_tactic Lean.Parser.Tactic.eqRefl] def evalRefl : Tactic := fun _ =>
|
||||
liftMetaTactic fun mvarId => do mvarId.refl; pure []
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.intro] def evalIntro : Tactic := fun stx => do
|
||||
|
||||
@@ -264,7 +264,6 @@ def reorderAlts (alts : Array Alt) (altsSyntax : Array Syntax) : Array Alt := Id
|
||||
def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (altsSyntax : Array Syntax)
|
||||
(initialInfo : Info)
|
||||
(numEqs : Nat := 0) (numGeneralized : Nat := 0) (toClear : Array FVarId := #[]) : TacticM Unit := do
|
||||
checkAltNames alts altsSyntax
|
||||
let hasAlts := altsSyntax.size > 0
|
||||
if hasAlts then
|
||||
-- default to initial state outside of alts
|
||||
@@ -276,6 +275,7 @@ def evalAlts (elimInfo : ElimInfo) (alts : Array Alt) (optPreTac : Syntax) (alts
|
||||
else go
|
||||
where
|
||||
go := do
|
||||
checkAltNames alts altsSyntax
|
||||
let alts := reorderAlts alts altsSyntax
|
||||
let hasAlts := altsSyntax.size > 0
|
||||
let mut usedWildcard := false
|
||||
|
||||
@@ -39,9 +39,14 @@ def expandOptLocation (stx : Syntax) : Location :=
|
||||
|
||||
open Meta
|
||||
|
||||
/-- Runs the given `atLocal` and `atTarget` methods on each of the locations selected by the given `loc`.
|
||||
If any of the selected tactic applications fail, it will call `failed` with the main goal mvar.
|
||||
-/
|
||||
/--
|
||||
Runs the given `atLocal` and `atTarget` methods on each of the locations selected by the given `loc`.
|
||||
* If `loc` is a list of locations, runs at each specified hypothesis (and finally the goal if `⊢` is included),
|
||||
and fails if any of the tactic applications fail.
|
||||
* If `loc` is `*`, runs at the target first and then the hypotheses in reverse order.
|
||||
If `atTarget` closes the main goal, `withLocation` does not run `atLocal`.
|
||||
If all tactic applications fail, `withLocation` with call `failed` with the main goal mvar.
|
||||
-/
|
||||
def withLocation (loc : Location) (atLocal : FVarId → TacticM Unit) (atTarget : TacticM Unit) (failed : MVarId → TacticM Unit) : TacticM Unit := do
|
||||
match loc with
|
||||
| Location.targets hyps type =>
|
||||
@@ -52,7 +57,8 @@ def withLocation (loc : Location) (atLocal : FVarId → TacticM Unit) (atTarget
|
||||
withMainContext atTarget
|
||||
| Location.wildcard =>
|
||||
let worked ← tryTactic <| withMainContext <| atTarget
|
||||
withMainContext do
|
||||
let g ← try getMainGoal catch _ => return () -- atTarget closed the goal
|
||||
g.withContext do
|
||||
let mut worked := worked
|
||||
-- We must traverse backwards because the given `atLocal` may use the revert/intro idiom
|
||||
for fvarId in (← getLCtx).getFVarIds.reverse do
|
||||
|
||||
20
src/Lean/Elab/Tactic/SEval.lean
Normal file
20
src/Lean/Elab/Tactic/SEval.lean
Normal file
@@ -0,0 +1,20 @@
|
||||
/-
|
||||
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Tactic.SymEval
|
||||
import Lean.Elab.Tactic.Basic
|
||||
|
||||
namespace Lean.Elab.Tactic
|
||||
|
||||
open Meta Tactic
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.seval] def evalSEval : Tactic := fun _ => withMainContext do
|
||||
let mvarId ← getMainGoal
|
||||
let result? ← sevalTarget mvarId {}
|
||||
match result? with
|
||||
| none => replaceMainGoal []
|
||||
| some mvarId => replaceMainGoal [mvarId]
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
@@ -264,7 +264,14 @@ register_builtin_option tactic.simp.trace : Bool := {
|
||||
descr := "When tracing is enabled, calls to `simp` or `dsimp` will print an equivalent `simp only` call."
|
||||
}
|
||||
|
||||
def traceSimpCall (stx : Syntax) (usedSimps : UsedSimps) : MetaM Unit := do
|
||||
/--
|
||||
If `stx` is the syntax of a `simp`, `simp_all` or `dsimp` tactic invocation, and
|
||||
`usedSimps` is the set of simp lemmas used by this invocation, then `mkSimpOnly`
|
||||
creates the syntax of an equivalent `simp only`, `simp_all only` or `dsimp only`
|
||||
invocation.
|
||||
-/
|
||||
def mkSimpOnly (stx : Syntax) (usedSimps : UsedSimps) : MetaM Syntax := do
|
||||
let isSimpAll := stx.isOfKind ``Parser.Tactic.simpAll
|
||||
let mut stx := stx
|
||||
if stx[3].isNone then
|
||||
stx := stx.setArg 3 (mkNullNode #[mkAtom "only"])
|
||||
@@ -281,9 +288,15 @@ def traceSimpCall (stx : Syntax) (usedSimps : UsedSimps) : MetaM Unit := do
|
||||
else
|
||||
(← `(Parser.Tactic.simpLemma| $(mkIdent (← unresolveNameGlobal declName)):ident)))
|
||||
| .fvar fvarId => -- local hypotheses in the context
|
||||
-- `simp_all` always uses all propositional hypotheses (and it can't use
|
||||
-- any others). So `simp_all only [h]`, where `h` is a hypothesis, would
|
||||
-- be redundant. It would also be confusing since it suggests that only
|
||||
-- `h` is used.
|
||||
if isSimpAll then
|
||||
continue
|
||||
if let some ldecl := lctx.find? fvarId then
|
||||
localsOrStar := localsOrStar.bind fun locals =>
|
||||
if !ldecl.userName.isInaccessibleUserName &&
|
||||
if !ldecl.userName.isInaccessibleUserName && !ldecl.userName.hasMacroScopes &&
|
||||
(lctx.findFromUserName? ldecl.userName).get!.fvarId == ldecl.fvarId then
|
||||
some (locals.push ldecl.userName)
|
||||
else
|
||||
@@ -299,8 +312,10 @@ def traceSimpCall (stx : Syntax) (usedSimps : UsedSimps) : MetaM Unit := do
|
||||
else
|
||||
args := args.push (← `(Parser.Tactic.simpStar| *))
|
||||
let argsStx := if args.isEmpty then #[] else #[mkAtom "[", (mkAtom ",").mkSep args, mkAtom "]"]
|
||||
stx := stx.setArg 4 (mkNullNode argsStx)
|
||||
logInfoAt stx[0] m!"Try this: {stx}"
|
||||
return stx.setArg 4 (mkNullNode argsStx)
|
||||
|
||||
def traceSimpCall (stx : Syntax) (usedSimps : UsedSimps) : MetaM Unit := do
|
||||
logInfoAt stx[0] m!"Try this: {← mkSimpOnly stx usedSimps}"
|
||||
|
||||
/--
|
||||
`simpLocation ctx discharge? varIdToLemmaId loc`
|
||||
@@ -337,14 +352,14 @@ where
|
||||
/-
|
||||
"simp " (config)? (discharger)? ("only ")? ("[" simpLemma,* "]")? (location)?
|
||||
-/
|
||||
@[builtin_tactic Lean.Parser.Tactic.simp] def evalSimp : Tactic := fun stx => do
|
||||
let { ctx, dischargeWrapper } ← withMainContext <| mkSimpContext stx (eraseLocal := false)
|
||||
@[builtin_tactic Lean.Parser.Tactic.simp] def evalSimp : Tactic := fun stx => withMainContext do
|
||||
let { ctx, dischargeWrapper } ← mkSimpContext stx (eraseLocal := false)
|
||||
let usedSimps ← dischargeWrapper.with fun discharge? =>
|
||||
simpLocation ctx discharge? (expandOptLocation stx[5])
|
||||
if tactic.simp.trace.get (← getOptions) then
|
||||
traceSimpCall stx usedSimps
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.simpAll] def evalSimpAll : Tactic := fun stx => do
|
||||
@[builtin_tactic Lean.Parser.Tactic.simpAll] def evalSimpAll : Tactic := fun stx => withMainContext do
|
||||
let { ctx, .. } ← mkSimpContext stx (eraseLocal := true) (kind := .simpAll) (ignoreStarArg := true)
|
||||
let (result?, usedSimps) ← simpAll (← getMainGoal) ctx
|
||||
match result? with
|
||||
@@ -370,7 +385,7 @@ where
|
||||
| none => replaceMainGoal []
|
||||
| some mvarId => replaceMainGoal [mvarId]
|
||||
if tactic.simp.trace.get (← getOptions) then
|
||||
traceSimpCall (← getRef) usedSimps
|
||||
mvarId.withContext <| traceSimpCall (← getRef) usedSimps
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.dsimp] def evalDSimp : Tactic := fun stx => do
|
||||
let { ctx, .. } ← withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp)
|
||||
|
||||
@@ -60,7 +60,7 @@ def bar ⦃x : Nat⦄ : Nat := x
|
||||
#check bar -- bar : ⦃x : Nat⦄ → Nat
|
||||
```
|
||||
|
||||
See also the Lean manual: https://lean-lang.org/lean4/doc/expressions.html#implicit-arguments
|
||||
See also [the Lean manual](https://lean-lang.org/lean4/doc/expressions.html#implicit-arguments).
|
||||
-/
|
||||
inductive BinderInfo where
|
||||
/-- Default binder annotation, e.g. `(x : α)` -/
|
||||
@@ -300,8 +300,8 @@ inductive Expr where
|
||||
above it (i.e. introduced by a `lam`, `forallE`, or `letE`).
|
||||
|
||||
The `deBruijnIndex` parameter is the *de-Bruijn* index for the bound
|
||||
variable. See [here](https://en.wikipedia.org/wiki/De_Bruijn_index)
|
||||
for additional information on de-Bruijn indexes.
|
||||
variable. See [the Wikipedia page on de-Bruijn indices](https://en.wikipedia.org/wiki/De_Bruijn_index)
|
||||
for additional information.
|
||||
|
||||
For example, consider the expression `fun x : Nat => forall y : Nat, x = y`.
|
||||
The `x` and `y` variables in the equality expression are constructed
|
||||
@@ -319,11 +319,11 @@ inductive Expr where
|
||||
| bvar (deBruijnIndex : Nat)
|
||||
|
||||
/--
|
||||
The `fvar` constructor represent free variables. These /free/ variable
|
||||
The `fvar` constructor represent free variables. These *free* variable
|
||||
occurrences are not bound by an earlier `lam`, `forallE`, or `letE`
|
||||
constructor and its binder exists in a local context only.
|
||||
|
||||
Note that Lean uses the /locally nameless approach/. See [here](https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.365.2479&rep=rep1&type=pdf)
|
||||
Note that Lean uses the *locally nameless approach*. See [McBride and McKinna](https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.365.2479&rep=rep1&type=pdf)
|
||||
for additional details.
|
||||
|
||||
When "visiting" the body of a binding expression (i.e. `lam`, `forallE`, or `letE`),
|
||||
@@ -361,7 +361,7 @@ inductive Expr where
|
||||
A function application.
|
||||
|
||||
For example, the natural number one, i.e. `Nat.succ Nat.zero` is represented as
|
||||
`Expr.app (.const `Nat.succ []) (.const .zero [])`
|
||||
``Expr.app (.const `Nat.succ []) (.const .zero [])``.
|
||||
Note that multiple arguments are represented using partial application.
|
||||
|
||||
For example, the two argument application `f x y` is represented as
|
||||
@@ -387,15 +387,15 @@ inductive Expr where
|
||||
|
||||
For example:
|
||||
- `forall x : Prop, x ∧ x`:
|
||||
```lean
|
||||
Expr.forallE `x (.sort .zero)
|
||||
(.app (.app (.const `And []) (.bvar 0)) (.bvar 0)) .default
|
||||
```
|
||||
```lean
|
||||
Expr.forallE `x (.sort .zero)
|
||||
(.app (.app (.const `And []) (.bvar 0)) (.bvar 0)) .default
|
||||
```
|
||||
- `Nat → Bool`:
|
||||
```lean
|
||||
Expr.forallE `a (.const `Nat [])
|
||||
(.const `Bool []) .default
|
||||
```
|
||||
```lean
|
||||
Expr.forallE `a (.const `Nat [])
|
||||
(.const `Bool []) .default
|
||||
```
|
||||
-/
|
||||
| forallE (binderName : Name) (binderType : Expr) (body : Expr) (binderInfo : BinderInfo)
|
||||
|
||||
@@ -450,11 +450,11 @@ inductive Expr where
|
||||
The type of `struct` must be an structure-like inductive type. That is, it has only one
|
||||
constructor, is not recursive, and it is not an inductive predicate. The kernel and elaborators
|
||||
check whether the `typeName` matches the type of `struct`, and whether the (zero-based) index
|
||||
is valid (i.e., it is smaller than the numbef of constructor fields).
|
||||
is valid (i.e., it is smaller than the number of constructor fields).
|
||||
When exporting Lean developments to other systems, `proj` can be replaced with `typeName`.`rec`
|
||||
applications.
|
||||
|
||||
Example, given `a : Nat x Bool`, `a.1` is represented as
|
||||
Example, given `a : Nat × Bool`, `a.1` is represented as
|
||||
```
|
||||
.proj `Prod 0 a
|
||||
```
|
||||
@@ -774,8 +774,8 @@ instance : BEq Expr where
|
||||
beq := Expr.eqv
|
||||
|
||||
/--
|
||||
Return true iff `a` and `b` are equal.
|
||||
Binder names and annotations are taking into account.
|
||||
Return `true` iff `a` and `b` are equal.
|
||||
Binder names and annotations are taken into account.
|
||||
-/
|
||||
@[extern "lean_expr_equal"]
|
||||
opaque equal (a : @& Expr) (b : @& Expr) : Bool
|
||||
@@ -831,7 +831,7 @@ def isConst : Expr → Bool
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Return `true` if the given expression is a constant of the give name.
|
||||
Return `true` if the given expression is a constant of the given name.
|
||||
Examples:
|
||||
- `` (.const `Nat []).isConstOf `Nat `` is `true`
|
||||
- `` (.const `Nat []).isConstOf `False `` is `false`
|
||||
|
||||
@@ -205,6 +205,9 @@ def ofNat : Nat → Level
|
||||
| 0 => levelZero
|
||||
| n+1 => mkLevelSucc (ofNat n)
|
||||
|
||||
instance instOfNat (n : Nat) : OfNat Level n where
|
||||
ofNat := ofNat n
|
||||
|
||||
def addOffsetAux : Nat → Level → Level
|
||||
| 0, u => u
|
||||
| (n+1), u => addOffsetAux n (mkLevelSucc u)
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.KAbstract
|
||||
import Lean.Meta.Check
|
||||
import Lean.Meta.AppBuilder
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
@@ -50,13 +51,17 @@ def CasesOnApp.toExpr (c : CasesOnApp) : Expr :=
|
||||
/--
|
||||
Given a `casesOn` application `c` of the form
|
||||
```
|
||||
casesOn As (fun is x => motive[i, xs]) is major (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining
|
||||
casesOn As (fun is x => motive[is, xs]) is major (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining
|
||||
```
|
||||
and an expression `e : B[is, major]`, construct the term
|
||||
```
|
||||
casesOn As (fun is x => B[is, x] → motive[i, xs]) is major (fun ys_1 (y : B[C_1[ys_1]]) => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n (y : B[C_n[ys_n]]) => (alt_n : motive (C_n[ys_n]) e remaining
|
||||
casesOn As (fun is x => B[is, x] → motive[i, xs]) is major (fun ys_1 (y : B[_, C_1[ys_1]]) => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n (y : B[_, C_n[ys_n]]) => (alt_n : motive (C_n[ys_n]) e remaining
|
||||
```
|
||||
We use `kabstract` to abstract the `is` and `major` from `B[is, major]`.
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.Fix` when replacing recursive calls with calls to
|
||||
the argument provided by `fix` to refine the termination argument, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def CasesOnApp.addArg (c : CasesOnApp) (arg : Expr) (checkIfRefined : Bool := false) : MetaM CasesOnApp := do
|
||||
lambdaTelescope c.motive fun motiveArgs motiveBody => do
|
||||
@@ -106,11 +111,68 @@ where
|
||||
throwError "failed to add argument to `casesOn` application, argument type was not refined by `casesOn`"
|
||||
return altsNew
|
||||
|
||||
/-- Similar `CasesOnApp.addArg`, but returns `none` on failure. -/
|
||||
/-- Similar to `CasesOnApp.addArg`, but returns `none` on failure. -/
|
||||
def CasesOnApp.addArg? (c : CasesOnApp) (arg : Expr) (checkIfRefined : Bool := false) : MetaM (Option CasesOnApp) :=
|
||||
try
|
||||
return some (← c.addArg arg checkIfRefined)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
/--
|
||||
Given a `casesOn` application `c` of the form
|
||||
```
|
||||
casesOn As (fun is x => motive[is, xs]) is major (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining
|
||||
```
|
||||
and an expression `B[is, major]` (which may not be a type, e.g. `n : Nat`)
|
||||
for every alternative `i`, construct the expression `fun ys_i => B[_, C_i[ys_i]]`
|
||||
|
||||
This is similar to `CasesOnApp.addArg` when you only have an expression to
|
||||
refined, and not a type with a value.
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.GuessFix` when constructing the context of recursive
|
||||
calls to refine the functions' paramter, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def CasesOnApp.refineThrough (c : CasesOnApp) (e : Expr) : MetaM (Array Expr) :=
|
||||
lambdaTelescope c.motive fun motiveArgs _motiveBody => do
|
||||
unless motiveArgs.size == c.indices.size + 1 do
|
||||
throwError "failed to transfer argument through `casesOn` application, motive must be lambda expression with #{c.indices.size + 1} binders"
|
||||
let discrs := c.indices ++ #[c.major]
|
||||
let mut eAbst := e
|
||||
for motiveArg in motiveArgs.reverse, discr in discrs.reverse do
|
||||
eAbst ← kabstract eAbst discr
|
||||
eAbst := eAbst.instantiate1 motiveArg
|
||||
-- Let's create something that’s a `Sort` and mentions `e`
|
||||
-- (recall that `e` itself possibly isn't a type),
|
||||
-- by writing `e = e`, so that we can use it as a motive
|
||||
let eEq ← mkEq eAbst eAbst
|
||||
let motive ← mkLambdaFVars motiveArgs eEq
|
||||
let us := if c.propOnly then c.us else levelZero :: c.us.tail!
|
||||
-- Now instantiate the casesOn wth this synthetic motive
|
||||
let aux := mkAppN (mkConst c.declName us) c.params
|
||||
let aux := mkApp aux motive
|
||||
let aux := mkAppN aux discrs
|
||||
check aux
|
||||
let auxType ← inferType aux
|
||||
-- The type of the remaining arguments will mention `e` instantiated for each arg
|
||||
-- so extract them
|
||||
forallTelescope auxType fun altAuxs _ => do
|
||||
let altAuxTys ← altAuxs.mapM (inferType ·)
|
||||
(Array.zip c.altNumParams altAuxTys).mapM fun (altNumParams, altAuxTy) => do
|
||||
forallBoundedTelescope altAuxTy altNumParams fun fvs body => do
|
||||
unless fvs.size = altNumParams do
|
||||
throwError "failed to transfer argument through `casesOn` application, alt type must be telescope with #{altNumParams} arguments"
|
||||
-- extract type from our synthetic equality
|
||||
let body := body.getArg! 2
|
||||
-- and abstract over the parameters of the alternatives, so that we can safely pass the Expr out
|
||||
mkLambdaFVars fvs body
|
||||
|
||||
/-- A non-failing version of `CasesOnApp.refineThrough` -/
|
||||
def CasesOnApp.refineThrough? (c : CasesOnApp) (e : Expr) :
|
||||
MetaM (Option (Array Expr)) :=
|
||||
try
|
||||
return some (← c.refineThrough e)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
end Lean.Meta
|
||||
|
||||
@@ -28,12 +28,12 @@ partial def collectMVars (e : Expr) : StateRefT CollectMVars.State MetaM Unit :=
|
||||
| none => pure ()
|
||||
| some d => collectMVars (mkMVar d.mvarIdPending)
|
||||
|
||||
/-- Return metavariables in occurring the given expression. See `collectMVars` -/
|
||||
/-- Return metavariables occurring in the given expression. See `collectMVars` -/
|
||||
def getMVars (e : Expr) : MetaM (Array MVarId) := do
|
||||
let (_, s) ← (collectMVars e).run {}
|
||||
pure s.result
|
||||
|
||||
/-- Similar to getMVars, but removes delayed assignments. -/
|
||||
/-- Similar to `getMVars`, but removes delayed assignments. -/
|
||||
def getMVarsNoDelayed (e : Expr) : MetaM (Array MVarId) := do
|
||||
let mvarIds ← getMVars e
|
||||
mvarIds.filterM fun mvarId => not <$> mvarId.isDelayedAssigned
|
||||
|
||||
@@ -30,7 +30,7 @@ namespace Lean.Meta.DiscrTree
|
||||
Recall that projections from classes are **NOT** reducible.
|
||||
For example, the expressions `Add.add α (ringAdd ?α ?s) ?x ?x`
|
||||
and `Add.add Nat Nat.hasAdd a b` generates paths with the following keys
|
||||
respctively
|
||||
respectively
|
||||
```
|
||||
⟨Add.add, 4⟩, *, *, *, *
|
||||
⟨Add.add, 4⟩, *, *, ⟨a,0⟩, ⟨b,0⟩
|
||||
|
||||
@@ -56,7 +56,7 @@ If we enable `iota`, then the lhs is reduced to `f a`.
|
||||
Note that when retrieving terms, we may also disable `beta` and `zeta` reduction.
|
||||
See issue https://github.com/leanprover/lean4/issues/2669
|
||||
|
||||
- During type class resolution, we often want to reduce types using even `iota` and projection reductionn.
|
||||
- During type class resolution, we often want to reduce types using even `iota` and projection reduction.
|
||||
Example:
|
||||
```
|
||||
inductive Ty where
|
||||
|
||||
@@ -169,6 +169,7 @@ where
|
||||
let fail _ := do
|
||||
throwError "only trivial inductive applications supported in premises:{indentExpr t}"
|
||||
|
||||
let t ← whnf t
|
||||
t.withApp fun f args => do
|
||||
if let some name := f.constName? then
|
||||
if let some idx := ctx.typeInfos.findIdx?
|
||||
@@ -190,6 +191,7 @@ where
|
||||
(domain : Expr)
|
||||
{α : Type} (k : Expr → MetaM α) : MetaM α := do
|
||||
forallTelescopeReducing domain fun xs t => do
|
||||
let t ← whnf t
|
||||
t.withApp fun _ args => do
|
||||
let hApp := mkAppN binder xs
|
||||
let t := mkAppN vars.motives[indValIdx]! $ args[ctx.numParams:] ++ #[hApp]
|
||||
|
||||
@@ -910,11 +910,17 @@ private partial def updateAlts (typeNew : Expr) (altNumParams : Array Nat) (alts
|
||||
- matcherApp `match_i As (fun xs => motive[xs]) discrs (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining`, and
|
||||
- expression `e : B[discrs]`,
|
||||
Construct the term
|
||||
`match_i As (fun xs => B[xs] -> motive[xs]) discrs (fun ys_1 (y : B[C_1[ys_1]]) => alt_1) ... (fun ys_n (y : B[C_n[ys_n]]) => alt_n) e remaining`, and
|
||||
`match_i As (fun xs => B[xs] -> motive[xs]) discrs (fun ys_1 (y : B[C_1[ys_1]]) => alt_1) ... (fun ys_n (y : B[C_n[ys_n]]) => alt_n) e remaining`.
|
||||
|
||||
We use `kabstract` to abstract the discriminants from `B[discrs]`.
|
||||
|
||||
This method assumes
|
||||
- the `matcherApp.motive` is a lambda abstraction where `xs.size == discrs.size`
|
||||
- each alternative is a lambda abstraction where `ys_i.size == matcherApp.altNumParams[i]`
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.Fix` when replacing recursive calls with calls to
|
||||
the argument provided by `fix` to refine the termination argument, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def MatcherApp.addArg (matcherApp : MatcherApp) (e : Expr) : MetaM MatcherApp :=
|
||||
lambdaTelescope matcherApp.motive fun motiveArgs motiveBody => do
|
||||
@@ -951,13 +957,76 @@ def MatcherApp.addArg (matcherApp : MatcherApp) (e : Expr) : MetaM MatcherApp :=
|
||||
remaining := #[e] ++ matcherApp.remaining
|
||||
}
|
||||
|
||||
/-- Similar `MatcherApp.addArg?`, but returns `none` on failure. -/
|
||||
/-- Similar to `MatcherApp.addArg`, but returns `none` on failure. -/
|
||||
def MatcherApp.addArg? (matcherApp : MatcherApp) (e : Expr) : MetaM (Option MatcherApp) :=
|
||||
try
|
||||
return some (← matcherApp.addArg e)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
|
||||
/-- Given
|
||||
- matcherApp `match_i As (fun xs => motive[xs]) discrs (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining`, and
|
||||
- a expression `B[discrs]` (which may not be a type, e.g. `n : Nat`),
|
||||
returns the expressions `fun ys_1 ... ys_i => B[C_1[ys_1]] ... B[C_n[ys_n]]`,
|
||||
|
||||
This method assumes
|
||||
- the `matcherApp.motive` is a lambda abstraction where `xs.size == discrs.size`
|
||||
- each alternative is a lambda abstraction where `ys_i.size == matcherApp.altNumParams[i]`
|
||||
|
||||
This is similar to `MatcherApp.addArg` when you only have an expression to
|
||||
refined, and not a type with a value.
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.GuessFix` when constructing the context of recursive
|
||||
calls to refine the functions' paramter, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def MatcherApp.refineThrough (matcherApp : MatcherApp) (e : Expr) : MetaM (Array Expr) :=
|
||||
lambdaTelescope matcherApp.motive fun motiveArgs _motiveBody => do
|
||||
unless motiveArgs.size == matcherApp.discrs.size do
|
||||
-- This error can only happen if someone implemented a transformation that rewrites the motive created by `mkMatcher`.
|
||||
throwError "failed to transfer argument through matcher application, motive must be lambda expression with #{matcherApp.discrs.size} arguments"
|
||||
|
||||
let eAbst ← matcherApp.discrs.size.foldRevM (init := e) fun i eAbst => do
|
||||
let motiveArg := motiveArgs[i]!
|
||||
let discr := matcherApp.discrs[i]!
|
||||
let eTypeAbst ← kabstract eAbst discr
|
||||
return eTypeAbst.instantiate1 motiveArg
|
||||
-- Let's create something that’s a `Sort` and mentions `e`
|
||||
-- (recall that `e` itself possibly isn't a type),
|
||||
-- by writing `e = e`, so that we can use it as a motive
|
||||
let eEq ← mkEq eAbst eAbst
|
||||
|
||||
let matcherLevels ← match matcherApp.uElimPos? with
|
||||
| none => pure matcherApp.matcherLevels
|
||||
| some pos =>
|
||||
pure <| matcherApp.matcherLevels.set! pos levelZero
|
||||
let motive ← mkLambdaFVars motiveArgs eEq
|
||||
let aux := mkAppN (mkConst matcherApp.matcherName matcherLevels.toList) matcherApp.params
|
||||
let aux := mkApp aux motive
|
||||
let aux := mkAppN aux matcherApp.discrs
|
||||
unless (← isTypeCorrect aux) do
|
||||
throwError "failed to transfer argument through matcher application, type error when constructing the new motive"
|
||||
let auxType ← inferType aux
|
||||
forallTelescope auxType fun altAuxs _ => do
|
||||
let altAuxTys ← altAuxs.mapM (inferType ·)
|
||||
(Array.zip matcherApp.altNumParams altAuxTys).mapM fun (altNumParams, altAuxTy) => do
|
||||
forallBoundedTelescope altAuxTy altNumParams fun fvs body => do
|
||||
unless fvs.size = altNumParams do
|
||||
throwError "failed to transfer argument through matcher application, alt type must be telescope with #{altNumParams} arguments"
|
||||
-- extract type from our synthetic equality
|
||||
let body := body.getArg! 2
|
||||
-- and abstract over the parameters of the alternatives, so that we can safely pass the Expr out
|
||||
mkLambdaFVars fvs body
|
||||
|
||||
/-- A non-failing version of `MatcherApp.refineThrough` -/
|
||||
def MatcherApp.refineThrough? (matcherApp : MatcherApp) (e : Expr) :
|
||||
MetaM (Option (Array Expr)) :=
|
||||
try
|
||||
return some (← matcherApp.refineThrough e)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
builtin_initialize
|
||||
registerTraceClass `Meta.Match.match
|
||||
registerTraceClass `Meta.Match.debug
|
||||
|
||||
@@ -28,4 +28,5 @@ import Lean.Meta.Tactic.Rename
|
||||
import Lean.Meta.Tactic.LinearArith
|
||||
import Lean.Meta.Tactic.AC
|
||||
import Lean.Meta.Tactic.Refl
|
||||
import Lean.Meta.Tactic.Congr
|
||||
import Lean.Meta.Tactic.Congr
|
||||
import Lean.Meta.Tactic.SymEval
|
||||
|
||||
@@ -8,7 +8,7 @@ import Lean.Meta.Tactic.Clear
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
private partial def cleanupCore (mvarId : MVarId) : MetaM MVarId := do
|
||||
private partial def cleanupCore (mvarId : MVarId) (toPreserve : Array FVarId) (indirectProps : Bool) : MetaM MVarId := do
|
||||
mvarId.withContext do
|
||||
mvarId.checkNotAssigned `cleanup
|
||||
let used ← collectUsed |>.run' (false, {})
|
||||
@@ -53,18 +53,23 @@ where
|
||||
|
||||
collectUsed : StateRefT (Bool × FVarIdSet) MetaM FVarIdSet := do
|
||||
addUsedFVars (← instantiateMVars (← mvarId.getType))
|
||||
collectProps
|
||||
toPreserve.forM addUsedFVar
|
||||
if indirectProps then collectProps
|
||||
return (← get).2
|
||||
|
||||
/--
|
||||
Auxiliary tactic for cleaning the local context. It removes local declarations (aka hypotheses) that are *not* relevant.
|
||||
We say a variable `x` is "relevant" if
|
||||
- It occurs in the `toPreserve` array, or
|
||||
- It occurs in the target type, or
|
||||
- There is a relevant variable `y` that depends on `x`, or
|
||||
- The type of `x` is a proposition and it depends on a relevant variable `y`.
|
||||
- If `indirectProps` is true, the type of `x` is a proposition and it depends on a relevant variable `y`.
|
||||
|
||||
By default, `toPreserve := #[]` and `indirectProps := true`. These settings are used in the mathlib tactic `extract_goal`
|
||||
to give the user more control over which variables to include.
|
||||
-/
|
||||
abbrev _root_.Lean.MVarId.cleanup (mvarId : MVarId) : MetaM MVarId := do
|
||||
cleanupCore mvarId
|
||||
abbrev _root_.Lean.MVarId.cleanup (mvarId : MVarId) (toPreserve : Array FVarId := #[]) (indirectProps : Bool := true) : MetaM MVarId := do
|
||||
cleanupCore mvarId toPreserve indirectProps
|
||||
|
||||
@[deprecated MVarId.cleanup]
|
||||
abbrev cleanup (mvarId : MVarId) : MetaM MVarId := do
|
||||
|
||||
@@ -30,45 +30,6 @@ def Config.updateArith (c : Config) : CoreM Config := do
|
||||
else
|
||||
return c
|
||||
|
||||
def Result.getProof (r : Result) : MetaM Expr := do
|
||||
match r.proof? with
|
||||
| some p => return p
|
||||
| none => mkEqRefl r.expr
|
||||
|
||||
/--
|
||||
Similar to `Result.getProof`, but adds a `mkExpectedTypeHint` if `proof?` is `none`
|
||||
(i.e., result is definitionally equal to input), but we cannot establish that
|
||||
`source` and `r.expr` are definitionally when using `TransparencyMode.reducible`. -/
|
||||
def Result.getProof' (source : Expr) (r : Result) : MetaM Expr := do
|
||||
match r.proof? with
|
||||
| some p => return p
|
||||
| none =>
|
||||
if (← isDefEq source r.expr) then
|
||||
mkEqRefl r.expr
|
||||
else
|
||||
/- `source` and `r.expr` must be definitionally equal, but
|
||||
are not definitionally equal at `TransparencyMode.reducible` -/
|
||||
mkExpectedTypeHint (← mkEqRefl r.expr) (← mkEq source r.expr)
|
||||
|
||||
def mkCongrFun (r : Result) (a : Expr) : MetaM Result :=
|
||||
match r.proof? with
|
||||
| none => return { expr := mkApp r.expr a, proof? := none }
|
||||
| some h => return { expr := mkApp r.expr a, proof? := (← Meta.mkCongrFun h a) }
|
||||
|
||||
def mkCongr (r₁ r₂ : Result) : MetaM Result :=
|
||||
let e := mkApp r₁.expr r₂.expr
|
||||
match r₁.proof?, r₂.proof? with
|
||||
| none, none => return { expr := e, proof? := none }
|
||||
| some h, none => return { expr := e, proof? := (← Meta.mkCongrFun h r₂.expr) }
|
||||
| none, some h => return { expr := e, proof? := (← Meta.mkCongrArg r₁.expr h) }
|
||||
| some h₁, some h₂ => return { expr := e, proof? := (← Meta.mkCongr h₁ h₂) }
|
||||
|
||||
private def mkImpCongr (src : Expr) (r₁ r₂ : Result) : MetaM Result := do
|
||||
let e := src.updateForallE! r₁.expr r₂.expr
|
||||
match r₁.proof?, r₂.proof? with
|
||||
| none, none => return { expr := e, proof? := none }
|
||||
| _, _ => return { expr := e, proof? := (← Meta.mkImpCongr (← r₁.getProof) (← r₂.getProof)) } -- TODO specialize if bottleneck
|
||||
|
||||
/-- Return true if `e` is of the form `ofNat n` where `n` is a kernel Nat literal -/
|
||||
def isOfNatNatLit (e : Expr) : Bool :=
|
||||
e.isAppOfArity ``OfNat.ofNat 3 && e.appFn!.appArg!.isNatLit
|
||||
@@ -306,29 +267,6 @@ def getSimpLetCase (n : Name) (t : Expr) (b : Expr) : MetaM SimpLetCase := do
|
||||
else
|
||||
return SimpLetCase.dep
|
||||
|
||||
/-- Given the application `e`, remove unnecessary casts of the form `Eq.rec a rfl` and `Eq.ndrec a rfl`. -/
|
||||
partial def removeUnnecessaryCasts (e : Expr) : MetaM Expr := do
|
||||
let mut args := e.getAppArgs
|
||||
let mut modified := false
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
if isDummyEqRec arg then
|
||||
args := args.set! i (elimDummyEqRec arg)
|
||||
modified := true
|
||||
if modified then
|
||||
return mkAppN e.getAppFn args
|
||||
else
|
||||
return e
|
||||
where
|
||||
isDummyEqRec (e : Expr) : Bool :=
|
||||
(e.isAppOfArity ``Eq.rec 6 || e.isAppOfArity ``Eq.ndrec 6) && e.appArg!.isAppOf ``Eq.refl
|
||||
|
||||
elimDummyEqRec (e : Expr) : Expr :=
|
||||
if isDummyEqRec e then
|
||||
elimDummyEqRec e.appFn!.appFn!.appArg!
|
||||
else
|
||||
e
|
||||
|
||||
partial def simp (e : Expr) : M Result := withIncRecDepth do
|
||||
checkSystem "simp"
|
||||
let cfg ← getConfig
|
||||
@@ -420,22 +358,7 @@ where
|
||||
return { expr := (← dsimp e) }
|
||||
|
||||
congrArgs (r : Result) (args : Array Expr) : M Result := do
|
||||
if args.isEmpty then
|
||||
return r
|
||||
else
|
||||
let infos := (← getFunInfoNArgs r.expr args.size).paramInfo
|
||||
let mut r := r
|
||||
let mut i := 0
|
||||
for arg in args do
|
||||
trace[Debug.Meta.Tactic.simp] "app [{i}] {infos.size} {arg} hasFwdDeps: {infos[i]!.hasFwdDeps}"
|
||||
if i < infos.size && !infos[i]!.hasFwdDeps then
|
||||
r ← mkCongr r (← simp arg)
|
||||
else if (← whnfD (← inferType r.expr)).isArrow then
|
||||
r ← mkCongr r (← simp arg)
|
||||
else
|
||||
r ← mkCongrFun r (← dsimp arg)
|
||||
i := i + 1
|
||||
return r
|
||||
Simp.congrArgs simp dsimp r args
|
||||
|
||||
visitFn (e : Expr) : M Result := do
|
||||
let f := e.getAppFn
|
||||
@@ -451,112 +374,9 @@ where
|
||||
proof ← Meta.mkCongrFun proof arg
|
||||
return { expr := eNew, proof? := proof }
|
||||
|
||||
mkCongrSimp? (f : Expr) : M (Option CongrTheorem) := do
|
||||
if f.isConst then if (← isMatcher f.constName!) then
|
||||
-- We always use simple congruence theorems for auxiliary match applications
|
||||
return none
|
||||
let info ← getFunInfo f
|
||||
let kinds ← getCongrSimpKinds f info
|
||||
if kinds.all fun k => match k with | CongrArgKind.fixed => true | CongrArgKind.eq => true | _ => false then
|
||||
/- If all argument kinds are `fixed` or `eq`, then using
|
||||
simple congruence theorems `congr`, `congrArg`, and `congrFun` produces a more compact proof -/
|
||||
return none
|
||||
match (← get).congrCache.find? f with
|
||||
| some thm? => return thm?
|
||||
| none =>
|
||||
let thm? ← mkCongrSimpCore? f info kinds
|
||||
modify fun s => { s with congrCache := s.congrCache.insert f thm? }
|
||||
return thm?
|
||||
|
||||
/-- Try to use automatically generated congruence theorems. See `mkCongrSimp?`. -/
|
||||
tryAutoCongrTheorem? (e : Expr) : M (Option Result) := do
|
||||
let f := e.getAppFn
|
||||
-- TODO: cache
|
||||
let some cgrThm ← mkCongrSimp? f | return none
|
||||
if cgrThm.argKinds.size != e.getAppNumArgs then return none
|
||||
let mut simplified := false
|
||||
let mut hasProof := false
|
||||
let mut hasCast := false
|
||||
let mut argsNew := #[]
|
||||
let mut argResults := #[]
|
||||
let args := e.getAppArgs
|
||||
for arg in args, kind in cgrThm.argKinds do
|
||||
match kind with
|
||||
| CongrArgKind.fixed => argsNew := argsNew.push (← dsimp arg)
|
||||
| CongrArgKind.cast => hasCast := true; argsNew := argsNew.push arg
|
||||
| CongrArgKind.subsingletonInst => argsNew := argsNew.push arg
|
||||
| CongrArgKind.eq =>
|
||||
let argResult ← simp arg
|
||||
argResults := argResults.push argResult
|
||||
argsNew := argsNew.push argResult.expr
|
||||
if argResult.proof?.isSome then hasProof := true
|
||||
if arg != argResult.expr then simplified := true
|
||||
| _ => unreachable!
|
||||
if !simplified then return some { expr := e }
|
||||
/-
|
||||
If `hasProof` is false, we used to return `mkAppN f argsNew` with `proof? := none`.
|
||||
However, this created a regression when we started using `proof? := none` for `rfl` theorems.
|
||||
Consider the following goal
|
||||
```
|
||||
m n : Nat
|
||||
a : Fin n
|
||||
h₁ : m < n
|
||||
h₂ : Nat.pred (Nat.succ m) < n
|
||||
⊢ Fin.succ (Fin.mk m h₁) = Fin.succ (Fin.mk m.succ.pred h₂)
|
||||
```
|
||||
The term `m.succ.pred` is simplified to `m` using a `Nat.pred_succ` which is a `rfl` theorem.
|
||||
The auto generated theorem for `Fin.mk` has casts and if used here at `Fin.mk m.succ.pred h₂`,
|
||||
it produces the term `Fin.mk m (id (Eq.refl m) ▸ h₂)`. The key property here is that the
|
||||
proof `(id (Eq.refl m) ▸ h₂)` has type `m < n`. If we had just returned `mkAppN f argsNew`,
|
||||
the resulting term would be `Fin.mk m h₂` which is type correct, but later we would not be
|
||||
able to apply `eq_self` to
|
||||
```lean
|
||||
Fin.succ (Fin.mk m h₁) = Fin.succ (Fin.mk m h₂)
|
||||
```
|
||||
because we would not be able to establish that `m < n` and `Nat.pred (Nat.succ m) < n` are definitionally
|
||||
equal using `TransparencyMode.reducible` (`Nat.pred` is not reducible).
|
||||
Thus, we decided to return here only if the auto generated congruence theorem does not introduce casts.
|
||||
-/
|
||||
if !hasProof && !hasCast then return some { expr := mkAppN f argsNew }
|
||||
let mut proof := cgrThm.proof
|
||||
let mut type := cgrThm.type
|
||||
let mut j := 0 -- index at argResults
|
||||
let mut subst := #[]
|
||||
for arg in args, kind in cgrThm.argKinds do
|
||||
proof := mkApp proof arg
|
||||
subst := subst.push arg
|
||||
type := type.bindingBody!
|
||||
match kind with
|
||||
| CongrArgKind.fixed => pure ()
|
||||
| CongrArgKind.cast => pure ()
|
||||
| CongrArgKind.subsingletonInst =>
|
||||
let clsNew := type.bindingDomain!.instantiateRev subst
|
||||
let instNew ← if (← isDefEq (← inferType arg) clsNew) then
|
||||
pure arg
|
||||
else
|
||||
match (← trySynthInstance clsNew) with
|
||||
| LOption.some val => pure val
|
||||
| _ =>
|
||||
trace[Meta.Tactic.simp.congr] "failed to synthesize instance{indentExpr clsNew}"
|
||||
return none
|
||||
proof := mkApp proof instNew
|
||||
subst := subst.push instNew
|
||||
type := type.bindingBody!
|
||||
| CongrArgKind.eq =>
|
||||
let argResult := argResults[j]!
|
||||
let argProof ← argResult.getProof' arg
|
||||
j := j + 1
|
||||
proof := mkApp2 proof argResult.expr argProof
|
||||
subst := subst.push argResult.expr |>.push argProof
|
||||
type := type.bindingBody!.bindingBody!
|
||||
| _ => unreachable!
|
||||
let some (_, _, rhs) := type.instantiateRev subst |>.eq? | unreachable!
|
||||
let rhs ← if hasCast then removeUnnecessaryCasts rhs else pure rhs
|
||||
if hasProof then
|
||||
return some { expr := rhs, proof? := proof }
|
||||
else
|
||||
/- See comment above. This is reachable if `hasCast == true`. The `rhs` is not structurally equal to `mkAppN f argsNew` -/
|
||||
return some { expr := rhs }
|
||||
Simp.tryAutoCongrTheorem? simp dsimp e
|
||||
|
||||
congrDefault (e : Expr) : M Result := do
|
||||
if let some result ← tryAutoCongrTheorem? e then
|
||||
@@ -958,19 +778,6 @@ def dsimp (e : Expr) (ctx : Simp.Context)
|
||||
(usedSimps : UsedSimps := {}) : MetaM (Expr × UsedSimps) := do profileitM Exception "dsimp" (← getOptions) do
|
||||
Simp.dsimpMain e ctx usedSimps (methods := Simp.DefaultMethods.methods)
|
||||
|
||||
/--
|
||||
Auxiliary method.
|
||||
Given the current `target` of `mvarId`, apply `r` which is a new target and proof that it is equal to the current one.
|
||||
-/
|
||||
def applySimpResultToTarget (mvarId : MVarId) (target : Expr) (r : Simp.Result) : MetaM MVarId := do
|
||||
match r.proof? with
|
||||
| some proof => mvarId.replaceTargetEq r.expr proof
|
||||
| none =>
|
||||
if target != r.expr then
|
||||
mvarId.replaceTargetDefEq r.expr
|
||||
else
|
||||
return mvarId
|
||||
|
||||
/-- See `simpTarget`. This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
|
||||
def simpTargetCore (mvarId : MVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none)
|
||||
(mayCloseGoal := true) (usedSimps : UsedSimps := {}) : MetaM (Option MVarId × UsedSimps) := do
|
||||
|
||||
@@ -37,13 +37,18 @@ def synthesizeArgs (thmId : Origin) (xs : Array Expr) (bis : Array BinderInfo) (
|
||||
if (← synthesizeInstance x type) then
|
||||
continue
|
||||
if (← isProp type) then
|
||||
-- We save the state, so that `UsedTheorems` does not accumulate
|
||||
-- `simp` lemmas used during unsuccessful discharging.
|
||||
let usedTheorems := (← get).usedTheorems
|
||||
match (← discharge? type) with
|
||||
| some proof =>
|
||||
unless (← isDefEq x proof) do
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign proof{indentExpr type}"
|
||||
modify fun s => { s with usedTheorems }
|
||||
return false
|
||||
| none =>
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to discharge hypotheses{indentExpr type}"
|
||||
modify fun s => { s with usedTheorems }
|
||||
return false
|
||||
return true
|
||||
where
|
||||
@@ -111,7 +116,7 @@ private def tryTheoremCore (lhs : Expr) (xs : Array Expr) (bis : Array BinderInf
|
||||
| some { expr := eNew, proof? := some proof, .. } =>
|
||||
let mut proof := proof
|
||||
for extraArg in extraArgs do
|
||||
proof ← mkCongrFun proof extraArg
|
||||
proof ← Meta.mkCongrFun proof extraArg
|
||||
if (← hasAssignableMVar eNew) then
|
||||
trace[Meta.Tactic.simp.rewrite] "{← ppSimpTheorem thm}, resulting expression has unassigned metavariables"
|
||||
return none
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.AppBuilder
|
||||
import Lean.Meta.CongrTheorems
|
||||
import Lean.Meta.Tactic.Replace
|
||||
import Lean.Meta.Tactic.Simp.SimpTheorems
|
||||
import Lean.Meta.Tactic.Simp.SimpCongrTheorems
|
||||
|
||||
@@ -45,10 +46,6 @@ structure State where
|
||||
|
||||
abbrev SimpM := ReaderT Context $ StateRefT State MetaM
|
||||
|
||||
instance : MonadBacktrack SavedState SimpM where
|
||||
saveState := Meta.saveState
|
||||
restoreState s := s.restore
|
||||
|
||||
inductive Step where
|
||||
| visit : Result → Step
|
||||
| done : Result → Step
|
||||
@@ -105,8 +102,240 @@ def recordSimpTheorem (thmId : Origin) : SimpM Unit :=
|
||||
let n := s.usedTheorems.size
|
||||
{ s with usedTheorems := s.usedTheorems.insert thmId n }
|
||||
|
||||
def Result.getProof (r : Result) : MetaM Expr := do
|
||||
match r.proof? with
|
||||
| some p => return p
|
||||
| none => mkEqRefl r.expr
|
||||
|
||||
/--
|
||||
Similar to `Result.getProof`, but adds a `mkExpectedTypeHint` if `proof?` is `none`
|
||||
(i.e., result is definitionally equal to input), but we cannot establish that
|
||||
`source` and `r.expr` are definitionally when using `TransparencyMode.reducible`. -/
|
||||
def Result.getProof' (source : Expr) (r : Result) : MetaM Expr := do
|
||||
match r.proof? with
|
||||
| some p => return p
|
||||
| none =>
|
||||
if (← isDefEq source r.expr) then
|
||||
mkEqRefl r.expr
|
||||
else
|
||||
/- `source` and `r.expr` must be definitionally equal, but
|
||||
are not definitionally equal at `TransparencyMode.reducible` -/
|
||||
mkExpectedTypeHint (← mkEqRefl r.expr) (← mkEq source r.expr)
|
||||
|
||||
def mkCongrFun (r : Result) (a : Expr) : MetaM Result :=
|
||||
match r.proof? with
|
||||
| none => return { expr := mkApp r.expr a, proof? := none }
|
||||
| some h => return { expr := mkApp r.expr a, proof? := (← Meta.mkCongrFun h a) }
|
||||
|
||||
def mkCongr (r₁ r₂ : Result) : MetaM Result :=
|
||||
let e := mkApp r₁.expr r₂.expr
|
||||
match r₁.proof?, r₂.proof? with
|
||||
| none, none => return { expr := e, proof? := none }
|
||||
| some h, none => return { expr := e, proof? := (← Meta.mkCongrFun h r₂.expr) }
|
||||
| none, some h => return { expr := e, proof? := (← Meta.mkCongrArg r₁.expr h) }
|
||||
| some h₁, some h₂ => return { expr := e, proof? := (← Meta.mkCongr h₁ h₂) }
|
||||
|
||||
def mkImpCongr (src : Expr) (r₁ r₂ : Result) : MetaM Result := do
|
||||
let e := src.updateForallE! r₁.expr r₂.expr
|
||||
match r₁.proof?, r₂.proof? with
|
||||
| none, none => return { expr := e, proof? := none }
|
||||
| _, _ => return { expr := e, proof? := (← Meta.mkImpCongr (← r₁.getProof) (← r₂.getProof)) } -- TODO specialize if bottleneck
|
||||
|
||||
/-- Given the application `e`, remove unnecessary casts of the form `Eq.rec a rfl` and `Eq.ndrec a rfl`. -/
|
||||
partial def removeUnnecessaryCasts (e : Expr) : MetaM Expr := do
|
||||
let mut args := e.getAppArgs
|
||||
let mut modified := false
|
||||
for i in [:args.size] do
|
||||
let arg := args[i]!
|
||||
if isDummyEqRec arg then
|
||||
args := args.set! i (elimDummyEqRec arg)
|
||||
modified := true
|
||||
if modified then
|
||||
return mkAppN e.getAppFn args
|
||||
else
|
||||
return e
|
||||
where
|
||||
isDummyEqRec (e : Expr) : Bool :=
|
||||
(e.isAppOfArity ``Eq.rec 6 || e.isAppOfArity ``Eq.ndrec 6) && e.appArg!.isAppOf ``Eq.refl
|
||||
|
||||
elimDummyEqRec (e : Expr) : Expr :=
|
||||
if isDummyEqRec e then
|
||||
elimDummyEqRec e.appFn!.appFn!.appArg!
|
||||
else
|
||||
e
|
||||
|
||||
/--
|
||||
Given a simplified function result `r` and arguments `args`, simplify arguments using `simp` and `dsimp`.
|
||||
The resulting proof is built using `congr` and `congrFun` theorems.
|
||||
-/
|
||||
@[specialize] def congrArgs
|
||||
[Monad m] [MonadLiftT MetaM m] [MonadLiftT IO m] [MonadRef m] [MonadOptions m] [MonadTrace m] [AddMessageContext m]
|
||||
(simp : Expr → m Result)
|
||||
(dsimp : Expr → m Expr)
|
||||
(r : Result) (args : Array Expr) : m Result := do
|
||||
if args.isEmpty then
|
||||
return r
|
||||
else
|
||||
let infos := (← getFunInfoNArgs r.expr args.size).paramInfo
|
||||
let mut r := r
|
||||
let mut i := 0
|
||||
for arg in args do
|
||||
trace[Debug.Meta.Tactic.simp] "app [{i}] {infos.size} {arg} hasFwdDeps: {infos[i]!.hasFwdDeps}"
|
||||
if i < infos.size && !infos[i]!.hasFwdDeps then
|
||||
r ← mkCongr r (← simp arg)
|
||||
else if (← whnfD (← inferType r.expr)).isArrow then
|
||||
r ← mkCongr r (← simp arg)
|
||||
else
|
||||
r ← mkCongrFun r (← dsimp arg)
|
||||
i := i + 1
|
||||
return r
|
||||
|
||||
/--
|
||||
Helper class for generalizing `mkCongrSimp?`
|
||||
-/
|
||||
class MonadCongrCache (m : Type → Type) where
|
||||
find? : Expr → m (Option (Option CongrTheorem))
|
||||
save : Expr → (Option CongrTheorem) → m Unit
|
||||
|
||||
instance : MonadCongrCache M where
|
||||
find? f := return (← get).congrCache.find? f
|
||||
save f thm? := modify fun s => { s with congrCache := s.congrCache.insert f thm? }
|
||||
|
||||
/--
|
||||
Retrieve auto-generated congruence lemma for `f`.
|
||||
|
||||
Remark: If all argument kinds are `fixed` or `eq`, it returns `none` because
|
||||
using simple congruence theorems `congr`, `congrArg`, and `congrFun` produces a more compact proof.
|
||||
-/
|
||||
def mkCongrSimp? [Monad m] [MonadLiftT MetaM m] [MonadEnv m] [MonadCongrCache m]
|
||||
(f : Expr) : m (Option CongrTheorem) := do
|
||||
if f.isConst then if (← isMatcher f.constName!) then
|
||||
-- We always use simple congruence theorems for auxiliary match applications
|
||||
return none
|
||||
let info ← getFunInfo f
|
||||
let kinds ← getCongrSimpKinds f info
|
||||
if kinds.all fun k => match k with | CongrArgKind.fixed => true | CongrArgKind.eq => true | _ => false then
|
||||
/- See remark above. -/
|
||||
return none
|
||||
match (← MonadCongrCache.find? f) with
|
||||
| some thm? => return thm?
|
||||
| none =>
|
||||
let thm? ← mkCongrSimpCore? f info kinds
|
||||
MonadCongrCache.save f thm?
|
||||
return thm?
|
||||
|
||||
/--
|
||||
Try to use automatically generated congruence theorems. See `mkCongrSimp?`.
|
||||
-/
|
||||
@[specialize] def tryAutoCongrTheorem?
|
||||
[Monad m] [MonadEnv m] [MonadCongrCache m] [MonadLiftT MetaM m]
|
||||
[MonadLiftT IO m] [MonadRef m] [MonadOptions m] [MonadTrace m] [AddMessageContext m]
|
||||
(simp : Expr → m Result)
|
||||
(dsimp : Expr → m Expr)
|
||||
(e : Expr) : m (Option Result) := do
|
||||
let f := e.getAppFn
|
||||
-- TODO: cache
|
||||
let some cgrThm ← mkCongrSimp? f | return none
|
||||
if cgrThm.argKinds.size != e.getAppNumArgs then return none
|
||||
let mut simplified := false
|
||||
let mut hasProof := false
|
||||
let mut hasCast := false
|
||||
let mut argsNew := #[]
|
||||
let mut argResults := #[]
|
||||
let args := e.getAppArgs
|
||||
for arg in args, kind in cgrThm.argKinds do
|
||||
match kind with
|
||||
| CongrArgKind.fixed => argsNew := argsNew.push (← dsimp arg)
|
||||
| CongrArgKind.cast => hasCast := true; argsNew := argsNew.push arg
|
||||
| CongrArgKind.subsingletonInst => argsNew := argsNew.push arg
|
||||
| CongrArgKind.eq =>
|
||||
let argResult ← simp arg
|
||||
argResults := argResults.push argResult
|
||||
argsNew := argsNew.push argResult.expr
|
||||
if argResult.proof?.isSome then hasProof := true
|
||||
if arg != argResult.expr then simplified := true
|
||||
| _ => unreachable!
|
||||
if !simplified then return some { expr := e }
|
||||
/-
|
||||
If `hasProof` is false, we used to return `mkAppN f argsNew` with `proof? := none`.
|
||||
However, this created a regression when we started using `proof? := none` for `rfl` theorems.
|
||||
Consider the following goal
|
||||
```
|
||||
m n : Nat
|
||||
a : Fin n
|
||||
h₁ : m < n
|
||||
h₂ : Nat.pred (Nat.succ m) < n
|
||||
⊢ Fin.succ (Fin.mk m h₁) = Fin.succ (Fin.mk m.succ.pred h₂)
|
||||
```
|
||||
The term `m.succ.pred` is simplified to `m` using a `Nat.pred_succ` which is a `rfl` theorem.
|
||||
The auto generated theorem for `Fin.mk` has casts and if used here at `Fin.mk m.succ.pred h₂`,
|
||||
it produces the term `Fin.mk m (id (Eq.refl m) ▸ h₂)`. The key property here is that the
|
||||
proof `(id (Eq.refl m) ▸ h₂)` has type `m < n`. If we had just returned `mkAppN f argsNew`,
|
||||
the resulting term would be `Fin.mk m h₂` which is type correct, but later we would not be
|
||||
able to apply `eq_self` to
|
||||
```lean
|
||||
Fin.succ (Fin.mk m h₁) = Fin.succ (Fin.mk m h₂)
|
||||
```
|
||||
because we would not be able to establish that `m < n` and `Nat.pred (Nat.succ m) < n` are definitionally
|
||||
equal using `TransparencyMode.reducible` (`Nat.pred` is not reducible).
|
||||
Thus, we decided to return here only if the auto generated congruence theorem does not introduce casts.
|
||||
-/
|
||||
if !hasProof && !hasCast then return some { expr := mkAppN f argsNew }
|
||||
let mut proof := cgrThm.proof
|
||||
let mut type := cgrThm.type
|
||||
let mut j := 0 -- index at argResults
|
||||
let mut subst := #[]
|
||||
for arg in args, kind in cgrThm.argKinds do
|
||||
proof := mkApp proof arg
|
||||
subst := subst.push arg
|
||||
type := type.bindingBody!
|
||||
match kind with
|
||||
| CongrArgKind.fixed => pure ()
|
||||
| CongrArgKind.cast => pure ()
|
||||
| CongrArgKind.subsingletonInst =>
|
||||
let clsNew := type.bindingDomain!.instantiateRev subst
|
||||
let instNew ← if (← isDefEq (← inferType arg) clsNew) then
|
||||
pure arg
|
||||
else
|
||||
match (← trySynthInstance clsNew) with
|
||||
| LOption.some val => pure val
|
||||
| _ =>
|
||||
trace[Meta.Tactic.simp.congr] "failed to synthesize instance{indentExpr clsNew}"
|
||||
return none
|
||||
proof := mkApp proof instNew
|
||||
subst := subst.push instNew
|
||||
type := type.bindingBody!
|
||||
| CongrArgKind.eq =>
|
||||
let argResult := argResults[j]!
|
||||
let argProof ← argResult.getProof' arg
|
||||
j := j + 1
|
||||
proof := mkApp2 proof argResult.expr argProof
|
||||
subst := subst.push argResult.expr |>.push argProof
|
||||
type := type.bindingBody!.bindingBody!
|
||||
| _ => unreachable!
|
||||
let some (_, _, rhs) := type.instantiateRev subst |>.eq? | unreachable!
|
||||
let rhs ← if hasCast then removeUnnecessaryCasts rhs else pure rhs
|
||||
if hasProof then
|
||||
return some { expr := rhs, proof? := proof }
|
||||
else
|
||||
/- See comment above. This is reachable if `hasCast == true`. The `rhs` is not structurally equal to `mkAppN f argsNew` -/
|
||||
return some { expr := rhs }
|
||||
|
||||
end Simp
|
||||
|
||||
export Simp (SimpM)
|
||||
|
||||
/--
|
||||
Auxiliary method.
|
||||
Given the current `target` of `mvarId`, apply `r` which is a new target and proof that it is equal to the current one.
|
||||
-/
|
||||
def applySimpResultToTarget (mvarId : MVarId) (target : Expr) (r : Simp.Result) : MetaM MVarId := do
|
||||
match r.proof? with
|
||||
| some proof => mvarId.replaceTargetEq r.expr proof
|
||||
| none =>
|
||||
if target != r.expr then
|
||||
mvarId.replaceTargetDefEq r.expr
|
||||
else
|
||||
return mvarId
|
||||
|
||||
end Lean.Meta
|
||||
|
||||
14
src/Lean/Meta/Tactic/SymEval.lean
Normal file
14
src/Lean/Meta/Tactic/SymEval.lean
Normal file
@@ -0,0 +1,14 @@
|
||||
/-
|
||||
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Tactic.SymEval.Types
|
||||
import Lean.Meta.Tactic.SymEval.Main
|
||||
|
||||
namespace Lean
|
||||
|
||||
builtin_initialize registerTraceClass `Meta.Tactic.seval
|
||||
builtin_initialize registerTraceClass `Meta.Tactic.seval.visit
|
||||
|
||||
end Lean
|
||||
133
src/Lean/Meta/Tactic/SymEval/Main.lean
Normal file
133
src/Lean/Meta/Tactic/SymEval/Main.lean
Normal file
@@ -0,0 +1,133 @@
|
||||
/-
|
||||
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Tactic.Util
|
||||
import Lean.Meta.Tactic.Simp.Rewrite
|
||||
import Lean.Meta.Tactic.SymEval.Types
|
||||
|
||||
namespace Lean.Meta
|
||||
namespace SymEval
|
||||
|
||||
def cacheResult (e : Expr) (r : Result) : M Result := do
|
||||
let dischargeDepth := (← read).dischargeDepth
|
||||
modify fun s => { s with cache := s.cache.insert e { r with dischargeDepth } }
|
||||
return r
|
||||
|
||||
def evalLit (e : Expr) : M Result :=
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
partial def seval (e : Expr) : M Result := withIncRecDepth do
|
||||
checkSystem "eval"
|
||||
if (← isProof e) then
|
||||
return { expr := e }
|
||||
if let some result := (← get).cache.find? e then
|
||||
if result.dischargeDepth ≤ (← read).dischargeDepth then
|
||||
return result
|
||||
loop { expr := e }
|
||||
where
|
||||
loop (r : Result) : M Result := do
|
||||
let cfg ← getConfig
|
||||
if (← get).numSteps > cfg.maxSteps then
|
||||
throwError "'seval' failed, maximum number of steps exceeded"
|
||||
else
|
||||
modify fun s => { s with numSteps := s.numSteps + 1 }
|
||||
let r ← Simp.mkEqTrans r (← step r.expr)
|
||||
cacheResult e r
|
||||
|
||||
step (e : Expr) : M Result := do
|
||||
trace[Meta.Tactic.seval.visit] "{e}"
|
||||
match e with
|
||||
| .mdata _ e => seval e
|
||||
| .proj .. => evalProj e
|
||||
| .app .. => evalApp e
|
||||
| .lam .. => evalLambda e
|
||||
| .forallE .. => evalForall e
|
||||
| .letE .. => evalLet e
|
||||
| .const .. => evalConst e
|
||||
| .bvar .. => unreachable!
|
||||
| .sort .. => return { expr := e }
|
||||
| .lit .. => evalLit e
|
||||
| .mvar .. => seval (← instantiateMVars e)
|
||||
| .fvar .. => evalFVar e
|
||||
|
||||
evalConst (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
evalFVar (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
evalLet (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
evalProj (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
evalLambda (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
evalForall (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
return { expr := e }
|
||||
|
||||
congrArgs (r : Result) (args : Array Expr) : M Result := do
|
||||
Simp.congrArgs seval pure r args
|
||||
|
||||
/-- Try to use automatically generated congruence theorems. See `mkCongrSimp?`. -/
|
||||
tryAutoCongrTheorem? (e : Expr) : M (Option Result) := do
|
||||
Simp.tryAutoCongrTheorem? seval pure e
|
||||
|
||||
congr (e : Expr) : M Result := do
|
||||
if let some result ← tryAutoCongrTheorem? e then
|
||||
return result
|
||||
else
|
||||
e.withApp fun f args => do
|
||||
congrArgs (← seval f) args
|
||||
|
||||
evalApp (e : Expr) : M Result := do
|
||||
-- TODO
|
||||
congr e
|
||||
|
||||
def main (e : Expr) (ctx : Context): MetaM Result := do
|
||||
try
|
||||
withoutCatchingRuntimeEx do
|
||||
let (r, _) ← seval e ctx |>.run {}
|
||||
return r
|
||||
catch ex =>
|
||||
if ex.isRuntime then throwNestedTacticEx `seval ex else throw ex
|
||||
|
||||
end SymEval
|
||||
|
||||
def seval (e : Expr) (ctx : SymEval.Context) : MetaM SymEval.Result := do profileitM Exception "seval" (← getOptions) do
|
||||
SymEval.main e ctx
|
||||
|
||||
/-- See `sevalTarget`. This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
|
||||
def sevalTargetCore (mvarId : MVarId) (ctx : SymEval.Context) : MetaM (Option MVarId) := do
|
||||
let target ← instantiateMVars (← mvarId.getType)
|
||||
let r ← seval target ctx
|
||||
if r.expr.consumeMData.isConstOf ``True then
|
||||
match r.proof? with
|
||||
| some proof => mvarId.assign (← mkOfEqTrue proof)
|
||||
| none => mvarId.assign (mkConst ``True.intro)
|
||||
return none
|
||||
else
|
||||
applySimpResultToTarget mvarId target r
|
||||
|
||||
/--
|
||||
Symbolic evaluate the given goal target (aka type).
|
||||
Return `none` if the goal was closed. Return `some mvarId'` otherwise,
|
||||
where `mvarId'` is the new reduced goal.
|
||||
-/
|
||||
def sevalTarget (mvarId : MVarId) (ctx : SymEval.Context := {}) : MetaM (Option MVarId) :=
|
||||
mvarId.withContext do
|
||||
mvarId.checkNotAssigned `seval
|
||||
sevalTargetCore mvarId ctx
|
||||
|
||||
end Lean.Meta
|
||||
58
src/Lean/Meta/Tactic/SymEval/Types.lean
Normal file
58
src/Lean/Meta/Tactic/SymEval/Types.lean
Normal file
@@ -0,0 +1,58 @@
|
||||
/-
|
||||
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.Tactic.Simp.Types
|
||||
|
||||
namespace Lean.Meta.SymEval
|
||||
|
||||
/-!
|
||||
The `seval` tactic is similar to `simp`, but it is optimized for reducing nested ground
|
||||
terms, and performing partial evaluation.
|
||||
-/
|
||||
|
||||
/--
|
||||
Configuration options for `seval` tactic.
|
||||
-/
|
||||
-- TODO: move to `Init`
|
||||
structure Config where
|
||||
maxSteps : Nat := 100000
|
||||
deriving Inhabited
|
||||
|
||||
structure Context where
|
||||
config : Config := {}
|
||||
/-- `ground` is true when visiting a ground term. -/
|
||||
ground : Bool := false
|
||||
simpTheorems : SimpTheoremsArray := {}
|
||||
congrTheorems : SimpCongrTheorems := {}
|
||||
dischargeDepth : Nat := 0
|
||||
deriving Inhabited
|
||||
|
||||
export Simp (Cache CongrCache Result)
|
||||
|
||||
/--
|
||||
State for the `seval` tactic.
|
||||
TODO: better support for hash-consing.
|
||||
-/
|
||||
structure State where
|
||||
cache : Cache := {}
|
||||
congrCache : CongrCache := {}
|
||||
numSteps : Nat := 0
|
||||
|
||||
abbrev M := ReaderT Context $ StateRefT State MetaM
|
||||
|
||||
instance : Simp.MonadCongrCache M where
|
||||
find? f := return (← get).congrCache.find? f
|
||||
save f thm? := modify fun s => { s with congrCache := s.congrCache.insert f thm? }
|
||||
|
||||
def getConfig : M Config :=
|
||||
return (← read).config
|
||||
|
||||
def getSimpTheorems : M SimpTheoremsArray :=
|
||||
return (← read).simpTheorems
|
||||
|
||||
def getSimpCongrTheorems : M SimpCongrTheorems :=
|
||||
return (← read).congrTheorems
|
||||
|
||||
end Lean.Meta.SymEval
|
||||
@@ -73,12 +73,18 @@ namespace Meta
|
||||
|
||||
/--
|
||||
Similar to `Core.transform`, but terms provided to `pre` and `post` do not contain loose bound variables.
|
||||
So, it is safe to use any `MetaM` method at `pre` and `post`. -/
|
||||
So, it is safe to use any `MetaM` method at `pre` and `post`.
|
||||
|
||||
If `skipConstInApp := true`, then for an expression `mkAppN (.const f) args`, the subexpression
|
||||
`.const f` is not visited again. Put differently: every `.const f` is visited once, with its
|
||||
arguments if present, on its own otherwise.
|
||||
-/
|
||||
partial def transform {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m] [MonadTrace m] [MonadRef m] [MonadOptions m] [AddMessageContext m]
|
||||
(input : Expr)
|
||||
(pre : Expr → m TransformStep := fun _ => return .continue)
|
||||
(post : Expr → m TransformStep := fun e => return .done e)
|
||||
(usedLetOnly := false)
|
||||
(skipConstInApp := false)
|
||||
: m Expr := do
|
||||
let _ : STWorld IO.RealWorld m := ⟨⟩
|
||||
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := MetaM) (liftM (m := ST IO.RealWorld) x) }
|
||||
@@ -109,7 +115,10 @@ partial def transform {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m]
|
||||
| e => visitPost (← mkLetFVars (usedLetOnly := usedLetOnly) fvars (← visit (e.instantiateRev fvars)))
|
||||
let visitApp (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
|
||||
e.withApp fun f args => do
|
||||
visitPost (mkAppN (← visit f) (← args.mapM visit))
|
||||
if skipConstInApp && f.isConst then
|
||||
visitPost (mkAppN f (← args.mapM visit))
|
||||
else
|
||||
visitPost (mkAppN (← visit f) (← args.mapM visit))
|
||||
match (← pre e) with
|
||||
| .done e => pure e
|
||||
| .visit e => visit e
|
||||
|
||||
@@ -15,76 +15,79 @@ assignments. It is used in the elaborator, tactic framework, unifier
|
||||
the requirements imposed by these modules.
|
||||
|
||||
- We may invoke TC while executing `isDefEq`. We need this feature to
|
||||
be able to solve unification problems such as:
|
||||
```
|
||||
f ?a (ringAdd ?s) ?x ?y =?= f Int intAdd n m
|
||||
```
|
||||
where `(?a : Type) (?s : Ring ?a) (?x ?y : ?a)`
|
||||
During `isDefEq` (i.e., unification), it will need to solve the constrain
|
||||
```
|
||||
ringAdd ?s =?= intAdd
|
||||
```
|
||||
We say `ringAdd ?s` is stuck because it cannot be reduced until we
|
||||
synthesize the term `?s : Ring ?a` using TC. This can be done since we
|
||||
have assigned `?a := Int` when solving `?a =?= Int`.
|
||||
WellFoundedRelationbe able to solve unification problems such as:
|
||||
```
|
||||
f ?a (ringAdd ?s) ?x ?y =?= f Int intAdd n m
|
||||
```
|
||||
where `(?a : Type) (?s : Ring ?a) (?x ?y : ?a)`.
|
||||
|
||||
During `isDefEq` (i.e., unification), it will need to solve the constrain
|
||||
```
|
||||
ringAdd ?s =?= intAdd
|
||||
```
|
||||
We say `ringAdd ?s` is stuck because it cannot be reduced until we
|
||||
synthesize the term `?s : Ring ?a` using TC. This can be done since we
|
||||
have assigned `?a := Int` when solving `?a =?= Int`.
|
||||
|
||||
- TC uses `isDefEq`, and `isDefEq` may create TC problems as shown
|
||||
above. Thus, we may have nested TC problems.
|
||||
above. Thus, we may have nested TC problems.
|
||||
|
||||
- `isDefEq` extends the local context when going inside binders. Thus,
|
||||
the local context for nested TC may be an extension of the local
|
||||
context for outer TC.
|
||||
the local context for nested TC may be an extension of the local
|
||||
context for outer TC.
|
||||
|
||||
- TC should not assign metavariables created by the elaborator, simp,
|
||||
tactic framework, and outer TC problems. Reason: TC commits to the
|
||||
first solution it finds. Consider the TC problem `Coe Nat ?x`,
|
||||
where `?x` is a metavariable created by the caller. There are many
|
||||
solutions to this problem (e.g., `?x := Int`, `?x := Real`, ...),
|
||||
and it doesn’t make sense to commit to the first one since TC does
|
||||
not know the constraints the caller may impose on `?x` after the
|
||||
TC problem is solved.
|
||||
Remark: we claim it is not feasible to make the whole system backtrackable,
|
||||
and allow the caller to backtrack back to TC and ask it for another solution
|
||||
if the first one found did not work. We claim it would be too inefficient.
|
||||
tactic framework, and outer TC problems. Reason: TC commits to the
|
||||
first solution it finds. Consider the TC problem `Coe Nat ?x`,
|
||||
where `?x` is a metavariable created by the caller. There are many
|
||||
solutions to this problem (e.g., `?x := Int`, `?x := Real`, ...),
|
||||
and it doesn’t make sense to commit to the first one since TC does
|
||||
not know the constraints the caller may impose on `?x` after the
|
||||
TC problem is solved.
|
||||
|
||||
Remark: we claim it is not feasible to make the whole system backtrackable,
|
||||
and allow the caller to backtrack back to TC and ask it for another solution
|
||||
if the first one found did not work. We claim it would be too inefficient.
|
||||
|
||||
- TC metavariables should not leak outside of TC. Reason: we want to
|
||||
get rid of them after we synthesize the instance.
|
||||
get rid of them after we synthesize the instance.
|
||||
|
||||
- `simp` invokes `isDefEq` for matching the left-hand-side of
|
||||
equations to terms in our goal. Thus, it may invoke TC indirectly.
|
||||
equations to terms in our goal. Thus, it may invoke TC indirectly.
|
||||
|
||||
- In Lean3, we didn’t have to create a fresh pattern for trying to
|
||||
match the left-hand-side of equations when executing `simp`. We had a
|
||||
mechanism called "tmp" metavariables. It avoided this overhead, but it
|
||||
created many problems since `simp` may indirectly call TC which may
|
||||
recursively call TC. Moreover, we may want to allow TC to invoke
|
||||
tactics in the future. Thus, when `simp` invokes `isDefEq`, it may indirectly invoke
|
||||
a tactic and `simp` itself. The Lean3 approach assumed that
|
||||
metavariables were short-lived, this is not true in Lean4, and to some
|
||||
extent was also not true in Lean3 since `simp`, in principle, could
|
||||
trigger an arbitrary number of nested TC problems.
|
||||
match the left-hand-side of equations when executing `simp`. We had a
|
||||
mechanism called "tmp" metavariables. It avoided this overhead, but it
|
||||
created many problems since `simp` may indirectly call TC which may
|
||||
recursively call TC. Moreover, we may want to allow TC to invoke
|
||||
tactics in the future. Thus, when `simp` invokes `isDefEq`, it may indirectly invoke
|
||||
a tactic and `simp` itself. The Lean3 approach assumed that
|
||||
metavariables were short-lived, this is not true in Lean4, and to some
|
||||
extent was also not true in Lean3 since `simp`, in principle, could
|
||||
trigger an arbitrary number of nested TC problems.
|
||||
|
||||
- Here are some possible call stack traces we could have in Lean3 (and Lean4).
|
||||
```
|
||||
Elaborator (-> TC -> isDefEq)+
|
||||
Elaborator -> isDefEq (-> TC -> isDefEq)*
|
||||
Elaborator -> simp -> isDefEq (-> TC -> isDefEq)*
|
||||
```
|
||||
In Lean4, TC may also invoke tactics in the future.
|
||||
```
|
||||
Elaborator (-> TC -> isDefEq)+
|
||||
Elaborator -> isDefEq (-> TC -> isDefEq)*
|
||||
Elaborator -> simp -> isDefEq (-> TC -> isDefEq)*
|
||||
```
|
||||
In Lean4, TC may also invoke tactics in the future.
|
||||
|
||||
- In Lean3 and Lean4, TC metavariables are not really short-lived. We
|
||||
solve an arbitrary number of unification problems, and we may have
|
||||
nested TC invocations.
|
||||
solve an arbitrary number of unification problems, and we may have
|
||||
nested TC invocations.
|
||||
|
||||
- TC metavariables do not share the same local context even in the
|
||||
same invocation. In the C++ and Lean implementations we use a trick to
|
||||
ensure they do:
|
||||
https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379/src/library/type_context.cpp#L3583-L3594
|
||||
same invocation. In the C++ and Lean implementations we use a trick to
|
||||
ensure they do:
|
||||
<https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379/src/library/type_context.cpp#L3583-L3594>
|
||||
|
||||
- Metavariables may be natural, synthetic or syntheticOpaque.
|
||||
a) Natural metavariables may be assigned by unification (i.e., `isDefEq`).
|
||||
|
||||
b) Synthetic metavariables may still be assigned by unification,
|
||||
1. Natural metavariables may be assigned by unification (i.e., `isDefEq`).
|
||||
|
||||
2. Synthetic metavariables may still be assigned by unification,
|
||||
but whenever possible `isDefEq` will avoid the assignment. For example,
|
||||
if we have the unification constraint `?m =?= ?n`, where `?m` is synthetic,
|
||||
but `?n` is not, `isDefEq` solves it by using the assignment `?n := ?m`.
|
||||
@@ -94,7 +97,7 @@ https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379
|
||||
them, and check whether the synthesized result is compatible with the one
|
||||
assigned by `isDefEq`.
|
||||
|
||||
c) SyntheticOpaque metavariables are never assigned by `isDefEq`.
|
||||
3. SyntheticOpaque metavariables are never assigned by `isDefEq`.
|
||||
That is, the constraint `?n =?= Nat.succ Nat.zero` always fail
|
||||
if `?n` is a syntheticOpaque metavariable. This kind of metavariable
|
||||
is created by tactics such as `intro`. Reason: in the tactic framework,
|
||||
@@ -104,78 +107,80 @@ https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379
|
||||
This distinction was not precise in Lean3 and produced
|
||||
counterintuitive behavior. For example, the following hack was added
|
||||
in Lean3 to work around one of these issues:
|
||||
https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379/src/library/type_context.cpp#L2751
|
||||
<https://github.com/leanprover/lean/blob/92826917a252a6092cffaf5fc5f1acb1f8cef379/src/library/type_context.cpp#L2751>
|
||||
|
||||
- When creating lambda/forall expressions, we need to convert/abstract
|
||||
free variables and convert them to bound variables. Now, suppose we are
|
||||
trying to create a lambda/forall expression by abstracting free
|
||||
variable `xs` and a term `t[?m]` which contains a metavariable `?m`,
|
||||
and the local context of `?m` contains `xs`. The term
|
||||
```
|
||||
fun xs => t[?m]
|
||||
```
|
||||
will be ill-formed if we later assign a term `s` to `?m`, and
|
||||
`s` contains free variables in `xs`. We address this issue by changing
|
||||
the free variable abstraction procedure. We consider two cases: `?m`
|
||||
is natural or synthetic, or `?m` is syntheticOpaque. Assume the type of `?m` is
|
||||
`A[xs]`. Then, in both cases we create an auxiliary metavariable `?n` with
|
||||
type `forall xs => A[xs]`, and local context := local context of `?m` - `xs`.
|
||||
In both cases, we produce the term `fun xs => t[?n xs]`
|
||||
|
||||
1- If `?m` is natural or synthetic, then we assign `?m := ?n xs`, and we produce
|
||||
the term `fun xs => t[?n xs]`
|
||||
|
||||
2- If `?m` is syntheticOpaque, then we mark `?n` as a syntheticOpaque variable.
|
||||
However, `?n` is managed by the metavariable context itself.
|
||||
We say we have a "delayed assignment" `?n xs := ?m`.
|
||||
That is, after a term `s` is assigned to `?m`, and `s`
|
||||
does not contain metavariables, we replace any occurrence
|
||||
`?n ts` with `s[xs := ts]`.
|
||||
|
||||
Gruesome details:
|
||||
|
||||
- When we create the type `forall xs => A` for `?n`, we may
|
||||
encounter the same issue if `A` contains metavariables. So, the
|
||||
process above is recursive. We claim it terminates because we keep
|
||||
creating new metavariables with smaller local contexts.
|
||||
|
||||
- Suppose, we have `t[?m]` and we want to create a let-expression by
|
||||
abstracting a let-decl free variable `x`, and the local context of
|
||||
`?m` contains `x`. Similarly to the previous case
|
||||
free variables and convert them to bound variables. Now, suppose we are
|
||||
trying to create a lambda/forall expression by abstracting free
|
||||
variable `xs` and a term `t[?m]` which contains a metavariable `?m`,
|
||||
and the local context of `?m` contains `xs`. The term
|
||||
```
|
||||
let x : T := v; t[?m]
|
||||
fun xs => t[?m]
|
||||
```
|
||||
will be ill-formed if we later assign a term `s` to `?m`, and
|
||||
`s` contains free variable `x`. Again, assume the type of `?m` is `A[x]`.
|
||||
`s` contains free variables in `xs`. We address this issue by changing
|
||||
the free variable abstraction procedure. We consider two cases: `?m`
|
||||
is natural or synthetic, or `?m` is syntheticOpaque. Assume the type of `?m` is
|
||||
`A[xs]`. Then, in both cases we create an auxiliary metavariable `?n` with
|
||||
type `forall xs => A[xs]`, and local context := local context of `?m` - `xs`.
|
||||
In both cases, we produce the term `fun xs => t[?n xs]`
|
||||
|
||||
1- If `?m` is natural or synthetic, then we create `?n : (let x : T := v; A[x])` with
|
||||
and local context := local context of `?m` - `x`, we assign `?m := ?n`,
|
||||
and produce the term `let x : T := v; t[?n]`. That is, we are just making
|
||||
sure `?n` must never be assigned to a term containing `x`.
|
||||
1. If `?m` is natural or synthetic, then we assign `?m := ?n xs`, and we produce
|
||||
the term `fun xs => t[?n xs]`
|
||||
|
||||
2- If `?m` is syntheticOpaque, we create a fresh syntheticOpaque `?n`
|
||||
with type `?n : T -> (let x : T := v; A[x])` and local context := local context of `?m` - `x`,
|
||||
create the delayed assignment `?n #[x] := ?m`, and produce the term `let x : T := v; t[?n x]`.
|
||||
Now suppose we assign `s` to `?m`. We do not assign the term `fun (x : T) => s` to `?n`, since
|
||||
`fun (x : T) => s` may not even be type correct. Instead, we just replace applications `?n r`
|
||||
with `s[x/r]`. The term `r` may not necessarily be a bound variable. For example, a tactic
|
||||
may have reduced `let x : T := v; t[?n x]` into `t[?n v]`.
|
||||
We are essentially using the pair "delayed assignment + application" to implement a delayed
|
||||
substitution.
|
||||
2. If `?m` is syntheticOpaque, then we mark `?n` as a syntheticOpaque variable.
|
||||
However, `?n` is managed by the metavariable context itself.
|
||||
We say we have a "delayed assignment" `?n xs := ?m`.
|
||||
That is, after a term `s` is assigned to `?m`, and `s`
|
||||
does not contain metavariables, we replace any occurrence
|
||||
`?n ts` with `s[xs := ts]`.
|
||||
|
||||
Gruesome details:
|
||||
|
||||
- When we create the type `forall xs => A` for `?n`, we may
|
||||
encounter the same issue if `A` contains metavariables. So, the
|
||||
process above is recursive. We claim it terminates because we keep
|
||||
creating new metavariables with smaller local contexts.
|
||||
|
||||
- Suppose, we have `t[?m]` and we want to create a let-expression by
|
||||
abstracting a let-decl free variable `x`, and the local context of
|
||||
`?m` contains `x`. Similarly to the previous case
|
||||
```
|
||||
let x : T := v; t[?m]
|
||||
```
|
||||
will be ill-formed if we later assign a term `s` to `?m`, and
|
||||
`s` contains free variable `x`. Again, assume the type of `?m` is `A[x]`.
|
||||
|
||||
1. If `?m` is natural or synthetic, then we create `?n : (let x : T := v; A[x])` with
|
||||
and local context := local context of `?m` - `x`, we assign `?m := ?n`,
|
||||
and produce the term `let x : T := v; t[?n]`. That is, we are just making
|
||||
sure `?n` must never be assigned to a term containing `x`.
|
||||
|
||||
2. If `?m` is syntheticOpaque, we create a fresh syntheticOpaque `?n`
|
||||
with type `?n : T -> (let x : T := v; A[x])` and local context := local context of `?m` - `x`,
|
||||
create the delayed assignment `?n #[x] := ?m`, and produce the term `let x : T := v; t[?n x]`.
|
||||
|
||||
Now suppose we assign `s` to `?m`. We do not assign the term `fun (x : T) => s` to `?n`, since
|
||||
`fun (x : T) => s` may not even be type correct. Instead, we just replace applications `?n r`
|
||||
with `s[x/r]`. The term `r` may not necessarily be a bound variable. For example, a tactic
|
||||
may have reduced `let x : T := v; t[?n x]` into `t[?n v]`.
|
||||
|
||||
We are essentially using the pair "delayed assignment + application" to implement a delayed
|
||||
substitution.
|
||||
|
||||
- We use TC for implementing coercions. Both Joe Hendrix and Reid Barton
|
||||
reported a nasty limitation. In Lean3, TC will not be used if there are
|
||||
metavariables in the TC problem. For example, the elaborator will not try
|
||||
to synthesize `Coe Nat ?x`. This is good, but this constraint is too
|
||||
strict for problems such as `Coe (Vector Bool ?n) (BV ?n)`. The coercion
|
||||
exists independently of `?n`. Thus, during TC, we want `isDefEq` to throw
|
||||
an exception instead of return `false` whenever it tries to assign
|
||||
a metavariable owned by its caller. The idea is to sign to the caller that
|
||||
it cannot solve the TC problem at this point, and more information is needed.
|
||||
That is, the caller must make progress an assign its metavariables before
|
||||
trying to invoke TC again.
|
||||
reported a nasty limitation. In Lean3, TC will not be used if there are
|
||||
metavariables in the TC problem. For example, the elaborator will not try
|
||||
to synthesize `Coe Nat ?x`. This is good, but this constraint is too
|
||||
strict for problems such as `Coe (Vector Bool ?n) (BV ?n)`. The coercion
|
||||
exists independently of `?n`. Thus, during TC, we want `isDefEq` to throw
|
||||
an exception instead of return `false` whenever it tries to assign
|
||||
a metavariable owned by its caller. The idea is to sign to the caller that
|
||||
it cannot solve the TC problem at this point, and more information is needed.
|
||||
That is, the caller must make progress an assign its metavariables before
|
||||
trying to invoke TC again.
|
||||
|
||||
In Lean4, we are using a simpler design for the `MetavarContext`.
|
||||
In Lean4, we are using a simpler design for the `MetavarContext`.
|
||||
|
||||
- No distinction between temporary and regular metavariables.
|
||||
|
||||
@@ -184,6 +189,7 @@ In Lean4, we are using a simpler design for the `MetavarContext`.
|
||||
- MetavarContext also has a `depth` field.
|
||||
|
||||
- We bump the `MetavarContext` depth when we create a nested problem.
|
||||
|
||||
Example: Elaborator (depth = 0) -> Simplifier matcher (depth = 1) -> TC (level = 2) -> TC (level = 3) -> ...
|
||||
|
||||
- When `MetavarContext` is at depth N, `isDefEq` does not assign variables from `depth < N`.
|
||||
@@ -192,11 +198,12 @@ In Lean4, we are using a simpler design for the `MetavarContext`.
|
||||
|
||||
- New design even allows us to invoke tactics from TC.
|
||||
|
||||
* Main concern
|
||||
We don't have tmp metavariables anymore in Lean4. Thus, before trying to match
|
||||
the left-hand-side of an equation in `simp`. We first must bump the level of the `MetavarContext`,
|
||||
create fresh metavariables, then create a new pattern by replacing the free variable on the left-hand-side with
|
||||
these metavariables. We are hoping to minimize this overhead by
|
||||
- Main concern
|
||||
|
||||
We don't have tmp metavariables anymore in Lean4. Thus, before trying to match
|
||||
the left-hand-side of an equation in `simp`. We first must bump the level of the `MetavarContext`,
|
||||
create fresh metavariables, then create a new pattern by replacing the free variable on the left-hand-side with
|
||||
these metavariables. We are hoping to minimize this overhead by
|
||||
|
||||
- Using better indexing data structures in `simp`. They should reduce the number of time `simp` must invoke `isDefEq`.
|
||||
|
||||
@@ -480,7 +487,8 @@ def assignDelayedMVar [MonadMCtx m] (mvarId : MVarId) (fvars : Array Expr) (mvar
|
||||
modifyMCtx fun m => { m with dAssignment := m.dAssignment.insert mvarId { fvars, mvarIdPending } }
|
||||
|
||||
/-!
|
||||
Notes on artificial eta-expanded terms due to metavariables.
|
||||
## Notes on artificial eta-expanded terms due to metavariables.
|
||||
|
||||
We try avoid synthetic terms such as `((fun x y => t) a b)` in the output produced by the elaborator.
|
||||
This kind of term may be generated when instantiating metavariable assignments.
|
||||
This module tries to avoid their generation because they often introduce unnecessary dependencies and
|
||||
@@ -491,9 +499,11 @@ all free variables that may be used to "fill" the hole. Suppose, we create a met
|
||||
containing `(x : Nat) (y : Nat) (b : Bool)`, then we can assign terms such as `x + y` to `?m` since `x` and `y`
|
||||
are in the context used to create `?m`. Now, suppose we have the term `?m + 1` and we want to create the lambda expression
|
||||
`fun x => ?m + 1`. This term is not correct since we may assign to `?m` a term containing `x`.
|
||||
|
||||
We address this issue by create a synthetic metavariable `?n : Nat → Nat` and adding the delayed assignment
|
||||
`?n #[x] := ?m`, and the term `fun x => ?n x + 1`. When we later assign a term `t[x]` to `?m`, `fun x => t[x]` is assigned to
|
||||
`?n`, and if we substitute it at `fun x => ?n x + 1`, we produce `fun x => ((fun x => t[x]) x) + 1`.
|
||||
|
||||
To avoid this term eta-expanded term, we apply beta-reduction when instantiating metavariable assignments in this module.
|
||||
This operation is performed at `instantiateExprMVars`, `elimMVarDeps`, and `levelMVarToParam`.
|
||||
-/
|
||||
@@ -923,7 +933,8 @@ private def getLocalDeclWithSmallestIdx (lctx : LocalContext) (xs : Array Expr)
|
||||
Remark: We used to throw an `Exception.revertFailure` exception when an auxiliary declaration
|
||||
had to be reversed. Recall that auxiliary declarations are created when compiling (mutually)
|
||||
recursive definitions. The `revertFailure` due to auxiliary declaration dependency was originally
|
||||
introduced in Lean3 to address issue https://github.com/leanprover/lean/issues/1258.
|
||||
introduced in Lean3 to address issue <https://github.com/leanprover/lean/issues/1258>.
|
||||
|
||||
In Lean4, this solution is not satisfactory because all definitions/theorems are potentially
|
||||
recursive. So, even a simple (incomplete) definition such as
|
||||
```
|
||||
@@ -939,11 +950,13 @@ private def getLocalDeclWithSmallestIdx (lctx : LocalContext) (xs : Array Expr)
|
||||
we create the metavariable `?n : {α : Type} → (a : α) → (f : α → List α) → List α`,
|
||||
add the delayed assignment `?n #[α, a, f] := ?m`, and create the lambda
|
||||
`fun {α : Type} (a : α) => ?n α a f`.
|
||||
|
||||
See `elimMVarDeps` for more information.
|
||||
|
||||
If we kept using the Lean3 approach, we would get the `Exception.revertFailure` exception because we are
|
||||
reverting the auxiliary definition `f`.
|
||||
|
||||
Note that https://github.com/leanprover/lean/issues/1258 is not an issue in Lean4 because
|
||||
Note that <https://github.com/leanprover/lean/issues/1258> is not an issue in Lean4 because
|
||||
we have changed how we compile recursive definitions.
|
||||
-/
|
||||
def collectForwardDeps (lctx : LocalContext) (toRevert : Array Expr) : M (Array Expr) := do
|
||||
|
||||
@@ -564,7 +564,40 @@ def hexDigitFn : ParserFn := fun c s =>
|
||||
if curr.isDigit || ('a' <= curr && curr <= 'f') || ('A' <= curr && curr <= 'F') then s.setPos i
|
||||
else s.mkUnexpectedError "invalid hexadecimal numeral"
|
||||
|
||||
def quotedCharCoreFn (isQuotable : Char → Bool) : ParserFn := fun c s =>
|
||||
/--
|
||||
Parses the whitespace after the `\` when there is a string gap.
|
||||
Raises an error if the whitespace does not contain exactly one newline character.
|
||||
Processes `\r\n` as a newline.
|
||||
-/
|
||||
partial def stringGapFn (seenNewline afterCR : Bool) : ParserFn := fun c s =>
|
||||
let i := s.pos
|
||||
if h : c.input.atEnd i then s -- let strLitFnAux handle the EOI error if !seenNewline
|
||||
else
|
||||
let curr := c.input.get' i h
|
||||
if curr == '\n' then
|
||||
if seenNewline then
|
||||
-- Having more than one newline in a string gap is visually confusing
|
||||
s.mkUnexpectedError "unexpected additional newline in string gap"
|
||||
else
|
||||
stringGapFn true false c (s.next' c.input i h)
|
||||
else if curr == '\r' then
|
||||
stringGapFn seenNewline true c (s.next' c.input i h)
|
||||
else if afterCR then
|
||||
s.mkUnexpectedError "expecting newline after carriage return"
|
||||
else if curr.isWhitespace then
|
||||
stringGapFn seenNewline false c (s.next' c.input i h)
|
||||
else if seenNewline then
|
||||
s
|
||||
else
|
||||
s.mkUnexpectedError "expecting newline in string gap"
|
||||
|
||||
/--
|
||||
Parses a string quotation after a `\`.
|
||||
- `isQuotable` determines which characters are valid escapes
|
||||
- `inString` enables features that are only valid within strings,
|
||||
in particular `"\" newline whitespace*` gaps.
|
||||
-/
|
||||
def quotedCharCoreFn (isQuotable : Char → Bool) (inString : Bool) : ParserFn := fun c s =>
|
||||
let input := c.input
|
||||
let i := s.pos
|
||||
if h : input.atEnd i then s.mkEOIError
|
||||
@@ -576,6 +609,8 @@ def quotedCharCoreFn (isQuotable : Char → Bool) : ParserFn := fun c s =>
|
||||
andthenFn hexDigitFn hexDigitFn c (s.next' input i h)
|
||||
else if curr == 'u' then
|
||||
andthenFn hexDigitFn (andthenFn hexDigitFn (andthenFn hexDigitFn hexDigitFn)) c (s.next' input i h)
|
||||
else if inString && (curr == '\n' || curr == '\r') then
|
||||
stringGapFn false false c s
|
||||
else
|
||||
s.mkUnexpectedError "invalid escape sequence"
|
||||
|
||||
@@ -583,7 +618,14 @@ def isQuotableCharDefault (c : Char) : Bool :=
|
||||
c == '\\' || c == '\"' || c == '\'' || c == 'r' || c == 'n' || c == 't'
|
||||
|
||||
def quotedCharFn : ParserFn :=
|
||||
quotedCharCoreFn isQuotableCharDefault
|
||||
quotedCharCoreFn isQuotableCharDefault false
|
||||
|
||||
/--
|
||||
Like `quotedCharFn` but enables escapes that are only valid inside strings.
|
||||
In particular, string gaps (`"\" newline whitespace*`).
|
||||
-/
|
||||
def quotedStringFn : ParserFn :=
|
||||
quotedCharCoreFn isQuotableCharDefault true
|
||||
|
||||
/-- Push `(Syntax.node tk <new-atom>)` onto syntax stack if parse was successful. -/
|
||||
def mkNodeToken (n : SyntaxNodeKind) (startPos : String.Pos) : ParserFn := fun c s => Id.run do
|
||||
@@ -624,7 +666,7 @@ partial def strLitFnAux (startPos : String.Pos) : ParserFn := fun c s =>
|
||||
let s := s.setPos (input.next' i h)
|
||||
if curr == '\"' then
|
||||
mkNodeToken strLitKind startPos c s
|
||||
else if curr == '\\' then andthenFn quotedCharFn (strLitFnAux startPos) c s
|
||||
else if curr == '\\' then andthenFn quotedStringFn (strLitFnAux startPos) c s
|
||||
else strLitFnAux startPos c s
|
||||
|
||||
def decimalNumberFn (startPos : String.Pos) (c : ParserContext) : ParserState → ParserState := fun s =>
|
||||
|
||||
@@ -28,32 +28,27 @@ match against a quotation in a command kind's elaborator). -/
|
||||
@[builtin_term_parser low] def quot := leading_parser
|
||||
"`(" >> withoutPosition (incQuotDepth (many1Unbox commandParser)) >> ")"
|
||||
|
||||
/-
|
||||
A mutual block may be broken in different cliques,
|
||||
we identify them using an `ident` (an element of the clique).
|
||||
We provide two kinds of hints to the termination checker:
|
||||
1- A wellfounded relation (`p` is `termParser`)
|
||||
2- A tactic for proving the recursive applications are "decreasing" (`p` is `tacticSeq`)
|
||||
/--
|
||||
A decreasing_by clause can either be a single tactic (for all functions), or
|
||||
a list of tactics labeled with the function they apply to.
|
||||
-/
|
||||
def terminationHintMany (p : Parser) := leading_parser
|
||||
atomic (lookahead (ident >> " => ")) >>
|
||||
many1Indent (group (ppLine >> ppIndent (ident >> " => " >> p >> optional ";")))
|
||||
def terminationHint1 (p : Parser) := leading_parser p
|
||||
def terminationHint (p : Parser) := terminationHintMany p <|> terminationHint1 p
|
||||
def decreasingByElement := leading_parser
|
||||
ppLine >> ppIndent (ident >> " => " >> Tactic.tacticSeq >> patternIgnore (optional ";"))
|
||||
def decreasingByMany := leading_parser
|
||||
atomic (lookahead (ident >> " => ")) >> many1Indent decreasingByElement
|
||||
def decreasingBy1 := leading_parser Tactic.tacticSeq
|
||||
|
||||
def terminationByCore := leading_parser
|
||||
ppDedent ppLine >> "termination_by' " >> terminationHint termParser
|
||||
def decreasingBy := leading_parser
|
||||
ppDedent ppLine >> "decreasing_by " >> terminationHint Tactic.tacticSeq
|
||||
ppDedent ppLine >> "decreasing_by " >> (decreasingByMany <|> decreasingBy1)
|
||||
|
||||
def terminationByElement := leading_parser
|
||||
ppLine >> (ident <|> Term.hole) >> many (ppSpace >> (ident <|> Term.hole)) >>
|
||||
" => " >> termParser >> optional ";"
|
||||
" => " >> termParser >> patternIgnore (optional ";")
|
||||
def terminationBy := leading_parser
|
||||
ppDedent ppLine >> "termination_by" >> many1Indent terminationByElement
|
||||
|
||||
def terminationSuffix :=
|
||||
optional (terminationBy <|> terminationByCore) >> optional decreasingBy
|
||||
optional terminationBy >> optional decreasingBy
|
||||
|
||||
@[builtin_command_parser]
|
||||
def moduleDoc := leading_parser ppDedent <|
|
||||
|
||||
@@ -11,7 +11,11 @@ namespace Parser
|
||||
|
||||
namespace Module
|
||||
def «prelude» := leading_parser "prelude"
|
||||
def «import» := leading_parser "import " >> optional "runtime" >> ident
|
||||
-- `optional (checkNoWsBefore >> "." >> checkNoWsBefore >> ident)`
|
||||
-- can never fully succeed but ensures that `import (runtime)? <ident>.`
|
||||
-- produces a partial syntax that contains the dot.
|
||||
-- The partial syntax is useful for import dot-auto-completion.
|
||||
def «import» := leading_parser "import " >> optional "runtime" >> ident >> optional (checkNoWsBefore >> "." >> checkNoWsBefore >> ident)
|
||||
def header := leading_parser optional («prelude» >> ppLine) >> many («import» >> ppLine) >> ppLine
|
||||
/--
|
||||
Parser for a Lean module. We never actually run this parser but instead use the imperative definitions below that
|
||||
|
||||
@@ -24,7 +24,7 @@ partial def interpolatedStrFn (p : ParserFn) : ParserFn := fun c s =>
|
||||
let s := mkNodeToken interpolatedStrLitKind startPos c s
|
||||
s.mkNode interpolatedStrKind stackSize
|
||||
else if curr == '\\' then
|
||||
andthenFn (quotedCharCoreFn isQuotableCharForStrInterpolant) (parse startPos) c s
|
||||
andthenFn (quotedCharCoreFn isQuotableCharForStrInterpolant true) (parse startPos) c s
|
||||
else if curr == '{' then
|
||||
let s := mkNodeToken interpolatedStrLitKind startPos c s
|
||||
let s := p c s
|
||||
|
||||
@@ -669,7 +669,8 @@ def isIdent (stx : Syntax) : Bool :=
|
||||
checkStackTop isIdent "expected preceding identifier" >>
|
||||
checkNoWsBefore "no space before '.{'" >> ".{" >>
|
||||
sepBy1 levelParser ", " >> "}"
|
||||
/-- `x@e` matches the pattern `e` and binds its value to the identifier `x`. -/
|
||||
/-- `x@e` or `x:h@e` matches the pattern `e` and binds its value to the identifier `x`.
|
||||
If present, the identifier `h` is bound to a proof of `x = e`. -/
|
||||
@[builtin_term_parser] def namedPattern : TrailingParser := trailing_parser
|
||||
checkStackTop isIdent "expected preceding identifier" >>
|
||||
checkNoWsBefore "no space before '@'" >> "@" >>
|
||||
|
||||
@@ -277,6 +277,17 @@ end Delaborator
|
||||
open SubExpr (Pos PosMap)
|
||||
open Delaborator (OptionsPerPos topDownAnalyze)
|
||||
|
||||
/-- Custom version of `Lean.Core.betaReduce` to beta reduce expressions for the `pp.beta` option.
|
||||
We do not want to beta reduce the application in `let_fun` annotations. -/
|
||||
private partial def betaReduce' (e : Expr) : CoreM Expr :=
|
||||
Core.transform e (pre := fun e => do
|
||||
if isLetFun e then
|
||||
return .done <| e.updateMData! (.app (← betaReduce' e.mdataExpr!.appFn!) (← betaReduce' e.mdataExpr!.appArg!))
|
||||
else if e.isHeadBetaTarget then
|
||||
return .visit e.headBeta
|
||||
else
|
||||
return .continue)
|
||||
|
||||
def delabCore (e : Expr) (optionsPerPos : OptionsPerPos := {}) (delab := Delaborator.delab) : MetaM (Term × PosMap Elab.Info) := do
|
||||
/- Using `erasePatternAnnotations` here is a bit hackish, but we do it
|
||||
`Expr.mdata` affects the delaborator. TODO: should we fix that? -/
|
||||
@@ -291,6 +302,7 @@ def delabCore (e : Expr) (optionsPerPos : OptionsPerPos := {}) (delab := Delabor
|
||||
catch _ => pure ()
|
||||
withOptions (fun _ => opts) do
|
||||
let e ← if getPPInstantiateMVars opts then instantiateMVars e else pure e
|
||||
let e ← if getPPBeta opts then betaReduce' e else pure e
|
||||
let optionsPerPos ←
|
||||
if !getPPAll opts && getPPAnalyze opts && optionsPerPos.isEmpty then
|
||||
topDownAnalyze e
|
||||
|
||||
@@ -68,6 +68,11 @@ register_builtin_option pp.instantiateMVars : Bool := {
|
||||
group := "pp"
|
||||
descr := "(pretty printer) instantiate mvars before delaborating"
|
||||
}
|
||||
register_builtin_option pp.beta : Bool := {
|
||||
defValue := false
|
||||
group := "pp"
|
||||
descr := "(pretty printer) apply beta-reduction when pretty printing"
|
||||
}
|
||||
register_builtin_option pp.structureInstances : Bool := {
|
||||
defValue := true
|
||||
group := "pp"
|
||||
@@ -152,11 +157,6 @@ register_builtin_option g_pp_locals_full_names : Bool := {
|
||||
group := "pp"
|
||||
descr := "(pretty printer) show full names of locals"
|
||||
}
|
||||
register_builtin_option g_pp_beta : Bool := {
|
||||
defValue := false
|
||||
group := "pp"
|
||||
descr := "(pretty printer) apply beta-reduction when pretty printing"
|
||||
}
|
||||
register_builtin_option g_pp_goal_compact : Bool := {
|
||||
defValue := false
|
||||
group := "pp"
|
||||
@@ -196,6 +196,7 @@ def getPPUniverses (o : Options) : Bool := o.get pp.universes.name (getPPAll o)
|
||||
def getPPFullNames (o : Options) : Bool := o.get pp.fullNames.name (getPPAll o)
|
||||
def getPPPrivateNames (o : Options) : Bool := o.get pp.privateNames.name (getPPAll o)
|
||||
def getPPInstantiateMVars (o : Options) : Bool := o.get pp.instantiateMVars.name pp.instantiateMVars.defValue
|
||||
def getPPBeta (o : Options) : Bool := o.get pp.beta.name pp.beta.defValue
|
||||
def getPPSafeShadowing (o : Options) : Bool := o.get pp.safeShadowing.name pp.safeShadowing.defValue
|
||||
def getPPProofs (o : Options) : Bool := o.get pp.proofs.name (getPPAll o)
|
||||
def getPPProofsWithType (o : Options) : Bool := o.get pp.proofs.withType.name pp.proofs.withType.defValue
|
||||
|
||||
@@ -6,13 +6,12 @@ Authors: Marc Huisinga, Wojciech Nawrocki
|
||||
-/
|
||||
import Init.System.IO
|
||||
import Lean.Data.RBMap
|
||||
|
||||
import Lean.Environment
|
||||
|
||||
import Lean.Data.Lsp
|
||||
import Lean.Data.Json.FromToJson
|
||||
|
||||
import Lean.Util.Paths
|
||||
import Lean.Util.FileSetupInfo
|
||||
import Lean.LoadDynlib
|
||||
|
||||
import Lean.Server.Utils
|
||||
@@ -23,8 +22,10 @@ import Lean.Server.References
|
||||
import Lean.Server.FileWorker.Utils
|
||||
import Lean.Server.FileWorker.RequestHandling
|
||||
import Lean.Server.FileWorker.WidgetRequests
|
||||
import Lean.Server.FileWorker.SetupFile
|
||||
import Lean.Server.Rpc.Basic
|
||||
import Lean.Widget.InteractiveDiagnostic
|
||||
import Lean.Server.ImportCompletion
|
||||
|
||||
/-!
|
||||
For general server architecture, see `README.md`. For details of IPC communication, see `Watchdog.lean`.
|
||||
@@ -125,7 +126,7 @@ section Elab
|
||||
let ctx ← read
|
||||
let some headerSnap := snaps[0]? | panic! "empty snapshots"
|
||||
if headerSnap.msgLog.hasErrors then
|
||||
-- Treat header processing errors as fatal so users aren't swamped with
|
||||
-- Treats header processing errors as fatal so users aren't swamped with
|
||||
-- followup errors
|
||||
publishProgressAtPos m headerSnap.beginPos ctx.hOut (kind := LeanFileProgressKind.fatalError)
|
||||
publishIleanInfoFinal m ctx.hOut #[headerSnap]
|
||||
@@ -142,137 +143,129 @@ end Elab
|
||||
-- Pending requests are tracked so they can be cancelled
|
||||
abbrev PendingRequestMap := RBMap RequestID (Task (Except IO.Error Unit)) compare
|
||||
|
||||
structure AvailableImportsCache where
|
||||
availableImports : ImportCompletion.AvailableImports
|
||||
lastRequestTimestampMs : Nat
|
||||
|
||||
structure WorkerState where
|
||||
doc : EditableDocument
|
||||
-- The initial header syntax tree. Changing the header requires restarting the worker process.
|
||||
initHeaderStx : Syntax
|
||||
pendingRequests : PendingRequestMap
|
||||
doc : EditableDocument
|
||||
-- The initial header syntax tree that the file worker was started with.
|
||||
initHeaderStx : Syntax
|
||||
-- The current header syntax tree. Changing the header from `initHeaderStx` initiates a restart
|
||||
-- that only completes after a while, so `currHeaderStx` tracks the modified syntax until then.
|
||||
currHeaderStx : Syntax
|
||||
importCachingTask? : Option (Task (Except Error AvailableImportsCache))
|
||||
pendingRequests : PendingRequestMap
|
||||
/-- A map of RPC session IDs. We allow asynchronous elab tasks and request handlers
|
||||
to modify sessions. A single `Ref` ensures atomic transactions. -/
|
||||
rpcSessions : RBMap UInt64 (IO.Ref RpcSession) compare
|
||||
rpcSessions : RBMap UInt64 (IO.Ref RpcSession) compare
|
||||
|
||||
abbrev WorkerM := ReaderT WorkerContext <| StateRefT WorkerState IO
|
||||
|
||||
/- Worker initialization sequence. -/
|
||||
section Initialization
|
||||
/-- Use `lake print-paths` to compile dependencies on the fly and add them to `LEAN_PATH`.
|
||||
Compilation progress is reported to `hOut` via LSP notifications. Return the search path for
|
||||
source files. -/
|
||||
partial def lakeSetupSearchPath (lakePath : System.FilePath) (m : DocumentMeta) (imports : Array Import) (hOut : FS.Stream) : IO SearchPath := do
|
||||
let mut args := #["print-paths"] ++ imports.map (toString ·.module)
|
||||
if m.dependencyBuildMode matches .never then
|
||||
args := args.push "--no-build"
|
||||
let cmdStr := " ".intercalate (toString lakePath :: args.toList)
|
||||
let lakeProc ← Process.spawn {
|
||||
stdin := Process.Stdio.null
|
||||
stdout := Process.Stdio.piped
|
||||
stderr := Process.Stdio.piped
|
||||
cmd := lakePath.toString
|
||||
args
|
||||
}
|
||||
-- progress notification: report latest stderr line
|
||||
let rec processStderr (acc : String) : IO String := do
|
||||
let line ← lakeProc.stderr.getLine
|
||||
if line == "" then
|
||||
return acc
|
||||
else
|
||||
publishDiagnostics m #[{ range := ⟨⟨0, 0⟩, ⟨0, 0⟩⟩, severity? := DiagnosticSeverity.information, message := line }] hOut
|
||||
processStderr (acc ++ line)
|
||||
let stderr ← IO.asTask (processStderr "") Task.Priority.dedicated
|
||||
let stdout := String.trim (← lakeProc.stdout.readToEnd)
|
||||
let stderr ← IO.ofExcept stderr.get
|
||||
match (← lakeProc.wait) with
|
||||
| 0 =>
|
||||
let Except.ok (paths : LeanPaths) ← pure (Json.parse stdout >>= fromJson?)
|
||||
| throwServerError s!"invalid output from `{cmdStr}`:\n{stdout}\nstderr:\n{stderr}"
|
||||
initSearchPath (← getBuildDir) paths.oleanPath
|
||||
paths.loadDynlibPaths.forM loadDynlib
|
||||
paths.srcPath.mapM realPathNormalized
|
||||
| 2 => pure [] -- no lakefile.lean
|
||||
-- error from `--no-build`
|
||||
| 3 => throwServerError s!"Imports are out of date and must be rebuilt; use the \"Restart File\" command in your editor.\n\n{stdout}"
|
||||
| _ => throwServerError s!"`{cmdStr}` failed:\n{stdout}\nstderr:\n{stderr}"
|
||||
def buildHeaderEnv (m : DocumentMeta) (headerStx : Syntax) (fileSetupResult : FileSetupResult) : IO (Environment × MessageLog) := do
|
||||
let (headerEnv, msgLog) ←
|
||||
match fileSetupResult.kind with
|
||||
| .success | .noLakefile =>
|
||||
-- allows `headerEnv` to be leaked, which would live until the end of the process anyway
|
||||
Elab.processHeader (leakEnv := true) headerStx fileSetupResult.fileOptions MessageLog.empty m.mkInputContext
|
||||
| .importsOutOfDate =>
|
||||
mkErrorEnvironment "Imports are out of date and must be rebuilt; use the \"Restart File\" command in your editor."
|
||||
| .error msg =>
|
||||
mkErrorEnvironment msg
|
||||
|
||||
def compileHeader (m : DocumentMeta) (hOut : FS.Stream) (opts : Options) (hasWidgets : Bool)
|
||||
let mut headerEnv := headerEnv
|
||||
try
|
||||
if let some path := System.Uri.fileUriToPath? m.uri then
|
||||
headerEnv := headerEnv.setMainModule (← moduleNameOfFileName path none)
|
||||
catch _ =>
|
||||
pure ()
|
||||
|
||||
return (headerEnv, msgLog)
|
||||
|
||||
where
|
||||
mkErrorEnvironment (errorMsg : String) : IO (Environment × MessageLog) := do
|
||||
let msgs := MessageLog.empty.add { fileName := "<ignored>", pos := ⟨0, 0⟩, data := errorMsg }
|
||||
return (← mkEmptyEnvironment, msgs)
|
||||
|
||||
def buildCommandState
|
||||
(m : DocumentMeta)
|
||||
(headerStx : Syntax)
|
||||
(headerEnv : Environment)
|
||||
(headerMsgLog : MessageLog)
|
||||
(opts : Options)
|
||||
: Elab.Command.State :=
|
||||
let headerContextInfo : Elab.ContextInfo := {
|
||||
env := headerEnv
|
||||
fileMap := m.text
|
||||
ngen := { namePrefix := `_worker }
|
||||
}
|
||||
let headerInfo := Elab.Info.ofCommandInfo { elaborator := `header, stx := headerStx }
|
||||
let headerInfoNodes := headerStx[1].getArgs.toList.map fun importStx =>
|
||||
Elab.InfoTree.node (Elab.Info.ofCommandInfo {
|
||||
elaborator := `import
|
||||
stx := importStx
|
||||
}) #[].toPArray'
|
||||
let headerInfoTree := Elab.InfoTree.node headerInfo headerInfoNodes.toPArray'
|
||||
let headerInfoState := {
|
||||
enabled := true
|
||||
trees := #[Elab.InfoTree.context headerContextInfo headerInfoTree].toPArray'
|
||||
}
|
||||
{ Elab.Command.mkState headerEnv headerMsgLog opts with infoState := headerInfoState }
|
||||
|
||||
def compileHeader (m : DocumentMeta) (hOut : FS.Stream) (globalOptions : Options) (hasWidgets : Bool)
|
||||
: IO (Syntax × Task (Except Error (Snapshot × SearchPath))) := do
|
||||
-- parsing should not take long, do synchronously
|
||||
let (headerStx, headerParserState, msgLog) ← Parser.parseHeader m.mkInputContext
|
||||
let (headerStx, headerParserState, parseMsgLog) ← Parser.parseHeader m.mkInputContext
|
||||
(headerStx, ·) <$> EIO.asTask do
|
||||
let mut srcSearchPath ← initSrcSearchPath (← getBuildDir)
|
||||
let lakePath ← match (← IO.getEnv "LAKE") with
|
||||
| some path => pure <| System.FilePath.mk path
|
||||
| none =>
|
||||
let lakePath ← match (← IO.getEnv "LEAN_SYSROOT") with
|
||||
| some path => pure <| System.FilePath.mk path / "bin" / "lake"
|
||||
| _ => pure <| (← appDir) / "lake"
|
||||
pure <| lakePath.withExtension System.FilePath.exeExtension
|
||||
let (headerEnv, msgLog) ← try
|
||||
if let some path := System.Uri.fileUriToPath? m.uri then
|
||||
-- NOTE: we assume for now that `lakefile.lean` does not have any non-stdlib deps
|
||||
-- NOTE: lake does not exist in stage 0 (yet?)
|
||||
if path.fileName != "lakefile.lean" && (← System.FilePath.pathExists lakePath) then
|
||||
let pkgSearchPath ← lakeSetupSearchPath lakePath m (Lean.Elab.headerToImports headerStx) hOut
|
||||
srcSearchPath ← initSrcSearchPath (← getBuildDir) pkgSearchPath
|
||||
-- allow `headerEnv` to be leaked, which would live until the end of the process anyway
|
||||
Elab.processHeader (leakEnv := true) headerStx opts msgLog m.mkInputContext
|
||||
catch e => -- should be from `lake print-paths`
|
||||
let msgs := MessageLog.empty.add { fileName := "<ignored>", pos := ⟨0, 0⟩, data := e.toString }
|
||||
pure (← mkEmptyEnvironment, msgs)
|
||||
let mut headerEnv := headerEnv
|
||||
try
|
||||
if let some path := System.Uri.fileUriToPath? m.uri then
|
||||
headerEnv := headerEnv.setMainModule (← moduleNameOfFileName path none)
|
||||
catch _ => pure ()
|
||||
let cmdState := Elab.Command.mkState headerEnv msgLog opts
|
||||
let cmdState := { cmdState with infoState := {
|
||||
enabled := true
|
||||
trees := #[Elab.InfoTree.context ({
|
||||
env := headerEnv
|
||||
fileMap := m.text
|
||||
ngen := { namePrefix := `_worker }
|
||||
}) (Elab.InfoTree.node
|
||||
(Elab.Info.ofCommandInfo { elaborator := `header, stx := headerStx })
|
||||
(headerStx[1].getArgs.toList.map (fun importStx =>
|
||||
Elab.InfoTree.node (Elab.Info.ofCommandInfo {
|
||||
elaborator := `import
|
||||
stx := importStx
|
||||
}) #[].toPArray'
|
||||
)).toPArray'
|
||||
)].toPArray'
|
||||
}}
|
||||
let imports := Lean.Elab.headerToImports headerStx
|
||||
let fileSetupResult ← setupFile m imports fun stderrLine =>
|
||||
let progressDiagnostic := {
|
||||
range := ⟨⟨0, 0⟩, ⟨0, 0⟩⟩
|
||||
severity? := DiagnosticSeverity.information
|
||||
message := stderrLine
|
||||
}
|
||||
publishDiagnostics m #[progressDiagnostic] hOut
|
||||
let fileSetupResult := fileSetupResult.addGlobalOptions globalOptions
|
||||
let (headerEnv, envMsgLog) ← buildHeaderEnv m headerStx fileSetupResult
|
||||
let headerMsgLog := parseMsgLog.append envMsgLog
|
||||
let cmdState := buildCommandState m headerStx headerEnv headerMsgLog fileSetupResult.fileOptions
|
||||
let headerSnap := {
|
||||
beginPos := 0
|
||||
stx := headerStx
|
||||
mpState := headerParserState
|
||||
cmdState := cmdState
|
||||
beginPos := 0
|
||||
stx := headerStx
|
||||
mpState := headerParserState
|
||||
cmdState := cmdState
|
||||
interactiveDiags := ← cmdState.messages.msgs.mapM (Widget.msgToInteractiveDiagnostic m.text · hasWidgets)
|
||||
tacticCache := (← IO.mkRef {})
|
||||
tacticCache := (← IO.mkRef {})
|
||||
}
|
||||
publishDiagnostics m headerSnap.diagnostics.toArray hOut
|
||||
return (headerSnap, srcSearchPath)
|
||||
return (headerSnap, fileSetupResult.srcSearchPath)
|
||||
|
||||
def initializeWorker (meta : DocumentMeta) (i o e : FS.Stream) (initParams : InitializeParams) (opts : Options)
|
||||
: IO (WorkerContext × WorkerState) := do
|
||||
let clientHasWidgets := initParams.initializationOptions?.bind (·.hasWidgets?) |>.getD false
|
||||
let (headerStx, headerTask) ← compileHeader meta o opts (hasWidgets := clientHasWidgets)
|
||||
let cancelTk ← CancelToken.new
|
||||
let ctx :=
|
||||
{ hIn := i
|
||||
hOut := o
|
||||
hLog := e
|
||||
headerTask
|
||||
initParams
|
||||
clientHasWidgets
|
||||
}
|
||||
let ctx := {
|
||||
hIn := i
|
||||
hOut := o
|
||||
hLog := e
|
||||
headerTask
|
||||
initParams
|
||||
clientHasWidgets
|
||||
}
|
||||
let cmdSnaps ← EIO.mapTask (t := headerTask) (match · with
|
||||
| Except.ok (s, _) => unfoldCmdSnaps meta #[s] cancelTk ctx (startAfterMs := 0)
|
||||
| Except.error e => throw (e : ElabTaskError))
|
||||
let doc : EditableDocument := { meta, cmdSnaps := AsyncList.delayed cmdSnaps, cancelTk }
|
||||
return (ctx,
|
||||
{ doc := doc
|
||||
initHeaderStx := headerStx
|
||||
pendingRequests := RBMap.empty
|
||||
rpcSessions := RBMap.empty
|
||||
return (ctx, {
|
||||
doc := doc
|
||||
initHeaderStx := headerStx
|
||||
currHeaderStx := headerStx
|
||||
importCachingTask? := none
|
||||
pendingRequests := RBMap.empty
|
||||
rpcSessions := RBMap.empty
|
||||
})
|
||||
end Initialization
|
||||
|
||||
@@ -280,53 +273,67 @@ section Updates
|
||||
def updatePendingRequests (map : PendingRequestMap → PendingRequestMap) : WorkerM Unit := do
|
||||
modify fun st => { st with pendingRequests := map st.pendingRequests }
|
||||
|
||||
/-- Given the new document, updates editable doc state. -/
|
||||
def updateDocument (newMeta : DocumentMeta) : WorkerM Unit := do
|
||||
def determineValidSnapshots (oldDoc : EditableDocument) (newMeta : DocumentMeta) (newHeaderSnap : Snapshot) : IO (List Snapshot) := do
|
||||
let changePos := oldDoc.meta.text.source.firstDiffPos newMeta.text.source
|
||||
-- Ignores exceptions, we are only interested in the successful snapshots
|
||||
let (cmdSnaps, _) ← oldDoc.cmdSnaps.getFinishedPrefix
|
||||
oldDoc.cmdSnaps.cancel
|
||||
-- NOTE(WN): we invalidate eagerly as `endPos` consumes input greedily. To re-elaborate only
|
||||
-- when really necessary, we could do a whitespace-aware `Syntax` comparison instead.
|
||||
let mut validSnaps ← pure (cmdSnaps.takeWhile (fun s => s.endPos < changePos))
|
||||
if h : validSnaps.length ≤ 1 then
|
||||
validSnaps := [newHeaderSnap]
|
||||
else
|
||||
/- When at least one valid non-header snap exists, it may happen that a change does not fall
|
||||
within the syntactic range of that last snap but still modifies it by appending tokens.
|
||||
We check for this here. We do not currently handle crazy grammars in which an appended
|
||||
token can merge two or more previous commands into one. To do so would require reparsing
|
||||
the entire file. -/
|
||||
have : validSnaps.length ≥ 2 := Nat.gt_of_not_le h
|
||||
let mut lastSnap := validSnaps.getLast (by subst ·; simp at h)
|
||||
let preLastSnap :=
|
||||
have : 0 < validSnaps.length := Nat.lt_of_lt_of_le (by decide) this
|
||||
have : validSnaps.length - 2 < validSnaps.length := Nat.sub_lt this (by decide)
|
||||
validSnaps[validSnaps.length - 2]
|
||||
let newLastStx ← parseNextCmd newMeta.mkInputContext preLastSnap
|
||||
if newLastStx != lastSnap.stx then
|
||||
validSnaps := validSnaps.dropLast
|
||||
return validSnaps
|
||||
|
||||
def startNewSnapshotTasks (newMeta : DocumentMeta) : WorkerM (AsyncList ElabTaskError Snapshot × CancelToken) := do
|
||||
let ctx ← read
|
||||
let oldDoc := (←get).doc
|
||||
let oldDoc := (← get).doc
|
||||
oldDoc.cancelTk.set
|
||||
let initHeaderStx := (← get).initHeaderStx
|
||||
let (newHeaderStx, newMpState, _) ← Parser.parseHeader newMeta.mkInputContext
|
||||
let cancelTk ← CancelToken.new
|
||||
let headSnapTask := oldDoc.cmdSnaps.waitHead?
|
||||
let newSnaps ← if initHeaderStx != newHeaderStx then
|
||||
EIO.asTask (ε := ElabTaskError) (prio := .dedicated) do
|
||||
|
||||
if initHeaderStx != newHeaderStx then
|
||||
set { ← get with currHeaderStx := newHeaderStx }
|
||||
let terminationTask ← EIO.asTask (ε := ElabTaskError) (prio := .dedicated) do
|
||||
IO.sleep ctx.initParams.editDelay.toUInt32
|
||||
cancelTk.check
|
||||
IO.Process.exit 2
|
||||
else EIO.mapTask (ε := ElabTaskError) (t := headSnapTask) (prio := .dedicated) fun headSnap?? => do
|
||||
return (AsyncList.delayed terminationTask, cancelTk)
|
||||
|
||||
let headSnapTask := oldDoc.cmdSnaps.waitHead?
|
||||
let newSnapTasks ← EIO.mapTask (ε := ElabTaskError) (t := headSnapTask) (prio := .dedicated) fun headSnap?? => do
|
||||
-- There is always at least one snapshot absent exceptions
|
||||
let some headSnap ← MonadExcept.ofExcept headSnap?? | panic! "empty snapshots"
|
||||
let newHeaderSnap := { headSnap with stx := newHeaderStx, mpState := newMpState }
|
||||
let changePos := oldDoc.meta.text.source.firstDiffPos newMeta.text.source
|
||||
-- Ignore exceptions, we are only interested in the successful snapshots
|
||||
let (cmdSnaps, _) ← oldDoc.cmdSnaps.getFinishedPrefix
|
||||
oldDoc.cmdSnaps.cancel
|
||||
-- NOTE(WN): we invalidate eagerly as `endPos` consumes input greedily. To re-elaborate only
|
||||
-- when really necessary, we could do a whitespace-aware `Syntax` comparison instead.
|
||||
let mut validSnaps ← pure (cmdSnaps.takeWhile (fun s => s.endPos < changePos))
|
||||
if h : validSnaps.length ≤ 1 then
|
||||
validSnaps := [newHeaderSnap]
|
||||
else
|
||||
/- When at least one valid non-header snap exists, it may happen that a change does not fall
|
||||
within the syntactic range of that last snap but still modifies it by appending tokens.
|
||||
We check for this here. We do not currently handle crazy grammars in which an appended
|
||||
token can merge two or more previous commands into one. To do so would require reparsing
|
||||
the entire file. -/
|
||||
have : validSnaps.length ≥ 2 := Nat.gt_of_not_le h
|
||||
let mut lastSnap := validSnaps.getLast (by subst ·; simp at h)
|
||||
let preLastSnap :=
|
||||
have : 0 < validSnaps.length := Nat.lt_of_lt_of_le (by decide) this
|
||||
have : validSnaps.length - 2 < validSnaps.length := Nat.sub_lt this (by decide)
|
||||
validSnaps[validSnaps.length - 2]
|
||||
let newLastStx ← parseNextCmd newMeta.mkInputContext preLastSnap
|
||||
if newLastStx != lastSnap.stx then
|
||||
validSnaps := validSnaps.dropLast
|
||||
let validSnaps ← determineValidSnapshots oldDoc newMeta newHeaderSnap
|
||||
-- wait for a bit, giving the initial `cancelTk.check` in `nextCmdSnap` time to trigger
|
||||
-- before kicking off any expensive elaboration (TODO: make expensive elaboration cancelable)
|
||||
unfoldCmdSnaps newMeta validSnaps.toArray cancelTk ctx
|
||||
(startAfterMs := ctx.initParams.editDelay.toUInt32)
|
||||
modify fun st => { st with doc := { meta := newMeta, cmdSnaps := AsyncList.delayed newSnaps, cancelTk } }
|
||||
|
||||
return (AsyncList.delayed newSnapTasks, cancelTk)
|
||||
|
||||
/-- Given the new document, updates editable doc state. -/
|
||||
def updateDocument (newMeta : DocumentMeta) : WorkerM Unit := do
|
||||
let (newSnaps, cancelTk) ← startNewSnapshotTasks newMeta
|
||||
modify fun st => { st with doc := { meta := newMeta, cmdSnaps := newSnaps, cancelTk } }
|
||||
|
||||
end Updates
|
||||
|
||||
/- Notifications are handled in the main thread. They may change global worker state
|
||||
@@ -396,6 +403,30 @@ section MessageHandling
|
||||
: WorkerM Unit := do
|
||||
updatePendingRequests (fun pendingRequests => pendingRequests.insert id requestTask)
|
||||
|
||||
def handleImportCompletionRequest (id : RequestID) (params : CompletionParams)
|
||||
: WorkerM (Task (Except Error AvailableImportsCache)) := do
|
||||
let ctx ← read
|
||||
let st ← get
|
||||
let text := st.doc.meta.text
|
||||
|
||||
match st.importCachingTask? with
|
||||
| none => IO.asTask do
|
||||
let availableImports ← ImportCompletion.collectAvailableImports
|
||||
let lastRequestTimestampMs ← IO.monoMsNow
|
||||
let completions := ImportCompletion.find text st.currHeaderStx params availableImports
|
||||
ctx.hOut.writeLspResponse ⟨id, completions⟩
|
||||
pure { availableImports, lastRequestTimestampMs : AvailableImportsCache }
|
||||
|
||||
| some task => IO.mapTask (t := task) fun result => do
|
||||
let mut ⟨availableImports, lastRequestTimestampMs⟩ ← IO.ofExcept result
|
||||
let timestampNowMs ← IO.monoMsNow
|
||||
if timestampNowMs - lastRequestTimestampMs >= 10000 then
|
||||
availableImports ← ImportCompletion.collectAvailableImports
|
||||
lastRequestTimestampMs := timestampNowMs
|
||||
let completions := ImportCompletion.find text st.currHeaderStx params availableImports
|
||||
ctx.hOut.writeLspResponse ⟨id, completions⟩
|
||||
pure { availableImports, lastRequestTimestampMs : AvailableImportsCache }
|
||||
|
||||
def handleRequest (id : RequestID) (method : String) (params : Json)
|
||||
: WorkerM Unit := do
|
||||
let ctx ← read
|
||||
@@ -413,26 +444,33 @@ section MessageHandling
|
||||
message := toString e }
|
||||
return
|
||||
|
||||
if method == "textDocument/completion" then
|
||||
let params ← parseParams CompletionParams params
|
||||
if ImportCompletion.isImportCompletionRequest st.doc.meta.text st.currHeaderStx params then
|
||||
let importCachingTask ← handleImportCompletionRequest id params
|
||||
set <| { st with importCachingTask? := some importCachingTask }
|
||||
return
|
||||
|
||||
-- we assume that every request requires at least the header snapshot or the search path
|
||||
let t ← IO.bindTask ctx.headerTask fun x => do
|
||||
let (_, srcSearchPath) ← IO.ofExcept x
|
||||
let rc : RequestContext :=
|
||||
{ rpcSessions := st.rpcSessions
|
||||
srcSearchPath
|
||||
doc := st.doc
|
||||
hLog := ctx.hLog
|
||||
hOut := ctx.hOut
|
||||
initParams := ctx.initParams }
|
||||
let t? ← EIO.toIO' <| handleLspRequest method params rc
|
||||
let t₁ ← match t? with
|
||||
| Except.error e =>
|
||||
IO.asTask do
|
||||
ctx.hOut.writeLspResponseError <| e.toLspResponseError id
|
||||
| Except.ok t => (IO.mapTask · t) fun
|
||||
| Except.ok resp =>
|
||||
ctx.hOut.writeLspResponse ⟨id, resp⟩
|
||||
| Except.error e =>
|
||||
ctx.hOut.writeLspResponseError <| e.toLspResponseError id
|
||||
let (_, srcSearchPath) ← IO.ofExcept x
|
||||
let rc : RequestContext :=
|
||||
{ rpcSessions := st.rpcSessions
|
||||
srcSearchPath
|
||||
doc := st.doc
|
||||
hLog := ctx.hLog
|
||||
hOut := ctx.hOut
|
||||
initParams := ctx.initParams }
|
||||
let t? ← EIO.toIO' <| handleLspRequest method params rc
|
||||
let t₁ ← match t? with
|
||||
| Except.error e =>
|
||||
IO.asTask do
|
||||
ctx.hOut.writeLspResponseError <| e.toLspResponseError id
|
||||
| Except.ok t => (IO.mapTask · t) fun
|
||||
| Except.ok resp =>
|
||||
ctx.hOut.writeLspResponse ⟨id, resp⟩
|
||||
| Except.error e =>
|
||||
ctx.hOut.writeLspResponseError <| e.toLspResponseError id
|
||||
queueRequest id t
|
||||
end MessageHandling
|
||||
|
||||
|
||||
128
src/Lean/Server/FileWorker/SetupFile.lean
Normal file
128
src/Lean/Server/FileWorker/SetupFile.lean
Normal file
@@ -0,0 +1,128 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Ullrich, Marc Huisinga
|
||||
-/
|
||||
import Init.System.IO
|
||||
import Lean.Server.Utils
|
||||
import Lean.Util.FileSetupInfo
|
||||
import Lean.Util.LakePath
|
||||
import Lean.LoadDynlib
|
||||
|
||||
namespace Lean.Server.FileWorker
|
||||
|
||||
open IO
|
||||
|
||||
structure LakeSetupFileOutput where
|
||||
spawnArgs : Process.SpawnArgs
|
||||
exitCode : UInt32
|
||||
stdout : String
|
||||
stderr : String
|
||||
|
||||
partial def runLakeSetupFile
|
||||
(m : DocumentMeta)
|
||||
(lakePath filePath : System.FilePath)
|
||||
(imports : Array Import)
|
||||
(handleStderr : String → IO Unit)
|
||||
: IO LakeSetupFileOutput := do
|
||||
let mut args := #["setup-file", filePath.toString] ++ imports.map (toString ·.module)
|
||||
if m.dependencyBuildMode matches .never then
|
||||
args := args.push "--no-build"
|
||||
let spawnArgs : Process.SpawnArgs := {
|
||||
stdin := Process.Stdio.null
|
||||
stdout := Process.Stdio.piped
|
||||
stderr := Process.Stdio.piped
|
||||
cmd := lakePath.toString
|
||||
args
|
||||
}
|
||||
let lakeProc ← Process.spawn spawnArgs
|
||||
|
||||
let rec processStderr (acc : String) : IO String := do
|
||||
let line ← lakeProc.stderr.getLine
|
||||
if line == "" then
|
||||
return acc
|
||||
else
|
||||
handleStderr line
|
||||
processStderr (acc ++ line)
|
||||
let stderr ← IO.asTask (processStderr "") Task.Priority.dedicated
|
||||
|
||||
let stdout := String.trim (← lakeProc.stdout.readToEnd)
|
||||
let stderr ← IO.ofExcept stderr.get
|
||||
let exitCode ← lakeProc.wait
|
||||
return ⟨spawnArgs, exitCode, stdout, stderr⟩
|
||||
|
||||
inductive FileSetupResultKind where
|
||||
| success
|
||||
| noLakefile
|
||||
| importsOutOfDate
|
||||
| error (msg : String)
|
||||
|
||||
structure FileSetupResult where
|
||||
kind : FileSetupResultKind
|
||||
srcSearchPath : SearchPath
|
||||
fileOptions : Options
|
||||
|
||||
def FileSetupResult.ofSuccess (pkgSearchPath : SearchPath) (fileOptions : Options)
|
||||
: IO FileSetupResult := do return {
|
||||
kind := FileSetupResultKind.success
|
||||
srcSearchPath := ← initSrcSearchPath pkgSearchPath,
|
||||
fileOptions
|
||||
}
|
||||
|
||||
def FileSetupResult.ofNoLakefile : IO FileSetupResult := do return {
|
||||
kind := FileSetupResultKind.noLakefile
|
||||
srcSearchPath := ← initSrcSearchPath
|
||||
fileOptions := Options.empty
|
||||
}
|
||||
|
||||
def FileSetupResult.ofImportsOutOfDate : IO FileSetupResult := do return {
|
||||
kind := FileSetupResultKind.importsOutOfDate
|
||||
srcSearchPath := ← initSrcSearchPath
|
||||
fileOptions := Options.empty
|
||||
}
|
||||
|
||||
def FileSetupResult.ofError (msg : String) : IO FileSetupResult := do return {
|
||||
kind := FileSetupResultKind.error msg
|
||||
srcSearchPath := ← initSrcSearchPath
|
||||
fileOptions := Options.empty
|
||||
}
|
||||
|
||||
def FileSetupResult.addGlobalOptions (result : FileSetupResult) (globalOptions : Options)
|
||||
: FileSetupResult :=
|
||||
let fileOptions := globalOptions.mergeBy (fun _ _ fileOpt => fileOpt) result.fileOptions
|
||||
{ result with fileOptions := fileOptions }
|
||||
|
||||
/-- Uses `lake setup-file` to compile dependencies on the fly and add them to `LEAN_PATH`.
|
||||
Compilation progress is reported to `handleStderr`. Returns the search path for
|
||||
source files and the options for the file. -/
|
||||
partial def setupFile (m : DocumentMeta) (imports : Array Import) (handleStderr : String → IO Unit) : IO FileSetupResult := do
|
||||
let some filePath := System.Uri.fileUriToPath? m.uri
|
||||
| return ← FileSetupResult.ofNoLakefile -- untitled files have no lakefile
|
||||
|
||||
-- NOTE: we assume for now that `lakefile.lean` does not have any non-core-Lean deps
|
||||
-- NOTE: lake does not exist in stage 0 (yet?)
|
||||
if filePath.fileName == "lakefile.lean" then
|
||||
return ← FileSetupResult.ofNoLakefile -- the lakefile itself has no lakefile
|
||||
|
||||
let lakePath ← determineLakePath
|
||||
if !(← System.FilePath.pathExists lakePath) then
|
||||
return ← FileSetupResult.ofNoLakefile
|
||||
|
||||
let result ← runLakeSetupFile m lakePath filePath imports handleStderr
|
||||
|
||||
let cmdStr := " ".intercalate (toString result.spawnArgs.cmd :: result.spawnArgs.args.toList)
|
||||
|
||||
match result.exitCode with
|
||||
| 0 =>
|
||||
let Except.ok (info : FileSetupInfo) := Json.parse result.stdout >>= fromJson?
|
||||
| return ← FileSetupResult.ofError s!"Invalid output from `{cmdStr}`:\n{result.stdout}\nstderr:\n{result.stderr}"
|
||||
initSearchPath (← getBuildDir) info.paths.oleanPath
|
||||
info.paths.loadDynlibPaths.forM loadDynlib
|
||||
let pkgSearchPath ← info.paths.srcPath.mapM realPathNormalized
|
||||
FileSetupResult.ofSuccess pkgSearchPath info.setupOptions.toOptions
|
||||
| 2 => -- exit code for lake reporting that there is no lakefile
|
||||
FileSetupResult.ofNoLakefile
|
||||
| 3 => -- exit code for `--no-build`
|
||||
FileSetupResult.ofImportsOutOfDate
|
||||
| _ =>
|
||||
FileSetupResult.ofError s!"`{cmdStr}` failed:\n{result.stdout}\nstderr:\n{result.stderr}"
|
||||
141
src/Lean/Server/ImportCompletion.lean
Normal file
141
src/Lean/Server/ImportCompletion.lean
Normal file
@@ -0,0 +1,141 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Marc Huisinga
|
||||
-/
|
||||
import Lean.Data.Name
|
||||
import Lean.Data.NameTrie
|
||||
import Lean.Data.Lsp.Utf16
|
||||
import Lean.Data.Lsp.LanguageFeatures
|
||||
import Lean.Util.Paths
|
||||
import Lean.Util.LakePath
|
||||
|
||||
namespace ImportCompletion
|
||||
|
||||
open Lean Lsp
|
||||
|
||||
abbrev ImportTrie := Lean.NameTrie Name
|
||||
|
||||
abbrev AvailableImports := Array Name
|
||||
|
||||
def AvailableImports.toImportTrie (imports : AvailableImports) : ImportTrie := Id.run do
|
||||
let mut importTrie := ∅
|
||||
for i in imports do
|
||||
importTrie := importTrie.insert i i
|
||||
return importTrie
|
||||
|
||||
def determinePartialHeaderCompletions
|
||||
(headerStx : Syntax)
|
||||
(completionPos : String.Pos)
|
||||
: Option Syntax := Id.run do
|
||||
let some importCmdToComplete := headerStx[1].find? fun importStx => Id.run do
|
||||
let importIdStx := importStx
|
||||
let some startPos := importIdStx.getPos?
|
||||
| return false
|
||||
let some endPos := importIdStx.getTailPos?
|
||||
| return false
|
||||
return startPos <= completionPos && completionPos <= endPos
|
||||
| return none
|
||||
return some importCmdToComplete
|
||||
|
||||
/-- Checks whether `completionPos` points at the position after an incomplete `import` statement. -/
|
||||
def isImportNameCompletionRequest (headerStx : Syntax) (completionPos : String.Pos) : Bool :=
|
||||
headerStx[1].getArgs.any fun importStx =>
|
||||
let importCmd := importStx[0]
|
||||
let importId := importStx[2]
|
||||
importId.isMissing && importCmd.getTailPos?.isSome && completionPos == importCmd.getTailPos?.get! + ' '
|
||||
|
||||
/-- Checks whether `completionPos` points at a free space in the header. -/
|
||||
def isImportCmdCompletionRequest (headerStx : Syntax) (completionPos : String.Pos) : Bool :=
|
||||
! headerStx[1].getArgs.any fun importStx => importStx.getArgs.any fun arg =>
|
||||
arg.getPos?.isSome && arg.getTailPos?.isSome
|
||||
&& arg.getPos?.get! <= completionPos && completionPos <= arg.getTailPos?.get!
|
||||
|
||||
def computePartialImportCompletions
|
||||
(headerStx : Syntax)
|
||||
(completionPos : String.Pos)
|
||||
(availableImports : ImportTrie)
|
||||
: Array Name := Id.run do
|
||||
let some importStxToComplete := headerStx[1].getArgs.find? fun importStx => Id.run do
|
||||
-- `partialTrailingDotStx` ≙ `("." ident)?`
|
||||
let partialTrailingDotStx := importStx[3]
|
||||
if ! partialTrailingDotStx.hasArgs then
|
||||
return false
|
||||
let trailingDot := partialTrailingDotStx[0]
|
||||
let some tailPos := trailingDot.getTailPos?
|
||||
| return false
|
||||
return tailPos == completionPos
|
||||
| return #[]
|
||||
let importPrefixToComplete := importStxToComplete[2].getId
|
||||
|
||||
let completions : Array Name :=
|
||||
availableImports.matchingToArray importPrefixToComplete
|
||||
|>.map fun matchingAvailableImport =>
|
||||
matchingAvailableImport.replacePrefix importPrefixToComplete Name.anonymous
|
||||
|
||||
let nonEmptyCompletions := completions.filter fun completion => !completion.isAnonymous
|
||||
|
||||
return nonEmptyCompletions.insertionSort (Name.cmp · · == Ordering.lt)
|
||||
|
||||
def isImportCompletionRequest (text : FileMap) (headerStx : Syntax) (params : CompletionParams) : Bool :=
|
||||
let completionPos := text.lspPosToUtf8Pos params.position
|
||||
let headerStartPos := headerStx.getPos?.getD 0
|
||||
let headerEndPos := headerStx.getTailPos?.getD headerStartPos
|
||||
completionPos <= headerEndPos + ' ' + ' '
|
||||
|
||||
def collectAvailableImportsFromLake : IO (Option AvailableImports) := do
|
||||
let lakePath ← Lean.determineLakePath
|
||||
let spawnArgs : IO.Process.SpawnArgs := {
|
||||
stdin := IO.Process.Stdio.null
|
||||
stdout := IO.Process.Stdio.piped
|
||||
stderr := IO.Process.Stdio.piped
|
||||
cmd := lakePath.toString
|
||||
args := #["available-imports"]
|
||||
}
|
||||
let lakeProc ← IO.Process.spawn spawnArgs
|
||||
let stdout := String.trim (← lakeProc.stdout.readToEnd)
|
||||
let exitCode ← lakeProc.wait
|
||||
match exitCode with
|
||||
| 0 =>
|
||||
let Except.ok (availableImports : AvailableImports) := Json.parse stdout >>= fromJson?
|
||||
| throw <| IO.userError s!"invalid output from `lake available-imports`:\n{stdout}"
|
||||
return availableImports
|
||||
| _ =>
|
||||
return none
|
||||
|
||||
def collectAvailableImportsFromSrcSearchPath : IO AvailableImports :=
|
||||
(·.2) <$> StateT.run (s := #[]) do
|
||||
let srcSearchPath ← initSrcSearchPath
|
||||
for p in srcSearchPath do
|
||||
if ! (← p.isDir) then
|
||||
continue
|
||||
Lean.forEachModuleInDir p fun mod => do
|
||||
modify (·.push mod)
|
||||
|
||||
def collectAvailableImports : IO AvailableImports := do
|
||||
match ← ImportCompletion.collectAvailableImportsFromLake with
|
||||
| none =>
|
||||
-- lake is not available => walk LEAN_SRC_PATH for an approximation
|
||||
ImportCompletion.collectAvailableImportsFromSrcSearchPath
|
||||
| some availableImports => pure availableImports
|
||||
|
||||
def find (text : FileMap) (headerStx : Syntax) (params : CompletionParams) (availableImports : AvailableImports) : CompletionList :=
|
||||
let availableImports := availableImports.toImportTrie
|
||||
let completionPos := text.lspPosToUtf8Pos params.position
|
||||
if isImportNameCompletionRequest headerStx completionPos then
|
||||
let allAvailableImportNameCompletions := availableImports.toArray.map ({ label := toString · })
|
||||
{ isIncomplete := false, items := allAvailableImportNameCompletions }
|
||||
else if isImportCmdCompletionRequest headerStx completionPos then
|
||||
let allAvailableFullImportCompletions := availableImports.toArray.map ({ label := s!"import {·}" })
|
||||
{ isIncomplete := false, items := allAvailableFullImportCompletions }
|
||||
else
|
||||
let completionNames : Array Name := computePartialImportCompletions headerStx completionPos availableImports
|
||||
let completions : Array CompletionItem := completionNames.map ({ label := toString · })
|
||||
{ isIncomplete := false, items := completions }
|
||||
|
||||
def computeCompletions (text : FileMap) (headerStx : Syntax) (params : CompletionParams)
|
||||
: IO CompletionList := do
|
||||
let availableImports ← collectAvailableImports
|
||||
return find text headerStx params availableImports
|
||||
|
||||
end ImportCompletion
|
||||
@@ -39,7 +39,7 @@ Another important consideration is the *compacted region* memory used by importe
|
||||
|
||||
When the user has two or more files in a single dependency chain open, it is desirable for changes in imports to propagate to modules importing them. That is, when `B.lean` depends on `A.lean` and both are open, changes to `A` should eventually be observable in `B`. But a major problem with Lean 3 is how it does this much too eagerly. Often `B` will be recompiled needlessly as soon as `A` is opened, even if no changes have been made to `A`. For heavyweight modules which take up to several minutes to compile, this causes frustration when `A` is opened merely for inspection e.g. via go-to-definition.
|
||||
|
||||
In Lean 4, the situation is different as `.olean` artifacts are required to exist for all imported modules -- one cannot import a `.lean` file without compiling it first. In the running example, when a user opens and edits `A`, nothing is going to happen to `B`. They can continue to interact with it as if `A` kept its previous contents. But when `A` is saved with changes, users can then issue the "refresh file dependencies" command in their editor, which will restart the respective worker and use `lake print-paths` to rebuild and locate its dependencies. This being a conscious action, users will be aware of having to then wait for compilation.
|
||||
In Lean 4, the situation is different as `.olean` artifacts are required to exist for all imported modules -- one cannot import a `.lean` file without compiling it first. In the running example, when a user opens and edits `A`, nothing is going to happen to `B`. They can continue to interact with it as if `A` kept its previous contents. But when `A` is saved with changes, users can then issue the "refresh file dependencies" command in their editor, which will restart the respective worker and use `lake setup-file` to rebuild and locate its dependencies. This being a conscious action, users will be aware of having to then wait for compilation.
|
||||
|
||||
### Worker architecture
|
||||
|
||||
|
||||
@@ -72,30 +72,42 @@ def merge (a : RefInfo) (b : RefInfo) : RefInfo :=
|
||||
usages := a.usages.append b.usages
|
||||
}
|
||||
|
||||
def contains (self : RefInfo) (pos : Lsp.Position) : Bool := Id.run do
|
||||
def findRange? (self : RefInfo) (pos : Lsp.Position) (includeStop := false) : Option Range := do
|
||||
if let some range := self.definition then
|
||||
if contains range pos then
|
||||
return true
|
||||
return range
|
||||
for range in self.usages do
|
||||
if contains range pos then
|
||||
return true
|
||||
false
|
||||
return range
|
||||
none
|
||||
where
|
||||
contains (range : Lsp.Range) (pos : Lsp.Position) : Bool :=
|
||||
range.start <= pos && pos < range.end
|
||||
-- Note: includeStop is used here to toggle between closed-interval and half-open-interval
|
||||
-- behavior for the range. Closed-interval behavior matches the expectation of VSCode
|
||||
-- when selecting an identifier at a cursor position, see #767.
|
||||
range.start <= pos && (if includeStop then pos <= range.end else pos < range.end)
|
||||
|
||||
def contains (self : RefInfo) (pos : Lsp.Position) (includeStop := false) : Bool := Id.run do
|
||||
(self.findRange? pos includeStop).isSome
|
||||
|
||||
end Lean.Lsp.RefInfo
|
||||
|
||||
namespace Lean.Lsp.ModuleRefs
|
||||
open Server
|
||||
|
||||
def findAt (self : ModuleRefs) (pos : Lsp.Position) : Array RefIdent := Id.run do
|
||||
def findAt (self : ModuleRefs) (pos : Lsp.Position) (includeStop := false) : Array RefIdent := Id.run do
|
||||
let mut result := #[]
|
||||
for (ident, info) in self.toList do
|
||||
if info.contains pos then
|
||||
if info.contains pos includeStop then
|
||||
result := result.push ident
|
||||
result
|
||||
|
||||
def findRange? (self : ModuleRefs) (pos : Lsp.Position) (includeStop := false) : Option Range := do
|
||||
for (_, info) in self.toList do
|
||||
if let some range := info.findRange? pos includeStop then
|
||||
return range
|
||||
none
|
||||
|
||||
end Lean.Lsp.ModuleRefs
|
||||
|
||||
namespace Lean.Server
|
||||
@@ -270,11 +282,15 @@ def allRefs (self : References) : HashMap Name Lsp.ModuleRefs :=
|
||||
let ileanRefs := self.ileans.toList.foldl (init := HashMap.empty) fun m (name, _, refs) => m.insert name refs
|
||||
self.workers.toList.foldl (init := ileanRefs) fun m (name, _, refs) => m.insert name refs
|
||||
|
||||
def findAt (self : References) (module : Name) (pos : Lsp.Position) : Array RefIdent := Id.run do
|
||||
def findAt (self : References) (module : Name) (pos : Lsp.Position) (includeStop := false) : Array RefIdent := Id.run do
|
||||
if let some refs := self.allRefs.find? module then
|
||||
return refs.findAt pos
|
||||
return refs.findAt pos includeStop
|
||||
#[]
|
||||
|
||||
def findRange? (self : References) (module : Name) (pos : Lsp.Position) (includeStop := false) : Option Range := do
|
||||
let refs ← self.allRefs.find? module
|
||||
refs.findRange? pos includeStop
|
||||
|
||||
def referringTo (self : References) (identModule : Name) (ident : RefIdent) (srcSearchPath : SearchPath)
|
||||
(includeDefinition : Bool := true) : IO (Array Location) := do
|
||||
let refsToCheck := match ident with
|
||||
|
||||
@@ -352,7 +352,7 @@ def findDefinitions (p : TextDocumentPositionParams) : ServerM <| Array Location
|
||||
let srcSearchPath := (← read).srcSearchPath
|
||||
if let some module ← searchModuleNameOfFileName path srcSearchPath then
|
||||
let references ← (← read).references.get
|
||||
for ident in references.findAt module p.position do
|
||||
for ident in references.findAt module p.position (includeStop := true) do
|
||||
if let some definition ← references.definitionOf? ident srcSearchPath then
|
||||
definitions := definitions.push definition
|
||||
return definitions
|
||||
@@ -363,7 +363,7 @@ def handleReference (p : ReferenceParams) : ServerM (Array Location) := do
|
||||
let srcSearchPath := (← read).srcSearchPath
|
||||
if let some module ← searchModuleNameOfFileName path srcSearchPath then
|
||||
let references ← (← read).references.get
|
||||
for ident in references.findAt module p.position do
|
||||
for ident in references.findAt module p.position (includeStop := true) do
|
||||
let identRefs ← references.referringTo module ident srcSearchPath p.context.includeDeclaration
|
||||
result := result.append identRefs
|
||||
return result
|
||||
@@ -386,6 +386,33 @@ def handleWorkspaceSymbol (p : WorkspaceSymbolParams) : ServerM (Array SymbolInf
|
||||
|>.map fun ((name, _), location) =>
|
||||
{ name, kind := SymbolKind.constant, location }
|
||||
|
||||
def handlePrepareRename (p : PrepareRenameParams) : ServerM (Option Range) := do
|
||||
-- This just checks that the cursor is over a renameable identifier
|
||||
if let some path := System.Uri.fileUriToPath? p.textDocument.uri then
|
||||
let srcSearchPath := (← read).srcSearchPath
|
||||
if let some module ← searchModuleNameOfFileName path srcSearchPath then
|
||||
let references ← (← read).references.get
|
||||
return references.findRange? module p.position (includeStop := true)
|
||||
return none
|
||||
|
||||
def handleRename (p : RenameParams) : ServerM Lsp.WorkspaceEdit := do
|
||||
if (String.toName p.newName).isAnonymous then
|
||||
throwServerError s!"Can't rename: `{p.newName}` is not an identifier"
|
||||
let mut refs : HashMap DocumentUri (RBMap Lsp.Position Lsp.Position compare) := ∅
|
||||
for { uri, range } in (← handleReference { p with context.includeDeclaration := true }) do
|
||||
refs := refs.insert uri <| (refs.findD uri ∅).insert range.start range.end
|
||||
-- We have to filter the list of changes to put the ranges in order and
|
||||
-- remove any duplicates or overlapping ranges, or else the rename will not apply
|
||||
let changes := refs.fold (init := ∅) fun changes uri map => Id.run do
|
||||
let mut last := ⟨0, 0⟩
|
||||
let mut arr := #[]
|
||||
for (start, stop) in map do
|
||||
if last ≤ start then
|
||||
arr := arr.push { range := ⟨start, stop⟩, newText := p.newName }
|
||||
last := stop
|
||||
return changes.insert uri arr
|
||||
return { changes? := some changes }
|
||||
|
||||
end RequestHandling
|
||||
|
||||
section NotificationHandling
|
||||
@@ -507,6 +534,8 @@ section MessageHandling
|
||||
match method with
|
||||
| "textDocument/references" => handle ReferenceParams (Array Location) handleReference
|
||||
| "workspace/symbol" => handle WorkspaceSymbolParams (Array SymbolInformation) handleWorkspaceSymbol
|
||||
| "textDocument/prepareRename" => handle PrepareRenameParams (Option Range) handlePrepareRename
|
||||
| "textDocument/rename" => handle RenameParams WorkspaceEdit handleRename
|
||||
| _ => forwardRequestToWorker id method params
|
||||
|
||||
def handleNotification (method : String) (params : Json) : ServerM Unit := do
|
||||
@@ -608,6 +637,9 @@ def mkLeanServerCapabilities : ServerCapabilities := {
|
||||
definitionProvider := true
|
||||
typeDefinitionProvider := true
|
||||
referencesProvider := true
|
||||
renameProvider? := some {
|
||||
prepareProvider := true
|
||||
}
|
||||
workspaceSymbolProvider := true
|
||||
documentHighlightProvider := true
|
||||
documentSymbolProvider := true
|
||||
@@ -665,7 +697,7 @@ def loadReferences : IO References := do
|
||||
|
||||
def initAndRunWatchdog (args : List String) (i o e : FS.Stream) : IO Unit := do
|
||||
let workerPath ← findWorkerPath
|
||||
let srcSearchPath ← initSrcSearchPath (← getBuildDir)
|
||||
let srcSearchPath ← initSrcSearchPath
|
||||
let references ← IO.mkRef (← loadReferences)
|
||||
let fileWorkersRef ← IO.mkRef (RBMap.empty : FileWorkerMap)
|
||||
let i ← maybeTee "wdIn.txt" false i
|
||||
|
||||
@@ -23,6 +23,7 @@ import Lean.Util.ForEachExprWhere
|
||||
import Lean.Util.ReplaceLevel
|
||||
import Lean.Util.FoldConsts
|
||||
import Lean.Util.SCC
|
||||
import Lean.Util.TestExtern
|
||||
import Lean.Util.OccursCheck
|
||||
import Lean.Util.Paths
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Util.FileSetupInfo
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user