Compare commits

..

1 Commits

Author SHA1 Message Date
Kim Morrison
2513be6a09 feat: HashSet.ofArray (unverified) 2024-09-17 16:42:31 +10:00
2578 changed files with 16113 additions and 71784 deletions

View File

@@ -25,7 +25,7 @@ Please put an X between the brackets as you perform the following steps:
### Context
[Broader context that the issue occurred in. If there was any prior discussion on [the Lean Zulip](https://leanprover.zulipchat.com), link it here as well.]
[Broader context that the issue occured in. If there was any prior discussion on [the Lean Zulip](https://leanprover.zulipchat.com), link it here as well.]
### Steps to Reproduce
@@ -39,7 +39,7 @@ Please put an X between the brackets as you perform the following steps:
### Versions
[Output of `#version` or `#eval Lean.versionString`]
[Output of `#eval Lean.versionString`]
[OS version, if not using live.lean-lang.org.]
### Additional Information

View File

@@ -5,10 +5,6 @@
* Include the link to your `RFC` or `bug` issue in the description.
* If the issue does not already have approval from a developer, submit the PR as draft.
* The PR title/description will become the commit message. Keep it up-to-date as the PR evolves.
* For `feat/fix` PRs, the first paragraph starting with "This PR" must be present and will become a
changelog entry unless the PR is labeled with `no-changelog`. If the PR does not have this label,
it must instead be categorized with one of the `changelog-*` labels (which will be done by a
reviewer for external PRs).
* A toolchain of the form `leanprover/lean4-pr-releases:pr-release-NNNN` for Linux and M-series Macs will be generated upon build. To generate binaries for Windows and Intel-based Macs as well, write a comment containing `release-ci` on its own line.
* If you rebase your PR onto `nightly-with-mathlib` then CI will test Mathlib against your PR.
* You can manage the `awaiting-review`, `awaiting-author`, and `WIP` labels yourself, by writing a comment containing one of these labels on its own line.
@@ -16,6 +12,4 @@
---
This PR <short changelog summary for feat/fix, see above>.
Closes <`RFC` or `bug` issue number fixed by this PR, if any>
Closes #0000 (`RFC` or `bug` issue number fixed by this PR, if any)

View File

@@ -1,8 +0,0 @@
version: 2
updates:
- package-ecosystem: "github-actions"
directory: "/"
schedule:
interval: "monthly"
commit-message:
prefix: "chore: CI"

View File

@@ -17,6 +17,6 @@ jobs:
- name: Checkout
uses: actions/checkout@v4
- name: actionlint
uses: raven-actions/actionlint@v2
uses: raven-actions/actionlint@v1
with:
pyflakes: false # we do not use python scripts

View File

@@ -11,10 +11,7 @@ jobs:
with:
# the default is to use a virtual merge commit between the PR and master: just use the PR
ref: ${{ github.event.pull_request.head.sha }}
sparse-checkout: |
src/Lean
src/Std
src/lake/Lake
sparse-checkout: src/Lean
- name: Check Prelude
run: |
failed_files=""
@@ -22,8 +19,8 @@ jobs:
if ! grep -q "^prelude$" "$file"; then
failed_files="$failed_files$file\n"
fi
done < <(find src/Lean src/Std src/lake/Lake -name '*.lean' -print0)
done < <(find src/Lean -name '*.lean' -print0)
if [ -n "$failed_files" ]; then
echo -e "The following files should use 'prelude':\n$failed_files"
exit 1
fi
fi

View File

@@ -217,7 +217,7 @@ jobs:
"release": true,
"check-level": 2,
"shell": "msys2 {0}",
"CMAKE_OPTIONS": "-G \"Unix Makefiles\"",
"CMAKE_OPTIONS": "-G \"Unix Makefiles\" -DUSE_GMP=OFF",
// for reasons unknown, interactivetests are flaky on Windows
"CTEST_OPTIONS": "--repeat until-pass:2",
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-w64-windows-gnu.tar.zst",
@@ -227,7 +227,7 @@ jobs:
{
"name": "Linux aarch64",
"os": "nscloud-ubuntu-22.04-arm64-4x8",
"CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-linux_aarch64",
"CMAKE_OPTIONS": "-DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-linux_aarch64",
"release": true,
"check-level": 2,
"shell": "nix develop .#oldGlibcAArch -c bash -euxo pipefail {0}",
@@ -257,7 +257,7 @@ jobs:
"cross": true,
"shell": "bash -euxo pipefail {0}",
// Just a few selected tests because wasm is slow
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_libuv\\.lean\""
}
];
console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
@@ -316,9 +316,9 @@ jobs:
git fetch --depth=1 origin ${{ github.sha }}
git checkout FETCH_HEAD flake.nix flake.lock
if: github.event_name == 'pull_request'
# (needs to be after "Checkout" so files don't get overridden)
# (needs to be after "Checkout" so files don't get overriden)
- name: Setup emsdk
uses: mymindstorm/setup-emsdk@v14
uses: mymindstorm/setup-emsdk@v12
with:
version: 3.1.44
actions-cache-folder: emsdk
@@ -452,7 +452,7 @@ jobs:
run: ccache -s
# This job collects results from all the matrix jobs
# This can be made the "required" job, instead of listing each
# This can be made the required job, instead of listing each
# matrix job separately
all-done:
name: Build matrix complete
@@ -492,7 +492,7 @@ jobs:
with:
path: artifacts
- name: Release
uses: softprops/action-gh-release@v2
uses: softprops/action-gh-release@v1
with:
files: artifacts/*/*
fail_on_unmatched_files: true
@@ -536,7 +536,7 @@ jobs:
echo -e "\n*Full commit log*\n" >> diff.md
git log --oneline "$last_tag"..HEAD | sed 's/^/* /' >> diff.md
- name: Release Nightly
uses: softprops/action-gh-release@v2
uses: softprops/action-gh-release@v1
with:
body_path: diff.md
prerelease: true

View File

@@ -1,8 +1,7 @@
# This workflow allows any user to add one of the `awaiting-review`, `awaiting-author`, `WIP`,
# `release-ci`, or a `changelog-XXX` label by commenting on the PR or issue.
# or `release-ci` labels by commenting on the PR or issue.
# If any labels from the set {`awaiting-review`, `awaiting-author`, `WIP`} are added, other labels
# from that set are removed automatically at the same time.
# Similarly, if any `changelog-XXX` label is added, other `changelog-YYY` labels are removed.
name: Label PR based on Comment
@@ -12,7 +11,7 @@ on:
jobs:
update-label:
if: github.event.issue.pull_request != null && (contains(github.event.comment.body, 'awaiting-review') || contains(github.event.comment.body, 'awaiting-author') || contains(github.event.comment.body, 'WIP') || contains(github.event.comment.body, 'release-ci') || contains(github.event.comment.body, 'changelog-'))
if: github.event.issue.pull_request != null && (contains(github.event.comment.body, 'awaiting-review') || contains(github.event.comment.body, 'awaiting-author') || contains(github.event.comment.body, 'WIP') || contains(github.event.comment.body, 'release-ci'))
runs-on: ubuntu-latest
steps:
@@ -21,14 +20,13 @@ jobs:
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
script: |
const { owner, repo, number: issue_number } = context.issue;
const { owner, repo, number: issue_number } = context.issue;
const commentLines = context.payload.comment.body.split('\r\n');
const awaitingReview = commentLines.includes('awaiting-review');
const awaitingAuthor = commentLines.includes('awaiting-author');
const wip = commentLines.includes('WIP');
const releaseCI = commentLines.includes('release-ci');
const changelogMatch = commentLines.find(line => line.startsWith('changelog-'));
if (awaitingReview || awaitingAuthor || wip) {
await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'awaiting-review' }).catch(() => {});
@@ -49,19 +47,3 @@ jobs:
if (releaseCI) {
await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['release-ci'] });
}
if (changelogMatch) {
const changelogLabel = changelogMatch.trim();
const { data: existingLabels } = await github.rest.issues.listLabelsOnIssue({ owner, repo, issue_number });
const changelogLabels = existingLabels.filter(label => label.name.startsWith('changelog-'));
// Remove all other changelog labels
for (const label of changelogLabels) {
if (label.name !== changelogLabel) {
await github.rest.issues.removeLabel({ owner, repo, issue_number, name: label.name }).catch(() => {});
}
}
// Add the new changelog label
await github.rest.issues.addLabels({ owner, repo, issue_number, labels: [changelogLabel] });
}

View File

@@ -96,7 +96,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-*/build/source/src/build ./push-test; false)
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:
@@ -110,6 +110,14 @@ jobs:
# https://github.com/netlify/cli/issues/1809
cp -r --dereference ./result ./dist
if: matrix.name == 'Nix Linux'
- name: Check manual for broken links
id: lychee
uses: lycheeverse/lychee-action@v1.9.0
with:
fail: false # report errors but do not block CI on temporary failures
# gmplib.org consistently times out from GH actions
# the GitHub token is to avoid rate limiting
args: --base './dist' --no-progress --github-token ${{ secrets.GITHUB_TOKEN }} --exclude 'gmplib.org' './dist/**/*.html'
- name: Rebuild Nix Store Cache
run: |
rm -rf nix-store-cache || true
@@ -121,7 +129,7 @@ jobs:
python3 -c 'import base64; print("alias="+base64.urlsafe_b64encode(bytes.fromhex("${{github.sha}}")).decode("utf-8").rstrip("="))' >> "$GITHUB_OUTPUT"
echo "message=`git log -1 --pretty=format:"%s"`" >> "$GITHUB_OUTPUT"
- name: Publish manual to Netlify
uses: nwtgck/actions-netlify@v3.0
uses: nwtgck/actions-netlify@v2.0
id: publish-manual
with:
publish-dir: ./dist

View File

@@ -1,25 +0,0 @@
name: Check PR body for changelog convention
on:
merge_group:
pull_request:
types: [opened, synchronize, reopened, edited, labeled, converted_to_draft, ready_for_review]
jobs:
check-pr-body:
runs-on: ubuntu-latest
steps:
- name: Check PR body
if: github.event_name == 'pull_request'
uses: actions/github-script@v7
with:
script: |
const { title, body, labels, draft } = context.payload.pull_request;
if (!draft && /^(feat|fix):/.test(title) && !labels.some(label => label.name == "changelog-no")) {
if (!labels.some(label => label.name.startsWith("changelog-"))) {
core.setFailed('feat/fix PR must have a `changelog-*` label');
}
if (!/^This PR [^<]/.test(body)) {
core.setFailed('feat/fix PR must have changelog summary starting with "This PR ..." as first line.');
}
}

View File

@@ -34,7 +34,7 @@ jobs:
- name: Download artifact from the previous workflow.
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
id: download-artifact
uses: dawidd6/action-download-artifact@v7 # https://github.com/marketplace/actions/download-workflow-artifact
uses: dawidd6/action-download-artifact@v2 # https://github.com/marketplace/actions/download-workflow-artifact
with:
run_id: ${{ github.event.workflow_run.id }}
path: artifacts
@@ -60,7 +60,7 @@ jobs:
GH_TOKEN: ${{ secrets.PR_RELEASES_TOKEN }}
- name: Release
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: softprops/action-gh-release@v2
uses: softprops/action-gh-release@v1
with:
name: Release for PR ${{ steps.workflow-info.outputs.pullRequestNumber }}
# There are coredumps files here as well, but all in deeper subdirectories.
@@ -75,7 +75,7 @@ jobs:
- name: Report release status
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v7
uses: actions/github-script@v6
with:
script: |
await github.rest.repos.createCommitStatus({
@@ -111,7 +111,7 @@ jobs:
- name: 'Setup jq'
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: dcarbone/install-jq-action@v3.0.1
uses: dcarbone/install-jq-action@v1.0.1
# Check that the most recently nightly coincides with 'git merge-base HEAD master'
- name: Check merge-base and nightly-testing-YYYY-MM-DD
@@ -134,7 +134,7 @@ jobs:
MESSAGE=""
if [[ -n "$MATHLIB_REMOTE_TAGS" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
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."
@@ -149,7 +149,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
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\`."
fi
@@ -164,10 +164,10 @@ jobs:
# Use GitHub API to check if a comment already exists
existing_comment="$(curl --retry 3 --location --silent \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments" \
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-bot"))')"
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-mathlib4-bot"))')"
existing_comment_id="$(echo "$existing_comment" | jq -r .id)"
existing_comment_body="$(echo "$existing_comment" | jq -r .body)"
@@ -177,14 +177,14 @@ jobs:
echo "Posting message to the comments: $MESSAGE"
# Append new result to the existing comment or post a new comment
# It's essential we use the MATHLIB4_COMMENT_BOT token here, so that Mathlib CI can subsequently edit the comment.
# It's essential we use the MATHLIB4_BOT token here, so that Mathlib CI can subsequently edit the comment.
if [ -z "$existing_comment_id" ]; then
INTRO="Mathlib CI status ([docs](https://leanprover-community.github.io/contribute/tags_and_branches.html)):"
# Post new comment with a bullet point
echo "Posting as new comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X POST \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg intro "$INTRO" --arg val "$MESSAGE" '{"body":($intro + "\n" + $val)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
@@ -193,7 +193,7 @@ jobs:
echo "Appending to existing comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X PATCH \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg existing "$existing_comment_body" --arg message "$MESSAGE" '{"body":($existing + "\n" + $message)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/comments/$existing_comment_id"
@@ -208,7 +208,7 @@ jobs:
- name: Report mathlib base
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true' }}
uses: actions/github-script@v7
uses: actions/github-script@v6
with:
script: |
const description =
@@ -329,18 +329,16 @@ jobs:
git switch -c lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} "$BASE"
echo "leanprover/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}" > lean-toolchain
git add lean-toolchain
sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}",' lakefile.lean
sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
lake update batteries
git add lakefile.lean lake-manifest.json
git commit -m "Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
else
echo "Branch already exists, merging $BASE and bumping Batteries."
echo "Branch already exists, pushing an empty commit."
git switch lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# The Mathlib `nightly-testing` branch or `nightly-testing-YYYY-MM-DD` tag 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
lake update batteries
git add lake-manifest.json
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi

View File

@@ -11,7 +11,7 @@ jobs:
stale:
runs-on: ubuntu-latest
steps:
- uses: actions/stale@v9
- uses: actions/stale@v8
with:
days-before-stale: -1
days-before-pr-stale: 30

14
.gitpod.Dockerfile vendored
View File

@@ -1,14 +0,0 @@
# You can find the new timestamped tags here: https://hub.docker.com/r/gitpod/workspace-full/tags
FROM gitpod/workspace-full
USER root
RUN apt-get update && apt-get install git libgmp-dev libuv1-dev cmake ccache clang -y && apt-get clean
USER gitpod
# Install and configure elan
RUN curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- -y --default-toolchain none
ENV PATH="/home/gitpod/.elan/bin:${PATH}"
# Create a dummy toolchain so that we can pre-register it with elan
RUN mkdir -p /workspace/lean4/build/release/stage1/bin && touch /workspace/lean4/build/release/stage1/bin/lean && elan toolchain link lean4 /workspace/lean4/build/release/stage1
RUN mkdir -p /workspace/lean4/build/release/stage0/bin && touch /workspace/lean4/build/release/stage0/bin/lean && elan toolchain link lean4-stage0 /workspace/lean4/build/release/stage0

View File

@@ -1,11 +0,0 @@
image:
file: .gitpod.Dockerfile
vscode:
extensions:
- leanprover.lean4
tasks:
- name: Release build
init: cmake --preset release
command: make -C build/release -j$(nproc || sysctl -n hw.logicalcpu)

View File

@@ -4,20 +4,22 @@
# Listed persons will automatically be asked by GitHub to review a PR touching these paths.
# If multiple names are listed, a review by any of them is considered sufficient by default.
/.github/ @kim-em
/RELEASES.md @kim-em
/.github/ @Kha @semorrison
/RELEASES.md @semorrison
/src/kernel/ @leodemoura
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @kim-em
/src/Lean/Elab/Tactic/ @kim-em
/src/Lean/Elab/Deriving/ @semorrison
/src/Lean/Elab/Tactic/ @semorrison
/src/Lean/Language/ @Kha
/src/Lean/Meta/Tactic/ @leodemoura
/src/Lean/PrettyPrinter/ @kmill
/src/Lean/Parser/ @Kha
/src/Lean/PrettyPrinter/ @Kha
/src/Lean/PrettyPrinter/Delaborator/ @kmill
/src/Lean/Server/ @mhuisi
/src/Lean/Widget/ @Vtec234
/src/Init/Data/ @kim-em
/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
@@ -43,4 +45,3 @@
/src/Std/ @TwoFX
/src/Std/Tactic/BVDecide/ @hargoniX
/src/Lean/Elab/Tactic/BVDecide/ @hargoniX
/src/Std/Sat/ @hargoniX

File diff suppressed because it is too large Load Diff

1
debug.log Normal file
View File

@@ -0,0 +1 @@
[0829/202002.254:ERROR:crashpad_client_win.cc(868)] not connected

View File

@@ -73,7 +73,7 @@ update the archived C source code of the stage 0 compiler in `stage0/src`.
The github repository will automatically update stage0 on `master` once
`src/stdlib_flags.h` and `stage0/src/stdlib_flags.h` are out of sync.
If you have write access to the lean4 repository, you can also manually
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>
or using Github CLI with
@@ -103,21 +103,10 @@ your PR using rebase merge, bypassing the merge queue.
As written above, changes in meta code in the current stage usually will only
affect later stages. This is an issue in two specific cases.
* For the special case of *quotations*, it is desirable to have changes in builtin parsers affect them immediately: when the changes in the parser become active in the next stage, builtin macros implemented via quotations should generate syntax trees compatible with the new parser, and quotation patterns in builtin macros and elaborators should be able to match syntax created by the new parser and macros.
Since quotations capture the syntax tree structure during execution of the current stage and turn it into code for the next stage, we need to run the current stage's builtin parsers in quotations via the interpreter for this to work.
Caveats:
* We activate this behavior by default when building stage 1 by setting `-Dinternal.parseQuotWithCurrentStage=true`.
We force-disable it inside `macro/macro_rules/elab/elab_rules` via `suppressInsideQuot` as they are guaranteed not to run in the next stage and may need to be run in the current one, so the stage 0 parser is the correct one to use for them.
It may be necessary to extend this disabling to functions that contain quotations and are (exclusively) used by one of the mentioned commands. A function using quotations should never be used by both builtin and non-builtin macros/elaborators. Example: https://github.com/leanprover/lean4/blob/f70b7e5722da6101572869d87832494e2f8534b7/src/Lean/Elab/Tactic/Config.lean#L118-L122
* The parser needs to be reachable via an `import` statement, otherwise the version of the previous stage will silently be used.
* Only the parser code (`Parser.fn`) is affected; all metadata such as leading tokens is taken from the previous stage.
For an example, see https://github.com/leanprover/lean4/commit/f9dcbbddc48ccab22c7674ba20c5f409823b4cc1#diff-371387aed38bb02bf7761084fd9460e4168ae16d1ffe5de041b47d3ad2d22422R13
* For *non-builtin* meta code such as `notation`s or `macro`s in
`Notation.lean`, we expect changes to affect the current file and all later
files of the same stage immediately, just like outside the stdlib. To ensure
this, we build stage 1 using `-Dinterpreter.prefer_native=false` -
this, we need to build the stage using `-Dinterpreter.prefer_native=false` -
otherwise, when executing a macro, the interpreter would notice that there is
already a native symbol available for this function and run it instead of the
new IR, but the symbol is from the previous stage!
@@ -135,11 +124,26 @@ affect later stages. This is an issue in two specific cases.
further stages (e.g. after an `update-stage0`) will then need to be compiled
with the flag set to `false` again since they will expect the new signature.
When enabling `prefer_native`, we usually want to *disable* `parseQuotWithCurrentStage` as it would otherwise make quotations use the interpreter after all.
However, there is a specific case where we want to set both options to `true`: when we make changes to a non-builtin parser like `simp` that has a builtin elaborator, we cannot have the new parser be active outside of quotations in stage 1 as the builtin elaborator from stage 0 would not understand them; on the other hand, we need quotations in e.g. the builtin `simp` elaborator to produce the new syntax in the next stage.
As this issue usually affects only tactics, enabling `debug.byAsSorry` instead of `prefer_native` can be a simpler solution.
For an example, see https://github.com/leanprover/lean4/commit/da4c46370d85add64ef7ca5e7cc4638b62823fbb.
For a `prefer_native` example, see https://github.com/leanprover/lean4/commit/da4c46370d85add64ef7ca5e7cc4638b62823fbb.
* For the special case of *quotations*, it is desirable to have changes in
built-in parsers affect them immediately: when the changes in the parser
become active in the next stage, macros implemented via quotations should
generate syntax trees compatible with the new parser, and quotation patterns
in macro and elaborators should be able to match syntax created by the new
parser and macros. Since quotations capture the syntax tree structure during
execution of the current stage and turn it into code for the next stage, we
need to run the current stage's built-in parsers in quotation via the
interpreter for this to work. Caveats:
* Since interpreting full parsers is not nearly as cheap and we rarely change
built-in syntax, this needs to be opted in using `-Dinternal.parseQuotWithCurrentStage=true`.
* The parser needs to be reachable via an `import` statement, otherwise the
version of the previous stage will silently be used.
* Only the parser code (`Parser.fn`) is affected; all metadata such as leading
tokens is taken from the previous stage.
For an example, see https://github.com/leanprover/lean4/commit/f9dcbbddc48ccab22c7674ba20c5f409823b4cc1#diff-371387aed38bb02bf7761084fd9460e4168ae16d1ffe5de041b47d3ad2d22422
(from before the flag defaulted to `false`).
To modify either of these flags both for building and editing the stdlib, adjust
the code in `stage0/src/stdlib_flags.h`. The flags will automatically be reset

View File

@@ -71,12 +71,6 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Verso](https://github.com/leanprover/verso)
- Dependencies: exist, but they're not part of the release workflow
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [import-graph](https://github.com/leanprover-community/import-graph)
- Toolchain bump PR including updated Lake manifest
- Create and push the tag

View File

@@ -18,7 +18,7 @@ def ctor (mvarId : MVarId) (idx : Nat) : MetaM (List MVarId) := do
else if h : idx - 1 < ctors.length then
mvarId.apply (.const ctors[idx - 1] us)
else
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} constructors"
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} contructors"
open Elab Tactic

View File

@@ -29,7 +29,7 @@ def ex3 (declName : Name) : MetaM Unit := do
for x in xs do
trace[Meta.debug] "{x} : {← inferType x}"
def myMin [LT α] [DecidableLT α] (a b : α) : α :=
def myMin [LT α] [DecidableRel (α := α) (·<·)] (a b : α) : α :=
if a < b then
a
else

View File

@@ -149,7 +149,7 @@ We now define the constant folding optimization that traverses a term if replace
/-!
The correctness of the `Term.constFold` is proved using induction, case-analysis, and the term simplifier.
We prove all cases but the one for `plus` using `simp [*]`. This tactic instructs the term simplifier to
use hypotheses such as `a = b` as rewriting/simplifications rules.
use hypotheses such as `a = b` as rewriting/simplications rules.
We use the `split` to break the nested `match` expression in the `plus` case into two cases.
The local variables `iha` and `ihb` are the induction hypotheses for `a` and `b`.
The modifier `←` in a term simplifier argument instructs the term simplifier to use the equation as a rewriting rule in

View File

@@ -12,17 +12,17 @@ Remark: this example is based on an example found in the Idris manual.
Vectors
--------
A `Vec` is a list of size `n` whose elements belong to a type `α`.
A `Vector` is a list of size `n` whose elements belong to a type `α`.
-/
inductive Vec (α : Type u) : Nat Type u
| nil : Vec α 0
| cons : α Vec α n Vec α (n+1)
inductive Vector (α : Type u) : Nat Type u
| nil : Vector α 0
| cons : α Vector α n Vector α (n+1)
/-!
We can overload the `List.cons` notation `::` and use it to create `Vec`s.
We can overload the `List.cons` notation `::` and use it to create `Vector`s.
-/
infix:67 " :: " => Vec.cons
infix:67 " :: " => Vector.cons
/-!
Now, we define the types of our simple functional language.
@@ -50,11 +50,11 @@ the builtin instance for `Add Int` as the solution.
/-!
Expressions are indexed by the types of the local variables, and the type of the expression itself.
-/
inductive HasType : Fin n Vec Ty n Ty Type where
inductive HasType : Fin n Vector Ty n Ty Type where
| stop : HasType 0 (ty :: ctx) ty
| pop : HasType k ctx ty HasType k.succ (u :: ctx) ty
inductive Expr : Vec Ty n Ty Type where
inductive Expr : Vector Ty n Ty Type where
| var : HasType i ctx ty Expr ctx ty
| val : Int Expr ctx Ty.int
| lam : Expr (a :: ctx) ty Expr ctx (Ty.fn a ty)
@@ -102,8 +102,8 @@ indexed over the types in scope. Since an environment is just another form of li
to the vector of local variable types, we overload again the notation `::` so that we can use the usual list syntax.
Given a proof that a variable is defined in the context, we can then produce a value from the environment.
-/
inductive Env : Vec Ty n Type where
| nil : Env Vec.nil
inductive Env : Vector Ty n Type where
| nil : Env Vector.nil
| cons : Ty.interp a Env ctx Env (a :: ctx)
infix:67 " :: " => Env.cons

View File

@@ -225,7 +225,7 @@ We now define the constant folding optimization that traverses a term if replace
/-!
The correctness of the `constFold` is proved using induction, case-analysis, and the term simplifier.
We prove all cases but the one for `plus` using `simp [*]`. This tactic instructs the term simplifier to
use hypotheses such as `a = b` as rewriting/simplifications rules.
use hypotheses such as `a = b` as rewriting/simplications rules.
We use the `split` to break the nested `match` expression in the `plus` case into two cases.
The local variables `iha` and `ihb` are the induction hypotheses for `a` and `b`.
The modifier `←` in a term simplifier argument instructs the term simplifier to use the equation as a rewriting rule in

View File

@@ -29,7 +29,7 @@ inductive HasType : Expr → Ty → Prop
/-!
We can easily show that if `e` has type `t₁` and type `t₂`, then `t₁` and `t₂` must be equal
by using the `cases` tactic. This tactic creates a new subgoal for every constructor,
by using the the `cases` tactic. This tactic creates a new subgoal for every constructor,
and automatically discharges unreachable cases. The tactic combinator `tac₁ <;> tac₂` applies
`tac₂` to each subgoal produced by `tac₁`. Then, the tactic `rfl` is used to close all produced
goals using reflexivity.
@@ -82,7 +82,9 @@ theorem Expr.typeCheck_correct (h₁ : HasType e ty) (h₂ : e.typeCheck ≠ .un
/-!
Now, we prove that if `Expr.typeCheck e` returns `Maybe.unknown`, then forall `ty`, `HasType e ty` does not hold.
The notation `e.typeCheck` is sugar for `Expr.typeCheck e`. Lean can infer this because we explicitly said that `e` has type `Expr`.
The proof is by induction on `e` and case analysis. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used to to rename "inaccessible" variables.
We say a variable is inaccessible if it is introduced by a tactic (e.g., `cases`) or has been shadowed by another variable introduced
by the user. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
the cases corresponding to the constructors `Expr.nat` and `Expr.bool`.
-/
theorem Expr.typeCheck_complete {e : Expr} : e.typeCheck = .unknown ¬ HasType e ty := by

View File

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

View File

@@ -93,7 +93,7 @@ Meaning "Remote Procedure Call",this is a Lean function callable from widget cod
Our method will take in the `name : Name` of a constant in the environment and return its type.
By convention, we represent the input data as a `structure`.
Since it will be sent over from JavaScript,
we need `FromJson` and `ToJson` instance.
we need `FromJson` and `ToJson` instnace.
We'll see why the position field is needed later.
-/

View File

@@ -396,7 +396,7 @@ Every expression in Lean has a natural computational interpretation, unless it i
* *β-reduction* : An expression ``(λ x, t) s`` β-reduces to ``t[s/x]``, that is, the result of replacing ``x`` by ``s`` in ``t``.
* *ζ-reduction* : An expression ``let x := s in t`` ζ-reduces to ``t[s/x]``.
* *δ-reduction* : If ``c`` is a defined constant with definition ``t``, then ``c`` δ-reduces to ``t``.
* *δ-reduction* : If ``c`` is a defined constant with definition ``t``, then ``c`` δ-reduces to to ``t``.
* *ι-reduction* : When a function defined by recursion on an inductive type is applied to an element given by an explicit constructor, the result ι-reduces to the specified function value, as described in [Inductive Types](inductive.md).
The reduction relation is transitive, which is to say, is ``s`` reduces to ``s'`` and ``t`` reduces to ``t'``, then ``s t`` reduces to ``s' t'``, ``λ x, s`` reduces to ``λ x, s'``, and so on. If ``s`` and ``t`` reduce to a common term, they are said to be *definitionally equal*. Definitional equality is defined to be the smallest equivalence relation that satisfies all these properties and also includes α-equivalence and the following two relations:

View File

@@ -128,16 +128,16 @@ Numeric literals can be specified in various bases.
```
numeral : numeral10 | numeral2 | numeral8 | numeral16
numeral10 : [0-9]+ ("_"+ [0-9]+)*
numeral2 : "0" [bB] ("_"* [0-1]+)+
numeral8 : "0" [oO] ("_"* [0-7]+)+
numeral16 : "0" [xX] ("_"* hex_char+)+
numeral10 : [0-9]+
numeral2 : "0" [bB] [0-1]+
numeral8 : "0" [oO] [0-7]+
numeral16 : "0" [xX] hex_char+
```
Floating point literals are also possible with optional exponent:
```
float : numeral10 "." numeral10? [eE[+-]numeral10]
float : [0-9]+ "." [0-9]+ [[eE[+-][0-9]+]
```
For example:
@@ -147,7 +147,6 @@ constant w : Int := 55
constant x : Nat := 26085
constant y : Nat := 0x65E5
constant z : Float := 2.548123e-05
constant b : Bool := 0b_11_01_10_00
```
Note: that negative numbers are created by applying the "-" negation prefix operator to the number, for example:

View File

@@ -1,6 +1,6 @@
These are instructions to set up a working development environment for those who wish to make changes to Lean itself. It is part of the [Development Guide](../dev/index.md).
These are instructions to set up a working development environment for those who wish to make changes to Lean itself. It is part of the [Development Guide](doc/dev/index.md).
We strongly suggest that new users instead follow the [Quickstart](../quickstart.md) to get started using Lean, since this sets up an environment that can automatically manage multiple Lean toolchain versions, which is necessary when working within the Lean ecosystem.
We strongly suggest that new users instead follow the [Quickstart](doc/quickstart.md) to get started using Lean, since this sets up an environment that can automatically manage multiple Lean toolchain versions, which is necessary when working within the Lean ecosystem.
Requirements
------------

View File

@@ -15,24 +15,17 @@ Mode](https://docs.microsoft.com/en-us/windows/apps/get-started/enable-your-devi
which will allow Lean to create symlinks that e.g. enable go-to-definition in
the stdlib.
## Installing the Windows SDK
Install the Windows SDK from [Microsoft](https://developer.microsoft.com/en-us/windows/downloads/windows-sdk/).
The oldest supported version is 10.0.18362.0. If you installed the Windows SDK to the default location,
then there should be a directory with the version number at `C:\Program Files (x86)\Windows Kits\10\Include`.
If there are multiple directories, only the highest version number matters.
## Installing dependencies
[The official webpage of MSYS2][msys2] provides one-click installers.
Once installed, you should run the "MSYS2 CLANG64" shell from the start menu (the one that runs `clang64.exe`).
Do not run "MSYS2 MSYS" or "MSYS2 MINGW64" instead!
MSYS2 has a package management system, [pacman][pacman].
Once installed, you should run the "MSYS2 MinGW 64-bit shell" from the start menu (the one that runs `mingw64.exe`).
Do not run "MSYS2 MSYS" instead!
MSYS2 has a package management system, [pacman][pacman], which is used in Arch Linux.
Here are the commands to install all dependencies needed to compile Lean on your machine.
```bash
pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
pacman -S make python mingw-w64-x86_64-cmake mingw-w64-x86_64-clang mingw-w64-x86_64-ccache mingw-w64-x86_64-libuv mingw-w64-x86_64-gmp git unzip diffutils binutils
```
You should now be able to run these commands:
@@ -68,7 +61,8 @@ If you want a version that can run independently of your MSYS install
then you need to copy the following dependent DLL's from where ever
they are installed in your MSYS setup:
- libc++.dll
- libgcc_s_seh-1.dll
- libstdc++-6.dll
- libgmp-10.dll
- libuv-1.dll
- libwinpthread-1.dll
@@ -88,6 +82,6 @@ version clang to your path.
**-bash: gcc: command not found**
Make sure `/clang64/bin` is in your PATH environment. If it is not then
check you launched the MSYS2 CLANG64 shell from the start menu.
(The one that runs `clang64.exe`).
Make sure `/mingw64/bin` is in your PATH environment. If it is not then
check you launched the MSYS2 MinGW 64-bit shell from the start menu.
(The one that runs `mingw64.exe`).

View File

@@ -138,8 +138,8 @@ definition:
-/
instance : Applicative List where
pure := List.singleton
seq f x := List.flatMap f fun y => Functor.map y (x ())
pure := List.pure
seq f x := List.bind f fun y => Functor.map y (x ())
/-!
Notice you can now sequence a _list_ of functions and a _list_ of items.

View File

@@ -128,8 +128,8 @@ Applying the identity function through an applicative structure should not chang
values or structure. For example:
-/
instance : Applicative List where
pure := List.singleton
seq f x := List.flatMap f fun y => Functor.map y (x ())
pure := List.pure
seq f x := List.bind f fun y => Functor.map y (x ())
#eval pure id <*> [1, 2, 3] -- [1, 2, 3]
/-!
@@ -171,7 +171,7 @@ of data contained in the container resulting in a new container that has the sam
`u <*> pure y = pure (. y) <*> u`.
This law is a little more complicated, so don't sweat it too much. It states that the order that
This law is is a little more complicated, so don't sweat it too much. It states that the order that
you wrap things shouldn't matter. One the left, you apply any applicative `u` over a pure wrapped
object. On the right, you first wrap a function applying the object as an argument. Note that `(·
y)` is short hand for: `fun f => f y`. Then you apply this to the first applicative `u`. These
@@ -235,8 +235,8 @@ structure or its values.
Left identity is `x >>= pure = x` and is demonstrated by the following examples on a monadic `List`:
-/
instance : Monad List where
pure := List.singleton
bind := List.flatMap
pure := List.pure
bind := List.bind
def a := ["apple", "orange"]

View File

@@ -192,8 +192,8 @@ implementation of `pure` and `bind`.
-/
instance : Monad List where
pure := List.singleton
bind := List.flatMap
pure := List.pure
bind := List.bind
/-!
Like you saw with the applicative `seq` operator, the `bind` operator applies the given function

View File

@@ -139,7 +139,7 @@ You might be wondering, how does the context actually move through the `ReaderM`
add an input argument to a function by modifying its return type? There is a special command in
Lean that will show you the reduced types:
-/
#reduce (types := true) ReaderM Environment String -- Environment → String
#reduce ReaderM Environment String -- Environment → String
/-!
And you can see here that this type is actually a function! It's a function that takes an
`Environment` as input and returns a `String`.
@@ -196,4 +196,4 @@ entirely.
Now it's time to move on to [StateM Monad](states.lean.md) which is like a `ReaderM` that is
also updatable.
-/
-/

View File

@@ -7,7 +7,7 @@ Platforms built & tested by our CI, available as binary releases via elan (see b
* x86-64 Linux with glibc 2.27+
* x86-64 macOS 10.15+
* aarch64 (Apple Silicon) macOS 10.15+
* x86-64 Windows 11 (any version), Windows 10 (version 1903 or higher), Windows Server 2022
* x86-64 Windows 10+
### Tier 2

View File

@@ -38,24 +38,8 @@
# more convenient `ctest` output
CTEST_OUTPUT_ON_FAILURE = 1;
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
GMP = (pkgsDist.gmp.override { withStatic = true; }).overrideAttrs (attrs:
pkgs.lib.optionalAttrs (pkgs.stdenv.system == "aarch64-linux") {
# would need additional linking setup on Linux aarch64, we don't use it anywhere else either
hardeningDisable = [ "stackprotector" ];
});
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: {
configureFlags = ["--enable-static"];
hardeningDisable = [ "stackprotector" ];
# Sync version with CMakeLists.txt
version = "1.48.0";
src = pkgs.fetchFromGitHub {
owner = "libuv";
repo = "libuv";
rev = "v1.48.0";
sha256 = "100nj16fg8922qg4m2hdjh62zv4p32wyrllsvqr659hdhjc03bsk";
};
doCheck = false;
});
GMP = pkgsDist.gmp.override { withStatic = true; };
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: { configureFlags = ["--enable-static"]; });
GLIBC = pkgsDist.glibc;
GLIBC_DEV = pkgsDist.glibc.dev;
GCC_LIB = pkgsDist.gcc.cc.lib;

View File

@@ -170,7 +170,7 @@ lib.warn "The Nix-based build is deprecated" rec {
ln -sf ${lean-all}/* .
'';
buildPhase = ''
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi|leanruntest_timeIO' -j$NIX_BUILD_CORES
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi' -j$NIX_BUILD_CORES
'';
installPhase = ''
mkdir $out

View File

@@ -0,0 +1,3 @@
* The `Lean` module has switched from `Lean.HashMap` and `Lean.HashSet` to `Std.HashMap` and `Std.HashSet`. `Lean.HashMap` and `Lean.HashSet` are now deprecated and will be removed in a future release. Users of `Lean` APIs that interact with hash maps, for example `Lean.Environment.const2ModIdx`, might encounter minor breakage due to the following breaking changes from `Lean.HashMap` to `Std.HashMap`:
* query functions use the term `get` instead of `find`,
* the notation `map[key]` no longer returns an optional value but expects a proof that the key is present in the map instead. The previous behavior is available via the `map[key]?` notation.

1
releases_drafts/libuv.md Normal file
View File

@@ -0,0 +1 @@
* #4963 [LibUV](https://libuv.org/) is now required to build Lean. This change only affects developers who compile Lean themselves instead of obtaining toolchains via `elan`. We have updated the official build instructions with information on how to obtain LibUV on our supported platforms.

View File

@@ -1,16 +0,0 @@
We replace the inductive predicate `List.lt` with an upstreamed version of `List.Lex` from Mathlib.
(Previously `Lex.lt` was defined in terms of `<`; now it is generalized to take an arbitrary relation.)
This subtely changes the notion of ordering on `List α`.
`List.lt` was a weaker relation: in particular if `l₁ < l₂`, then
`a :: l₁ < b :: l₂` may hold according to `List.lt` even if `a` and `b` are merely incomparable
(either neither `a < b` nor `b < a`), whereas according to `List.Lex` this would require `a = b`.
When `<` is total, in the sense that `¬ · < ·` is antisymmetric, then the two relations coincide.
Mathlib was already overriding the order instances for `List α`,
so this change should not be noticed by anyone already using Mathlib.
We simultaneously add the boolean valued `List.lex` function, parameterised by a `BEq` typeclass
and an arbitrary `lt` function. This will support the flexibility previously provided for `List.lt`,
via a `==` function which is weaker than strict equality.

View File

@@ -17,7 +17,7 @@ for f in $(git ls-files src ':!:src/lake/*' ':!:src/Leanc.lean'); do
done
# special handling for Lake files due to its nested directory
# copy the README to ensure the `stage0/src/lake` directory is committed
# copy the README to ensure the `stage0/src/lake` directory is comitted
for f in $(git ls-files 'src/lake/Lake/*' src/lake/Lake.lean src/lake/LakeMain.lean src/lake/README.md ':!:src/lakefile.toml'); do
if [[ $f == *.lean ]]; then
f=${f#src/lake}

View File

@@ -1,12 +0,0 @@
#! /bin/env bash
# Open a Mathlib4 PR for benchmarking a given Lean 4 PR
set -euo pipefail
[ $# -eq 1 ] || (echo "usage: $0 <lean4 PR #>"; exit 1)
LEAN_PR=$1
PR_RESPONSE=$(gh api repos/leanprover-community/mathlib4/pulls -X POST -f head=lean-pr-testing-$LEAN_PR -f base=nightly-testing -f title="leanprover/lean4#$LEAN_PR benchmarking" -f draft=true -f body="ignore me")
PR_NUMBER=$(echo "$PR_RESPONSE" | jq '.number')
echo "opened https://github.com/leanprover-community/mathlib4/pull/$PR_NUMBER"
gh api repos/leanprover-community/mathlib4/issues/$PR_NUMBER/comments -X POST -f body="!bench" > /dev/null

View File

@@ -48,8 +48,6 @@ $CP llvm-host/lib/*/lib{c++,c++abi,unwind}.* llvm-host/lib/
$CP -r llvm/include/*-*-* llvm-host/include/
# glibc: use for linking (so Lean programs don't embed newer symbol versions), but not for running (because libc.so, librt.so, and ld.so must be compatible)!
$CP $GLIBC/lib/libc_nonshared.a stage1/lib/glibc
# libpthread_nonshared.a must be linked in order to be able to use `pthread_atfork(3)`. LibUV uses this function.
$CP $GLIBC/lib/libpthread_nonshared.a stage1/lib/glibc
for f in $GLIBC/lib/lib{c,dl,m,rt,pthread}-*; do b=$(basename $f); cp $f stage1/lib/glibc/${b%-*}.so; done
OPTIONS=()
echo -n " -DLEAN_STANDALONE=ON"
@@ -64,8 +62,8 @@ fi
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
# but do not change sysroot so users can still link against system libs
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -Wl,--no-as-needed'"
# do not set `LEAN_CC` for tests
echo -n " -DLEAN_TEST_VARS=''"

View File

@@ -31,21 +31,15 @@ cp /clang64/lib/{crtbegin,crtend,crt2,dllcrt2}.o stage1/lib/
# runtime
(cd llvm; cp --parents lib/clang/*/lib/*/libclang_rt.builtins* ../stage1)
# further dependencies
# Note: even though we're linking against libraries like `libbcrypt.a` which appear to be static libraries from the file name,
# we're not actually linking statically against the code.
# Rather, `libbcrypt.a` is an import library (see https://en.wikipedia.org/wiki/Dynamic-link_library#Import_libraries) that just
# tells the compiler how to dynamically link against `bcrypt.dll` (which is located in the System32 folder).
# This distinction is relevant specifically for `libicu.a`/`icu.dll` because there we want updates to the time zone database to
# be delivered to users via Windows Update without having to recompile Lean or Lean programs.
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase,psapi,iphlpapi,userenv,ws2_32,dbghelp,ole32,icu}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
echo -n " -DLEAN_STANDALONE=ON"
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=1 -DCMAKE_CXX_COMPILER=$PWD/llvm/bin/clang++.exe -DCMAKE_CXX_COMPILER_WORKS=1 -DLEAN_CXX_STDLIB='-lc++ -lc++abi'"
echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual. Always link ICU dynamically.
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp -luv -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv -lucrtbase'"
# do not set `LEAN_CC` for tests
echo -n " -DAUTO_THREAD_FINALIZATION=OFF -DSTAGE0_AUTO_THREAD_FINALIZATION=OFF"
echo -n " -DLEAN_TEST_VARS=''"

View File

@@ -10,15 +10,13 @@ endif()
include(ExternalProject)
project(LEAN CXX C)
set(LEAN_VERSION_MAJOR 4)
set(LEAN_VERSION_MINOR 16)
set(LEAN_VERSION_MINOR 12)
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'")
set(LEAN_VERSION_STRING "${LEAN_VERSION_MAJOR}.${LEAN_VERSION_MINOR}.${LEAN_VERSION_PATCH}")
if (LEAN_SPECIAL_VERSION_DESC)
string(APPEND LEAN_VERSION_STRING "-${LEAN_SPECIAL_VERSION_DESC}")
elseif (NOT LEAN_VERSION_IS_RELEASE)
string(APPEND LEAN_VERSION_STRING "-pre")
endif()
set(LEAN_PLATFORM_TARGET "" CACHE STRING "LLVM triple of the target platform")
@@ -51,8 +49,6 @@ option(LLVM "LLVM" OFF)
option(USE_GITHASH "GIT_HASH" ON)
# When ON we install LICENSE files to CMAKE_INSTALL_PREFIX
option(INSTALL_LICENSE "INSTALL_LICENSE" ON)
# When ON we install a copy of cadical
option(INSTALL_CADICAL "Install a copy of cadical" ON)
# When ON thread storage is automatically finalized, it assumes platform support pthreads.
# This option is important when using Lean as library that is invoked from a different programming language (e.g., Haskell).
option(AUTO_THREAD_FINALIZATION "AUTO_THREAD_FINALIZATION" ON)
@@ -122,7 +118,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# From https://emscripten.org/docs/compiling/WebAssembly.html#backends:
# > The simple and safe thing is to pass all -s flags at both compile and link time.
set(EMSCRIPTEN_SETTINGS "-s ALLOW_MEMORY_GROWTH=1 -fwasm-exceptions -pthread -flto")
string(APPEND LEANC_EXTRA_CC_FLAGS " -pthread")
string(APPEND LEANC_EXTRA_FLAGS " -pthread")
string(APPEND LEAN_EXTRA_CXX_FLAGS " -D LEAN_EMSCRIPTEN ${EMSCRIPTEN_SETTINGS}")
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${EMSCRIPTEN_SETTINGS}")
endif()
@@ -157,11 +153,7 @@ if ((${MULTI_THREAD} MATCHES "ON") AND (${CMAKE_SYSTEM_NAME} MATCHES "Darwin"))
endif ()
# We want explicit stack probes in huge Lean stack frames for robust stack overflow detection
string(APPEND LEANC_EXTRA_CC_FLAGS " -fstack-clash-protection")
# This makes signed integer overflow guaranteed to match 2's complement.
string(APPEND CMAKE_CXX_FLAGS " -fwrapv")
string(APPEND LEANC_EXTRA_CC_FLAGS " -fwrapv")
string(APPEND LEANC_EXTRA_FLAGS " -fstack-clash-protection")
if(NOT MULTI_THREAD)
message(STATUS "Disabled multi-thread support, it will not be safe to run multiple threads in parallel")
@@ -251,77 +243,15 @@ if("${USE_GMP}" MATCHES "ON")
endif()
endif()
# LibUV
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
# Only on WebAssembly we compile LibUV ourselves
set(LIBUV_EMSCRIPTEN_FLAGS "${EMSCRIPTEN_SETTINGS}")
# LibUV does not compile on WebAssembly without modifications because
# building LibUV on a platform requires including stub implementations
# for features not present on the target platform. This patch includes
# the minimum amount of stub implementations needed for successfully
# running Lean on WebAssembly and using LibUV's temporary file support.
# It still leaves several symbols completely undefined: uv__fs_event_close,
# uv__hrtime, uv__io_check_fd, uv__io_fork, uv__io_poll, uv__platform_invalidate_fd
# uv__platform_loop_delete, uv__platform_loop_init. Making additional
# LibUV features available on WebAssembly might require adapting the
# patch to include additional LibUV source files.
set(LIBUV_PATCH_IN "
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 5e8e0166..f3b29134 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -317,6 +317,11 @@ if(CMAKE_SYSTEM_NAME STREQUAL \"GNU\")
src/unix/hurd.c)
endif()
+if(CMAKE_SYSTEM_NAME STREQUAL \"Emscripten\")
+ list(APPEND uv_sources
+ src/unix/no-proctitle.c)
+endif()
+
if(CMAKE_SYSTEM_NAME STREQUAL \"Linux\")
list(APPEND uv_defines _GNU_SOURCE _POSIX_C_SOURCE=200112)
list(APPEND uv_libraries dl rt)
")
string(REPLACE "\n" "\\n" LIBUV_PATCH ${LIBUV_PATCH_IN})
ExternalProject_add(libuv
PREFIX libuv
GIT_REPOSITORY https://github.com/libuv/libuv
# Sync version with flake.nix
GIT_TAG v1.48.0
CMAKE_ARGS -DCMAKE_BUILD_TYPE=Release -DLIBUV_BUILD_TESTS=OFF -DLIBUV_BUILD_SHARED=OFF -DCMAKE_AR=${CMAKE_AR} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -DCMAKE_POSITION_INDEPENDENT_CODE=ON -DCMAKE_C_FLAGS=${LIBUV_EMSCRIPTEN_FLAGS}
PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
BUILD_IN_SOURCE ON
INSTALL_COMMAND "")
set(LIBUV_INCLUDE_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
else()
if(NOT "${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
# LibUV
find_package(LibUV 1.0.0 REQUIRED)
include_directories(${LIBUV_INCLUDE_DIR})
endif()
include_directories(${LIBUV_INCLUDE_DIR})
if(NOT LEAN_STANDALONE)
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
endif()
# Windows SDK (for ICU)
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
# Pass 'tools' to skip MSVC version check (as MSVC/Visual Studio is not necessarily installed)
find_package(WindowsSDK REQUIRED COMPONENTS tools)
# This will give a semicolon-separated list of include directories
get_windowssdk_include_dirs(${WINDOWSSDK_LATEST_DIR} WINDOWSSDK_INCLUDE_DIRS)
# To successfully build against Windows SDK headers, the Windows SDK headers must have lower
# priority than other system headers, so use `-idirafter`. Unfortunately, CMake does not
# support this using `include_directories`.
string(REPLACE ";" "\" -idirafter \"" WINDOWSSDK_INCLUDE_DIRS "${WINDOWSSDK_INCLUDE_DIRS}")
string(APPEND CMAKE_CXX_FLAGS " -idirafter \"${WINDOWSSDK_INCLUDE_DIRS}\"")
string(APPEND LEAN_EXTRA_LINKER_FLAGS " -licu")
endif()
# ccache
if(CCACHE AND NOT CMAKE_CXX_COMPILER_LAUNCHER AND NOT CMAKE_C_COMPILER_LAUNCHER)
find_program(CCACHE_PATH ccache)
@@ -451,7 +381,7 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
endif()
string(APPEND CMAKE_CXX_FLAGS " -fPIC -ftls-model=initial-exec")
string(APPEND LEANC_EXTRA_CC_FLAGS " -fPIC")
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-rpath=\\$$ORIGIN/..:\\$$ORIGIN")
string(APPEND LAKESHARED_LINKER_FLAGS " -Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libLake.a.export -Wl,--no-whole-archive")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath=\\\$ORIGIN/../lib:\\\$ORIGIN/../lib/lean")
@@ -464,7 +394,7 @@ elseif(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
string(APPEND CMAKE_CXX_FLAGS " -fPIC")
string(APPEND LEANC_EXTRA_CC_FLAGS " -fPIC")
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
string(APPEND LAKESHARED_LINKER_FLAGS " -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libLake_shared.dll.a -Wl,--whole-archive ${CMAKE_BINARY_DIR}/lib/temp/libLake.a.export -Wl,--no-whole-archive")
endif()
@@ -479,7 +409,7 @@ if(NOT(${CMAKE_SYSTEM_NAME} MATCHES "Windows") AND NOT(${CMAKE_SYSTEM_NAME} MATC
string(APPEND CMAKE_EXE_LINKER_FLAGS " -rdynamic")
# hide all other symbols
string(APPEND CMAKE_CXX_FLAGS " -fvisibility=hidden -fvisibility-inlines-hidden")
string(APPEND LEANC_EXTRA_CC_FLAGS " -fvisibility=hidden")
string(APPEND LEANC_EXTRA_FLAGS " -fvisibility=hidden")
endif()
# On Windows, add bcrypt for random number generation
@@ -505,7 +435,7 @@ endif()
# Git HASH
if(USE_GITHASH)
include(GetGitRevisionDescription)
get_git_head_revision(GIT_REFSPEC GIT_SHA1 ALLOW_LOOKING_ABOVE_CMAKE_SOURCE_DIR)
get_git_head_revision(GIT_REFSPEC GIT_SHA1)
if(${GIT_SHA1} MATCHES "GITDIR-NOTFOUND")
message(STATUS "Failed to read git_sha1")
set(GIT_SHA1 "")
@@ -544,10 +474,9 @@ include_directories(${CMAKE_BINARY_DIR}/include) # config.h etc., "public" head
string(TOUPPER "${CMAKE_BUILD_TYPE}" uppercase_CMAKE_BUILD_TYPE)
string(APPEND LEANC_OPTS " ${CMAKE_CXX_FLAGS_${uppercase_CMAKE_BUILD_TYPE}}")
# Do embed flag for finding system headers and libraries in dev builds
# Do embed flag for finding system libraries in dev builds
if(CMAKE_OSX_SYSROOT AND NOT LEAN_STANDALONE)
string(APPEND LEANC_EXTRA_CC_FLAGS " ${CMAKE_CXX_SYSROOT_FLAG}${CMAKE_OSX_SYSROOT}")
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${CMAKE_CXX_SYSROOT_FLAG}${CMAKE_OSX_SYSROOT}")
string(APPEND LEANC_EXTRA_FLAGS " ${CMAKE_CXX_SYSROOT_FLAG}${CMAKE_OSX_SYSROOT}")
endif()
add_subdirectory(initialize)
@@ -593,10 +522,6 @@ if(${STAGE} GREATER 1)
endif()
else()
add_subdirectory(runtime)
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
add_dependencies(leanrt libuv)
add_dependencies(leanrt_initial-exec libuv)
endif()
add_subdirectory(util)
set(LEAN_OBJS ${LEAN_OBJS} $<TARGET_OBJECTS:util>)
@@ -619,7 +544,7 @@ else()
OUTPUT_NAME leancpp)
endif()
if((${STAGE} GREATER 0) AND CADICAL AND INSTALL_CADICAL)
if((${STAGE} GREATER 0) AND CADICAL)
add_custom_target(copy-cadical
COMMAND cmake -E copy_if_different "${CADICAL}" "${CMAKE_BINARY_DIR}/bin/cadical${CMAKE_EXECUTABLE_SUFFIX}")
add_dependencies(leancpp copy-cadical)
@@ -637,10 +562,7 @@ if (${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
# We set `ERROR_ON_UNDEFINED_SYMBOLS=0` because our build of LibUV does not
# define all symbols, see the comment about LibUV on WebAssembly further up
# in this file.
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1 -s ERROR_ON_UNDEFINED_SYMBOLS=0")
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
endif()
# Build the compiler using the bootstrapped C sources for stage0, and use
@@ -741,7 +663,7 @@ file(COPY ${LEAN_SOURCE_DIR}/bin/leanmake DESTINATION ${CMAKE_BINARY_DIR}/bin)
install(DIRECTORY "${CMAKE_BINARY_DIR}/bin/" USE_SOURCE_PERMISSIONS DESTINATION bin)
if (${STAGE} GREATER 0 AND CADICAL AND INSTALL_CADICAL)
if (${STAGE} GREATER 0 AND CADICAL)
install(PROGRAMS "${CADICAL}" DESTINATION bin)
endif()

View File

@@ -35,5 +35,3 @@ import Init.Ext
import Init.Omega
import Init.MacroTrace
import Init.Grind
import Init.While
import Init.Syntax

View File

@@ -40,23 +40,21 @@ theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) :
/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl
@[deprecated "Use `ite_eq_right_iff`" (since := "2024-09-18")]
-- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`.
theorem ite_some_none_eq_none [Decidable P] :
(if P then some x else none) = none ¬ P := by
simp only [ite_eq_right_iff, reduceCtorEq]
rfl
@[deprecated "Use `Option.ite_none_right_eq_some`" (since := "2024-09-18")]
theorem ite_some_none_eq_some [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
@[deprecated "Use `dite_eq_right_iff" (since := "2024-09-18")]
-- 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
@[deprecated "Use `Option.dite_none_right_eq_some`" (since := "2024-09-18")]
theorem dite_some_none_eq_some [Decidable P] {x : P α} {y : α} :
@[simp] theorem dite_some_none_eq_some [Decidable P] {x : P α} {y : α} :
(if h : P then some (x h) else none) = some y h : P, x h = y := by
by_cases h : P <;> simp [h]

View File

@@ -80,8 +80,6 @@ noncomputable scoped instance (priority := low) propDecidable (a : Prop) : Decid
noncomputable def decidableInhabited (a : Prop) : Inhabited (Decidable a) where
default := inferInstance
instance (a : Prop) : Nonempty (Decidable a) := propDecidable a
noncomputable def typeDecidableEq (α : Sort u) : DecidableEq α :=
fun _ _ => inferInstance
@@ -123,11 +121,11 @@ theorem propComplete (a : Prop) : a = True a = False :=
| Or.inl ha => Or.inl (eq_true ha)
| Or.inr hn => Or.inr (eq_false hn)
-- this supersedes byCases in Decidable
-- this supercedes byCases in Decidable
theorem byCases {p q : Prop} (hpq : p q) (hnpq : ¬p q) : q :=
Decidable.byCases (dec := propDecidable _) hpq hnpq
-- this supersedes byContradiction in Decidable
-- this supercedes byContradiction in Decidable
theorem byContradiction {p : Prop} (h : ¬p False) : p :=
Decidable.byContradiction (dec := propDecidable _) h

View File

@@ -8,42 +8,6 @@ import Init.Core
universe u v w
/--
A `ForIn'` instance, which handles `for h : x in c do`,
can also handle `for x in x do` by ignoring `h`, and so provides a `ForIn` instance.
Note that this instance will cause a potentially non-defeq duplication if both `ForIn` and `ForIn'`
instances are provided for the same type.
-/
-- We set the priority to 500 so it is below the default,
-- but still above the low priority instance from `Stream`.
instance (priority := 500) instForInOfForIn' [ForIn' m ρ α d] : ForIn m ρ α where
forIn x b f := forIn' x b fun a _ => f a
@[simp] theorem forIn'_eq_forIn [d : Membership α ρ] [ForIn' m ρ α d] {β} [Monad m] (x : ρ) (b : β)
(f : (a : α) a x β m (ForInStep β)) (g : (a : α) β m (ForInStep β))
(h : a m b, f a m b = g a b) :
forIn' x b f = forIn x b g := by
simp [instForInOfForIn']
congr
apply funext
intro a
apply funext
intro m
apply funext
intro b
simp [h]
rfl
/-- Extract the value from a `ForInStep`, ignoring whether it is `done` or `yield`. -/
def ForInStep.value (x : ForInStep α) : α :=
match x with
| ForInStep.done b => b
| ForInStep.yield b => b
@[simp] theorem ForInStep.value_done (b : β) : (ForInStep.done b).value = b := rfl
@[simp] theorem ForInStep.value_yield (b : β) : (ForInStep.yield b).value = b := rfl
@[reducible]
def Functor.mapRev {f : Type u Type v} [Functor f] {α β : Type u} : f α (α β) f β :=
fun a f => f <$> a

View File

@@ -33,10 +33,6 @@ attribute [simp] id_map
@[simp] theorem id_map' [Functor m] [LawfulFunctor m] (x : m α) : (fun a => a) <$> x = x :=
id_map x
@[simp] theorem Functor.map_map [Functor f] [LawfulFunctor f] (m : α β) (g : β γ) (x : f α) :
g <$> m <$> x = (fun a => g (m a)) <$> x :=
(comp_map _ _ _).symm
/--
The `Applicative` typeclass only contains the operations of an applicative functor.
`LawfulApplicative` further asserts that these operations satisfy the laws of an applicative functor:
@@ -87,16 +83,12 @@ class LawfulMonad (m : Type u → Type v) [Monad m] extends LawfulApplicative m
seq_assoc x g h := (by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind])
export LawfulMonad (bind_pure_comp bind_map pure_bind bind_assoc)
attribute [simp] pure_bind bind_assoc bind_pure_comp
attribute [simp] pure_bind bind_assoc
@[simp] theorem bind_pure [Monad m] [LawfulMonad m] (x : m α) : x >>= pure = x := by
show x >>= (fun a => pure (id a)) = x
rw [bind_pure_comp, id_map]
/--
Use `simp [← bind_pure_comp]` rather than `simp [map_eq_pure_bind]`,
as `bind_pure_comp` is in the default simp set, so also using `map_eq_pure_bind` would cause a loop.
-/
theorem map_eq_pure_bind [Monad m] [LawfulMonad m] (f : α β) (x : m α) : f <$> x = x >>= fun a => pure (f a) := by
rw [ bind_pure_comp]
@@ -106,7 +98,7 @@ theorem seq_eq_bind_map {α β : Type u} [Monad m] [LawfulMonad m] (f : m (α
theorem bind_congr [Bind m] {x : m α} {f g : α m β} (h : a, f a = g a) : x >>= f = x >>= g := by
simp [funext h]
theorem bind_pure_unit [Monad m] [LawfulMonad m] {x : m PUnit} : (x >>= fun _ => pure ) = x := by
@[simp] theorem bind_pure_unit [Monad m] [LawfulMonad m] {x : m PUnit} : (x >>= fun _ => pure ) = x := by
rw [bind_pure]
theorem map_congr [Functor m] {x : m α} {f g : α β} (h : a, f a = g a) : (f <$> x : m β) = g <$> x := by
@@ -117,24 +109,10 @@ theorem seq_eq_bind {α β : Type u} [Monad m] [LawfulMonad m] (mf : m (α
theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *> y = x >>= fun _ => y := by
rw [seqRight_eq]
simp only [map_eq_pure_bind, const, seq_eq_bind_map, bind_assoc, pure_bind, id_eq, bind_pure]
simp [map_eq_pure_bind, seq_eq_bind_map, const]
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]
simp only [map_eq_pure_bind, seq_eq_bind_map, bind_assoc, pure_bind, const_apply]
@[simp] theorem map_bind [Monad m] [LawfulMonad m] (f : β γ) (x : m α) (g : α m β) :
f <$> (x >>= g) = x >>= fun a => f <$> g a := by
rw [ bind_pure_comp, LawfulMonad.bind_assoc]
simp [bind_pure_comp]
@[simp] theorem bind_map_left [Monad m] [LawfulMonad m] (f : α β) (x : m α) (g : β m γ) :
((f <$> x) >>= fun b => g b) = (x >>= fun a => g (f a)) := by
rw [ bind_pure_comp]
simp only [bind_assoc, pure_bind]
theorem Functor.map_unit [Monad m] [LawfulMonad m] {a : m PUnit} : (fun _ => PUnit.unit) <$> a = a := by
simp [map]
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
/--
An alternative constructor for `LawfulMonad` which has more
@@ -183,9 +161,9 @@ end Id
instance : LawfulMonad Option := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun x _ _ => by cases x <;> rfl)
(bind_pure_comp := fun _ x => by cases x <;> rfl)
(pure_bind := fun x f => rfl)
(bind_assoc := fun x f g => by cases x <;> rfl)
(bind_pure_comp := fun f x => by cases x <;> rfl)
instance : LawfulApplicative Option := inferInstance
instance : LawfulFunctor Option := inferInstance

View File

@@ -7,7 +7,6 @@ prelude
import Init.Control.Lawful.Basic
import Init.Control.Except
import Init.Control.StateRef
import Init.Ext
open Function
@@ -15,7 +14,7 @@ open Function
namespace ExceptT
@[ext] theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
simp [run] at h
assumption
@@ -26,7 +25,7 @@ namespace ExceptT
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
simp [ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont]
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
@[simp] theorem bind_throw [Monad m] [LawfulMonad m] (f : α ExceptT ε m β) : (throw e >>= f) = throw e := by
simp [throw, throwThe, MonadExceptOf.throw, bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
@@ -44,7 +43,7 @@ theorem run_bind [Monad m] (x : ExceptT ε m α)
@[simp] theorem run_map [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α)
: (f <$> x).run = Except.map f <$> x.run := by
simp [Functor.map, ExceptT.map, bind_pure_comp]
simp [Functor.map, ExceptT.map, map_eq_pure_bind]
apply bind_congr
intro a; cases a <;> simp [Except.map]
@@ -63,7 +62,7 @@ protected theorem seqLeft_eq {α β ε : Type u} {m : Type u → Type v} [Monad
intro
| Except.error _ => simp
| Except.ok _ =>
simp [bind_pure_comp]; apply bind_congr; intro b;
simp [map_eq_pure_bind]; apply bind_congr; intro b;
cases b <;> simp [comp, Except.map, const]
protected theorem seqRight_eq [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x *> y = const α id <$> x <*> y := by
@@ -85,19 +84,14 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
pure_bind := by intros; apply ext; simp [run_bind]
bind_assoc := by intros; apply ext; simp [run_bind]; apply bind_congr; intro a; cases a <;> simp
@[simp] theorem map_throw [Monad m] [LawfulMonad m] {α β : Type _} (f : α β) (e : ε) :
f <$> (throw e : ExceptT ε m α) = (throw e : ExceptT ε m β) := by
simp only [ExceptT.instMonad, ExceptT.map, ExceptT.mk, throw, throwThe, MonadExceptOf.throw,
pure_bind]
end ExceptT
/-! # Except -/
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun a _ _ => by cases a <;> rfl)
(pure_bind := fun a f => rfl)
(bind_assoc := fun a f g => by cases a <;> rfl)
instance : LawfulApplicative (Except ε) := inferInstance
instance : LawfulFunctor (Except ε) := inferInstance
@@ -106,7 +100,7 @@ instance : LawfulFunctor (Except ε) := inferInstance
namespace ReaderT
@[ext] theorem ext {x y : ReaderT ρ m α} (h : ctx, x.run ctx = y.run ctx) : x = y := by
theorem ext {x y : ReaderT ρ m α} (h : ctx, x.run ctx = y.run ctx) : x = y := by
simp [run] at h
exact funext h
@@ -168,7 +162,7 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateRefT' ω σ m) :=
namespace StateT
@[ext] theorem ext {x y : StateT σ m α} (h : s, x.run s = y.run s) : x = y :=
theorem ext {x y : StateT σ m α} (h : s, x.run s = y.run s) : x = y :=
funext h
@[simp] theorem run'_eq [Monad m] (x : StateT σ m α) (s : σ) : run' x s = (·.1) <$> run x s :=
@@ -181,7 +175,7 @@ namespace StateT
simp [bind, StateT.bind, run]
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
simp [Functor.map, StateT.map, run, bind_pure_comp]
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
@@ -216,13 +210,13 @@ theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f :
theorem seqRight_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x *> y = const α id <$> x <*> y := by
apply ext; intro s
simp [bind_pure_comp, const]
simp [map_eq_pure_bind, const]
apply bind_congr; intro p; cases p
simp [Prod.eta]
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
apply ext; intro s
simp [bind_pure_comp]
simp [map_eq_pure_bind]
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
id_map := by intros; apply ext; intros; simp[Prod.eta]
@@ -230,7 +224,7 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
seqLeft_eq := seqLeft_eq
seqRight_eq := seqRight_eq
pure_seq := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp; apply LawfulMonad.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp

View File

@@ -6,7 +6,8 @@ Authors: Leonardo de Moura, Sebastian Ullrich
The State monad transformer using IO references.
-/
prelude
import Init.System.ST
import Init.System.IO
import Init.Control.State
def StateRefT' (ω : Type) (σ : Type) (m : Type Type) (α : Type) : Type := ReaderT (ST.Ref ω σ) m α

View File

@@ -7,7 +7,6 @@ Notation for operators defined at Prelude.lean
-/
prelude
import Init.Tactics
import Init.Meta
namespace Lean.Parser.Tactic.Conv
@@ -47,20 +46,12 @@ scoped syntax (name := withAnnotateState)
/-- `skip` does nothing. -/
syntax (name := skip) "skip" : conv
/--
Traverses into the left subterm of a binary operator.
In general, for an `n`-ary operator, it traverses into the second to last argument.
It is a synonym for `arg -2`.
-/
/-- Traverses into the left subterm of a binary operator.
(In general, for an `n`-ary operator, it traverses into the second to last argument.) -/
syntax (name := lhs) "lhs" : conv
/--
Traverses into the right subterm of a binary operator.
In general, for an `n`-ary operator, it traverses into the last argument.
It is a synonym for `arg -1`.
-/
/-- Traverses into the right subterm of a binary operator.
(In general, for an `n`-ary operator, it traverses into the last argument.) -/
syntax (name := rhs) "rhs" : conv
/-- Traverses into the function of a (unary) function application.
@@ -83,17 +74,13 @@ subgoals for all the function arguments. For example, if the target is `f x y` t
`congr` produces two subgoals, one for `x` and one for `y`. -/
syntax (name := congr) "congr" : conv
syntax argArg := "@"? "-"? num
/--
* `arg i` traverses into the `i`'th argument of the target. For example if the
target is `f a b c d` then `arg 1` traverses to `a` and `arg 3` traverses to `c`.
The index may be negative; `arg -1` traverses into the last argument,
`arg -2` into the second-to-last argument, and so on.
* `arg @i` is the same as `arg i` but it counts all arguments instead of just the
explicit arguments.
* `arg 0` traverses into the function. If the target is `f a b c d`, `arg 0` traverses into `f`. -/
syntax (name := arg) "arg " argArg : conv
syntax (name := arg) "arg " "@"? num : conv
/-- `ext x` traverses into a binder (a `fun x => e` or `∀ x, e` expression)
to target `e`, introducing name `x` in the process. -/
@@ -143,11 +130,11 @@ For example, if we are searching for `f _` in `f (f a) = f b`:
syntax (name := pattern) "pattern " (occs)? term : conv
/-- `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. -/
syntax (name := rewrite) "rewrite" optConfig rwRuleSeq : conv
syntax (name := rewrite) "rewrite" (config)? rwRuleSeq : conv
/-- `simp [thm]` performs simplification using `thm` and marked `@[simp]` lemmas.
See the `simp` tactic for more information. -/
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
syntax (name := simp) "simp" (config)? (discharger)? (&" only")?
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
/--
@@ -164,7 +151,7 @@ example (a : Nat): (0 + 0) = a - a := by
rw [← Nat.sub_self a]
```
-/
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
syntax (name := dsimp) "dsimp" (config)? (discharger)? (&" only")?
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
/-- `simp_match` simplifies match expressions. For example,
@@ -260,12 +247,12 @@ macro (name := failIfSuccess) tk:"fail_if_success " s:convSeq : conv =>
/-- `rw [rules]` applies the given list of rewrite rules to the target.
See the `rw` tactic for more information. -/
macro "rw" c:optConfig s:rwRuleSeq : conv => `(conv| rewrite $c:optConfig $s)
macro "rw" c:(config)? s:rwRuleSeq : conv => `(conv| rewrite $[$c]? $s)
/-- `erw [rules]` is a shorthand for `rw (transparency := .default) [rules]`.
/-- `erw [rules]` is a shorthand for `rw (config := { transparency := .default }) [rules]`.
This does rewriting up to unfolding of regular definitions (by comparison to regular `rw`
which only unfolds `@[reducible]` definitions). -/
macro "erw" c:optConfig s:rwRuleSeq : conv => `(conv| rw $[$(getConfigItems c)]* (transparency := .default) $s:rwRuleSeq)
macro "erw" s:rwRuleSeq : conv => `(conv| rw (config := { transparency := .default }) $s)
/-- `args` traverses into all arguments. Synonym for `congr`. -/
macro "args" : conv => `(conv| congr)
@@ -276,7 +263,7 @@ macro "right" : conv => `(conv| rhs)
/-- `intro` traverses into binders. Synonym for `ext`. -/
macro "intro" xs:(ppSpace colGt ident)* : conv => `(conv| ext $xs*)
syntax enterArg := ident <|> argArg
syntax enterArg := ident <|> ("@"? num)
/-- `enter [arg, ...]` is a compact way to describe a path to a subterm.
It is a shorthand for other conv tactics as follows:
@@ -285,7 +272,12 @@ It is a shorthand for other conv tactics as follows:
* `enter [x]` (where `x` is an identifier) is equivalent to `ext x`.
For example, given the target `f (g a (fun x => x b))`, `enter [1, 2, x, 1]`
will traverse to the subterm `b`. -/
syntax (name := enter) "enter" " [" withoutPosition(enterArg,+) "]" : conv
syntax "enter" " [" withoutPosition(enterArg,+) "]" : conv
macro_rules
| `(conv| enter [$i:num]) => `(conv| arg $i)
| `(conv| enter [@$i]) => `(conv| arg @$i)
| `(conv| enter [$id:ident]) => `(conv| ext $id)
| `(conv| enter [$arg, $args,*]) => `(conv| (enter [$arg]; enter [$args,*]))
/-- The `apply thm` conv tactic is the same as `apply thm` the tactic.
There are no restrictions on `thm`, but strange results may occur if `thm`

View File

@@ -324,6 +324,7 @@ class ForIn' (m : Type u₁ → Type u₂) (ρ : Type u) (α : outParam (Type v)
export ForIn' (forIn')
/--
Auxiliary type used to compile `do` notation. It is used when compiling a do block
nested inside a combinator like `tryCatch`. It encodes the possible ways the
@@ -822,9 +823,6 @@ theorem iff_iff_implies_and_implies {a b : Prop} : (a ↔ b) ↔ (a → b) ∧ (
protected theorem Iff.rfl {a : Prop} : a a :=
Iff.refl a
-- And, also for backward compatibility, we try `Iff.rfl.` using `exact` (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
theorem Iff.of_eq (h : a = b) : a b := h Iff.rfl
theorem Iff.trans (h₁ : a b) (h₂ : b c) : a c :=
@@ -837,9 +835,6 @@ instance : Trans Iff Iff Iff where
theorem Eq.comm {a b : α} : a = b b = a := Iff.intro Eq.symm Eq.symm
theorem eq_comm {a b : α} : a = b b = a := Eq.comm
theorem HEq.comm {a : α} {b : β} : HEq a b HEq b a := Iff.intro HEq.symm HEq.symm
theorem heq_comm {a : α} {b : β} : HEq a b HEq b a := HEq.comm
@[symm] theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.comm: (a b) (b a) := Iff.intro Iff.symm Iff.symm
theorem iff_comm : (a b) (b a) := Iff.comm
@@ -861,21 +856,16 @@ theorem Exists.elim {α : Sort u} {p : α → Prop} {b : Prop}
/-! # Decidable -/
@[simp] theorem decide_true (h : Decidable True) : @decide True h = true :=
theorem decide_true_eq_true (h : Decidable True) : @decide True h = true :=
match h with
| isTrue _ => rfl
| isFalse h => False.elim <| h
@[simp] theorem decide_false (h : Decidable False) : @decide False h = false :=
theorem decide_false_eq_false (h : Decidable False) : @decide False h = false :=
match h with
| isFalse _ => rfl
| isTrue h => False.elim h
set_option linter.missingDocs false in
@[deprecated decide_true (since := "2024-11-05")] abbrev decide_true_eq_true := decide_true
set_option linter.missingDocs false in
@[deprecated decide_false (since := "2024-11-05")] abbrev decide_false_eq_false := decide_false
/-- Similar to `decide`, but uses an explicit instance -/
@[inline] def toBoolUsing {p : Prop} (d : Decidable p) : Bool :=
decide (h := d)
@@ -1201,21 +1191,6 @@ end
/-! # Product -/
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (α × β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
(x, y)
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (MProd α β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
x, y
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (PProd α β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
x, y
instance [Inhabited α] [Inhabited β] : Inhabited (α × β) where
default := (default, default)
@@ -1389,7 +1364,6 @@ gen_injective_theorems% Except
gen_injective_theorems% EStateM.Result
gen_injective_theorems% Lean.Name
gen_injective_theorems% Lean.Syntax
gen_injective_theorems% BitVec
theorem Nat.succ.inj {m n : Nat} : m.succ = n.succ m = n :=
fun x => Nat.noConfusion x id
@@ -1869,8 +1843,7 @@ section
variable {α : Type u}
variable (r : α α Prop)
instance Quotient.decidableEq {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)]
: DecidableEq (Quotient s) :=
instance {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)] : DecidableEq (Quotient s) :=
fun (q₁ q₂ : Quotient s) =>
Quotient.recOnSubsingleton₂ q₁ q₂
fun a₁ a₂ =>
@@ -1902,8 +1875,7 @@ theorem funext {α : Sort u} {β : α → Sort v} {f g : (x : α) → β x}
show extfunApp (Quot.mk eqv f) = extfunApp (Quot.mk eqv g)
exact congrArg extfunApp (Quot.sound h)
instance Pi.instSubsingleton {α : Sort u} {β : α Sort v} [ a, Subsingleton (β a)] :
Subsingleton ( a, β a) where
instance {α : Sort u} {β : α Sort v} [ a, Subsingleton (β a)] : Subsingleton ( a, β a) where
allEq f g := funext fun a => Subsingleton.elim (f a) (g a)
/-! # Squash -/
@@ -1922,12 +1894,12 @@ represents an element of `Squash α` the same as `α` itself
`Squash.lift` will extract a value in any subsingleton `β` from a function on `α`,
while `Nonempty.rec` can only do the same when `β` is a proposition.
-/
def Squash (α : Sort u) := Quot (fun (_ _ : α) => True)
def Squash (α : Type u) := Quot (fun (_ _ : α) => True)
/-- The canonical quotient map into `Squash α`. -/
def Squash.mk {α : Sort u} (x : α) : Squash α := Quot.mk _ x
def Squash.mk {α : Type u} (x : α) : Squash α := Quot.mk _ x
theorem Squash.ind {α : Sort u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
theorem Squash.ind {α : Type u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
Quot.ind h
/-- If `β` is a subsingleton, then a function `α → β` lifts to `Squash α → β`. -/
@@ -1941,6 +1913,15 @@ instance : Subsingleton (Squash α) where
apply Quot.sound
trivial
/-! # Relations -/
/--
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
-/
class Antisymm {α : Sort u} (r : α α Prop) : Prop where
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
antisymm {a b : α} : r a b r b a a = b
namespace Lean
/-! # Kernel reduction hints -/
@@ -2057,7 +2038,7 @@ class IdempotentOp (op : ααα) : Prop where
`LeftIdentify op o` indicates `o` is a left identity of `op`.
This class does not require a proof that `o` is an identity, and
is used primarily for inferring the identity using class resolution.
is used primarily for infering the identity using class resoluton.
-/
class LeftIdentity (op : α β β) (o : outParam α) : Prop
@@ -2073,7 +2054,7 @@ class LawfulLeftIdentity (op : α → β → β) (o : outParam α) extends LeftI
`RightIdentify op o` indicates `o` is a right identity `o` of `op`.
This class does not require a proof that `o` is an identity, and is used
primarily for inferring the identity using class resolution.
primarily for infering the identity using class resoluton.
-/
class RightIdentity (op : α β α) (o : outParam β) : Prop
@@ -2089,7 +2070,7 @@ class LawfulRightIdentity (op : α → β → α) (o : outParam β) extends Righ
`Identity op o` indicates `o` is a left and right identity of `op`.
This class does not require a proof that `o` is an identity, and is used
primarily for inferring the identity using class resolution.
primarily for infering the identity using class resoluton.
-/
class Identity (op : α α α) (o : outParam α) extends LeftIdentity op o, RightIdentity op o : Prop
@@ -2116,37 +2097,4 @@ instance : Commutative Or := ⟨fun _ _ => propext or_comm⟩
instance : Commutative And := fun _ _ => propext and_comm
instance : Commutative Iff := fun _ _ => propext iff_comm
/-- `IsRefl X r` means the binary relation `r` on `X` is reflexive. -/
class Refl (r : α α Prop) : Prop where
/-- A reflexive relation satisfies `r a a`. -/
refl : a, r a a
/--
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
-/
class Antisymm (r : α α Prop) : Prop where
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
antisymm (a b : α) : r a b r b a a = b
@[deprecated Antisymm (since := "2024-10-16"), inherit_doc Antisymm]
abbrev _root_.Antisymm (r : α α Prop) : Prop := Std.Antisymm r
/-- `Asymm X r` means that the binary relation `r` on `X` is asymmetric, that is,
`r a b → ¬ r b a`. -/
class Asymm (r : α α Prop) : Prop where
/-- An asymmetric relation satisfies `r a b → ¬ r b a`. -/
asymm : a b, r a b ¬r b a
/-- `Total X r` means that the binary relation `r` on `X` is total, that is, that for any
`x y : X` we have `r x y` or `r y x`. -/
class Total (r : α α Prop) : Prop where
/-- A total relation satisfies `r a b r b a`. -/
total : a b, r a b r b a
/-- `Irrefl X r` means the binary relation `r` on `X` is irreflexive (that is, `r x x` never
holds). -/
class Irrefl (r : α α Prop) : Prop where
/-- An irreflexive relation satisfies `¬ r a a`. -/
irrefl : a, ¬r a a
end Std

View File

@@ -19,9 +19,7 @@ import Init.Data.ByteArray
import Init.Data.FloatArray
import Init.Data.Fin
import Init.Data.UInt
import Init.Data.SInt
import Init.Data.Float
import Init.Data.Float32
import Init.Data.Option
import Init.Data.Ord
import Init.Data.Random
@@ -35,6 +33,7 @@ import Init.Data.Prod
import Init.Data.AC
import Init.Data.Queue
import Init.Data.Channel
import Init.Data.Cast
import Init.Data.Sum
import Init.Data.BEq
import Init.Data.Subtype
@@ -42,6 +41,3 @@ import Init.Data.ULift
import Init.Data.PLift
import Init.Data.Zero
import Init.Data.NeZero
import Init.Data.Function
import Init.Data.RArray
import Init.Data.Vector

View File

@@ -15,11 +15,3 @@ import Init.Data.Array.BasicAux
import Init.Data.Array.Lemmas
import Init.Data.Array.TakeDrop
import Init.Data.Array.Bootstrap
import Init.Data.Array.GetLit
import Init.Data.Array.MapIdx
import Init.Data.Array.Set
import Init.Data.Array.Monadic
import Init.Data.Array.FinRange
import Init.Data.Array.Perm
import Init.Data.Array.Find
import Init.Data.Array.Lex

View File

@@ -5,22 +5,10 @@ Authors: Joachim Breitner, Mario Carneiro
-/
prelude
import Init.Data.Array.Mem
import Init.Data.Array.Lemmas
import Init.Data.List.Attach
namespace Array
/--
`O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on
`a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l`
but is defined only when all members of `l` satisfy `P`, using the proof
to apply `f`.
We replace this at runtime with a more efficient version via the `csimp` lemma `pmap_eq_pmapImpl`.
-/
def pmap {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) : Array β :=
(l.toList.pmap f (fun a m => H a (mem_def.mpr m))).toArray
/--
Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
`Array {x // P x}` is the same as the input `Array α`.
@@ -38,544 +26,4 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
with the same elements but in the type `{x // x ∈ xs}`. -/
@[inline] def attach (xs : Array α) : Array {x // x xs} := xs.attachWith _ fun _ => id
@[simp] theorem _root_.List.attachWith_toArray {l : List α} {P : α Prop} {H : x l.toArray, P x} :
l.toArray.attachWith P H = (l.attachWith P (by simpa using H)).toArray := by
simp [attachWith]
@[simp] theorem _root_.List.attach_toArray {l : List α} :
l.toArray.attach = (l.attachWith (· l.toArray) (by simp)).toArray := by
simp [attach]
@[simp] theorem _root_.List.pmap_toArray {l : List α} {P : α Prop} {f : a, P a β} {H : a l.toArray, P a} :
l.toArray.pmap f H = (l.pmap f (by simpa using H)).toArray := by
simp [pmap]
@[simp] theorem toList_attachWith {l : Array α} {P : α Prop} {H : x l, P x} :
(l.attachWith P H).toList = l.toList.attachWith P (by simpa [mem_toList] using H) := by
simp [attachWith]
@[simp] theorem toList_attach {α : Type _} {l : Array α} :
l.attach.toList = l.toList.attachWith (· l) (by simp [mem_toList]) := by
simp [attach]
@[simp] theorem toList_pmap {l : Array α} {P : α Prop} {f : a, P a β} {H : a l, P a} :
(l.pmap f H).toList = l.toList.pmap f (fun a m => H a (mem_def.mpr m)) := by
simp [pmap]
/-- Implementation of `pmap` using the zero-copy version of `attach`. -/
@[inline] private def pmapImpl {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) :
Array β := (l.attachWith _ H).map fun x, h' => f x h'
@[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by
funext α β p f L h'
cases L
simp only [pmap, pmapImpl, List.attachWith_toArray, List.map_toArray, mk.injEq, List.map_attachWith]
apply List.pmap_congr_left
intro a m h₁ h₂
congr
@[simp] theorem pmap_empty {P : α Prop} (f : a, P a β) : pmap f #[] (by simp) = #[] := rfl
@[simp] theorem pmap_push {P : α Prop} (f : a, P a β) (a : α) (l : Array α) (h : b l.push a, P b) :
pmap f (l.push a) h =
(pmap f l (fun a m => by simp at h; exact h a (.inl m))).push (f a (h a (by simp))) := by
simp [pmap]
@[simp] theorem attach_empty : (#[] : Array α).attach = #[] := rfl
@[simp] theorem attachWith_empty {P : α Prop} (H : x #[], P x) : (#[] : Array α).attachWith P H = #[] := rfl
@[simp] theorem _root_.List.attachWith_mem_toArray {l : List α} :
l.attachWith (fun x => x l.toArray) (fun x h => by simpa using h) =
l.attach.map fun x, h => x, by simpa using h := by
simp only [List.attachWith, List.attach, List.map_pmap]
apply List.pmap_congr_left
simp
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (l : Array α) (H) :
@pmap _ _ p (fun a _ => f a) l H = map f l := by
cases l; simp
theorem pmap_congr_left {p q : α Prop} {f : a, p a β} {g : a, q a β} (l : Array α) {H₁ H₂}
(h : a l, (h₁ h₂), f a h₁ = g a h₂) : pmap f l H₁ = pmap g l H₂ := by
cases l
simp only [mem_toArray] at h
simp only [List.pmap_toArray, mk.injEq]
rw [List.pmap_congr_left _ h]
theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (l H) :
map g (pmap f l H) = pmap (fun a h => g (f a h)) l H := by
cases l
simp [List.map_pmap]
theorem pmap_map {p : β Prop} (g : b, p b γ) (f : α β) (l H) :
pmap g (map f l) H = pmap (fun a h => g (f a) h) l fun _ h => H _ (mem_map_of_mem _ h) := by
cases l
simp [List.pmap_map]
theorem attach_congr {l₁ l₂ : Array α} (h : l₁ = l₂) :
l₁.attach = l₂.attach.map (fun x => x.1, h x.2) := by
subst h
simp
theorem attachWith_congr {l₁ l₂ : Array α} (w : l₁ = l₂) {P : α Prop} {H : x l₁, P x} :
l₁.attachWith P H = l₂.attachWith P fun _ h => H _ (w h) := by
subst w
simp
@[simp] theorem attach_push {a : α} {l : Array α} :
(l.push a).attach =
(l.attach.map (fun x, h => x, mem_push_of_mem a h)).push a, by simp := by
cases l
rw [attach_congr (List.push_toArray _ _)]
simp [Function.comp_def]
@[simp] theorem attachWith_push {a : α} {l : Array α} {P : α Prop} {H : x l.push a, P x} :
(l.push a).attachWith P H =
(l.attachWith P (fun x h => by simp at H; exact H x (.inl h))).push a, H a (by simp) := by
cases l
simp [attachWith_congr (List.push_toArray _ _)]
theorem pmap_eq_map_attach {p : α Prop} (f : a, p a β) (l H) :
pmap f l H = l.attach.map fun x => f x.1 (H _ x.2) := by
cases l
simp [List.pmap_eq_map_attach]
theorem attach_map_coe (l : Array α) (f : α β) :
(l.attach.map fun (i : {i // i l}) => f i) = l.map f := by
cases l
simp [List.attach_map_coe]
theorem attach_map_val (l : Array α) (f : α β) : (l.attach.map fun i => f i.val) = l.map f :=
attach_map_coe _ _
theorem attach_map_subtype_val (l : Array α) : l.attach.map Subtype.val = l := by
cases l; simp
theorem attachWith_map_coe {p : α Prop} (f : α β) (l : Array α) (H : a l, p a) :
((l.attachWith p H).map fun (i : { i // p i}) => f i) = l.map f := by
cases l; simp
theorem attachWith_map_val {p : α Prop} (f : α β) (l : Array α) (H : a l, p a) :
((l.attachWith p H).map fun i => f i.val) = l.map f :=
attachWith_map_coe _ _ _
theorem attachWith_map_subtype_val {p : α Prop} (l : Array α) (H : a l, p a) :
(l.attachWith p H).map Subtype.val = l := by
cases l; simp
@[simp]
theorem mem_attach (l : Array α) : x, x l.attach
| a, h => by
have := mem_map.1 (by rw [attach_map_subtype_val] <;> exact h)
rcases this with _, _, m, rfl
exact m
@[simp]
theorem mem_pmap {p : α Prop} {f : a, p a β} {l H b} :
b pmap f l H (a : _) (h : a l), f a (H a h) = b := by
simp only [pmap_eq_map_attach, mem_map, mem_attach, true_and, Subtype.exists, eq_comm]
theorem mem_pmap_of_mem {p : α Prop} {f : a, p a β} {l H} {a} (h : a l) :
f a (H a h) pmap f l H := by
rw [mem_pmap]
exact a, h, rfl
@[simp]
theorem size_pmap {p : α Prop} {f : a, p a β} {l H} : (pmap f l H).size = l.size := by
cases l; simp
@[simp]
theorem size_attach {L : Array α} : L.attach.size = L.size := by
cases L; simp
@[simp]
theorem size_attachWith {p : α Prop} {l : Array α} {H} : (l.attachWith p H).size = l.size := by
cases l; simp
@[simp]
theorem pmap_eq_empty_iff {p : α Prop} {f : a, p a β} {l H} : pmap f l H = #[] l = #[] := by
cases l; simp
theorem pmap_ne_empty_iff {P : α Prop} (f : (a : α) P a β) {xs : Array α}
(H : (a : α), a xs P a) : xs.pmap f H #[] xs #[] := by
cases xs; simp
theorem pmap_eq_self {l : Array α} {p : α Prop} {hp : (a : α), a l p a}
{f : (a : α) p a α} : l.pmap f hp = l a (h : a l), f a (hp a h) = a := by
cases l; simp [List.pmap_eq_self]
@[simp]
theorem attach_eq_empty_iff {l : Array α} : l.attach = #[] l = #[] := by
cases l; simp
theorem attach_ne_empty_iff {l : Array α} : l.attach #[] l #[] := by
cases l; simp
@[simp]
theorem attachWith_eq_empty_iff {l : Array α} {P : α Prop} {H : a l, P a} :
l.attachWith P H = #[] l = #[] := by
cases l; simp
theorem attachWith_ne_empty_iff {l : Array α} {P : α Prop} {H : a l, P a} :
l.attachWith P H #[] l #[] := by
cases l; simp
@[simp]
theorem getElem?_pmap {p : α Prop} (f : a, p a β) {l : Array α} (h : a l, p a) (n : Nat) :
(pmap f l h)[n]? = Option.pmap f l[n]? fun x H => h x (mem_of_getElem? H) := by
cases l; simp
@[simp]
theorem getElem_pmap {p : α Prop} (f : a, p a β) {l : Array α} (h : a l, p a) {n : Nat}
(hn : n < (pmap f l h).size) :
(pmap f l h)[n] =
f (l[n]'(@size_pmap _ _ p f l h hn))
(h _ (getElem_mem (@size_pmap _ _ p f l h hn))) := by
cases l; simp
@[simp]
theorem getElem?_attachWith {xs : Array α} {i : Nat} {P : α Prop} {H : a xs, P a} :
(xs.attachWith P H)[i]? = xs[i]?.pmap Subtype.mk (fun _ a => H _ (mem_of_getElem? a)) :=
getElem?_pmap ..
@[simp]
theorem getElem?_attach {xs : Array α} {i : Nat} :
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => mem_of_getElem? a) :=
getElem?_attachWith
@[simp]
theorem getElem_attachWith {xs : Array α} {P : α Prop} {H : a xs, P a}
{i : Nat} (h : i < (xs.attachWith P H).size) :
(xs.attachWith P H)[i] = xs[i]'(by simpa using h), H _ (getElem_mem (by simpa using h)) :=
getElem_pmap _ _ h
@[simp]
theorem getElem_attach {xs : Array α} {i : Nat} (h : i < xs.attach.size) :
xs.attach[i] = xs[i]'(by simpa using h), getElem_mem (by simpa using h) :=
getElem_attachWith h
theorem foldl_pmap (l : Array α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : γ β γ) (x : γ) :
(l.pmap f H).foldl g x = l.attach.foldl (fun acc a => g acc (f a.1 (H _ a.2))) x := by
rw [pmap_eq_map_attach, foldl_map]
theorem foldr_pmap (l : Array α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : β γ γ) (x : γ) :
(l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
rw [pmap_eq_map_attach, foldr_map]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldl_subtype` below.
-/
theorem foldl_attach (l : Array α) (f : β α β) (b : β) :
l.attach.foldl (fun acc t => f acc t.1) b = l.foldl f b := by
rcases l with l
simp only [List.attach_toArray, List.attachWith_mem_toArray, List.map_attach, size_toArray,
List.length_pmap, List.foldl_toArray', mem_toArray, List.foldl_subtype]
congr
ext
simpa using fun a => List.mem_of_getElem? a
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldr_subtype` below.
-/
theorem foldr_attach (l : Array α) (f : α β β) (b : β) :
l.attach.foldr (fun t acc => f t.1 acc) b = l.foldr f b := by
rcases l with l
simp only [List.attach_toArray, List.attachWith_mem_toArray, List.map_attach, size_toArray,
List.length_pmap, List.foldr_toArray', mem_toArray, List.foldr_subtype]
congr
ext
simpa using fun a => List.mem_of_getElem? a
theorem attach_map {l : Array α} (f : α β) :
(l.map f).attach = l.attach.map (fun x, h => f x, mem_map_of_mem f h) := by
cases l
ext <;> simp
theorem attachWith_map {l : Array α} (f : α β) {P : β Prop} {H : (b : β), b l.map f P b} :
(l.map f).attachWith P H = (l.attachWith (P f) (fun _ h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
cases l
ext
· simp
· simp only [List.map_toArray, List.attachWith_toArray, List.getElem_toArray,
List.getElem_attachWith, List.getElem_map, Function.comp_apply]
erw [List.getElem_attachWith] -- Why is `erw` needed here?
theorem map_attachWith {l : Array α} {P : α Prop} {H : (a : α), a l P a}
(f : { x // P x } β) :
(l.attachWith P H).map f =
l.pmap (fun a (h : a l P a) => f a, H _ h.1) (fun a h => h, H a h) := by
cases l
ext <;> simp
/-- See also `pmap_eq_map_attach` for writing `pmap` in terms of `map` and `attach`. -/
theorem map_attach {l : Array α} (f : { x // x l } β) :
l.attach.map f = l.pmap (fun a h => f a, h) (fun _ => id) := by
cases l
ext <;> simp
theorem attach_filterMap {l : Array α} {f : α Option β} :
(l.filterMap f).attach = l.attach.filterMap
fun x, h => (f x).pbind (fun b m => some b, mem_filterMap.mpr x, h, m) := by
cases l
rw [attach_congr (List.filterMap_toArray f _)]
simp [List.attach_filterMap, List.map_filterMap, Function.comp_def]
theorem attach_filter {l : Array α} (p : α Bool) :
(l.filter p).attach = l.attach.filterMap
fun x => if w : p x.1 then some x.1, mem_filter.mpr x.2, w else none := by
cases l
rw [attach_congr (List.filter_toArray p _)]
simp [List.attach_filter, List.map_filterMap, Function.comp_def]
-- We are still missing here `attachWith_filterMap` and `attachWith_filter`.
-- Also missing are `filterMap_attach`, `filter_attach`, `filterMap_attachWith` and `filter_attachWith`.
theorem pmap_pmap {p : α Prop} {q : β Prop} (g : a, p a β) (f : b, q b γ) (l H₁ H₂) :
pmap f (pmap g l H₁) H₂ =
pmap (α := { x // x l }) (fun a h => f (g a h) (H₂ (g a h) (mem_pmap_of_mem a.2))) l.attach
(fun a _ => H₁ a a.2) := by
cases l
simp [List.pmap_pmap, List.pmap_map]
@[simp] theorem pmap_append {p : ι Prop} (f : a : ι, p a α) (l₁ l₂ : Array ι)
(h : a l₁ ++ l₂, p a) :
(l₁ ++ l₂).pmap f h =
(l₁.pmap f fun a ha => h a (mem_append_left l₂ ha)) ++
l₂.pmap f fun a ha => h a (mem_append_right l₁ ha) := by
cases l₁
cases l₂
simp
theorem pmap_append' {p : α Prop} (f : a : α, p a β) (l₁ l₂ : Array α)
(h₁ : a l₁, p a) (h₂ : a l₂, p a) :
((l₁ ++ l₂).pmap f fun a ha => (mem_append.1 ha).elim (h₁ a) (h₂ a)) =
l₁.pmap f h₁ ++ l₂.pmap f h₂ :=
pmap_append f l₁ l₂ _
@[simp] theorem attach_append (xs ys : Array α) :
(xs ++ ys).attach = xs.attach.map (fun x, h => x, mem_append_left ys h) ++
ys.attach.map fun x, h => x, mem_append_right xs h := by
cases xs
cases ys
rw [attach_congr (List.append_toArray _ _)]
simp [List.attach_append, Function.comp_def]
@[simp] theorem attachWith_append {P : α Prop} {xs ys : Array α}
{H : (a : α), a xs ++ ys P a} :
(xs ++ ys).attachWith P H = xs.attachWith P (fun a h => H a (mem_append_left ys h)) ++
ys.attachWith P (fun a h => H a (mem_append_right xs h)) := by
simp [attachWith, attach_append, map_pmap, pmap_append]
@[simp] theorem pmap_reverse {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs.reverse P a) :
xs.reverse.pmap f H = (xs.pmap f (fun a h => H a (by simpa using h))).reverse := by
induction xs <;> simp_all
theorem reverse_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) :
(xs.pmap f H).reverse = xs.reverse.pmap f (fun a h => H a (by simpa using h)) := by
rw [pmap_reverse]
@[simp] theorem attachWith_reverse {P : α Prop} {xs : Array α}
{H : (a : α), a xs.reverse P a} :
xs.reverse.attachWith P H =
(xs.attachWith P (fun a h => H a (by simpa using h))).reverse := by
cases xs
simp
theorem reverse_attachWith {P : α Prop} {xs : Array α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).reverse = (xs.reverse.attachWith P (fun a h => H a (by simpa using h))) := by
cases xs
simp
@[simp] theorem attach_reverse (xs : Array α) :
xs.reverse.attach = xs.attach.reverse.map fun x, h => x, by simpa using h := by
cases xs
rw [attach_congr (List.reverse_toArray _)]
simp
theorem reverse_attach (xs : Array α) :
xs.attach.reverse = xs.reverse.attach.map fun x, h => x, by simpa using h := by
cases xs
simp
@[simp] theorem back?_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) :
(xs.pmap f H).back? = xs.attach.back?.map fun a, m => f a (H a m) := by
cases xs
simp
@[simp] theorem back?_attachWith {P : α Prop} {xs : Array α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).back? = xs.back?.pbind (fun a h => some a, H _ (mem_of_back?_eq_some h)) := by
cases xs
simp
@[simp]
theorem back?_attach {xs : Array α} :
xs.attach.back? = xs.back?.pbind fun a h => some a, mem_of_back?_eq_some h := by
cases xs
simp
/-! ## unattach
`Array.unattach` is the (one-sided) inverse of `Array.attach`. It is a synonym for `Array.map Subtype.val`.
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
functions applied to `l : Array { x // p x }` which only depend on the value, not the predicate, and rewrite these
in terms of a simpler function applied to `l.unattach`.
Further, we provide simp lemmas that push `unattach` inwards.
-/
/--
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
It is introduced as in intermediate step by lemmas such as `map_subtype`,
and is ideally subsequently simplified away by `unattach_attach`.
If not, usually the right approach is `simp [Array.unattach, -Array.map_subtype]` to unfold.
-/
def unattach {α : Type _} {p : α Prop} (l : Array { x // p x }) := l.map (·.val)
@[simp] theorem unattach_nil {p : α Prop} : (#[] : Array { x // p x }).unattach = #[] := rfl
@[simp] theorem unattach_push {p : α Prop} {a : { x // p x }} {l : Array { x // p x }} :
(l.push a).unattach = l.unattach.push a.1 := by
simp only [unattach, Array.map_push]
@[simp] theorem size_unattach {p : α Prop} {l : Array { x // p x }} :
l.unattach.size = l.size := by
unfold unattach
simp
@[simp] theorem _root_.List.unattach_toArray {p : α Prop} {l : List { x // p x }} :
l.toArray.unattach = l.unattach.toArray := by
simp only [unattach, List.map_toArray, List.unattach]
@[simp] theorem toList_unattach {p : α Prop} {l : Array { x // p x }} :
l.unattach.toList = l.toList.unattach := by
simp only [unattach, toList_map, List.unattach]
@[simp] theorem unattach_attach {l : Array α} : l.attach.unattach = l := by
cases l
simp only [List.attach_toArray, List.unattach_toArray, List.unattach_attachWith]
@[simp] theorem unattach_attachWith {p : α Prop} {l : Array α}
{H : a l, p a} :
(l.attachWith p H).unattach = l := by
cases l
simp
@[simp] theorem getElem?_unattach {p : α Prop} {l : Array { x // p x }} (i : Nat) :
l.unattach[i]? = l[i]?.map Subtype.val := by
simp [unattach]
@[simp] theorem getElem_unattach
{p : α Prop} {l : Array { x // p x }} (i : Nat) (h : i < l.unattach.size) :
l.unattach[i] = (l[i]'(by simpa using h)).1 := by
simp [unattach]
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--
This lemma identifies folds over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
theorem foldl_subtype {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
l.foldl f x = l.unattach.foldl g x := by
cases l
simp only [List.foldl_toArray', List.unattach_toArray]
rw [List.foldl_subtype] -- Why can't simp do this?
simp [hf]
/-- Variant of `foldl_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldl_subtype' {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} (h : stop = l.size) :
l.foldl f x 0 stop = l.unattach.foldl g x := by
subst h
rwa [foldl_subtype]
/--
This lemma identifies folds over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
theorem foldr_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
l.foldr f x = l.unattach.foldr g x := by
cases l
simp only [List.foldr_toArray', List.unattach_toArray]
rw [List.foldr_subtype]
simp [hf]
/-- Variant of `foldr_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldr_subtype' {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} (h : start = l.size) :
l.foldr f x start 0 = l.unattach.foldr g x := by
subst h
rwa [foldr_subtype]
/--
This lemma identifies maps over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
l.map f = l.unattach.map g := by
cases l
simp only [List.map_toArray, List.unattach_toArray]
rw [List.map_subtype]
simp [hf]
@[simp] theorem filterMap_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
l.filterMap f = l.unattach.filterMap g := by
cases l
simp only [size_toArray, List.filterMap_toArray', List.unattach_toArray, List.length_unattach,
mk.injEq]
rw [List.filterMap_subtype]
simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(l.filter f).unattach = l.unattach.filter g := by
cases l
simp [hf]
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem unattach_reverse {p : α Prop} {l : Array { x // p x }} :
l.reverse.unattach = l.unattach.reverse := by
cases l
simp
@[simp] theorem unattach_append {p : α Prop} {l₁ l₂ : Array { x // p x }} :
(l₁ ++ l₂).unattach = l₁.unattach ++ l₂.unattach := by
cases l₁
cases l₂
simp
end Array

File diff suppressed because it is too large Load Diff

View File

@@ -32,8 +32,10 @@ private theorem List.of_toArrayAux_eq_toArrayAux {as bs : List α} {cs ds : Arra
have := Array.of_push_eq_push ih₂
simp [this]
theorem List.toArray_eq_toArray_eq (as bs : List α) : (as.toArray = bs.toArray) = (as = bs) := by
simp
@[simp] theorem List.toArray_eq_toArray_eq (as bs : List α) : (as.toArray = bs.toArray) = (as = bs) := by
apply propext; apply Iff.intro
· intro h; simp [toArray] at h; have := of_toArrayAux_eq_toArrayAux h rfl; exact this.1
· intro h; rw [h]
def Array.mapM' [Monad m] (f : α m β) (as : Array α) : m { bs : Array β // bs.size = as.size } :=
go 0 mkEmpty as.size, rfl (by simp)
@@ -58,7 +60,7 @@ where
if ptrEq a b then
go (i+1) as
else
go (i+1) (as.set i b h)
go (i+1) (as.set i, h b)
else
return as

View File

@@ -5,64 +5,59 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Omega
universe u v
namespace Array
-- TODO: CLEANUP
@[specialize] def binSearchAux {α : Type u} {β : Type v} (lt : α α Bool) (found : Option α β) (as : Array α) (k : α) :
(lo : Fin (as.size + 1)) (hi : Fin as.size) (lo.1 hi.1) β
| lo, hi, h =>
let m := (lo.1 + hi.1)/2
let a := as[m]
if lt a k then
if h' : m + 1 hi.1 then
binSearchAux lt found as k m+1, by omega hi h'
else found none
else if lt k a then
if h' : m = 0 m - 1 < lo.1 then found none
else binSearchAux lt found as k lo m-1, by omega (by simp; omega)
else found (some a)
termination_by lo hi => hi.1 - lo.1
namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
-- TODO: remove `partial` using well-founded recursion
@[specialize] partial def binSearchAux {α : Type u} {β : Type v} [Inhabited β] (lt : α α Bool) (found : Option α β) (as : Array α) (k : α) : Nat Nat β
| lo, hi =>
if lo <= hi then
let _ := Inhabited.mk k
let m := (lo + hi)/2
let a := as.get! m
if lt a k then binSearchAux lt found as k (m+1) hi
else if lt k a then
if m == 0 then found none
else binSearchAux lt found as k lo (m-1)
else found (some a)
else found none
@[inline] def binSearch {α : Type} (as : Array α) (k : α) (lt : α α Bool) (lo := 0) (hi := as.size - 1) : Option α :=
if h : lo < as.size then
if lo < as.size then
let hi := if hi < as.size then hi else as.size - 1
if w : lo hi then
binSearchAux lt id as k lo, by omega hi, by simp [hi]; split <;> omega (by simp [hi]; omega)
else
none
binSearchAux lt id as k lo hi
else
none
@[inline] def binSearchContains {α : Type} (as : Array α) (k : α) (lt : α α Bool) (lo := 0) (hi := as.size - 1) : Bool :=
if h : lo < as.size then
if lo < as.size then
let hi := if hi < as.size then hi else as.size - 1
if w : lo hi then
binSearchAux lt Option.isSome as k lo, by omega hi, by simp [hi]; split <;> omega (by simp [hi]; omega)
else
false
binSearchAux lt Option.isSome as k lo hi
else
false
@[specialize] private def binInsertAux {α : Type u} {m : Type u Type v} [Monad m]
@[specialize] private partial def binInsertAux {α : Type u} {m : Type u Type v} [Monad m]
(lt : α α Bool)
(merge : α m α)
(add : Unit m α)
(as : Array α)
(k : α) : (lo : Fin as.size) (hi : Fin as.size) (lo.1 hi.1) (lt as[lo] k) m (Array α)
| lo, hi, h, w =>
let mid := (lo.1 + hi.1)/2
let midVal := as[mid]
if w₁ : lt midVal k then
if h' : mid = lo then do let v add (); pure <| as.insertIdx (lo+1) v
else binInsertAux lt merge add as k mid, by omega hi (by simp; omega) w₁
else if w₂ : lt k midVal then
have : mid lo := fun z => by simp [midVal, z] at w₁; simp_all
binInsertAux lt merge add as k lo mid, by omega (by simp; omega) w
(k : α) : Nat Nat m (Array α)
| lo, hi =>
let _ := Inhabited.mk k
-- as[lo] < k < as[hi]
let mid := (lo + hi)/2
let midVal := as.get! mid
if lt midVal k then
if mid == lo then do let v add (); pure <| as.insertAt! (lo+1) v
else binInsertAux lt merge add as k mid hi
else if lt k midVal then
binInsertAux lt merge add as k lo mid
else do
as.modifyM mid <| fun v => merge v
termination_by lo hi => hi.1 - lo.1
@[specialize] def binInsertM {α : Type u} {m : Type u Type v} [Monad m]
(lt : α α Bool)
@@ -70,12 +65,13 @@ termination_by lo hi => hi.1 - lo.1
(add : Unit m α)
(as : Array α)
(k : α) : m (Array α) :=
if h : as.size = 0 then do let v add (); pure <| as.push v
else if lt k as[0] then do let v add (); pure <| as.insertIdx 0 v
else if h' : !lt as[0] k then as.modifyM 0 <| merge
else if lt as[as.size - 1] k then do let v add (); pure <| as.push v
else if !lt k as[as.size - 1] then as.modifyM (as.size - 1) <| merge
else binInsertAux lt merge add as k 0, by omega as.size - 1, by omega (by simp) (by simpa using h')
let _ := Inhabited.mk k
if as.isEmpty then do let v add (); pure <| as.push v
else if lt k (as.get! 0) then do let v add (); pure <| as.insertAt! 0 v
else if !lt (as.get! 0) k then as.modifyM 0 <| merge
else if lt as.back k then do let v add (); pure <| as.push v
else if !lt k as.back then as.modifyM (as.size - 1) <| merge
else binInsertAux lt merge add as k 0 (as.size - 1)
@[inline] def binInsert {α : Type u} (lt : α α Bool) (as : Array α) (k : α) : Array α :=
Id.run <| binInsertM lt (fun _ => k) (fun _ => k) as k

View File

@@ -15,26 +15,26 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
namespace Array
theorem foldlM_toList.aux [Monad m]
theorem foldlM_eq_foldlM_toList.aux [Monad m]
(f : β α m β) (arr : Array α) (i j) (H : arr.size i + j) (b) :
foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.toList.drop j).foldlM f b := by
unfold foldlM.loop
split; split
· cases Nat.not_le_of_gt _ (Nat.zero_add _ H)
· rename_i i; rw [Nat.succ_add] at H
simp [foldlM_toList.aux f arr i (j+1) H]
rw (occs := [2]) [ List.getElem_cons_drop_succ_eq_drop _]
simp [foldlM_eq_foldlM_toList.aux f arr i (j+1) H]
rw (config := {occs := .pos [2]}) [ List.get_drop_eq_drop _ _ _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
@[simp] theorem foldlM_toList [Monad m]
theorem foldlM_eq_foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.toList.foldlM f init = arr.foldlM f init := by
simp [foldlM, foldlM_toList.aux]
arr.foldlM f init = arr.toList.foldlM f init := by
simp [foldlM, foldlM_eq_foldlM_toList.aux]
@[simp] theorem foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.toList.foldl f init = arr.foldl f init :=
List.foldl_eq_foldlM .. foldlM_toList ..
theorem foldl_eq_foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init :=
List.foldl_eq_foldlM .. foldlM_eq_foldlM_toList ..
theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
(f : α β m β) (arr : Array α) (init : β) (i h) :
@@ -42,7 +42,7 @@ theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
unfold foldrM.fold
match i with
| 0 => simp [List.foldlM, List.take]
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]; rfl
theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.reverse.foldlM (fun x y => f y x) init := by
@@ -51,94 +51,56 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_
simp [foldrM, h, foldrM_eq_reverse_foldlM_toList.aux, List.take_length]
@[simp] theorem foldrM_toList [Monad m]
theorem foldrM_eq_foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.toList.foldrM f init = arr.foldrM f init := by
arr.foldrM f init = arr.toList.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList, List.foldlM_reverse]
@[simp] theorem foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.toList.foldr f init = arr.foldr f init :=
List.foldr_eq_foldrM .. foldrM_toList ..
theorem foldr_eq_foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init :=
List.foldr_eq_foldrM .. foldrM_eq_foldrM_toList ..
@[simp] theorem push_toList (arr : Array α) (a : α) : (arr.push a).toList = arr.toList ++ [a] := by
simp [push, List.concat_eq_append]
@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.toList ++ l := by
simp [toListAppend, foldr_toList]
simp [toListAppend, foldr_eq_foldr_toList]
@[simp] theorem toListImpl_eq (arr : Array α) : arr.toListImpl = arr.toList := by
simp [toListImpl, foldr_toList]
simp [toListImpl, foldr_eq_foldr_toList]
@[simp] theorem pop_toList (arr : Array α) : arr.pop.toList = arr.toList.dropLast := rfl
@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl
@[simp] theorem toList_append (arr arr' : Array α) :
@[simp] theorem append_toList (arr arr' : Array α) :
(arr ++ arr').toList = arr.toList ++ arr'.toList := by
rw [ append_eq_append]; unfold Array.append
rw [ foldl_toList]
rw [foldl_eq_foldl_toList]
induction arr'.toList generalizing arr <;> simp [*]
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
apply ext'; simp only [toList_append, toList_empty, List.nil_append]
@[simp] theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
apply ext'; simp only [toList_append, List.append_assoc]
@[simp] theorem appendList_eq_append
(arr : Array α) (l : List α) : arr.appendList l = arr ++ l := rfl
@[simp] theorem toList_appendList (arr : Array α) (l : List α) :
@[simp] theorem appendList_toList (arr : Array α) (l : List α) :
(arr ++ l).toList = arr.toList ++ l := by
rw [ appendList_eq_append]; unfold Array.appendList
induction l generalizing arr <;> simp [*]
@[deprecated toList_appendList (since := "2024-12-11")]
abbrev appendList_toList := @toList_appendList
@[deprecated foldlM_eq_foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_eq_foldlM_toList
@[deprecated "Use the reverse direction of `foldrM_toList`." (since := "2024-11-13")]
theorem foldrM_eq_foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.foldrM f init := by
simp
@[deprecated "Use the reverse direction of `foldlM_toList`." (since := "2024-11-13")]
theorem foldlM_eq_foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.toList.foldlM f init:= by
simp
@[deprecated "Use the reverse direction of `foldr_toList`." (since := "2024-11-13")]
theorem foldr_eq_foldr_toList
(f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init := by
simp
@[deprecated "Use the reverse direction of `foldl_toList`." (since := "2024-11-13")]
theorem foldl_eq_foldl_toList
(f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init:= by
simp
@[deprecated foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_toList
@[deprecated foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_toList
@[deprecated foldl_eq_foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_eq_foldl_toList
@[deprecated foldrM_eq_reverse_foldlM_toList (since := "2024-09-09")]
abbrev foldrM_eq_reverse_foldlM_data := @foldrM_eq_reverse_foldlM_toList
@[deprecated foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_toList
@[deprecated foldrM_eq_foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_eq_foldrM_toList
@[deprecated foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_toList
@[deprecated foldr_eq_foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_eq_foldr_toList
@[deprecated push_toList (since := "2024-09-09")]
abbrev push_data := @push_toList
@@ -149,10 +111,10 @@ abbrev toList_eq := @toListImpl_eq
@[deprecated pop_toList (since := "2024-09-09")]
abbrev pop_data := @pop_toList
@[deprecated toList_append (since := "2024-09-09")]
abbrev append_data := @toList_append
@[deprecated append_toList (since := "2024-09-09")]
abbrev append_data := @append_toList
@[deprecated toList_appendList (since := "2024-09-09")]
abbrev appendList_data := @toList_appendList
@[deprecated appendList_toList (since := "2024-09-09")]
abbrev appendList_data := @appendList_toList
end Array

View File

@@ -5,81 +5,43 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.BEq
import Init.Data.List.Nat.BEq
import Init.ByCases
namespace Array
theorem rel_of_isEqvAux
{r : α α Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i a.size)
(heqv : Array.isEqvAux a b hsz r i hi)
{j : Nat} (hj : j < i) : r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi))) := by
induction i with
| zero => contradiction
| succ i ih =>
simp only [Array.isEqvAux, Bool.and_eq_true, decide_eq_true_eq] at heqv
by_cases hj' : j < i
next =>
exact ih _ heqv.right hj'
next =>
replace hj' : j = i := Nat.eq_of_le_of_lt_succ (Nat.not_lt.mp hj') hj
subst hj'
exact heqv.left
theorem eq_of_isEqvAux [DecidableEq α] (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i a.size) (heqv : Array.isEqvAux a b hsz (fun x y => x = y) i) (j : Nat) (low : i j) (high : j < a.size) : a[j] = b[j]'(hsz high) := by
by_cases h : i < a.size
· unfold Array.isEqvAux at heqv
simp [h] at heqv
have hind := eq_of_isEqvAux a b hsz (i+1) (Nat.succ_le_of_lt h) heqv.2
by_cases heq : i = j
· subst heq; exact heqv.1
· exact hind j (Nat.succ_le_of_lt (Nat.lt_of_le_of_ne low heq)) high
· have heq : i = a.size := Nat.le_antisymm hi (Nat.ge_of_not_lt h)
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 isEqvAux_of_rel {r : α α Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i a.size)
(w : j, (hj : j < i) r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi)))) : Array.isEqvAux a b hsz r i hi := by
induction i with
| zero => simp [Array.isEqvAux]
| succ i ih =>
simp only [isEqvAux, Bool.and_eq_true]
exact w i (Nat.lt_add_one i), ih _ fun j hj => w j (Nat.lt_add_right 1 hj)
theorem rel_of_isEqv {r : α α Bool} {a b : Array α} :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) := by
simp only [isEqv]
split <;> rename_i h
· exact fun h' => h, fun i => rel_of_isEqvAux h (Nat.le_refl ..) h'
· intro; contradiction
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) : Array.isEqv a b (fun x y => x = y) a = b := by
simp [Array.isEqv]
split
next hsz =>
intro h
have aux := eq_of_isEqvAux a b hsz 0 (Nat.zero_le ..) h
exact ext a b hsz fun i h _ => aux i (Nat.zero_le ..) _
next => intro; contradiction
theorem isEqv_iff_rel {a b : Array α} {r} :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) :=
rel_of_isEqv, fun h, w => by
simp only [isEqv, h, reduceDIte]
exact isEqvAux_of_rel h (by simp [h]) w
theorem isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) : Array.isEqvAux a a rfl (fun x y => x = y) i = true := by
unfold Array.isEqvAux
split
next h => simp [h, isEqvAux_self a (i+1)]
next h => simp [h]
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
theorem isEqv_eq_decide (a b : Array α) (r) :
Array.isEqv a b r =
if h : a.size = b.size then decide ( (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h'))) else false := by
by_cases h : Array.isEqv a b r
· simp only [h, Bool.true_eq]
simp only [isEqv_iff_rel] at h
obtain h, w := h
simp [h, w]
· let h' := h
simp only [Bool.not_eq_true] at h
simp only [h, Bool.false_eq, dite_eq_right_iff, decide_eq_false_iff_not, Classical.not_forall,
Bool.not_eq_true]
simpa [isEqv_iff_rel] using h'
@[simp] theorem isEqv_toList [BEq α] (a b : Array α) : (a.toList.isEqv b.toList r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, List.isEqv_eq_decide]
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) (h : Array.isEqv a b (fun x y => x = y)) : a = b := by
have h, h' := rel_of_isEqv h
exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
theorem isEqvAux_self (r : α α Bool) (hr : a, r a a) (a : Array α) (i : Nat) (h : i a.size) :
Array.isEqvAux a a rfl r i h = true := by
induction i with
| zero => simp [Array.isEqvAux]
| succ i ih =>
simp_all only [isEqvAux, Bool.and_self]
theorem isEqv_self_beq [BEq α] [ReflBEq α] (a : Array α) : Array.isEqv a a (· == ·) = true := by
simp [isEqv, isEqvAux_self]
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (· = ·) = true := by
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (fun x y => x = y) = true := by
simp [isEqv, isEqvAux_self]
instance [DecidableEq α] : DecidableEq (Array α) :=
@@ -88,22 +50,4 @@ instance [DecidableEq α] : DecidableEq (Array α) :=
| true => isTrue (eq_of_isEqv a b h)
| false => isFalse fun h' => by subst h'; rw [isEqv_self] at h; contradiction
theorem beq_eq_decide [BEq α] (a b : Array α) :
(a == b) = if h : a.size = b.size then
decide ( (i : Nat) (h' : i < a.size), a[i] == b[i]'(h h')) else false := by
simp [BEq.beq, isEqv_eq_decide]
@[simp] theorem beq_toList [BEq α] (a b : Array α) : (a.toList == b.toList) = (a == b) := by
simp [beq_eq_decide, List.beq_eq_decide]
end Array
namespace List
@[simp] theorem isEqv_toArray [BEq α] (a b : List α) : (a.toArray.isEqv b.toArray r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, Array.isEqv_eq_decide]
@[simp] theorem beq_toArray [BEq α] (a b : List α) : (a.toArray == b.toArray) = (a == b) := by
simp [beq_eq_decide, Array.beq_eq_decide]
end List

View File

@@ -1,14 +0,0 @@
/-
Copyright (c) 2024 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: François G. Dorais
-/
prelude
import Init.Data.List.FinRange
namespace Array
/-- `finRange n` is the array of all elements of `Fin n` in order. -/
protected def finRange (n : Nat) : Array (Fin n) := ofFn fun i => i
end Array

View File

@@ -1,281 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Find
import Init.Data.Array.Lemmas
import Init.Data.Array.Attach
/-!
# Lemmas about `Array.findSome?`, `Array.find?`.
-/
namespace Array
open Nat
/-! ### findSome? -/
@[simp] theorem findSomeRev?_push_of_isSome (l : Array α) (h : (f a).isSome) : (l.push a).findSomeRev? f = f a := by
cases l; simp_all
@[simp] theorem findSomeRev?_push_of_isNone (l : Array α) (h : (f a).isNone) : (l.push a).findSomeRev? f = l.findSomeRev? f := by
cases l; simp_all
theorem exists_of_findSome?_eq_some {f : α Option β} {l : Array α} (w : l.findSome? f = some b) :
a, a l f a = b := by
cases l; simp_all [List.exists_of_findSome?_eq_some]
@[simp] theorem findSome?_eq_none_iff : findSome? p l = none x l, p x = none := by
cases l; simp
@[simp] theorem findSome?_isSome_iff {f : α Option β} {l : Array α} :
(l.findSome? f).isSome x, x l (f x).isSome := by
cases l; simp
theorem findSome?_eq_some_iff {f : α Option β} {l : Array α} {b : β} :
l.findSome? f = some b (l₁ : Array α) (a : α) (l₂ : Array α), l = l₁.push a ++ l₂ f a = some b x l₁, f x = none := by
cases l
simp only [List.findSome?_toArray, List.findSome?_eq_some_iff]
constructor
· rintro l₁, a, l₂, rfl, h₁, h₂
exact l₁.toArray, a, l₂.toArray, by simp_all
· rintro l₁, a, l₂, h₀, h₁, h₂
exact l₁.toList, a, l₂.toList, by simpa using congrArg toList h₀, h₁, by simpa
@[simp] theorem findSome?_guard (l : Array α) : findSome? (Option.guard fun x => p x) l = find? p l := by
cases l; simp
@[simp] theorem getElem?_zero_filterMap (f : α Option β) (l : Array α) : (l.filterMap f)[0]? = l.findSome? f := by
cases l; simp [ List.head?_eq_getElem?]
@[simp] theorem getElem_zero_filterMap (f : α Option β) (l : Array α) (h) :
(l.filterMap f)[0] = (l.findSome? f).get (by cases l; simpa [List.length_filterMap_eq_countP] using h) := by
cases l; simp [ List.head_eq_getElem, getElem?_zero_filterMap]
@[simp] theorem back?_filterMap (f : α Option β) (l : Array α) : (l.filterMap f).back? = l.findSomeRev? f := by
cases l; simp
@[simp] theorem back!_filterMap [Inhabited β] (f : α Option β) (l : Array α) :
(l.filterMap f).back! = (l.findSomeRev? f).getD default := by
cases l; simp
@[simp] theorem map_findSome? (f : α Option β) (g : β γ) (l : Array α) :
(l.findSome? f).map g = l.findSome? (Option.map g f) := by
cases l; simp
theorem findSome?_map (f : β γ) (l : Array β) : findSome? p (l.map f) = l.findSome? (p f) := by
cases l; simp [List.findSome?_map]
theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (l₁.findSome? f).or (l₂.findSome? f) := by
cases l₁; cases l₂; simp [List.findSome?_append]
theorem getElem?_zero_flatten (L : Array (Array α)) :
(flatten L)[0]? = L.findSome? fun l => l[0]? := by
cases L using array_array_induction
simp [ List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
(L.findSome? fun l => l[0]?).isSome := by
cases L using array_array_induction
simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
List.findSome?_isSome_iff, isSome_getElem?]
simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
Nat.sum_pos_iff_exists_pos, List.mem_map] at h
obtain _, xs, m, rfl, h := h
exact xs, m, by simpa using h
theorem getElem_zero_flatten {L : Array (Array α)} (h) :
(flatten L)[0] = (L.findSome? fun l => l[0]?).get (getElem_zero_flatten.proof h) := by
have t := getElem?_zero_flatten L
simp [getElem?_eq_getElem, h] at t
simp [ t]
theorem back?_flatten {L : Array (Array α)} :
(flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
cases L using array_array_induction
simp [List.getLast?_flatten, List.map_reverse, List.findSome?_map, Function.comp_def]
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
simp [ List.toArray_replicate, List.findSome?_replicate]
@[simp] theorem findSome?_mkArray_of_pos (h : 0 < n) : findSome? f (mkArray n a) = f a := by
simp [findSome?_mkArray, Nat.ne_of_gt h]
-- Argument is unused, but used to decide whether `simp` should unfold.
@[simp] theorem findSome?_mkArray_of_isSome (_ : (f a).isSome) :
findSome? f (mkArray n a) = if n = 0 then none else f a := by
simp [findSome?_mkArray]
@[simp] theorem findSome?_mkArray_of_isNone (h : (f a).isNone) :
findSome? f (mkArray n a) = none := by
rw [Option.isNone_iff_eq_none] at h
simp [findSome?_mkArray, h]
/-! ### find? -/
@[simp] theorem find?_singleton (a : α) (p : α Bool) :
#[a].find? p = if p a then some a else none := by
simp [singleton_eq_toArray_singleton]
@[simp] theorem findRev?_push_of_pos (l : Array α) (h : p a) :
findRev? p (l.push a) = some a := by
cases l; simp [h]
@[simp] theorem findRev?_cons_of_neg (l : Array α) (h : ¬p a) :
findRev? p (l.push a) = findRev? p l := by
cases l; simp [h]
@[simp] theorem find?_eq_none : find? p l = none x l, ¬ p x := by
cases l; simp
theorem find?_eq_some_iff_append {xs : Array α} :
xs.find? p = some b p b (as bs : Array α), xs = as.push b ++ bs a as, !p a := by
rcases xs with xs
simp only [List.find?_toArray, List.find?_eq_some_iff_append, Bool.not_eq_eq_eq_not,
Bool.not_true, exists_and_right, and_congr_right_iff]
intro w
constructor
· rintro as, x, rfl, h
exact as.toArray, x.toArray, by simp , by simpa using h
· rintro as, x, h', h
exact as.toList, x.toList, by simpa using congrArg Array.toList h',
by simpa using h
@[simp]
theorem find?_push_eq_some {xs : Array α} :
(xs.push a).find? p = some b xs.find? p = some b (xs.find? p = none (p a a = b)) := by
cases xs; simp
@[simp] theorem find?_isSome {xs : Array α} {p : α Bool} : (xs.find? p).isSome x, x xs p x := by
cases xs; simp
theorem find?_some {xs : Array α} (h : find? p xs = some a) : p a := by
cases xs
simp at h
exact List.find?_some h
theorem mem_of_find?_eq_some {xs : Array α} (h : find? p xs = some a) : a xs := by
cases xs
simp at h
simpa using List.mem_of_find?_eq_some h
theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h xs := by
cases xs
simp [List.get_find?_mem]
@[simp] theorem find?_filter {xs : Array α} (p q : α Bool) :
(xs.filter p).find? q = xs.find? (fun a => p a q a) := by
cases xs; simp
@[simp] theorem getElem?_zero_filter (p : α Bool) (l : Array α) :
(l.filter p)[0]? = l.find? p := by
cases l; simp [ List.head?_eq_getElem?]
@[simp] theorem getElem_zero_filter (p : α Bool) (l : Array α) (h) :
(l.filter p)[0] =
(l.find? p).get (by cases l; simpa [ List.countP_eq_length_filter] using h) := by
cases l
simp [List.getElem_zero_eq_head]
@[simp] theorem back?_filter (p : α Bool) (l : Array α) : (l.filter p).back? = l.findRev? p := by
cases l; simp
@[simp] theorem back!_filter [Inhabited α] (p : α Bool) (l : Array α) :
(l.filter p).back! = (l.findRev? p).get! := by
cases l; simp [Option.get!_eq_getD]
@[simp] theorem find?_filterMap (xs : Array α) (f : α Option β) (p : β Bool) :
(xs.filterMap f).find? p = (xs.find? (fun a => (f a).any p)).bind f := by
cases xs; simp
@[simp] theorem find?_map (f : β α) (xs : Array β) :
find? p (xs.map f) = (xs.find? (p f)).map f := by
cases xs; simp
@[simp] theorem find?_append {l₁ l₂ : Array α} :
(l₁ ++ l₂).find? p = (l₁.find? p).or (l₂.find? p) := by
cases l₁
cases l₂
simp
@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α Bool) :
xs.flatten.find? p = xs.findSome? (·.find? p) := by
cases xs using array_array_induction
simp [List.findSome?_map, Function.comp_def]
theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α Bool} :
xs.flatten.find? p = none ys xs, x ys, !p x := by
simp
/--
If `find? p` returns `some a` from `xs.flatten`, then `p a` holds, and
some array in `xs` contains `a`, and no earlier element of that array satisfies `p`.
Moreover, no earlier array in `xs` has an element satisfying `p`.
-/
theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α Bool} {a : α} :
xs.flatten.find? p = some a
p a (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
xs = as.push (ys.push a ++ zs) ++ bs
( a as, x a, !p x) ( x ys, !p x) := by
cases xs using array_array_induction
simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
intro w
constructor
· rintro as, ys, zs, bs, rfl, h₁, h₂
exact as.toArray.map List.toArray, ys.toArray,
zs.toArray, bs.toArray.map List.toArray, by simp, by simpa using h₁, by simpa using h₂
· rintro as, ys, zs, bs, h, h₁, h₂
replace h := congrArg (·.map Array.toList) (congrArg Array.toList h)
simp [Function.comp_def] at h
exact as.toList.map Array.toList, ys.toList,
zs.toList, bs.toList.map Array.toList, by simpa using h,
by simpa using h₁, by simpa using h₂
@[simp] theorem find?_flatMap (xs : Array α) (f : α Array β) (p : β Bool) :
(xs.flatMap f).find? p = xs.findSome? (fun x => (f x).find? p) := by
cases xs
simp [List.find?_flatMap, Array.flatMap_toArray]
theorem find?_flatMap_eq_none {xs : Array α} {f : α Array β} {p : β Bool} :
(xs.flatMap f).find? p = none x xs, y f x, !p y := by
simp
theorem find?_mkArray :
find? p (mkArray n a) = if n = 0 then none else if p a then some a else none := by
simp [ List.toArray_replicate, List.find?_replicate]
@[simp] theorem find?_mkArray_of_length_pos (h : 0 < n) :
find? p (mkArray n a) = if p a then some a else none := by
simp [find?_mkArray, Nat.ne_of_gt h]
@[simp] theorem find?_mkArray_of_pos (h : p a) :
find? p (mkArray n a) = if n = 0 then none else some a := by
simp [find?_mkArray, h]
@[simp] theorem find?_mkArray_of_neg (h : ¬ p a) : find? p (mkArray n a) = none := by
simp [find?_mkArray, h]
-- This isn't a `@[simp]` lemma since there is already a lemma for `l.find? p = none` for any `l`.
theorem find?_mkArray_eq_none {n : Nat} {a : α} {p : α Bool} :
(mkArray n a).find? p = none n = 0 !p a := by
simp [ List.toArray_replicate, List.find?_replicate_eq_none, Classical.or_iff_not_imp_left]
@[simp] theorem find?_mkArray_eq_some {n : Nat} {a b : α} {p : α Bool} :
(mkArray n a).find? p = some b n 0 p a a = b := by
simp [ List.toArray_replicate]
@[simp] theorem get_find?_mkArray (n : Nat) (a : α) (p : α Bool) (h) :
((mkArray n a).find? p).get h = a := by
simp [ List.toArray_replicate]
theorem find?_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) (p : β Bool) :
(xs.pmap f H).find? p = (xs.attach.find? (fun a, m => p (f a (H a m)))).map fun a, m => f a (H a m) := by
simp only [pmap_eq_map_attach, find?_map]
rfl
end Array

View File

@@ -1,46 +0,0 @@
/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
namespace Array
/-! ### getLit -/
-- auxiliary declaration used in the equation compiler when pattern matching array literals.
abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
have := h₁.symm h₂
a[i]
theorem extLit {n : Nat}
(a b : Array α)
(hsz₁ : a.size = n) (hsz₂ : b.size = n)
(h : (i : Nat) (hi : i < n) a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ _ => h i (hsz₁ hi₁)
def toListLitAux (a : Array α) (n : Nat) (hsz : a.size = n) : (i : Nat), i a.size List α List α
| 0, _, acc => acc
| (i+1), hi, acc => toListLitAux a n hsz i (Nat.le_of_succ_le hi) (a.getLit i hsz (Nat.lt_of_lt_of_eq (Nat.lt_of_lt_of_le (Nat.lt_succ_self i) hi) hsz) :: acc)
def toArrayLit (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
List.toArray <| toListLitAux a n hsz n (hsz Nat.le_refl _) []
theorem toArrayLit_eq (as : Array α) (n : Nat) (hsz : as.size = n) : as = toArrayLit as n hsz := by
apply ext'
simp [toArrayLit, toList_toArray]
have hle : n as.size := hsz Nat.le_refl _
have hge : as.size n := hsz Nat.le_refl _
have := go n hle
rw [List.drop_eq_nil_of_le hge] at this
rw [this]
where
getLit_eq (as : Array α) (i : Nat) (h₁ : as.size = n) (h₂ : i < n) : as.getLit i h₁ h₂ = getElem as.toList i ((id (α := as.toList.length = n) h₁) h₂) :=
rfl
go (i : Nat) (hi : i as.size) : toListLitAux as n hsz i hi (as.toList.drop i) = as.toList := by
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.getElem_cons_drop_succ_eq_drop, *]
end Array

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Array.Basic
@[inline] def Array.insertionSort (a : Array α) (lt : α α Bool := by exact (· < ·)) : Array α :=
@[inline] def Array.insertionSort (a : Array α) (lt : α α Bool) : Array α :=
traverse a 0 a.size
where
@[specialize] traverse (a : Array α) (i : Nat) (fuel : Nat) : Array α :=
@@ -23,6 +23,6 @@ where
| j'+1 =>
have h' : j' < a.size := by subst j; exact Nat.lt_trans (Nat.lt_succ_self _) h
if lt a[j] a[j'] then
swapLoop (a.swap j j') j' (by rw [size_swap]; assumption; done)
swapLoop (a.swap j, h j', h') j' (by rw [size_swap]; assumption; done)
else
a

File diff suppressed because it is too large Load Diff

View File

@@ -1,8 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kim Morrison
-/
prelude
import Init.Data.Array.Lex.Basic
import Init.Data.Array.Lex.Lemmas

View File

@@ -1,30 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kim Morrison
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Nat.Lemmas
import Init.Data.Range
namespace Array
/--
Lexicographic comparator for arrays.
`lex as bs lt` is true if
- `bs` is larger than `as` and `as` is pairwise equivalent via `==` to the initial segment of `bs`, or
- there is an index `i` such that `lt as[i] bs[i]`, and for all `j < i`, `as[j] == bs[j]`.
-/
def lex [BEq α] (as bs : Array α) (lt : α α Bool := by exact (· < ·)) : Bool := Id.run do
for h : i in [0 : min as.size bs.size] do
-- TODO: `omega` should be able to find this itself.
have : i < min as.size bs.size := Membership.get_elem_helper h rfl
if lt as[i] bs[i] then
return true
else if as[i] != bs[i] then
return false
return as.size < bs.size
end Array

View File

@@ -1,216 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.Lex
namespace Array
/-! ### Lexicographic ordering -/
@[simp] theorem lt_toArray [LT α] (l₁ l₂ : List α) : l₁.toArray < l₂.toArray l₁ < l₂ := Iff.rfl
@[simp] theorem le_toArray [LT α] (l₁ l₂ : List α) : l₁.toArray l₂.toArray l₁ l₂ := Iff.rfl
theorem not_lt_iff_ge [LT α] (l₁ l₂ : List α) : ¬ l₁ < l₂ l₂ l₁ := Iff.rfl
theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] (l₁ l₂ : List α) :
¬ l₁ l₂ l₂ < l₁ :=
Decidable.not_not
@[simp] theorem lex_empty [BEq α] {lt : α α Bool} (l : Array α) : l.lex #[] lt = false := by
simp [lex, Id.run]
@[simp] theorem singleton_lex_singleton [BEq α] {lt : α α Bool} : #[a].lex #[b] lt = lt a b := by
simp only [lex, List.getElem_toArray, List.getElem_singleton]
cases lt a b <;> cases a != b <;> simp [Id.run]
private theorem cons_lex_cons [BEq α] {lt : α α Bool} {a b : α} {xs ys : Array α} :
(#[a] ++ xs).lex (#[b] ++ ys) lt =
(lt a b || a == b && xs.lex ys lt) := by
simp only [lex, Id.run]
simp only [Std.Range.forIn'_eq_forIn'_range', size_append, size_toArray, List.length_singleton,
Nat.add_comm 1]
simp [Nat.add_min_add_right, List.range'_succ, getElem_append_left, List.range'_succ_left,
getElem_append_right]
cases lt a b
· rw [bne]
cases a == b <;> simp
· simp
@[simp] theorem _root_.List.lex_toArray [BEq α] (lt : α α Bool) (l₁ l₂ : List α) :
l₁.toArray.lex l₂.toArray lt = l₁.lex l₂ lt := by
induction l₁ generalizing l₂ with
| nil => cases l₂ <;> simp [lex, Id.run]
| cons x l₁ ih =>
cases l₂ with
| nil => simp [lex, Id.run]
| cons y l₂ =>
rw [List.toArray_cons, List.toArray_cons y, cons_lex_cons, List.lex, ih]
@[simp] theorem lex_toList [BEq α] (lt : α α Bool) (l₁ l₂ : Array α) :
l₁.toList.lex l₂.toList lt = l₁.lex l₂ lt := by
cases l₁ <;> cases l₂ <;> simp
protected theorem lt_irrefl [LT α] [Std.Irrefl (· < · : α α Prop)] (l : Array α) : ¬ l < l :=
List.lt_irrefl l.toList
instance ltIrrefl [LT α] [Std.Irrefl (· < · : α α Prop)] : Std.Irrefl (α := Array α) (· < ·) where
irrefl := Array.lt_irrefl
@[simp] theorem empty_le [LT α] (l : Array α) : #[] l := List.nil_le l.toList
@[simp] theorem le_empty [LT α] (l : Array α) : l #[] l = #[] := by
cases l
simp
@[simp] theorem empty_lt_push [LT α] (l : Array α) (a : α) : #[] < l.push a := by
rcases l with (_ | x, l) <;> simp
protected theorem le_refl [LT α] [i₀ : Std.Irrefl (· < · : α α Prop)] (l : Array α) : l l :=
List.le_refl l.toList
instance [LT α] [Std.Irrefl (· < · : α α Prop)] : Std.Refl (· · : Array α Array α Prop) where
refl := Array.le_refl
protected theorem lt_trans [LT α] [DecidableLT α]
[i₁ : Trans (· < · : α α Prop) (· < ·) (· < ·)]
{l₁ l₂ l₃ : Array α} (h₁ : l₁ < l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
List.lt_trans h₁ h₂
instance [LT α] [DecidableLT α]
[Trans (· < · : α α Prop) (· < ·) (· < ·)] :
Trans (· < · : Array α Array α Prop) (· < ·) (· < ·) where
trans h₁ h₂ := Array.lt_trans h₁ h₂
protected theorem lt_of_le_of_lt [DecidableEq α] [LT α] [DecidableLT α]
[i₀ : Std.Irrefl (· < · : α α Prop)]
[i₁ : Std.Asymm (· < · : α α Prop)]
[i₂ : Std.Antisymm (¬ · < · : α α Prop)]
[i₃ : Trans (¬ · < · : α α Prop) (¬ · < ·) (¬ · < ·)]
{l₁ l₂ l₃ : Array α} (h₁ : l₁ l₂) (h₂ : l₂ < l₃) : l₁ < l₃ :=
List.lt_of_le_of_lt h₁ h₂
protected theorem le_trans [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
[Trans (¬ · < · : α α Prop) (¬ · < ·) (¬ · < ·)]
{l₁ l₂ l₃ : Array α} (h₁ : l₁ l₂) (h₂ : l₂ l₃) : l₁ l₃ :=
fun h₃ => h₁ (Array.lt_of_le_of_lt h₂ h₃)
instance [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)]
[Trans (¬ · < · : α α Prop) (¬ · < ·) (¬ · < ·)] :
Trans (· · : Array α Array α Prop) (· ·) (· ·) where
trans h₁ h₂ := Array.le_trans h₁ h₂
protected theorem lt_asymm [DecidableEq α] [LT α] [DecidableLT α]
[i : Std.Asymm (· < · : α α Prop)]
{l₁ l₂ : Array α} (h : l₁ < l₂) : ¬ l₂ < l₁ := List.lt_asymm h
instance [DecidableEq α] [LT α] [DecidableLT α]
[Std.Asymm (· < · : α α Prop)] :
Std.Asymm (· < · : Array α Array α Prop) where
asymm _ _ := Array.lt_asymm
protected theorem le_total [DecidableEq α] [LT α] [DecidableLT α]
[i : Std.Total (¬ · < · : α α Prop)] {l₁ l₂ : Array α} : l₁ l₂ l₂ l₁ :=
List.le_total
instance [DecidableEq α] [LT α] [DecidableLT α]
[Std.Total (¬ · < · : α α Prop)] :
Std.Total (· · : Array α Array α Prop) where
total _ _ := Array.le_total
@[simp] theorem lex_eq_true_iff_lt [DecidableEq α] [LT α] [DecidableLT α]
{l₁ l₂ : Array α} : lex l₁ l₂ = true l₁ < l₂ := by
cases l₁
cases l₂
simp
@[simp] theorem lex_eq_false_iff_ge [DecidableEq α] [LT α] [DecidableLT α]
{l₁ l₂ : Array α} : lex l₁ l₂ = false l₂ l₁ := by
cases l₁
cases l₂
simp [List.not_lt_iff_ge]
instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLT (Array α) :=
fun l₁ l₂ => decidable_of_iff (lex l₁ l₂ = true) lex_eq_true_iff_lt
instance [DecidableEq α] [LT α] [DecidableLT α] : DecidableLE (Array α) :=
fun l₁ l₂ => decidable_of_iff (lex l₂ l₁ = false) lex_eq_false_iff_ge
/--
`l₁` is lexicographically less than `l₂` if either
- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.size`,
and `l₁` is shorter than `l₂` or
- there exists an index `i` such that
- for all `j < i`, `l₁[j] == l₂[j]` and
- `l₁[i] < l₂[i]`
-/
theorem lex_eq_true_iff_exists [BEq α] (lt : α α Bool) :
lex l₁ l₂ lt = true
(l₁.isEqv (l₂.take l₁.size) (· == ·) l₁.size < l₂.size)
( (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
( j, (hj : j < i)
l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) lt l₁[i] l₂[i]) := by
cases l₁
cases l₂
simp [List.lex_eq_true_iff_exists]
/--
`l₁` is *not* lexicographically less than `l₂`
(which you might think of as "`l₂` is lexicographically greater than or equal to `l₁`"") if either
- `l₁` is pairwise equivalent under `· == ·` to `l₂.take l₁.length` or
- there exists an index `i` such that
- for all `j < i`, `l₁[j] == l₂[j]` and
- `l₂[i] < l₁[i]`
This formulation requires that `==` and `lt` are compatible in the following senses:
- `==` is symmetric
(we unnecessarily further assume it is transitive, to make use of the existing typeclasses)
- `lt` is irreflexive with respect to `==` (i.e. if `x == y` then `lt x y = false`
- `lt` is asymmmetric (i.e. `lt x y = true → lt y x = false`)
- `lt` is antisymmetric with respect to `==` (i.e. `lt x y = false → lt y x = false → x == y`)
-/
theorem lex_eq_false_iff_exists [BEq α] [PartialEquivBEq α] (lt : α α Bool)
(lt_irrefl : x y, x == y lt x y = false)
(lt_asymm : x y, lt x y = true lt y x = false)
(lt_antisymm : x y, lt x y = false lt y x = false x == y) :
lex l₁ l₂ lt = false
(l₂.isEqv (l₁.take l₂.size) (· == ·))
( (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
( j, (hj : j < i)
l₁[j]'(Nat.lt_trans hj h₁) == l₂[j]'(Nat.lt_trans hj h₂)) lt l₂[i] l₁[i]) := by
cases l₁
cases l₂
simp_all [List.lex_eq_false_iff_exists]
theorem lt_iff_exists [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : Array α} :
l₁ < l₂
(l₁ = l₂.take l₁.size l₁.size < l₂.size)
( (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
( j, (hj : j < i)
l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) l₁[i] < l₂[i]) := by
cases l₁
cases l₂
simp [List.lt_iff_exists]
theorem le_iff_exists [DecidableEq α] [LT α] [DecidableLT α]
[Std.Irrefl (· < · : α α Prop)]
[Std.Asymm (· < · : α α Prop)]
[Std.Antisymm (¬ · < · : α α Prop)] {l₁ l₂ : Array α} :
l₁ l₂
(l₁ = l₂.take l₁.size)
( (i : Nat) (h₁ : i < l₁.size) (h₂ : i < l₂.size),
( j, (hj : j < i)
l₁[j]'(Nat.lt_trans hj h₁) = l₂[j]'(Nat.lt_trans hj h₂)) l₁[i] < l₂[i]) := by
cases l₁
cases l₂
simp [List.le_iff_exists]
end Array

View File

@@ -1,112 +0,0 @@
/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.MapIdx
namespace Array
/-! ### mapFinIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
theorem mapFinIdx_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.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
let arr : Array β := Array.mapFinIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
induction i generalizing j bs with simp [mapFinIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
| succ i ih =>
apply @ih (bs.push (f j, by omega as[j])) (j + 1) (by omega) (by simp; omega)
· intro i i_lt h'
rw [getElem_push]
split
· apply h₂
· simp only [size_push] at h'
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
simp [mapFinIdx, mapFinIdxM]; exact go rfl nofun h0
theorem mapFinIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) :=
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapFinIdx (a : Array α) (f : Fin a.size α β) : (a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapFinIdx _ _
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapFinIdx a f).size) :
(a.mapFinIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapFinIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
(a.mapFinIdx f)[i]? =
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
split <;> simp_all
@[simp] theorem toList_mapFinIdx (a : Array α) (f : Fin a.size α β) :
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a => f i, by simp a) := by
apply List.ext_getElem <;> simp
/-! ### mapIdx -/
theorem mapIdx_induction (f : Nat α β) (as : Array α)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
theorem mapIdx_spec (f : Nat α β) (as : Array α)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (f : Nat α β) (as : Array α) : (as.mapIdx f).size = as.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem getElem_mapIdx (f : Nat α β) (as : Array α) (i : Nat)
(h : i < (as.mapIdx f).size) :
(as.mapIdx f)[i] = f i (as[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i as[i]) fun _ => rfl).2 i (by simp_all)
@[simp] theorem getElem?_mapIdx (f : Nat α β) (as : Array α) (i : Nat) :
(as.mapIdx f)[i]? =
as[i]?.map (f i) := by
simp [getElem?_def, size_mapIdx, getElem_mapIdx]
@[simp] theorem toList_mapIdx (f : Nat α β) (as : Array α) :
(as.mapIdx f).toList = as.toList.mapIdx (fun i a => f i a) := by
apply List.ext_getElem <;> simp
end Array
namespace List
@[simp] theorem mapFinIdx_toArray (l : List α) (f : Fin l.length α β) :
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
ext <;> simp
@[simp] theorem mapIdx_toArray (f : Nat α β) (l : List α) :
l.toArray.mapIdx f = (l.mapIdx f).toArray := by
ext <;> simp
end List

View File

@@ -10,16 +10,25 @@ import Init.Data.List.BasicAux
namespace Array
/-- `a ∈ as` is a predicate which asserts that `a` is in the array `as`. -/
-- NB: This is defined as a structure rather than a plain def so that a lemma
-- like `sizeOf_lt_of_mem` will not apply with no actual arrays around.
structure Mem (as : Array α) (a : α) : Prop where
val : a as.toList
instance : Membership α (Array α) where
mem := Mem
theorem sizeOf_lt_of_mem [SizeOf α] {as : Array α} (h : a as) : sizeOf a < sizeOf as := by
cases as with | _ as =>
exact Nat.lt_trans (List.sizeOf_lt_of_mem h.val) (by simp_arith)
theorem sizeOf_get [SizeOf α] (as : Array α) (i : Nat) (h : i < as.size) : sizeOf (as.get i h) < sizeOf as := by
theorem sizeOf_get [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
cases as with | _ as =>
simpa using Nat.lt_trans (List.sizeOf_get _ i, h) (by simp_arith)
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 _ _ h
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

View File

@@ -1,194 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.Array.Attach
import Init.Data.List.Monadic
/-!
# Lemmas about `Array.forIn'` and `Array.forIn`.
-/
namespace Array
open Nat
/-! ## Monadic operations -/
/-! ### mapM -/
theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α m β) (l : Array α) :
mapM f l = l.foldlM (fun acc a => return (acc.push ( f a))) #[] := by
rcases l with l
simp only [List.mapM_toArray, bind_pure_comp, size_toArray, List.foldlM_toArray']
rw [List.mapM_eq_reverse_foldlM_cons]
simp only [bind_pure_comp, Functor.map_map]
suffices (k), (fun a => a.reverse.toArray) <$> List.foldlM (fun acc a => (fun a => a :: acc) <$> f a) k l =
List.foldlM (fun acc a => acc.push <$> f a) k.reverse.toArray l by
exact this []
intro k
induction l generalizing k with
| nil => simp
| cons a as ih =>
simp [ih, List.foldlM_cons]
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Array β₁) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : Array β₁)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_map]
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldlM g init =
l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filterMap]
rfl
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldrM g init =
l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filterMap]
rfl
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β) (l : Array α) (init : β) :
(l.filter p).foldlM g init =
l.foldlM (fun x y => if p y then g x y else pure x) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filter]
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β) (l : Array α) (init : β) :
(l.filter p).foldrM g init =
l.foldrM (fun x y => if p x then g x y else pure y) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filter]
/-! ### forM -/
@[congr] theorem forM_congr [Monad m] {as bs : Array α} (w : as = bs)
{f : α m PUnit} :
forM f as = forM f bs := by
cases as <;> cases bs
simp_all
@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Array α) (g : α β) (f : β m PUnit) :
(l.map g).forM f = l.forM (fun a => f (g a)) := by
cases l
simp
/-! ### forIn' -/
@[congr] theorem forIn'_congr [Monad m] {as bs : Array α} (w : as = bs)
{b b' : β} (hb : b = b')
{f : (a' : α) a' as β m (ForInStep β)}
{g : (a' : α) a' bs β m (ForInStep β)}
(h : a m b, f a (by simpa [w] using m) b = g a m b) :
forIn' as b f = forIn' bs b' g := by
cases as <;> cases bs
simp only [mk.injEq, mem_toArray, List.forIn'_toArray] at w h
exact List.forIn'_congr w hb h
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m (ForInStep β)) (init : β) :
forIn' l init f = ForInStep.value <$>
l.attach.foldlM (fun b a, m => match b with
| .yield b => f a m b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp only [List.forIn'_toArray, List.forIn'_eq_foldlM, List.attachWith_mem_toArray, size_toArray,
List.length_map, List.length_attach, List.foldlM_toArray', List.foldlM_map]
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn'_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m γ) (g : (a : α) a l β γ β) (init : β) :
forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
l.attach.foldlM (fun b a, m => g a m b <$> f a m b) init := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' l init (fun a m b => pure (.yield (f a m b))) =
pure (f := m) (l.attach.foldl (fun b a, h => f a h b) init) := by
cases l
simp [List.forIn'_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn'_yield_eq_foldl
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' (m := Id) l init (fun a m b => .yield (f a m b)) =
l.attach.foldl (fun b a, h => f a h b) init := by
cases l
simp [List.foldl_map]
@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
(l : Array α) (g : α β) (f : (b : β) b l.map g γ m (ForInStep γ)) :
forIn' (l.map g) init f = forIn' l init fun a h y => f (g a) (mem_map_of_mem g h) y := by
cases l
simp
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn_eq_foldlM [Monad m] [LawfulMonad m]
(f : α β m (ForInStep β)) (init : β) (l : Array α) :
forIn l init f = ForInStep.value <$>
l.foldlM (fun b a => match b with
| .yield b => f a b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
simp only [List.forIn_toArray, List.forIn_eq_foldlM, size_toArray, List.foldlM_toArray']
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : α β m γ) (g : α β γ β) (init : β) :
forIn l init (fun a b => (fun c => .yield (g a b c)) <$> f a b) =
l.foldlM (fun b a => g a b <$> f a b) init := by
cases l
simp [List.foldlM_map]
theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : α β β) (init : β) :
forIn l init (fun a b => pure (.yield (f a b))) =
pure (f := m) (l.foldl (fun b a => f a b) init) := by
cases l
simp [List.forIn_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn_yield_eq_foldl
(l : Array α) (f : α β β) (init : β) :
forIn (m := Id) l init (fun a b => .yield (f a b)) =
l.foldl (fun b a => f a b) init := by
cases l
simp [List.foldl_map]
@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
(l : Array α) (g : α β) (f : β γ m (ForInStep γ)) :
forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
cases l
simp
end Array

View File

@@ -1,65 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Nat.Perm
import Init.Data.Array.Lemmas
namespace Array
open List
/--
`Perm as bs` asserts that `as` and `bs` are permutations of each other.
This is a wrapper around `List.Perm`, and for now has much less API.
For more complicated verification, use `perm_iff_toList_perm` and the `List` API.
-/
def Perm (as bs : Array α) : Prop :=
as.toList ~ bs.toList
@[inherit_doc] scoped infixl:50 " ~ " => Perm
theorem perm_iff_toList_perm {as bs : Array α} : as ~ bs as.toList ~ bs.toList := Iff.rfl
@[simp] theorem perm_toArray (as bs : List α) : as.toArray ~ bs.toArray as ~ bs := by
simp [perm_iff_toList_perm]
@[simp, refl] protected theorem Perm.refl (l : Array α) : l ~ l := by
cases l
simp
protected theorem Perm.rfl {l : List α} : l ~ l := .refl _
theorem Perm.of_eq {l₁ l₂ : Array α} (h : l₁ = l₂) : l₁ ~ l₂ := h .rfl
protected theorem Perm.symm {l₁ l₂ : Array α} (h : l₁ ~ l₂) : l₂ ~ l₁ := by
cases l₁; cases l₂
simp only [perm_toArray] at h
simpa using h.symm
protected theorem Perm.trans {l₁ l₂ l₃ : Array α} (h₁ : l₁ ~ l₂) (h₂ : l₂ ~ l₃) : l₁ ~ l₃ := by
cases l₁; cases l₂; cases l₃
simp only [perm_toArray] at h₁ h₂
simpa using h₁.trans h₂
instance : Trans (Perm (α := α)) (Perm (α := α)) (Perm (α := α)) where
trans h₁ h₂ := Perm.trans h₁ h₂
theorem perm_comm {l₁ l₂ : Array α} : l₁ ~ l₂ l₂ ~ l₁ := Perm.symm, Perm.symm
theorem Perm.push (x y : α) {l₁ l₂ : Array α} (p : l₁ ~ l₂) :
(l₁.push x).push y ~ (l₂.push y).push x := by
cases l₁; cases l₂
simp only [perm_toArray] at p
simp only [push_toArray, List.append_assoc, singleton_append, perm_toArray]
exact p.append (Perm.swap' _ _ Perm.nil)
theorem swap_perm {as : Array α} {i j : Nat} (h₁ : i < as.size) (h₂ : j < as.size) :
as.swap i j ~ as := by
simp only [swap, perm_iff_toList_perm, toList_set]
apply set_set_perm
end Array

View File

@@ -4,52 +4,44 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Vector.Basic
import Init.Data.Ord
import Init.Data.Array.Basic
namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
private def qpartition {n} (as : Vector α n) (lt : α α Bool) (lo hi : Nat)
(hlo : lo < n := by omega) (hhi : hi < n := by omega) : {n : Nat // lo n} × Vector α n :=
def qpartition (as : Array α) (lt : α α Bool) (lo hi : Nat) : Nat × Array α :=
if h : as.size = 0 then (0, as) else have : Inhabited α := as[0]'(by revert h; cases as.size <;> simp) -- TODO: remove
let mid := (lo + hi) / 2
let as := if lt as[mid] as[lo] then as.swap lo mid else as
let as := if lt as[hi] as[lo] then as.swap lo hi else as
let as := if lt as[mid] as[hi] then as.swap mid hi else as
let pivot := as[hi]
let rec loop (as : Vector α n) (i j : Nat)
(ilo : lo i := by omega) (jh : j < n := by omega) (w : i j := by omega) :=
let as := if lt (as.get! mid) (as.get! lo) then as.swap! lo mid else as
let as := if lt (as.get! hi) (as.get! lo) then as.swap! lo hi else as
let as := if lt (as.get! mid) (as.get! hi) then as.swap! mid hi else as
let pivot := as.get! hi
let rec loop (as : Array α) (i j : Nat) :=
if h : j < hi then
if lt as[j] pivot then
loop (as.swap i j) (i+1) (j+1)
if lt (as.get! j) pivot then
let as := as.swap! i j
loop as (i+1) (j+1)
else
loop as i (j+1)
else
(i, ilo, as.swap i hi)
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] def qsort (as : Array α) (lt : α α Bool := by exact (· < ·))
(low := 0) (high := as.size - 1) : Array α :=
let rec @[specialize] sort {n} (as : Vector α n) (lo hi : Nat)
(hlo : lo < n := by omega) (hhi : hi < n := by omega) :=
if h₁ : lo < hi then
let mid, hmid, as := qpartition as lt lo hi
if h₂ : mid hi then
as
@[inline] partial def qsort (as : Array α) (lt : α α Bool) (low := 0) (high := as.size - 1) : Array α :=
let rec @[specialize] sort (as : Array α) (low high : Nat) :=
if low < high then
let p := qpartition as lt low high;
-- TODO: fix `partial` support in the equation compiler, it breaks if we use `let (mid, as) := partition as lt low high`
let mid := p.1
let as := p.2
if mid >= high then as
else
sort (sort as lo mid) (mid+1) hi
let as := sort as low mid
sort as (mid+1) high
else as
if h : as.size = 0 then
as
else
let low := min low (as.size - 1)
let high := min high (as.size - 1)
sort as, rfl low high |>.toArray
set_option linter.unusedVariables.funArgs false in
/--
Sort an array using `compare` to compare elements.
-/
def qsortOrd [ord : Ord α] (xs : Array α) : Array α :=
xs.qsort fun x y => compare x y |>.isLT
sort as low high
end Array

View File

@@ -1,41 +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.Tactics
/--
Set an element in an array, using a proof that the index is in bounds.
(This proof can usually be omitted, and will be synthesized automatically.)
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_fset"]
def Array.set (a : Array α) (i : @& Nat) (v : α) (h : i < a.size := by get_elem_tactic) :
Array α where
toList := a.toList.set i v
/--
Set an element in an array, or do nothing if the index is out of bounds.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[inline] def Array.setIfInBounds (a : Array α) (i : Nat) (v : α) : Array α :=
dite (LT.lt i a.size) (fun h => a.set i v h) (fun _ => a)
@[deprecated Array.setIfInBounds (since := "2024-11-24")] abbrev Array.setD := @Array.setIfInBounds
/--
Set an element in an array, or panic if the index is out of bounds.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_set"]
def Array.set! (a : Array α) (i : @& Nat) (v : α) : Array α :=
Array.setIfInBounds a i v

View File

@@ -15,6 +15,15 @@ structure Subarray (α : Type u) where
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
namespace Subarray
def size (s : Subarray α) : Nat :=
@@ -39,7 +48,7 @@ instance : GetElem (Subarray α) Nat α fun xs i => i < xs.size where
getElem xs i h := xs.get i, h
@[inline] def getD (s : Subarray α) (i : Nat) (v₀ : α) : α :=
if h : i < s.size then s[i] else v₀
if h : i < s.size then s.get i, h else v₀
abbrev get! [Inhabited α] (s : Subarray α) (i : Nat) : α :=
getD s i default
@@ -50,22 +59,6 @@ def popFront (s : Subarray α) : Subarray α :=
else
s
/--
The empty subarray.
-/
protected def empty : Subarray α where
array := #[]
start := 0
stop := 0
start_le_stop := Nat.le_refl 0
stop_le_array_size := Nat.le_refl 0
instance : EmptyCollection (Subarray α) :=
Subarray.empty
instance : Inhabited (Subarray α) :=
{}
@[inline] unsafe def forInUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (s : Subarray α) (b : β) (f : α β m (ForInStep β)) : m β :=
let sz := USize.ofNat s.stop
let rec @[specialize] loop (i : USize) (b : β) : m β := do

View File

@@ -23,13 +23,16 @@ 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 omega
stop_le_array_size := by assumption
}
let post := {s with
start := s.start + i'
@@ -45,7 +48,9 @@ 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 omega
start_le_stop := by
rw [Nat.min_def]
split <;> simp only [Nat.le_refl, *]
stop_le_array_size := arr.stop_le_array_size
/--
@@ -58,7 +63,9 @@ def take (arr : Subarray α) (i : Nat) : Subarray α where
stop := min (arr.start + i) arr.stop
start_le_stop := by
have := arr.start_le_stop
omega
rw [Nat.min_def]
split <;> omega
stop_le_array_size := by
have := arr.stop_le_array_size
omega
rw [Nat.min_def]
split <;> omega

View File

@@ -12,7 +12,6 @@ namespace Array
theorem exists_of_uset (self : Array α) (i d h) :
l₁ l₂, self.toList = l₁ ++ self[i] :: l₂ List.length l₁ = i.toNat
(self.uset i d h).toList = l₁ ++ d :: l₂ := by
simpa only [ugetElem_eq_getElem, getElem_toList, uset, toList_set] using
List.exists_of_set _
simpa [Array.getElem_eq_toList_getElem] using List.exists_of_set _
end Array

View File

@@ -40,9 +40,6 @@ theorem BEq.symm [BEq α] [PartialEquivBEq α] {a b : α} : a == b → b == a :=
theorem BEq.comm [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = (b == a) :=
Bool.eq_iff_iff.2 BEq.symm, BEq.symm
theorem bne_comm [BEq α] [PartialEquivBEq α] {a b : α} : (a != b) = (b != a) := by
rw [bne, BEq.comm, bne]
theorem BEq.symm_false [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = false (b == a) = false :=
BEq.comm (α := α) id

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: Kim Morrison
Authors: Scott Morrison
-/
prelude
import Init.Data.BitVec.Basic

View File

@@ -1,20 +1,19 @@
/-
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, Siddharth Bhat
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
-/
prelude
import Init.Data.Fin.Basic
import Init.Data.Nat.Bitwise.Lemmas
import Init.Data.Nat.Power2
import Init.Data.Int.Bitwise
import Init.Data.BitVec.BasicAux
/-!
We define the basic algebraic structure of bitvectors. We choose the `Fin` representation over
others for its relative efficiency (Lean has special support for `Nat`), and the fact that bitwise
operations on `Fin` are already defined. Some other possible representations are `List Bool`,
`{ l : List Bool // l.length = w }`, `Fin w → Bool`.
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
(Lean has special support for `Nat`), alignment with `UIntXY` types which are also represented
with `Fin`, and the fact that bitwise operations on `Fin` are already defined. Some other possible
representations are `List Bool`, `{ l : List Bool // l.length = w }`, `Fin w → Bool`.
We define many of the bitvector operations from the
[`QF_BV` logic](https://smtlib.cs.uiowa.edu/logics-all.shtml#QF_BV).
@@ -23,12 +22,63 @@ of SMT-LIBv2.
set_option linter.missingDocs true
/--
A bitvector of the specified width.
This is represented as the underlying `Nat` number in both the runtime
and the kernel, inheriting all the special support for `Nat`.
-/
structure BitVec (w : Nat) where
/-- Construct a `BitVec w` from a number less than `2^w`.
O(1), because we use `Fin` as the internal representation of a bitvector. -/
ofFin ::
/-- Interpret a bitvector as a number less than `2^w`.
O(1), because we use `Fin` as the internal representation of a bitvector. -/
toFin : Fin (2^w)
/--
Bitvectors have decidable equality. This should be used via the instance `DecidableEq (BitVec n)`.
-/
-- We manually derive the `DecidableEq` instances for `BitVec` because
-- we want to have builtin support for bit-vector literals, and we
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
def BitVec.decEq (x y : BitVec n) : Decidable (x = y) :=
match x, y with
| n, m =>
if h : n = m then
isTrue (h rfl)
else
isFalse (fun h' => BitVec.noConfusion h' (fun h' => absurd h' h))
instance : DecidableEq (BitVec n) := BitVec.decEq
namespace BitVec
section Nat
/-- The `BitVec` with value `i`, given a proof that `i < 2^n`. -/
@[match_pattern]
protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
toFin := i, p
/-- The `BitVec` with value `i mod 2^n`. -/
@[match_pattern]
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
toFin := Fin.ofNat' (2^n) i
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
instance natCastInst : NatCast (BitVec w) := BitVec.ofNat w
/-- Given a bitvector `x`, return the underlying `Nat`. This is O(1) because `BitVec` is a
(zero-cost) wrapper around a `Nat`. -/
protected def toNat (x : BitVec n) : Nat := x.toFin.val
/-- Return the bound in terms of toNat. -/
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
@[deprecated isLt (since := "2024-03-12")]
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
/-- Theorem for normalizing the bit vector literal representation. -/
-- TODO: This needs more usage data to assess which direction the simp should go.
@[simp, bv_toNat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
@@ -123,9 +173,6 @@ instance : GetElem (BitVec w) Nat Bool fun _ i => i < w where
theorem getElem_eq_testBit_toNat (x : BitVec w) (i : Nat) (h : i < w) :
x[i] = x.toNat.testBit i := rfl
theorem getLsbD_eq_getElem {x : BitVec w} {i : Nat} (h : i < w) :
x.getLsbD i = x[i] := rfl
end getElem
section Int
@@ -188,6 +235,22 @@ end repr_toString
section arithmetic
/--
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
modulo `2^n`.
SMT-Lib name: `bvadd`.
-/
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
instance : Add (BitVec n) := BitVec.add
/--
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
modulo `2^n`.
-/
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
instance : Sub (BitVec n) := BitVec.sub
/--
Negation for bit vectors. This can be interpreted as either signed or unsigned negation
modulo `2^n`.
@@ -203,8 +266,8 @@ Return the absolute value of a signed bitvector.
protected def abs (x : BitVec n) : BitVec n := if x.msb then .neg x else x
/--
Multiplication for bit vectors. This can be interpreted as either signed or unsigned
multiplication modulo `2^n`.
Multiplication for bit vectors. This can be interpreted as either signed or unsigned negation
modulo `2^n`.
SMT-Lib name: `bvmul`.
-/
@@ -321,6 +384,10 @@ SMT-Lib name: `bvult`.
-/
protected def ult (x y : BitVec n) : Bool := x.toNat < y.toNat
instance : LT (BitVec n) where lt := (·.toNat < ·.toNat)
instance (x y : BitVec n) : Decidable (x < y) :=
inferInstanceAs (Decidable (x.toNat < y.toNat))
/--
Unsigned less-than-or-equal-to for bit vectors.
@@ -328,6 +395,10 @@ SMT-Lib name: `bvule`.
-/
protected def ule (x y : BitVec n) : Bool := x.toNat y.toNat
instance : LE (BitVec n) where le := (·.toNat ·.toNat)
instance (x y : BitVec n) : Decidable (x y) :=
inferInstanceAs (Decidable (x.toNat y.toNat))
/--
Signed less-than for bit vectors.
@@ -351,17 +422,17 @@ end relations
section cast
/-- `cast eq x` embeds `x` into an equal `BitVec` type. -/
@[inline] protected def cast (eq : n = m) (x : BitVec n) : BitVec m := .ofNatLt x.toNat (eq x.isLt)
@[inline] def cast (eq : n = m) (x : BitVec n) : BitVec m := .ofNatLt x.toNat (eq x.isLt)
@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) :
(BitVec.ofNat n x).cast h = BitVec.ofNat m x := by
cast h (BitVec.ofNat n x) = BitVec.ofNat m x := by
subst h; rfl
@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) :
(x.cast h).cast h = x.cast (h₁ h₂) :=
cast h (cast h x) = cast (h₁ h₂) x :=
rfl
@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : x.cast h = x := rfl
@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : cast h x = x := rfl
/--
Extraction of bits `start` to `start + len - 1` from a bit vector of size `n` to yield a
@@ -379,15 +450,13 @@ SMT-Lib name: `extract`.
def extractLsb (hi lo : Nat) (x : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ x
/--
A version of `setWidth` that requires a proof, but is a noop.
A version of `zeroExtend` that requires a proof, but is a noop.
-/
def setWidth' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
def zeroExtend' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
x.toNat#'(by
apply Nat.lt_of_lt_of_le x.isLt
exact Nat.pow_le_pow_of_le_right (by trivial) le)
@[deprecated setWidth' (since := "2024-09-18"), inherit_doc setWidth'] abbrev zeroExtend' := @setWidth'
/--
`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without
needing to compute `x % 2^(2+n)`.
@@ -400,35 +469,22 @@ def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w + m) :=
(msbs.toNat <<< m)#'(shiftLeftLt msbs.isLt m)
/--
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
Zero extend vector `x` of length `w` by adding zeros in the high bits until it has length `v`.
If `v < w` then it truncates the high bits instead.
SMT-Lib name: `zero_extend`.
-/
def setWidth (v : Nat) (x : BitVec w) : BitVec v :=
def zeroExtend (v : Nat) (x : BitVec w) : BitVec v :=
if h : w v then
setWidth' h x
zeroExtend' h x
else
.ofNat v x.toNat
/--
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
SMT-Lib name: `zero_extend`.
Truncate the high bits of bitvector `x` of length `w`, resulting in a vector of length `v`.
If `v > w` then it zero-extends the vector instead.
-/
abbrev zeroExtend := @setWidth
/--
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
SMT-Lib name: `zero_extend`.
-/
abbrev truncate := @setWidth
abbrev truncate := @zeroExtend
/--
Sign extend a vector of length `w`, extending with `i` additional copies of the most significant
@@ -579,7 +635,7 @@ input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`.
SMT-Lib name: `concat`.
-/
def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) :=
shiftLeftZeroExtend msbs m ||| setWidth' (Nat.le_add_left m n) lsbs
shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs
instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := .append
@@ -602,13 +658,6 @@ result of appending a single bit to the front in the naive implementation).
That is, the new bit is the least significant bit. -/
def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool lsb)
/--
`x.shiftConcat b` shifts all bits of `x` to the left by `1` and sets the least significant bit to `b`.
It is a non-dependent version of `concat` that does not change the total bitwidth.
-/
def shiftConcat (x : BitVec n) (b : Bool) : BitVec n :=
(x.concat b).truncate n
/-- Prepend a single bit to the front of a bitvector, using big endian order (see `append`).
That is, the new bit is the most significant bit. -/
def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) :=
@@ -631,16 +680,6 @@ def twoPow (w : Nat) (i : Nat) : BitVec w := 1#w <<< i
end bitwise
/-- Compute a hash of a bitvector, combining 64-bit words using `mixHash`. -/
def hash (bv : BitVec n) : UInt64 :=
if n 64 then
bv.toFin.val.toUInt64
else
mixHash (bv.toFin.val.toUInt64) (hash ((bv >>> 64).setWidth (n - 64)))
instance : Hashable (BitVec n) where
hash := hash
section normalization_eqs
/-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/
@[simp] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y := rfl
@@ -654,8 +693,6 @@ section normalization_eqs
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
@[simp] theorem udiv_eq (x y : BitVec w) : BitVec.udiv x y = x / y := rfl
@[simp] theorem umod_eq (x y : BitVec w) : BitVec.umod x y = x % y := rfl
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
end normalization_eqs

View File

@@ -1,52 +0,0 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
-/
prelude
import Init.Data.Fin.Basic
set_option linter.missingDocs true
/-!
This module exists to provide the very basic `BitVec` definitions required for
`Init.Data.UInt.BasicAux`.
-/
namespace BitVec
section Nat
/-- The `BitVec` with value `i mod 2^n`. -/
@[match_pattern]
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
toFin := Fin.ofNat' (2^n) i
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
/-- Return the bound in terms of toNat. -/
theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
end Nat
section arithmetic
/--
Addition for bit vectors. This can be interpreted as either signed or unsigned addition
modulo `2^n`.
SMT-Lib name: `bvadd`.
-/
protected def add (x y : BitVec n) : BitVec n := .ofNat n (x.toNat + y.toNat)
instance : Add (BitVec n) := BitVec.add
/--
Subtraction for bit vectors. This can be interpreted as either signed or unsigned subtraction
modulo `2^n`.
-/
protected def sub (x y : BitVec n) : BitVec n := .ofNat n ((2^n - y.toNat) + x.toNat)
instance : Sub (BitVec n) := BitVec.sub
end arithmetic
end BitVec

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: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix, Siddharth Bhat
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
-/
prelude
import Init.Data.BitVec.Folds
@@ -18,80 +18,6 @@ as vectors of bits into proofs about Lean `BitVec` values.
The module is named for the bit-blasting operation in an SMT solver that converts bitvector
expressions into expressions about individual bits in each vector.
### Example: How bitblasting works for multiplication
We explain how the lemmas here are used for bitblasting,
by using multiplication as a prototypical example.
Other bitblasters for other operations follow the same pattern.
To bitblast a multiplication of the form `x * y`,
we must unfold the above into a form that the SAT solver understands.
We assume that the solver already knows how to bitblast addition.
This is known to `bv_decide`, by exploiting the lemma `add_eq_adc`,
which says that `x + y : BitVec w` equals `(adc x y false).2`,
where `adc` builds an add-carry circuit in terms of the primitive operations
(bitwise and, bitwise or, bitwise xor) that bv_decide already understands.
In this way, we layer bitblasters on top of each other,
by reducing the multiplication bitblaster to an addition operation.
The core lemma is given by `getLsbD_mul`:
```lean
x y : BitVec w ⊢ (x * y).getLsbD i = (mulRec x y w).getLsbD i
```
Which says that the `i`th bit of `x * y` can be obtained by
evaluating the `i`th bit of `(mulRec x y w)`.
Once again, we assume that `bv_decide` knows how to implement `getLsbD`,
given that `mulRec` can be understood by `bv_decide`.
We write two lemmas to enable `bv_decide` to unfold `(mulRec x y w)`
into a complete circuit, **when `w` is a known constant**`.
This is given by two recurrence lemmas, `mulRec_zero_eq` and `mulRec_succ_eq`,
which are applied repeatedly when the width is `0` and when the width is `w' + 1`:
```lean
mulRec_zero_eq :
mulRec x y 0 =
if y.getLsbD 0 then x else 0
mulRec_succ_eq
mulRec x y (s + 1) =
mulRec x y s +
if y.getLsbD (s + 1) then (x <<< (s + 1)) else 0 := rfl
```
By repeatedly applying the lemmas `mulRec_zero_eq` and `mulRec_succ_eq`,
one obtains a circuit for multiplication.
Note that this circuit uses `BitVec.add`, `BitVec.getLsbD`, `BitVec.shiftLeft`.
Here, `BitVec.add` and `BitVec.shiftLeft` are (recursively) bitblasted by `bv_decide`,
using the lemmas `add_eq_adc` and `shiftLeft_eq_shiftLeftRec`,
and `BitVec.getLsbD` is a primitive that `bv_decide` knows how to reduce to SAT.
The two lemmas, `mulRec_zero_eq`, and `mulRec_succ_eq`,
are used in `Std.Tactic.BVDecide.BVExpr.bitblast.blastMul`
to prove the correctness of the circuit that is built by `bv_decide`.
```lean
def blastMul (aig : AIG BVBit) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry BVBit w
theorem denote_blastMul (aig : AIG BVBit) (lhs rhs : BitVec w) (assign : Assignment) :
...
⟦(blastMul aig input).aig, (blastMul aig input).vec[idx], assign.toAIGAssignment⟧
=
(lhs * rhs).getLsbD idx
```
The definition and theorem above are internal to `bv_decide`,
and use `mulRec_{zero,succ}_eq` to prove that the circuit built by `bv_decide`
computes the correct value for multiplication.
To zoom out, therefore, we follow two steps:
First, we prove bitvector lemmas to unfold a high-level operation (such as multiplication)
into already bitblastable operations (such as addition and left shift).
We then use these lemmas to prove the correctness of the circuit that `bv_decide` builds.
We use this workflow to implement bitblasting for all SMT-LIB2 operations.
## Main results
* `x + y : BitVec w` is `(adc x y false).2`.
@@ -174,30 +100,6 @@ theorem carry_succ (i : Nat) (x y : BitVec w) (c : Bool) :
exact mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ ..
cases x.toNat.testBit i <;> cases y.toNat.testBit i <;> (simp; omega)
theorem carry_succ_one (i : Nat) (x : BitVec w) (h : 0 < w) :
carry (i+1) x (1#w) false = decide ( j i, x.getLsbD j = true) := by
induction i with
| zero => simp [carry_succ, h]
| succ i ih =>
rw [carry_succ, ih]
simp only [getLsbD_one, add_one_ne_zero, decide_false, Bool.and_false, atLeastTwo_false_mid]
cases hx : x.getLsbD (i+1)
case false =>
have : j i + 1, x.getLsbD j = false :=
i+1, by omega, hx
simpa
case true =>
suffices
( (j : Nat), j i x.getLsbD j = true)
( (j : Nat), j i + 1 x.getLsbD j = true) by
simpa
constructor
· intro h j hj
rcases Nat.le_or_eq_of_le_succ hj with (hj' | rfl)
· apply h; assumption
· exact hx
· intro h j hj; apply h; omega
/--
If `x &&& y = 0`, then the carry bit `(x + y + 0)` is always `false` for any index `i`.
Intuitively, this is because a carry is only produced when at least two of `x`, `y`, and the
@@ -230,18 +132,18 @@ theorem toNat_add_of_and_eq_zero {x y : BitVec w} (h : x &&& y = 0#w) :
simp [not_eq_true, carry_of_and_eq_zero h]
/-- Carry function for bitwise addition. -/
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, x ^^ (y ^^ c))
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c))
/-- Bitwise addition implemented via a ripple carry adder. -/
def adc (x y : BitVec w) : Bool Bool × BitVec w :=
iunfoldr fun (i : Fin w) c => adcb (x.getLsbD i) (y.getLsbD i) c
theorem getLsbD_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
getLsbD (x + y + setWidth w (ofBool c)) i =
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y c)) := by
getLsbD (x + y + zeroExtend w (ofBool c)) i =
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y c)) := by
let x, x_lt := x
let y, y_lt := y
simp only [getLsbD, toNat_add, toNat_setWidth, i_lt, toNat_ofFin, toNat_ofBool,
simp only [getLsbD, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool,
Nat.mod_add_mod, Nat.add_mod_mod]
apply Eq.trans
rw [ Nat.div_add_mod x (2^i), Nat.div_add_mod y (2^i)]
@@ -249,7 +151,7 @@ theorem getLsbD_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool
[ Nat.testBit_mod_two_pow,
Nat.testBit_mul_two_pow_add_eq,
i_lt,
decide_true,
decide_True,
Bool.true_and,
Nat.add_assoc,
Nat.add_left_comm (_%_) (_ * _) _,
@@ -259,26 +161,15 @@ theorem getLsbD_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool
theorem getLsbD_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
getLsbD (x + y) i =
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y false)) := by
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y false)) := by
simpa using getLsbD_add_add_bool i_lt x y false
theorem getElem_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
(x + y + setWidth w (ofBool c))[i] =
(x[i] ^^ (y[i] ^^ carry i x y c)) := by
simp only [ getLsbD_eq_getElem]
rw [getLsbD_add_add_bool]
omega
theorem getElem_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
(x + y)[i] = (x[i] ^^ (y[i] ^^ carry i x y false)) := by
simpa using getElem_add_add_bool i_lt x y false
theorem adc_spec (x y : BitVec w) (c : Bool) :
adc x y c = (carry w x y c, x + y + setWidth w (ofBool c)) := by
adc x y c = (carry w x y c, x + y + zeroExtend w (ofBool c)) := by
simp only [adc]
apply iunfoldr_replace
(fun i => carry i x y c)
(x + y + setWidth w (ofBool c))
(x + y + zeroExtend w (ofBool c))
c
case init =>
simp [carry, Nat.mod_one]
@@ -291,21 +182,6 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
/-! ### add -/
theorem getMsbD_add {i : Nat} {i_lt : i < w} {x y : BitVec w} :
getMsbD (x + y) i =
Bool.xor (getMsbD x i) (Bool.xor (getMsbD y i) (carry (w - 1 - i) x y false)) := by
simp [getMsbD, getLsbD_add, i_lt, show w - 1 - i < w by omega]
theorem msb_add {w : Nat} {x y: BitVec w} :
(x + y).msb =
Bool.xor x.msb (Bool.xor y.msb (carry (w - 1) x y false)) := by
simp only [BitVec.msb, BitVec.getMsbD]
by_cases h : w 0
· simp [h, show w = 0 by omega]
· rw [getLsbD_add (x := x)]
simp [show w > 0 by omega]
omega
/-- Adding a bitvector to its own complement yields the all ones bitpattern -/
@[simp] theorem add_not_self (x : BitVec w) : x + ~~~x = allOnes w := by
rw [add_eq_adc, adc, iunfoldr_replace (fun _ => false) (allOnes w)]
@@ -331,30 +207,6 @@ theorem add_eq_or_of_and_eq_zero {w : Nat} (x y : BitVec w)
simp_all [hx]
· by_cases hx : x.getLsbD i <;> simp_all [hx]
/-! ### Sub-/
theorem getLsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
(x - y).getLsbD i
= (x.getLsbD i ^^ ((~~~y + 1#w).getLsbD i ^^ carry i x (~~~y + 1#w) false)) := by
rw [sub_toAdd, BitVec.neg_eq_not_add, getLsbD_add]
omega
theorem getMsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
(x - y).getMsbD i =
(x.getMsbD i ^^ ((~~~y + 1).getMsbD i ^^ carry (w - 1 - i) x (~~~y + 1) false)) := by
rw [sub_toAdd, neg_eq_not_add, getMsbD_add]
· rfl
· omega
theorem getElem_sub {i : Nat} {x y : BitVec w} (h : i < w) :
(x - y)[i] = (x[i] ^^ ((~~~y + 1#w)[i] ^^ carry i x (~~~y + 1#w) false)) := by
simp [ getLsbD_eq_getElem, getLsbD_sub, h]
theorem msb_sub {x y: BitVec w} :
(x - y).msb
= (x.msb ^^ ((~~~y + 1#w).msb ^^ carry (w - 1 - 0) x (~~~y + 1#w) false)) := by
simp [sub_toAdd, BitVec.neg_eq_not_add, msb_add]
/-! ### Negation -/
theorem bit_not_testBit (x : BitVec w) (i : Fin w) :
@@ -380,121 +232,6 @@ theorem bit_neg_eq_neg (x : BitVec w) : -x = (adc (((iunfoldr (fun (i : Fin w) c
simp [ sub_toAdd, BitVec.sub_add_cancel]
· simp [bit_not_testBit x _]
/--
Remember that negating a bitvector is equal to incrementing the complement
by one, i.e., `-x = ~~~x + 1`. See also `neg_eq_not_add`.
This computation has two crucial properties:
- The least significant bit of `-x` is the same as the least significant bit of `x`, and
- The `i+1`-th least significant bit of `-x` is the complement of the `i+1`-th bit of `x`, unless
all of the preceding bits are `false`, in which case the bit is equal to the `i+1`-th bit of `x`
-/
theorem getLsbD_neg {i : Nat} {x : BitVec w} :
getLsbD (-x) i =
(getLsbD x i ^^ decide (i < w) && decide ( j < i, getLsbD x j = true)) := by
rw [neg_eq_not_add]
by_cases hi : i < w
· rw [getLsbD_add hi]
have : 0 < w := by omega
simp only [getLsbD_not, hi, decide_true, Bool.true_and, getLsbD_one, this, not_bne,
_root_.true_and, not_eq_eq_eq_not]
cases i with
| zero =>
have carry_zero : carry 0 ?x ?y false = false := by
simp [carry]; omega
simp [hi, carry_zero]
| succ =>
rw [carry_succ_one _ _ (by omega), Bool.xor_not, decide_not]
simp only [add_one_ne_zero, decide_false, getLsbD_not, and_eq_true, decide_eq_true_eq,
not_eq_eq_eq_not, Bool.not_true, false_bne, not_exists, _root_.not_and, not_eq_true,
bne_right_inj, decide_eq_decide]
constructor
· rintro h j hj; exact And.right <| h j (by omega)
· rintro h j hj; exact by omega, h j (by omega)
· have h_ge : w i := by omega
simp [getLsbD_ge _ _ h_ge, h_ge, hi]
theorem getElem_neg {i : Nat} {x : BitVec w} (h : i < w) :
(-x)[i] = (x[i] ^^ decide ( j < i, x.getLsbD j = true)) := by
simp [ getLsbD_eq_getElem, getLsbD_neg, h]
theorem getMsbD_neg {i : Nat} {x : BitVec w} :
getMsbD (-x) i =
(getMsbD x i ^^ decide ( j < w, i < j getMsbD x j = true)) := by
simp only [getMsbD, getLsbD_neg, Bool.decide_and, Bool.and_eq_true, decide_eq_true_eq]
by_cases hi : i < w
case neg =>
simp [hi]; omega
case pos =>
have h₁ : w - 1 - i < w := by omega
simp only [hi, decide_true, h₁, Bool.true_and, Bool.bne_right_inj, decide_eq_decide]
constructor
· rintro j, hj, h
refine w - 1 - j, by omega, by omega, by omega, _root_.cast ?_ h
congr; omega
· rintro j, hj₁, hj₂, -, h
exact w - 1 - j, by omega, h
theorem msb_neg {w : Nat} {x : BitVec w} :
(-x).msb = ((x != 0#w && x != intMin w) ^^ x.msb) := by
simp only [BitVec.msb, getMsbD_neg]
by_cases hmin : x = intMin _
case pos =>
have : ( j, j < w 0 < j 0 < w j = 0) False := by
simp; omega
simp [hmin, getMsbD_intMin, this]
case neg =>
by_cases hzero : x = 0#w
case pos => simp [hzero]
case neg =>
have w_pos : 0 < w := by
cases w
· rw [@of_length_zero x] at hzero
contradiction
· omega
suffices j, j < w 0 < j x.getMsbD j = true
by simp [show x != 0#w by simpa, show x != intMin w by simpa, this]
false_or_by_contra
rename_i getMsbD_x
simp only [not_exists, _root_.not_and, not_eq_true] at getMsbD_x
/- `getMsbD` says that all bits except the msb are `false` -/
cases hmsb : x.msb
case true =>
apply hmin
apply eq_of_getMsbD_eq
intro i hi
simp only [getMsbD_intMin, w_pos, decide_true, Bool.true_and]
cases i
case zero => exact hmsb
case succ => exact getMsbD_x _ hi (by omega)
case false =>
apply hzero
apply eq_of_getMsbD_eq
intro i hi
simp only [getMsbD_zero]
cases i
case zero => exact hmsb
case succ => exact getMsbD_x _ hi (by omega)
/-! ### abs -/
theorem msb_abs {w : Nat} {x : BitVec w} :
x.abs.msb = (decide (x = intMin w) && decide (0 < w)) := by
simp only [BitVec.abs, getMsbD_neg, ne_eq, decide_not, Bool.not_bne]
by_cases h₀ : 0 < w
· by_cases h₁ : x = intMin w
· simp [h₁, msb_intMin]
· simp only [neg_eq, h₁, decide_false]
by_cases h₂ : x.msb
· simp [h₂, msb_neg]
and_intros
· by_cases h₃ : x = 0#w
· simp [h₃] at h₂
· simp [h₃]
· simp [h₁]
· simp [h₂]
· simp [BitVec.msb, show w = 0 by omega]
/-! ### Inequalities (le / lt) -/
theorem ult_eq_not_carry (x y : BitVec w) : x.ult y = !carry w x (~~~y) true := by
@@ -569,48 +306,43 @@ theorem mulRec_succ_eq (x y : BitVec w) (s : Nat) :
Recurrence lemma: truncating to `i+1` bits and then zero extending to `w`
equals truncating upto `i` bits `[0..i-1]`, and then adding the `i`th bit of `x`.
-/
theorem setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow (x : BitVec w) (i : Nat) :
setWidth w (x.setWidth (i + 1)) =
setWidth w (x.setWidth i) + (x &&& twoPow w i) := by
theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w) (i : Nat) :
zeroExtend w (x.truncate (i + 1)) =
zeroExtend w (x.truncate i) + (x &&& twoPow w i) := by
rw [add_eq_or_of_and_eq_zero]
· ext k h
simp only [getLsbD_setWidth, h, decide_true, Bool.true_and, getLsbD_or, getLsbD_and]
· ext k
simp only [getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsbD_or, getLsbD_and]
by_cases hik : i = k
· subst hik
simp [h]
· simp only [getLsbD_twoPow, hik, decide_false, Bool.and_false, Bool.or_false]
simp
· simp only [getLsbD_twoPow, hik, decide_False, Bool.and_false, Bool.or_false]
by_cases hik' : k < (i + 1)
· have hik'' : k < i := by omega
simp [hik', hik'']
· have hik'' : ¬ (k < i) := by omega
simp [hik', hik'']
· ext k
simp only [and_twoPow, getLsbD_and, getLsbD_setWidth, Fin.is_lt, decide_true, Bool.true_and,
simp only [and_twoPow, getLsbD_and, getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and,
getLsbD_zero, and_eq_false_imp, and_eq_true, decide_eq_true_eq, and_imp]
by_cases hi : x.getLsbD i <;> simp [hi] <;> omega
@[deprecated setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow (since := "2024-09-18"),
inherit_doc setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow]
abbrev zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow :=
@setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow
/--
Recurrence lemma: multiplying `x` with the first `s` bits of `y` is the
same as truncating `y` to `s` bits, then zero extending to the original length,
and performing the multplication. -/
theorem mulRec_eq_mul_signExtend_setWidth (x y : BitVec w) (s : Nat) :
mulRec x y s = x * ((y.setWidth (s + 1)).setWidth w) := by
theorem mulRec_eq_mul_signExtend_truncate (x y : BitVec w) (s : Nat) :
mulRec x y s = x * ((y.truncate (s + 1)).zeroExtend w) := by
induction s
case zero =>
simp only [mulRec_zero_eq, ofNat_eq_ofNat, Nat.reduceAdd]
by_cases y.getLsbD 0
case pos hy =>
simp only [hy, reduceIte, setWidth_one_eq_ofBool_getLsb_zero,
simp only [hy, reduceIte, truncate, zeroExtend_one_eq_ofBool_getLsb_zero,
ofBool_true, ofNat_eq_ofNat]
rw [setWidth_ofNat_one_eq_ofNat_one_of_lt (by omega)]
rw [zeroExtend_ofNat_one_eq_ofNat_one_of_lt (by omega)]
simp
case neg hy =>
simp [hy, setWidth_one_eq_ofBool_getLsb_zero]
simp [hy, zeroExtend_one_eq_ofBool_getLsb_zero]
case succ s' hs =>
rw [mulRec_succ_eq, hs]
have heq :
@@ -618,23 +350,16 @@ theorem mulRec_eq_mul_signExtend_setWidth (x y : BitVec w) (s : Nat) :
(x * (y &&& (BitVec.twoPow w (s' + 1)))) := by
simp only [ofNat_eq_ofNat, and_twoPow]
by_cases hy : y.getLsbD (s' + 1) <;> simp [hy]
rw [heq, BitVec.mul_add, setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow]
@[deprecated mulRec_eq_mul_signExtend_setWidth (since := "2024-09-18"),
inherit_doc mulRec_eq_mul_signExtend_setWidth]
abbrev mulRec_eq_mul_signExtend_truncate := @mulRec_eq_mul_signExtend_setWidth
rw [heq, BitVec.mul_add, zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow]
theorem getLsbD_mul (x y : BitVec w) (i : Nat) :
(x * y).getLsbD i = (mulRec x y w).getLsbD i := by
simp only [mulRec_eq_mul_signExtend_setWidth]
rw [setWidth_setWidth_of_le]
simp only [mulRec_eq_mul_signExtend_truncate]
rw [truncate, truncate_eq_zeroExtend, truncate_eq_zeroExtend,
truncate_truncate_of_le]
· simp
· omega
theorem getElem_mul {x y : BitVec w} {i : Nat} (h : i < w) :
(x * y)[i] = (mulRec x y w)[i] := by
simp [mulRec_eq_mul_signExtend_setWidth]
/-! ## shiftLeft recurrence for bitblasting -/
/--
@@ -677,22 +402,22 @@ theorem shiftLeft_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
`shiftLeftRec x y n` shifts `x` to the left by the first `n` bits of `y`.
-/
theorem shiftLeftRec_eq {x : BitVec w₁} {y : BitVec w₂} {n : Nat} :
shiftLeftRec x y n = x <<< (y.setWidth (n + 1)).setWidth w₂ := by
shiftLeftRec x y n = x <<< (y.truncate (n + 1)).zeroExtend w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, setWidth_one,
and_one_eq_setWidth_ofBool_getLsbD]
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, truncate_one,
and_one_eq_zeroExtend_ofBool_getLsbD]
case succ n ih =>
simp only [shiftLeftRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsbD (n + 1)
· simp only [h, reduceIte]
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
shiftLeft_or_of_and_eq_zero]
simp [and_twoPow]
· simp only [h, false_eq_true, reduceIte, shiftLeft_zero']
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)]
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)]
simp [h]
/--
@@ -705,385 +430,6 @@ theorem shiftLeft_eq_shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) :
· simp [of_length_zero]
· simp [shiftLeftRec_eq]
/-! # udiv/urem recurrence for bitblasting
In order to prove the correctness of the division algorithm on the integers,
one shows that `n.div d = q` and `n.mod d = r` iff `n = d * q + r` and `0 ≤ r < d`.
Mnemonic: `n` is the numerator, `d` is the denominator, `q` is the quotient, and `r` the remainder.
This *uniqueness of decomposition* is not true for bitvectors.
For `n = 0, d = 3, w = 3`, we can write:
- `0 = 0 * 3 + 0` (`q = 0`, `r = 0 < 3`.)
- `0 = 2 * 3 + 2 = 6 + 2 ≃ 0 (mod 8)` (`q = 2`, `r = 2 < 3`).
Such examples can be created by choosing different `(q, r)` for a fixed `(d, n)`
such that `(d * q + r)` overflows and wraps around to equal `n`.
This tells us that the division algorithm must have more restrictions than just the ones
we have for integers. These restrictions are captured in `DivModState.Lawful`.
The key idea is to state the relationship in terms of the toNat values of {n, d, q, r}.
If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q` and `n.umod d = r`.
Following this, we implement the division algorithm by repeated shift-subtract.
References:
- Fast 32-bit Division on the DSP56800E: Minimized nonrestoring division algorithm by David Baca
- Bitwuzla sources for bitblasting.h
-/
private theorem Nat.div_add_eq_left_of_lt {x y z : Nat} (hx : z x) (hy : y < z) (hz : 0 < z) :
(x + y) / z = x / z := by
refine Nat.div_eq_of_lt_le ?lo ?hi
· apply Nat.le_trans
· exact div_mul_le_self x z
· omega
· simp only [succ_eq_add_one, Nat.add_mul, Nat.one_mul]
apply Nat.add_lt_add_of_le_of_lt
· apply Nat.le_of_eq
exact (Nat.div_eq_iff_eq_mul_left hz hx).mp rfl
· exact hy
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q`. -/
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
(hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n / d = q := by
apply BitVec.eq_of_toNat_eq
rw [toNat_udiv]
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
simp [hdqnr]
rw [Nat.div_add_eq_left_of_lt] at hdqnr
· rw [ hdqnr]
exact mul_div_right q.toNat hd
· exact Nat.dvd_mul_right d.toNat q.toNat
· exact hrd
· exact hd
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.umod d = r`. -/
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n % d = r := by
apply BitVec.eq_of_toNat_eq
rw [toNat_umod]
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
simp [hdqnr]
rw [Nat.add_mod, Nat.mul_mod_right] at hdqnr
simp only [Nat.zero_add, mod_mod] at hdqnr
replace hrd : r.toNat < d.toNat := by
simpa [BitVec.lt_def] using hrd
rw [Nat.mod_eq_of_lt hrd] at hdqnr
simp [hdqnr]
/-! ### DivModState -/
/-- `DivModState` is a structure that maintains the state of recursive `divrem` calls. -/
structure DivModState (w : Nat) : Type where
/-- The number of bits in the numerator that are not yet processed -/
wn : Nat
/-- The number of bits in the remainder (and quotient) -/
wr : Nat
/-- The current quotient. -/
q : BitVec w
/-- The current remainder. -/
r : BitVec w
/-- `DivModArgs` contains the arguments to a `divrem` call which remain constant throughout
execution. -/
structure DivModArgs (w : Nat) where
/-- the numerator (aka, dividend) -/
n : BitVec w
/-- the denumerator (aka, divisor)-/
d : BitVec w
/-- A `DivModState` is lawful if the remainder width `wr` plus the numerator width `wn` equals `w`,
and the bitvectors `r` and `n` have values in the bounds given by bitwidths `wr`, resp. `wn`.
This is a proof engineering choice: an alternative world could have been
`r : BitVec wr` and `n : BitVec wn`, but this required much more dependent typing coercions.
Instead, we choose to declare all involved bitvectors as length `w`, and then prove that
the values are within their respective bounds.
We start with `wn = w` and `wr = 0`, and then in each step, we decrement `wn` and increment `wr`.
In this way, we grow a legal remainder in each loop iteration.
-/
structure DivModState.Lawful {w : Nat} (args : DivModArgs w) (qr : DivModState w) : Prop where
/-- The sum of widths of the dividend and remainder is `w`. -/
hwrn : qr.wr + qr.wn = w
/-- The denominator is positive. -/
hdPos : 0 < args.d
/-- The remainder is strictly less than the denominator. -/
hrLtDivisor : qr.r.toNat < args.d.toNat
/-- The remainder is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hrWidth : qr.r.toNat < 2^qr.wr
/-- The quotient is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hqWidth : qr.q.toNat < 2^qr.wr
/-- The low `(w - wn)` bits of `n` obey the invariant for division. -/
hdiv : args.n.toNat >>> qr.wn = args.d.toNat * qr.q.toNat + qr.r.toNat
/-- A lawful DivModState implies `w > 0`. -/
def DivModState.Lawful.hw {args : DivModArgs w} {qr : DivModState w}
{h : DivModState.Lawful args qr} : 0 < w := by
have hd := h.hdPos
rcases w with rfl | w
· have hcontra : args.d = 0#0 := by apply Subsingleton.elim
rw [hcontra] at hd
simp at hd
· omega
/-- An initial value with both `q, r = 0`. -/
def DivModState.init (w : Nat) : DivModState w := {
wn := w
wr := 0
q := 0#w
r := 0#w
}
/-- The initial state is lawful. -/
def DivModState.lawful_init {w : Nat} (args : DivModArgs w) (hd : 0#w < args.d) :
DivModState.Lawful args (DivModState.init w) := by
simp only [BitVec.DivModState.init]
exact {
hwrn := by simp only; omega,
hdPos := by assumption
hrLtDivisor := by simp [BitVec.lt_def] at hd ; assumption
hrWidth := by simp [DivModState.init],
hqWidth := by simp [DivModState.init],
hdiv := by
simp only [DivModState.init, toNat_ofNat, zero_mod, Nat.mul_zero, Nat.add_zero];
rw [Nat.shiftRight_eq_div_pow]
apply Nat.div_eq_of_lt args.n.isLt
}
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
quotient has been correctly computed.
-/
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
(h_lawful : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n / d = qr.q := by
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
have hdiv := h_lawful.hdiv
simp only [h_final] at *
omega
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
remainder has been correctly computed.
-/
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
(h : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n % d = qr.r := by
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
have hdiv := h.hdiv
simp only [shiftRight_zero] at hdiv
simp only [h_final] at *
exact hdiv.symm
/-! ### DivModState.Poised -/
/--
A `Poised` DivModState is a state which is `Lawful` and furthermore, has at least
one numerator bit left to process `(0 < wn)`
The input to the shift subtractor is a legal input to `divrem`, and we also need to have an
input bit to perform shift subtraction on, and thus we need `0 < wn`.
-/
structure DivModState.Poised {w : Nat} (args : DivModArgs w) (qr : DivModState w)
extends DivModState.Lawful args qr : Type where
/-- Only perform a round of shift-subtract if we have dividend bits. -/
hwn_lt : 0 < qr.wn
/--
In the shift subtract input, the dividend is at least one bit long (`wn > 0`), so
the remainder has bits to be computed (`wr < w`).
-/
def DivModState.wr_lt_w {qr : DivModState w} (h : qr.Poised args) : qr.wr < w := by
have hwrn := h.hwrn
have hwn_lt := h.hwn_lt
omega
/-! ### Division shift subtractor -/
/--
One round of the division algorithm, that tries to perform a subtract shift.
Note that this should only be called when `r.msb = false`, so we will not overflow.
-/
def divSubtractShift (args : DivModArgs w) (qr : DivModState w) : DivModState w :=
let {n, d} := args
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (n.getLsbD wn)
if r' < d then {
q := qr.q.shiftConcat false, -- If `r' < d`, then we do not have a quotient bit.
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true, -- Otherwise, `r' ≥ d`, and we have a quotient bit.
r := r' - d -- we subtract to maintain the invariant that `r < d`.
wn, wr
}
/-- The value of shifting right by `wn - 1` equals shifting by `wn` and grabbing the lsb at `(wn - 1)`. -/
theorem DivModState.toNat_shiftRight_sub_one_eq
{args : DivModArgs w} {qr : DivModState w} (h : qr.Poised args) :
args.n.toNat >>> (qr.wn - 1)
= (args.n.toNat >>> qr.wn) * 2 + (args.n.getLsbD (qr.wn - 1)).toNat := by
show BitVec.toNat (args.n >>> (qr.wn - 1)) = _
have {..} := h -- break the structure down for `omega`
rw [shiftRight_sub_one_eq_shiftConcat args.n h.hwn_lt]
rw [toNat_shiftConcat_eq_of_lt (k := w - qr.wn)]
· simp
· omega
· apply BitVec.toNat_ushiftRight_lt
omega
/--
This is used when proving the correctness of the division algorithm,
where we know that `r < d`.
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
In arithmetic, this is the same as showing that
`r * 2 + 1 - d < d`, which this theorem establishes.
-/
private theorem two_mul_add_sub_lt_of_lt_of_lt_two (h : a < x) (hy : y < 2) :
2 * a + y - x < x := by omega
/-- We show that the output of `divSubtractShift` is lawful, which tells us that it
obeys the division equation. -/
theorem lawful_divSubtractShift (qr : DivModState w) (h : qr.Poised args) :
DivModState.Lawful args (divSubtractShift args qr) := by
rcases args with n, d
simp only [divSubtractShift, decide_eq_true_eq]
-- We add these hypotheses for `omega` to find them later.
have hrwn, hd, hrd, hr, hn, hrnd, hwn_lt := h
have : d.toNat * (qr.q.toNat * 2) = d.toNat * qr.q.toNat * 2 := by rw [Nat.mul_assoc]
by_cases rltd : shiftConcat qr.r (n.getLsbD (qr.wn - 1)) < d
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case pos.hrWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hqWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hdiv =>
simp [qr.toNat_shiftRight_sub_one_eq h, h.hdiv, this,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth]
omega
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case neg.hrLtDivisor =>
simp only [lt_def, Nat.not_lt] at rltd
rw [BitVec.toNat_sub_of_le rltd,
toNat_shiftConcat_eq_of_lt (hk := qr.wr_lt_w h) (hx := h.hrWidth),
Nat.mul_comm]
apply two_mul_add_sub_lt_of_lt_of_lt_two <;> bv_omega
case neg.hrWidth =>
simp only
have hdr' : d (qr.r.shiftConcat (n.getLsbD (qr.wn - 1))) :=
BitVec.not_lt_iff_le.mp rltd
have hr' : ((qr.r.shiftConcat (n.getLsbD (qr.wn - 1)))).toNat < 2 ^ (qr.wr + 1) := by
apply toNat_shiftConcat_lt_of_lt <;> bv_omega
rw [BitVec.toNat_sub_of_le hdr']
omega
case neg.hqWidth =>
apply toNat_shiftConcat_lt_of_lt <;> omega
case neg.hdiv =>
have rltd' := (BitVec.not_lt_iff_le.mp rltd)
simp only [qr.toNat_shiftRight_sub_one_eq h,
BitVec.toNat_sub_of_le rltd',
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth]
simp only [BitVec.le_def,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth] at rltd'
simp only [toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth, h.hdiv, Nat.mul_add]
bv_omega
/-! ### Core division algorithm circuit -/
/-- A recursive definition of division for bitblasting, in terms of a shift-subtraction circuit. -/
def divRec {w : Nat} (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
DivModState w :=
match m with
| 0 => qr
| m + 1 => divRec m args <| divSubtractShift args qr
@[simp]
theorem divRec_zero (qr : DivModState w) :
divRec 0 args qr = qr := rfl
@[simp]
theorem divRec_succ (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m + 1) args qr =
divRec m args (divSubtractShift args qr) := rfl
/-- The output of `divRec` is a lawful state -/
theorem lawful_divRec {args : DivModArgs w} {qr : DivModState w}
(h : DivModState.Lawful args qr) :
DivModState.Lawful args (divRec qr.wn args qr) := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
exact h
case succ wn' ih =>
simp only [divRec_succ]
apply ih
· apply lawful_divSubtractShift
constructor
· assumption
· omega
· simp only [divSubtractShift, hm]
split <;> rfl
/-- The output of `divRec` has no more bits left to process (i.e., `wn = 0`) -/
@[simp]
theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
(divRec qr.wn args qr).wn = 0 := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
assumption
case succ wn' ih =>
apply ih
simp only [divSubtractShift, hm]
split <;> rfl
/-- The result of `udiv` agrees with the result of the division recurrence. -/
theorem udiv_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n / d = out.q := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
/-- The result of `umod` agrees with the result of the division recurrence. -/
theorem umod_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n % d = out.r := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
theorem divRec_succ' (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m+1) args qr =
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (args.n.getLsbD wn)
let input : DivModState _ :=
if r' < args.d then {
q := qr.q.shiftConcat false,
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true,
r := r' - args.d
wn, wr
}
divRec m args input := by
simp [divRec_succ, divSubtractShift]
/- ### Arithmetic shift right (sshiftRight) recurrence -/
/--
@@ -1100,8 +446,8 @@ def sshiftRightRec (x : BitVec w₁) (y : BitVec w₂) (n : Nat) : BitVec w₁ :
@[simp]
theorem sshiftRightRec_zero_eq (x : BitVec w₁) (y : BitVec w₂) :
sshiftRightRec x y 0 = x.sshiftRight' (y &&& twoPow w₂ 0) := by
simp only [sshiftRightRec]
sshiftRightRec x y 0 = x.sshiftRight' (y &&& 1#w₂) := by
simp only [sshiftRightRec, twoPow_zero]
@[simp]
theorem sshiftRightRec_succ_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
@@ -1120,18 +466,18 @@ theorem sshiftRight'_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
toNat_add_of_and_eq_zero h, sshiftRight_add]
theorem sshiftRightRec_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
sshiftRightRec x y n = x.sshiftRight' ((y.setWidth (n + 1)).setWidth w₂) := by
sshiftRightRec x y n = x.sshiftRight' ((y.truncate (n + 1)).zeroExtend w₂) := by
induction n generalizing x y
case zero =>
ext i
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_setWidth_ofBool_getLsbD, setWidth_one]
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
case succ n ih =>
simp only [sshiftRightRec_succ_eq, and_twoPow, ih]
by_cases h : y.getLsbD (n + 1)
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
sshiftRight'_or_of_and_eq_zero (by simp [and_twoPow]), h]
simp
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)
(by simp [h])]
simp [h]
@@ -1183,20 +529,20 @@ theorem ushiftRight'_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
simp [ add_eq_or_of_and_eq_zero _ _ h, toNat_add_of_and_eq_zero h, shiftRight_add]
theorem ushiftRightRec_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
ushiftRightRec x y n = x >>> (y.setWidth (n + 1)).setWidth w₂ := by
ushiftRightRec x y n = x >>> (y.truncate (n + 1)).zeroExtend w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [ushiftRightRec_zero, twoPow_zero, Nat.reduceAdd,
and_one_eq_setWidth_ofBool_getLsbD, setWidth_one]
and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
case succ n ih =>
simp only [ushiftRightRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsbD (n + 1) <;> simp only [h, reduceIte]
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
ushiftRight'_or_of_and_eq_zero]
simp [and_twoPow]
· simp [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false, h]
· simp [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false, h]
/--
Show that `x >>> y` can be written in terms of `ushiftRightRec`.

View File

@@ -48,7 +48,7 @@ private theorem iunfoldr.eq_test
simp only [init, eq_nil]
case step =>
intro i
simp_all [setWidth_succ]
simp_all [truncate_succ]
theorem iunfoldr_getLsbD' {f : Fin w α α × Bool} (state : Nat α)
(ind : (i : Fin w), (f i (state i.val)).fst = state (i.val+1)) :
@@ -65,7 +65,7 @@ theorem iunfoldr_getLsbD' {f : Fin w → αα × Bool} (state : Nat → α)
intro
apply And.intro
· intro i
have := Fin.pos i
have := Fin.size_pos i
contradiction
· rfl
case step =>

File diff suppressed because it is too large Load Diff

View File

@@ -12,8 +12,6 @@ namespace Bool
/-- Boolean exclusive or -/
abbrev xor : Bool Bool Bool := bne
@[inherit_doc] infixl:33 " ^^ " => xor
instance (p : Bool Prop) [inst : DecidablePred p] : Decidable ( x, p x) :=
match inst true, inst false with
| isFalse ht, _ => isFalse fun h => absurd (h _) ht
@@ -147,8 +145,8 @@ theorem and_or_distrib_right : ∀ (x y z : Bool), ((x || y) && z) = (x && z ||
theorem or_and_distrib_left : (x y z : Bool), (x || y && z) = ((x || y) && (x || z)) := by decide
theorem or_and_distrib_right : (x y z : Bool), (x && y || z) = ((x || z) && (y || z)) := by decide
theorem and_xor_distrib_left : (x y z : Bool), (x && (y ^^ z)) = ((x && y) ^^ (x && z)) := by decide
theorem and_xor_distrib_right : (x y z : Bool), ((x ^^ y) && z) = ((x && z) ^^ (y && z)) := by decide
theorem and_xor_distrib_left : (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide
theorem and_xor_distrib_right : (x y z : Bool), (xor x y && z) = xor (x && z) (y && z) := by decide
/-- De Morgan's law for boolean and -/
@[simp] theorem not_and : (x y : Bool), (!(x && y)) = (!x || !y) := by decide
@@ -225,7 +223,7 @@ theorem bne_not_self : ∀ (x : Bool), (x != !x) = true := by decide
Added for equivalence with `Bool.not_beq_self` and needed for confluence
due to `beq_iff_eq`.
-/
theorem not_eq_self : (b : Bool), ((!b) = b) False := by simp
@[simp] theorem not_eq_self : (b : Bool), ((!b) = b) False := by decide
@[simp] theorem eq_not_self : (b : Bool), (b = (!b)) False := by decide
@[simp] theorem beq_self_left : (a b : Bool), (a == (a == b)) = b := by decide
@@ -238,8 +236,8 @@ theorem not_bne_not : ∀ (x y : Bool), ((!x) != (!y)) = (x != y) := by simp
@[simp] theorem bne_assoc : (x y z : Bool), ((x != y) != z) = (x != (y != z)) := by decide
instance : Std.Associative (· != ·) := bne_assoc
@[simp] theorem bne_right_inj : {x y z : Bool}, (x != y) = (x != z) y = z := by decide
@[simp] theorem bne_left_inj : {x y z : Bool}, (x != z) = (y != z) x = y := by decide
@[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
theorem eq_not_of_ne : {x y : Bool}, x y x = !y := by decide
@@ -254,6 +252,15 @@ theorem beq_eq_decide_eq [BEq α] [LawfulBEq α] [DecidableEq α] (a b : α) :
theorem eq_not : {a b : Bool}, (a = (!b)) (a b) := by decide
theorem not_eq : {a b : Bool}, ((!a) = b) (a b) := by decide
@[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
/--
We move `!` from the left hand side of an equality to the right hand side.
This helps confluence, and also helps combining pairs of `!`s.
-/
@[simp] theorem not_eq_eq_eq_not : {a b : Bool}, ((!a) = b) (a = !b) := by decide
@[simp] theorem coe_iff_coe : {a b : Bool}, (a b) a = b := by decide
@[simp] theorem coe_true_iff_false : {a b : Bool}, (a b = false) a = (!b) := by decide
@@ -267,37 +274,37 @@ theorem beq_comm {α} [BEq α] [LawfulBEq α] {a b : α} : (a == b) = (b == a) :
/-! ### xor -/
theorem false_xor : (x : Bool), (false ^^ x) = x := false_bne
theorem false_xor : (x : Bool), xor false x = x := false_bne
theorem xor_false : (x : Bool), (x ^^ false) = x := bne_false
theorem xor_false : (x : Bool), xor x false = x := bne_false
theorem true_xor : (x : Bool), (true ^^ x) = !x := true_bne
theorem true_xor : (x : Bool), xor true x = !x := true_bne
theorem xor_true : (x : Bool), (x ^^ true) = !x := bne_true
theorem xor_true : (x : Bool), xor x true = !x := bne_true
theorem not_xor_self : (x : Bool), (!x ^^ x) = true := not_bne_self
theorem not_xor_self : (x : Bool), xor (!x) x = true := not_bne_self
theorem xor_not_self : (x : Bool), (x ^^ !x) = true := bne_not_self
theorem xor_not_self : (x : Bool), xor x (!x) = true := bne_not_self
theorem not_xor : (x y : Bool), (!x ^^ y) = !(x ^^ y) := by decide
theorem not_xor : (x y : Bool), xor (!x) y = !(xor x y) := by decide
theorem xor_not : (x y : Bool), (x ^^ !y) = !(x ^^ y) := by decide
theorem xor_not : (x y : Bool), xor x (!y) = !(xor x y) := by decide
theorem not_xor_not : (x y : Bool), (!x ^^ !y) = (x ^^ y) := not_bne_not
theorem not_xor_not : (x y : Bool), xor (!x) (!y) = (xor x y) := not_bne_not
theorem xor_self : (x : Bool), (x ^^ x) = false := by decide
theorem xor_self : (x : Bool), xor x x = false := by decide
theorem xor_comm : (x y : Bool), (x ^^ y) = (y ^^ x) := by decide
theorem xor_comm : (x y : Bool), xor x y = xor y x := by decide
theorem xor_left_comm : (x y z : Bool), (x ^^ (y ^^ z)) = (y ^^ (x ^^ z)) := by decide
theorem xor_left_comm : (x y z : Bool), xor x (xor y z) = xor y (xor x z) := by decide
theorem xor_right_comm : (x y z : Bool), ((x ^^ y) ^^ z) = ((x ^^ z) ^^ y) := by decide
theorem xor_right_comm : (x y z : Bool), xor (xor x y) z = xor (xor x z) y := by decide
theorem xor_assoc : (x y z : Bool), ((x ^^ y) ^^ z) = (x ^^ (y ^^ z)) := bne_assoc
theorem xor_assoc : (x y z : Bool), xor (xor x y) z = xor x (xor y z) := bne_assoc
theorem xor_right_inj : {x y z : Bool}, (x ^^ y) = (x ^^ z) y = z := bne_right_inj
theorem xor_left_inj : {x y z : Bool}, xor x y = xor x z y = z := bne_left_inj
theorem xor_left_inj : {x y z : Bool}, (x ^^ z) = (y ^^ z) x = y := bne_left_inj
theorem xor_right_inj : {x y z : Bool}, xor x z = xor y z x = y := bne_right_inj
/-! ### le/lt -/
@@ -368,14 +375,13 @@ theorem and_or_inj_left_iff :
/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/
def toNat (b : Bool) : Nat := cond b 1 0
@[simp, bv_toNat] theorem toNat_false : false.toNat = 0 := rfl
@[simp] theorem toNat_false : false.toNat = 0 := rfl
@[simp, bv_toNat] theorem toNat_true : true.toNat = 1 := rfl
@[simp] theorem toNat_true : true.toNat = 1 := rfl
theorem toNat_le (c : Bool) : c.toNat 1 := by
cases c <;> trivial
@[bv_toNat]
theorem toNat_lt (b : Bool) : b.toNat < 2 :=
Nat.lt_succ_of_le (toNat_le _)
@@ -384,15 +390,6 @@ theorem toNat_lt (b : Bool) : b.toNat < 2 :=
@[simp] theorem toNat_eq_one {b : Bool} : b.toNat = 1 b = true := by
cases b <;> simp
/-! ## toInt -/
/-- convert a `Bool` to an `Int`, `false -> 0`, `true -> 1` -/
def toInt (b : Bool) : Int := cond b 1 0
@[simp] theorem toInt_false : false.toInt = 0 := rfl
@[simp] theorem toInt_true : true.toInt = 1 := rfl
/-! ### ite -/
@[simp] theorem if_true_left (p : Prop) [h : Decidable p] (f : Bool) :
@@ -420,7 +417,7 @@ def toInt (b : Bool) : Int := cond b 1 0
@[simp] theorem ite_eq_true_else_eq_false {q : Prop} :
(if b = true then q else b = false) (b = true q) := by
cases b <;> simp [not_eq_self]
cases b <;> simp
/-
`not_ite_eq_true_eq_true` and related theorems below are added for

View File

@@ -42,7 +42,7 @@ def usize (a : @& ByteArray) : USize :=
a.size.toUSize
@[extern "lean_byte_array_uget"]
def uget : (a : @& ByteArray) (i : USize) (h : i.toNat < a.size := by get_elem_tactic) UInt8
def uget : (a : @& ByteArray) (i : USize) i.toNat < a.size UInt8
| bs, i, h => bs[i]
@[extern "lean_byte_array_get"]
@@ -50,11 +50,11 @@ def get! : (@& ByteArray) → (@& Nat) → UInt8
| bs, i => bs.get! i
@[extern "lean_byte_array_fget"]
def get : (a : @& ByteArray) (i : @& Nat) (h : i < a.size := by get_elem_tactic) UInt8
| bs, i, _ => bs[i]
def get : (a : @& ByteArray) (@& Fin a.size) UInt8
| bs, i => bs.get i
instance : GetElem ByteArray Nat UInt8 fun xs i => i < xs.size where
getElem xs i h := xs.get i
getElem xs i h := xs.get i, h
instance : GetElem ByteArray USize UInt8 fun xs i => i.val < xs.size where
getElem xs i h := xs.uget i h
@@ -64,11 +64,11 @@ def set! : ByteArray → (@& Nat) → UInt8 → ByteArray
| bs, i, b => bs.set! i b
@[extern "lean_byte_array_fset"]
def set : (a : ByteArray) (i : @& Nat) UInt8 (h : i < a.size := by get_elem_tactic) ByteArray
| bs, i, b, h => bs.set i b h
def set : (a : ByteArray) (@& Fin a.size) UInt8 ByteArray
| bs, i, b => bs.set i b
@[extern "lean_byte_array_uset"]
def uset : (a : ByteArray) (i : USize) UInt8 (h : i.toNat < a.size := by get_elem_tactic) ByteArray
def uset : (a : ByteArray) (i : USize) UInt8 i.toNat < a.size ByteArray
| bs, i, v, h => bs.uset i v h
@[extern "lean_byte_array_hash"]
@@ -108,18 +108,8 @@ def toList (bs : ByteArray) : List UInt8 :=
@[inline] def findIdx? (a : ByteArray) (p : UInt8 Bool) (start := 0) : Option Nat :=
let rec @[specialize] loop (i : Nat) :=
if h : i < a.size then
if p a[i] then some i else loop (i+1)
else
none
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
loop start
@[inline] def findFinIdx? (a : ByteArray) (p : UInt8 Bool) (start := 0) : Option (Fin a.size) :=
let rec @[specialize] loop (i : Nat) :=
if h : i < a.size then
if p a[i] then some i, h else loop (i+1)
if i < a.size then
if p (a.get! i) then some i else loop (i+1)
else
none
termination_by a.size - i
@@ -154,7 +144,7 @@ protected def forIn {β : Type v} {m : Type v → Type w} [Monad m] (as : ByteAr
have h' : i < as.size := Nat.lt_of_lt_of_le (Nat.lt_succ_self i) h
have : as.size - 1 < as.size := Nat.sub_lt (Nat.zero_lt_of_lt h') (by decide)
have : as.size - 1 - i < as.size := Nat.lt_of_le_of_lt (Nat.sub_le (as.size - 1) i) this
match ( f as[as.size - 1 - i] b) with
match ( f (as.get as.size - 1 - i, this) b) with
| ForInStep.done b => pure b
| ForInStep.yield b => loop i (Nat.le_of_lt h') b
loop as.size (Nat.le_refl _) b
@@ -188,7 +178,7 @@ def foldlM {β : Type v} {m : Type v → Type w} [Monad m] (f : β → UInt8 →
match i with
| 0 => pure b
| i'+1 =>
loop i' (j+1) ( f b as[j])
loop i' (j+1) ( f b (as.get j, Nat.lt_of_lt_of_le hlt h))
else
pure b
loop (stop - start) start init
@@ -255,7 +245,7 @@ On an invalid position, returns `(default : UInt8)`. -/
@[inline]
def curr : Iterator UInt8
| arr, i =>
if h : i < arr.size then
if h:i < arr.size then
arr[i]'h
else
default

View File

@@ -8,8 +8,6 @@ import Init.Data.Queue
import Init.System.Promise
import Init.System.Mutex
set_option linter.deprecated false
namespace IO
/--
@@ -17,7 +15,6 @@ Internal state of an `Channel`.
We maintain the invariant that at all times either `consumers` or `values` is empty.
-/
@[deprecated "Use Std.Channel.State from Std.Sync.Channel instead" (since := "2024-12-02")]
structure Channel.State (α : Type) where
values : Std.Queue α :=
consumers : Std.Queue (Promise (Option α)) :=
@@ -30,14 +27,12 @@ FIFO channel with unbounded buffer, where `recv?` returns a `Task`.
A channel can be closed. Once it is closed, all `send`s are ignored, and
`recv?` returns `none` once the queue is empty.
-/
@[deprecated "Use Std.Channel from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel (α : Type) : Type := Mutex (Channel.State α)
instance : Nonempty (Channel α) :=
inferInstanceAs (Nonempty (Mutex _))
/-- Creates a new `Channel`. -/
@[deprecated "Use Std.Channel.new from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.new : BaseIO (Channel α) :=
Mutex.new {}
@@ -46,7 +41,6 @@ Sends a message on an `Channel`.
This function does not block.
-/
@[deprecated "Use Std.Channel.send from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.send (ch : Channel α) (v : α) : BaseIO Unit :=
ch.atomically do
let st get
@@ -60,7 +54,6 @@ def Channel.send (ch : Channel α) (v : α) : BaseIO Unit :=
/--
Closes an `Channel`.
-/
@[deprecated "Use Std.Channel.close from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.close (ch : Channel α) : BaseIO Unit :=
ch.atomically do
let st get
@@ -74,7 +67,6 @@ Every message is only received once.
Returns `none` if the channel is closed and the queue is empty.
-/
@[deprecated "Use Std.Channel.recv? from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.recv? (ch : Channel α) : BaseIO (Task (Option α)) :=
ch.atomically do
let st get
@@ -93,7 +85,6 @@ def Channel.recv? (ch : Channel α) : BaseIO (Task (Option α)) :=
Note that if this function is called twice, each `forAsync` only gets half the messages.
-/
@[deprecated "Use Std.Channel.forAsync from Std.Sync.Channel instead" (since := "2024-12-02")]
partial def Channel.forAsync (f : α BaseIO Unit) (ch : Channel α)
(prio : Task.Priority := .default) : BaseIO (Task Unit) := do
BaseIO.bindTask (prio := prio) ( ch.recv?) fun
@@ -105,13 +96,11 @@ Receives all currently queued messages from the channel.
Those messages are dequeued and will not be returned by `recv?`.
-/
@[deprecated "Use Std.Channel.recvAllCurrent from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.recvAllCurrent (ch : Channel α) : BaseIO (Array α) :=
ch.atomically do
modifyGet fun st => (st.values.toArray, { st with values := })
/-- Type tag for synchronous (blocking) operations on a `Channel`. -/
@[deprecated "Use Std.Channel.Sync from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.Sync := Channel
/--
@@ -121,7 +110,6 @@ For example, `ch.sync.recv?` blocks until the next message,
and `for msg in ch.sync do ...` iterates synchronously over the channel.
These functions should only be used in dedicated threads.
-/
@[deprecated "Use Std.Channel.sync from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.sync (ch : Channel α) : Channel.Sync α := ch
/--
@@ -130,11 +118,9 @@ Synchronously receives a message from the channel.
Every message is only received once.
Returns `none` if the channel is closed and the queue is empty.
-/
@[deprecated "Use Std.Channel.Sync.recv? from Std.Sync.Channel instead" (since := "2024-12-02")]
def Channel.Sync.recv? (ch : Channel.Sync α) : BaseIO (Option α) := do
IO.wait ( Channel.recv? ch)
@[deprecated "Use Std.Channel.Sync.forIn from Std.Sync.Channel instead" (since := "2024-12-02")]
private partial def Channel.Sync.forIn [Monad m] [MonadLiftT BaseIO m]
(ch : Channel.Sync α) (f : α β m (ForInStep β)) : β m β := fun b => do
match ch.recv? with

View File

@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.Data.UInt.BasicAux
import Init.Data.UInt.Basic
/-- Determines if the given integer is a valid [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).
@@ -42,10 +42,8 @@ theorem isValidUInt32 (n : Nat) (h : isValidCharNat n) : n < UInt32.size := by
theorem isValidChar_of_isValidCharNat (n : Nat) (h : isValidCharNat n) : isValidChar (UInt32.ofNat' n (isValidUInt32 n h)) :=
match h with
| Or.inl h =>
Or.inl (UInt32.ofNat'_lt_of_lt _ (by decide) h)
| Or.inr h₁, h₂ =>
Or.inr UInt32.lt_ofNat'_of_lt _ (by decide) h₁, UInt32.ofNat'_lt_of_lt _ (by decide) h₂
| Or.inl h => Or.inl h
| Or.inr h₁, h₂ => Or.inr h₁, h
theorem isValidChar_zero : isValidChar 0 :=
Or.inl (by decide)
@@ -59,7 +57,7 @@ theorem isValidChar_zero : isValidChar 0 :=
c.val.toUInt8
/-- The numbers from 0 to 256 are all valid UTF-8 characters, so we can embed one in the other. -/
def ofUInt8 (n : UInt8) : Char := n.toUInt32, .inl (Nat.lt_trans n.toBitVec.isLt (by decide))
def ofUInt8 (n : UInt8) : Char := n.toUInt32, .inl (Nat.lt_trans n.1.2 (by decide))
instance : Inhabited Char where
default := 'A'

View File

@@ -9,9 +9,6 @@ import Init.Data.UInt.Lemmas
namespace Char
@[ext] protected theorem ext : {a b : Char} a.val = b.val a = b
| _,_, _,_, rfl => rfl
theorem le_def {a b : Char} : a b a.1 b.1 := .rfl
theorem lt_def {a b : Char} : a < b a.1 < b.1 := .rfl
theorem lt_iff_val_lt_val {a b : Char} : a < b a.val < b.val := Iff.rfl
@@ -22,44 +19,9 @@ theorem lt_iff_val_lt_val {a b : Char} : a < b ↔ a.val < b.val := Iff.rfl
protected theorem le_trans {a b c : Char} : a b b c a c := UInt32.le_trans
protected theorem lt_trans {a b c : Char} : a < b b < c a < c := UInt32.lt_trans
protected theorem le_total (a b : Char) : a b b a := UInt32.le_total a.1 b.1
protected theorem le_antisymm {a b : Char} : a b b a a = b :=
fun h₁ h₂ => Char.ext (UInt32.le_antisymm h₁ h₂)
protected theorem lt_asymm {a b : Char} (h : a < b) : ¬ b < a := UInt32.lt_asymm h
protected theorem ne_of_lt {a b : Char} (h : a < b) : a b := Char.ne_of_val_ne (UInt32.ne_of_lt h)
instance ltIrrefl : Std.Irrefl (· < · : Char Char Prop) where
irrefl := Char.lt_irrefl
instance leRefl : Std.Refl (· · : Char Char Prop) where
refl := Char.le_refl
instance leTrans : Trans (· · : Char Char Prop) (· ·) (· ·) where
trans := Char.le_trans
instance ltTrans : Trans (· < · : Char Char Prop) (· < ·) (· < ·) where
trans := Char.lt_trans
-- This instance is useful while setting up instances for `String`.
def notLTTrans : Trans (¬ · < · : Char Char Prop) (¬ · < ·) (¬ · < ·) where
trans h₁ h₂ := by simpa using Char.le_trans (by simpa using h₂) (by simpa using h₁)
instance leAntisymm : Std.Antisymm (· · : Char Char Prop) where
antisymm _ _ := Char.le_antisymm
-- This instance is useful while setting up instances for `String`.
def notLTAntisymm : Std.Antisymm (¬ · < · : Char Char Prop) where
antisymm _ _ h₁ h₂ := Char.le_antisymm (by simpa using h₂) (by simpa using h₁)
instance ltAsymm : Std.Asymm (· < · : Char Char Prop) where
asymm _ _ := Char.lt_asymm
instance leTotal : Std.Total (· · : Char Char Prop) where
total := Char.le_total
-- This instance is useful while setting up instances for `String`.
def notLTTotal : Std.Total (¬ · < · : Char Char Prop) where
total := fun x y => by simpa using Char.le_total y x
theorem utf8Size_eq (c : Char) : c.utf8Size = 1 c.utf8Size = 2 c.utf8Size = 3 c.utf8Size = 4 := by
have := c.utf8Size_pos
have := c.utf8Size_le_four
@@ -69,6 +31,9 @@ theorem utf8Size_eq (c : Char) : c.utf8Size = 1 c.utf8Size = 2 c.utf8Siz
rw [Char.ofNat, dif_pos]
rfl
@[ext] protected theorem ext : {a b : Char} a.val = b.val a = b
| _,_, _,_, rfl => rfl
end Char
@[deprecated Char.utf8Size (since := "2024-06-04")] abbrev String.csize := Char.utf8Size

View File

@@ -14,7 +14,7 @@ instance coeToNat : CoeOut (Fin n) Nat :=
fun v => v.val
/--
From the empty type `Fin 0`, any desired result `α` can be derived. This is similar to `Empty.elim`.
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 _)
@@ -36,6 +36,12 @@ def succ : Fin n → Fin (n + 1)
variable {n : Nat}
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
protected def ofNat {n : Nat} (a : Nat) : Fin (n + 1) :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
/--
Returns `a` modulo `n` as a `Fin n`.
@@ -44,12 +50,9 @@ The assumption `NeZero n` ensures that `Fin n` is nonempty.
protected def ofNat' (n : Nat) [NeZero n] (a : Nat) : Fin n :=
a % n, Nat.mod_lt _ (pos_of_neZero n)
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
@[deprecated Fin.ofNat' (since := "2024-11-27")]
protected def ofNat {n : Nat} (a : Nat) : Fin (n + 1) :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
-- We intend to deprecate `Fin.ofNat` in favor of `Fin.ofNat'` (and later rename).
-- This is waiting on https://github.com/leanprover/lean4/pull/5323
-- attribute [deprecated Fin.ofNat' (since := "2024-09-16")] Fin.ofNat
private theorem mlt {b : Nat} : {a : Nat} a < n b % n < n
| 0, h => Nat.mod_lt _ h
@@ -162,7 +165,6 @@ theorem modn_lt : ∀ {m : Nat} (i : Fin n), m > 0 → (modn i m).val < m
theorem val_lt_of_le (i : Fin b) (h : b n) : i.val < n :=
Nat.lt_of_lt_of_le i.isLt h
/-- If you actually have an element of `Fin n`, then the `n` is always positive -/
protected theorem pos (i : Fin n) : 0 < n :=
Nat.lt_of_le_of_lt (Nat.zero_le _) i.2
@@ -176,7 +178,7 @@ protected theorem pos (i : Fin n) : 0 < n :=
@[inline] def castLE (h : n m) (i : Fin n) : Fin m := i, Nat.lt_of_lt_of_le i.2 h
/-- `cast eq i` embeds `i` into an equal `Fin` type. -/
@[inline] protected def cast (eq : n = m) (i : Fin n) : Fin m := i, eq i.2
@[inline] def cast (eq : n = m) (i : Fin n) : Fin m := i, eq i.2
/-- `castAdd m i` embeds `i : Fin n` in `Fin (n+m)`. See also `Fin.natAdd` and `Fin.addNat`. -/
@[inline] def castAdd (m) : Fin n Fin (n + m) :=

View File

@@ -5,217 +5,22 @@ Authors: François G. Dorais
-/
prelude
import Init.Data.Nat.Linear
import Init.Control.Lawful.Basic
import Init.Data.Fin.Lemmas
namespace Fin
/-- Folds over `Fin n` from the left: `foldl 3 f x = f (f (f x 0) 1) 2`. -/
@[inline] def foldl (n) (f : α Fin n α) (init : α) : α := loop init 0 where
/-- Inner loop for `Fin.foldl`. `Fin.foldl.loop n f x i = f (f (f x i) ...) (n-1)` -/
@[semireducible, specialize] loop (x : α) (i : Nat) : α :=
loop (x : α) (i : Nat) : α :=
if h : i < n then loop (f x i, h) (i+1) else x
termination_by n - i
/-- 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
/-- Inner loop for `Fin.foldr`. `Fin.foldr.loop n f i x = f 0 (f ... (f (i-1) x))` -/
@[specialize] loop : (i : _) i n α α
| 0, _, x => x
| i+1, h, x => loop i (Nat.le_of_lt h) (f i, h x)
termination_by structural i => i
/--
Folds a monadic function over `Fin n` from left to right:
```
Fin.foldlM n f x₀ = do
let x₁ ← f x₀ 0
let x₂ ← f x₁ 1
...
let xₙ ← f xₙ₋₁ (n-1)
pure xₙ
```
-/
@[inline] def foldlM [Monad m] (n) (f : α Fin n m α) (init : α) : m α := loop init 0 where
/--
Inner loop for `Fin.foldlM`.
```
Fin.foldlM.loop n f xᵢ i = do
let xᵢ₊₁ ← f xᵢ i
...
let xₙ ← f xₙ₋₁ (n-1)
pure xₙ
```
-/
@[semireducible, specialize] loop (x : α) (i : Nat) : m α := do
if h : i < n then f x i, h >>= (loop · (i+1)) else pure x
termination_by n - i
decreasing_by decreasing_trivial_pre_omega
/--
Folds a monadic function over `Fin n` from right to left:
```
Fin.foldrM n f xₙ = do
let xₙ₋₁ ← f (n-1) xₙ
let xₙ₋₂ ← f (n-2) xₙ₋₁
...
let x₀ ← f 0 x₁
pure x₀
```
-/
@[inline] def foldrM [Monad m] (n) (f : Fin n α m α) (init : α) : m α :=
loop n, Nat.le_refl n init where
/--
Inner loop for `Fin.foldrM`.
```
Fin.foldrM.loop n f i xᵢ = do
let xᵢ₋₁ ← f (i-1) xᵢ
...
let x₁ ← f 1 x₂
let x₀ ← f 0 x₁
pure x₀
```
-/
@[semireducible, specialize] loop : {i // i n} α m α
| 0, _, x => pure x
| i+1, h, x => f i, h x >>= loop i, Nat.le_of_lt h
/-! ### foldlM -/
theorem foldlM_loop_lt [Monad m] (f : α Fin n m α) (x) (h : i < n) :
foldlM.loop n f x i = f x i, h >>= (foldlM.loop n f . (i+1)) := by
rw [foldlM.loop, dif_pos h]
theorem foldlM_loop_eq [Monad m] (f : α Fin n m α) (x) : foldlM.loop n f x n = pure x := by
rw [foldlM.loop, dif_neg (Nat.lt_irrefl _)]
theorem foldlM_loop [Monad m] (f : α Fin (n+1) m α) (x) (h : i < n+1) :
foldlM.loop (n+1) f x i = f x i, h >>= (foldlM.loop n (fun x j => f x j.succ) . i) := by
if h' : i < n then
rw [foldlM_loop_lt _ _ h]
congr; funext
rw [foldlM_loop_lt _ _ h', foldlM_loop]; rfl
else
cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h')
rw [foldlM_loop_lt]
congr; funext
rw [foldlM_loop_eq, foldlM_loop_eq]
termination_by n - i
@[simp] theorem foldlM_zero [Monad m] (f : α Fin 0 m α) (x) : foldlM 0 f x = pure x :=
foldlM_loop_eq ..
theorem foldlM_succ [Monad m] (f : α Fin (n+1) m α) (x) :
foldlM (n+1) f x = f x 0 >>= foldlM n (fun x j => f x j.succ) := foldlM_loop ..
/-! ### foldrM -/
theorem foldrM_loop_zero [Monad m] (f : Fin n α m α) (x) :
foldrM.loop n f 0, Nat.zero_le _ x = pure x := by
rw [foldrM.loop]
theorem foldrM_loop_succ [Monad m] (f : Fin n α m α) (x) (h : i < n) :
foldrM.loop n f i+1, h x = f i, h x >>= foldrM.loop n f i, Nat.le_of_lt h := by
rw [foldrM.loop]
theorem foldrM_loop [Monad m] [LawfulMonad m] (f : Fin (n+1) α m α) (x) (h : i+1 n+1) :
foldrM.loop (n+1) f i+1, h x =
foldrM.loop n (fun j => f j.succ) i, Nat.le_of_succ_le_succ h x >>= f 0 := by
induction i generalizing x with
| zero =>
rw [foldrM_loop_zero, foldrM_loop_succ, pure_bind]
conv => rhs; rw [bind_pure (f 0 x)]
congr; funext
| succ i ih =>
rw [foldrM_loop_succ, foldrM_loop_succ, bind_assoc]
congr; funext; exact ih ..
@[simp] theorem foldrM_zero [Monad m] (f : Fin 0 α m α) (x) : foldrM 0 f x = pure x :=
foldrM_loop_zero ..
theorem foldrM_succ [Monad m] [LawfulMonad m] (f : Fin (n+1) α m α) (x) :
foldrM (n+1) f x = foldrM n (fun i => f i.succ) x >>= f 0 := foldrM_loop ..
/-! ### foldl -/
theorem foldl_loop_lt (f : α Fin n α) (x) (h : i < n) :
foldl.loop n f x i = foldl.loop n f (f x i, h) (i+1) := by
rw [foldl.loop, dif_pos h]
theorem foldl_loop_eq (f : α Fin n α) (x) : foldl.loop n f x n = x := by
rw [foldl.loop, dif_neg (Nat.lt_irrefl _)]
theorem foldl_loop (f : α Fin (n+1) α) (x) (h : i < n+1) :
foldl.loop (n+1) f x i = foldl.loop n (fun x j => f x j.succ) (f x i, h) i := by
if h' : i < n then
rw [foldl_loop_lt _ _ h]
rw [foldl_loop_lt _ _ h', foldl_loop]; rfl
else
cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h')
rw [foldl_loop_lt]
rw [foldl_loop_eq, foldl_loop_eq]
@[simp] theorem foldl_zero (f : α Fin 0 α) (x) : foldl 0 f x = x :=
foldl_loop_eq ..
theorem foldl_succ (f : α Fin (n+1) α) (x) :
foldl (n+1) f x = foldl n (fun x i => f x i.succ) (f x 0) :=
foldl_loop ..
theorem foldl_succ_last (f : α Fin (n+1) α) (x) :
foldl (n+1) f x = f (foldl n (f · ·.castSucc) x) (last n) := by
rw [foldl_succ]
induction n generalizing x with
| zero => simp [foldl_succ, Fin.last]
| succ n ih => rw [foldl_succ, ih (f · ·.succ), foldl_succ]; simp [succ_castSucc]
theorem foldl_eq_foldlM (f : α Fin n α) (x) :
foldl n f x = foldlM (m:=Id) n f x := by
induction n generalizing x <;> simp [foldl_succ, foldlM_succ, *]
/-! ### foldr -/
theorem foldr_loop_zero (f : Fin n α α) (x) :
foldr.loop n f 0 (Nat.zero_le _) x = x := by
rw [foldr.loop]
theorem foldr_loop_succ (f : Fin n α α) (x) (h : i < n) :
foldr.loop n f (i+1) h x = foldr.loop n f i (Nat.le_of_lt h) (f i, h x) := by
rw [foldr.loop]
theorem foldr_loop (f : Fin (n+1) α α) (x) (h : i+1 n+1) :
foldr.loop (n+1) f (i+1) h x =
f 0 (foldr.loop n (fun j => f j.succ) i (Nat.le_of_succ_le_succ h) x) := by
induction i generalizing x with
| zero => simp [foldr_loop_succ, foldr_loop_zero]
| succ i ih => rw [foldr_loop_succ, ih]; rfl
@[simp] theorem foldr_zero (f : Fin 0 α α) (x) : foldr 0 f x = x :=
foldr_loop_zero ..
theorem foldr_succ (f : Fin (n+1) α α) (x) :
foldr (n+1) f x = f 0 (foldr n (fun i => f i.succ) x) := foldr_loop ..
theorem foldr_succ_last (f : Fin (n+1) α α) (x) :
foldr (n+1) f x = foldr n (f ·.castSucc) (f (last n) x) := by
induction n generalizing x with
| zero => simp [foldr_succ, Fin.last]
| succ n ih => rw [foldr_succ, ih (f ·.succ), foldr_succ]; simp [succ_castSucc]
theorem foldr_eq_foldrM (f : Fin n α α) (x) :
foldr n f x = foldrM (m:=Id) n f x := by
induction n <;> simp [foldr_succ, foldrM_succ, *]
theorem foldl_rev (f : Fin n α α) (x) :
foldl n (fun x i => f i.rev x) x = foldr n f x := by
induction n generalizing x with
| zero => simp
| succ n ih => rw [foldl_succ, foldr_succ_last, ih]; simp [rev_succ]
theorem foldr_rev (f : α Fin n α) (x) :
foldr n (fun i x => f x i.rev) x = foldl n f x := by
induction n generalizing x with
| zero => simp
| succ n ih => rw [foldl_succ_last, foldr_succ, ih]; simp [rev_succ]
/-- 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
/-- Inner loop for `Fin.foldr`. `Fin.foldr.loop n f i x = f 0 (f ... (f (i-1) x))` -/
loop : {i // i n} α α
| 0, _, x => x
| i+1, h, x => loop i, Nat.le_of_lt h (f i, h x)
end Fin

View File

@@ -26,7 +26,7 @@ def hIterateFrom (P : Nat → Sort _) {n} (f : ∀(i : Fin n), P i.val → P (i.
decreasing_by decreasing_trivial_pre_omega
/--
`hIterate` is a heterogeneous iterative operation that applies a
`hIterate` is a heterogenous iterative operation that applies a
index-dependent function `f` to a value `init : P start` a total of
`stop - start` times to produce a value of type `P stop`.
@@ -35,7 +35,7 @@ Concretely, `hIterate start stop f init` is equal to
init |> f start _ |> f (start+1) _ ... |> f (end-1) _
```
Because it is heterogeneous and must return a value of type `P stop`,
Because it is heterogenous and must return a value of type `P stop`,
`hIterate` requires proof that `start ≤ stop`.
One can prove properties of `hIterate` using the general theorem
@@ -70,7 +70,7 @@ private theorem hIterateFrom_elim {P : Nat → Sort _}(Q : ∀(i : Nat), P i →
/-
`hIterate_elim` provides a mechanism for showing that the result of
`hIterate` satisfies a property `Q stop` by showing that the states
`hIterate` satisifies a property `Q stop` by showing that the states
at the intermediate indices `i : start ≤ i < stop` satisfy `Q i`.
-/
theorem hIterate_elim {P : Nat Sort _} (Q : (i : Nat), P i Prop)

View File

@@ -13,19 +13,17 @@ import Init.Omega
namespace Fin
@[deprecated Fin.pos (since := "2024-11-11")]
theorem size_pos (i : Fin n) : 0 < n := i.pos
/-- If you actually have an element of `Fin n`, then the `n` is always positive -/
theorem size_pos (i : Fin n) : 0 < n := Nat.lt_of_le_of_lt (Nat.zero_le _) i.2
theorem mod_def (a m : Fin n) : a % m = Fin.mk (a % m) (Nat.lt_of_le_of_lt (Nat.mod_le _ _) a.2) :=
rfl
theorem mul_def (a b : Fin n) : a * b = Fin.mk ((a * b) % n) (Nat.mod_lt _ a.pos) := rfl
theorem mul_def (a b : Fin n) : a * b = Fin.mk ((a * b) % n) (Nat.mod_lt _ a.size_pos) := rfl
theorem sub_def (a b : Fin n) : a - b = Fin.mk (((n - b) + a) % n) (Nat.mod_lt _ a.pos) := rfl
theorem sub_def (a b : Fin n) : a - b = Fin.mk (((n - b) + a) % n) (Nat.mod_lt _ a.size_pos) := rfl
theorem pos' : [Nonempty (Fin n)], 0 < n | i => i.pos
@[deprecated pos' (since := "2024-11-11")] abbrev size_pos' := @pos'
theorem size_pos' : [Nonempty (Fin n)], 0 < n | i => i.size_pos
@[simp] theorem is_lt (a : Fin n) : (a : Nat) < n := a.2
@@ -56,12 +54,7 @@ theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
@[simp] theorem val_ofNat' (n : Nat) [NeZero n] (a : Nat) :
(Fin.ofNat' n a).val = a % n := rfl
@[simp] theorem ofNat'_self {n : Nat} [NeZero n] : Fin.ofNat' n n = 0 := by
ext
simp
congr
@[simp] theorem ofNat'_val_eq_self [NeZero n] (x : Fin n) : (Fin.ofNat' n x) = x := by
@[simp] theorem ofNat'_val_eq_self [NeZero n](x : Fin n) : (Fin.ofNat' n x) = x := by
ext
rw [val_ofNat', Nat.mod_eq_of_lt]
exact x.2
@@ -75,9 +68,6 @@ theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
@[simp] theorem modn_val (a : Fin n) (b : Nat) : (a.modn b).val = a.val % b :=
rfl
@[simp] theorem val_eq_zero (a : Fin 1) : a.val = 0 :=
Nat.eq_zero_of_le_zero <| Nat.le_of_lt_succ a.isLt
theorem ite_val {n : Nat} {c : Prop} [Decidable c] {x : c Fin n} (y : ¬c Fin n) :
(if h : c then x h else y h).val = if h : c then (x h).val else (y h).val := by
by_cases c <;> simp [*]
@@ -130,7 +120,7 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) :
@[simp] theorem mk_lt_mk {x y : Nat} {hx hy} : (x, hx : Fin n) < y, hy x < y := .rfl
@[simp] theorem val_zero (n : Nat) [NeZero n] : ((0 : Fin n) : Nat) = 0 := rfl
@[simp] theorem val_zero (n : Nat) : (0 : Fin (n + 1)).1 = 0 := rfl
@[simp] theorem mk_zero : (0, Nat.succ_pos n : Fin (n + 1)) = 0 := rfl
@@ -177,24 +167,8 @@ theorem rev_eq {n a : Nat} (i : Fin (n + 1)) (h : n = a + i) :
@[simp] theorem rev_lt_rev {i j : Fin n} : rev i < rev j j < i := by
rw [ Fin.not_le, Fin.not_le, rev_le_rev]
/-! ### last -/
@[simp] theorem val_last (n : Nat) : last n = n := rfl
@[simp] theorem last_zero : (Fin.last 0 : Fin 1) = 0 := by
ext
simp
@[simp] theorem zero_eq_last_iff {n : Nat} : (0 : Fin (n + 1)) = last n n = 0 := by
constructor
· intro h
simp_all [Fin.ext_iff]
· rintro rfl
simp
@[simp] theorem last_eq_zero_iff {n : Nat} : Fin.last n = 0 n = 0 := by
simp [eq_comm (a := Fin.last n)]
theorem le_last (i : Fin (n + 1)) : i last n := Nat.le_of_lt_succ i.is_lt
theorem last_pos : (0 : Fin (n + 2)) < last (n + 1) := Nat.succ_pos _
@@ -228,32 +202,10 @@ instance subsingleton_one : Subsingleton (Fin 1) := subsingleton_iff_le_one.2 (b
theorem fin_one_eq_zero (a : Fin 1) : a = 0 := Subsingleton.elim a 0
@[simp] theorem zero_eq_one_iff {n : Nat} [NeZero n] : (0 : Fin n) = 1 n = 1 := by
constructor
· intro h
simp [Fin.ext_iff] at h
change 0 % n = 1 % n at h
rw [eq_comm] at h
simpa using h
· rintro rfl
simp
@[simp] theorem one_eq_zero_iff {n : Nat} [NeZero n] : (1 : Fin n) = 0 n = 1 := by
rw [eq_comm]
simp
theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.pos) := rfl
theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.size_pos) := rfl
theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl
@[simp] protected theorem zero_add [NeZero n] (k : Fin n) : (0 : Fin n) + k = k := by
ext
simp [Fin.add_def, Nat.mod_eq_of_lt k.2]
@[simp] protected theorem add_zero [NeZero n] (k : Fin n) : k + 0 = k := by
ext
simp [add_def, Nat.mod_eq_of_lt k.2]
theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by
match n with
| 0 => cases h
@@ -370,25 +322,21 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
Fin.castLE mn Fin.castLE km = Fin.castLE (Nat.le_trans km mn) :=
funext (castLE_castLE km mn)
@[simp] theorem coe_cast (h : n = m) (i : Fin n) : (i.cast h : Nat) = i := rfl
@[simp] theorem coe_cast (h : n = m) (i : Fin n) : (cast h i : Nat) = i := rfl
@[simp] theorem cast_last {n' : Nat} {h : n + 1 = n' + 1} : (last n).cast h = last n' :=
@[simp] theorem cast_last {n' : Nat} {h : n + 1 = n' + 1} : cast h (last n) = last n' :=
Fin.ext (by rw [coe_cast, val_last, val_last, Nat.succ.inj h])
@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : Fin.cast h i, hn = i, h hn := rfl
@[simp] theorem cast_refl (n : Nat) (h : n = n) : Fin.cast h = id := by
ext
simp
@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h i, hn = i, h hn := rfl
@[simp] theorem cast_trans {k : Nat} (h : n = m) (h' : m = k) {i : Fin n} :
(i.cast h).cast h' = i.cast (Eq.trans h h') := rfl
cast h' (cast h i) = cast (Eq.trans h h') i := rfl
theorem castLE_of_eq {m n : Nat} (h : m = n) {h' : m n} : castLE h' = Fin.cast h := rfl
@[simp] theorem coe_castAdd (m : Nat) (i : Fin n) : (castAdd m i : Nat) = i := rfl
@[simp] theorem castAdd_zero : (castAdd 0 : Fin n Fin (n + 0)) = Fin.cast rfl := rfl
@[simp] theorem castAdd_zero : (castAdd 0 : Fin n Fin (n + 0)) = cast rfl := rfl
theorem castAdd_lt {m : Nat} (n : Nat) (i : Fin m) : (castAdd n i : Nat) < m := by simp
@@ -406,37 +354,37 @@ theorem castAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) :
castAdd m (Fin.cast h i) = Fin.cast (congrArg (. + m) h) (castAdd m i) := Fin.ext rfl
theorem cast_castAdd_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
(i.castAdd m).cast h = (i.cast (Nat.add_right_cancel h)).castAdd m := rfl
cast h (castAdd m i) = castAdd m (cast (Nat.add_right_cancel h) i) := rfl
@[simp] theorem cast_castAdd_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) :
(i.castAdd m').cast h = i.castAdd m := rfl
cast h (castAdd m' i) = castAdd m i := rfl
theorem castAdd_castAdd {m n p : Nat} (i : Fin m) :
(i.castAdd n).castAdd p = (i.castAdd (n + p)).cast (Nat.add_assoc ..).symm := rfl
castAdd p (castAdd n i) = cast (Nat.add_assoc ..).symm (castAdd (n + p) i) := rfl
/-- The cast of the successor is the successor of the cast. See `Fin.succ_cast_eq` for rewriting in
the reverse direction. -/
@[simp] theorem cast_succ_eq {n' : Nat} (i : Fin n) (h : n.succ = n'.succ) :
i.succ.cast h = (i.cast (Nat.succ.inj h)).succ := rfl
cast h i.succ = (cast (Nat.succ.inj h) i).succ := rfl
theorem succ_cast_eq {n' : Nat} (i : Fin n) (h : n = n') :
(i.cast h).succ = i.succ.cast (by rw [h]) := rfl
(cast h i).succ = cast (by rw [h]) i.succ := rfl
@[simp] theorem coe_castSucc (i : Fin n) : (i.castSucc : Nat) = i := rfl
@[simp] theorem coe_castSucc (i : Fin n) : (Fin.castSucc i : Nat) = i := rfl
@[simp] theorem castSucc_mk (n i : Nat) (h : i < n) : castSucc i, h = i, Nat.lt.step h := rfl
@[simp] theorem cast_castSucc {n' : Nat} {h : n + 1 = n' + 1} {i : Fin n} :
i.castSucc.cast h = (i.cast (Nat.succ.inj h)).castSucc := rfl
cast h (castSucc i) = castSucc (cast (Nat.succ.inj h) i) := rfl
theorem castSucc_lt_succ (i : Fin n) : i.castSucc < i.succ :=
theorem castSucc_lt_succ (i : Fin n) : Fin.castSucc i < i.succ :=
lt_def.2 <| by simp only [coe_castSucc, val_succ, Nat.lt_succ_self]
theorem le_castSucc_iff {i : Fin (n + 1)} {j : Fin n} : i j.castSucc i < j.succ := by
theorem le_castSucc_iff {i : Fin (n + 1)} {j : Fin n} : i Fin.castSucc j i < j.succ := by
simpa only [lt_def, le_def] using Nat.add_one_le_add_one_iff.symm
theorem castSucc_lt_iff_succ_le {n : Nat} {i : Fin n} {j : Fin (n + 1)} :
i.castSucc < j i.succ j := .rfl
Fin.castSucc i < j i.succ j := .rfl
@[simp] theorem succ_last (n : Nat) : (last n).succ = last n.succ := rfl
@@ -444,55 +392,51 @@ theorem castSucc_lt_iff_succ_le {n : Nat} {i : Fin n} {j : Fin (n + 1)} :
i.succ = last (n + 1) i = last n := by rw [ succ_last, succ_inj]
@[simp] theorem castSucc_castLT (i : Fin (n + 1)) (h : (i : Nat) < n) :
(castLT i h).castSucc = i := rfl
castSucc (castLT i h) = i := rfl
@[simp] theorem castLT_castSucc {n : Nat} (a : Fin n) (h : (a : Nat) < n) :
castLT a.castSucc h = a := rfl
castLT (castSucc a) h = a := rfl
@[simp] theorem castSucc_lt_castSucc_iff {a b : Fin n} :
a.castSucc < b.castSucc a < b := .rfl
Fin.castSucc a < Fin.castSucc b a < b := .rfl
theorem castSucc_inj {a b : Fin n} : a.castSucc = b.castSucc a = b := by simp [Fin.ext_iff]
theorem castSucc_inj {a b : Fin n} : castSucc a = castSucc b a = b := by simp [Fin.ext_iff]
theorem castSucc_lt_last (a : Fin n) : a.castSucc < last n := a.is_lt
theorem castSucc_lt_last (a : Fin n) : castSucc a < last n := a.is_lt
@[simp] theorem castSucc_zero : castSucc (0 : Fin (n + 1)) = 0 := rfl
@[simp] theorem castSucc_one {n : Nat} : castSucc (1 : Fin (n + 2)) = 1 := rfl
/-- `castSucc i` is positive when `i` is positive -/
theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < i.castSucc := by
theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < castSucc i := by
simpa [lt_def] using h
@[simp] theorem castSucc_eq_zero_iff {a : Fin (n + 1)} : a.castSucc = 0 a = 0 := by simp [Fin.ext_iff]
@[simp] theorem castSucc_eq_zero_iff {a : Fin (n + 1)} : castSucc a = 0 a = 0 := by simp [Fin.ext_iff]
theorem castSucc_ne_zero_iff {a : Fin (n + 1)} : a.castSucc 0 a 0 :=
theorem castSucc_ne_zero_iff {a : Fin (n + 1)} : castSucc a 0 a 0 :=
not_congr <| castSucc_eq_zero_iff
theorem castSucc_fin_succ (n : Nat) (j : Fin n) :
j.succ.castSucc = (j.castSucc).succ := by simp [Fin.ext_iff]
castSucc (Fin.succ j) = Fin.succ (castSucc j) := by simp [Fin.ext_iff]
@[simp]
theorem coeSucc_eq_succ {a : Fin n} : a.castSucc + 1 = a.succ := by
theorem coeSucc_eq_succ {a : Fin n} : castSucc a + 1 = a.succ := by
cases n
· exact a.elim0
· simp [Fin.ext_iff, add_def, Nat.mod_eq_of_lt (Nat.succ_lt_succ a.is_lt)]
theorem lt_succ {a : Fin n} : a.castSucc < a.succ := by
theorem lt_succ {a : Fin n} : castSucc a < a.succ := by
rw [castSucc, lt_def, coe_castAdd, val_succ]; exact Nat.lt_succ_self a.val
theorem exists_castSucc_eq {n : Nat} {i : Fin (n + 1)} : ( j, castSucc j = i) i last n :=
fun j, hj => hj Fin.ne_of_lt j.castSucc_lt_last,
fun hi => i.castLT <| Fin.val_lt_last hi, rfl
theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = i.succ.castSucc := rfl
theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = castSucc i.succ := rfl
@[simp] theorem coe_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl
@[simp] theorem addNat_zero (n : Nat) (i : Fin n) : addNat i 0 = i := by
ext
simp
@[simp] theorem addNat_one {i : Fin n} : addNat i 1 = i.succ := rfl
theorem le_coe_addNat (m : Nat) (i : Fin n) : m addNat i m :=
@@ -502,17 +446,17 @@ theorem le_coe_addNat (m : Nat) (i : Fin n) : m ≤ addNat i m :=
addNat i, hi n = i + n, Nat.add_lt_add_right hi n := rfl
@[simp] theorem cast_addNat_zero {n n' : Nat} (i : Fin n) (h : n + 0 = n') :
(addNat i 0).cast h = i.cast ((Nat.add_zero _).symm.trans h) := rfl
cast h (addNat i 0) = cast ((Nat.add_zero _).symm.trans h) i := rfl
/-- For rewriting in the reverse direction, see `Fin.cast_addNat_left`. -/
theorem addNat_cast {n n' m : Nat} (i : Fin n') (h : n' = n) :
addNat (i.cast h) m = (addNat i m).cast (congrArg (. + m) h) := rfl
addNat (cast h i) m = cast (congrArg (. + m) h) (addNat i m) := rfl
theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
(addNat i m).cast h = addNat (i.cast (Nat.add_right_cancel h)) m := rfl
cast h (addNat i m) = addNat (cast (Nat.add_right_cancel h) i) m := rfl
@[simp] theorem cast_addNat_right {n m m' : Nat} (i : Fin n) (h : n + m' = n + m) :
(addNat i m').cast h = addNat i m :=
cast h (addNat i m') = addNat i m :=
Fin.ext <| (congrArg ((· + ·) (i : Nat)) (Nat.add_left_cancel h) : _)
@[simp] theorem coe_natAdd (n : Nat) {m : Nat} (i : Fin m) : (natAdd n i : Nat) = n + i := rfl
@@ -522,55 +466,47 @@ theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
theorem le_coe_natAdd (m : Nat) (i : Fin n) : m natAdd m i := Nat.le_add_right ..
@[simp] theorem natAdd_zero {n : Nat} : natAdd 0 = Fin.cast (Nat.zero_add n).symm := by ext; simp
theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp
/-- For rewriting in the reverse direction, see `Fin.cast_natAdd_right`. -/
theorem natAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) :
natAdd m (i.cast h) = (natAdd m i).cast (congrArg _ h) := rfl
natAdd m (cast h i) = cast (congrArg _ h) (natAdd m i) := rfl
theorem cast_natAdd_right {n n' m : Nat} (i : Fin n') (h : m + n' = m + n) :
(natAdd m i).cast h = natAdd m (i.cast (Nat.add_left_cancel h)) := rfl
cast h (natAdd m i) = natAdd m (cast (Nat.add_left_cancel h) i) := rfl
@[simp] theorem cast_natAdd_left {n m m' : Nat} (i : Fin n) (h : m' + n = m + n) :
(natAdd m' i).cast h = natAdd m i :=
cast h (natAdd m' i) = natAdd m i :=
Fin.ext <| (congrArg (· + (i : Nat)) (Nat.add_right_cancel h) : _)
theorem castAdd_natAdd (p m : Nat) {n : Nat} (i : Fin n) :
castAdd p (natAdd m i) = (natAdd m (castAdd p i)).cast (Nat.add_assoc ..).symm := rfl
castAdd p (natAdd m i) = cast (Nat.add_assoc ..).symm (natAdd m (castAdd p i)) := rfl
theorem natAdd_castAdd (p m : Nat) {n : Nat} (i : Fin n) :
natAdd m (castAdd p i) = (castAdd p (natAdd m i)).cast (Nat.add_assoc ..) := rfl
natAdd m (castAdd p i) = cast (Nat.add_assoc ..) (castAdd p (natAdd m i)) := rfl
theorem natAdd_natAdd (m n : Nat) {p : Nat} (i : Fin p) :
natAdd m (natAdd n i) = (natAdd (m + n) i).cast (Nat.add_assoc ..) :=
natAdd m (natAdd n i) = cast (Nat.add_assoc ..) (natAdd (m + n) i) :=
Fin.ext <| (Nat.add_assoc ..).symm
@[simp]
theorem cast_natAdd_zero {n n' : Nat} (i : Fin n) (h : 0 + n = n') :
(natAdd 0 i).cast h = i.cast ((Nat.zero_add _).symm.trans h) := by simp
cast h (natAdd 0 i) = cast ((Nat.zero_add _).symm.trans h) i :=
Fin.ext <| Nat.zero_add _
@[simp]
theorem cast_natAdd (n : Nat) {m : Nat} (i : Fin m) :
(natAdd n i).cast (Nat.add_comm ..) = addNat i n := Fin.ext <| Nat.add_comm ..
cast (Nat.add_comm ..) (natAdd n i) = addNat i n := Fin.ext <| Nat.add_comm ..
@[simp]
theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) :
(addNat i m).cast (Nat.add_comm ..) = natAdd m i := Fin.ext <| Nat.add_comm ..
cast (Nat.add_comm ..) (addNat i m) = natAdd m i := Fin.ext <| Nat.add_comm ..
@[simp] theorem natAdd_last {m n : Nat} : natAdd n (last m) = last (n + m) := rfl
@[simp] theorem addNat_last (n : Nat) :
addNat (last n) m = (last (n + m)).cast (by omega) := by
ext
simp
theorem natAdd_castSucc {m n : Nat} {i : Fin m} : natAdd n (castSucc i) = castSucc (natAdd n i) :=
rfl
@[simp] theorem natAdd_eq_addNat (n : Nat) (i : Fin n) : Fin.natAdd n i = i.addNat n := by
ext
simp
omega
theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := Fin.ext <| by
rw [val_rev, coe_castAdd, coe_addNat, val_rev, Nat.sub_add_comm (Nat.succ_le_of_lt k.is_lt)]
@@ -586,8 +522,8 @@ theorem rev_succ (k : Fin n) : rev (succ k) = castSucc (rev k) := k.rev_addNat 1
@[simp] theorem coe_pred (j : Fin (n + 1)) (h : j 0) : (j.pred h : Nat) = j - 1 := rfl
@[simp] theorem succ_pred : (i : Fin (n + 1)) (h : i 0), (i.pred h).succ = i
| 0, _, hi => by simp only [mk_zero, ne_eq, not_true] at hi
| _ + 1, _, _ => rfl
| 0, h, hi => by simp only [mk_zero, ne_eq, not_true] at hi
| n + 1, h, hi => rfl
@[simp]
theorem pred_succ (i : Fin n) {h : i.succ 0} : i.succ.pred h = i := by
@@ -636,15 +572,6 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
@[simp] theorem subNat_mk {i : Nat} (h₁ : i < n + m) (h₂ : m i) :
subNat m i, h₁ h₂ = i - m, Nat.sub_lt_right_of_lt_add h₂ h₁ := rfl
@[simp] theorem subNat_zero (i : Fin n) (h : 0 (i : Nat)): Fin.subNat 0 i h = i := by
ext
simp
@[simp] theorem subNat_one_succ (i : Fin (n + 1)) (h : 1 (i : Nat)) : (subNat 1 i h).succ = i := by
ext
simp
omega
@[simp] theorem pred_castSucc_succ (i : Fin n) :
pred (castSucc i.succ) (Fin.ne_of_gt (castSucc_pos i.succ_pos)) = castSucc i := rfl
@@ -655,7 +582,7 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
subNat m (addNat i m) h = i := Fin.ext <| Nat.add_sub_cancel i m
@[simp] theorem natAdd_subNat_cast {i : Fin (n + m)} (h : n i) :
natAdd n (subNat n (i.cast (Nat.add_comm ..)) h) = i := by simp [ cast_addNat]
natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [ cast_addNat]; rfl
/-! ### recursion and induction principles -/
@@ -823,12 +750,12 @@ theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right
/-! ### add -/
theorem ofNat'_add [NeZero n] (x : Nat) (y : Fin n) :
@[simp] theorem ofNat'_add [NeZero n] (x : Nat) (y : Fin n) :
Fin.ofNat' n x + y = Fin.ofNat' n (x + y.val) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.add_def]
theorem add_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
@[simp] theorem add_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
x + Fin.ofNat' n y = Fin.ofNat' n (x.val + y) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.add_def]
@@ -838,21 +765,16 @@ theorem add_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
protected theorem coe_sub (a b : Fin n) : ((a - b : Fin n) : Nat) = ((n - b) + a) % n := by
cases a; cases b; rfl
theorem ofNat'_sub [NeZero n] (x : Nat) (y : Fin n) :
@[simp] theorem ofNat'_sub [NeZero n] (x : Nat) (y : Fin n) :
Fin.ofNat' n x - y = Fin.ofNat' n ((n - y.val) + x) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.sub_def]
theorem sub_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
@[simp] theorem sub_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
x - Fin.ofNat' n y = Fin.ofNat' n ((n - y % n) + x.val) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.sub_def]
@[simp] protected theorem sub_self [NeZero n] {x : Fin n} : x - x = 0 := by
ext
rw [Fin.sub_def]
simp
private theorem _root_.Nat.mod_eq_sub_of_lt_two_mul {x n} (h₁ : n x) (h₂ : x < 2 * n) :
x % n = x - n := by
rw [Nat.mod_eq, if_pos (by omega), Nat.mod_eq_of_lt (by omega)]

View File

@@ -31,7 +31,7 @@ opaque floatSpec : FloatSpec := {
structure Float where
val : floatSpec.float
instance : Nonempty Float := { val := floatSpec.val }
instance : Inhabited Float := { val := floatSpec.val }
@[extern "lean_float_add"] opaque Float.add : Float Float Float
@[extern "lean_float_sub"] opaque Float.sub : Float Float Float
@@ -47,25 +47,6 @@ def Float.lt : Float → Float → Prop := fun a b =>
def Float.le : Float Float Prop := fun a b =>
floatSpec.le a.val b.val
/--
Raw transmutation from `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
-/
@[extern "lean_float_of_bits"] opaque Float.ofBits : UInt64 Float
/--
Raw transmutation to `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
Note that this function is distinct from `Float.toUInt64`, which attempts
to preserve the numeric value, and not the bitwise value.
-/
@[extern "lean_float_to_bits"] opaque Float.toBits : Float UInt64
instance : Add Float := Float.add
instance : Sub Float := Float.sub
instance : Mul Float := Float.mul
@@ -91,35 +72,21 @@ instance floatDecLt (a b : Float) : Decidable (a < b) := Float.decLt a b
instance floatDecLe (a b : Float) : Decidable (a b) := Float.decLe a b
@[extern "lean_float_to_string"] opaque Float.toString : Float String
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt8` (including Inf), returns the maximum value of `UInt8`
(i.e. `UInt8.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt8, returns 0. -/
@[extern "lean_float_to_uint8"] opaque Float.toUInt8 : Float UInt8
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt16` (including Inf), returns the maximum value of `UInt16`
(i.e. `UInt16.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt16, returns 0. -/
@[extern "lean_float_to_uint16"] opaque Float.toUInt16 : Float UInt16
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt32` (including Inf), returns the maximum value of `UInt32`
(i.e. `UInt32.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt32, returns 0. -/
@[extern "lean_float_to_uint32"] opaque Float.toUInt32 : Float UInt32
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt64` (including Inf), returns the maximum value of `UInt64`
(i.e. `UInt64.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt64, returns 0. -/
@[extern "lean_float_to_uint64"] opaque Float.toUInt64 : Float UInt64
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `USize` (including Inf), returns the maximum value of `USize`
(i.e. `USize.size - 1`). This value is platform dependent).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for USize, returns 0. -/
@[extern "lean_float_to_usize"] opaque Float.toUSize : Float USize
@[extern "lean_float_isnan"] opaque Float.isNaN : Float Bool
@@ -136,9 +103,6 @@ instance : ToString Float where
@[extern "lean_uint64_to_float"] opaque UInt64.toFloat (n : UInt64) : Float
instance : Inhabited Float where
default := UInt64.toFloat 0
instance : Repr Float where
reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n

View File

@@ -1,179 +0,0 @@
/-
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.Data.Int.Basic
import Init.Data.ToString.Basic
import Init.Data.Float
-- Just show FloatSpec is inhabited.
opaque float32Spec : FloatSpec := {
float := Unit,
val := (),
lt := fun _ _ => True,
le := fun _ _ => True,
decLt := fun _ _ => inferInstanceAs (Decidable True),
decLe := fun _ _ => inferInstanceAs (Decidable True)
}
/-- Native floating point type, corresponding to the IEEE 754 *binary32* format
(`float` in C or `f32` in Rust). -/
structure Float32 where
val : float32Spec.float
instance : Nonempty Float32 := { val := float32Spec.val }
@[extern "lean_float32_add"] opaque Float32.add : Float32 Float32 Float32
@[extern "lean_float32_sub"] opaque Float32.sub : Float32 Float32 Float32
@[extern "lean_float32_mul"] opaque Float32.mul : Float32 Float32 Float32
@[extern "lean_float32_div"] opaque Float32.div : Float32 Float32 Float32
@[extern "lean_float32_negate"] opaque Float32.neg : Float32 Float32
set_option bootstrap.genMatcherCode false
def Float32.lt : Float32 Float32 Prop := fun a b =>
match a, b with
| a, b => float32Spec.lt a b
def Float32.le : Float32 Float32 Prop := fun a b =>
float32Spec.le a.val b.val
/--
Raw transmutation from `UInt32`.
Float32s and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
-/
@[extern "lean_float32_of_bits"] opaque Float32.ofBits : UInt32 Float32
/--
Raw transmutation to `UInt32`.
Float32s and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
Note that this function is distinct from `Float32.toUInt32`, which attempts
to preserve the numeric value, and not the bitwise value.
-/
@[extern "lean_float32_to_bits"] opaque Float32.toBits : Float32 UInt32
instance : Add Float32 := Float32.add
instance : Sub Float32 := Float32.sub
instance : Mul Float32 := Float32.mul
instance : Div Float32 := Float32.div
instance : Neg Float32 := Float32.neg
instance : LT Float32 := Float32.lt
instance : LE Float32 := Float32.le
/-- Note: this is not reflexive since `NaN != NaN`.-/
@[extern "lean_float32_beq"] opaque Float32.beq (a b : Float32) : Bool
instance : BEq Float32 := Float32.beq
@[extern "lean_float32_decLt"] opaque Float32.decLt (a b : Float32) : Decidable (a < b) :=
match a, b with
| a, b => float32Spec.decLt a b
@[extern "lean_float32_decLe"] opaque Float32.decLe (a b : Float32) : Decidable (a b) :=
match a, b with
| a, b => float32Spec.decLe a b
instance float32DecLt (a b : Float32) : Decidable (a < b) := Float32.decLt a b
instance float32DecLe (a b : Float32) : Decidable (a b) := Float32.decLe a b
@[extern "lean_float32_to_string"] opaque Float32.toString : Float32 String
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt8` (including Inf), returns the maximum value of `UInt8`
(i.e. `UInt8.size - 1`).
-/
@[extern "lean_float32_to_uint8"] opaque Float32.toUInt8 : Float32 UInt8
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt16` (including Inf), returns the maximum value of `UInt16`
(i.e. `UInt16.size - 1`).
-/
@[extern "lean_float32_to_uint16"] opaque Float32.toUInt16 : Float32 UInt16
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt32` (including Inf), returns the maximum value of `UInt32`
(i.e. `UInt32.size - 1`).
-/
@[extern "lean_float32_to_uint32"] opaque Float32.toUInt32 : Float32 UInt32
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt64` (including Inf), returns the maximum value of `UInt64`
(i.e. `UInt64.size - 1`).
-/
@[extern "lean_float32_to_uint64"] opaque Float32.toUInt64 : Float32 UInt64
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `USize` (including Inf), returns the maximum value of `USize`
(i.e. `USize.size - 1`). This value is platform dependent).
-/
@[extern "lean_float32_to_usize"] opaque Float32.toUSize : Float32 USize
@[extern "lean_float32_isnan"] opaque Float32.isNaN : Float32 Bool
@[extern "lean_float32_isfinite"] opaque Float32.isFinite : Float32 Bool
@[extern "lean_float32_isinf"] opaque Float32.isInf : Float32 Bool
/-- Splits the given float `x` into a significand/exponent pair `(s, i)`
such that `x = s * 2^i` where `s ∈ (-1;-0.5] [0.5; 1)`.
Returns an undefined value if `x` is not finite.
-/
@[extern "lean_float32_frexp"] opaque Float32.frExp : Float32 Float32 × Int
instance : ToString Float32 where
toString := Float32.toString
@[extern "lean_uint64_to_float32"] opaque UInt64.toFloat32 (n : UInt64) : Float32
instance : Inhabited Float32 where
default := UInt64.toFloat32 0
instance : Repr Float32 where
reprPrec n prec := if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
instance : ReprAtom Float32 :=
@[extern "sinf"] opaque Float32.sin : Float32 Float32
@[extern "cosf"] opaque Float32.cos : Float32 Float32
@[extern "tanf"] opaque Float32.tan : Float32 Float32
@[extern "asinf"] opaque Float32.asin : Float32 Float32
@[extern "acosf"] opaque Float32.acos : Float32 Float32
@[extern "atanf"] opaque Float32.atan : Float32 Float32
@[extern "atan2f"] opaque Float32.atan2 : Float32 Float32 Float32
@[extern "sinhf"] opaque Float32.sinh : Float32 Float32
@[extern "coshf"] opaque Float32.cosh : Float32 Float32
@[extern "tanhf"] opaque Float32.tanh : Float32 Float32
@[extern "asinhf"] opaque Float32.asinh : Float32 Float32
@[extern "acoshf"] opaque Float32.acosh : Float32 Float32
@[extern "atanhf"] opaque Float32.atanh : Float32 Float32
@[extern "expf"] opaque Float32.exp : Float32 Float32
@[extern "exp2f"] opaque Float32.exp2 : Float32 Float32
@[extern "logf"] opaque Float32.log : Float32 Float32
@[extern "log2f"] opaque Float32.log2 : Float32 Float32
@[extern "log10f"] opaque Float32.log10 : Float32 Float32
@[extern "powf"] opaque Float32.pow : Float32 Float32 Float32
@[extern "sqrtf"] opaque Float32.sqrt : Float32 Float32
@[extern "cbrtf"] opaque Float32.cbrt : Float32 Float32
@[extern "ceilf"] opaque Float32.ceil : Float32 Float32
@[extern "floorf"] opaque Float32.floor : Float32 Float32
@[extern "roundf"] opaque Float32.round : Float32 Float32
@[extern "fabsf"] opaque Float32.abs : Float32 Float32
instance : HomogeneousPow Float32 := Float32.pow
instance : Min Float32 := minOfLe
instance : Max Float32 := maxOfLe
/--
Efficiently computes `x * 2^i`.
-/
@[extern "lean_float32_scaleb"]
opaque Float32.scaleB (x : Float32) (i : @& Int) : Float32
@[extern "lean_float32_to_float"] opaque Float32.toFloat : Float32 Float
@[extern "lean_float_to_float32"] opaque Float.toFloat32 : Float Float32

View File

@@ -46,8 +46,8 @@ def uget : (a : @& FloatArray) → (i : USize) → i.toNat < a.size → Float
| ds, i, h => ds[i]
@[extern "lean_float_array_fget"]
def get : (ds : @& FloatArray) (i : @& Nat) (h : i < ds.size := by get_elem_tactic) Float
| ds, i, h => ds.get i h
def get : (ds : @& FloatArray) (@& Fin ds.size) Float
| ds, i => ds.get i
@[extern "lean_float_array_get"]
def get! : (@& FloatArray) (@& Nat) Float
@@ -55,23 +55,23 @@ def get! : (@& FloatArray) → (@& Nat) → Float
def get? (ds : FloatArray) (i : Nat) : Option Float :=
if h : i < ds.size then
some (ds.get i h)
ds.get i, h
else
none
instance : GetElem FloatArray Nat Float fun xs i => i < xs.size where
getElem xs i h := xs.get i h
getElem xs i h := xs.get i, h
instance : GetElem FloatArray USize Float fun xs i => i.val < xs.size where
getElem xs i h := xs.uget i h
@[extern "lean_float_array_uset"]
def uset : (a : FloatArray) (i : USize) Float (h : i.toNat < a.size := by get_elem_tactic) FloatArray
def uset : (a : FloatArray) (i : USize) Float i.toNat < a.size FloatArray
| ds, i, v, h => ds.uset i v h
@[extern "lean_float_array_fset"]
def set : (ds : FloatArray) (i : @& Nat) Float (h : i < ds.size := by get_elem_tactic) FloatArray
| ds, i, d, h => ds.set i d h
def set : (ds : FloatArray) (@& Fin ds.size) Float FloatArray
| ds, i, d => ds.set i d
@[extern "lean_float_array_set"]
def set! : FloatArray (@& Nat) Float FloatArray
@@ -83,7 +83,7 @@ def isEmpty (s : FloatArray) : Bool :=
partial def toList (ds : FloatArray) : List Float :=
let rec loop (i r) :=
if h : i < ds.size then
loop (i+1) (ds[i] :: r)
loop (i+1) (ds.get i, h :: r)
else
r.reverse
loop 0 []
@@ -115,7 +115,7 @@ protected def forIn {β : Type v} {m : Type v → Type w} [Monad m] (as : FloatA
have h' : i < as.size := Nat.lt_of_lt_of_le (Nat.lt_succ_self i) h
have : as.size - 1 < as.size := Nat.sub_lt (Nat.zero_lt_of_lt h') (by decide)
have : as.size - 1 - i < as.size := Nat.lt_of_le_of_lt (Nat.sub_le (as.size - 1) i) this
match ( f as[as.size - 1 - i] b) with
match ( f (as.get as.size - 1 - i, this) b) with
| ForInStep.done b => pure b
| ForInStep.yield b => loop i (Nat.le_of_lt h') b
loop as.size (Nat.le_refl _) b
@@ -149,7 +149,7 @@ def foldlM {β : Type v} {m : Type v → Type w} [Monad m] (f : β → Float →
match i with
| 0 => pure b
| i'+1 =>
loop i' (j+1) ( f b (as[j]'(Nat.lt_of_lt_of_le hlt h)))
loop i' (j+1) ( f b (as.get j, Nat.lt_of_lt_of_le hlt h))
else
pure b
loop (stop - start) start init

View File

@@ -1,35 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Core
namespace Function
@[inline]
def curry : (α × β φ) α β φ := fun f a b => f (a, b)
/-- Interpret a function with two arguments as a function on `α × β` -/
@[inline]
def uncurry : (α β φ) α × β φ := fun f a => f a.1 a.2
@[simp]
theorem curry_uncurry (f : α β φ) : curry (uncurry f) = f :=
rfl
@[simp]
theorem uncurry_curry (f : α × β φ) : uncurry (curry f) = f :=
funext fun _a, _b => rfl
@[simp]
theorem uncurry_apply_pair {α β γ} (f : α β γ) (x : α) (y : β) : uncurry f (x, y) = f x y :=
rfl
@[simp]
theorem curry_apply {α β γ} (f : α × β γ) (x : α) (y : β) : curry f x y = f (x, y) :=
rfl
end Function

View File

@@ -48,15 +48,9 @@ instance : Hashable UInt64 where
instance : Hashable USize where
hash n := n.toUInt64
instance : Hashable ByteArray where
hash as := as.foldl (fun r a => mixHash r (hash a)) 7
instance : Hashable (Fin n) where
hash v := v.val.toUInt64
instance : Hashable Char where
hash c := c.val.toUInt64
instance : Hashable Int where
hash
| Int.ofNat n => UInt64.ofNat (2 * n)

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