Compare commits

..

4 Commits

Author SHA1 Message Date
Scott Morrison
3c2e5a5984 Merge remote-tracking branch 'origin/master' into copyright_headers 2024-02-20 17:46:58 +11:00
Scott Morrison
4fcd2e6475 only run on pull_request 2024-02-20 12:28:05 +11:00
Scott Morrison
19f14f3451 ignore ./nix 2024-02-20 12:27:06 +11:00
Scott Morrison
38564aa8d4 chore: CI checks for copyright headers 2024-02-20 12:25:41 +11:00
3670 changed files with 20889 additions and 106876 deletions

View File

@@ -9,15 +9,9 @@ assignees: ''
### Prerequisites
Please put an X between the brackets as you perform the following steps:
* [ ] Check that your issue is not already filed:
https://github.com/leanprover/lean4/issues
* [ ] Reduce the issue to a minimal, self-contained, reproducible test case.
Avoid dependencies to Mathlib or Batteries.
* [ ] Test your test case against the latest nightly release, for example on
https://live.lean-lang.org/#project=lean-nightly
(You can also use the settings there to switch to “Lean nightly”)
* [ ] Put an X between the brackets on this line if you have done all of the following:
* Check that your issue is not already [filed](https://github.com/leanprover/lean4/issues).
* Reduce the issue to a minimal, self-contained, reproducible test case. Avoid dependencies to mathlib4 or std4.
### Description
@@ -39,8 +33,8 @@ Please put an X between the brackets as you perform the following steps:
### Versions
[Output of `#eval Lean.versionString`]
[OS version, if not using live.lean-lang.org.]
[Output of `#eval Lean.versionString` or of `lean --version` in the folder that the issue occured in]
[OS version]
### Additional Information

View File

@@ -15,7 +15,7 @@ jobs:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
uses: actions/checkout@v3
- name: actionlint
uses: raven-actions/actionlint@v1
with:

View File

@@ -1,26 +0,0 @@
name: Check for modules that should use `prelude`
on: [pull_request]
jobs:
check-prelude:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
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 }}
sparse-checkout: src/Lean
- name: Check Prelude
run: |
failed_files=""
while IFS= read -r -d '' file; do
if ! grep -q "^prelude$" "$file"; then
failed_files="$failed_files$file\n"
fi
done < <(find src/Lean -name '*.lean' -print0)
if [ -n "$failed_files" ]; then
echo -e "The following files should use 'prelude':\n$failed_files"
exit 1
fi

View File

@@ -1,57 +0,0 @@
name: Check for stage0 changes
on:
merge_group:
pull_request:
jobs:
check-stage0-on-queue:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
with:
ref: ${{ github.event.pull_request.head.sha }}
filter: blob:none
fetch-depth: 0
- name: Find base commit
if: github.event_name == 'pull_request'
run: echo "BASE=$(git merge-base origin/${{ github.base_ref }} HEAD)" >> "$GITHUB_ENV"
- name: Identify stage0 changes
run: |
git diff "${BASE:-HEAD^}..HEAD" --name-only -- stage0 |
grep -v -x -F $'stage0/src/stdlib_flags.h\nstage0/src/lean.mk.in' \
> "$RUNNER_TEMP/stage0" || true
if test -s "$RUNNER_TEMP/stage0"
then
echo "CHANGES=yes" >> "$GITHUB_ENV"
else
echo "CHANGES=no" >> "$GITHUB_ENV"
fi
shell: bash
- if: github.event_name == 'pull_request'
name: Set label
uses: actions/github-script@v7
with:
script: |
const { owner, repo, number: issue_number } = context.issue;
if (process.env.CHANGES == 'yes') {
await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['changes-stage0'] }).catch(() => {});
} else {
await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'changes-stage0' }).catch(() => {});
}
- if: env.CHANGES == 'yes'
name: Report changes
run: |
echo "Found changes to stage0/, please do not merge using the merge queue." | tee "$GITHUB_STEP_SUMMARY"
# shellcheck disable=SC2129
echo '```' >> "$GITHUB_STEP_SUMMARY"
cat "$RUNNER_TEMP/stage0" >> "$GITHUB_STEP_SUMMARY"
echo '```' >> "$GITHUB_STEP_SUMMARY"
- if: github.event_name == 'merge_group' && env.CHANGES == 'yes'
name: Fail when on the merge queue
run: exit 1

View File

@@ -6,20 +6,10 @@ on:
tags:
- '*'
pull_request:
types: [opened, synchronize, reopened, labeled]
merge_group:
schedule:
- cron: '0 7 * * *' # 8AM CET/11PM PT
# for manual re-release of a nightly
workflow_dispatch:
inputs:
action:
description: 'Action'
required: true
default: 'release nightly'
type: choice
options:
- release nightly
concurrency:
group: ${{ github.workflow }}-${{ github.ref }}-${{ github.event_name }}
@@ -31,10 +21,8 @@ jobs:
configure:
runs-on: ubuntu-latest
outputs:
# 0: PRs without special label
# 1: PRs with `merge-ci` label, merge queue checks, master commits
# 2: PRs with `release-ci` label, releases (incl. nightlies)
check-level: ${{ steps.set-level.outputs.check-level }}
# 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
@@ -51,12 +39,163 @@ jobs:
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,
"cross_target": "aarch64-apple-darwin",
"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": "../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,
"cross_target": "aarch64-unknown-linux-gnu",
"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": "../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@v4
uses: actions/checkout@v3
# don't schedule nightlies on forks
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
- name: Set Nightly
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly'
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4'
id: set-nightly
run: |
if [[ -n '${{ secrets.PUSH_NIGHTLY_TOKEN }}' ]]; then
@@ -101,170 +240,6 @@ jobs:
echo "Tag ${TAG_NAME} did not match SemVer regex."
fi
- name: Set check level
id: set-level
# We do not use github.event.pull_request.labels.*.name here because
# re-running a run does not update that list, and we do want to be able to
# rerun the workflow run after setting the `release-ci`/`merge-ci` labels.
run: |
check_level=0
if [[ -n "${{ steps.set-nightly.outputs.nightly }}" || -n "${{ steps.set-release.outputs.RELEASE_TAG }}" ]]; then
check_level=2
elif [[ "${{ github.event_name }}" != "pull_request" ]]; then
check_level=1
else
labels="$(gh api repos/${{ github.repository_owner }}/${{ github.event.repository.name }}/pulls/${{ github.event.pull_request.number }}) --jq '.labels'"
if echo "$labels" | grep -q "release-ci"; then
check_level=2
elif echo "$labels" | grep -q "merge-ci"; then
check_level=1
fi
fi
echo "check-level=$check_level" >> "$GITHUB_OUTPUT"
env:
GH_TOKEN: ${{ github.token }}
- name: Configure build matrix
id: set-matrix
uses: actions/github-script@v7
with:
script: |
const level = ${{ steps.set-level.outputs.check-level }};
console.log(`level: ${level}`);
// use large runners where available (original repo)
let large = ${{ github.repository == 'leanprover/lean4' }};
let matrix = [
{
// portable release build: use channel with older glibc (2.27)
"name": "Linux LLVM",
"os": "ubuntu-latest",
"release": false,
"check-level": 2,
"shell": "nix develop .#oldGlibc -c 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": large ? "nscloud-ubuntu-22.04-amd64-4x8" : "ubuntu-latest",
"release": true,
"check-level": 0,
"shell": "nix develop .#oldGlibc -c 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": large ? "nscloud-ubuntu-22.04-amd64-4x8" : "ubuntu-latest",
"check-stage3": level >= 2,
"test-speedcenter": level >= 2,
"check-level": 1,
},
{
"name": "Linux Debug",
"os": "ubuntu-latest",
"check-level": 2,
"CMAKE_PRESET": "debug",
// exclude seriously slow tests
"CTEST_OPTIONS": "-E 'interactivetest|leanpkgtest|laketest|benchtest'"
},
// TODO: suddenly started failing in CI
/*{
"name": "Linux fsanitize",
"os": "ubuntu-latest",
"check-level": 2,
// turn off custom allocator & symbolic functions to make LSAN do its magic
"CMAKE_PRESET": "sanitize",
// exclude seriously slow/problematic tests (laketests crash)
"CTEST_OPTIONS": "-E 'interactivetest|leanpkgtest|laketest|benchtest'"
},*/
{
"name": "macOS",
"os": "macos-13",
"release": true,
"check-level": 2,
"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-14",
"CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
"release": true,
"check-level": 1,
"shell": "bash -euxo pipefail {0}",
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-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": "Windows",
"os": "windows-2022",
"release": true,
"check-level": 2,
"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,
"check-level": 2,
"cross": true,
"cross_target": "aarch64-unknown-linux-gnu",
"shell": "nix develop .#oldGlibcAArch -c 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": "../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,
"check-level": 2,
"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,
"check-level": 2,
"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)}`)
return matrix.filter((job) => level >= job["check-level"])
build:
needs: [configure]
if: github.event_name != 'schedule' || github.repository == 'leanprover/lean4'
@@ -276,7 +251,7 @@ jobs:
runs-on: ${{ matrix.os }}
defaults:
run:
shell: ${{ matrix.shell || 'nix develop -c bash -euxo pipefail {0}' }}
shell: ${{ matrix.shell || 'nix-shell --run "bash -euxo pipefail {0}"' }}
name: ${{ matrix.name }}
env:
# must be inside workspace
@@ -291,34 +266,28 @@ jobs:
CXX: c++
MACOSX_DEPLOYMENT_TARGET: 10.15
steps:
- name: Checkout
uses: actions/checkout@v3
with:
submodules: true
# 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: DeterminateSystems/nix-installer-action@main
if: runner.os == 'Linux' && !matrix.cmultilib
uses: cachix/install-nix-action@v18
with:
install_url: https://releases.nixos.org/nix/nix-2.12.0/install
if: matrix.os == 'ubuntu-latest' && !matrix.cmultilib
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: clang64
# `:` means do not prefix with msystem
pacboy: "make: python: cmake clang ccache gmp git: zip: unzip: diffutils: binutils: tree: zstd tar:"
if: runner.os == 'Windows'
# `:p` means prefix with appropriate msystem prefix
pacboy: "make python cmake:p clang:p ccache:p gmp:p git zip unzip diffutils binutils tree zstd:p tar"
if: matrix.os == 'windows-2022'
- name: Install Brew Packages
run: |
brew install ccache tree zstd coreutils gmp
if: runner.os == 'macOS'
- name: Checkout
uses: actions/checkout@v4
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 }}
# Do check out some CI-relevant files from virtual merge commit to accommodate CI changes on
# master (as the workflow files themselves are always taken from the merge)
# (needs to be after "Install *" to use the right shell)
- name: CI Merge Checkout
run: |
git fetch --depth=1 origin ${{ github.sha }}
git checkout FETCH_HEAD flake.nix flake.lock
if: github.event_name == 'pull_request'
# (needs to be after "Checkout" so files don't get overriden)
if: matrix.os == 'macos-latest'
- name: Setup emsdk
uses: mymindstorm/setup-emsdk@v12
with:
@@ -334,22 +303,26 @@ jobs:
uses: actions/cache@v3
with:
path: .ccache
key: ${{ matrix.name }}-build-v3-${{ github.event.pull_request.head.sha }}
key: ${{ matrix.name }}-build-v3-${{ github.sha }}
# fall back to (latest) previous cache
restore-keys: |
${{ matrix.name }}-build-v3
# open nix-shell once for initial setup
- name: Setup
run: |
ccache --zero-stats
if: runner.os == 'Linux'
- name: Set up NPROC
# open nix-shell once for initial setup
true
if: matrix.os == 'ubuntu-latest'
- name: Set up core dumps
run: |
echo "NPROC=$(nproc 2>/dev/null || sysctl -n hw.logicalcpu 2>/dev/null || echo 4)" >> $GITHUB_ENV
mkdir -p $PWD/coredumps
# store in current directory, for easy uploading together with binary
echo $PWD/coredumps/%e.%p.%t | sudo tee /proc/sys/kernel/core_pattern
if: matrix.os == 'ubuntu-latest'
- name: Build
run: |
mkdir build
cd build
ulimit -c unlimited # coredumps
# arguments passed to `cmake`
# this also enables githash embedding into stage 1 library
OPTIONS=(-DCHECK_OLEAN_VERSION=ON)
@@ -375,11 +348,9 @@ jobs:
OPTIONS+=(-DLEAN_SPECIAL_VERSION_DESC=${{ needs.configure.outputs.LEAN_SPECIAL_VERSION_DESC }})
fi
# contortion to support empty OPTIONS with old macOS bash
cmake .. --preset ${{ matrix.CMAKE_PRESET || 'release' }} -B . ${{ matrix.CMAKE_OPTIONS }} ${OPTIONS[@]+"${OPTIONS[@]}"} -DLEAN_INSTALL_PREFIX=$PWD/..
time make -j$NPROC
- name: Install
run: |
make -C build install
cmake .. ${{ matrix.CMAKE_OPTIONS }} ${OPTIONS[@]+"${OPTIONS[@]}"} -DLEAN_INSTALL_PREFIX=$PWD/..
make -j4
make install
- name: Check Binaries
run: ${{ matrix.binary-check }} lean-*/bin/* || true
- name: List Install Tree
@@ -397,7 +368,7 @@ jobs:
else
${{ matrix.tar || 'tar' }} cf - $dir | zstd -T0 --no-progress -o pack/$dir.tar.zst
fi
- uses: actions/upload-artifact@v4
- uses: actions/upload-artifact@v3
if: matrix.release
with:
name: build-${{ matrix.name }}
@@ -407,43 +378,62 @@ jobs:
build/stage1/bin/lean --stats src/Lean.lean
if: ${{ !matrix.cross }}
- name: Test
id: test
run: |
time ctest --preset ${{ matrix.CMAKE_PRESET || 'release' }} --test-dir build/stage1 -j$NPROC --output-junit test-results.xml ${{ matrix.CTEST_OPTIONS }}
if: (matrix.wasm || !matrix.cross) && needs.configure.outputs.check-level >= 1
- name: Test Summary
uses: test-summary/action@v2
with:
paths: build/stage1/test-results.xml
# prefix `if` above with `always` so it's run even if tests failed
if: always() && steps.test.conclusion != 'skipped'
cd build/stage1
ulimit -c unlimited # coredumps
# exclude nonreproducible test
ctest -j4 --output-on-failure ${{ matrix.CTEST_OPTIONS }} < /dev/null
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) && steps.test.conclusion != 'skipped'
if: ${{ !matrix.cross && needs.configure.outputs.quick == 'false' }}
- name: Build Stage 2
run: |
make -C build -j$NPROC stage2
cd build
ulimit -c unlimited # coredumps
make -j4 stage2
if: matrix.test-speedcenter
- name: Check Stage 3
run: |
make -C build -j$NPROC check-stage3
cd build
ulimit -c unlimited # coredumps
make -j4 check-stage3
if: matrix.test-speedcenter
- name: Test Speedcenter Benchmarks
run: |
# Necessary for some timing metrics but does not work on Namespace runners
# and we just want to test that the benchmarks run at all here
#echo -1 | sudo tee /proc/sys/kernel/perf_event_paranoid
echo -1 | sudo tee /proc/sys/kernel/perf_event_paranoid
export BUILD=$PWD/build PATH=$PWD/build/stage1/bin:$PATH
cd tests/bench
nix shell .#temci -c temci exec --config speedcenter.yaml --included_blocks fast --runs 1
if: matrix.test-speedcenter
- name: Check rebootstrap
run: |
# clean rebuild in case of Makefile changes
make -C build update-stage0 && rm -rf build/stage* && make -C build -j$NPROC
if: matrix.name == 'Linux' && needs.configure.outputs.check-level >= 1
cd build
ulimit -c unlimited # coredumps
make update-stage0 && make -j4
if: matrix.name == 'Linux' && needs.configure.outputs.quick == 'false'
- name: CCache stats
run: ccache -s
- name: Show stacktrace for coredumps
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
run: |
for c in coredumps/*; do
progbin="$(file $c | sed "s/.*execfn: '\([^']*\)'.*/\1/")"
echo bt | $GDB/bin/gdb -q $progbin $c || true
done
- name: Upload coredumps
uses: actions/upload-artifact@v3
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
with:
name: coredumps-${{ matrix.name }}
path: |
./coredumps
./build/stage0/bin/lean
./build/stage0/lib/lean/libleanshared.so
./build/stage1/bin/lean
./build/stage1/lib/lean/libleanshared.so
./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
@@ -452,27 +442,14 @@ jobs:
name: Build matrix complete
runs-on: ubuntu-latest
needs: build
# mark as merely cancelled not failed if builds are cancelled
if: ${{ !cancelled() }}
if: ${{ always() }}
steps:
- if: ${{ contains(needs.*.result, 'failure') && github.repository == 'leanprover/lean4' && github.ref_name == 'master' }}
uses: zulip/github-actions-zulip/send-message@v1
with:
api-key: ${{ secrets.ZULIP_BOT_KEY }}
email: "github-actions-bot@lean-fro.zulipchat.com"
organization-url: "https://lean-fro.zulipchat.com"
to: "infrastructure"
topic: "Github actions"
type: "stream"
content: |
A build of `${{ github.ref_name }}`, triggered by event `${{ github.event_name }}`, [failed](https://github.com/${{ github.repository }}/actions/runs/${{ github.run_id }}).
- if: contains(needs.*.result, 'failure')
- 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:
@@ -482,7 +459,7 @@ jobs:
runs-on: ubuntu-latest
needs: build
steps:
- uses: actions/download-artifact@v4
- uses: actions/download-artifact@v3
with:
path: artifacts
- name: Release
@@ -490,14 +467,8 @@ jobs:
with:
files: artifacts/*/*
fail_on_unmatched_files: true
prerelease: ${{ !startsWith(github.ref, 'refs/tags/v') || contains(github.ref, '-rc') }}
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
- name: Update release.lean-lang.org
run: |
gh workflow -R leanprover/release-index run update-index.yml
env:
GITHUB_TOKEN: ${{ secrets.RELEASE_INDEX_TOKEN }}
# This job creates nightly releases during the cron job.
# It is responsible for creating the tag, and automatically generating a changelog.
@@ -507,12 +478,12 @@ jobs:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
# needed for tagging
fetch-depth: 0
token: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
- uses: actions/download-artifact@v4
- uses: actions/download-artifact@v3
with:
path: artifacts
- name: Prepare Nightly Release
@@ -540,13 +511,3 @@ jobs:
repository: ${{ github.repository_owner }}/lean4-nightly
env:
GITHUB_TOKEN: ${{ secrets.PUSH_NIGHTLY_TOKEN }}
- name: Update release.lean-lang.org
run: |
gh workflow -R leanprover/release-index run update-index.yml
env:
GITHUB_TOKEN: ${{ secrets.RELEASE_INDEX_TOKEN }}
- name: Update toolchain on mathlib4's nightly-testing branch
run: |
gh workflow -R leanprover-community/mathlib4 run nightly_bump_toolchain.yml
env:
GITHUB_TOKEN: ${{ secrets.MATHLIB4_BOT }}

View File

@@ -10,11 +10,11 @@ jobs:
- name: Verify .lean files start with a copyright header.
run: |
FILES=$(find ./src -type d \( -path "./src/lake/examples" -o -path "./src/lake/tests" \) -prune -o -type f -name "*.lean" -exec perl -ne 'BEGIN { $/ = undef; } print "$ARGV\n" if !m{\A/-\nCopyright}; exit;' {} \;)
FILES=$(find . -type d \( -path "./tests" -o -path "./doc" -o -path "./src/lake/examples" -o -path "./src/lake/tests" -o -path "./build" -o -path "./nix" \) -prune -o -type f -name "*.lean" -exec perl -ne 'BEGIN { $/ = undef; } print "$ARGV\n" if !m{\A/-\nCopyright}; exit;' {} \;)
if [ -n "$FILES" ]; then
echo "Found .lean files which do not have a copyright header:"
echo "$FILES"
exit 1
else
echo "All copyright headers present."
echo "All copyright headres present!"
fi

View File

@@ -1,34 +0,0 @@
name: Jira sync
on:
issues:
types: [closed]
jobs:
jira-sync:
runs-on: ubuntu-latest
steps:
- name: Move Jira issue to Done
env:
JIRA_API_TOKEN: ${{ secrets.JIRA_API_TOKEN }}
JIRA_USERNAME: ${{ secrets.JIRA_USERNAME }}
JIRA_BASE_URL: ${{ secrets.JIRA_BASE_URL }}
run: |
issue_number=${{ github.event.issue.number }}
jira_issue_key=$(curl -s -u "${JIRA_USERNAME}:${JIRA_API_TOKEN}" \
-X GET -H "Content-Type: application/json" \
"${JIRA_BASE_URL}/rest/api/2/search?jql=summary~\"${issue_number}\"" | \
jq -r '.issues[0].key')
if [ -z "$jira_issue_key" ]; then
exit
fi
curl -s -u "${JIRA_USERNAME}:${JIRA_API_TOKEN}" \
-X POST -H "Content-Type: application/json" \
--data "{\"transition\": {\"id\": \"41\"}}" \
"${JIRA_BASE_URL}/rest/api/2/issue/${jira_issue_key}/transitions"
echo "Moved Jira issue ${jira_issue_key} to Done"

View File

@@ -13,36 +13,18 @@ concurrency:
cancel-in-progress: true
jobs:
# see ci.yml
configure:
runs-on: ubuntu-latest
outputs:
matrix: ${{ steps.set-matrix.outputs.result }}
steps:
- name: Configure build matrix
id: set-matrix
uses: actions/github-script@v7
with:
script: |
let large = ${{ github.repository == 'leanprover/lean4' }};
let matrix = [
{
"name": "Nix Linux",
"os": large ? "nscloud-ubuntu-22.04-amd64-8x8" : "ubuntu-latest",
}
];
console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`);
return matrix;
Build:
needs: [configure]
runs-on: ${{ matrix.os }}
defaults:
run:
shell: nix run .#ciShell -- bash -euxo pipefail {0}
strategy:
matrix:
include: ${{fromJson(needs.configure.outputs.matrix)}}
include:
- name: Nix Linux
os: ubuntu-latest
#- name: Nix macOS
# os: macos-latest
# complete all jobs
fail-fast: false
name: ${{ matrix.name }}
@@ -50,7 +32,7 @@ jobs:
NIX_BUILD_ARGS: --print-build-logs --fallback
steps:
- name: Checkout
uses: actions/checkout@v4
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 }}
@@ -94,16 +76,10 @@ jobs:
nix build $NIX_BUILD_ARGS .#cacheRoots -o push-build
- name: Test
run: |
nix build --keep-failed $NIX_BUILD_ARGS .#test -o push-test || (ln -s /tmp/nix-build-*/source/src/build/ ./push-test; false)
- name: Test Summary
uses: test-summary/action@v2
with:
paths: push-test/test-results.xml
if: always()
continue-on-error: true
nix build $NIX_BUILD_ARGS .#test -o push-test
- name: Build manual
run: |
nix build $NIX_BUILD_ARGS --update-input lean --no-write-lock-file ./doc#{lean-mdbook,leanInk,alectryon,inked} -o push-doc
nix build $NIX_BUILD_ARGS --update-input lean --no-write-lock-file ./doc#{lean-mdbook,leanInk,alectryon,test,inked} -o push-doc
nix build $NIX_BUILD_ARGS --update-input lean --no-write-lock-file ./doc
# https://github.com/netlify/cli/issues/1809
cp -r --dereference ./result ./dist
@@ -146,3 +122,5 @@ jobs:
- name: Fixup CCache Cache
run: |
sudo chown -R $USER /nix/var/cache
- name: CCache stats
run: CCACHE_DIR=/nix/var/cache/ccache nix run .#nixpkgs.ccache -- -s

View File

@@ -126,22 +126,24 @@ jobs:
if [ "$NIGHTLY_SHA" = "$MERGE_BASE_SHA" ]; then
echo "The merge base of this PR coincides with the nightly release"
BATTERIES_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/batteries.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
MATHLIB_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/mathlib4.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
if [[ -n "$BATTERIES_REMOTE_TAGS" ]]; then
echo "... and Batteries has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
if [[ -n "$MATHLIB_REMOTE_TAGS" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE=""
if [[ -n "$MATHLIB_REMOTE_TAGS" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
else
echo "... but Mathlib does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Mathlib CI can not be attempted yet, as the \`nightly-testing-$MOST_RECENT_NIGHTLY\` tag does not exist there yet. We will retry when you push more commits. If you rebase your branch onto \`nightly-with-mathlib\`, Mathlib CI should run now."
fi
else
echo "... but Batteries does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Batteries CI can not be attempted yet, as the \`nightly-testing-$MOST_RECENT_NIGHTLY\` tag does not exist there yet. We will retry when you push more commits. If you rebase your branch onto \`nightly-with-mathlib\`, Batteries CI should run now."
echo "... but Mathlib does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Mathlib CI can not be attempted yet, as the \`nightly-testing-$MOST_RECENT_NIGHTLY\` tag does not exist there yet. We will retry when you push more commits. If you rebase your branch onto \`nightly-with-mathlib\`, Mathlib CI should run now."
fi
STD_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover/std4.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
if [[ -n "$STD_REMOTE_TAGS" ]]; then
echo "... and Std has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE=""
else
echo "... but Std does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Std CI can not be attempted yet, as the \`nightly-testing-$MOST_RECENT_NIGHTLY\` tag does not exist there yet. We will retry when you push more commits. If you rebase your branch onto \`nightly-with-mathlib\`, Std CI should run now."
fi
else
@@ -149,9 +151,7 @@ jobs:
echo "but 'git merge-base origin/master HEAD' reported: $MERGE_BASE_SHA"
git -C lean4.git log -10 origin/master
git -C lean4.git fetch origin nightly-with-mathlib
NIGHTLY_WITH_MATHLIB_SHA="$(git -C lean4.git rev-parse "origin/nightly-with-mathlib")"
MESSAGE="- ❗ Batteries/Mathlib CI will not be attempted unless your PR branches off the \`nightly-with-mathlib\` branch. Try \`git rebase $MERGE_BASE_SHA --onto $NIGHTLY_WITH_MATHLIB_SHA\`."
MESSAGE="- ❗ Std/Mathlib CI will not be attempted unless your PR branches off the \`nightly-with-mathlib\` branch."
fi
if [[ -n "$MESSAGE" ]]; then
@@ -223,27 +223,27 @@ jobs:
description: description,
});
# We next automatically create a Batteries branch using this toolchain.
# Batteries doesn't itself have a mechanism to report results of CI from this branch back to Lean
# Instead this is taken care of by Mathlib CI, which will fail if Batteries fails.
# We next automatically create a Std branch using this toolchain.
# Std doesn't itself have a mechanism to report results of CI from this branch back to Lean
# Instead this is taken care of by Mathlib CI, which will fail if Std fails.
- name: Cleanup workspace
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
run: |
sudo rm -rf ./*
# Checkout the Batteries repository with all branches
- name: Checkout Batteries repository
# Checkout the Std repository with all branches
- name: Checkout Std repository
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
repository: leanprover-community/batteries
repository: leanprover/std4
token: ${{ secrets.MATHLIB4_BOT }}
ref: nightly-testing
fetch-depth: 0 # This ensures we check out all tags and branches.
- name: Check if tag exists
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
id: check_batteries_tag
id: check_std_tag
run: |
git config user.name "leanprover-community-mathlib4-bot"
git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com"
@@ -251,7 +251,7 @@ jobs:
if git ls-remote --heads --tags --exit-code origin "nightly-testing-${MOST_RECENT_NIGHTLY}" >/dev/null; then
BASE="nightly-testing-${MOST_RECENT_NIGHTLY}"
else
echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' tag at Batteries. Falling back to 'nightly-testing'."
echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' tag at Std. Falling back to 'nightly-testing'."
BASE=nightly-testing
fi
@@ -268,7 +268,7 @@ jobs:
else
echo "Branch already exists, pushing an empty commit."
git switch lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# The Batteries `nightly-testing` or `nightly-testing-YYYY-MM-DD` branch may have moved since this branch was created, so merge their changes.
# The Std `nightly-testing` or `nightly-testing-YYYY-MM-DD` branch may have moved since this branch was created, so merge their changes.
# (This should no longer be possible once `nightly-testing-YYYY-MM-DD` is a tag, but it is still safe to merge.)
git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
@@ -291,20 +291,13 @@ jobs:
# Checkout the mathlib4 repository with all branches
- name: Checkout mathlib4 repository
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
uses: actions/checkout@v4
uses: actions/checkout@v3
with:
repository: leanprover-community/mathlib4
token: ${{ secrets.MATHLIB4_BOT }}
ref: nightly-testing
fetch-depth: 0 # This ensures we check out all tags and branches.
- name: install elan
run: |
set -o pipefail
curl -sSfL https://github.com/leanprover/elan/releases/download/v3.0.0/elan-x86_64-unknown-linux-gnu.tar.gz | tar xz
./elan-init -y --default-toolchain none
echo "$HOME/.elan/bin" >> "${GITHUB_PATH}"
- name: Check if tag exists
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
id: check_mathlib_tag
@@ -328,9 +321,8 @@ jobs:
git switch -c lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} "$BASE"
echo "leanprover/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}" > lean-toolchain
git add lean-toolchain
sed -i 's,require "leanprover-community" / "batteries" @ ".\+",require "leanprover-community" / "batteries" @ "git#nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
lake update batteries
git add lakefile.lean lake-manifest.json
sed -i "s/require std from git \"https:\/\/github.com\/leanprover\/std4\" @ \".\+\"/require std from git \"https:\/\/github.com\/leanprover\/std4\" @ \"nightly-testing-${MOST_RECENT_NIGHTLY}\"/" lakefile.lean
git add lakefile.lean
git commit -m "Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
else
echo "Branch already exists, pushing an empty commit."

View File

@@ -1,33 +0,0 @@
name: Restart by label
on:
pull_request_target:
types:
- unlabeled
- labeled
jobs:
restart-on-label:
runs-on: ubuntu-latest
if: contains(github.event.label.name, 'merge-ci') || contains(github.event.label.name, 'release-ci')
steps:
- run: |
# Finding latest CI workflow run on current pull request
# (unfortunately cannot search by PR number, only base branch,
# and that is't even unique given PRs from forks, but the risk
# of confusion is low and the danger is mild)
run_id=$(gh run list -e pull_request -b "$head_ref" --workflow 'CI' --limit 1 \
--limit 1 --json databaseId --jq '.[0].databaseId')
echo "Run id: ${run_id}"
gh run view "$run_id"
echo "Cancelling (just in case)"
gh run cancel "$run_id" || echo "(failed)"
echo "Waiting for 30s"
sleep 30
gh run view "$run_id"
echo "Rerunning"
gh run rerun "$run_id"
gh run view "$run_id"
shell: bash
env:
head_ref: ${{ github.head_ref }}
GH_TOKEN: ${{ github.token }}
GH_REPO: ${{ github.repository }}

View File

@@ -23,7 +23,7 @@ jobs:
# 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@v4
- uses: actions/checkout@v3
with:
ssh-key: ${{secrets.STAGE0_SSH_KEY}}
- run: echo "should_update_stage0=yes" >> "$GITHUB_ENV"

6
.gitignore vendored
View File

@@ -4,10 +4,8 @@
*.lock
.lake
lake-manifest.json
/build
/src/lakefile.toml
/tests/lakefile.toml
/lakefile.toml
build
!/src/lake/Lake/Build
GPATH
GRTAGS
GSYMS

View File

@@ -78,10 +78,6 @@ add_custom_target(update-stage0
COMMAND $(MAKE) -C stage1 update-stage0
DEPENDS stage1)
add_custom_target(update-stage0-commit
COMMAND $(MAKE) -C stage1 update-stage0-commit
DEPENDS stage1)
add_custom_target(test
COMMAND $(MAKE) -C stage1 test
DEPENDS stage1)

View File

@@ -1,83 +0,0 @@
{
"version": 2,
"cmakeMinimumRequired": {
"major": 3,
"minor": 10,
"patch": 0
},
"configurePresets": [
{
"name": "release",
"displayName": "Default development optimized build config",
"generator": "Unix Makefiles",
"binaryDir": "${sourceDir}/build/release"
},
{
"name": "debug",
"displayName": "Debug build config",
"cacheVariables": {
"CMAKE_BUILD_TYPE": "Debug"
},
"generator": "Unix Makefiles",
"binaryDir": "${sourceDir}/build/debug"
},
{
"name": "sanitize",
"displayName": "Sanitize build config",
"cacheVariables": {
"LEAN_EXTRA_CXX_FLAGS": "-fsanitize=address,undefined",
"LEANC_EXTRA_FLAGS": "-fsanitize=address,undefined -fsanitize-link-c++-runtime",
"SMALL_ALLOCATOR": "OFF",
"BSYMBOLIC": "OFF"
},
"generator": "Unix Makefiles",
"binaryDir": "${sourceDir}/build/sanitize"
},
{
"name": "sandebug",
"inherits": ["debug", "sanitize"],
"displayName": "Sanitize+debug build config",
"binaryDir": "${sourceDir}/build/sandebug"
}
],
"buildPresets": [
{
"name": "release",
"configurePreset": "release"
},
{
"name": "debug",
"configurePreset": "debug"
},
{
"name": "sanitize",
"configurePreset": "sanitize"
},
{
"name": "sandebug",
"configurePreset": "sandebug"
}
],
"testPresets": [
{
"name": "release",
"configurePreset": "release",
"output": {"outputOnFailure": true, "shortProgress": true}
},
{
"name": "debug",
"configurePreset": "debug",
"inherits": "release"
},
{
"name": "sanitize",
"configurePreset": "sanitize",
"inherits": "release"
},
{
"name": "sandebug",
"configurePreset": "sandebug",
"inherits": "release"
}
]
}

View File

@@ -6,40 +6,17 @@
/.github/ @Kha @semorrison
/RELEASES.md @semorrison
/src/Init/IO.lean @joehendrix
/src/kernel/ @leodemoura
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @semorrison
/src/Lean/Elab/Tactic/ @semorrison
/src/Lean/Language/ @Kha
/src/Lean/Meta/Tactic/ @leodemoura
/src/Lean/Parser/ @Kha
/src/Lean/PrettyPrinter/ @Kha
/src/Lean/PrettyPrinter/Delaborator/ @kmill
/src/Lean/Server/ @mhuisi
/src/Lean/Widget/ @Vtec234
/src/Init/Data/ @semorrison
/src/Init/Data/Array/Lemmas.lean @digama0
/src/Init/Data/List/Lemmas.lean @digama0
/src/Init/Data/List/BasicAux.lean @digama0
/src/Init/Data/Array/Subarray.lean @david-christiansen
/src/Lean/Elab/Tactic/RCases.lean @digama0
/src/Init/RCases.lean @digama0
/src/Lean/Elab/Tactic/Ext.lean @digama0
/src/Init/Ext.lean @digama0
/src/Lean/Elab/Tactic/Simpa.lean @digama0
/src/Lean/Elab/Tactic/NormCast.lean @digama0
/src/Lean/Meta/Tactic/NormCast.lean @digama0
/src/Lean/Meta/Tactic/TryThis.lean @digama0
/src/Lean/Elab/Tactic/SimpTrace.lean @digama0
/src/Lean/Elab/Tactic/NoMatch.lean @digama0
/src/Lean/Elab/Tactic/ShowTerm.lean @digama0
/src/Lean/Elab/Tactic/Repeat.lean @digama0
/src/Lean/Meta/Tactic/Repeat.lean @digama0
/src/Lean/Meta/CoeAttr.lean @digama0
/src/Lean/Elab/GuardMsgs.lean @digama0
/src/Lean/Elab/Tactic/Guard.lean @digama0
/src/Init/Guard.lean @digama0
/src/Lean/Server/CodeActions/ @digama0
/src/Std/ @TwoFX
/src/runtime/io.cpp @joehendrix

View File

@@ -63,20 +63,6 @@ Because the change will be squashed, there is no need to polish the commit messa
Reviews and Feedback:
----
The lean4 repo is managed by the Lean FRO's *triage team* that aims to provide initial feedback on new bug reports, PRs, and RFCs weekly.
This feedback generally consists of prioritizing the ticket using one of the following categories:
* label `P-high`: We will work on this issue
* label `P-medium`: We may work on this issue if we find the time
* label `P-low`: We are not planning to work on this issue
* *closed*: This issue is already fixed, it is not an issue, or is not sufficiently compatible with our roadmap for the project and we will not work on it nor accept external contributions on it
For *bug reports*, the listed priority reflects our commitment to fixing the issue.
It is generally indicative but not necessarily identical to the priority an external contribution addressing this bug would receive.
For *PRs* and *RFCs*, the priority reflects our commitment to reviewing them and getting them to an acceptable state.
Accepted RFCs are marked with the label `RFC accepted` and afterwards assigned a new "implementation" priority as with bug reports.
General guidelines for interacting with reviews and feedback:
**Be Patient**: Given the limited number of full-time maintainers and the volume of PRs, reviews may take some time.
**Engage Constructively**: Always approach feedback positively and constructively. Remember, reviews are about ensuring the best quality for the project, not personal criticism.

View File

@@ -22,4 +22,4 @@ Please read our [Contribution Guidelines](CONTRIBUTING.md) first.
# Building from Source
See [Building Lean](https://lean-lang.org/lean4/doc/make/index.html) (documentation source: [doc/make/index.md](doc/make/index.md)).
See [Building Lean](https://lean-lang.org/lean4/doc/make/index.html).

File diff suppressed because it is too large Load Diff

9
default.nix Normal file
View File

@@ -0,0 +1,9 @@
# used for `nix-shell https://github.com/leanprover/lean4/archive/master.tar.gz -A nix`
{ nix = (import ./shell.nix {}).nix; } //
(import (
fetchTarball {
url = "https://github.com/edolstra/flake-compat/archive/c75e76f80c57784a6734356315b306140646ee84.tar.gz";
sha256 = "071aal00zp2m9knnhddgr2wqzlx6i6qa1263lv1y7bdn2w20h10h"; }
) {
src = ./.;
}).defaultNix

View File

@@ -1,4 +1,4 @@
open Batteries
open Std
open Lean
inductive BoolExpr where

View File

@@ -89,6 +89,5 @@
- [Testing](./dev/testing.md)
- [Debugging](./dev/debugging.md)
- [Commit Convention](./dev/commit_convention.md)
- [Release checklist](./dev/release_checklist.md)
- [Building This Manual](./dev/mdbook.md)
- [Foreign Function Interface](./dev/ffi.md)

View File

@@ -1,11 +1 @@
# Characters
A value of type `Char`, also known as a character, is a [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value). It is represented using an unsigned 32-bit integer and is statically guaranteed to be a valid Unicode scalar value.
Syntactically, character literals are enclosed in single quotes.
```lean
#eval 'a' -- 'a'
#eval '' -- '∀'
```
Characters are ordered and can be decidably compared using the relational operators `=`, `<`, `≤`, `>`, `≥`.

View File

@@ -75,28 +75,26 @@ The github repository will automatically update stage0 on `master` once
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/leanprover/lean4/actions/workflows/update-stage0.yml>
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 preferable, but should you need
to do it locally, you can use `make update-stage0-commit` in `build/release` to
update `stage0` from `stage1` or `make -C stageN update-stage0-commit` to
update from another stage. This command will automatically stage the updated files
and introduce a commit,so make sure to commit your work before that.
If you rebased the branch (either onto a newer version of `master`, or fixing
up some commits prior to the stage0 update, recreate the stage0 update commits.
The script `script/rebase-stage0.sh` can be used for that.
The CI should prevent PRs with changes to stage0 (besides `stdlib_flags.h`)
from entering `master` through the (squashing!) merge queue, and label such PRs
with the `changes-stage0` label. Such PRs should have a cleaned up history,
with separate stage0 update commits; then coordinate with the admins to merge
your PR using rebase merge, bypassing the merge queue.
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

View File

@@ -53,59 +53,10 @@ In the case of `@[extern]` all *irrelevant* types are removed first; see next se
Its runtime value is either a pointer to an opaque bignum object or, if the lowest bit of the "pointer" is 1 (`lean_is_scalar`), an encoded unboxed natural number (`lean_box`/`lean_unbox`).
* A universe `Sort u`, type constructor `... → Sort u`, or proposition `p : Prop` is *irrelevant* and is either statically erased (see above) or represented as a `lean_object *` with the runtime value `lean_box(0)`
* Any other type is represented by `lean_object *`.
Its runtime value is a pointer to an object of a subtype of `lean_object` (see the "Inductive types" section below) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.
Its runtime value is a pointer to an object of a subtype of `lean_object` (see respective declarations in `lean.h`) or the unboxed value `lean_box(cidx)` for the `cidx`th constructor of an inductive type if this constructor does not have any relevant parameters.
Example: the runtime value of `u : Unit` is always `lean_box(0)`.
#### Inductive types
For inductive types which are in the fallback `lean_object *` case above and not trivial constructors, the type is stored as a `lean_ctor_object`, and `lean_is_ctor` will return true. A `lean_ctor_object` stores the constructor index in the header, and the fields are stored in the `m_objs` portion of the object.
The memory order of the fields is derived from the types and order of the fields in the declaration. They are ordered as follows:
* Non-scalar fields stored as `lean_object *`
* Fields of type `USize`
* Other scalar fields, in decreasing order by size
Within each group the fields are ordered in declaration order. **Warning**: Trivial wrapper types still count toward a field being treated as non-scalar for this purpose.
* To access fields of the first kind, use `lean_ctor_get(val, i)` to get the `i`th non-scalar field.
* To access `USize` fields, use `lean_ctor_get_usize(val, n+i)` to get the `i`th usize field and `n` is the total number of fields of the first kind.
* To access other scalar fields, use `lean_ctor_get_uintN(val, off)` or `lean_ctor_get_usize(val, off)` as appropriate. Here `off` is the byte offset of the field in the structure, starting at `n*sizeof(void*)` where `n` is the number of fields of the first two kinds.
For example, a structure such as
```lean
structure S where
ptr_1 : Array Nat
usize_1 : USize
sc64_1 : UInt64
ptr_2 : { x : UInt64 // x > 0 } -- wrappers don't count as scalars
sc64_2 : Float -- `Float` is 64 bit
sc8_1 : Bool
sc16_1 : UInt16
sc8_2 : UInt8
sc64_3 : UInt64
usize_2 : USize
ptr_3 : Char -- trivial wrapper around `UInt32`
sc32_1 : UInt32
sc16_2 : UInt16
```
would get re-sorted into the following memory order:
* `S.ptr_1` - `lean_ctor_get(val, 0)`
* `S.ptr_2` - `lean_ctor_get(val, 1)`
* `S.ptr_3` - `lean_ctor_get(val, 2)`
* `S.usize_1` - `lean_ctor_get_usize(val, 3)`
* `S.usize_2` - `lean_ctor_get_usize(val, 4)`
* `S.sc64_1` - `lean_ctor_get_uint64(val, sizeof(void*)*5)`
* `S.sc64_2` - `lean_ctor_get_float(val, sizeof(void*)*5 + 8)`
* `S.sc64_3` - `lean_ctor_get_uint64(val, sizeof(void*)*5 + 16)`
* `S.sc32_1` - `lean_ctor_get_uint32(val, sizeof(void*)*5 + 24)`
* `S.sc16_1` - `lean_ctor_get_uint16(val, sizeof(void*)*5 + 28)`
* `S.sc16_2` - `lean_ctor_get_uint16(val, sizeof(void*)*5 + 30)`
* `S.sc8_1` - `lean_ctor_get_uint8(val, sizeof(void*)*5 + 32)`
* `S.sc8_2` - `lean_ctor_get_uint8(val, sizeof(void*)*5 + 33)`
### Borrowing
By default, all `lean_object *` parameters of an `@[extern]` function are considered *owned*, i.e. the external code is passed a "virtual RC token" and is responsible for passing this token along to another consuming function (exactly once) or freeing it via `lean_dec`.
@@ -160,15 +111,6 @@ if (lean_io_result_is_ok(res)) {
lean_io_mark_end_initialization();
```
In addition, any other thread not spawned by the Lean runtime itself must be initialized for Lean use by calling
```c
void lean_initialize_thread();
```
and should be finalized in order to free all thread-local resources by calling
```c
void lean_finalize_thread();
```
## `@[extern]` in the Interpreter
The interpreter can run Lean declarations for which symbols are available in loaded shared libraries, which includes `@[extern]` declarations.

View File

@@ -74,9 +74,3 @@ Lean's build process uses [`ccache`](https://ccache.dev/) if it is
installed to speed up recompilation of the generated C code. Without
`ccache`, you'll likely spend more time than necessary waiting on
rebuilds - it's a good idea to make sure it's installed.
### `prelude`
Unlike most Lean projects, all submodules of the `Lean` module begin with the
`prelude` keyword. This disables the automated import of `Init`, meaning that
developers need to figure out their own subset of `Init` to import. This is done
such that changing files in `Init` doesn't force a full rebuild of `Lean`.

View File

@@ -1,250 +0,0 @@
# Releasing a stable version
This checklist walks you through releasing a stable version.
See below for the checklist for release candidates.
We'll use `v4.6.0` as the intended release version as a running example.
- One week before the planned release, ensure that
(1) someone has written the release notes and
(2) someone has written the first draft of the release blog post.
If there is any material in `./releases_drafts/` on the `releases/v4.6.0` branch, then the release notes are not done.
(See the section "Writing the release notes".)
- `git checkout releases/v4.6.0`
(This branch should already exist, from the release candidates.)
- `git pull`
- In `src/CMakeLists.txt`, verify you see
- `set(LEAN_VERSION_MINOR 6)` (for whichever `6` is appropriate)
- `set(LEAN_VERSION_IS_RELEASE 1)`
- (both of these should already be in place from the release candidates)
- `git tag v4.6.0`
- `git push $REMOTE v4.6.0`, where `$REMOTE` is the upstream Lean repository (e.g., `origin`, `upstream`)
- Now wait, while CI runs.
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`,
looking for the `v4.6.0` tag.
- This step can take up to an hour.
- If you are intending to cut the next release candidate on the same day,
you may want to start on the release candidate checklist now.
- Go to https://github.com/leanprover/lean4/releases and verify that the `v4.6.0` release appears.
- Edit the release notes on Github to select the "Set as the latest release".
- Follow the instructions in creating a release candidate for the "GitHub release notes" step,
now that we have a written `RELEASES.md` section.
Do a quick sanity check.
- Next, we will move a curated list of downstream repos to the latest stable release.
- For each of the repositories listed below:
- Make a PR to `master`/`main` changing the toolchain to `v4.6.0`
- Update the toolchain file
- In the Lakefile, if there are dependencies on specific version tags of dependencies that you've already pushed as part of this process, update them to the new tag.
If they depend on `main` or `master`, don't change this; you've just updated the dependency, so it will work and be saved in the manifest
- Run `lake update`
- The PR title should be "chore: bump toolchain to v4.6.0".
- Merge the PR once CI completes.
- Create the tag `v4.6.0` from `master`/`main` and push it.
- Merge the tag `v4.6.0` into the `stable` branch and push it.
- We do this for the repositories:
- [lean4checker](https://github.com/leanprover/lean4checker)
- No dependencies
- Toolchain bump PR
- Create and push the tag
- Merge the tag into `stable`
- [Batteries](https://github.com/leanprover-community/batteries)
- No dependencies
- Toolchain bump PR
- Create and push the tag
- Merge the tag into `stable`
- [ProofWidgets4](https://github.com/leanprover-community/ProofWidgets4)
- Dependencies: `Batteries`
- Note on versions and branches:
- `ProofWidgets` uses a sequential version tagging scheme, e.g. `v0.0.29`,
which does not refer to the toolchain being used.
- Make a new release in this sequence after merging the toolchain bump PR.
- `ProofWidgets` does not maintain a `stable` branch.
- Toolchain bump PR
- Create and push the tag, following the version convention of the repository
- [Aesop](https://github.com/leanprover-community/aesop)
- Dependencies: `Batteries`
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- [doc-gen4](https://github.com/leanprover/doc-gen4)
- Dependencies: exist, but they're not part of the release workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [import-graph](https://github.com/leanprover-community/import-graph)
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Mathlib](https://github.com/leanprover-community/mathlib4)
- Dependencies: `Aesop`, `ProofWidgets4`, `lean4checker`, `Batteries`, `doc-gen4`, `import-graph`
- Toolchain bump PR notes:
- In addition to updating the `lean-toolchain` and `lakefile.lean`,
in `.github/workflows/lean4checker.yml` update the line
`git checkout v4.6.0` to the appropriate tag.
- Push the PR branch to the main Mathlib repository rather than a fork, or CI may not work reliably
- Create and push the tag
- Create a new branch from the tag, push it, and open a pull request against `stable`.
Coordinate with a Mathlib maintainer to get this merged.
- [REPL](https://github.com/leanprover-community/repl)
- Dependencies: `Mathlib` (for test code)
- Note that there are two copies of `lean-toolchain`/`lakefile.lean`:
in the root, and in `test/Mathlib/`. Edit both, and run `lake update` in both directories.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- Merge the tag into `stable`
- The `v4.6.0` section of `RELEASES.md` is out of sync between
`releases/v4.6.0` and `master`. This should be reconciled:
- Replace the `v4.6.0` section on `master` with the `v4.6.0` section on `releases/v4.6.0`
and commit this to `master`.
- Merge the release announcement PR for the Lean website - it will be deployed automatically
- Finally, make an announcement!
This should go in https://leanprover.zulipchat.com/#narrow/stream/113486-announce, with topic `v4.6.0`.
Please see previous announcements for suggested language.
You will want a few bullet points for main topics from the release notes.
Link to the blog post from the Zulip announcement.
- Make sure that whoever is handling social media knows the release is out.
## Optimistic(?) time estimates:
- Initial checks and push the tag: 30 minutes.
- Waiting for the release: 60 minutes.
- Fixing release notes: 10 minutes.
- Bumping toolchains in downstream repositories, up to creating the Mathlib PR: 30 minutes.
- Waiting for Mathlib CI and bors: 120 minutes.
- Finalizing Mathlib tags and stable branch, and updating REPL: 15 minutes.
- Posting announcement and/or blog post: 20 minutes.
# Creating a release candidate.
This checklist walks you through creating the first release candidate for a version of Lean.
We'll use `v4.7.0-rc1` as the intended release version in this example.
- Decide which nightly release you want to turn into a release candidate.
We will use `nightly-2024-02-29` in this example.
- It is essential that Batteries and Mathlib already have reviewed branches compatible with this nightly.
- Check that both Batteries and Mathlib's `bump/v4.7.0` branch contain `nightly-2024-02-29`
in their `lean-toolchain`.
- The steps required to reach that state are beyond the scope of this checklist, but see below!
- Create the release branch from this nightly tag:
```
git remote add nightly https://github.com/leanprover/lean4-nightly.git
git fetch nightly tag nightly-2024-02-29
git checkout nightly-2024-02-29
git checkout -b releases/v4.7.0
```
- In `RELEASES.md` replace `Development in progress` in the `v4.7.0` section with `Release notes to be written.`
- We will rely on automatically generated release notes for release candidates,
and the written release notes will be used for stable versions only.
It is essential to choose the nightly that will become the release candidate as early as possible, to avoid confusion.
- In `src/CMakeLists.txt`,
- verify that you see `set(LEAN_VERSION_MINOR 7)` (for whichever `7` is appropriate); this should already have been updated when the development cycle began.
- `set(LEAN_VERSION_IS_RELEASE 1)` (this should be a change; on `master` and nightly releases it is always `0`).
- Commit your changes to `src/CMakeLists.txt`, and push.
- `git tag v4.7.0-rc1`
- `git push origin v4.7.0-rc1`
- Ping the FRO Zulip that release notes need to be written. The release notes do not block completing the rest of this checklist.
- Now wait, while CI runs.
- You can monitor this at `https://github.com/leanprover/lean4/actions/workflows/ci.yml`, looking for the `v4.7.0-rc1` tag.
- This step can take up to an hour.
- (GitHub release notes) Once the release appears at https://github.com/leanprover/lean4/releases/
- Verify that the release is marked as a prerelease (this should have been done automatically by the CI release job).
- In the "previous tag" dropdown, select `v4.6.0`, and click "Generate release notes".
This will add a list of all the commits since the last stable version.
- Delete "update stage0" commits, and anything with a completely inscrutable commit message.
- Next, we will move a curated list of downstream repos to the release candidate.
- This assumes that there is already a *reviewed* branch `bump/v4.7.0` on each repository
containing the required adaptations (or no adaptations are required).
The preparation of this branch is beyond the scope of this document.
- For each of the target repositories:
- Checkout the `bump/v4.7.0` branch.
- Verify that the `lean-toolchain` is set to the nightly from which the release candidate was created.
- `git merge origin/master`
- Change the `lean-toolchain` to `leanprover/lean4:v4.7.0-rc1`
- In `lakefile.lean`, change any dependencies which were using `nightly-testing` or `bump/v4.7.0` branches
back to `master` or `main`, and run `lake update` for those dependencies.
- Run `lake build` to ensure that dependencies are found (but it's okay to stop it after a moment).
- `git commit`
- `git push`
- Open a PR from `bump/v4.7.0` to `master`, and either merge it yourself after CI, if appropriate,
or notify the maintainers that it is ready to go.
- Once this PR has been merged, tag `master` with `v4.7.0-rc1` and push this tag.
- We do this for the same list of repositories as for stable releases, see above.
As above, there are dependencies between these, and so the process above is iterative.
It greatly helps if you can merge the `bump/v4.7.0` PRs yourself!
It is essential for Mathlib CI that you then create the next `bump/v4.8.0` branch
for the next development cycle.
Set the `lean-toolchain` file on this branch to same `nightly` you used for this release.
- For Batteries/Aesop/Mathlib, which maintain a `nightly-testing` branch, make sure there is a tag
`nightly-testing-2024-02-29` with date corresponding to the nightly used for the release
(create it if not), and then on the `nightly-testing` branch `git reset --hard master`, and force push.
- Make an announcement!
This should go in https://leanprover.zulipchat.com/#narrow/stream/113486-announce, with topic `v4.7.0-rc1`.
Please see previous announcements for suggested language.
You will want a few bullet points for main topics from the release notes.
Please also make sure that whoever is handling social media knows the release is out.
- Begin the next development cycle (i.e. for `v4.8.0`) on the Lean repository, by making a PR that:
- Updates `src/CMakeLists.txt` to say `set(LEAN_VERSION_MINOR 8)`
- Replaces the "release notes will be copied" text in the `v4.6.0` section of `RELEASES.md` with the
finalized release notes from the `releases/v4.6.0` branch.
- Replaces the "development in progress" in the `v4.7.0` section of `RELEASES.md` with
```
Release candidate, release notes will be copied from `branch releases/v4.7.0` once completed.
```
and inserts the following section before that section:
```
v4.8.0
----------
Development in progress.
```
- Removes all the entries from the `./releases_drafts/` folder.
## Time estimates:
Slightly longer than the corresponding steps for a stable release.
Similar process, but more things go wrong.
In particular, updating the downstream repositories is significantly more work
(because we need to merge existing `bump/v4.7.0` branches, not just update a toolchain).
# Preparing `bump/v4.7.0` branches
While not part of the release process per se,
this is a brief summary of the work that goes into updating Batteries/Aesop/Mathlib to new versions.
Please read https://leanprover-community.github.io/contribute/tags_and_branches.html
* Each repo has an unreviewed `nightly-testing` branch that
receives commits automatically from `master`, and
has its toolchain updated automatically for every nightly.
(Note: the aesop branch is not automated, and is updated on an as needed basis.)
As a consequence this branch is often broken.
A bot posts in the (private!) "Mathlib reviewers" stream on Zulip about the status of these branches.
* We fix the breakages by committing directly to `nightly-testing`: there is no PR process.
* This can either be done by the person managing this process directly,
or by soliciting assistance from authors of files, or generally helpful people on Zulip!
* Each repo has a `bump/v4.7.0` which accumulates reviewed changes adapting to new versions.
* Once `nightly-testing` is working on a given nightly, say `nightly-2024-02-15`, we will create a PR to `bump/v4.7.0`.
* For Mathlib, there is a script in `scripts/create-adaptation-pr.sh` that automates this process.
* For Batteries and Aesop it is currently manual.
* For all of these repositories, the process is the same:
* Make sure `bump/v4.7.0` is up to date with `master` (by merging `master`, no PR necessary)
* Create from `bump/v4.7.0` a `bump/nightly-2024-02-15` branch.
* In that branch, `git merge nightly-testing` to bring across changes from `nightly-testing`.
* Sanity check changes, commit, and make a PR to `bump/v4.7.0` from the `bump/nightly-2024-02-15` branch.
* Solicit review, merge the PR into `bump/v4.7.0`.
* It is always okay to merge in the following directions:
`master` -> `bump/v4.7.0` -> `bump/nightly-2024-02-15` -> `nightly-testing`.
Please remember to push any merges you make to intermediate steps!
# Writing the release notes
We are currently trying a system where release notes are compiled all at once from someone looking through the commit history.
The exact steps are a work in progress.
Here is the general idea:
* The work is done right on the `releases/v4.6.0` branch sometime after it is created but before the stable release is made.
The release notes for `v4.6.0` will later be copied to `master` when we begin a new development cycle.
* There can be material for release notes entries in commit messages.
* There can also be pre-written entries in `./releases_drafts`, which should be all incorporated in the release notes and then deleted from the branch.
See `./releases_drafts/README.md` for more information.
* The release notes should be written from a downstream expert user's point of view.
This section will be updated when the next release notes are written (for `v4.10.0`).

View File

@@ -4,16 +4,16 @@ def ack : Nat → Nat → Nat
| 0, y => y+1
| x+1, 0 => ack x 1
| x+1, y+1 => ack x (ack (x+1) y)
termination_by x y => (x, y)
termination_by ack x y => (x, y)
def sum (a : Array Int) : Int :=
let rec go (i : Nat) :=
if _ : i < a.size then
if i < a.size then
a[i] + go (i+1)
else
0
termination_by a.size - i
go 0
termination_by go i => a.size - i
set_option pp.proofs true
#print sum.go

View File

@@ -4,42 +4,43 @@ open Lean Meta
def ctor (mvarId : MVarId) (idx : Nat) : MetaM (List MVarId) := do
/- Set `MetaM` context using `mvarId` -/
mvarId.withContext do
withMVarContext mvarId do
/- Fail if the metavariable is already assigned. -/
mvarId.checkNotAssigned `ctor
checkNotAssigned mvarId `ctor
/- Retrieve the target type, instantiateMVars, and use `whnf`. -/
let target mvarId.getType'
let target getMVarType' mvarId
let .const declName us := target.getAppFn
| throwTacticEx `ctor mvarId "target is not an inductive datatype"
let .inductInfo { ctors, .. } getConstInfo declName
| throwTacticEx `ctor mvarId "target is not an inductive datatype"
if idx = 0 then
throwTacticEx `ctor mvarId "invalid index, it must be > 0"
throwTacticEx `ctor mvarId "invalid index, it must be > 0"
else if h : idx - 1 < ctors.length then
mvarId.apply (.const ctors[idx - 1] us)
apply mvarId (.const ctors[idx - 1] us)
else
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} contructors"
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} contructors"
open Elab Tactic
elab "ctor" idx:num : tactic =>
elab "ctor" idx:num : tactic =>
liftMetaTactic (ctor · idx.getNat)
example (p : Prop) : p := by
example (p : Prop) : p := by
ctor 1 -- Error
example (h : q) : p q := by
example (h : q) : p q := by
ctor 0 -- Error
exact h
example (h : q) : p q := by
example (h : q) : p q := by
ctor 3 -- Error
exact h
example (h : q) : p q := by
example (h : q) : p q := by
ctor 2
exact h
example (h : q) : p q := by
example (h : q) : p q := by
ctor 1
exact h -- Error
exact h -- Error

View File

@@ -5,15 +5,15 @@ open Lean Meta
def ex1 (declName : Name) : MetaM Unit := do
let info getConstInfo declName
IO.println s!"{declName} : {← ppExpr info.type}"
if let some val := info.value? then
if let some val := info.value? then
IO.println s!"{declName} : {← ppExpr val}"
#eval ex1 ``Nat
def ex2 (declName : Name) : MetaM Unit := do
let info getConstInfo declName
trace[Meta.debug] "{declName} : {info.type}"
if let some val := info.value? then
if let some val := info.value? then
trace[Meta.debug] "{declName} : {val}"
#eval ex2 ``Add.add
@@ -30,9 +30,9 @@ def ex3 (declName : Name) : MetaM Unit := do
trace[Meta.debug] "{x} : {← inferType x}"
def myMin [LT α] [DecidableRel (α := α) (·<·)] (a b : α) : α :=
if a < b then
if a < b then
a
else
else
b
set_option trace.Meta.debug true in
@@ -40,7 +40,7 @@ set_option trace.Meta.debug true in
def ex4 : MetaM Unit := do
let nat := mkConst ``Nat
withLocalDeclD `a nat fun a =>
withLocalDeclD `a nat fun a =>
withLocalDeclD `b nat fun b => do
let e mkAppM ``HAdd.hAdd #[a, b]
trace[Meta.debug] "{e} : {← inferType e}"
@@ -66,17 +66,15 @@ open Elab Term
def ex5 : TermElabM Unit := do
let nat := Lean.mkConst ``Nat
withLocalDeclD `a nat fun a => do
withLocalDeclD `a nat fun a => do
withLocalDeclD `b nat fun b => do
let ab mkAppM ``HAdd.hAdd #[a, b]
let abStx exprToSyntax ab
let aStx exprToSyntax a
let stx `(fun x => if x < 10 then $abStx + x else x + $aStx)
let stx `(fun x => if x < 10 then $( exprToSyntax ab) + x else x + $( exprToSyntax a))
let e elabTerm stx none
trace[Meta.debug] "{e} : {← inferType e}"
let e := mkApp e (mkNatLit 5)
let e whnf e
trace[Meta.debug] "{e}"
set_option trace.Meta.debug true in
#eval ex5

View File

@@ -4,16 +4,16 @@ def ack : Nat → Nat → Nat
| 0, y => y+1
| x+1, 0 => ack x 1
| x+1, y+1 => ack x (ack (x+1) y)
termination_by x y => (x, y)
termination_by ack x y => (x, y)
def sum (a : Array Int) : Int :=
let rec go (i : Nat) :=
if _ : i < a.size then
if i < a.size then
a[i] + go (i+1)
else
0
termination_by a.size - i
go 0
termination_by go i => a.size - i
set_option pp.proofs true
#print sum.go

View File

@@ -277,13 +277,14 @@ theorem BinTree.find_insert (b : BinTree β) (k : Nat) (v : β)
. by_cases' key < k
cases h; apply ihr; assumption
theorem BinTree.find_insert_of_ne (b : BinTree β) (ne : k k') (v : β)
theorem BinTree.find_insert_of_ne (b : BinTree β) (h : k k') (v : β)
: (b.insert k v).find? k' = b.find? k' := by
let t, h := b; simp
induction t with simp
| leaf =>
intros le
exact Nat.lt_of_le_of_ne le ne
intros
have_eq k k'
contradiction
| node left key value right ihl ihr =>
let .node hl hr bl br := h
specialize ihl bl

View File

@@ -1 +0,0 @@
build

View File

@@ -149,4 +149,4 @@ def fact : Expr ctx (Ty.fn Ty.int Ty.int) :=
(op (·*·) (delay fun _ => app fact (op (·-·) (var stop) (val 1))) (var stop)))
decreasing_by sorry
#eval! fact.interp Env.nil 10
#eval fact.interp Env.nil 10

View File

@@ -1,4 +1,4 @@
#!/usr/bin/env bash
source ../../tests/common.sh
exec_check lean -Dlinter.all=false "$f"
exec_check lean -j 0 -Dlinter.all=false "$f"

138
doc/flake.lock generated
View File

@@ -18,15 +18,12 @@
}
},
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1710146030,
"narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
"lastModified": 1656928814,
"narHash": "sha256-RIFfgBuKz6Hp89yRr7+NR5tzIAbn52h8vT6vXkYjZoM=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
"rev": "7e2a3b3dfd9af950a856d66b0a7d01e3c18aa249",
"type": "github"
},
"original": {
@@ -38,12 +35,13 @@
"lean": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs",
"nixpkgs-old": "nixpkgs-old"
"lean4-mode": "lean4-mode",
"nix": "nix",
"nixpkgs": "nixpkgs_2"
},
"locked": {
"lastModified": 0,
"narHash": "sha256-saRAtQ6VautVXKDw1XH35qwP0KEBKTKZbg/TRa4N9Vw=",
"narHash": "sha256-YnYbmG0oou1Q/GE4JbMNb8/yqUVXBPIvcdQQJHBqtPk=",
"path": "../.",
"type": "path"
},
@@ -52,6 +50,22 @@
"type": "path"
}
},
"lean4-mode": {
"flake": false,
"locked": {
"lastModified": 1659020985,
"narHash": "sha256-+dRaXB7uvN/weSZiKcfSKWhcdJVNg9Vg8k0pJkDNjpc=",
"owner": "leanprover",
"repo": "lean4-mode",
"rev": "37d5c99b7b29c80ab78321edd6773200deb0bca6",
"type": "github"
},
"original": {
"owner": "leanprover",
"repo": "lean4-mode",
"type": "github"
}
},
"leanInk": {
"flake": false,
"locked": {
@@ -69,6 +83,22 @@
"type": "github"
}
},
"lowdown-src": {
"flake": false,
"locked": {
"lastModified": 1633514407,
"narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
"owner": "kristapsdz",
"repo": "lowdown",
"rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
"type": "github"
},
"original": {
"owner": "kristapsdz",
"repo": "lowdown",
"type": "github"
}
},
"mdBook": {
"flake": false,
"locked": {
@@ -85,13 +115,65 @@
"type": "github"
}
},
"nix": {
"inputs": {
"lowdown-src": "lowdown-src",
"nixpkgs": "nixpkgs",
"nixpkgs-regression": "nixpkgs-regression"
},
"locked": {
"lastModified": 1657097207,
"narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
"owner": "NixOS",
"repo": "nix",
"rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nix",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1710889954,
"narHash": "sha256-Pr6F5Pmd7JnNEMHHmspZ0qVqIBVxyZ13ik1pJtm2QXk=",
"lastModified": 1653988320,
"narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "7872526e9c5332274ea5932a0c3270d6e4724f3b",
"rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-22.05-small",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-regression": {
"locked": {
"lastModified": 1643052045,
"narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1657208011,
"narHash": "sha256-BlIFwopAykvdy1DYayEkj6ZZdkn+cVgPNX98QVLc0jM=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "2770cc0b1e8faa0e20eb2c6aea64c256a706d4f2",
"type": "github"
},
"original": {
@@ -101,23 +183,6 @@
"type": "github"
}
},
"nixpkgs-old": {
"flake": false,
"locked": {
"lastModified": 1581379743,
"narHash": "sha256-i1XCn9rKuLjvCdu2UeXKzGLF6IuQePQKFt4hEKRU5oc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-19.03",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"alectryon": "alectryon",
@@ -129,21 +194,6 @@
"leanInk": "leanInk",
"mdBook": "mdBook"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",

View File

@@ -17,7 +17,7 @@
};
outputs = inputs@{ self, ... }: inputs.flake-utils.lib.eachDefaultSystem (system:
with inputs.lean.packages.${system}.deprecated; with nixpkgs;
with inputs.lean.packages.${system}; with nixpkgs;
let
doc-src = lib.sourceByRegex ../. ["doc.*" "tests(/lean(/beginEndAsMacro.lean)?)?"];
in {
@@ -27,7 +27,7 @@
src = inputs.mdBook;
cargoDeps = drv.cargoDeps.overrideAttrs (_: {
inherit src;
outputHash = "sha256-CO3A9Kpp4sIvkT9X3p+GTidazk7Fn4jf0AP2PINN44A=";
outputHash = "sha256-1YlPS6cqgxE4fjy9G8pWrpP27YrrbCDnfeyIsX81ZNw=";
});
doCheck = false;
});
@@ -44,6 +44,21 @@
mdbook build -d $out
'';
};
# We use a separate derivation instead of `checkPhase` so we can push it but not `doc` to the binary cache
test = stdenv.mkDerivation {
name ="lean-doc-test";
src = doc-src;
buildInputs = [ lean-mdbook stage1.Lean.lean-package strace ];
patchPhase = ''
cd doc
patchShebangs test
'';
buildPhase = ''
mdbook test
touch $out
'';
dontInstall = true;
};
leanInk = (buildLeanPackage {
name = "Main";
src = inputs.leanInk;

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 65 KiB

After

Width:  |  Height:  |  Size: 57 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 23 KiB

View File

@@ -13,7 +13,7 @@ Recall that nonnegative numerals are considered to be a `Nat` if there are no ty
The operator `/` for `Int` implements integer division.
```lean
#eval -10 / 4 -- -3
#eval -10 / 4 -- -2
```
Similar to `Nat`, the internal representation of `Int` is optimized. Small integers are

100
doc/latex/lean4.py Normal file
View File

@@ -0,0 +1,100 @@
# -*- coding: utf-8 -*-
"""
pygments.lexers.theorem
~~~~~~~~~~~~~~~~~~~~~~~
Lexers for theorem-proving languages.
:copyright: Copyright 2006-2017 by the Pygments team, see AUTHORS.
:license: BSD, see LICENSE for details.
"""
import re
from pygments.lexer import RegexLexer, default, words
from pygments.token import Text, Comment, Operator, Keyword, Name, String, \
Number, Punctuation, Generic
__all__ = ['Lean4Lexer']
class Lean4Lexer(RegexLexer):
"""
For the `Lean 4 <https://github.com/leanprover/lean4>`_
theorem prover.
.. versionadded:: 2.0
"""
name = 'Lean4'
aliases = ['lean4']
filenames = ['*.lean']
mimetypes = ['text/x-lean']
flags = re.MULTILINE | re.UNICODE
keywords1 = (
'import', 'abbreviation', 'opaque_hint', 'tactic_hint', 'definition',
'renaming', 'inline', 'hiding', 'parameter', 'lemma', 'variable',
'theorem', 'axiom', 'inductive', 'structure', 'universe', 'alias',
'help', 'options', 'precedence', 'postfix', 'prefix',
'infix', 'infixl', 'infixr', 'notation', '#eval',
'#check', '#reduce', '#exit', 'coercion', 'end', 'private', 'using', 'namespace',
'including', 'instance', 'section', 'context', 'protected', 'expose',
'export', 'set_option', 'extends', 'open', 'example',
'constant', 'constants', 'print', 'opaque', 'reducible', 'irreducible',
'def', 'macro', 'elab', 'syntax', 'macro_rules', 'reduce', 'where',
'abbrev', 'noncomputable', 'class', 'attribute', 'synth', 'mutual',
)
keywords2 = (
'forall', 'fun', 'Pi', 'obtain', 'from', 'have', 'show', 'assume',
'take', 'let', 'if', 'else', 'then', 'by', 'in', 'with', 'begin',
'proof', 'qed', 'calc', 'match', 'nomatch', 'do', 'at',
)
keywords3 = (
# Sorts
'Type', 'Prop', 'Sort',
)
operators = (
u'!=', u'#', u'&', u'&&', u'*', u'+', u'-', u'/', u'@', u'!', u'`',
u'-.', u'->', u'.', u'..', u'...', u'::', u':>', u';', u';;', u'<',
u'<-', u'=', u'==', u'>', u'_', u'|', u'||', u'~', u'=>', u'<=', u'>=',
u'/\\', u'\\/', u'', u'Π', u'λ', u'', u'', u'', u'', u'', u'',
u'¬', u'⁻¹', u'', u'', u'', u'', u'', u'', u'', u'×', u'',
u'', u'', u'', u'',
)
punctuation = (u'(', u')', u':', u'{', u'}', u'[', u']', u'', u'',
u':=', u',')
tokens = {
'root': [
(r'\s+', Text),
(r'/-', Comment, 'comment'),
(r'--.*?$', Comment.Single),
(words(keywords1, prefix=r'\b', suffix=r'\b'), Keyword.Namespace),
(words(keywords2, prefix=r'\b', suffix=r'\b'), Keyword),
(words(keywords3, prefix=r'\b', suffix=r'\b'), Keyword.Type),
(words(operators), Name.Builtin.Pseudo),
(words(punctuation), Operator),
(u"[A-Za-z_\u03b1-\u03ba\u03bc-\u03fb\u1f00-\u1ffe\u2100-\u214f]"
u"[A-Za-z_'\u03b1-\u03ba\u03bc-\u03fb\u1f00-\u1ffe\u2070-\u2079"
u"\u207f-\u2089\u2090-\u209c\u2100-\u214f0-9]*", Name),
(r'\d+', Number.Integer),
(r'"', String.Double, 'string'),
(r'[~?][a-z][\w\']*:', Name.Variable)
],
'comment': [
# Multiline Comments
(r'[^/-]', Comment.Multiline),
(r'/-', Comment.Multiline, '#push'),
(r'-/', Comment.Multiline, '#pop'),
(r'[/-]', Comment.Multiline)
],
'string': [
(r'[^\\"]+', String.Double),
(r'\\[n"\\]', String.Escape),
('"', String.Double, '#pop'),
],
}

View File

@@ -1,7 +1,3 @@
These are instructions to set up a working development environment for those who wish to make changes to Lean itself. It is part of the [Development Guide](doc/dev/index.md).
We strongly suggest that new users instead follow the [Quickstart](doc/quickstart.md) to get started using Lean, since this sets up an environment that can automatically manage multiple Lean toolchain versions, which is necessary when working within the Lean ecosystem.
Requirements
------------
@@ -16,32 +12,44 @@ Platform-Specific Setup
- [Windows (msys2)](msys2.md)
- [Windows (WSL)](wsl.md)
- [macOS (homebrew)](osx-10.9.md)
- Linux/macOS/WSL via [Nix](https://nixos.org/nix/): Call `nix develop` in the project root. That's it.
- Linux/macOS/WSL via [Nix](https://nixos.org/nix/): Call `nix-shell` in the project root. That's it.
Generic Build Instructions
--------------------------
Setting up a basic parallelized release build:
Setting up a basic release build:
```bash
git clone https://github.com/leanprover/lean4
git clone https://github.com/leanprover/lean4 --recurse-submodules
cd lean4
cmake --preset release
make -C build/release -j$(nproc) # see below for macOS
mkdir -p build/release
cd build/release
cmake ../..
make
```
You can replace `$(nproc)`, which is not available on macOS and some alternative shells, with the desired parallelism amount.
For regular development, we recommend running
```bash
git config submodule.recurse true
```
in the checkout so that `--recurse-submodules` doesn't have to be
specified with `git pull/checkout/...`.
The above commands will compile the Lean library and binaries into the
`stage1` subfolder; see below for details.
`stage1` subfolder; see below for details. Add `-j N` for an
appropriate `N` to `make` for a parallel build.
You should not usually run `cmake --install` after a successful build.
For example, on an AMD Ryzen 9 `make` takes 00:04:55, whereas `make -j 10`
takes 00:01:38. Your results may vary depending on the speed of your hard
drive.
You should not usually run `make install` after a successful build.
See [Dev setup using elan](../dev/index.md#dev-setup-using-elan) on how to properly set up your editor to use the correct stage depending on the source directory.
Useful CMake Configuration Settings
-----------------------------------
Pass these along with the `cmake --preset release` command.
There are also two alternative presets that combine some of these options you can use instead of `release`: `debug` and `sandebug` (sanitize + debug).
Pass these along with the `cmake ../..` command.
* `-D CMAKE_BUILD_TYPE=`\
Select the build type. Valid values are `RELEASE` (default), `DEBUG`,

39
doc/make/msvc.md Normal file
View File

@@ -0,0 +1,39 @@
# Compiling Lean with Visual Studio
WARNING: Compiling Lean with Visual Studio doesn't currently work.
There's an ongoing effort to port Lean to Visual Studio.
The instructions below are for VS 2017.
In the meantime you can use [MSYS2](msys2.md) or [WSL](wsl.md).
## Installing dependencies
First, install `vcpkg` from https://github.com/Microsoft/vcpkg if you haven't
done so already.
Then, open a console in the directory you cloned `vcpkg` to, and type:
`vcpkg install mpir` for the 32-bit library or
`vcpkg install mpir:x64-windows` for the x64 one.
In Visual Studio, use the "open folder" feature and open the Lean directory.
Go to the `CMake->Change CMake Settings` menu. File `CMakeSettings.json` opens.
In each of the targets, add the following snippet (i.e., after every
`ctestCommandArgs`):
```json
"variables": [
{
"name": "CMAKE_TOOLCHAIN_FILE",
"value": "C:\\path\\to\\vcpkg\\scripts\\buildsystems\\vcpkg.cmake"
}
]
```
## Enable Intellisense
In Visual Studio, press Ctrl+Q and type `CppProperties.json` and press Enter.
Ensure `includePath` variables include `"${workspaceRoot}\\src"`.
## Build Lean
Press F7.

View File

@@ -38,9 +38,10 @@ cmake --version
Then follow the [generic build instructions](index.md) in the MSYS2
MinGW shell, using:
```
cmake --preset release -DCMAKE_C_COMPILER=clang -DCMAKE_CXX_COMPILER=clang++
cmake ../.. -G "Unix Makefiles" -DCMAKE_C_COMPILER=clang -DCMAKE_CXX_COMPILER=clang++
```
instead of `cmake --preset release`. This will use the clang compiler instead of gcc, which is required with msys2.
instead of `cmake ../..`. This ensures that cmake will call `sh` instead of `cmd.exe`
for script tasks and it will use the clang compiler instead of gcc, which is required.
## Install lean

View File

@@ -1,4 +1,4 @@
# Install Packages on OS X 14.5
# Install Packages on OS X 10.9
We assume that you are using [homebrew][homebrew] as a package manager.
@@ -22,7 +22,7 @@ brew install gcc
```
To install clang++-3.5 via homebrew, please execute:
```bash
brew install llvm
brew install llvm --with-clang --with-asan
```
To use compilers other than the default one (Apple's clang++), you
need to use `-DCMAKE_CXX_COMPILER` option to specify the compiler

View File

@@ -33,7 +33,7 @@ convert the pure non-monadic value `x / y` into the required `Except` object. S
Now this return typing would get tedious if you had to include it everywhere that you call this
function, however, Lean type inference can clean this up. For example, you can define a test
function that calls the `divide` function and you don't need to say anything here about the fact that
function can calls the `divide` function and you don't need to say anything here about the fact that
it might throw an error, because that is inferred:
-/
def test := divide 5 0

View File

@@ -15,7 +15,7 @@ data type containing several important pieces of information. First and foremost
current player, and it has a random generator.
-/
open Batteries (HashMap)
open Std (HashMap)
abbrev TileIndex := Nat × Nat -- a 2D index
inductive TileState where

View File

@@ -7,17 +7,12 @@ See [Setup](./setup.md) for supported platforms and other ways to set up Lean 4.
1. Launch VS Code and install the `lean4` extension by clicking on the "Extensions" sidebar entry and searching for "lean4".
![installing the vscode-lean4 extension](images/code-ext.png)
![installing the vscode-lean4 extension](images/code-ext.png)
1. Open the Lean 4 setup guide by creating a new text file using "File > New Text File" (`Ctrl+N` / `Cmd+N`), clicking on the ∀-symbol in the top right and selecting "Documentation… > Docs: Show Setup Guide".
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".
![show setup guide](images/show-setup-guide.png)
![show setup guide](images/show-setup-guide.png)
1. Follow the Lean 4 setup guide. It will:
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.
- walk you through learning resources for Lean,
- teach you how to set up Lean's dependencies on your platform,
- install Lean 4 for you at the click of a button,
- help you set up your first project.
![setup guide](images/setup_guide.png)
![setup guide](images/setup_guide.png)

View File

@@ -6,7 +6,6 @@ Platforms built & tested by our CI, available as binary releases via elan (see b
* x86-64 Linux with glibc 2.27+
* x86-64 macOS 10.15+
* aarch64 (Apple Silicon) macOS 10.15+
* x86-64 Windows 10+
### Tier 2
@@ -17,6 +16,7 @@ Releases may be silently broken due to the lack of automated testing.
Issue reports and fixes are welcome.
* aarch64 Linux with glibc 2.27+
* aarch64 (Apple Silicon) macOS
* x86 (32-bit) Linux
* Emscripten Web Assembly

View File

@@ -43,8 +43,7 @@ $ pdflatex test.tex
## Example with `minted`
First [install Pygments](https://pygments.org/download/) (version 2.18 or newer).
Then save the following sample LaTeX file `test.tex` into the same directory:
First [install Pygments](https://pygments.org/download/). Then save [`lean4.py`](https://raw.githubusercontent.com/leanprover/lean4/master/doc/latex/lean4.py), which contains an version of the Lean highlighter updated for Lean 4, and the following sample LaTeX file `test.tex` into the same directory:
```latex
\documentclass{article}
@@ -52,8 +51,9 @@ Then save the following sample LaTeX file `test.tex` into the same directory:
% switch to a monospace font supporting more Unicode characters
\setmonofont{FreeMono}
\usepackage{minted}
\newmintinline[lean]{lean4}{bgcolor=white}
\newminted[leancode]{lean4}{fontsize=\footnotesize}
% instruct minted to use our local theorem.py
\newmintinline[lean]{lean4.py:Lean4Lexer -x}{bgcolor=white}
\newminted[leancode]{lean4.py:Lean4Lexer -x}{fontsize=\footnotesize}
\usemintedstyle{tango} % a nice, colorful theme
\begin{document}
@@ -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
@@ -78,14 +81,11 @@ Some remarks:
- either `xelatex` or `lualatex` is required to handle Unicode characters in the code.
- `--shell-escape` is needed to allow `xelatex` to execute `pygmentize` in a shell.
- If the chosen monospace font is missing some Unicode symbols, you can direct them to be displayed using a fallback font or other replacement LaTeX code.
``` latex
\usepackage{newunicodechar}
\newfontfamily{\freeserif}{DejaVu Sans}
\newunicodechar{✝}{\freeserif{✝}}
\newunicodechar{𝓞}{\ensuremath{\mathcal{O}}}
```
- If you are using an old version of Pygments, you can copy
[`lean.py`](https://raw.githubusercontent.com/pygments/pygments/master/pygments/lexers/lean.py) into your working directory,
and use `lean4.py:Lean4Lexer -x` instead of `lean4` above.
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.
``` latex
\usepackage{newunicodechar}
\newfontfamily{\freeserif}{DejaVu Sans}
\newunicodechar{✝}{\freeserif{✝}}
\newunicodechar{𝓞}{\ensuremath{\mathcal{O}}}
```
- minted has a "helpful" feature that draws red boxes around characters the chosen lexer doesn't recognize.
Since the Lean lexer cannot encompass all user-defined syntax, it is advisable to [work around](https://tex.stackexchange.com/a/343506/14563) this feature.

136
flake.lock generated
View File

@@ -1,15 +1,12 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1710146030,
"narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
"lastModified": 1656928814,
"narHash": "sha256-RIFfgBuKz6Hp89yRr7+NR5tzIAbn52h8vT6vXkYjZoM=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
"rev": "7e2a3b3dfd9af950a856d66b0a7d01e3c18aa249",
"type": "github"
},
"original": {
@@ -18,13 +15,97 @@
"type": "github"
}
},
"lean4-mode": {
"flake": false,
"locked": {
"lastModified": 1676498134,
"narHash": "sha256-u3WvyKxOViZG53hkb8wd2/Og6muTecbh+NdflIgVeyk=",
"owner": "leanprover",
"repo": "lean4-mode",
"rev": "2c6ef33f476fdf5eb5e4fa4fa023ba8b11372440",
"type": "github"
},
"original": {
"owner": "leanprover",
"repo": "lean4-mode",
"type": "github"
}
},
"lowdown-src": {
"flake": false,
"locked": {
"lastModified": 1633514407,
"narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
"owner": "kristapsdz",
"repo": "lowdown",
"rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
"type": "github"
},
"original": {
"owner": "kristapsdz",
"repo": "lowdown",
"type": "github"
}
},
"nix": {
"inputs": {
"lowdown-src": "lowdown-src",
"nixpkgs": "nixpkgs",
"nixpkgs-regression": "nixpkgs-regression"
},
"locked": {
"lastModified": 1657097207,
"narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
"owner": "NixOS",
"repo": "nix",
"rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nix",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1710889954,
"narHash": "sha256-Pr6F5Pmd7JnNEMHHmspZ0qVqIBVxyZ13ik1pJtm2QXk=",
"lastModified": 1653988320,
"narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "7872526e9c5332274ea5932a0c3270d6e4724f3b",
"rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-22.05-small",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-regression": {
"locked": {
"lastModified": 1643052045,
"narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1686089707,
"narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
"type": "github"
},
"original": {
@@ -34,43 +115,12 @@
"type": "github"
}
},
"nixpkgs-old": {
"flake": false,
"locked": {
"lastModified": 1581379743,
"narHash": "sha256-i1XCn9rKuLjvCdu2UeXKzGLF6IuQePQKFt4hEKRU5oc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-19.03",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs",
"nixpkgs-old": "nixpkgs-old"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
"lean4-mode": "lean4-mode",
"nix": "nix",
"nixpkgs": "nixpkgs_2"
}
}
},

View File

@@ -1,55 +1,63 @@
{
description = "Lean development flake. Not intended for end users.";
description = "Lean interactive theorem prover";
inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
# old nixpkgs used for portable release with older glibc (2.27)
inputs.nixpkgs-old.url = "github:NixOS/nixpkgs/nixos-19.03";
inputs.nixpkgs-old.flake = false;
inputs.flake-utils.url = "github:numtide/flake-utils";
inputs.nix.url = "github:NixOS/nix";
inputs.lean4-mode = {
url = "github:leanprover/lean4-mode";
flake = false;
};
# used *only* by `stage0-from-input` below
#inputs.lean-stage0 = {
# url = github:leanprover/lean4;
# inputs.nixpkgs.follows = "nixpkgs";
# inputs.flake-utils.follows = "flake-utils";
# inputs.nix.follows = "nix";
# inputs.lean4-mode.follows = "lean4-mode";
#};
outputs = { self, nixpkgs, nixpkgs-old, flake-utils, ... }@inputs: flake-utils.lib.eachDefaultSystem (system:
outputs = { self, nixpkgs, flake-utils, nix, lean4-mode, ... }@inputs: flake-utils.lib.eachDefaultSystem (system:
let
pkgs = import nixpkgs { inherit system; };
# An old nixpkgs for creating releases with an old glibc
pkgsDist-old = import nixpkgs-old { inherit system; };
# An old nixpkgs for creating releases with an old glibc
pkgsDist-old-aarch = import nixpkgs-old { localSystem.config = "aarch64-unknown-linux-gnu"; };
lean-packages = pkgs.callPackage (./nix/packages.nix) { src = ./.; };
devShellWithDist = pkgsDist: pkgs.mkShell.override {
stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
} ({
buildInputs = with pkgs; [
cmake gmp ccache
lean-packages.llvmPackages.llvm # llvm-symbolizer for asan/lsan
gdb
# TODO: only add when proven to not affect the flakification
#pkgs.python3
tree # for CI
];
# https://github.com/NixOS/nixpkgs/issues/60919
hardeningDisable = [ "all" ];
# more convenient `ctest` output
CTEST_OUTPUT_ON_FAILURE = 1;
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
GMP = pkgsDist.gmp.override { withStatic = true; };
GLIBC = pkgsDist.glibc;
GLIBC_DEV = pkgsDist.glibc.dev;
GCC_LIB = pkgsDist.gcc.cc.lib;
ZLIB = pkgsDist.zlib;
GDB = pkgsDist.gdb;
});
pkgs = import nixpkgs {
inherit system;
# for `vscode-with-extensions`
config.allowUnfree = true;
};
lean-packages = pkgs.callPackage (./nix/packages.nix) { src = ./.; inherit nix lean4-mode; };
in {
packages = {
# to be removed when Nix CI is not needed anymore
inherit (lean-packages) cacheRoots test update-stage0-commit ciShell;
deprecated = lean-packages;
packages = lean-packages // rec {
debug = lean-packages.override { debug = true; };
stage0debug = lean-packages.override { stage0debug = true; };
asan = lean-packages.override { extraCMakeFlags = [ "-DLEAN_EXTRA_CXX_FLAGS=-fsanitize=address" "-DLEANC_EXTRA_FLAGS=-fsanitize=address" "-DSMALL_ALLOCATOR=OFF" "-DSYMBOLIC=OFF" ]; };
asandebug = asan.override { debug = true; };
tsan = lean-packages.override {
extraCMakeFlags = [ "-DLEAN_EXTRA_CXX_FLAGS=-fsanitize=thread" "-DLEANC_EXTRA_FLAGS=-fsanitize=thread" "-DCOMPRESSED_OBJECT_HEADER=OFF" ];
stage0 = (lean-packages.override {
# Compressed headers currently trigger data race reports in tsan.
# Turn them off for stage 0 as well so stage 1 can read its own stdlib.
extraCMakeFlags = [ "-DCOMPRESSED_OBJECT_HEADER=OFF" ];
}).stage1;
};
tsandebug = tsan.override { debug = true; };
stage0-from-input = lean-packages.override {
stage0 = pkgs.writeShellScriptBin "lean" ''
exec ${inputs.lean-stage0.packages.${system}.lean}/bin/lean -Dinterpreter.prefer_native=false "$@"
'';
};
inherit self;
};
defaultPackage = lean-packages.lean-all;
inherit (lean-packages) devShell;
checks.lean = lean-packages.test;
}) // rec {
templates.pkg = {
path = ./nix/templates/pkg;
description = "A custom Lean package";
};
# The default development shell for working on lean itself
devShells.default = devShellWithDist pkgs;
devShells.oldGlibc = devShellWithDist pkgsDist-old;
devShells.oldGlibcAArch = devShellWithDist pkgsDist-old-aarch;
});
defaultTemplate = templates.pkg;
};
}

View File

@@ -2,7 +2,7 @@
stdenv, lib, cmake, gmp, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
... } @ args:
with builtins;
lib.warn "The Nix-based build is deprecated" rec {
rec {
inherit stdenv;
sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
buildCMake = args: stdenv.mkDerivation ({
@@ -65,7 +65,12 @@ lib.warn "The Nix-based build is deprecated" rec {
installPhase = ''
mkdir -p $out/bin $out/lib/lean
mv bin/lean $out/bin/
mv lib/lean/*.{so,dylib} $out/lib/lean
mv lib/lean/libleanshared.* $out/lib/lean
'' + lib.optionalString stdenv.isDarwin ''
for lib in $(otool -L $out/bin/lean | tail -n +2 | cut -d' ' -f1); do
if [[ "$lib" == *lean* ]]; then install_name_tool -change "$lib" "$out/lib/lean/$(basename $lib)" $out/bin/lean; fi
done
otool -L $out/bin/lean
'';
meta.mainProgram = "lean";
});
@@ -87,8 +92,7 @@ lib.warn "The Nix-based build is deprecated" rec {
leanFlags = [ "-DwarningAsError=true" ];
} // args);
Init' = build { name = "Init"; deps = []; };
Std' = build { name = "Std"; deps = [ Init' ]; };
Lean' = build { name = "Lean"; deps = [ Std' ]; };
Lean' = build { name = "Lean"; deps = [ Init' ]; };
attachSharedLib = sharedLib: pkg: pkg // {
inherit sharedLib;
mods = mapAttrs (_: m: m // { inherit sharedLib; propagatedLoadDynlibs = []; }) pkg.mods;
@@ -96,8 +100,7 @@ lib.warn "The Nix-based build is deprecated" rec {
in (all: all // all.lean) rec {
inherit (Lean) emacs-dev emacs-package vscode-dev vscode-package;
Init = attachSharedLib leanshared Init';
Std = attachSharedLib leanshared Std' // { allExternalDeps = [ Init ]; };
Lean = attachSharedLib leanshared Lean' // { allExternalDeps = [ Std ]; };
Lean = attachSharedLib leanshared Lean' // { allExternalDeps = [ Init ]; };
Lake = build {
name = "Lake";
src = src + "/src/lake";
@@ -111,42 +114,35 @@ lib.warn "The Nix-based build is deprecated" rec {
linkFlags = lib.optional stdenv.isLinux "-rdynamic";
src = src + "/src/lake";
};
stdlib = [ Init Std Lean Lake ];
stdlib = [ Init Lean Lake ];
modDepsFiles = symlinkJoin { name = "modDepsFiles"; paths = map (l: l.modDepsFile) (stdlib ++ [ Leanc ]); };
depRoots = symlinkJoin { name = "depRoots"; paths = map (l: l.depRoots) stdlib; };
iTree = symlinkJoin { name = "ileans"; paths = map (l: l.iTree) stdlib; };
Leanc = build { name = "Leanc"; src = lean-bin-tools-unwrapped.leanc_src; deps = stdlib; roots = [ "Leanc" ]; };
stdlibLinkFlags = "${lib.concatMapStringsSep " " (l: "-L${l.staticLib}") stdlib} -L${leancpp}/lib/lean";
libInit_shared = runCommand "libInit_shared" { buildInputs = [ stdenv.cc ]; libName = "libInit_shared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
mkdir $out
touch empty.c
${stdenv.cc}/bin/cc -shared -o $out/$libName empty.c
'';
stdlibLinkFlags = "-L${Init.staticLib} -L${Lean.staticLib} -L${Lake.staticLib} -L${leancpp}/lib/lean";
leanshared = runCommand "leanshared" { buildInputs = [ stdenv.cc ]; libName = "libleanshared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
mkdir $out
LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared ${lib.optionalString stdenv.isLinux "-Wl,-Bsymbolic"} \
${if stdenv.isDarwin
then "-Wl,-force_load,${Init.staticLib}/libInit.a -Wl,-force_load,${Std.staticLib}/libStd.a -Wl,-force_load,${Lean.staticLib}/libLean.a -Wl,-force_load,${leancpp}/lib/lean/libleancpp.a ${leancpp}/lib/libleanrt_initial-exec.a -lc++"
else "-Wl,--whole-archive -lInit -lStd -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++"} \
-lm ${stdlibLinkFlags} \
${if stdenv.isDarwin then "-Wl,-force_load,${Init.staticLib}/libInit.a -Wl,-force_load,${Lean.staticLib}/libLean.a -Wl,-force_load,${leancpp}/lib/lean/libleancpp.a ${leancpp}/lib/libleanrt_initial-exec.a -lc++"
else "-Wl,--whole-archive -lInit -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++"} -lm ${stdlibLinkFlags} \
$(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
-o $out/$libName
'';
mods = foldl' (mods: pkg: mods // pkg.mods) {} stdlib;
print-paths = Lean.makePrintPathsFor [] mods;
leanc = writeShellScriptBin "leanc" ''
LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${libInit_shared} -L${leanshared} "$@"
LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${leanshared} "$@"
'';
lean = runCommand "lean" { buildInputs = lib.optional stdenv.isDarwin darwin.cctools; } ''
mkdir -p $out/bin
${leanc}/bin/leanc ${leancpp}/lib/lean.cpp.o ${libInit_shared}/* ${leanshared}/* -o $out/bin/lean
${leanc}/bin/leanc ${leancpp}/lib/lean.cpp.o ${leanshared}/* -o $out/bin/lean
'';
# derivation following the directory layout of the "basic" setup, mostly useful for running tests
lean-all = stdenv.mkDerivation {
name = "lean-${desc}";
buildCommand = ''
mkdir -p $out/bin $out/lib/lean
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${libInit_shared}/* ${leanshared}/* $out/lib/lean/
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${leanshared}/* $out/lib/lean/
# put everything in a single final derivation so `IO.appDir` references work
cp ${lean}/bin/lean ${leanc}/bin/leanc ${Lake-Main.executable}/bin/lake $out/bin
# NOTE: `lndir` will not override existing `bin/leanc`
@@ -154,9 +150,11 @@ lib.warn "The Nix-based build is deprecated" rec {
'';
meta.mainProgram = "lean";
};
cacheRoots = linkFarmFromDrvs "cacheRoots" ([
cacheRoots = linkFarmFromDrvs "cacheRoots" [
stage0 lean leanc lean-all iTree modDepsFiles depRoots Leanc.src
] ++ map (lib: lib.oTree) stdlib);
# .o files are not a runtime dependency on macOS because of lack of thin archives
Lean.oTree Lake.oTree
];
test = buildCMake {
name = "lean-test-${desc}";
realSrc = lib.sourceByRegex src [ "src.*" "tests.*" ];
@@ -171,17 +169,16 @@ lib.warn "The Nix-based build is deprecated" rec {
ln -sf ${lean-all}/* .
'';
buildPhase = ''
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)' -j$NIX_BUILD_CORES
ctest --output-on-failure -E 'leancomptest_(doc_example|foreign)' -j$NIX_BUILD_CORES
'';
installPhase = ''
mkdir $out
mv test-results.xml $out
touch $out
'';
};
update-stage0 =
let cTree = symlinkJoin { name = "cs"; paths = map (lib: lib.cTree) stdlib; }; in
let cTree = symlinkJoin { name = "cs"; paths = [ Init.cTree Lean.cTree ]; }; in
writeShellScriptBin "update-stage0" ''
CSRCS=${cTree} CP_C_PARAMS="--dereference --no-preserve=all" ${src + "/script/lib/update-stage0"}
CSRCS=${cTree} CP_C_PARAMS="--dereference --no-preserve=all" ${src + "/script/update-stage0"}
'';
update-stage0-commit = writeShellScriptBin "update-stage0-commit" ''
set -euo pipefail

View File

@@ -1,16 +1,16 @@
{ lean, lean-leanDeps ? lean, lean-final ? lean, leanc,
stdenv, lib, coreutils, gnused, writeShellScriptBin, bash, substituteAll, symlinkJoin, linkFarmFromDrvs,
stdenv, lib, coreutils, gnused, writeShellScriptBin, bash, lean-emacs, lean-vscode, nix, substituteAll, symlinkJoin, linkFarmFromDrvs,
runCommand, darwin, mkShell, ... }:
let lean-final' = lean-final; in
lib.makeOverridable (
{ name, src, fullSrc ? src, srcPrefix ? "", srcPath ? "$PWD/${srcPrefix}",
# Lean dependencies. Each entry should be an output of buildLeanPackage.
deps ? [ lean.Init lean.Std lean.Lean ],
deps ? [ lean.Lean ],
# Static library dependencies. Each derivation `static` should contain a static library in the directory `${static}`.
staticLibDeps ? [],
# Whether to wrap static library inputs in a -Wl,--start-group [...] -Wl,--end-group to ensure dependencies are resolved.
groupStaticLibs ? false,
# Shared library dependencies included at interpretation with --load-dynlib and linked to. Each derivation `shared` should contain a
# Shared library dependencies included at interpretation with --load-dynlib and linked to. Each derivation `shared` should contain a
# shared library at the path `${shared}/${shared.libName or shared.name}` and a name to link to like `-l${shared.linkName or shared.name}`.
# These libs are also linked to in packages that depend on this one.
nativeSharedLibs ? [],
@@ -88,9 +88,9 @@ with builtins; let
allNativeSharedLibs =
lib.unique (lib.flatten (nativeSharedLibs ++ (map (dep: dep.allNativeSharedLibs or []) allExternalDeps)));
# A flattened list of all static library dependencies: this and every dep module's explicitly provided `staticLibDeps`,
# A flattened list of all static library dependencies: this and every dep module's explicitly provided `staticLibDeps`,
# plus every dep module itself: `dep.staticLib`
allStaticLibDeps =
allStaticLibDeps =
lib.unique (lib.flatten (staticLibDeps ++ (map (dep: [dep.staticLib] ++ dep.staticLibDeps or []) allExternalDeps)));
pathOfSharedLib = dep: dep.libPath or "${dep}/${dep.libName or dep.name}";
@@ -176,7 +176,7 @@ with builtins; let
# make local "copy" so `drv`'s Nix store path doesn't end up in ccache's hash
ln -s ${drv.c}/${drv.cPath} src.c
# on the other hand, a debug build is pretty fast anyway, so preserve the path for gdb
leanc -c -o $out/$oPath $leancFlags -fPIC ${if debug then "${drv.c}/${drv.cPath} -g" else "src.c -O3 -DNDEBUG -DLEAN_EXPORTING"}
leanc -c -o $out/$oPath $leancFlags -fPIC ${if debug then "${drv.c}/${drv.cPath} -g" else "src.c -O3 -DNDEBUG"}
'';
};
mkMod = mod: deps:
@@ -197,6 +197,19 @@ with builtins; let
then map (m: m.module) header.imports
else abort "errors while parsing imports of ${mod}:\n${lib.concatStringsSep "\n" header.errors}";
in mkMod mod (map (dep: if modDepsMap ? ${dep} then modCandidates.${dep} else externalModMap.${dep}) deps)) modDepsMap;
makeEmacsWrapper = name: emacs: lean: writeShellScriptBin name ''
${emacs} --eval "(progn (setq lean4-rootdir \"${lean}\"))" "$@"
'';
makeVSCodeWrapper = name: lean: writeShellScriptBin name ''
PATH=${lean}/bin:$PATH ${lean-vscode}/bin/code "$@"
'';
printPaths = deps: writeShellScriptBin "print-paths" ''
echo '${toJSON {
oleanPath = [(depRoot "print-paths" deps)];
srcPath = ["."] ++ map (dep: dep.src) allExternalDeps;
loadDynlibPaths = map pathOfSharedLib (loadDynlibsOfDeps deps);
}}'
'';
expandGlob = g:
if typeOf g == "string" then [g]
else if g.glob == "one" then [g.mod]
@@ -211,8 +224,7 @@ with builtins; let
allLinkFlags = lib.foldr (shared: acc: acc ++ [ "-L${shared}" "-l${shared.linkName or shared.name}" ]) linkFlags allNativeSharedLibs;
objects = mapAttrs (_: m: m.obj) mods';
bintools = if stdenv.isDarwin then darwin.cctools else stdenv.cc.bintools.bintools;
staticLib = runCommand "${name}-lib" { buildInputs = [ bintools ]; } ''
staticLib = runCommand "${name}-lib" { buildInputs = [ stdenv.cc.bintools.bintools ]; } ''
mkdir -p $out
ar Trcs $out/lib${libName}.a ${lib.concatStringsSep " " (map (drv: "${drv}/${drv.oPath}") (attrValues objects))};
'';
@@ -244,4 +256,48 @@ in rec {
-o $out/bin/${executableName} \
${lib.concatStringsSep " " allLinkFlags}
'') {};
lean-package = writeShellScriptBin "lean" ''
LEAN_PATH=${modRoot}:$LEAN_PATH LEAN_SRC_PATH=$LEAN_SRC_PATH:${src} exec ${lean-final}/bin/lean "$@"
'';
emacs-package = makeEmacsWrapper "emacs-package" lean-package;
vscode-package = makeVSCodeWrapper "vscode-package" lean-package;
link-ilean = writeShellScriptBin "link-ilean" ''
dest=''${1:-.}
mkdir -p $dest/build/lib
ln -sf ${iTree}/* $dest/build/lib
'';
makePrintPathsFor = deps: mods: printPaths deps // mapAttrs (_: mod: makePrintPathsFor (deps ++ [mod]) mods) mods;
print-paths = makePrintPathsFor [] (mods' // externalModMap);
# `lean` wrapper that dynamically runs Nix for the actual `lean` executable so the same editor can be
# used for multiple projects/after upgrading the `lean` input/for editing both stage 1 and the tests
lean-bin-dev = substituteAll {
name = "lean";
dir = "bin";
src = ./lean-dev.in;
isExecutable = true;
srcRoot = fullSrc; # use root flake.nix in case of Lean repo
inherit bash nix srcTarget srcArgs;
};
lake-dev = substituteAll {
name = "lake";
dir = "bin";
src = ./lake-dev.in;
isExecutable = true;
srcRoot = fullSrc; # use root flake.nix in case of Lean repo
inherit bash nix srcTarget srcArgs;
};
lean-dev = symlinkJoin { name = "lean-dev"; paths = [ lean-bin-dev lake-dev ]; };
emacs-dev = makeEmacsWrapper "emacs-dev" "${lean-emacs}/bin/emacs" lean-dev;
emacs-path-dev = makeEmacsWrapper "emacs-path-dev" "emacs" lean-dev;
vscode-dev = makeVSCodeWrapper "vscode-dev" lean-dev;
devShell = mkShell {
buildInputs = [ nix ];
shellHook = ''
export LEAN_SRC_PATH="${srcPath}"
'';
};
})

View File

@@ -1,6 +1,9 @@
{ src, pkgs, ... } @ args:
{ src, pkgs, nix, ... } @ args:
with pkgs;
let
nix-pinned = writeShellScriptBin "nix" ''
${nix.packages.${system}.default}/bin/nix --experimental-features 'nix-command flakes' --extra-substituters https://lean4.cachix.org/ --option warn-dirty false "$@"
'';
# https://github.com/NixOS/nixpkgs/issues/130963
llvmPackages = if stdenv.isDarwin then llvmPackages_11 else llvmPackages_15;
cc = (ccacheWrapper.override rec {
@@ -39,9 +42,40 @@ let
inherit (lean) stdenv;
lean = lean.stage1;
inherit (lean.stage1) leanc;
inherit lean-emacs lean-vscode;
nix = nix-pinned;
}));
lean4-mode = emacsPackages.melpaBuild {
pname = "lean4-mode";
version = "1";
commit = "1";
src = args.lean4-mode;
packageRequires = with pkgs.emacsPackages.melpaPackages; [ dash f flycheck magit-section lsp-mode s ];
recipe = pkgs.writeText "recipe" ''
(lean4-mode
:repo "leanprover/lean4-mode"
:fetcher github
:files ("*.el" "data"))
'';
};
lean-emacs = emacsWithPackages [ lean4-mode ];
# updating might be nicer by building from source from a flake input, but this is good enough for now
vscode-lean4 = vscode-utils.extensionFromVscodeMarketplace {
name = "lean4";
publisher = "leanprover";
version = "0.0.63";
sha256 = "sha256-kjEex7L0F2P4pMdXi4NIZ1y59ywJVubqDqsoYagZNkI=";
};
lean-vscode = vscode-with-extensions.override {
vscodeExtensions = [ vscode-lean4 ];
};
in {
inherit cc buildLeanPackage llvmPackages;
inherit cc lean4-mode buildLeanPackage llvmPackages vscode-lean4;
lean = lean.stage1;
stage0print-paths = lean.stage1.Lean.print-paths;
HEAD-as-stage0 = (lean.stage1.Lean.overrideArgs { srcTarget = "..#stage0-from-input.stage0"; srcArgs = "(--override-input lean-stage0 ..\?rev=$(git rev-parse HEAD) -- -Dinterpreter.prefer_native=false \"$@\")"; });
HEAD-as-stage1 = (lean.stage1.Lean.overrideArgs { srcTarget = "..\?rev=$(git rev-parse HEAD)#stage0"; });
nix = nix-pinned;
nixpkgs = pkgs;
ciShell = writeShellScriptBin "ciShell" ''
set -o pipefail
@@ -49,4 +83,5 @@ in {
# prefix lines with cumulative and individual execution time
"$@" |& ts -i "(%.S)]" | ts -s "[%M:%S"
'';
} // lean.stage1
vscode = lean-vscode;
} // lean.stage1.Lean // lean.stage1 // lean

View File

@@ -1,22 +0,0 @@
Draft release notes
-------------------
This folder contains drafts of release notes for inclusion in `RELEASES.md`.
During the process to create a release candidate, we look through all the commits that make up the release
to prepare the release notes, and in that process we take these drafts into account.
Guidelines:
- You should prefer adding release notes to commit messages over adding anything to this folder.
A release note should briefly explain the impact of a change from a user's point of view.
Please mark these parts out with words such as **release notes** and/or **breaking changes**.
- It is not necessary to add anything to this folder. It is meant for larger features that span multiple PRs,
or for anything that would be helpful when preparing the release notes that might be missed
by someone reading through the change log.
- If the PR that adds a feature simultaneously adds a draft release note, including the PR number is not required
since it can be obtained from the git history for the file.
When release notes are prepared, all the draft release notes are deleted from this folder.
For release candidates beyond the first one, you can either update `RELEASE.md` directly
or continue to add drafts.
When a release is finalized, we will copy the completed release notes from `RELEASE.md` to the `master` branch.

View File

@@ -1,65 +0,0 @@
* Structural recursion can now be explicitly requested using
```
termination_by structural x
```
in analogy to the existing `termination_by x` syntax that causes well-founded recursion to be used.
(#4542)
* The `termination_by?` syntax no longer forces the use of well-founded recursion, and when structural
recursion is inferred, will print the result using the `termination_by` syntax.
* Mutual structural recursion is supported now. This supports both mutual recursion over a non-mutual
data type, as well as recursion over mutual or nested data types:
```lean
mutual
def Even : Nat → Prop
| 0 => True
| n+1 => Odd n
def Odd : Nat → Prop
| 0 => False
| n+1 => Even n
end
mutual
inductive A
| other : B → A
| empty
inductive B
| other : A → B
| empty
end
mutual
def A.size : A → Nat
| .other b => b.size + 1
| .empty => 0
def B.size : B → Nat
| .other a => a.size + 1
| .empty => 0
end
inductive Tree where | node : List Tree → Tree
mutual
def Tree.size : Tree → Nat
| node ts => Tree.list_size ts
def Tree.list_size : List Tree → Nat
| [] => 0
| t::ts => Tree.size t + Tree.list_size ts
end
```
Functional induction principles are generated for these functions as well (`A.size.induct`, `A.size.mutual_induct`).
Nested structural recursion is still not supported.
PRs #4639, #4715, #4642, #4656, #4684, #4715, #4728, #4575, #4731, #4658, #4734, #4738, #4718,
#4733, #4787, #4788, #4789, #4807, #4772
* A bugfix in the structural recursion code may in some cases break existing code, when a parameter
of the type of the recursive argument is bound behind indices of that type. This can usually be
fixed by reordering the parameters of the function (PR #4672)

View File

@@ -1,28 +0,0 @@
import Lean.Util.Profiler
/-!
Usage:
```sh
lean --run ./script/collideProfiles.lean **/*.lean.json ... > merged.json
```
Merges multiple `trace.profiler.output` profiles into a single one while deduplicating samples with
the same stack. This is useful for building cumulative profiles of medium-to-large projects because
Firefox Profiler cannot handle hundreds of tracks and the deduplication will also ensure that the
profile is small enough for uploading.
As ordering of samples is not meaningful after this transformation, only "Call Tree" and "Flame
Graph" are useful for such profiles.
-/
open Lean
def main (args : List String) : IO Unit := do
let profiles args.toArray.mapM fun path => do
let json IO.FS.readFile path
let profile IO.ofExcept $ Json.parse json
IO.ofExcept <| fromJson? profile
-- NOTE: `collide` should not be interpreted
let profile := Firefox.Profile.collide profiles
IO.println <| Json.compress <| toJson profile

View File

@@ -1,39 +0,0 @@
#!/bin/bash
# https://chat.openai.com/share/7469c7c3-aceb-4d80-aee5-62982e1f1538
# Output CSV Header
echo '"Issue URL","Title","Days Since Creation","Days Since Last Update","Total Reactions","Assignee","Labels"'
# Get the current date in YYYY-MM-DD format
today=$(date +%Y-%m-%d)
# Fetch only open issues (excluding PRs and closed issues) from the repository 'leanprover/lean4'
issues=$(gh api repos/leanprover/lean4/issues --paginate --jq '.[] | select(.pull_request == null and .state == "open") | {url: .html_url, title: .title, created_at: (.created_at | split("T")[0]), updated_at: (.updated_at | split("T")[0]), number: .number, assignee: (.assignee.login // ""), labels: [.labels[].name] | join(",")}')
# Process each JSON object
echo "$issues" | while IFS= read -r issue; do
# Extract fields from JSON
url=$(echo "$issue" | jq -r '.url')
title=$(echo "$issue" | jq -r '.title')
created_at=$(echo "$issue" | jq -r '.created_at')
updated_at=$(echo "$issue" | jq -r '.updated_at')
issue_number=$(echo "$issue" | jq -r '.number')
assignee=$(echo "$issue" | jq -r '.assignee')
labels=$(echo "$issue" | jq -r '.labels')
# Calculate days since creation and update using macOS compatible date calculation
days_since_created=$(( ($(date -jf "%Y-%m-%d" "$today" +%s) - $(date -jf "%Y-%m-%d" "$created_at" +%s)) / 86400 ))
days_since_updated=$(( ($(date -jf "%Y-%m-%d" "$today" +%s) - $(date -jf "%Y-%m-%d" "$updated_at" +%s)) / 86400 ))
# Fetch the total number of reactions for each issue
reaction_data=$(gh api repos/leanprover/lean4/issues/$issue_number/reactions --paginate --jq 'length' 2>&1)
if [[ $reaction_data == *"Not Found"* ]]; then
total_reactions="Error fetching reactions"
else
total_reactions=$reaction_data
fi
# Format output as CSV by escaping quotes and delimiting with commas
echo "\"$url\",\"${title//\"/\"\"}\",\"$days_since_created\",\"$days_since_updated\",\"$total_reactions\",\"$assignee\",\"$labels\""
done

View File

@@ -1,2 +0,0 @@
This directory contains various scripts that are *not* meant to be called
directly, but through other scripts or makefiles.

View File

@@ -1,19 +0,0 @@
#!/usr/bin/env bash
# Script internal to `./script/rebase-stage0.sh`
# Determine OS type for sed in-place editing
SED_CMD=("sed" "-i")
if [[ "$OSTYPE" == "darwin"* ]]
then
# macOS requires an empty string argument with -i for in-place editing
SED_CMD=("sed" "-i" "")
fi
if [ "$STAGE0_WITH_NIX" = true ]
then
"${SED_CMD[@]}" '/chore: update stage0/ s,.*,x nix run .#update-stage0-commit,' "$1"
else
"${SED_CMD[@]}" '/chore: update stage0/ s,.*,x make -j32 -C build/release update-stage0 \&\& git commit -m "chore: update stage0",' "$1"
fi

View File

@@ -1,33 +0,0 @@
#!/usr/bin/env bash
set -euo pipefail
rm -r stage0 || true
# don't copy untracked files
# `:!` is git glob flavor for exclude patterns
for f in $(git ls-files src ':!:src/lake/*' ':!:src/Leanc.lean'); do
if [[ $f == *.lean ]]; then
f=${f#src/}
f=${f%.lean}.c
mkdir -p $(dirname stage0/stdlib/$f)
cp ${CP_C_PARAMS:-} $CSRCS/$f stage0/stdlib/$f
else
mkdir -p $(dirname stage0/$f)
cp $f stage0/$f
fi
done
# special handling for Lake files due to its nested directory
# copy the README to ensure the `stage0/src/lake` directory is comitted
for f in $(git ls-files 'src/lake/Lake/*' src/lake/Lake.lean src/lake/README.md ':!:src/lakefile.toml'); do
if [[ $f == *.lean ]]; then
f=${f#src/lake}
f=${f%.lean}.c
mkdir -p $(dirname stage0/stdlib/$f)
cp ${CP_C_PARAMS:-} $CSRCS/$f stage0/stdlib/$f
else
mkdir -p $(dirname stage0/$f)
cp $f stage0/$f
fi
done
git add stage0

View File

@@ -25,8 +25,6 @@ cp -L llvm/bin/llvm-ar stage1/bin/
# dependencies of the above
$CP llvm/lib/lib{clang-cpp,LLVM}*.so* stage1/lib/
$CP $ZLIB/lib/libz.so* stage1/lib/
# general clang++ dependency, breaks cross-library C++ exceptions if linked statically
$CP $GCC_LIB/lib/libgcc_s.so* stage1/lib/
# bundle libatomic (referenced by LLVM >= 15, and required by the lean executable to run)
$CP $GCC_LIB/lib/libatomic.so* stage1/lib/
@@ -62,7 +60,7 @@ fi
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
# but do not change sysroot so users can still link against system libs
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -static-libgcc -Wl,-Bstatic -lgmp -lunwind -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -Wl,--no-as-needed'"
# do not set `LEAN_CC` for tests

View File

@@ -1,24 +0,0 @@
#!/usr/bin/env bash
# This script rebases onto the given branch/commit, and updates
# all `chore: update stage0` commits along the way.
# Whether to use nix or make to update stage0
if [ "$1" = "-nix" ]
then
export STAGE0_WITH_NIX=true
shift
fi
# Check if an argument is provided
if [ "$#" -eq 0 ]; then
echo "Usage: $0 [-nix] <options to git rebase -i>"
exit 1
fi
REPO_ROOT=$(git rev-parse --show-toplevel)
# Run git rebase in interactive mode, but automatically edit the todo list
# using the defined GIT_SEQUENCE_EDITOR command
GIT_SEQUENCE_EDITOR="$REPO_ROOT/script/lib/rebase-editor.sh" git rebase -i "$@"

18
script/update-stage0 Executable file
View File

@@ -0,0 +1,18 @@
#!/usr/bin/env bash
set -euo pipefail
rm -r stage0 || true
# don't copy untracked files
# `:!` is git glob flavor for exclude patterns
for f in $(git ls-files src ':!:src/lake/*' ':!:src/Leanc.lean'); do
if [[ $f == *.lean ]]; then
f=${f#src/}
f=${f%.lean}.c
mkdir -p $(dirname stage0/stdlib/$f)
cp ${CP_C_PARAMS:-} $CSRCS/$f stage0/stdlib/$f
else
mkdir -p $(dirname stage0/$f)
cp $f stage0/$f
fi
done
git add stage0

27
shell.nix Normal file
View File

@@ -0,0 +1,27 @@
let
flake = (import ./default.nix);
flakePkgs = flake.packages.${builtins.currentSystem};
in { pkgs ? flakePkgs.nixpkgs, pkgsDist ? pkgs }:
# use `shell` as default
(attribs: attribs.shell // attribs) rec {
shell = pkgs.mkShell.override {
stdenv = pkgs.overrideCC pkgs.stdenv flakePkgs.llvmPackages.clang;
} (rec {
buildInputs = with pkgs; [
cmake gmp ccache
flakePkgs.llvmPackages.llvm # llvm-symbolizer for asan/lsan
];
# https://github.com/NixOS/nixpkgs/issues/60919
hardeningDisable = [ "all" ];
# more convenient `ctest` output
CTEST_OUTPUT_ON_FAILURE = 1;
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
GMP = pkgsDist.gmp.override { withStatic = true; };
GLIBC = pkgsDist.glibc;
GLIBC_DEV = pkgsDist.glibc.dev;
GCC_LIB = pkgsDist.gcc.cc.lib;
ZLIB = pkgsDist.zlib;
GDB = pkgsDist.gdb;
});
nix = flake.devShell.${builtins.currentSystem};
}

View File

@@ -1,6 +1,5 @@
cmake_minimum_required(VERSION 3.10)
cmake_policy(SET CMP0054 NEW)
cmake_policy(SET CMP0110 NEW)
if(NOT (${CMAKE_GENERATOR} MATCHES "Unix Makefiles"))
message(FATAL_ERROR "The only supported CMake generator at the moment is 'Unix Makefiles'")
endif()
@@ -10,7 +9,7 @@ endif()
include(ExternalProject)
project(LEAN CXX C)
set(LEAN_VERSION_MAJOR 4)
set(LEAN_VERSION_MINOR 11)
set(LEAN_VERSION_MINOR 7)
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'")
@@ -74,7 +73,6 @@ option(USE_GMP "USE_GMP" ON)
# development-specific options
option(CHECK_OLEAN_VERSION "Only load .olean files compiled with the current version of Lean" OFF)
option(USE_LAKE "Use Lake instead of lean.mk for building core libs from language server" 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`")
@@ -301,12 +299,13 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
cmake_path(GET ZLIB_LIBRARY PARENT_PATH ZLIB_LIBRARY_PARENT_PATH)
string(APPEND LEANSHARED_LINKER_FLAGS " -L ${ZLIB_LIBRARY_PARENT_PATH}")
endif()
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lleanrt")
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lleanrt")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lStd -lLean -lnodefs.js -lleanrt")
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lnodefs.js -lleanrt")
else()
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -lStd -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
string(APPEND LEANC_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
endif()
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lLake")
set(LEAN_CXX_STDLIB "-lstdc++" CACHE STRING "C++ stdlib linker flags")
@@ -314,17 +313,8 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
set(LEAN_CXX_STDLIB "-lc++")
endif()
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
# in local builds, link executables and not just dynlibs against C++ stdlib as well,
# which is required for e.g. asan
if(NOT LEAN_STANDALONE)
string(APPEND CMAKE_EXE_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
endif()
# flags for user binaries = flags for toolchain binaries + Lake
string(APPEND LEANC_STATIC_LINKER_FLAGS " ${TOOLCHAIN_STATIC_LINKER_FLAGS} -lLake")
string(APPEND LEANC_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
string(APPEND LEANSHARED_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
if (LLVM)
string(APPEND LEANSHARED_LINKER_FLAGS " -L${LLVM_CONFIG_LIBDIR} ${LLVM_CONFIG_LDFLAGS} ${LLVM_CONFIG_LIBS} ${LLVM_CONFIG_SYSTEM_LIBS}")
@@ -352,9 +342,9 @@ endif()
# get rid of unused parts of C++ stdlib
if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-dead_strip")
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-dead_strip")
elseif(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,--gc-sections")
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,--gc-sections")
endif()
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
@@ -364,20 +354,26 @@ endif()
if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
if(BSYMBOLIC)
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
endif()
string(APPEND CMAKE_CXX_FLAGS " -fPIC -ftls-model=initial-exec")
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-rpath=\\$$ORIGIN/..:\\$$ORIGIN")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath=\\\$ORIGIN/../lib:\\\$ORIGIN/../lib/lean")
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-rpath=\\$$ORIGIN/..:\\$$ORIGIN")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared -Wl,-rpath=\\\$ORIGIN/../lib:\\\$ORIGIN/../lib/lean")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
string(APPEND CMAKE_CXX_FLAGS " -ftls-model=initial-exec")
string(APPEND INIT_SHARED_LINKER_FLAGS " -install_name @rpath/libInit_shared.dylib")
string(APPEND LEANSHARED_LINKER_FLAGS " -install_name @rpath/libleanshared.dylib")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
string(APPEND CMAKE_CXX_FLAGS " -fPIC")
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
# We do not use dynamic linking via leanshared for Emscripten to keep things
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,--whole-archive -lInit -lLean -lleancpp -lleanrt ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared")
endif()
if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
@@ -403,7 +399,7 @@ endif()
# are already loaded) and probably fail unless we set up LD_LIBRARY_PATH.
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
# import library created by the `leanshared` target
string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared")
string(APPEND LEANC_SHARED_LINKER_FLAGS " -lleanshared")
elseif("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin")
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup")
endif()
@@ -509,25 +505,13 @@ string(REGEX REPLACE "^([a-zA-Z]):" "/\\1" LEAN_BIN "${CMAKE_BINARY_DIR}/bin")
# (also looks nicer in the build log)
file(RELATIVE_PATH LIB ${LEAN_SOURCE_DIR} ${CMAKE_BINARY_DIR}/lib)
# set up libInit_shared only on Windows; see also stdlib.make.in
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
set(INIT_SHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libInit.a.export ${CMAKE_BINARY_DIR}/lib/temp/libStd.a.export ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a -Wl,--no-whole-archive -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libInit_shared.dll.a")
endif()
if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
set(LEANSHARED_LINKER_FLAGS "-Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libInit.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libStd.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libLean.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libleancpp.a ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libLean.a.export -lleancpp -Wl,--no-whole-archive -lInit_shared -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
set(LEANSHARED_LINKER_FLAGS "-Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libInit.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libLean.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libleancpp.a ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
else()
set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit -lStd -lLean -lleancpp -Wl,--no-whole-archive ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
endif()
if (${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# We do not use dynamic linking via leanshared for Emscripten to keep things
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
string(APPEND LEAN_EXE_LINKER_FLAGS " ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit -lLean -lleancpp -Wl,--no-whole-archive ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
endif()
endif()
# Build the compiler using the bootstrapped C sources for stage0, and use
@@ -536,12 +520,16 @@ if (LLVM AND ${STAGE} GREATER 0)
set(EXTRA_LEANMAKE_OPTS "LLVM=1")
endif()
# Escape for `make`. Yes, twice.
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE "${CMAKE_EXE_LINKER_FLAGS}")
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE_MAKE "${CMAKE_EXE_LINKER_FLAGS_MAKE}")
configure_file(${LEAN_SOURCE_DIR}/stdlib.make.in ${CMAKE_BINARY_DIR}/stdlib.make)
add_custom_target(make_stdlib ALL
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
# The actual rule is in a separate makefile because we want to prefix it with '+' to use the Make job server
# for a parallelized nested build, but CMake doesn't let us do that.
# We use `lean` from the previous stage, but `leanc`, headers, etc. from the current stage
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Init Std Lean
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Init Lean
VERBATIM)
# if we have LLVM enabled, then build `lean.h.bc` which has the LLVM bitcode
@@ -553,33 +541,17 @@ endif()
# We declare these as separate custom targets so they use separate `make` invocations, which makes `make` recompute which dependencies
# (e.g. `libLean.a`) are now newer than the target file
if(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# dummy targets, see `MAIN_MODULE` discussion above
add_custom_target(Init_shared ALL
DEPENDS make_stdlib leanrt_initial-exec
COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libInit_shared${CMAKE_SHARED_LIBRARY_SUFFIX}
)
add_custom_target(leanshared ALL
DEPENDS Init_shared leancpp
COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libleanshared${CMAKE_SHARED_LIBRARY_SUFFIX}
)
else()
add_custom_target(Init_shared ALL
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS make_stdlib leanrt_initial-exec
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Init_shared
VERBATIM)
add_custom_target(leanshared ALL
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS make_stdlib leancpp leanrt_initial-exec
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanshared
VERBATIM)
add_custom_target(leanshared ALL
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS Init_shared leancpp
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanshared
VERBATIM)
if(${STAGE} GREATER 0)
if(NOT EXISTS ${LEAN_SOURCE_DIR}/lake/Lake.lean)
message(FATAL_ERROR "src/lake does not exist. Please check out the Lake submodule using `git submodule update --init src/lake`.")
endif()
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lInit_shared -lleanshared")
endif()
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
add_custom_target(lake ALL
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS leanshared
@@ -589,18 +561,14 @@ endif()
if(PREV_STAGE)
add_custom_target(update-stage0
COMMAND bash -c 'CSRCS=${CMAKE_BINARY_DIR}/lib/temp script/lib/update-stage0'
COMMAND bash -c 'CSRCS=${CMAKE_BINARY_DIR}/lib/temp script/update-stage0'
DEPENDS make_stdlib
WORKING_DIRECTORY "${LEAN_SOURCE_DIR}/..")
add_custom_target(update-stage0-commit
COMMAND git commit -m "chore: update stage0"
DEPENDS update-stage0)
endif()
# use Bash version for building, use Lean version in bin/ for tests & distribution
configure_file("${LEAN_SOURCE_DIR}/bin/leanc.in" "${CMAKE_BINARY_DIR}/leanc.sh" @ONLY)
if(${STAGE} GREATER 0 AND EXISTS ${LEAN_SOURCE_DIR}/Leanc.lean AND NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
if(${STAGE} GREATER 0 AND EXISTS ${LEAN_SOURCE_DIR}/Leanc.lean)
configure_file("${LEAN_SOURCE_DIR}/Leanc.lean" "${CMAKE_BINARY_DIR}/leanc/Leanc.lean" @ONLY)
add_custom_target(leanc ALL
WORKING_DIRECTORY ${CMAKE_BINARY_DIR}/leanc
@@ -651,14 +619,3 @@ if(LEAN_INSTALL_PREFIX)
set(LEAN_INSTALL_SUFFIX "-${LOWER_SYSTEM_NAME}" CACHE STRING "If LEAN_INSTALL_PREFIX is set, append this value to CMAKE_INSTALL_PREFIX")
set(CMAKE_INSTALL_PREFIX "${LEAN_INSTALL_PREFIX}/lean-${LEAN_VERSION_STRING}${LEAN_INSTALL_SUFFIX}")
endif()
# Escape for `make`. Yes, twice.
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE "${CMAKE_EXE_LINKER_FLAGS}")
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE_MAKE "${CMAKE_EXE_LINKER_FLAGS_MAKE}")
configure_file(${LEAN_SOURCE_DIR}/stdlib.make.in ${CMAKE_BINARY_DIR}/stdlib.make)
if(USE_LAKE AND STAGE EQUAL 1)
configure_file(${LEAN_SOURCE_DIR}/lakefile.toml.in ${LEAN_SOURCE_DIR}/lakefile.toml)
configure_file(${LEAN_SOURCE_DIR}/lakefile.toml.in ${LEAN_SOURCE_DIR}/../tests/lakefile.toml)
configure_file(${LEAN_SOURCE_DIR}/lakefile.toml.in ${LEAN_SOURCE_DIR}/../lakefile.toml)
endif()

View File

@@ -33,5 +33,3 @@ import Init.SizeOfLemmas
import Init.BinderPredicates
import Init.Ext
import Init.Omega
import Init.MacroTrace
import Init.Grind

View File

@@ -1,5 +1,5 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
@@ -21,9 +21,9 @@ macro_rules
/-! ## if-then-else -/
@[simp] theorem if_true {_ : Decidable True} (t e : α) : ite True t e = t := if_pos trivial
@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial
@[simp] theorem if_false {_ : Decidable False} (t e : α) : ite False t e = e := if_neg id
@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id
theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl
@@ -37,6 +37,15 @@ theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) :
f (ite P x y) = ite P (f x) (f y) :=
apply_dite f P (fun _ => x) (fun _ => y)
/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/
@[simp] theorem dite_not (P : Prop) {_ : Decidable P} (x : ¬P α) (y : ¬¬P α) :
dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by
by_cases h : P <;> simp [h]
/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/
@[simp] theorem ite_not (P : Prop) {_ : Decidable P} (x y : α) : ite (¬P) x y = ite P y x :=
dite_not P (fun _ => x) (fun _ => y)
@[simp] theorem dite_eq_left_iff {P : Prop} [Decidable P] {B : ¬ P α} :
dite P (fun _ => a) B = a h, B h = a := by
by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
@@ -63,12 +72,3 @@ theorem ite_some_none_eq_none [Decidable P] :
@[simp] theorem ite_some_none_eq_some [Decidable P] :
(if P then some x else none) = some y P x = y := by
split <;> simp_all
-- This is not marked as `simp` as it is already handled by `dite_eq_right_iff`.
theorem dite_some_none_eq_none [Decidable P] {x : P α} :
(if h : P then some (x h) else none) = none ¬P := by
simp
@[simp] theorem dite_some_none_eq_some [Decidable P] {x : P α} {y : α} :
(if h : P then some (x h) else none) = some y h : P, x h = y := by
by_cases h : P <;> simp [h]

View File

@@ -15,13 +15,6 @@ namespace Classical
noncomputable def indefiniteDescription {α : Sort u} (p : α Prop) (h : x, p x) : {x // p x} :=
choice <| let x, px := h; x, px
/--
Given that there exists an element satisfying `p`, returns one such element.
This is a straightforward consequence of, and equivalent to, `Classical.choice`.
See also `choose_spec`, which asserts that the returned value has property `p`.
-/
noncomputable def choose {α : Sort u} {p : α Prop} (h : x, p x) : α :=
(indefiniteDescription p h).val
@@ -132,15 +125,16 @@ theorem byContradiction {p : Prop} (h : ¬p → False) : p :=
/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`.
The left-to-right direction, double negation elimination (DNE),
is classically true but not constructively. -/
@[simp] theorem not_not : ¬¬a a := Decidable.not_not
@[scoped simp] theorem not_not : ¬¬a a := Decidable.not_not
@[simp low] theorem not_forall {p : α Prop} : (¬ x, p x) x, ¬p x := Decidable.not_forall
@[simp] theorem not_forall {p : α Prop} : (¬ x, p x) x, ¬p x := Decidable.not_forall
theorem not_forall_not {p : α Prop} : (¬ x, ¬p x) x, p x := Decidable.not_forall_not
theorem not_exists_not {p : α Prop} : (¬ x, ¬p x) x, p x := Decidable.not_exists_not
theorem forall_or_exists_not (P : α Prop) : ( a, P a) a, ¬ P a := by
rw [ not_forall]; exact em _
theorem exists_or_forall_not (P : α Prop) : ( a, P a) a, ¬ P a := by
rw [ not_exists]; exact em _
@@ -153,22 +147,8 @@ theorem not_and_iff_or_not_not : ¬(a ∧ b) ↔ ¬a ¬b := Decidable.not_an
theorem not_iff : ¬(a b) (¬a b) := Decidable.not_iff
@[simp] theorem imp_iff_left_iff : (b a b) a b := Decidable.imp_iff_left_iff
@[simp] theorem imp_iff_right_iff : (a b b) a b := Decidable.imp_iff_right_iff
@[simp] theorem and_or_imp : a b (a c) a b c := Decidable.and_or_imp
@[simp] theorem not_imp : ¬(a b) a ¬b := Decidable.not_imp_iff_and_not
@[simp] theorem imp_and_neg_imp_iff (p q : Prop) : (p q) (¬p q) q :=
Iff.intro (fun (a : _ _) => (Classical.em p).rec a.left a.right)
(fun a => And.intro (fun _ => a) (fun _ => a))
end Classical
/- Export for Mathlib compat. -/
export Classical (imp_iff_right_iff imp_and_neg_imp_iff and_or_imp not_imp)
/-- Extract an element from a existential statement, using `Classical.choose`. -/
-- This enables projection notation.
@[reducible] noncomputable def Exists.choose {p : α Prop} (P : a, p a) : α := Classical.choose P

View File

@@ -321,7 +321,7 @@ Helper definition used by the elaborator. It is not meant to be used directly by
This is used for coercions between monads, in the case where we want to apply
a monad lift and a coercion on the result type at the same time.
-/
@[coe_decl] abbrev Lean.Internal.liftCoeM {m : Type u Type v} {n : Type u Type w} {α β : Type u}
@[inline, coe_decl] def Lean.Internal.liftCoeM {m : Type u Type v} {n : Type u Type w} {α β : Type u}
[MonadLiftT m n] [ a, CoeT α a β] [Monad n] (x : m α) : n β := do
let a liftM x
pure (CoeT.coe a)
@@ -331,7 +331,7 @@ Helper definition used by the elaborator. It is not meant to be used directly by
This is used for coercing the result type under a monad.
-/
@[coe_decl] abbrev Lean.Internal.coeM {m : Type u Type v} {α β : Type u}
@[inline, coe_decl] def Lean.Internal.coeM {m : Type u Type v} {α β : Type u}
[ a, CoeT α a β] [Monad m] (x : m α) : m β := do
let a x
pure (CoeT.coe a)

View File

@@ -20,29 +20,8 @@ def Functor.discard {f : Type u → Type v} {α : Type u} [Functor f] (x : f α)
export Functor (discard)
/--
An `Alternative` functor is an `Applicative` functor that can "fail" or be "empty"
and a binary operation `<|>` that “collects values” or finds the “left-most success”.
Important instances include
* `Option`, where `failure := none` and `<|>` returns the left-most `some`.
* Parser combinators typically provide an `Applicative` instance for error-handling and
backtracking.
Error recovery and state can interact subtly. For example, the implementation of `Alternative` for `OptionT (StateT σ Id)` keeps modifications made to the state while recovering from failure, while `StateT σ (OptionT Id)` discards them.
-/
-- NB: List instance is in mathlib. Once upstreamed, add
-- * `List`, where `failure` is the empty list and `<|>` concatenates.
class Alternative (f : Type u Type v) extends Applicative f : Type (max (u+1) v) where
/--
Produces an empty collection or recoverable failure. The `<|>` operator collects values or recovers
from failures. See `Alternative` for more details.
-/
failure : {α : Type u} f α
/--
Depending on the `Alternative` instance, collects values or recovers from `failure`s by
returning the leftmost success. Can be written using the `<|>` operator syntax.
-/
orElse : {α : Type u} f α (Unit f α) f α
instance (f : Type u Type v) (α : Type u) [Alternative f] : OrElse (f α) := Alternative.orElse
@@ -51,15 +30,9 @@ variable {f : Type u → Type v} [Alternative f] {α : Type u}
export Alternative (failure)
/--
If the proposition `p` is true, does nothing, else fails (using `failure`).
-/
@[always_inline, inline] def guard {f : Type Type v} [Alternative f] (p : Prop) [Decidable p] : f Unit :=
if p then pure () else failure
/--
Returns `some x` if `f` succeeds with value `x`, else returns `none`.
-/
@[always_inline, inline] def optional (x : f α) : f (Option α) :=
some <$> x <|> pure none

View File

@@ -131,7 +131,7 @@ protected def adapt {ε' α : Type u} (f : ε → ε') : ExceptT ε m α → Exc
end ExceptT
@[always_inline]
instance (m : Type u Type v) (ε₁ : Type u) (ε₂ : Type u) [MonadExceptOf ε₁ m] : MonadExceptOf ε₁ (ExceptT ε₂ m) where
instance (m : Type u Type v) (ε₁ : Type u) (ε₂ : Type u) [Monad m] [MonadExceptOf ε₁ m] : MonadExceptOf ε₁ (ExceptT ε₂ m) where
throw e := ExceptT.mk <| throwThe ε₁ e
tryCatch x handle := ExceptT.mk <| tryCatchThe ε₁ x handle

View File

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Control.Lawful.Basic
import Init.Control.Lawful
/-!
The Exception monad transformer using CPS style.
@@ -18,7 +18,6 @@ namespace ExceptCpsT
def run {ε α : Type u} [Monad m] (x : ExceptCpsT ε m α) : m (Except ε α) :=
x _ (fun a => pure (Except.ok a)) (fun e => pure (Except.error e))
set_option linter.unusedVariables false in -- `s` unused
@[always_inline, inline]
def runK {ε α : Type u} (x : ExceptCpsT ε m α) (s : ε) (ok : α m β) (error : ε m β) : m β :=
x _ ok error

View File

@@ -4,5 +4,373 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Control.Lawful.Basic
import Init.Control.Lawful.Instances
import Init.SimpLemmas
import Init.Control.Except
import Init.Control.StateRef
open Function
@[simp] theorem monadLift_self [Monad m] (x : m α) : monadLift x = x :=
rfl
class LawfulFunctor (f : Type u Type v) [Functor f] : Prop where
map_const : (Functor.mapConst : α f β f α) = Functor.map const β
id_map (x : f α) : id <$> x = x
comp_map (g : α β) (h : β γ) (x : f α) : (h g) <$> x = h <$> g <$> x
export LawfulFunctor (map_const id_map comp_map)
attribute [simp] id_map
@[simp] theorem id_map' [Functor m] [LawfulFunctor m] (x : m α) : (fun a => a) <$> x = x :=
id_map x
class LawfulApplicative (f : Type u Type v) [Applicative f] extends LawfulFunctor f : Prop where
seqLeft_eq (x : f α) (y : f β) : x <* y = const β <$> x <*> y
seqRight_eq (x : f α) (y : f β) : x *> y = const α id <$> x <*> y
pure_seq (g : α β) (x : f α) : pure g <*> x = g <$> x
map_pure (g : α β) (x : α) : g <$> (pure x : f α) = pure (g x)
seq_pure {α β : Type u} (g : f (α β)) (x : α) : g <*> pure x = (fun h => h x) <$> g
seq_assoc {α β γ : Type u} (x : f α) (g : f (α β)) (h : f (β γ)) : h <*> (g <*> x) = ((@comp α β γ) <$> h) <*> g <*> x
comp_map g h x := (by
repeat rw [ pure_seq]
simp [seq_assoc, map_pure, seq_pure])
export LawfulApplicative (seqLeft_eq seqRight_eq pure_seq map_pure seq_pure seq_assoc)
attribute [simp] map_pure seq_pure
@[simp] theorem pure_id_seq [Applicative f] [LawfulApplicative f] (x : f α) : pure id <*> x = x := by
simp [pure_seq]
class LawfulMonad (m : Type u Type v) [Monad m] extends LawfulApplicative m : Prop where
bind_pure_comp (f : α β) (x : m α) : x >>= (fun a => pure (f a)) = f <$> x
bind_map {α β : Type u} (f : m (α β)) (x : m α) : f >>= (. <$> x) = f <*> x
pure_bind (x : α) (f : α m β) : pure x >>= f = f x
bind_assoc (x : m α) (f : α m β) (g : β m γ) : x >>= f >>= g = x >>= fun x => f x >>= g
map_pure g x := (by rw [ bind_pure_comp, pure_bind])
seq_pure g x := (by rw [ bind_map]; simp [map_pure, bind_pure_comp])
seq_assoc x g h := (by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind])
export LawfulMonad (bind_pure_comp bind_map pure_bind bind_assoc)
attribute [simp] pure_bind bind_assoc
@[simp] theorem bind_pure [Monad m] [LawfulMonad m] (x : m α) : x >>= pure = x := by
show x >>= (fun a => pure (id a)) = x
rw [bind_pure_comp, id_map]
theorem map_eq_pure_bind [Monad m] [LawfulMonad m] (f : α β) (x : m α) : f <$> x = x >>= fun a => pure (f a) := by
rw [ bind_pure_comp]
theorem seq_eq_bind_map {α β : Type u} [Monad m] [LawfulMonad m] (f : m (α β)) (x : m α) : f <*> x = f >>= (. <$> x) := by
rw [ bind_map]
theorem bind_congr [Bind m] {x : m α} {f g : α m β} (h : a, f a = g a) : x >>= f = x >>= g := by
simp [funext h]
@[simp] theorem bind_pure_unit [Monad m] [LawfulMonad m] {x : m PUnit} : (x >>= fun _ => pure ) = x := by
rw [bind_pure]
theorem map_congr [Functor m] {x : m α} {f g : α β} (h : a, f a = g a) : (f <$> x : m β) = g <$> x := by
simp [funext h]
theorem seq_eq_bind {α β : Type u} [Monad m] [LawfulMonad m] (mf : m (α β)) (x : m α) : mf <*> x = mf >>= fun f => f <$> x := by
rw [bind_map]
theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *> y = x >>= fun _ => y := by
rw [seqRight_eq]
simp [map_eq_pure_bind, seq_eq_bind_map, const]
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
/--
An alternative constructor for `LawfulMonad` which has more
defaultable fields in the common case.
-/
theorem LawfulMonad.mk' (m : Type u Type v) [Monad m]
(id_map : {α} (x : m α), id <$> x = x)
(pure_bind : {α β} (x : α) (f : α m β), pure x >>= f = f x)
(bind_assoc : {α β γ} (x : m α) (f : α m β) (g : β m γ),
x >>= f >>= g = x >>= fun x => f x >>= g)
(map_const : {α β} (x : α) (y : m β),
Functor.mapConst x y = Function.const β x <$> y := by intros; rfl)
(seqLeft_eq : {α β} (x : m α) (y : m β),
x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl)
(seqRight_eq : {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl)
(bind_pure_comp : {α β} (f : α β) (x : m α),
x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl)
(bind_map : {α β} (f : m (α β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl)
: LawfulMonad m :=
have map_pure {α β} (g : α β) (x : α) : g <$> (pure x : m α) = pure (g x) := by
rw [ bind_pure_comp]; simp [pure_bind]
{ id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure,
comp_map := by simp [ bind_pure_comp, bind_assoc, pure_bind]
pure_seq := by intros; rw [ bind_map]; simp [pure_bind]
seq_pure := by intros; rw [ bind_map]; simp [map_pure, bind_pure_comp]
seq_assoc := by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind]
map_const := funext fun x => funext (map_const x)
seqLeft_eq := by simp [seqLeft_eq, bind_map, bind_pure_comp, pure_bind, bind_assoc]
seqRight_eq := fun x y => by
rw [seqRight_eq, bind_map, bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] }
/-! # Id -/
namespace Id
@[simp] theorem map_eq (x : Id α) (f : α β) : f <$> x = f x := rfl
@[simp] theorem bind_eq (x : Id α) (f : α id β) : x >>= f = f x := rfl
@[simp] theorem pure_eq (a : α) : (pure a : Id α) = a := rfl
instance : LawfulMonad Id := by
refine' { .. } <;> intros <;> rfl
end Id
/-! # ExceptT -/
namespace ExceptT
theorem ext [Monad m] {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
simp [run] at h
assumption
@[simp] theorem run_pure [Monad m] (x : α) : run (pure x : ExceptT ε m α) = pure (Except.ok x) := rfl
@[simp] theorem run_lift [Monad.{u, v} m] (x : m α) : run (ExceptT.lift x : ExceptT ε m α) = (Except.ok <$> x : m (Except ε α)) := rfl
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
@[simp] theorem bind_throw [Monad m] [LawfulMonad m] (f : α ExceptT ε m β) : (throw e >>= f) = throw e := by
simp [throw, throwThe, MonadExceptOf.throw, bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
theorem run_bind [Monad m] (x : ExceptT ε m α)
: run (x >>= f : ExceptT ε m β)
=
run x >>= fun
| Except.ok x => run (f x)
| Except.error e => pure (Except.error e) :=
rfl
@[simp] theorem lift_pure [Monad m] [LawfulMonad m] (a : α) : ExceptT.lift (pure a) = (pure a : ExceptT ε m α) := by
simp [ExceptT.lift, pure, ExceptT.pure]
@[simp] theorem run_map [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α)
: (f <$> x).run = Except.map f <$> x.run := by
simp [Functor.map, ExceptT.map, map_eq_pure_bind]
apply bind_congr
intro a; cases a <;> simp [Except.map]
protected theorem seq_eq {α β ε : Type u} [Monad m] (mf : ExceptT ε m (α β)) (x : ExceptT ε m α) : mf <*> x = mf >>= fun f => f <$> x :=
rfl
protected theorem bind_pure_comp [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α) : x >>= pure f = f <$> x := by
intros; rfl
protected theorem seqLeft_eq {α β ε : Type u} {m : Type u Type v} [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x <* y = const β <$> x <*> y := by
show (x >>= fun a => y >>= fun _ => pure a) = (const (α := α) β <$> x) >>= fun f => f <$> y
rw [ ExceptT.bind_pure_comp]
apply ext
simp [run_bind]
apply bind_congr
intro
| Except.error _ => simp
| Except.ok _ =>
simp [map_eq_pure_bind]; apply bind_congr; intro b;
cases b <;> simp [comp, Except.map, const]
protected theorem seqRight_eq [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x *> y = const α id <$> x <*> y := by
show (x >>= fun _ => y) = (const α id <$> x) >>= fun f => f <$> y
rw [ ExceptT.bind_pure_comp]
apply ext
simp [run_bind]
apply bind_congr
intro a; cases a <;> simp
instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
id_map := by intros; apply ext; simp
map_const := by intros; rfl
seqLeft_eq := ExceptT.seqLeft_eq
seqRight_eq := ExceptT.seqRight_eq
pure_seq := by intros; apply ext; simp [ExceptT.seq_eq, run_bind]
bind_pure_comp := ExceptT.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; simp [run_bind]
bind_assoc := by intros; apply ext; simp [run_bind]; apply bind_congr; intro a; cases a <;> simp
end ExceptT
/-! # Except -/
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun a f => rfl)
(bind_assoc := fun a f g => by cases a <;> rfl)
instance : LawfulApplicative (Except ε) := inferInstance
instance : LawfulFunctor (Except ε) := inferInstance
/-! # ReaderT -/
namespace ReaderT
theorem ext {x y : ReaderT ρ m α} (h : ctx, x.run ctx = y.run ctx) : x = y := by
simp [run] at h
exact funext h
@[simp] theorem run_pure [Monad m] (a : α) (ctx : ρ) : (pure a : ReaderT ρ m α).run ctx = pure a := rfl
@[simp] theorem run_bind [Monad m] (x : ReaderT ρ m α) (f : α ReaderT ρ m β) (ctx : ρ)
: (x >>= f).run ctx = x.run ctx >>= λ a => (f a).run ctx := rfl
@[simp] theorem run_mapConst [Monad m] (a : α) (x : ReaderT ρ m β) (ctx : ρ)
: (Functor.mapConst a x).run ctx = Functor.mapConst a (x.run ctx) := rfl
@[simp] theorem run_map [Monad m] (f : α β) (x : ReaderT ρ m α) (ctx : ρ)
: (f <$> x).run ctx = f <$> x.run ctx := rfl
@[simp] theorem run_monadLift [MonadLiftT n m] (x : n α) (ctx : ρ)
: (monadLift x : ReaderT ρ m α).run ctx = (monadLift x : m α) := rfl
@[simp] theorem run_monadMap [MonadFunctor n m] (f : {β : Type u} n β n β) (x : ReaderT ρ m α) (ctx : ρ)
: (monadMap @f x : ReaderT ρ m α).run ctx = monadMap @f (x.run ctx) := rfl
@[simp] theorem run_read [Monad m] (ctx : ρ) : (ReaderT.read : ReaderT ρ m ρ).run ctx = pure ctx := rfl
@[simp] theorem run_seq {α β : Type u} [Monad m] (f : ReaderT ρ m (α β)) (x : ReaderT ρ m α) (ctx : ρ)
: (f <*> x).run ctx = (f.run ctx <*> x.run ctx) := rfl
@[simp] theorem run_seqRight [Monad m] (x : ReaderT ρ m α) (y : ReaderT ρ m β) (ctx : ρ)
: (x *> y).run ctx = (x.run ctx *> y.run ctx) := rfl
@[simp] theorem run_seqLeft [Monad m] (x : ReaderT ρ m α) (y : ReaderT ρ m β) (ctx : ρ)
: (x <* y).run ctx = (x.run ctx <* y.run ctx) := rfl
instance [Monad m] [LawfulFunctor m] : LawfulFunctor (ReaderT ρ m) where
id_map := by intros; apply ext; simp
map_const := by intros; funext a b; apply ext; intros; simp [map_const]
comp_map := by intros; apply ext; intros; simp [comp_map]
instance [Monad m] [LawfulApplicative m] : LawfulApplicative (ReaderT ρ m) where
seqLeft_eq := by intros; apply ext; intros; simp [seqLeft_eq]
seqRight_eq := by intros; apply ext; intros; simp [seqRight_eq]
pure_seq := by intros; apply ext; intros; simp [pure_seq]
map_pure := by intros; apply ext; intros; simp [map_pure]
seq_pure := by intros; apply ext; intros; simp [seq_pure]
seq_assoc := by intros; apply ext; intros; simp [seq_assoc]
instance [Monad m] [LawfulMonad m] : LawfulMonad (ReaderT ρ m) where
bind_pure_comp := by intros; apply ext; intros; simp [LawfulMonad.bind_pure_comp]
bind_map := by intros; apply ext; intros; simp [bind_map]
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp
end ReaderT
/-! # StateRefT -/
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateRefT' ω σ m) :=
inferInstanceAs (LawfulMonad (ReaderT (ST.Ref ω σ) m))
/-! # StateT -/
namespace StateT
theorem ext {x y : StateT σ m α} (h : s, x.run s = y.run s) : x = y :=
funext h
@[simp] theorem run'_eq [Monad m] (x : StateT σ m α) (s : σ) : run' x s = (·.1) <$> run x s :=
rfl
@[simp] theorem run_pure [Monad m] (a : α) (s : σ) : (pure a : StateT σ m α).run s = pure (a, s) := rfl
@[simp] theorem run_bind [Monad m] (x : StateT σ m α) (f : α StateT σ m β) (s : σ)
: (x >>= f).run s = x.run s >>= λ p => (f p.1).run p.2 := by
simp [bind, StateT.bind, run]
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
@[simp] theorem run_set [Monad m] (s s' : σ) : (set s' : StateT σ m PUnit).run s = pure (, s') := rfl
@[simp] theorem run_modify [Monad m] (f : σ σ) (s : σ) : (modify f : StateT σ m PUnit).run s = pure (, f s) := rfl
@[simp] theorem run_modifyGet [Monad m] (f : σ α × σ) (s : σ) : (modifyGet f : StateT σ m α).run s = pure ((f s).1, (f s).2) := by
simp [modifyGet, MonadStateOf.modifyGet, StateT.modifyGet, run]
@[simp] theorem run_lift {α σ : Type u} [Monad m] (x : m α) (s : σ) : (StateT.lift x : StateT σ m α).run s = x >>= fun a => pure (a, s) := rfl
@[simp] theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f : α StateT σ m β) (s : σ) : (StateT.lift x >>= f).run s = x >>= fun a => (f a).run s := by
simp [StateT.lift, StateT.run, bind, StateT.bind]
@[simp] theorem run_monadLift {α σ : Type u} [Monad m] [MonadLiftT n m] (x : n α) (s : σ) : (monadLift x : StateT σ m α).run s = (monadLift x : m α) >>= fun a => pure (a, s) := rfl
@[simp] theorem run_monadMap [Monad m] [MonadFunctor n m] (f : {β : Type u} n β n β) (x : StateT σ m α) (s : σ)
: (monadMap @f x : StateT σ m α).run s = monadMap @f (x.run s) := rfl
@[simp] theorem run_seq {α β σ : Type u} [Monad m] [LawfulMonad m] (f : StateT σ m (α β)) (x : StateT σ m α) (s : σ) : (f <*> x).run s = (f.run s >>= fun fs => (fun (p : α × σ) => (fs.1 p.1, p.2)) <$> x.run fs.2) := by
show (f >>= fun g => g <$> x).run s = _
simp
@[simp] theorem run_seqRight [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) (s : σ) : (x *> y).run s = (x.run s >>= fun p => y.run p.2) := by
show (x >>= fun _ => y).run s = _
simp
@[simp] theorem run_seqLeft {α β σ : Type u} [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) (s : σ) : (x <* y).run s = (x.run s >>= fun p => y.run p.2 >>= fun p' => pure (p.1, p'.2)) := by
show (x >>= fun a => y >>= fun _ => pure a).run s = _
simp
theorem seqRight_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x *> y = const α id <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind, const]
apply bind_congr; intro p; cases p
simp [Prod.eta]
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind]
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
id_map := by intros; apply ext; intros; simp[Prod.eta]
map_const := by intros; rfl
seqLeft_eq := seqLeft_eq
seqRight_eq := seqRight_eq
pure_seq := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp; apply LawfulMonad.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp
end StateT
/-! # EStateM -/
instance : LawfulMonad (EStateM ε σ) := .mk'
(id_map := fun x => funext <| fun s => by
dsimp only [EStateM.instMonadEStateM, EStateM.map]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun x _ _ => funext <| fun s => by
dsimp only [EStateM.instMonadEStateM, EStateM.bind]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(map_const := fun _ _ => rfl)
/-! # Option -/
instance : LawfulMonad Option := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun x f => rfl)
(bind_assoc := fun x f g => by cases x <;> rfl)
(bind_pure_comp := fun f x => by cases x <;> rfl)
instance : LawfulApplicative Option := inferInstance
instance : LawfulFunctor Option := inferInstance

View File

@@ -1,169 +0,0 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.SimpLemmas
import Init.Meta
open Function
@[simp] theorem monadLift_self {m : Type u Type v} (x : m α) : monadLift x = x :=
rfl
/--
The `Functor` typeclass only contains the operations of a functor.
`LawfulFunctor` further asserts that these operations satisfy the laws of a functor,
including the preservation of the identity and composition laws:
```
id <$> x = x
(h ∘ g) <$> x = h <$> g <$> x
```
-/
class LawfulFunctor (f : Type u Type v) [Functor f] : Prop where
map_const : (Functor.mapConst : α f β f α) = Functor.map const β
id_map (x : f α) : id <$> x = x
comp_map (g : α β) (h : β γ) (x : f α) : (h g) <$> x = h <$> g <$> x
export LawfulFunctor (map_const id_map comp_map)
attribute [simp] id_map
@[simp] theorem id_map' [Functor m] [LawfulFunctor m] (x : m α) : (fun a => a) <$> x = x :=
id_map x
/--
The `Applicative` typeclass only contains the operations of an applicative functor.
`LawfulApplicative` further asserts that these operations satisfy the laws of an applicative functor:
```
pure id <*> v = v
pure (·∘·) <*> u <*> v <*> w = u <*> (v <*> w)
pure f <*> pure x = pure (f x)
u <*> pure y = pure (· y) <*> u
```
-/
class LawfulApplicative (f : Type u Type v) [Applicative f] extends LawfulFunctor f : Prop where
seqLeft_eq (x : f α) (y : f β) : x <* y = const β <$> x <*> y
seqRight_eq (x : f α) (y : f β) : x *> y = const α id <$> x <*> y
pure_seq (g : α β) (x : f α) : pure g <*> x = g <$> x
map_pure (g : α β) (x : α) : g <$> (pure x : f α) = pure (g x)
seq_pure {α β : Type u} (g : f (α β)) (x : α) : g <*> pure x = (fun h => h x) <$> g
seq_assoc {α β γ : Type u} (x : f α) (g : f (α β)) (h : f (β γ)) : h <*> (g <*> x) = ((@comp α β γ) <$> h) <*> g <*> x
comp_map g h x := (by
repeat rw [ pure_seq]
simp [seq_assoc, map_pure, seq_pure])
export LawfulApplicative (seqLeft_eq seqRight_eq pure_seq map_pure seq_pure seq_assoc)
attribute [simp] map_pure seq_pure
@[simp] theorem pure_id_seq [Applicative f] [LawfulApplicative f] (x : f α) : pure id <*> x = x := by
simp [pure_seq]
/--
The `Monad` typeclass only contains the operations of a monad.
`LawfulMonad` further asserts that these operations satisfy the laws of a monad,
including associativity and identity laws for `bind`:
```
pure x >>= f = f x
x >>= pure = x
x >>= f >>= g = x >>= (fun x => f x >>= g)
```
`LawfulMonad.mk'` is an alternative constructor containing useful defaults for many fields.
-/
class LawfulMonad (m : Type u Type v) [Monad m] extends LawfulApplicative m : Prop where
bind_pure_comp (f : α β) (x : m α) : x >>= (fun a => pure (f a)) = f <$> x
bind_map {α β : Type u} (f : m (α β)) (x : m α) : f >>= (. <$> x) = f <*> x
pure_bind (x : α) (f : α m β) : pure x >>= f = f x
bind_assoc (x : m α) (f : α m β) (g : β m γ) : x >>= f >>= g = x >>= fun x => f x >>= g
map_pure g x := (by rw [ bind_pure_comp, pure_bind])
seq_pure g x := (by rw [ bind_map]; simp [map_pure, bind_pure_comp])
seq_assoc x g h := (by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind])
export LawfulMonad (bind_pure_comp bind_map pure_bind bind_assoc)
attribute [simp] pure_bind bind_assoc
@[simp] theorem bind_pure [Monad m] [LawfulMonad m] (x : m α) : x >>= pure = x := by
show x >>= (fun a => pure (id a)) = x
rw [bind_pure_comp, id_map]
theorem map_eq_pure_bind [Monad m] [LawfulMonad m] (f : α β) (x : m α) : f <$> x = x >>= fun a => pure (f a) := by
rw [ bind_pure_comp]
theorem seq_eq_bind_map {α β : Type u} [Monad m] [LawfulMonad m] (f : m (α β)) (x : m α) : f <*> x = f >>= (. <$> x) := by
rw [ bind_map]
theorem bind_congr [Bind m] {x : m α} {f g : α m β} (h : a, f a = g a) : x >>= f = x >>= g := by
simp [funext h]
@[simp] theorem bind_pure_unit [Monad m] [LawfulMonad m] {x : m PUnit} : (x >>= fun _ => pure ) = x := by
rw [bind_pure]
theorem map_congr [Functor m] {x : m α} {f g : α β} (h : a, f a = g a) : (f <$> x : m β) = g <$> x := by
simp [funext h]
theorem seq_eq_bind {α β : Type u} [Monad m] [LawfulMonad m] (mf : m (α β)) (x : m α) : mf <*> x = mf >>= fun f => f <$> x := by
rw [bind_map]
theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *> y = x >>= fun _ => y := by
rw [seqRight_eq]
simp [map_eq_pure_bind, seq_eq_bind_map, const]
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
/--
An alternative constructor for `LawfulMonad` which has more
defaultable fields in the common case.
-/
theorem LawfulMonad.mk' (m : Type u Type v) [Monad m]
(id_map : {α} (x : m α), id <$> x = x)
(pure_bind : {α β} (x : α) (f : α m β), pure x >>= f = f x)
(bind_assoc : {α β γ} (x : m α) (f : α m β) (g : β m γ),
x >>= f >>= g = x >>= fun x => f x >>= g)
(map_const : {α β} (x : α) (y : m β),
Functor.mapConst x y = Function.const β x <$> y := by intros; rfl)
(seqLeft_eq : {α β} (x : m α) (y : m β),
x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl)
(seqRight_eq : {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl)
(bind_pure_comp : {α β} (f : α β) (x : m α),
x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl)
(bind_map : {α β} (f : m (α β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl)
: LawfulMonad m :=
have map_pure {α β} (g : α β) (x : α) : g <$> (pure x : m α) = pure (g x) := by
rw [ bind_pure_comp]; simp [pure_bind]
{ id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure,
comp_map := by simp [ bind_pure_comp, bind_assoc, pure_bind]
pure_seq := by intros; rw [ bind_map]; simp [pure_bind]
seq_pure := by intros; rw [ bind_map]; simp [map_pure, bind_pure_comp]
seq_assoc := by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind]
map_const := funext fun x => funext (map_const x)
seqLeft_eq := by simp [seqLeft_eq, bind_map, bind_pure_comp, pure_bind, bind_assoc]
seqRight_eq := fun x y => by
rw [seqRight_eq, bind_map, bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] }
/-! # Id -/
namespace Id
@[simp] theorem map_eq (x : Id α) (f : α β) : f <$> x = f x := rfl
@[simp] theorem bind_eq (x : Id α) (f : α id β) : x >>= f = f x := rfl
@[simp] theorem pure_eq (a : α) : (pure a : Id α) = a := rfl
instance : LawfulMonad Id := by
refine' { .. } <;> intros <;> rfl
end Id
/-! # Option -/
instance : LawfulMonad Option := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun x f => rfl)
(bind_assoc := fun x f g => by cases x <;> rfl)
(bind_pure_comp := fun f x => by cases x <;> rfl)
instance : LawfulApplicative Option := inferInstance
instance : LawfulFunctor Option := inferInstance

View File

@@ -1,248 +0,0 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Control.Lawful.Basic
import Init.Control.Except
import Init.Control.StateRef
open Function
/-! # ExceptT -/
namespace ExceptT
theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
simp [run] at h
assumption
@[simp] theorem run_pure [Monad m] (x : α) : run (pure x : ExceptT ε m α) = pure (Except.ok x) := rfl
@[simp] theorem run_lift [Monad.{u, v} m] (x : m α) : run (ExceptT.lift x : ExceptT ε m α) = (Except.ok <$> x : m (Except ε α)) := rfl
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
@[simp] theorem bind_throw [Monad m] [LawfulMonad m] (f : α ExceptT ε m β) : (throw e >>= f) = throw e := by
simp [throw, throwThe, MonadExceptOf.throw, bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
theorem run_bind [Monad m] (x : ExceptT ε m α)
: run (x >>= f : ExceptT ε m β)
=
run x >>= fun
| Except.ok x => run (f x)
| Except.error e => pure (Except.error e) :=
rfl
@[simp] theorem lift_pure [Monad m] [LawfulMonad m] (a : α) : ExceptT.lift (pure a) = (pure a : ExceptT ε m α) := by
simp [ExceptT.lift, pure, ExceptT.pure]
@[simp] theorem run_map [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α)
: (f <$> x).run = Except.map f <$> x.run := by
simp [Functor.map, ExceptT.map, map_eq_pure_bind]
apply bind_congr
intro a; cases a <;> simp [Except.map]
protected theorem seq_eq {α β ε : Type u} [Monad m] (mf : ExceptT ε m (α β)) (x : ExceptT ε m α) : mf <*> x = mf >>= fun f => f <$> x :=
rfl
protected theorem bind_pure_comp [Monad m] (f : α β) (x : ExceptT ε m α) : x >>= pure f = f <$> x := by
intros; rfl
protected theorem seqLeft_eq {α β ε : Type u} {m : Type u Type v} [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x <* y = const β <$> x <*> y := by
show (x >>= fun a => y >>= fun _ => pure a) = (const (α := α) β <$> x) >>= fun f => f <$> y
rw [ ExceptT.bind_pure_comp]
apply ext
simp [run_bind]
apply bind_congr
intro
| Except.error _ => simp
| Except.ok _ =>
simp [map_eq_pure_bind]; apply bind_congr; intro b;
cases b <;> simp [comp, Except.map, const]
protected theorem seqRight_eq [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x *> y = const α id <$> x <*> y := by
show (x >>= fun _ => y) = (const α id <$> x) >>= fun f => f <$> y
rw [ ExceptT.bind_pure_comp]
apply ext
simp [run_bind]
apply bind_congr
intro a; cases a <;> simp
instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
id_map := by intros; apply ext; simp
map_const := by intros; rfl
seqLeft_eq := ExceptT.seqLeft_eq
seqRight_eq := ExceptT.seqRight_eq
pure_seq := by intros; apply ext; simp [ExceptT.seq_eq, run_bind]
bind_pure_comp := ExceptT.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; simp [run_bind]
bind_assoc := by intros; apply ext; simp [run_bind]; apply bind_congr; intro a; cases a <;> simp
end ExceptT
/-! # Except -/
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun a f => rfl)
(bind_assoc := fun a f g => by cases a <;> rfl)
instance : LawfulApplicative (Except ε) := inferInstance
instance : LawfulFunctor (Except ε) := inferInstance
/-! # ReaderT -/
namespace ReaderT
theorem ext {x y : ReaderT ρ m α} (h : ctx, x.run ctx = y.run ctx) : x = y := by
simp [run] at h
exact funext h
@[simp] theorem run_pure [Monad m] (a : α) (ctx : ρ) : (pure a : ReaderT ρ m α).run ctx = pure a := rfl
@[simp] theorem run_bind [Monad m] (x : ReaderT ρ m α) (f : α ReaderT ρ m β) (ctx : ρ)
: (x >>= f).run ctx = x.run ctx >>= λ a => (f a).run ctx := rfl
@[simp] theorem run_mapConst [Monad m] (a : α) (x : ReaderT ρ m β) (ctx : ρ)
: (Functor.mapConst a x).run ctx = Functor.mapConst a (x.run ctx) := rfl
@[simp] theorem run_map [Monad m] (f : α β) (x : ReaderT ρ m α) (ctx : ρ)
: (f <$> x).run ctx = f <$> x.run ctx := rfl
@[simp] theorem run_monadLift [MonadLiftT n m] (x : n α) (ctx : ρ)
: (monadLift x : ReaderT ρ m α).run ctx = (monadLift x : m α) := rfl
@[simp] theorem run_monadMap [MonadFunctor n m] (f : {β : Type u} n β n β) (x : ReaderT ρ m α) (ctx : ρ)
: (monadMap @f x : ReaderT ρ m α).run ctx = monadMap @f (x.run ctx) := rfl
@[simp] theorem run_read [Monad m] (ctx : ρ) : (ReaderT.read : ReaderT ρ m ρ).run ctx = pure ctx := rfl
@[simp] theorem run_seq {α β : Type u} [Monad m] (f : ReaderT ρ m (α β)) (x : ReaderT ρ m α) (ctx : ρ)
: (f <*> x).run ctx = (f.run ctx <*> x.run ctx) := rfl
@[simp] theorem run_seqRight [Monad m] (x : ReaderT ρ m α) (y : ReaderT ρ m β) (ctx : ρ)
: (x *> y).run ctx = (x.run ctx *> y.run ctx) := rfl
@[simp] theorem run_seqLeft [Monad m] (x : ReaderT ρ m α) (y : ReaderT ρ m β) (ctx : ρ)
: (x <* y).run ctx = (x.run ctx <* y.run ctx) := rfl
instance [Monad m] [LawfulFunctor m] : LawfulFunctor (ReaderT ρ m) where
id_map := by intros; apply ext; simp
map_const := by intros; funext a b; apply ext; intros; simp [map_const]
comp_map := by intros; apply ext; intros; simp [comp_map]
instance [Monad m] [LawfulApplicative m] : LawfulApplicative (ReaderT ρ m) where
seqLeft_eq := by intros; apply ext; intros; simp [seqLeft_eq]
seqRight_eq := by intros; apply ext; intros; simp [seqRight_eq]
pure_seq := by intros; apply ext; intros; simp [pure_seq]
map_pure := by intros; apply ext; intros; simp [map_pure]
seq_pure := by intros; apply ext; intros; simp [seq_pure]
seq_assoc := by intros; apply ext; intros; simp [seq_assoc]
instance [Monad m] [LawfulMonad m] : LawfulMonad (ReaderT ρ m) where
bind_pure_comp := by intros; apply ext; intros; simp [LawfulMonad.bind_pure_comp]
bind_map := by intros; apply ext; intros; simp [bind_map]
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp
end ReaderT
/-! # StateRefT -/
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateRefT' ω σ m) :=
inferInstanceAs (LawfulMonad (ReaderT (ST.Ref ω σ) m))
/-! # StateT -/
namespace StateT
theorem ext {x y : StateT σ m α} (h : s, x.run s = y.run s) : x = y :=
funext h
@[simp] theorem run'_eq [Monad m] (x : StateT σ m α) (s : σ) : run' x s = (·.1) <$> run x s :=
rfl
@[simp] theorem run_pure [Monad m] (a : α) (s : σ) : (pure a : StateT σ m α).run s = pure (a, s) := rfl
@[simp] theorem run_bind [Monad m] (x : StateT σ m α) (f : α StateT σ m β) (s : σ)
: (x >>= f).run s = x.run s >>= λ p => (f p.1).run p.2 := by
simp [bind, StateT.bind, run]
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
@[simp] theorem run_set [Monad m] (s s' : σ) : (set s' : StateT σ m PUnit).run s = pure (, s') := rfl
@[simp] theorem run_modify [Monad m] (f : σ σ) (s : σ) : (modify f : StateT σ m PUnit).run s = pure (, f s) := rfl
@[simp] theorem run_modifyGet [Monad m] (f : σ α × σ) (s : σ) : (modifyGet f : StateT σ m α).run s = pure ((f s).1, (f s).2) := by
simp [modifyGet, MonadStateOf.modifyGet, StateT.modifyGet, run]
@[simp] theorem run_lift {α σ : Type u} [Monad m] (x : m α) (s : σ) : (StateT.lift x : StateT σ m α).run s = x >>= fun a => pure (a, s) := rfl
theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f : α StateT σ m β) (s : σ) : (StateT.lift x >>= f).run s = x >>= fun a => (f a).run s := by
simp [StateT.lift, StateT.run, bind, StateT.bind]
@[simp] theorem run_monadLift {α σ : Type u} [Monad m] [MonadLiftT n m] (x : n α) (s : σ) : (monadLift x : StateT σ m α).run s = (monadLift x : m α) >>= fun a => pure (a, s) := rfl
@[simp] theorem run_monadMap [MonadFunctor n m] (f : {β : Type u} n β n β) (x : StateT σ m α) (s : σ) :
(monadMap @f x : StateT σ m α).run s = monadMap @f (x.run s) := rfl
@[simp] theorem run_seq {α β σ : Type u} [Monad m] [LawfulMonad m] (f : StateT σ m (α β)) (x : StateT σ m α) (s : σ) : (f <*> x).run s = (f.run s >>= fun fs => (fun (p : α × σ) => (fs.1 p.1, p.2)) <$> x.run fs.2) := by
show (f >>= fun g => g <$> x).run s = _
simp
@[simp] theorem run_seqRight [Monad m] (x : StateT σ m α) (y : StateT σ m β) (s : σ) : (x *> y).run s = (x.run s >>= fun p => y.run p.2) := by
show (x >>= fun _ => y).run s = _
simp
@[simp] theorem run_seqLeft {α β σ : Type u} [Monad m] (x : StateT σ m α) (y : StateT σ m β) (s : σ) : (x <* y).run s = (x.run s >>= fun p => y.run p.2 >>= fun p' => pure (p.1, p'.2)) := by
show (x >>= fun a => y >>= fun _ => pure a).run s = _
simp
theorem seqRight_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x *> y = const α id <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind, const]
apply bind_congr; intro p; cases p
simp [Prod.eta]
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind]
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
id_map := by intros; apply ext; intros; simp[Prod.eta]
map_const := by intros; rfl
seqLeft_eq := seqLeft_eq
seqRight_eq := seqRight_eq
pure_seq := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp; apply LawfulMonad.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp
end StateT
/-! # EStateM -/
instance : LawfulMonad (EStateM ε σ) := .mk'
(id_map := fun x => funext <| fun s => by
dsimp only [EStateM.instMonad, EStateM.map]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun x _ _ => funext <| fun s => by
dsimp only [EStateM.instMonad, EStateM.bind]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(map_const := fun _ _ => rfl)

View File

@@ -10,7 +10,7 @@ import Init.Control.Except
universe u v
instance : ToBool (Option α) := Option.isSome
instance : ToBool (Option α) := Option.toBool
def OptionT (m : Type u Type v) (α : Type u) : Type v :=
m (Option α)
@@ -67,7 +67,7 @@ instance : MonadExceptOf Unit (OptionT m) where
throw := fun _ => OptionT.fail
tryCatch := OptionT.tryCatch
instance (ε : Type u) [MonadExceptOf ε m] : MonadExceptOf ε (OptionT m) where
instance (ε : Type u) [Monad m] [MonadExceptOf ε m] : MonadExceptOf ε (OptionT m) where
throw e := OptionT.mk <| throwThe ε e
tryCatch x handle := OptionT.mk <| tryCatchThe ε x handle

View File

@@ -32,7 +32,7 @@ instance : MonadControl m (ReaderT ρ m) where
restoreM x _ := x
@[always_inline]
instance ReaderT.tryFinally [MonadFinally m] : MonadFinally (ReaderT ρ m) where
instance ReaderT.tryFinally [MonadFinally m] [Monad m] : MonadFinally (ReaderT ρ m) where
tryFinally' x h ctx := tryFinally' (x ctx) (fun a? => h a? ctx)
@[reducible] def ReaderM (ρ : Type u) := ReaderT ρ Id

View File

@@ -87,7 +87,7 @@ protected def lift {α : Type u} (t : m α) : StateT σ m α :=
instance : MonadLift m (StateT σ m) := StateT.lift
@[always_inline]
instance (σ m) : MonadFunctor m (StateT σ m) := fun f x s => f (x s)
instance (σ m) [Monad m] : MonadFunctor m (StateT σ m) := fun f x s => f (x s)
@[always_inline]
instance (ε) [MonadExceptOf ε m] : MonadExceptOf ε (StateT σ m) := {

View File

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Control.Lawful.Basic
import Init.Control.Lawful
/-!
The State monad transformer using CPS style.
@@ -14,18 +14,16 @@ def StateCpsT (σ : Type u) (m : Type u → Type v) (α : Type u) := (δ : Type
namespace StateCpsT
variable {α σ : Type u} {m : Type u Type v}
@[always_inline, inline]
def runK (x : StateCpsT σ m α) (s : σ) (k : α σ m β) : m β :=
def runK {α σ : Type u} {m : Type u Type v} (x : StateCpsT σ m α) (s : σ) (k : α σ m β) : m β :=
x _ s k
@[always_inline, inline]
def run [Monad m] (x : StateCpsT σ m α) (s : σ) : m (α × σ) :=
def run {α σ : Type u} {m : Type u Type v} [Monad m] (x : StateCpsT σ m α) (s : σ) : m (α × σ) :=
runK x s (fun a s => pure (a, s))
@[always_inline, inline]
def run' [Monad m] (x : StateCpsT σ m α) (s : σ) : m α :=
def run' {α σ : Type u} {m : Type u Type v} [Monad m] (x : StateCpsT σ m α) (s : σ) : m α :=
runK x s (fun a _ => pure a)
@[always_inline]
@@ -50,29 +48,29 @@ protected def lift [Monad m] (x : m α) : StateCpsT σ m α :=
instance [Monad m] : MonadLift m (StateCpsT σ m) where
monadLift := StateCpsT.lift
@[simp] theorem runK_pure (a : α) (s : σ) (k : α σ m β) : (pure a : StateCpsT σ m α).runK s k = k a s := rfl
@[simp] theorem runK_pure {m : Type u Type v} (a : α) (s : σ) (k : α σ m β) : (pure a : StateCpsT σ m α).runK s k = k a s := rfl
@[simp] theorem runK_get (s : σ) (k : σ σ m β) : (get : StateCpsT σ m σ).runK s k = k s s := rfl
@[simp] theorem runK_get {m : Type u Type v} (s : σ) (k : σ σ m β) : (get : StateCpsT σ m σ).runK s k = k s s := rfl
@[simp] theorem runK_set (s s' : σ) (k : PUnit σ m β) : (set s' : StateCpsT σ m PUnit).runK s k = k s' := rfl
@[simp] theorem runK_set {m : Type u Type v} (s s' : σ) (k : PUnit σ m β) : (set s' : StateCpsT σ m PUnit).runK s k = k s' := rfl
@[simp] theorem runK_modify (f : σ σ) (s : σ) (k : PUnit σ m β) : (modify f : StateCpsT σ m PUnit).runK s k = k (f s) := rfl
@[simp] theorem runK_modify {m : Type u Type v} (f : σ σ) (s : σ) (k : PUnit σ m β) : (modify f : StateCpsT σ m PUnit).runK s k = k (f s) := rfl
@[simp] theorem runK_lift [Monad m] (x : m α) (s : σ) (k : α σ m β) : (StateCpsT.lift x : StateCpsT σ m α).runK s k = x >>= (k . s) := rfl
@[simp] theorem runK_lift {α σ : Type u} [Monad m] (x : m α) (s : σ) (k : α σ m β) : (StateCpsT.lift x : StateCpsT σ m α).runK s k = x >>= (k . s) := rfl
@[simp] theorem runK_monadLift [Monad m] [MonadLiftT n m] (x : n α) (s : σ) (k : α σ m β)
@[simp] theorem runK_monadLift {σ : Type u} [Monad m] [MonadLiftT n m] (x : n α) (s : σ) (k : α σ m β)
: (monadLift x : StateCpsT σ m α).runK s k = (monadLift x : m α) >>= (k . s) := rfl
@[simp] theorem runK_bind_pure (a : α) (f : α StateCpsT σ m β) (s : σ) (k : β σ m γ) : (pure a >>= f).runK s k = (f a).runK s k := rfl
@[simp] theorem runK_bind_pure {α σ : Type u} [Monad m] (a : α) (f : α StateCpsT σ m β) (s : σ) (k : β σ m γ) : (pure a >>= f).runK s k = (f a).runK s k := rfl
@[simp] theorem runK_bind_lift [Monad m] (x : m α) (f : α StateCpsT σ m β) (s : σ) (k : β σ m γ)
@[simp] theorem runK_bind_lift {α σ : Type u} [Monad m] (x : m α) (f : α StateCpsT σ m β) (s : σ) (k : β σ m γ)
: (StateCpsT.lift x >>= f).runK s k = x >>= fun a => (f a).runK s k := rfl
@[simp] theorem runK_bind_get (f : σ StateCpsT σ m β) (s : σ) (k : β σ m γ) : (get >>= f).runK s k = (f s).runK s k := rfl
@[simp] theorem runK_bind_get {σ : Type u} [Monad m] (f : σ StateCpsT σ m β) (s : σ) (k : β σ m γ) : (get >>= f).runK s k = (f s).runK s k := rfl
@[simp] theorem runK_bind_set (f : PUnit StateCpsT σ m β) (s s' : σ) (k : β σ m γ) : (set s' >>= f).runK s k = (f ).runK s' k := rfl
@[simp] theorem runK_bind_set {σ : Type u} [Monad m] (f : PUnit StateCpsT σ m β) (s s' : σ) (k : β σ m γ) : (set s' >>= f).runK s k = (f ).runK s' k := rfl
@[simp] theorem runK_bind_modify (f : σ σ) (g : PUnit StateCpsT σ m β) (s : σ) (k : β σ m γ) : (modify f >>= g).runK s k = (g ).runK (f s) k := rfl
@[simp] theorem runK_bind_modify {σ : Type u} [Monad m] (f : σ σ) (g : PUnit StateCpsT σ m β) (s : σ) (k : β σ m γ) : (modify f >>= g).runK s k = (g ).runK (f s) k := rfl
@[simp] theorem run_eq [Monad m] (x : StateCpsT σ m α) (s : σ) : x.run s = x.runK s (fun a s => pure (a, s)) := rfl

View File

@@ -34,22 +34,22 @@ protected def lift (x : m α) : StateRefT' ω σ m α :=
instance [Monad m] : Monad (StateRefT' ω σ m) := inferInstanceAs (Monad (ReaderT _ _))
instance : MonadLift m (StateRefT' ω σ m) := StateRefT'.lift
instance (σ m) : MonadFunctor m (StateRefT' ω σ m) := inferInstanceAs (MonadFunctor m (ReaderT _ _))
instance (σ m) [Monad m] : MonadFunctor m (StateRefT' ω σ m) := inferInstanceAs (MonadFunctor m (ReaderT _ _))
instance [Alternative m] [Monad m] : Alternative (StateRefT' ω σ m) := inferInstanceAs (Alternative (ReaderT _ _))
@[inline]
protected def get [MonadLiftT (ST ω) m] : StateRefT' ω σ m σ :=
protected def get [Monad m] [MonadLiftT (ST ω) m] : StateRefT' ω σ m σ :=
fun ref => ref.get
@[inline]
protected def set [MonadLiftT (ST ω) m] (s : σ) : StateRefT' ω σ m PUnit :=
protected def set [Monad m] [MonadLiftT (ST ω) m] (s : σ) : StateRefT' ω σ m PUnit :=
fun ref => ref.set s
@[inline]
protected def modifyGet [MonadLiftT (ST ω) m] (f : σ α × σ) : StateRefT' ω σ m α :=
protected def modifyGet [Monad m] [MonadLiftT (ST ω) m] (f : σ α × σ) : StateRefT' ω σ m α :=
fun ref => ref.modifyGet f
instance [MonadLiftT (ST ω) m] : MonadStateOf σ (StateRefT' ω σ m) where
instance [MonadLiftT (ST ω) m] [Monad m] : MonadStateOf σ (StateRefT' ω σ m) where
get := StateRefT'.get
set := StateRefT'.set
modifyGet := StateRefT'.modifyGet
@@ -64,5 +64,5 @@ end StateRefT'
instance (ω σ : Type) (m : Type Type) : MonadControl m (StateRefT' ω σ m) :=
inferInstanceAs (MonadControl m (ReaderT _ _))
instance {m : Type Type} {ω σ : Type} [MonadFinally m] : MonadFinally (StateRefT' ω σ m) :=
instance {m : Type Type} {ω σ : Type} [MonadFinally m] [Monad m] : MonadFinally (StateRefT' ω σ m) :=
inferInstanceAs (MonadFinally (ReaderT _ _))

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
Notation for operators defined at Prelude.lean
-/
prelude
import Init.Tactics
import Init.NotationExtra
namespace Lean.Parser.Tactic.Conv
@@ -156,6 +156,7 @@ match [a, b] with
simplifies to `a`. -/
syntax (name := simpMatch) "simp_match" : conv
/-- Executes the given tactic block without converting `conv` goal into a regular goal. -/
syntax (name := nestedTacticCore) "tactic'" " => " tacticSeq : conv
@@ -201,7 +202,7 @@ macro (name := anyGoals) tk:"any_goals " s:convSeq : conv =>
with inaccessible names to the given names.
* `case tag₁ | tag₂ => tac` is equivalent to `(case tag₁ => tac); (case tag₂ => tac)`.
-/
macro (name := case) tk:"case " args:sepBy1(caseArg, "|") arr:" => " s:convSeq : conv =>
macro (name := case) tk:"case " args:sepBy1(caseArg, " | ") arr:" => " s:convSeq : conv =>
`(conv| tactic' => case%$tk $args|* =>%$arr conv' => ($s); all_goals rfl)
/--
@@ -210,7 +211,7 @@ has been solved after applying `tac`, nor admits the goal if `tac` failed.
Recall that `case` closes the goal using `sorry` when `tac` fails, and
the tactic execution is not interrupted.
-/
macro (name := case') tk:"case' " args:sepBy1(caseArg, "|") arr:" => " s:convSeq : conv =>
macro (name := case') tk:"case' " args:sepBy1(caseArg, " | ") arr:" => " s:convSeq : conv =>
`(conv| tactic' => case'%$tk $args|* =>%$arr conv' => $s)
/--

View File

@@ -19,7 +19,7 @@ which applies to all applications of the function).
-/
@[simp] def inline {α : Sort u} (a : α) : α := a
theorem id_def {α : Sort u} (a : α) : id a = a := rfl
theorem id.def {α : Sort u} (a : α) : id a = a := rfl
/--
`flip f a b` is `f b a`. It is useful for "point-free" programming,
@@ -165,7 +165,6 @@ whose first component is `a : α` and whose second component is `b : β a`
It is sometimes known as the dependent sum type, since it is the type level version
of an indexed summation.
-/
@[pp_using_anonymous_constructor]
structure Sigma {α : Type u} (β : α Type v) where
/-- Constructor for a dependent pair. If `a : α` and `b : β a` then `⟨a, b⟩ : Sigma β`.
(This will usually require a type ascription to determine `β`
@@ -191,7 +190,6 @@ which can cause problems for universe level unification,
because the equation `max 1 u v = ?u + 1` has no solution in level arithmetic.
`PSigma` is usually only used in automation that constructs pairs of arbitrary types.
-/
@[pp_using_anonymous_constructor]
structure PSigma {α : Sort u} (β : α Sort v) where
/-- Constructor for a dependent pair. If `a : α` and `b : β a` then `⟨a, b⟩ : PSigma β`.
(This will usually require a type ascription to determine `β`
@@ -468,13 +466,11 @@ class Singleton (α : outParam <| Type u) (β : Type v) where
export Singleton (singleton)
/-- `insert x ∅ = {x}` -/
class LawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] :
class IsLawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] :
Prop where
/-- `insert x ∅ = {x}` -/
insert_emptyc_eq (x : α) : (insert x : β) = singleton x
export LawfulSingleton (insert_emptyc_eq)
attribute [simp] insert_emptyc_eq
export IsLawfulSingleton (insert_emptyc_eq)
/-- Type class used to implement the notation `{ a ∈ c | p a }` -/
class Sep (α : outParam <| Type u) (γ : Type v) where
@@ -644,7 +640,7 @@ instance : LawfulBEq String := inferInstance
/-! # Logical connectives and equality -/
@[inherit_doc True.intro] theorem trivial : True :=
@[inherit_doc True.intro] def trivial : True :=
theorem mt {a b : Prop} (h₁ : a b) (h₂ : ¬b) : ¬a :=
fun ha => h₂ (h₁ ha)
@@ -681,7 +677,7 @@ You can prove theorems about the resulting element by induction on `h`, since
theorem Eq.substr {α : Sort u} {p : α Prop} {a b : α} (h₁ : b = a) (h₂ : p a) : p b :=
h₁ h₂
@[simp] theorem cast_eq {α : Sort u} (h : α = α) (a : α) : cast h a = a :=
theorem cast_eq {α : Sort u} (h : α = α) (a : α) : cast h a = a :=
rfl
/--
@@ -703,7 +699,7 @@ theorem Ne.elim (h : a ≠ b) : a = b → False := h
theorem Ne.irrefl (h : a a) : False := h rfl
@[symm] theorem Ne.symm (h : a b) : b a := fun h₁ => h (h₁.symm)
theorem Ne.symm (h : a b) : b a := fun h₁ => h (h₁.symm)
theorem ne_comm {α} {a b : α} : a b b a := Ne.symm, Ne.symm
@@ -741,22 +737,19 @@ theorem beq_false_of_ne [BEq α] [LawfulBEq α] {a b : α} (h : a ≠ b) : (a ==
section
variable {α β φ : Sort u} {a a' : α} {b b' : β} {c : φ}
/-- Non-dependent recursor for `HEq` -/
noncomputable def HEq.ndrec.{u1, u2} {α : Sort u2} {a : α} {motive : {β : Sort u2} β Sort u1} (m : motive a) {β : Sort u2} {b : β} (h : HEq a b) : motive b :=
theorem HEq.ndrec.{u1, u2} {α : Sort u2} {a : α} {motive : {β : Sort u2} β Sort u1} (m : motive a) {β : Sort u2} {b : β} (h : HEq a b) : motive b :=
h.rec m
/-- `HEq.ndrec` variant -/
noncomputable def HEq.ndrecOn.{u1, u2} {α : Sort u2} {a : α} {motive : {β : Sort u2} β Sort u1} {β : Sort u2} {b : β} (h : HEq a b) (m : motive a) : motive b :=
theorem HEq.ndrecOn.{u1, u2} {α : Sort u2} {a : α} {motive : {β : Sort u2} β Sort u1} {β : Sort u2} {b : β} (h : HEq a b) (m : motive a) : motive b :=
h.rec m
/-- `HEq.ndrec` variant -/
noncomputable def HEq.elim {α : Sort u} {a : α} {p : α Sort v} {b : α} (h₁ : HEq a b) (h₂ : p a) : p b :=
theorem HEq.elim {α : Sort u} {a : α} {p : α Sort v} {b : α} (h₁ : HEq a b) (h₂ : p a) : p b :=
eq_of_heq h₁ h₂
theorem HEq.subst {p : (T : Sort u) T Prop} (h₁ : HEq a b) (h₂ : p α a) : p β b :=
HEq.ndrecOn h₁ h₂
@[symm] theorem HEq.symm (h : HEq a b) : HEq b a :=
theorem HEq.symm (h : HEq a b) : HEq b a :=
h.rec (HEq.refl a)
theorem heq_of_eq (h : a = a') : HEq a a' :=
@@ -812,15 +805,15 @@ instance : Trans Iff Iff Iff where
theorem Eq.comm {a b : α} : a = b b = a := Iff.intro Eq.symm Eq.symm
theorem eq_comm {a b : α} : a = b b = a := Eq.comm
@[symm] theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.comm: (a b) (b a) := Iff.intro Iff.symm Iff.symm
theorem iff_comm : (a b) (b a) := Iff.comm
@[symm] theorem And.symm : a b b a := fun ha, hb => hb, ha
theorem And.symm : a b b a := fun ha, hb => hb, ha
theorem And.comm : a b b a := Iff.intro And.symm And.symm
theorem and_comm : a b b a := And.comm
@[symm] theorem Or.symm : a b b a := .rec .inr .inl
theorem Or.symm : a b b a := .rec .inr .inl
theorem Or.comm : a b b a := Iff.intro Or.symm Or.symm
theorem or_comm : a b b a := Or.comm
@@ -1091,23 +1084,19 @@ def InvImage {α : Sort u} {β : Sort v} (r : β → β → Prop) (f : α → β
fun a₁ a₂ => r (f a₁) (f a₂)
/--
The transitive closure `TransGen r` of a relation `r` is the smallest relation which is
transitive and contains `r`. `TransGen r a z` if and only if there exists a sequence
The transitive closure `r` of a relation `r` is the smallest relation which is
transitive and contains `r`. `r a z` if and only if there exists a sequence
`a r b r ... r z` of length at least 1 connecting `a` to `z`.
-/
inductive Relation.TransGen {α : Sort u} (r : α α Prop) : α α Prop
/-- If `r a b` then `TransGen r a b`. This is the base case of the transitive closure. -/
| single {a b} : r a b TransGen r a b
inductive TC {α : Sort u} (r : α α Prop) : α α Prop where
/-- If `r a b` then `r a b`. This is the base case of the transitive closure. -/
| base : a b, r a b TC r a b
/-- The transitive closure is transitive. -/
| tail {a b c} : TransGen r a b r b c TransGen r a c
/-- Deprecated synonym for `Relation.TransGen`. -/
@[deprecated Relation.TransGen (since := "2024-07-16")] abbrev TC := @Relation.TransGen
| trans : a b c, TC r a b TC r b c TC r a c
/-! # Subtype -/
namespace Subtype
theorem existsOfSubtype {α : Type u} {p : α Prop} : { x // p x } Exists (fun x => p x)
| a, h => a, h
@@ -1120,6 +1109,9 @@ theorem eta (a : {x // p x}) (h : p (val a)) : mk (val a) h = a := by
cases a
exact rfl
instance {α : Type u} {p : α Prop} {a : α} (h : p a) : Inhabited {x // p x} where
default := a, h
instance {α : Type u} {p : α Prop} [DecidableEq α] : DecidableEq {x : α // p x} :=
fun a, h₁ b, h₂ =>
if h : a = b then isTrue (by subst h; exact rfl)
@@ -1179,7 +1171,7 @@ def Prod.lexLt [LT α] [LT β] (s : α × β) (t : α × β) : Prop :=
s.1 < t.1 (s.1 = t.1 s.2 < t.2)
instance Prod.lexLtDec
[LT α] [LT β] [DecidableEq α]
[LT α] [LT β] [DecidableEq α] [DecidableEq β]
[(a b : α) Decidable (a < b)] [(a b : β) Decidable (a < b)]
: (s t : α × β) Decidable (Prod.lexLt s t) :=
fun _ _ => inferInstanceAs (Decidable (_ _))
@@ -1197,20 +1189,11 @@ def Prod.map {α₁ : Type u₁} {α₂ : Type u₂} {β₁ : Type v₁} {β₂
(f : α₁ α₂) (g : β₁ β₂) : α₁ × β₁ α₂ × β₂
| (a, b) => (f a, g b)
@[simp] theorem Prod.map_apply (f : α β) (g : γ δ) (x) (y) :
Prod.map f g (x, y) = (f x, g y) := rfl
@[simp] theorem Prod.map_fst (f : α β) (g : γ δ) (x) : (Prod.map f g x).1 = f x.1 := rfl
@[simp] theorem Prod.map_snd (f : α β) (g : γ δ) (x) : (Prod.map f g x).2 = g x.2 := rfl
/-! # Dependent products -/
theorem Exists.of_psigma_prop {α : Sort u} {p : α Prop} : (PSigma (fun x => p x)) Exists (fun x => p x)
theorem ex_of_PSigma {α : Type u} {p : α Prop} : (PSigma (fun x => p x)) Exists (fun x => p x)
| x, hx => x, hx
@[deprecated Exists.of_psigma_prop (since := "2024-07-27")]
theorem ex_of_PSigma {α : Type u} {p : α Prop} : (PSigma (fun x => p x)) Exists (fun x => p x) :=
Exists.of_psigma_prop
protected theorem PSigma.eta {α : Sort u} {β : α Sort v} {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂}
(h₁ : a₁ = a₂) (h₂ : Eq.ndrec b₁ h₁ = b₂) : PSigma.mk a₁ b₁ = PSigma.mk a₂ b₂ := by
subst h₁
@@ -1320,6 +1303,7 @@ gen_injective_theorems% Fin
gen_injective_theorems% Array
gen_injective_theorems% Sum
gen_injective_theorems% PSum
gen_injective_theorems% Nat
gen_injective_theorems% Option
gen_injective_theorems% List
gen_injective_theorems% Except
@@ -1327,12 +1311,6 @@ gen_injective_theorems% EStateM.Result
gen_injective_theorems% Lean.Name
gen_injective_theorems% Lean.Syntax
theorem Nat.succ.inj {m n : Nat} : m.succ = n.succ m = n :=
fun x => Nat.noConfusion x id
theorem Nat.succ.injEq (u v : Nat) : (u.succ = v.succ) = (u = v) :=
Eq.propIntro Nat.succ.inj (congrArg Nat.succ)
@[simp] theorem beq_iff_eq [BEq α] [LawfulBEq α] (a b : α) : a == b a = b :=
eq_of_beq, by intro h; subst h; exact LawfulBEq.rfl
@@ -1372,9 +1350,6 @@ theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_fa
theorem of_iff_true (h : a True) : a := h.mpr trivial
theorem iff_true_intro (h : a) : a True := iff_of_true h trivial
theorem eq_iff_true_of_subsingleton [Subsingleton α] (x y : α) : x = y True :=
iff_true_intro (Subsingleton.elim ..)
theorem not_of_iff_false : (p False) ¬p := Iff.mp
theorem iff_false_intro (h : ¬a) : a False := iff_of_false h id
@@ -1428,9 +1403,9 @@ theorem false_imp_iff (a : Prop) : (False → a) ↔ True := iff_true_intro Fals
theorem true_imp_iff (α : Prop) : (True α) α := imp_iff_right True.intro
@[simp high] theorem imp_self : (a a) True := iff_true_intro id
@[simp] theorem imp_self : (a a) True := iff_true_intro id
@[simp] theorem imp_false : (a False) ¬a := Iff.rfl
theorem imp_false : (a False) ¬a := Iff.rfl
theorem imp.swap : (a b c) (b a c) := Iff.intro flip flip
@@ -1552,7 +1527,7 @@ protected abbrev rec
(q : Quot r) : motive q :=
Eq.ndrecOn (Quot.liftIndepPr1 f h q) ((lift (Quot.indep f) (Quot.indepCoherent f h) q).2)
@[inherit_doc Quot.rec, elab_as_elim] protected abbrev recOn
@[inherit_doc Quot.rec] protected abbrev recOn
(q : Quot r)
(f : (a : α) motive (Quot.mk r a))
(h : (a b : α) (p : r a b) Eq.ndrec (f a) (sound p) = f b)
@@ -1563,7 +1538,7 @@ protected abbrev rec
Dependent induction principle for a quotient, when the target type is a `Subsingleton`.
In this case the quotient's side condition is trivial so any function can be lifted.
-/
@[elab_as_elim] protected abbrev recOnSubsingleton
protected abbrev recOnSubsingleton
[h : (a : α) Subsingleton (motive (Quot.mk r a))]
(q : Quot r)
(f : (a : α) motive (Quot.mk r a))
@@ -1616,7 +1591,7 @@ protected def mk' {α : Sort u} [s : Setoid α] (a : α) : Quotient s :=
The analogue of `Quot.sound`: If `a` and `b` are related by the equivalence relation,
then they have equal equivalence classes.
-/
theorem sound {α : Sort u} {s : Setoid α} {a b : α} : a b Quotient.mk s a = Quotient.mk s b :=
def sound {α : Sort u} {s : Setoid α} {a b : α} : a b Quotient.mk s a = Quotient.mk s b :=
Quot.sound
/--
@@ -1880,7 +1855,7 @@ instance : Subsingleton (Squash α) where
/--
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
-/
class Antisymm {α : Sort u} (r : α α Prop) : Prop where
class Antisymm {α : Sort u} (r : α α Prop) where
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
antisymm {a b : α} : r a b r b a a = b
@@ -2055,8 +2030,4 @@ class LawfulCommIdentity (op : ααα) (o : outParam α) [hc : Commuta
left_id a := Eq.trans (hc.comm o a) (right_id a)
right_id a := Eq.trans (hc.comm a o) (left_id a)
instance : Commutative Or := fun _ _ => propext or_comm
instance : Commutative And := fun _ _ => propext and_comm
instance : Commutative Iff := fun _ _ => propext iff_comm
end Std

View File

@@ -14,7 +14,6 @@ import Init.Data.String
import Init.Data.List
import Init.Data.Int
import Init.Data.Array
import Init.Data.Array.Subarray.Split
import Init.Data.ByteArray
import Init.Data.FloatArray
import Init.Data.Fin
@@ -34,6 +33,3 @@ import Init.Data.AC
import Init.Data.Queue
import Init.Data.Channel
import Init.Data.Cast
import Init.Data.Sum
import Init.Data.BEq
import Init.Data.Subtype

View File

@@ -106,7 +106,7 @@ def norm [info : ContextInformation α] (ctx : α) (e : Expr) : List Nat :=
let xs := if info.isComm ctx then sort xs else xs
if info.isIdem ctx then mergeIdem xs else xs
noncomputable def List.two_step_induction
theorem List.two_step_induction
{motive : List Nat Sort u}
(l : List Nat)
(empty : motive [])
@@ -146,8 +146,8 @@ theorem Context.evalList_mergeIdem (ctx : Context α) (h : ContextInformation.is
| nil =>
simp [mergeIdem, mergeIdem.loop]
split
next h₂ => simp [evalList, h₂, h.1, EvalInformation.evalOp]
next => rfl
case inl h₂ => simp [evalList, h₂, h.1, EvalInformation.evalOp]
rfl
| cons z zs =>
by_cases h₂ : x = y
case pos =>
@@ -191,11 +191,11 @@ theorem Context.evalList_insert
. simp [evalList, h.1, EvalInformation.evalOp]
| step y z zs ih =>
simp [insert] at *; split
next => rfl
next =>
case inl => rfl
case inr =>
split
next => simp [evalList, EvalInformation.evalOp]; rw [h.1, ctx.assoc.1, h.1 (evalList _ _ _)]
next => simp_all [evalList, EvalInformation.evalOp]; rw [h.1, ctx.assoc.1, h.1 (evalList _ _ _)]
case inl => simp [evalList, EvalInformation.evalOp]; rw [h.1, ctx.assoc.1, h.1 (evalList _ _ _)]
case inr => simp_all [evalList, EvalInformation.evalOp]; rw [h.1, ctx.assoc.1, h.1 (evalList _ _ _)]
theorem Context.evalList_sort_congr
(ctx : Context α)

View File

@@ -10,7 +10,5 @@ import Init.Data.Array.BinSearch
import Init.Data.Array.InsertionSort
import Init.Data.Array.DecidableEq
import Init.Data.Array.Mem
import Init.Data.Array.Attach
import Init.Data.Array.BasicAux
import Init.Data.Array.Lemmas
import Init.Data.Array.TakeDrop

View File

@@ -1,29 +0,0 @@
/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner, Mario Carneiro
-/
prelude
import Init.Data.Array.Mem
import Init.Data.List.Attach
namespace Array
/--
Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
`Array {x // P x}` is the same as the input `Array α`.
-/
@[inline] private unsafe def attachWithImpl
(xs : Array α) (P : α Prop) (_ : x xs, P x) : Array {x // P x} := unsafeCast xs
/-- `O(1)`. "Attach" a proof `P x` that holds for all the elements of `xs` to produce a new array
with the same elements but in the type `{x // P x}`. -/
@[implemented_by attachWithImpl] def attachWith
(xs : Array α) (P : α Prop) (H : x xs, P x) : Array {x // P x} :=
xs.data.attachWith P fun x h => H x (Array.Mem.mk h)
/-- `O(1)`. "Attach" the proof that the elements of `xs` are in `xs` to produce a new array
with the same elements but in the type `{x // x ∈ xs}`. -/
@[inline] def attach (xs : Array α) : Array {x // x xs} := xs.attachWith _ fun _ => id
end Array

View File

@@ -10,7 +10,7 @@ import Init.Data.Fin.Basic
import Init.Data.UInt.Basic
import Init.Data.Repr
import Init.Data.ToString.Basic
import Init.GetElem
import Init.Util
universe u v w
namespace Array
@@ -31,7 +31,6 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
go (i : Nat) (acc : Array α) : Array α :=
if h : i < n then go (i+1) (acc.push (f i, h)) else acc
termination_by n - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
/-- The array `#[0, 1, ..., n - 1]`. -/
def range (n : Nat) : Array Nat :=
@@ -44,23 +43,16 @@ instance : EmptyCollection (Array α) := ⟨Array.empty⟩
instance : Inhabited (Array α) where
default := Array.empty
@[simp] def isEmpty (a : Array α) : Bool :=
def isEmpty (a : Array α) : Bool :=
a.size = 0
def singleton (v : α) : Array α :=
mkArray 1 v
/-- Low-level version of `size` that directly queries the C array object cached size.
While this is not provable, `usize` always returns the exact size of the array since
the implementation only supports arrays of size less than `USize.size`.
-/
@[extern "lean_array_size", simp]
def usize (a : @& Array α) : USize := a.size.toUSize
/-- Low-level version of `fget` which is as fast as a C array read.
`Fin` values are represented as tag pointers in the Lean runtime. Thus,
`fget` may be slightly slower than `uget`. -/
@[extern "lean_array_uget", simp]
@[extern "lean_array_uget"]
def uget (a : @& Array α) (i : USize) (h : i.toNat < a.size) : α :=
a[i.toNat]
@@ -108,7 +100,7 @@ def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
a'.set (size_set a i v₂ j) v₁
/--
Swaps two entries in an array, or returns the array unchanged if either index is out of bounds.
Swaps two entries in an array, or panics if either index is out of bounds.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
@@ -181,7 +173,7 @@ def modifyOp (self : Array α) (idx : Nat) (f : αα) : Array α :=
This kind of low level trick can be removed with a little bit of compiler support. For example, if the compiler simplifies `as.size < usizeSz` to true. -/
@[inline] unsafe def forInUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (b : β) (f : α β m (ForInStep β)) : m β :=
let sz := as.usize
let sz := USize.ofNat as.size
let rec @[specialize] loop (i : USize) (b : β) : m β := do
if i < sz then
let a := as.uget i lcProof
@@ -287,7 +279,7 @@ def foldrM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
/-- See comment at `forInUnsafe` -/
@[inline]
unsafe def mapMUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m β) (as : Array α) : m (Array β) :=
let sz := as.usize
let sz := USize.ofNat as.size
let rec @[specialize] map (i : USize) (r : Array NonScalar) : m (Array PNonScalar.{v}) := do
if i < sz then
let v := r.uget i lcProof
@@ -312,7 +304,6 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
else
pure r
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
@[inline]
@@ -385,7 +376,6 @@ def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as :
else
pure false
termination_by stop - j
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop start
if h : stop as.size then
any stop h
@@ -466,13 +456,24 @@ def findRev? {α : Type} (as : Array α) (p : α → Bool) : Option α :=
@[inline]
def findIdx? {α : Type u} (as : Array α) (p : α Bool) : Option Nat :=
let rec loop (j : Nat) :=
if h : j < as.size then
if p as[j] then some j else loop (j + 1)
else none
termination_by as.size - j
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop 0
let rec loop (i : Nat) (j : Nat) (inv : i + j = as.size) : Option Nat :=
if hlt : j < as.size then
match i, inv with
| 0, inv => by
apply False.elim
rw [Nat.zero_add] at inv
rw [inv] at hlt
exact absurd hlt (Nat.lt_irrefl _)
| i+1, inv =>
if p as[j] then
some j
else
have : i + (j+1) = as.size := by
rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
loop i (j+1) this
else
none
loop as.size 0 rfl
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v
@@ -486,7 +487,7 @@ def all (as : Array α) (p : α → Bool) (start := 0) (stop := as.size) : Bool
Id.run <| as.allM p start stop
def contains [BEq α] (as : Array α) (a : α) : Bool :=
as.any (· == a)
as.any fun b => a == b
def elem [BEq α] (a : α) (as : Array α) : Bool :=
as.contains a
@@ -566,7 +567,6 @@ def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : αα → Bool) (
else
true
termination_by a.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def isEqv (a b : Array α) (p : α α Bool) : Bool :=
if h : a.size = b.size then
@@ -671,7 +671,6 @@ def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size)
else indexOfAux a v (i+1)
else none
termination_by a.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@@ -714,7 +713,6 @@ def popWhile (p : α → Bool) (as : Array α) : Array α :=
else
as
termination_by as.size
decreasing_by simp_wf; decreasing_trivial_pre_omega
def takeWhile (p : α Bool) (as : Array α) : Array α :=
let rec go (i : Nat) (r : Array α) : Array α :=
@@ -727,38 +725,35 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
else
r
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
go 0 #[]
/-- Remove the element at a given index from an array without bounds checks, using a `Fin` index.
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
if h : i.val + 1 < a.size then
let a' := a.swap i.val + 1, h i
let i' : Fin a'.size := i.val + 1, by simp [a', h]
a'.feraseIdx i'
def eraseIdxAux (i : Nat) (a : Array α) : Array α :=
if h : i < a.size then
let idx : Fin a.size := i, h;
let idx1 : Fin a.size := i - 1, by exact Nat.lt_of_le_of_lt (Nat.pred_le i) h;
let a' := a.swap idx idx1
eraseIdxAux (i+1) a'
else
a.pop
termination_by a.size - i.val
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ i.isLt
termination_by a.size - i
theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
induction a, i using Array.feraseIdx.induct with
| @case1 a i h a' _ ih =>
unfold feraseIdx
simp [h, a', ih]
| case2 a i h =>
unfold feraseIdx
simp [h]
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
eraseIdxAux (i.val + 1) a
/-- Remove the element at a given index from an array, or do nothing if the index is out of bounds.
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
def eraseIdx (a : Array α) (i : Nat) : Array α :=
if h : i < a.size then a.feraseIdx i, h else a
if i < a.size then eraseIdxAux (i+1) a else a
def eraseIdxSzAux (a : Array α) (i : Nat) (r : Array α) (heq : r.size = a.size) : { r : Array α // r.size = a.size - 1 } :=
if h : i < r.size then
let idx : Fin r.size := i, h;
let idx1 : Fin r.size := i - 1, by exact Nat.lt_of_le_of_lt (Nat.pred_le i) h;
eraseIdxSzAux a (i+1) (r.swap idx idx1) ((size_swap r idx idx1).trans heq)
else
r.pop, (size_pop r).trans (heq rfl)
termination_by r.size - i
def eraseIdx' (a : Array α) (i : Fin a.size) : { r : Array α // r.size = a.size - 1 } :=
eraseIdxSzAux a (i.val + 1) a rfl
def erase [BEq α] (as : Array α) (a : α) : Array α :=
match as.indexOf? a with
@@ -775,7 +770,6 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
else
as
termination_by j.1
decreasing_by simp_wf; decreasing_trivial_pre_omega
let j := as.size
let as := as.push a
loop as j, size_push .. j.lt_succ_self
@@ -796,11 +790,11 @@ def toArrayLit (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
theorem ext' {as bs : Array α} (h : as.data = bs.data) : as = bs := by
cases as; cases bs; simp at h; rw [h]
@[simp] theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).data = acc.data ++ as := by
theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).data = acc.data ++ as := by
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
theorem data_toArray (as : List α) : as.toArray.data = as := by
simp [List.toArray, Array.mkEmpty]
simp [List.toArray, toArrayAux_eq, Array.mkEmpty]
theorem toArrayLit_eq (as : Array α) (n : Nat) (hsz : as.size = n) : as = toArrayLit as n hsz := by
apply ext'
@@ -815,7 +809,7 @@ where
rfl
go (i : Nat) (hi : i as.size) : toListLitAux as n hsz i hi (as.data.drop i) = as.data := by
induction i <;> simp [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
cases i <;> simp [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, go]
def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size bs.size) (i : Nat) : Bool :=
if h : i < as.size then
@@ -829,7 +823,6 @@ def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) (i : N
else
true
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
/-- Return true iff `as` is a prefix of `bs`.
That is, `bs = as ++ t` for some `t : List α`.-/
@@ -851,7 +844,6 @@ private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
else
true
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
def allDiff [BEq α] (as : Array α) : Bool :=
allDiffAux as 0
@@ -867,7 +859,6 @@ def allDiff [BEq α] (as : Array α) : Bool :=
else
cs
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α β γ) : Array γ :=
zipWithAux f as bs 0 #[]

View File

@@ -9,7 +9,7 @@ import Init.Data.Nat.Linear
import Init.NotationExtra
theorem Array.of_push_eq_push {as bs : Array α} (h : as.push a = bs.push b) : as = bs a = b := by
simp only [push, mk.injEq] at h
simp [push] at h
have h₁, h₂ := List.of_concat_eq_concat h
cases as; cases bs
simp_all
@@ -48,7 +48,6 @@ where
let b f as[i]
go (i+1) acc.val.push b, by simp [acc.property] hlt
termination_by as.size - i
decreasing_by decreasing_trivial_pre_omega
@[inline] private unsafe def mapMonoMImp [Monad m] (as : Array α) (f : α m α) : m (Array α) :=
go 0 as

View File

@@ -21,25 +21,22 @@ theorem eq_of_isEqvAux [DecidableEq α] (a b : Array α) (hsz : a.size = b.size)
subst heq
exact absurd (Nat.lt_of_lt_of_le high low) (Nat.lt_irrefl j)
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) : Array.isEqv a b (fun x y => x = y) a = b := by
simp [Array.isEqv]
split
next hsz =>
case inr => intro; contradiction
case inl hsz =>
intro h
have aux := eq_of_isEqvAux a b hsz 0 (Nat.zero_le ..) h
exact ext a b hsz fun i h _ => aux i (Nat.zero_le ..) _
next => intro; contradiction
theorem isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) : Array.isEqvAux a a rfl (fun x y => x = y) i = true := by
unfold Array.isEqvAux
split
next h => simp [h, isEqvAux_self a (i+1)]
next h => simp [h]
case inl h => simp [h, isEqvAux_self a (i+1)]
case inr h => simp [h]
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (fun x y => x = y) = true := by
simp [isEqv, isEqvAux_self]

View File

@@ -5,41 +5,28 @@ Authors: Mario Carneiro
-/
prelude
import Init.Data.Nat.MinMax
import Init.Data.Nat.Lemmas
import Init.Data.List.Monadic
import Init.Data.List.Lemmas
import Init.Data.Fin.Basic
import Init.Data.Array.Mem
import Init.TacticsExtra
/-!
## Bootstrapping theorems about arrays
This file contains some theorems about `Array` and `List` needed for `Init.Data.List.Impl`.
This file contains some theorems about `Array` and `List` needed for `Std.List.Basic`.
-/
namespace Array
attribute [simp] data_toArray uset
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
@[simp] theorem toArray_data : (a : Array α) a.data.toArray = a
| l => ext' (data_toArray l)
@[simp] theorem data_length {l : Array α} : l.data.length = l.size := rfl
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
theorem getElem_eq_data_getElem (a : Array α) (h : i < a.size) : a[i] = a.data[i] := by
by_cases i < a.size <;> (try simp [*]) <;> rfl
@[deprecated getElem_eq_data_getElem (since := "2024-06-12")]
theorem getElem_eq_data_get (a : Array α) (h : i < a.size) : a[i] = a.data.get i, h := by
simp [getElem_eq_data_getElem]
by_cases i < a.size <;> (try simp [*]) <;> rfl
theorem foldlM_eq_foldlM_data.aux [Monad m]
(f : β α m β) (arr : Array α) (i j) (H : arr.size i + j) (b) :
@@ -51,7 +38,7 @@ theorem foldlM_eq_foldlM_data.aux [Monad m]
simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H]
rw (config := {occs := .pos [2]}) [ List.get_drop_eq_drop _ _ _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
theorem foldlM_eq_foldlM_data [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
@@ -118,11 +105,11 @@ theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α)
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_data_getElem, List.concat_eq_append, List.getElem_append_left, h]
simp only [push, getElem_eq_data_get, List.concat_eq_append, List.get_append_left, h]
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_data_getElem, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_data_getElem, Nat.zero_lt_one]
simp only [push, getElem_eq_data_get, List.concat_eq_append]
rw [List.get_append_right] <;> simp [getElem_eq_data_get, Nat.zero_lt_one]
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
@@ -139,11 +126,9 @@ where
mapM.map f arr i r = (arr.data.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
unfold mapM.map; split
· rw [ List.get_drop_eq_drop _ i _]
simp only [aux (i + 1), map_eq_pure_bind, data_length, List.foldlM_cons, bind_assoc, pure_bind]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
simp [aux (i+1), map_eq_pure_bind]; rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
termination_by arr.size - i
decreasing_by decreasing_trivial_pre_omega
@[simp] theorem map_data (f : α β) (arr : Array α) : (arr.map f).data = arr.data.map f := by
rw [map, mapM_eq_foldlM]
@@ -153,8 +138,7 @@ where
simp [H]
@[simp] theorem size_map (f : α β) (arr : Array α) : (arr.map f).size = arr.size := by
simp only [ data_length]
simp
simp [size]
@[simp] theorem pop_data (arr : Array α) : arr.pop.data = arr.data.dropLast := rfl
@@ -201,874 +185,3 @@ theorem anyM_stop_le_start [Monad m] (p : α → m Bool) (as : Array α) (start
theorem mem_def (a : α) (as : Array α) : a as a as.data :=
fun | .mk h => h, Array.Mem.mk
/-! # get -/
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
theorem getElem?_lt
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some (a[i]) := dif_pos h
theorem getElem?_ge
(a : Array α) {i : Nat} (h : i a.size) : a[i]? = none := dif_neg (Nat.not_lt_of_le h)
@[simp] theorem get?_eq_getElem? (a : Array α) (i : Nat) : a.get? i = a[i]? := rfl
theorem getElem?_len_le (a : Array α) {i : Nat} (h : a.size i) : a[i]? = none := by
simp [getElem?_ge, h]
theorem getD_get? (a : Array α) (i : Nat) (d : α) :
Option.getD a[i]? d = if p : i < a.size then a[i]'p else d := by
if h : i < a.size then
simp [setD, h, getElem?_def]
else
have p : i a.size := Nat.le_of_not_gt h
simp [setD, getElem?_len_le _ p, h]
@[simp] theorem getD_eq_get? (a : Array α) (n d) : a.getD n d = (a[n]?).getD d := by
simp only [getD, get_eq_getElem, get?_eq_getElem?]; split <;> simp [getD_get?, *]
theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) : a.get! i = (a.get? i).getD default := by
by_cases p : i < a.size <;> simp [getD_get?, get!_eq_getD, p]
/-! # set -/
@[simp] theorem getElem_set_eq (a : Array α) (i : Fin a.size) (v : α) {j : Nat}
(eq : i.val = j) (p : j < (a.set i v).size) :
(a.set i v)[j]'p = v := by
simp [set, getElem_eq_data_getElem, eq]
@[simp] theorem getElem_set_ne (a : Array α) (i : Fin a.size) (v : α) {j : Nat} (pj : j < (a.set i v).size)
(h : i.val j) : (a.set i v)[j]'pj = a[j]'(size_set a i v pj) := by
simp only [set, getElem_eq_data_getElem, List.getElem_set_ne h]
theorem getElem_set (a : Array α) (i : Fin a.size) (v : α) (j : Nat)
(h : j < (a.set i v).size) :
(a.set i v)[j]'h = if i = j then v else a[j]'(size_set a i v h) := by
by_cases p : i.1 = j <;> simp [p]
@[simp] theorem getElem?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1]? = v := by simp [getElem?_lt, i.2]
@[simp] theorem getElem?_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α)
(ne : i.val j) : (a.set i v)[j]? = a[j]? := by
by_cases h : j < a.size <;> simp [getElem?_lt, getElem?_ge, Nat.ge_of_not_lt, ne, h]
/-! # setD -/
@[simp] theorem set!_is_setD : @set! = @setD := rfl
@[simp] theorem size_setD (a : Array α) (index : Nat) (val : α) :
(Array.setD a index val).size = a.size := by
if h : index < a.size then
simp [setD, h]
else
simp [setD, h]
@[simp] theorem getElem_setD_eq (a : Array α) {i : Nat} (v : α) (h : _) :
(setD a i v)[i]'h = v := by
simp at h
simp only [setD, h, dite_true, getElem_set, ite_true]
@[simp]
theorem getElem?_setD_eq (a : Array α) {i : Nat} (p : i < a.size) (v : α) : (a.setD i v)[i]? = some v := by
simp [getElem?_lt, p]
/-- Simplifies a normal form from `get!` -/
@[simp] theorem getD_get?_setD (a : Array α) (i : Nat) (v d : α) :
Option.getD (setD a i v)[i]? d = if i < a.size then v else d := by
by_cases h : i < a.size <;>
simp [setD, Nat.not_lt_of_le, h, getD_get?]
/-! # ofFn -/
@[simp] theorem size_ofFn_go {n} (f : Fin n α) (i acc) :
(ofFn.go f i acc).size = acc.size + (n - i) := by
if hin : i < n then
unfold ofFn.go
have : 1 + (n - (i + 1)) = n - i :=
Nat.sub_sub .. Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. hin))
rw [dif_pos hin, size_ofFn_go f (i+1), size_push, Nat.add_assoc, this]
else
have : n - i = 0 := Nat.sub_eq_zero_of_le (Nat.le_of_not_lt hin)
unfold ofFn.go
simp [hin, this]
termination_by n - i
@[simp] theorem size_ofFn (f : Fin n α) : (ofFn f).size = n := by simp [ofFn]
theorem getElem_ofFn_go (f : Fin n α) (i) {acc k}
(hki : k < n) (hin : i n) (hi : i = acc.size)
(hacc : j, hj : j < acc.size, acc[j] = f j, Nat.lt_of_lt_of_le hj (hi hin)) :
haveI : acc.size + (n - acc.size) = n := Nat.add_sub_cancel' (hi hin)
(ofFn.go f i acc)[k]'(by simp [*]) = f k, hki := by
unfold ofFn.go
if hin : i < n then
have : 1 + (n - (i + 1)) = n - i :=
Nat.sub_sub .. Nat.add_sub_cancel' (Nat.le_sub_of_add_le (Nat.add_comm .. hin))
simp only [dif_pos hin]
rw [getElem_ofFn_go f (i+1) _ hin (by simp [*]) (fun j hj => ?hacc)]
cases (Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ (by simpa using hj)) with
| inl hj => simp [get_push, hj, hacc j hj]
| inr hj => simp [get_push, *]
else
simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi hin)))]
termination_by n - i
@[simp] theorem getElem_ofFn (f : Fin n α) (i : Nat) (h) :
(ofFn f)[i] = f i, size_ofFn f h :=
getElem_ofFn_go _ _ _ (by simp) (by simp) nofun
/-- # mkArray -/
@[simp] theorem mkArray_data (n : Nat) (v : α) : (mkArray n v).data = List.replicate n v := rfl
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
(mkArray n v)[i] = v := by simp [Array.getElem_eq_data_getElem]
/-- # mem -/
theorem mem_data {a : α} {l : Array α} : a l.data a l := (mem_def _ _).symm
theorem not_mem_nil (a : α) : ¬ a #[] := nofun
/-- # get lemmas -/
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] l := by
erw [Array.mem_def, getElem_eq_data_getElem]
apply List.get_mem
theorem getElem_fin_eq_data_get (a : Array α) (i : Fin _) : a[i] = a.data.get i := rfl
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
a[i] = a[i.toNat] := rfl
theorem getElem?_eq_getElem (a : Array α) (i : Nat) (h : i < a.size) : a[i]? = a[i] :=
getElem?_pos ..
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size i) : a[i]? = none := by
simp [getElem?_neg, h]
theorem getElem_mem_data (a : Array α) (h : i < a.size) : a[i] a.data := by
simp only [getElem_eq_data_getElem, List.getElem_mem]
theorem getElem?_eq_data_get? (a : Array α) (i : Nat) : a[i]? = a.data.get? i := by
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]; rfl
theorem get?_eq_data_get? (a : Array α) (i : Nat) : a.get? i = a.data.get? i :=
getElem?_eq_data_get? ..
theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
simp [get!_eq_getD]
@[simp] theorem back_eq_back? [Inhabited α] (a : Array α) : a.back = a.back?.getD default := by
simp [back, back?]
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
simp [back?, getElem?_eq_data_get?]
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
theorem get?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
(a.push x)[i]? = some a[i] := by
rw [getElem?_pos, get_push_lt]
theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
rw [getElem?_pos, get_push_eq]
theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by
match Nat.lt_trichotomy i a.size with
| Or.inl g =>
have h1 : i < a.size + 1 := by omega
have h2 : i a.size := by omega
simp [getElem?_def, size_push, g, h1, h2, get_push_lt]
| Or.inr (Or.inl heq) =>
simp [heq, getElem?_pos, get_push_eq]
| Or.inr (Or.inr g) =>
simp only [getElem?_def, size_push]
have h1 : ¬ (i < a.size) := by omega
have h2 : ¬ (i < a.size + 1) := by omega
have h3 : i a.size := by omega
simp [h1, h2, h3]
@[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by
simp only [getElem?_def, Nat.lt_irrefl, dite_false]
@[simp] theorem data_set (a : Array α) (i v) : (a.set i v).data = a.data.set i.1 v := rfl
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1] = v := by
simp only [set, getElem_eq_data_getElem, List.getElem_set_eq]
theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2]
@[simp] theorem get?_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α)
(h : i.1 j) : (a.set i v)[j]? = a[j]? := by
by_cases j < a.size <;> simp [getElem?_pos, getElem?_neg, *]
theorem get?_set (a : Array α) (i : Fin a.size) (j : Nat) (v : α) :
(a.set i v)[j]? = if i.1 = j then some v else a[j]? := by
if h : i.1 = j then subst j; simp [*] else simp [*]
theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v : α) :
(a.set i v)[j]'(by simp [*]) = if i = j then v else a[j] := by
if h : i.1 = j then subst j; simp [*] else simp [*]
@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size)
(h : i.1 j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
simp only [set, getElem_eq_data_getElem, List.getElem_set_ne h]
theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) :
(setD a i v)[i] = v := by
simp at h
simp only [setD, h, dite_true, get_set, ite_true]
theorem set_set (a : Array α) (i : Fin a.size) (v v' : α) :
(a.set i v).set i, by simp [i.2] v' = a.set i v' := by simp [set, List.set_set]
private theorem fin_cast_val (e : n = n') (i : Fin n) : e i = i.1, e i.2 := by cases e; rfl
theorem swap_def (a : Array α) (i j : Fin a.size) :
a.swap i j = (a.set i (a.get j)).set j.1, by simp [j.2] (a.get i) := by
simp [swap, fin_cast_val]
theorem data_swap (a : Array α) (i j : Fin a.size) :
(a.swap i j).data = (a.data.set i (a.get j)).set j (a.get i) := by simp [swap_def]
theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
if j = k then some a[i.1] else if i = k then some a[j.1] else a[k]? := by
simp [swap_def, get?_set, getElem_fin_eq_data_get]
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
a.swapAt i v = (a[i.1], a.set i v) := rfl
-- @[simp] -- FIXME: gives a weird linter error
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
a.swapAt! i v = (a[i], a.set i, h v) := by simp [swapAt!, h]
@[simp] theorem data_pop (a : Array α) : a.pop.data = a.data.dropLast := by simp [pop]
@[simp] theorem pop_empty : (#[] : Array α).pop = #[] := rfl
@[simp] theorem pop_push (a : Array α) : (a.push x).pop = a := by simp [pop]
@[simp] theorem getElem_pop (a : Array α) (i : Nat) (hi : i < a.pop.size) :
a.pop[i] = a[i]'(Nat.lt_of_lt_of_le (a.size_pop hi) (Nat.sub_le _ _)) :=
List.getElem_dropLast ..
theorem eq_empty_of_size_eq_zero {as : Array α} (h : as.size = 0) : as = #[] := by
apply ext
· simp [h]
· intros; contradiction
theorem eq_push_pop_back_of_size_ne_zero [Inhabited α] {as : Array α} (h : as.size 0) :
as = as.pop.push as.back := by
apply ext
· simp [Nat.sub_add_cancel (Nat.zero_lt_of_ne_zero h)]
· intros i h h'
if hlt : i < as.pop.size then
rw [get_push_lt (h:=hlt), getElem_pop]
else
have heq : i = as.pop.size :=
Nat.le_antisymm (size_pop .. Nat.le_pred_of_lt h) (Nat.le_of_not_gt hlt)
cases heq; rw [get_push_eq, back, size_pop, get!_eq_getD, getD, dif_pos h]; rfl
theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size 0) :
(bs : Array α) (c : α), as = bs.push c :=
let _ : Inhabited α := as[0]
as.pop, as.back, eq_push_pop_back_of_size_ne_zero h
theorem size_eq_length_data (as : Array α) : as.size = as.data.length := rfl
@[simp] theorem size_swap! (a : Array α) (i j) :
(a.swap! i j).size = a.size := by unfold swap!; split <;> (try split) <;> simp [size_swap]
@[simp] theorem size_reverse (a : Array α) : a.reverse.size = a.size := by
let rec go (as : Array α) (i j) : (reverse.loop as i j).size = as.size := by
rw [reverse.loop]
if h : i < j then
have := reverse.termination h
simp [(go · (i+1) j-1, ·), h]
else simp [h]
termination_by j - i
simp only [reverse]; split <;> simp [go]
@[simp] theorem size_range {n : Nat} : (range n).size = n := by
unfold range
induction n with
| zero => simp [Nat.fold]
| succ k ih =>
rw [Nat.fold, flip]
simp only [mkEmpty_eq, size_push] at *
omega
set_option linter.deprecated false in
@[simp] theorem reverse_data (a : Array α) : a.reverse.data = a.data.reverse := by
let rec go (as : Array α) (i j hj)
(h : i + j + 1 = a.size) (h₂ : as.size = a.size)
(H : k, as.data.get? k = if i k k j then a.data.get? k else a.data.reverse.get? k)
(k) : (reverse.loop as i j, hj).data.get? k = a.data.reverse.get? k := by
rw [reverse.loop]; dsimp; split <;> rename_i h₁
· have p := reverse.termination h₁
match j with | j+1 => ?_
simp only [Nat.add_sub_cancel] at p
rw [(go · (i+1) j)]
· rwa [Nat.add_right_comm i]
· simp [size_swap, h₂]
· intro k
rw [ getElem?_eq_data_get?, get?_swap]
simp only [H, getElem_eq_data_get, List.get?_eq_get, Nat.le_of_lt h₁, getElem?_eq_data_get?]
split <;> rename_i h₂
· simp only [ h₂, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, and_false]
exact (List.get?_reverse' (j+1) i (Eq.trans (by simp_arith) h)).symm
split <;> rename_i h₃
· simp only [ h₃, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, false_and]
exact (List.get?_reverse' i (j+1) (Eq.trans (by simp_arith) h)).symm
simp only [Nat.succ_le, Nat.lt_iff_le_and_ne.trans (and_iff_left h₃),
Nat.lt_succ.symm.trans (Nat.lt_iff_le_and_ne.trans (and_iff_left (Ne.symm h₂)))]
· rw [H]; split <;> rename_i h₂
· cases Nat.le_antisymm (Nat.not_lt.1 h₁) (Nat.le_trans h₂.1 h₂.2)
cases Nat.le_antisymm h₂.1 h₂.2
exact (List.get?_reverse' _ _ h).symm
· rfl
termination_by j - i
simp only [reverse]
split
· match a with | [] | [_] => rfl
· have := Nat.sub_add_cancel (Nat.le_of_not_le _)
refine List.ext_get? <| go _ _ _ _ (by simp [this]) rfl fun k => ?_
split
· rfl
· rename_i h
simp only [ show k < _ + 1 _ from Nat.lt_succ (n := a.size - 1), this, Nat.zero_le,
true_and, Nat.not_lt] at h
rw [List.get?_eq_none.2 _, List.get?_eq_none.2 (a.data.length_reverse _)]
/-! ### foldl / foldr -/
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
-- reproduced to avoid a dependency on `SatisfiesM`.
theorem foldl_induction
{as : Array α} (motive : Nat β Prop) {init : β} (h0 : motive 0 init) {f : β α β}
(hf : i : Fin as.size, b, motive i.1 b motive (i.1 + 1) (f b as[i])) :
motive as.size (as.foldl f init) := by
let rec go {i j b} (h₁ : j as.size) (h₂ : as.size i + j) (H : motive j b) :
(motive as.size) (foldlM.loop (m := Id) f as as.size (Nat.le_refl _) i j b) := by
unfold foldlM.loop; split
· next hj =>
split
· cases Nat.not_le_of_gt (by simp [hj]) h₂
· exact go hj (by rwa [Nat.succ_add] at h₂) (hf j, hj b H)
· next hj => exact Nat.le_antisymm h₁ (Nat.ge_of_not_lt hj) H
simpa [foldl, foldlM] using go (Nat.zero_le _) (Nat.le_refl _) h0
-- This proof is the pure version of `Array.SatisfiesM_foldrM`,
-- reproduced to avoid a dependency on `SatisfiesM`.
theorem foldr_induction
{as : Array α} (motive : Nat β Prop) {init : β} (h0 : motive as.size init) {f : α β β}
(hf : i : Fin as.size, b, motive (i.1 + 1) b motive i.1 (f as[i] b)) :
motive 0 (as.foldr f init) := by
let rec go {i b} (hi : i as.size) (H : motive i b) :
(motive 0) (foldrM.fold (m := Id) f as 0 i hi b) := by
unfold foldrM.fold; simp; split
· next hi => exact (hi H)
· next hi =>
split; {simp at hi}
· next i hi' =>
exact go _ (hf i, hi' b H)
simp [foldr, foldrM]; split; {exact go _ h0}
· next h => exact (Nat.eq_zero_of_not_pos h h0)
/-! ### map -/
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
simp only [mem_def, map_data, List.mem_map]
theorem mapM_eq_mapM_data [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = return mk ( arr.data.mapM f) := by
rw [mapM_eq_foldlM, foldlM_eq_foldlM_data, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.data]
induction arr.data.reverse with
| nil => simp; rfl
| cons a l ih => simp [ih]; simp [map_eq_pure_bind, push]
theorem mapM_map_eq_foldl (as : Array α) (f : α β) (i) :
mapM.map (m := Id) f as i b = as.foldl (start := i) (fun r a => r.push (f a)) b := by
unfold mapM.map
split <;> rename_i h
· simp only [Id.bind_eq]
dsimp [foldl, Id.run, foldlM]
rw [mapM_map_eq_foldl, dif_pos (by omega), foldlM.loop, dif_pos h]
-- Calling `split` here gives a bad goal.
have : size as - i = Nat.succ (size as - i - 1) := by omega
rw [this]
simp [foldl, foldlM, Id.run, Nat.sub_add_eq]
· dsimp [foldl, Id.run, foldlM]
rw [dif_pos (by omega), foldlM.loop, dif_neg h]
rfl
termination_by as.size - i
theorem map_eq_foldl (as : Array α) (f : α β) :
as.map f = as.foldl (fun r a => r.push (f a)) #[] :=
mapM_map_eq_foldl _ _ _
theorem map_induction (as : Array α) (f : α β) (motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop) (hs : i, motive i.1 p i (f as[i]) motive (i+1)) :
motive as.size
eq : (as.map f).size = as.size, i h, p i, h ((as.map f)[i]) := by
have t := foldl_induction (as := as) (β := Array β)
(motive := fun i arr => motive i arr.size = i i h2, p i arr[i.1])
(init := #[]) (f := fun r a => r.push (f a)) ?_ ?_
obtain m, eq, w := t
· refine m, by simpa [map_eq_foldl] using eq, ?_
intro i h
simp [eq] at w
specialize w i, h h
simpa [map_eq_foldl] using w
· exact h0, rfl, nofun
· intro i b m, eq, w
refine ?_, ?_, ?_
· exact (hs _ m).2
· simp_all
· intro j h
simp at h
by_cases h' : j < size b
· rw [get_push]
simp_all
· rw [get_push, dif_neg h']
simp only [show j = i by omega]
exact (hs _ m).1
theorem map_spec (as : Array α) (f : α β) (p : Fin as.size β Prop)
(hs : i, p i (f as[i])) :
eq : (as.map f).size = as.size, i h, p i, h ((as.map f)[i]) := by
simpa using map_induction as f (fun _ => True) trivial p (by simp_all)
@[simp] theorem getElem_map (f : α β) (as : Array α) (i : Nat) (h) :
((as.map f)[i]) = f (as[i]'(size_map .. h)) := by
have := map_spec as f (fun i b => b = f (as[i]))
simp only [implies_true, true_implies] at this
obtain eq, w := this
apply w
simp_all
/-! ### mapIdx -/
-- This could also be prove from `SatisfiesM_mapIdxM`.
theorem mapIdx_induction (as : Array α) (f : Fin as.size α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
let arr : Array β := Array.mapIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
induction i generalizing j bs with simp [mapIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
| succ i ih =>
apply @ih (bs.push (f j, by omega as[j])) (j + 1) (by omega) (by simp; omega)
· intro i i_lt h'
rw [get_push]
split
· apply h₂
· simp only [size_push] at h'
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
simp [mapIdx, mapIdxM]; exact go rfl nofun h0
theorem mapIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (a : Array α) (f : Fin a.size α β) : (a.mapIdx f).size = a.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapIdx _ _
@[simp] theorem getElem_mapIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapIdx a f).size) :
haveI : i < a.size := by simp_all
(a.mapIdx f)[i] = f i, this a[i] :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
/-! ### modify -/
@[simp] theorem size_modify (a : Array α) (i : Nat) (f : α α) : (a.modify i f).size = a.size := by
unfold modify modifyM Id.run
split <;> simp
theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
(arr.modify x f).get i, by simp [h] =
if x = i then f (arr.get i, h) else arr.get i, h := by
simp [modify, modifyM, Id.run]; split
· simp [get_set _ _ _ h]; split <;> simp [*]
· rw [if_neg (mt (by rintro rfl; exact h) _)]
/-! ### filter -/
@[simp] theorem filter_data (p : α Bool) (l : Array α) :
(l.filter p).data = l.data.filter p := by
dsimp only [filter]
rw [foldl_eq_foldl_data]
generalize l.data = l
suffices a, (List.foldl (fun r a => if p a = true then push r a else r) a l).data =
a.data ++ List.filter p l by
simpa using this #[]
induction l with simp
| cons => split <;> simp [*]
@[simp] theorem filter_filter (q) (l : Array α) :
filter p (filter q l) = filter (fun a => p a q a) l := by
apply ext'
simp only [filter_data, List.filter_filter]
@[simp] theorem mem_filter : x filter p as x as p x := by
simp only [mem_def, filter_data, List.mem_filter]
theorem mem_of_mem_filter {a : α} {l} (h : a filter p l) : a l :=
(mem_filter.mp h).1
/-! ### filterMap -/
@[simp] theorem filterMap_data (f : α Option β) (l : Array α) :
(l.filterMap f).data = l.data.filterMap f := by
dsimp only [filterMap, filterMapM]
rw [foldlM_eq_foldlM_data]
generalize l.data = l
have this : a : Array β, (Id.run (List.foldlM (m := Id) ?_ a l)).data =
a.data ++ List.filterMap f l := ?_
exact this #[]
induction l
· simp_all [Id.run]
· simp_all [Id.run, List.filterMap_cons]
split <;> simp_all
@[simp] theorem mem_filterMap (f : α Option β) (l : Array α) {b : β} :
b filterMap f l a, a l f a = some b := by
simp only [mem_def, filterMap_data, List.mem_filterMap]
/-! ### empty -/
theorem size_empty : (#[] : Array α).size = 0 := rfl
theorem empty_data : (#[] : Array α).data = [] := rfl
/-! ### append -/
theorem push_eq_append_singleton (as : Array α) (x) : as.push x = as ++ #[x] := rfl
@[simp] theorem mem_append {a : α} {s t : Array α} : a s ++ t a s a t := by
simp only [mem_def, append_data, List.mem_append]
theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
simp only [size, append_data, List.length_append]
theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
(as ++ bs)[i] = as[i] := by
simp only [getElem_eq_data_getElem]
have h' : i < (as.data ++ bs.data).length := by rwa [ data_length, append_data] at h
conv => rhs; rw [ List.getElem_append_left (bs := bs.data) (h' := h')]
apply List.get_of_eq; rw [append_data]
theorem get_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size i)
(hlt : i - as.size < bs.size := Nat.sub_lt_left_of_lt_add hle (size_append .. h)) :
(as ++ bs)[i] = bs[i - as.size] := by
simp only [getElem_eq_data_getElem]
have h' : i < (as.data ++ bs.data).length := by rwa [ data_length, append_data] at h
conv => rhs; rw [ List.getElem_append_right (h' := h') (h := Nat.not_lt_of_ge hle)]
apply List.get_of_eq; rw [append_data]
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
apply ext'; simp only [append_data, empty_data, List.append_nil]
@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
apply ext'; simp only [append_data, empty_data, List.nil_append]
theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
apply ext'; simp only [append_data, List.append_assoc]
/-! ### extract -/
theorem extract_loop_zero (as bs : Array α) (start : Nat) : extract.loop as 0 start bs = bs := by
rw [extract.loop]; split <;> rfl
theorem extract_loop_succ (as bs : Array α) (size start : Nat) (h : start < as.size) :
extract.loop as (size+1) start bs = extract.loop as size (start+1) (bs.push as[start]) := by
rw [extract.loop, dif_pos h]; rfl
theorem extract_loop_of_ge (as bs : Array α) (size start : Nat) (h : start as.size) :
extract.loop as size start bs = bs := by
rw [extract.loop, dif_neg (Nat.not_lt_of_ge h)]
theorem extract_loop_eq_aux (as bs : Array α) (size start : Nat) :
extract.loop as size start bs = bs ++ extract.loop as size start #[] := by
induction size using Nat.recAux generalizing start bs with
| zero => rw [extract_loop_zero, extract_loop_zero, append_nil]
| succ size ih =>
if h : start < as.size then
rw [extract_loop_succ (h:=h), ih (bs.push _), push_eq_append_singleton]
rw [extract_loop_succ (h:=h), ih (#[].push _), push_eq_append_singleton, nil_append]
rw [append_assoc]
else
rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
rw [extract_loop_of_ge (h:=Nat.le_of_not_lt h)]
rw [append_nil]
theorem extract_loop_eq (as bs : Array α) (size start : Nat) (h : start + size as.size) :
extract.loop as size start bs = bs ++ as.extract start (start + size) := by
simp [extract]; rw [extract_loop_eq_aux, Nat.min_eq_left h, Nat.add_sub_cancel_left]
theorem size_extract_loop (as bs : Array α) (size start : Nat) :
(extract.loop as size start bs).size = bs.size + min size (as.size - start) := by
induction size using Nat.recAux generalizing start bs with
| zero => rw [extract_loop_zero, Nat.zero_min, Nat.add_zero]
| succ size ih =>
if h : start < as.size then
rw [extract_loop_succ (h:=h), ih, size_push, Nat.add_assoc, Nat.add_min_add_left,
Nat.sub_succ, Nat.one_add, Nat.one_add, Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)]
else
have h := Nat.le_of_not_gt h
rw [extract_loop_of_ge (h:=h), Nat.sub_eq_zero_of_le h, Nat.min_zero, Nat.add_zero]
@[simp] theorem size_extract (as : Array α) (start stop : Nat) :
(as.extract start stop).size = min stop as.size - start := by
simp [extract]; rw [size_extract_loop, size_empty, Nat.zero_add, Nat.sub_min_sub_right,
Nat.min_assoc, Nat.min_self]
theorem get_extract_loop_lt_aux (as bs : Array α) (size start : Nat) (hlt : i < bs.size) :
i < (extract.loop as size start bs).size := by
rw [size_extract_loop]
apply Nat.lt_of_lt_of_le hlt
exact Nat.le_add_right ..
theorem get_extract_loop_lt (as bs : Array α) (size start : Nat) (hlt : i < bs.size)
(h := get_extract_loop_lt_aux as bs size start hlt) :
(extract.loop as size start bs)[i] = bs[i] := by
apply Eq.trans _ (get_append_left (bs:=extract.loop as size start #[]) hlt)
· rw [size_append]; exact Nat.lt_of_lt_of_le hlt (Nat.le_add_right ..)
· congr; rw [extract_loop_eq_aux]
theorem get_extract_loop_ge_aux (as bs : Array α) (size start : Nat) (hge : i bs.size)
(h : i < (extract.loop as size start bs).size) : start + i - bs.size < as.size := by
have h : i < bs.size + (as.size - start) := by
apply Nat.lt_of_lt_of_le h
rw [size_extract_loop]
apply Nat.add_le_add_left
exact Nat.min_le_right ..
rw [Nat.add_sub_assoc hge]
apply Nat.add_lt_of_lt_sub'
exact Nat.sub_lt_left_of_lt_add hge h
theorem get_extract_loop_ge (as bs : Array α) (size start : Nat) (hge : i bs.size)
(h : i < (extract.loop as size start bs).size)
(h' := get_extract_loop_ge_aux as bs size start hge h) :
(extract.loop as size start bs)[i] = as[start + i - bs.size] := by
induction size using Nat.recAux generalizing start bs with
| zero =>
rw [size_extract_loop, Nat.zero_min, Nat.add_zero] at h
omega
| succ size ih =>
have : start < as.size := by
apply Nat.lt_of_le_of_lt (Nat.le_add_right start (i - bs.size))
rwa [ Nat.add_sub_assoc hge]
have : i < (extract.loop as size (start+1) (bs.push as[start])).size := by
rwa [ extract_loop_succ]
have heq : (extract.loop as (size+1) start bs)[i] =
(extract.loop as size (start+1) (bs.push as[start]))[i] := by
congr 1; rw [extract_loop_succ]
rw [heq]
if hi : bs.size = i then
cases hi
have h₁ : bs.size < (bs.push as[start]).size := by rw [size_push]; exact Nat.lt_succ_self ..
have h₂ : bs.size < (extract.loop as size (start+1) (bs.push as[start])).size := by
rw [size_extract_loop]; apply Nat.lt_of_lt_of_le h₁; exact Nat.le_add_right ..
have h : (extract.loop as size (start + 1) (push bs as[start]))[bs.size] = as[start] := by
rw [get_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, get_push_eq]
rw [h]; congr; rw [Nat.add_sub_cancel]
else
have hge : bs.size + 1 i := Nat.lt_of_le_of_ne hge hi
rw [ih (bs.push as[start]) (start+1) ((size_push ..).symm hge)]
congr 1; rw [size_push, Nat.add_right_comm, Nat.add_sub_add_right]
theorem get_extract_aux {as : Array α} {start stop : Nat} (h : i < (as.extract start stop).size) :
start + i < as.size := by
rw [size_extract] at h; apply Nat.add_lt_of_lt_sub'; apply Nat.lt_of_lt_of_le h
apply Nat.sub_le_sub_right; apply Nat.min_le_right
@[simp] theorem get_extract {as : Array α} {start stop : Nat}
(h : i < (as.extract start stop).size) :
(as.extract start stop)[i] = as[start + i]'(get_extract_aux h) :=
show (extract.loop as (min stop as.size - start) start #[])[i]
= as[start + i]'(get_extract_aux h) by rw [get_extract_loop_ge]; rfl; exact Nat.zero_le _
@[simp] theorem extract_all (as : Array α) : as.extract 0 as.size = as := by
apply ext
· rw [size_extract, Nat.min_self, Nat.sub_zero]
· intros; rw [get_extract]; congr; rw [Nat.zero_add]
theorem extract_empty_of_stop_le_start (as : Array α) {start stop : Nat} (h : stop start) :
as.extract start stop = #[] := by
simp [extract]; rw [Nat.sub_min_sub_right, Nat.sub_eq_zero_of_le h, Nat.zero_min,
extract_loop_zero]
theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : as.size start) :
as.extract start stop = #[] := by
simp [extract]; rw [Nat.sub_min_sub_right, Nat.sub_eq_zero_of_le h, Nat.min_zero,
extract_loop_zero]
@[simp] theorem extract_empty (start stop : Nat) : (#[] : Array α).extract start stop = #[] :=
extract_empty_of_size_le_start _ (Nat.zero_le _)
/-! ### any -/
-- Auxiliary for `any_iff_exists`.
theorem anyM_loop_iff_exists (p : α Bool) (as : Array α) (start stop) (h : stop as.size) :
anyM.loop (m := Id) p as stop h start = true
i : Fin as.size, start i i < stop p as[i] = true := by
unfold anyM.loop
split <;> rename_i h₁
· dsimp
split <;> rename_i h₂
· simp only [true_iff]
refine start, by omega, by dsimp; omega, by dsimp; omega, h₂
· rw [anyM_loop_iff_exists]
constructor
· rintro i, ge, lt, h
have : start i := by rintro rfl; omega
exact i, by omega, lt, h
· rintro i, ge, lt, h
have : start i := by rintro rfl; erw [h] at h₂; simp_all
exact i, by omega, lt, h
· simp
omega
termination_by stop - start
-- This could also be proved from `SatisfiesM_anyM_iff_exists` in `Batteries.Data.Array.Init.Monadic`
theorem any_iff_exists (p : α Bool) (as : Array α) (start stop) :
any as p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
dsimp [any, anyM, Id.run]
split
· rw [anyM_loop_iff_exists]; rfl
· rw [anyM_loop_iff_exists]
constructor
· rintro i, ge, _, h
exact i, by omega, by omega, h
· rintro i, ge, _, h
exact i, by omega, by omega, h
theorem any_eq_true (p : α Bool) (as : Array α) :
any as p i : Fin as.size, p as[i] := by simp [any_iff_exists, Fin.isLt]
theorem any_def {p : α Bool} (as : Array α) : as.any p = as.data.any p := by
rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get]
exact fun i, h => _, i, rfl, h, fun _, i, rfl, h => i, h
/-! ### all -/
theorem all_eq_not_any_not (p : α Bool) (as : Array α) (start stop) :
all as p start stop = !(any as (!p ·) start stop) := by
dsimp [all, allM]
rfl
theorem all_iff_forall (p : α Bool) (as : Array α) (start stop) :
all as p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
rw [all_eq_not_any_not]
suffices ¬(any as (!p ·) start stop = true)
i : Fin as.size, start i.1 i.1 < stop p as[i] by
simp_all
rw [any_iff_exists]
simp
theorem all_eq_true (p : α Bool) (as : Array α) : all as p i : Fin as.size, p as[i] := by
simp [all_iff_forall, Fin.isLt]
theorem all_def {p : α Bool} (as : Array α) : as.all p = as.data.all p := by
rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]; simp only [List.mem_iff_getElem]
constructor
· rintro w x r, h, rfl
rw [ getElem_eq_data_getElem]
exact w r, h
· intro w i
exact w as[i] i, i.2, (getElem_eq_data_getElem as i.2).symm
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p x, x l p x := by
simp only [all_def, List.all_eq_true, mem_def]
/-! ### contains -/
theorem contains_def [DecidableEq α] {a : α} {as : Array α} : as.contains a a as := by
rw [mem_def, contains, any_def, List.any_eq_true]; simp [and_comm]
instance [DecidableEq α] (a : α) (as : Array α) : Decidable (a as) :=
decidable_of_iff _ contains_def
/-! ### swap -/
open Fin
@[simp] theorem get_swap_right (a : Array α) {i j : Fin a.size} : (a.swap i j)[j.val] = a[i] :=
by simp only [swap, fin_cast_val, get_eq_getElem, getElem_set_eq, getElem_fin]
@[simp] theorem get_swap_left (a : Array α) {i j : Fin a.size} : (a.swap i j)[i.val] = a[j] :=
if he : ((Array.size_set _ _ _).symm j).val = i.val then by
simp only [he, fin_cast_val, get_swap_right, getElem_fin]
else by
apply Eq.trans
· apply Array.get_set_ne
· simp only [size_set, Fin.isLt]
· assumption
· simp [get_set_ne]
@[simp] theorem get_swap_of_ne (a : Array α) {i j : Fin a.size} (hp : p < a.size)
(hi : p i) (hj : p j) : (a.swap i j)[p]'(a.size_swap .. |>.symm hp) = a[p] := by
apply Eq.trans
· have : ((a.size_set i (a.get j)).symm j).val = j.val := by simp only [fin_cast_val]
apply Array.get_set_ne
· simp only [this]
apply Ne.symm
· assumption
· apply Array.get_set_ne
· apply Ne.symm
· assumption
theorem get_swap (a : Array α) (i j : Fin a.size) (k : Nat) (hk: k < a.size) :
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
split
· simp_all only [get_swap_left]
· split <;> simp_all
theorem get_swap' (a : Array α) (i j : Fin a.size) (k : Nat) (hk' : k < (a.swap i j).size) :
(a.swap i j)[k] = if k = i then a[j] else if k = j then a[i] else a[k]'(by simp_all) := by
apply get_swap
@[simp] theorem swap_swap (a : Array α) {i j : Fin a.size} :
(a.swap i j).swap i.1, (a.size_swap ..).symm i.2 j.1, (a.size_swap ..).symm j.2 = a := by
apply ext
· simp only [size_swap]
· intros
simp only [get_swap']
split
· simp_all
· split <;> simp_all
theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i := by
apply ext
· simp only [size_swap]
· intros
simp only [get_swap']
split
· split <;> simp_all
· split <;> simp_all
end Array

View File

@@ -8,6 +8,16 @@ import Init.Data.Array.Basic
import Init.Data.Nat.Linear
import Init.Data.List.BasicAux
theorem List.sizeOf_get_lt [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
match as, i with
| [], i => apply Fin.elim0 i
| a::as, 0, _ => simp_arith [get]
| a::as, i+1, h =>
simp [get]
have h : i < as.length := Nat.lt_of_succ_lt_succ h
have ih := sizeOf_get_lt as i, h
exact Nat.lt_of_lt_of_le ih (Nat.le_add_left ..)
namespace Array
/-- `a ∈ as` is a predicate which asserts that `a` is in the array `as`. -/
@@ -19,28 +29,25 @@ structure Mem (a : α) (as : Array α) : Prop where
instance : Membership α (Array α) where
mem a as := Mem a as
theorem sizeOf_get_lt [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
cases as with | _ as =>
exact Nat.lt_trans (List.sizeOf_get_lt as i) (by simp_arith)
theorem sizeOf_lt_of_mem [SizeOf α] {as : Array α} (h : a as) : sizeOf a < sizeOf as := by
cases as with | _ as =>
exact Nat.lt_trans (List.sizeOf_lt_of_mem h.val) (by simp_arith)
theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
@[simp] theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
cases as with | _ as =>
exact Nat.lt_trans (List.sizeOf_get ..) (by simp_arith)
@[simp] theorem sizeOf_getElem [SizeOf α] (as : Array α) (i : Nat) (h : i < as.size) :
sizeOf (as[i]'h) < sizeOf as := sizeOf_get _ _
/-- This tactic, added to the `decreasing_trivial` toolbox, proves that
`sizeOf arr[i] < sizeOf arr`, which is useful for well founded recursions
over a nested inductive like `inductive T | mk : Array T → T`. -/
macro "array_get_dec" : tactic =>
`(tactic| first
-- subsumed by simp
-- | with_reducible apply sizeOf_get
-- | with_reducible apply sizeOf_getElem
| (with_reducible apply Nat.lt_trans (sizeOf_get ..)); simp_arith
| (with_reducible apply Nat.lt_trans (sizeOf_getElem ..)); simp_arith
)
| apply sizeOf_get
| apply Nat.lt_trans (sizeOf_get ..); simp_arith)
macro_rules | `(tactic| decreasing_trivial) => `(tactic| array_get_dec)
@@ -50,10 +57,9 @@ provided that `a ∈ arr` which is useful for well founded recursions over a nes
-- NB: This is analogue to tactic `sizeOf_list_dec`
macro "array_mem_dec" : tactic =>
`(tactic| first
| with_reducible apply Array.sizeOf_lt_of_mem; assumption; done
| with_reducible
apply Nat.lt_trans (Array.sizeOf_lt_of_mem ?h)
case' h => assumption
| apply Array.sizeOf_lt_of_mem; assumption; done
| apply Nat.lt_trans (Array.sizeOf_lt_of_mem ?h)
case' h => assumption
simp_arith)
macro_rules | `(tactic| decreasing_trivial) => `(tactic| array_mem_dec)

View File

@@ -10,7 +10,7 @@ namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
def qpartition (as : Array α) (lt : α α Bool) (lo hi : Nat) : Nat × Array α :=
if h : as.size = 0 then (0, as) else have : Inhabited α := as[0]'(by revert h; cases as.size <;> simp) -- TODO: remove
if h : as.size = 0 then (0, as) else have : Inhabited α := as[0]'(by revert h; cases as.size <;> simp [Nat.zero_lt_succ]) -- TODO: remove
let mid := (lo + hi) / 2
let as := if lt (as.get! mid) (as.get! lo) then as.swap! lo mid else as
let as := if lt (as.get! hi) (as.get! lo) then as.swap! lo hi else as
@@ -27,7 +27,6 @@ def qpartition (as : Array α) (lt : αα → Bool) (lo hi : Nat) : Nat ×
let as := as.swap! i hi
(i, as)
termination_by hi - j
decreasing_by all_goals simp_wf; decreasing_trivial_pre_omega
loop as lo lo
@[inline] partial def qsort (as : Array α) (lt : α α Bool) (low := 0) (high := as.size - 1) : Array α :=

View File

@@ -9,40 +9,25 @@ import Init.Data.Array.Basic
universe u v w
structure Subarray (α : Type u) where
array : Array α
as : Array α
start : Nat
stop : Nat
start_le_stop : start stop
stop_le_array_size : stop array.size
@[deprecated Subarray.array (since := "2024-04-13")]
abbrev Subarray.as (s : Subarray α) : Array α := s.array
@[deprecated Subarray.start_le_stop (since := "2024-04-13")]
theorem Subarray.h₁ (s : Subarray α) : s.start s.stop := s.start_le_stop
@[deprecated Subarray.stop_le_array_size (since := "2024-04-13")]
theorem Subarray.h₂ (s : Subarray α) : s.stop s.array.size := s.stop_le_array_size
h₁ : start stop
h₂ : stop as.size
namespace Subarray
def size (s : Subarray α) : Nat :=
s.stop - s.start
theorem size_le_array_size {s : Subarray α} : s.size s.array.size := by
let {array, start, stop, start_le_stop, stop_le_array_size} := s
simp [size]
apply Nat.le_trans (Nat.sub_le stop start)
assumption
def get (s : Subarray α) (i : Fin s.size) : α :=
have : s.start + i.val < s.array.size := by
apply Nat.lt_of_lt_of_le _ s.stop_le_array_size
have : s.start + i.val < s.as.size := by
apply Nat.lt_of_lt_of_le _ s.h₂
have := i.isLt
simp [size] at this
rw [Nat.add_comm]
exact Nat.add_lt_of_lt_sub this
s.array[s.start + i.val]
s.as[s.start + i.val]
instance : GetElem (Subarray α) Nat α fun xs i => i < xs.size where
getElem xs i h := xs.get i, h
@@ -55,7 +40,7 @@ abbrev get! [Inhabited α] (s : Subarray α) (i : Nat) : α :=
def popFront (s : Subarray α) : Subarray α :=
if h : s.start < s.stop then
{ s with start := s.start + 1, start_le_stop := Nat.le_of_lt_succ (Nat.add_lt_add_right h 1) }
{ s with start := s.start + 1, h₁ := Nat.le_of_lt_succ (Nat.add_lt_add_right h 1) }
else
s
@@ -63,7 +48,7 @@ def popFront (s : Subarray α) : Subarray α :=
let sz := USize.ofNat s.stop
let rec @[specialize] loop (i : USize) (b : β) : m β := do
if i < sz then
let a := s.array.uget i lcProof
let a := s.as.uget i lcProof
match ( f a b) with
| ForInStep.done b => pure b
| ForInStep.yield b => loop (i+1) b
@@ -81,27 +66,27 @@ instance : ForIn m (Subarray α) α where
@[inline]
def foldlM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : β α m β) (init : β) (as : Subarray α) : m β :=
as.array.foldlM f (init := init) (start := as.start) (stop := as.stop)
as.as.foldlM f (init := init) (start := as.start) (stop := as.stop)
@[inline]
def foldrM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α β m β) (init : β) (as : Subarray α) : m β :=
as.array.foldrM f (init := init) (start := as.stop) (stop := as.start)
as.as.foldrM f (init := init) (start := as.stop) (stop := as.start)
@[inline]
def anyM {α : Type u} {m : Type Type w} [Monad m] (p : α m Bool) (as : Subarray α) : m Bool :=
as.array.anyM p (start := as.start) (stop := as.stop)
as.as.anyM p (start := as.start) (stop := as.stop)
@[inline]
def allM {α : Type u} {m : Type Type w} [Monad m] (p : α m Bool) (as : Subarray α) : m Bool :=
as.array.allM p (start := as.start) (stop := as.stop)
as.as.allM p (start := as.start) (stop := as.stop)
@[inline]
def forM {α : Type u} {m : Type v Type w} [Monad m] (f : α m PUnit) (as : Subarray α) : m PUnit :=
as.array.forM f (start := as.start) (stop := as.stop)
as.as.forM f (start := as.start) (stop := as.stop)
@[inline]
def forRevM {α : Type u} {m : Type v Type w} [Monad m] (f : α m PUnit) (as : Subarray α) : m PUnit :=
as.array.forRevM f (start := as.stop) (stop := as.start)
as.as.forRevM f (start := as.stop) (stop := as.start)
@[inline]
def foldl {α : Type u} {β : Type v} (f : β α β) (init : β) (as : Subarray α) : β :=
@@ -148,25 +133,15 @@ variable {α : Type u}
def toSubarray (as : Array α) (start : Nat := 0) (stop : Nat := as.size) : Subarray α :=
if h₂ : stop as.size then
if h₁ : start stop then
{ array := as, start := start, stop := stop,
start_le_stop := h₁, stop_le_array_size := h₂ }
else
{ array := as, start := stop, stop := stop,
start_le_stop := Nat.le_refl _, stop_le_array_size := h₂ }
if h₁ : start stop then
{ as := as, start := start, stop := stop, h₁ := h₁, h₂ := h₂ }
else
{ as := as, start := stop, stop := stop, h₁ := Nat.le_refl _, h₂ := h₂ }
else
if h₁ : start as.size then
{ array := as,
start := start,
stop := as.size,
start_le_stop := h₁,
stop_le_array_size := Nat.le_refl _ }
else
{ array := as,
start := as.size,
stop := as.size,
start_le_stop := Nat.le_refl _,
stop_le_array_size := Nat.le_refl _ }
if h₁ : start as.size then
{ as := as, start := start, stop := as.size, h₁ := h₁, h₂ := Nat.le_refl _ }
else
{ as := as, start := as.size, stop := as.size, h₁ := Nat.le_refl _, h₂ := Nat.le_refl _ }
@[coe]
def ofSubarray (s : Subarray α) : Array α := Id.run do

View File

@@ -1,71 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Thrane Christiansen
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Array.Subarray
import Init.Omega
/-
This module contains splitting operations on subarrays that crucially rely on `omega` for proof
automation. Placing them in another module breaks an import cycle, because `omega` itself uses the
array library.
-/
namespace Subarray
/--
Splits a subarray into two parts.
-/
def split (s : Subarray α) (i : Fin s.size.succ) : (Subarray α × Subarray α) :=
let i', isLt := i
have := s.start_le_stop
have := s.stop_le_array_size
have : i' s.stop - s.start := Nat.lt_succ.mp isLt
have : s.start + i' s.stop := by omega
have : s.start + i' s.array.size := by omega
have : s.start + i' s.stop := by
simp only [size] at isLt
omega
let pre := {s with
stop := s.start + i',
start_le_stop := by omega,
stop_le_array_size := by assumption
}
let post := {s with
start := s.start + i'
start_le_stop := by assumption
}
(pre, post)
/--
Removes the first `i` elements of the subarray. If there are `i` or fewer elements, the resulting
subarray is empty.
-/
def drop (arr : Subarray α) (i : Nat) : Subarray α where
array := arr.array
start := min (arr.start + i) arr.stop
stop := arr.stop
start_le_stop := by
rw [Nat.min_def]
split <;> simp only [Nat.le_refl, *]
stop_le_array_size := arr.stop_le_array_size
/--
Keeps only the first `i` elements of the subarray. If there are `i` or fewer elements, the resulting
subarray is empty.
-/
def take (arr : Subarray α) (i : Nat) : Subarray α where
array := arr.array
start := arr.start
stop := min (arr.start + i) arr.stop
start_le_stop := by
have := arr.start_le_stop
rw [Nat.min_def]
split <;> omega
stop_le_array_size := by
have := arr.stop_le_array_size
rw [Nat.min_def]
split <;> omega

View File

@@ -1,17 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.Nat.TakeDrop
namespace Array
theorem exists_of_uset (self : Array α) (i d h) :
l₁ l₂, self.data = l₁ ++ self[i] :: l₂ List.length l₁ = i.toNat
(self.uset i d h).data = l₁ ++ d :: l₂ := by
simpa [Array.getElem_eq_data_getElem] using List.exists_of_set _
end Array

View File

@@ -1,60 +0,0 @@
/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Markus Himmel
-/
prelude
import Init.Data.Bool
set_option linter.missingDocs true
/-- `PartialEquivBEq α` says that the `BEq` implementation is a
partial equivalence relation, that is:
* it is symmetric: `a == b → b == a`
* it is transitive: `a == b → b == c → a == c`.
-/
class PartialEquivBEq (α) [BEq α] : Prop where
/-- Symmetry for `BEq`. If `a == b` then `b == a`. -/
symm : (a : α) == b b == a
/-- Transitivity for `BEq`. If `a == b` and `b == c` then `a == c`. -/
trans : (a : α) == b b == c a == c
/-- `ReflBEq α` says that the `BEq` implementation is reflexive. -/
class ReflBEq (α) [BEq α] : Prop where
/-- Reflexivity for `BEq`. -/
refl : (a : α) == a
/-- `EquivBEq` says that the `BEq` implementation is an equivalence relation. -/
class EquivBEq (α) [BEq α] extends PartialEquivBEq α, ReflBEq α : Prop
@[simp]
theorem BEq.refl [BEq α] [ReflBEq α] {a : α} : a == a :=
ReflBEq.refl
theorem beq_of_eq [BEq α] [ReflBEq α] {a b : α} : a = b a == b
| rfl => BEq.refl
theorem BEq.symm [BEq α] [PartialEquivBEq α] {a b : α} : a == b b == a :=
PartialEquivBEq.symm
theorem BEq.comm [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = (b == a) :=
Bool.eq_iff_iff.2 BEq.symm, BEq.symm
theorem BEq.symm_false [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = false (b == a) = false :=
BEq.comm (α := α) id
theorem BEq.trans [BEq α] [PartialEquivBEq α] {a b c : α} : a == b b == c a == c :=
PartialEquivBEq.trans
theorem BEq.neq_of_neq_of_beq [BEq α] [PartialEquivBEq α] {a b c : α} :
(a == b) = false b == c (a == c) = false :=
fun h₁ h₂ => Bool.eq_false_iff.2 fun h₃ => Bool.eq_false_iff.1 h₁ (BEq.trans h₃ (BEq.symm h₂))
theorem BEq.neq_of_beq_of_neq [BEq α] [PartialEquivBEq α] {a b c : α} :
a == b (b == c) = false (a == c) = false :=
fun h₁ h₂ => Bool.eq_false_iff.2 fun h₃ => Bool.eq_false_iff.1 h₂ (BEq.trans (BEq.symm h₁) h₃)
instance (priority := low) [BEq α] [LawfulBEq α] : EquivBEq α where
refl := LawfulBEq.rfl
symm h := (beq_iff_eq _ _).2 <| Eq.symm <| (beq_iff_eq _ _).1 h
trans hab hbc := (beq_iff_eq _ _).2 <| ((beq_iff_eq _ _).1 hab).trans <| (beq_iff_eq _ _).1 hbc

View File

@@ -1,13 +1,15 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Copyright (c) 2022 by the authors listed in the file AUTHORS and their
institutional affiliations. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer
-/
prelude
import Init.Data.Fin.Basic
import Init.Data.Nat.Bitwise.Lemmas
import Init.Data.Nat.Power2
import Init.Data.Int.Bitwise
namespace Std
/-!
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
@@ -20,13 +22,9 @@ We define many of the bitvector operations from the
of SMT-LIBv2.
-/
set_option linter.missingDocs true
/--
A bitvector of the specified width.
This is represented as the underlying `Nat` number in both the runtime
and the kernel, inheriting all the special support for `Nat`.
A bitvector of the specified width. This is represented as the underlying `Nat` number
in both the runtime and the kernel, inheriting all the special support for `Nat`.
-/
structure BitVec (w : Nat) where
/-- Construct a `BitVec w` from a number less than `2^w`.
@@ -35,39 +33,20 @@ structure BitVec (w : Nat) where
/-- Interpret a bitvector as a number less than `2^w`.
O(1), because we use `Fin` as the internal representation of a bitvector. -/
toFin : Fin (2^w)
/--
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
-/
-- We manually derive the `DecidableEq` instances for `BitVec` because
-- we want to have builtin support for bit-vector literals, and we
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
def BitVec.decEq (a b : BitVec n) : Decidable (a = b) :=
match a, b with
| n, m =>
if h : n = m then
isTrue (h rfl)
else
isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h))
instance : DecidableEq (BitVec n) := BitVec.decEq
deriving DecidableEq
namespace BitVec
section Nat
/-- `cast eq i` embeds `i` into an equal `BitVec` type. -/
@[inline] def cast (eq : n = m) (i : BitVec n) : BitVec m :=
.ofFin (Fin.cast (congrArg _ eq) i.toFin)
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
@[match_pattern]
protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
toFin := i, p
/-- The `BitVec` with value `i mod 2^n`. -/
@[match_pattern]
/-- The `BitVec` with value `i mod 2^n`. Treated as an operation on bitvectors,
this is truncation of the high bits when downcasting and zero-extension when upcasting. -/
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
toFin := Fin.ofNat' i (Nat.two_pow_pos n)
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
instance natCastInst : NatCast (BitVec w) := BitVec.ofNat w
instance : NatCast (BitVec w) := BitVec.ofNat w
/-- Given a bitvector `a`, return the underlying `Nat`. This is O(1) because `BitVec` is a
(zero-cost) wrapper around a `Nat`. -/
@@ -76,46 +55,6 @@ protected def toNat (a : BitVec n) : Nat := a.toFin.val
/-- Return the bound in terms of toNat. -/
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
@[deprecated isLt (since := "2024-03-12")]
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
/-- Theorem for normalizing the bit vector literal representation. -/
-- TODO: This needs more usage data to assess which direction the simp should go.
@[simp, bv_toNat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
-- Note. Mathlib would like this to go the other direction.
@[simp] theorem natCast_eq_ofNat (w x : Nat) : @Nat.cast (BitVec w) _ x = .ofNat w x := rfl
end Nat
section subsingleton
/-- All empty bitvectors are equal -/
instance : Subsingleton (BitVec 0) where
allEq := by intro 0, _ 0, _; rfl
/-- The empty bitvector -/
abbrev nil : BitVec 0 := 0
/-- Every bitvector of length 0 is equal to `nil`, i.e., there is only one empty bitvector -/
theorem eq_nil (x : BitVec 0) : x = nil := Subsingleton.allEq ..
end subsingleton
section zero_allOnes
/-- Return a bitvector `0` of size `n`. This is the bitvector with all zero bits. -/
protected def zero (n : Nat) : BitVec n := .ofNatLt 0 (Nat.two_pow_pos n)
instance : Inhabited (BitVec n) where default := .zero n
/-- Bit vector of size `n` where all bits are `1`s -/
def allOnes (n : Nat) : BitVec n :=
.ofNatLt (2^n - 1) (Nat.le_of_eq (Nat.sub_add_cancel (Nat.two_pow_pos n)))
end zero_allOnes
section getXsb
/-- Return the `i`-th least significant bit or `false` if `i ≥ w`. -/
@[inline] def getLsb (x : BitVec w) (i : Nat) : Bool := x.toNat.testBit i
@@ -125,67 +64,43 @@ section getXsb
/-- Return most-significant bit in bitvector. -/
@[inline] protected def msb (a : BitVec n) : Bool := getMsb a 0
end getXsb
section Int
/-- Interpret the bitvector as an integer stored in two's complement form. -/
protected def toInt (a : BitVec n) : Int :=
if 2 * a.toNat < 2^n then
a.toNat
else
(a.toNat : Int) - (2^n : Nat)
if a.msb then Int.ofNat a.toNat - Int.ofNat (2^n) else a.toNat
/-- The `BitVec` with value `(2^n + (i mod 2^n)) mod 2^n`. -/
protected def ofInt (n : Nat) (i : Int) : BitVec n := .ofNatLt (i % (Int.ofNat (2^n))).toNat (by
apply (Int.toNat_lt _).mpr
· apply Int.emod_lt_of_pos
exact Int.ofNat_pos.mpr (Nat.two_pow_pos _)
· apply Int.emod_nonneg
intro eq
apply Nat.ne_of_gt (Nat.two_pow_pos n)
exact Int.ofNat_inj.mp eq)
/-- Return a bitvector `0` of size `n`. This is the bitvector with all zero bits. -/
protected def zero (n : Nat) : BitVec n := 0, Nat.two_pow_pos n
instance : IntCast (BitVec w) := BitVec.ofInt w
instance : Inhabited (BitVec n) where default := .zero n
end Int
section Syntax
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
/-- Notation for bit vector literals. `i#n` is a shorthand for `BitVec.ofNat n i`. -/
syntax:max num noWs "#" noWs term:max : term
macro_rules | `($i:num#$n) => `(BitVec.ofNat $n $i)
scoped syntax:max term:max noWs "#" noWs term:max : term
macro_rules | `($i#$n) => `(BitVec.ofNat $n $i)
/- Support for `i#n` notation in patterns. -/
attribute [match_pattern] BitVec.ofNat
/-- Unexpander for bit vector literals. -/
@[app_unexpander BitVec.ofNat] def unexpandBitVecOfNat : Lean.PrettyPrinter.Unexpander
| `($(_) $n $i:num) => `($i:num#$n)
| `($(_) $n $i) => `($i#$n)
| _ => throw ()
/-- Notation for bit vector literals without truncation. `i#'lt` is a shorthand for `BitVec.ofNatLt i lt`. -/
scoped syntax:max term:max noWs "#'" noWs term:max : term
macro_rules | `($i#'$p) => `(BitVec.ofNatLt $i $p)
/-- Unexpander for bit vector literals without truncation. -/
@[app_unexpander BitVec.ofNatLt] def unexpandBitVecOfNatLt : Lean.PrettyPrinter.Unexpander
| `($(_) $i $p) => `($i#'$p)
| _ => throw ()
end Syntax
section repr_toString
/-- Convert bitvector into a fixed-width hex number. -/
protected def toHex {n : Nat} (x : BitVec n) : String :=
let s := (Nat.toDigits 16 x.toNat).asString
let t := (List.replicate ((n+3) / 4 - s.length) '0').asString
t ++ s
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Format) ++ "#" ++ repr n
instance : ToString (BitVec n) where toString a := toString (repr a)
end repr_toString
section arithmetic
/-- Theorem for normalizing the bit vector literal representation. -/
-- TODO: This needs more usage data to assess which direction the simp should go.
@[simp] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = BitVec.ofNat n i := rfl
@[simp] theorem natCast_eq_ofNat : Nat.cast x = x#w := rfl
/--
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
@@ -193,14 +108,14 @@ modulo `2^n`.
SMT-Lib name: `bvadd`.
-/
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
protected def add (x y : BitVec n) : BitVec n where toFin := x.toFin + y.toFin
instance : Add (BitVec n) := BitVec.add
/--
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
modulo `2^n`.
-/
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
protected def sub (x y : BitVec n) : BitVec n where toFin := x.toFin - y.toFin
instance : Sub (BitVec n) := BitVec.sub
/--
@@ -209,9 +124,12 @@ modulo `2^n`.
SMT-Lib name: `bvneg`.
-/
protected def neg (x : BitVec n) : BitVec n := .ofNat n (2^n - x.toNat)
protected def neg (x : BitVec n) : BitVec n := .sub 0 x
instance : Neg (BitVec n) := .neg
/-- Bit vector of size `n` where all bits are `1`s -/
def allOnes (n : Nat) : BitVec n := -1
/--
Return the absolute value of a signed bitvector.
-/
@@ -223,14 +141,13 @@ modulo `2^n`.
SMT-Lib name: `bvmul`.
-/
protected def mul (x y : BitVec n) : BitVec n := BitVec.ofNat n (x.toNat * y.toNat)
protected def mul (x y : BitVec n) : BitVec n := ofFin <| x.toFin * y.toFin
instance : Mul (BitVec n) := .mul
/--
Unsigned division for bit vectors using the Lean convention where division by zero returns zero.
-/
def udiv (x y : BitVec n) : BitVec n :=
(x.toNat / y.toNat)#'(Nat.lt_of_le_of_lt (Nat.div_le_self _ _) x.isLt)
def udiv (x y : BitVec n) : BitVec n := ofFin <| x.toFin / y.toFin
instance : Div (BitVec n) := .udiv
/--
@@ -238,8 +155,7 @@ Unsigned modulo for bit vectors.
SMT-Lib name: `bvurem`.
-/
def umod (x y : BitVec n) : BitVec n :=
(x.toNat % y.toNat)#'(Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt)
def umod (x y : BitVec n) : BitVec n := ofFin <| x.toFin % y.toFin
instance : Mod (BitVec n) := .umod
/--
@@ -249,7 +165,7 @@ where division by zero returns the `allOnes` bitvector.
SMT-Lib name: `bvudiv`.
-/
def smtUDiv (x y : BitVec n) : BitVec n := if y = 0 then allOnes n else udiv x y
def smtUDiv (x y : BitVec n) : BitVec n := if y = 0 then -1 else .udiv x y
/--
Signed t-division for bit vectors using the Lean convention where division
@@ -302,54 +218,35 @@ SMT_Lib name: `bvsmod`.
-/
def smod (s t : BitVec m) : BitVec m :=
match s.msb, t.msb with
| false, false => umod s t
| false, false => .umod s t
| false, true =>
let u := umod s (.neg t)
(if u = .zero m then u else .add u t)
let u := .umod s (.neg t)
(if u = BitVec.ofNat m 0 then u else .add u t)
| true, false =>
let u := umod (.neg s) t
(if u = .zero m then u else .sub t u)
| true, true => .neg (umod (.neg s) (.neg t))
end arithmetic
section bool
/-- Turn a `Bool` into a bitvector of length `1` -/
def ofBool (b : Bool) : BitVec 1 := cond b 1 0
@[simp] theorem ofBool_false : ofBool false = 0 := by trivial
@[simp] theorem ofBool_true : ofBool true = 1 := by trivial
/-- Fills a bitvector with `w` copies of the bit `b`. -/
def fill (w : Nat) (b : Bool) : BitVec w := bif b then -1 else 0
end bool
section relations
let u := .umod (.neg s) t
(if u = BitVec.ofNat m 0 then u else .sub t u)
| true, true => .neg (.umod (.neg s) (.neg t))
/--
Unsigned less-than for bit vectors.
SMT-Lib name: `bvult`.
-/
protected def ult (x y : BitVec n) : Bool := x.toNat < y.toNat
instance : LT (BitVec n) where lt := (·.toNat < ·.toNat)
protected def ult (x y : BitVec n) : Bool := x.toFin < y.toFin
instance : LT (BitVec n) where lt x y := x.toFin < y.toFin
instance (x y : BitVec n) : Decidable (x < y) :=
inferInstanceAs (Decidable (x.toNat < y.toNat))
inferInstanceAs (Decidable (x.toFin < y.toFin))
/--
Unsigned less-than-or-equal-to for bit vectors.
SMT-Lib name: `bvule`.
-/
protected def ule (x y : BitVec n) : Bool := x.toNat y.toNat
protected def ule (x y : BitVec n) : Bool := x.toFin y.toFin
instance : LE (BitVec n) where le := (·.toNat ·.toNat)
instance : LE (BitVec n) where le x y := x.toFin y.toFin
instance (x y : BitVec n) : Decidable (x y) :=
inferInstanceAs (Decidable (x.toNat y.toNat))
inferInstanceAs (Decidable (x.toFin y.toFin))
/--
Signed less-than for bit vectors.
@@ -369,22 +266,152 @@ SMT-Lib name: `bvsle`.
-/
protected def sle (x y : BitVec n) : Bool := x.toInt y.toInt
end relations
/--
Bitwise AND for bit vectors.
section cast
```lean
0b1010#4 &&& 0b0110#4 = 0b0010#4
```
/-- `cast eq i` embeds `i` into an equal `BitVec` type. -/
@[inline] def cast (eq : n = m) (i : BitVec n) : BitVec m := .ofNatLt i.toNat (eq i.isLt)
SMT-Lib name: `bvand`.
-/
protected def and (x y : BitVec n) : BitVec n where toFin :=
x.toNat &&& y.toNat, Nat.and_lt_two_pow x.toNat y.isLt
instance : AndOp (BitVec w) := .and
@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) :
cast h (BitVec.ofNat n x) = BitVec.ofNat m x := by
subst h; rfl
/--
Bitwise OR for bit vectors.
@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) :
cast h₂ (cast h₁ x) = cast (h₁ h₂) x :=
rfl
```lean
0b1010#4 ||| 0b0110#4 = 0b1110#4
```
@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : cast h x = x := rfl
SMT-Lib name: `bvor`.
-/
protected def or (x y : BitVec n) : BitVec n where toFin :=
x.toNat ||| y.toNat, Nat.or_lt_two_pow x.isLt y.isLt
instance : OrOp (BitVec w) := .or
/--
Bitwise XOR for bit vectors.
```lean
0b1010#4 ^^^ 0b0110#4 = 0b1100#4
```
SMT-Lib name: `bvxor`.
-/
protected def xor (x y : BitVec n) : BitVec n where toFin :=
x.toNat ^^^ y.toNat, Nat.xor_lt_two_pow x.isLt y.isLt
instance : Xor (BitVec w) := .xor
/--
Bitwise NOT for bit vectors.
```lean
~~~(0b0101#4) == 0b1010
```
SMT-Lib name: `bvnot`.
-/
protected def not (x : BitVec n) : BitVec n :=
allOnes n ^^^ x
instance : Complement (BitVec w) := .not
/-- The `BitVec` with value `(2^n + (i mod 2^n)) mod 2^n`. -/
protected def ofInt (n : Nat) (i : Int) : BitVec n :=
match i with
| Int.ofNat a => .ofNat n a
| Int.negSucc a => ~~~.ofNat n a
instance : IntCast (BitVec w) := BitVec.ofInt w
/--
Left shift for bit vectors. The low bits are filled with zeros. As a numeric operation, this is
equivalent to `a * 2^s`, modulo `2^n`.
SMT-Lib name: `bvshl` except this operator uses a `Nat` shift value.
-/
protected def shiftLeft (a : BitVec n) (s : Nat) : BitVec n := .ofNat n (a.toNat <<< s)
instance : HShiftLeft (BitVec w) Nat (BitVec w) := .shiftLeft
/--
(Logical) right shift for bit vectors. The high bits are filled with zeros.
As a numeric operation, this is equivalent to `a / 2^s`, rounding down.
SMT-Lib name: `bvlshr` except this operator uses a `Nat` shift value.
-/
def ushiftRight (a : BitVec n) (s : Nat) : BitVec n :=
a.toNat >>> s, by
let a, lt := a
simp only [BitVec.toNat, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul (Nat.two_pow_pos s)]
rw [Nat.mul_one a]
exact Nat.mul_lt_mul_of_lt_of_le' lt (Nat.two_pow_pos s) (Nat.le_refl 1)
instance : HShiftRight (BitVec w) Nat (BitVec w) := .ushiftRight
/--
Arithmetic right shift for bit vectors. The high bits are filled with the
most-significant bit.
As a numeric operation, this is equivalent to `a.toInt >>> s`.
SMT-Lib name: `bvashr` except this operator uses a `Nat` shift value.
-/
def sshiftRight (a : BitVec n) (s : Nat) : BitVec n := .ofInt n (a.toInt >>> s)
instance {n} : HShiftLeft (BitVec m) (BitVec n) (BitVec m) := fun x y => x <<< y.toNat
instance {n} : HShiftRight (BitVec m) (BitVec n) (BitVec m) := fun x y => x >>> y.toNat
/--
Rotate left for bit vectors. All the bits of `x` are shifted to higher positions, with the top `n`
bits wrapping around to fill the low bits.
```lean
rotateLeft 0b0011#4 3 = 0b1001
```
SMT-Lib name: `rotate_left` except this operator uses a `Nat` shift amount.
-/
def rotateLeft (x : BitVec w) (n : Nat) : BitVec w := x <<< n ||| x >>> (w - n)
/--
Rotate right for bit vectors. All the bits of `x` are shifted to lower positions, with the
bottom `n` bits wrapping around to fill the high bits.
```lean
rotateRight 0b01001#5 1 = 0b10100
```
SMT-Lib name: `rotate_right` except this operator uses a `Nat` shift amount.
-/
def rotateRight (x : BitVec w) (n : Nat) : BitVec w := x >>> n ||| x <<< (w - n)
/--
A version of `zeroExtend` that requires a proof, but is a noop.
-/
def zeroExtend' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
x.toNat, by
apply Nat.lt_of_lt_of_le x.isLt
exact Nat.pow_le_pow_of_le_right (by trivial) le
/--
`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without
needing to compute `x % 2^(2+n)`.
-/
def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w+m) :=
let shiftLeftLt {x : Nat} (p : x < 2^w) (m : Nat) : x <<< m < 2^(w+m) := by
simp [Nat.shiftLeft_eq, Nat.pow_add]
apply Nat.mul_lt_mul_of_pos_right p
exact (Nat.two_pow_pos m)
msbs.toNat <<< m, shiftLeftLt msbs.isLt m
/--
Concatenation of bitvectors. This uses the "big endian" convention that the more significant
input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`.
SMT-Lib name: `concat`.
-/
def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) :=
shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs
instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := .append
/--
Extraction of bits `start` to `start + len - 1` from a bit vector of size `n` to yield a
@@ -401,24 +428,17 @@ SMT-Lib name: `extract`.
-/
def extractLsb (hi lo : Nat) (a : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ a
/--
A version of `zeroExtend` that requires a proof, but is a noop.
-/
def zeroExtend' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
x.toNat#'(by
apply Nat.lt_of_lt_of_le x.isLt
exact Nat.pow_le_pow_of_le_right (by trivial) le)
-- TODO: write this using multiplication
/-- `replicate i x` concatenates `i` copies of `x` into a new vector of length `w*i`. -/
def replicate : (i : Nat) BitVec w BitVec (w*i)
| 0, _ => 0
| n+1, x =>
have hEq : w + w*n = w*(n + 1) := by
rw [Nat.mul_add, Nat.add_comm, Nat.mul_one]
hEq (x ++ replicate n x)
/--
`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without
needing to compute `x % 2^(2+n)`.
-/
def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w+m) :=
let shiftLeftLt {x : Nat} (p : x < 2^w) (m : Nat) : x <<< m < 2^(w+m) := by
simp [Nat.shiftLeft_eq, Nat.pow_add]
apply Nat.mul_lt_mul_of_pos_right p
exact (Nat.two_pow_pos m)
(msbs.toNat <<< m)#'(shiftLeftLt msbs.isLt m)
/-- Fills a bitvector with `w` copies of the bit `b`. -/
def fill (w : Nat) (b : Bool) : BitVec w := bif b then -1 else 0
/--
Zero extend vector `x` of length `w` by adding zeros in the high bits until it has length `v`.
@@ -446,148 +466,40 @@ SMT-Lib name: `sign_extend`.
-/
def signExtend (v : Nat) (x : BitVec w) : BitVec v := .ofInt v x.toInt
end cast
/-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/
@[simp] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y := rfl
@[simp] theorem shiftLeft_eq (x : BitVec w) (n : Nat) : BitVec.shiftLeft x n = x <<< n := rfl
@[simp] theorem ushiftRight_eq (x : BitVec w) (n : Nat) : BitVec.ushiftRight x n = x >>> n := rfl
@[simp] theorem not_eq (x : BitVec w) : BitVec.not x = ~~~x := rfl
@[simp] theorem and_eq (x y : BitVec w) : BitVec.and x y = x &&& y := rfl
@[simp] theorem or_eq (x y : BitVec w) : BitVec.or x y = x ||| y := rfl
@[simp] theorem xor_eq (x y : BitVec w) : BitVec.xor x y = x ^^^ y := rfl
@[simp] theorem neg_eq (x : BitVec w) : BitVec.neg x = -x := rfl
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
section bitwise
@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) :
cast h (BitVec.ofNat n x) = BitVec.ofNat m x := by
subst h; rfl
/--
Bitwise AND for bit vectors.
@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) :
cast h₂ (cast h₁ x) = cast (h₁ h₂) x :=
rfl
```lean
0b1010#4 &&& 0b0110#4 = 0b0010#4
```
@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) :
cast h x = x :=
rfl
SMT-Lib name: `bvand`.
-/
protected def and (x y : BitVec n) : BitVec n :=
(x.toNat &&& y.toNat)#'(Nat.and_lt_two_pow x.toNat y.isLt)
instance : AndOp (BitVec w) := .and
/-- Turn a `Bool` into a bitvector of length `1` -/
def ofBool (b : Bool) : BitVec 1 := cond b 1 0
/--
Bitwise OR for bit vectors.
@[simp] theorem ofBool_false : ofBool false = 0 := by trivial
@[simp] theorem ofBool_true : ofBool true = 1 := by trivial
```lean
0b1010#4 ||| 0b0110#4 = 0b1110#4
```
SMT-Lib name: `bvor`.
-/
protected def or (x y : BitVec n) : BitVec n :=
(x.toNat ||| y.toNat)#'(Nat.or_lt_two_pow x.isLt y.isLt)
instance : OrOp (BitVec w) := .or
/--
Bitwise XOR for bit vectors.
```lean
0b1010#4 ^^^ 0b0110#4 = 0b1100#4
```
SMT-Lib name: `bvxor`.
-/
protected def xor (x y : BitVec n) : BitVec n :=
(x.toNat ^^^ y.toNat)#'(Nat.xor_lt_two_pow x.isLt y.isLt)
instance : Xor (BitVec w) := .xor
/--
Bitwise NOT for bit vectors.
```lean
~~~(0b0101#4) == 0b1010
```
SMT-Lib name: `bvnot`.
-/
protected def not (x : BitVec n) : BitVec n := allOnes n ^^^ x
instance : Complement (BitVec w) := .not
/--
Left shift for bit vectors. The low bits are filled with zeros. As a numeric operation, this is
equivalent to `a * 2^s`, modulo `2^n`.
SMT-Lib name: `bvshl` except this operator uses a `Nat` shift value.
-/
protected def shiftLeft (a : BitVec n) (s : Nat) : BitVec n := BitVec.ofNat n (a.toNat <<< s)
instance : HShiftLeft (BitVec w) Nat (BitVec w) := .shiftLeft
/--
(Logical) right shift for bit vectors. The high bits are filled with zeros.
As a numeric operation, this is equivalent to `a / 2^s`, rounding down.
SMT-Lib name: `bvlshr` except this operator uses a `Nat` shift value.
-/
def ushiftRight (a : BitVec n) (s : Nat) : BitVec n :=
(a.toNat >>> s)#'(by
let a, lt := a
simp only [BitVec.toNat, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul (Nat.two_pow_pos s)]
rw [Nat.mul_one a]
exact Nat.mul_lt_mul_of_lt_of_le' lt (Nat.two_pow_pos s) (Nat.le_refl 1))
instance : HShiftRight (BitVec w) Nat (BitVec w) := .ushiftRight
/--
Arithmetic right shift for bit vectors. The high bits are filled with the
most-significant bit.
As a numeric operation, this is equivalent to `a.toInt >>> s`.
SMT-Lib name: `bvashr` except this operator uses a `Nat` shift value.
-/
def sshiftRight (a : BitVec n) (s : Nat) : BitVec n := .ofInt n (a.toInt >>> s)
instance {n} : HShiftLeft (BitVec m) (BitVec n) (BitVec m) := fun x y => x <<< y.toNat
instance {n} : HShiftRight (BitVec m) (BitVec n) (BitVec m) := fun x y => x >>> y.toNat
/-- Auxiliary function for `rotateLeft`, which does not take into account the case where
the rotation amount is greater than the bitvector width. -/
def rotateLeftAux (x : BitVec w) (n : Nat) : BitVec w :=
x <<< n ||| x >>> (w - n)
/--
Rotate left for bit vectors. All the bits of `x` are shifted to higher positions, with the top `n`
bits wrapping around to fill the low bits.
```lean
rotateLeft 0b0011#4 3 = 0b1001
```
SMT-Lib name: `rotate_left` except this operator uses a `Nat` shift amount.
-/
def rotateLeft (x : BitVec w) (n : Nat) : BitVec w := rotateLeftAux x (n % w)
/--
Auxiliary function for `rotateRight`, which does not take into account the case where
the rotation amount is greater than the bitvector width.
-/
def rotateRightAux (x : BitVec w) (n : Nat) : BitVec w :=
x >>> n ||| x <<< (w - n)
/--
Rotate right for bit vectors. All the bits of `x` are shifted to lower positions, with the
bottom `n` bits wrapping around to fill the high bits.
```lean
rotateRight 0b01001#5 1 = 0b10100
```
SMT-Lib name: `rotate_right` except this operator uses a `Nat` shift amount.
-/
def rotateRight (x : BitVec w) (n : Nat) : BitVec w := rotateRightAux x (n % w)
/--
Concatenation of bitvectors. This uses the "big endian" convention that the more significant
input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`.
SMT-Lib name: `concat`.
-/
def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) :=
shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs
instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := .append
-- TODO: write this using multiplication
/-- `replicate i x` concatenates `i` copies of `x` into a new vector of length `w*i`. -/
def replicate : (i : Nat) BitVec w BitVec (w*i)
| 0, _ => 0#0
| n+1, x =>
(x ++ replicate n x).cast (by rw [Nat.mul_succ]; omega)
/-- The empty bitvector -/
abbrev nil : BitVec 0 := 0
/-!
### Cons and Concat
@@ -606,6 +518,14 @@ def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool
def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) :=
((ofBool msb) ++ lsbs).cast (Nat.add_comm ..)
/-- All empty bitvectors are equal -/
instance : Subsingleton (BitVec 0) where
allEq := by intro 0, _ 0, _; rfl
/-- Every bitvector of length 0 is equal to `nil`, i.e., there is only one empty bitvector -/
theorem eq_nil : (x : BitVec 0), x = nil
| ofFin 0, _ => rfl
theorem append_ofBool (msbs : BitVec w) (lsb : Bool) :
msbs ++ ofBool lsb = concat msbs lsb :=
rfl
@@ -613,40 +533,3 @@ theorem append_ofBool (msbs : BitVec w) (lsb : Bool) :
theorem ofBool_append (msb : Bool) (lsbs : BitVec w) :
ofBool msb ++ lsbs = (cons msb lsbs).cast (Nat.add_comm ..) :=
rfl
/--
`twoPow w i` is the bitvector `2^i` if `i < w`, and `0` otherwise.
That is, 2 to the power `i`.
For the bitwise point of view, it has the `i`th bit as `1` and all other bits as `0`.
-/
def twoPow (w : Nat) (i : Nat) : BitVec w := 1#w <<< i
end bitwise
section normalization_eqs
/-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/
@[simp] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y := rfl
@[simp] theorem shiftLeft_eq (x : BitVec w) (n : Nat) : BitVec.shiftLeft x n = x <<< n := rfl
@[simp] theorem ushiftRight_eq (x : BitVec w) (n : Nat) : BitVec.ushiftRight x n = x >>> n := rfl
@[simp] theorem not_eq (x : BitVec w) : BitVec.not x = ~~~x := rfl
@[simp] theorem and_eq (x y : BitVec w) : BitVec.and x y = x &&& y := rfl
@[simp] theorem or_eq (x y : BitVec w) : BitVec.or x y = x ||| y := rfl
@[simp] theorem xor_eq (x y : BitVec w) : BitVec.xor x y = x ^^^ y := rfl
@[simp] theorem neg_eq (x : BitVec w) : BitVec.neg x = -x := rfl
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
end normalization_eqs
/-- Converts a list of `Bool`s to a big-endian `BitVec`. -/
def ofBoolListBE : (bs : List Bool) BitVec bs.length
| [] => 0#0
| b :: bs => cons b (ofBoolListBE bs)
/-- Converts a list of `Bool`s to a little-endian `BitVec`. -/
def ofBoolListLE : (bs : List Bool) BitVec bs.length
| [] => 0#0
| b :: bs => concat (ofBoolListLE bs) b
end BitVec

View File

@@ -1,11 +1,11 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Copyright (c) 2023 by the authors listed in the file AUTHORS and their
institutional affiliations. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
-/
prelude
import Init.Data.BitVec.Folds
import Init.Data.Nat.Mod
/-!
# Bitblasting of bitvectors
@@ -28,27 +28,11 @@ https://github.com/mhk119/lean-smt/blob/bitvec/Smt/Data/Bitwise.lean.
-/
set_option linter.missingDocs true
open Nat Bool
namespace Bool
/-- At least two out of three booleans are true. -/
abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c
@[simp] theorem atLeastTwo_false_left : atLeastTwo false b c = (b && c) := by simp [atLeastTwo]
@[simp] theorem atLeastTwo_false_mid : atLeastTwo a false c = (a && c) := by simp [atLeastTwo]
@[simp] theorem atLeastTwo_false_right : atLeastTwo a b false = (a && b) := by simp [atLeastTwo]
@[simp] theorem atLeastTwo_true_left : atLeastTwo true b c = (b || c) := by cases b <;> cases c <;> simp [atLeastTwo]
@[simp] theorem atLeastTwo_true_mid : atLeastTwo a true c = (a || c) := by cases a <;> cases c <;> simp [atLeastTwo]
@[simp] theorem atLeastTwo_true_right : atLeastTwo a b true = (a || b) := by cases a <;> cases b <;> simp [atLeastTwo]
end Bool
/-! ### Preliminaries -/
namespace BitVec
namespace Std.BitVec
private theorem testBit_limit {x i : Nat} (x_lt_succ : x < 2^(i+1)) :
testBit x i = decide (x 2^i) := by
@@ -73,63 +57,37 @@ private theorem testBit_limit {x i : Nat} (x_lt_succ : x < 2^(i+1)) :
_ x := testBit_implies_ge jp
private theorem mod_two_pow_succ (x i : Nat) :
x % 2^(i+1) = 2^i*(x.testBit i).toNat + x % (2 ^ i):= by
rw [Nat.mod_pow_succ, Nat.add_comm, Nat.toNat_testBit]
x % 2^(i+1) = 2^i*(x.testBit i).toNat + x % (2 ^ i):= by
apply Nat.eq_of_testBit_eq
intro j
simp only [Nat.mul_add_lt_is_or, testBit_or, testBit_mod_two_pow, testBit_shiftLeft,
Nat.testBit_bool_to_nat, Nat.sub_eq_zero_iff_le, Nat.mod_lt, Nat.two_pow_pos,
testBit_mul_pow_two]
rcases Nat.lt_trichotomy i j with i_lt_j | i_eq_j | j_lt_i
· have i_le_j : i j := Nat.le_of_lt i_lt_j
have not_j_le_i : ¬(j i) := Nat.not_le_of_lt i_lt_j
have not_j_lt_i : ¬(j < i) := Nat.not_lt_of_le i_le_j
have not_j_lt_i_succ : ¬(j < i + 1) :=
Nat.not_le_of_lt (Nat.succ_lt_succ i_lt_j)
simp [i_le_j, not_j_le_i, not_j_lt_i, not_j_lt_i_succ]
· simp [i_eq_j]
· have j_le_i : j i := Nat.le_of_lt j_lt_i
have j_le_i_succ : j < i + 1 := Nat.succ_le_succ j_le_i
have not_j_ge_i : ¬(j i) := Nat.not_le_of_lt j_lt_i
simp [j_lt_i, j_le_i, not_j_ge_i, j_le_i_succ]
private theorem mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ
(x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by
have : c.toNat 1 := Bool.toNat_le c
rw [Nat.pow_succ]
omega
private theorem mod_two_pow_lt (x i : Nat) : x % 2 ^ i < 2^i := Nat.mod_lt _ (Nat.two_pow_pos _)
/-! ### Addition -/
/-- carry i x y c returns true if the `i` carry bit is true when computing `x + y + c`. -/
def carry (i : Nat) (x y : BitVec w) (c : Bool) : Bool :=
decide (x.toNat % 2^i + y.toNat % 2^i + c.toNat 2^i)
/-- carry w x y c returns true if the `w` carry bit is true when computing `x + y + c`. -/
def carry (w x y : Nat) (c : Bool) : Bool := decide (x % 2^w + y % 2^w + c.toNat 2^w)
@[simp] theorem carry_zero : carry 0 x y c = c := by
cases c <;> simp [carry, mod_one]
theorem carry_succ (i : Nat) (x y : BitVec w) (c : Bool) :
carry (i+1) x y c = atLeastTwo (x.getLsb i) (y.getLsb i) (carry i x y c) := by
simp only [carry, mod_two_pow_succ, atLeastTwo, getLsb]
simp only [Nat.pow_succ']
have sum_bnd : x.toNat%2^i + (y.toNat%2^i + c.toNat) < 2*2^i := by
simp only [ Nat.pow_succ']
exact mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ ..
cases x.toNat.testBit i <;> cases y.toNat.testBit i <;> (simp; omega)
/--
If `x &&& y = 0`, then the carry bit `(x + y + 0)` is always `false` for any index `i`.
Intuitively, this is because a carry is only produced when at least two of `x`, `y`, and the
previous carry are true. However, since `x &&& y = 0`, at most one of `x, y` can be true,
and thus we never have a previous carry, which means that the sum cannot produce a carry.
-/
theorem carry_of_and_eq_zero {x y : BitVec w} (h : x &&& y = 0#w) : carry i x y false = false := by
induction i with
| zero => simp
| succ i ih =>
replace h := congrArg (·.getLsb i) h
simp_all [carry_succ]
/-- The final carry bit when computing `x + y + c` is `true` iff `x.toNat + y.toNat + c.toNat ≥ 2^w`. -/
theorem carry_width {x y : BitVec w} :
carry w x y c = decide (x.toNat + y.toNat + c.toNat 2^w) := by
simp [carry]
/--
If `x &&& y = 0`, then addition does not overflow, and thus `(x + y).toNat = x.toNat + y.toNat`.
-/
theorem toNat_add_of_and_eq_zero {x y : BitVec w} (h : x &&& y = 0#w) :
(x + y).toNat = x.toNat + y.toNat := by
rw [toNat_add]
apply Nat.mod_eq_of_lt
suffices ¬ decide (x.toNat + y.toNat + false.toNat 2^w) by
simp only [decide_eq_true_eq] at this
omega
rw [ carry_width]
simp [not_eq_true, carry_of_and_eq_zero h]
/-- At least two out of three booleans are true. -/
abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c
/-- Carry function for bitwise addition. -/
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c))
@@ -138,9 +96,25 @@ def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xo
def adc (x y : BitVec w) : Bool Bool × BitVec w :=
iunfoldr fun (i : Fin w) c => adcb (x.getLsb i) (y.getLsb i) c
theorem adc_overflow_limit (x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by
have : c.toNat 1 := Bool.toNat_le_one c
rw [Nat.pow_succ]
omega
theorem carry_succ (w x y : Nat) (c : Bool) :
carry (succ w) x y c = atLeastTwo (x.testBit w) (y.testBit w) (carry w x y c) := by
simp only [carry, mod_two_pow_succ, atLeastTwo]
simp only [Nat.pow_succ']
generalize testBit x w = xh
generalize testBit y w = yh
have sum_bnd : x%2^w + (y%2^w + c.toNat) < 2*2^w := by
simp only [ Nat.pow_succ']
exact adc_overflow_limit x y w c
cases xh <;> cases yh <;> (simp; omega)
theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
getLsb (x + y + zeroExtend w (ofBool c)) i =
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x y c)) := by
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat c)) := by
let x, x_lt := x
let y, y_lt := y
simp only [getLsb, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool,
@@ -155,27 +129,33 @@ theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool)
Bool.true_and,
Nat.add_assoc,
Nat.add_left_comm (_%_) (_ * _) _,
testBit_limit (mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ x y i c)
testBit_limit (adc_overflow_limit x y i c)
]
simp [testBit_to_div_mod, carry, Nat.add_assoc]
theorem getLsb_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
getLsb (x + y) i =
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x y false)) := by
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat false)) := by
simpa using getLsb_add_add_bool i_lt x y false
theorem adc_spec (x y : BitVec w) (c : Bool) :
adc x y c = (carry w x y c, x + y + zeroExtend w (ofBool c)) := by
adc x y c = (carry w x.toNat y.toNat c, x + y + zeroExtend w (ofBool c)) := by
simp only [adc]
apply iunfoldr_replace
(fun i => carry i x y c)
(fun i => carry i x.toNat y.toNat c)
(x + y + zeroExtend w (ofBool c))
c
case init =>
simp [carry, Nat.mod_one]
cases c <;> rfl
case step =>
simp [adcb, Prod.mk.injEq, carry_succ, getLsb_add_add_bool]
intro i, lt
simp only [adcb, Prod.mk.injEq, carry_succ]
apply And.intro
case left =>
rw [testBit_toNat, testBit_toNat]
case right =>
simp [getLsb_add_add_bool lt]
theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := by
simp [adc_spec]
@@ -191,305 +171,3 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
/-- Subtracting `x` from the all ones bitvector is equivalent to taking its complement -/
theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by
rw [ add_not_self x, BitVec.add_comm, add_sub_cancel]
/-- Addition of bitvectors is the same as bitwise or, if bitwise and is zero. -/
theorem add_eq_or_of_and_eq_zero {w : Nat} (x y : BitVec w)
(h : x &&& y = 0#w) : x + y = x ||| y := by
rw [add_eq_adc, adc, iunfoldr_replace (fun _ => false) (x ||| y)]
· rfl
· simp only [adcb, atLeastTwo, Bool.and_false, Bool.or_false, bne_false, getLsb_or,
Prod.mk.injEq, and_eq_false_imp]
intros i
replace h : (x &&& y).getLsb i = (0#w).getLsb i := by rw [h]
simp only [getLsb_and, getLsb_zero, and_eq_false_imp] at h
constructor
· intros hx
simp_all [hx]
· by_cases hx : x.getLsb i <;> simp_all [hx]
/-! ### Negation -/
theorem bit_not_testBit (x : BitVec w) (i : Fin w) :
getLsb (((iunfoldr (fun (i : Fin w) c => (c, !(x.getLsb i)))) ()).snd) i.val = !(getLsb x i.val) := by
apply iunfoldr_getLsb (fun _ => ()) i (by simp)
theorem bit_not_add_self (x : BitVec w) :
((iunfoldr (fun (i : Fin w) c => (c, !(x.getLsb i)))) ()).snd + x = -1 := by
simp only [add_eq_adc]
apply iunfoldr_replace_snd (fun _ => false) (-1) false rfl
intro i; simp only [ BitVec.not, adcb, testBit_toNat]
rw [iunfoldr_replace_snd (fun _ => ()) (((iunfoldr (fun i c => (c, !(x.getLsb i)))) ()).snd)]
<;> simp [bit_not_testBit, negOne_eq_allOnes, getLsb_allOnes]
theorem bit_not_eq_not (x : BitVec w) :
((iunfoldr (fun i c => (c, !(x.getLsb i)))) ()).snd = ~~~ x := by
simp [allOnes_sub_eq_not, BitVec.eq_sub_iff_add_eq.mpr (bit_not_add_self x), negOne_eq_allOnes]
theorem bit_neg_eq_neg (x : BitVec w) : -x = (adc (((iunfoldr (fun (i : Fin w) c => (c, !(x.getLsb i)))) ()).snd) (BitVec.ofNat w 1) false).snd:= by
simp only [ add_eq_adc]
rw [iunfoldr_replace_snd ((fun _ => ())) (((iunfoldr (fun (i : Fin w) c => (c, !(x.getLsb i)))) ()).snd) _ rfl]
· rw [BitVec.eq_sub_iff_add_eq.mpr (bit_not_add_self x), sub_toAdd, BitVec.add_comm _ (-x)]
simp [ sub_toAdd, BitVec.sub_add_cancel]
· simp [bit_not_testBit x _]
/-! ### Inequalities (le / lt) -/
theorem ult_eq_not_carry (x y : BitVec w) : x.ult y = !carry w x (~~~y) true := by
simp only [BitVec.ult, carry, toNat_mod_cancel, toNat_not, toNat_true, ge_iff_le, decide_not,
Nat.not_le, decide_eq_decide]
rw [Nat.mod_eq_of_lt (by omega)]
omega
theorem ule_eq_not_ult (x y : BitVec w) : x.ule y = !y.ult x := by
simp [BitVec.ule, BitVec.ult, decide_not]
theorem ule_eq_carry (x y : BitVec w) : x.ule y = carry w y (~~~x) true := by
simp [ule_eq_not_ult, ult_eq_not_carry]
/-- If two bitvectors have the same `msb`, then signed and unsigned comparisons coincide -/
theorem slt_eq_ult_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) :
x.slt y = x.ult y := by
simp only [BitVec.slt, toInt_eq_msb_cond, BitVec.ult, decide_eq_decide, h]
cases y.msb <;> simp
/-- If two bitvectors have different `msb`s, then unsigned comparison is determined by this bit -/
theorem ult_eq_msb_of_msb_neq {x y : BitVec w} (h : x.msb y.msb) :
x.ult y = y.msb := by
simp only [BitVec.ult, msb_eq_decide, ne_eq, decide_eq_decide] at *
omega
/-- If two bitvectors have different `msb`s, then signed and unsigned comparisons are opposites -/
theorem slt_eq_not_ult_of_msb_neq {x y : BitVec w} (h : x.msb y.msb) :
x.slt y = !x.ult y := by
simp only [BitVec.slt, toInt_eq_msb_cond, Bool.eq_not_of_ne h, ult_eq_msb_of_msb_neq h]
cases y.msb <;> (simp; omega)
theorem slt_eq_ult (x y : BitVec w) :
x.slt y = (x.msb != y.msb).xor (x.ult y) := by
by_cases h : x.msb = y.msb
· simp [h, slt_eq_ult_of_msb_eq]
· have h' : x.msb != y.msb := by simp_all
simp [slt_eq_not_ult_of_msb_neq h, h']
theorem slt_eq_not_carry (x y : BitVec w) :
x.slt y = (x.msb == y.msb).xor (carry w x (~~~y) true) := by
simp only [slt_eq_ult, bne, ult_eq_not_carry]
cases x.msb == y.msb <;> simp
theorem sle_eq_not_slt (x y : BitVec w) : x.sle y = !y.slt x := by
simp only [BitVec.sle, BitVec.slt, decide_not, decide_eq_decide]; omega
theorem sle_eq_carry (x y : BitVec w) :
x.sle y = !((x.msb == y.msb).xor (carry w y (~~~x) true)) := by
rw [sle_eq_not_slt, slt_eq_not_carry, beq_comm]
/-! ### mul recurrence for bitblasting -/
/--
A recurrence that describes multiplication as repeated addition.
Is useful for bitblasting multiplication.
-/
def mulRec (l r : BitVec w) (s : Nat) : BitVec w :=
let cur := if r.getLsb s then (l <<< s) else 0
match s with
| 0 => cur
| s + 1 => mulRec l r s + cur
theorem mulRec_zero_eq (l r : BitVec w) :
mulRec l r 0 = if r.getLsb 0 then l else 0 := by
simp [mulRec]
theorem mulRec_succ_eq (l r : BitVec w) (s : Nat) :
mulRec l r (s + 1) = mulRec l r s + if r.getLsb (s + 1) then (l <<< (s + 1)) else 0 := rfl
/--
Recurrence lemma: truncating to `i+1` bits and then zero extending to `w`
equals truncating upto `i` bits `[0..i-1]`, and then adding the `i`th bit of `x`.
-/
theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w) (i : Nat) :
zeroExtend w (x.truncate (i + 1)) =
zeroExtend w (x.truncate i) + (x &&& twoPow w i) := by
rw [add_eq_or_of_and_eq_zero]
· ext k
simp only [getLsb_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsb_or, getLsb_and]
by_cases hik : i = k
· subst hik
simp
· simp only [getLsb_twoPow, hik, decide_False, Bool.and_false, Bool.or_false]
by_cases hik' : k < (i + 1)
· have hik'' : k < i := by omega
simp [hik', hik'']
· have hik'' : ¬ (k < i) := by omega
simp [hik', hik'']
· ext k
simp
by_cases hi : x.getLsb i <;> simp [hi] <;> omega
/--
Recurrence lemma: multiplying `l` with the first `s` bits of `r` is the
same as truncating `r` to `s` bits, then zero extending to the original length,
and performing the multplication. -/
theorem mulRec_eq_mul_signExtend_truncate (l r : BitVec w) (s : Nat) :
mulRec l r s = l * ((r.truncate (s + 1)).zeroExtend w) := by
induction s
case zero =>
simp only [mulRec_zero_eq, ofNat_eq_ofNat, Nat.reduceAdd]
by_cases r.getLsb 0
case pos hr =>
simp only [hr, reduceIte, truncate, zeroExtend_one_eq_ofBool_getLsb_zero,
hr, ofBool_true, ofNat_eq_ofNat]
rw [zeroExtend_ofNat_one_eq_ofNat_one_of_lt (by omega)]
simp
case neg hr =>
simp [hr, zeroExtend_one_eq_ofBool_getLsb_zero]
case succ s' hs =>
rw [mulRec_succ_eq, hs]
have heq :
(if r.getLsb (s' + 1) = true then l <<< (s' + 1) else 0) =
(l * (r &&& (BitVec.twoPow w (s' + 1)))) := by
simp only [ofNat_eq_ofNat, and_twoPow]
by_cases hr : r.getLsb (s' + 1) <;> simp [hr]
rw [heq, BitVec.mul_add, zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow]
theorem getLsb_mul (x y : BitVec w) (i : Nat) :
(x * y).getLsb i = (mulRec x y w).getLsb i := by
simp only [mulRec_eq_mul_signExtend_truncate]
rw [truncate, truncate_eq_zeroExtend, truncate_eq_zeroExtend,
truncate_truncate_of_le]
· simp
· omega
/-! ## shiftLeft recurrence for bitblasting -/
/--
`shiftLeftRec x y n` shifts `x` to the left by the first `n` bits of `y`.
The theorem `shiftLeft_eq_shiftLeftRec` proves the equivalence of `(x <<< y)` and `shiftLeftRec`.
Together with equations `shiftLeftRec_zero`, `shiftLeftRec_succ`,
this allows us to unfold `shiftLeft` into a circuit for bitblasting.
-/
def shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) (n : Nat) : BitVec w₁ :=
let shiftAmt := (y &&& (twoPow w₂ n))
match n with
| 0 => x <<< shiftAmt
| n + 1 => (shiftLeftRec x y n) <<< shiftAmt
@[simp]
theorem shiftLeftRec_zero {x : BitVec w₁} {y : BitVec w₂} :
shiftLeftRec x y 0 = x <<< (y &&& twoPow w₂ 0) := by
simp [shiftLeftRec]
@[simp]
theorem shiftLeftRec_succ {x : BitVec w₁} {y : BitVec w₂} :
shiftLeftRec x y (n + 1) = (shiftLeftRec x y n) <<< (y &&& twoPow w₂ (n + 1)) := by
simp [shiftLeftRec]
/--
If `y &&& z = 0`, `x <<< (y ||| z) = x <<< y <<< z`.
This follows as `y &&& z = 0` implies `y ||| z = y + z`,
and thus `x <<< (y ||| z) = x <<< (y + z) = x <<< y <<< z`.
-/
theorem shiftLeft_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
(h : y &&& z = 0#w₂) :
x <<< (y ||| z) = x <<< y <<< z := by
rw [ add_eq_or_of_and_eq_zero _ _ h,
shiftLeft_eq', toNat_add_of_and_eq_zero h]
simp [shiftLeft_add]
/--
`shiftLeftRec x y n` shifts `x` to the left by the first `n` bits of `y`.
-/
theorem shiftLeftRec_eq {x : BitVec w₁} {y : BitVec w₂} {n : Nat} :
shiftLeftRec x y n = x <<< (y.truncate (n + 1)).zeroExtend w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, truncate_one,
and_one_eq_zeroExtend_ofBool_getLsb]
case succ n ih =>
simp only [shiftLeftRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsb (n + 1)
· simp only [h, reduceIte]
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsb_true h,
shiftLeft_or_of_and_eq_zero]
simp
· simp only [h, false_eq_true, reduceIte, shiftLeft_zero']
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsb_false (i := n + 1)]
simp [h]
/--
Show that `x <<< y` can be written in terms of `shiftLeftRec`.
This can be unfolded in terms of `shiftLeftRec_zero`, `shiftLeftRec_succ` for bitblasting.
-/
theorem shiftLeft_eq_shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) :
x <<< y = shiftLeftRec x y (w₂ - 1) := by
rcases w₂ with rfl | w₂
· simp [of_length_zero]
· simp [shiftLeftRec_eq]
/- ### Logical shift right (ushiftRight) recurrence for bitblasting -/
/--
`ushiftRightRec x y n` shifts `x` logically to the right by the first `n` bits of `y`.
The theorem `shiftRight_eq_ushiftRightRec` proves the equivalence
of `(x >>> y)` and `ushiftRightRec`.
Together with equations `ushiftRightRec_zero`, `ushiftRightRec_succ`,
this allows us to unfold `ushiftRight` into a circuit for bitblasting.
-/
def ushiftRightRec (x : BitVec w₁) (y : BitVec w₂) (n : Nat) : BitVec w₁ :=
let shiftAmt := (y &&& (twoPow w₂ n))
match n with
| 0 => x >>> shiftAmt
| n + 1 => (ushiftRightRec x y n) >>> shiftAmt
@[simp]
theorem ushiftRightRec_zero (x : BitVec w₁) (y : BitVec w₂) :
ushiftRightRec x y 0 = x >>> (y &&& twoPow w₂ 0) := by
simp [ushiftRightRec]
@[simp]
theorem ushiftRightRec_succ (x : BitVec w₁) (y : BitVec w₂) :
ushiftRightRec x y (n + 1) = (ushiftRightRec x y n) >>> (y &&& twoPow w₂ (n + 1)) := by
simp [ushiftRightRec]
/--
If `y &&& z = 0`, `x >>> (y ||| z) = x >>> y >>> z`.
This follows as `y &&& z = 0` implies `y ||| z = y + z`,
and thus `x >>> (y ||| z) = x >>> (y + z) = x >>> y >>> z`.
-/
theorem ushiftRight'_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
(h : y &&& z = 0#w₂) :
x >>> (y ||| z) = x >>> y >>> z := by
simp [ add_eq_or_of_and_eq_zero _ _ h, toNat_add_of_and_eq_zero h, shiftRight_add]
theorem ushiftRightRec_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
ushiftRightRec x y n = x >>> (y.truncate (n + 1)).zeroExtend w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [ushiftRightRec_zero, twoPow_zero, Nat.reduceAdd,
and_one_eq_zeroExtend_ofBool_getLsb, truncate_one]
case succ n ih =>
simp only [ushiftRightRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsb (n + 1) <;> simp only [h, reduceIte]
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsb_true h,
ushiftRight'_or_of_and_eq_zero]
simp
· simp [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsb_false, h]
/--
Show that `x >>> y` can be written in terms of `ushiftRightRec`.
This can be unfolded in terms of `ushiftRightRec_zero`, `ushiftRightRec_succ` for bitblasting.
-/
theorem shiftRight_eq_ushiftRightRec (x : BitVec w₁) (y : BitVec w₂) :
x >>> y = ushiftRightRec x y (w₂ - 1) := by
rcases w₂ with rfl | w₂
· simp [of_length_zero]
· simp [ushiftRightRec_eq]
end BitVec

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