mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-18 10:54:09 +00:00
Compare commits
139 Commits
attachWith
...
empty_suba
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
fd7377eb54 | ||
|
|
96adf04a62 | ||
|
|
0db6daa8f1 | ||
|
|
130b465aaf | ||
|
|
ccdf07b6a1 | ||
|
|
5605e0198a | ||
|
|
5f22ba7789 | ||
|
|
16a16898d5 | ||
|
|
4ea76aadd1 | ||
|
|
ef71f0beab | ||
|
|
9f4075be72 | ||
|
|
1b6572726f | ||
|
|
56b78a0ed1 | ||
|
|
e28bfedae2 | ||
|
|
e7691f37c6 | ||
|
|
48711ce6eb | ||
|
|
0733273a78 | ||
|
|
2221296d3c | ||
|
|
f22998edfe | ||
|
|
3817b16c35 | ||
|
|
9eef726204 | ||
|
|
9460f79d28 | ||
|
|
c38c07e1a1 | ||
|
|
062ecb5eae | ||
|
|
13969ad667 | ||
|
|
91a033488c | ||
|
|
1fb75b68ab | ||
|
|
26f508db87 | ||
|
|
3d1ac7cfa2 | ||
|
|
0196bca784 | ||
|
|
b320dcfef9 | ||
|
|
5dea30f169 | ||
|
|
90cb6e5da8 | ||
|
|
a3ca15d2b2 | ||
|
|
c2f6297554 | ||
|
|
1defa2028f | ||
|
|
78c40f380c | ||
|
|
3e2a465b13 | ||
|
|
1ec0c64c7b | ||
|
|
604bcf50ef | ||
|
|
145c9efb32 | ||
|
|
e4f2de0a53 | ||
|
|
7845a05cf1 | ||
|
|
57679eeff5 | ||
|
|
974cc3306c | ||
|
|
c7819bd6eb | ||
|
|
a4fb740d2f | ||
|
|
ea75c924a1 | ||
|
|
65f4b92505 | ||
|
|
a6f0112fc5 | ||
|
|
eee0553318 | ||
|
|
5d2c7fc1d9 | ||
|
|
94de4ae964 | ||
|
|
1129160d80 | ||
|
|
8cc62940e0 | ||
|
|
b612403980 | ||
|
|
6b0d4e50c0 | ||
|
|
0cae7165aa | ||
|
|
ba43ce18c3 | ||
|
|
3190be3058 | ||
|
|
a108644461 | ||
|
|
4b47a10bef | ||
|
|
2d5ebf3705 | ||
|
|
5017b2bfbf | ||
|
|
1b4ee185e8 | ||
|
|
27c4c366b4 | ||
|
|
405b5aa047 | ||
|
|
edf2327229 | ||
|
|
cda6733f97 | ||
|
|
624f1b9963 | ||
|
|
cf94f793a2 | ||
|
|
9185955692 | ||
|
|
9d583ab4ec | ||
|
|
50339e38d9 | ||
|
|
8b61dda964 | ||
|
|
fc20b5dfb4 | ||
|
|
7fba7ed7b6 | ||
|
|
2f2142ab37 | ||
|
|
e551a366a0 | ||
|
|
f4afbc2f8b | ||
|
|
8c8585536c | ||
|
|
c825b5a560 | ||
|
|
738435b90a | ||
|
|
1883c9b7eb | ||
|
|
fc52015841 | ||
|
|
a6830f90ab | ||
|
|
eceba0faf4 | ||
|
|
fc963ffceb | ||
|
|
d8e0fa425b | ||
|
|
e43664c405 | ||
|
|
c50bc845c2 | ||
|
|
b41019e8e8 | ||
|
|
0a2d121e45 | ||
|
|
152ca85fa9 | ||
|
|
0ecf2a030a | ||
|
|
7b8f2fe54c | ||
|
|
34f85bee02 | ||
|
|
590c725943 | ||
|
|
9193196208 | ||
|
|
c3f384d6a5 | ||
|
|
daf24ff6aa | ||
|
|
fa6afa85df | ||
|
|
592e1dc6c2 | ||
|
|
c4293f04ef | ||
|
|
e417ad8a70 | ||
|
|
ddd471223c | ||
|
|
4e5e2ad311 | ||
|
|
dcff54edb5 | ||
|
|
30e90a4dff | ||
|
|
988fc7b25a | ||
|
|
3872027d92 | ||
|
|
d38dc72a54 | ||
|
|
4641ed8c96 | ||
|
|
77cd700fa8 | ||
|
|
a6a06a620f | ||
|
|
21d71de481 | ||
|
|
b74f85accd | ||
|
|
46b16b6df1 | ||
|
|
445c8f2ee0 | ||
|
|
3f8e3e726d | ||
|
|
45af92fcd1 | ||
|
|
7952a7f74d | ||
|
|
c25d206647 | ||
|
|
078e9b6d77 | ||
|
|
a745e33123 | ||
|
|
7740a38a71 | ||
|
|
9568f305d8 | ||
|
|
b1179d5cc3 | ||
|
|
e6145a6937 | ||
|
|
d47ae99721 | ||
|
|
0aac83fe40 | ||
|
|
8c6ac845b1 | ||
|
|
b714a96034 | ||
|
|
4e0f6b8b45 | ||
|
|
979c5a4d6a | ||
|
|
2079bdcbca | ||
|
|
1a2217d47e | ||
|
|
3ef67c468a | ||
|
|
4c439c73a7 |
2
.github/ISSUE_TEMPLATE/bug_report.md
vendored
2
.github/ISSUE_TEMPLATE/bug_report.md
vendored
@@ -25,7 +25,7 @@ Please put an X between the brackets as you perform the following steps:
|
||||
|
||||
### Context
|
||||
|
||||
[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.]
|
||||
[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.]
|
||||
|
||||
### Steps to Reproduce
|
||||
|
||||
|
||||
2
.github/workflows/ci.yml
vendored
2
.github/workflows/ci.yml
vendored
@@ -316,7 +316,7 @@ 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 overriden)
|
||||
# (needs to be after "Checkout" so files don't get overridden)
|
||||
- name: Setup emsdk
|
||||
uses: mymindstorm/setup-emsdk@v12
|
||||
with:
|
||||
|
||||
20
.github/workflows/pr-release.yml
vendored
20
.github/workflows/pr-release.yml
vendored
@@ -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_BOT }}" \
|
||||
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_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-mathlib4-bot"))')"
|
||||
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-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_BOT token here, so that Mathlib CI can subsequently edit the comment.
|
||||
# It's essential we use the MATHLIB4_COMMENT_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_BOT }}" \
|
||||
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_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_BOT }}" \
|
||||
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_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"
|
||||
@@ -329,16 +329,18 @@ 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 "nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
|
||||
sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}",' 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, pushing an empty commit."
|
||||
echo "Branch already exists, merging $BASE and bumping Batteries."
|
||||
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
|
||||
get add lake-manifest.json
|
||||
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
|
||||
fi
|
||||
|
||||
|
||||
20
RELEASES.md
20
RELEASES.md
@@ -381,7 +381,7 @@ v4.10.0
|
||||
|
||||
* **Commands**
|
||||
* [#4370](https://github.com/leanprover/lean4/pull/4370) makes the `variable` command fully elaborate binders during validation, fixing an issue where some errors would be reported only at the next declaration.
|
||||
* [#4408](https://github.com/leanprover/lean4/pull/4408) fixes a discrepency in universe parameter order between `theorem` and `def` declarations.
|
||||
* [#4408](https://github.com/leanprover/lean4/pull/4408) fixes a discrepancy in universe parameter order between `theorem` and `def` declarations.
|
||||
* [#4493](https://github.com/leanprover/lean4/pull/4493) and
|
||||
[#4482](https://github.com/leanprover/lean4/pull/4482) fix a discrepancy in the elaborators for `theorem`, `def`, and `example`,
|
||||
making `Prop`-valued `example`s and other definition commands elaborate like `theorem`s.
|
||||
@@ -443,7 +443,7 @@ v4.10.0
|
||||
* [#4454](https://github.com/leanprover/lean4/pull/4454) adds public `Name.isInternalDetail` function for filtering declarations using naming conventions for internal names.
|
||||
|
||||
* **Other fixes or improvements**
|
||||
* [#4416](https://github.com/leanprover/lean4/pull/4416) sorts the ouput of `#print axioms` for determinism.
|
||||
* [#4416](https://github.com/leanprover/lean4/pull/4416) sorts the output of `#print axioms` for determinism.
|
||||
* [#4528](https://github.com/leanprover/lean4/pull/4528) fixes error message range for the cdot focusing tactic.
|
||||
|
||||
### Language server, widgets, and IDE extensions
|
||||
@@ -479,7 +479,7 @@ v4.10.0
|
||||
* [#4372](https://github.com/leanprover/lean4/pull/4372) fixes linearity in `HashMap.insert` and `HashMap.erase`, leading to a 40% speedup in a replace-heavy workload.
|
||||
* `Option`
|
||||
* [#4403](https://github.com/leanprover/lean4/pull/4403) generalizes type of `Option.forM` from `Unit` to `PUnit`.
|
||||
* [#4504](https://github.com/leanprover/lean4/pull/4504) remove simp attribute from `Option.elim` and instead adds it to individal reduction lemmas, making unfolding less aggressive.
|
||||
* [#4504](https://github.com/leanprover/lean4/pull/4504) remove simp attribute from `Option.elim` and instead adds it to individual reduction lemmas, making unfolding less aggressive.
|
||||
* `Nat`
|
||||
* [#4242](https://github.com/leanprover/lean4/pull/4242) adds missing theorems for `n + 1` and `n - 1` normal forms.
|
||||
* [#4486](https://github.com/leanprover/lean4/pull/4486) makes `Nat.min_assoc` be a simp lemma.
|
||||
@@ -940,7 +940,7 @@ While most changes could be considered to be a breaking change, this section mak
|
||||
In particular, tactics embedded in the type will no longer make use of the type of `value` in expressions such as `let x : type := value; body`.
|
||||
* Now functions defined by well-founded recursion are marked with `@[irreducible]` by default ([#4061](https://github.com/leanprover/lean4/pull/4061)).
|
||||
Existing proofs that hold by definitional equality (e.g. `rfl`) can be
|
||||
rewritten to explictly unfold the function definition (using `simp`,
|
||||
rewritten to explicitly unfold the function definition (using `simp`,
|
||||
`unfold`, `rw`), or the recursive function can be temporarily made
|
||||
semireducible (using `unseal f in` before the command), or the function
|
||||
definition itself can be marked as `@[semireducible]` to get the previous
|
||||
@@ -1559,7 +1559,7 @@ v4.7.0
|
||||
and `BitVec` as we begin making the APIs and simp normal forms for these types
|
||||
more complete and consistent.
|
||||
4. Laying the groundwork for the Std roadmap, as a library focused on
|
||||
essential datatypes not provided by the core langauge (e.g. `RBMap`)
|
||||
essential datatypes not provided by the core language (e.g. `RBMap`)
|
||||
and utilities such as basic IO.
|
||||
While we have achieved most of our initial aims in `v4.7.0-rc1`,
|
||||
some upstreaming will continue over the coming months.
|
||||
@@ -1570,7 +1570,7 @@ v4.7.0
|
||||
There is now kernel support for these functions.
|
||||
[#3376](https://github.com/leanprover/lean4/pull/3376).
|
||||
|
||||
* `omega`, our integer linear arithmetic tactic, is now availabe in the core langauge.
|
||||
* `omega`, our integer linear arithmetic tactic, is now available in the core language.
|
||||
* It is supplemented by a preprocessing tactic `bv_omega` which can solve goals about `BitVec`
|
||||
which naturally translate into linear arithmetic problems.
|
||||
[#3435](https://github.com/leanprover/lean4/pull/3435).
|
||||
@@ -1663,11 +1663,11 @@ v4.6.0
|
||||
/-
|
||||
The `Step` type has three constructors: `.done`, `.visit`, `.continue`.
|
||||
* The constructor `.done` instructs `simp` that the result does
|
||||
not need to be simplied further.
|
||||
not need to be simplified further.
|
||||
* The constructor `.visit` instructs `simp` to visit the resulting expression.
|
||||
* The constructor `.continue` instructs `simp` to try other simplification procedures.
|
||||
|
||||
All three constructors take a `Result`. The `.continue` contructor may also take `none`.
|
||||
All three constructors take a `Result`. The `.continue` constructor may also take `none`.
|
||||
`Result` has two fields `expr` (the new expression), and `proof?` (an optional proof).
|
||||
If the new expression is definitionally equal to the input one, then `proof?` can be omitted or set to `none`.
|
||||
-/
|
||||
@@ -1879,7 +1879,7 @@ v4.5.0
|
||||
---------
|
||||
|
||||
* Modify the lexical syntax of string literals to have string gaps, which are escape sequences of the form `"\" newline whitespace*`.
|
||||
These have the interpetation of an empty string and allow a string to flow across multiple lines without introducing additional whitespace.
|
||||
These have the interpretation of an empty string and allow a string to flow across multiple lines without introducing additional whitespace.
|
||||
The following is equivalent to `"this is a string"`.
|
||||
```lean
|
||||
"this is \
|
||||
@@ -1902,7 +1902,7 @@ v4.5.0
|
||||
|
||||
If the well-founded relation you want to use is not the one that the
|
||||
`WellFoundedRelation` type class would infer for your termination argument,
|
||||
you can use `WellFounded.wrap` from the std libarary to explicitly give one:
|
||||
you can use `WellFounded.wrap` from the std library to explicitly give one:
|
||||
```diff
|
||||
-termination_by' ⟨r, hwf⟩
|
||||
+termination_by x => hwf.wrap x
|
||||
|
||||
@@ -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 also manually
|
||||
If you have write access to the lean4 repository, you can 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
|
||||
|
||||
@@ -71,6 +71,12 @@ 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
|
||||
|
||||
@@ -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} contructors"
|
||||
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} constructors"
|
||||
|
||||
open Elab Tactic
|
||||
|
||||
|
||||
@@ -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/simplications rules.
|
||||
use hypotheses such as `a = b` as rewriting/simplifications 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
|
||||
|
||||
@@ -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/simplications rules.
|
||||
use hypotheses such as `a = b` as rewriting/simplifications 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
|
||||
|
||||
@@ -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 the `cases` tactic. This tactic creates a new subgoal for every constructor,
|
||||
by using 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,7 @@ 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. The tactic `rename_i` is used to to rename "inaccessible" variables.
|
||||
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used 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`.
|
||||
|
||||
@@ -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` instnace.
|
||||
we need `FromJson` and `ToJson` instance.
|
||||
We'll see why the position field is needed later.
|
||||
-/
|
||||
|
||||
|
||||
@@ -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 to ``t``.
|
||||
* *δ-reduction* : If ``c`` is a defined constant with definition ``t``, then ``c`` δ-reduces 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:
|
||||
|
||||
@@ -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 is a little more complicated, so don't sweat it too much. It states that the order that
|
||||
This law 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
|
||||
|
||||
@@ -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 comitted
|
||||
# copy the README to ensure the `stage0/src/lake` directory is committed
|
||||
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}
|
||||
|
||||
@@ -40,21 +40,23 @@ 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
|
||||
|
||||
-- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`.
|
||||
@[deprecated "Use `ite_eq_right_iff`" (since := "2024-09-18")]
|
||||
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
|
||||
|
||||
@[simp] theorem ite_some_none_eq_some [Decidable P] :
|
||||
@[deprecated "Use `Option.ite_none_right_eq_some`" (since := "2024-09-18")]
|
||||
theorem ite_some_none_eq_some [Decidable P] :
|
||||
(if P then some x else none) = some y ↔ P ∧ x = y := by
|
||||
split <;> simp_all
|
||||
|
||||
-- This is not marked as `simp` as it is already handled by `dite_eq_right_iff`.
|
||||
@[deprecated "Use `dite_eq_right_iff" (since := "2024-09-18")]
|
||||
theorem dite_some_none_eq_none [Decidable P] {x : P → α} :
|
||||
(if h : P then some (x h) else none) = none ↔ ¬P := by
|
||||
simp
|
||||
|
||||
@[simp] theorem dite_some_none_eq_some [Decidable P] {x : P → α} {y : α} :
|
||||
@[deprecated "Use `Option.dite_none_right_eq_some`" (since := "2024-09-18")]
|
||||
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]
|
||||
|
||||
@@ -121,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 supercedes byCases in Decidable
|
||||
-- this supersedes byCases in Decidable
|
||||
theorem byCases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
|
||||
Decidable.byCases (dec := propDecidable _) hpq hnpq
|
||||
|
||||
-- this supercedes byContradiction in Decidable
|
||||
-- this supersedes byContradiction in Decidable
|
||||
theorem byContradiction {p : Prop} (h : ¬p → False) : p :=
|
||||
Decidable.byContradiction (dec := propDecidable _) h
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@ Important instances include
|
||||
* `Option`, where `failure := none` and `<|>` returns the left-most `some`.
|
||||
* Parser combinators typically provide an `Applicative` instance for error-handling and
|
||||
backtracking.
|
||||
|
||||
|
||||
Error recovery and state can interact subtly. For example, the implementation of `Alternative` for `OptionT (StateT σ Id)` keeps modifications made to the state while recovering from failure, while `StateT σ (OptionT Id)` discards them.
|
||||
-/
|
||||
-- NB: List instance is in mathlib. Once upstreamed, add
|
||||
|
||||
@@ -33,6 +33,10 @@ 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:
|
||||
@@ -83,12 +87,16 @@ 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
|
||||
attribute [simp] pure_bind bind_assoc bind_pure_comp
|
||||
|
||||
@[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]
|
||||
|
||||
@@ -109,10 +117,21 @@ 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 [map_eq_pure_bind, seq_eq_bind_map, const]
|
||||
simp only [map_eq_pure_bind, const, seq_eq_bind_map, bind_assoc, pure_bind, id_eq, bind_pure]
|
||||
|
||||
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
|
||||
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
|
||||
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]
|
||||
|
||||
/--
|
||||
An alternative constructor for `LawfulMonad` which has more
|
||||
|
||||
@@ -25,7 +25,7 @@ theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
|
||||
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
|
||||
|
||||
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α → ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
|
||||
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
|
||||
simp [ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont]
|
||||
|
||||
@[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]
|
||||
@@ -43,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, map_eq_pure_bind]
|
||||
simp [Functor.map, ExceptT.map, ←bind_pure_comp]
|
||||
apply bind_congr
|
||||
intro a; cases a <;> simp [Except.map]
|
||||
|
||||
@@ -62,7 +62,7 @@ protected theorem seqLeft_eq {α β ε : Type u} {m : Type u → Type v} [Monad
|
||||
intro
|
||||
| Except.error _ => simp
|
||||
| Except.ok _ =>
|
||||
simp [map_eq_pure_bind]; apply bind_congr; intro b;
|
||||
simp [←bind_pure_comp]; 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
|
||||
@@ -175,7 +175,7 @@ theorem ext {x y : StateT σ m α} (h : ∀ s, x.run s = y.run s) : x = y :=
|
||||
simp [bind, StateT.bind, run]
|
||||
|
||||
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α → β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
|
||||
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
|
||||
simp [Functor.map, StateT.map, run, ←bind_pure_comp]
|
||||
|
||||
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
|
||||
|
||||
@@ -210,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 [map_eq_pure_bind, const]
|
||||
simp [←bind_pure_comp, const]
|
||||
apply bind_congr; intro p; cases p
|
||||
simp [Prod.eta]
|
||||
|
||||
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
|
||||
apply ext; intro s
|
||||
simp [map_eq_pure_bind]
|
||||
simp [←bind_pure_comp]
|
||||
|
||||
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
|
||||
id_map := by intros; apply ext; intros; simp[Prod.eta]
|
||||
@@ -224,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; apply LawfulMonad.bind_pure_comp
|
||||
bind_pure_comp := by intros; apply ext; intros; simp
|
||||
bind_map := by intros; rfl
|
||||
pure_bind := by intros; apply ext; intros; simp
|
||||
bind_assoc := by intros; apply ext; intros; simp
|
||||
|
||||
@@ -823,6 +823,9 @@ 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 :=
|
||||
@@ -835,6 +838,9 @@ 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
|
||||
@@ -1191,6 +1197,21 @@ 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)
|
||||
|
||||
@@ -1875,7 +1896,8 @@ 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 {α : Sort u} {β : α → Sort v} [∀ a, Subsingleton (β a)] : Subsingleton (∀ a, β a) where
|
||||
instance Pi.instSubsingleton {α : Sort u} {β : α → Sort v} [∀ a, Subsingleton (β a)] :
|
||||
Subsingleton (∀ a, β a) where
|
||||
allEq f g := funext fun a => Subsingleton.elim (f a) (g a)
|
||||
|
||||
/-! # Squash -/
|
||||
@@ -2038,7 +2060,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 infering the identity using class resoluton.
|
||||
is used primarily for inferring the identity using class resolution.
|
||||
-/
|
||||
class LeftIdentity (op : α → β → β) (o : outParam α) : Prop
|
||||
|
||||
@@ -2054,7 +2076,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 infering the identity using class resoluton.
|
||||
primarily for inferring the identity using class resolution.
|
||||
-/
|
||||
class RightIdentity (op : α → β → α) (o : outParam β) : Prop
|
||||
|
||||
@@ -2070,7 +2092,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 infering the identity using class resoluton.
|
||||
primarily for inferring the identity using class resolution.
|
||||
-/
|
||||
class Identity (op : α → α → α) (o : outParam α) extends LeftIdentity op o, RightIdentity op o : Prop
|
||||
|
||||
|
||||
@@ -33,7 +33,6 @@ 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
|
||||
|
||||
@@ -15,3 +15,4 @@ 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
|
||||
|
||||
@@ -13,43 +13,75 @@ import Init.Data.ToString.Basic
|
||||
import Init.GetElem
|
||||
universe u v w
|
||||
|
||||
namespace Array
|
||||
/-! ### Array literal syntax -/
|
||||
|
||||
syntax "#[" withoutPosition(sepBy(term, ", ")) "]" : term
|
||||
|
||||
macro_rules
|
||||
| `(#[ $elems,* ]) => `(List.toArray [ $elems,* ])
|
||||
|
||||
variable {α : Type u}
|
||||
|
||||
namespace Array
|
||||
|
||||
/-! ### Preliminary theorems -/
|
||||
|
||||
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
|
||||
List.length_set ..
|
||||
|
||||
@[simp] theorem size_push (a : Array α) (v : α) : (push a v).size = a.size + 1 :=
|
||||
List.length_concat ..
|
||||
|
||||
theorem ext (a b : Array α)
|
||||
(h₁ : a.size = b.size)
|
||||
(h₂ : (i : Nat) → (hi₁ : i < a.size) → (hi₂ : i < b.size) → a[i] = b[i])
|
||||
: a = b := by
|
||||
let rec extAux (a b : List α)
|
||||
(h₁ : a.length = b.length)
|
||||
(h₂ : (i : Nat) → (hi₁ : i < a.length) → (hi₂ : i < b.length) → a.get ⟨i, hi₁⟩ = b.get ⟨i, hi₂⟩)
|
||||
: a = b := by
|
||||
induction a generalizing b with
|
||||
| nil =>
|
||||
cases b with
|
||||
| nil => rfl
|
||||
| cons b bs => rw [List.length_cons] at h₁; injection h₁
|
||||
| cons a as ih =>
|
||||
cases b with
|
||||
| nil => rw [List.length_cons] at h₁; injection h₁
|
||||
| cons b bs =>
|
||||
have hz₁ : 0 < (a::as).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
|
||||
have hz₂ : 0 < (b::bs).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
|
||||
have headEq : a = b := h₂ 0 hz₁ hz₂
|
||||
have h₁' : as.length = bs.length := by rw [List.length_cons, List.length_cons] at h₁; injection h₁
|
||||
have h₂' : (i : Nat) → (hi₁ : i < as.length) → (hi₂ : i < bs.length) → as.get ⟨i, hi₁⟩ = bs.get ⟨i, hi₂⟩ := by
|
||||
intro i hi₁ hi₂
|
||||
have hi₁' : i+1 < (a::as).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
|
||||
have hi₂' : i+1 < (b::bs).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
|
||||
have : (a::as).get ⟨i+1, hi₁'⟩ = (b::bs).get ⟨i+1, hi₂'⟩ := h₂ (i+1) hi₁' hi₂'
|
||||
apply this
|
||||
have tailEq : as = bs := ih bs h₁' h₂'
|
||||
rw [headEq, tailEq]
|
||||
cases a; cases b
|
||||
apply congrArg
|
||||
apply extAux
|
||||
assumption
|
||||
assumption
|
||||
|
||||
theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
|
||||
cases as; cases bs; simp at h; rw [h]
|
||||
|
||||
@[simp] theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).toList = acc.toList ++ as := by
|
||||
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
|
||||
|
||||
@[simp] theorem toList_toArray (as : List α) : as.toArray.toList = as := rfl
|
||||
|
||||
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
|
||||
|
||||
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
|
||||
|
||||
@[deprecated Array.toList (since := "2024-09-10")] abbrev Array.data := @Array.toList
|
||||
|
||||
@[extern "lean_mk_array"]
|
||||
def mkArray {α : Type u} (n : Nat) (v : α) : Array α where
|
||||
toList := List.replicate n v
|
||||
|
||||
/--
|
||||
`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`.
|
||||
```
|
||||
ofFn f = #[f 0, f 1, ... , f(n - 1)]
|
||||
``` -/
|
||||
def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
|
||||
/-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/
|
||||
go (i : Nat) (acc : Array α) : Array α :=
|
||||
if h : i < n then go (i+1) (acc.push (f ⟨i, h⟩)) else acc
|
||||
termination_by n - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
/-- The array `#[0, 1, ..., n - 1]`. -/
|
||||
def range (n : Nat) : Array Nat :=
|
||||
n.fold (flip Array.push) (mkEmpty n)
|
||||
|
||||
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
|
||||
List.length_replicate ..
|
||||
|
||||
instance : EmptyCollection (Array α) := ⟨Array.empty⟩
|
||||
instance : Inhabited (Array α) where
|
||||
default := Array.empty
|
||||
|
||||
@[simp] def isEmpty (a : Array α) : Bool :=
|
||||
a.size = 0
|
||||
|
||||
def singleton (v : α) : Array α :=
|
||||
mkArray 1 v
|
||||
/-! ### Externs -/
|
||||
|
||||
/-- Low-level version of `size` that directly queries the C array object cached size.
|
||||
While this is not provable, `usize` always returns the exact size of the array since
|
||||
@@ -65,29 +97,6 @@ def usize (a : @& Array α) : USize := a.size.toUSize
|
||||
def uget (a : @& Array α) (i : USize) (h : i.toNat < a.size) : α :=
|
||||
a[i.toNat]
|
||||
|
||||
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
|
||||
getElem xs i h := xs.uget i h
|
||||
|
||||
def back [Inhabited α] (a : Array α) : α :=
|
||||
a.get! (a.size - 1)
|
||||
|
||||
def get? (a : Array α) (i : Nat) : Option α :=
|
||||
if h : i < a.size then some a[i] else none
|
||||
|
||||
def back? (a : Array α) : Option α :=
|
||||
a.get? (a.size - 1)
|
||||
|
||||
-- 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]
|
||||
|
||||
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
|
||||
List.length_set ..
|
||||
|
||||
@[simp] theorem size_push (a : Array α) (v : α) : (push a v).size = a.size + 1 :=
|
||||
List.length_concat ..
|
||||
|
||||
/-- Low-level version of `fset` which is as fast as a C array fset.
|
||||
`Fin` values are represented as tag pointers in the Lean runtime. Thus,
|
||||
`fset` may be slightly slower than `uset`. -/
|
||||
@@ -95,6 +104,19 @@ abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size =
|
||||
def uset (a : Array α) (i : USize) (v : α) (h : i.toNat < a.size) : Array α :=
|
||||
a.set ⟨i.toNat, h⟩ v
|
||||
|
||||
@[extern "lean_array_pop"]
|
||||
def pop (a : Array α) : Array α where
|
||||
toList := a.toList.dropLast
|
||||
|
||||
@[simp] theorem size_pop (a : Array α) : a.pop.size = a.size - 1 := by
|
||||
match a with
|
||||
| ⟨[]⟩ => rfl
|
||||
| ⟨a::as⟩ => simp [pop, Nat.succ_sub_succ_eq_sub, size]
|
||||
|
||||
@[extern "lean_mk_array"]
|
||||
def mkArray {α : Type u} (n : Nat) (v : α) : Array α where
|
||||
toList := List.replicate n v
|
||||
|
||||
/--
|
||||
Swaps two entries in an array.
|
||||
|
||||
@@ -108,6 +130,10 @@ def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
|
||||
let a' := a.set i v₂
|
||||
a'.set (size_set a i v₂ ▸ j) v₁
|
||||
|
||||
@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
|
||||
show ((a.set i (a.get j)).set (size_set a i _ ▸ j) (a.get i)).size = a.size
|
||||
rw [size_set, size_set]
|
||||
|
||||
/--
|
||||
Swaps two entries in an array, or returns the array unchanged if either index is out of bounds.
|
||||
|
||||
@@ -121,6 +147,64 @@ def swap! (a : Array α) (i j : @& Nat) : Array α :=
|
||||
else a
|
||||
else a
|
||||
|
||||
/-! ### GetElem instance for `USize`, backed by `uget` -/
|
||||
|
||||
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
|
||||
getElem xs i h := xs.uget i h
|
||||
|
||||
/-! ### Definitions -/
|
||||
|
||||
instance : EmptyCollection (Array α) := ⟨Array.empty⟩
|
||||
instance : Inhabited (Array α) where
|
||||
default := Array.empty
|
||||
|
||||
@[simp] def isEmpty (a : Array α) : Bool :=
|
||||
a.size = 0
|
||||
|
||||
@[specialize]
|
||||
def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : α → α → Bool) :
|
||||
∀ (i : Nat) (_ : i ≤ a.size), Bool
|
||||
| 0, _ => true
|
||||
| i+1, h =>
|
||||
p a[i] (b[i]'(hsz ▸ h)) && isEqvAux a b hsz p i (Nat.le_trans (Nat.le_add_right i 1) h)
|
||||
|
||||
@[inline] def isEqv (a b : Array α) (p : α → α → Bool) : Bool :=
|
||||
if h : a.size = b.size then
|
||||
isEqvAux a b h p a.size (Nat.le_refl a.size)
|
||||
else
|
||||
false
|
||||
|
||||
instance [BEq α] : BEq (Array α) :=
|
||||
⟨fun a b => isEqv a b BEq.beq⟩
|
||||
|
||||
/--
|
||||
`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`.
|
||||
```
|
||||
ofFn f = #[f 0, f 1, ... , f(n - 1)]
|
||||
``` -/
|
||||
def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
|
||||
/-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
go (i : Nat) (acc : Array α) : Array α :=
|
||||
if h : i < n then go (i+1) (acc.push (f ⟨i, h⟩)) else acc
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
/-- The array `#[0, 1, ..., n - 1]`. -/
|
||||
def range (n : Nat) : Array Nat :=
|
||||
n.fold (flip Array.push) (mkEmpty n)
|
||||
|
||||
def singleton (v : α) : Array α :=
|
||||
mkArray 1 v
|
||||
|
||||
def back [Inhabited α] (a : Array α) : α :=
|
||||
a.get! (a.size - 1)
|
||||
|
||||
def get? (a : Array α) (i : Nat) : Option α :=
|
||||
if h : i < a.size then some a[i] else none
|
||||
|
||||
def back? (a : Array α) : Option α :=
|
||||
a.get? (a.size - 1)
|
||||
|
||||
@[inline] def swapAt (a : Array α) (i : Fin a.size) (v : α) : α × Array α :=
|
||||
let e := a.get i
|
||||
let a := a.set i v
|
||||
@@ -134,10 +218,6 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
|
||||
have : Inhabited α := ⟨v⟩
|
||||
panic! ("index " ++ toString i ++ " out of bounds")
|
||||
|
||||
@[extern "lean_array_pop"]
|
||||
def pop (a : Array α) : Array α where
|
||||
toList := a.toList.dropLast
|
||||
|
||||
def shrink (a : Array α) (n : Nat) : Array α :=
|
||||
let rec loop
|
||||
| 0, a => a
|
||||
@@ -306,12 +386,12 @@ unsafe def mapMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad
|
||||
def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → m β) (as : Array α) : m (Array β) :=
|
||||
-- Note: we cannot use `foldlM` here for the reference implementation because this calls
|
||||
-- `bind` and `pure` too many times. (We are not assuming `m` is a `LawfulMonad`)
|
||||
let rec map (i : Nat) (r : Array β) : m (Array β) := do
|
||||
if hlt : i < as.size then
|
||||
map (i+1) (r.push (← f as[i]))
|
||||
else
|
||||
pure r
|
||||
termination_by as.size - i
|
||||
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
map (i : Nat) (r : Array β) : m (Array β) := do
|
||||
if hlt : i < as.size then
|
||||
map (i+1) (r.push (← f as[i]))
|
||||
else
|
||||
pure r
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
map 0 (mkEmpty as.size)
|
||||
|
||||
@@ -375,7 +455,8 @@ unsafe def anyMUnsafe {α : Type u} {m : Type → Type w} [Monad m] (p : α →
|
||||
@[implemented_by anyMUnsafe]
|
||||
def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
|
||||
let any (stop : Nat) (h : stop ≤ as.size) :=
|
||||
let rec loop (j : Nat) : m Bool := do
|
||||
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
loop (j : Nat) : m Bool := do
|
||||
if hlt : j < stop then
|
||||
have : j < as.size := Nat.lt_of_lt_of_le hlt h
|
||||
if (← p as[j]) then
|
||||
@@ -384,7 +465,6 @@ def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as :
|
||||
loop (j+1)
|
||||
else
|
||||
pure false
|
||||
termination_by stop - j
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
loop start
|
||||
if h : stop ≤ as.size then
|
||||
@@ -466,16 +546,28 @@ def findRev? {α : Type} (as : Array α) (p : α → Bool) : Option α :=
|
||||
|
||||
@[inline]
|
||||
def findIdx? {α : Type u} (as : Array α) (p : α → Bool) : Option Nat :=
|
||||
let rec loop (j : Nat) :=
|
||||
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
loop (j : Nat) :=
|
||||
if h : j < as.size then
|
||||
if p as[j] then some j else loop (j + 1)
|
||||
else none
|
||||
termination_by as.size - j
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
loop 0
|
||||
|
||||
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
|
||||
a.findIdx? fun a => a == v
|
||||
a.findIdx? fun a => a == v
|
||||
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
|
||||
if h : i < a.size then
|
||||
let idx : Fin a.size := ⟨i, h⟩;
|
||||
if a.get idx == v then some idx
|
||||
else indexOfAux a v (i+1)
|
||||
else none
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
|
||||
indexOfAux a v 0
|
||||
|
||||
@[inline]
|
||||
def any (as : Array α) (p : α → Bool) (start := 0) (stop := as.size) : Bool :=
|
||||
@@ -491,13 +583,6 @@ def contains [BEq α] (as : Array α) (a : α) : Bool :=
|
||||
def elem [BEq α] (a : α) (as : Array α) : Bool :=
|
||||
as.contains a
|
||||
|
||||
@[inline] def getEvenElems (as : Array α) : Array α :=
|
||||
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
|
||||
if even then
|
||||
(false, r.push a)
|
||||
else
|
||||
(true, r)
|
||||
|
||||
/-- Convert a `Array α` into an `List α`. This is O(n) in the size of the array. -/
|
||||
-- This function is exported to C, where it is called by `Array.toList`
|
||||
-- (the projection) to implement this functionality.
|
||||
@@ -510,17 +595,6 @@ def toListImpl (as : Array α) : List α :=
|
||||
def toListAppend (as : Array α) (l : List α) : List α :=
|
||||
as.foldr List.cons l
|
||||
|
||||
instance {α : Type u} [Repr α] : Repr (Array α) where
|
||||
reprPrec a _ :=
|
||||
let _ : Std.ToFormat α := ⟨repr⟩
|
||||
if a.size == 0 then
|
||||
"#[]"
|
||||
else
|
||||
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList a) ("," ++ Std.Format.line)) "]"
|
||||
|
||||
instance [ToString α] : ToString (Array α) where
|
||||
toString a := "#" ++ toString a.toList
|
||||
|
||||
protected def append (as : Array α) (bs : Array α) : Array α :=
|
||||
bs.foldl (init := as) fun r v => r.push v
|
||||
|
||||
@@ -546,44 +620,13 @@ def concatMap (f : α → Array β) (as : Array α) : Array β :=
|
||||
def flatten (as : Array (Array α)) : Array α :=
|
||||
as.foldl (init := empty) fun r a => r ++ a
|
||||
|
||||
end Array
|
||||
|
||||
export Array (mkArray)
|
||||
|
||||
syntax "#[" withoutPosition(sepBy(term, ", ")) "]" : term
|
||||
|
||||
macro_rules
|
||||
| `(#[ $elems,* ]) => `(List.toArray [ $elems,* ])
|
||||
|
||||
namespace Array
|
||||
|
||||
-- TODO(Leo): cleanup
|
||||
@[specialize]
|
||||
def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : α → α → Bool) (i : Nat) : Bool :=
|
||||
if h : i < a.size then
|
||||
have : i < b.size := hsz ▸ h
|
||||
p a[i] b[i] && isEqvAux a b hsz p (i+1)
|
||||
else
|
||||
true
|
||||
termination_by a.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
@[inline] def isEqv (a b : Array α) (p : α → α → Bool) : Bool :=
|
||||
if h : a.size = b.size then
|
||||
isEqvAux a b h p 0
|
||||
else
|
||||
false
|
||||
|
||||
instance [BEq α] : BEq (Array α) :=
|
||||
⟨fun a b => isEqv a b BEq.beq⟩
|
||||
|
||||
@[inline]
|
||||
def filter (p : α → Bool) (as : Array α) (start := 0) (stop := as.size) : Array α :=
|
||||
as.foldl (init := #[]) (start := start) (stop := stop) fun r a =>
|
||||
if p a then r.push a else r
|
||||
|
||||
@[inline]
|
||||
def filterM [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m (Array α) :=
|
||||
def filterM {α : Type} [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m (Array α) :=
|
||||
as.foldlM (init := #[]) (start := start) (stop := stop) fun r a => do
|
||||
if (← p a) then return r.push a else return r
|
||||
|
||||
@@ -618,93 +661,25 @@ def partition (p : α → Bool) (as : Array α) : Array α × Array α := Id.run
|
||||
cs := cs.push a
|
||||
return (bs, cs)
|
||||
|
||||
theorem ext (a b : Array α)
|
||||
(h₁ : a.size = b.size)
|
||||
(h₂ : (i : Nat) → (hi₁ : i < a.size) → (hi₂ : i < b.size) → a[i] = b[i])
|
||||
: a = b := by
|
||||
let rec extAux (a b : List α)
|
||||
(h₁ : a.length = b.length)
|
||||
(h₂ : (i : Nat) → (hi₁ : i < a.length) → (hi₂ : i < b.length) → a.get ⟨i, hi₁⟩ = b.get ⟨i, hi₂⟩)
|
||||
: a = b := by
|
||||
induction a generalizing b with
|
||||
| nil =>
|
||||
cases b with
|
||||
| nil => rfl
|
||||
| cons b bs => rw [List.length_cons] at h₁; injection h₁
|
||||
| cons a as ih =>
|
||||
cases b with
|
||||
| nil => rw [List.length_cons] at h₁; injection h₁
|
||||
| cons b bs =>
|
||||
have hz₁ : 0 < (a::as).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
|
||||
have hz₂ : 0 < (b::bs).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
|
||||
have headEq : a = b := h₂ 0 hz₁ hz₂
|
||||
have h₁' : as.length = bs.length := by rw [List.length_cons, List.length_cons] at h₁; injection h₁
|
||||
have h₂' : (i : Nat) → (hi₁ : i < as.length) → (hi₂ : i < bs.length) → as.get ⟨i, hi₁⟩ = bs.get ⟨i, hi₂⟩ := by
|
||||
intro i hi₁ hi₂
|
||||
have hi₁' : i+1 < (a::as).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
|
||||
have hi₂' : i+1 < (b::bs).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
|
||||
have : (a::as).get ⟨i+1, hi₁'⟩ = (b::bs).get ⟨i+1, hi₂'⟩ := h₂ (i+1) hi₁' hi₂'
|
||||
apply this
|
||||
have tailEq : as = bs := ih bs h₁' h₂'
|
||||
rw [headEq, tailEq]
|
||||
cases a; cases b
|
||||
apply congrArg
|
||||
apply extAux
|
||||
assumption
|
||||
assumption
|
||||
|
||||
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₁)
|
||||
|
||||
end Array
|
||||
|
||||
-- CLEANUP the following code
|
||||
namespace Array
|
||||
|
||||
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
|
||||
if h : i < a.size then
|
||||
let idx : Fin a.size := ⟨i, h⟩;
|
||||
if a.get idx == v then some idx
|
||||
else indexOfAux a v (i+1)
|
||||
else none
|
||||
termination_by a.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
|
||||
indexOfAux a v 0
|
||||
|
||||
@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
|
||||
show ((a.set i (a.get j)).set (size_set a i _ ▸ j) (a.get i)).size = a.size
|
||||
rw [size_set, size_set]
|
||||
|
||||
@[simp] theorem size_pop (a : Array α) : a.pop.size = a.size - 1 := by
|
||||
match a with
|
||||
| ⟨[]⟩ => rfl
|
||||
| ⟨a::as⟩ => simp [pop, Nat.succ_sub_succ_eq_sub, size]
|
||||
|
||||
theorem reverse.termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
|
||||
rw [Nat.sub_sub, Nat.add_comm]
|
||||
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
|
||||
|
||||
def reverse (as : Array α) : Array α :=
|
||||
if h : as.size ≤ 1 then
|
||||
as
|
||||
else
|
||||
loop as 0 ⟨as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h ▸ by decide) h)⟩
|
||||
where
|
||||
termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
|
||||
rw [Nat.sub_sub, Nat.add_comm]
|
||||
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
|
||||
loop (as : Array α) (i : Nat) (j : Fin as.size) :=
|
||||
if h : i < j then
|
||||
have := reverse.termination h
|
||||
have := termination h
|
||||
let as := as.swap ⟨i, Nat.lt_trans h j.2⟩ j
|
||||
have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
|
||||
loop as (i+1) ⟨j-1, this⟩
|
||||
else
|
||||
as
|
||||
termination_by j - i
|
||||
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
def popWhile (p : α → Bool) (as : Array α) : Array α :=
|
||||
if h : as.size > 0 then
|
||||
if p (as.get ⟨as.size - 1, Nat.sub_lt h (by decide)⟩) then
|
||||
@@ -713,11 +688,11 @@ def popWhile (p : α → Bool) (as : Array α) : Array α :=
|
||||
as
|
||||
else
|
||||
as
|
||||
termination_by as.size
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def takeWhile (p : α → Bool) (as : Array α) : Array α :=
|
||||
let rec go (i : Nat) (r : Array α) : Array α :=
|
||||
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
go (i : Nat) (r : Array α) : Array α :=
|
||||
if h : i < as.size then
|
||||
let a := as.get ⟨i, h⟩
|
||||
if p a then
|
||||
@@ -726,7 +701,6 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
|
||||
r
|
||||
else
|
||||
r
|
||||
termination_by as.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
go 0 #[]
|
||||
|
||||
@@ -734,6 +708,7 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
|
||||
|
||||
This function takes worst case O(n) time because
|
||||
it has to backshift all elements at positions greater than `i`.-/
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
|
||||
if h : i.val + 1 < a.size then
|
||||
let a' := a.swap ⟨i.val + 1, h⟩ i
|
||||
@@ -744,6 +719,7 @@ def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
|
||||
termination_by a.size - i.val
|
||||
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ i.isLt
|
||||
|
||||
-- This is required in `Lean.Data.PersistentHashMap`.
|
||||
theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
|
||||
induction a, i using Array.feraseIdx.induct with
|
||||
| @case1 a i h a' _ ih =>
|
||||
@@ -767,14 +743,14 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
|
||||
|
||||
/-- Insert element `a` at position `i`. -/
|
||||
@[inline] def insertAt (as : Array α) (i : Fin (as.size + 1)) (a : α) : Array α :=
|
||||
let rec loop (as : Array α) (j : Fin as.size) :=
|
||||
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
loop (as : Array α) (j : Fin as.size) :=
|
||||
if i.1 < j then
|
||||
let j' := ⟨j-1, Nat.lt_of_le_of_lt (Nat.pred_le _) j.2⟩
|
||||
let as := as.swap j' j
|
||||
loop as ⟨j', by rw [size_swap]; exact j'.2⟩
|
||||
else
|
||||
as
|
||||
termination_by j.1
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
let j := as.size
|
||||
let as := as.push a
|
||||
@@ -786,41 +762,7 @@ def insertAt! (as : Array α) (i : Nat) (a : α) : Array α :=
|
||||
insertAt as ⟨i, Nat.lt_succ_of_le h⟩ a
|
||||
else panic! "invalid index"
|
||||
|
||||
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 ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
|
||||
cases as; cases bs; simp at h; rw [h]
|
||||
|
||||
@[simp] theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).toList = acc.toList ++ as := by
|
||||
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
|
||||
|
||||
@[simp] theorem toList_toArray (as : List α) : as.toArray.toList = as := by
|
||||
simp [List.toArray, Array.mkEmpty]
|
||||
|
||||
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
|
||||
|
||||
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
|
||||
|
||||
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 [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
|
||||
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) (i : Nat) : Bool :=
|
||||
if h : i < as.size then
|
||||
let a := as[i]
|
||||
@@ -832,7 +774,6 @@ def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) (i : N
|
||||
false
|
||||
else
|
||||
true
|
||||
termination_by as.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
/-- Return true iff `as` is a prefix of `bs`.
|
||||
@@ -843,24 +784,8 @@ def isPrefixOf [BEq α] (as bs : Array α) : Bool :=
|
||||
else
|
||||
false
|
||||
|
||||
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size → Bool
|
||||
| 0, _ => true
|
||||
| i+1, h =>
|
||||
have : i < as.size := Nat.lt_trans (Nat.lt_succ_self _) h;
|
||||
a != as[i] && allDiffAuxAux as a i this
|
||||
|
||||
private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
|
||||
if h : i < as.size then
|
||||
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)
|
||||
else
|
||||
true
|
||||
termination_by as.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def allDiff [BEq α] (as : Array α) : Bool :=
|
||||
allDiffAux as 0
|
||||
|
||||
@[specialize] def zipWithAux (f : α → β → γ) (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) : Array γ :=
|
||||
@[semireducible, specialize] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
def zipWithAux (f : α → β → γ) (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) : Array γ :=
|
||||
if h : i < as.size then
|
||||
let a := as[i]
|
||||
if h : i < bs.size then
|
||||
@@ -870,7 +795,6 @@ def allDiff [BEq α] (as : Array α) : Bool :=
|
||||
cs
|
||||
else
|
||||
cs
|
||||
termination_by as.size - i
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : Array γ :=
|
||||
@@ -886,4 +810,48 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
|
||||
as.foldl (init := (#[], #[])) fun (as, bs) a =>
|
||||
if p a then (as.push a, bs) else (as, bs.push a)
|
||||
|
||||
/-! ### Auxiliary functions used in metaprogramming.
|
||||
|
||||
We do not intend to provide verification theorems for these functions.
|
||||
-/
|
||||
|
||||
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size → Bool
|
||||
| 0, _ => true
|
||||
| i+1, h =>
|
||||
have : i < as.size := Nat.lt_trans (Nat.lt_succ_self _) h;
|
||||
a != as[i] && allDiffAuxAux as a i this
|
||||
|
||||
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
|
||||
private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
|
||||
if h : i < as.size then
|
||||
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)
|
||||
else
|
||||
true
|
||||
decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
|
||||
def allDiff [BEq α] (as : Array α) : Bool :=
|
||||
allDiffAux as 0
|
||||
|
||||
@[inline] def getEvenElems (as : Array α) : Array α :=
|
||||
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
|
||||
if even then
|
||||
(false, r.push a)
|
||||
else
|
||||
(true, r)
|
||||
|
||||
/-! ### Repr and ToString -/
|
||||
|
||||
instance {α : Type u} [Repr α] : Repr (Array α) where
|
||||
reprPrec a _ :=
|
||||
let _ : Std.ToFormat α := ⟨repr⟩
|
||||
if a.size == 0 then
|
||||
"#[]"
|
||||
else
|
||||
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList a) ("," ++ Std.Format.line)) "]"
|
||||
|
||||
instance [ToString α] : ToString (Array α) where
|
||||
toString a := "#" ++ toString a.toList
|
||||
|
||||
end Array
|
||||
|
||||
export Array (mkArray)
|
||||
|
||||
@@ -34,7 +34,7 @@ private theorem List.of_toArrayAux_eq_toArrayAux {as bs : List α} {cs ds : Arra
|
||||
|
||||
@[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; simpa [toArray] using h
|
||||
· intro h; rw [h]
|
||||
|
||||
def Array.mapM' [Monad m] (f : α → m β) (as : Array α) : m { bs : Array β // bs.size = as.size } :=
|
||||
|
||||
@@ -5,43 +5,49 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.Basic
|
||||
import Init.Data.BEq
|
||||
import Init.ByCases
|
||||
|
||||
namespace Array
|
||||
|
||||
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 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 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, rel_of_isEqvAux r a b h a.size (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 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 (fun x y => x = y) a b h
|
||||
exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
|
||||
|
||||
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 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 [DecidableEq α] (a : Array α) : Array.isEqv a a (fun x y => x = y) = true := by
|
||||
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
|
||||
simp [isEqv, isEqvAux_self]
|
||||
|
||||
instance [DecidableEq α] : DecidableEq (Array α) :=
|
||||
|
||||
46
src/Init/Data/Array/GetLit.lean
Normal file
46
src/Init/Data/Array/GetLit.lean
Normal file
@@ -0,0 +1,46 @@
|
||||
/-
|
||||
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 [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
|
||||
|
||||
end Array
|
||||
@@ -19,12 +19,119 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
|
||||
|
||||
namespace Array
|
||||
|
||||
attribute [simp] data_toArray uset
|
||||
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
|
||||
|
||||
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
|
||||
|
||||
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := by
|
||||
by_cases i < a.size <;> (try simp [*]) <;> rfl
|
||||
|
||||
theorem getElem?_eq_getElem {a : Array α} {i : Nat} (h : i < a.size) : a[i]? = some a[i] :=
|
||||
getElem?_pos ..
|
||||
|
||||
@[simp] theorem getElem?_eq_none_iff {a : Array α} : a[i]? = none ↔ a.size ≤ i := by
|
||||
by_cases h : i < a.size
|
||||
· simp [getElem?_eq_getElem, h]
|
||||
· rw [getElem?_neg a i h]
|
||||
simp_all
|
||||
|
||||
theorem getElem?_eq {a : Array α} {i : Nat} :
|
||||
a[i]? = if h : i < a.size then some a[i] else none := by
|
||||
split
|
||||
· simp_all [getElem?_eq_getElem]
|
||||
· simp_all
|
||||
|
||||
theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
|
||||
rw [getElem?_eq]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
|
||||
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp
|
||||
|
||||
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
|
||||
(a.push x)[i] = a[i] := by
|
||||
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
|
||||
|
||||
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
|
||||
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
|
||||
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
|
||||
|
||||
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
|
||||
(a.push x)[i] = if h : i < a.size then a[i] else x := by
|
||||
by_cases h' : i < a.size
|
||||
· simp [get_push_lt, h']
|
||||
· simp at h
|
||||
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
|
||||
|
||||
end Array
|
||||
|
||||
namespace List
|
||||
|
||||
open Array
|
||||
|
||||
/-! ### Lemmas about `List.toArray`. -/
|
||||
|
||||
@[simp] theorem size_toArrayAux {a : List α} {b : Array α} :
|
||||
(a.toArrayAux b).size = b.size + a.length := by
|
||||
simp [size]
|
||||
|
||||
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
|
||||
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
|
||||
a.toArray[i] = a[i]'(by simpa using h) := rfl
|
||||
|
||||
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
|
||||
theorem toArray_concat {as : List α} {x : α} :
|
||||
(as ++ [x]).toArray = as.toArray.push x := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
|
||||
apply Array.ext'
|
||||
simp
|
||||
|
||||
/-- Unapplied variant of `push_toArray`, useful for monadic reasoning. -/
|
||||
@[simp] theorem push_toArray_fun (l : List α) : l.toArray.push = fun a => (l ++ [a]).toArray := by
|
||||
funext a
|
||||
simp
|
||||
|
||||
@[simp] theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List α) :
|
||||
l.toArray.foldrM f init = l.foldrM f init := by
|
||||
rw [foldrM_eq_reverse_foldlM_toList]
|
||||
simp
|
||||
|
||||
@[simp] theorem foldlM_toArray [Monad m] (f : β → α → m β) (init : β) (l : List α) :
|
||||
l.toArray.foldlM f init = l.foldlM f init := by
|
||||
rw [foldlM_eq_foldlM_toList]
|
||||
|
||||
@[simp] theorem foldr_toArray (f : α → β → β) (init : β) (l : List α) :
|
||||
l.toArray.foldr f init = l.foldr f init := by
|
||||
rw [foldr_eq_foldr_toList]
|
||||
|
||||
@[simp] theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
|
||||
l.toArray.foldl f init = l.foldl f init := by
|
||||
rw [foldl_eq_foldl_toList]
|
||||
|
||||
end List
|
||||
|
||||
namespace Array
|
||||
|
||||
attribute [simp] uset
|
||||
|
||||
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
|
||||
|
||||
@[simp] theorem toArray_toList : (a : Array α) → a.toList.toArray = a
|
||||
| ⟨l⟩ => ext' (toList_toArray l)
|
||||
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
|
||||
|
||||
@[deprecated toArray_toList (since := "2024-09-09")]
|
||||
abbrev toArray_data := @toArray_toList
|
||||
@@ -38,20 +145,11 @@ abbrev data_length := @toList_length
|
||||
|
||||
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
|
||||
|
||||
theorem getElem_eq_toList_getElem (a : Array α) (h : i < a.size) : a[i] = a.toList[i] := by
|
||||
by_cases i < a.size <;> (try simp [*]) <;> rfl
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
|
||||
abbrev getElem_eq_data_getElem := @getElem_eq_toList_getElem
|
||||
|
||||
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
|
||||
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get ⟨i, h⟩ := by
|
||||
simp [getElem_eq_toList_getElem]
|
||||
|
||||
theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
|
||||
simp [foldrM_eq_reverse_foldlM_toList, -size_push]
|
||||
|
||||
/-- Variant of `foldrM_push` with the `start := arr.size + 1` rather than `(arr.push a).size`. -/
|
||||
@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by
|
||||
simp [← foldrM_push]
|
||||
@@ -59,6 +157,7 @@ theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array
|
||||
theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
|
||||
|
||||
/-- Variant of `foldr_push` with the `start := arr.size + 1` rather than `(arr.push a).size`. -/
|
||||
@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' ..
|
||||
|
||||
@@ -68,22 +167,6 @@ theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α)
|
||||
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
|
||||
rw [toListRev, foldl_eq_foldl_toList, ← List.foldr_reverse, List.foldr_cons_nil]
|
||||
|
||||
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
|
||||
(a.push x)[i] = a[i] := by
|
||||
simp only [push, getElem_eq_toList_getElem, List.concat_eq_append, List.getElem_append_left, h]
|
||||
|
||||
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
|
||||
simp only [push, getElem_eq_toList_getElem, List.concat_eq_append]
|
||||
rw [List.getElem_append_right] <;> simp [getElem_eq_toList_getElem, Nat.zero_lt_one]
|
||||
|
||||
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
|
||||
(a.push x)[i] = if h : i < a.size then a[i] else x := by
|
||||
by_cases h' : i < a.size
|
||||
· simp [get_push_lt, h']
|
||||
· simp at h
|
||||
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
|
||||
|
||||
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
|
||||
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
|
||||
rw [mapM, aux, foldlM_eq_foldlM_toList]; rfl
|
||||
@@ -186,11 +269,11 @@ theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default
|
||||
@[simp] theorem getElem_set_eq (a : Array α) (i : Fin a.size) (v : α) {j : Nat}
|
||||
(eq : i.val = j) (p : j < (a.set i v).size) :
|
||||
(a.set i v)[j]'p = v := by
|
||||
simp [set, getElem_eq_toList_getElem, ←eq]
|
||||
simp [set, getElem_eq_getElem_toList, ←eq]
|
||||
|
||||
@[simp] theorem getElem_set_ne (a : Array α) (i : Fin a.size) (v : α) {j : Nat} (pj : j < (a.set i v).size)
|
||||
(h : i.val ≠ j) : (a.set i v)[j]'pj = a[j]'(size_set a i v ▸ pj) := by
|
||||
simp only [set, getElem_eq_toList_getElem, List.getElem_set_ne h]
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
|
||||
|
||||
theorem getElem_set (a : Array α) (i : Fin a.size) (v : α) (j : Nat)
|
||||
(h : j < (a.set i v).size) :
|
||||
@@ -271,13 +354,16 @@ termination_by n - i
|
||||
|
||||
/-- # mkArray -/
|
||||
|
||||
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
|
||||
List.length_replicate ..
|
||||
|
||||
@[simp] theorem toList_mkArray (n : Nat) (v : α) : (mkArray n v).toList = List.replicate n v := rfl
|
||||
|
||||
@[deprecated toList_mkArray (since := "2024-09-09")]
|
||||
abbrev mkArray_data := @toList_mkArray
|
||||
|
||||
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
|
||||
(mkArray n v)[i] = v := by simp [Array.getElem_eq_toList_getElem]
|
||||
(mkArray n v)[i] = v := by simp [Array.getElem_eq_getElem_toList]
|
||||
|
||||
/-- # mem -/
|
||||
|
||||
@@ -318,7 +404,7 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
|
||||
hidx
|
||||
|
||||
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] ∈ l := by
|
||||
erw [Array.mem_def, getElem_eq_toList_getElem]
|
||||
erw [Array.mem_def, getElem_eq_getElem_toList]
|
||||
apply List.get_mem
|
||||
|
||||
theorem getElem_fin_eq_toList_get (a : Array α) (i : Fin _) : a[i] = a.toList.get i := rfl
|
||||
@@ -329,20 +415,17 @@ abbrev getElem_fin_eq_data_get := @getElem_fin_eq_toList_get
|
||||
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
|
||||
a[i] = a[i.toNat] := rfl
|
||||
|
||||
theorem getElem?_eq_getElem (a : Array α) (i : Nat) (h : i < a.size) : a[i]? = some a[i] :=
|
||||
getElem?_pos ..
|
||||
|
||||
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size ≤ i) : a[i]? = none := by
|
||||
simp [getElem?_neg, h]
|
||||
|
||||
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] ∈ a.toList := by
|
||||
simp only [getElem_eq_toList_getElem, List.getElem_mem]
|
||||
simp only [getElem_eq_getElem_toList, List.getElem_mem]
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]; rfl
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
@[deprecated getElem?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
@@ -396,7 +479,7 @@ abbrev data_set := @toList_set
|
||||
|
||||
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1] = v := by
|
||||
simp only [set, getElem_eq_toList_getElem, List.getElem_set_self]
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_self]
|
||||
|
||||
theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2]
|
||||
@@ -415,7 +498,7 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v :
|
||||
|
||||
@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size)
|
||||
(h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
|
||||
simp only [set, getElem_eq_toList_getElem, List.getElem_set_ne h]
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
|
||||
|
||||
theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) :
|
||||
(setD a i v)[i] = v := by
|
||||
@@ -431,7 +514,7 @@ theorem swap_def (a : Array α) (i j : Fin a.size) :
|
||||
a.swap i j = (a.set i (a.get j)).set ⟨j.1, by simp [j.2]⟩ (a.get i) := by
|
||||
simp [swap, fin_cast_val]
|
||||
|
||||
theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
(a.swap i j).toList = (a.toList.set i (a.get j)).set j (a.get i) := by simp [swap_def]
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
@@ -444,7 +527,7 @@ theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]?
|
||||
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
|
||||
a.swapAt i v = (a[i.1], a.set i v) := rfl
|
||||
|
||||
-- @[simp] -- FIXME: gives a weird linter error
|
||||
@[simp]
|
||||
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
|
||||
a.swapAt! i v = (a[i], a.set ⟨i, h⟩ v) := by simp [swapAt!, h]
|
||||
|
||||
@@ -495,7 +578,6 @@ abbrev size_eq_length_data := @size_eq_length_toList
|
||||
let rec go (as : Array α) (i j) : (reverse.loop as i j).size = as.size := by
|
||||
rw [reverse.loop]
|
||||
if h : i < j then
|
||||
have := reverse.termination h
|
||||
simp [(go · (i+1) ⟨j-1, ·⟩), h]
|
||||
else simp [h]
|
||||
termination_by j - i
|
||||
@@ -518,7 +600,7 @@ abbrev data_range := @toList_range
|
||||
|
||||
@[simp]
|
||||
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
|
||||
simp [getElem_eq_toList_getElem]
|
||||
simp [getElem_eq_getElem_toList]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[simp] theorem reverse_toList (a : Array α) : a.reverse.toList = a.toList.reverse := by
|
||||
@@ -527,9 +609,8 @@ set_option linter.deprecated false in
|
||||
(H : ∀ k, as.toList.get? k = if i ≤ k ∧ k ≤ j then a.toList.get? k else a.toList.reverse.get? k)
|
||||
(k) : (reverse.loop as i ⟨j, hj⟩).toList.get? k = a.toList.reverse.get? k := by
|
||||
rw [reverse.loop]; dsimp; split <;> rename_i h₁
|
||||
· have p := reverse.termination h₁
|
||||
match j with | j+1 => ?_
|
||||
simp only [Nat.add_sub_cancel] at p ⊢
|
||||
· match j with | j+1 => ?_
|
||||
simp only [Nat.add_sub_cancel]
|
||||
rw [(go · (i+1) j)]
|
||||
· rwa [Nat.add_right_comm i]
|
||||
· simp [size_swap, h₂]
|
||||
@@ -565,6 +646,32 @@ set_option linter.deprecated false in
|
||||
|
||||
/-! ### foldl / foldr -/
|
||||
|
||||
@[simp] theorem foldlM_loop_empty [Monad m] (f : β → α → m β) (init : β) (i j : Nat) :
|
||||
foldlM.loop f #[] s h i j init = pure init := by
|
||||
unfold foldlM.loop; split
|
||||
· split
|
||||
· rfl
|
||||
· simp at h
|
||||
omega
|
||||
· rfl
|
||||
|
||||
@[simp] theorem foldlM_empty [Monad m] (f : β → α → m β) (init : β) :
|
||||
foldlM f init #[] start stop = return init := by
|
||||
simp [foldlM]
|
||||
|
||||
@[simp] theorem foldrM_fold_empty [Monad m] (f : α → β → m β) (init : β) (i j : Nat) (h) :
|
||||
foldrM.fold f #[] i j h init = pure init := by
|
||||
unfold foldrM.fold
|
||||
split <;> rename_i h₁
|
||||
· rfl
|
||||
· split <;> rename_i h₂
|
||||
· rfl
|
||||
· simp at h₂
|
||||
|
||||
@[simp] theorem foldrM_empty [Monad m] (f : α → β → m β) (init : β) :
|
||||
foldrM f init #[] start stop = return init := by
|
||||
simp [foldrM]
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldl_induction
|
||||
@@ -608,8 +715,8 @@ theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : A
|
||||
rw [mapM_eq_foldlM, foldlM_eq_foldlM_toList, ← List.foldrM_reverse]
|
||||
conv => rhs; rw [← List.reverse_reverse arr.toList]
|
||||
induction arr.toList.reverse with
|
||||
| nil => simp; rfl
|
||||
| cons a l ih => simp [ih]; simp [map_eq_pure_bind, push]
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih]
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
@@ -750,7 +857,7 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@[simp] theorem filter_toList (p : α → Bool) (l : Array α) :
|
||||
@[simp] theorem toList_filter (p : α → Bool) (l : Array α) :
|
||||
(l.filter p).toList = l.toList.filter p := by
|
||||
dsimp only [filter]
|
||||
rw [foldl_eq_foldl_toList]
|
||||
@@ -761,23 +868,23 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
|
||||
induction l with simp
|
||||
| cons => split <;> simp [*]
|
||||
|
||||
@[deprecated filter_toList (since := "2024-09-09")]
|
||||
abbrev filter_data := @filter_toList
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[simp] theorem filter_filter (q) (l : Array α) :
|
||||
filter p (filter q l) = filter (fun a => p a && q a) l := by
|
||||
apply ext'
|
||||
simp only [filter_toList, List.filter_filter]
|
||||
simp only [toList_filter, List.filter_filter]
|
||||
|
||||
@[simp] theorem mem_filter : x ∈ filter p as ↔ x ∈ as ∧ p x := by
|
||||
simp only [mem_def, filter_toList, List.mem_filter]
|
||||
simp only [mem_def, toList_filter, List.mem_filter]
|
||||
|
||||
theorem mem_of_mem_filter {a : α} {l} (h : a ∈ filter p l) : a ∈ l :=
|
||||
(mem_filter.mp h).1
|
||||
|
||||
/-! ### filterMap -/
|
||||
|
||||
@[simp] theorem filterMap_toList (f : α → Option β) (l : Array α) :
|
||||
@[simp] theorem toList_filterMap (f : α → Option β) (l : Array α) :
|
||||
(l.filterMap f).toList = l.toList.filterMap f := by
|
||||
dsimp only [filterMap, filterMapM]
|
||||
rw [foldlM_eq_foldlM_toList]
|
||||
@@ -790,12 +897,12 @@ theorem mem_of_mem_filter {a : α} {l} (h : a ∈ filter p l) : a ∈ l :=
|
||||
· simp_all [Id.run, List.filterMap_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated filterMap_toList (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @filterMap_toList
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[simp] theorem mem_filterMap {f : α → Option β} {l : Array α} {b : β} :
|
||||
b ∈ filterMap f l ↔ ∃ a, a ∈ l ∧ f a = some b := by
|
||||
simp only [mem_def, filterMap_toList, List.mem_filterMap]
|
||||
simp only [mem_def, toList_filterMap, List.mem_filterMap]
|
||||
|
||||
/-! ### empty -/
|
||||
|
||||
@@ -818,7 +925,7 @@ theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size :=
|
||||
|
||||
theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
|
||||
(as ++ bs)[i] = as[i] := by
|
||||
simp only [getElem_eq_toList_getElem]
|
||||
simp only [getElem_eq_getElem_toList]
|
||||
have h' : i < (as.toList ++ bs.toList).length := by rwa [← toList_length, append_toList] at h
|
||||
conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
|
||||
apply List.get_of_eq; rw [append_toList]
|
||||
@@ -826,9 +933,9 @@ theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i <
|
||||
theorem get_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size ≤ i)
|
||||
(hlt : i - as.size < bs.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) :
|
||||
(as ++ bs)[i] = bs[i - as.size] := by
|
||||
simp only [getElem_eq_toList_getElem]
|
||||
simp only [getElem_eq_getElem_toList]
|
||||
have h' : i < (as.toList ++ bs.toList).length := by rwa [← toList_length, append_toList] at h
|
||||
conv => rhs; rw [← List.getElem_append_right (h' := h') (h := Nat.not_lt_of_ge hle)]
|
||||
conv => rhs; rw [← List.getElem_append_right (h₁ := hle) (h₂ := h')]
|
||||
apply List.get_of_eq; rw [append_toList]
|
||||
|
||||
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
|
||||
@@ -974,6 +1081,33 @@ theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : a
|
||||
|
||||
/-! ### any -/
|
||||
|
||||
theorem anyM_loop_cons [Monad m] (p : α → m Bool) (a : α) (as : List α) (stop start : Nat) (h : stop + 1 ≤ (a :: as).length) :
|
||||
anyM.loop p ⟨a :: as⟩ (stop + 1) h (start + 1) = anyM.loop p ⟨as⟩ stop (by simpa using h) start := by
|
||||
rw [anyM.loop]
|
||||
conv => rhs; rw [anyM.loop]
|
||||
split <;> rename_i h'
|
||||
· simp only [Nat.add_lt_add_iff_right] at h'
|
||||
rw [dif_pos h']
|
||||
rw [anyM_loop_cons]
|
||||
simp
|
||||
· rw [dif_neg]
|
||||
omega
|
||||
|
||||
@[simp] theorem anyM_toList [Monad m] (p : α → m Bool) (as : Array α) :
|
||||
as.toList.anyM p = as.anyM p :=
|
||||
match as with
|
||||
| ⟨[]⟩ => rfl
|
||||
| ⟨a :: as⟩ => by
|
||||
simp only [List.anyM, anyM, size_toArray, List.length_cons, Nat.le_refl, ↓reduceDIte]
|
||||
rw [anyM.loop, dif_pos (by omega)]
|
||||
congr 1
|
||||
funext b
|
||||
split
|
||||
· simp
|
||||
· simp only [Bool.false_eq_true, ↓reduceIte]
|
||||
rw [anyM_loop_cons]
|
||||
simpa [anyM] using anyM_toList p ⟨as⟩
|
||||
|
||||
-- Auxiliary for `any_iff_exists`.
|
||||
theorem anyM_loop_iff_exists {p : α → Bool} {as : Array α} {start stop} (h : stop ≤ as.size) :
|
||||
anyM.loop (m := Id) p as stop h start = true ↔
|
||||
@@ -1018,6 +1152,17 @@ theorem any_def {p : α → Bool} (as : Array α) : as.any p = as.toList.any p :
|
||||
|
||||
/-! ### all -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
|
||||
dsimp [allM, anyM]
|
||||
simp
|
||||
|
||||
@[simp] theorem allM_toList [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
as.toList.allM p = as.allM p := by
|
||||
rw [allM_eq_not_anyM_not]
|
||||
rw [← anyM_toList]
|
||||
rw [List.allM_eq_not_anyM_not]
|
||||
|
||||
theorem all_eq_not_any_not (p : α → Bool) (as : Array α) (start stop) :
|
||||
all as p start stop = !(any as (!p ·) start stop) := by
|
||||
dsimp [all, allM]
|
||||
@@ -1039,10 +1184,10 @@ theorem all_def {p : α → Bool} (as : Array α) : as.all p = as.toList.all p :
|
||||
rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]; simp only [List.mem_iff_getElem]
|
||||
constructor
|
||||
· rintro w x ⟨r, h, rfl⟩
|
||||
rw [← getElem_eq_toList_getElem]
|
||||
rw [← getElem_eq_getElem_toList]
|
||||
exact w ⟨r, h⟩
|
||||
· intro w i
|
||||
exact w as[i] ⟨i, i.2, (getElem_eq_toList_getElem as i.2).symm⟩
|
||||
exact w as[i] ⟨i, i.2, (getElem_eq_getElem_toList i.2).symm⟩
|
||||
|
||||
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p ↔ ∀ x, x ∈ l → p x := by
|
||||
simp only [all_def, List.all_eq_true, mem_def]
|
||||
@@ -1113,5 +1258,118 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
|
||||
· split <;> simp_all
|
||||
· split <;> simp_all
|
||||
|
||||
|
||||
end Array
|
||||
|
||||
|
||||
open Array
|
||||
|
||||
namespace List
|
||||
|
||||
/-!
|
||||
### More theorems about `List.toArray`, followed by an `Array` operation.
|
||||
|
||||
Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
|
||||
-/
|
||||
|
||||
@[simp] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by
|
||||
simp [mem_def]
|
||||
|
||||
@[simp] theorem getElem?_toArray (l : List α) (i : Nat) : l.toArray[i]? = l[i]? := by
|
||||
simp [getElem?_eq_getElem?_toList]
|
||||
|
||||
@[simp] theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
|
||||
simp
|
||||
|
||||
@[simp] theorem push_append_toArray (as : Array α) (a : α) (l : List α) :
|
||||
as.push a ++ l.toArray = as ++ (a :: l).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem mapM_toArray [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) :
|
||||
l.toArray.mapM f = List.toArray <$> l.mapM f := by
|
||||
simp only [← mapM'_eq_mapM, mapM_eq_foldlM]
|
||||
suffices ∀ init : Array β,
|
||||
foldlM (fun bs a => bs.push <$> f a) init l.toArray = (init ++ toArray ·) <$> mapM' f l by
|
||||
simpa using this #[]
|
||||
intro init
|
||||
induction l generalizing init with
|
||||
| nil => simp
|
||||
| cons a l ih =>
|
||||
simp only [foldlM_toArray] at ih
|
||||
rw [size_toArray, mapM'_cons, foldlM_toArray]
|
||||
simp [ih]
|
||||
|
||||
@[simp] theorem map_toArray (f : α → β) (l : List α) : l.toArray.map f = (l.map f).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
|
||||
l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem set_toArray (l : List α) (i : Fin l.toArray.size) (a : α) :
|
||||
l.toArray.set i a = (l.set i a).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
|
||||
l.toArray.uset i a h = (l.set i.toNat a).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem setD_toArray (l : List α) (i : Nat) (a : α) :
|
||||
l.toArray.setD i a = (l.set i a).toArray := by
|
||||
apply ext'
|
||||
simp only [setD]
|
||||
split
|
||||
· simp
|
||||
· simp_all [List.set_eq_of_length_le]
|
||||
|
||||
@[simp] theorem anyM_toArray [Monad m] [LawfulMonad m] (p : α → m Bool) (l : List α) :
|
||||
l.toArray.anyM p = l.anyM p := by
|
||||
rw [← anyM_toList]
|
||||
|
||||
@[simp] theorem any_toArray (p : α → Bool) (l : List α) : l.toArray.any p = l.any p := by
|
||||
rw [Array.any_def]
|
||||
|
||||
@[simp] theorem allM_toArray [Monad m] [LawfulMonad m] (p : α → m Bool) (l : List α) :
|
||||
l.toArray.allM p = l.allM p := by
|
||||
rw [← allM_toList]
|
||||
|
||||
@[simp] theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p := by
|
||||
rw [Array.all_def]
|
||||
|
||||
@[simp] theorem swap_toArray (l : List α) (i j : Fin l.toArray.size) :
|
||||
l.toArray.swap i j = ((l.set i l[j]).set j l[i]).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem filter_toArray (p : α → Bool) (l : List α) :
|
||||
l.toArray.filter p = (l.filter p).toArray := by
|
||||
apply ext'
|
||||
erw [toList_filter] -- `erw` required to unify `l.length` with `l.toArray.size`.
|
||||
|
||||
@[simp] theorem filterMap_toArray (f : α → Option β) (l : List α) :
|
||||
l.toArray.filterMap f = (l.filterMap f).toArray := by
|
||||
apply ext'
|
||||
erw [toList_filterMap] -- `erw` required to unify `l.length` with `l.toArray.size`.
|
||||
|
||||
@[simp] theorem append_toArray (l₁ l₂ : List α) :
|
||||
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_range (n : Nat) : (range n).toArray = Array.range n := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
end List
|
||||
|
||||
@@ -59,6 +59,22 @@ 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
|
||||
|
||||
@@ -12,6 +12,7 @@ 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 [Array.getElem_eq_toList_getElem] using List.exists_of_set _
|
||||
simpa only [ugetElem_eq_getElem, getElem_eq_getElem_toList, uset, toList_set] using
|
||||
List.exists_of_set _
|
||||
|
||||
end Array
|
||||
|
||||
@@ -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: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.BitVec.Basic
|
||||
|
||||
@@ -64,7 +64,7 @@ protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
|
||||
/-- The `BitVec` with value `i mod 2^n`. -/
|
||||
@[match_pattern]
|
||||
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
|
||||
toFin := Fin.ofNat' i (Nat.two_pow_pos n)
|
||||
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⟩
|
||||
@@ -173,6 +173,9 @@ 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
|
||||
@@ -266,8 +269,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 negation
|
||||
modulo `2^n`.
|
||||
Multiplication for bit vectors. This can be interpreted as either signed or unsigned
|
||||
multiplication modulo `2^n`.
|
||||
|
||||
SMT-Lib name: `bvmul`.
|
||||
-/
|
||||
@@ -450,13 +453,15 @@ SMT-Lib name: `extract`.
|
||||
def extractLsb (hi lo : Nat) (x : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ x
|
||||
|
||||
/--
|
||||
A version of `zeroExtend` that requires a proof, but is a noop.
|
||||
A version of `setWidth` that requires a proof, but is a noop.
|
||||
-/
|
||||
def zeroExtend' {n w : Nat} (le : n ≤ w) (x : BitVec n) : BitVec w :=
|
||||
def setWidth' {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)`.
|
||||
@@ -469,22 +474,35 @@ def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w + m) :=
|
||||
(msbs.toNat <<< m)#'(shiftLeftLt msbs.isLt m)
|
||||
|
||||
/--
|
||||
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.
|
||||
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`.
|
||||
-/
|
||||
def zeroExtend (v : Nat) (x : BitVec w) : BitVec v :=
|
||||
def setWidth (v : Nat) (x : BitVec w) : BitVec v :=
|
||||
if h : w ≤ v then
|
||||
zeroExtend' h x
|
||||
setWidth' h x
|
||||
else
|
||||
.ofNat v x.toNat
|
||||
|
||||
/--
|
||||
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.
|
||||
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 := @zeroExtend
|
||||
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
|
||||
|
||||
/--
|
||||
Sign extend a vector of length `w`, extending with `i` additional copies of the most significant
|
||||
@@ -635,7 +653,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 ||| zeroExtend' (Nat.le_add_left m n) lsbs
|
||||
shiftLeftZeroExtend msbs m ||| setWidth' (Nat.le_add_left m n) lsbs
|
||||
|
||||
instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := ⟨.append⟩
|
||||
|
||||
@@ -658,6 +676,13 @@ 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) :=
|
||||
|
||||
@@ -132,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, Bool.xor x (Bool.xor y c))
|
||||
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, x ^^ (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 + zeroExtend w (ofBool c)) i =
|
||||
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y c)) := by
|
||||
getLsbD (x + y + setWidth w (ofBool c)) i =
|
||||
(getLsbD x i ^^ (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_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool,
|
||||
simp only [getLsbD, toNat_add, toNat_setWidth, 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)]
|
||||
@@ -161,15 +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 =
|
||||
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y false)) := by
|
||||
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y false)) := by
|
||||
simpa using getLsbD_add_add_bool i_lt x y false
|
||||
|
||||
theorem adc_spec (x y : BitVec w) (c : Bool) :
|
||||
adc x y c = (carry w x y c, x + y + zeroExtend w (ofBool c)) := by
|
||||
adc x y c = (carry w x y c, x + y + setWidth w (ofBool c)) := by
|
||||
simp only [adc]
|
||||
apply iunfoldr_replace
|
||||
(fun i => carry i x y c)
|
||||
(x + y + zeroExtend w (ofBool c))
|
||||
(x + y + setWidth w (ofBool c))
|
||||
c
|
||||
case init =>
|
||||
simp [carry, Nat.mod_one]
|
||||
@@ -306,12 +306,12 @@ 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 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
|
||||
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
|
||||
rw [add_eq_or_of_and_eq_zero]
|
||||
· ext k
|
||||
simp only [getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsbD_or, getLsbD_and]
|
||||
simp only [getLsbD_setWidth, Fin.is_lt, decide_True, Bool.true_and, getLsbD_or, getLsbD_and]
|
||||
by_cases hik : i = k
|
||||
· subst hik
|
||||
simp
|
||||
@@ -322,27 +322,32 @@ theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w
|
||||
· have hik'' : ¬ (k < i) := by omega
|
||||
simp [hik', hik'']
|
||||
· ext k
|
||||
simp only [and_twoPow, getLsbD_and, getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and,
|
||||
simp only [and_twoPow, getLsbD_and, getLsbD_setWidth, 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_truncate (x y : BitVec w) (s : Nat) :
|
||||
mulRec x y s = x * ((y.truncate (s + 1)).zeroExtend w) := by
|
||||
theorem mulRec_eq_mul_signExtend_setWidth (x y : BitVec w) (s : Nat) :
|
||||
mulRec x y s = x * ((y.setWidth (s + 1)).setWidth 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, truncate, zeroExtend_one_eq_ofBool_getLsb_zero,
|
||||
simp only [hy, ↓reduceIte, setWidth_one_eq_ofBool_getLsb_zero,
|
||||
ofBool_true, ofNat_eq_ofNat]
|
||||
rw [zeroExtend_ofNat_one_eq_ofNat_one_of_lt (by omega)]
|
||||
rw [setWidth_ofNat_one_eq_ofNat_one_of_lt (by omega)]
|
||||
simp
|
||||
case neg hy =>
|
||||
simp [hy, zeroExtend_one_eq_ofBool_getLsb_zero]
|
||||
simp [hy, setWidth_one_eq_ofBool_getLsb_zero]
|
||||
case succ s' hs =>
|
||||
rw [mulRec_succ_eq, hs]
|
||||
have heq :
|
||||
@@ -350,13 +355,16 @@ theorem mulRec_eq_mul_signExtend_truncate (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, ← zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow]
|
||||
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
|
||||
|
||||
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_truncate]
|
||||
rw [truncate, ← truncate_eq_zeroExtend, ← truncate_eq_zeroExtend,
|
||||
truncate_truncate_of_le]
|
||||
simp only [mulRec_eq_mul_signExtend_setWidth]
|
||||
rw [setWidth_setWidth_of_le]
|
||||
· simp
|
||||
· omega
|
||||
|
||||
@@ -402,22 +410,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.truncate (n + 1)).zeroExtend w₂ := by
|
||||
shiftLeftRec x y n = x <<< (y.setWidth (n + 1)).setWidth w₂ := by
|
||||
induction n generalizing x y
|
||||
case zero =>
|
||||
ext i
|
||||
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, truncate_one,
|
||||
and_one_eq_zeroExtend_ofBool_getLsbD]
|
||||
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, setWidth_one,
|
||||
and_one_eq_setWidth_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 [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
|
||||
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_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 [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)]
|
||||
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)]
|
||||
simp [h]
|
||||
|
||||
/--
|
||||
@@ -430,6 +438,386 @@ 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.udiv 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.umod 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.udiv 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.umod 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 divison 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.udiv 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.umod d = out.r := by
|
||||
have := DivModState.lawful_init {n, d} hd
|
||||
have := lawful_divRec this
|
||||
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
|
||||
|
||||
@[simp]
|
||||
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 -/
|
||||
|
||||
/--
|
||||
@@ -466,18 +854,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.truncate (n + 1)).zeroExtend w₂) := by
|
||||
sshiftRightRec x y n = x.sshiftRight' ((y.setWidth (n + 1)).setWidth w₂) := by
|
||||
induction n generalizing x y
|
||||
case zero =>
|
||||
ext i
|
||||
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
|
||||
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_setWidth_ofBool_getLsbD, setWidth_one]
|
||||
case succ n ih =>
|
||||
simp only [sshiftRightRec_succ_eq, and_twoPow, ih]
|
||||
by_cases h : y.getLsbD (n + 1)
|
||||
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
|
||||
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
|
||||
sshiftRight'_or_of_and_eq_zero (by simp [and_twoPow]), h]
|
||||
simp
|
||||
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)
|
||||
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)
|
||||
(by simp [h])]
|
||||
simp [h]
|
||||
|
||||
@@ -529,20 +917,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.truncate (n + 1)).zeroExtend w₂ := by
|
||||
ushiftRightRec x y n = x >>> (y.setWidth (n + 1)).setWidth w₂ := by
|
||||
induction n generalizing x y
|
||||
case zero =>
|
||||
ext i
|
||||
simp only [ushiftRightRec_zero, twoPow_zero, Nat.reduceAdd,
|
||||
and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
|
||||
and_one_eq_setWidth_ofBool_getLsbD, setWidth_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 [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
|
||||
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
|
||||
ushiftRight'_or_of_and_eq_zero]
|
||||
simp [and_twoPow]
|
||||
· simp [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false, h]
|
||||
· simp [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false, h]
|
||||
|
||||
/--
|
||||
Show that `x >>> y` can be written in terms of `ushiftRightRec`.
|
||||
|
||||
@@ -48,7 +48,7 @@ private theorem iunfoldr.eq_test
|
||||
simp only [init, eq_nil]
|
||||
case step =>
|
||||
intro i
|
||||
simp_all [truncate_succ]
|
||||
simp_all [setWidth_succ]
|
||||
|
||||
theorem iunfoldr_getLsbD' {f : Fin w → α → α × Bool} (state : Nat → α)
|
||||
(ind : ∀(i : Fin w), (f i (state i.val)).fst = state (i.val+1)) :
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -6,16 +6,13 @@ Authors: F. G. Dorais
|
||||
prelude
|
||||
import Init.NotationExtra
|
||||
|
||||
/-- Boolean exclusive or -/
|
||||
abbrev xor : Bool → Bool → Bool := bne
|
||||
|
||||
namespace Bool
|
||||
|
||||
/- Namespaced versions that can be used instead of prefixing `_root_` -/
|
||||
@[inherit_doc not] protected abbrev not := not
|
||||
@[inherit_doc or] protected abbrev or := or
|
||||
@[inherit_doc and] protected abbrev and := and
|
||||
@[inherit_doc xor] protected abbrev xor := xor
|
||||
/-- 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
|
||||
@@ -150,8 +147,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 && 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
|
||||
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
|
||||
|
||||
/-- De Morgan's law for boolean and -/
|
||||
@[simp] theorem not_and : ∀ (x y : Bool), (!(x && y)) = (!x || !y) := by decide
|
||||
@@ -257,15 +254,6 @@ 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
|
||||
@@ -279,37 +267,37 @@ theorem beq_comm {α} [BEq α] [LawfulBEq α] {a b : α} : (a == b) = (b == a) :
|
||||
|
||||
/-! ### xor -/
|
||||
|
||||
theorem false_xor : ∀ (x : Bool), xor false x = x := false_bne
|
||||
theorem false_xor : ∀ (x : Bool), (false ^^ x) = x := false_bne
|
||||
|
||||
theorem xor_false : ∀ (x : Bool), xor x false = x := bne_false
|
||||
theorem xor_false : ∀ (x : Bool), (x ^^ false) = x := bne_false
|
||||
|
||||
theorem true_xor : ∀ (x : Bool), xor true x = !x := true_bne
|
||||
theorem true_xor : ∀ (x : Bool), (true ^^ x) = !x := true_bne
|
||||
|
||||
theorem xor_true : ∀ (x : Bool), xor x true = !x := bne_true
|
||||
theorem xor_true : ∀ (x : Bool), (x ^^ true) = !x := bne_true
|
||||
|
||||
theorem not_xor_self : ∀ (x : Bool), xor (!x) x = true := not_bne_self
|
||||
theorem not_xor_self : ∀ (x : Bool), (!x ^^ x) = true := not_bne_self
|
||||
|
||||
theorem xor_not_self : ∀ (x : Bool), xor x (!x) = true := bne_not_self
|
||||
theorem xor_not_self : ∀ (x : Bool), (x ^^ !x) = true := bne_not_self
|
||||
|
||||
theorem not_xor : ∀ (x y : Bool), xor (!x) y = !(xor x y) := by decide
|
||||
theorem not_xor : ∀ (x y : Bool), (!x ^^ y) = !(x ^^ y) := by decide
|
||||
|
||||
theorem xor_not : ∀ (x y : Bool), xor x (!y) = !(xor x y) := by decide
|
||||
theorem xor_not : ∀ (x y : Bool), (x ^^ !y) = !(x ^^ y) := by decide
|
||||
|
||||
theorem not_xor_not : ∀ (x y : Bool), xor (!x) (!y) = (xor x y) := not_bne_not
|
||||
theorem not_xor_not : ∀ (x y : Bool), (!x ^^ !y) = (x ^^ y) := not_bne_not
|
||||
|
||||
theorem xor_self : ∀ (x : Bool), xor x x = false := by decide
|
||||
theorem xor_self : ∀ (x : Bool), (x ^^ x) = false := by decide
|
||||
|
||||
theorem xor_comm : ∀ (x y : Bool), xor x y = xor y x := by decide
|
||||
theorem xor_comm : ∀ (x y : Bool), (x ^^ y) = (y ^^ x) := by decide
|
||||
|
||||
theorem xor_left_comm : ∀ (x y z : Bool), xor x (xor y z) = xor y (xor x z) := by decide
|
||||
theorem xor_left_comm : ∀ (x y z : Bool), (x ^^ (y ^^ z)) = (y ^^ (x ^^ z)) := by decide
|
||||
|
||||
theorem xor_right_comm : ∀ (x y z : Bool), xor (xor x y) z = xor (xor x z) y := by decide
|
||||
theorem xor_right_comm : ∀ (x y z : Bool), ((x ^^ y) ^^ z) = ((x ^^ z) ^^ y) := by decide
|
||||
|
||||
theorem xor_assoc : ∀ (x y z : Bool), xor (xor x y) z = xor x (xor y z) := bne_assoc
|
||||
theorem xor_assoc : ∀ (x y z : Bool), ((x ^^ y) ^^ z) = (x ^^ (y ^^ z)) := bne_assoc
|
||||
|
||||
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 ^^ y) = (x ^^ z) ↔ y = z := bne_left_inj
|
||||
|
||||
theorem xor_right_inj : ∀ {x y z : Bool}, xor x z = xor y z ↔ x = y := bne_right_inj
|
||||
theorem xor_right_inj : ∀ {x y z : Bool}, (x ^^ z) = (y ^^ z) ↔ x = y := bne_right_inj
|
||||
|
||||
/-! ### le/lt -/
|
||||
|
||||
@@ -380,13 +368,14 @@ 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] theorem toNat_false : false.toNat = 0 := rfl
|
||||
@[simp, bv_toNat] theorem toNat_false : false.toNat = 0 := rfl
|
||||
|
||||
@[simp] theorem toNat_true : true.toNat = 1 := rfl
|
||||
@[simp, bv_toNat] 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 _)
|
||||
|
||||
@@ -597,7 +586,7 @@ theorem decide_beq_decide (p q : Prop) [dpq : Decidable (p ↔ q)] [dp : Decidab
|
||||
|
||||
end Bool
|
||||
|
||||
export Bool (cond_eq_if)
|
||||
export Bool (cond_eq_if xor and or not)
|
||||
|
||||
/-! ### decide -/
|
||||
|
||||
|
||||
@@ -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 simlar to `Empty.elim`.
|
||||
From the empty type `Fin 0`, any desired result `α` can be derived. This is similar to `Empty.elim`.
|
||||
-/
|
||||
def elim0.{u} {α : Sort u} : Fin 0 → α
|
||||
| ⟨_, h⟩ => absurd h (not_lt_zero _)
|
||||
@@ -31,7 +31,7 @@ This differs from addition, which wraps around:
|
||||
(2 : Fin 3) + 1 = (0 : Fin 3)
|
||||
```
|
||||
-/
|
||||
def succ : Fin n → Fin n.succ
|
||||
def succ : Fin n → Fin (n + 1)
|
||||
| ⟨i, h⟩ => ⟨i+1, Nat.succ_lt_succ h⟩
|
||||
|
||||
variable {n : Nat}
|
||||
@@ -39,16 +39,20 @@ variable {n : Nat}
|
||||
/--
|
||||
Returns `a` modulo `n + 1` as a `Fin n.succ`.
|
||||
-/
|
||||
protected def ofNat {n : Nat} (a : Nat) : 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`.
|
||||
|
||||
The assumption `n > 0` ensures that `Fin n` is nonempty.
|
||||
The assumption `NeZero n` ensures that `Fin n` is nonempty.
|
||||
-/
|
||||
protected def ofNat' {n : Nat} (a : Nat) (h : n > 0) : Fin n :=
|
||||
⟨a % n, Nat.mod_lt _ h⟩
|
||||
protected def ofNat' (n : Nat) [NeZero n] (a : Nat) : Fin n :=
|
||||
⟨a % n, Nat.mod_lt _ (pos_of_neZero n)⟩
|
||||
|
||||
-- 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
|
||||
@@ -141,10 +145,10 @@ instance : ShiftLeft (Fin n) where
|
||||
instance : ShiftRight (Fin n) where
|
||||
shiftRight := Fin.shiftRight
|
||||
|
||||
instance instOfNat {n : Nat} [NeZero n] {i : Nat} : OfNat (Fin (no_index n)) i where
|
||||
ofNat := Fin.ofNat' i (pos_of_neZero _)
|
||||
instance instOfNat {n : Nat} [NeZero n] {i : Nat} : OfNat (Fin n) i where
|
||||
ofNat := Fin.ofNat' n i
|
||||
|
||||
instance : Inhabited (Fin (no_index (n+1))) where
|
||||
instance instInhabited {n : Nat} [NeZero n] : Inhabited (Fin n) where
|
||||
default := 0
|
||||
|
||||
@[simp] theorem zero_eta : (⟨0, Nat.zero_lt_succ _⟩ : Fin (n + 1)) = 0 := rfl
|
||||
|
||||
@@ -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 heterogenous iterative operation that applies a
|
||||
`hIterate` is a heterogeneous 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 heterogenous and must return a value of type `P stop`,
|
||||
Because it is heterogeneous 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` satisifies a property `Q stop` by showing that the states
|
||||
`hIterate` satisfies 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)
|
||||
|
||||
@@ -51,10 +51,15 @@ theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} :
|
||||
|
||||
theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
|
||||
|
||||
@[simp] theorem val_ofNat' (a : Nat) (is_pos : n > 0) :
|
||||
(Fin.ofNat' a is_pos).val = a % n := rfl
|
||||
@[simp] theorem val_ofNat' (n : Nat) [NeZero n] (a : Nat) :
|
||||
(Fin.ofNat' n a).val = a % n := rfl
|
||||
|
||||
@[simp] theorem ofNat'_val_eq_self (x : Fin n) (h) : (Fin.ofNat' x h) = x := by
|
||||
@[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
|
||||
ext
|
||||
rw [val_ofNat', Nat.mod_eq_of_lt]
|
||||
exact x.2
|
||||
@@ -68,6 +73,9 @@ 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 [*]
|
||||
@@ -120,7 +128,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) : (0 : Fin (n + 1)).1 = 0 := rfl
|
||||
@[simp] theorem val_zero (n : Nat) [NeZero n] : ((0 : Fin n) : Nat) = 0 := rfl
|
||||
|
||||
@[simp] theorem mk_zero : (⟨0, Nat.succ_pos n⟩ : Fin (n + 1)) = 0 := rfl
|
||||
|
||||
@@ -167,8 +175,24 @@ 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 _
|
||||
@@ -202,10 +226,28 @@ 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.size_pos) := rfl
|
||||
|
||||
theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl
|
||||
|
||||
@[simp] protected theorem zero_add {n : Nat} [NeZero n] (i : Fin n) : (0 : Fin n) + i = i := by
|
||||
ext
|
||||
simp [Fin.add_def, Nat.mod_eq_of_lt i.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
|
||||
@@ -329,6 +371,10 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
|
||||
|
||||
@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h ⟨i, hn⟩ = ⟨i, h ▸ hn⟩ := rfl
|
||||
|
||||
@[simp] theorem cast_refl (n : Nat) (h : n = n) : cast h = id := by
|
||||
ext
|
||||
simp
|
||||
|
||||
@[simp] theorem cast_trans {k : Nat} (h : n = m) (h' : m = k) {i : Fin n} :
|
||||
cast h' (cast h i) = cast (Eq.trans h h') i := rfl
|
||||
|
||||
@@ -437,6 +483,10 @@ theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = castSucc i.succ
|
||||
|
||||
@[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 :=
|
||||
@@ -466,7 +516,7 @@ 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 ..
|
||||
|
||||
theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp
|
||||
@[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) :
|
||||
@@ -504,9 +554,19 @@ theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) :
|
||||
|
||||
@[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 = cast (by omega) (last (n + m)) := 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)]
|
||||
|
||||
@@ -572,6 +632,15 @@ 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) : (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
|
||||
|
||||
@@ -582,7 +651,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 (cast (Nat.add_comm ..) i) h) = i := by simp [← cast_addNat]; rfl
|
||||
natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [← cast_addNat]
|
||||
|
||||
/-! ### recursion and induction principles -/
|
||||
|
||||
@@ -750,13 +819,13 @@ theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right
|
||||
|
||||
/-! ### add -/
|
||||
|
||||
@[simp] theorem ofNat'_add (x : Nat) (lt : 0 < n) (y : Fin n) :
|
||||
Fin.ofNat' x lt + y = Fin.ofNat' (x + y.val) lt := by
|
||||
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]
|
||||
|
||||
@[simp] theorem add_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) :
|
||||
x + Fin.ofNat' y lt = Fin.ofNat' (x.val + y) lt := by
|
||||
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]
|
||||
|
||||
@@ -765,16 +834,21 @@ theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right
|
||||
protected theorem coe_sub (a b : Fin n) : ((a - b : Fin n) : Nat) = ((n - b) + a) % n := by
|
||||
cases a; cases b; rfl
|
||||
|
||||
@[simp] theorem ofNat'_sub (x : Nat) (lt : 0 < n) (y : Fin n) :
|
||||
Fin.ofNat' x lt - y = Fin.ofNat' ((n - y.val) + x) lt := by
|
||||
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]
|
||||
|
||||
@[simp] theorem sub_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) :
|
||||
x - Fin.ofNat' y lt = Fin.ofNat' ((n - y % n) + x.val) lt := by
|
||||
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)]
|
||||
|
||||
@@ -194,7 +194,7 @@ theorem fdiv_eq_tdiv {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = tdiv
|
||||
@[simp, norm_cast] theorem ofNat_emod (m n : Nat) : (↑(m % n) : Int) = m % n := rfl
|
||||
|
||||
|
||||
/-! ### mod definitiions -/
|
||||
/-! ### mod definitions -/
|
||||
|
||||
theorem emod_add_ediv : ∀ a b : Int, a % b + b * (a / b) = a
|
||||
| ofNat _, ofNat _ => congrArg ofNat <| Nat.mod_add_div ..
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Lemmas
|
||||
import Init.Data.Nat.Lemmas
|
||||
|
||||
namespace Int
|
||||
|
||||
@@ -35,10 +36,24 @@ theorem pow_le_pow_of_le_right {n : Nat} (hx : n > 0) {i : Nat} : ∀ {j}, i ≤
|
||||
theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
|
||||
pow_le_pow_of_le_right h (Nat.zero_le _)
|
||||
|
||||
@[norm_cast]
|
||||
theorem natCast_pow (b n : Nat) : ((b^n : Nat) : Int) = (b : Int) ^ n := by
|
||||
match n with
|
||||
| 0 => rfl
|
||||
| n + 1 =>
|
||||
simp only [Nat.pow_succ, Int.pow_succ, natCast_mul, natCast_pow _ n]
|
||||
|
||||
@[simp]
|
||||
protected theorem two_pow_pred_sub_two_pow {w : Nat} (h : 0 < w) :
|
||||
((2 ^ (w - 1) : Nat) - (2 ^ w : Nat) : Int) = - ((2 ^ (w - 1) : Nat) : Int) := by
|
||||
rw [← Nat.two_pow_pred_add_two_pow_pred h]
|
||||
omega
|
||||
|
||||
@[simp]
|
||||
protected theorem two_pow_pred_sub_two_pow' {w : Nat} (h : 0 < w) :
|
||||
(2 : Int) ^ (w - 1) - (2 : Int) ^ w = - (2 : Int) ^ (w - 1) := by
|
||||
norm_cast
|
||||
rw [← Nat.two_pow_pred_add_two_pow_pred h]
|
||||
simp [h]
|
||||
|
||||
end Int
|
||||
|
||||
@@ -130,24 +130,6 @@ theorem attachWith_map_subtype_val {p : α → Prop} (l : List α) (H : ∀ a
|
||||
(l.attachWith p H).map Subtype.val = l :=
|
||||
(attachWith_map_coe _ _ _).trans (List.map_id _)
|
||||
|
||||
theorem countP_attach (l : List α) (p : α → Bool) :
|
||||
l.attach.countP (fun a : {x // x ∈ l} => p a) = l.countP p := by
|
||||
simp only [← Function.comp_apply (g := Subtype.val), ← countP_map, attach_map_subtype_val]
|
||||
|
||||
theorem countP_attachWith {p : α → Prop} (l : List α) (H : ∀ a ∈ l, p a) (q : α → Bool) :
|
||||
(l.attachWith p H).countP (fun a : {x // p x} => q a) = l.countP q := by
|
||||
simp only [← Function.comp_apply (g := Subtype.val), ← countP_map, attachWith_map_subtype_val]
|
||||
|
||||
@[simp]
|
||||
theorem count_attach [DecidableEq α] (l : List α) (a : {x // x ∈ l}) :
|
||||
l.attach.count a = l.count ↑a :=
|
||||
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attach _ _
|
||||
|
||||
@[simp]
|
||||
theorem count_attachWith [DecidableEq α] {p : α → Prop} (l : List α) (H : ∀ a ∈ l, p a) (a : {x // p x}) :
|
||||
(l.attachWith p H).count a = l.count ↑a :=
|
||||
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attachWith _ _ _
|
||||
|
||||
@[simp]
|
||||
theorem mem_attach (l : List α) : ∀ x, x ∈ l.attach
|
||||
| ⟨a, h⟩ => by
|
||||
@@ -235,7 +217,7 @@ theorem getElem_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h
|
||||
(hn : n < (pmap f l h).length) :
|
||||
(pmap f l h)[n] =
|
||||
f (l[n]'(@length_pmap _ _ p f l h ▸ hn))
|
||||
(h _ (getElem_mem l n (@length_pmap _ _ p f l h ▸ hn))) := by
|
||||
(h _ (getElem_mem (@length_pmap _ _ p f l h ▸ hn))) := by
|
||||
induction l generalizing n with
|
||||
| nil =>
|
||||
simp only [length, pmap] at hn
|
||||
@@ -266,12 +248,12 @@ theorem getElem?_attach {xs : List α} {i : Nat} :
|
||||
@[simp]
|
||||
theorem getElem_attachWith {xs : List α} {P : α → Prop} {H : ∀ a ∈ xs, P a}
|
||||
{i : Nat} (h : i < (xs.attachWith P H).length) :
|
||||
(xs.attachWith P H)[i] = ⟨xs[i]'(by simpa using h), H _ (getElem_mem xs i (by simpa using h))⟩ :=
|
||||
(xs.attachWith P H)[i] = ⟨xs[i]'(by simpa using h), H _ (getElem_mem (by simpa using h))⟩ :=
|
||||
getElem_pmap ..
|
||||
|
||||
@[simp]
|
||||
theorem getElem_attach {xs : List α} {i : Nat} (h : i < xs.attach.length) :
|
||||
xs.attach[i] = ⟨xs[i]'(by simpa using h), getElem_mem xs i (by simpa using h)⟩ :=
|
||||
xs.attach[i] = ⟨xs[i]'(by simpa using h), getElem_mem (by simpa using h)⟩ :=
|
||||
getElem_attachWith h
|
||||
|
||||
@[simp] theorem head?_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
|
||||
@@ -312,6 +294,60 @@ theorem getElem_attach {xs : List α} {i : Nat} (h : i < xs.attach.length) :
|
||||
| nil => simp at h
|
||||
| cons x xs => simp [head_attach, h]
|
||||
|
||||
@[simp] theorem tail_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List α)
|
||||
(H : ∀ (a : α), a ∈ xs → P a) :
|
||||
(xs.pmap f H).tail = xs.tail.pmap f (fun a h => H a (mem_of_mem_tail h)) := by
|
||||
cases xs <;> simp
|
||||
|
||||
@[simp] theorem tail_attachWith {P : α → Prop} {xs : List α}
|
||||
{H : ∀ (a : α), a ∈ xs → P a} :
|
||||
(xs.attachWith P H).tail = xs.tail.attachWith P (fun a h => H a (mem_of_mem_tail h)) := by
|
||||
cases xs <;> simp
|
||||
|
||||
@[simp] theorem tail_attach (xs : List α) :
|
||||
xs.attach.tail = xs.tail.attach.map (fun ⟨x, h⟩ => ⟨x, mem_of_mem_tail h⟩) := by
|
||||
cases xs <;> simp
|
||||
|
||||
theorem foldl_pmap (l : List α) {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 : List α) {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.
|
||||
-/
|
||||
theorem foldl_attach (l : List α) (f : β → α → β) (b : β) :
|
||||
l.attach.foldl (fun acc t => f acc t.1) b = l.foldl f b := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons a l ih => rw [foldl_cons, attach_cons, foldl_cons, foldl_map, ih]
|
||||
|
||||
/--
|
||||
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.
|
||||
-/
|
||||
theorem foldr_attach (l : List α) (f : α → β → β) (b : β) :
|
||||
l.attach.foldr (fun t acc => f t.1 acc) b = l.foldr f b := by
|
||||
induction l generalizing b with
|
||||
| nil => simp
|
||||
| cons a l ih => rw [foldr_cons, attach_cons, foldr_cons, foldr_map, ih]
|
||||
|
||||
theorem attach_map {l : List α} (f : α → β) :
|
||||
(l.map f).attach = l.attach.map (fun ⟨x, h⟩ => ⟨f x, mem_map_of_mem f h⟩) := by
|
||||
induction l <;> simp [*]
|
||||
@@ -492,4 +528,24 @@ theorem getLast_attach {xs : List α} (h : xs.attach ≠ []) :
|
||||
xs.attach.getLast h = ⟨xs.getLast (by simpa using h), getLast_mem (by simpa using h)⟩ := by
|
||||
simp only [getLast_eq_head_reverse, reverse_attach, head_map, head_attach]
|
||||
|
||||
@[simp]
|
||||
theorem countP_attach (l : List α) (p : α → Bool) :
|
||||
l.attach.countP (fun a : {x // x ∈ l} => p a) = l.countP p := by
|
||||
simp only [← Function.comp_apply (g := Subtype.val), ← countP_map, attach_map_subtype_val]
|
||||
|
||||
@[simp]
|
||||
theorem countP_attachWith {p : α → Prop} (l : List α) (H : ∀ a ∈ l, p a) (q : α → Bool) :
|
||||
(l.attachWith p H).countP (fun a : {x // p x} => q a) = l.countP q := by
|
||||
simp only [← Function.comp_apply (g := Subtype.val), ← countP_map, attachWith_map_subtype_val]
|
||||
|
||||
@[simp]
|
||||
theorem count_attach [DecidableEq α] (l : List α) (a : {x // x ∈ l}) :
|
||||
l.attach.count a = l.count ↑a :=
|
||||
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attach _ _
|
||||
|
||||
@[simp]
|
||||
theorem count_attachWith [DecidableEq α] {p : α → Prop} (l : List α) (H : ∀ a ∈ l, p a) (a : {x // p x}) :
|
||||
(l.attachWith p H).count a = l.count ↑a :=
|
||||
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attachWith _ _ _
|
||||
|
||||
end List
|
||||
|
||||
@@ -1588,6 +1588,14 @@ such that adjacent elements are related by `R`.
|
||||
| [] => []
|
||||
| a::as => loop as a [] []
|
||||
where
|
||||
/--
|
||||
The arguments of `groupBy.loop l ag g gs` represent the following:
|
||||
|
||||
- `l : List α` are the elements which we still need to group.
|
||||
- `ag : α` is the previous element for which a comparison was performed.
|
||||
- `g : List α` is the group currently being assembled, in **reverse order**.
|
||||
- `gs : List (List α)` is all of the groups that have been completed, in **reverse order**.
|
||||
-/
|
||||
@[specialize] loop : List α → α → List α → List (List α) → List (List α)
|
||||
| a::as, ag, g, gs => match R ag a with
|
||||
| true => loop as a (ag::g) gs
|
||||
|
||||
@@ -155,7 +155,7 @@ def mapMono (as : List α) (f : α → α) : List α :=
|
||||
|
||||
/-! ## Additional lemmas required for bootstrapping `Array`. -/
|
||||
|
||||
theorem getElem_append_left (as bs : List α) (h : i < as.length) {h'} : (as ++ bs)[i] = as[i] := by
|
||||
theorem getElem_append_left {as bs : List α} (h : i < as.length) {h'} : (as ++ bs)[i] = as[i] := by
|
||||
induction as generalizing i with
|
||||
| nil => trivial
|
||||
| cons a as ih =>
|
||||
@@ -163,12 +163,14 @@ theorem getElem_append_left (as bs : List α) (h : i < as.length) {h'} : (as ++
|
||||
| zero => rfl
|
||||
| succ i => apply ih
|
||||
|
||||
theorem getElem_append_right (as bs : List α) (h : ¬ i < as.length) {h' h''} : (as ++ bs)[i]'h' = bs[i - as.length]'h'' := by
|
||||
theorem getElem_append_right {as bs : List α} {i : Nat} (h₁ : as.length ≤ i) {h₂} :
|
||||
(as ++ bs)[i]'h₂ =
|
||||
bs[i - as.length]'(by rw [length_append] at h₂; exact Nat.sub_lt_left_of_lt_add h₁ h₂) := by
|
||||
induction as generalizing i with
|
||||
| nil => trivial
|
||||
| cons a as ih =>
|
||||
cases i with simp [get, Nat.succ_sub_succ] <;> simp [Nat.succ_sub_succ] at h
|
||||
| succ i => apply ih; simp [h]
|
||||
cases i with simp [get, Nat.succ_sub_succ] <;> simp [Nat.succ_sub_succ] at h₁
|
||||
| succ i => apply ih; simp [h₁]
|
||||
|
||||
theorem get_last {as : List α} {i : Fin (length (as ++ [a]))} (h : ¬ i.1 < as.length) : (as ++ [a] : List _).get i = a := by
|
||||
cases i; rename_i i h'
|
||||
|
||||
@@ -115,6 +115,13 @@ theorem IsPrefix.countP_le (s : l₁ <+: l₂) : countP p l₁ ≤ countP p l₂
|
||||
theorem IsSuffix.countP_le (s : l₁ <:+ l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le _
|
||||
theorem IsInfix.countP_le (s : l₁ <:+: l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le _
|
||||
|
||||
-- See `Init.Data.List.Nat.Count` for `Sublist.le_countP : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁`.
|
||||
|
||||
theorem countP_tail_le (l) : countP p l.tail ≤ countP p l :=
|
||||
(tail_sublist l).countP_le _
|
||||
|
||||
-- See `Init.Data.List.Nat.Count` for `le_countP_tail : countP p l - 1 ≤ countP p l.tail`.
|
||||
|
||||
theorem countP_filter (l : List α) :
|
||||
countP p (filter q l) = countP (fun a => p a && q a) l := by
|
||||
simp only [countP_eq_length_filter, filter_filter]
|
||||
@@ -207,6 +214,13 @@ theorem IsPrefix.count_le (h : l₁ <+: l₂) (a : α) : count a l₁ ≤ count
|
||||
theorem IsSuffix.count_le (h : l₁ <:+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.sublist.count_le _
|
||||
theorem IsInfix.count_le (h : l₁ <:+: l₂) (a : α) : count a l₁ ≤ count a l₂ := h.sublist.count_le _
|
||||
|
||||
-- See `Init.Data.List.Nat.Count` for `Sublist.le_count : count a l₂ - (l₂.length - l₁.length) ≤ countP a l₁`.
|
||||
|
||||
theorem count_tail_le (a : α) (l) : count a l.tail ≤ count a l :=
|
||||
(tail_sublist l).count_le _
|
||||
|
||||
-- See `Init.Data.List.Nat.Count` for `le_count_tail : count a l - 1 ≤ count a l.tail`.
|
||||
|
||||
theorem count_le_count_cons (a b : α) (l : List α) : count a l ≤ count a (b :: l) :=
|
||||
(sublist_cons_self _ _).count_le _
|
||||
|
||||
|
||||
@@ -109,6 +109,10 @@ protected theorem Sublist.eraseP : l₁ <+ l₂ → l₁.eraseP p <+ l₂.eraseP
|
||||
theorem length_eraseP_le (l : List α) : (l.eraseP p).length ≤ l.length :=
|
||||
l.eraseP_sublist.length_le
|
||||
|
||||
theorem le_length_eraseP (l : List α) : l.length - 1 ≤ (l.eraseP p).length := by
|
||||
rw [length_eraseP]
|
||||
split <;> simp
|
||||
|
||||
theorem mem_of_mem_eraseP {l : List α} : a ∈ l.eraseP p → a ∈ l := (eraseP_subset _ ·)
|
||||
|
||||
@[simp] theorem mem_eraseP_of_neg {l : List α} (pa : ¬p a) : a ∈ l.eraseP p ↔ a ∈ l := by
|
||||
@@ -332,6 +336,10 @@ theorem IsPrefix.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+: l₂) : l₁
|
||||
theorem length_erase_le (a : α) (l : List α) : (l.erase a).length ≤ l.length :=
|
||||
(erase_sublist a l).length_le
|
||||
|
||||
theorem le_length_erase [LawfulBEq α] (a : α) (l : List α) : l.length - 1 ≤ (l.erase a).length := by
|
||||
rw [length_erase]
|
||||
split <;> simp
|
||||
|
||||
theorem mem_of_mem_erase {a b : α} {l : List α} (h : a ∈ l.erase b) : a ∈ l := erase_subset _ _ h
|
||||
|
||||
@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : List α} (ab : a ≠ b) :
|
||||
@@ -452,13 +460,22 @@ end erase
|
||||
|
||||
/-! ### eraseIdx -/
|
||||
|
||||
theorem length_eraseIdx : ∀ {l i}, i < length l → length (@eraseIdx α l i) = length l - 1
|
||||
| [], _, _ => rfl
|
||||
| _::_, 0, _ => by simp [eraseIdx]
|
||||
| x::xs, i+1, h => by
|
||||
have : i < length xs := Nat.lt_of_succ_lt_succ h
|
||||
simp [eraseIdx, ← Nat.add_one]
|
||||
rw [length_eraseIdx this, Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) this)]
|
||||
theorem length_eraseIdx (l : List α) (i : Nat) :
|
||||
(l.eraseIdx i).length = if i < l.length then l.length - 1 else l.length := by
|
||||
induction l generalizing i with
|
||||
| nil => simp
|
||||
| cons x l ih =>
|
||||
cases i with
|
||||
| zero => simp
|
||||
| succ i =>
|
||||
simp only [eraseIdx, length_cons, ih, add_one_lt_add_one_iff, Nat.add_one_sub_one]
|
||||
split
|
||||
· cases l <;> simp_all
|
||||
· rfl
|
||||
|
||||
theorem length_eraseIdx_of_lt {l : List α} {i} (h : i < length l) :
|
||||
(l.eraseIdx i).length = length l - 1 := by
|
||||
simp [length_eraseIdx, h]
|
||||
|
||||
@[simp] theorem eraseIdx_zero (l : List α) : eraseIdx l 0 = tail l := by cases l <;> rfl
|
||||
|
||||
@@ -468,6 +485,8 @@ theorem eraseIdx_eq_take_drop_succ :
|
||||
| a::l, 0 => by simp
|
||||
| a::l, i + 1 => by simp [eraseIdx_eq_take_drop_succ l i]
|
||||
|
||||
-- See `Init.Data.List.Nat.Erase` for `getElem?_eraseIdx` and `getElem_eraseIdx`.
|
||||
|
||||
@[simp] theorem eraseIdx_eq_nil {l : List α} {i : Nat} : eraseIdx l i = [] ↔ l = [] ∨ (length l = 1 ∧ i = 0) := by
|
||||
match l, i with
|
||||
| [], _
|
||||
@@ -499,6 +518,13 @@ theorem eraseIdx_eq_self : ∀ {l : List α} {k : Nat}, eraseIdx l k = l ↔ len
|
||||
theorem eraseIdx_of_length_le {l : List α} {k : Nat} (h : length l ≤ k) : eraseIdx l k = l := by
|
||||
rw [eraseIdx_eq_self.2 h]
|
||||
|
||||
theorem length_eraseIdx_le (l : List α) (i : Nat) : length (l.eraseIdx i) ≤ length l :=
|
||||
(eraseIdx_sublist l i).length_le
|
||||
|
||||
theorem le_length_eraseIdx (l : List α) (i : Nat) : length l - 1 ≤ length (l.eraseIdx i) := by
|
||||
rw [length_eraseIdx]
|
||||
split <;> simp
|
||||
|
||||
theorem eraseIdx_append_of_lt_length {l : List α} {k : Nat} (hk : k < length l) (l' : List α) :
|
||||
eraseIdx (l ++ l') k = eraseIdx l k ++ l' := by
|
||||
induction l generalizing k with
|
||||
@@ -520,7 +546,7 @@ theorem eraseIdx_append_of_length_le {l : List α} {k : Nat} (hk : length l ≤
|
||||
theorem eraseIdx_replicate {n : Nat} {a : α} {k : Nat} :
|
||||
(replicate n a).eraseIdx k = if k < n then replicate (n - 1) a else replicate n a := by
|
||||
split <;> rename_i h
|
||||
· rw [eq_replicate_iff, length_eraseIdx (by simpa using h)]
|
||||
· rw [eq_replicate_iff, length_eraseIdx_of_lt (by simpa using h)]
|
||||
simp only [length_replicate, true_and]
|
||||
intro b m
|
||||
replace m := mem_of_mem_eraseIdx m
|
||||
|
||||
@@ -224,7 +224,7 @@ theorem find?_eq_some : xs.find? p = some b ↔ p b ∧ ∃ as bs, xs = as ++ b
|
||||
simp only [cons_append] at h₁
|
||||
obtain ⟨rfl, -⟩ := h₁
|
||||
simp_all
|
||||
· simp only [ih, Bool.not_eq_true', exists_and_right, and_congr_right_iff]
|
||||
· simp only [ih, Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
|
||||
intro pb
|
||||
constructor
|
||||
· rintro ⟨as, ⟨⟨bs, rfl⟩, h₁⟩⟩
|
||||
@@ -620,6 +620,18 @@ theorem IsPrefix.findIdx_eq_of_findIdx_lt_length {l₁ l₂ : List α} {p : α
|
||||
· rfl
|
||||
· simp_all
|
||||
|
||||
theorem findIdx_le_findIdx {l : List α} {p q : α → Bool} (h : ∀ x ∈ l, p x → q x) : l.findIdx q ≤ l.findIdx p := by
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons x xs ih =>
|
||||
simp only [findIdx_cons, cond_eq_if]
|
||||
split
|
||||
· simp
|
||||
· split
|
||||
· simp_all
|
||||
· simp only [Nat.add_le_add_iff_right]
|
||||
exact ih fun _ m w => h _ (mem_cons_of_mem x m) w
|
||||
|
||||
/-! ### findIdx? -/
|
||||
|
||||
@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl
|
||||
@@ -803,7 +815,7 @@ theorem findIdx?_join {l : List (List α)} {p : α → Bool} :
|
||||
simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, zero_lt_succ, true_and]
|
||||
split <;> simp_all
|
||||
|
||||
theorem findIdx?_eq_enum_findSome? {xs : List α} {p : α → Bool} :
|
||||
theorem findIdx?_eq_findSome?_enum {xs : List α} {p : α → Bool} :
|
||||
xs.findIdx? p = xs.enum.findSome? fun ⟨i, a⟩ => if p a then some i else none := by
|
||||
induction xs with
|
||||
| nil => simp
|
||||
@@ -814,6 +826,30 @@ theorem findIdx?_eq_enum_findSome? {xs : List α} {p : α → Bool} :
|
||||
· simp_all only [enumFrom_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone, reduceCtorEq]
|
||||
simp [Function.comp_def, ← map_fst_add_enum_eq_enumFrom, findSome?_map]
|
||||
|
||||
theorem findIdx?_eq_fst_find?_enum {xs : List α} {p : α → Bool} :
|
||||
xs.findIdx? p = (xs.enum.find? fun ⟨_, x⟩ => p x).map (·.1) := by
|
||||
induction xs with
|
||||
| nil => simp
|
||||
| cons x xs ih =>
|
||||
simp only [findIdx?_cons, Nat.zero_add, findIdx?_start_succ, enum_cons]
|
||||
split
|
||||
· simp_all
|
||||
· simp only [Option.map_map, enumFrom_eq_map_enum, Bool.false_eq_true, not_false_eq_true,
|
||||
find?_cons_of_neg, find?_map, *]
|
||||
congr
|
||||
|
||||
-- See also `findIdx_le_findIdx`.
|
||||
theorem findIdx?_eq_none_of_findIdx?_eq_none {xs : List α} {p q : α → Bool} (w : ∀ x ∈ xs, p x → q x) :
|
||||
xs.findIdx? q = none → xs.findIdx? p = none := by
|
||||
simp only [findIdx?_eq_none_iff]
|
||||
intro h x m
|
||||
cases z : p x
|
||||
· rfl
|
||||
· exfalso
|
||||
specialize w x m z
|
||||
specialize h x m
|
||||
simp_all
|
||||
|
||||
theorem Sublist.findIdx?_isSome {l₁ l₂ : List α} (h : l₁ <+ l₂) :
|
||||
(l₁.findIdx? p).isSome → (l₂.findIdx? p).isSome := by
|
||||
simp only [List.findIdx?_isSome, any_eq_true]
|
||||
@@ -878,7 +914,7 @@ theorem lookup_eq_some_iff {l : List (α × β)} {k : α} {b : β} :
|
||||
simp only [lookup_eq_findSome?, findSome?_eq_some_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, a, l₂, rfl, h₁, h₂⟩
|
||||
simp only [beq_iff_eq, ite_some_none_eq_some] at h₁
|
||||
simp only [beq_iff_eq, Option.ite_none_right_eq_some, Option.some.injEq] at h₁
|
||||
obtain ⟨rfl, rfl⟩ := h₁
|
||||
simp at h₂
|
||||
exact ⟨l₁, l₂, rfl, by simpa using h₂⟩
|
||||
|
||||
@@ -109,6 +109,9 @@ theorem cons_eq_cons {a b : α} {l l' : List α} : a :: l = b :: l' ↔ a = b
|
||||
theorem exists_cons_of_ne_nil : ∀ {l : List α}, l ≠ [] → ∃ b L, l = b :: L
|
||||
| c :: l', _ => ⟨c, l', rfl⟩
|
||||
|
||||
theorem singleton_inj {α : Type _} {a b : α} : [a] = [b] ↔ a = b := by
|
||||
simp
|
||||
|
||||
/-! ### length -/
|
||||
|
||||
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
|
||||
@@ -263,9 +266,15 @@ theorem get!_len_le [Inhabited α] : ∀ {l : List α} {n}, length l ≤ n → l
|
||||
theorem getElem?_eq_some_iff {l : List α} : l[n]? = some a ↔ ∃ h : n < l.length, l[n] = a := by
|
||||
simp only [← get?_eq_getElem?, get?_eq_some, get_eq_getElem]
|
||||
|
||||
theorem some_eq_getElem?_iff {l : List α} : some a = l[n]? ↔ ∃ h : n < l.length, l[n] = a := by
|
||||
rw [eq_comm, getElem?_eq_some_iff]
|
||||
|
||||
@[simp] theorem getElem?_eq_none_iff : l[n]? = none ↔ length l ≤ n := by
|
||||
simp only [← get?_eq_getElem?, get?_eq_none]
|
||||
|
||||
@[simp] theorem none_eq_getElem?_iff {l : List α} {n : Nat} : none = l[n]? ↔ length l ≤ n := by
|
||||
simp [eq_comm (a := none)]
|
||||
|
||||
theorem getElem?_eq_none (h : length l ≤ n) : l[n]? = none := getElem?_eq_none_iff.mpr h
|
||||
|
||||
theorem getElem?_eq (l : List α) (i : Nat) :
|
||||
@@ -480,9 +489,9 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n : Nat, l[n]? = s
|
||||
theorem get?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n, l.get? n = some a :=
|
||||
let ⟨⟨n, _⟩, e⟩ := get_of_mem h; ⟨n, e ▸ get?_eq_get _⟩
|
||||
|
||||
theorem getElem_mem : ∀ (l : List α) n (h : n < l.length), l[n]'h ∈ l
|
||||
theorem getElem_mem : ∀ {l : List α} {n} (h : n < l.length), l[n]'h ∈ l
|
||||
| _ :: _, 0, _ => .head ..
|
||||
| _ :: l, _+1, _ => .tail _ (getElem_mem l ..)
|
||||
| _ :: l, _+1, _ => .tail _ (getElem_mem (l := l) ..)
|
||||
|
||||
theorem get_mem : ∀ (l : List α) n h, get l ⟨n, h⟩ ∈ l
|
||||
| _ :: _, 0, _ => .head ..
|
||||
@@ -524,7 +533,7 @@ theorem forall_getElem {l : List α} {p : α → Prop} :
|
||||
· simpa
|
||||
· apply w
|
||||
simp only [getElem_cons_succ]
|
||||
exact getElem_mem l n (lt_of_succ_lt_succ h)
|
||||
exact getElem_mem (lt_of_succ_lt_succ h)
|
||||
|
||||
@[simp] theorem decide_mem_cons [BEq α] [LawfulBEq α] {l : List α} :
|
||||
decide (y ∈ a :: l) = (y == a || decide (y ∈ l)) := by
|
||||
@@ -729,6 +738,45 @@ theorem mem_or_eq_of_mem_set : ∀ {l : List α} {n : Nat} {a b : α}, a ∈ l.s
|
||||
|
||||
-- See also `set_eq_take_append_cons_drop` in `Init.Data.List.TakeDrop`.
|
||||
|
||||
/-! ### BEq -/
|
||||
|
||||
@[simp] theorem reflBEq_iff [BEq α] : ReflBEq (List α) ↔ ReflBEq α := by
|
||||
constructor
|
||||
· intro h
|
||||
constructor
|
||||
intro a
|
||||
suffices ([a] == [a]) = true by
|
||||
simpa only [List.instBEq, List.beq, Bool.and_true]
|
||||
simp
|
||||
· intro h
|
||||
constructor
|
||||
intro a
|
||||
induction a with
|
||||
| nil => simp only [List.instBEq, List.beq]
|
||||
| cons a as ih =>
|
||||
simp [List.instBEq, List.beq]
|
||||
exact ih
|
||||
|
||||
@[simp] theorem lawfulBEq_iff [BEq α] : LawfulBEq (List α) ↔ LawfulBEq α := by
|
||||
constructor
|
||||
· intro h
|
||||
constructor
|
||||
· intro a b h
|
||||
apply singleton_inj.1
|
||||
apply eq_of_beq
|
||||
simp only [List.instBEq, List.beq]
|
||||
simpa
|
||||
· intro a
|
||||
suffices ([a] == [a]) = true by
|
||||
simpa only [List.instBEq, List.beq, Bool.and_true]
|
||||
simp
|
||||
· intro h
|
||||
constructor
|
||||
· intro a b h
|
||||
simpa using h
|
||||
· intro a
|
||||
simp
|
||||
|
||||
/-! ### Lexicographic ordering -/
|
||||
|
||||
protected theorem lt_irrefl [LT α] (lt_irrefl : ∀ x : α, ¬x < x) (l : List α) : ¬l < l := by
|
||||
@@ -890,6 +938,38 @@ def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β →
|
||||
x (mem_cons_self x l) :=
|
||||
rfl
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldl_rel {l : List α} {f g : β → α → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f c a) (g c' a)) :
|
||||
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldl_cons]
|
||||
apply ih
|
||||
· simp_all
|
||||
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
/--
|
||||
We can prove that two folds over the same list are related (by some arbitrary relation)
|
||||
if we know that the initial elements are related and the folding function, for each element of the list,
|
||||
preserves the relation.
|
||||
-/
|
||||
theorem foldr_rel {l : List α} {f g : α → β → β} {a b : β} (r : β → β → Prop)
|
||||
(h : r a b) (h' : ∀ (a : α), a ∈ l → ∀ (c c' : β), r c c' → r (f a c) (g a c')) :
|
||||
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
|
||||
induction l generalizing a b with
|
||||
| nil => simp_all
|
||||
| cons a l ih =>
|
||||
simp only [foldr_cons]
|
||||
apply h'
|
||||
· simp
|
||||
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
|
||||
|
||||
/-! ### getLast -/
|
||||
|
||||
theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
|
||||
@@ -929,6 +1009,10 @@ theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
|
||||
| [_], _ => .head ..
|
||||
| _::a::l, _ => .tail _ <| getLast_mem (cons_ne_nil a l)
|
||||
|
||||
theorem getLast_mem_getLast? : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ getLast? l
|
||||
| [], h => by contradiction
|
||||
| a :: l, _ => rfl
|
||||
|
||||
theorem getLastD_mem_cons : ∀ (l : List α) (a : α), getLastD l a ∈ a::l
|
||||
| [], _ => .head ..
|
||||
| _::_, _ => .tail _ <| getLast_mem _
|
||||
@@ -999,6 +1083,11 @@ theorem head?_eq_getElem? : ∀ l : List α, head? l = l[0]?
|
||||
| [] => rfl
|
||||
| a :: l => by simp
|
||||
|
||||
theorem head_eq_getElem (l : List α) (h : l ≠ []) : head l h = l[0]'(length_pos.mpr h) := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons _ _ => simp
|
||||
|
||||
theorem head_eq_iff_head?_eq_some {xs : List α} (h) : xs.head h = a ↔ xs.head? = some a := by
|
||||
cases xs with
|
||||
| nil => simp at h
|
||||
@@ -1026,6 +1115,10 @@ theorem mem_of_mem_head? : ∀ {l : List α} {a : α}, a ∈ l.head? → a ∈ l
|
||||
cases h
|
||||
exact mem_cons_self a l
|
||||
|
||||
theorem head_mem_head? : ∀ {l : List α} (h : l ≠ []), head l h ∈ head? l
|
||||
| [], h => by contradiction
|
||||
| a :: l, _ => rfl
|
||||
|
||||
theorem head?_concat {a : α} : (l ++ [a]).head? = l.head?.getD a := by
|
||||
cases l <;> simp
|
||||
|
||||
@@ -1055,6 +1148,55 @@ theorem tail_eq_tail? (l) : @tail α l = (tail? l).getD [] := by simp [tail_eq_t
|
||||
theorem mem_of_mem_tail {a : α} {l : List α} (h : a ∈ tail l) : a ∈ l := by
|
||||
induction l <;> simp_all
|
||||
|
||||
theorem ne_nil_of_tail_ne_nil {l : List α} : l.tail ≠ [] → l ≠ [] := by
|
||||
cases l <;> simp
|
||||
|
||||
@[simp] theorem getElem_tail (l : List α) (i : Nat) (h : i < l.tail.length) :
|
||||
(tail l)[i] = l[i + 1]'(add_lt_of_lt_sub (by simpa using h)) := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons _ l => simp
|
||||
|
||||
@[simp] theorem getElem?_tail (l : List α) (i : Nat) :
|
||||
(tail l)[i]? = l[i + 1]? := by
|
||||
cases l <;> simp
|
||||
|
||||
@[simp] theorem set_tail (l : List α) (i : Nat) (a : α) :
|
||||
l.tail.set i a = (l.set (i + 1) a).tail := by
|
||||
cases l <;> simp
|
||||
|
||||
theorem one_lt_length_of_tail_ne_nil {l : List α} (h : l.tail ≠ []) : 1 < l.length := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons _ l =>
|
||||
simp only [tail_cons, ne_eq] at h
|
||||
exact Nat.lt_add_of_pos_left (length_pos.mpr h)
|
||||
|
||||
@[simp] theorem head_tail (l : List α) (h : l.tail ≠ []) :
|
||||
(tail l).head h = l[1]'(one_lt_length_of_tail_ne_nil h) := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons _ l => simp [head_eq_getElem]
|
||||
|
||||
@[simp] theorem head?_tail (l : List α) : (tail l).head? = l[1]? := by
|
||||
simp [head?_eq_getElem?]
|
||||
|
||||
@[simp] theorem getLast_tail (l : List α) (h : l.tail ≠ []) :
|
||||
(tail l).getLast h = l.getLast (ne_nil_of_tail_ne_nil h) := by
|
||||
simp only [getLast_eq_getElem, length_tail, getElem_tail]
|
||||
congr
|
||||
match l with
|
||||
| _ :: _ :: l => simp
|
||||
|
||||
theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then none else l.getLast? := by
|
||||
match l with
|
||||
| [] => simp
|
||||
| [a] => simp
|
||||
| _ :: _ :: l =>
|
||||
simp only [tail_cons, length_cons, getLast?_cons_cons]
|
||||
rw [if_neg]
|
||||
rintro ⟨⟩
|
||||
|
||||
/-! ## Basic operations -/
|
||||
|
||||
/-! ### map -/
|
||||
@@ -1172,11 +1314,16 @@ theorem map_eq_iff : map f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map f := by
|
||||
theorem map_eq_foldr (f : α → β) (l : List α) : map f l = foldr (fun a bs => f a :: bs) [] l := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
|
||||
(map f l).set n (f a) = map f (l.set n a) := by
|
||||
induction l generalizing n with
|
||||
@[simp] theorem map_set {f : α → β} {l : List α} {i : Nat} {a : α} :
|
||||
(l.set i a).map f = (l.map f).set i (f a) := by
|
||||
induction l generalizing i with
|
||||
| nil => simp
|
||||
| cons b l ih => cases n <;> simp_all
|
||||
| cons b l ih => cases i <;> simp_all
|
||||
|
||||
@[deprecated "Use the reverse direction of `map_set`." (since := "2024-09-20")]
|
||||
theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
|
||||
(map f l).set n (f a) = map f (l.set n a) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem head_map (f : α → β) (l : List α) (w) :
|
||||
head (map f l) w = f (head l (by simpa using w)) := by
|
||||
@@ -1507,10 +1654,16 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
theorem getElem_append : ∀ {l₁ l₂ : List α} (n : Nat) (h : n < l₁.length),
|
||||
(l₁ ++ l₂)[n]'(length_append .. ▸ Nat.lt_add_right _ h) = l₁[n]
|
||||
| a :: l, _, 0, h => rfl
|
||||
| a :: l, _, n+1, h => by simp only [get, cons_append]; apply getElem_append
|
||||
@[simp] theorem nil_append_fun : (([] : List α) ++ ·) = id := rfl
|
||||
|
||||
@[simp] theorem cons_append_fun (a : α) (as : List α) :
|
||||
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
|
||||
|
||||
theorem getElem_append {l₁ l₂ : List α} (n : Nat) (h) :
|
||||
(l₁ ++ l₂)[n] = if h' : n < l₁.length then l₁[n] else l₂[n - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
|
||||
split <;> rename_i h'
|
||||
· rw [getElem_append_left h']
|
||||
· rw [getElem_append_right (by simpa using h')]
|
||||
|
||||
theorem getElem?_append_left {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
|
||||
(l₁ ++ l₂)[n]? = l₁[n]? := by
|
||||
@@ -1536,12 +1689,13 @@ theorem get?_append_right {l₁ l₂ : List α} {n : Nat} (h : l₁.length ≤ n
|
||||
(l₁ ++ l₂).get? n = l₂.get? (n - l₁.length) := by
|
||||
simp [getElem?_append_right, h]
|
||||
|
||||
theorem getElem_append_right' {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length ≤ n) (h₂) :
|
||||
(l₁ ++ l₂)[n]'h₂ =
|
||||
l₂[n - l₁.length]'(by rw [length_append] at h₂; exact Nat.sub_lt_left_of_lt_add h₁ h₂) :=
|
||||
Option.some.inj <| by rw [← getElem?_eq_getElem, ← getElem?_eq_getElem, getElem?_append_right h₁]
|
||||
/-- Variant of `getElem_append_left` useful for rewriting from the small list to the big list. -/
|
||||
theorem getElem_append_left' (l₂ : List α) {l₁ : List α} {n : Nat} (hn : n < l₁.length) :
|
||||
l₁[n] = (l₁ ++ l₂)[n]'(by simpa using Nat.lt_add_right l₂.length hn) := by
|
||||
rw [getElem_append_left] <;> simp
|
||||
|
||||
theorem getElem_append_right'' (l₁ : List α) {l₂ : List α} {n : Nat} (hn : n < l₂.length) :
|
||||
/-- Variant of `getElem_append_right` useful for rewriting from the small list to the big list. -/
|
||||
theorem getElem_append_right' (l₁ : List α) {l₂ : List α} {n : Nat} (hn : n < l₂.length) :
|
||||
l₂[n] = (l₁ ++ l₂)[n + l₁.length]'(by simpa [Nat.add_comm] using Nat.add_lt_add_left hn _) := by
|
||||
rw [getElem_append_right] <;> simp [*, le_add_left]
|
||||
|
||||
@@ -1552,7 +1706,7 @@ theorem get_append_right_aux {l₁ l₂ : List α} {n : Nat}
|
||||
exact Nat.sub_lt_left_of_lt_add h₁ h₂
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem_append_right' (since := "2024-06-12")]
|
||||
@[deprecated getElem_append_right (since := "2024-06-12")]
|
||||
theorem get_append_right' {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length ≤ n) (h₂) :
|
||||
(l₁ ++ l₂).get ⟨n, h₂⟩ = l₂.get ⟨n - l₁.length, get_append_right_aux h₁ h₂⟩ :=
|
||||
Option.some.inj <| by rw [← get?_eq_get, ← get?_eq_get, get?_append_right h₁]
|
||||
@@ -1644,7 +1798,7 @@ theorem get_append_left (as bs : List α) (h : i < as.length) {h'} :
|
||||
simp [getElem_append_left, h, h']
|
||||
|
||||
@[deprecated getElem_append_right (since := "2024-06-12")]
|
||||
theorem get_append_right (as bs : List α) (h : ¬ i < as.length) {h' h''} :
|
||||
theorem get_append_right (as bs : List α) (h : as.length ≤ i) {h' h''} :
|
||||
(as ++ bs).get ⟨i, h'⟩ = bs.get ⟨i - as.length, h''⟩ := by
|
||||
simp [getElem_append_right, h, h', h'']
|
||||
|
||||
@@ -1840,7 +1994,7 @@ theorem map_eq_append_iff {f : α → β} :
|
||||
map f l = L₁ ++ L₂ ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
|
||||
rw [← filterMap_eq_map, filterMap_eq_append_iff]
|
||||
|
||||
theorem append_eq_map_iff (f : α → β) :
|
||||
theorem append_eq_map_iff {f : α → β} :
|
||||
L₁ ++ L₂ = map f l ↔ ∃ l₁ l₂, l = l₁ ++ l₂ ∧ map f l₁ = L₁ ∧ map f l₂ = L₂ := by
|
||||
rw [eq_comm, map_eq_append_iff]
|
||||
|
||||
@@ -2243,6 +2397,12 @@ theorem map_eq_replicate_iff {l : List α} {f : α → β} {b : β} :
|
||||
theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.length b :=
|
||||
map_const l b
|
||||
|
||||
@[simp] theorem set_replicate_self : (replicate n a).set i a = replicate n a := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
simp [getElem_set]
|
||||
|
||||
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
|
||||
rw [eq_replicate_iff]
|
||||
constructor
|
||||
@@ -2323,6 +2483,47 @@ theorem bind_replicate {β} (f : α → List β) : (replicate n a).bind f = (rep
|
||||
@[simp] theorem isEmpty_replicate : (replicate n a).isEmpty = decide (n = 0) := by
|
||||
cases n <;> simp [replicate_succ]
|
||||
|
||||
/-- Every list is either empty, a non-empty `replicate`, or begins with a non-empty `replicate`
|
||||
followed by a different element. -/
|
||||
theorem eq_replicate_or_eq_replicate_append_cons {α : Type _} (l : List α) :
|
||||
(l = []) ∨ (∃ n a, l = replicate n a ∧ 0 < n) ∨
|
||||
(∃ n a b l', l = replicate n a ++ b :: l' ∧ 0 < n ∧ a ≠ b) := by
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons x l ih =>
|
||||
right
|
||||
rcases ih with rfl | ⟨n, a, rfl, h⟩ | ⟨n, a, b, l', rfl, h⟩
|
||||
· left
|
||||
exact ⟨1, x, rfl, by decide⟩
|
||||
· by_cases h' : x = a
|
||||
· subst h'
|
||||
left
|
||||
exact ⟨n + 1, x, rfl, by simp⟩
|
||||
· right
|
||||
refine ⟨1, x, a, replicate (n - 1) a, ?_, by decide, h'⟩
|
||||
match n with | n + 1 => simp [replicate_succ]
|
||||
· right
|
||||
by_cases h' : x = a
|
||||
· subst h'
|
||||
refine ⟨n + 1, x, b, l', by simp [replicate_succ], by simp, h.2⟩
|
||||
· refine ⟨1, x, a, replicate (n - 1) a ++ b :: l', ?_, by decide, h'⟩
|
||||
match n with | n + 1 => simp [replicate_succ]
|
||||
|
||||
/-- An induction principle for lists based on contiguous runs of identical elements. -/
|
||||
-- A `Sort _` valued version would require a different design. (And associated `@[simp]` lemmas.)
|
||||
theorem replicateRecOn {α : Type _} {p : List α → Prop} (m : List α)
|
||||
(h0 : p []) (hr : ∀ a n, 0 < n → p (replicate n a))
|
||||
(hi : ∀ a b n l, a ≠ b → 0 < n → p (b :: l) → p (replicate n a ++ b :: l)) : p m := by
|
||||
rcases eq_replicate_or_eq_replicate_append_cons m with
|
||||
rfl | ⟨n, a, rfl, hn⟩ | ⟨n, a, b, l', w, hn, h⟩
|
||||
· exact h0
|
||||
· exact hr _ _ hn
|
||||
· have : (b :: l').length < m.length := by
|
||||
simpa [w] using Nat.lt_add_of_pos_left hn
|
||||
subst w
|
||||
exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
|
||||
termination_by m.length
|
||||
|
||||
/-! ### reverse -/
|
||||
|
||||
@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
|
||||
@@ -2754,6 +2955,12 @@ theorem dropLast_append_cons : dropLast (l₁ ++ b :: l₂) = l₁ ++ dropLast (
|
||||
dropLast (a :: replicate n a) = replicate n a := by
|
||||
rw [← replicate_succ, dropLast_replicate, Nat.add_sub_cancel]
|
||||
|
||||
@[simp] theorem tail_reverse (l : List α) : l.reverse.tail = l.dropLast.reverse := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
simp [Nat.add_comm i, Nat.sub_add_eq]
|
||||
|
||||
/-!
|
||||
### splitAt
|
||||
|
||||
|
||||
@@ -51,6 +51,27 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
|
||||
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} :
|
||||
(l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*]
|
||||
|
||||
/-- Auxiliary lemma for `mapM_eq_reverse_foldlM_cons`. -/
|
||||
theorem foldlM_cons_eq_append [Monad m] [LawfulMonad m] (f : α → m β) (as : List α) (b : β) (bs : List β) :
|
||||
(as.foldlM (init := b :: bs) fun acc a => return ((← f a) :: acc)) =
|
||||
(· ++ b :: bs) <$> as.foldlM (init := []) fun acc a => return ((← f a) :: acc) := by
|
||||
induction as generalizing b bs with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [bind_pure_comp] at ih
|
||||
simp [ih, _root_.map_bind, Functor.map_map, Function.comp_def]
|
||||
|
||||
theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) :
|
||||
mapM f l = reverse <$> (l.foldlM (fun acc a => return ((← f a) :: acc)) []) := by
|
||||
rw [← mapM'_eq_mapM]
|
||||
induction l with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [mapM'_cons, ih, bind_map_left, foldlM_cons, LawfulMonad.bind_assoc, pure_bind,
|
||||
foldlM_cons_eq_append, _root_.map_bind, Functor.map_map, Function.comp_def, reverse_append,
|
||||
reverse_cons, reverse_nil, nil_append, singleton_append]
|
||||
simp [bind_pure_comp]
|
||||
|
||||
/-! ### forM -/
|
||||
|
||||
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
|
||||
@@ -66,4 +87,16 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
|
||||
(l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
|
||||
induction l₁ <;> simp [*]
|
||||
|
||||
/-! ### allM -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : List α) :
|
||||
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
|
||||
induction as with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [allM, anyM, bind_map_left, _root_.map_bind]
|
||||
congr
|
||||
funext b
|
||||
split <;> simp_all
|
||||
|
||||
end List
|
||||
|
||||
@@ -10,3 +10,5 @@ import Init.Data.List.Nat.Range
|
||||
import Init.Data.List.Nat.Sublist
|
||||
import Init.Data.List.Nat.TakeDrop
|
||||
import Init.Data.List.Nat.Count
|
||||
import Init.Data.List.Nat.Erase
|
||||
import Init.Data.List.Nat.Find
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Count
|
||||
import Init.Data.List.Find
|
||||
import Init.Data.List.MinMax
|
||||
import Init.Data.Nat.Lemmas
|
||||
|
||||
@@ -18,6 +19,26 @@ open Nat
|
||||
|
||||
namespace List
|
||||
|
||||
/-! ### dropLast -/
|
||||
|
||||
theorem tail_dropLast (l : List α) : tail (dropLast l) = dropLast (tail l) := by
|
||||
ext1
|
||||
simp only [getElem?_tail, getElem?_dropLast, length_tail]
|
||||
split <;> split
|
||||
· rfl
|
||||
· omega
|
||||
· omega
|
||||
· rfl
|
||||
|
||||
@[simp] theorem dropLast_reverse (l : List α) : l.reverse.dropLast = l.tail.reverse := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
simp only [getElem_dropLast, getElem_reverse, length_tail, getElem_tail]
|
||||
congr
|
||||
simp only [length_dropLast, length_reverse, length_tail] at h₁ h₂
|
||||
omega
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
theorem length_filter_lt_length_iff_exists {l} :
|
||||
@@ -37,7 +58,8 @@ theorem getElem_eq_getElem_reverse {l : List α} {i} (h : i < l.length) :
|
||||
|
||||
/-- The length of the List returned by `List.leftpad n a l` is equal
|
||||
to the larger of `n` and `l.length` -/
|
||||
@[simp]
|
||||
-- We don't mark this as a `@[simp]` lemma since we allow `simp` to unfold `leftpad`,
|
||||
-- so the left hand side simplifies directly to `n - l.length + l.length`.
|
||||
theorem leftpad_length (n : Nat) (a : α) (l : List α) :
|
||||
(leftpad n a l).length = max n l.length := by
|
||||
simp only [leftpad, length_append, length_replicate, Nat.sub_add_eq_max]
|
||||
@@ -97,6 +119,53 @@ theorem minimum?_cons' {a : Nat} {l : List Nat} :
|
||||
specialize le b h
|
||||
split <;> omega
|
||||
|
||||
theorem foldl_min
|
||||
{α : Type _} [Min α] [Std.IdempotentOp (min : α → α → α)] [Std.Associative (min : α → α → α)]
|
||||
{l : List α} {a : α} :
|
||||
l.foldl (init := a) min = min a (l.minimum?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [minimum?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
|
||||
theorem foldl_min_right {α β : Type _}
|
||||
[Min β] [Std.IdempotentOp (min : β → β → β)] [Std.Associative (min : β → β → β)]
|
||||
{l : List α} {b : β} {f : α → β} :
|
||||
(l.foldl (init := b) fun acc a => min acc (f a)) = min b ((l.map f).minimum?.getD b) := by
|
||||
rw [← foldl_map, foldl_min]
|
||||
|
||||
theorem foldl_min_le {l : List Nat} {a : Nat} : l.foldl (init := a) min ≤ a := by
|
||||
induction l generalizing a with
|
||||
| nil => simp
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
exact Nat.le_trans ih (Nat.min_le_left _ _)
|
||||
|
||||
theorem foldl_min_min_of_le {l : List Nat} {a b : Nat} (h : a ≤ b) :
|
||||
l.foldl (init := a) min ≤ b :=
|
||||
Nat.le_trans (foldl_min_le) h
|
||||
|
||||
theorem minimum?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
l.minimum?.getD k ≤ a := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [minimum?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact foldl_min_le
|
||||
· induction l generalizing b with
|
||||
| nil => simp_all
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact foldl_min_min_of_le (Nat.min_le_right _ _)
|
||||
· exact ih _ h
|
||||
|
||||
/-! ### maximum? -/
|
||||
|
||||
-- A specialization of `maximum?_eq_some_iff` to Nat.
|
||||
@@ -130,4 +199,51 @@ theorem maximum?_cons' {a : Nat} {l : List Nat} :
|
||||
specialize le b h
|
||||
split <;> omega
|
||||
|
||||
theorem foldl_max
|
||||
{α : Type _} [Max α] [Std.IdempotentOp (max : α → α → α)] [Std.Associative (max : α → α → α)]
|
||||
{l : List α} {a : α} :
|
||||
l.foldl (init := a) max = max a (l.maximum?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [maximum?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
|
||||
theorem foldl_max_right {α β : Type _}
|
||||
[Max β] [Std.IdempotentOp (max : β → β → β)] [Std.Associative (max : β → β → β)]
|
||||
{l : List α} {b : β} {f : α → β} :
|
||||
(l.foldl (init := b) fun acc a => max acc (f a)) = max b ((l.map f).maximum?.getD b) := by
|
||||
rw [← foldl_map, foldl_max]
|
||||
|
||||
theorem le_foldl_max {l : List Nat} {a : Nat} : a ≤ l.foldl (init := a) max := by
|
||||
induction l generalizing a with
|
||||
| nil => simp
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
exact Nat.le_trans (Nat.le_max_left _ _) ih
|
||||
|
||||
theorem le_foldl_max_of_le {l : List Nat} {a b : Nat} (h : a ≤ b) :
|
||||
a ≤ l.foldl (init := b) max :=
|
||||
Nat.le_trans h (le_foldl_max)
|
||||
|
||||
theorem le_maximum?_getD_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
a ≤ l.maximum?.getD k := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [maximum?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact le_foldl_max
|
||||
· induction l generalizing b with
|
||||
| nil => simp_all
|
||||
| cons c l ih =>
|
||||
simp only [foldl_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact le_foldl_max_of_le (Nat.le_max_right b a)
|
||||
· exact ih _ h
|
||||
|
||||
end List
|
||||
|
||||
@@ -28,4 +28,59 @@ theorem count_set [BEq α] (a b : α) (l : List α) (i : Nat) (h : i < l.length)
|
||||
(l.set i a).count b = l.count b - (if l[i] == b then 1 else 0) + (if a == b then 1 else 0) := by
|
||||
simp [count_eq_countP, countP_set, h]
|
||||
|
||||
/--
|
||||
The number of elements satisfying a predicate in a sublist is at least the number of elements satisfying the predicate in the list,
|
||||
minus the difference in the lengths.
|
||||
-/
|
||||
theorem Sublist.le_countP (s : l₁ <+ l₂) (p) : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁ := by
|
||||
match s with
|
||||
| .slnil => simp
|
||||
| .cons a s =>
|
||||
rename_i l
|
||||
simp only [countP_cons, length_cons]
|
||||
have := s.le_countP p
|
||||
have := s.length_le
|
||||
split <;> omega
|
||||
| .cons₂ a s =>
|
||||
rename_i l₁ l₂
|
||||
simp only [countP_cons, length_cons]
|
||||
have := s.le_countP p
|
||||
have := s.length_le
|
||||
split <;> omega
|
||||
|
||||
theorem IsPrefix.le_countP (s : l₁ <+: l₂) : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁ :=
|
||||
s.sublist.le_countP _
|
||||
|
||||
theorem IsSuffix.le_countP (s : l₁ <:+ l₂) : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁ :=
|
||||
s.sublist.le_countP _
|
||||
|
||||
theorem IsInfix.le_countP (s : l₁ <:+: l₂) : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁ :=
|
||||
s.sublist.le_countP _
|
||||
|
||||
/--
|
||||
The number of elements satisfying a predicate in the tail of a list is
|
||||
at least one less than the number of elements satisfying the predicate in the list.
|
||||
-/
|
||||
theorem le_countP_tail (l) : countP p l - 1 ≤ countP p l.tail := by
|
||||
have := (tail_sublist l).le_countP p
|
||||
simp only [length_tail] at this
|
||||
omega
|
||||
|
||||
variable [BEq α]
|
||||
|
||||
theorem Sublist.le_count (s : l₁ <+ l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) ≤ count a l₁ :=
|
||||
s.le_countP _
|
||||
|
||||
theorem IsPrefix.le_count (s : l₁ <+: l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) ≤ count a l₁ :=
|
||||
s.sublist.le_count _
|
||||
|
||||
theorem IsSuffix.le_count (s : l₁ <:+ l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) ≤ count a l₁ :=
|
||||
s.sublist.le_count _
|
||||
|
||||
theorem IsInfix.le_count (s : l₁ <:+: l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) ≤ count a l₁ :=
|
||||
s.sublist.le_count _
|
||||
|
||||
theorem le_count_tail (a : α) (l) : count a l - 1 ≤ count a l.tail :=
|
||||
le_countP_tail _
|
||||
|
||||
end List
|
||||
|
||||
66
src/Init/Data/List/Nat/Erase.lean
Normal file
66
src/Init/Data/List/Nat/Erase.lean
Normal file
@@ -0,0 +1,66 @@
|
||||
/-
|
||||
Copyright (c) 2024 Kim Morrison. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Nat.TakeDrop
|
||||
import Init.Data.List.Erase
|
||||
|
||||
namespace List
|
||||
|
||||
theorem getElem?_eraseIdx (l : List α) (i : Nat) (j : Nat) :
|
||||
(l.eraseIdx i)[j]? = if h : j < i then l[j]? else l[j + 1]? := by
|
||||
rw [eraseIdx_eq_take_drop_succ, getElem?_append]
|
||||
split <;> rename_i h
|
||||
· rw [getElem?_take]
|
||||
split
|
||||
· rfl
|
||||
· simp_all
|
||||
omega
|
||||
· rw [getElem?_drop]
|
||||
split <;> rename_i h'
|
||||
· simp only [length_take, Nat.min_def, Nat.not_lt] at h
|
||||
split at h
|
||||
· omega
|
||||
· simp_all [getElem?_eq_none]
|
||||
omega
|
||||
· simp only [length_take]
|
||||
simp only [length_take, Nat.min_def, Nat.not_lt] at h
|
||||
split at h
|
||||
· congr 1
|
||||
omega
|
||||
· rw [getElem?_eq_none, getElem?_eq_none] <;> omega
|
||||
|
||||
theorem getElem?_eraseIdx_of_lt (l : List α) (i : Nat) (j : Nat) (h : j < i) :
|
||||
(l.eraseIdx i)[j]? = l[j]? := by
|
||||
rw [getElem?_eraseIdx]
|
||||
simp [h]
|
||||
|
||||
theorem getElem?_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : i ≤ j) :
|
||||
(l.eraseIdx i)[j]? = l[j + 1]? := by
|
||||
rw [getElem?_eraseIdx]
|
||||
simp only [dite_eq_ite, ite_eq_right_iff]
|
||||
intro h'
|
||||
omega
|
||||
|
||||
theorem getElem_eraseIdx (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) :
|
||||
(l.eraseIdx i)[j] = if h' : j < i then
|
||||
l[j]'(by have := length_eraseIdx_le l i; omega)
|
||||
else
|
||||
l[j + 1]'(by rw [length_eraseIdx] at h; split at h <;> omega) := by
|
||||
apply Option.some.inj
|
||||
rw [← getElem?_eq_getElem, getElem?_eraseIdx]
|
||||
split <;> simp
|
||||
|
||||
theorem getElem_eraseIdx_of_lt (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) (h' : j < i) :
|
||||
(l.eraseIdx i)[j] = l[j]'(by have := length_eraseIdx_le l i; omega) := by
|
||||
rw [getElem_eraseIdx]
|
||||
simp only [dite_eq_left_iff, Nat.not_lt]
|
||||
intro h'
|
||||
omega
|
||||
|
||||
theorem getElem_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) (h' : i ≤ j) :
|
||||
(l.eraseIdx i)[j] = l[j + 1]'(by rw [length_eraseIdx] at h; split at h <;> omega) := by
|
||||
rw [getElem_eraseIdx, dif_neg]
|
||||
omega
|
||||
32
src/Init/Data/List/Nat/Find.lean
Normal file
32
src/Init/Data/List/Nat/Find.lean
Normal file
@@ -0,0 +1,32 @@
|
||||
/-
|
||||
Copyright (c) 2024 Kim Morrison. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Nat.Range
|
||||
import Init.Data.List.Find
|
||||
|
||||
namespace List
|
||||
|
||||
theorem findIdx?_eq_some_le_of_findIdx?_eq_some {xs : List α} {p q : α → Bool} (w : ∀ x ∈ xs, p x → q x) {i : Nat}
|
||||
(h : xs.findIdx? p = some i) : ∃ j, j ≤ i ∧ xs.findIdx? q = some j := by
|
||||
simp only [findIdx?_eq_findSome?_enum] at h
|
||||
rw [findSome?_eq_some_iff] at h
|
||||
simp only [Option.ite_none_right_eq_some, Option.some.injEq, ite_eq_right_iff, reduceCtorEq,
|
||||
imp_false, Bool.not_eq_true, Prod.forall, exists_and_right, Prod.exists] at h
|
||||
obtain ⟨h, h₁, b, ⟨es, h₂⟩, ⟨hb, rfl⟩, h₃⟩ := h
|
||||
rw [enum_eq_enumFrom, enumFrom_eq_append_iff] at h₂
|
||||
obtain ⟨l₁', l₂', rfl, rfl, h₂⟩ := h₂
|
||||
rw [eq_comm, enumFrom_eq_cons_iff] at h₂
|
||||
obtain ⟨a, as, rfl, h₂, rfl⟩ := h₂
|
||||
simp only [Nat.zero_add, Prod.mk.injEq] at h₂
|
||||
obtain ⟨rfl, rfl⟩ := h₂
|
||||
simp only [findIdx?_append]
|
||||
match h : findIdx? q l₁' with
|
||||
| some j =>
|
||||
refine ⟨j, ?_, by simp⟩
|
||||
rw [findIdx?_eq_some_iff_findIdx_eq] at h
|
||||
omega
|
||||
| none =>
|
||||
refine ⟨l₁'.length, by simp, by simp_all⟩
|
||||
@@ -109,7 +109,8 @@ theorem range'_eq_append_iff : range' s n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs =
|
||||
@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat → Bool} :
|
||||
(range' s n).find? p = some i ↔ p i ∧ i ∈ range' s n ∧ ∀ j, s ≤ j → j < i → !p j := by
|
||||
rw [find?_eq_some]
|
||||
simp only [Bool.not_eq_true', exists_and_right, mem_range'_1, and_congr_right_iff]
|
||||
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, mem_range'_1,
|
||||
and_congr_right_iff]
|
||||
simp only [range'_eq_append_iff, eq_comm (a := i :: _), range'_eq_cons_iff]
|
||||
intro h
|
||||
constructor
|
||||
@@ -176,7 +177,7 @@ theorem pairwise_le_range (n : Nat) : Pairwise (· ≤ ·) (range n) :=
|
||||
theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
|
||||
apply List.ext_getElem
|
||||
· simp
|
||||
· simp (config := { contextual := true }) [← getElem_take, Nat.lt_min]
|
||||
· simp (config := { contextual := true }) [getElem_take, Nat.lt_min]
|
||||
|
||||
theorem nodup_range (n : Nat) : Nodup (range n) := by
|
||||
simp (config := {decide := true}) only [range_eq_range', nodup_range']
|
||||
@@ -258,6 +259,9 @@ theorem nodup_iota (n : Nat) : Nodup (iota n) :=
|
||||
| zero => simp at h
|
||||
| succ n => simp
|
||||
|
||||
@[simp] theorem tail_iota (n : Nat) : (iota n).tail = iota (n - 1) := by
|
||||
cases n <;> simp
|
||||
|
||||
@[simp] theorem reverse_iota : reverse (iota n) = range' 1 n := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
@@ -272,15 +276,15 @@ theorem nodup_iota (n : Nat) : Nodup (iota n) :=
|
||||
rw [getLast_eq_head_reverse]
|
||||
simp
|
||||
|
||||
theorem find?_iota_eq_none {n : Nat} (p : Nat → Bool) :
|
||||
theorem find?_iota_eq_none {n : Nat} {p : Nat → Bool} :
|
||||
(iota n).find? p = none ↔ ∀ i, 0 < i → i ≤ n → !p i := by
|
||||
simp
|
||||
|
||||
@[simp] theorem find?_iota_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
|
||||
(iota n).find? p = some i ↔ p i ∧ i ∈ iota n ∧ ∀ j, i < j → j ≤ n → !p j := by
|
||||
rw [find?_eq_some]
|
||||
simp only [iota_eq_reverse_range', reverse_eq_append_iff, reverse_cons, append_assoc,
|
||||
singleton_append, Bool.not_eq_true', exists_and_right, mem_reverse, mem_range'_1,
|
||||
simp only [iota_eq_reverse_range', reverse_eq_append_iff, reverse_cons, append_assoc, cons_append,
|
||||
nil_append, Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, mem_reverse, mem_range'_1,
|
||||
and_congr_right_iff]
|
||||
intro h
|
||||
constructor
|
||||
@@ -354,17 +358,6 @@ theorem map_enumFrom (f : α → β) (n : Nat) (l : List α) :
|
||||
map (Prod.map id f) (enumFrom n l) = enumFrom n (map f l) := by
|
||||
induction l generalizing n <;> simp_all
|
||||
|
||||
@[simp]
|
||||
theorem enumFrom_map_fst (n) :
|
||||
∀ (l : List α), map Prod.fst (enumFrom n l) = range' n l.length
|
||||
| [] => rfl
|
||||
| _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _)
|
||||
|
||||
@[simp]
|
||||
theorem enumFrom_map_snd : ∀ (n) (l : List α), map Prod.snd (enumFrom n l) = l
|
||||
| _, [] => rfl
|
||||
| _, _ :: _ => congrArg (cons _) (enumFrom_map_snd _ _)
|
||||
|
||||
theorem snd_mem_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x ∈ enumFrom n l) : x.2 ∈ l :=
|
||||
enumFrom_map_snd n l ▸ mem_map_of_mem _ h
|
||||
|
||||
@@ -387,10 +380,6 @@ theorem mem_enumFrom {x : α} {i j : Nat} {xs : List α} (h : (i, x) ∈ xs.enum
|
||||
x = xs[i - j]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) :=
|
||||
⟨le_fst_of_mem_enumFrom h, fst_lt_add_of_mem_enumFrom h, snd_eq_of_mem_enumFrom h⟩
|
||||
|
||||
theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
|
||||
enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
|
||||
rw [enumFrom_cons, Nat.add_comm, ← map_fst_add_enumFrom_eq_enumFrom]
|
||||
|
||||
theorem enumFrom_map (n : Nat) (l : List α) (f : α → β) :
|
||||
enumFrom n (l.map f) = (enumFrom n l).map (Prod.map id f) := by
|
||||
induction l with
|
||||
@@ -407,22 +396,39 @@ theorem enumFrom_append (xs ys : List α) (n : Nat) :
|
||||
rw [cons_append, enumFrom_cons, IH, ← cons_append, ← enumFrom_cons, length, Nat.add_right_comm,
|
||||
Nat.add_assoc]
|
||||
|
||||
theorem enumFrom_eq_zip_range' (l : List α) {n : Nat} : l.enumFrom n = (range' n l.length).zip l :=
|
||||
zip_of_prod (enumFrom_map_fst _ _) (enumFrom_map_snd _ _)
|
||||
theorem enumFrom_eq_cons_iff {l : List α} {n : Nat} :
|
||||
l.enumFrom n = x :: l' ↔ ∃ a as, l = a :: as ∧ x = (n, a) ∧ l' = enumFrom (n + 1) as := by
|
||||
rw [enumFrom_eq_zip_range', zip_eq_cons_iff]
|
||||
constructor
|
||||
· rintro ⟨l₁, l₂, h, rfl, rfl⟩
|
||||
rw [range'_eq_cons_iff] at h
|
||||
obtain ⟨rfl, -, rfl⟩ := h
|
||||
exact ⟨x.2, l₂, by simp [enumFrom_eq_zip_range']⟩
|
||||
· rintro ⟨a, as, rfl, rfl, rfl⟩
|
||||
refine ⟨range' (n+1) as.length, as, ?_⟩
|
||||
simp [enumFrom_eq_zip_range', range'_succ]
|
||||
|
||||
@[simp]
|
||||
theorem unzip_enumFrom_eq_prod (l : List α) {n : Nat} :
|
||||
(l.enumFrom n).unzip = (range' n l.length, l) := by
|
||||
simp only [enumFrom_eq_zip_range', unzip_zip, length_range']
|
||||
theorem enumFrom_eq_append_iff {l : List α} {n : Nat} :
|
||||
l.enumFrom n = l₁ ++ l₂ ↔
|
||||
∃ l₁' l₂', l = l₁' ++ l₂' ∧ l₁ = l₁'.enumFrom n ∧ l₂ = l₂'.enumFrom (n + l₁'.length) := by
|
||||
rw [enumFrom_eq_zip_range', zip_eq_append_iff]
|
||||
constructor
|
||||
· rintro ⟨w, x, y, z, h, h', rfl, rfl, rfl⟩
|
||||
rw [range'_eq_append_iff] at h'
|
||||
obtain ⟨k, -, rfl, rfl⟩ := h'
|
||||
simp only [length_range'] at h
|
||||
obtain rfl := h
|
||||
refine ⟨y, z, rfl, ?_⟩
|
||||
simp only [enumFrom_eq_zip_range', length_append, true_and]
|
||||
congr
|
||||
omega
|
||||
· rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
|
||||
simp only [enumFrom_eq_zip_range']
|
||||
refine ⟨range' n l₁'.length, range' (n + l₁'.length) l₂'.length, l₁', l₂', ?_⟩
|
||||
simp [Nat.add_comm]
|
||||
|
||||
/-! ### enum -/
|
||||
|
||||
theorem enum_cons : (a::as).enum = (0, a) :: as.enumFrom 1 := rfl
|
||||
|
||||
theorem enum_cons' (x : α) (xs : List α) :
|
||||
enum (x :: xs) = (0, x) :: (enum xs).map (Prod.map (· + 1) id) :=
|
||||
enumFrom_cons' _ _ _
|
||||
|
||||
@[simp]
|
||||
theorem enum_eq_nil {l : List α} : List.enum l = [] ↔ l = [] := enumFrom_eq_nil
|
||||
|
||||
@@ -448,6 +454,9 @@ theorem getElem_enum (l : List α) (i : Nat) (h : i < l.enum.length) :
|
||||
l.enum.getLast? = l.getLast?.map fun a => (l.length - 1, a) := by
|
||||
simp [getLast?_eq_getElem?]
|
||||
|
||||
@[simp] theorem tail_enum (l : List α) : (enum l).tail = enumFrom 1 l.tail := by
|
||||
simp [enum]
|
||||
|
||||
theorem mk_mem_enum_iff_getElem? {i : Nat} {x : α} {l : List α} : (i, x) ∈ enum l ↔ l[i]? = x := by
|
||||
simp [enum, mk_mem_enumFrom_iff_le_and_getElem?_sub]
|
||||
|
||||
|
||||
@@ -36,23 +36,23 @@ theorem length_take_of_le (h : n ≤ length l) : length (take n l) = n := by sim
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the big list to the small list. -/
|
||||
theorem getElem_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
|
||||
theorem getElem_take' (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
|
||||
L[i] = (L.take j)[i]'(length_take .. ▸ Nat.lt_min.mpr ⟨hj, hi⟩) :=
|
||||
getElem_of_eq (take_append_drop j L).symm _ ▸ getElem_append ..
|
||||
getElem_of_eq (take_append_drop j L).symm _ ▸ getElem_append_left ..
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the small list to the big list. -/
|
||||
theorem getElem_take' (L : List α) {j i : Nat} {h : i < (L.take j).length} :
|
||||
theorem getElem_take (L : List α) {j i : Nat} {h : i < (L.take j).length} :
|
||||
(L.take j)[i] =
|
||||
L[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
|
||||
rw [length_take, Nat.lt_min] at h; rw [getElem_take L _ h.1]
|
||||
rw [length_take, Nat.lt_min] at h; rw [getElem_take' L _ h.1]
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the big list to the small list. -/
|
||||
@[deprecated getElem_take (since := "2024-06-12")]
|
||||
@[deprecated getElem_take' (since := "2024-06-12")]
|
||||
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
|
||||
get L ⟨i, hi⟩ = get (L.take j) ⟨i, length_take .. ▸ Nat.lt_min.mpr ⟨hj, hi⟩⟩ := by
|
||||
simp [getElem_take _ hi hj]
|
||||
simp [getElem_take' _ hi hj]
|
||||
|
||||
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
|
||||
length `> i`. Version designed to rewrite from the small list to the big list. -/
|
||||
@@ -60,7 +60,7 @@ length `> i`. Version designed to rewrite from the small list to the big list. -
|
||||
theorem get_take' (L : List α) {j i} :
|
||||
get (L.take j) i =
|
||||
get L ⟨i.1, Nat.lt_of_lt_of_le i.2 (length_take_le' _ _)⟩ := by
|
||||
simp [getElem_take']
|
||||
simp [getElem_take]
|
||||
|
||||
theorem getElem?_take_eq_none {l : List α} {n m : Nat} (h : n ≤ m) :
|
||||
(l.take n)[m]? = none :=
|
||||
@@ -110,7 +110,7 @@ theorem getLast?_take {l : List α} : (l.take n).getLast? = if n = 0 then none e
|
||||
|
||||
theorem getLast_take {l : List α} (h : l.take n ≠ []) :
|
||||
(l.take n).getLast h = l[n - 1]?.getD (l.getLast (by simp_all)) := by
|
||||
rw [getLast_eq_getElem, getElem_take']
|
||||
rw [getLast_eq_getElem, getElem_take]
|
||||
simp [length_take, Nat.min_def]
|
||||
simp at h
|
||||
split
|
||||
@@ -196,7 +196,7 @@ theorem dropLast_take {n : Nat} {l : List α} (h : n < l.length) :
|
||||
theorem take_prefix_take_left (l : List α) {m n : Nat} (h : m ≤ n) : take m l <+: take n l := by
|
||||
rw [isPrefix_iff]
|
||||
intro i w
|
||||
rw [getElem?_take_of_lt, getElem_take', getElem?_eq_getElem]
|
||||
rw [getElem?_take_of_lt, getElem_take, getElem?_eq_getElem]
|
||||
simp only [length_take] at w
|
||||
exact Nat.lt_of_lt_of_le (Nat.lt_of_lt_of_le w (Nat.min_le_left _ _)) h
|
||||
|
||||
@@ -219,8 +219,9 @@ dropping the first `i` elements. Version designed to rewrite from the big list t
|
||||
theorem getElem_drop' (L : List α) {i j : Nat} (h : i + j < L.length) :
|
||||
L[i + j] = (L.drop i)[j]'(lt_length_drop L h) := by
|
||||
have : i ≤ L.length := Nat.le_trans (Nat.le_add_right _ _) (Nat.le_of_lt h)
|
||||
rw [getElem_of_eq (take_append_drop i L).symm h, getElem_append_right'] <;>
|
||||
simp [Nat.min_eq_left this, Nat.add_sub_cancel_left, Nat.le_add_right]
|
||||
rw [getElem_of_eq (take_append_drop i L).symm h, getElem_append_right]
|
||||
· simp [Nat.min_eq_left this, Nat.add_sub_cancel_left]
|
||||
· simp [Nat.min_eq_left this, Nat.le_add_right]
|
||||
|
||||
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
|
||||
dropping the first `i` elements. Version designed to rewrite from the big list to the small list. -/
|
||||
@@ -267,9 +268,9 @@ theorem mem_take_iff_getElem {l : List α} {a : α} :
|
||||
constructor
|
||||
· rintro ⟨i, hm, rfl⟩
|
||||
simp at hm
|
||||
refine ⟨i, by omega, by rw [getElem_take']⟩
|
||||
refine ⟨i, by omega, by rw [getElem_take]⟩
|
||||
· rintro ⟨i, hm, rfl⟩
|
||||
refine ⟨i, by simpa, by rw [getElem_take']⟩
|
||||
refine ⟨i, by simpa, by rw [getElem_take]⟩
|
||||
|
||||
theorem mem_drop_iff_getElem {l : List α} {a : α} :
|
||||
a ∈ l.drop n ↔ ∃ (i : Nat) (hm : i + n < l.length), l[n + i] = a := by
|
||||
@@ -478,7 +479,7 @@ theorem false_of_mem_take_findIdx {xs : List α} {p : α → Bool} (h : x ∈ xs
|
||||
· simp only [take_succ_cons, findIdx?_cons]
|
||||
split
|
||||
· simp
|
||||
· simp [ih, Option.guard_comp]
|
||||
· simp [ih, Option.guard_comp, Option.bind_map]
|
||||
|
||||
@[simp] theorem min_findIdx_findIdx {xs : List α} {p q : α → Bool} :
|
||||
min (xs.findIdx p) (xs.findIdx q) = xs.findIdx (fun a => p a || q a) := by
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Pairwise
|
||||
import Init.Data.List.Zip
|
||||
|
||||
/-!
|
||||
# Lemmas about `List.range` and `List.enum`
|
||||
@@ -35,11 +36,16 @@ theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step)
|
||||
theorem range'_ne_nil (s : Nat) {n : Nat} : range' s n ≠ [] ↔ n ≠ 0 := by
|
||||
cases n <;> simp
|
||||
|
||||
@[simp] theorem range'_zero : range' s 0 = [] := by
|
||||
@[simp] theorem range'_zero : range' s 0 step = [] := by
|
||||
simp
|
||||
|
||||
@[simp] theorem range'_one {s step : Nat} : range' s 1 step = [s] := rfl
|
||||
|
||||
@[simp] theorem tail_range' (n : Nat) : (range' s n step).tail = range' (s + step) (n - 1) step := by
|
||||
cases n with
|
||||
| zero => simp
|
||||
| succ n => simp [range'_succ]
|
||||
|
||||
@[simp] theorem range'_inj : range' s n = range' s' n' ↔ n = n' ∧ (n = 0 ∨ s = s') := by
|
||||
constructor
|
||||
· intro h
|
||||
@@ -153,6 +159,9 @@ theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) :=
|
||||
theorem range_ne_nil {n : Nat} : range n ≠ [] ↔ n ≠ 0 := by
|
||||
cases n <;> simp
|
||||
|
||||
@[simp] theorem tail_range (n : Nat) : (range n).tail = range' 1 (n - 1) := by
|
||||
rw [range_eq_range', tail_range']
|
||||
|
||||
@[simp]
|
||||
theorem range_sublist {m n : Nat} : range m <+ range n ↔ m ≤ n := by
|
||||
simp only [range_eq_range', range'_sublist_right]
|
||||
@@ -219,6 +228,12 @@ theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).len
|
||||
simp only [getElem?_enumFrom, getElem?_eq_getElem h]
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem tail_enumFrom (l : List α) (n : Nat) : (enumFrom n l).tail = enumFrom (n + 1) l.tail := by
|
||||
induction l generalizing n with
|
||||
| nil => simp
|
||||
| cons _ l ih => simp [ih, enumFrom_cons]
|
||||
|
||||
theorem map_fst_add_enumFrom_eq_enumFrom (l : List α) (n k : Nat) :
|
||||
map (Prod.map (· + n) id) (enumFrom k l) = enumFrom (n + k) l :=
|
||||
ext_getElem? fun i ↦ by simp [(· ∘ ·), Nat.add_comm, Nat.add_left_comm]; rfl
|
||||
@@ -227,4 +242,47 @@ theorem map_fst_add_enum_eq_enumFrom (l : List α) (n : Nat) :
|
||||
map (Prod.map (· + n) id) (enum l) = enumFrom n l :=
|
||||
map_fst_add_enumFrom_eq_enumFrom l _ _
|
||||
|
||||
theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
|
||||
enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
|
||||
rw [enumFrom_cons, Nat.add_comm, ← map_fst_add_enumFrom_eq_enumFrom]
|
||||
|
||||
@[simp]
|
||||
theorem enumFrom_map_fst (n) :
|
||||
∀ (l : List α), map Prod.fst (enumFrom n l) = range' n l.length
|
||||
| [] => rfl
|
||||
| _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _)
|
||||
|
||||
@[simp]
|
||||
theorem enumFrom_map_snd : ∀ (n) (l : List α), map Prod.snd (enumFrom n l) = l
|
||||
| _, [] => rfl
|
||||
| _, _ :: _ => congrArg (cons _) (enumFrom_map_snd _ _)
|
||||
|
||||
theorem enumFrom_eq_zip_range' (l : List α) {n : Nat} : l.enumFrom n = (range' n l.length).zip l :=
|
||||
zip_of_prod (enumFrom_map_fst _ _) (enumFrom_map_snd _ _)
|
||||
|
||||
@[simp]
|
||||
theorem unzip_enumFrom_eq_prod (l : List α) {n : Nat} :
|
||||
(l.enumFrom n).unzip = (range' n l.length, l) := by
|
||||
simp only [enumFrom_eq_zip_range', unzip_zip, length_range']
|
||||
|
||||
/-! ### enum -/
|
||||
|
||||
theorem enum_cons : (a::as).enum = (0, a) :: as.enumFrom 1 := rfl
|
||||
|
||||
theorem enum_cons' (x : α) (xs : List α) :
|
||||
enum (x :: xs) = (0, x) :: (enum xs).map (Prod.map (· + 1) id) :=
|
||||
enumFrom_cons' _ _ _
|
||||
|
||||
theorem enum_eq_enumFrom {l : List α} : l.enum = l.enumFrom 0 := rfl
|
||||
|
||||
theorem enumFrom_eq_map_enum (l : List α) (n : Nat) :
|
||||
enumFrom n l = (enum l).map (Prod.map (· + n) id) := by
|
||||
induction l generalizing n with
|
||||
| nil => simp
|
||||
| cons x xs ih =>
|
||||
simp only [enumFrom_cons, ih, enum_cons, map_cons, Prod.map_apply, Nat.zero_add, id_eq, map_map,
|
||||
cons.injEq, map_inj_left, Function.comp_apply, Prod.forall, Prod.mk.injEq, and_true, true_and]
|
||||
intro a b _
|
||||
exact (succ_add a n).symm
|
||||
|
||||
end List
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kim Morrison
|
||||
Authors: Kim Morrison, Eric Wieser, François G. Dorais
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Perm
|
||||
@@ -114,31 +114,40 @@ theorem enumLE_trans (trans : ∀ a b c, le a b → le b c → le a c)
|
||||
· simp_all
|
||||
· simp_all
|
||||
|
||||
theorem enumLE_total (total : ∀ a b, !le a b → le b a)
|
||||
(a b : Nat × α) : !enumLE le a b → enumLE le b a := by
|
||||
theorem enumLE_total (total : ∀ a b, le a b || le b a)
|
||||
(a b : Nat × α) : enumLE le a b || enumLE le b a := by
|
||||
simp only [enumLE]
|
||||
split <;> split
|
||||
· simpa using Nat.le_of_lt
|
||||
· simpa using Nat.le_total a.fst b.fst
|
||||
· simp
|
||||
· simp
|
||||
· simp_all [total a.2 b.2]
|
||||
· have := total a.2 b.2
|
||||
simp_all
|
||||
|
||||
/-! ### merge -/
|
||||
|
||||
theorem merge_stable : ∀ (xs ys) (_ : ∀ x y, x ∈ xs → y ∈ ys → x.1 ≤ y.1),
|
||||
(merge xs ys (enumLE le)).map (·.2) = merge (xs.map (·.2)) (ys.map (·.2)) le
|
||||
| [], ys, _ => by simp [merge]
|
||||
| xs, [], _ => by simp [merge]
|
||||
| (i, x) :: xs, (j, y) :: ys, h => by
|
||||
simp only [merge, enumLE, map_cons]
|
||||
split <;> rename_i w
|
||||
· rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
|
||||
simp only [map_cons, cons.injEq, true_and]
|
||||
rw [merge_stable, map_cons]
|
||||
exact fun x' y' mx my => h x' y' (mem_cons_of_mem (i, x) mx) my
|
||||
· simp only [↓reduceIte, map_cons, cons.injEq, true_and, reduceCtorEq]
|
||||
rw [merge_stable, map_cons]
|
||||
exact fun x' y' mx my => h x' y' mx (mem_cons_of_mem (j, y) my)
|
||||
theorem cons_merge_cons (s : α → α → Bool) (a b l r) :
|
||||
merge (a::l) (b::r) s = if s a b then a :: merge l (b::r) s else b :: merge (a::l) r s := by
|
||||
simp only [merge]
|
||||
|
||||
@[simp] theorem cons_merge_cons_pos (s : α → α → Bool) (l r) (h : s a b) :
|
||||
merge (a::l) (b::r) s = a :: merge l (b::r) s := by
|
||||
rw [cons_merge_cons, if_pos h]
|
||||
|
||||
@[simp] theorem cons_merge_cons_neg (s : α → α → Bool) (l r) (h : ¬ s a b) :
|
||||
merge (a::l) (b::r) s = b :: merge (a::l) r s := by
|
||||
rw [cons_merge_cons, if_neg h]
|
||||
|
||||
@[simp] theorem length_merge (s : α → α → Bool) (l r) :
|
||||
(merge l r s).length = l.length + r.length := by
|
||||
match l, r with
|
||||
| [], r => simp
|
||||
| l, [] => simp
|
||||
| a::l, b::r =>
|
||||
rw [cons_merge_cons]
|
||||
split
|
||||
· simp_arith [length_merge s l (b::r)]
|
||||
· simp_arith [length_merge s (a::l) r]
|
||||
|
||||
/--
|
||||
The elements of `merge le xs ys` are exactly the elements of `xs` and `ys`.
|
||||
@@ -158,16 +167,37 @@ theorem mem_merge {a : α} {xs ys : List α} : a ∈ merge xs ys le ↔ a ∈ xs
|
||||
apply or_congr_left
|
||||
simp only [or_comm (a := a = y), or_assoc]
|
||||
|
||||
theorem mem_merge_left (s : α → α → Bool) (h : x ∈ l) : x ∈ merge l r s :=
|
||||
mem_merge.2 <| .inl h
|
||||
|
||||
theorem mem_merge_right (s : α → α → Bool) (h : x ∈ r) : x ∈ merge l r s :=
|
||||
mem_merge.2 <| .inr h
|
||||
|
||||
theorem merge_stable : ∀ (xs ys) (_ : ∀ x y, x ∈ xs → y ∈ ys → x.1 ≤ y.1),
|
||||
(merge xs ys (enumLE le)).map (·.2) = merge (xs.map (·.2)) (ys.map (·.2)) le
|
||||
| [], ys, _ => by simp [merge]
|
||||
| xs, [], _ => by simp [merge]
|
||||
| (i, x) :: xs, (j, y) :: ys, h => by
|
||||
simp only [merge, enumLE, map_cons]
|
||||
split <;> rename_i w
|
||||
· rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
|
||||
simp only [map_cons, cons.injEq, true_and]
|
||||
rw [merge_stable, map_cons]
|
||||
exact fun x' y' mx my => h x' y' (mem_cons_of_mem (i, x) mx) my
|
||||
· simp only [↓reduceIte, map_cons, cons.injEq, true_and, reduceCtorEq]
|
||||
rw [merge_stable, map_cons]
|
||||
exact fun x' y' mx my => h x' y' mx (mem_cons_of_mem (j, y) my)
|
||||
|
||||
-- We enable this instance locally so we can write `Pairwise le` instead of `Pairwise (le · ·)` everywhere.
|
||||
attribute [local instance] boolRelToRel
|
||||
|
||||
/--
|
||||
If the ordering relation `le` is transitive and total (i.e. `le a b ∨ le b a` for all `a, b`)
|
||||
If the ordering relation `le` is transitive and total (i.e. `le a b || le b a` for all `a, b`)
|
||||
then the `merge` of two sorted lists is sorted.
|
||||
-/
|
||||
theorem sorted_merge
|
||||
(trans : ∀ (a b c : α), le a b → le b c → le a c)
|
||||
(total : ∀ (a b : α), !le a b → le b a)
|
||||
(total : ∀ (a b : α), le a b || le b a)
|
||||
(l₁ l₂ : List α) (h₁ : l₁.Pairwise le) (h₂ : l₂.Pairwise le) : (merge l₁ l₂ le).Pairwise le := by
|
||||
induction l₁ generalizing l₂ with
|
||||
| nil => simpa only [merge]
|
||||
@@ -188,9 +218,10 @@ theorem sorted_merge
|
||||
· apply Pairwise.cons
|
||||
· intro z m
|
||||
rw [mem_merge, mem_cons] at m
|
||||
simp only [Bool.not_eq_true] at h
|
||||
rcases m with (⟨rfl|m⟩|m)
|
||||
· exact total _ _ (by simpa using h)
|
||||
· exact trans _ _ _ (total _ _ (by simpa using h)) (rel_of_pairwise_cons h₁ m)
|
||||
· simpa [h] using total y z
|
||||
· exact trans _ _ _ (by simpa [h] using total x y) (rel_of_pairwise_cons h₁ m)
|
||||
· exact rel_of_pairwise_cons h₂ m
|
||||
· exact ih₂ h₂.tail
|
||||
|
||||
@@ -234,7 +265,7 @@ theorem mergeSort_perm : ∀ (l : List α) (le), mergeSort l le ~ l
|
||||
(Perm.of_eq (splitInTwo_fst_append_splitInTwo_snd _)))
|
||||
termination_by l => l.length
|
||||
|
||||
@[simp] theorem mergeSort_length (l : List α) : (mergeSort l le).length = l.length :=
|
||||
@[simp] theorem length_mergeSort (l : List α) : (mergeSort l le).length = l.length :=
|
||||
(mergeSort_perm l le).length_eq
|
||||
|
||||
@[simp] theorem mem_mergeSort {a : α} {l : List α} : a ∈ mergeSort l le ↔ a ∈ l :=
|
||||
@@ -243,13 +274,13 @@ termination_by l => l.length
|
||||
/--
|
||||
The result of `mergeSort` is sorted,
|
||||
as long as the comparison function is transitive (`le a b → le b c → le a c`)
|
||||
and total in the sense that `le a b ∨ le b a`.
|
||||
and total in the sense that `le a b || le b a`.
|
||||
|
||||
The comparison function need not be irreflexive, i.e. `le a b` and `le b a` is allowed even when `a ≠ b`.
|
||||
-/
|
||||
theorem sorted_mergeSort
|
||||
(trans : ∀ (a b c : α), le a b → le b c → le a c)
|
||||
(total : ∀ (a b : α), !le a b → le b a) :
|
||||
(total : ∀ (a b : α), le a b || le b a) :
|
||||
(l : List α) → (mergeSort l le).Pairwise le
|
||||
| [] => by simp [mergeSort]
|
||||
| [a] => by simp [mergeSort]
|
||||
@@ -317,7 +348,7 @@ termination_by _ l => l.length
|
||||
|
||||
theorem mergeSort_cons {le : α → α → Bool}
|
||||
(trans : ∀ (a b c : α), le a b → le b c → le a c)
|
||||
(total : ∀ (a b : α), !le a b → le b a)
|
||||
(total : ∀ (a b : α), le a b || le b a)
|
||||
(a : α) (l : List α) :
|
||||
∃ l₁ l₂, mergeSort (a :: l) le = l₁ ++ a :: l₂ ∧ mergeSort l le = l₁ ++ l₂ ∧
|
||||
∀ b, b ∈ l₁ → !le a b := by
|
||||
@@ -376,7 +407,7 @@ then `c` is still a sublist of `mergeSort le l`.
|
||||
-/
|
||||
theorem sublist_mergeSort
|
||||
(trans : ∀ (a b c : α), le a b → le b c → le a c)
|
||||
(total : ∀ (a b : α), !le a b → le b a) :
|
||||
(total : ∀ (a b : α), le a b || le b a) :
|
||||
∀ {c : List α} (_ : c.Pairwise le) (_ : c <+ l),
|
||||
c <+ mergeSort l le
|
||||
| _, _, .slnil => nil_sublist _
|
||||
@@ -407,8 +438,45 @@ then `[a, b]` is still a sublist of `mergeSort le l`.
|
||||
-/
|
||||
theorem pair_sublist_mergeSort
|
||||
(trans : ∀ (a b c : α), le a b → le b c → le a c)
|
||||
(total : ∀ (a b : α), !le a b → le b a)
|
||||
(total : ∀ (a b : α), le a b || le b a)
|
||||
(hab : le a b) (h : [a, b] <+ l) : [a, b] <+ mergeSort l le :=
|
||||
sublist_mergeSort trans total (pairwise_pair.mpr hab) h
|
||||
|
||||
@[deprecated (since := "2024-09-02")] abbrev mergeSort_stable_pair := @pair_sublist_mergeSort
|
||||
|
||||
theorem map_merge {f : α → β} {r : α → α → Bool} {s : β → β → Bool} {l l' : List α}
|
||||
(hl : ∀ a ∈ l, ∀ b ∈ l', r a b = s (f a) (f b)) :
|
||||
(l.merge l' r).map f = (l.map f).merge (l'.map f) s := by
|
||||
match l, l' with
|
||||
| [], x' => simp
|
||||
| x, [] => simp
|
||||
| x :: xs, x' :: xs' =>
|
||||
simp only [List.forall_mem_cons] at hl
|
||||
simp only [forall_and] at hl
|
||||
simp only [List.map, List.cons_merge_cons]
|
||||
rw [← hl.1.1]
|
||||
split
|
||||
· rw [List.map, map_merge, List.map]
|
||||
simp only [List.forall_mem_cons, forall_and]
|
||||
exact ⟨hl.2.1, hl.2.2⟩
|
||||
· rw [List.map, map_merge, List.map]
|
||||
simp only [List.forall_mem_cons]
|
||||
exact ⟨hl.1.2, hl.2.2⟩
|
||||
|
||||
theorem map_mergeSort {r : α → α → Bool} {s : β → β → Bool} {f : α → β} {l : List α}
|
||||
(hl : ∀ a ∈ l, ∀ b ∈ l, r a b = s (f a) (f b)) :
|
||||
(l.mergeSort r).map f = (l.map f).mergeSort s :=
|
||||
match l with
|
||||
| [] => by simp
|
||||
| [x] => by simp
|
||||
| a :: b :: l => by
|
||||
simp only [mergeSort, splitInTwo_fst, splitInTwo_snd, map_cons]
|
||||
rw [map_merge (fun a am b bm => hl a (mem_of_mem_take (by simpa using am))
|
||||
b (mem_of_mem_drop (by simpa using bm)))]
|
||||
rw [map_mergeSort (s := s) (fun a am b bm => hl a (mem_of_mem_take (by simpa using am))
|
||||
b (mem_of_mem_take (by simpa using bm)))]
|
||||
rw [map_mergeSort (s := s) (fun a am b bm => hl a (mem_of_mem_drop (by simpa using am))
|
||||
b (mem_of_mem_drop (by simpa using bm)))]
|
||||
rw [map_take, map_drop]
|
||||
simp
|
||||
termination_by length l
|
||||
|
||||
@@ -667,7 +667,7 @@ theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length :=
|
||||
theorem IsPrefix.getElem {x y : List α} (h : x <+: y) {n} (hn : n < x.length) :
|
||||
x[n] = y[n]'(Nat.le_trans hn h.length_le) := by
|
||||
obtain ⟨_, rfl⟩ := h
|
||||
exact (List.getElem_append n hn).symm
|
||||
exact (List.getElem_append_left hn).symm
|
||||
|
||||
-- See `Init.Data.List.Nat.Sublist` for `IsSuffix.getElem`.
|
||||
|
||||
@@ -725,12 +725,21 @@ theorem infix_iff_suffix_prefix {l₁ l₂ : List α} : l₁ <:+: l₂ ↔ ∃ t
|
||||
theorem IsInfix.eq_of_length (h : l₁ <:+: l₂) : l₁.length = l₂.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length
|
||||
|
||||
theorem IsInfix.eq_of_length_le (h : l₁ <:+: l₂) : l₂.length ≤ l₁.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length_le
|
||||
|
||||
theorem IsPrefix.eq_of_length (h : l₁ <+: l₂) : l₁.length = l₂.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length
|
||||
|
||||
theorem IsPrefix.eq_of_length_le (h : l₁ <+: l₂) : l₂.length ≤ l₁.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length_le
|
||||
|
||||
theorem IsSuffix.eq_of_length (h : l₁ <:+ l₂) : l₁.length = l₂.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length
|
||||
|
||||
theorem IsSuffix.eq_of_length_le (h : l₁ <:+ l₂) : l₂.length ≤ l₁.length → l₁ = l₂ :=
|
||||
h.sublist.eq_of_length_le
|
||||
|
||||
theorem prefix_of_prefix_length_le :
|
||||
∀ {l₁ l₂ l₃ : List α}, l₁ <+: l₃ → l₂ <+: l₃ → length l₁ ≤ length l₂ → l₁ <+: l₂
|
||||
| [], l₂, _, _, _, _ => nil_prefix
|
||||
@@ -829,6 +838,24 @@ theorem isPrefix_iff : l₁ <+: l₂ ↔ ∀ i (h : i < l₁.length), l₂[i]? =
|
||||
rw (config := {occs := .pos [2]}) [← Nat.and_forall_add_one]
|
||||
simp [Nat.succ_lt_succ_iff, eq_comm]
|
||||
|
||||
theorem isPrefix_iff_getElem {l₁ l₂ : List α} :
|
||||
l₁ <+: l₂ ↔ ∃ (h : l₁.length ≤ l₂.length), ∀ x (hx : x < l₁.length),
|
||||
l₁[x] = l₂[x]'(Nat.lt_of_lt_of_le hx h) where
|
||||
mp h := ⟨h.length_le, fun _ _ ↦ h.getElem _⟩
|
||||
mpr h := by
|
||||
obtain ⟨hl, h⟩ := h
|
||||
induction l₂ generalizing l₁ with
|
||||
| nil =>
|
||||
simpa using hl
|
||||
| cons _ _ tail_ih =>
|
||||
cases l₁ with
|
||||
| nil =>
|
||||
exact nil_prefix
|
||||
| cons _ _ =>
|
||||
simp only [length_cons, Nat.add_le_add_iff_right, Fin.getElem_fin] at hl h
|
||||
simp only [cons_prefix_cons]
|
||||
exact ⟨h 0 (zero_lt_succ _), tail_ih hl fun a ha ↦ h a.succ (succ_lt_succ ha)⟩
|
||||
|
||||
-- See `Init.Data.List.Nat.Sublist` for `isSuffix_iff` and `ifInfix_iff`.
|
||||
|
||||
theorem isPrefix_filterMap_iff {β} {f : α → Option β} {l₁ : List α} {l₂ : List β} :
|
||||
|
||||
@@ -16,83 +16,6 @@ open Nat
|
||||
|
||||
/-! ## Zippers -/
|
||||
|
||||
/-! ### zip -/
|
||||
|
||||
theorem zip_map (f : α → γ) (g : β → δ) :
|
||||
∀ (l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
|
||||
| [], l₂ => rfl
|
||||
| l₁, [] => by simp only [map, zip_nil_right]
|
||||
| a :: l₁, b :: l₂ => by
|
||||
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
|
||||
|
||||
theorem zip_map_left (f : α → γ) (l₁ : List α) (l₂ : List β) :
|
||||
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]
|
||||
|
||||
theorem zip_map_right (f : β → γ) (l₁ : List α) (l₂ : List β) :
|
||||
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [← zip_map, map_id]
|
||||
|
||||
theorem zip_append :
|
||||
∀ {l₁ r₁ : List α} {l₂ r₂ : List β} (_h : length l₁ = length l₂),
|
||||
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
|
||||
| [], r₁, l₂, r₂, h => by simp only [eq_nil_of_length_eq_zero h.symm]; rfl
|
||||
| l₁, r₁, [], r₂, h => by simp only [eq_nil_of_length_eq_zero h]; rfl
|
||||
| a :: l₁, r₁, b :: l₂, r₂, h => by
|
||||
simp only [cons_append, zip_cons_cons, zip_append (Nat.succ.inj h)]
|
||||
|
||||
theorem zip_map' (f : α → β) (g : α → γ) :
|
||||
∀ l : List α, zip (l.map f) (l.map g) = l.map fun a => (f a, g a)
|
||||
| [] => rfl
|
||||
| a :: l => by simp only [map, zip_cons_cons, zip_map']
|
||||
|
||||
theorem of_mem_zip {a b} : ∀ {l₁ : List α} {l₂ : List β}, (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂
|
||||
| _ :: l₁, _ :: l₂, h => by
|
||||
cases h
|
||||
case head => simp
|
||||
case tail h =>
|
||||
· have := of_mem_zip h
|
||||
exact ⟨Mem.tail _ this.1, Mem.tail _ this.2⟩
|
||||
|
||||
@[deprecated of_mem_zip (since := "2024-07-28")] abbrev mem_zip := @of_mem_zip
|
||||
|
||||
theorem map_fst_zip :
|
||||
∀ (l₁ : List α) (l₂ : List β), l₁.length ≤ l₂.length → map Prod.fst (zip l₁ l₂) = l₁
|
||||
| [], bs, _ => rfl
|
||||
| _ :: as, _ :: bs, h => by
|
||||
simp [Nat.succ_le_succ_iff] at h
|
||||
show _ :: map Prod.fst (zip as bs) = _ :: as
|
||||
rw [map_fst_zip as bs h]
|
||||
| a :: as, [], h => by simp at h
|
||||
|
||||
theorem map_snd_zip :
|
||||
∀ (l₁ : List α) (l₂ : List β), l₂.length ≤ l₁.length → map Prod.snd (zip l₁ l₂) = l₂
|
||||
| _, [], _ => by
|
||||
rw [zip_nil_right]
|
||||
rfl
|
||||
| [], b :: bs, h => by simp at h
|
||||
| a :: as, b :: bs, h => by
|
||||
simp [Nat.succ_le_succ_iff] at h
|
||||
show _ :: map Prod.snd (zip as bs) = _ :: bs
|
||||
rw [map_snd_zip as bs h]
|
||||
|
||||
theorem map_prod_left_eq_zip {l : List α} (f : α → β) :
|
||||
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
|
||||
rw [← zip_map']
|
||||
congr
|
||||
simp
|
||||
|
||||
theorem map_prod_right_eq_zip {l : List α} (f : α → β) :
|
||||
(l.map fun x => (f x, x)) = (l.map f).zip l := by
|
||||
rw [← zip_map']
|
||||
congr
|
||||
simp
|
||||
|
||||
/-- See also `List.zip_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
|
||||
@[simp] theorem zip_replicate' {a : α} {b : β} {n : Nat} :
|
||||
zip (replicate n a) (replicate n b) = replicate n (a, b) := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => simp [replicate_succ, ih]
|
||||
|
||||
/-! ### zipWith -/
|
||||
|
||||
theorem zipWith_comm (f : α → β → γ) :
|
||||
@@ -229,6 +152,7 @@ theorem drop_zipWith : (zipWith f l l').drop n = zipWith f (l.drop n) (l'.drop n
|
||||
|
||||
@[deprecated drop_zipWith (since := "2024-07-26")] abbrev zipWith_distrib_drop := @drop_zipWith
|
||||
|
||||
@[simp]
|
||||
theorem tail_zipWith : (zipWith f l l').tail = zipWith f l.tail l'.tail := by
|
||||
rw [← drop_one]; simp [drop_zipWith]
|
||||
|
||||
@@ -248,6 +172,65 @@ theorem zipWith_append (f : α → β → γ) (l la : List α) (l' lb : List β)
|
||||
simp only [length_cons, Nat.succ.injEq] at h
|
||||
simp [ih _ h]
|
||||
|
||||
theorem zipWith_eq_cons_iff {f : α → β → γ} {l₁ : List α} {l₂ : List β} :
|
||||
zipWith f l₁ l₂ = g :: l ↔
|
||||
∃ a l₁' b l₂', l₁ = a :: l₁' ∧ l₂ = b :: l₂' ∧ g = f a b ∧ l = zipWith f l₁' l₂' := by
|
||||
match l₁, l₂ with
|
||||
| [], [] => simp
|
||||
| [], b :: l₂ => simp
|
||||
| a :: l₁, [] => simp
|
||||
| a' :: l₁, b' :: l₂ =>
|
||||
simp only [zip_cons_cons, cons.injEq, Prod.mk.injEq]
|
||||
constructor
|
||||
· rintro ⟨⟨rfl, rfl⟩, rfl⟩
|
||||
refine ⟨a', l₁, b', l₂, by simp⟩
|
||||
· rintro ⟨a, l₁, b, l₂, ⟨rfl, rfl⟩, ⟨rfl, rfl⟩, rfl, rfl⟩
|
||||
simp
|
||||
|
||||
theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : List β} :
|
||||
zipWith f l₁ l₂ = l₁' ++ l₂' ↔
|
||||
∃ w x y z, w.length = y.length ∧ l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zipWith f w y ∧ l₂' = zipWith f x z := by
|
||||
induction l₁ generalizing l₂ l₁' with
|
||||
| nil =>
|
||||
simp
|
||||
constructor
|
||||
· rintro ⟨rfl, rfl⟩
|
||||
exact ⟨[], [], [], by simp⟩
|
||||
· rintro ⟨_, _, _, -, ⟨rfl, rfl⟩, _, rfl, rfl, rfl⟩
|
||||
simp
|
||||
| cons x₁ l₁ ih₁ =>
|
||||
cases l₂ with
|
||||
| nil =>
|
||||
constructor
|
||||
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
|
||||
rintro rfl rfl
|
||||
exact ⟨[], x₁ :: l₁, [], by simp⟩
|
||||
· rintro ⟨w, x, y, z, h₁, _, h₃, rfl, rfl⟩
|
||||
simp only [nil_eq, append_eq_nil] at h₃
|
||||
obtain ⟨rfl, rfl⟩ := h₃
|
||||
simp
|
||||
| cons x₂ l₂ =>
|
||||
simp only [zipWith_cons_cons]
|
||||
rw [cons_eq_append_iff]
|
||||
constructor
|
||||
· rintro (⟨rfl, rfl⟩ | ⟨l₁'', rfl, h⟩)
|
||||
· exact ⟨[], x₁ :: l₁, [], x₂ :: l₂, by simp⟩
|
||||
· rw [ih₁] at h
|
||||
obtain ⟨w, x, y, z, h, rfl, rfl, h', rfl⟩ := h
|
||||
refine ⟨x₁ :: w, x, x₂ :: y, z, by simp [h, h']⟩
|
||||
· rintro ⟨w, x, y, z, h₁, h₂, h₃, rfl, rfl⟩
|
||||
rw [cons_eq_append_iff] at h₂
|
||||
rw [cons_eq_append_iff] at h₃
|
||||
obtain (⟨rfl, rfl⟩ | ⟨w', rfl, rfl⟩) := h₂
|
||||
· simp only [zipWith_nil_left, true_and, nil_eq, reduceCtorEq, false_and, exists_const,
|
||||
or_false]
|
||||
obtain (⟨rfl, rfl⟩ | ⟨y', rfl, rfl⟩) := h₃
|
||||
· simp
|
||||
· simp_all
|
||||
· obtain (⟨rfl, rfl⟩ | ⟨y', rfl, rfl⟩) := h₃
|
||||
· simp_all
|
||||
· simp_all [zipWith_append, Nat.succ_inj']
|
||||
|
||||
/-- See also `List.zipWith_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
|
||||
@[simp] theorem zipWith_replicate' {a : α} {b : β} {n : Nat} :
|
||||
zipWith f (replicate n a) (replicate n b) = replicate n (f a b) := by
|
||||
@@ -255,6 +238,113 @@ theorem zipWith_append (f : α → β → γ) (l la : List α) (l' lb : List β)
|
||||
| zero => rfl
|
||||
| succ n ih => simp [replicate_succ, ih]
|
||||
|
||||
/-! ### zip -/
|
||||
|
||||
theorem zip_eq_zipWith : ∀ (l₁ : List α) (l₂ : List β), zip l₁ l₂ = zipWith Prod.mk l₁ l₂
|
||||
| [], _ => rfl
|
||||
| _, [] => rfl
|
||||
| a :: l₁, b :: l₂ => by simp [zip_cons_cons, zip_eq_zipWith l₁ l₂]
|
||||
|
||||
theorem zip_map (f : α → γ) (g : β → δ) :
|
||||
∀ (l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
|
||||
| [], l₂ => rfl
|
||||
| l₁, [] => by simp only [map, zip_nil_right]
|
||||
| a :: l₁, b :: l₂ => by
|
||||
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
|
||||
|
||||
theorem zip_map_left (f : α → γ) (l₁ : List α) (l₂ : List β) :
|
||||
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [← zip_map, map_id]
|
||||
|
||||
theorem zip_map_right (f : β → γ) (l₁ : List α) (l₂ : List β) :
|
||||
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [← zip_map, map_id]
|
||||
|
||||
@[simp] theorem tail_zip (l₁ : List α) (l₂ : List β) :
|
||||
(zip l₁ l₂).tail = zip l₁.tail l₂.tail := by
|
||||
cases l₁ <;> cases l₂ <;> simp
|
||||
|
||||
theorem zip_append :
|
||||
∀ {l₁ r₁ : List α} {l₂ r₂ : List β} (_h : length l₁ = length l₂),
|
||||
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
|
||||
| [], r₁, l₂, r₂, h => by simp only [eq_nil_of_length_eq_zero h.symm]; rfl
|
||||
| l₁, r₁, [], r₂, h => by simp only [eq_nil_of_length_eq_zero h]; rfl
|
||||
| a :: l₁, r₁, b :: l₂, r₂, h => by
|
||||
simp only [cons_append, zip_cons_cons, zip_append (Nat.succ.inj h)]
|
||||
|
||||
theorem zip_map' (f : α → β) (g : α → γ) :
|
||||
∀ l : List α, zip (l.map f) (l.map g) = l.map fun a => (f a, g a)
|
||||
| [] => rfl
|
||||
| a :: l => by simp only [map, zip_cons_cons, zip_map']
|
||||
|
||||
theorem of_mem_zip {a b} : ∀ {l₁ : List α} {l₂ : List β}, (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂
|
||||
| _ :: l₁, _ :: l₂, h => by
|
||||
cases h
|
||||
case head => simp
|
||||
case tail h =>
|
||||
· have := of_mem_zip h
|
||||
exact ⟨Mem.tail _ this.1, Mem.tail _ this.2⟩
|
||||
|
||||
@[deprecated of_mem_zip (since := "2024-07-28")] abbrev mem_zip := @of_mem_zip
|
||||
|
||||
theorem map_fst_zip :
|
||||
∀ (l₁ : List α) (l₂ : List β), l₁.length ≤ l₂.length → map Prod.fst (zip l₁ l₂) = l₁
|
||||
| [], bs, _ => rfl
|
||||
| _ :: as, _ :: bs, h => by
|
||||
simp [Nat.succ_le_succ_iff] at h
|
||||
show _ :: map Prod.fst (zip as bs) = _ :: as
|
||||
rw [map_fst_zip as bs h]
|
||||
| a :: as, [], h => by simp at h
|
||||
|
||||
theorem map_snd_zip :
|
||||
∀ (l₁ : List α) (l₂ : List β), l₂.length ≤ l₁.length → map Prod.snd (zip l₁ l₂) = l₂
|
||||
| _, [], _ => by
|
||||
rw [zip_nil_right]
|
||||
rfl
|
||||
| [], b :: bs, h => by simp at h
|
||||
| a :: as, b :: bs, h => by
|
||||
simp [Nat.succ_le_succ_iff] at h
|
||||
show _ :: map Prod.snd (zip as bs) = _ :: bs
|
||||
rw [map_snd_zip as bs h]
|
||||
|
||||
theorem map_prod_left_eq_zip {l : List α} (f : α → β) :
|
||||
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
|
||||
rw [← zip_map']
|
||||
congr
|
||||
simp
|
||||
|
||||
theorem map_prod_right_eq_zip {l : List α} (f : α → β) :
|
||||
(l.map fun x => (f x, x)) = (l.map f).zip l := by
|
||||
rw [← zip_map']
|
||||
congr
|
||||
simp
|
||||
|
||||
@[simp] theorem zip_eq_nil_iff {l₁ : List α} {l₂ : List β} :
|
||||
zip l₁ l₂ = [] ↔ l₁ = [] ∨ l₂ = [] := by
|
||||
simp [zip_eq_zipWith]
|
||||
|
||||
theorem zip_eq_cons_iff {l₁ : List α} {l₂ : List β} :
|
||||
zip l₁ l₂ = (a, b) :: l ↔
|
||||
∃ l₁' l₂', l₁ = a :: l₁' ∧ l₂ = b :: l₂' ∧ l = zip l₁' l₂' := by
|
||||
simp only [zip_eq_zipWith, zipWith_eq_cons_iff]
|
||||
constructor
|
||||
· rintro ⟨a, l₁, b, l₂, rfl, rfl, h, rfl, rfl⟩
|
||||
simp only [Prod.mk.injEq] at h
|
||||
obtain ⟨rfl, rfl⟩ := h
|
||||
simp
|
||||
· rintro ⟨l₁', l₂', rfl, rfl, rfl⟩
|
||||
refine ⟨a, l₁', b, l₂', by simp⟩
|
||||
|
||||
theorem zip_eq_append_iff {l₁ : List α} {l₂ : List β} :
|
||||
zip l₁ l₂ = l₁' ++ l₂' ↔
|
||||
∃ w x y z, w.length = y.length ∧ l₁ = w ++ x ∧ l₂ = y ++ z ∧ l₁' = zip w y ∧ l₂' = zip x z := by
|
||||
simp [zip_eq_zipWith, zipWith_eq_append_iff]
|
||||
|
||||
/-- See also `List.zip_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
|
||||
@[simp] theorem zip_replicate' {a : α} {b : β} {n : Nat} :
|
||||
zip (replicate n a) (replicate n b) = replicate n (a, b) := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => simp [replicate_succ, ih]
|
||||
|
||||
/-! ### zipWithAll -/
|
||||
|
||||
theorem getElem?_zipWithAll {f : Option α → Option β → γ} {i : Nat} :
|
||||
@@ -284,12 +374,16 @@ theorem head?_zipWithAll {f : Option α → Option β → γ} :
|
||||
| none, none => .none | a?, b? => some (f a? b?) := by
|
||||
simp [head?_eq_getElem?, getElem?_zipWithAll]
|
||||
|
||||
theorem head_zipWithAll {f : Option α → Option β → γ} (h) :
|
||||
@[simp] theorem head_zipWithAll {f : Option α → Option β → γ} (h) :
|
||||
(zipWithAll f as bs).head h = f as.head? bs.head? := by
|
||||
apply Option.some.inj
|
||||
rw [← head?_eq_head, head?_zipWithAll]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem tail_zipWithAll {f : Option α → Option β → γ} :
|
||||
(zipWithAll f as bs).tail = zipWithAll f as.tail bs.tail := by
|
||||
cases as <;> cases bs <;> simp
|
||||
|
||||
theorem zipWithAll_map {μ} (f : Option γ → Option δ → μ) (g : α → γ) (h : β → δ) (l₁ : List α) (l₂ : List β) :
|
||||
zipWithAll f (l₁.map g) (l₂.map h) = zipWithAll (fun a b => f (g <$> a) (h <$> b)) l₁ l₂ := by
|
||||
induction l₁ generalizing l₂ <;> cases l₂ <;> simp_all
|
||||
@@ -358,6 +452,12 @@ theorem zip_of_prod {l : List α} {l' : List β} {lp : List (α × β)} (hl : lp
|
||||
(hr : lp.map Prod.snd = l') : lp = l.zip l' := by
|
||||
rw [← hl, ← hr, ← zip_unzip lp, ← unzip_fst, ← unzip_snd, zip_unzip, zip_unzip]
|
||||
|
||||
theorem tail_zip_fst {l : List (α × β)} : l.unzip.1.tail = l.tail.unzip.1 := by
|
||||
simp
|
||||
|
||||
theorem tail_zip_snd {l : List (α × β)} : l.unzip.2.tail = l.tail.unzip.2 := by
|
||||
simp
|
||||
|
||||
@[simp] theorem unzip_replicate {n : Nat} {a : α} {b : β} :
|
||||
unzip (replicate n (a, b)) = (replicate n a, replicate n b) := by
|
||||
ext1 <;> simp
|
||||
|
||||
@@ -514,6 +514,10 @@ protected theorem add_lt_add_left {n m : Nat} (h : n < m) (k : Nat) : k + n < k
|
||||
protected theorem add_lt_add_right {n m : Nat} (h : n < m) (k : Nat) : n + k < m + k :=
|
||||
Nat.add_comm k m ▸ Nat.add_comm k n ▸ Nat.add_lt_add_left h k
|
||||
|
||||
protected theorem lt_add_of_pos_left (h : 0 < k) : n < k + n := by
|
||||
rw [Nat.add_comm]
|
||||
exact Nat.add_lt_add_left h n
|
||||
|
||||
protected theorem lt_add_of_pos_right (h : 0 < k) : n < n + k :=
|
||||
Nat.add_lt_add_left h n
|
||||
|
||||
@@ -630,6 +634,8 @@ theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h
|
||||
|
||||
theorem lt_add_one_of_lt (h : a < b) : a < b + 1 := le_succ_of_le h
|
||||
|
||||
@[simp] theorem lt_one_iff : n < 1 ↔ n = 0 := Nat.lt_succ_iff.trans <| by rw [le_zero_eq]
|
||||
|
||||
theorem succ_pred_eq_of_ne_zero : ∀ {n}, n ≠ 0 → succ (pred n) = n
|
||||
| _+1, _ => rfl
|
||||
|
||||
@@ -718,7 +724,7 @@ protected theorem zero_ne_one : 0 ≠ (1 : Nat) :=
|
||||
|
||||
theorem succ_ne_zero (n : Nat) : succ n ≠ 0 := by simp
|
||||
|
||||
instance {n : Nat} : NeZero (succ n) := ⟨succ_ne_zero n⟩
|
||||
instance instNeZeroSucc {n : Nat} : NeZero (n + 1) := ⟨succ_ne_zero n⟩
|
||||
|
||||
/-! # mul + order -/
|
||||
|
||||
|
||||
@@ -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: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Nat.Bitwise.Basic
|
||||
|
||||
@@ -36,7 +36,7 @@ private theorem two_mul_sub_one {n : Nat} (n_pos : n > 0) : (2*n - 1) % 2 = 1 :=
|
||||
/-! ### Preliminaries -/
|
||||
|
||||
/--
|
||||
An induction principal that works on divison by two.
|
||||
An induction principal that works on division by two.
|
||||
-/
|
||||
noncomputable def div2Induction {motive : Nat → Sort u}
|
||||
(n : Nat) (ind : ∀(n : Nat), (n > 0 → motive (n/2)) → motive n) : motive n := by
|
||||
@@ -226,18 +226,18 @@ private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by
|
||||
simp [Nat.mod_eq (x+2) 2, p, hyp]
|
||||
cases Nat.mod_two_eq_zero_or_one x with | _ p => simp [p]
|
||||
|
||||
private theorem testBit_succ_zero : testBit (x + 1) 0 = not (testBit x 0) := by
|
||||
private theorem testBit_succ_zero : testBit (x + 1) 0 = !(testBit x 0) := by
|
||||
simp [testBit_to_div_mod, succ_mod_two]
|
||||
cases Nat.mod_two_eq_zero_or_one x with | _ p =>
|
||||
simp [p]
|
||||
|
||||
theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = not (testBit x i) := by
|
||||
theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = !(testBit x i) := by
|
||||
simp [testBit_to_div_mod, add_div_left, Nat.two_pow_pos, succ_mod_two]
|
||||
cases mod_two_eq_zero_or_one (x / 2 ^ i) with
|
||||
| _ p => simp [p]
|
||||
|
||||
theorem testBit_mul_two_pow_add_eq (a b i : Nat) :
|
||||
testBit (2^i*a + b) i = Bool.xor (a%2 = 1) (testBit b i) := by
|
||||
testBit (2^i*a + b) i = (a%2 = 1 ^^ testBit b i) := by
|
||||
match a with
|
||||
| 0 => simp
|
||||
| a+1 =>
|
||||
@@ -570,7 +570,7 @@ theorem or_div_two : (a ||| b) / 2 = a / 2 ||| b / 2 := by
|
||||
/-! ### xor -/
|
||||
|
||||
@[simp] theorem testBit_xor (x y i : Nat) :
|
||||
(x ^^^ y).testBit i = Bool.xor (x.testBit i) (y.testBit i) := by
|
||||
(x ^^^ y).testBit i = ((x.testBit i) ^^ (y.testBit i)) := by
|
||||
simp [HXor.hXor, Xor.xor, xor, testBit_bitwise ]
|
||||
|
||||
@[simp] theorem zero_xor (x : Nat) : 0 ^^^ x = x := by
|
||||
|
||||
@@ -84,7 +84,7 @@ decreasing_by apply div_rec_lemma; assumption
|
||||
protected def mod : @& Nat → @& Nat → Nat
|
||||
/-
|
||||
Nat.modCore is defined by well-founded recursion and thus irreducible. Nevertheless it is
|
||||
desireable if trivial `Nat.mod` calculations, namely
|
||||
desirable if trivial `Nat.mod` calculations, namely
|
||||
* `Nat.mod 0 m` for all `m`
|
||||
* `Nat.mod n (m+n)` for concrete literals `n`
|
||||
reduce definitionally.
|
||||
@@ -134,6 +134,19 @@ theorem mod_eq_of_lt {a b : Nat} (h : a < b) : a % b = a :=
|
||||
if_neg h'
|
||||
(mod_eq a b).symm ▸ this
|
||||
|
||||
@[simp] theorem one_mod_eq_zero_iff {n : Nat} : 1 % n = 0 ↔ n = 1 := by
|
||||
match n with
|
||||
| 0 => simp
|
||||
| 1 => simp
|
||||
| n + 2 =>
|
||||
rw [mod_eq_of_lt (by exact Nat.lt_of_sub_eq_succ rfl)]
|
||||
simp only [add_one_ne_zero, false_iff, ne_eq]
|
||||
exact ne_of_beq_eq_false rfl
|
||||
|
||||
@[simp] theorem Nat.zero_eq_one_mod_iff {n : Nat} : 0 = 1 % n ↔ n = 1 := by
|
||||
rw [eq_comm]
|
||||
simp
|
||||
|
||||
theorem mod_eq_sub_mod {a b : Nat} (h : a ≥ b) : a % b = (a - b) % b :=
|
||||
match eq_zero_or_pos b with
|
||||
| Or.inl h₁ => h₁.symm ▸ (Nat.sub_zero a).symm ▸ rfl
|
||||
@@ -157,6 +170,13 @@ theorem mod_lt (x : Nat) {y : Nat} : y > 0 → x % y < y := by
|
||||
rw [mod_eq_sub_mod h₁]
|
||||
exact h₂ h₃
|
||||
|
||||
@[simp] protected theorem sub_mod_add_mod_cancel (a b : Nat) [NeZero a] : a - b % a + b % a = a := by
|
||||
rw [Nat.sub_add_cancel]
|
||||
cases a with
|
||||
| zero => simp_all
|
||||
| succ a =>
|
||||
exact Nat.le_of_lt (mod_lt b (zero_lt_succ a))
|
||||
|
||||
theorem mod_le (x y : Nat) : x % y ≤ x := by
|
||||
match Nat.lt_or_ge x y with
|
||||
| Or.inl h₁ => rw [mod_eq_of_lt h₁]; apply Nat.le_refl
|
||||
@@ -197,7 +217,6 @@ decreasing_by apply div_rec_lemma; assumption
|
||||
theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by
|
||||
rw [div_eq a, if_pos]; constructor <;> assumption
|
||||
|
||||
|
||||
theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by
|
||||
induction m, k using mod.inductionOn with rw [div_eq, mod_eq]
|
||||
| base x y h => simp [h]
|
||||
|
||||
@@ -84,9 +84,6 @@ protected theorem add_lt_add_of_lt_of_le {a b c d : Nat} (hlt : a < b) (hle : c
|
||||
a + c < b + d :=
|
||||
Nat.lt_of_le_of_lt (Nat.add_le_add_left hle _) (Nat.add_lt_add_right hlt _)
|
||||
|
||||
protected theorem lt_add_of_pos_left : 0 < k → n < k + n := by
|
||||
rw [Nat.add_comm]; exact Nat.lt_add_of_pos_right
|
||||
|
||||
protected theorem pos_of_lt_add_right (h : n < n + k) : 0 < k :=
|
||||
Nat.lt_of_add_lt_add_left h
|
||||
|
||||
@@ -233,6 +230,17 @@ instance : Std.Associative (α := Nat) min := ⟨Nat.min_assoc⟩
|
||||
@[simp] protected theorem min_self_assoc' {m n : Nat} : min n (min m n) = min n m := by
|
||||
rw [Nat.min_comm m n, ← Nat.min_assoc, Nat.min_self]
|
||||
|
||||
@[simp] theorem min_add_left {a b : Nat} : min a (b + a) = a := by
|
||||
rw [Nat.min_def]
|
||||
simp
|
||||
@[simp] theorem min_add_right {a b : Nat} : min a (a + b) = a := by
|
||||
rw [Nat.min_def]
|
||||
simp
|
||||
@[simp] theorem add_left_min {a b : Nat} : min (b + a) a = a := by
|
||||
rw [Nat.min_comm, min_add_left]
|
||||
@[simp] theorem add_right_min {a b : Nat} : min (a + b) a = a := by
|
||||
rw [Nat.min_comm, min_add_right]
|
||||
|
||||
protected theorem sub_sub_eq_min : ∀ (a b : Nat), a - (a - b) = min a b
|
||||
| 0, _ => by rw [Nat.zero_sub, Nat.zero_min]
|
||||
| _, 0 => by rw [Nat.sub_zero, Nat.sub_self, Nat.min_zero]
|
||||
@@ -287,6 +295,17 @@ protected theorem max_assoc : ∀ (a b c : Nat), max (max a b) c = max a (max b
|
||||
| _+1, _+1, _+1 => by simp only [Nat.succ_max_succ]; exact congrArg succ <| Nat.max_assoc ..
|
||||
instance : Std.Associative (α := Nat) max := ⟨Nat.max_assoc⟩
|
||||
|
||||
@[simp] theorem max_add_left {a b : Nat} : max a (b + a) = b + a := by
|
||||
rw [Nat.max_def]
|
||||
simp
|
||||
@[simp] theorem max_add_right {a b : Nat} : max a (a + b) = a + b := by
|
||||
rw [Nat.max_def]
|
||||
simp
|
||||
@[simp] theorem add_left_max {a b : Nat} : max (b + a) a = b + a := by
|
||||
rw [Nat.max_comm, max_add_left]
|
||||
@[simp] theorem add_right_max {a b : Nat} : max (a + b) a = a + b := by
|
||||
rw [Nat.max_comm, max_add_right]
|
||||
|
||||
protected theorem sub_add_eq_max (a b : Nat) : a - b + b = max a b := by
|
||||
match Nat.le_total a b with
|
||||
| .inl hl => rw [Nat.max_eq_right hl, Nat.sub_eq_zero_iff_le.mpr hl, Nat.zero_add]
|
||||
@@ -586,6 +605,9 @@ theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by
|
||||
| zero => simp_all
|
||||
| succ k => omega
|
||||
|
||||
@[simp] theorem mod_mul_mod {a b c : Nat} : (a % c * b) % c = a * b % c := by
|
||||
rw [mul_mod, mod_mod, ← mul_mod]
|
||||
|
||||
/-! ### pow -/
|
||||
|
||||
theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by
|
||||
@@ -748,6 +770,16 @@ protected theorem two_pow_pred_mod_two_pow (h : 0 < w) :
|
||||
rw [mod_eq_of_lt]
|
||||
apply Nat.pow_pred_lt_pow (by omega) h
|
||||
|
||||
protected theorem pow_lt_pow_iff_pow_mul_le_pow {a n m : Nat} (h : 1 < a) :
|
||||
a ^ n < a ^ m ↔ a ^ n * a ≤ a ^ m := by
|
||||
rw [←Nat.pow_add_one, Nat.pow_le_pow_iff_right (by omega), Nat.pow_lt_pow_iff_right (by omega)]
|
||||
omega
|
||||
|
||||
@[simp]
|
||||
theorem two_pow_pred_mul_two (h : 0 < w) :
|
||||
2 ^ (w - 1) * 2 = 2 ^ w := by
|
||||
simp [← Nat.pow_succ, Nat.sub_add_cancel h]
|
||||
|
||||
/-! ### log2 -/
|
||||
|
||||
@[simp]
|
||||
|
||||
@@ -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: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega
|
||||
@@ -15,7 +15,7 @@ in particular
|
||||
and its corollary
|
||||
`Nat.mod_pow_succ : x % b ^ (k + 1) = x % b ^ k + b ^ k * ((x / b ^ k) % b)`.
|
||||
|
||||
It contains the necesssary preliminary results relating order and `*` and `/`,
|
||||
It contains the necessary preliminary results relating order and `*` and `/`,
|
||||
which should probably be moved to their own file.
|
||||
-/
|
||||
|
||||
|
||||
@@ -35,4 +35,4 @@ theorem neZero_iff {n : R} : NeZero n ↔ n ≠ 0 :=
|
||||
⟨fun h ↦ h.out, NeZero.mk⟩
|
||||
|
||||
@[simp] theorem neZero_zero_iff_false {α : Type _} [Zero α] : NeZero (0 : α) ↔ False :=
|
||||
⟨fun h ↦ h.ne rfl, fun h ↦ h.elim⟩
|
||||
⟨fun _ ↦ NeZero.ne (0 : α) rfl, fun h ↦ h.elim⟩
|
||||
|
||||
@@ -6,6 +6,7 @@ Authors: Mario Carneiro
|
||||
prelude
|
||||
import Init.Data.Option.BasicAux
|
||||
import Init.Data.Option.Instances
|
||||
import Init.Data.BEq
|
||||
import Init.Classical
|
||||
import Init.Ext
|
||||
|
||||
@@ -13,7 +14,7 @@ namespace Option
|
||||
|
||||
theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = some a := .rfl
|
||||
|
||||
@[simp] theorem mem_some {a b : α} : a ∈ some b ↔ b = a := by simp [mem_iff]
|
||||
theorem mem_some {a b : α} : a ∈ some b ↔ b = a := by simp
|
||||
|
||||
theorem mem_some_self (a : α) : a ∈ some a := mem_some.2 rfl
|
||||
|
||||
@@ -230,7 +231,7 @@ theorem isSome_filter_of_isSome (p : α → Bool) (o : Option α) (h : (o.filter
|
||||
o.isSome := by
|
||||
cases o <;> simp at h ⊢
|
||||
|
||||
@[simp] theorem filter_eq_none (p : α → Bool) :
|
||||
@[simp] theorem filter_eq_none {p : α → Bool} :
|
||||
Option.filter p o = none ↔ o = none ∨ ∀ a, a ∈ o → ¬ p a := by
|
||||
cases o <;> simp [filter_some]
|
||||
|
||||
@@ -247,7 +248,7 @@ theorem isSome_filter_of_isSome (p : α → Bool) (o : Option α) (h : (o.filter
|
||||
theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
|
||||
x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
|
||||
|
||||
@[simp] theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
|
||||
theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
|
||||
(x.map f).bind g = x.bind (g ∘ f) := by cases x <;> simp
|
||||
|
||||
@[simp] theorem map_bind {f : α → Option β} {g : β → γ} {x : Option α} :
|
||||
@@ -411,27 +412,42 @@ variable [BEq α]
|
||||
@[simp] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
|
||||
@[simp] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
|
||||
|
||||
@[simp] theorem reflBEq_iff : ReflBEq (Option α) ↔ ReflBEq α := by
|
||||
constructor
|
||||
· intro h
|
||||
constructor
|
||||
intro a
|
||||
suffices (some a == some a) = true by
|
||||
simpa only [some_beq_some]
|
||||
simp
|
||||
· intro h
|
||||
constructor
|
||||
· rintro (_ | a) <;> simp
|
||||
|
||||
@[simp] theorem lawfulBEq_iff : LawfulBEq (Option α) ↔ LawfulBEq α := by
|
||||
constructor
|
||||
· intro h
|
||||
constructor
|
||||
· intro a b h
|
||||
apply Option.some.inj
|
||||
apply eq_of_beq
|
||||
simpa
|
||||
· intro a
|
||||
suffices (some a == some a) = true by
|
||||
simpa only [some_beq_some]
|
||||
simp
|
||||
· intro h
|
||||
constructor
|
||||
· intro a b h
|
||||
simpa using h
|
||||
· intro a
|
||||
simp
|
||||
|
||||
end beq
|
||||
|
||||
/-! ### ite -/
|
||||
section ite
|
||||
|
||||
@[simp] theorem mem_dite_none_left {x : α} [Decidable p] {l : ¬ p → Option α} :
|
||||
(x ∈ if h : p then none else l h) ↔ ∃ h : ¬ p, x ∈ l h := by
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem mem_dite_none_right {x : α} [Decidable p] {l : p → Option α} :
|
||||
(x ∈ if h : p then l h else none) ↔ ∃ h : p, x ∈ l h := by
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem mem_ite_none_left {x : α} [Decidable p] {l : Option α} :
|
||||
(x ∈ if p then none else l) ↔ ¬ p ∧ x ∈ l := by
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem mem_ite_none_right {x : α} [Decidable p] {l : Option α} :
|
||||
(x ∈ if p then l else none) ↔ p ∧ x ∈ l := by
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem dite_none_left_eq_some {p : Prop} [Decidable p] {b : ¬p → Option β} :
|
||||
(if h : p then none else b h) = some a ↔ ∃ h, b h = some a := by
|
||||
split <;> simp_all
|
||||
@@ -464,6 +480,22 @@ section ite
|
||||
some a = (if p then b else none) ↔ p ∧ some a = b := by
|
||||
split <;> simp_all
|
||||
|
||||
theorem mem_dite_none_left {x : α} [Decidable p] {l : ¬ p → Option α} :
|
||||
(x ∈ if h : p then none else l h) ↔ ∃ h : ¬ p, x ∈ l h := by
|
||||
simp
|
||||
|
||||
theorem mem_dite_none_right {x : α} [Decidable p] {l : p → Option α} :
|
||||
(x ∈ if h : p then l h else none) ↔ ∃ h : p, x ∈ l h := by
|
||||
simp
|
||||
|
||||
theorem mem_ite_none_left {x : α} [Decidable p] {l : Option α} :
|
||||
(x ∈ if p then none else l) ↔ ¬ p ∧ x ∈ l := by
|
||||
simp
|
||||
|
||||
theorem mem_ite_none_right {x : α} [Decidable p] {l : Option α} :
|
||||
(x ∈ if p then l else none) ↔ p ∧ x ∈ l := by
|
||||
simp
|
||||
|
||||
@[simp] theorem isSome_dite {p : Prop} [Decidable p] {b : p → β} :
|
||||
(if h : p then some (b h) else none).isSome = true ↔ p := by
|
||||
split <;> simpa
|
||||
|
||||
@@ -51,6 +51,12 @@ instance [Repr α] : Repr (id α) :=
|
||||
instance [Repr α] : Repr (Id α) :=
|
||||
inferInstanceAs (Repr α)
|
||||
|
||||
/-
|
||||
This instance allows us to use `Empty` as a type parameter without causing instance synthesis to fail.
|
||||
-/
|
||||
instance : Repr Empty where
|
||||
reprPrec := nofun
|
||||
|
||||
instance : Repr Bool where
|
||||
reprPrec
|
||||
| true, _ => "true"
|
||||
|
||||
@@ -290,11 +290,17 @@ instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
|
||||
instance : Max UInt64 := maxOfLe
|
||||
instance : Min UInt64 := minOfLe
|
||||
|
||||
-- This instance would interfere with the global instance `NeZero (n + 1)`,
|
||||
-- so we only enable it locally.
|
||||
@[local instance]
|
||||
private def instNeZeroUSizeSize : NeZero USize.size := ⟨add_one_ne_zero _⟩
|
||||
|
||||
@[deprecated (since := "2024-09-16")]
|
||||
theorem usize_size_gt_zero : USize.size > 0 :=
|
||||
Nat.zero_lt_succ ..
|
||||
|
||||
@[extern "lean_usize_of_nat"]
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' n usize_size_gt_zero⟩
|
||||
def USize.ofNat (n : @& Nat) : USize := ⟨Fin.ofNat' _ n⟩
|
||||
abbrev Nat.toUSize := USize.ofNat
|
||||
@[extern "lean_usize_to_nat"]
|
||||
def USize.toNat (n : USize) : Nat := n.val.val
|
||||
|
||||
@@ -156,11 +156,11 @@ theorem getElem?_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem d
|
||||
theorem getElem!_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
|
||||
[Inhabited elem] (c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] :
|
||||
c[i]! = c[i]'h := by
|
||||
simp only [getElem!_def, getElem?_def, h]
|
||||
simp [getElem!_def, getElem?_def, h]
|
||||
|
||||
theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
|
||||
[Inhabited elem] (c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]! = default := by
|
||||
simp only [getElem!_def, getElem?_def, h]
|
||||
simp [getElem!_def, getElem?_def, h]
|
||||
|
||||
namespace Fin
|
||||
|
||||
|
||||
@@ -7,7 +7,7 @@ Additional goodies for writing macros
|
||||
-/
|
||||
prelude
|
||||
import Init.MetaTypes
|
||||
import Init.Data.Array.Basic
|
||||
import Init.Data.Array.GetLit
|
||||
import Init.Data.Option.BasicAux
|
||||
|
||||
namespace Lean
|
||||
@@ -862,7 +862,7 @@ partial def decodeRawStrLitAux (s : String) (i : String.Pos) (num : Nat) : Strin
|
||||
/--
|
||||
Takes the string literal lexical syntax parsed by the parser and interprets it as a string.
|
||||
This is where escape sequences are processed for example.
|
||||
The string `s` is is either a plain string literal or a raw string literal.
|
||||
The string `s` is either a plain string literal or a raw string literal.
|
||||
|
||||
If it returns `none` then the string literal is ill-formed, which indicates a bug in the parser.
|
||||
The function is not required to return `none` if the string literal is ill-formed.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.Int
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.IntList
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.LinearCombo
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.DivMod
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Zip
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.Coeffs
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
Authors: Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.PropLemmas
|
||||
|
||||
@@ -754,10 +754,11 @@ infer the proof of `Nonempty α`.
|
||||
noncomputable def Classical.ofNonempty {α : Sort u} [Nonempty α] : α :=
|
||||
Classical.choice inferInstance
|
||||
|
||||
instance (α : Sort u) {β : Sort v} [Nonempty β] : Nonempty (α → β) :=
|
||||
instance {α : Sort u} {β : Sort v} [Nonempty β] : Nonempty (α → β) :=
|
||||
Nonempty.intro fun _ => Classical.ofNonempty
|
||||
|
||||
instance (α : Sort u) {β : α → Sort v} [(a : α) → Nonempty (β a)] : Nonempty ((a : α) → β a) :=
|
||||
instance Pi.instNonempty {α : Sort u} {β : α → Sort v} [(a : α) → Nonempty (β a)] :
|
||||
Nonempty ((a : α) → β a) :=
|
||||
Nonempty.intro fun _ => Classical.ofNonempty
|
||||
|
||||
instance : Inhabited (Sort u) where
|
||||
@@ -766,7 +767,8 @@ instance : Inhabited (Sort u) where
|
||||
instance (α : Sort u) {β : Sort v} [Inhabited β] : Inhabited (α → β) where
|
||||
default := fun _ => default
|
||||
|
||||
instance (α : Sort u) {β : α → Sort v} [(a : α) → Inhabited (β a)] : Inhabited ((a : α) → β a) where
|
||||
instance Pi.instInhabited {α : Sort u} {β : α → Sort v} [(a : α) → Inhabited (β a)] :
|
||||
Inhabited ((a : α) → β a) where
|
||||
default := fun _ => default
|
||||
|
||||
deriving instance Inhabited for Bool
|
||||
@@ -1014,7 +1016,7 @@ with `Or : Prop → Prop → Prop`, which is the propositional connective).
|
||||
It is `@[macro_inline]` because it has C-like short-circuiting behavior:
|
||||
if `x` is true then `y` is not evaluated.
|
||||
-/
|
||||
@[macro_inline] def or (x y : Bool) : Bool :=
|
||||
@[macro_inline] def Bool.or (x y : Bool) : Bool :=
|
||||
match x with
|
||||
| true => true
|
||||
| false => y
|
||||
@@ -1025,7 +1027,7 @@ with `And : Prop → Prop → Prop`, which is the propositional connective).
|
||||
It is `@[macro_inline]` because it has C-like short-circuiting behavior:
|
||||
if `x` is false then `y` is not evaluated.
|
||||
-/
|
||||
@[macro_inline] def and (x y : Bool) : Bool :=
|
||||
@[macro_inline] def Bool.and (x y : Bool) : Bool :=
|
||||
match x with
|
||||
| false => false
|
||||
| true => y
|
||||
@@ -1034,10 +1036,12 @@ if `x` is false then `y` is not evaluated.
|
||||
`not x`, or `!x`, is the boolean "not" operation (not to be confused
|
||||
with `Not : Prop → Prop`, which is the propositional connective).
|
||||
-/
|
||||
@[inline] def not : Bool → Bool
|
||||
@[inline] def Bool.not : Bool → Bool
|
||||
| true => false
|
||||
| false => true
|
||||
|
||||
export Bool (or and not)
|
||||
|
||||
/--
|
||||
The type of natural numbers, starting at zero. It is defined as an
|
||||
inductive type freely generated by "zero is a natural number" and
|
||||
@@ -1208,7 +1212,7 @@ class HDiv (α : Type u) (β : Type v) (γ : outParam (Type w)) where
|
||||
* For most types like `Nat`, `Int`, `Rat`, `Real`, `a / 0` is defined to be `0`.
|
||||
* For `Nat`, `a / b` rounds downwards.
|
||||
* For `Int`, `a / b` rounds downwards if `b` is positive or upwards if `b` is negative.
|
||||
It is implemented as `Int.ediv`, the unique function satisfiying
|
||||
It is implemented as `Int.ediv`, the unique function satisfying
|
||||
`a % b + b * (a / b) = a` and `0 ≤ a % b < natAbs b` for `b ≠ 0`.
|
||||
Other rounding conventions are available using the functions
|
||||
`Int.fdiv` (floor rounding) and `Int.div` (truncation rounding).
|
||||
@@ -1362,7 +1366,7 @@ class Pow (α : Type u) (β : Type v) where
|
||||
/-- `a ^ b` computes `a` to the power of `b`. See `HPow`. -/
|
||||
pow : α → β → α
|
||||
|
||||
/-- The homogenous version of `Pow` where the exponent is a `Nat`.
|
||||
/-- The homogeneous version of `Pow` where the exponent is a `Nat`.
|
||||
The purpose of this class is that it provides a default `Pow` instance,
|
||||
which can be used to specialize the exponent to `Nat` during elaboration.
|
||||
|
||||
@@ -2063,7 +2067,7 @@ The size of type `USize`, that is, `2^System.Platform.numBits`, which may
|
||||
be either `2^32` or `2^64` depending on the platform's architecture.
|
||||
|
||||
Remark: we define `USize.size` using `(2^numBits - 1) + 1` to ensure the
|
||||
Lean unifier can solve contraints such as `?m + 1 = USize.size`. Recall that
|
||||
Lean unifier can solve constraints such as `?m + 1 = USize.size`. Recall that
|
||||
`numBits` does not reduce to a numeral in the Lean kernel since it is platform
|
||||
specific. Without this trick, the following definition would be rejected by the
|
||||
Lean type checker.
|
||||
@@ -2566,7 +2570,9 @@ structure Array (α : Type u) where
|
||||
/--
|
||||
Converts a `List α` into an `Array α`.
|
||||
|
||||
At runtime, this constructor is implemented by `List.toArray` and is O(n) in the length of the
|
||||
You can also use the synonym `List.toArray` when dot notation is convenient.
|
||||
|
||||
At runtime, this constructor is implemented by `List.toArrayImpl` and is O(n) in the length of the
|
||||
list.
|
||||
-/
|
||||
mk ::
|
||||
@@ -2580,6 +2586,9 @@ structure Array (α : Type u) where
|
||||
attribute [extern "lean_array_to_list"] Array.toList
|
||||
attribute [extern "lean_array_mk"] Array.mk
|
||||
|
||||
@[inherit_doc Array.mk, match_pattern]
|
||||
abbrev List.toArray (xs : List α) : Array α := .mk xs
|
||||
|
||||
/-- Construct a new empty array with initial capacity `c`. -/
|
||||
@[extern "lean_mk_empty_array_with_capacity"]
|
||||
def Array.mkEmpty {α : Type u} (c : @& Nat) : Array α where
|
||||
@@ -2707,7 +2716,10 @@ def Array.extract (as : Array α) (start stop : Nat) : Array α :=
|
||||
let sz' := Nat.sub (min stop as.size) start
|
||||
loop sz' start (mkEmpty sz')
|
||||
|
||||
/-- Auxiliary definition for `List.toArray`. -/
|
||||
/--
|
||||
Auxiliary definition for `List.toArray`.
|
||||
`List.toArrayAux as r = r ++ as.toArray`
|
||||
-/
|
||||
@[inline_if_reduce]
|
||||
def List.toArrayAux : List α → Array α → Array α
|
||||
| nil, r => r
|
||||
@@ -2723,7 +2735,7 @@ def List.redLength : List α → Nat
|
||||
-- This function is exported to C, where it is called by `Array.mk`
|
||||
-- (the constructor) to implement this functionality.
|
||||
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
|
||||
def List.toArray (as : List α) : Array α :=
|
||||
def List.toArrayImpl (as : List α) : Array α :=
|
||||
as.toArrayAux (Array.mkEmpty as.redLength)
|
||||
|
||||
/-- The typeclass which supplies the `>>=` "bind" function. See `Monad`. -/
|
||||
|
||||
@@ -231,8 +231,21 @@ instance : Std.Associative (· || ·) := ⟨Bool.or_assoc⟩
|
||||
@[simp] theorem Bool.not_false : (!false) = true := by decide
|
||||
@[simp] theorem beq_true (b : Bool) : (b == true) = b := by cases b <;> rfl
|
||||
@[simp] theorem beq_false (b : Bool) : (b == false) = !b := by cases b <;> rfl
|
||||
@[simp] theorem Bool.not_eq_true' (b : Bool) : ((!b) = true) = (b = false) := by cases b <;> simp
|
||||
@[simp] theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by cases b <;> simp
|
||||
|
||||
|
||||
/--
|
||||
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 Bool.not_eq_eq_eq_not {a b : Bool} : ((!a) = b) ↔ (a = !b) := by
|
||||
cases a <;> cases b <;> simp
|
||||
|
||||
@[simp] theorem Bool.not_eq_not {a b : Bool} : ¬a = !b ↔ a = b := by
|
||||
cases a <;> cases b <;> simp
|
||||
theorem Bool.not_not_eq {a b : Bool} : ¬(!a) = b ↔ a = b := by simp
|
||||
|
||||
theorem Bool.not_eq_true' (b : Bool) : ((!b) = true) = (b = false) := by simp
|
||||
theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by simp
|
||||
|
||||
@[simp] theorem Bool.not_eq_true (b : Bool) : (¬(b = true)) = (b = false) := by cases b <;> decide
|
||||
@[simp] theorem Bool.not_eq_false (b : Bool) : (¬(b = false)) = (b = true) := by cases b <;> decide
|
||||
|
||||
@@ -149,26 +149,27 @@ syntax (name := assumption) "assumption" : tactic
|
||||
|
||||
/--
|
||||
`contradiction` closes the main goal if its hypotheses are "trivially contradictory".
|
||||
|
||||
- Inductive type/family with no applicable constructors
|
||||
```lean
|
||||
example (h : False) : p := by contradiction
|
||||
```
|
||||
```lean
|
||||
example (h : False) : p := by contradiction
|
||||
```
|
||||
- Injectivity of constructors
|
||||
```lean
|
||||
example (h : none = some true) : p := by contradiction --
|
||||
```
|
||||
```lean
|
||||
example (h : none = some true) : p := by contradiction --
|
||||
```
|
||||
- Decidable false proposition
|
||||
```lean
|
||||
example (h : 2 + 2 = 3) : p := by contradiction
|
||||
```
|
||||
```lean
|
||||
example (h : 2 + 2 = 3) : p := by contradiction
|
||||
```
|
||||
- Contradictory hypotheses
|
||||
```lean
|
||||
example (h : p) (h' : ¬ p) : q := by contradiction
|
||||
```
|
||||
```lean
|
||||
example (h : p) (h' : ¬ p) : q := by contradiction
|
||||
```
|
||||
- Other simple contradictions such as
|
||||
```lean
|
||||
example (x : Nat) (h : x ≠ x) : p := by contradiction
|
||||
```
|
||||
```lean
|
||||
example (x : Nat) (h : x ≠ x) : p := by contradiction
|
||||
```
|
||||
-/
|
||||
syntax (name := contradiction) "contradiction" : tactic
|
||||
|
||||
@@ -363,31 +364,24 @@ syntax (name := fail) "fail" (ppSpace str)? : tactic
|
||||
syntax (name := eqRefl) "eq_refl" : tactic
|
||||
|
||||
/--
|
||||
`rfl` tries to close the current goal using reflexivity.
|
||||
This is supposed to be an extensible tactic and users can add their own support
|
||||
for new reflexive relations.
|
||||
|
||||
Remark: `rfl` is an extensible tactic. We later add `macro_rules` to try different
|
||||
reflexivity theorems (e.g., `Iff.rfl`).
|
||||
This tactic applies to a goal whose target has the form `x ~ x`,
|
||||
where `~` is equality, heterogeneous equality or any relation that
|
||||
has a reflexivity lemma tagged with the attribute @[refl].
|
||||
-/
|
||||
macro "rfl" : tactic => `(tactic| case' _ => fail "The rfl tactic failed. Possible reasons:
|
||||
- The goal is not a reflexive relation (neither `=` nor a relation with a @[refl] lemma).
|
||||
- The arguments of the relation are not equal.
|
||||
Try using the reflexivity lemma for your relation explicitly, e.g. `exact Eq.refl _` or
|
||||
`exact HEq.rfl` etc.")
|
||||
|
||||
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
|
||||
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
|
||||
syntax "rfl" : tactic
|
||||
|
||||
/--
|
||||
This tactic applies to a goal whose target has the form `x ~ x`,
|
||||
where `~` is a reflexive relation other than `=`,
|
||||
that is, a relation which has a reflexive lemma tagged with the attribute @[refl].
|
||||
The same as `rfl`, but without trying `eq_refl` at the end.
|
||||
-/
|
||||
syntax (name := applyRfl) "apply_rfl" : tactic
|
||||
|
||||
-- We try `apply_rfl` first, beause it produces a nice error message
|
||||
macro_rules | `(tactic| rfl) => `(tactic| apply_rfl)
|
||||
|
||||
-- But, mostly for backward compatibility, we try `eq_refl` too (reduces more aggressively)
|
||||
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
|
||||
-- Als for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
|
||||
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
|
||||
/--
|
||||
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
|
||||
theorems included (relevant for declarations defined by well-founded recursion).
|
||||
@@ -456,7 +450,7 @@ syntax (name := change) "change " term (location)? : tactic
|
||||
|
||||
/--
|
||||
* `change a with b` will change occurrences of `a` to `b` in the goal,
|
||||
assuming `a` and `b` are are definitionally equal.
|
||||
assuming `a` and `b` are definitionally equal.
|
||||
* `change a with b at h` similarly changes `a` to `b` in the type of hypothesis `h`.
|
||||
-/
|
||||
syntax (name := changeWith) "change " term " with " term (location)? : tactic
|
||||
@@ -773,8 +767,9 @@ macro_rules
|
||||
macro "refine_lift' " e:term : tactic => `(tactic| focus (refine' no_implicit_lambda% $e; rotate_right))
|
||||
/-- Similar to `have`, but using `refine'` -/
|
||||
macro "have' " d:haveDecl : tactic => `(tactic| refine_lift' have $d:haveDecl; ?_)
|
||||
/-- Similar to `have`, but using `refine'` -/
|
||||
set_option linter.missingDocs false in -- OK, because `tactic_alt` causes inheritance of docs
|
||||
macro (priority := high) "have'" x:ident " := " p:term : tactic => `(tactic| have' $x:ident : _ := $p)
|
||||
attribute [tactic_alt tacticHave'_] «tacticHave'_:=_»
|
||||
/-- Similar to `let`, but using `refine'` -/
|
||||
macro "let' " d:letDecl : tactic => `(tactic| refine_lift' let $d:letDecl; ?_)
|
||||
|
||||
@@ -793,7 +788,7 @@ syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
|
||||
After `with`, there is an optional tactic that runs on all branches, and
|
||||
then a list of alternatives.
|
||||
-/
|
||||
syntax inductionAlts := " with" (ppSpace tactic)? withPosition((colGe inductionAlt)+)
|
||||
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
|
||||
|
||||
/--
|
||||
Assuming `x` is a variable in the local context with an inductive type,
|
||||
@@ -1588,7 +1583,7 @@ macro "get_elem_tactic" : tactic =>
|
||||
There is a proof embedded in the right-hand-side, and we want it to be just `hi`.
|
||||
If `omega` is used to "fill" this proof, we will have a more complex proof term that
|
||||
cannot be inferred by unification.
|
||||
We hardcoded `assumption` here to ensure users cannot accidentaly break this IF
|
||||
We hardcoded `assumption` here to ensure users cannot accidentally break this IF
|
||||
they add new `macro_rules` for `get_elem_tactic_trivial`.
|
||||
|
||||
TODO: Implement priorities for `macro_rules`.
|
||||
@@ -1598,7 +1593,7 @@ macro "get_elem_tactic" : tactic =>
|
||||
| get_elem_tactic_trivial
|
||||
| fail "failed to prove index is valid, possible solutions:
|
||||
- Use `have`-expressions to prove the index is valid
|
||||
- Use `a[i]!` notation instead, runtime check is perfomed, and 'Panic' error message is produced if index is not valid
|
||||
- Use `a[i]!` notation instead, runtime check is performed, and 'Panic' error message is produced if index is not valid
|
||||
- Use `a[i]?` notation instead, result is an `Option` type
|
||||
- Use `a[i]'h` notation instead, where `h` is a proof that index is valid"
|
||||
)
|
||||
|
||||
@@ -20,7 +20,7 @@ macro "simp_wf" : tactic =>
|
||||
|
||||
/--
|
||||
This tactic is used internally by lean before presenting the proof obligations from a well-founded
|
||||
definition to the user via `decreasing_by`. It is not necessary to use this tactic manuall.
|
||||
definition to the user via `decreasing_by`. It is not necessary to use this tactic manually.
|
||||
-/
|
||||
macro "clean_wf" : tactic =>
|
||||
`(tactic| simp
|
||||
|
||||
@@ -68,7 +68,7 @@ namespace InitParamMap
|
||||
def initBorrow (ps : Array Param) : Array Param :=
|
||||
ps.map fun p => { p with borrow := p.ty.isObj }
|
||||
|
||||
/-- We do perform borrow inference for constants marked as `export`.
|
||||
/-- We do not perform borrow inference for constants marked as `export`.
|
||||
Reason: we current write wrappers in C++ for using exported functions.
|
||||
These wrappers use smart pointers such as `object_ref`.
|
||||
When writing a new wrapper we need to know whether an argument is a borrow
|
||||
|
||||
@@ -91,7 +91,7 @@ private def isBorrowParamAux (x : VarId) (ys : Array Arg) (consumeParamPred : Na
|
||||
| Arg.var y => x == y && !consumeParamPred i
|
||||
|
||||
private def isBorrowParam (x : VarId) (ys : Array Arg) (ps : Array Param) : Bool :=
|
||||
isBorrowParamAux x ys fun i => not ps[i]!.borrow
|
||||
isBorrowParamAux x ys fun i => ! ps[i]!.borrow
|
||||
|
||||
/--
|
||||
Return `n`, the number of times `x` is consumed.
|
||||
@@ -124,7 +124,7 @@ private def addIncBeforeAux (ctx : Context) (xs : Array Arg) (consumeParamPred :
|
||||
addInc ctx x b numIncs
|
||||
|
||||
private def addIncBefore (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
|
||||
addIncBeforeAux ctx xs (fun i => not ps[i]!.borrow) b liveVarsAfter
|
||||
addIncBeforeAux ctx xs (fun i => ! ps[i]!.borrow) b liveVarsAfter
|
||||
|
||||
/-- See `addIncBeforeAux`/`addIncBefore` for the procedure that inserts `inc` operations before an application. -/
|
||||
private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody :=
|
||||
|
||||
@@ -103,7 +103,7 @@ private def mkFresh : M VarId := do
|
||||
|
||||
/--
|
||||
Helper function for applying `S`. We only introduce a `reset` if we managed
|
||||
to replace a `ctor` withe `reuse` in `b`.
|
||||
to replace a `ctor` with `reuse` in `b`.
|
||||
-/
|
||||
private def tryS (x : VarId) (c : CtorInfo) (b : FnBody) : M FnBody := do
|
||||
let w ← mkFresh
|
||||
|
||||
@@ -242,7 +242,7 @@ structure ExtendState where
|
||||
/--
|
||||
A map from join point `FVarId`s to a respective map from free variables
|
||||
to `Param`s. The free variables in this map are the once that the context
|
||||
of said join point will be extended by by passing in the respective parameter.
|
||||
of said join point will be extended by passing in the respective parameter.
|
||||
-/
|
||||
fvarMap : Std.HashMap FVarId (Std.HashMap FVarId Param) := {}
|
||||
|
||||
|
||||
@@ -35,7 +35,7 @@ def checkIsDefinition (env : Environment) (n : Name) : Except String Unit :=
|
||||
match env.find? n with
|
||||
| (some (ConstantInfo.defnInfo _)) => Except.ok ()
|
||||
| (some (ConstantInfo.opaqueInfo _)) => Except.ok ()
|
||||
| none => Except.error s!"unknow declaration '{n}'"
|
||||
| none => Except.error s!"unknown declaration '{n}'"
|
||||
| _ => Except.error s!"declaration is not a definition '{n}'"
|
||||
|
||||
/--
|
||||
|
||||
@@ -195,7 +195,7 @@ def insert' (m : HashMap α β) (a : α) (b : β) : HashMap α β × Bool :=
|
||||
|
||||
/--
|
||||
Similar to `insert`, but returns `some old` if the map already had an entry `α → old`.
|
||||
If the result is `some old`, the the resulting map is equal to `m`. -/
|
||||
If the result is `some old`, the resulting map is equal to `m`. -/
|
||||
def insertIfNew (m : HashMap α β) (a : α) (b : β) : HashMap α β × Option β :=
|
||||
match m with
|
||||
| ⟨ m, hw ⟩ =>
|
||||
|
||||
@@ -28,6 +28,12 @@ instance : ToJson Json := ⟨id⟩
|
||||
instance : FromJson JsonNumber := ⟨Json.getNum?⟩
|
||||
instance : ToJson JsonNumber := ⟨Json.num⟩
|
||||
|
||||
instance : FromJson Empty where
|
||||
fromJson? j := throw (s!"type Empty has no constructor to match JSON value '{j}'. \
|
||||
This occurs when deserializing a value for type Empty, \
|
||||
e.g. at type Option Empty with code for the 'some' constructor.")
|
||||
|
||||
instance : ToJson Empty := ⟨nofun⟩
|
||||
-- looks like id, but there are coercions happening
|
||||
instance : FromJson Bool := ⟨Json.getBool?⟩
|
||||
instance : ToJson Bool := ⟨fun b => b⟩
|
||||
|
||||
@@ -266,7 +266,7 @@ instance [FromJson α] : FromJson (Notification α) where
|
||||
let params := params?
|
||||
let param : α ← fromJson? (toJson params)
|
||||
pure $ ⟨method, param⟩
|
||||
else throw "not a notfication"
|
||||
else throw "not a notification"
|
||||
|
||||
end Lean.JsonRpc
|
||||
|
||||
|
||||
@@ -36,7 +36,7 @@ instance : FromJson Trace := ⟨fun j =>
|
||||
| Except.ok "off" => return Trace.off
|
||||
| Except.ok "messages" => return Trace.messages
|
||||
| Except.ok "verbose" => return Trace.verbose
|
||||
| _ => throw "uknown trace"⟩
|
||||
| _ => throw "unknown trace"⟩
|
||||
|
||||
instance Trace.hasToJson : ToJson Trace :=
|
||||
⟨fun
|
||||
|
||||
@@ -317,8 +317,8 @@ variable {m : Type → Type w} [Monad m]
|
||||
anyMAux p t.root <||> t.tail.anyM p
|
||||
|
||||
@[inline] def allM (a : PersistentArray α) (p : α → m Bool) : m Bool := do
|
||||
let b ← anyM a (fun v => do let b ← p v; pure (not b))
|
||||
pure (not b)
|
||||
let b ← anyM a (fun v => do let b ← p v; pure (!b))
|
||||
pure (!b)
|
||||
|
||||
end
|
||||
|
||||
|
||||
@@ -239,7 +239,7 @@ structure InductiveVal extends ConstantVal where
|
||||
all : List Name
|
||||
/-- List of the names of the constructors for this inductive datatype. -/
|
||||
ctors : List Name
|
||||
/-- Number of auxillary data types produced from nested occurrences.
|
||||
/-- Number of auxiliary data types produced from nested occurrences.
|
||||
An inductive definition `T` is nested when there is a constructor with an argument `x : F T`,
|
||||
where `F : Type → Type` is some suitably behaved (ie strictly positive) function (Eg `Array T`, `List T`, `T × T`, ...). -/
|
||||
numNested : Nat
|
||||
|
||||
@@ -411,21 +411,23 @@ private def finalize : M Expr := do
|
||||
synthesizeAppInstMVars
|
||||
return e
|
||||
|
||||
/-- Return `true` if there is a named argument that depends on the next argument. -/
|
||||
private def anyNamedArgDependsOnCurrent : M Bool := do
|
||||
/--
|
||||
Returns a named argument that depends on the next argument, otherwise `none`.
|
||||
-/
|
||||
private def findNamedArgDependsOnCurrent? : M (Option NamedArg) := do
|
||||
let s ← get
|
||||
if s.namedArgs.isEmpty then
|
||||
return false
|
||||
return none
|
||||
else
|
||||
forallTelescopeReducing s.fType fun xs _ => do
|
||||
let curr := xs[0]!
|
||||
for i in [1:xs.size] do
|
||||
let xDecl ← xs[i]!.fvarId!.getDecl
|
||||
if s.namedArgs.any fun arg => arg.name == xDecl.userName then
|
||||
if let some arg := s.namedArgs.find? fun arg => arg.name == xDecl.userName then
|
||||
/- Remark: a default value at `optParam` does not count as a dependency -/
|
||||
if (← exprDependsOn xDecl.type.cleanupAnnotations curr.fvarId!) then
|
||||
return true
|
||||
return false
|
||||
return arg
|
||||
return none
|
||||
|
||||
|
||||
/-- Return `true` if there are regular or named arguments to be processed. -/
|
||||
@@ -433,11 +435,13 @@ private def hasArgsToProcess : M Bool := do
|
||||
let s ← get
|
||||
return !s.args.isEmpty || !s.namedArgs.isEmpty
|
||||
|
||||
/-- Return `true` if the next argument at `args` is of the form `_` -/
|
||||
private def isNextArgHole : M Bool := do
|
||||
/--
|
||||
Returns the argument syntax if the next argument at `args` is of the form `_`.
|
||||
-/
|
||||
private def nextArgHole? : M (Option Syntax) := do
|
||||
match (← get).args with
|
||||
| Arg.stx (Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure true
|
||||
| _ => pure false
|
||||
| Arg.stx stx@(Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure stx
|
||||
| _ => pure none
|
||||
|
||||
/--
|
||||
Return `true` if the next argument to be processed is the outparam of a local instance, and it the result type
|
||||
@@ -512,8 +516,9 @@ where
|
||||
|
||||
mutual
|
||||
/--
|
||||
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
|
||||
and then execute the main loop.-/
|
||||
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
|
||||
and then execute the main loop.
|
||||
-/
|
||||
private partial def addEtaArg (argName : Name) : M Expr := do
|
||||
let n ← getBindingName
|
||||
let type ← getArgExpectedType
|
||||
@@ -522,6 +527,9 @@ mutual
|
||||
addNewArg argName x
|
||||
main
|
||||
|
||||
/--
|
||||
Create a fresh metavariable for the implicit argument, add it to `f`, and thn execute the main loop.
|
||||
-/
|
||||
private partial def addImplicitArg (argName : Name) : M Expr := do
|
||||
let argType ← getArgExpectedType
|
||||
let arg ← if (← isNextOutParamOfLocalInstanceAndResult) then
|
||||
@@ -539,35 +547,47 @@ mutual
|
||||
main
|
||||
|
||||
/--
|
||||
Process a `fType` of the form `(x : A) → B x`.
|
||||
This method assume `fType` is a function type -/
|
||||
Process a `fType` of the form `(x : A) → B x`.
|
||||
This method assume `fType` is a function type.
|
||||
-/
|
||||
private partial def processExplicitArg (argName : Name) : M Expr := do
|
||||
match (← get).args with
|
||||
| arg::args =>
|
||||
if (← anyNamedArgDependsOnCurrent) then
|
||||
-- Note: currently the following test never succeeds in explicit mode since `@x.f` notation does not exist.
|
||||
if let some true := NamedArg.suppressDeps <$> (← findNamedArgDependsOnCurrent?) then
|
||||
/-
|
||||
We treat the explicit argument `argName` as implicit if we have named arguments that depend on it.
|
||||
The idea is that this explicit argument can be inferred using the type of the named argument one.
|
||||
Note that we also use this approach in the branch where there are no explicit arguments left.
|
||||
This is important to make sure the system behaves in a uniform way.
|
||||
Moreover, users rely on this behavior. For example, consider the example on issue #1851
|
||||
We treat the explicit argument `argName` as implicit
|
||||
if we have a named arguments that depends on it whose `suppressDeps` flag set to `true`.
|
||||
The motivation for this is class projections (issue #1851).
|
||||
In some cases, class projections can have explicit parameters. For example, in
|
||||
```
|
||||
class Approx {α : Type} (a : α) (X : Type) : Type where
|
||||
val : X
|
||||
|
||||
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)] [x : Approx x' X]
|
||||
|
||||
#check f.val
|
||||
#check f.val x.val
|
||||
```
|
||||
The type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`
|
||||
Note that the argument `a` is explicit since there is no way to infer it from the expected
|
||||
type or the type of other explicit arguments.
|
||||
Recall that `f.val` is sugar for `Approx.val (self := f)`. In both `#check` commands above
|
||||
the user assumed that `a` does not need to be provided since it can be inferred from the type
|
||||
of `self`.
|
||||
We used to that only in the branch where `(← get).args` was empty, but it created an asymmetry
|
||||
because `#check f.val` worked as expected, but one would have to write `#check f.val _ x.val`
|
||||
the type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`.
|
||||
Note that the parameter `a` is explicit since there is no way to infer it from the expected
|
||||
type or from the types of other explicit parameters.
|
||||
Being a parameter of the class, `a` is determined by the type of `self`.
|
||||
|
||||
Consider
|
||||
```
|
||||
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)]
|
||||
```
|
||||
Recall that `f.val` is, to first approximation, sugar for `Approx.val (self := f)`.
|
||||
Without further refinement, this would expand to `fun f'' : α → β => Approx.val f'' f`,
|
||||
which is a type error, since `f''` must be defeq to `f'`.
|
||||
Furthermore, with projection notation, users expect all structure parameters
|
||||
to be uniformly implicit; after all, they are determined by `self`.
|
||||
To handle this, the `(self := f)` named argument is annotated with the `suppressDeps` flag.
|
||||
This causes the `a` parameter to become implicit, and `f.val` instead expands to `Approx.val f' f`.
|
||||
|
||||
This feature previously was enabled for *all* explicit arguments, which confused users
|
||||
and was frequently reported as a bug (issue #1867).
|
||||
Now it is only enabled for the `self` argument in structure projections.
|
||||
|
||||
We used to do this only when `(← get).args` was empty,
|
||||
but it created an asymmetry because `f.val` worked as expected,
|
||||
yet one would have to write `f.val _ x` when there are further arguments.
|
||||
-/
|
||||
return (← addImplicitArg argName)
|
||||
propagateExpectedType arg
|
||||
@@ -584,7 +604,6 @@ mutual
|
||||
match evalSyntaxConstant env opts tacticDecl with
|
||||
| Except.error err => throwError err
|
||||
| Except.ok tacticSyntax =>
|
||||
-- TODO(Leo): does this work correctly for tactic sequences?
|
||||
let tacticBlock ← `(by $(⟨tacticSyntax⟩))
|
||||
/-
|
||||
We insert position information from the current ref into `stx` everywhere, simulating this being
|
||||
@@ -596,24 +615,32 @@ mutual
|
||||
-/
|
||||
let info := (← getRef).getHeadInfo
|
||||
let tacticBlock := tacticBlock.raw.rewriteBottomUp (·.setInfo info)
|
||||
let argNew := Arg.stx tacticBlock
|
||||
let mvar ← mkTacticMVar argType.consumeTypeAnnotations tacticBlock (.autoParam argName)
|
||||
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
|
||||
-- We should look into removing this since terminfo for synthetic syntax is suspect,
|
||||
-- but we noted it was necessary to preserve the behavior of the unused variable linter.
|
||||
addTermInfo' tacticBlock mvar
|
||||
let argNew := Arg.expr mvar
|
||||
propagateExpectedType argNew
|
||||
elabAndAddNewArg argName argNew
|
||||
main
|
||||
| false, _, some _ =>
|
||||
throwError "invalid autoParam, argument must be a constant"
|
||||
| _, _, _ =>
|
||||
if !(← get).namedArgs.isEmpty then
|
||||
if (← anyNamedArgDependsOnCurrent) then
|
||||
addImplicitArg argName
|
||||
else if (← read).ellipsis then
|
||||
if (← read).ellipsis then
|
||||
addImplicitArg argName
|
||||
else if !(← get).namedArgs.isEmpty then
|
||||
if let some _ ← findNamedArgDependsOnCurrent? then
|
||||
/-
|
||||
Dependencies of named arguments cannot be turned into eta arguments
|
||||
since they are determined by the named arguments.
|
||||
Instead we can turn them into implicit arguments.
|
||||
-/
|
||||
addImplicitArg argName
|
||||
else
|
||||
addEtaArg argName
|
||||
else if !(← read).explicit then
|
||||
if (← read).ellipsis then
|
||||
addImplicitArg argName
|
||||
else if (← fTypeHasOptAutoParams) then
|
||||
if (← fTypeHasOptAutoParams) then
|
||||
addEtaArg argName
|
||||
else
|
||||
finalize
|
||||
@@ -641,24 +668,30 @@ mutual
|
||||
finalize
|
||||
|
||||
/--
|
||||
Process a `fType` of the form `[x : A] → B x`.
|
||||
This method assume `fType` is a function type -/
|
||||
Process a `fType` of the form `[x : A] → B x`.
|
||||
This method assume `fType` is a function type.
|
||||
-/
|
||||
private partial def processInstImplicitArg (argName : Name) : M Expr := do
|
||||
if (← read).explicit then
|
||||
if (← isNextArgHole) then
|
||||
/- Recall that if '@' has been used, and the argument is '_', then we still use type class resolution -/
|
||||
let arg ← mkFreshExprMVar (← getArgExpectedType) MetavarKind.synthetic
|
||||
if let some stx ← nextArgHole? then
|
||||
-- We still use typeclass resolution for `_` arguments.
|
||||
-- This behavior can be suppressed with `(_)`.
|
||||
let ty ← getArgExpectedType
|
||||
let arg ← mkInstMVar ty
|
||||
addTermInfo' stx arg ty
|
||||
modify fun s => { s with args := s.args.tail! }
|
||||
addInstMVar arg.mvarId!
|
||||
addNewArg argName arg
|
||||
main
|
||||
else
|
||||
processExplicitArg argName
|
||||
else
|
||||
let arg ← mkFreshExprMVar (← getArgExpectedType) MetavarKind.synthetic
|
||||
discard <| mkInstMVar (← getArgExpectedType)
|
||||
main
|
||||
where
|
||||
mkInstMVar (ty : Expr) : M Expr := do
|
||||
let arg ← mkFreshExprMVar ty MetavarKind.synthetic
|
||||
addInstMVar arg.mvarId!
|
||||
addNewArg argName arg
|
||||
main
|
||||
return arg
|
||||
|
||||
/-- Elaborate function application arguments. -/
|
||||
partial def main : M Expr := do
|
||||
@@ -689,6 +722,104 @@ end
|
||||
|
||||
end ElabAppArgs
|
||||
|
||||
|
||||
/-! # Eliminator-like function application elaborator -/
|
||||
|
||||
/--
|
||||
Information about an eliminator used by the elab-as-elim elaborator.
|
||||
This is not to be confused with `Lean.Meta.ElimInfo`, which is for `induction` and `cases`.
|
||||
The elab-as-elim routine is less restrictive in what counts as an eliminator, and it doesn't need
|
||||
to have a strict notion of what is a "target" — all it cares about are
|
||||
1. that the return type of a function is of the form `m ...` where `m` is a parameter
|
||||
(unlike `induction` and `cases` eliminators, the arguments to `m`, known as "discriminants",
|
||||
can be any expressions, not just parameters), and
|
||||
2. which arguments should be eagerly elaborated, to make discriminants be as elaborated as
|
||||
possible for the expected type generalization procedure,
|
||||
and which should be postponed (since they are the "minor premises").
|
||||
|
||||
Note that the routine isn't doing induction/cases *on* particular expressions.
|
||||
The purpose of elab-as-elim is to successfully solve the higher-order unification problem
|
||||
between the return type of the function and the expected type.
|
||||
-/
|
||||
structure ElabElimInfo where
|
||||
/-- The eliminator. -/
|
||||
elimExpr : Expr
|
||||
/-- The type of the eliminator. -/
|
||||
elimType : Expr
|
||||
/-- The position of the motive parameter. -/
|
||||
motivePos : Nat
|
||||
/--
|
||||
Positions of "major" parameters (those that should be eagerly elaborated
|
||||
because they can contribute to the motive inference procedure).
|
||||
All parameters that are neither the motive nor a major parameter are "minor" parameters.
|
||||
The major parameters include all of the parameters that transitively appear in the motive's arguments,
|
||||
as well as "first-order" arguments that include such parameters,
|
||||
since they too can help with elaborating discriminants.
|
||||
|
||||
For example, in the following theorem the argument `h : a = b`
|
||||
should be elaborated eagerly because it contains `b`, which occurs in `motive b`.
|
||||
```
|
||||
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
|
||||
```
|
||||
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
|
||||
argument `α` to be elaborated eagerly to create a type-correct motive.
|
||||
```
|
||||
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
|
||||
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
|
||||
```
|
||||
-/
|
||||
majorsPos : Array Nat := #[]
|
||||
deriving Repr, Inhabited
|
||||
|
||||
def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
|
||||
let elimType ← inferType elimExpr
|
||||
trace[Elab.app.elab_as_elim] "eliminator {indentExpr elimExpr}\nhas type{indentExpr elimType}"
|
||||
forallTelescopeReducing elimType fun xs type => do
|
||||
let motive := type.getAppFn
|
||||
let motiveArgs := type.getAppArgs
|
||||
unless motive.isFVar do
|
||||
throwError "unexpected eliminator resulting type{indentExpr type}"
|
||||
let motiveType ← inferType motive
|
||||
forallTelescopeReducing motiveType fun motiveParams motiveResultType => do
|
||||
unless motiveParams.size == motiveArgs.size do
|
||||
throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
|
||||
unless motiveResultType.isSort do
|
||||
throwError "motive result type must be a sort{indentExpr motiveType}"
|
||||
let some motivePos ← pure (xs.indexOf? motive) |
|
||||
throwError "unexpected eliminator type{indentExpr elimType}"
|
||||
/-
|
||||
Compute transitive closure of fvars appearing in arguments to the motive.
|
||||
These are the primary set of major parameters.
|
||||
-/
|
||||
let initMotiveFVars : CollectFVars.State := motiveArgs.foldl (init := {}) collectFVars
|
||||
let motiveFVars ← xs.size.foldRevM (init := initMotiveFVars) fun i s => do
|
||||
let x := xs[i]!
|
||||
if s.fvarSet.contains x.fvarId! then
|
||||
return collectFVars s (← inferType x)
|
||||
else
|
||||
return s
|
||||
/- Collect the major parameter positions -/
|
||||
let mut majorsPos := #[]
|
||||
for i in [:xs.size] do
|
||||
let x := xs[i]!
|
||||
unless motivePos == i do
|
||||
let xType ← x.fvarId!.getType
|
||||
/-
|
||||
We also consider "first-order" types because we can reliably "extract" information from them.
|
||||
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
|
||||
-/
|
||||
let isFirstOrder (e : Expr) : Bool := Option.isNone <| e.find? fun e => e.isApp && !e.getAppFn.isConst
|
||||
if motiveFVars.fvarSet.contains x.fvarId!
|
||||
|| (isFirstOrder xType
|
||||
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
|
||||
majorsPos := majorsPos.push i
|
||||
trace[Elab.app.elab_as_elim] "motivePos: {motivePos}"
|
||||
trace[Elab.app.elab_as_elim] "majorsPos: {majorsPos}"
|
||||
return { elimExpr, elimType, motivePos, majorsPos }
|
||||
|
||||
def getElabElimInfo (elimName : Name) : MetaM ElabElimInfo := do
|
||||
getElabElimExprInfo (← mkConstWithFreshMVarLevels elimName)
|
||||
|
||||
builtin_initialize elabAsElim : TagAttribute ←
|
||||
registerTagAttribute `elab_as_elim
|
||||
"instructs elaborator that the arguments of the function application should be elaborated as were an eliminator"
|
||||
@@ -703,33 +834,15 @@ builtin_initialize elabAsElim : TagAttribute ←
|
||||
let info ← getConstInfo declName
|
||||
if (← hasOptAutoParams info.type) then
|
||||
throwError "[elab_as_elim] attribute cannot be used in declarations containing optional and auto parameters"
|
||||
discard <| getElimInfo declName
|
||||
discard <| getElabElimInfo declName
|
||||
go.run' {} {}
|
||||
|
||||
/-! # Eliminator-like function application elaborator -/
|
||||
namespace ElabElim
|
||||
|
||||
/-- Context of the `elab_as_elim` elaboration procedure. -/
|
||||
structure Context where
|
||||
elimInfo : ElimInfo
|
||||
elimInfo : ElabElimInfo
|
||||
expectedType : Expr
|
||||
/--
|
||||
Position of additional arguments that should be elaborated eagerly
|
||||
because they can contribute to the motive inference procedure.
|
||||
For example, in the following theorem the argument `h : a = b`
|
||||
should be elaborated eagerly because it contains `b` which occurs
|
||||
in `motive b`.
|
||||
```
|
||||
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
|
||||
```
|
||||
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
|
||||
argument `α` to be elaborated eagerly to create a type-correct motive.
|
||||
```
|
||||
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
|
||||
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
|
||||
```
|
||||
-/
|
||||
extraArgsPos : Array Nat
|
||||
|
||||
/-- State of the `elab_as_elim` elaboration procedure. -/
|
||||
structure State where
|
||||
@@ -741,8 +854,6 @@ structure State where
|
||||
namedArgs : List NamedArg
|
||||
/-- User-provided arguments that still have to be processed. -/
|
||||
args : List Arg
|
||||
/-- Discriminants (targets) processed so far. -/
|
||||
discrs : Array (Option Expr)
|
||||
/-- Instance implicit arguments collected so far. -/
|
||||
instMVars : Array MVarId := #[]
|
||||
/-- Position of the next argument to be processed. We use it to decide whether the argument is the motive or a discriminant. -/
|
||||
@@ -788,7 +899,7 @@ def finalize : M Expr := do
|
||||
let some motive := (← get).motive?
|
||||
| throwError "failed to elaborate eliminator, insufficient number of arguments"
|
||||
trace[Elab.app.elab_as_elim] "motive: {motive}"
|
||||
forallTelescope (← get).fType fun xs _ => do
|
||||
forallTelescope (← get).fType fun xs fType => do
|
||||
trace[Elab.app.elab_as_elim] "xs: {xs}"
|
||||
let mut expectedType := (← read).expectedType
|
||||
trace[Elab.app.elab_as_elim] "expectedType:{indentD expectedType}"
|
||||
@@ -797,6 +908,7 @@ def finalize : M Expr := do
|
||||
let mut f := (← get).f
|
||||
if xs.size > 0 then
|
||||
-- under-application, specialize the expected type using `xs`
|
||||
-- Note: if we ever wanted to support optParams and autoParams, this is where it could be.
|
||||
assert! (← get).args.isEmpty
|
||||
for x in xs do
|
||||
let .forallE _ t b _ ← whnf expectedType | throwInsufficient
|
||||
@@ -813,18 +925,11 @@ def finalize : M Expr := do
|
||||
trace[Elab.app.elab_as_elim] "expectedType after processing:{indentD expectedType}"
|
||||
let result := mkAppN f xs
|
||||
trace[Elab.app.elab_as_elim] "result:{indentD result}"
|
||||
let mut discrs := (← get).discrs
|
||||
let idx := (← get).idx
|
||||
if discrs.any Option.isNone then
|
||||
for i in [idx:idx + xs.size], x in xs do
|
||||
if let some tidx := (← read).elimInfo.targetsPos.indexOf? i then
|
||||
discrs := discrs.set! tidx x
|
||||
if let some idx := discrs.findIdx? Option.isNone then
|
||||
-- This should not happen.
|
||||
trace[Elab.app.elab_as_elim] "Internal error, missing target with index {idx}"
|
||||
throwError "failed to elaborate eliminator, insufficient number of arguments"
|
||||
trace[Elab.app.elab_as_elim] "discrs: {discrs.map Option.get!}"
|
||||
let motiveVal ← mkMotive (discrs.map Option.get!) expectedType
|
||||
unless fType.getAppFn == (← get).motive? do
|
||||
throwError "Internal error, eliminator target type isn't an application of the motive"
|
||||
let discrs := fType.getAppArgs
|
||||
trace[Elab.app.elab_as_elim] "discrs: {discrs}"
|
||||
let motiveVal ← mkMotive discrs expectedType
|
||||
unless (← isTypeCorrect motiveVal) do
|
||||
throwError "failed to elaborate eliminator, motive is not type correct:{indentD motiveVal}"
|
||||
unless (← isDefEq motive motiveVal) do
|
||||
@@ -858,10 +963,6 @@ def getNextArg? (binderName : Name) (binderInfo : BinderInfo) : M (LOption Arg)
|
||||
def setMotive (motive : Expr) : M Unit :=
|
||||
modify fun s => { s with motive? := motive }
|
||||
|
||||
/-- Push the given expression into the `discrs` field in the state, where `i` is which target it is for. -/
|
||||
def addDiscr (i : Nat) (discr : Expr) : M Unit :=
|
||||
modify fun s => { s with discrs := s.discrs.set! i discr }
|
||||
|
||||
/-- Elaborate the given argument with the given expected type. -/
|
||||
private def elabArg (arg : Arg) (argExpectedType : Expr) : M Expr := do
|
||||
match arg with
|
||||
@@ -904,18 +1005,13 @@ partial def main : M Expr := do
|
||||
mkImplicitArg binderType binderInfo
|
||||
setMotive motive
|
||||
addArgAndContinue motive
|
||||
else if let some tidx := (← read).elimInfo.targetsPos.indexOf? idx then
|
||||
else if (← read).elimInfo.majorsPos.contains idx then
|
||||
match (← getNextArg? binderName binderInfo) with
|
||||
| .some arg => let discr ← elabArg arg binderType; addDiscr tidx discr; addArgAndContinue discr
|
||||
| .some arg => let discr ← elabArg arg binderType; addArgAndContinue discr
|
||||
| .undef => finalize
|
||||
| .none => let discr ← mkImplicitArg binderType binderInfo; addDiscr tidx discr; addArgAndContinue discr
|
||||
| .none => let discr ← mkImplicitArg binderType binderInfo; addArgAndContinue discr
|
||||
else match (← getNextArg? binderName binderInfo) with
|
||||
| .some (.stx stx) =>
|
||||
if (← read).extraArgsPos.contains idx then
|
||||
let arg ← elabArg (.stx stx) binderType
|
||||
addArgAndContinue arg
|
||||
else
|
||||
addArgAndContinue (← postponeElabTerm stx binderType)
|
||||
| .some (.stx stx) => addArgAndContinue (← postponeElabTerm stx binderType)
|
||||
| .some (.expr val) => addArgAndContinue (← ensureArgType (← get).f val binderType)
|
||||
| .undef => finalize
|
||||
| .none => addArgAndContinue (← mkImplicitArg binderType binderInfo)
|
||||
@@ -969,13 +1065,10 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
|
||||
let some expectedType := expectedType? | throwError "failed to elaborate eliminator, expected type is not available"
|
||||
let expectedType ← instantiateMVars expectedType
|
||||
if expectedType.getAppFn.isMVar then throwError "failed to elaborate eliminator, expected type is not available"
|
||||
let extraArgsPos ← getElabAsElimExtraArgsPos elimInfo
|
||||
trace[Elab.app.elab_as_elim] "extraArgsPos: {extraArgsPos}"
|
||||
ElabElim.main.run { elimInfo, expectedType, extraArgsPos } |>.run' {
|
||||
ElabElim.main.run { elimInfo, expectedType } |>.run' {
|
||||
f, fType
|
||||
args := args.toList
|
||||
namedArgs := namedArgs.toList
|
||||
discrs := mkArray elimInfo.targetsPos.size none
|
||||
}
|
||||
else
|
||||
ElabAppArgs.main.run { explicit, ellipsis, resultIsOutParamSupport } |>.run' {
|
||||
@@ -986,12 +1079,12 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
|
||||
}
|
||||
where
|
||||
/-- Return `some info` if we should elaborate as an eliminator. -/
|
||||
elabAsElim? : TermElabM (Option ElimInfo) := do
|
||||
elabAsElim? : TermElabM (Option ElabElimInfo) := do
|
||||
unless (← read).heedElabAsElim do return none
|
||||
if explicit || ellipsis then return none
|
||||
let .const declName _ := f | return none
|
||||
unless (← shouldElabAsElim declName) do return none
|
||||
let elimInfo ← getElimInfo declName
|
||||
let elimInfo ← getElabElimInfo declName
|
||||
forallTelescopeReducing (← inferType f) fun xs _ => do
|
||||
/- Process arguments similar to `Lean.Elab.Term.ElabElim.main` to see if the motive has been
|
||||
provided, in which case we use the standard app elaborator.
|
||||
@@ -1022,41 +1115,6 @@ where
|
||||
return none
|
||||
| _, _ => return some elimInfo
|
||||
|
||||
/--
|
||||
Collect extra argument positions that must be elaborated eagerly when using `elab_as_elim`.
|
||||
The idea is that they contribute to motive inference. See comment at `ElamElim.Context.extraArgsPos`.
|
||||
-/
|
||||
getElabAsElimExtraArgsPos (elimInfo : ElimInfo) : MetaM (Array Nat) := do
|
||||
forallTelescope elimInfo.elimType fun xs type => do
|
||||
let targets := type.getAppArgs
|
||||
/- Compute transitive closure of fvars appearing in the motive and the targets. -/
|
||||
let initMotiveFVars : CollectFVars.State := targets.foldl (init := {}) collectFVars
|
||||
let motiveFVars ← xs.size.foldRevM (init := initMotiveFVars) fun i s => do
|
||||
let x := xs[i]!
|
||||
if elimInfo.motivePos == i || elimInfo.targetsPos.contains i || s.fvarSet.contains x.fvarId! then
|
||||
return collectFVars s (← inferType x)
|
||||
else
|
||||
return s
|
||||
/- Collect the extra argument positions -/
|
||||
let mut extraArgsPos := #[]
|
||||
for i in [:xs.size] do
|
||||
let x := xs[i]!
|
||||
unless elimInfo.motivePos == i || elimInfo.targetsPos.contains i do
|
||||
let xType ← x.fvarId!.getType
|
||||
/- We only consider "first-order" types because we can reliably "extract" information from them. -/
|
||||
if motiveFVars.fvarSet.contains x.fvarId!
|
||||
|| (isFirstOrder xType
|
||||
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
|
||||
extraArgsPos := extraArgsPos.push i
|
||||
return extraArgsPos
|
||||
|
||||
/-
|
||||
Helper function for implementing `elab_as_elim`.
|
||||
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
|
||||
-/
|
||||
isFirstOrder (e : Expr) : Bool :=
|
||||
Option.isNone <| e.find? fun e =>
|
||||
e.isApp && !e.getAppFn.isConst
|
||||
|
||||
/-- Auxiliary inductive datatype that represents the resolution of an `LVal`. -/
|
||||
inductive LValResolution where
|
||||
@@ -1221,7 +1279,7 @@ private partial def mkBaseProjections (baseStructName : Name) (structName : Name
|
||||
let mut e := e
|
||||
for projFunName in path do
|
||||
let projFn ← mkConst projFunName
|
||||
e ← elabAppArgs projFn #[{ name := `self, val := Arg.expr e }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
e ← elabAppArgs projFn #[{ name := `self, val := Arg.expr e, suppressDeps := true }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
return e
|
||||
|
||||
private def typeMatchesBaseName (type : Expr) (baseName : Name) : MetaM Bool := do
|
||||
@@ -1305,10 +1363,10 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
|
||||
let projFn ← mkConst info.projFn
|
||||
let projFn ← addProjTermInfo lval.getRef projFn
|
||||
if lvals.isEmpty then
|
||||
let namedArgs ← addNamedArg namedArgs { name := `self, val := Arg.expr f }
|
||||
let namedArgs ← addNamedArg namedArgs { name := `self, val := Arg.expr f, suppressDeps := true }
|
||||
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
|
||||
else
|
||||
let f ← elabAppArgs projFn #[{ name := `self, val := Arg.expr f }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
let f ← elabAppArgs projFn #[{ name := `self, val := Arg.expr f, suppressDeps := true }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
|
||||
loop f lvals
|
||||
else
|
||||
unreachable!
|
||||
|
||||
@@ -9,18 +9,22 @@ import Lean.Elab.Term
|
||||
namespace Lean.Elab.Term
|
||||
|
||||
/--
|
||||
Auxiliary inductive datatype for combining unelaborated syntax
|
||||
and already elaborated expressions. It is used to elaborate applications. -/
|
||||
Auxiliary inductive datatype for combining unelaborated syntax
|
||||
and already elaborated expressions. It is used to elaborate applications.
|
||||
-/
|
||||
inductive Arg where
|
||||
| stx (val : Syntax)
|
||||
| expr (val : Expr)
|
||||
deriving Inhabited
|
||||
|
||||
/-- Named arguments created using the notation `(x := val)` -/
|
||||
/-- Named arguments created using the notation `(x := val)`. -/
|
||||
structure NamedArg where
|
||||
ref : Syntax := Syntax.missing
|
||||
name : Name
|
||||
val : Arg
|
||||
/-- If `true`, then make all parameters that depend on this one become implicit.
|
||||
This is used for projection notation, since structure parameters might be explicit for classes. -/
|
||||
suppressDeps : Bool := false
|
||||
deriving Inhabited
|
||||
|
||||
/--
|
||||
|
||||
@@ -24,7 +24,7 @@ def elabAuxDef : CommandElab
|
||||
let id := `_aux ++ (← getMainModule) ++ `_ ++ id
|
||||
let id := String.intercalate "_" <| id.components.map (·.toString (escape := false))
|
||||
let ns ← getCurrNamespace
|
||||
-- make sure we only add a single component so that scoped workes
|
||||
-- make sure we only add a single component so that scoped works
|
||||
let id ← mkAuxName (ns.mkStr id) 1
|
||||
let id := id.replacePrefix ns Name.anonymous -- TODO: replace with def _root_.id
|
||||
elabCommand <|
|
||||
|
||||
@@ -170,8 +170,9 @@ private def toBinderViews (stx : Syntax) : TermElabM (Array BinderView) := do
|
||||
else
|
||||
throwUnsupportedSyntax
|
||||
|
||||
private def registerFailedToInferBinderTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit :=
|
||||
private def registerFailedToInferBinderTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit := do
|
||||
registerCustomErrorIfMVar type ref "failed to infer binder type"
|
||||
registerLevelMVarErrorExprInfo type ref m!"failed to infer universe levels in binder type"
|
||||
|
||||
def addLocalVarInfo (stx : Syntax) (fvar : Expr) : TermElabM Unit :=
|
||||
addTermInfo' (isBinder := true) stx fvar
|
||||
@@ -639,7 +640,7 @@ open Lean.Elab.Term.Quotation in
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/-- If `useLetExpr` is true, then a kernel let-expression `let x : type := val; body` is created.
|
||||
Otherwise, we create a term of the form `(fun (x : type) => body) val`
|
||||
Otherwise, we create a term of the form `letFun val (fun (x : type) => body)`
|
||||
|
||||
The default elaboration order is `binders`, `typeStx`, `valStx`, and `body`.
|
||||
If `elabBodyFirst == true`, then we use the order `binders`, `typeStx`, `body`, and `valStx`. -/
|
||||
@@ -650,7 +651,7 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
|
||||
/-
|
||||
We use `withSynthesize` to ensure that any postponed elaboration problem
|
||||
and nested tactics in `type` are resolved before elaborating `val`.
|
||||
Resolved: we want to avoid synthethic opaque metavariables in `type`.
|
||||
Resolved: we want to avoid synthetic opaque metavariables in `type`.
|
||||
Recall that this kind of metavariable is non-assignable, and `isDefEq`
|
||||
may waste a lot of time unfolding declarations before failing.
|
||||
See issue #4051 for an example.
|
||||
@@ -670,7 +671,9 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
|
||||
Recall that TC resolution does **not** produce synthetic opaque metavariables.
|
||||
-/
|
||||
let type ← withSynthesize (postpone := .partial) <| elabType typeStx
|
||||
registerCustomErrorIfMVar type typeStx "failed to infer 'let' declaration type"
|
||||
let letMsg := if useLetExpr then "let" else "have"
|
||||
registerCustomErrorIfMVar type typeStx m!"failed to infer '{letMsg}' declaration type"
|
||||
registerLevelMVarErrorExprInfo type typeStx m!"failed to infer universe levels in '{letMsg}' declaration type"
|
||||
if elabBodyFirst then
|
||||
let type ← mkForallFVars fvars type
|
||||
let val ← mkFreshExprMVar type
|
||||
|
||||
@@ -381,7 +381,7 @@ unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax): CommandElabM Uni
|
||||
-- Evaluate using term using `MetaEval` class.
|
||||
let elabMetaEval : CommandElabM Unit := do
|
||||
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
|
||||
-- we don't polute the environment with auxliary declarations.
|
||||
-- we don't pollute the environment with auxliary declarations.
|
||||
-- We have special support for `CommandElabM` to ensure `#eval` can be used to execute commands
|
||||
-- that modify `CommandElabM` state not just the `Environment`.
|
||||
let act : Sum (CommandElabM Unit) (Environment → Options → IO (String × Except IO.Error Environment)) ←
|
||||
|
||||
@@ -150,26 +150,10 @@ private def getMVarFromUserName (ident : Syntax) : MetaM Expr := do
|
||||
elabTerm b expectedType?
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
private def mkTacticMVar (type : Expr) (tacticCode : Syntax) : TermElabM Expr := do
|
||||
let mvar ← mkFreshExprMVar type MetavarKind.syntheticOpaque
|
||||
let mvarId := mvar.mvarId!
|
||||
let ref ← getRef
|
||||
registerSyntheticMVar ref mvarId <| SyntheticMVarKind.tactic tacticCode (← saveContext)
|
||||
return mvar
|
||||
|
||||
register_builtin_option debug.byAsSorry : Bool := {
|
||||
defValue := false
|
||||
group := "debug"
|
||||
descr := "replace `by ..` blocks with `sorry` IF the expected type is a proposition"
|
||||
}
|
||||
|
||||
@[builtin_term_elab byTactic] def elabByTactic : TermElab := fun stx expectedType? => do
|
||||
match expectedType? with
|
||||
| some expectedType =>
|
||||
if ← pure (debug.byAsSorry.get (← getOptions)) <&&> isProp expectedType then
|
||||
mkSorry expectedType false
|
||||
else
|
||||
mkTacticMVar expectedType stx
|
||||
mkTacticMVar expectedType stx .term
|
||||
| none =>
|
||||
tryPostpone
|
||||
throwError ("invalid 'by' tactic, expected type has not been provided")
|
||||
|
||||
@@ -532,8 +532,7 @@ def elabCommandTopLevel (stx : Syntax) : CommandElabM Unit := withRef stx do pro
|
||||
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
|
||||
-- should be true iff the command supports incrementality
|
||||
if (← IO.hasFinished snap.new.result) then
|
||||
trace[Elab.snapshotTree]
|
||||
(←Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.format)
|
||||
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
|
||||
modify fun st => { st with
|
||||
messages := initMsgs ++ msgs
|
||||
infoState := { st.infoState with trees := initInfoTrees ++ st.infoState.trees }
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user