Compare commits

..

5 Commits

Author SHA1 Message Date
Leonardo de Moura
a06e0edcf3 chore: fix tests 2024-03-13 20:57:53 -07:00
Leonardo de Moura
8f8aa0baca chore: update stage0 2024-03-13 20:47:18 -07:00
Leonardo de Moura
347d30439b chore: remove bootstrapping workaround 2024-03-13 20:46:04 -07:00
Leonardo de Moura
6f4c2d55ba chore: update stage0 2024-03-13 20:44:10 -07:00
Leonardo de Moura
22a408e572 chore: avoid reserved name
TODO: update state0 and cleanup
2024-03-13 20:41:52 -07:00
2432 changed files with 9213 additions and 43650 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

@@ -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,6 +6,7 @@ on:
tags:
- '*'
pull_request:
types: [opened, synchronize, reopened, labeled]
merge_group:
schedule:
- cron: '0 7 * * *' # 8AM CET/11PM PT
@@ -40,18 +41,12 @@ jobs:
steps:
- name: Run quick CI?
id: set-quick
# 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 settings the `full-ci` label.
run: |
if [ "${{ github.event_name }}" == 'pull_request' ]
then
echo "quick=$(gh api repos/${{ github.repository_owner }}/${{ github.event.repository.name }}/pulls/${{ github.event.pull_request.number }} --jq '.labels | any(.name == "full-ci") | not')" >> "$GITHUB_OUTPUT"
else
echo "quick=false" >> "$GITHUB_OUTPUT"
fi
env:
GH_TOKEN: ${{ github.token }}
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
@@ -59,10 +54,7 @@ jobs:
with:
script: |
const quick = ${{ steps.set-quick.outputs.quick }};
console.log(`quick: ${quick}`);
// use large runners outside PRs where available (original repo)
// disabled for now as this mostly just speeds up the test suite which is not a bottleneck
// let large = ${{ github.event_name != 'pull_request' && github.repository == 'leanprover/lean4' }} ? "-large" : "";
console.log(`quick: ${quick}`)
let matrix = [
{
// portable release build: use channel with older glibc (2.27)
@@ -70,7 +62,7 @@ jobs:
"os": "ubuntu-latest",
"release": false,
"quick": false,
"shell": "nix develop .#oldGlibc -c bash -euxo pipefail {0}",
"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",
@@ -84,7 +76,7 @@ jobs:
"os": "ubuntu-latest",
"release": true,
"quick": true,
"shell": "nix develop .#oldGlibc -c bash -euxo pipefail {0}",
"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",
@@ -106,8 +98,7 @@ jobs:
// exclude seriously slow tests
"CTEST_OPTIONS": "-E 'interactivetest|leanpkgtest|laketest|benchtest'"
},
// TODO: suddenly started failing in CI
/*{
{
"name": "Linux fsanitize",
"os": "ubuntu-latest",
"quick": false,
@@ -115,10 +106,10 @@ jobs:
"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-13",
"os": "macos-latest",
"release": true,
"quick": false,
"shell": "bash -euxo pipefail {0}",
@@ -129,7 +120,7 @@ jobs:
},
{
"name": "macOS aarch64",
"os": "macos-13",
"os": "macos-latest",
"release": true,
"quick": false,
"cross": true,
@@ -149,10 +140,12 @@ jobs:
"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",
// also, the liasolver test hits “too many exported symbols”
"CTEST_OPTIONS": "--repeat until-pass:2 -E 'leanbenchtest_liasolver.lean'",
"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"
// TEMP while compiler tests are deactivated
"binary-check": "true"
},
{
"name": "Linux aarch64",
@@ -162,7 +155,7 @@ jobs:
"quick": false,
"cross": true,
"cross_target": "aarch64-unknown-linux-gnu",
"shell": "nix develop .#oldGlibcAArch -c bash -euxo pipefail {0}",
"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-*"
},
@@ -260,7 +253,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
@@ -285,18 +278,18 @@ jobs:
uses: cachix/install-nix-action@v18
with:
install_url: https://releases.nixos.org/nix/nix-2.12.0/install
if: runner.os == 'Linux' && !matrix.cmultilib
if: matrix.os == 'ubuntu-latest' && !matrix.cmultilib
- name: Install MSYS2
uses: msys2/setup-msys2@v2
with:
msystem: clang64
# `: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: runner.os == 'Windows'
if: matrix.os == 'windows-2022'
- name: Install Brew Packages
run: |
brew install ccache tree zstd coreutils gmp
if: runner.os == 'macOS'
if: matrix.os == 'macos-latest'
- name: Setup emsdk
uses: mymindstorm/setup-emsdk@v12
with:
@@ -320,13 +313,13 @@ jobs:
run: |
# open nix-shell once for initial setup
true
if: runner.os == 'Linux'
if: matrix.os == 'ubuntu-latest'
- name: Set up core dumps
run: |
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: runner.os == 'Linux'
if: matrix.os == 'ubuntu-latest'
- name: Build
run: |
mkdir build
@@ -391,14 +384,8 @@ jobs:
cd build/stage1
ulimit -c unlimited # coredumps
# exclude nonreproducible test
ctest -j4 --progress --output-junit test-results.xml --output-on-failure ${{ matrix.CTEST_OPTIONS }} < /dev/null
ctest -j4 --output-on-failure ${{ matrix.CTEST_OPTIONS }} < /dev/null
if: (matrix.wasm || !matrix.cross) && needs.configure.outputs.quick == 'false'
- 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() && (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 && needs.configure.outputs.quick == 'false' }}
@@ -431,7 +418,7 @@ jobs:
- name: CCache stats
run: ccache -s
- name: Show stacktrace for coredumps
if: ${{ failure() && runner.os == 'Linux' }}
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
run: |
for c in coredumps/*; do
progbin="$(file $c | sed "s/.*execfn: '\([^']*\)'.*/\1/")"
@@ -441,7 +428,7 @@ jobs:
# shared libs
#- name: Upload coredumps
# uses: actions/upload-artifact@v3
# if: ${{ failure() && runner.os == 'Linux' }}
# if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
# with:
# name: coredumps-${{ matrix.name }}
# path: |
@@ -460,10 +447,9 @@ 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')
- if: contains(needs.*.result, 'failure') || contains(needs.*.result, 'cancelled')
uses: actions/github-script@v7
with:
script: |

View File

@@ -10,7 +10,7 @@ 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"

View File

@@ -6,6 +6,7 @@ on:
tags:
- '*'
pull_request:
types: [opened, synchronize, reopened, labeled]
merge_group:
concurrency:
@@ -76,13 +77,7 @@ 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,test,inked} -o push-doc

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. Try \`git rebase $MERGE_BASE_SHA --onto $NIGHTLY_SHA\`."
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@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 }}"
@@ -321,7 +321,7 @@ 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 batteries from git \"https:\/\/github.com\/leanprover-community\/batteries\" @ \".\+\"/require batteries from git \"https:\/\/github.com\/leanprover-community\/batteries\" @ \"nightly-testing-${MOST_RECENT_NIGHTLY}\"/" lakefile.lean
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

View File

@@ -1,31 +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, 'full-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 10s"
sleep 10
echo "Rerunning"
gh run rerun "$run_id"
shell: bash
env:
head_ref: ${{ github.head_ref }}
GH_TOKEN: ${{ github.token }}
GH_REPO: ${{ github.repository }}

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

@@ -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/runtime/io.cpp @joehendrix

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).

View File

@@ -8,43 +8,24 @@ This file contains work-in-progress notes for the upcoming release, as well as p
Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
of each version.
v4.9.0 (development in progress)
v4.8.0 (development in progress)
---------
* Functions defined by well-founded recursion are now marked as
`@[irreducible]`, which should prevent expensive and often unfruitful
unfolding of such definitions.
Existing proofs that hold by definitional equality (e.g. `rfl`) can be
rewritten to explictly unfold the function definition (using `simp`,
`unfold`, `rw`), or the recursive function can be temporariliy made
semireducible (using `unseal f in` before the command) or the function
definition itself can be marked as `@[semireducible]` to get the previous
behavor.
v4.8.0
---------
* **Executables configured with `supportInterpreter := true` on Windows should now be run via `lake exe` to function properly.**
The way Lean is built on Windows has changed (see PR [#3601](https://github.com/leanprover/lean4/pull/3601)). As a result, Lake now dynamically links executables with `supportInterpreter := true` on Windows to `libleanshared.dll` and `libInit_shared.dll`. Therefore, such executables will not run unless those shared libraries are co-located with the executables or part of `PATH`. Running the executable via `lake exe` will ensure these libraries are part of `PATH`.
In a related change, the signature of the `nativeFacets` Lake configuration options has changed from a static `Array` to a function `(shouldExport : Bool) → Array`. See its docstring or Lake's [README](src/lake/README.md) for further details on the changed option.
* Lean now generates an error if the type of a theorem is **not** a proposition.
* Importing two different files containing proofs of the same theorem is no longer considered an error. This feature is particularly useful for theorems that are automatically generated on demand (e.g., equational theorems).
* Functional induction principles.
* New command `derive_functinal_induction`:
Derived from the definition of a (possibly mutually) recursive function, a **functional induction principle** is created that is tailored to proofs about that function.
For example from:
Derived from the definition of a (possibly mutually) recursive function
defined by well-founded recursion, a **functional induction principle** is
tailored to proofs about that function. For example from:
```
def ackermann : Nat → Nat → Nat
| 0, m => m + 1
| n+1, 0 => ackermann n 1
| n+1, m+1 => ackermann n (ackermann (n + 1) m)
derive_functional_induction ackermann
```
we get
```
@@ -54,72 +35,6 @@ v4.8.0
(x x : Nat) : motive x x
```
It can be used in the `induction` tactic using the `using` syntax:
```
induction n, m using ackermann.induct
```
* The termination checker now recognizes more recursion patterns without an
explicit `termination_by`. In particular the idiom of counting up to an upper
bound, as in
```
def Array.sum (arr : Array Nat) (i acc : Nat) : Nat :=
if _ : i < arr.size then
Array.sum arr (i+1) (acc + arr[i])
else
acc
```
is recognized without having to say `termination_by arr.size - i`.
* Shorter instances names. There is a new algorithm for generating names for anonymous instances.
Across Std and Mathlib, the median ratio between lengths of new names and of old names is about 72%.
With the old algorithm, the longest name was 1660 characters, and now the longest name is 202 characters.
The new algorithm's 95th percentile name length is 67 characters, versus 278 for the old algorithm.
While the new algorithm produces names that are 1.2% less unique,
it avoids cross-project collisions by adding a module-based suffix
when it does not refer to declarations from the same "project" (modules that share the same root).
PR [#3089](https://github.com/leanprover/lean4/pull/3089).
* Attribute `@[pp_using_anonymous_constructor]` to make structures pretty print like `⟨x, y, z⟩`
rather than `{a := x, b := y, c := z}`.
This attribute is applied to `Sigma`, `PSigma`, `PProd`, `Subtype`, `And`, and `Fin`.
* Now structure instances pretty print with parent structures' fields inlined.
That is, if `B` extends `A`, then `{ toA := { x := 1 }, y := 2 }` now pretty prints as `{ x := 1, y := 2 }`.
Setting option `pp.structureInstances.flatten` to false turns this off.
* Option `pp.structureProjections` is renamed to `pp.fieldNotation`, and there is now a suboption `pp.fieldNotation.generalized`
to enable pretty printing function applications using generalized field notation (defaults to true).
Field notation can be disabled on a function-by-function basis using the `@[pp_nodot]` attribute.
* Added options `pp.mvars` (default: true) and `pp.mvars.withType` (default: false).
When `pp.mvars` is false, expression metavariables pretty print as `?_` and universe metavariables pretty print as `_`.
When `pp.mvars.withType` is true, expression metavariables pretty print with a type ascription.
These can be set when using `#guard_msgs` to make tests not depend on the particular names of metavariables.
[#3798](https://github.com/leanprover/lean4/pull/3798) and
[#3978](https://github.com/leanprover/lean4/pull/3978).
* Hovers for terms in `match` expressions in the Infoview now reliably show the correct term.
* Added `@[induction_eliminator]` and `@[cases_eliminator]` attributes to be able to define custom eliminators
for the `induction` and `cases` tactics, replacing the `@[eliminator]` attribute.
Gives custom eliminators for `Nat` so that `induction` and `cases` put goal states into terms of `0` and `n + 1`
rather than `Nat.zero` and `Nat.succ n`.
Added option `tactic.customEliminators` to control whether to use custom eliminators.
Added a hack for `rcases`/`rintro`/`obtain` to use the custom eliminator for `Nat`.
[#3629](https://github.com/leanprover/lean4/pull/3629),
[#3655](https://github.com/leanprover/lean4/pull/3655), and
[#3747](https://github.com/leanprover/lean4/pull/3747).
* The `#guard_msgs` command now has options to change whitespace normalization and sensitivity to message ordering.
For example, `#guard_msgs (whitespace := lax) in cmd` collapses whitespace before checking messages,
and `#guard_msgs (ordering := sorted) in cmd` sorts the messages in lexicographic order before checking.
PR [#3883](https://github.com/leanprover/lean4/pull/3883).
* The `#guard_msgs` command now supports showing a diff between the expected and actual outputs. This feature is currently
disabled by default, but can be enabled with `set_option guard_msgs.diff true`. Depending on user feedback, this option
may default to `true` in a future version of Lean.
Breaking changes:
* Automatically generated equational theorems are now named using suffix `.eq_<idx>` instead of `._eq_<idx>`, and `.def` instead of `._unfold`. Example:
@@ -147,14 +62,6 @@ fact.def :
-/
```
* The coercion from `String` to `Name` was removed. Previously, it was `Name.mkSimple`, which does not separate strings at dots, but experience showed that this is not always the desired coercion. For the previous behavior, manually insert a call to `Name.mkSimple`.
* The `Subarray` fields `as`, `h₁` and `h₂` have been renamed to `array`, `start_le_stop`, and `stop_le_array_size`, respectively. This more closely follows standard Lean conventions. Deprecated aliases for the field projections were added; these will be removed in a future release.
* The change to the instance name algorithm (described above) can break projects that made use of the auto-generated names.
* `Option.toMonad` has been renamed to `Option.getM` and the unneeded `[Monad m]` instance argument has been removed.
v4.7.0
---------

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

@@ -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`.

View File

@@ -21,7 +21,7 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Reconcile discrepancies in the `v4.6.0` section,
usually via copy and paste and a commit to `releases/v4.6.0`.
- `git tag v4.6.0`
- `git push $REMOTE v4.6.0`, where `$REMOTE` is the upstream Lean repository (e.g., `origin`, `upstream`)
- `git push origin v4.6.0`
- 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.
@@ -34,76 +34,48 @@ We'll use `v4.6.0` as the intended release version as a running example.
(e.g. `v4.6.0-rc1`), and quickly 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.
- Make a PR to `master`/`main` changing the toolchain to `v4.6.0`.
The PR title should be "chore: bump toolchain to v4.6.0".
Since the `v4.6.0` release should be functionally identical to the last release candidate,
which the repository should already be on, this PR is a no-op besides changing the toolchain.
- Once this is merged, create the tag `v4.6.0` from `master`/`main` and push it.
- Merge the tag `v4.6.0` into the stable branch.
- We do this for the repositories:
- [lean4checker](https://github.com/leanprover/lean4checker)
- No dependencies
- Note: `lean4checker` uses a different version tagging scheme: use `toolchain/v4.6.0` rather than `v4.6.0`.
- 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`
- `lean4checker` uses a different version tagging scheme: use `toolchain/v4.6.0` rather than `v4.6.0`.
- [Std](https://github.com/leanprover-community/repl)
- [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
- `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.
- [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/build.yml.in` in the `lean4checker` section update the line
`git checkout toolchain/v4.6.0` to the appropriate tag,
and then run `.github/workflows/mk_build_yml.sh`. Coordinate with
a Mathlib maintainer to get this merged.
- 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.
- In addition to updating the `lean-toolchain` and `lakefile.lean`,
in `.github/workflows/build.yml.in` in the `lean4checker` section update the line
`git checkout toolchain/v4.6.0` to the appropriate tag,
and then run `.github/workflows/mk_build_yml.sh`.
- [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`
in the root, and in `test/Mathlib/`.
- Note that there are dependencies between these packages:
you should update the lakefile so that you are using the `v4.6.0` tag of upstream repositories
(or the sequential tag for `ProofWidgets4`), and run `lake update` before committing.
- This means that this process is sequential; each repository must have its bump PR merged,
and the new tag pushed, before you can make the PR for the downstream repositories.
- `lean4checker` has no dependencies
- `Std` has no dependencies
- `Aesop` depends on `Std`
- `ProofWidgets4` depends on `Std`
- `Mathlib` depends on `Aesop`, `ProofWidgets4`, and `lean4checker` (and transitively on `Std`)
- `REPL` depends on `Mathlib` (this dependency is only for testing).
- 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.
Please also make sure that whoever is handling social media knows the release is out.
## Optimistic(?) time estimates:
- Initial checks and push the tag: 30 minutes.
@@ -123,8 +95,8 @@ 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`
- It is essential that Std and Mathlib already have reviewed branches compatible with this nightly.
- Check that both Std 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:
@@ -182,7 +154,7 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
- 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!
- For Batteries/Aesop/Mathlib, which maintain a `nightly-testing` branch, make sure there is a tag
- For Std/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!
@@ -204,7 +176,7 @@ In particular, updating the downstream repositories is significantly more work
# 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.
this is a brief summary of the work that goes into updating Std/Aesop/Mathlib to new versions.
Please read https://leanprover-community.github.io/contribute/tags_and_branches.html

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

@@ -27,7 +27,7 @@
src = inputs.mdBook;
cargoDeps = drv.cargoDeps.overrideAttrs (_: {
inherit src;
outputHash = "sha256-CO3A9Kpp4sIvkT9X3p+GTidazk7Fn4jf0AP2PINN44A=";
outputHash = "sha256-1YlPS6cqgxE4fjy9G8pWrpP27YrrbCDnfeyIsX81ZNw=";
});
doCheck = false;
});

View File

@@ -12,7 +12,7 @@ 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
--------------------------

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

105
flake.lock generated
View File

@@ -1,31 +1,12 @@
{
"nodes": {
"flake-compat": {
"flake": false,
"locked": {
"lastModified": 1673956053,
"narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=",
"owner": "edolstra",
"repo": "flake-compat",
"rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9",
"type": "github"
},
"original": {
"owner": "edolstra",
"repo": "flake-compat",
"type": "github"
}
},
"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": {
@@ -37,11 +18,11 @@
"lean4-mode": {
"flake": false,
"locked": {
"lastModified": 1709737301,
"narHash": "sha256-uT9JN2kLNKJK9c/S/WxLjiHmwijq49EgLb+gJUSDpz0=",
"lastModified": 1676498134,
"narHash": "sha256-u3WvyKxOViZG53hkb8wd2/Og6muTecbh+NdflIgVeyk=",
"owner": "leanprover",
"repo": "lean4-mode",
"rev": "f1f24c15134dee3754b82c9d9924866fe6bc6b9f",
"rev": "2c6ef33f476fdf5eb5e4fa4fa023ba8b11372440",
"type": "github"
},
"original": {
@@ -50,35 +31,34 @@
"type": "github"
}
},
"libgit2": {
"lowdown-src": {
"flake": false,
"locked": {
"lastModified": 1697646580,
"narHash": "sha256-oX4Z3S9WtJlwvj0uH9HlYcWv+x1hqp8mhXl7HsLu2f0=",
"owner": "libgit2",
"repo": "libgit2",
"rev": "45fd9ed7ae1a9b74b957ef4f337bc3c8b3df01b5",
"lastModified": 1633514407,
"narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
"owner": "kristapsdz",
"repo": "lowdown",
"rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
"type": "github"
},
"original": {
"owner": "libgit2",
"repo": "libgit2",
"owner": "kristapsdz",
"repo": "lowdown",
"type": "github"
}
},
"nix": {
"inputs": {
"flake-compat": "flake-compat",
"libgit2": "libgit2",
"lowdown-src": "lowdown-src",
"nixpkgs": "nixpkgs",
"nixpkgs-regression": "nixpkgs-regression"
},
"locked": {
"lastModified": 1711102798,
"narHash": "sha256-CXOIJr8byjolqG7eqCLa+Wfi7rah62VmLoqSXENaZnw=",
"lastModified": 1657097207,
"narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
"owner": "NixOS",
"repo": "nix",
"rev": "a22328066416650471c3545b0b138669ea212ab4",
"rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
"type": "github"
},
"original": {
@@ -89,33 +69,16 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1709083642,
"narHash": "sha256-7kkJQd4rZ+vFrzWu8sTRtta5D1kBG0LSRYAfhtmMlSo=",
"lastModified": 1653988320,
"narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "b550fe4b4776908ac2a861124307045f8e717c8e",
"rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "release-23.11",
"repo": "nixpkgs",
"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",
"ref": "nixos-22.05-small",
"repo": "nixpkgs",
"type": "github"
}
@@ -138,11 +101,11 @@
},
"nixpkgs_2": {
"locked": {
"lastModified": 1710889954,
"narHash": "sha256-Pr6F5Pmd7JnNEMHHmspZ0qVqIBVxyZ13ik1pJtm2QXk=",
"lastModified": 1686089707,
"narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "7872526e9c5332274ea5932a0c3270d6e4724f3b",
"rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
"type": "github"
},
"original": {
@@ -157,23 +120,7 @@
"flake-utils": "flake-utils",
"lean4-mode": "lean4-mode",
"nix": "nix",
"nixpkgs": "nixpkgs_2",
"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"
"nixpkgs": "nixpkgs_2"
}
}
},

View File

@@ -2,9 +2,6 @@
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 = {
@@ -20,41 +17,14 @@
# inputs.lean4-mode.follows = "lean4-mode";
#};
outputs = { self, nixpkgs, nixpkgs-old, flake-utils, nix, lean4-mode, ... }@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;
# for `vscode-with-extensions`
config.allowUnfree = true;
};
# 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 = ./.; inherit nix lean4-mode; };
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
# TODO: only add when proven to not affect the flakification
#pkgs.python3
];
# 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;
});
in {
packages = lean-packages // rec {
debug = lean-packages.override { debug = true; };
@@ -79,10 +49,7 @@
};
defaultPackage = lean-packages.lean-all;
# The default development shell for working on lean itself
devShells.default = devShellWithDist pkgs;
devShells.oldGlibc = devShellWithDist pkgsDist-old;
devShells.oldGlibcAArch = devShellWithDist pkgsDist-old-aarch;
inherit (lean-packages) devShell;
checks.lean = lean-packages.test;
}) // rec {

View File

@@ -65,7 +65,7 @@ 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/*.so $out/lib/lean
'';
meta.mainProgram = "lean";
});
@@ -170,17 +170,16 @@ 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 = [ 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

@@ -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:

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,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 "$@"

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

@@ -9,7 +9,7 @@ endif()
include(ExternalProject)
project(LEAN CXX C)
set(LEAN_VERSION_MAJOR 4)
set(LEAN_VERSION_MINOR 9)
set(LEAN_VERSION_MINOR 8)
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'")
@@ -315,12 +315,6 @@ 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")
@@ -509,13 +503,13 @@ 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}/runtime/libleanrt_initial-exec.a -Wl,--no-whole-archive -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libInit_shared.dll.a")
set(INIT_SHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit ${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/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,--whole-archive -lLean -lleancpp -Wl,--no-whole-archive -lInit_shared -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
else()
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}")
endif()
@@ -591,13 +585,9 @@ 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

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

@@ -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
@@ -63,16 +63,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 only [dite_eq_right_iff]
rfl
@[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 only [h, dite_cond_eq_true, dite_cond_eq_false, Option.some.injEq,
false_iff, not_exists]
case pos => exact fun h_eq Exists.intro h h_eq, fun h_exists => h_exists.2
case neg => exact fun h_false _ h_false

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

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

@@ -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

@@ -12,15 +12,6 @@ open Function
@[simp] theorem monadLift_self [Monad m] (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
@@ -33,16 +24,6 @@ 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
@@ -61,18 +42,6 @@ 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

View File

@@ -235,13 +235,13 @@ end StateT
instance : LawfulMonad (EStateM ε σ) := .mk'
(id_map := fun x => funext <| fun s => by
dsimp only [EStateM.instMonad, EStateM.map]
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.instMonad, EStateM.bind]
dsimp only [EStateM.instMonadEStateM, EStateM.bind]
match x s with
| .ok _ _ => rfl
| .error _ _ => 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 α)

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
Notation for operators defined at Prelude.lean
-/
prelude
import Init.Tactics
import Init.Meta
namespace Lean.Parser.Tactic.Conv
@@ -201,7 +201,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 +210,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 `β`
@@ -1114,6 +1112,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)
@@ -1305,6 +1306,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
@@ -1312,12 +1314,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
@@ -1598,7 +1594,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
/--
@@ -2037,8 +2033,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

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,7 +43,7 @@ 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 α :=
@@ -53,15 +52,13 @@ def singleton (v : α) : Array α :=
/-- 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]
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
getElem xs i h := xs.uget i h
instance : LawfulGetElem (Array α) USize α fun xs i => i.toNat < xs.size where
def back [Inhabited α] (a : Array α) : α :=
a.get! (a.size - 1)
@@ -307,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]
@@ -380,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
@@ -461,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
@@ -561,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
@@ -666,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
@@ -709,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 α :=
@@ -722,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
@@ -770,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
@@ -824,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 α`.-/
@@ -846,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
@@ -862,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

@@ -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,8 +21,6 @@ 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]
@@ -39,7 +37,6 @@ theorem isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) : Array.isEqvAux
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,7 +5,6 @@ Authors: Mario Carneiro
-/
prelude
import Init.Data.Nat.MinMax
import Init.Data.Nat.Lemmas
import Init.Data.List.Lemmas
import Init.Data.Fin.Basic
import Init.Data.Array.Mem
@@ -21,13 +20,6 @@ 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]
@@ -138,7 +130,6 @@ where
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]
@@ -148,8 +139,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
@@ -197,8 +187,7 @@ 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 -/
/-- # get -/
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
theorem getElem?_lt
@@ -228,7 +217,7 @@ theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default
@[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 -/
/-- # 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) :
@@ -251,7 +240,7 @@ theorem getElem_set (a : Array α) (i : Fin a.size) (v : α) (j : Nat)
(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 -/
/- # setD -/
@[simp] theorem set!_is_setD : @set! = @setD := rfl
@@ -277,788 +266,4 @@ theorem getElem?_setD_eq (a : Array α) {i : Nat} (p : i < a.size) (v : α) : (a
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_get]
/-- # 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_get]
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_get, List.get_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?, 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?, 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?, 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_get, List.get_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_get, List.get_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.get_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
@[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 := reverse.termination h₁
match j with | j+1 => ?_
simp at *
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 [getElem?_eq_data_get?, getElem_eq_data_get, List.get?_eq_get, H, Nat.le_of_lt h₁]
split <;> rename_i h₂
· simp [ h₂, Nat.not_le.2 (Nat.lt_succ_self _)]
exact (List.get?_reverse' _ _ (Eq.trans (by simp_arith) h)).symm
split <;> rename_i h₃
· simp [ h₃, Nat.not_le.2 (Nat.lt_succ_self _)]
exact (List.get?_reverse' _ _ (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 <| go _ _ _ _ (by simp [this]) rfl fun k => ?_
split; {rfl}; rename_i h
simp [ show k < _ + 1 _ from Nat.lt_succ (n := a.size - 1), this] 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]
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_get]
have h' : i < (as.data ++ bs.data).length := by rwa [ data_length, append_data] at h
conv => rhs; rw [ List.get_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_get]
have h' : i < (as.data ++ bs.data).length := by rwa [ data_length, append_data] at h
conv => rhs; rw [ List.get_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_get]
constructor
· rintro w x r, rfl
rw [ getElem_eq_data_get]
apply w
· intro w i
exact w as[i] i, (getElem_eq_data_get 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

@@ -27,20 +27,13 @@ theorem sizeOf_lt_of_mem [SizeOf α] {as : Array α} (h : a ∈ as) : sizeOf a <
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 +43,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

@@ -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,46 +9,29 @@ 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
instance : LawfulGetElem (Subarray α) Nat α fun xs i => i < xs.size where
@[inline] def getD (s : Subarray α) (i : Nat) (v₀ : α) : α :=
if h : i < s.size then s.get i, h else v₀
@@ -57,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
@@ -65,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
@@ -83,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 α) : β :=
@@ -150,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,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: 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
@@ -34,8 +34,7 @@ structure BitVec (w : Nat) where
O(1), because we use `Fin` as the internal representation of a bitvector. -/
toFin : Fin (2^w)
@[deprecated (since := "2024-04-12")]
protected abbrev Std.BitVec := _root_.BitVec
@[deprecated] abbrev Std.BitVec := _root_.BitVec
-- We manually derive the `DecidableEq` instances for `BitVec` because
-- we want to have builtin support for bit-vector literals, and we
@@ -74,7 +73,7 @@ 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")]
@[deprecated isLt]
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
/-- Theorem for normalizing the bit vector literal representation. -/
@@ -619,14 +618,4 @@ section normalization_eqs
@[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

@@ -159,43 +159,4 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by
rw [ add_not_self x, BitVec.add_comm, add_sub_cancel]
/-! ### 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]
end BitVec

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Harun Khan
Authors: Joe Hendrix
-/
prelude
import Init.Data.BitVec.Lemmas
@@ -48,51 +48,6 @@ private theorem iunfoldr.eq_test
intro i
simp_all [truncate_succ]
theorem iunfoldr_getLsb' {f : Fin w α α × Bool} (state : Nat α)
(ind : (i : Fin w), (f i (state i.val)).fst = state (i.val+1)) :
( i : Fin w, getLsb (iunfoldr f (state 0)).snd i.val = (f i (state i.val)).snd)
(iunfoldr f (state 0)).fst = state w := by
unfold iunfoldr
simp
apply Fin.hIterate_elim
(fun j (p : α × BitVec j) => (hj : j w)
( i : Fin j, getLsb p.snd i.val = (f i.val, Nat.lt_of_lt_of_le i.isLt hj (state i.val)).snd)
p.fst = state j)
case hj => simp
case init =>
intro
apply And.intro
· intro i
have := Fin.size_pos i
contradiction
· rfl
case step =>
intro j s, v ih hj
apply And.intro
case left =>
intro i
simp only [getLsb_cons]
have hj2 : j.val w := by simp
cases (Nat.lt_or_eq_of_le (Nat.lt_succ.mp i.isLt)) with
| inl h3 => simp [if_neg, (Nat.ne_of_lt h3)]
exact (ih hj2).1 i.val, h3
| inr h3 => simp [h3, if_pos]
cases (Nat.eq_zero_or_pos j.val) with
| inl hj3 => congr
rw [ (ih hj2).2]
| inr hj3 => congr
exact (ih hj2).2
case right =>
simp
have hj2 : j.val w := by simp
rw [ ind j, (ih hj2).2]
theorem iunfoldr_getLsb {f : Fin w α α × Bool} (state : Nat α) (i : Fin w)
(ind : (i : Fin w), (f i (state i.val)).fst = state (i.val+1)) :
getLsb (iunfoldr f (state 0)).snd i.val = (f i (state i.val)).snd := by
exact (iunfoldr_getLsb' state ind).1 i
/--
Correctness theorem for `iunfoldr`.
-/
@@ -103,11 +58,4 @@ theorem iunfoldr_replace
iunfoldr f a = (state w, value) := by
simp [iunfoldr.eq_test state value a init step]
theorem iunfoldr_replace_snd
{f : Fin w α α × Bool} (state : Nat α) (value : BitVec w) (a : α)
(init : state 0 = a)
(step : (i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) :
(iunfoldr f a).snd = value := by
simp [iunfoldr.eq_test state value a init step]
end BitVec

View File

@@ -1,8 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed,
Authors: Joe Hendrix
-/
prelude
import Init.Data.Bool
@@ -42,36 +41,12 @@ theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsb i := rfl
have p : 2^w 2^i := Nat.pow_le_pow_of_le_right (by omega) ge
omega
@[simp] theorem getMsb_ge (x : BitVec w) (i : Nat) (ge : w i) : getMsb x i = false := by
rw [getMsb]
simp only [Bool.and_eq_false_imp, decide_eq_true_eq]
omega
theorem lt_of_getLsb (x : BitVec w) (i : Nat) : getLsb x i = true i < w := by
if h : i < w then
simp [h]
else
simp [Nat.ge_of_not_lt h]
theorem lt_of_getMsb (x : BitVec w) (i : Nat) : getMsb x i = true i < w := by
if h : i < w then
simp [h]
else
simp [Nat.ge_of_not_lt h]
theorem getMsb_eq_getLsb (x : BitVec w) (i : Nat) : x.getMsb i = (decide (i < w) && x.getLsb (w - 1 - i)) := by
rw [getMsb]
theorem getLsb_eq_getMsb (x : BitVec w) (i : Nat) : x.getLsb i = (decide (i < w) && x.getMsb (w - 1 - i)) := by
rw [getMsb]
by_cases h₁ : i < w <;> by_cases h₂ : w - 1 - i < w <;>
simp only [h₁, h₂] <;> simp only [decide_True, decide_False, Bool.false_and, Bool.and_false, Bool.true_and, Bool.and_true]
· congr
omega
all_goals
apply getLsb_ge
omega
-- We choose `eq_of_getLsb_eq` as the `@[ext]` theorem for `BitVec`
-- somewhat arbitrarily over `eq_of_getMsg_eq`.
@[ext] theorem eq_of_getLsb_eq {x y : BitVec w}
@@ -104,13 +79,7 @@ theorem eq_of_getMsb_eq {x y : BitVec w}
have q := pred w - 1 - i, q_lt
simpa [q_lt, Nat.sub_sub_self, r] using q
-- This cannot be a `@[simp]` lemma, as it would be tried at every term.
theorem of_length_zero {x : BitVec 0} : x = 0#0 := by ext; simp
@[simp] theorem toNat_zero_length (x : BitVec 0) : x.toNat = 0 := by simp [of_length_zero]
@[simp] theorem getLsb_zero_length (x : BitVec 0) : x.getLsb i = false := by simp [of_length_zero]
@[simp] theorem getMsb_zero_length (x : BitVec 0) : x.getMsb i = false := by simp [of_length_zero]
@[simp] theorem msb_zero_length (x : BitVec 0) : x.msb = false := by simp [BitVec.msb, of_length_zero]
@[simp] theorem of_length_zero {x : BitVec 0} : x = 0#0 := by ext; simp
theorem eq_of_toFin_eq : {x y : BitVec w}, x.toFin = y.toFin x = y
| _, _, _, _, rfl => rfl
@@ -127,8 +96,6 @@ theorem ofNat_one (n : Nat) : BitVec.ofNat 1 n = BitVec.ofBool (n % 2 = 1) := b
theorem ofBool_eq_iff_eq : (b b' : Bool), BitVec.ofBool b = BitVec.ofBool b' b = b' := by
decide
@[simp] theorem not_ofBool : ~~~ (ofBool b) = ofBool (!b) := by cases b <;> rfl
@[simp, bv_toNat] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
@[simp] theorem toNat_ofNatLt (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
@@ -146,8 +113,7 @@ theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) :
getLsb (x#n) i = (i < n && x.testBit i) := by
simp [getLsb, BitVec.ofNat, Fin.val_ofNat']
@[simp, deprecated toNat_ofNat (since := "2024-02-22")]
theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial
@[simp, deprecated toNat_ofNat] theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial
@[simp] theorem getLsb_zero : (0#w).getLsb i = false := by simp [getLsb]
@@ -246,12 +212,6 @@ theorem eq_of_toInt_eq {i j : BitVec n} : i.toInt = j.toInt → i = j := by
have _jlt := j.isLt
split <;> split <;> omega
theorem toInt_inj (x y : BitVec n) : x.toInt = y.toInt x = y :=
Iff.intro eq_of_toInt_eq (congrArg BitVec.toInt)
theorem toInt_ne (x y : BitVec n) : x.toInt y.toInt x y := by
rw [Ne, toInt_inj]
@[simp] theorem toNat_ofInt {n : Nat} (i : Int) :
(BitVec.ofInt n i).toNat = (i % (2^n : Nat)).toNat := by
unfold BitVec.ofInt
@@ -330,19 +290,6 @@ theorem nat_eq_toNat (x : BitVec w) (y : Nat)
getLsb (zeroExtend' ge x) i = getLsb x i := by
simp [getLsb, toNat_zeroExtend']
@[simp] theorem getMsb_zeroExtend' (ge : m n) (x : BitVec n) (i : Nat) :
getMsb (zeroExtend' ge x) i = (decide (i m - n) && getMsb x (i - (m - n))) := by
simp only [getMsb, getLsb_zeroExtend', gt_iff_lt]
by_cases h₁ : decide (i < m) <;> by_cases h₂ : decide (i m - n) <;> by_cases h₃ : decide (i - (m - n) < n) <;>
by_cases h₄ : n - 1 - (i - (m - n)) = m - 1 - i
all_goals
simp only [h₁, h₂, h₃, h₄]
simp_all only [ge_iff_le, decide_eq_true_eq, Nat.not_le, Nat.not_lt, Bool.true_and,
Bool.false_and, Bool.and_self] <;>
(try apply getLsb_ge) <;>
(try apply (getLsb_ge _ _ _).symm) <;>
omega
@[simp] theorem getLsb_zeroExtend (m : Nat) (x : BitVec n) (i : Nat) :
getLsb (zeroExtend m x) i = (decide (i < m) && getLsb x i) := by
simp [getLsb, toNat_zeroExtend, Nat.testBit_mod_two_pow]
@@ -350,7 +297,7 @@ theorem nat_eq_toNat (x : BitVec w) (y : Nat)
@[simp] theorem getMsb_zeroExtend_add {x : BitVec w} (h : k i) :
(x.zeroExtend (w + k)).getMsb i = x.getMsb (i - k) := by
by_cases h : w = 0
· subst h; simp [of_length_zero]
· subst h; simp
simp only [getMsb, getLsb_zeroExtend]
by_cases h₁ : i < w + k <;> by_cases h₂ : i - k < w <;> by_cases h₃ : w + k - 1 - i < w + k
<;> simp [h₁, h₂, h₃]
@@ -533,24 +480,6 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
simp [h]
omega
/-! ### cast -/
@[simp] theorem not_cast {x : BitVec w} (h : w = w') : ~~~(cast h x) = cast h (~~~x) := by
ext
simp_all [lt_of_getLsb]
@[simp] theorem and_cast {x y : BitVec w} (h : w = w') : cast h x &&& cast h y = cast h (x &&& y) := by
ext
simp_all [lt_of_getLsb]
@[simp] theorem or_cast {x y : BitVec w} (h : w = w') : cast h x ||| cast h y = cast h (x ||| y) := by
ext
simp_all [lt_of_getLsb]
@[simp] theorem xor_cast {x y : BitVec w} (h : w = w') : cast h x &&& cast h y = cast h (x &&& y) := by
ext
simp_all [lt_of_getLsb]
/-! ### shiftLeft -/
@[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
@@ -600,26 +529,10 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
<;> simp_all
<;> (rw [getLsb_ge]; omega)
@[simp] theorem getMsb_shiftLeftZeroExtend (x : BitVec m) (n : Nat) :
getMsb (shiftLeftZeroExtend x n) i = getMsb x i := by
have : n i + n := by omega
simp_all [shiftLeftZeroExtend_eq]
@[simp] theorem msb_shiftLeftZeroExtend (x : BitVec w) (i : Nat) :
(shiftLeftZeroExtend x i).msb = x.msb := by
simp [shiftLeftZeroExtend_eq, BitVec.msb]
theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
(x <<< n) <<< m = x <<< (n + m) := by
ext i
simp only [getLsb_shiftLeft, Fin.is_lt, decide_True, Bool.true_and]
rw [show i - (n + m) = (i - m - n) by omega]
cases h₂ : decide (i < m) <;>
cases h₃ : decide (i - m < w) <;>
cases h₄ : decide (i - m < n) <;>
cases h₅ : decide (i < n + m) <;>
simp at * <;> omega
/-! ### ushiftRight -/
@[simp, bv_toNat] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
@@ -640,18 +553,11 @@ theorem append_def (x : BitVec v) (y : BitVec w) :
@[simp] theorem getLsb_append {v : BitVec n} {w : BitVec m} :
getLsb (v ++ w) i = bif i < m then getLsb w i else getLsb v (i - m) := by
simp only [append_def, getLsb_or, getLsb_shiftLeftZeroExtend, getLsb_zeroExtend']
simp [append_def]
by_cases h : i < m
· simp [h]
· simp [h]; simp_all
@[simp] theorem getMsb_append {v : BitVec n} {w : BitVec m} :
getMsb (v ++ w) i = bif n i then getMsb w (i - n) else getMsb v i := by
simp [append_def]
by_cases h : n i
· simp [h]
· simp [h]
theorem msb_append {x : BitVec w} {y : BitVec v} :
(x ++ y).msb = bif (w == 0) then (y.msb) else (x.msb) := by
rw [ append_eq, append]
@@ -680,36 +586,6 @@ theorem msb_append {x : BitVec w} {y : BitVec v} :
@[simp] theorem truncate_cons {x : BitVec w} : (cons a x).truncate w = x := by
simp [cons]
@[simp] theorem not_append {x : BitVec w} {y : BitVec v} : ~~~ (x ++ y) = (~~~ x) ++ (~~~ y) := by
ext i
simp only [getLsb_not, getLsb_append, cond_eq_if]
split
· simp_all
· simp_all; omega
@[simp] theorem and_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
(x₁ ++ y₁) &&& (x₂ ++ y₂) = (x₁ &&& x₂) ++ (y₁ &&& y₂) := by
ext i
simp only [getLsb_append, cond_eq_if]
split <;> simp [*]
@[simp] theorem or_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
(x₁ ++ y₁) ||| (x₂ ++ y₂) = (x₁ ||| x₂) ++ (y₁ ||| y₂) := by
ext i
simp only [getLsb_append, cond_eq_if]
split <;> simp [*]
@[simp] theorem xor_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
(x₁ ++ y₁) ^^^ (x₂ ++ y₂) = (x₁ ^^^ x₂) ++ (y₁ ^^^ y₂) := by
ext i
simp only [getLsb_append, cond_eq_if]
split <;> simp [*]
theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
(x >>> n) >>> m = x >>> (n + m) := by
ext i
simp [Nat.add_assoc n m i]
/-! ### rev -/
theorem getLsb_rev (x : BitVec w) (i : Fin w) :
@@ -754,12 +630,6 @@ theorem toNat_cons' {x : BitVec w} :
@[simp] theorem msb_cons : (cons a x).msb = a := by
simp [cons, msb_cast, msb_append]
@[simp] theorem getMsb_cons_zero : (cons a x).getMsb 0 = a := by
rw [ BitVec.msb, msb_cons]
@[simp] theorem getMsb_cons_succ : (cons a x).getMsb (i + 1) = x.getMsb i := by
simp [cons, Nat.le_add_left 1 i]
theorem truncate_succ (x : BitVec w) :
truncate (i+1) x = cons (getLsb x i) (truncate i x) := by
apply eq_of_getLsb_eq
@@ -780,21 +650,6 @@ theorem eq_msb_cons_truncate (x : BitVec (w+1)) : x = (cons x.msb (x.truncate w)
· simp_all
· omega
@[simp] theorem not_cons (x : BitVec w) (b : Bool) : ~~~(cons b x) = cons (!b) (~~~x) := by
simp [cons]
@[simp] theorem cons_or_cons (x y : BitVec w) (a b : Bool) :
(cons a x) ||| (cons b y) = cons (a || b) (x ||| y) := by
ext i; cases i using Fin.succRecOn <;> simp <;> split <;> rfl
@[simp] theorem cons_and_cons (x y : BitVec w) (a b : Bool) :
(cons a x) &&& (cons b y) = cons (a && b) (x &&& y) := by
ext i; cases i using Fin.succRecOn <;> simp <;> split <;> rfl
@[simp] theorem cons_xor_cons (x y : BitVec w) (a b : Bool) :
(cons a x) ^^^ (cons b y) = cons (xor a b) (x ^^^ y) := by
ext i; cases i using Fin.succRecOn <;> simp <;> split <;> rfl
/-! ### concat -/
@[simp] theorem toNat_concat (x : BitVec w) (b : Bool) :
@@ -847,42 +702,24 @@ Definition of bitvector addition as a nat.
.ofFin x + y = .ofFin (x + y.toFin) := rfl
@[simp] theorem add_ofFin (x : BitVec n) (y : Fin (2^n)) :
x + .ofFin y = .ofFin (x.toFin + y) := rfl
theorem ofNat_add {n} (x y : Nat) : (x + y)#n = x#n + y#n := by
@[simp] theorem ofNat_add_ofNat {n} (x y : Nat) : x#n + y#n = (x + y)#n := by
apply eq_of_toNat_eq ; simp [BitVec.ofNat]
theorem ofNat_add_ofNat {n} (x y : Nat) : x#n + y#n = (x + y)#n :=
(ofNat_add x y).symm
protected theorem add_assoc (x y z : BitVec n) : x + y + z = x + (y + z) := by
apply eq_of_toNat_eq ; simp [Nat.add_assoc]
instance : Std.Associative (α := BitVec n) (· + ·) := BitVec.add_assoc
protected theorem add_comm (x y : BitVec n) : x + y = y + x := by
simp [add_def, Nat.add_comm]
instance : Std.Commutative (α := BitVec n) (· + ·) := BitVec.add_comm
@[simp] protected theorem add_zero (x : BitVec n) : x + 0#n = x := by simp [add_def]
@[simp] protected theorem zero_add (x : BitVec n) : 0#n + x = x := by simp [add_def]
instance : Std.LawfulIdentity (α := BitVec n) (· + ·) 0#n where
left_id := BitVec.zero_add
right_id := BitVec.add_zero
theorem truncate_add (x y : BitVec w) (h : i w) :
(x + y).truncate i = x.truncate i + y.truncate i := by
have dvd : 2^i 2^w := Nat.pow_dvd_pow _ h
simp [bv_toNat, h, Nat.mod_mod_of_dvd _ dvd]
@[simp, bv_toNat] theorem toInt_add (x y : BitVec w) :
(x + y).toInt = (x.toInt + y.toInt).bmod (2^w) := by
simp [toInt_eq_toNat_bmod]
theorem ofInt_add {n} (x y : Int) : BitVec.ofInt n (x + y) =
BitVec.ofInt n x + BitVec.ofInt n y := by
apply eq_of_toInt_eq
simp
/-! ### sub/neg -/
theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n (x.toNat + (2^n - y.toNat)) := by rfl
@@ -920,19 +757,10 @@ theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by
theorem add_sub_cancel (x y : BitVec w) : x + y - y = x := by
apply eq_of_toNat_eq
have y_toNat_le := Nat.le_of_lt y.isLt
have y_toNat_le := Nat.le_of_lt y.toNat_lt
rw [toNat_sub, toNat_add, Nat.mod_add_mod, Nat.add_assoc, Nat.add_sub_assoc y_toNat_le,
Nat.add_sub_cancel_left, Nat.add_mod_right, toNat_mod_cancel]
theorem sub_add_cancel (x y : BitVec w) : x - y + y = x := by
rw [sub_toAdd, BitVec.add_assoc, BitVec.add_comm _ y,
BitVec.add_assoc, sub_toAdd, add_sub_cancel]
theorem eq_sub_iff_add_eq {x y z : BitVec w} : x = z - y x + y = z := by
apply Iff.intro <;> intro h
· simp [h, sub_add_cancel]
· simp [h, add_sub_cancel]
theorem negOne_eq_allOnes : -1#w = allOnes w := by
apply eq_of_toNat_eq
if g : w = 0 then
@@ -942,13 +770,6 @@ theorem negOne_eq_allOnes : -1#w = allOnes w := by
have r : (2^w - 1) < 2^w := by omega
simp [Nat.mod_eq_of_lt q, Nat.mod_eq_of_lt r]
theorem neg_eq_not_add (x : BitVec w) : -x = ~~~x + 1 := by
apply eq_of_toNat_eq
simp only [toNat_neg, ofNat_eq_ofNat, toNat_add, toNat_not, toNat_ofNat, Nat.add_mod_mod]
congr
have hx : x.toNat < 2^w := x.isLt
rw [Nat.sub_sub, Nat.add_comm 1 x.toNat, Nat.sub_sub, Nat.sub_add_cancel (by omega)]
/-! ### mul -/
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
@@ -975,15 +796,6 @@ instance : Std.Associative (fun (x y : BitVec w) => x * y) := ⟨BitVec.mul_asso
instance : Std.LawfulCommIdentity (fun (x y : BitVec w) => x * y) (1#w) where
right_id := BitVec.mul_one
@[simp, bv_toNat] theorem toInt_mul (x y : BitVec w) :
(x * y).toInt = (x.toInt * y.toInt).bmod (2^w) := by
simp [toInt_eq_toNat_bmod]
theorem ofInt_mul {n} (x y : Int) : BitVec.ofInt n (x * y) =
BitVec.ofInt n x * BitVec.ofInt n y := by
apply eq_of_toInt_eq
simp
/-! ### le and lt -/
@[bv_toNat] theorem le_def (x y : BitVec n) :
@@ -1013,7 +825,7 @@ protected theorem lt_of_le_ne (x y : BitVec n) (h1 : x <= y) (h2 : ¬ x = y) : x
simp
exact Nat.lt_of_le_of_ne
/-! ### intMax -/
/- ! ### intMax -/
/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
def intMax (w : Nat) : BitVec w := (2^w - 1)#w
@@ -1027,20 +839,4 @@ theorem toNat_intMax_eq : (intMax w).toNat = 2^w - 1 := by
omega
simp [intMax, Nat.shiftLeft_eq, Nat.one_mul, natCast_eq_ofNat, toNat_ofNat, Nat.mod_eq_of_lt h]
/-! ### ofBoolList -/
@[simp] theorem getMsb_ofBoolListBE : (ofBoolListBE bs).getMsb i = bs.getD i false := by
induction bs generalizing i <;> cases i <;> simp_all [ofBoolListBE]
@[simp] theorem getLsb_ofBoolListBE :
(ofBoolListBE bs).getLsb i = (decide (i < bs.length) && bs.getD (bs.length - 1 - i) false) := by
simp [getLsb_eq_getMsb]
@[simp] theorem getLsb_ofBoolListLE : (ofBoolListLE bs).getLsb i = bs.getD i false := by
induction bs generalizing i <;> cases i <;> simp_all [ofBoolListLE]
@[simp] theorem getMsb_ofBoolListLE :
(ofBoolListLE bs).getMsb i = (decide (i < bs.length) && bs.getD (bs.length - 1 - i) false) := by
simp [getMsb_eq_getLsb]
end BitVec

View File

@@ -74,7 +74,6 @@ Added for confluence with `not_and_self` `and_not_self` on term
@[simp] theorem eq_false_and_eq_true_self : (b : Bool), (b = false b = true) False := by decide
theorem and_comm : (x y : Bool), (x && y) = (y && x) := by decide
instance : Std.Commutative (· && ·) := and_comm
theorem and_left_comm : (x y z : Bool), (x && (y && z)) = (y && (x && z)) := by decide
theorem and_right_comm : (x y z : Bool), ((x && y) && z) = ((x && z) && y) := by decide
@@ -121,7 +120,6 @@ Needed for confluence of term `(a || b) ↔ a` which reduces to `(a || b) = a` v
@[simp] theorem iff_or_self : (a b : Bool), (b = (a || b)) (a b) := by decide
theorem or_comm : (x y : Bool), (x || y) = (y || x) := by decide
instance : Std.Commutative (· || ·) := or_comm
theorem or_left_comm : (x y z : Bool), (x || (y || z)) = (y || (x || z)) := by decide
theorem or_right_comm : (x y z : Bool), ((x || y) || z) = ((x || z) || y) := by decide
@@ -188,18 +186,12 @@ in false_eq and true_eq.
@[simp] theorem true_beq : b, (true == b) = b := by decide
@[simp] theorem false_beq : b, (false == b) = !b := by decide
@[simp] theorem beq_true : b, (b == true) = b := by decide
instance : Std.LawfulIdentity (· == ·) true where
left_id := true_beq
right_id := beq_true
@[simp] theorem beq_false : b, (b == false) = !b := by decide
@[simp] theorem true_bne : (b : Bool), (true != b) = !b := by decide
@[simp] theorem false_bne : (b : Bool), (false != b) = b := by decide
@[simp] theorem bne_true : (b : Bool), (b != true) = !b := by decide
@[simp] theorem bne_false : (b : Bool), (b != false) = b := by decide
instance : Std.LawfulIdentity (· != ·) false where
left_id := false_bne
right_id := bne_false
@[simp] theorem not_beq_self : (x : Bool), ((!x) == x) = false := by decide
@[simp] theorem beq_not_self : (x : Bool), (x == !x) = false := by decide
@@ -222,19 +214,12 @@ due to `beq_iff_eq`.
@[simp] theorem not_bne_not : (x y : Bool), ((!x) != (!y)) = (x != y) := by decide
@[simp] theorem bne_assoc : (x y z : Bool), ((x != y) != z) = (x != (y != z)) := by decide
instance : Std.Associative (· != ·) := bne_assoc
@[simp] theorem bne_left_inj : (x y z : Bool), (x != y) = (x != z) y = z := by decide
@[simp] theorem bne_right_inj : (x y z : Bool), (x != z) = (y != z) x = y := by decide
/-! ### coercision related normal forms -/
theorem beq_eq_decide_eq [BEq α] [LawfulBEq α] [DecidableEq α] (a b : α) :
(a == b) = decide (a = b) := by
cases h : a == b
· simp [ne_of_beq_false h]
· simp [eq_of_beq h]
@[simp] theorem not_eq_not : {a b : Bool}, ¬a = !b a = b := by decide
@[simp] theorem not_not_eq : {a b : Bool}, ¬(!a) = b a = b := by decide
@@ -245,11 +230,6 @@ theorem beq_eq_decide_eq [BEq α] [LawfulBEq α] [DecidableEq α] (a b : α) :
@[simp] theorem coe_false_iff_true : (a b : Bool), (a = false b) (!a) = b := by decide
@[simp] theorem coe_false_iff_false : (a b : Bool), (a = false b = false) (!a) = (!b) := by decide
/-! ### beq properties -/
theorem beq_comm {α} [BEq α] [LawfulBEq α] {a b : α} : (a == b) = (b == a) :=
(Bool.coe_iff_coe (a == b) (b == a)).mp (by simp [@eq_comm α])
/-! ### xor -/
theorem false_xor : (x : Bool), xor false x = x := false_bne
@@ -360,8 +340,7 @@ def toNat (b:Bool) : Nat := cond b 1 0
theorem toNat_le (c : Bool) : c.toNat 1 := by
cases c <;> trivial
@[deprecated toNat_le (since := "2024-02-23")]
abbrev toNat_le_one := toNat_le
@[deprecated toNat_le] abbrev toNat_le_one := toNat_le
theorem toNat_lt (b : Bool) : b.toNat < 2 :=
Nat.lt_succ_of_le (toNat_le _)

View File

@@ -52,13 +52,9 @@ def get : (a : @& ByteArray) → (@& Fin a.size) → UInt8
instance : GetElem ByteArray Nat UInt8 fun xs i => i < xs.size where
getElem xs i h := xs.get i, h
instance : LawfulGetElem ByteArray Nat UInt8 fun xs i => i < xs.size where
instance : GetElem ByteArray USize UInt8 fun xs i => i.val < xs.size where
getElem xs i h := xs.uget i h
instance : LawfulGetElem ByteArray USize UInt8 fun xs i => i.val < xs.size where
@[extern "lean_byte_array_set"]
def set! : ByteArray (@& Nat) UInt8 ByteArray
| bs, i, b => bs.set! i b
@@ -199,18 +195,6 @@ instance : ToString ByteArray := ⟨fun bs => bs.toList.toString⟩
/-- Interpret a `ByteArray` of size 8 as a little-endian `UInt64`. -/
def ByteArray.toUInt64LE! (bs : ByteArray) : UInt64 :=
assert! bs.size == 8
(bs.get! 7).toUInt64 <<< 0x38 |||
(bs.get! 6).toUInt64 <<< 0x30 |||
(bs.get! 5).toUInt64 <<< 0x28 |||
(bs.get! 4).toUInt64 <<< 0x20 |||
(bs.get! 3).toUInt64 <<< 0x18 |||
(bs.get! 2).toUInt64 <<< 0x10 |||
(bs.get! 1).toUInt64 <<< 0x8 |||
(bs.get! 0).toUInt64
/-- Interpret a `ByteArray` of size 8 as a big-endian `UInt64`. -/
def ByteArray.toUInt64BE! (bs : ByteArray) : UInt64 :=
assert! bs.size == 8
(bs.get! 0).toUInt64 <<< 0x38 |||
(bs.get! 1).toUInt64 <<< 0x30 |||
@@ -220,3 +204,15 @@ def ByteArray.toUInt64BE! (bs : ByteArray) : UInt64 :=
(bs.get! 5).toUInt64 <<< 0x10 |||
(bs.get! 6).toUInt64 <<< 0x8 |||
(bs.get! 7).toUInt64
/-- Interpret a `ByteArray` of size 8 as a big-endian `UInt64`. -/
def ByteArray.toUInt64BE! (bs : ByteArray) : UInt64 :=
assert! bs.size == 8
(bs.get! 7).toUInt64 <<< 0x38 |||
(bs.get! 6).toUInt64 <<< 0x30 |||
(bs.get! 5).toUInt64 <<< 0x28 |||
(bs.get! 4).toUInt64 <<< 0x20 |||
(bs.get! 3).toUInt64 <<< 0x18 |||
(bs.get! 2).toUInt64 <<< 0x10 |||
(bs.get! 1).toUInt64 <<< 0x8 |||
(bs.get! 0).toUInt64

View File

@@ -41,7 +41,7 @@ Sends a message on an `Channel`.
This function does not block.
-/
def Channel.send (ch : Channel α) (v : α) : BaseIO Unit :=
def Channel.send (v : α) (ch : Channel α) : BaseIO Unit :=
ch.atomically do
let st get
if st.closed then return

View File

@@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Robert Y. Lewis, Keeley Hoek, Mario Carneiro
-/
prelude
import Init.Data.Nat.Div
import Init.Data.Nat.Bitwise.Basic
import Init.Coe
open Nat
@@ -13,40 +15,17 @@ namespace Fin
instance coeToNat : CoeOut (Fin n) Nat :=
fun v => v.val
/--
From the empty type `Fin 0`, any desired result `α` can be derived. This is simlar to `Empty.elim`.
-/
def elim0.{u} {α : Sort u} : Fin 0 α
| _, h => absurd h (not_lt_zero _)
/--
Returns the successor of the argument.
The bound in the result type is increased:
```
(2 : Fin 3).succ = (3 : Fin 4)
```
This differs from addition, which wraps around:
```
(2 : Fin 3) + 1 = (0 : Fin 3)
```
-/
def succ : Fin n Fin n.succ
| i, h => i+1, Nat.succ_lt_succ h
variable {n : Nat}
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
protected def ofNat {n : Nat} (a : Nat) : Fin n.succ :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
/--
Returns `a` modulo `n` as a `Fin n`.
The assumption `n > 0` ensures that `Fin n` is nonempty.
-/
protected def ofNat' {n : Nat} (a : Nat) (h : n > 0) : Fin n :=
a % n, Nat.mod_lt _ h
@@ -56,15 +35,12 @@ private theorem mlt {b : Nat} : {a : Nat} → a < n → b % n < n
have : n > 0 := Nat.lt_trans (Nat.zero_lt_succ _) h;
Nat.mod_lt _ this
/-- Addition modulo `n` -/
protected def add : Fin n Fin n Fin n
| a, h, b, _ => (a + b) % n, mlt h
/-- Multiplication modulo `n` -/
protected def mul : Fin n Fin n Fin n
| a, h, b, _ => (a * b) % n, mlt h
/-- Subtraction modulo `n` -/
protected def sub : Fin n Fin n Fin n
| a, h, b, _ => (a + (n - b)) % n, mlt h
@@ -194,3 +170,9 @@ theorem val_add_one_le_of_lt {n : Nat} {a b : Fin n} (h : a < b) : (a : Nat) + 1
theorem val_add_one_le_of_gt {n : Nat} {a b : Fin n} (h : a > b) : (b : Nat) + 1 (a : Nat) := h
end Fin
instance [GetElem cont Nat elem dom] : GetElem cont (Fin n) elem fun xs i => dom xs i where
getElem xs i h := getElem xs i.1 h
macro_rules
| `(tactic| get_elem_tactic_trivial) => `(tactic| apply Fin.val_lt_of_le; get_elem_tactic_trivial; done)

View File

@@ -12,7 +12,6 @@ import Init.Data.Nat.Linear
loop (x : α) (i : Nat) : α :=
if h : i < n then loop (f x i, h) (i+1) else x
termination_by n - i
decreasing_by decreasing_trivial_pre_omega
/-- Folds over `Fin n` from the right: `foldr 3 f x = f 0 (f 1 (f 2 x))`. -/
@[inline] def foldr (n) (f : Fin n α α) (init : α) : α := loop n, Nat.le_refl n init where

View File

@@ -23,7 +23,6 @@ def hIterateFrom (P : Nat → Sort _) {n} (f : ∀(i : Fin n), P i.val → P (i.
have p : i = n := (or_iff_left g).mp (Nat.eq_or_lt_of_le ubnd)
_root_.cast (congrArg P p) a
termination_by n - i
decreasing_by decreasing_trivial_pre_omega
/--
`hIterate` is a heterogenous iterative operation that applies a

View File

@@ -11,9 +11,6 @@ import Init.ByCases
import Init.Conv
import Init.Omega
-- Remove after the next stage0 update
set_option allowUnsafeReducibility true
namespace Fin
/-- If you actually have an element of `Fin n`, then the `n` is always positive -/
@@ -62,8 +59,7 @@ theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
@[simp] theorem val_ofNat' (a : Nat) (is_pos : n > 0) :
(Fin.ofNat' a is_pos).val = a % n := rfl
@[deprecated ofNat'_zero_val (since := "2024-02-22")]
theorem ofNat'_zero_val : (Fin.ofNat' 0 h).val = 0 := Nat.zero_mod _
@[deprecated ofNat'_zero_val] theorem ofNat'_zero_val : (Fin.ofNat' 0 h).val = 0 := Nat.zero_mod _
@[simp] theorem mod_val (a b : Fin n) : (a % b).val = a.val % b.val :=
rfl
@@ -545,7 +541,7 @@ theorem pred_mk {n : Nat} (i : Nat) (h : i < n + 1) (w) : Fin.pred ⟨i, h⟩ w
{a b : Fin (n + 1)} {ha : a 0} {hb : b 0}, a.pred ha = b.pred hb a = b
| 0, _, _, ha, _ => by simp only [mk_zero, ne_eq, not_true] at ha
| i + 1, _, 0, _, _, hb => by simp only [mk_zero, ne_eq, not_true] at hb
| i + 1, hi, j + 1, hj, ha, hb => by simp [ext_iff, Nat.succ.injEq]
| i + 1, hi, j + 1, hj, ha, hb => by simp [ext_iff]
@[simp] theorem pred_one {n : Nat} :
Fin.pred (1 : Fin (n + 2)) (Ne.symm (Fin.ne_of_lt one_pos)) = 0 := rfl
@@ -606,7 +602,6 @@ A version of `Fin.succRec` taking `i : Fin n` as the first argument. -/
@Fin.succRecOn (n + 1) i.succ motive zero succ = succ n i (Fin.succRecOn i zero succ) := by
cases i; rfl
/-- Define `motive i` by induction on `i : Fin (n + 1)` via induction on the underlying `Nat` value.
This function has two arguments: `zero` handles the base case on `motive 0`,
and `succ` defines the inductive step using `motive i.castSucc`.
@@ -615,12 +610,8 @@ and `succ` defines the inductive step using `motive i.castSucc`.
@[elab_as_elim] def induction {motive : Fin (n + 1) Sort _} (zero : motive 0)
(succ : i : Fin n, motive (castSucc i) motive i.succ) :
i : Fin (n + 1), motive i
| i, hi => go i hi
where
-- Use a curried function so that this is structurally recursive
go : (i : Nat) (hi : i < n + 1), motive i, hi
| 0, hi => by rwa [Fin.mk_zero]
| i+1, hi => succ i, Nat.lt_of_succ_lt_succ hi (go i (Nat.lt_of_succ_lt hi))
| 0, hi => by rwa [Fin.mk_zero]
| i+1, hi => succ i, Nat.lt_of_succ_lt_succ hi (induction zero succ i, Nat.lt_of_succ_lt hi)
@[simp] theorem induction_zero {motive : Fin (n + 1) Sort _} (zero : motive 0)
(hs : i : Fin n, motive (castSucc i) motive i.succ) :
@@ -692,7 +683,6 @@ and `cast` defines the inductive step using `motive i.succ`, inducting downwards
termination_by n + 1 - i
decreasing_by decreasing_with
-- FIXME: we put the proof down here to avoid getting a dummy `have` in the definition
try simp only [Nat.succ_sub_succ_eq_sub]
exact Nat.add_sub_add_right .. Nat.sub_lt_sub_left i.2 (Nat.lt_succ_self i)
@[simp] theorem reverseInduction_last {n : Nat} {motive : Fin (n + 1) Sort _} {zero succ} :
@@ -802,20 +792,15 @@ protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by
protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
ext <| by rw [mul_def, mul_def, Nat.mul_comm]
instance : Std.Commutative (α := Fin n) (· * ·) := Fin.mul_comm
protected theorem mul_assoc (a b c : Fin n) : a * b * c = a * (b * c) := by
apply eq_of_val_eq
simp only [val_mul]
rw [ Nat.mod_eq_of_lt a.isLt, Nat.mod_eq_of_lt b.isLt, Nat.mod_eq_of_lt c.isLt]
simp only [ Nat.mul_mod, Nat.mul_assoc]
instance : Std.Associative (α := Fin n) (· * ·) := Fin.mul_assoc
protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by
rw [Fin.mul_comm, Fin.mul_one]
instance : Std.LawfulIdentity (α := Fin (n + 1)) (· * ·) 1 where
left_id := Fin.one_mul
right_id := Fin.mul_one
protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [ext_iff, mul_def]

View File

@@ -58,13 +58,9 @@ def get? (ds : FloatArray) (i : Nat) : Option Float :=
instance : GetElem FloatArray Nat Float fun xs i => i < xs.size where
getElem xs i h := xs.get i, h
instance : LawfulGetElem FloatArray Nat Float fun xs i => i < xs.size where
instance : GetElem FloatArray USize Float fun xs i => i.val < xs.size where
getElem xs i h := xs.uget i h
instance : LawfulGetElem FloatArray USize Float fun xs i => i.val < xs.size where
@[extern "lean_float_array_uset"]
def uset : (a : FloatArray) (i : USize) Float i.toNat < a.size FloatArray
| ds, i, v, h => ds.uset i v h

View File

@@ -100,7 +100,7 @@ protected def neg (n : @& Int) : Int :=
```
-/
@[default_instance mid]
instance instNegInt : Neg Int where
instance : Neg Int where
neg := Int.neg
/-- Subtraction of two natural numbers. -/
@@ -173,13 +173,13 @@ inductive NonNeg : Int → Prop where
/-- Definition of `a ≤ b`, encoded as `b - a ≥ 0`. -/
protected def le (a b : Int) : Prop := NonNeg (b - a)
instance instLEInt : LE Int where
instance : LE Int where
le := Int.le
/-- Definition of `a < b`, encoded as `a + 1 ≤ b`. -/
protected def lt (a b : Int) : Prop := (a + 1) b
instance instLTInt : LT Int where
instance : LT Int where
lt := Int.lt
set_option bootstrap.genMatcherCode false in

View File

@@ -8,14 +8,11 @@ prelude
import Init.Data.Int.DivMod
import Init.Data.Int.Order
import Init.Data.Nat.Dvd
import Init.RCases
/-!
# Lemmas about integer division needed to bootstrap `omega`.
-/
-- Remove after the next stage0 update
set_option allowUnsafeReducibility true
open Nat (succ)
@@ -144,14 +141,12 @@ theorem eq_one_of_mul_eq_one_left {a b : Int} (H : 0 ≤ b) (H' : a * b = 1) : b
| ofNat _ => show ofNat _ = _ by simp
| -[_+1] => show -ofNat _ = _ by simp
unseal Nat.div in
@[simp] protected theorem div_zero : a : Int, div a 0 = 0
| ofNat _ => show ofNat _ = _ by simp
| -[_+1] => rfl
@[simp] theorem zero_fdiv (b : Int) : fdiv 0 b = 0 := by cases b <;> rfl
unseal Nat.div in
@[simp] protected theorem fdiv_zero : a : Int, fdiv a 0 = 0
| 0 => rfl
| succ _ => rfl
@@ -182,7 +177,7 @@ theorem fdiv_eq_div {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = div a
@[simp] theorem mod_zero : a : Int, mod a 0 = a
| ofNat _ => congrArg ofNat <| Nat.mod_zero _
| -[_+1] => congrArg (fun n => -ofNat n) <| Nat.mod_zero _
| -[_+1] => rfl
@[simp] theorem zero_fmod (b : Int) : fmod 0 b = 0 := by cases b <;> rfl
@@ -229,9 +224,7 @@ theorem mod_add_div : ∀ a b : Int, mod a b + b * (a.div b) = a
| ofNat m, -[n+1] => by
show (m % succ n + -(succ n) * -(m / succ n) : Int) = m
rw [Int.neg_mul_neg]; exact congrArg ofNat (Nat.mod_add_div ..)
| -[m+1], 0 => by
show -(((succ m) % 0) : Int) + 0 * -(succ m / 0) = -(succ m)
rw [Nat.mod_zero, Int.zero_mul, Int.add_zero]
| -[_+1], 0 => rfl
| -[m+1], ofNat n => by
show -(((succ m) % n) : Int) + n * -(succ m / n) = -(succ m)
rw [Int.mul_neg, Int.neg_add]
@@ -769,13 +762,11 @@ theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int}
| (n:Nat) => congrArg ofNat (Nat.div_one _)
| -[n+1] => by simp [Int.div, neg_ofNat_succ]; rfl
unseal Nat.div in
@[simp] protected theorem div_neg : a b : Int, a.div (-b) = -(a.div b)
| ofNat m, 0 => show ofNat (m / 0) = -(m / 0) by rw [Nat.div_zero]; rfl
| ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm
| ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl
unseal Nat.div in
@[simp] protected theorem neg_div : a b : Int, (-a).div b = -(a.div b)
| 0, n => by simp [Int.neg_zero]
| succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl
@@ -944,7 +935,6 @@ theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b :
match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with
| _, _, _, rfl, _, rfl => ofNat_fdiv .. ofNat_zero_le _
unseal Nat.div in
theorem fdiv_nonpos : {a b : Int}, 0 a b 0 a.fdiv b 0
| 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => _
@@ -1063,39 +1053,19 @@ theorem emod_add_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n + y) n = Int.bmo
simp [Int.emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
@[simp]
theorem emod_mul_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n * y) n = Int.bmod (x * y) n := by
simp [Int.emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_mul, Int.mul_assoc, Int.bmod_add_mul_cancel]
@[simp]
theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n := by
rw [bmod_def x n]
split
case inl p =>
simp only [emod_add_bmod_congr]
simp
case inr p =>
rw [Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg]
simp
@[simp] theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
@[simp]
theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
rw [bmod_def x n]
split
case inl p =>
simp
case inr p =>
rw [Int.sub_mul, Int.sub_eq_add_neg, Int.mul_neg]
simp
@[simp] theorem mul_bmod_bmod : Int.bmod (x * Int.bmod y n) n = Int.bmod (x * y) n := by
rw [Int.mul_comm x, bmod_mul_bmod, Int.mul_comm x]
theorem add_bmod (a b : Int) (n : Nat) : (a + b).bmod n = (a.bmod n + b.bmod n).bmod n := by
simp
theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
theorem emod_bmod {x : Int} {m : Nat} : bmod (x % m) m = bmod x m := by
simp [bmod]

View File

@@ -6,7 +6,7 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
prelude
import Init.Data.Int.Basic
import Init.Conv
import Init.NotationExtra
import Init.PropLemmas
namespace Int
@@ -137,16 +137,12 @@ protected theorem add_comm : ∀ a b : Int, a + b = b + a
| ofNat _, -[_+1] => rfl
| -[_+1], ofNat _ => rfl
| -[_+1], -[_+1] => by simp [Nat.add_comm]
instance : Std.Commutative (α := Int) (· + ·) := Int.add_comm
@[simp] protected theorem add_zero : a : Int, a + 0 = a
| ofNat _ => rfl
| -[_+1] => rfl
@[simp] protected theorem zero_add (a : Int) : 0 + a = a := Int.add_comm .. a.add_zero
instance : Std.LawfulIdentity (α := Int) (· + ·) 0 where
left_id := Int.zero_add
right_id := Int.add_zero
theorem ofNat_add_negSucc_of_lt (h : m < n.succ) : ofNat m + -[n+1] = -[n - m+1] :=
show subNatNat .. = _ by simp [succ_sub (le_of_lt_succ h), subNatNat]
@@ -200,7 +196,6 @@ where
simp
rw [Int.add_comm, subNatNat_add_negSucc]
simp [Nat.add_comm, Nat.add_left_comm, Nat.add_assoc]
instance : Std.Associative (α := Int) (· + ·) := Int.add_assoc
protected theorem add_left_comm (a b c : Int) : a + (b + c) = b + (a + c) := by
rw [ Int.add_assoc, Int.add_comm a, Int.add_assoc]
@@ -356,7 +351,6 @@ protected theorem sub_right_inj (i j k : Int) : (i - k = j - k) ↔ i = j := by
protected theorem mul_comm (a b : Int) : a * b = b * a := by
cases a <;> cases b <;> simp [Nat.mul_comm]
instance : Std.Commutative (α := Int) (· * ·) := Int.mul_comm
theorem ofNat_mul_negOfNat (m n : Nat) : (m : Nat) * negOfNat n = negOfNat (m * n) := by
cases n <;> rfl
@@ -375,7 +369,6 @@ attribute [local simp] ofNat_mul_negOfNat negOfNat_mul_ofNat
protected theorem mul_assoc (a b c : Int) : a * b * c = a * (b * c) := by
cases a <;> cases b <;> cases c <;> simp [Nat.mul_assoc]
instance : Std.Associative (α := Int) (· * ·) := Int.mul_assoc
protected theorem mul_left_comm (a b c : Int) : a * (b * c) = b * (a * c) := by
rw [ Int.mul_assoc, Int.mul_assoc, Int.mul_comm a]
@@ -465,9 +458,6 @@ protected theorem sub_mul (a b c : Int) : (a - b) * c = a * c - b * c := by
| -[n+1] => show -[1 * n +1] = -[n+1] by rw [Nat.one_mul]
@[simp] protected theorem mul_one (a : Int) : a * 1 = a := by rw [Int.mul_comm, Int.one_mul]
instance : Std.LawfulIdentity (α := Int) (· * ·) 1 where
left_id := Int.one_mul
right_id := Int.mul_one
protected theorem mul_neg_one (a : Int) : a * -1 = -a := by rw [Int.mul_neg, Int.mul_one]

View File

@@ -6,6 +6,7 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
prelude
import Init.Data.Int.Lemmas
import Init.ByCases
import Init.RCases
/-!
# Results about the order properties of the integers, and the integers as an ordered ring.
@@ -187,7 +188,6 @@ protected theorem min_comm (a b : Int) : min a b = min b a := by
by_cases h₁ : a b <;> by_cases h₂ : b a <;> simp [h₁, h₂]
· exact Int.le_antisymm h₁ h₂
· cases not_or_intro h₁ h₂ <| Int.le_total ..
instance : Std.Commutative (α := Int) min := Int.min_comm
protected theorem min_le_right (a b : Int) : min a b b := by rw [Int.min_def]; split <;> simp [*]
@@ -207,7 +207,6 @@ protected theorem max_comm (a b : Int) : max a b = max b a := by
by_cases h₁ : a b <;> by_cases h₂ : b a <;> simp [h₁, h₂]
· exact Int.le_antisymm h₂ h₁
· cases not_or_intro h₁ h₂ <| Int.le_total ..
instance : Std.Commutative (α := Int) max := Int.max_comm
protected theorem le_max_left (a b : Int) : a max a b := by rw [Int.max_def]; split <;> simp [*]
@@ -1000,8 +999,7 @@ theorem natAbs_add_le (a b : Int) : natAbs (a + b) ≤ natAbs a + natAbs b := by
refine fun a b => subNatNat_elim a b.succ
(fun m n i => n = b.succ natAbs i (m + b).succ) ?_
(fun i n (e : (n + i).succ = _) => ?_) rfl
· intro i n h
subst h
· rintro i n rfl
rw [Nat.add_comm _ i, Nat.add_assoc]
exact Nat.le_add_right i (b.succ + b).succ
· apply succ_le_succ

View File

@@ -8,5 +8,3 @@ import Init.Data.List.Basic
import Init.Data.List.BasicAux
import Init.Data.List.Control
import Init.Data.List.Lemmas
import Init.Data.List.Impl
import Init.Data.List.TakeDrop

View File

@@ -7,7 +7,6 @@ prelude
import Init.SimpLemmas
import Init.Data.Nat.Basic
import Init.Data.Nat.Div
set_option linter.missingDocs true -- keep it documented
open Decidable List
@@ -55,6 +54,15 @@ variable {α : Type u} {β : Type v} {γ : Type w}
namespace List
instance : GetElem (List α) Nat α fun as i => i < as.length where
getElem as i h := as.get i, h
@[simp] theorem cons_getElem_zero (a : α) (as : List α) (h : 0 < (a :: as).length) : getElem (a :: as) 0 h = a := by
rfl
@[simp] theorem cons_getElem_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
rfl
theorem length_add_eq_lengthTRAux (as : List α) (n : Nat) : as.length + n = as.lengthTRAux n := by
induction as generalizing n with
| nil => simp [length, lengthTRAux]
@@ -127,9 +135,6 @@ instance : Append (List α) := ⟨List.append⟩
| nil => rfl
| cons a as ih =>
simp_all [HAppend.hAppend, Append.append, List.append]
instance : Std.LawfulIdentity (α := List α) (· ++ ·) [] where
left_id := nil_append
right_id := append_nil
@[simp] theorem cons_append (a : α) (as bs : List α) : (a::as) ++ bs = a::(as ++ bs) := rfl
@@ -139,7 +144,6 @@ theorem append_assoc (as bs cs : List α) : (as ++ bs) ++ cs = as ++ (bs ++ cs)
induction as with
| nil => rfl
| cons a as ih => simp [ih]
instance : Std.Associative (α := List α) (· ++ ·) := append_assoc
theorem append_cons (as : List α) (b : α) (bs : List α) : as ++ b :: bs = as ++ [b] ++ bs := by
induction as with
@@ -454,7 +458,7 @@ contains the longest initial segment for which `p` returns true
and the second part is everything else.
* `span (· > 5) [6, 8, 9, 5, 2, 9] = ([6, 8, 9], [5, 2, 9])`
* `span (· > 10) [6, 8, 9, 5, 2, 9] = ([], [6, 8, 9, 5, 2, 9])`
* `span (· > 10) [6, 8, 9, 5, 2, 9] = ([6, 8, 9, 5, 2, 9], [])`
-/
@[inline] def span (p : α Bool) (as : List α) : List α × List α :=
loop as []
@@ -516,6 +520,11 @@ def drop : Nat → List α → List α
@[simp] theorem drop_nil : ([] : List α).drop i = [] := by
cases i <;> rfl
theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
match as, i with
| _::_, 0 => rfl
| _::_, i+1 => get_drop_eq_drop _ i _
/--
`O(min n |xs|)`. Returns the first `n` elements of `xs`, or the whole list if `n` is too large.
* `take 0 [a, b, c, d, e] = []`

View File

@@ -5,7 +5,6 @@ Author: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Linear
import Init.Ext
universe u
@@ -13,157 +12,63 @@ namespace List
/-! The following functions can't be defined at `Init.Data.List.Basic`, because they depend on `Init.Util`,
and `Init.Util` depends on `Init.Data.List.Basic`. -/
/--
Returns the `i`-th element in the list (zero-based).
If the index is out of bounds (`i ≥ as.length`), this function panics when executed, and returns
`default`. See `get?` and `getD` for safer alternatives.
-/
def get! [Inhabited α] : (as : List α) (i : Nat) α
def get! [Inhabited α] : List α Nat α
| a::_, 0 => a
| _::as, n+1 => get! as n
| _, _ => panic! "invalid index"
/--
Returns the `i`-th element in the list (zero-based).
If the index is out of bounds (`i ≥ as.length`), this function returns `none`.
Also see `get`, `getD` and `get!`.
-/
def get? : (as : List α) (i : Nat) Option α
def get? : List α Nat Option α
| a::_, 0 => some a
| _::as, n+1 => get? as n
| _, _ => none
/--
Returns the `i`-th element in the list (zero-based).
def getD (as : List α) (idx : Nat) (a₀ : α) : α :=
(as.get? idx).getD a₀
If the index is out of bounds (`i ≥ as.length`), this function returns `fallback`.
See also `get?` and `get!`.
-/
def getD (as : List α) (i : Nat) (fallback : α) : α :=
(as.get? i).getD fallback
@[ext] theorem ext : {l₁ l₂ : List α}, ( n, l₁.get? n = l₂.get? n) l₁ = l₂
| [], [], _ => rfl
| a :: l₁, [], h => nomatch h 0
| [], a' :: l₂, h => nomatch h 0
| a :: l₁, a' :: l₂, h => by
have h0 : some a = some a' := h 0
injection h0 with aa; simp only [aa, ext fun n => h (n+1)]
/--
Returns the first element in the list.
If the list is empty, this function panics when executed, and returns `default`.
See `head` and `headD` for safer alternatives.
-/
def head! [Inhabited α] : List α α
| [] => panic! "empty list"
| a::_ => a
/--
Returns the first element in the list.
If the list is empty, this function returns `none`.
Also see `headD` and `head!`.
-/
def head? : List α Option α
| [] => none
| a::_ => some a
/--
Returns the first element in the list.
If the list is empty, this function returns `fallback`.
Also see `head?` and `head!`.
-/
def headD : (as : List α) (fallback : α) α
| [], fallback => fallback
def headD : List α α α
| [], a₀ => a₀
| a::_, _ => a
/--
Returns the first element of a non-empty list.
-/
def head : (as : List α) as [] α
| a::_, _ => a
/--
Drops the first element of the list.
If the list is empty, this function panics when executed, and returns the empty list.
See `tail` and `tailD` for safer alternatives.
-/
def tail! : List α List α
| [] => panic! "empty list"
| _::as => as
/--
Drops the first element of the list.
If the list is empty, this function returns `none`.
Also see `tailD` and `tail!`.
-/
def tail? : List α Option (List α)
| [] => none
| _::as => some as
/--
Drops the first element of the list.
def tailD : List α List α List α
| [], as₀ => as₀
| _::as, _ => as
If the list is empty, this function returns `fallback`.
Also see `head?` and `head!`.
-/
def tailD (list fallback : List α) : List α :=
match list with
| [] => fallback
| _ :: tl => tl
/--
Returns the last element of a non-empty list.
-/
def getLast : (as : List α), as [] α
| [], h => absurd rfl h
| [a], _ => a
| _::b::as, _ => getLast (b::as) (fun h => List.noConfusion h)
/--
Returns the last element in the list.
If the list is empty, this function panics when executed, and returns `default`.
See `getLast` and `getLastD` for safer alternatives.
-/
def getLast! [Inhabited α] : List α α
| [] => panic! "empty list"
| a::as => getLast (a::as) (fun h => List.noConfusion h)
/--
Returns the last element in the list.
If the list is empty, this function returns `none`.
Also see `getLastD` and `getLast!`.
-/
def getLast? : List α Option α
| [] => none
| a::as => some (getLast (a::as) (fun h => List.noConfusion h))
/--
Returns the last element in the list.
If the list is empty, this function returns `fallback`.
Also see `getLast?` and `getLast!`.
-/
def getLastD : (as : List α) (fallback : α) α
def getLastD : List α α α
| [], a₀ => a₀
| a::as, _ => getLast (a::as) (fun h => List.noConfusion h)
/--
`O(n)`. Rotates the elements of `xs` to the left such that the element at
`xs[i]` rotates to `xs[(i - n) % l.length]`.
* `rotateLeft [1, 2, 3, 4, 5] 3 = [4, 5, 1, 2, 3]`
* `rotateLeft [1, 2, 3, 4, 5] 5 = [1, 2, 3, 4, 5]`
* `rotateLeft [1, 2, 3, 4, 5] = [2, 3, 4, 5, 1]`
-/
def rotateLeft (xs : List α) (n : Nat := 1) : List α :=
let len := xs.length
if len 1 then
@@ -174,13 +79,6 @@ def rotateLeft (xs : List α) (n : Nat := 1) : List α :=
let e := xs.drop n
e ++ b
/--
`O(n)`. Rotates the elements of `xs` to the right such that the element at
`xs[i]` rotates to `xs[(i + n) % l.length]`.
* `rotateRight [1, 2, 3, 4, 5] 3 = [3, 4, 5, 1, 2]`
* `rotateRight [1, 2, 3, 4, 5] 5 = [1, 2, 3, 4, 5]`
* `rotateRight [1, 2, 3, 4, 5] = [5, 1, 2, 3, 4]`
-/
def rotateRight (xs : List α) (n : Nat := 1) : List α :=
let len := xs.length
if len 1 then
@@ -226,10 +124,9 @@ theorem sizeOf_lt_of_mem [SizeOf α] {as : List α} (h : a ∈ as) : sizeOf a <
over a nested inductive like `inductive T | mk : List T → T`. -/
macro "sizeOf_list_dec" : tactic =>
`(tactic| first
| with_reducible apply sizeOf_lt_of_mem; assumption; done
| with_reducible
apply Nat.lt_trans (sizeOf_lt_of_mem ?h)
case' h => assumption
| apply sizeOf_lt_of_mem; assumption; done
| apply Nat.lt_trans (sizeOf_lt_of_mem ?h)
case' h => assumption
simp_arith)
macro_rules | `(tactic| decreasing_trivial) => `(tactic| sizeOf_list_dec)
@@ -312,15 +209,6 @@ def mapMono (as : List α) (f : αα) : List α :=
Monadic generalization of `List.partition`.
This uses `Array.toList` and which isn't imported by `Init.Data.List.Basic`.
```
def posOrNeg (x : Int) : Except String Bool :=
if x > 0 then pure true
else if x < 0 then pure false
else throw "Zero is not positive or negative"
partitionM posOrNeg [-1, 2, 3] = Except.ok ([2, 3], [-1])
partitionM posOrNeg [0, 2, 3] = Except.error "Zero is not positive or negative"
```
-/
@[inline] def partitionM [Monad m] (p : α m Bool) (l : List α) : m (List α × List α) :=
go l #[] #[]

View File

@@ -40,13 +40,6 @@ Finally, we rarely use `mapM` with something that is not a `Monad`.
Users that want to use `mapM` with `Applicative` should use `mapA` instead.
-/
/--
Applies the monadic action `f` on every element in the list, left-to-right, and returns the list of
results.
See `List.forM` for the variant that discards the results.
See `List.mapA` for the variant that works with `Applicative`.
-/
@[inline]
def mapM {m : Type u Type v} [Monad m] {α : Type w} {β : Type u} (f : α m β) (as : List α) : m (List β) :=
let rec @[specialize] loop
@@ -54,42 +47,17 @@ def mapM {m : Type u → Type v} [Monad m] {α : Type w} {β : Type u} (f : α
| a :: as, bs => do loop as (( f a)::bs)
loop as []
/--
Applies the applicative action `f` on every element in the list, left-to-right, and returns the list of
results.
NB: If `m` is also a `Monad`, then using `mapM` can be more efficient.
See `List.forA` for the variant that discards the results.
See `List.mapM` for the variant that works with `Monad`.
**Warning**: this function is not tail-recursive, meaning that it may fail with a stack overflow on long lists.
-/
@[specialize]
def mapA {m : Type u Type v} [Applicative m] {α : Type w} {β : Type u} (f : α m β) : List α m (List β)
| [] => pure []
| a::as => List.cons <$> f a <*> mapA f as
/--
Applies the monadic action `f` on every element in the list, left-to-right.
See `List.mapM` for the variant that collects results.
See `List.forA` for the variant that works with `Applicative`.
-/
@[specialize]
protected def forM {m : Type u Type v} [Monad m] {α : Type w} (as : List α) (f : α m PUnit) : m PUnit :=
match as with
| [] => pure
| a :: as => do f a; List.forM as f
/--
Applies the applicative action `f` on every element in the list, left-to-right.
NB: If `m` is also a `Monad`, then using `forM` can be more efficient.
See `List.mapA` for the variant that collects results.
See `List.forM` for the variant that works with `Monad`.
-/
@[specialize]
def forA {m : Type u Type v} [Applicative m] {α : Type w} (as : List α) (f : α m PUnit) : m PUnit :=
match as with
@@ -103,27 +71,15 @@ def filterAuxM {m : Type → Type v} [Monad m] {α : Type} (f : α → m Bool) :
let b f h
filterAuxM f t (cond b (h :: acc) acc)
/--
Applies the monadic predicate `p` on every element in the list, left-to-right, and returns those
elements `x` for which `p x` returns `true`.
-/
@[inline]
def filterM {m : Type Type v} [Monad m] {α : Type} (p : α m Bool) (as : List α) : m (List α) := do
let as filterAuxM p as []
def filterM {m : Type Type v} [Monad m] {α : Type} (f : α m Bool) (as : List α) : m (List α) := do
let as filterAuxM f as []
pure as.reverse
/--
Applies the monadic predicate `p` on every element in the list, right-to-left, and returns those
elements `x` for which `p x` returns `true`.
-/
@[inline]
def filterRevM {m : Type Type v} [Monad m] {α : Type} (p : α m Bool) (as : List α) : m (List α) :=
filterAuxM p as.reverse []
def filterRevM {m : Type Type v} [Monad m] {α : Type} (f : α m Bool) (as : List α) : m (List α) :=
filterAuxM f as.reverse []
/--
Applies the monadic function `f` on every element `x` in the list, left-to-right, and returns those
results `y` for which `f x` returns `some y`.
-/
@[inline]
def filterMapM {m : Type u Type v} [Monad m] {α β : Type u} (f : α m (Option β)) (as : List α) : m (List β) :=
let rec @[specialize] loop
@@ -134,16 +90,6 @@ def filterMapM {m : Type u → Type v} [Monad m] {α β : Type u} (f : α → m
| some b => loop as (b::bs)
loop as.reverse []
/--
Folds a monadic function over a list from left to right:
```
foldlM f x₀ [a, b, c] = do
let x₁ ← f x₀ a
let x₂ ← f x₁ b
let x₃ ← f x₂ c
pure x₃
```
-/
@[specialize]
protected def foldlM {m : Type u Type v} [Monad m] {s : Type u} {α : Type w} : (f : s α m s) (init : s) List α m s
| _, s, [] => pure s
@@ -151,26 +97,10 @@ protected def foldlM {m : Type u → Type v} [Monad m] {s : Type u} {α : Type w
let s' f s a
List.foldlM f s' as
/--
Folds a monadic function over a list from right to left:
```
foldrM f x₀ [a, b, c] = do
let x₁ ← f c x₀
let x₂ ← f b x₁
let x₃ ← f a x₂
pure x₃
```
-/
@[inline]
def foldrM {m : Type u Type v} [Monad m] {s : Type u} {α : Type w} (f : α s m s) (init : s) (l : List α) : m s :=
l.reverse.foldlM (fun s a => f a s) init
/--
Maps `f` over the list and collects the results with `<|>`.
```
firstM f [a, b, c] = f a <|> f b <|> f c <|> failure
```
-/
@[specialize]
def firstM {m : Type u Type v} [Alternative m] {α : Type w} {β : Type u} (f : α m β) : List α m β
| [] => failure

View File

@@ -1,261 +0,0 @@
/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Lemmas
/-!
## Tail recursive implementations for `List` definitions.
Many of the proofs require theorems about `Array`,
so these are in a separate file to minimize imports.
-/
namespace List
/-- Tail recursive version of `erase`. -/
@[inline] def setTR (l : List α) (n : Nat) (a : α) : List α := go l n #[] where
/-- Auxiliary for `setTR`: `setTR.go l a xs n acc = acc.toList ++ set xs a`,
unless `n ≥ l.length` in which case it returns `l` -/
go : List α Nat Array α List α
| [], _, _ => l
| _::xs, 0, acc => acc.toListAppend (a::xs)
| x::xs, n+1, acc => go xs n (acc.push x)
@[csimp] theorem set_eq_setTR : @set = @setTR := by
funext α l n a; simp [setTR]
let rec go (acc) : xs n, l = acc.data ++ xs
setTR.go l a xs n acc = acc.data ++ xs.set n a
| [], _ => fun h => by simp [setTR.go, set, h]
| x::xs, 0 => by simp [setTR.go, set]
| x::xs, n+1 => fun h => by simp [setTR.go, set]; rw [go _ xs]; {simp}; simp [h]
exact (go #[] _ _ rfl).symm
/-- Tail recursive version of `erase`. -/
@[inline] def eraseTR [BEq α] (l : List α) (a : α) : List α := go l #[] where
/-- Auxiliary for `eraseTR`: `eraseTR.go l a xs acc = acc.toList ++ erase xs a`,
unless `a` is not present in which case it returns `l` -/
go : List α Array α List α
| [], _ => l
| x::xs, acc => bif x == a then acc.toListAppend xs else go xs (acc.push x)
@[csimp] theorem erase_eq_eraseTR : @List.erase = @eraseTR := by
funext α _ l a; simp [eraseTR]
suffices xs acc, l = acc.data ++ xs eraseTR.go l a xs acc = acc.data ++ xs.erase a from
(this l #[] (by simp)).symm
intro xs; induction xs with intro acc h
| nil => simp [List.erase, eraseTR.go, h]
| cons x xs IH =>
simp [List.erase, eraseTR.go]
cases x == a <;> simp
· rw [IH]; simp; simp; exact h
/-- Tail recursive version of `eraseIdx`. -/
@[inline] def eraseIdxTR (l : List α) (n : Nat) : List α := go l n #[] where
/-- Auxiliary for `eraseIdxTR`: `eraseIdxTR.go l n xs acc = acc.toList ++ eraseIdx xs a`,
unless `a` is not present in which case it returns `l` -/
go : List α Nat Array α List α
| [], _, _ => l
| _::as, 0, acc => acc.toListAppend as
| a::as, n+1, acc => go as n (acc.push a)
@[csimp] theorem eraseIdx_eq_eraseIdxTR : @eraseIdx = @eraseIdxTR := by
funext α l n; simp [eraseIdxTR]
suffices xs acc, l = acc.data ++ xs eraseIdxTR.go l xs n acc = acc.data ++ xs.eraseIdx n from
(this l #[] (by simp)).symm
intro xs; induction xs generalizing n with intro acc h
| nil => simp [eraseIdx, eraseIdxTR.go, h]
| cons x xs IH =>
match n with
| 0 => simp [eraseIdx, eraseIdxTR.go]
| n+1 =>
simp [eraseIdx, eraseIdxTR.go]
rw [IH]; simp; simp; exact h
/-- Tail recursive version of `bind`. -/
@[inline] def bindTR (as : List α) (f : α List β) : List β := go as #[] where
/-- Auxiliary for `bind`: `bind.go f as = acc.toList ++ bind f as` -/
@[specialize] go : List α Array β List β
| [], acc => acc.toList
| x::xs, acc => go xs (acc ++ f x)
@[csimp] theorem bind_eq_bindTR : @List.bind = @bindTR := by
funext α β as f
let rec go : as acc, bindTR.go f as acc = acc.data ++ as.bind f
| [], acc => by simp [bindTR.go, bind]
| x::xs, acc => by simp [bindTR.go, bind, go xs]
exact (go as #[]).symm
/-- Tail recursive version of `join`. -/
@[inline] def joinTR (l : List (List α)) : List α := bindTR l id
@[csimp] theorem join_eq_joinTR : @join = @joinTR := by
funext α l; rw [ List.bind_id, List.bind_eq_bindTR]; rfl
/-- Tail recursive version of `filterMap`. -/
@[inline] def filterMapTR (f : α Option β) (l : List α) : List β := go l #[] where
/-- Auxiliary for `filterMap`: `filterMap.go f l = acc.toList ++ filterMap f l` -/
@[specialize] go : List α Array β List β
| [], acc => acc.toList
| a::as, acc => match f a with
| none => go as acc
| some b => go as (acc.push b)
@[csimp] theorem filterMap_eq_filterMapTR : @List.filterMap = @filterMapTR := by
funext α β f l
let rec go : as acc, filterMapTR.go f as acc = acc.data ++ as.filterMap f
| [], acc => by simp [filterMapTR.go, filterMap]
| a::as, acc => by simp [filterMapTR.go, filterMap, go as]; split <;> simp [*]
exact (go l #[]).symm
/-- Tail recursive version of `replace`. -/
@[inline] def replaceTR [BEq α] (l : List α) (b c : α) : List α := go l #[] where
/-- Auxiliary for `replace`: `replace.go l b c xs acc = acc.toList ++ replace xs b c`,
unless `b` is not found in `xs` in which case it returns `l`. -/
@[specialize] go : List α Array α List α
| [], _ => l
| a::as, acc => bif a == b then acc.toListAppend (c::as) else go as (acc.push a)
@[csimp] theorem replace_eq_replaceTR : @List.replace = @replaceTR := by
funext α _ l b c; simp [replaceTR]
suffices xs acc, l = acc.data ++ xs
replaceTR.go l b c xs acc = acc.data ++ xs.replace b c from
(this l #[] (by simp)).symm
intro xs; induction xs with intro acc
| nil => simp [replace, replaceTR.go]
| cons x xs IH =>
simp [replace, replaceTR.go]; split <;> simp [*]
· intro h; rw [IH]; simp; simp; exact h
/-- Tail recursive version of `take`. -/
@[inline] def takeTR (n : Nat) (l : List α) : List α := go l n #[] where
/-- Auxiliary for `take`: `take.go l xs n acc = acc.toList ++ take n xs`,
unless `n ≥ xs.length` in which case it returns `l`. -/
@[specialize] go : List α Nat Array α List α
| [], _, _ => l
| _::_, 0, acc => acc.toList
| a::as, n+1, acc => go as n (acc.push a)
@[csimp] theorem take_eq_takeTR : @take = @takeTR := by
funext α n l; simp [takeTR]
suffices xs acc, l = acc.data ++ xs takeTR.go l xs n acc = acc.data ++ xs.take n from
(this l #[] (by simp)).symm
intro xs; induction xs generalizing n with intro acc
| nil => cases n <;> simp [take, takeTR.go]
| cons x xs IH =>
cases n with simp [take, takeTR.go]
| succ n => intro h; rw [IH]; simp; simp; exact h
/-- Tail recursive version of `takeWhile`. -/
@[inline] def takeWhileTR (p : α Bool) (l : List α) : List α := go l #[] where
/-- Auxiliary for `takeWhile`: `takeWhile.go p l xs acc = acc.toList ++ takeWhile p xs`,
unless no element satisfying `p` is found in `xs` in which case it returns `l`. -/
@[specialize] go : List α Array α List α
| [], _ => l
| a::as, acc => bif p a then go as (acc.push a) else acc.toList
@[csimp] theorem takeWhile_eq_takeWhileTR : @takeWhile = @takeWhileTR := by
funext α p l; simp [takeWhileTR]
suffices xs acc, l = acc.data ++ xs
takeWhileTR.go p l xs acc = acc.data ++ xs.takeWhile p from
(this l #[] (by simp)).symm
intro xs; induction xs with intro acc
| nil => simp [takeWhile, takeWhileTR.go]
| cons x xs IH =>
simp [takeWhile, takeWhileTR.go]; split <;> simp [*]
· intro h; rw [IH]; simp; simp; exact h
/-- Tail recursive version of `foldr`. -/
@[specialize] def foldrTR (f : α β β) (init : β) (l : List α) : β := l.toArray.foldr f init
@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by
funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_data, -Array.size_toArray]
/-- Tail recursive version of `zipWith`. -/
@[inline] def zipWithTR (f : α β γ) (as : List α) (bs : List β) : List γ := go as bs #[] where
/-- Auxiliary for `zipWith`: `zipWith.go f as bs acc = acc.toList ++ zipWith f as bs` -/
go : List α List β Array γ List γ
| a::as, b::bs, acc => go as bs (acc.push (f a b))
| _, _, acc => acc.toList
@[csimp] theorem zipWith_eq_zipWithTR : @zipWith = @zipWithTR := by
funext α β γ f as bs
let rec go : as bs acc, zipWithTR.go f as bs acc = acc.data ++ as.zipWith f bs
| [], _, acc | _::_, [], acc => by simp [zipWithTR.go, zipWith]
| a::as, b::bs, acc => by simp [zipWithTR.go, zipWith, go as bs]
exact (go as bs #[]).symm
/-- Tail recursive version of `unzip`. -/
def unzipTR (l : List (α × β)) : List α × List β :=
l.foldr (fun (a, b) (al, bl) => (a::al, b::bl)) ([], [])
@[csimp] theorem unzip_eq_unzipTR : @unzip = @unzipTR := by
funext α β l; simp [unzipTR]; induction l <;> simp [*]
/-- Tail recursive version of `enumFrom`. -/
def enumFromTR (n : Nat) (l : List α) : List (Nat × α) :=
let arr := l.toArray
(arr.foldr (fun a (n, acc) => (n-1, (n-1, a) :: acc)) (n + arr.size, [])).2
@[csimp] theorem enumFrom_eq_enumFromTR : @enumFrom = @enumFromTR := by
funext α n l; simp [enumFromTR, -Array.size_toArray]
let f := fun (a : α) (n, acc) => (n-1, (n-1, a) :: acc)
let rec go : l n, l.foldr f (n + l.length, []) = (n, enumFrom n l)
| [], n => rfl
| a::as, n => by
rw [ show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as]
simp [enumFrom, f]
rw [Array.foldr_eq_foldr_data]
simp [go]
theorem replicateTR_loop_eq : n, replicateTR.loop a n acc = replicate n a ++ acc
| 0 => rfl
| n+1 => by rw [ replicateTR_loop_replicate_eq _ 1 n, replicate, replicate,
replicateTR.loop, replicateTR_loop_eq n, replicateTR_loop_eq n, append_assoc]; rfl
/-- Tail recursive version of `dropLast`. -/
@[inline] def dropLastTR (l : List α) : List α := l.toArray.pop.toList
@[csimp] theorem dropLast_eq_dropLastTR : @dropLast = @dropLastTR := by
funext α l; simp [dropLastTR]
/-- Tail recursive version of `intersperse`. -/
def intersperseTR (sep : α) : List α List α
| [] => []
| [x] => [x]
| x::y::xs => x :: sep :: y :: xs.foldr (fun a r => sep :: a :: r) []
@[csimp] theorem intersperse_eq_intersperseTR : @intersperse = @intersperseTR := by
funext α sep l; simp [intersperseTR]
match l with
| [] | [_] => rfl
| x::y::xs => simp [intersperse]; induction xs generalizing y <;> simp [*]
/-- Tail recursive version of `intercalate`. -/
def intercalateTR (sep : List α) : List (List α) List α
| [] => []
| [x] => x
| x::xs => go sep.toArray x xs #[]
where
/-- Auxiliary for `intercalateTR`:
`intercalateTR.go sep x xs acc = acc.toList ++ intercalate sep.toList (x::xs)` -/
go (sep : Array α) : List α List (List α) Array α List α
| x, [], acc => acc.toListAppend x
| x, y::xs, acc => go sep y xs (acc ++ x ++ sep)
@[csimp] theorem intercalate_eq_intercalateTR : @intercalate = @intercalateTR := by
funext α sep l; simp [intercalate, intercalateTR]
match l with
| [] => rfl
| [_] => simp
| x::y::xs =>
let rec go {acc x} : xs,
intercalateTR.go sep.toArray x xs acc = acc.data ++ join (intersperse sep (x::xs))
| [] => by simp [intercalateTR.go]
| _::_ => by simp [intercalateTR.go, go]
simp [intersperse, go]
end List

File diff suppressed because it is too large Load Diff

View File

@@ -1,360 +0,0 @@
/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.List.Lemmas
import Init.Data.Nat.Lemmas
/-!
# Lemmas about `List.take`, `List.drop`, `List.zip` and `List.zipWith`.
These are in a separate file from most of the list lemmas
as they required importing more lemmas about natural numbers.
-/
namespace List
open Nat
/-! ### take -/
abbrev take_succ_cons := @take_cons_succ
@[simp] theorem length_take : (i : Nat) (l : List α), length (take i l) = min i (length l)
| 0, l => by simp [Nat.zero_min]
| succ n, [] => by simp [Nat.min_zero]
| succ n, _ :: l => by simp [Nat.succ_min_succ, length_take]
theorem length_take_le (n) (l : List α) : length (take n l) n := by simp [Nat.min_le_left]
theorem length_take_le' (n) (l : List α) : length (take n l) l.length :=
by simp [Nat.min_le_right]
theorem length_take_of_le (h : n length l) : length (take n l) = n := by simp [Nat.min_eq_left h]
theorem take_all_of_le {n} {l : List α} (h : length l n) : take n l = l :=
take_length_le h
@[simp]
theorem take_left : l₁ l₂ : List α, take (length l₁) (l₁ ++ l₂) = l₁
| [], _ => rfl
| a :: l₁, l₂ => congrArg (cons a) (take_left l₁ l₂)
theorem take_left' {l₁ l₂ : List α} {n} (h : length l₁ = n) : take n (l₁ ++ l₂) = l₁ := by
rw [ h]; apply take_left
theorem take_take : (n m) (l : List α), take n (take m l) = take (min n m) l
| n, 0, l => by rw [Nat.min_zero, take_zero, take_nil]
| 0, m, l => by rw [Nat.zero_min, take_zero, take_zero]
| succ n, succ m, nil => by simp only [take_nil]
| succ n, succ m, a :: l => by
simp only [take, succ_min_succ, take_take n m l]
theorem take_replicate (a : α) : n m : Nat, take n (replicate m a) = replicate (min n m) a
| n, 0 => by simp [Nat.min_zero]
| 0, m => by simp [Nat.zero_min]
| succ n, succ m => by simp [succ_min_succ, take_replicate]
theorem map_take (f : α β) :
(L : List α) (i : Nat), (L.take i).map f = (L.map f).take i
| [], i => by simp
| _, 0 => by simp
| h :: t, n + 1 => by dsimp; rw [map_take f t n]
/-- Taking the first `n` elements in `l₁ ++ l₂` is the same as appending the first `n` elements
of `l₁` to the first `n - l₁.length` elements of `l₂`. -/
theorem take_append_eq_append_take {l₁ l₂ : List α} {n : Nat} :
take n (l₁ ++ l₂) = take n l₁ ++ take (n - l₁.length) l₂ := by
induction l₁ generalizing n
· simp
· cases n
· simp [*]
· simp only [cons_append, take_cons_succ, length_cons, succ_eq_add_one, cons.injEq,
append_cancel_left_eq, true_and, *]
congr 1
omega
theorem take_append_of_le_length {l₁ l₂ : List α} {n : Nat} (h : n l₁.length) :
(l₁ ++ l₂).take n = l₁.take n := by
simp [take_append_eq_append_take, Nat.sub_eq_zero_of_le h]
/-- Taking the first `l₁.length + i` elements in `l₁ ++ l₂` is the same as appending the first
`i` elements of `l₂` to `l₁`. -/
theorem take_append {l₁ l₂ : List α} (i : Nat) :
take (l₁.length + i) (l₁ ++ l₂) = l₁ ++ take i l₂ := by
rw [take_append_eq_append_take, take_all_of_le (Nat.le_add_right _ _), Nat.add_sub_cancel_left]
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the big list to the small list. -/
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
get L i, hi = get (L.take j) i, length_take .. Nat.lt_min.mpr hj, hi :=
get_of_eq (take_append_drop j L).symm _ get_append ..
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
theorem get_take' (L : List α) {j i} :
get (L.take j) i =
get L i.1, Nat.lt_of_lt_of_le i.2 (length_take_le' _ _) := by
let i, hi := i; rw [length_take, Nat.lt_min] at hi; rw [get_take L _ hi.1]
theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by
induction n generalizing l m with
| zero =>
exact absurd h (Nat.not_lt_of_le m.zero_le)
| succ _ hn =>
cases l with
| nil => simp only [take_nil]
| cons hd tl =>
cases m
· simp only [get?, take]
· simpa only using hn (Nat.lt_of_succ_lt_succ h)
theorem get?_take_eq_none {l : List α} {n m : Nat} (h : n m) :
(l.take n).get? m = none :=
get?_eq_none.mpr <| Nat.le_trans (length_take_le _ _) h
theorem get?_take_eq_if {l : List α} {n m : Nat} :
(l.take n).get? m = if m < n then l.get? m else none := by
split
· next h => exact get?_take h
· next h => exact get?_take_eq_none (Nat.le_of_not_lt h)
@[simp]
theorem nth_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1)).get? n = l.get? n :=
get?_take (Nat.lt_succ_self n)
theorem take_succ {l : List α} {n : Nat} : l.take (n + 1) = l.take n ++ (l.get? n).toList := by
induction l generalizing n with
| nil =>
simp only [Option.toList, get?, take_nil, append_nil]
| cons hd tl hl =>
cases n
· simp only [Option.toList, get?, eq_self_iff_true, take, nil_append]
· simp only [hl, cons_append, get?, eq_self_iff_true, take]
@[simp]
theorem take_eq_nil_iff {l : List α} {k : Nat} : l.take k = [] l = [] k = 0 := by
cases l <;> cases k <;> simp [Nat.succ_ne_zero]
@[simp]
theorem take_eq_take :
{l : List α} {m n : Nat}, l.take m = l.take n min m l.length = min n l.length
| [], m, n => by simp [Nat.min_zero]
| _ :: xs, 0, 0 => by simp
| x :: xs, m + 1, 0 => by simp [Nat.zero_min, succ_min_succ]
| x :: xs, 0, n + 1 => by simp [Nat.zero_min, succ_min_succ]
| x :: xs, m + 1, n + 1 => by simp [succ_min_succ, take_eq_take]; omega
theorem take_add (l : List α) (m n : Nat) : l.take (m + n) = l.take m ++ (l.drop m).take n := by
suffices take (m + n) (take m l ++ drop m l) = take m l ++ take n (drop m l) by
rw [take_append_drop] at this
assumption
rw [take_append_eq_append_take, take_all_of_le, append_right_inj]
· simp only [take_eq_take, length_take, length_drop]
omega
apply Nat.le_trans (m := m)
· apply length_take_le
· apply Nat.le_add_right
theorem take_eq_nil_of_eq_nil : {as : List α} {i}, as = [] as.take i = []
| _, _, rfl => take_nil
theorem ne_nil_of_take_ne_nil {as : List α} {i : Nat} (h: as.take i []) : as [] :=
mt take_eq_nil_of_eq_nil h
theorem dropLast_eq_take (l : List α) : l.dropLast = l.take l.length.pred := by
cases l with
| nil => simp [dropLast]
| cons x l =>
induction l generalizing x with
| nil => simp [dropLast]
| cons hd tl hl => simp [dropLast, hl]
theorem dropLast_take {n : Nat} {l : List α} (h : n < l.length) :
(l.take n).dropLast = l.take n.pred := by
simp only [dropLast_eq_take, length_take, Nat.le_of_lt h, take_take, pred_le, Nat.min_eq_left]
theorem map_eq_append_split {f : α β} {l : List α} {s₁ s₂ : List β}
(h : map f l = s₁ ++ s₂) : l₁ l₂, l = l₁ ++ l₂ map f l₁ = s₁ map f l₂ = s₂ := by
have := h
rw [ take_append_drop (length s₁) l] at this
rw [map_append] at this
refine _, _, rfl, append_inj this ?_
rw [length_map, length_take, Nat.min_eq_left]
rw [ length_map l f, h, length_append]
apply Nat.le_add_right
/-! ### drop -/
@[simp]
theorem drop_eq_nil_iff_le {l : List α} {k : Nat} : l.drop k = [] l.length k := by
refine' fun h => _, drop_eq_nil_of_le
induction k generalizing l with
| zero =>
simp only [drop] at h
simp [h]
| succ k hk =>
cases l
· simp
· simp only [drop] at h
simpa [Nat.succ_le_succ_iff] using hk h
theorem drop_length_cons {l : List α} (h : l []) (a : α) :
(a :: l).drop l.length = [l.getLast h] := by
induction l generalizing a with
| nil =>
cases h rfl
| cons y l ih =>
simp only [drop, length]
by_cases h₁ : l = []
· simp [h₁]
rw [getLast_cons' _ h₁]
exact ih h₁ y
/-- Dropping the elements up to `n` in `l₁ ++ l₂` is the same as dropping the elements up to `n`
in `l₁`, dropping the elements up to `n - l₁.length` in `l₂`, and appending them. -/
theorem drop_append_eq_append_drop {l₁ l₂ : List α} {n : Nat} :
drop n (l₁ ++ l₂) = drop n l₁ ++ drop (n - l₁.length) l₂ := by
induction l₁ generalizing n
· simp
· cases n
· simp [*]
· simp only [cons_append, drop_succ_cons, length_cons, succ_eq_add_one, append_cancel_left_eq, *]
congr 1
omega
theorem drop_append_of_le_length {l₁ l₂ : List α} {n : Nat} (h : n l₁.length) :
(l₁ ++ l₂).drop n = l₁.drop n ++ l₂ := by
simp [drop_append_eq_append_drop, Nat.sub_eq_zero_of_le h]
/-- Dropping the elements up to `l₁.length + i` in `l₁ + l₂` is the same as dropping the elements
up to `i` in `l₂`. -/
@[simp]
theorem drop_append {l₁ l₂ : List α} (i : Nat) : drop (l₁.length + i) (l₁ ++ l₂) = drop i l₂ := by
rw [drop_append_eq_append_drop, drop_eq_nil_of_le] <;>
simp [Nat.add_sub_cancel_left, Nat.le_add_right]
theorem drop_sizeOf_le [SizeOf α] (l : List α) (n : Nat) : sizeOf (l.drop n) sizeOf l := by
induction l generalizing n with
| nil => rw [drop_nil]; apply Nat.le_refl
| cons _ _ lih =>
induction n with
| zero => apply Nat.le_refl
| succ n =>
exact Trans.trans (lih _) (Nat.le_add_left _ _)
theorem lt_length_drop (L : List α) {i j : Nat} (h : i + j < L.length) : j < (L.drop i).length := by
have A : i < L.length := Nat.lt_of_le_of_lt (Nat.le.intro rfl) h
rw [(take_append_drop i L).symm] at h
simpa only [Nat.le_of_lt A, Nat.min_eq_left, Nat.add_lt_add_iff_left, length_take,
length_append] using h
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the big list to the small list. -/
theorem get_drop (L : List α) {i j : Nat} (h : i + j < L.length) :
get L i + j, h = get (L.drop i) j, lt_length_drop L h := by
have : i L.length := Nat.le_trans (Nat.le_add_right _ _) (Nat.le_of_lt h)
rw [get_of_eq (take_append_drop i L).symm i + j, h, get_append_right'] <;>
simp [Nat.min_eq_left this, Nat.add_sub_cancel_left, Nat.le_add_right]
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
theorem get_drop' (L : List α) {i j} :
get (L.drop i) j = get L i + j, by
rw [Nat.add_comm]
exact Nat.add_lt_of_lt_sub (length_drop i L j.2) := by
rw [get_drop]
@[simp]
theorem get?_drop (L : List α) (i j : Nat) : get? (L.drop i) j = get? L (i + j) := by
ext
simp only [get?_eq_some, get_drop', Option.mem_def]
constructor <;> intro h, ha
· exact _, ha
· refine ?_, ha
rw [length_drop]
rw [Nat.add_comm] at h
apply Nat.lt_sub_of_add_lt h
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (n + m) l
| m, [] => by simp
| 0, l => by simp
| m + 1, a :: l =>
calc
drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
_ = drop (n + m) l := drop_drop n m l
_ = drop (n + (m + 1)) (a :: l) := rfl
theorem take_drop : (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
| 0, _, _ => by simp
| _, _, [] => by simp
| _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
theorem drop_take : (m n : Nat) (l : List α), drop n (take m l) = take (m - n) (drop n l)
| 0, _, _ => by simp
| _, 0, _ => by simp
| _, _, [] => by simp
| m+1, n+1, h :: t => by
simp [take_succ_cons, drop_succ_cons, drop_take m n t]
congr 1
omega
theorem map_drop (f : α β) :
(L : List α) (i : Nat), (L.drop i).map f = (L.map f).drop i
| [], i => by simp
| L, 0 => by simp
| h :: t, n + 1 => by
dsimp
rw [map_drop f t]
theorem reverse_take {α} {xs : List α} (n : Nat) (h : n xs.length) :
xs.reverse.take n = (xs.drop (xs.length - n)).reverse := by
induction xs generalizing n <;>
simp only [reverse_cons, drop, reverse_nil, Nat.zero_sub, length, take_nil]
next xs_hd xs_tl xs_ih =>
cases Nat.lt_or_eq_of_le h with
| inl h' =>
have h' := Nat.le_of_succ_le_succ h'
rw [take_append_of_le_length, xs_ih _ h']
rw [show xs_tl.length + 1 - n = succ (xs_tl.length - n) from _, drop]
· rwa [succ_eq_add_one, Nat.sub_add_comm]
· rwa [length_reverse]
| inr h' =>
subst h'
rw [length, Nat.sub_self, drop]
suffices xs_tl.length + 1 = (xs_tl.reverse ++ [xs_hd]).length by
rw [this, take_length, reverse_cons]
rw [length_append, length_reverse]
rfl
@[simp]
theorem get_cons_drop : (l : List α) i, get l i :: drop (i + 1) l = drop i l
| _::_, 0, _ => rfl
| _::_, i+1, _ => get_cons_drop _ i, _
theorem drop_eq_get_cons {n} {l : List α} (h) : drop n l = get l n, h :: drop (n + 1) l :=
(get_cons_drop _ n, h).symm
theorem drop_eq_nil_of_eq_nil : {as : List α} {i}, as = [] as.drop i = []
| _, _, rfl => drop_nil
theorem ne_nil_of_drop_ne_nil {as : List α} {i : Nat} (h: as.drop i []) : as [] :=
mt drop_eq_nil_of_eq_nil h
/-! ### zipWith -/
@[simp] theorem length_zipWith (f : α β γ) (l₁ l₂) :
length (zipWith f l₁ l₂) = min (length l₁) (length l₂) := by
induction l₁ generalizing l₂ <;> cases l₂ <;>
simp_all [succ_min_succ, Nat.zero_min, Nat.min_zero]
/-! ### zip -/
@[simp] theorem length_zip (l₁ : List α) (l₂ : List β) :
length (zip l₁ l₂) = min (length l₁) (length l₂) := by
simp [zip]
end List

View File

@@ -19,4 +19,3 @@ import Init.Data.Nat.Lemmas
import Init.Data.Nat.Mod
import Init.Data.Nat.Lcm
import Init.Data.Nat.Compare
import Init.Data.Nat.Simproc

View File

@@ -137,9 +137,6 @@ instance : LawfulBEq Nat where
@[simp] protected theorem zero_add : (n : Nat), 0 + n = n
| 0 => rfl
| n+1 => congrArg succ (Nat.zero_add n)
instance : Std.LawfulIdentity (α := Nat) (· + ·) 0 where
left_id := Nat.zero_add
right_id := Nat.add_zero
theorem succ_add : (n m : Nat), (succ n) + m = succ (n + m)
| _, 0 => rfl
@@ -163,12 +160,10 @@ protected theorem add_comm : ∀ (n m : Nat), n + m = m + n
have : succ (n + m) = succ (m + n) := by apply congrArg; apply Nat.add_comm
rw [succ_add m n]
apply this
instance : Std.Commutative (α := Nat) (· + ·) := Nat.add_comm
protected theorem add_assoc : (n m k : Nat), (n + m) + k = n + (m + k)
| _, _, 0 => rfl
| n, m, succ k => congrArg succ (Nat.add_assoc n m k)
instance : Std.Associative (α := Nat) (· + ·) := Nat.add_assoc
protected theorem add_left_comm (n m k : Nat) : n + (m + k) = m + (n + k) := by
rw [ Nat.add_assoc, Nat.add_comm n m, Nat.add_assoc]
@@ -179,7 +174,7 @@ protected theorem add_right_comm (n m k : Nat) : (n + m) + k = (n + k) + m := by
protected theorem add_left_cancel {n m k : Nat} : n + m = n + k m = k := by
induction n with
| zero => simp
| succ n ih => simp [succ_add, succ.injEq]; intro h; apply ih h
| succ n ih => simp [succ_add]; intro h; apply ih h
protected theorem add_right_cancel {n m k : Nat} (h : n + m = k + m) : n = k := by
rw [Nat.add_comm n m, Nat.add_comm k m] at h
@@ -212,16 +207,12 @@ theorem succ_mul (n m : Nat) : (succ n) * m = (n * m) + m := by
protected theorem mul_comm : (n m : Nat), n * m = m * n
| n, 0 => (Nat.zero_mul n).symm (Nat.mul_zero n).symm rfl
| n, succ m => (mul_succ n m).symm (succ_mul m n).symm (Nat.mul_comm n m).symm rfl
instance : Std.Commutative (α := Nat) (· * ·) := Nat.mul_comm
@[simp] protected theorem mul_one : (n : Nat), n * 1 = n :=
Nat.zero_add
@[simp] protected theorem one_mul (n : Nat) : 1 * n = n :=
Nat.mul_comm n 1 Nat.mul_one n
instance : Std.LawfulIdentity (α := Nat) (· * ·) 1 where
left_id := Nat.one_mul
right_id := Nat.mul_one
protected theorem left_distrib (n m k : Nat) : n * (m + k) = n * m + n * k := by
induction n with
@@ -240,7 +231,6 @@ protected theorem add_mul (n m k : Nat) : (n + m) * k = n * k + m * k :=
protected theorem mul_assoc : (n m k : Nat), (n * m) * k = n * (m * k)
| n, m, 0 => rfl
| n, m, succ k => by simp [mul_succ, Nat.mul_assoc n m k, Nat.left_distrib]
instance : Std.Associative (α := Nat) (· * ·) := Nat.mul_assoc
protected theorem mul_left_comm (n m k : Nat) : n * (m * k) = m * (n * k) := by
rw [ Nat.mul_assoc, Nat.mul_comm n m, Nat.mul_assoc]
@@ -258,7 +248,7 @@ theorem lt_succ_of_le {n m : Nat} : n ≤ m → n < succ m := succ_le_succ
@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n := rfl
theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
@[simp] theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
induction m with
| zero => exact rfl
| succ m ih => apply congrArg pred ih
@@ -584,7 +574,7 @@ theorem eq_zero_or_eq_succ_pred : ∀ n, n = 0 n = succ (pred n)
| 0 => .inl rfl
| _+1 => .inr rfl
theorem succ_inj' : succ a = succ b a = b := (Nat.succ.injEq a b).to_iff
theorem succ_inj' : succ a = succ b a = b := succ.inj, congrArg _
theorem succ_le_succ_iff : succ a succ b a b := le_of_succ_le_succ, succ_le_succ
@@ -812,7 +802,7 @@ theorem add_sub_of_le {a b : Nat} (h : a ≤ b) : a + (b - a) = b := by
protected theorem add_sub_add_right (n k m : Nat) : (n + k) - (m + k) = n - m := by
induction k with
| zero => simp
| succ k ih => simp [ Nat.add_assoc, succ_sub_succ_eq_sub, ih]
| succ k ih => simp [ Nat.add_assoc, ih]
protected theorem add_sub_add_left (k n m : Nat) : (k + n) - (k + m) = n - m := by
rw [Nat.add_comm k n, Nat.add_comm k m, Nat.add_sub_add_right]

View File

@@ -9,7 +9,6 @@ import Init.Data.Bool
import Init.Data.Int.Pow
import Init.Data.Nat.Bitwise.Basic
import Init.Data.Nat.Lemmas
import Init.Data.Nat.Simproc
import Init.TacticsExtra
import Init.Omega
@@ -50,10 +49,7 @@ noncomputable def div2Induction {motive : Nat → Sort u}
apply hyp
exact Nat.div_lt_self n_pos (Nat.le_refl _)
@[simp] theorem zero_and (x : Nat) : 0 &&& x = 0 := by
simp only [HAnd.hAnd, AndOp.and, land]
unfold bitwise
simp
@[simp] theorem zero_and (x : Nat) : 0 &&& x = 0 := by rfl
@[simp] theorem and_zero (x : Nat) : x &&& 0 = 0 := by
simp only [HAnd.hAnd, AndOp.and, land]
@@ -191,6 +187,8 @@ theorem lt_pow_two_of_testBit (x : Nat) (p : ∀i, i ≥ n → testBit x i = fal
have test_false := p _ i_ge_n
simp only [test_true] at test_false
/-! ### testBit -/
private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by
induction x with
| zero =>
@@ -234,7 +232,7 @@ theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) :
rw [Nat.sub_eq_zero_iff_le] at i_sub_j_eq
exact Nat.not_le_of_gt j_lt_i i_sub_j_eq
| d+1 =>
simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod]
simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod]
@[simp] theorem testBit_mod_two_pow (x j i : Nat) :
testBit (x % 2^j) i = (decide (i < j) && testBit x i) := by
@@ -258,7 +256,7 @@ theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) :
exact Nat.lt_add_of_pos_right (Nat.two_pow_pos j)
simp only [hyp y y_lt_x]
if i_lt_j : i < j then
rw [Nat.add_comm _ (2^_), testBit_two_pow_add_gt i_lt_j]
rw [ Nat.add_comm _ (2^_), testBit_two_pow_add_gt i_lt_j]
else
simp [i_lt_j]
@@ -273,7 +271,7 @@ theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) :
induction i generalizing n x with
| zero =>
match n with
| 0 => simp [succ_sub_succ_eq_sub]
| 0 => simp
| n+1 =>
simp [not_decide_mod_two_eq_one]
omega
@@ -281,7 +279,7 @@ theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) :
simp only [testBit_succ]
match n with
| 0 =>
simp [decide_eq_false, succ_sub_succ_eq_sub]
simp [decide_eq_false]
| n+1 =>
rw [Nat.two_pow_succ_sub_succ_div_two, ih]
· simp [Nat.succ_lt_succ_iff]
@@ -403,12 +401,12 @@ theorem and_pow_two_identity {x : Nat} (lt : x < 2^n) : x &&& 2^n-1 = x := by
/-! ### lor -/
@[simp] theorem zero_or (x : Nat) : 0 ||| x = x := by
@[simp] theorem or_zero (x : Nat) : 0 ||| x = x := by
simp only [HOr.hOr, OrOp.or, lor]
unfold bitwise
simp [@eq_comm _ 0]
@[simp] theorem or_zero (x : Nat) : x ||| 0 = x := by
@[simp] theorem zero_or (x : Nat) : x ||| 0 = x := by
simp only [HOr.hOr, OrOp.or, lor]
unfold bitwise
simp [@eq_comm _ 0]

View File

@@ -28,7 +28,7 @@ protected def div (x y : @& Nat) : Nat :=
0
decreasing_by apply div_rec_lemma; assumption
instance instDiv : Div Nat := Nat.div
instance : Div Nat := Nat.div
theorem div_eq (x y : Nat) : x / y = if 0 < y y x then (x - y) / y + 1 else 0 := by
show Nat.div x y = _
@@ -82,34 +82,22 @@ decreasing_by apply div_rec_lemma; assumption
@[extern "lean_nat_mod"]
protected def mod : @& Nat @& Nat Nat
/-
Nat.modCore is defined by well-founded recursion and thus irreducible. Nevertheless it is
desireable if trivial `Nat.mod` calculations, namely
* `Nat.mod 0 m` for all `m`
* `Nat.mod n (m+n)` for concrete literals `n`
reduce definitionally.
This property is desirable for `Fin n` literals, as it means `(ofNat 0 : Fin n).val = 0` by
definition.
-/
/- This case is not needed mathematically as the case below is equal to it; however, it makes
`0 % n = 0` true definitionally rather than just propositionally.
This property is desirable for `Fin n`, as it means `(ofNat 0 : Fin n).val = 0` by definition.
Primarily, this is valuable because mathlib in Lean3 assumed this was true definitionally, and so
keeping this definitional equality makes mathlib easier to port to mathlib4. -/
| 0, _ => 0
| n@(_ + 1), m =>
if m n -- NB: if n < m does not reduce as well as `m ≤ n`!
then Nat.modCore n m
else n
| x@(_ + 1), y => Nat.modCore x y
instance instMod : Mod Nat := Nat.mod
instance : Mod Nat := Nat.mod
protected theorem modCore_eq_mod (n m : Nat) : Nat.modCore n m = n % m := by
show Nat.modCore n m = Nat.mod n m
match n, m with
| 0, _ =>
protected theorem modCore_eq_mod (x y : Nat) : Nat.modCore x y = x % y := by
cases x with
| zero =>
rw [Nat.modCore]
exact if_neg fun hlt, hle => Nat.lt_irrefl _ (Nat.lt_of_lt_of_le hlt hle)
| (_ + 1), _ =>
rw [Nat.mod]; dsimp
refine iteInduction (fun _ => rfl) (fun h => ?false) -- cannot use `split` this early yet
rw [Nat.modCore]
exact if_neg fun _hlt, hle => h hle
| succ x => rfl
theorem mod_eq (x y : Nat) : x % y = if 0 < y y x then (x - y) % y else x := by
rw [Nat.modCore_eq_mod, Nat.modCore_eq_mod, Nat.modCore]

View File

@@ -10,24 +10,6 @@ import Init.RCases
namespace Nat
/--
Computes the greatest common divisor of two natural numbers.
This reference implementation via the Euclidean algorithm
is overridden in both the kernel and the compiler to efficiently
evaluate using the "bignum" representation (see `Nat`).
The definition provided here is the logical model
(and it is soundness-critical that they coincide).
The GCD of two natural numbers is the largest natural number
that divides both arguments.
In particular, the GCD of a number and `0` is the number itself:
```
example : Nat.gcd 10 15 = 5 := rfl
example : Nat.gcd 0 5 = 5 := rfl
example : Nat.gcd 7 0 = 7 := rfl
```
-/
@[extern "lean_nat_gcd"]
def gcd (m n : @& Nat) : Nat :=
if m = 0 then
@@ -37,11 +19,11 @@ def gcd (m n : @& Nat) : Nat :=
termination_by m
decreasing_by simp_wf; apply mod_lt _ (zero_lt_of_ne_zero _); assumption
@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y := by
rw [gcd]; rfl
@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
rfl
theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) := by
rw [gcd]; rfl
theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
rfl
@[simp] theorem gcd_one_left (n : Nat) : gcd 1 n = 1 := by
rw [gcd_succ, mod_one]
@@ -54,17 +36,13 @@ theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) := by
-- `simp [gcd_succ]` produces an invalid term unless `gcd_succ` is proved with `id rfl` instead
rw [gcd_succ]
exact gcd_zero_left _
instance : Std.LawfulIdentity gcd 0 where
left_id := gcd_zero_left
right_id := gcd_zero_right
@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
cases n <;> simp [gcd_succ]
instance : Std.IdempotentOp gcd := gcd_self
theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m :=
match m with
| 0 => by have := (mod_zero n).symm; rwa [gcd, gcd_zero_right]
| 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right]
| _ + 1 => by simp [gcd_succ]
@[elab_as_elim] theorem gcd.induction {P : Nat Nat Prop} (m n : Nat)
@@ -101,7 +79,6 @@ theorem gcd_comm (m n : Nat) : gcd m n = gcd n m :=
Nat.dvd_antisymm
(dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n))
(dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))
instance : Std.Commutative gcd := gcd_comm
theorem gcd_eq_left_iff_dvd : m n gcd m n = m :=
fun h => by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left],

View File

@@ -14,7 +14,6 @@ def lcm (m n : Nat) : Nat := m * n / gcd m n
theorem lcm_comm (m n : Nat) : lcm m n = lcm n m := by
rw [lcm, lcm, Nat.mul_comm n m, gcd_comm n m]
instance : Std.Commutative lcm := lcm_comm
@[simp] theorem lcm_zero_left (m : Nat) : lcm 0 m = 0 := by simp [lcm]
@@ -23,15 +22,11 @@ instance : Std.Commutative lcm := ⟨lcm_comm⟩
@[simp] theorem lcm_one_left (m : Nat) : lcm 1 m = m := by simp [lcm]
@[simp] theorem lcm_one_right (m : Nat) : lcm m 1 = m := by simp [lcm]
instance : Std.LawfulIdentity lcm 1 where
left_id := lcm_one_left
right_id := lcm_one_right
@[simp] theorem lcm_self (m : Nat) : lcm m m = m := by
match eq_zero_or_pos m with
| .inl h => rw [h, lcm_zero_left]
| .inr h => simp [lcm, Nat.mul_div_cancel _ h]
instance : Std.IdempotentOp lcm := lcm_self
theorem dvd_lcm_left (m n : Nat) : m lcm m n :=
n / gcd m n, by rw [ Nat.mul_div_assoc m (Nat.gcd_dvd_right m n)]; rfl
@@ -59,7 +54,6 @@ Nat.dvd_antisymm
(Nat.dvd_trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k))
(lcm_dvd (Nat.dvd_trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k))
(dvd_lcm_right (lcm m n) k)))
instance : Std.Associative lcm := lcm_assoc
theorem lcm_ne_zero (hm : m 0) (hn : n 0) : lcm m n 0 := by
intro h

View File

@@ -88,7 +88,7 @@ protected theorem add_pos_right (m) (h : 0 < n) : 0 < m + n :=
Nat.lt_of_lt_of_le h (Nat.le_add_left ..)
protected theorem add_self_ne_one : n, n + n 1
| n+1, h => by rw [Nat.succ_add, Nat.succ.injEq] at h; contradiction
| n+1, h => by rw [Nat.succ_add, Nat.succ_inj'] at h; contradiction
/-! ## sub -/
@@ -137,14 +137,14 @@ protected theorem sub_le_iff_le_add' {a b c : Nat} : a - b ≤ c ↔ a ≤ b + c
protected theorem le_sub_iff_add_le {n : Nat} (h : k m) : n m - k n + k m :=
Nat.add_le_of_le_sub h, Nat.le_sub_of_add_le
@[deprecated Nat.le_sub_iff_add_le (since := "2024-02-19")]
@[deprecated Nat.le_sub_iff_add_le]
protected theorem add_le_to_le_sub (n : Nat) (h : m k) : n + m k n k - m :=
(Nat.le_sub_iff_add_le h).symm
protected theorem add_le_of_le_sub' {n k m : Nat} (h : m k) : n k - m m + n k :=
Nat.add_comm .. Nat.add_le_of_le_sub h
@[deprecated Nat.add_le_of_le_sub' (since := "2024-02-19")]
@[deprecated Nat.add_le_of_le_sub']
protected theorem add_le_of_le_sub_left {n k m : Nat} (h : m k) : n k - m m + n k :=
Nat.add_le_of_le_sub' h
@@ -200,7 +200,6 @@ theorem succ_min_succ (x y) : min (succ x) (succ y) = succ (min x y) := by
| inr h => rw [Nat.min_eq_right h, Nat.min_eq_right (Nat.succ_le_succ h)]
@[simp] protected theorem min_self (a : Nat) : min a a = a := Nat.min_eq_left (Nat.le_refl _)
instance : Std.IdempotentOp (α := Nat) min := Nat.min_self
@[simp] protected theorem zero_min (a) : min 0 a = 0 := Nat.min_eq_left (Nat.zero_le _)
@@ -211,7 +210,6 @@ protected theorem min_assoc : ∀ (a b c : Nat), min (min a b) c = min a (min b
| _, 0, _ => by rw [Nat.zero_min, Nat.min_zero, Nat.zero_min]
| _, _, 0 => by rw [Nat.min_zero, Nat.min_zero, Nat.min_zero]
| _+1, _+1, _+1 => by simp only [Nat.succ_min_succ]; exact congrArg succ <| Nat.min_assoc ..
instance : Std.Associative (α := Nat) min := Nat.min_assoc
protected theorem sub_sub_eq_min : (a b : Nat), a - (a - b) = min a b
| 0, _ => by rw [Nat.zero_sub, Nat.zero_min]
@@ -251,21 +249,16 @@ protected theorem max_lt {a b c : Nat} : max a b < c ↔ a < c ∧ b < c := by
rw [ Nat.succ_le, Nat.succ_max_succ a b]; exact Nat.max_le
@[simp] protected theorem max_self (a : Nat) : max a a = a := Nat.max_eq_right (Nat.le_refl _)
instance : Std.IdempotentOp (α := Nat) max := Nat.max_self
@[simp] protected theorem zero_max (a) : max 0 a = a := Nat.max_eq_right (Nat.zero_le _)
@[simp] protected theorem max_zero (a) : max a 0 = a := Nat.max_eq_left (Nat.zero_le _)
instance : Std.LawfulIdentity (α := Nat) max 0 where
left_id := Nat.zero_max
right_id := Nat.max_zero
protected theorem max_assoc : (a b c : Nat), max (max a b) c = max a (max b c)
| 0, _, _ => by rw [Nat.zero_max, Nat.zero_max]
| _, 0, _ => by rw [Nat.zero_max, Nat.max_zero]
| _, _, 0 => by rw [Nat.max_zero, Nat.max_zero]
| _+1, _+1, _+1 => by simp only [Nat.succ_max_succ]; exact congrArg succ <| Nat.max_assoc ..
instance : Std.Associative (α := Nat) max := Nat.max_assoc
protected theorem sub_add_eq_max (a b : Nat) : a - b + b = max a b := by
match Nat.le_total a b with
@@ -401,11 +394,11 @@ protected theorem mul_min_mul_left (a b c : Nat) : min (a * b) (a * c) = a * min
/-! ### mul -/
@[deprecated Nat.mul_le_mul_left (since := "2024-02-19")]
@[deprecated Nat.mul_le_mul_left]
protected theorem mul_le_mul_of_nonneg_left {a b c : Nat} : a b c * a c * b :=
Nat.mul_le_mul_left c
@[deprecated Nat.mul_le_mul_right (since := "2024-02-19")]
@[deprecated Nat.mul_le_mul_right]
protected theorem mul_le_mul_of_nonneg_right {a b c : Nat} : a b a * c b * c :=
Nat.mul_le_mul_right c
@@ -478,7 +471,6 @@ protected theorem mul_lt_mul_of_lt_of_lt {a b c d : Nat} (hac : a < c) (hbd : b
theorem succ_mul_succ (a b) : succ a * succ b = a * b + a + b + 1 := by
rw [succ_mul, mul_succ]; rfl
theorem mul_le_add_right (m k n : Nat) : k * m m + n (k-1) * m n := by
match k with
| 0 =>
@@ -678,10 +670,6 @@ protected theorem pow_lt_pow_iff_right {a n m : Nat} (h : 1 < a) :
/-! ### log2 -/
@[simp]
theorem log2_zero : Nat.log2 0 = 0 := by
simp [Nat.log2]
theorem le_log2 (h : n 0) : k n.log2 2 ^ k n := by
match k with
| 0 => simp [show 1 n from Nat.pos_of_ne_zero h]
@@ -702,7 +690,7 @@ theorem log2_self_le (h : n ≠ 0) : 2 ^ n.log2 ≤ n := (le_log2 h).1 (Nat.le_r
theorem lt_log2_self : n < 2 ^ (n.log2 + 1) :=
match n with
| 0 => by simp
| 0 => Nat.zero_lt_two
| n+1 => (log2_lt n.succ_ne_zero).1 (Nat.le_refl _)
/-! ### dvd -/

View File

@@ -580,7 +580,7 @@ attribute [-simp] Nat.right_distrib Nat.left_distrib
theorem PolyCnstr.denote_mul (ctx : Context) (k : Nat) (c : PolyCnstr) : (c.mul (k+1)).denote ctx = c.denote ctx := by
cases c; rename_i eq lhs rhs
have : k 0 k + 1 1 := by intro h; match k with | 0 => contradiction | k+1 => simp [Nat.succ.injEq]
have : k 0 k + 1 1 := by intro h; match k with | 0 => contradiction | k+1 => simp
have : ¬ (k == 0) (k + 1 == 1) = false := fun h => beq_false_of_ne (this (ne_of_beq_false (Bool.of_not_eq_true h)))
have : ¬ ((k + 1 == 0) = true) := fun h => absurd (eq_of_beq h) (Nat.succ_ne_zero k)
have : (1 == (0 : Nat)) = false := rfl

View File

@@ -17,7 +17,6 @@ protected theorem min_comm (a b : Nat) : min a b = min b a := by
| .inl h => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
| .inr (.inl h) => simp [Nat.min_def, h]
| .inr (.inr h) => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
instance : Std.Commutative (α := Nat) min := Nat.min_comm
protected theorem min_le_right (a b : Nat) : min a b b := by
by_cases (a <= b) <;> simp [Nat.min_def, *]
@@ -48,7 +47,6 @@ protected theorem max_comm (a b : Nat) : max a b = max b a := by
by_cases h₁ : a b <;> by_cases h₂ : b a <;> simp [h₁, h₂]
· exact Nat.le_antisymm h₂ h₁
· cases not_or_intro h₁ h₂ <| Nat.le_total ..
instance : Std.Commutative (α := Nat) max := Nat.max_comm
protected theorem le_max_left ( a b : Nat) : a max a b := by
by_cases (a <= b) <;> simp [Nat.max_def, *]

View File

@@ -1,108 +0,0 @@
/-
Copyright (c) 2023 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix
-/
prelude
import Init.Data.Bool
import Init.Data.Nat.Basic
import Init.Data.Nat.Lemmas
/-!
This contains lemmas used by the Nat simprocs for simplifying arithmetic
addition offsets.
-/
namespace Nat.Simproc
/- Sub proofs -/
theorem sub_add_eq_comm (a b c : Nat) : a - (b + c) = a - c - b := by
rw [Nat.add_comm b c]
exact Nat.sub_add_eq a c b
theorem add_sub_add_le (a c : Nat) {b d : Nat} (h : b d) : a + b - (c + d) = a - (c + (d-b)) := by
induction b generalizing a c d with
| zero =>
simp
| succ b ind =>
match d with
| 0 =>
contradiction
| d + 1 =>
have g := Nat.le_of_succ_le_succ h
rw [Nat.add_succ a, Nat.add_succ c, Nat.succ_sub_succ, Nat.succ_sub_succ,
ind _ _ g]
theorem add_sub_add_ge (a c : Nat) {b d : Nat} (h : b d) : a + b - (c + d) = a + (b - d) - c := by
rw [Nat.add_comm c d, Nat.sub_add_eq, Nat.add_sub_assoc h a]
theorem add_sub_le (a : Nat) {b c : Nat} (h : b c) : a + b - c = a - (c - b) := by
have p := add_sub_add_le a 0 h
simp only [Nat.zero_add] at p
exact p
/- Eq proofs -/
theorem add_eq_gt (a : Nat) {b c : Nat} (h : b > c) : (a + b = c) = False :=
eq_false (Nat.ne_of_gt (Nat.lt_of_lt_of_le h (le_add_left b a)))
theorem eq_add_gt (a : Nat) {b c : Nat} (h : c > a) : (a = b + c) = False := by
rw [@Eq.comm Nat a (b + c)]
exact add_eq_gt b h
theorem add_eq_add_le (a c : Nat) {b d : Nat} (h : b d) : (a + b = c + d) = (a = c + (d - b)) := by
have g : b c + d := Nat.le_trans h (le_add_left d c)
rw [ Nat.add_sub_assoc h, @Eq.comm _ a, Nat.sub_eq_iff_eq_add g, @Eq.comm _ (a + b)]
theorem add_eq_add_ge (a c : Nat) {b d : Nat} (h : b d) : (a + b = c + d) = (a + (b - d) = c) := by
rw [@Eq.comm _ (a + b) _, add_eq_add_le c a h, @Eq.comm _ _ c]
theorem add_eq_le (a : Nat) {b c : Nat} (h : b c) : (a + b = c) = (a = c - b) := by
have r := add_eq_add_le a 0 h
simp only [Nat.zero_add] at r
exact r
theorem eq_add_le {a : Nat} (b : Nat) {c : Nat} (h : c a) : (a = b + c) = (b = a - c) := by
rw [@Eq.comm Nat a (b + c)]
exact add_eq_le b h
/- Lemmas for lifting Eq proofs to beq -/
theorem beqEqOfEqEq {a b c d : Nat} (p : (a = b) = (c = d)) : (a == b) = (c == d) := by
simp only [Bool.beq_eq_decide_eq, p]
theorem beqFalseOfEqFalse {a b : Nat} (p : (a = b) = False) : (a == b) = false := by
simp [Bool.beq_eq_decide_eq, p]
theorem bneEqOfEqEq {a b c d : Nat} (p : (a = b) = (c = d)) : (a != b) = (c != d) := by
simp only [bne, beqEqOfEqEq p]
theorem bneTrueOfEqFalse {a b : Nat} (p : (a = b) = False) : (a != b) = true := by
simp [bne, beqFalseOfEqFalse p]
/- le proofs -/
theorem add_le_add_le (a c : Nat) {b d : Nat} (h : b d) : (a + b c + d) = (a c + (d - b)) := by
rw [ Nat.add_sub_assoc h, Nat.le_sub_iff_add_le]
exact Nat.le_trans h (le_add_left d c)
theorem add_le_add_ge (a c : Nat) {b d : Nat} (h : b d) : (a + b c + d) = (a + (b - d) c) := by
rw [ Nat.add_sub_assoc h, Nat.sub_le_iff_le_add]
theorem add_le_le (a : Nat) {b c : Nat} (h : b c) : (a + b c) = (a c - b) := by
have r := add_le_add_le a 0 h
simp only [Nat.zero_add] at r
exact r
theorem add_le_gt (a : Nat) {b c : Nat} (h : b > c) : (a + b c) = False :=
eq_false (Nat.not_le_of_gt (Nat.lt_of_lt_of_le h (le_add_left b a)))
theorem le_add_le (a : Nat) {b c : Nat} (h : a c) : (a b + c) = True :=
eq_true (Nat.le_trans h (le_add_left c b))
theorem le_add_ge (a : Nat) {b c : Nat} (h : a c) : (a b + c) = (a - c b) := by
have r := add_le_add_ge 0 b h
simp only [Nat.zero_add] at r
exact r
end Nat.Simproc

View File

@@ -13,48 +13,30 @@ namespace Option
deriving instance DecidableEq for Option
deriving instance BEq for Option
/-- Lifts an optional value to any `Alternative`, sending `none` to `failure`. -/
def getM [Alternative m] : Option α m α
def toMonad [Monad m] [Alternative m] : Option α m α
| none => failure
| some a => pure a
@[deprecated getM (since := "2024-04-17")]
def toMonad [Monad m] [Alternative m] : Option α m α := getM
@[inline] def toBool : Option α Bool
| some _ => true
| none => false
/-- Returns `true` on `some x` and `false` on `none`. -/
@[inline] def isSome : Option α Bool
| some _ => true
| none => false
@[deprecated isSome, inline] def toBool : Option α Bool := isSome
/-- Returns `true` on `none` and `false` on `some x`. -/
@[inline] def isNone : Option α Bool
| some _ => false
| none => true
/--
`x?.isEqSome y` is equivalent to `x? == some y`, but avoids an allocation.
-/
@[inline] def isEqSome [BEq α] : Option α α Bool
| some a, b => a == b
| none, _ => false
@[inline] protected def bind : Option α (α Option β) Option β
| none, _ => none
| some a, f => f a
| some a, b => b a
/-- Runs `f` on `o`'s value, if any, and returns its result, or else returns `none`. -/
@[inline] protected def bindM [Monad m] (f : α m (Option β)) (o : Option α) : m (Option β) := do
if let some a := o then
return ( f a)
else
return none
/--
Runs a monadic function `f` on an optional value.
If the optional value is `none` the function is not called.
-/
@[inline] protected def mapM [Monad m] (f : α m β) (o : Option α) : m (Option β) := do
if let some a := o then
return some ( f a)
@@ -64,24 +46,18 @@ If the optional value is `none` the function is not called.
theorem map_id : (Option.map id : Option α Option α) = id :=
funext (fun o => match o with | none => rfl | some _ => rfl)
/-- Keeps an optional value only if it satisfies the predicate `p`. -/
@[always_inline, inline] protected def filter (p : α Bool) : Option α Option α
| some a => if p a then some a else none
| none => none
/-- Checks that an optional value satisfies a predicate `p` or is `none`. -/
@[always_inline, inline] protected def all (p : α Bool) : Option α Bool
| some a => p a
| none => true
/-- Checks that an optional value is not `none` and the value satisfies a predicate `p`. -/
@[always_inline, inline] protected def any (p : α Bool) : Option α Bool
| some a => p a
| none => false
/--
Implementation of `OrElse`'s `<|>` syntax for `Option`.
-/
@[always_inline, macro_inline] protected def orElse : Option α (Unit Option α) Option α
| some a, _ => some a
| none, b => b ()

View File

@@ -6,7 +6,6 @@ Authors: Dany Fabian, Sebastian Ullrich
prelude
import Init.Data.String
import Init.Data.Array.Basic
inductive Ordering where
| lt | eq | gt
@@ -88,24 +87,11 @@ def isGE : Ordering → Bool
end Ordering
/--
Yields an `Ordering` s.t. `x < y` corresponds to `Ordering.lt` / `Ordering.gt` and
`x = y` corresponds to `Ordering.eq`.
-/
@[inline] def compareOfLessAndEq {α} (x y : α) [LT α] [Decidable (x < y)] [DecidableEq α] : Ordering :=
if x < y then Ordering.lt
else if x = y then Ordering.eq
else Ordering.gt
/--
Yields an `Ordering` s.t. `x < y` corresponds to `Ordering.lt` / `Ordering.gt` and
`x == y` corresponds to `Ordering.eq`.
-/
@[inline] def compareOfLessAndBEq {α} (x y : α) [LT α] [Decidable (x < y)] [BEq α] : Ordering :=
if x < y then .lt
else if x == y then .eq
else .gt
/--
Compare `a` and `b` lexicographically by `cmp₁` and `cmp₂`. `a` and `b` are
first compared by `cmp₁`. If this returns 'equal', `a` and `b` are compared
@@ -114,23 +100,11 @@ by `cmp₂` to break the tie.
@[inline] def compareLex (cmp₁ cmp₂ : α β Ordering) (a : α) (b : β) : Ordering :=
(cmp₁ a b).then (cmp₂ a b)
/--
`Ord α` provides a computable total order on `α`, in terms of the
`compare : αα → Ordering` function.
Typically instances will be transitive, reflexive, and antisymmetric,
but this is not enforced by the typeclass.
There is a derive handler, so appending `deriving Ord` to an inductive type or structure
will attempt to create an `Ord` instance.
-/
class Ord (α : Type u) where
/-- Compare two elements in `α` using the comparator contained in an `[Ord α]` instance. -/
compare : α α Ordering
export Ord (compare)
set_option linter.unusedVariables false in -- allow specifying `ord` explicitly
/--
Compare `x` and `y` by comparing `f x` and `f y`.
-/
@@ -173,22 +147,17 @@ instance : Ord USize where
instance : Ord Char where
compare x y := compareOfLessAndEq x y
instance [Ord α] : Ord (Option α) where
compare
| none, none => .eq
| none, some _ => .lt
| some _, none => .gt
| some x, some y => compare x y
/-- The lexicographic order on pairs. -/
def lexOrd [Ord α] [Ord β] : Ord (α × β) where
compare := compareLex (compareOn (·.1)) (compareOn (·.2))
compare p1 p2 := match compare p1.1 p2.1 with
| .eq => compare p1.2 p2.2
| o => o
def ltOfOrd [Ord α] : LT α where
lt a b := compare a b = Ordering.lt
lt a b := compare a b == Ordering.lt
instance [Ord α] : DecidableRel (@LT.lt α ltOfOrd) :=
inferInstanceAs (DecidableRel (fun a b => compare a b = Ordering.lt))
inferInstanceAs (DecidableRel (fun a b => compare a b == Ordering.lt))
def leOfOrd [Ord α] : LE α where
le a b := (compare a b).isLE
@@ -225,7 +194,7 @@ protected def opposite (ord : Ord α) : Ord α where
/--
`ord.on f` compares `x` and `y` by comparing `f x` and `f y` according to `ord`.
-/
protected def on (_ : Ord β) (f : α β) : Ord α where
protected def on (ord : Ord β) (f : α β) : Ord α where
compare := compareOn f
/--
@@ -241,13 +210,4 @@ returns 'equal', by `ord₂`.
protected def lex' (ord₁ ord₂ : Ord α) : Ord α where
compare := compareLex ord₁.compare ord₂.compare
/--
Creates an order which compares elements of an `Array` in lexicographic order.
-/
protected def arrayOrd [a : Ord α] : Ord (Array α) where
compare x y :=
let _ : LT α := a.toLT
let _ : BEq α := a.toBEq
compareOfLessAndBEq x.toList y.toList
end Ord

View File

@@ -13,24 +13,11 @@ open Sum Subtype Nat
open Std
/--
A typeclass that specifies the standard way of turning values of some type into `Format`.
When rendered this `Format` should be as close as possible to something that can be parsed as the
input value.
-/
class Repr (α : Type u) where
/--
Turn a value of type `α` into `Format` at a given precedence. The precedence value can be used
to avoid parentheses if they are not necessary.
-/
reprPrec : α Nat Format
export Repr (reprPrec)
/--
Turn `a` into `Format` using its `Repr` instance. The precedence level is initially set to 0.
-/
abbrev repr [Repr α] (a : α) : Format :=
reprPrec a 0
@@ -116,11 +103,6 @@ instance {p : α → Prop} [Repr α] : Repr (Subtype p) where
namespace Nat
/-
We have pure functions for calculating the decimal representation of a `Nat` (`toDigits`), but also
a fast variant that handles small numbers (`USize`) via C code (`lean_string_of_usize`).
-/
def digitChar (n : Nat) : Char :=
if n = 0 then '0' else
if n = 1 then '1' else
@@ -151,20 +133,6 @@ def toDigitsCore (base : Nat) : Nat → Nat → List Char → List Char
def toDigits (base : Nat) (n : Nat) : List Char :=
toDigitsCore base (n+1) n []
@[extern "lean_string_of_usize"]
protected def _root_.USize.repr (n : @& USize) : String :=
(toDigits 10 n.toNat).asString
/-- We statically allocate and memoize reprs for small natural numbers. -/
private def reprArray : Array String := Id.run do
List.range 128 |>.map (·.toUSize.repr) |> Array.mk
private def reprFast (n : Nat) : String :=
if h : n < 128 then Nat.reprArray.get n, h else
if h : n < USize.size then (USize.ofNatCore n h).repr
else (toDigits 10 n).asString
@[implemented_by reprFast]
protected def repr (n : Nat) : String :=
(toDigits 10 n).asString
@@ -194,32 +162,6 @@ def toSuperDigits (n : Nat) : List Char :=
def toSuperscriptString (n : Nat) : String :=
(toSuperDigits n).asString
def subDigitChar (n : Nat) : Char :=
if n = 0 then '' else
if n = 1 then '' else
if n = 2 then '' else
if n = 3 then '' else
if n = 4 then '' else
if n = 5 then '' else
if n = 6 then '' else
if n = 7 then '' else
if n = 8 then '' else
if n = 9 then '' else
'*'
partial def toSubDigitsAux : Nat List Char List Char
| n, ds =>
let d := subDigitChar <| n % 10;
let n' := n / 10;
if n' = 0 then d::ds
else toSubDigitsAux n' (d::ds)
def toSubDigits (n : Nat) : List Char :=
toSubDigitsAux n []
def toSubscriptString (n : Nat) : String :=
(toSubDigits n).asString
end Nat
instance : Repr Nat where

View File

@@ -94,8 +94,7 @@ instance : Stream (Subarray α) α where
next? s :=
if h : s.start < s.stop then
have : s.start + 1 s.stop := Nat.succ_le_of_lt h
some (s.array.get s.start, Nat.lt_of_lt_of_le h s.stop_le_array_size,
{ s with start := s.start + 1, start_le_stop := this })
some (s.as.get s.start, Nat.lt_of_lt_of_le h s.h₂, { s with start := s.start + 1, h₁ := this })
else
none

View File

@@ -24,80 +24,34 @@ instance : LT String :=
instance decLt (s₁ s₂ : @& String) : Decidable (s₁ < s₂) :=
List.hasDecidableLt s₁.data s₂.data
/--
Returns the length of a string in Unicode code points.
Examples:
* `"".length = 0`
* `"abc".length = 3`
* `"L∃∀N".length = 4`
-/
@[extern "lean_string_length"]
def length : (@& String) Nat
| s => s.length
/--
Pushes a character onto the end of a string.
The internal implementation uses dynamic arrays and will perform destructive updates
if the string is not shared.
Example: `"abc".push 'd' = "abcd"`
-/
/-- The internal implementation uses dynamic arrays and will perform destructive updates
if the String is not shared. -/
@[extern "lean_string_push"]
def push : String Char String
| s, c => s ++ [c]
/--
Appends two strings.
The internal implementation uses dynamic arrays and will perform destructive updates
if the string is not shared.
Example: `"abc".append "def" = "abcdef"`
-/
/-- The internal implementation uses dynamic arrays and will perform destructive updates
if the String is not shared. -/
@[extern "lean_string_append"]
def append : String (@& String) String
| a, b => a ++ b
/--
Converts a string to a list of characters.
Even though the logical model of strings is as a structure that wraps a list of characters,
this operation takes time and space linear in the length of the string, because the compiler
uses an optimized representation as dynamic arrays.
Example: `"abc".toList = ['a', 'b', 'c']`
-/
/-- O(n) in the runtime, where n is the length of the String -/
def toList (s : String) : List Char :=
s.data
/-- Returns true if `p` is a valid UTF-8 position in the string `s`, meaning that `p ≤ s.endPos`
and `p` lies on a UTF-8 character boundary. This has an O(1) implementation in the runtime. -/
@[extern "lean_string_is_valid_pos"]
def Pos.isValid (s : @&String) (p : @& Pos) : Bool :=
go s.data 0
where
go : List Char Pos Bool
| [], i => i = p
| c::cs, i => if i = p then true else go cs (i + c)
def utf8GetAux : List Char Pos Pos Char
| [], _, _ => default
| c::cs, i, p => if i = p then c else utf8GetAux cs (i + c) p
/--
Returns the character at position `p` of a string. If `p` is not a valid position,
returns `(default : Char)`.
See `utf8GetAux` for the reference implementation.
Examples:
* `"abc".get ⟨1⟩ = 'b'`
* `"abc".get ⟨3⟩ = (default : Char) = 'A'`
Positions can also be invalid if a byte index points into the middle of a multi-byte UTF-8
character. For example,`"L∃∀N".get ⟨2⟩ = (default : Char) = 'A'`.
Return character at position `p`. If `p` is not a valid position
returns `(default : Char)`.
See `utf8GetAux` for the reference implementation.
-/
@[extern "lean_string_utf8_get"]
def get (s : @& String) (p : @& Pos) : Char :=
@@ -108,30 +62,12 @@ def utf8GetAux? : List Char → Pos → Pos → Option Char
| [], _, _ => none
| c::cs, i, p => if i = p then c else utf8GetAux? cs (i + c) p
/--
Returns the character at position `p`. If `p` is not a valid position, returns `none`.
Examples:
* `"abc".get? ⟨1⟩ = some 'b'`
* `"abc".get? ⟨3⟩ = none`
Positions can also be invalid if a byte index points into the middle of a multi-byte UTF-8
character. For example, `"L∃∀N".get? ⟨2⟩ = none`
-/
@[extern "lean_string_utf8_get_opt"]
def get? : (@& String) (@& Pos) Option Char
| s, p => utf8GetAux? s 0 p
/--
Returns the character at position `p` of a string. If `p` is not a valid position,
returns `(default : Char)` and produces a panic error message.
Examples:
* `"abc".get! ⟨1⟩ = 'b'`
* `"abc".get! ⟨3⟩` panics
Positions can also be invalid if a byte index points into the middle of a multi-byte UTF-8 character. For example,
`"L∃∀N".get! ⟨2⟩` panics.
Similar to `get`, but produces a panic error message if `p` is not a valid `String.Pos`.
-/
@[extern "lean_string_utf8_get_bang"]
def get! (s : @& String) (p : @& Pos) : Char :=
@@ -143,48 +79,13 @@ def utf8SetAux (c' : Char) : List Char → Pos → Pos → List Char
| c::cs, i, p =>
if i = p then (c'::cs) else c::(utf8SetAux c' cs (i + c) p)
/--
Replaces the character at a specified position in a string with a new character. If the position
is invalid, the string is returned unchanged.
If both the replacement character and the replaced character are ASCII characters and the string
is not shared, destructive updates are used.
Examples:
* `"abc".set ⟨1⟩ 'B' = "aBc"`
* `"abc".set ⟨3⟩ 'D' = "abc"`
* `"L∃∀N".set ⟨4⟩ 'X' = "L∃XN"`
Because `'∃'` is a multi-byte character, the byte index `2` in `L∃∀N` is an invalid position,
so `"L∃∀N".set ⟨2⟩ 'X' = "L∃∀N"`.
-/
@[extern "lean_string_utf8_set"]
def set : String (@& Pos) Char String
| s, i, c => utf8SetAux c s 0 i
/--
Replaces the character at position `p` in the string `s` with the result of applying `f` to that character.
If `p` is an invalid position, the string is returned unchanged.
Examples:
* `abc.modify ⟨1⟩ Char.toUpper = "aBc"`
* `abc.modify ⟨3⟩ Char.toUpper = "abc"`
-/
def modify (s : String) (i : Pos) (f : Char Char) : String :=
s.set i <| f <| s.get i
/--
Returns the next position in a string after position `p`. If `p` is not a valid position or `p = s.endPos`,
the result is unspecified.
Examples:
* `"abc".next ⟨1⟩ = String.Pos.mk 2`
* `"L∃∀N".next ⟨1⟩ = String.Pos.mk 4`, since `'∃'` is a multi-byte UTF-8 character
Cases where the result is unspecified:
* `"abc".next ⟨3⟩`, since `3 = s.endPos`
* `"L∃∀N".next ⟨2⟩`, since `2` points into the middle of a multi-byte UTF-8 character
-/
@[extern "lean_string_utf8_next"]
def next (s : @& String) (p : @& Pos) : Pos :=
let c := get s p
@@ -344,21 +245,12 @@ termination_by s.endPos.1 - i.1
@[specialize] def split (s : String) (p : Char Bool) : List String :=
splitAux s p 0 0 []
/--
Auxiliary for `splitOn`. Preconditions:
* `sep` is not empty
* `b <= i` are indexes into `s`
* `j` is an index into `sep`, and not at the end
It represents the state where we have currently parsed some split parts into `r` (in reverse order),
`b` is the beginning of the string / the end of the previous match of `sep`, and the first `j` bytes
of `sep` match the bytes `i-j .. i` of `s`.
-/
def splitOnAux (s sep : String) (b : Pos) (i : Pos) (j : Pos) (r : List String) : List String :=
if s.atEnd i then
if h : s.atEnd i then
let r := (s.extract b i)::r
r.reverse
else
have := Nat.sub_lt_sub_left (Nat.gt_of_not_le (mt decide_eq_true h)) (lt_next s _)
if s.get i == sep.get j then
let i := s.next i
let j := sep.next j
@@ -367,42 +259,9 @@ def splitOnAux (s sep : String) (b : Pos) (i : Pos) (j : Pos) (r : List String)
else
splitOnAux s sep b i j r
else
splitOnAux s sep b (s.next (i - j)) 0 r
termination_by (s.endPos.1 - (i - j).1, sep.endPos.1 - j.1)
decreasing_by
all_goals simp_wf
focus
rename_i h _ _
left; exact Nat.sub_lt_sub_left
(Nat.lt_of_le_of_lt (Nat.sub_le ..) (Nat.gt_of_not_le (mt decide_eq_true h)))
(Nat.lt_of_le_of_lt (Nat.sub_le ..) (lt_next s _))
focus
rename_i i₀ j₀ _ eq h'
rw [show (s.next i₀ - sep.next j₀).1 = (i₀ - j₀).1 by
show (_ + csize _) - (_ + csize _) = _
rw [(beq_iff_eq ..).1 eq, Nat.add_sub_add_right]; rfl]
right; exact Nat.sub_lt_sub_left
(Nat.lt_of_le_of_lt (Nat.le_add_right ..) (Nat.gt_of_not_le (mt decide_eq_true h')))
(lt_next sep _)
focus
rename_i h _
left; exact Nat.sub_lt_sub_left
(Nat.lt_of_le_of_lt (Nat.sub_le ..) (Nat.gt_of_not_le (mt decide_eq_true h)))
(lt_next s _)
splitOnAux s sep b (s.next i) 0 r
termination_by s.endPos.1 - i.1
/--
Splits a string `s` on occurrences of the separator `sep`. When `sep` is empty, it returns `[s]`;
when `sep` occurs in overlapping patterns, the first match is taken. There will always be exactly
`n+1` elements in the returned list if there were `n` nonoverlapping matches of `sep` in the string.
The default separator is `" "`. The separators are not included in the returned substrings.
```
"here is some text ".splitOn = ["here", "is", "some", "text", ""]
"here is some text ".splitOn "some" = ["here is ", " text "]
"here is some text ".splitOn "" = ["here is some text "]
"ababacabac".splitOn "aba" = ["", "bac", "c"]
```
-/
def splitOn (s : String) (sep : String := " ") : List String :=
if sep == "" then [s] else splitOnAux s sep 0 0 0 []
@@ -683,15 +542,13 @@ def substrEq (s1 : String) (off1 : String.Pos) (s2 : String) (off2 : String.Pos)
off1.byteIdx + sz s1.endPos.byteIdx && off2.byteIdx + sz s2.endPos.byteIdx && loop off1 off2 { byteIdx := off1.byteIdx + sz }
where
loop (off1 off2 stop1 : Pos) :=
if _h : off1.byteIdx < stop1.byteIdx then
if h : off1.byteIdx < stop1.byteIdx then
let c₁ := s1.get off1
let c₂ := s2.get off2
have := Nat.sub_lt_sub_left h (Nat.add_lt_add_left (one_le_csize c₁) off1.1)
c₁ == c₂ && loop (off1 + c₁) (off2 + c₂) stop1
else true
termination_by stop1.1 - off1.1
decreasing_by
have := Nat.sub_lt_sub_left _h (Nat.add_lt_add_left (one_le_csize c₁) off1.1)
decreasing_tactic
/-- Return true iff `p` is a prefix of `s` -/
def isPrefixOf (p : String) (s : String) : Bool :=

View File

@@ -17,132 +17,32 @@ def toNat! (s : String) : Nat :=
else
panic! "Nat expected"
def utf8DecodeChar? (a : ByteArray) (i : Nat) : Option Char := do
let c a[i]?
if c &&& 0x80 == 0 then
some c.toUInt32, .inl (Nat.lt_trans c.1.2 (by decide))
else if c &&& 0xe0 == 0xc0 then
let c1 a[i+1]?
guard (c1 &&& 0xc0 == 0x80)
let r := ((c &&& 0x1f).toUInt32 <<< 6) ||| (c1 &&& 0x3f).toUInt32
guard (0x80 r)
-- TODO: Prove h from the definition of r once we have the necessary lemmas
if h : r < 0xd800 then some r, .inl h else none
else if c &&& 0xf0 == 0xe0 then
let c1 a[i+1]?
let c2 a[i+2]?
guard (c1 &&& 0xc0 == 0x80 && c2 &&& 0xc0 == 0x80)
let r :=
((c &&& 0x0f).toUInt32 <<< 12) |||
((c1 &&& 0x3f).toUInt32 <<< 6) |||
(c2 &&& 0x3f).toUInt32
guard (0x800 r)
-- TODO: Prove `r < 0x110000` from the definition of r once we have the necessary lemmas
if h : r < 0xd800 0xdfff < r r < 0x110000 then some r, h else none
else if c &&& 0xf8 == 0xf0 then
let c1 a[i+1]?
let c2 a[i+2]?
let c3 a[i+3]?
guard (c1 &&& 0xc0 == 0x80 && c2 &&& 0xc0 == 0x80 && c3 &&& 0xc0 == 0x80)
let r :=
((c &&& 0x07).toUInt32 <<< 18) |||
((c1 &&& 0x3f).toUInt32 <<< 12) |||
((c2 &&& 0x3f).toUInt32 <<< 6) |||
(c3 &&& 0x3f).toUInt32
if h : 0x10000 r r < 0x110000 then
some r, .inr Nat.lt_of_lt_of_le (by decide) h.1, h.2
else none
else
none
/--
Convert a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded `ByteArray` string to `String`.
The result is unspecified if `a` is not properly UTF-8 encoded.
-/
@[extern "lean_string_from_utf8_unchecked"]
opaque fromUTF8Unchecked (a : @& ByteArray) : String
/-- Returns true if the given byte array consists of valid UTF-8. -/
@[extern "lean_string_validate_utf8"]
def validateUTF8 (a : @& ByteArray) : Bool :=
(loop 0).isSome
where
loop (i : Nat) : Option Unit := do
if i < a.size then
let c utf8DecodeChar? a i
loop (i + csize c)
else pure ()
termination_by a.size - i
decreasing_by exact Nat.sub_lt_sub_left _ (Nat.lt_add_of_pos_right (one_le_csize c))
/-- Converts a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded `ByteArray` string to `String`. -/
@[extern "lean_string_from_utf8"]
def fromUTF8 (a : @& ByteArray) (h : validateUTF8 a) : String :=
loop 0 ""
where
loop (i : Nat) (acc : String) : String :=
if i < a.size then
let c := (utf8DecodeChar? a i).getD default
loop (i + csize c) (acc.push c)
else acc
termination_by a.size - i
decreasing_by exact Nat.sub_lt_sub_left _ (Nat.lt_add_of_pos_right (one_le_csize c))
/-- Converts a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded `ByteArray` string to `String`,
or returns `none` if `a` is not properly UTF-8 encoded. -/
@[inline] def fromUTF8? (a : ByteArray) : Option String :=
if h : validateUTF8 a then fromUTF8 a h else none
/-- Converts a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded `ByteArray` string to `String`,
or panics if `a` is not properly UTF-8 encoded. -/
@[inline] def fromUTF8! (a : ByteArray) : String :=
if h : validateUTF8 a then fromUTF8 a h else panic! "invalid UTF-8 string"
def utf8EncodeChar (c : Char) : List UInt8 :=
let v := c.val
if v 0x7f then
[v.toUInt8]
else if v 0x7ff then
[(v >>> 6).toUInt8 &&& 0x1f ||| 0xc0,
v.toUInt8 &&& 0x3f ||| 0x80]
else if v 0xffff then
[(v >>> 12).toUInt8 &&& 0x0f ||| 0xe0,
(v >>> 6).toUInt8 &&& 0x3f ||| 0x80,
v.toUInt8 &&& 0x3f ||| 0x80]
else
[(v >>> 18).toUInt8 &&& 0x07 ||| 0xf0,
(v >>> 12).toUInt8 &&& 0x3f ||| 0x80,
(v >>> 6).toUInt8 &&& 0x3f ||| 0x80,
v.toUInt8 &&& 0x3f ||| 0x80]
@[simp] theorem length_utf8EncodeChar (c : Char) : (utf8EncodeChar c).length = csize c := by
simp [csize, utf8EncodeChar, Char.utf8Size]
cases Decidable.em (c.val 0x7f) <;> simp [*]
cases Decidable.em (c.val 0x7ff) <;> simp [*]
cases Decidable.em (c.val 0xffff) <;> simp [*]
/-- Converts the given `String` to a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded byte array. -/
/-- Convert the given `String` to a [UTF-8](https://en.wikipedia.org/wiki/UTF-8) encoded byte array. -/
@[extern "lean_string_to_utf8"]
def toUTF8 (a : @& String) : ByteArray :=
a.data.bind utf8EncodeChar
@[simp] theorem size_toUTF8 (s : String) : s.toUTF8.size = s.utf8ByteSize := by
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.bind]
induction s.data <;> simp [List.map, List.join, utf8ByteSize.go, Nat.add_comm, *]
opaque toUTF8 (a : @& String) : ByteArray
/-- Accesses a byte in the UTF-8 encoding of the `String`. O(1) -/
@[extern "lean_string_get_byte_fast"]
def getUtf8Byte (s : @& String) (n : Nat) (h : n < s.utf8ByteSize) : UInt8 :=
(toUTF8 s).get n, size_toUTF8 _ h
opaque getUtf8Byte (s : @& String) (n : Nat) (h : n < s.utf8ByteSize) : UInt8
theorem Iterator.sizeOf_next_lt_of_hasNext (i : String.Iterator) (h : i.hasNext) : sizeOf i.next < sizeOf i := by
cases i; rename_i s pos; simp [Iterator.next, Iterator.sizeOf_eq]; simp [Iterator.hasNext] at h
exact Nat.sub_lt_sub_left h (String.lt_next s pos)
macro_rules
| `(tactic| decreasing_trivial) =>
`(tactic| with_reducible apply String.Iterator.sizeOf_next_lt_of_hasNext; assumption)
macro_rules | `(tactic| decreasing_trivial) => `(tactic| apply String.Iterator.sizeOf_next_lt_of_hasNext; assumption)
theorem Iterator.sizeOf_next_lt_of_atEnd (i : String.Iterator) (h : ¬ i.atEnd = true) : sizeOf i.next < sizeOf i :=
have h : i.hasNext := decide_eq_true <| Nat.gt_of_not_le <| mt decide_eq_true h
sizeOf_next_lt_of_hasNext i h
macro_rules
| `(tactic| decreasing_trivial) =>
`(tactic| with_reducible apply String.Iterator.sizeOf_next_lt_of_atEnd; assumption)
macro_rules | `(tactic| decreasing_trivial) => `(tactic| apply String.Iterator.sizeOf_next_lt_of_atEnd; assumption)
namespace Iterator
@@ -162,40 +62,4 @@ namespace Iterator
end Iterator
private def findLeadingSpacesSize (s : String) : Nat :=
let it := s.iter
let it := it.find (· == '\n') |>.next
consumeSpaces it 0 s.length
where
consumeSpaces (it : String.Iterator) (curr min : Nat) : Nat :=
if it.atEnd then min
else if it.curr == ' ' || it.curr == '\t' then consumeSpaces it.next (curr + 1) min
else if it.curr == '\n' then findNextLine it.next min
else findNextLine it.next (Nat.min curr min)
findNextLine (it : String.Iterator) (min : Nat) : Nat :=
if it.atEnd then min
else if it.curr == '\n' then consumeSpaces it.next 0 min
else findNextLine it.next min
private def removeNumLeadingSpaces (n : Nat) (s : String) : String :=
consumeSpaces n s.iter ""
where
consumeSpaces (n : Nat) (it : String.Iterator) (r : String) : String :=
match n with
| 0 => saveLine it r
| n+1 =>
if it.atEnd then r
else if it.curr == ' ' || it.curr == '\t' then consumeSpaces n it.next r
else saveLine it r
termination_by (it, 1)
saveLine (it : String.Iterator) (r : String) : String :=
if it.atEnd then r
else if it.curr == '\n' then consumeSpaces n it.next (r.push '\n')
else saveLine it.next (r.push it.curr)
termination_by (it, 0)
def removeLeadingSpaces (s : String) : String :=
let n := findLeadingSpacesSize s
if n == 0 then s else removeNumLeadingSpaces n s
end String

View File

@@ -103,7 +103,7 @@ def UInt16.shiftLeft (a b : UInt16) : UInt16 := ⟨a.val <<< (modn b 16).val⟩
@[extern "lean_uint16_to_uint8"]
def UInt16.toUInt8 (a : UInt16) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint8_to_uint16"]
def UInt8.toUInt16 (a : UInt8) : UInt16 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt8.toUInt16 (a : UInt8) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint16_shift_right"]
def UInt16.shiftRight (a b : UInt16) : UInt16 := a.val >>> (modn b 16).val
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
@@ -186,9 +186,9 @@ def UInt32.toUInt8 (a : UInt32) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint32_to_uint16"]
def UInt32.toUInt16 (a : UInt32) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint8_to_uint32"]
def UInt8.toUInt32 (a : UInt8) : UInt32 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt8.toUInt32 (a : UInt8) : UInt32 := a.toNat.toUInt32
@[extern "lean_uint16_to_uint32"]
def UInt16.toUInt32 (a : UInt16) : UInt32 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt16.toUInt32 (a : UInt16) : UInt32 := a.toNat.toUInt32
instance UInt32.instOfNat : OfNat UInt32 n := UInt32.ofNat n
instance : Add UInt32 := UInt32.add
@@ -244,11 +244,11 @@ def UInt64.toUInt16 (a : UInt64) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint64_to_uint32"]
def UInt64.toUInt32 (a : UInt64) : UInt32 := a.toNat.toUInt32
@[extern "lean_uint8_to_uint64"]
def UInt8.toUInt64 (a : UInt8) : UInt64 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt8.toUInt64 (a : UInt8) : UInt64 := a.toNat.toUInt64
@[extern "lean_uint16_to_uint64"]
def UInt16.toUInt64 (a : UInt16) : UInt64 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt16.toUInt64 (a : UInt16) : UInt64 := a.toNat.toUInt64
@[extern "lean_uint32_to_uint64"]
def UInt32.toUInt64 (a : UInt32) : UInt64 := a.val, Nat.lt_trans a.1.2 (by decide)
def UInt32.toUInt64 (a : UInt32) : UInt64 := a.toNat.toUInt64
instance UInt64.instOfNat : OfNat UInt64 n := UInt64.ofNat n
instance : Add UInt64 := UInt64.add
@@ -321,7 +321,7 @@ def USize.shiftLeft (a b : USize) : USize := ⟨a.val <<< (modn b System.Platfor
@[extern "lean_usize_shift_right"]
def USize.shiftRight (a b : USize) : USize := a.val >>> (modn b System.Platform.numBits).val
@[extern "lean_uint32_to_usize"]
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.val a.1.2
def UInt32.toUSize (a : UInt32) : USize := a.toNat.toUSize
@[extern "lean_usize_to_uint32"]
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32

View File

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Mario Carneiro
-/
prelude
import Init.Data.ToString.Macro
import Init.TacticsExtra
import Init.RCases

View File

@@ -1,173 +0,0 @@
/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Util
@[never_extract]
private def outOfBounds [Inhabited α] : α :=
panic! "index out of bounds"
/--
The class `GetElem coll idx elem valid` implements the `xs[i]` notation.
Given `xs[i]` with `xs : coll` and `i : idx`, Lean looks for an instance of
`GetElem coll idx elem valid` and uses this to infer the type of return
value `elem` and side conditions `valid` required to ensure `xs[i]` yields
a valid value of type `elem`.
For example, the instance for arrays looks like
`GetElem (Array α) Nat α (fun xs i => i < xs.size)`.
The proof side-condition `valid xs i` is automatically dispatched by the
`get_elem_tactic` tactic, which can be extended by adding more clauses to
`get_elem_tactic_trivial`.
-/
class GetElem (coll : Type u) (idx : Type v) (elem : outParam (Type w))
(valid : outParam (coll idx Prop)) where
/--
The syntax `arr[i]` gets the `i`'th element of the collection `arr`. If there
are proof side conditions to the application, they will be automatically
inferred by the `get_elem_tactic` tactic.
The actual behavior of this class is type-dependent, but here are some
important implementations:
* `arr[i] : α` where `arr : Array α` and `i : Nat` or `i : USize`: does array
indexing with no bounds check and a proof side goal `i < arr.size`.
* `l[i] : α` where `l : List α` and `i : Nat`: index into a list, with proof
side goal `i < l.length`.
* `stx[i] : Syntax` where `stx : Syntax` and `i : Nat`: get a syntax argument,
no side goal (returns `.missing` out of range)
There are other variations on this syntax:
* `arr[i]!` is syntax for `getElem! arr i` which should panic and return
`default : α` if the index is not valid.
* `arr[i]?` is syntax for `getElem?` which should return `none` if the index
is not valid.
* `arr[i]'h` is syntax for `getElem arr i h` with `h` an explicit proof the
index is valid.
-/
getElem (xs : coll) (i : idx) (h : valid xs i) : elem
getElem? (xs : coll) (i : idx) [Decidable (valid xs i)] : Option elem :=
if h : _ then some (getElem xs i h) else none
getElem! [Inhabited elem] (xs : coll) (i : idx) [Decidable (valid xs i)] : elem :=
match getElem? xs i with | some e => e | none => outOfBounds
export GetElem (getElem getElem! getElem?)
@[inherit_doc getElem]
syntax:max term noWs "[" withoutPosition(term) "]" : term
macro_rules | `($x[$i]) => `(getElem $x $i (by get_elem_tactic))
@[inherit_doc getElem]
syntax term noWs "[" withoutPosition(term) "]'" term:max : term
macro_rules | `($x[$i]'$h) => `(getElem $x $i $h)
/--
The syntax `arr[i]?` gets the `i`'th element of the collection `arr` or
returns `none` if `i` is out of bounds.
-/
macro:max x:term noWs "[" i:term "]" noWs "?" : term => `(getElem? $x $i)
/--
The syntax `arr[i]!` gets the `i`'th element of the collection `arr` and
panics `i` is out of bounds.
-/
macro:max x:term noWs "[" i:term "]" noWs "!" : term => `(getElem! $x $i)
class LawfulGetElem (cont : Type u) (idx : Type v) (elem : outParam (Type w))
(dom : outParam (cont idx Prop)) [ge : GetElem cont idx elem dom] : Prop where
getElem?_def (c : cont) (i : idx) [Decidable (dom c i)] :
c[i]? = if h : dom c i then some (c[i]'h) else none := by intros; eq_refl
getElem!_def [Inhabited elem] (c : cont) (i : idx) [Decidable (dom c i)] :
c[i]! = match c[i]? with | some e => e | none => default := by intros; eq_refl
export LawfulGetElem (getElem?_def getElem!_def)
theorem getElem?_pos [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
(c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] : c[i]? = some (c[i]'h) := by
rw [getElem?_def]
exact dif_pos h
theorem getElem?_neg [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
(c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]? = none := by
rw [getElem?_def]
exact dif_neg h
theorem getElem!_pos [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
[Inhabited elem] (c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] :
c[i]! = c[i]'h := by
simp only [getElem!_def, getElem?_def, h]
theorem getElem!_neg [GetElem cont idx elem dom] [LawfulGetElem cont idx elem dom]
[Inhabited elem] (c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]! = default := by
simp only [getElem!_def, getElem?_def, h]
namespace Fin
instance instGetElemFinVal [GetElem cont Nat elem dom] : GetElem cont (Fin n) elem fun xs i => dom xs i where
getElem xs i h := getElem xs i.1 h
getElem? xs i := getElem? xs i.val
getElem! xs i := getElem! xs i.val
instance [GetElem cont Nat elem dom] [h : LawfulGetElem cont Nat elem dom] :
LawfulGetElem cont (Fin n) elem fun xs i => dom xs i where
getElem?_def _c _i _d := h.getElem?_def ..
getElem!_def _c _i _d := h.getElem!_def ..
@[simp] theorem getElem_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n) (h : Dom a i) :
a[i] = a[i.1] := rfl
@[simp] theorem getElem?_fin [h : GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n)
[Decidable (Dom a i)] : a[i]? = a[i.1]? := by rfl
@[simp] theorem getElem!_fin [GetElem Cont Nat Elem Dom] (a : Cont) (i : Fin n)
[Decidable (Dom a i)] [Inhabited Elem] : a[i]! = a[i.1]! := rfl
macro_rules
| `(tactic| get_elem_tactic_trivial) => `(tactic| apply Fin.val_lt_of_le; get_elem_tactic_trivial; done)
end Fin
namespace List
instance : GetElem (List α) Nat α fun as i => i < as.length where
getElem as i h := as.get i, h
instance : LawfulGetElem (List α) Nat α fun as i => i < as.length where
@[simp] theorem cons_getElem_zero (a : α) (as : List α) (h : 0 < (a :: as).length) : getElem (a :: as) 0 h = a := by
rfl
@[simp] theorem cons_getElem_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
rfl
theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
match as, i with
| _::_, 0 => rfl
| _::_, i+1 => get_drop_eq_drop _ i _
end List
namespace Array
instance : GetElem (Array α) Nat α fun xs i => i < xs.size where
getElem xs i h := xs.get i, h
instance : LawfulGetElem (Array α) Nat α fun xs i => i < xs.size where
end Array
namespace Lean.Syntax
instance : GetElem Syntax Nat Syntax fun _ _ => True where
getElem stx i _ := stx.getArg i
instance : LawfulGetElem Syntax Nat Syntax fun _ _ => True where
end Lean.Syntax

View File

@@ -1,8 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Norm
import Init.Grind.Tactics

View File

@@ -1,110 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.SimpLemmas
import Init.Classical
import Init.ByCases
namespace Lean.Grind
/-!
Normalization theorems for the `grind` tactic.
We are also going to use simproc's in the future.
-/
-- Not
attribute [grind_norm] Classical.not_not
-- Ne
attribute [grind_norm] ne_eq
-- Iff
@[grind_norm] theorem iff_eq (p q : Prop) : (p q) = (p = q) := by
by_cases p <;> by_cases q <;> simp [*]
-- Eq
attribute [grind_norm] eq_self heq_eq_eq
-- Prop equality
@[grind_norm] theorem eq_true_eq (p : Prop) : (p = True) = p := by simp
@[grind_norm] theorem eq_false_eq (p : Prop) : (p = False) = ¬p := by simp
@[grind_norm] theorem not_eq_prop (p q : Prop) : (¬(p = q)) = (p = ¬q) := by
by_cases p <;> by_cases q <;> simp [*]
-- True
attribute [grind_norm] not_true
-- False
attribute [grind_norm] not_false_eq_true
-- Implication as a clause
@[grind_norm] theorem imp_eq (p q : Prop) : (p q) = (¬ p q) := by
by_cases p <;> by_cases q <;> simp [*]
-- And
@[grind_norm] theorem not_and (p q : Prop) : (¬(p q)) = (¬p ¬q) := by
by_cases p <;> by_cases q <;> simp [*]
attribute [grind_norm] and_true true_and and_false false_and and_assoc
-- Or
attribute [grind_norm] not_or
attribute [grind_norm] or_true true_or or_false false_or or_assoc
-- ite
attribute [grind_norm] ite_true ite_false
@[grind_norm] theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
by_cases p <;> simp [*]
-- Forall
@[grind_norm] theorem not_forall (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] forall_and
-- Exists
@[grind_norm] theorem not_exists (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] exists_const exists_or
-- Bool cond
@[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
cases c <;> simp [*]
-- Bool or
attribute [grind_norm]
Bool.or_false Bool.or_true Bool.false_or Bool.true_or Bool.or_eq_true Bool.or_assoc
-- Bool and
attribute [grind_norm]
Bool.and_false Bool.and_true Bool.false_and Bool.true_and Bool.and_eq_true Bool.and_assoc
-- Bool not
attribute [grind_norm]
Bool.not_not
-- beq
attribute [grind_norm] beq_iff_eq
-- bne
attribute [grind_norm] bne_iff_ne
-- Bool not eq true/false
attribute [grind_norm] Bool.not_eq_true Bool.not_eq_false
-- decide
attribute [grind_norm] decide_eq_true_eq decide_not not_decide_eq_true
-- Nat LE
attribute [grind_norm] Nat.le_zero_eq
-- Nat/Int LT
@[grind_norm] theorem Nat.lt_eq (a b : Nat) : (a < b) = (a + 1 b) := by
simp [Nat.lt, LT.lt]
@[grind_norm] theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 b) := by
simp [Int.lt, LT.lt]
-- GT GE
attribute [grind_norm] GT.gt GE.ge
end Lean.Grind

View File

@@ -1,14 +0,0 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Tactics
namespace Lean.Grind
/-!
`grind` tactic and related tactics.
-/
end Lean.Grind

View File

@@ -1,18 +0,0 @@
/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
Extra notation that depends on Init/Meta
-/
prelude
import Init.Data.ToString.Macro
import Init.Meta
namespace Lean
macro "Macro.trace[" id:ident "]" s:interpolatedStr(term) : term =>
`(Macro.trace $(quote id.getId.eraseMacroScopes) (s! $s))
end Lean

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