mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-17 18:34:06 +00:00
Compare commits
93 Commits
toArray_th
...
array_30
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
6a69b7eb67 | ||
|
|
c5fd652765 | ||
|
|
4cd4bcc9be | ||
|
|
7d26a1604f | ||
|
|
3a46fd0fde | ||
|
|
994cfa4c74 | ||
|
|
cf3e7de143 | ||
|
|
2ace579438 | ||
|
|
40d6a6def0 | ||
|
|
d96b7a7d98 | ||
|
|
40e97bd566 | ||
|
|
3bd01de384 | ||
|
|
8835ab46ad | ||
|
|
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 |
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
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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,7 @@ 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
|
||||
@@ -837,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
|
||||
@@ -1892,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 -/
|
||||
@@ -2055,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
|
||||
|
||||
@@ -2071,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
|
||||
|
||||
@@ -2087,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
|
||||
|
||||
@@ -73,8 +73,7 @@ theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
|
||||
@[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]
|
||||
@[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]
|
||||
|
||||
@@ -811,11 +810,27 @@ 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.
|
||||
/-! ## Auxiliary functions used in metaprogramming.
|
||||
|
||||
We do not intend to provide verification theorems for these functions.
|
||||
-/
|
||||
|
||||
/-! ### eraseReps -/
|
||||
|
||||
/--
|
||||
`O(|l|)`. Erase repeated adjacent elements. Keeps the first occurrence of each run.
|
||||
* `eraseReps #[1, 3, 2, 2, 2, 3, 5] = #[1, 3, 2, 3, 5]`
|
||||
-/
|
||||
def eraseReps {α} [BEq α] (as : Array α) : Array α :=
|
||||
if h : 0 < as.size then
|
||||
let ⟨last, r⟩ := as.foldl (init := (as[0], #[])) fun ⟨last, r⟩ a =>
|
||||
if a == last then ⟨last, r⟩ else ⟨a, r.push last⟩
|
||||
r.push last
|
||||
else
|
||||
#[]
|
||||
|
||||
/-! ### allDiff -/
|
||||
|
||||
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size → Bool
|
||||
| 0, _ => true
|
||||
| i+1, h =>
|
||||
@@ -833,6 +848,8 @@ decreasing_by simp_wf; decreasing_trivial_pre_omega
|
||||
def allDiff [BEq α] (as : Array α) : Bool :=
|
||||
allDiffAux as 0
|
||||
|
||||
/-! ### getEvenElems -/
|
||||
|
||||
@[inline] def getEvenElems (as : Array α) : Array α :=
|
||||
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
|
||||
if even then
|
||||
|
||||
@@ -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,14 +5,15 @@ 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 hi)
|
||||
(j : Nat) (hj : j < i) : a[j]'(Nat.lt_of_lt_of_le hj hi) = b[j]'(Nat.lt_of_lt_of_le hj (hsz ▸ hi)) := by
|
||||
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 =>
|
||||
@@ -25,23 +26,28 @@ theorem eq_of_isEqvAux
|
||||
subst hj'
|
||||
exact heqv.left
|
||||
|
||||
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 a.size (Nat.le_refl ..) h
|
||||
exact ext a b hsz fun i h _ => aux i h
|
||||
next => intro; contradiction
|
||||
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 isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) (h : i ≤ a.size) :
|
||||
Array.isEqvAux a a rfl (fun x y => x = y) i h = true := by
|
||||
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 (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, decide_True, Bool.and_self]
|
||||
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 α) :=
|
||||
|
||||
@@ -19,12 +19,119 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
|
||||
|
||||
namespace Array
|
||||
|
||||
@[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) :
|
||||
@@ -280,7 +363,7 @@ termination_by n - i
|
||||
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 -/
|
||||
|
||||
@@ -321,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
|
||||
@@ -332,24 +415,27 @@ 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
|
||||
theorem getElem?_eq_toList_getElem? (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg]
|
||||
|
||||
@[deprecated getElem?_eq_toList_get? (since := "2024-09-09")]
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-30")]
|
||||
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]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[deprecated getElem?_eq_toList_getElem? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
|
||||
set_option linter.deprecated false in
|
||||
theorem get?_eq_toList_get? (a : Array α) (i : Nat) : a.get? i = a.toList.get? i :=
|
||||
getElem?_eq_toList_get? ..
|
||||
|
||||
@@ -363,7 +449,7 @@ theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD
|
||||
simp [back, back?]
|
||||
|
||||
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
|
||||
simp [back?, getElem?_eq_toList_get?]
|
||||
simp [back?, getElem?_eq_toList_getElem?]
|
||||
|
||||
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
|
||||
|
||||
@@ -399,7 +485,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]
|
||||
@@ -418,7 +504,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
|
||||
@@ -434,7 +520,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")]
|
||||
@@ -447,7 +533,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]
|
||||
|
||||
@@ -520,14 +606,13 @@ 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
|
||||
let rec go (as : Array α) (i j hj)
|
||||
(h : i + j + 1 = a.size) (h₂ : as.size = a.size)
|
||||
(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
|
||||
(H : ∀ k, as.toList[k]? = if i ≤ k ∧ k ≤ j then a.toList[k]? else a.toList.reverse[k]?)
|
||||
(k : Nat) : (reverse.loop as i ⟨j, hj⟩).toList[k]? = a.toList.reverse[k]? := by
|
||||
rw [reverse.loop]; dsimp; split <;> rename_i h₁
|
||||
· match j with | j+1 => ?_
|
||||
simp only [Nat.add_sub_cancel]
|
||||
@@ -535,37 +620,63 @@ set_option linter.deprecated false in
|
||||
· rwa [Nat.add_right_comm i]
|
||||
· simp [size_swap, h₂]
|
||||
· intro k
|
||||
rw [← getElem?_eq_toList_get?, get?_swap]
|
||||
simp only [H, getElem_eq_toList_get, ← List.get?_eq_get, Nat.le_of_lt h₁,
|
||||
getElem?_eq_toList_get?]
|
||||
rw [← getElem?_eq_toList_getElem?, get?_swap]
|
||||
simp only [H, getElem_eq_getElem_toList, ← List.getElem?_eq_getElem, Nat.le_of_lt h₁,
|
||||
getElem?_eq_toList_getElem?]
|
||||
split <;> rename_i h₂
|
||||
· simp only [← h₂, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, and_false]
|
||||
exact (List.get?_reverse' (j+1) i (Eq.trans (by simp_arith) h)).symm
|
||||
exact (List.getElem?_reverse' (j+1) i (Eq.trans (by simp_arith) h)).symm
|
||||
split <;> rename_i h₃
|
||||
· simp only [← h₃, Nat.not_le.2 (Nat.lt_succ_self _), Nat.le_refl, false_and]
|
||||
exact (List.get?_reverse' i (j+1) (Eq.trans (by simp_arith) h)).symm
|
||||
exact (List.getElem?_reverse' i (j+1) (Eq.trans (by simp_arith) h)).symm
|
||||
simp only [Nat.succ_le, Nat.lt_iff_le_and_ne.trans (and_iff_left h₃),
|
||||
Nat.lt_succ.symm.trans (Nat.lt_iff_le_and_ne.trans (and_iff_left (Ne.symm h₂)))]
|
||||
· rw [H]; split <;> rename_i h₂
|
||||
· cases Nat.le_antisymm (Nat.not_lt.1 h₁) (Nat.le_trans h₂.1 h₂.2)
|
||||
cases Nat.le_antisymm h₂.1 h₂.2
|
||||
exact (List.get?_reverse' _ _ h).symm
|
||||
exact (List.getElem?_reverse' _ _ h).symm
|
||||
· rfl
|
||||
termination_by j - i
|
||||
simp only [reverse]
|
||||
split
|
||||
· match a with | ⟨[]⟩ | ⟨[_]⟩ => rfl
|
||||
· have := Nat.sub_add_cancel (Nat.le_of_not_le ‹_›)
|
||||
refine List.ext_get? <| go _ _ _ _ (by simp [this]) rfl fun k => ?_
|
||||
refine List.ext_getElem? <| go _ _ _ _ (by simp [this]) rfl fun k => ?_
|
||||
split
|
||||
· rfl
|
||||
· rename_i h
|
||||
simp only [← show k < _ + 1 ↔ _ from Nat.lt_succ (n := a.size - 1), this, Nat.zero_le,
|
||||
true_and, Nat.not_lt] at h
|
||||
rw [List.get?_eq_none.2 ‹_›, List.get?_eq_none.2 (a.toList.length_reverse ▸ ‹_›)]
|
||||
rw [List.getElem?_eq_none_iff.2 ‹_›, List.getElem?_eq_none_iff.2 (a.toList.length_reverse ▸ ‹_›)]
|
||||
|
||||
/-! ### 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
|
||||
@@ -609,8 +720,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
|
||||
@@ -751,7 +862,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]
|
||||
@@ -762,23 +873,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]
|
||||
@@ -791,12 +902,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 -/
|
||||
|
||||
@@ -819,7 +930,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]
|
||||
@@ -827,7 +938,7 @@ 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₁ := hle) (h₂ := h')]
|
||||
apply List.get_of_eq; rw [append_toList]
|
||||
@@ -975,6 +1086,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 ↔
|
||||
@@ -1019,6 +1157,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]
|
||||
@@ -1040,10 +1189,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]
|
||||
@@ -1115,3 +1264,117 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
|
||||
· 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
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.Basic
|
||||
import Init.Data.Ord
|
||||
|
||||
namespace Array
|
||||
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
|
||||
@@ -44,4 +45,11 @@ def qpartition (as : Array α) (lt : α → α → Bool) (lo hi : Nat) : Nat ×
|
||||
else as
|
||||
sort as low high
|
||||
|
||||
set_option linter.unusedVariables.funArgs false in
|
||||
/--
|
||||
Sort an array using `compare` to compare elements.
|
||||
-/
|
||||
def qsortOrd [ord : Ord α] (xs : Array α) : Array α :=
|
||||
xs.qsort fun x y => compare x y |>.isLT
|
||||
|
||||
end Array
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -269,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`.
|
||||
-/
|
||||
@@ -676,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) :=
|
||||
|
||||
@@ -438,6 +438,385 @@ 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 ..)
|
||||
|
||||
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 -/
|
||||
|
||||
/--
|
||||
|
||||
@@ -11,6 +11,7 @@ import Init.Data.Fin.Lemmas
|
||||
import Init.Data.Nat.Lemmas
|
||||
import Init.Data.Nat.Mod
|
||||
import Init.Data.Int.Bitwise.Lemmas
|
||||
import Init.Data.Int.Pow
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
@@ -164,7 +165,8 @@ theorem getMsbD_eq_getMsb?_getD (x : BitVec w) (i : Nat) :
|
||||
· simp [getMsb?, h]
|
||||
· rw [getLsbD_eq_getElem?_getD, getMsb?_eq_getLsb?]
|
||||
split <;>
|
||||
· simp
|
||||
· simp only [getLsb?_eq_getElem?, Bool.and_iff_right_iff_imp, decide_eq_true_eq,
|
||||
Option.getD_none, Bool.and_eq_false_imp]
|
||||
intros
|
||||
omega
|
||||
|
||||
@@ -264,11 +266,17 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
|
||||
|
||||
@[simp] theorem getLsbD_zero : (0#w).getLsbD i = false := by simp [getLsbD]
|
||||
|
||||
@[simp] theorem getElem_zero (h : i < w) : (0#w)[i] = false := by simp [getElem_eq_testBit_toNat]
|
||||
|
||||
@[simp] theorem getMsbD_zero : (0#w).getMsbD i = false := by simp [getMsbD]
|
||||
|
||||
@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat :=
|
||||
Nat.mod_eq_of_lt x.isLt
|
||||
|
||||
@[simp] theorem toNat_mod_cancel' {x : BitVec n} :
|
||||
(x.toNat : Int) % (((2 ^ n) : Nat) : Int) = x.toNat := by
|
||||
rw_mod_cast [toNat_mod_cancel]
|
||||
|
||||
@[simp] theorem sub_toNat_mod_cancel {x : BitVec w} (h : ¬ x = 0#w) :
|
||||
(2 ^ w - x.toNat) % 2 ^ w = 2 ^ w - x.toNat := by
|
||||
simp only [toNat_eq, toNat_ofNat, Nat.zero_mod] at h
|
||||
@@ -296,7 +304,7 @@ theorem getElem?_zero_ofNat_one : (BitVec.ofNat (w+1) 1)[0]? = some true := by
|
||||
|
||||
-- This does not need to be a `@[simp]` theorem as it is already handled by `getElem?_eq_getElem`.
|
||||
theorem getElem?_zero_ofBool (b : Bool) : (ofBool b)[0]? = some b := by
|
||||
simp [ofBool, cond_eq_if]
|
||||
simp only [ofBool, ofNat_eq_ofNat, cond_eq_if]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem getElem_zero_ofBool (b : Bool) : (ofBool b)[0] = b := by
|
||||
@@ -312,13 +320,20 @@ theorem getLsbD_ofBool (b : Bool) (i : Nat) : (ofBool b).getLsbD i = ((i = 0) &&
|
||||
· simp only [ofBool, ofNat_eq_ofNat, cond_true, getLsbD_ofNat, Bool.and_true]
|
||||
by_cases hi : i = 0 <;> simp [hi] <;> omega
|
||||
|
||||
@[simp]
|
||||
theorem getElem_ofBool {b : Bool} {i : Nat} : (ofBool b)[0] = b := by
|
||||
rcases b with rfl | rfl
|
||||
· simp [ofBool]
|
||||
· simp only [ofBool]
|
||||
by_cases hi : i = 0 <;> simp [hi] <;> omega
|
||||
|
||||
/-! ### msb -/
|
||||
|
||||
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
|
||||
|
||||
theorem msb_eq_getLsbD_last (x : BitVec w) :
|
||||
x.msb = x.getLsbD (w - 1) := by
|
||||
simp [BitVec.msb, getMsbD, getLsbD]
|
||||
simp only [BitVec.msb, getMsbD]
|
||||
rcases w with rfl | w
|
||||
· simp [BitVec.eq_nil x]
|
||||
· simp
|
||||
@@ -346,7 +361,7 @@ theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat
|
||||
| 0 =>
|
||||
simp [BitVec.msb, BitVec.getMsbD] at p
|
||||
| n + 1 =>
|
||||
simp [BitVec.msb_eq_decide] at p
|
||||
simp only [msb_eq_decide, Nat.add_one_sub_one, decide_eq_true_eq] at p
|
||||
simp only [Nat.add_sub_cancel]
|
||||
exact p
|
||||
|
||||
@@ -406,7 +421,7 @@ theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) :=
|
||||
/-- Prove equality of bitvectors in terms of nat operations. -/
|
||||
theorem eq_of_toInt_eq {x y : BitVec n} : x.toInt = y.toInt → x = y := by
|
||||
intro eq
|
||||
simp [toInt_eq_toNat_cond] at eq
|
||||
simp only [toInt_eq_toNat_cond] at eq
|
||||
apply eq_of_toNat_eq
|
||||
revert eq
|
||||
have _xlt := x.isLt
|
||||
@@ -635,10 +650,18 @@ protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) :
|
||||
@[simp] theorem extractLsb_toNat (hi lo : Nat) (x : BitVec n) :
|
||||
(extractLsb hi lo x).toNat = (x.toNat >>> lo) % 2^(hi-lo+1) := rfl
|
||||
|
||||
@[simp] theorem getElem_extractLsb' {start len : Nat} {x : BitVec n} {i : Nat} (h : i < len) :
|
||||
(extractLsb' start len x)[i] = x.getLsbD (start+i) := by
|
||||
simp [getElem_eq_testBit_toNat, getLsbD, h]
|
||||
|
||||
@[simp] theorem getLsbD_extractLsb' (start len : Nat) (x : BitVec n) (i : Nat) :
|
||||
(extractLsb' start len x).getLsbD i = (i < len && x.getLsbD (start+i)) := by
|
||||
simp [getLsbD, Nat.lt_succ]
|
||||
|
||||
@[simp] theorem getElem_extract {hi lo : Nat} {x : BitVec n} {i : Nat} (h : i < hi - lo + 1) :
|
||||
(extractLsb hi lo x)[i] = getLsbD x (lo+i) := by
|
||||
simp [getElem_eq_testBit_toNat, getLsbD, h]
|
||||
|
||||
@[simp] theorem getLsbD_extract (hi lo : Nat) (x : BitVec n) (i : Nat) :
|
||||
getLsbD (extractLsb hi lo x) i = (i ≤ (hi-lo) && getLsbD x (lo+i)) := by
|
||||
simp [getLsbD, Nat.lt_succ]
|
||||
@@ -714,10 +737,16 @@ instance : Std.Commutative (fun (x y : BitVec w) => x ||| y) := ⟨BitVec.or_com
|
||||
ext i
|
||||
simp
|
||||
|
||||
instance : Std.IdempotentOp (α := BitVec n) (· ||| · ) where
|
||||
idempotent _ := BitVec.or_self
|
||||
|
||||
@[simp] theorem or_zero {x : BitVec w} : x ||| 0#w = x := by
|
||||
ext i
|
||||
simp
|
||||
|
||||
instance : Std.LawfulCommIdentity (α := BitVec n) (· ||| · ) (0#n) where
|
||||
right_id _ := BitVec.or_zero
|
||||
|
||||
@[simp] theorem zero_or {x : BitVec w} : 0#w ||| x = x := by
|
||||
ext i
|
||||
simp
|
||||
@@ -775,6 +804,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x &&& y) := ⟨BitVec.and_co
|
||||
ext i
|
||||
simp
|
||||
|
||||
instance : Std.IdempotentOp (α := BitVec n) (· &&& · ) where
|
||||
idempotent _ := BitVec.and_self
|
||||
|
||||
@[simp] theorem and_zero {x : BitVec w} : x &&& 0#w = 0#w := by
|
||||
ext i
|
||||
simp
|
||||
@@ -787,6 +819,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x &&& y) := ⟨BitVec.and_co
|
||||
ext i
|
||||
simp
|
||||
|
||||
instance : Std.LawfulCommIdentity (α := BitVec n) (· &&& · ) (allOnes n) where
|
||||
right_id _ := BitVec.and_allOnes
|
||||
|
||||
@[simp] theorem allOnes_and {x : BitVec w} : allOnes w &&& x = x := by
|
||||
ext i
|
||||
simp
|
||||
@@ -843,6 +878,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x ^^^ y) := ⟨BitVec.xor_co
|
||||
ext i
|
||||
simp
|
||||
|
||||
instance : Std.LawfulCommIdentity (α := BitVec n) (· ^^^ · ) (0#n) where
|
||||
right_id _ := BitVec.xor_zero
|
||||
|
||||
@[simp] theorem zero_xor {x : BitVec w} : 0#w ^^^ x = x := by
|
||||
ext i
|
||||
simp
|
||||
@@ -863,8 +901,8 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
rw [← h]
|
||||
rw [Nat.testBit_two_pow_sub_succ (isLt _)]
|
||||
· cases w : decide (i < v)
|
||||
· simp at w
|
||||
simp [w]
|
||||
· simp only [decide_eq_false_iff_not, Nat.not_lt] at w
|
||||
simp only [Bool.false_bne, Bool.false_and]
|
||||
rw [Nat.testBit_lt_two_pow]
|
||||
calc BitVec.toNat x < 2 ^ v := isLt _
|
||||
_ ≤ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w
|
||||
@@ -895,6 +933,10 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
ext
|
||||
simp
|
||||
|
||||
@[simp] theorem not_allOnes : ~~~ allOnes w = 0#w := by
|
||||
ext
|
||||
simp
|
||||
|
||||
@[simp] theorem xor_allOnes {x : BitVec w} : x ^^^ allOnes w = ~~~ x := by
|
||||
ext i
|
||||
simp
|
||||
@@ -903,6 +945,21 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
ext i
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
|
||||
ext i
|
||||
simp
|
||||
|
||||
@[simp] theorem getMsb_not {x : BitVec w} :
|
||||
(~~~x).getMsbD i = (decide (i < w) && !(x.getMsbD i)) := by
|
||||
simp only [getMsbD]
|
||||
by_cases h : i < w
|
||||
· simp [h]; omega
|
||||
· simp [h];
|
||||
|
||||
@[simp] theorem msb_not {x : BitVec w} : (~~~x).msb = (decide (0 < w) && !x.msb) := by
|
||||
simp [BitVec.msb]
|
||||
|
||||
/-! ### cast -/
|
||||
|
||||
@[simp] theorem not_cast {x : BitVec w} (h : w = w') : ~~~(cast h x) = cast h (~~~x) := by
|
||||
@@ -947,6 +1004,14 @@ theorem zero_shiftLeft (n : Nat) : 0#w <<< n = 0#w := by
|
||||
cases h₁ : decide (i < m) <;> cases h₂ : decide (n ≤ i) <;> cases h₃ : decide (i < n)
|
||||
all_goals { simp_all <;> omega }
|
||||
|
||||
@[simp] theorem getElem_shiftLeft {x : BitVec m} {n : Nat} (h : i < m) :
|
||||
(x <<< n)[i] = (!decide (i < n) && getLsbD x (i - n)) := by
|
||||
rw [← testBit_toNat, getElem_eq_testBit_toNat]
|
||||
simp only [toNat_shiftLeft, Nat.testBit_mod_two_pow, Nat.testBit_shiftLeft, ge_iff_le]
|
||||
-- This step could be a case bashing tactic.
|
||||
cases h₁ : decide (i < m) <;> cases h₂ : decide (n ≤ i) <;> cases h₃ : decide (i < n)
|
||||
all_goals { simp_all <;> omega }
|
||||
|
||||
theorem shiftLeft_xor_distrib (x y : BitVec w) (n : Nat) :
|
||||
(x ^^^ y) <<< n = (x <<< n) ^^^ (y <<< n) := by
|
||||
ext i
|
||||
@@ -977,7 +1042,8 @@ theorem shiftLeft_or_distrib (x y : BitVec w) (n : Nat) :
|
||||
simp only [t]
|
||||
simp only [decide_True, Nat.sub_sub, Bool.true_and, Nat.add_assoc]
|
||||
by_cases h₁ : k < w <;> by_cases h₂ : w - (1 + k) < i <;> by_cases h₃ : k + i < w
|
||||
<;> simp [h₁, h₂, h₃]
|
||||
<;> simp only [h₁, h₂, h₃, decide_False, h₂, decide_True, Bool.not_true, Bool.false_and, Bool.and_self,
|
||||
Bool.true_and, Bool.false_eq, Bool.false_and, Bool.not_false]
|
||||
<;> (first | apply getLsbD_ge | apply Eq.symm; apply getLsbD_ge)
|
||||
<;> omega
|
||||
|
||||
@@ -992,6 +1058,14 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
|
||||
exact Nat.mul_lt_mul_of_pos_right x.isLt (Nat.two_pow_pos _)
|
||||
· omega
|
||||
|
||||
@[simp] theorem getElem_shiftLeftZeroExtend {x : BitVec m} {n : Nat} (h : i < m + n) :
|
||||
(shiftLeftZeroExtend x n)[i] = ((! decide (i < n)) && getLsbD x (i - n)) := by
|
||||
rw [shiftLeftZeroExtend_eq, getLsbD]
|
||||
simp only [getElem_eq_testBit_toNat, getLsbD_shiftLeft, getLsbD_setWidth]
|
||||
cases h₁ : decide (i < n) <;> cases h₂ : decide (i - n < m + n)
|
||||
<;> simp_all [h]
|
||||
<;> omega
|
||||
|
||||
@[simp] theorem getLsbD_shiftLeftZeroExtend (x : BitVec m) (n : Nat) :
|
||||
getLsbD (shiftLeftZeroExtend x n) i = ((! decide (i < n)) && getLsbD x (i - n)) := by
|
||||
rw [shiftLeftZeroExtend_eq]
|
||||
@@ -1020,6 +1094,16 @@ theorem shiftLeft_add {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
cases h₅ : decide (i < n + m) <;>
|
||||
simp at * <;> omega
|
||||
|
||||
@[simp]
|
||||
theorem allOnes_shiftLeft_and_shiftLeft {x : BitVec w} {n : Nat} :
|
||||
BitVec.allOnes w <<< n &&& x <<< n = x <<< n := by
|
||||
simp [← BitVec.shiftLeft_and_distrib]
|
||||
|
||||
@[simp]
|
||||
theorem allOnes_shiftLeft_or_shiftLeft {x : BitVec w} {n : Nat} :
|
||||
BitVec.allOnes w <<< n ||| x <<< n = BitVec.allOnes w <<< n := by
|
||||
simp [← shiftLeft_or_distrib]
|
||||
|
||||
@[deprecated shiftLeft_add (since := "2024-06-02")]
|
||||
theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
(x <<< n) <<< m = x <<< (n + m) := by
|
||||
@@ -1040,6 +1124,11 @@ theorem getLsbD_shiftLeft' {x : BitVec w₁} {y : BitVec w₂} {i : Nat} :
|
||||
(x <<< y).getLsbD i = (decide (i < w₁) && !decide (i < y.toNat) && x.getLsbD (i - y.toNat)) := by
|
||||
simp [shiftLeft_eq', getLsbD_shiftLeft]
|
||||
|
||||
@[simp]
|
||||
theorem getElem_shiftLeft' {x : BitVec w₁} {y : BitVec w₂} {i : Nat} (h : i < w₁) :
|
||||
(x <<< y)[i] = (!decide (i < y.toNat) && x.getLsbD (i - y.toNat)) := by
|
||||
simp [shiftLeft_eq', getLsbD_shiftLeft]
|
||||
|
||||
/-! ### ushiftRight -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
|
||||
@@ -1072,6 +1161,17 @@ theorem ushiftRight_or_distrib (x y : BitVec w) (n : Nat) :
|
||||
theorem ushiftRight_zero_eq (x : BitVec w) : x >>> 0 = x := by
|
||||
simp [bv_toNat]
|
||||
|
||||
/--
|
||||
Shifting right by `n < w` yields a bitvector whose value is less than `2 ^ (w - n)`.
|
||||
-/
|
||||
theorem toNat_ushiftRight_lt (x : BitVec w) (n : Nat) (hn : n ≤ w) :
|
||||
(x >>> n).toNat < 2 ^ (w - n) := by
|
||||
rw [toNat_ushiftRight, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul]
|
||||
· rw [Nat.pow_sub_mul_pow]
|
||||
· apply x.isLt
|
||||
· apply hn
|
||||
· apply Nat.pow_pos (by decide)
|
||||
|
||||
/-! ### ushiftRight reductions from BitVec to Nat -/
|
||||
|
||||
@[simp]
|
||||
@@ -1121,7 +1221,7 @@ theorem sshiftRight_eq_of_msb_true {x : BitVec w} {s : Nat} (h : x.msb = true) :
|
||||
· rw [Nat.shiftRight_eq_div_pow]
|
||||
apply Nat.lt_of_le_of_lt (Nat.div_le_self _ _) (by omega)
|
||||
|
||||
@[simp] theorem getLsbD_sshiftRight (x : BitVec w) (s i : Nat) :
|
||||
theorem getLsbD_sshiftRight (x : BitVec w) (s i : Nat) :
|
||||
getLsbD (x.sshiftRight s) i =
|
||||
(!decide (w ≤ i) && if s + i < w then x.getLsbD (s + i) else x.msb) := by
|
||||
rcases hmsb : x.msb with rfl | rfl
|
||||
@@ -1142,6 +1242,15 @@ theorem sshiftRight_eq_of_msb_true {x : BitVec w} {s : Nat} (h : x.msb = true) :
|
||||
Nat.not_lt, decide_eq_true_eq]
|
||||
omega
|
||||
|
||||
theorem getElem_sshiftRight {x : BitVec w} {s i : Nat} (h : i < w) :
|
||||
(x.sshiftRight s)[i] = (if s + i < w then x.getLsbD (s + i) else x.msb) := by
|
||||
rcases hmsb : x.msb with rfl | rfl
|
||||
· simp only [sshiftRight_eq_of_msb_false hmsb, getElem_ushiftRight, Bool.if_false_right,
|
||||
Bool.iff_and_self, decide_eq_true_eq]
|
||||
intros hlsb
|
||||
apply BitVec.lt_of_getLsbD hlsb
|
||||
· simp [sshiftRight_eq_of_msb_true hmsb]
|
||||
|
||||
theorem sshiftRight_xor_distrib (x y : BitVec w) (n : Nat) :
|
||||
(x ^^^ y).sshiftRight n = (x.sshiftRight n) ^^^ (y.sshiftRight n) := by
|
||||
ext i
|
||||
@@ -1179,7 +1288,7 @@ theorem sshiftRight_msb_eq_msb {n : Nat} {x : BitVec w} :
|
||||
|
||||
@[simp] theorem sshiftRight_zero {x : BitVec w} : x.sshiftRight 0 = x := by
|
||||
ext i
|
||||
simp
|
||||
simp [getLsbD_sshiftRight]
|
||||
|
||||
theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
|
||||
x.sshiftRight (m + n) = (x.sshiftRight m).sshiftRight n := by
|
||||
@@ -1196,6 +1305,22 @@ theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
|
||||
omega
|
||||
· simp [h₃, sshiftRight_msb_eq_msb]
|
||||
|
||||
theorem not_sshiftRight {b : BitVec w} :
|
||||
~~~b.sshiftRight n = (~~~b).sshiftRight n := by
|
||||
ext i
|
||||
simp only [getLsbD_not, Fin.is_lt, decide_True, getLsbD_sshiftRight, Bool.not_and, Bool.not_not,
|
||||
Bool.true_and, msb_not]
|
||||
by_cases h : w ≤ i
|
||||
<;> by_cases h' : n + i < w
|
||||
<;> by_cases h'' : 0 < w
|
||||
<;> simp [h, h', h'']
|
||||
<;> omega
|
||||
|
||||
@[simp]
|
||||
theorem not_sshiftRight_not {x : BitVec w} {n : Nat} :
|
||||
~~~((~~~x).sshiftRight n) = x.sshiftRight n := by
|
||||
simp [not_sshiftRight]
|
||||
|
||||
/-! ### sshiftRight reductions from BitVec to Nat -/
|
||||
|
||||
@[simp]
|
||||
@@ -1226,6 +1351,69 @@ theorem umod_eq {x y : BitVec n} :
|
||||
theorem toNat_umod {x y : BitVec n} :
|
||||
(x.umod y).toNat = x.toNat % y.toNat := rfl
|
||||
|
||||
/-! ### sdiv -/
|
||||
|
||||
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
|
||||
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => udiv x y
|
||||
| false, true => - (x.udiv (- y))
|
||||
| true, false => - ((- x).udiv y)
|
||||
| true, true => (- x).udiv (- y) := by
|
||||
rw [BitVec.sdiv]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (udiv x y).toNat
|
||||
| false, true => (- (x.udiv (- y))).toNat
|
||||
| true, false => (- ((- x).udiv y)).toNat
|
||||
| true, true => ((- x).udiv (- y)).toNat := by
|
||||
simp only [sdiv_eq, toNat_udiv]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
|
||||
|
||||
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
|
||||
have hx : x = 0#1 ∨ x = 1#1 := by bv_omega
|
||||
have hy : y = 0#1 ∨ y = 1#1 := by bv_omega
|
||||
rcases hx with rfl | rfl <;>
|
||||
rcases hy with rfl | rfl <;>
|
||||
rfl
|
||||
|
||||
/-! ### smod -/
|
||||
|
||||
/-- Equation theorem for `smod` in terms of `umod`. -/
|
||||
theorem smod_eq (x y : BitVec w) : x.smod y =
|
||||
match x.msb, y.msb with
|
||||
| false, false => x.umod y
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u else u + y)
|
||||
| true, false =>
|
||||
let u := umod (- x) y
|
||||
(if u = 0#w then u else y - u)
|
||||
| true, true => - ((- x).umod (- y)) := by
|
||||
rw [BitVec.smod]
|
||||
rcases x.msb <;> rcases y.msb <;> simp
|
||||
|
||||
@[bv_toNat]
|
||||
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
|
||||
match x.msb, y.msb with
|
||||
| false, false => (x.umod y).toNat
|
||||
| false, true =>
|
||||
let u := x.umod (- y)
|
||||
(if u = 0#w then u.toNat else (u + y).toNat)
|
||||
| true, false =>
|
||||
let u := (-x).umod y
|
||||
(if u = 0#w then u.toNat else (y - u).toNat)
|
||||
| true, true => (- ((- x).umod (- y))).toNat := by
|
||||
simp only [smod_eq, toNat_umod]
|
||||
by_cases h : x.msb <;> by_cases h' : y.msb
|
||||
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
|
||||
<;> simp only [h, h', h'', h''']
|
||||
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
|
||||
<;> simp [h'', h''']
|
||||
|
||||
/-! ### signExtend -/
|
||||
|
||||
/-- Equation theorem for `Int.sub` when both arguments are `Int.ofNat` -/
|
||||
@@ -1271,7 +1459,7 @@ theorem signExtend_eq_not_setWidth_not_of_msb_true {x : BitVec w} {v : Nat} (hms
|
||||
· apply Nat.le_refl
|
||||
· omega
|
||||
|
||||
@[simp] theorem getLsbD_signExtend (x : BitVec w) {v i : Nat} :
|
||||
theorem getLsbD_signExtend (x : BitVec w) {v i : Nat} :
|
||||
(x.signExtend v).getLsbD i = (decide (i < v) && if i < w then x.getLsbD i else x.msb) := by
|
||||
rcases hmsb : x.msb with rfl | rfl
|
||||
· rw [signExtend_eq_not_setWidth_not_of_msb_false hmsb]
|
||||
@@ -1279,6 +1467,11 @@ theorem signExtend_eq_not_setWidth_not_of_msb_true {x : BitVec w} {v : Nat} (hms
|
||||
· rw [signExtend_eq_not_setWidth_not_of_msb_true hmsb]
|
||||
by_cases (i < v) <;> by_cases (i < w) <;> simp_all <;> omega
|
||||
|
||||
theorem getElem_signExtend {x : BitVec w} {v i : Nat} (h : i < v) :
|
||||
(x.signExtend v)[i] = if i < w then x.getLsbD i else x.msb := by
|
||||
rw [←getLsbD_eq_getElem, getLsbD_signExtend]
|
||||
simp [h]
|
||||
|
||||
/-- Sign extending to a width smaller than the starting width is a truncation. -/
|
||||
theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v ≤ w):
|
||||
x.signExtend v = x.setWidth v := by
|
||||
@@ -1300,16 +1493,23 @@ theorem append_def (x : BitVec v) (y : BitVec w) :
|
||||
(x ++ y).toNat = x.toNat <<< n ||| y.toNat :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem getLsbD_append {x : BitVec n} {y : BitVec m} :
|
||||
theorem getLsbD_append {x : BitVec n} {y : BitVec m} :
|
||||
getLsbD (x ++ y) i = bif i < m then getLsbD y i else getLsbD x (i - m) := by
|
||||
simp only [append_def, getLsbD_or, getLsbD_shiftLeftZeroExtend, getLsbD_setWidth']
|
||||
by_cases h : i < m
|
||||
· simp [h]
|
||||
· simp [h]; simp_all
|
||||
· simp_all [h]
|
||||
|
||||
theorem getElem_append {x : BitVec n} {y : BitVec m} (h : i < n + m) :
|
||||
(x ++ y)[i] = bif i < m then getLsbD y i else getLsbD x (i - m) := by
|
||||
simp only [append_def, getElem_or, getElem_shiftLeftZeroExtend, getElem_setWidth']
|
||||
by_cases h' : i < m
|
||||
· simp [h']
|
||||
· simp_all [h']
|
||||
|
||||
@[simp] theorem getMsbD_append {x : BitVec n} {y : BitVec m} :
|
||||
getMsbD (x ++ y) i = bif n ≤ i then getMsbD y (i - n) else getMsbD x i := by
|
||||
simp [append_def]
|
||||
simp only [append_def]
|
||||
by_cases h : n ≤ i
|
||||
· simp [h]
|
||||
· simp [h]
|
||||
@@ -1317,7 +1517,7 @@ theorem append_def (x : BitVec v) (y : BitVec w) :
|
||||
theorem msb_append {x : BitVec w} {y : BitVec v} :
|
||||
(x ++ y).msb = bif (w == 0) then (y.msb) else (x.msb) := by
|
||||
rw [← append_eq, append]
|
||||
simp [msb_setWidth']
|
||||
simp only [msb_or, msb_shiftLeftZeroExtend, msb_setWidth']
|
||||
by_cases h : w = 0
|
||||
· subst h
|
||||
simp [BitVec.msb, getMsbD]
|
||||
@@ -1336,6 +1536,10 @@ theorem msb_append {x : BitVec w} {y : BitVec v} :
|
||||
rw [getLsbD_append]
|
||||
simpa using lt_of_getLsbD
|
||||
|
||||
@[simp] theorem zero_append_zero : 0#v ++ 0#w = 0#(v + w) := by
|
||||
ext
|
||||
simp only [getLsbD_append, getLsbD_zero, Bool.cond_self]
|
||||
|
||||
@[simp] theorem cast_append_right (h : w + v = w + v') (x : BitVec w) (y : BitVec v) :
|
||||
cast h (x ++ y) = x ++ cast (by omega) y := by
|
||||
ext
|
||||
@@ -1350,7 +1554,7 @@ theorem msb_append {x : BitVec w} {y : BitVec v} :
|
||||
@[simp] theorem cast_append_left (h : w + v = w' + v) (x : BitVec w) (y : BitVec v) :
|
||||
cast h (x ++ y) = cast (by omega) x ++ y := by
|
||||
ext
|
||||
simp
|
||||
simp [getLsbD_append]
|
||||
|
||||
theorem setWidth_append {x : BitVec w} {y : BitVec v} :
|
||||
(x ++ y).setWidth k = if h : k ≤ v then y.setWidth k else (x.setWidth (k - v) ++ y).cast (by omega) := by
|
||||
@@ -1361,9 +1565,9 @@ theorem setWidth_append {x : BitVec w} {y : BitVec v} :
|
||||
· have t : i < v := by omega
|
||||
simp [t]
|
||||
· by_cases t : i < v
|
||||
· simp [t]
|
||||
· simp [t, getLsbD_append]
|
||||
· have t' : i - v < k - v := by omega
|
||||
simp [t, t']
|
||||
simp [t, t', getLsbD_append]
|
||||
|
||||
@[simp] theorem setWidth_append_of_eq {x : BitVec v} {y : BitVec w} (h : w' = w) : setWidth (v' + w') (x ++ y) = setWidth v' x ++ setWidth w' y := by
|
||||
subst h
|
||||
@@ -1391,25 +1595,40 @@ theorem setWidth_append {x : BitVec w} {y : BitVec v} :
|
||||
(x₁ ++ y₁) &&& (x₂ ++ y₂) = (x₁ &&& x₂) ++ (y₁ &&& y₂) := by
|
||||
ext i
|
||||
simp only [getLsbD_append, cond_eq_if]
|
||||
split <;> simp [*]
|
||||
split <;> simp [getLsbD_append, *]
|
||||
|
||||
@[simp] theorem or_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
|
||||
(x₁ ++ y₁) ||| (x₂ ++ y₂) = (x₁ ||| x₂) ++ (y₁ ||| y₂) := by
|
||||
ext i
|
||||
simp only [getLsbD_append, cond_eq_if]
|
||||
split <;> simp [*]
|
||||
split <;> simp [getLsbD_append, *]
|
||||
|
||||
@[simp] theorem xor_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
|
||||
(x₁ ++ y₁) ^^^ (x₂ ++ y₂) = (x₁ ^^^ x₂) ++ (y₁ ^^^ y₂) := by
|
||||
ext i
|
||||
simp only [getLsbD_append, cond_eq_if]
|
||||
split <;> simp [*]
|
||||
split <;> simp [getLsbD_append, *]
|
||||
|
||||
theorem shiftRight_add {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
x >>> (n + m) = (x >>> n) >>> m:= by
|
||||
ext i
|
||||
simp [Nat.add_assoc n m i]
|
||||
|
||||
theorem shiftLeft_ushiftRight {x : BitVec w} {n : Nat}:
|
||||
x >>> n <<< n = x &&& BitVec.allOnes w <<< n := by
|
||||
induction n generalizing x
|
||||
case zero =>
|
||||
ext; simp
|
||||
case succ n ih =>
|
||||
rw [BitVec.shiftLeft_add, Nat.add_comm, BitVec.shiftRight_add, ih,
|
||||
Nat.add_comm, BitVec.shiftLeft_add, BitVec.shiftLeft_and_distrib]
|
||||
ext i
|
||||
by_cases hw : w = 0
|
||||
· simp [hw]
|
||||
· by_cases hi₂ : i.val = 0
|
||||
· simp [hi₂]
|
||||
· simp [Nat.lt_one_iff, hi₂, show 1 + (i.val - 1) = i by omega]
|
||||
|
||||
@[deprecated shiftRight_add (since := "2024-06-02")]
|
||||
theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
(x >>> n) >>> m = x >>> (n + m) := by
|
||||
@@ -1419,7 +1638,13 @@ theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
|
||||
|
||||
theorem getLsbD_rev (x : BitVec w) (i : Fin w) :
|
||||
x.getLsbD i.rev = x.getMsbD i := by
|
||||
simp [getLsbD, getMsbD]
|
||||
simp only [getLsbD, Fin.val_rev, getMsbD, Fin.is_lt, decide_True, Bool.true_and]
|
||||
congr 1
|
||||
omega
|
||||
|
||||
theorem getElem_rev {x : BitVec w} {i : Fin w}:
|
||||
x[i.rev] = x.getMsbD i := by
|
||||
simp only [Fin.getElem_fin, Fin.val_rev, getMsbD, Fin.is_lt, decide_True, Bool.true_and]
|
||||
congr 1
|
||||
omega
|
||||
|
||||
@@ -1442,15 +1667,30 @@ theorem toNat_cons' {x : BitVec w} :
|
||||
(cons a x).toNat = (a.toNat <<< w) + x.toNat := by
|
||||
simp [cons, Nat.shiftLeft_eq, Nat.mul_comm _ (2^w), Nat.mul_add_lt_is_or, x.isLt]
|
||||
|
||||
@[simp] theorem getLsbD_cons (b : Bool) {n} (x : BitVec n) (i : Nat) :
|
||||
theorem getLsbD_cons (b : Bool) {n} (x : BitVec n) (i : Nat) :
|
||||
getLsbD (cons b x) i = if i = n then b else getLsbD x i := by
|
||||
simp only [getLsbD, toNat_cons, Nat.testBit_or]
|
||||
simp only [getLsbD, toNat_cons, Nat.testBit_or, Nat.testBit_shiftLeft, ge_iff_le]
|
||||
rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
|
||||
· have p1 : ¬(n ≤ i) := by omega
|
||||
have p2 : i ≠ n := by omega
|
||||
simp [p1, p2]
|
||||
· simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_True, Nat.sub_self, Nat.testBit_zero,
|
||||
Bool.true_and, testBit_toNat, getLsbD_ge, Bool.or_false, ↓reduceIte]
|
||||
cases b <;> trivial
|
||||
· have p1 : i ≠ n := by omega
|
||||
have p2 : i - n ≠ 0 := by omega
|
||||
simp [p1, p2, Nat.testBit_bool_to_nat]
|
||||
|
||||
theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
|
||||
(cons b x)[i] = if i = n then b else getLsbD x i := by
|
||||
simp only [getElem_eq_testBit_toNat, toNat_cons, Nat.testBit_or, getLsbD]
|
||||
rw [Nat.testBit_shiftLeft]
|
||||
rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
|
||||
· have p1 : ¬(n ≤ i) := by omega
|
||||
have p2 : i ≠ n := by omega
|
||||
simp [p1, p2]
|
||||
· simp [i_eq_n, testBit_toNat]
|
||||
· simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_True, Nat.sub_self, Nat.testBit_zero,
|
||||
Bool.true_and, testBit_toNat, getLsbD_ge, Bool.or_false, ↓reduceIte]
|
||||
cases b <;> trivial
|
||||
· have p1 : i ≠ n := by omega
|
||||
have p2 : i - n ≠ 0 := by omega
|
||||
@@ -1476,15 +1716,19 @@ theorem setWidth_succ (x : BitVec w) :
|
||||
have j_lt : j.val < i := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ j.isLt) j_eq
|
||||
simp [j_eq, j_lt]
|
||||
|
||||
theorem eq_msb_cons_setWidth (x : BitVec (w+1)) : x = (cons x.msb (x.setWidth w)) := by
|
||||
@[simp] theorem cons_msb_setWidth (x : BitVec (w+1)) : (cons x.msb (x.setWidth w)) = x := by
|
||||
ext i
|
||||
simp
|
||||
simp only [getLsbD_cons]
|
||||
split <;> rename_i h
|
||||
· simp [BitVec.msb, getMsbD, h]
|
||||
· by_cases h' : i < w
|
||||
· simp_all
|
||||
· omega
|
||||
|
||||
@[deprecated "Use the reverse direction of `cons_msb_setWidth`"]
|
||||
theorem eq_msb_cons_setWidth (x : BitVec (w+1)) : x = (cons x.msb (x.setWidth w)) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem not_cons (x : BitVec w) (b : Bool) : ~~~(cons b x) = cons (!b) (~~~x) := by
|
||||
simp [cons]
|
||||
|
||||
@@ -1521,12 +1765,27 @@ theorem getLsbD_concat (x : BitVec w) (b : Bool) (i : Nat) :
|
||||
· simp [Nat.mod_eq_of_lt b.toNat_lt]
|
||||
· simp [Nat.div_eq_of_lt b.toNat_lt, Nat.testBit_add_one]
|
||||
|
||||
theorem getElem_concat (x : BitVec w) (b : Bool) (i : Nat) (h : i < w + 1) :
|
||||
(concat x b)[i] = if i = 0 then b else x.getLsbD (i - 1) := by
|
||||
simp only [concat, getElem_eq_testBit_toNat, getLsbD, toNat_append,
|
||||
toNat_ofBool, Nat.testBit_or, Nat.shiftLeft_eq]
|
||||
cases i
|
||||
· simp [Nat.mod_eq_of_lt b.toNat_lt]
|
||||
· simp [Nat.div_eq_of_lt b.toNat_lt, Nat.testBit_add_one]
|
||||
|
||||
@[simp] theorem getLsbD_concat_zero : (concat x b).getLsbD 0 = b := by
|
||||
simp [getLsbD_concat]
|
||||
|
||||
@[simp] theorem getElem_concat_zero : (concat x b)[0] = b := by
|
||||
simp [getElem_concat]
|
||||
|
||||
@[simp] theorem getLsbD_concat_succ : (concat x b).getLsbD (i + 1) = x.getLsbD i := by
|
||||
simp [getLsbD_concat]
|
||||
|
||||
@[simp] theorem getElem_concat_succ {x : BitVec w} {i : Nat} (h : i < w) :
|
||||
(concat x b)[i + 1] = x[i] := by
|
||||
simp [getElem_concat, h, getLsbD_eq_getElem]
|
||||
|
||||
@[simp] theorem not_concat (x : BitVec w) (b : Bool) : ~~~(concat x b) = concat (~~~x) !b := by
|
||||
ext i; cases i using Fin.succRecOn <;> simp [*, Nat.succ_lt_succ]
|
||||
|
||||
@@ -1542,6 +1801,55 @@ theorem getLsbD_concat (x : BitVec w) (b : Bool) (i : Nat) :
|
||||
(concat x a) ^^^ (concat y b) = concat (x ^^^ y) (a ^^ b) := by
|
||||
ext i; cases i using Fin.succRecOn <;> simp
|
||||
|
||||
/-! ### shiftConcat -/
|
||||
|
||||
theorem getLsbD_shiftConcat (x : BitVec w) (b : Bool) (i : Nat) :
|
||||
(shiftConcat x b).getLsbD i
|
||||
= (decide (i < w) && (if (i = 0) then b else x.getLsbD (i - 1))) := by
|
||||
simp only [shiftConcat, getLsbD_setWidth, getLsbD_concat]
|
||||
|
||||
theorem getLsbD_shiftConcat_eq_decide (x : BitVec w) (b : Bool) (i : Nat) :
|
||||
(shiftConcat x b).getLsbD i
|
||||
= (decide (i < w) && ((decide (i = 0) && b) || (decide (0 < i) && x.getLsbD (i - 1)))) := by
|
||||
simp only [getLsbD_shiftConcat]
|
||||
split <;> simp [*, show ((0 < i) ↔ ¬(i = 0)) by omega]
|
||||
|
||||
theorem shiftRight_sub_one_eq_shiftConcat (n : BitVec w) (hwn : 0 < wn) :
|
||||
n >>> (wn - 1) = (n >>> wn).shiftConcat (n.getLsbD (wn - 1)) := by
|
||||
ext i
|
||||
simp only [getLsbD_ushiftRight, getLsbD_shiftConcat, Fin.is_lt, decide_True, Bool.true_and]
|
||||
split
|
||||
· simp [*]
|
||||
· congr 1; omega
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_shiftConcat {x : BitVec w} {b : Bool} :
|
||||
(x.shiftConcat b).toNat
|
||||
= (x.toNat <<< 1 + b.toNat) % 2 ^ w := by
|
||||
simp [shiftConcat, Nat.shiftLeft_eq]
|
||||
|
||||
/-- `x.shiftConcat b` does not overflow if `x < 2^k` for `k < w`, and so
|
||||
`x.shiftConcat b |>.toNat = x.toNat * 2 + b.toNat`. -/
|
||||
theorem toNat_shiftConcat_eq_of_lt {x : BitVec w} {b : Bool} {k : Nat}
|
||||
(hk : k < w) (hx : x.toNat < 2 ^ k) :
|
||||
(x.shiftConcat b).toNat = x.toNat * 2 + b.toNat := by
|
||||
simp only [toNat_shiftConcat, Nat.shiftLeft_eq, Nat.pow_one]
|
||||
have : 2 ^ k < 2 ^ w := Nat.pow_lt_pow_of_lt (by omega) (by omega)
|
||||
have : 2 ^ k * 2 ≤ 2 ^ w := (Nat.pow_lt_pow_iff_pow_mul_le_pow (by omega)).mp this
|
||||
rw [Nat.mod_eq_of_lt (by cases b <;> simp [bv_toNat] <;> omega)]
|
||||
|
||||
theorem toNat_shiftConcat_lt_of_lt {x : BitVec w} {b : Bool} {k : Nat}
|
||||
(hk : k < w) (hx : x.toNat < 2 ^ k) :
|
||||
(x.shiftConcat b).toNat < 2 ^ (k + 1) := by
|
||||
rw [toNat_shiftConcat_eq_of_lt hk hx]
|
||||
have : 2 ^ (k + 1) ≤ 2 ^ w := Nat.pow_le_pow_of_le_right (by decide) (by assumption)
|
||||
have := Bool.toNat_lt b
|
||||
omega
|
||||
|
||||
@[simp] theorem zero_concat_false : concat 0#w false = 0#(w + 1) := by
|
||||
ext
|
||||
simp [getLsbD_concat]
|
||||
|
||||
/-! ### add -/
|
||||
|
||||
theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl
|
||||
@@ -1592,6 +1900,15 @@ theorem ofInt_add {n} (x y : Int) : BitVec.ofInt n (x + y) =
|
||||
apply eq_of_toInt_eq
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem shiftLeft_add_distrib {x y : BitVec w} {n : Nat} :
|
||||
(x + y) <<< n = x <<< n + y <<< n := by
|
||||
induction n
|
||||
case zero =>
|
||||
simp
|
||||
case succ n ih =>
|
||||
simp [ih, toNat_eq, Nat.shiftLeft_eq, ← Nat.add_mul]
|
||||
|
||||
/-! ### sub/neg -/
|
||||
|
||||
theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toNat) := by rfl
|
||||
@@ -1631,13 +1948,28 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
|
||||
@[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
|
||||
simp [Neg.neg, BitVec.neg]
|
||||
|
||||
theorem toInt_neg {x : BitVec w} :
|
||||
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
|
||||
simp only [toInt_eq_toNat_bmod, toNat_neg, Int.ofNat_emod, Int.emod_bmod_congr]
|
||||
rw [← Int.subNatNat_of_le (by omega), Int.subNatNat_eq_coe, Int.sub_eq_add_neg, Int.add_comm,
|
||||
Int.bmod_add_cancel]
|
||||
by_cases h : x.toNat < ((2 ^ w) + 1) / 2
|
||||
· rw [Int.bmod_pos (x := x.toNat)]
|
||||
all_goals simp only [toNat_mod_cancel']
|
||||
norm_cast
|
||||
· rw [Int.bmod_neg (x := x.toNat)]
|
||||
· simp only [toNat_mod_cancel']
|
||||
rw_mod_cast [Int.neg_sub, Int.sub_eq_add_neg, Int.add_comm, Int.bmod_add_cancel]
|
||||
· norm_cast
|
||||
simp_all
|
||||
|
||||
@[simp] theorem toFin_neg (x : BitVec n) :
|
||||
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=
|
||||
rfl
|
||||
|
||||
theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by
|
||||
apply eq_of_toNat_eq
|
||||
simp
|
||||
simp only [toNat_sub, toNat_add, toNat_neg, Nat.add_mod_mod]
|
||||
rw [Nat.add_comm]
|
||||
|
||||
@[simp] theorem neg_zero (n:Nat) : -BitVec.ofNat n 0 = BitVec.ofNat n 0 := by apply eq_of_toNat_eq ; simp
|
||||
@@ -1686,6 +2018,17 @@ theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x ≠ y ↔ x ≠ -y := by
|
||||
subst h'
|
||||
simp at h
|
||||
|
||||
/-! ### abs -/
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_abs {x : BitVec w} : x.abs.toNat = if x.msb then 2^w - x.toNat else x.toNat := by
|
||||
simp only [BitVec.abs, neg_eq]
|
||||
by_cases h : x.msb = true
|
||||
· simp only [h, ↓reduceIte, toNat_neg]
|
||||
have : 2 * x.toNat ≥ 2 ^ w := BitVec.msb_eq_true_iff_two_mul_ge.mp h
|
||||
rw [Nat.mod_eq_of_lt (by omega)]
|
||||
· simp [h]
|
||||
|
||||
/-! ### mul -/
|
||||
|
||||
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
|
||||
@@ -1724,6 +2067,15 @@ theorem BitVec.mul_add {x y z : BitVec w} :
|
||||
rw [Nat.mul_mod, Nat.mod_mod (y.toNat + z.toNat),
|
||||
← Nat.mul_mod, Nat.mul_add]
|
||||
|
||||
theorem mul_succ {x y : BitVec w} : x * (y + 1#w) = x * y + x := by simp [BitVec.mul_add]
|
||||
theorem succ_mul {x y : BitVec w} : (x + 1#w) * y = x * y + y := by simp [BitVec.mul_comm, BitVec.mul_add]
|
||||
|
||||
theorem mul_two {x : BitVec w} : x * 2#w = x + x := by
|
||||
have : 2#w = 1#w + 1#w := by apply BitVec.eq_of_toNat_eq; simp
|
||||
simp [this, mul_succ]
|
||||
|
||||
theorem two_mul {x : BitVec w} : 2#w * x = x + x := by rw [BitVec.mul_comm, mul_two]
|
||||
|
||||
@[simp, bv_toNat] theorem toInt_mul (x y : BitVec w) :
|
||||
(x * y).toInt = (x.toInt * y.toInt).bmod (2^w) := by
|
||||
simp [toInt_eq_toNat_bmod]
|
||||
@@ -1799,6 +2151,10 @@ protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x.umod y < y
|
||||
simp only [ofNat_eq_ofNat, lt_def, toNat_ofNat, Nat.zero_mod, umod, toNat_ofNatLt]
|
||||
apply Nat.mod_lt
|
||||
|
||||
theorem not_lt_iff_le {x y : BitVec w} : (¬ x < y) ↔ y ≤ x := by
|
||||
constructor <;>
|
||||
(intro h; simp only [lt_def, Nat.not_lt, le_def] at h ⊢; omega)
|
||||
|
||||
/-! ### ofBoolList -/
|
||||
|
||||
@[simp] theorem getMsbD_ofBoolListBE : (ofBoolListBE bs).getMsbD i = bs.getD i false := by
|
||||
@@ -1808,6 +2164,13 @@ protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x.umod y < y
|
||||
(ofBoolListBE bs).getLsbD i = (decide (i < bs.length) && bs.getD (bs.length - 1 - i) false) := by
|
||||
simp [getLsbD_eq_getMsbD]
|
||||
|
||||
@[simp] theorem getElem_ofBoolListBE (h : i < bs.length) :
|
||||
(ofBoolListBE bs)[i] = bs[bs.length - 1 - i] := by
|
||||
rw [← getLsbD_eq_getElem, getLsbD_ofBoolListBE]
|
||||
simp only [h, decide_True, List.getD_eq_getElem?_getD, Bool.true_and]
|
||||
rw [List.getElem?_eq_getElem (by omega)]
|
||||
simp
|
||||
|
||||
@[simp] theorem getLsb_ofBoolListLE : (ofBoolListLE bs).getLsbD i = bs.getD i false := by
|
||||
induction bs generalizing i <;> cases i <;> simp_all [ofBoolListLE]
|
||||
|
||||
@@ -2037,6 +2400,27 @@ theorem twoPow_zero {w : Nat} : twoPow w 0 = 1#w := by
|
||||
theorem getLsbD_one {w i : Nat} : (1#w).getLsbD i = (decide (0 < w) && decide (0 = i)) := by
|
||||
rw [← twoPow_zero, getLsbD_twoPow]
|
||||
|
||||
theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
|
||||
x <<< n = x * (BitVec.twoPow w n) := by
|
||||
ext i
|
||||
simp [getLsbD_shiftLeft, Fin.is_lt, decide_True, Bool.true_and, mul_twoPow_eq_shiftLeft]
|
||||
|
||||
/- ### cons -/
|
||||
|
||||
@[simp] theorem true_cons_zero : cons true 0#w = twoPow (w + 1) w := by
|
||||
ext
|
||||
simp [getLsbD_cons]
|
||||
omega
|
||||
|
||||
@[simp] theorem false_cons_zero : cons false 0#w = 0#(w + 1) := by
|
||||
ext
|
||||
simp [getLsbD_cons]
|
||||
|
||||
@[simp] theorem zero_concat_true : concat 0#w true = 1#(w + 1) := by
|
||||
ext
|
||||
simp [getLsbD_concat]
|
||||
omega
|
||||
|
||||
/- ### setWidth, setWidth, and bitwise operations -/
|
||||
|
||||
/--
|
||||
@@ -2129,10 +2513,28 @@ theorem getLsbD_intMin (w : Nat) : (intMin w).getLsbD i = decide (i + 1 = w) :=
|
||||
simp only [intMin, getLsbD_twoPow, boolToPropSimps]
|
||||
omega
|
||||
|
||||
/--
|
||||
The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
|
||||
-/
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_intMin : (intMin w).toNat = 2 ^ (w - 1) % 2 ^ w := by
|
||||
simp [intMin]
|
||||
|
||||
/--
|
||||
The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
|
||||
-/
|
||||
@[simp]
|
||||
theorem toInt_intMin {w : Nat} :
|
||||
(intMin w).toInt = -((2 ^ (w - 1) % 2 ^ w) : Nat) := by
|
||||
by_cases h : w = 0
|
||||
· subst h
|
||||
simp [BitVec.toInt]
|
||||
· have w_pos : 0 < w := by omega
|
||||
simp only [BitVec.toInt, toNat_intMin, w_pos, Nat.two_pow_pred_mod_two_pow,
|
||||
Int.two_pow_pred_sub_two_pow, ite_eq_right_iff]
|
||||
rw [Nat.mul_comm]
|
||||
simp [w_pos]
|
||||
|
||||
@[simp]
|
||||
theorem neg_intMin {w : Nat} : -intMin w = intMin w := by
|
||||
by_cases h : 0 < w
|
||||
@@ -2140,6 +2542,22 @@ theorem neg_intMin {w : Nat} : -intMin w = intMin w := by
|
||||
· simp only [Nat.not_lt, Nat.le_zero_eq] at h
|
||||
simp [bv_toNat, h]
|
||||
|
||||
theorem toInt_neg_of_ne_intMin {x : BitVec w} (rs : x ≠ intMin w) :
|
||||
(-x).toInt = -(x.toInt) := by
|
||||
simp only [ne_eq, toNat_eq, toNat_intMin] at rs
|
||||
by_cases x_zero : x = 0
|
||||
· subst x_zero
|
||||
simp [BitVec.toInt]
|
||||
omega
|
||||
by_cases w_0 : w = 0
|
||||
· subst w_0
|
||||
simp [BitVec.eq_nil x]
|
||||
have : 0 < w := by omega
|
||||
rw [Nat.two_pow_pred_mod_two_pow (by omega)] at rs
|
||||
simp only [BitVec.toInt, BitVec.toNat_neg, BitVec.sub_toNat_mod_cancel x_zero]
|
||||
have := @Nat.two_pow_pred_mul_two w (by omega)
|
||||
split <;> split <;> omega
|
||||
|
||||
/-! ### intMax -/
|
||||
|
||||
/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
|
||||
@@ -2173,6 +2591,11 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
|
||||
|
||||
/-! ### Non-overflow theorems -/
|
||||
|
||||
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
|
||||
theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
|
||||
(x + y).toNat = x.toNat + y.toNat := by
|
||||
rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]
|
||||
|
||||
/--
|
||||
If `y ≤ x`, then the subtraction `(x - y)` does not overflow.
|
||||
Thus, `(x - y).toNat = x.toNat - y.toNat`
|
||||
@@ -2186,6 +2609,88 @@ theorem toNat_sub_of_le {x y : BitVec n} (h : y ≤ x) :
|
||||
· have : 2 ^ n - y.toNat + x.toNat = 2 ^ n + (x.toNat - y.toNat) := by omega
|
||||
rw [this, Nat.add_mod_left, Nat.mod_eq_of_lt (by omega)]
|
||||
|
||||
/--
|
||||
If `y > x`, then the subtraction `(x - y)` *does* overflow, and the result is the wraparound.
|
||||
Thus, `(x - y).toNat = 2^w - (y.toNat - x.toNat)`.
|
||||
-/
|
||||
theorem toNat_sub_of_lt {x y : BitVec w} (h : x < y) :
|
||||
(x - y).toNat = 2^w - (y.toNat - x.toNat) := by
|
||||
simp only [toNat_sub]
|
||||
rw [Nat.mod_eq_of_lt (by bv_omega)]
|
||||
bv_omega
|
||||
|
||||
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow.
|
||||
Thus, `(x * y).toNat = x.toNat * y.toNat`.
|
||||
-/
|
||||
theorem toNat_mul_of_lt {w} {x y : BitVec w} (h : x.toNat * y.toNat < 2^w) :
|
||||
(x * y).toNat = x.toNat * y.toNat := by
|
||||
rw [BitVec.toNat_mul, Nat.mod_eq_of_lt h]
|
||||
|
||||
/-! ### Decidable quantifiers -/
|
||||
|
||||
theorem forall_zero_iff {P : BitVec 0 → Prop} :
|
||||
(∀ v, P v) ↔ P 0#0 := by
|
||||
constructor
|
||||
· intro h
|
||||
apply h
|
||||
· intro h v
|
||||
obtain (rfl : v = 0#0) := (by ext ⟨i, h⟩; simp at h)
|
||||
apply h
|
||||
|
||||
theorem forall_cons_iff {P : BitVec (n + 1) → Prop} :
|
||||
(∀ v : BitVec (n + 1), P v) ↔ (∀ (x : Bool) (v : BitVec n), P (v.cons x)) := by
|
||||
constructor
|
||||
· intro h _ _
|
||||
apply h
|
||||
· intro h v
|
||||
have w : v = (v.setWidth n).cons v.msb := by simp
|
||||
rw [w]
|
||||
apply h
|
||||
|
||||
instance instDecidableForallBitVecZero (P : BitVec 0 → Prop) :
|
||||
∀ [Decidable (P 0#0)], Decidable (∀ v, P v)
|
||||
| .isTrue h => .isTrue fun v => by
|
||||
obtain (rfl : v = 0#0) := (by ext ⟨i, h⟩; cases h)
|
||||
exact h
|
||||
| .isFalse h => .isFalse (fun w => h (w _))
|
||||
|
||||
instance instDecidableForallBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
|
||||
[Decidable (∀ (x : Bool) (v : BitVec n), P (v.cons x))] : Decidable (∀ v, P v) :=
|
||||
decidable_of_iff' (∀ x (v : BitVec n), P (v.cons x)) forall_cons_iff
|
||||
|
||||
instance instDecidableExistsBitVecZero (P : BitVec 0 → Prop) [Decidable (P 0#0)] :
|
||||
Decidable (∃ v, P v) :=
|
||||
decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
|
||||
|
||||
instance instDecidableExistsBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
|
||||
[Decidable (∀ (x : Bool) (v : BitVec n), ¬ P (v.cons x))] : Decidable (∃ v, P v) :=
|
||||
decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
|
||||
|
||||
/--
|
||||
For small numerals this isn't necessary (as typeclass search can use the above two instances),
|
||||
but for large numerals this provides a shortcut.
|
||||
Note, however, that for large numerals the decision procedure may be very slow,
|
||||
and you should use `bv_decide` if possible.
|
||||
-/
|
||||
instance instDecidableForallBitVec :
|
||||
∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∀ v, P v)
|
||||
| 0, _, _ => inferInstance
|
||||
| n + 1, _, _ =>
|
||||
have := instDecidableForallBitVec n
|
||||
inferInstance
|
||||
|
||||
/--
|
||||
For small numerals this isn't necessary (as typeclass search can use the above two instances),
|
||||
but for large numerals this provides a shortcut.
|
||||
Note, however, that for large numerals the decision procedure may be very slow.
|
||||
-/
|
||||
instance instDecidableExistsBitVec :
|
||||
∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∃ v, P v)
|
||||
| 0, _, _ => inferInstance
|
||||
| n + 1, _, _ =>
|
||||
have := instDecidableExistsBitVec n
|
||||
inferInstance
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
set_option linter.missingDocs false
|
||||
|
||||
@@ -368,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 _)
|
||||
|
||||
|
||||
@@ -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 _)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -72,21 +72,35 @@ instance floatDecLt (a b : Float) : Decidable (a < b) := Float.decLt a b
|
||||
instance floatDecLe (a b : Float) : Decidable (a ≤ b) := Float.decLe a b
|
||||
|
||||
@[extern "lean_float_to_string"] opaque Float.toString : Float → String
|
||||
|
||||
/-- If the given float is positive, truncates the value to the nearest positive integer.
|
||||
If negative or larger than the maximum value for UInt8, returns 0. -/
|
||||
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
|
||||
If negative or NaN, returns 0.
|
||||
If larger than the maximum value for UInt8 (including Inf), returns maximum value of UInt8
|
||||
(i.e. UInt8.size - 1).
|
||||
-/
|
||||
@[extern "lean_float_to_uint8"] opaque Float.toUInt8 : Float → UInt8
|
||||
/-- If the given float is positive, truncates the value to the nearest positive integer.
|
||||
If negative or larger than the maximum value for UInt16, returns 0. -/
|
||||
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
|
||||
If negative or NaN, returns 0.
|
||||
If larger than the maximum value for UInt16 (including Inf), returns maximum value of UInt16
|
||||
(i.e. UInt16.size - 1).
|
||||
-/
|
||||
@[extern "lean_float_to_uint16"] opaque Float.toUInt16 : Float → UInt16
|
||||
/-- If the given float is positive, truncates the value to the nearest positive integer.
|
||||
If negative or larger than the maximum value for UInt32, returns 0. -/
|
||||
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
|
||||
If negative or NaN, returns 0.
|
||||
If larger than the maximum value for UInt32 (including Inf), returns maximum value of UInt32
|
||||
(i.e. UInt32.size - 1).
|
||||
-/
|
||||
@[extern "lean_float_to_uint32"] opaque Float.toUInt32 : Float → UInt32
|
||||
/-- If the given float is positive, truncates the value to the nearest positive integer.
|
||||
If negative or larger than the maximum value for UInt64, returns 0. -/
|
||||
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
|
||||
If negative or NaN, returns 0.
|
||||
If larger than the maximum value for UInt64 (including Inf), returns maximum value of UInt64
|
||||
(i.e. UInt64.size - 1).
|
||||
-/
|
||||
@[extern "lean_float_to_uint64"] opaque Float.toUInt64 : Float → UInt64
|
||||
/-- If the given float is positive, truncates the value to the nearest positive integer.
|
||||
If negative or larger than the maximum value for USize, returns 0. -/
|
||||
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
|
||||
If negative or NaN, returns 0.
|
||||
If larger than the maximum value for USize (including Inf), returns maximum value of USize
|
||||
(i.e. USize.size - 1; Note that this value is platform dependent).
|
||||
-/
|
||||
@[extern "lean_float_to_usize"] opaque Float.toUSize : Float → USize
|
||||
|
||||
@[extern "lean_float_isnan"] opaque Float.isNaN : Float → Bool
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -43,7 +43,7 @@ The operations are organized as follow:
|
||||
* Logic: `any`, `all`, `or`, and `and`.
|
||||
* Zippers: `zipWith`, `zip`, `zipWithAll`, and `unzip`.
|
||||
* Ranges and enumeration: `range`, `iota`, `enumFrom`, and `enum`.
|
||||
* Minima and maxima: `minimum?` and `maximum?`.
|
||||
* Minima and maxima: `min?` and `max?`.
|
||||
* Other functions: `intersperse`, `intercalate`, `eraseDups`, `eraseReps`, `span`, `groupBy`,
|
||||
`removeAll`
|
||||
(currently these functions are mostly only used in meta code,
|
||||
@@ -1464,30 +1464,34 @@ def enum : List α → List (Nat × α) := enumFrom 0
|
||||
|
||||
/-! ## Minima and maxima -/
|
||||
|
||||
/-! ### minimum? -/
|
||||
/-! ### min? -/
|
||||
|
||||
/--
|
||||
Returns the smallest element of the list, if it is not empty.
|
||||
* `[].minimum? = none`
|
||||
* `[4].minimum? = some 4`
|
||||
* `[1, 4, 2, 10, 6].minimum? = some 1`
|
||||
* `[].min? = none`
|
||||
* `[4].min? = some 4`
|
||||
* `[1, 4, 2, 10, 6].min? = some 1`
|
||||
-/
|
||||
def minimum? [Min α] : List α → Option α
|
||||
def min? [Min α] : List α → Option α
|
||||
| [] => none
|
||||
| a::as => some <| as.foldl min a
|
||||
|
||||
/-! ### maximum? -/
|
||||
@[inherit_doc min?, deprecated min? (since := "2024-09-29")] abbrev minimum? := @min?
|
||||
|
||||
/-! ### max? -/
|
||||
|
||||
/--
|
||||
Returns the largest element of the list, if it is not empty.
|
||||
* `[].maximum? = none`
|
||||
* `[4].maximum? = some 4`
|
||||
* `[1, 4, 2, 10, 6].maximum? = some 10`
|
||||
* `[].max? = none`
|
||||
* `[4].max? = some 4`
|
||||
* `[1, 4, 2, 10, 6].max? = some 10`
|
||||
-/
|
||||
def maximum? [Max α] : List α → Option α
|
||||
def max? [Max α] : List α → Option α
|
||||
| [] => none
|
||||
| a::as => some <| as.foldl max a
|
||||
|
||||
@[inherit_doc max?, deprecated max? (since := "2024-09-29")] abbrev maximum? := @max?
|
||||
|
||||
/-! ## Other list operations
|
||||
|
||||
The functions are currently mostly used in meta code,
|
||||
|
||||
@@ -31,7 +31,7 @@ The following operations are still missing `@[csimp]` replacements:
|
||||
The following operations are not recursive to begin with
|
||||
(or are defined in terms of recursive primitives):
|
||||
`isEmpty`, `isSuffixOf`, `isSuffixOf?`, `rotateLeft`, `rotateRight`, `insert`, `zip`, `enum`,
|
||||
`minimum?`, `maximum?`, and `removeAll`.
|
||||
`min?`, `max?`, and `removeAll`.
|
||||
|
||||
The following operations were already given `@[csimp]` replacements in `Init/Data/List/Basic.lean`:
|
||||
`length`, `map`, `filter`, `replicate`, `leftPad`, `unzip`, `range'`, `iota`, `intersperse`.
|
||||
|
||||
@@ -55,7 +55,7 @@ See also
|
||||
* `Init.Data.List.Erase` for lemmas about `List.eraseP` and `List.erase`.
|
||||
* `Init.Data.List.Find` for lemmas about `List.find?`, `List.findSome?`, `List.findIdx`,
|
||||
`List.findIdx?`, and `List.indexOf`
|
||||
* `Init.Data.List.MinMax` for lemmas about `List.minimum?` and `List.maximum?`.
|
||||
* `Init.Data.List.MinMax` for lemmas about `List.min?` and `List.max?`.
|
||||
* `Init.Data.List.Pairwise` for lemmas about `List.Pairwise` and `List.Nodup`.
|
||||
* `Init.Data.List.Sublist` for lemmas about `List.Subset`, `List.Sublist`, `List.IsPrefix`,
|
||||
`List.IsSuffix`, and `List.IsInfix`.
|
||||
@@ -203,6 +203,9 @@ theorem get?_eq_none : l.get? n = none ↔ length l ≤ n :=
|
||||
|
||||
@[simp] theorem get_eq_getElem (l : List α) (i : Fin l.length) : l.get i = l[i.1]'i.2 := rfl
|
||||
|
||||
theorem getElem?_eq_some {l : List α} : l[i]? = some a ↔ ∃ h : i < l.length, l[i]'h = a := by
|
||||
simpa using get?_eq_some
|
||||
|
||||
/--
|
||||
If one has `l.get i` in an expression (with `i : Fin l.length`) and `h : l = l'`,
|
||||
`rw [h]` will give a "motive it not type correct" error, as it cannot rewrite the
|
||||
@@ -489,7 +492,7 @@ 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
|
||||
@[simp] theorem getElem_mem : ∀ {l : List α} {n} (h : n < l.length), l[n]'h ∈ l
|
||||
| _ :: _, 0, _ => .head ..
|
||||
| _ :: l, _+1, _ => .tail _ (getElem_mem (l := l) ..)
|
||||
|
||||
@@ -878,6 +881,20 @@ theorem foldr_map' {α β : Type u} (g : α → β) (f : α → α → α) (f' :
|
||||
· simp
|
||||
· simp [*, h]
|
||||
|
||||
theorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldl_cons, ha.assoc]
|
||||
rw [foldl_assoc]
|
||||
|
||||
theorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] :
|
||||
∀ {l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
|
||||
| [], a₁, a₂ => rfl
|
||||
| a :: l, a₁, a₂ => by
|
||||
simp only [foldr_cons, ha.assoc]
|
||||
rw [foldr_assoc]
|
||||
|
||||
theorem foldl_hom (f : α₁ → α₂) (g₁ : α₁ → β → α₁) (g₂ : α₂ → β → α₂) (l : List β) (init : α₁)
|
||||
(H : ∀ x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
|
||||
induction l generalizing init <;> simp [*, H]
|
||||
@@ -1004,7 +1021,7 @@ theorem getLast_eq_getLastD (a l h) : @getLast α (a::l) h = getLastD l a := by
|
||||
theorem getLast!_cons [Inhabited α] : @getLast! α _ (a::l) = getLastD l a := by
|
||||
simp [getLast!, getLast_eq_getLastD]
|
||||
|
||||
theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
|
||||
@[simp] theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
|
||||
| [], h => absurd rfl h
|
||||
| [_], _ => .head ..
|
||||
| _::a::l, _ => .tail _ <| getLast_mem (cons_ne_nil a l)
|
||||
@@ -1102,7 +1119,7 @@ theorem head?_eq_some_iff {xs : List α} {a : α} : xs.head? = some a ↔ ∃ ys
|
||||
@[simp] theorem head?_isSome : l.head?.isSome ↔ l ≠ [] := by
|
||||
cases l <;> simp
|
||||
|
||||
theorem head_mem : ∀ {l : List α} (h : l ≠ []), head l h ∈ l
|
||||
@[simp] theorem head_mem : ∀ {l : List α} (h : l ≠ []), head l h ∈ l
|
||||
| [], h => absurd rfl h
|
||||
| _::_, _ => .head ..
|
||||
|
||||
@@ -1654,6 +1671,11 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
|
||||
|
||||
/-! ### 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'
|
||||
@@ -2387,11 +2409,21 @@ theorem map_eq_replicate_iff {l : List α} {f : α → β} {b : β} :
|
||||
@[simp] theorem map_const (l : List α) (b : β) : map (Function.const α b) l = replicate l.length b :=
|
||||
map_eq_replicate_iff.mpr fun _ _ => rfl
|
||||
|
||||
@[simp] theorem map_const_fun (x : β) : map (Function.const α x) = (replicate ·.length x) := by
|
||||
funext l
|
||||
simp
|
||||
|
||||
/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
|
||||
-- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
|
||||
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
|
||||
|
||||
@@ -7,7 +7,7 @@ prelude
|
||||
import Init.Data.List.Lemmas
|
||||
|
||||
/-!
|
||||
# Lemmas about `List.minimum?` and `List.maximum?.
|
||||
# Lemmas about `List.min?` and `List.max?.
|
||||
-/
|
||||
|
||||
namespace List
|
||||
@@ -16,24 +16,24 @@ open Nat
|
||||
|
||||
/-! ## Minima and maxima -/
|
||||
|
||||
/-! ### minimum? -/
|
||||
/-! ### min? -/
|
||||
|
||||
@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl
|
||||
@[simp] theorem min?_nil [Min α] : ([] : List α).min? = none := rfl
|
||||
|
||||
-- We don't put `@[simp]` on `minimum?_cons`,
|
||||
-- We don't put `@[simp]` on `min?_cons`,
|
||||
-- because the definition in terms of `foldl` is not useful for proofs.
|
||||
theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl
|
||||
theorem min?_cons [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
|
||||
|
||||
@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [minimum?]
|
||||
@[simp] theorem min?_eq_none_iff {xs : List α} [Min α] : xs.min? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [min?]
|
||||
|
||||
theorem minimum?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
|
||||
{xs : List α} → xs.minimum? = some a → a ∈ xs := by
|
||||
theorem min?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
|
||||
{xs : List α} → xs.min? = some a → a ∈ xs := by
|
||||
intro xs
|
||||
match xs with
|
||||
| nil => simp
|
||||
| x :: xs =>
|
||||
simp only [minimum?_cons, Option.some.injEq, List.mem_cons]
|
||||
simp only [min?_cons, Option.some.injEq, List.mem_cons]
|
||||
intro eq
|
||||
induction xs generalizing x with
|
||||
| nil =>
|
||||
@@ -49,12 +49,12 @@ theorem minimum?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b
|
||||
|
||||
-- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
|
||||
|
||||
theorem le_minimum?_iff [Min α] [LE α]
|
||||
theorem le_min?_iff [Min α] [LE α]
|
||||
(le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) :
|
||||
{xs : List α} → xs.minimum? = some a → ∀ {x}, x ≤ a ↔ ∀ b, b ∈ xs → x ≤ b
|
||||
{xs : List α} → xs.min? = some a → ∀ {x}, x ≤ a ↔ ∀ b, b ∈ xs → x ≤ b
|
||||
| nil => by simp
|
||||
| cons x xs => by
|
||||
rw [minimum?]
|
||||
rw [min?]
|
||||
intro eq y
|
||||
simp only [Option.some.injEq] at eq
|
||||
induction xs generalizing x with
|
||||
@@ -67,46 +67,46 @@ theorem le_minimum?_iff [Min α] [LE α]
|
||||
|
||||
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
|
||||
-- and `le_min_iff`.
|
||||
theorem minimum?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
theorem min?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
(le_refl : ∀ a : α, a ≤ a)
|
||||
(min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b)
|
||||
(le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) {xs : List α} :
|
||||
xs.minimum? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → a ≤ b := by
|
||||
refine ⟨fun h => ⟨minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h).1 (le_refl _)⟩, ?_⟩
|
||||
xs.min? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → a ≤ b := by
|
||||
refine ⟨fun h => ⟨min?_mem min_eq_or h, (le_min?_iff le_min_iff h).1 (le_refl _)⟩, ?_⟩
|
||||
intro ⟨h₁, h₂⟩
|
||||
cases xs with
|
||||
| nil => simp at h₁
|
||||
| cons x xs =>
|
||||
exact congrArg some <| anti.1
|
||||
((le_minimum?_iff le_min_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
|
||||
(h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl))
|
||||
((le_min?_iff le_min_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
|
||||
(h₂ _ (min?_mem min_eq_or (xs := x::xs) rfl))
|
||||
|
||||
theorem minimum?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
|
||||
(replicate n a).minimum? = if n = 0 then none else some a := by
|
||||
theorem min?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
|
||||
(replicate n a).min? = if n = 0 then none else some a := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, minimum?_cons]
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons]
|
||||
|
||||
@[simp] theorem minimum?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
|
||||
(replicate n a).minimum? = some a := by
|
||||
simp [minimum?_replicate, Nat.ne_of_gt h, w]
|
||||
@[simp] theorem min?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
|
||||
(replicate n a).min? = some a := by
|
||||
simp [min?_replicate, Nat.ne_of_gt h, w]
|
||||
|
||||
/-! ### maximum? -/
|
||||
/-! ### max? -/
|
||||
|
||||
@[simp] theorem maximum?_nil [Max α] : ([] : List α).maximum? = none := rfl
|
||||
@[simp] theorem max?_nil [Max α] : ([] : List α).max? = none := rfl
|
||||
|
||||
-- We don't put `@[simp]` on `maximum?_cons`,
|
||||
-- We don't put `@[simp]` on `max?_cons`,
|
||||
-- because the definition in terms of `foldl` is not useful for proofs.
|
||||
theorem maximum?_cons [Max α] {xs : List α} : (x :: xs).maximum? = foldl max x xs := rfl
|
||||
theorem max?_cons [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
|
||||
|
||||
@[simp] theorem maximum?_eq_none_iff {xs : List α} [Max α] : xs.maximum? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [maximum?]
|
||||
@[simp] theorem max?_eq_none_iff {xs : List α} [Max α] : xs.max? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [max?]
|
||||
|
||||
theorem maximum?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) :
|
||||
{xs : List α} → xs.maximum? = some a → a ∈ xs
|
||||
theorem max?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a ∨ max a b = b) :
|
||||
{xs : List α} → xs.max? = some a → a ∈ xs
|
||||
| nil => by simp
|
||||
| cons x xs => by
|
||||
rw [maximum?]; rintro ⟨⟩
|
||||
rw [max?]; rintro ⟨⟩
|
||||
induction xs generalizing x with simp at *
|
||||
| cons y xs ih =>
|
||||
rcases ih (max x y) with h | h <;> simp [h]
|
||||
@@ -114,40 +114,57 @@ theorem maximum?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a ∨ max a b
|
||||
|
||||
-- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
|
||||
|
||||
theorem maximum?_le_iff [Max α] [LE α]
|
||||
theorem max?_le_iff [Max α] [LE α]
|
||||
(max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) :
|
||||
{xs : List α} → xs.maximum? = some a → ∀ {x}, a ≤ x ↔ ∀ b ∈ xs, b ≤ x
|
||||
{xs : List α} → xs.max? = some a → ∀ {x}, a ≤ x ↔ ∀ b ∈ xs, b ≤ x
|
||||
| nil => by simp
|
||||
| cons x xs => by
|
||||
rw [maximum?]; rintro ⟨⟩ y
|
||||
rw [max?]; rintro ⟨⟩ y
|
||||
induction xs generalizing x with
|
||||
| nil => simp
|
||||
| cons y xs ih => simp [ih, max_le_iff, and_assoc]
|
||||
|
||||
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `max_eq_or`,
|
||||
-- and `le_min_iff`.
|
||||
theorem maximum?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
theorem max?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
(le_refl : ∀ a : α, a ≤ a)
|
||||
(max_eq_or : ∀ a b : α, max a b = a ∨ max a b = b)
|
||||
(max_le_iff : ∀ a b c : α, max b c ≤ a ↔ b ≤ a ∧ c ≤ a) {xs : List α} :
|
||||
xs.maximum? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, b ≤ a := by
|
||||
refine ⟨fun h => ⟨maximum?_mem max_eq_or h, (maximum?_le_iff max_le_iff h).1 (le_refl _)⟩, ?_⟩
|
||||
xs.max? = some a ↔ a ∈ xs ∧ ∀ b ∈ xs, b ≤ a := by
|
||||
refine ⟨fun h => ⟨max?_mem max_eq_or h, (max?_le_iff max_le_iff h).1 (le_refl _)⟩, ?_⟩
|
||||
intro ⟨h₁, h₂⟩
|
||||
cases xs with
|
||||
| nil => simp at h₁
|
||||
| cons x xs =>
|
||||
exact congrArg some <| anti.1
|
||||
(h₂ _ (maximum?_mem max_eq_or (xs := x::xs) rfl))
|
||||
((maximum?_le_iff max_le_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
|
||||
(h₂ _ (max?_mem max_eq_or (xs := x::xs) rfl))
|
||||
((max?_le_iff max_le_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
|
||||
|
||||
theorem maximum?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
|
||||
(replicate n a).maximum? = if n = 0 then none else some a := by
|
||||
theorem max?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
|
||||
(replicate n a).max? = if n = 0 then none else some a := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, maximum?_cons]
|
||||
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons]
|
||||
|
||||
@[simp] theorem maximum?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
|
||||
(replicate n a).maximum? = some a := by
|
||||
simp [maximum?_replicate, Nat.ne_of_gt h, w]
|
||||
@[simp] theorem max?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
|
||||
(replicate n a).max? = some a := by
|
||||
simp [max?_replicate, Nat.ne_of_gt h, w]
|
||||
|
||||
@[deprecated min?_nil (since := "2024-09-29")] abbrev minimum?_nil := @min?_nil
|
||||
@[deprecated min?_cons (since := "2024-09-29")] abbrev minimum?_cons := @min?_cons
|
||||
@[deprecated min?_eq_none_iff (since := "2024-09-29")] abbrev mininmum?_eq_none_iff := @min?_eq_none_iff
|
||||
@[deprecated min?_mem (since := "2024-09-29")] abbrev minimum?_mem := @min?_mem
|
||||
@[deprecated le_min?_iff (since := "2024-09-29")] abbrev le_minimum?_iff := @le_min?_iff
|
||||
@[deprecated min?_eq_some_iff (since := "2024-09-29")] abbrev minimum?_eq_some_iff := @min?_eq_some_iff
|
||||
@[deprecated min?_replicate (since := "2024-09-29")] abbrev minimum?_replicate := @min?_replicate
|
||||
@[deprecated min?_replicate_of_pos (since := "2024-09-29")] abbrev minimum?_replicate_of_pos := @min?_replicate_of_pos
|
||||
@[deprecated max?_nil (since := "2024-09-29")] abbrev maximum?_nil := @max?_nil
|
||||
@[deprecated max?_cons (since := "2024-09-29")] abbrev maximum?_cons := @max?_cons
|
||||
@[deprecated max?_eq_none_iff (since := "2024-09-29")] abbrev maximum?_eq_none_iff := @max?_eq_none_iff
|
||||
@[deprecated max?_mem (since := "2024-09-29")] abbrev maximum?_mem := @max?_mem
|
||||
@[deprecated max?_le_iff (since := "2024-09-29")] abbrev maximum?_le_iff := @max?_le_iff
|
||||
@[deprecated max?_eq_some_iff (since := "2024-09-29")] abbrev maximum?_eq_some_iff := @max?_eq_some_iff
|
||||
@[deprecated max?_replicate (since := "2024-09-29")] abbrev maximum?_replicate := @max?_replicate
|
||||
@[deprecated max?_replicate_of_pos (since := "2024-09-29")] abbrev maximum?_replicate_of_pos := @max?_replicate_of_pos
|
||||
|
||||
end List
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -86,26 +86,26 @@ theorem mem_eraseIdx_iff_getElem? {x : α} {l} {k} : x ∈ eraseIdx l k ↔ ∃
|
||||
obtain ⟨h', -⟩ := getElem?_eq_some_iff.1 h
|
||||
exact ⟨h', h⟩
|
||||
|
||||
/-! ### minimum? -/
|
||||
/-! ### min? -/
|
||||
|
||||
-- A specialization of `minimum?_eq_some_iff` to Nat.
|
||||
theorem minimum?_eq_some_iff' {xs : List Nat} :
|
||||
xs.minimum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) :=
|
||||
minimum?_eq_some_iff
|
||||
-- A specialization of `min?_eq_some_iff` to Nat.
|
||||
theorem min?_eq_some_iff' {xs : List Nat} :
|
||||
xs.min? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, a ≤ b) :=
|
||||
min?_eq_some_iff
|
||||
(le_refl := Nat.le_refl)
|
||||
(min_eq_or := fun _ _ => by omega)
|
||||
(le_min_iff := fun _ _ _ => by omega)
|
||||
(min_eq_or := fun _ _ => Nat.min_def .. ▸ by split <;> simp)
|
||||
(le_min_iff := fun _ _ _ => Nat.le_min)
|
||||
|
||||
-- This could be generalized,
|
||||
-- but will first require further work on order typeclasses in the core repository.
|
||||
theorem minimum?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).minimum? = some (match l.minimum? with
|
||||
theorem min?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).min? = some (match l.min? with
|
||||
| none => a
|
||||
| some m => min a m) := by
|
||||
rw [minimum?_eq_some_iff']
|
||||
rw [min?_eq_some_iff']
|
||||
split <;> rename_i h m
|
||||
· simp_all
|
||||
· rw [minimum?_eq_some_iff'] at m
|
||||
· rw [min?_eq_some_iff'] at m
|
||||
obtain ⟨m, le⟩ := m
|
||||
rw [Nat.min_def]
|
||||
constructor
|
||||
@@ -122,11 +122,11 @@ theorem minimum?_cons' {a : Nat} {l : List Nat} :
|
||||
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
|
||||
l.foldl (init := a) min = min a (l.min?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [minimum?]
|
||||
simp only [min?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
@@ -134,7 +134,7 @@ theorem foldl_min
|
||||
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
|
||||
(l.foldl (init := b) fun acc a => min acc (f a)) = min b ((l.map f).min?.getD b) := by
|
||||
rw [← foldl_map, foldl_min]
|
||||
|
||||
theorem foldl_min_le {l : List Nat} {a : Nat} : l.foldl (init := a) min ≤ a := by
|
||||
@@ -148,12 +148,12 @@ 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
|
||||
theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
l.min?.getD k ≤ a := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [minimum?_cons]
|
||||
simp [min?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact foldl_min_le
|
||||
@@ -166,26 +166,26 @@ theorem minimum?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
· exact foldl_min_min_of_le (Nat.min_le_right _ _)
|
||||
· exact ih _ h
|
||||
|
||||
/-! ### maximum? -/
|
||||
/-! ### max? -/
|
||||
|
||||
-- A specialization of `maximum?_eq_some_iff` to Nat.
|
||||
theorem maximum?_eq_some_iff' {xs : List Nat} :
|
||||
xs.maximum? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, b ≤ a) :=
|
||||
maximum?_eq_some_iff
|
||||
-- A specialization of `max?_eq_some_iff` to Nat.
|
||||
theorem max?_eq_some_iff' {xs : List Nat} :
|
||||
xs.max? = some a ↔ (a ∈ xs ∧ ∀ b ∈ xs, b ≤ a) :=
|
||||
max?_eq_some_iff
|
||||
(le_refl := Nat.le_refl)
|
||||
(max_eq_or := fun _ _ => by omega)
|
||||
(max_le_iff := fun _ _ _ => by omega)
|
||||
(max_eq_or := fun _ _ => Nat.max_def .. ▸ by split <;> simp)
|
||||
(max_le_iff := fun _ _ _ => Nat.max_le)
|
||||
|
||||
-- This could be generalized,
|
||||
-- but will first require further work on order typeclasses in the core repository.
|
||||
theorem maximum?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).maximum? = some (match l.maximum? with
|
||||
theorem max?_cons' {a : Nat} {l : List Nat} :
|
||||
(a :: l).max? = some (match l.max? with
|
||||
| none => a
|
||||
| some m => max a m) := by
|
||||
rw [maximum?_eq_some_iff']
|
||||
rw [max?_eq_some_iff']
|
||||
split <;> rename_i h m
|
||||
· simp_all
|
||||
· rw [maximum?_eq_some_iff'] at m
|
||||
· rw [max?_eq_some_iff'] at m
|
||||
obtain ⟨m, le⟩ := m
|
||||
rw [Nat.max_def]
|
||||
constructor
|
||||
@@ -202,11 +202,11 @@ theorem maximum?_cons' {a : Nat} {l : List Nat} :
|
||||
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
|
||||
l.foldl (init := a) max = max a (l.max?.getD a) := by
|
||||
cases l with
|
||||
| nil => simp [Std.IdempotentOp.idempotent]
|
||||
| cons b l =>
|
||||
simp only [maximum?]
|
||||
simp only [max?]
|
||||
induction l generalizing a b with
|
||||
| nil => simp
|
||||
| cons c l ih => simp [ih, Std.Associative.assoc]
|
||||
@@ -214,7 +214,7 @@ theorem foldl_max
|
||||
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
|
||||
(l.foldl (init := b) fun acc a => max acc (f a)) = max b ((l.map f).max?.getD b) := by
|
||||
rw [← foldl_map, foldl_max]
|
||||
|
||||
theorem le_foldl_max {l : List Nat} {a : Nat} : a ≤ l.foldl (init := a) max := by
|
||||
@@ -228,12 +228,12 @@ 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
|
||||
theorem le_max?_getD_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
a ≤ l.max?.getD k := by
|
||||
cases l with
|
||||
| nil => simp at h
|
||||
| cons b l =>
|
||||
simp [maximum?_cons]
|
||||
simp [max?_cons]
|
||||
simp at h
|
||||
rcases h with (rfl | h)
|
||||
· exact le_foldl_max
|
||||
@@ -246,4 +246,11 @@ theorem le_maximum?_getD_of_mem {l : List Nat} {a k : Nat} (h : a ∈ l) :
|
||||
· exact le_foldl_max_of_le (Nat.le_max_right b a)
|
||||
· exact ih _ h
|
||||
|
||||
@[deprecated min?_eq_some_iff' (since := "2024-09-29")] abbrev minimum?_eq_some_iff' := @min?_eq_some_iff'
|
||||
@[deprecated min?_cons' (since := "2024-09-29")] abbrev minimum?_cons' := @min?_cons'
|
||||
@[deprecated min?_getD_le_of_mem (since := "2024-09-29")] abbrev minimum?_getD_le_of_mem := @min?_getD_le_of_mem
|
||||
@[deprecated max?_eq_some_iff' (since := "2024-09-29")] abbrev maximum?_eq_some_iff' := @max?_eq_some_iff'
|
||||
@[deprecated max?_cons' (since := "2024-09-29")] abbrev maximum?_cons' := @max?_cons'
|
||||
@[deprecated le_max?_getD_of_mem (since := "2024-09-29")] abbrev le_maximum?_getD_of_mem := @le_max?_getD_of_mem
|
||||
|
||||
end List
|
||||
|
||||
@@ -42,7 +42,7 @@ theorem getElem_take' (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j)
|
||||
|
||||
/-- 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} :
|
||||
@[simp] 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]
|
||||
@@ -52,7 +52,7 @@ length `> i`. Version designed to rewrite from the big list to the small list. -
|
||||
@[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
|
||||
|
||||
/-- 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. -/
|
||||
|
||||
@@ -248,6 +248,10 @@ theorem countP_eq_countP_filter_add (l : List α) (p q : α → Bool) :
|
||||
theorem Perm.count_eq [DecidableEq α] {l₁ l₂ : List α} (p : l₁ ~ l₂) (a) :
|
||||
count a l₁ = count a l₂ := p.countP_eq _
|
||||
|
||||
/-
|
||||
This theorem is a variant of `Perm.foldl_eq` defined in Mathlib which uses typeclasses rather
|
||||
than the explicit `comm` argument.
|
||||
-/
|
||||
theorem Perm.foldl_eq' {f : β → α → β} {l₁ l₂ : List α} (p : l₁ ~ l₂)
|
||||
(comm : ∀ x ∈ l₁, ∀ y ∈ l₁, ∀ (z), f (f z x) y = f (f z y) x)
|
||||
(init) : foldl f init l₁ = foldl f init l₂ := by
|
||||
@@ -264,6 +268,28 @@ theorem Perm.foldl_eq' {f : β → α → β} {l₁ l₂ : List α} (p : l₁ ~
|
||||
refine (IH₁ comm init).trans (IH₂ ?_ _)
|
||||
intros; apply comm <;> apply p₁.symm.subset <;> assumption
|
||||
|
||||
/-
|
||||
This theorem is a variant of `Perm.foldr_eq` defined in Mathlib which uses typeclasses rather
|
||||
than the explicit `comm` argument.
|
||||
-/
|
||||
theorem Perm.foldr_eq' {f : α → β → β} {l₁ l₂ : List α} (p : l₁ ~ l₂)
|
||||
(comm : ∀ x ∈ l₁, ∀ y ∈ l₁, ∀ (z), f y (f x z) = f x (f y z))
|
||||
(init) : foldr f init l₁ = foldr f init l₂ := by
|
||||
induction p using recOnSwap' generalizing init with
|
||||
| nil => simp
|
||||
| cons x _p IH =>
|
||||
simp only [foldr]
|
||||
congr 1
|
||||
apply IH; intros; apply comm <;> exact .tail _ ‹_›
|
||||
| swap' x y _p IH =>
|
||||
simp only [foldr]
|
||||
rw [comm x (.tail _ <| .head _) y (.head _)]
|
||||
congr 2
|
||||
apply IH; intros; apply comm <;> exact .tail _ (.tail _ ‹_›)
|
||||
| trans p₁ _p₂ IH₁ IH₂ =>
|
||||
refine (IH₁ comm init).trans (IH₂ ?_ _)
|
||||
intros; apply comm <;> apply p₁.symm.subset <;> assumption
|
||||
|
||||
theorem Perm.rec_heq {β : List α → Sort _} {f : ∀ a l, β l → β (a :: l)} {b : β []} {l l' : List α}
|
||||
(hl : l ~ l') (f_congr : ∀ {a l l' b b'}, l ~ l' → HEq b b' → HEq (f a l b) (f a l' b'))
|
||||
(f_swap : ∀ {a a' l b}, HEq (f a (a' :: l) (f a' l b)) (f a' (a :: l) (f a l b))) :
|
||||
|
||||
@@ -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 β} :
|
||||
|
||||
@@ -634,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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -605,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
|
||||
@@ -767,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⟩
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -1210,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).
|
||||
@@ -1364,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.
|
||||
|
||||
@@ -2065,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.
|
||||
@@ -2568,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 ::
|
||||
@@ -2582,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
|
||||
@@ -2709,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
|
||||
@@ -2725,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`. -/
|
||||
|
||||
@@ -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
|
||||
@@ -794,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,
|
||||
@@ -1589,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`.
|
||||
@@ -1599,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -120,7 +120,7 @@ section Methods
|
||||
|
||||
variable [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadInfoTree m] [MonadLiftT IO m]
|
||||
|
||||
/-- Elaborate declaration modifiers (i.e., attributes, `partial`, `private`, `proctected`, `unsafe`, `noncomputable`, doc string)-/
|
||||
/-- Elaborate declaration modifiers (i.e., attributes, `partial`, `private`, `protected`, `unsafe`, `noncomputable`, doc string)-/
|
||||
def elabModifiers (stx : Syntax) : m Modifiers := do
|
||||
let docCommentStx := stx[0]
|
||||
let attrsStx := stx[1]
|
||||
|
||||
@@ -61,16 +61,17 @@ def expandDeclSig (stx : Syntax) : Syntax × Syntax :=
|
||||
(binders, typeSpec[1])
|
||||
|
||||
/--
|
||||
Sort the given list of `usedParams` using the following order:
|
||||
- If it is an explicit level `allUserParams`, then use user given order.
|
||||
- Otherwise, use lexicographical.
|
||||
Sort the given list of `usedParams` using the following order:
|
||||
- If it is an explicit level in `allUserParams`, then use user-given order.
|
||||
- All other levels come in lexicographic order after these.
|
||||
|
||||
Remark: `scopeParams` are the universe params introduced using the `universe` command. `allUserParams` contains
|
||||
the universe params introduced using the `universe` command *and* the `.{...}` notation.
|
||||
Remark: `scopeParams` are the universe params introduced using the `universe` command. `allUserParams` contains
|
||||
the universe params introduced using the `universe` command *and* the `.{...}` notation.
|
||||
|
||||
Remark: this function return an exception if there is an `u` not in `usedParams`, that is in `allUserParams` but not in `scopeParams`.
|
||||
Remark: this function return an exception if there is an `u` not in `usedParams`, that is in `allUserParams` but not in `scopeParams`.
|
||||
|
||||
Remark: `explicitParams` are in reverse declaration order. That is, the head is the last declared parameter. -/
|
||||
Remark: `scopeParams` and `allUserParams` are in reverse declaration order. That is, the head is the last declared parameter.
|
||||
-/
|
||||
def sortDeclLevelParams (scopeParams : List Name) (allUserParams : List Name) (usedParams : Array Name) : Except String (List Name) :=
|
||||
match allUserParams.find? fun u => !usedParams.contains u && !scopeParams.elem u with
|
||||
| some u => throw s!"unused universe parameter '{u}'"
|
||||
|
||||
@@ -59,15 +59,17 @@ where
|
||||
let mut ctorArgs := #[]
|
||||
let mut rhs : Term := Syntax.mkStrLit (toString ctorInfo.name)
|
||||
rhs ← `(Format.text $rhs)
|
||||
-- add `_` for inductive parameters, they are inaccessible
|
||||
for _ in [:indVal.numParams] do
|
||||
ctorArgs := ctorArgs.push (← `(_))
|
||||
for i in [:ctorInfo.numFields] do
|
||||
let x := xs[indVal.numParams + i]!
|
||||
let a := mkIdent (← mkFreshUserName `a)
|
||||
ctorArgs := ctorArgs.push a
|
||||
let localDecl ← x.fvarId!.getDecl
|
||||
if localDecl.binderInfo.isExplicit then
|
||||
for i in [:xs.size] do
|
||||
-- Note: some inductive parameters are explicit if they were promoted from indices,
|
||||
-- so we process all constructor arguments in the same loop.
|
||||
let x := xs[i]!
|
||||
let a ← mkIdent <$> if i < indVal.numParams then pure header.argNames[i]! else mkFreshUserName `a
|
||||
if i < indVal.numParams then
|
||||
-- add `_` for inductive parameters, they are inaccessible
|
||||
ctorArgs := ctorArgs.push (← `(_))
|
||||
else
|
||||
ctorArgs := ctorArgs.push a
|
||||
if (← x.fvarId!.getBinderInfo).isExplicit then
|
||||
if (← inferType x).isAppOf indVal.name then
|
||||
rhs ← `($rhs ++ Format.line ++ $(mkIdent auxFunName):ident $a:ident max_prec)
|
||||
else if (← isType x <||> isProof x) then
|
||||
|
||||
@@ -18,7 +18,7 @@ private def getMonadForIn (expectedType? : Option Expr) : TermElabM Expr := do
|
||||
| some expectedType =>
|
||||
match (← isTypeApp? expectedType) with
|
||||
| some (m, _) => return m
|
||||
| none => throwError "invalid 'for_in%' notation, expected type is not of of the form `M α`{indentExpr expectedType}"
|
||||
| none => throwError "invalid 'for_in%' notation, expected type is not of the form `M α`{indentExpr expectedType}"
|
||||
|
||||
private def throwForInFailure (forInInstance : Expr) : TermElabM Expr :=
|
||||
throwError "failed to synthesize instance for 'for_in%' notation{indentExpr forInInstance}"
|
||||
@@ -375,7 +375,7 @@ private def hasHeterogeneousDefaultInstances (f : Expr) (maxType : Expr) (lhs :
|
||||
return false
|
||||
|
||||
/--
|
||||
Return `true` if polymorphic function `f` has a homogenous instance of `maxType`.
|
||||
Return `true` if polymorphic function `f` has a homogeneous instance of `maxType`.
|
||||
The coercions to `maxType` only makes sense if such instance exists.
|
||||
|
||||
For example, suppose `maxType` is `Int`, and `f` is `HPow.hPow`. Then,
|
||||
@@ -421,9 +421,9 @@ mutual
|
||||
| .binop ref kind f lhs rhs =>
|
||||
/-
|
||||
We only keep applying coercions to `maxType` if `f` is predicate or
|
||||
`f` has a homogenous instance with `maxType`. See `hasHomogeneousInstance` for additional details.
|
||||
`f` has a homogeneous instance with `maxType`. See `hasHomogeneousInstance` for additional details.
|
||||
|
||||
Remark: We assume `binrel%` elaborator is only used with homogenous predicates.
|
||||
Remark: We assume `binrel%` elaborator is only used with homogeneous predicates.
|
||||
-/
|
||||
if (← pure isPred <||> hasHomogeneousInstance f maxType) then
|
||||
return .binop ref kind f (← go lhs f true false) (← go rhs f false false)
|
||||
|
||||
@@ -30,7 +30,7 @@ private def mkUserNameFor (e : Expr) : TermElabM Name := do
|
||||
|
||||
|
||||
/--
|
||||
Remark: if the discriminat is `Systax.missing`, we abort the elaboration of the `match`-expression.
|
||||
Remark: if the discriminat is `Syntax.missing`, we abort the elaboration of the `match`-expression.
|
||||
This can happen due to error recovery. Example
|
||||
```
|
||||
example : (p ∨ p) → p := fun h => match
|
||||
@@ -795,7 +795,7 @@ private def elabMatchAltView (discrs : Array Discr) (alt : MatchAltView) (matchT
|
||||
let rhs ← elabTermEnsuringType alt.rhs matchType'
|
||||
-- We use all approximations to ensure the auxiliary type is defeq to the original one.
|
||||
unless (← fullApproxDefEq <| isDefEq matchType' matchType) do
|
||||
throwError "type mistmatch, alternative {← mkHasTypeButIsExpectedMsg matchType' matchType}"
|
||||
throwError "type mismatch, alternative {← mkHasTypeButIsExpectedMsg matchType' matchType}"
|
||||
let xs := altLHS.fvarDecls.toArray.map LocalDecl.toExpr ++ eqs
|
||||
let rhs ← if xs.isEmpty then pure <| mkSimpleThunk rhs else mkLambdaFVars xs rhs
|
||||
trace[Elab.match] "rhs: {rhs}"
|
||||
|
||||
@@ -98,7 +98,7 @@ private def isMultiConstant? (views : Array DefView) : Option (List Name) :=
|
||||
else
|
||||
none
|
||||
|
||||
private def getPendindMVarErrorMessage (views : Array DefView) : String :=
|
||||
private def getPendingMVarErrorMessage (views : Array DefView) : String :=
|
||||
match isMultiConstant? views with
|
||||
| some ids =>
|
||||
let idsStr := ", ".intercalate <| ids.map fun id => s!"`{id}`"
|
||||
@@ -196,7 +196,7 @@ private def elabHeaders (views : Array DefView)
|
||||
if view.type?.isSome then
|
||||
let pendingMVarIds ← getMVars type
|
||||
discard <| logUnassignedUsingErrorInfos pendingMVarIds <|
|
||||
getPendindMVarErrorMessage views
|
||||
getPendingMVarErrorMessage views
|
||||
let newHeader : DefViewElabHeaderData := {
|
||||
declName, shortDeclName, type, levelNames, binderIds
|
||||
numParams := xs.size
|
||||
@@ -947,45 +947,6 @@ private def levelMVarToParamHeaders (views : Array DefView) (headers : Array Def
|
||||
let newHeaders ← (process).run' 1
|
||||
newHeaders.mapM fun header => return { header with type := (← instantiateMVars header.type) }
|
||||
|
||||
partial def checkForHiddenUnivLevels (allUserLevelNames : List Name) (preDefs : Array PreDefinition) : TermElabM Unit :=
|
||||
unless (← MonadLog.hasErrors) do
|
||||
-- We do not report this kind of error if the declaration already contains errors
|
||||
let mut sTypes : CollectLevelParams.State := {}
|
||||
let mut sValues : CollectLevelParams.State := {}
|
||||
for preDef in preDefs do
|
||||
sTypes := collectLevelParams sTypes preDef.type
|
||||
sValues := collectLevelParams sValues preDef.value
|
||||
if sValues.params.all fun u => sTypes.params.contains u || allUserLevelNames.contains u then
|
||||
-- If all universe level occurring in values also occur in types or explicitly provided universes, then everything is fine
|
||||
-- and we just return
|
||||
return ()
|
||||
let checkPreDef (preDef : PreDefinition) : TermElabM Unit :=
|
||||
-- Otherwise, we try to produce an error message containing the expression with the offending universe
|
||||
let rec visitLevel (u : Level) : ReaderT Expr TermElabM Unit := do
|
||||
match u with
|
||||
| .succ u => visitLevel u
|
||||
| .imax u v | .max u v => visitLevel u; visitLevel v
|
||||
| .param n =>
|
||||
unless sTypes.visitedLevel.contains u || allUserLevelNames.contains n do
|
||||
let parent ← withOptions (fun o => pp.universes.set o true) do addMessageContext m!"{indentExpr (← read)}"
|
||||
let body ← withOptions (fun o => pp.letVarTypes.setIfNotSet (pp.funBinderTypes.setIfNotSet o true) true) do addMessageContext m!"{indentExpr preDef.value}"
|
||||
throwError "invalid occurrence of universe level '{u}' at '{preDef.declName}', it does not occur at the declaration type, nor it is explicit universe level provided by the user, occurring at expression{parent}\nat declaration body{body}"
|
||||
| _ => pure ()
|
||||
let rec visit (e : Expr) : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit := do
|
||||
checkCache { val := e : ExprStructEq } fun _ => do
|
||||
match e with
|
||||
| .forallE n d b c | .lam n d b c => visit d e; withLocalDecl n c d fun x => visit (b.instantiate1 x) e
|
||||
| .letE n t v b _ => visit t e; visit v e; withLetDecl n t v fun x => visit (b.instantiate1 x) e
|
||||
| .app .. => e.withApp fun f args => do visit f e; args.forM fun arg => visit arg e
|
||||
| .mdata _ b => visit b e
|
||||
| .proj _ _ b => visit b e
|
||||
| .sort u => visitLevel u (← read)
|
||||
| .const _ us => us.forM (visitLevel · (← read))
|
||||
| _ => pure ()
|
||||
visit preDef.value preDef.value |>.run {}
|
||||
for preDef in preDefs do
|
||||
checkPreDef preDef
|
||||
|
||||
def elabMutualDef (vars : Array Expr) (sc : Command.Scope) (views : Array DefView) : TermElabM Unit :=
|
||||
if isExample views then
|
||||
withoutModifyingEnv do
|
||||
@@ -1021,13 +982,12 @@ where
|
||||
let preDefs ← MutualClosure.main vars headers funFVars values letRecsToLift
|
||||
for preDef in preDefs do
|
||||
trace[Elab.definition] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
|
||||
let preDefs ← withLevelNames allUserLevelNames <| levelMVarToParamPreDecls preDefs
|
||||
let preDefs ← withLevelNames allUserLevelNames <| levelMVarToParamTypesPreDecls preDefs
|
||||
let preDefs ← instantiateMVarsAtPreDecls preDefs
|
||||
let preDefs ← shareCommonPreDefs preDefs
|
||||
let preDefs ← fixLevelParams preDefs scopeLevelNames allUserLevelNames
|
||||
for preDef in preDefs do
|
||||
trace[Elab.definition] "after eraseAuxDiscr, {preDef.declName} : {preDef.type} :=\n{preDef.value}"
|
||||
checkForHiddenUnivLevels allUserLevelNames preDefs
|
||||
addPreDefinitions preDefs
|
||||
processDeriving headers
|
||||
for view in views, header in headers do
|
||||
|
||||
@@ -39,14 +39,26 @@ structure PreDefinition where
|
||||
def PreDefinition.filterAttrs (preDef : PreDefinition) (p : Attribute → Bool) : PreDefinition :=
|
||||
{ preDef with modifiers := preDef.modifiers.filterAttrs p }
|
||||
|
||||
/--
|
||||
Applies `Lean.instantiateMVars` to the types of values of each predefinition.
|
||||
-/
|
||||
def instantiateMVarsAtPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
|
||||
preDefs.mapM fun preDef => do
|
||||
pure { preDef with type := (← instantiateMVars preDef.type), value := (← instantiateMVars preDef.value) }
|
||||
|
||||
def levelMVarToParamPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
|
||||
/--
|
||||
Applies `Lean.Elab.Term.levelMVarToParam` to the types of each predefinition.
|
||||
-/
|
||||
def levelMVarToParamTypesPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
|
||||
preDefs.mapM fun preDef => do
|
||||
pure { preDef with type := (← levelMVarToParam preDef.type), value := (← levelMVarToParam preDef.value) }
|
||||
pure { preDef with type := (← levelMVarToParam preDef.type) }
|
||||
|
||||
/--
|
||||
Collects all the level parameters in sorted order from the types and values of each predefinition.
|
||||
Throws an "unused universe parameter" error if there is an unused `.{...}` parameter.
|
||||
|
||||
See `Lean.collectLevelParams`.
|
||||
-/
|
||||
private def getLevelParamsPreDecls (preDefs : Array PreDefinition) (scopeLevelNames allUserLevelNames : List Name) : TermElabM (List Name) := do
|
||||
let mut s : CollectLevelParams.State := {}
|
||||
for preDef in preDefs do
|
||||
|
||||
@@ -126,7 +126,7 @@ def simpEqnType (eqnType : Expr) : MetaM Expr := do
|
||||
for y in ys.reverse do
|
||||
trace[Elab.definition] ">> simpEqnType: {← inferType y}, {type}"
|
||||
if proofVars.contains y.fvarId! then
|
||||
let some (_, Expr.fvar fvarId, rhs) ← matchEq? (← inferType y) | throwError "unexpected hypothesis in altenative{indentExpr eqnType}"
|
||||
let some (_, Expr.fvar fvarId, rhs) ← matchEq? (← inferType y) | throwError "unexpected hypothesis in alternative{indentExpr eqnType}"
|
||||
eliminated := eliminated.insert fvarId
|
||||
type := type.replaceFVarId fvarId rhs
|
||||
else if eliminated.contains y.fvarId! then
|
||||
|
||||
@@ -53,6 +53,64 @@ private def getMVarsAtPreDef (preDef : PreDefinition) : MetaM (Array MVarId) :=
|
||||
let (_, s) ← (collectMVarsAtPreDef preDef).run {}
|
||||
pure s.result
|
||||
|
||||
/--
|
||||
Set any lingering level mvars to `.zero`, for error recovery.
|
||||
-/
|
||||
private def setLevelMVarsAtPreDef (preDef : PreDefinition) : PreDefinition :=
|
||||
if preDef.value.hasLevelMVar then
|
||||
let value' :=
|
||||
preDef.value.replaceLevel fun l =>
|
||||
match l with
|
||||
| .mvar _ => levelZero
|
||||
| _ => none
|
||||
{ preDef with value := value' }
|
||||
else
|
||||
preDef
|
||||
|
||||
private partial def ensureNoUnassignedLevelMVarsAtPreDef (preDef : PreDefinition) : TermElabM PreDefinition := do
|
||||
if !preDef.value.hasLevelMVar then
|
||||
return preDef
|
||||
else
|
||||
let pendingLevelMVars := (collectLevelMVars {} (← instantiateMVars preDef.value)).result
|
||||
if (← logUnassignedLevelMVarsUsingErrorInfos pendingLevelMVars) then
|
||||
return setLevelMVarsAtPreDef preDef
|
||||
else if !(← MonadLog.hasErrors) then
|
||||
-- This is a fallback in case we don't have an error info available for the universe level metavariables.
|
||||
-- We try to produce an error message containing an expression with one of the universe level metavariables.
|
||||
let rec visitLevel (u : Level) (e : Expr) : TermElabM Unit := do
|
||||
if u.hasMVar then
|
||||
let e' ← exposeLevelMVars e
|
||||
throwError "\
|
||||
declaration '{preDef.declName}' contains universe level metavariables at the expression\
|
||||
{indentExpr e'}\n\
|
||||
in the declaration body{indentExpr <| ← exposeLevelMVars preDef.value}"
|
||||
let withExpr (e : Expr) (m : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit) :=
|
||||
withReader (fun _ => e) m
|
||||
let rec visit (e : Expr) (head := false) : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit := do
|
||||
if e.hasLevelMVar then
|
||||
checkCache { val := e : ExprStructEq } fun _ => do
|
||||
match e with
|
||||
| .forallE n d b c | .lam n d b c => withExpr e do visit d; withLocalDecl n c d fun x => visit (b.instantiate1 x)
|
||||
| .letE n t v b _ => withExpr e do visit t; visit v; withLetDecl n t v fun x => visit (b.instantiate1 x)
|
||||
| .mdata _ b => withExpr e do visit b
|
||||
| .proj _ _ b => withExpr e do visit b
|
||||
| .sort u => visitLevel u (← read)
|
||||
| .const _ us => (if head then id else withExpr e) <| us.forM (visitLevel · (← read))
|
||||
| .app .. => withExpr e do
|
||||
if let some (args, n, t, v, b) := e.letFunAppArgs? then
|
||||
visit t; visit v; withLocalDeclD n t fun x => visit (b.instantiate1 x); args.forM visit
|
||||
else
|
||||
e.withApp fun f args => do visit f true; args.forM visit
|
||||
| _ => pure ()
|
||||
try
|
||||
visit preDef.value |>.run preDef.value |>.run {}
|
||||
catch e =>
|
||||
logException e
|
||||
return setLevelMVarsAtPreDef preDef
|
||||
throwAbortCommand
|
||||
else
|
||||
return setLevelMVarsAtPreDef preDef
|
||||
|
||||
private def ensureNoUnassignedMVarsAtPreDef (preDef : PreDefinition) : TermElabM PreDefinition := do
|
||||
let pendingMVarIds ← getMVarsAtPreDef preDef
|
||||
if (← logUnassignedUsingErrorInfos pendingMVarIds) then
|
||||
@@ -62,7 +120,7 @@ private def ensureNoUnassignedMVarsAtPreDef (preDef : PreDefinition) : TermElabM
|
||||
else
|
||||
throwAbortCommand
|
||||
else
|
||||
return preDef
|
||||
ensureNoUnassignedLevelMVarsAtPreDef preDef
|
||||
|
||||
/--
|
||||
Letrec declarations produce terms of the form `(fun .. => ..) d` where `d` is a (partial) application of an auxiliary declaration for a letrec declaration.
|
||||
@@ -104,7 +162,7 @@ Checks consistency of a clique of TerminationHints:
|
||||
|
||||
* If not all have a hint, the hints are ignored (log error)
|
||||
* If one has `structural`, check that all have it, (else throw error)
|
||||
* A `structural` shold not have a `decreasing_by` (else log error)
|
||||
* A `structural` should not have a `decreasing_by` (else log error)
|
||||
|
||||
-/
|
||||
def checkTerminationByHints (preDefs : Array PreDefinition) : CoreM Unit := do
|
||||
|
||||
@@ -269,7 +269,7 @@ def inferBRecOnFTypes (recArgInfos : Array RecArgInfo) (positions : Positions)
|
||||
let brecOnType ← inferType brecOn
|
||||
-- Skip the indices and major argument
|
||||
let packedFTypes ← forallBoundedTelescope brecOnType (some (recArgInfo.indicesPos.size + 1)) fun _ brecOnType =>
|
||||
-- And return the types of of the next arguments
|
||||
-- And return the types of the next arguments
|
||||
arrowDomainsN numTypeFormers brecOnType
|
||||
|
||||
let mut FTypes := Array.mkArray positions.numIndices (Expr.sort 0)
|
||||
|
||||
@@ -119,7 +119,7 @@ def getRecArgInfos (fnName : Name) (xs : Array Expr) (value : Expr)
|
||||
(termArg? : Option TerminationArgument) : MetaM (Array RecArgInfo × MessageData) := do
|
||||
lambdaTelescope value fun ys _ => do
|
||||
if let .some termArg := termArg? then
|
||||
-- User explictly asked to use a certain argument, so throw errors eagerly
|
||||
-- User explicitly asked to use a certain argument, so throw errors eagerly
|
||||
let recArgInfo ← withRef termArg.ref do
|
||||
mapError (f := (m!"cannot use specified parameter for structural recursion:{indentD ·}")) do
|
||||
getRecArgInfo fnName xs.size (xs ++ ys) (← termArg.structuralArg)
|
||||
@@ -189,7 +189,7 @@ def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
|
||||
if (← group.isDefEq recArgInfo.indGroupInst) then
|
||||
return (.some recArgInfo)
|
||||
|
||||
-- Can this argument be understood as the auxillary type former of a nested inductive?
|
||||
-- Can this argument be understood as the auxiliary type former of a nested inductive?
|
||||
if nestedTypeFormers.isEmpty then return .none
|
||||
lambdaTelescope value fun ys _ => do
|
||||
let x := (xs++ys)[recArgInfo.recArgPos]!
|
||||
|
||||
@@ -13,7 +13,7 @@ This module contains the types
|
||||
* `IndGroupInst` which extends `IndGroupInfo` with levels and parameters
|
||||
to indicate a instantiation of the group.
|
||||
|
||||
One purpose of this abstraction is to make it clear when a fuction operates on a group as
|
||||
One purpose of this abstraction is to make it clear when a function operates on a group as
|
||||
a whole, rather than a specific inductive within the group.
|
||||
-/
|
||||
|
||||
|
||||
@@ -17,7 +17,7 @@ private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
|
||||
false
|
||||
|
||||
/--
|
||||
Preprocesses the expessions to improve the effectiveness of `elimRecursion`.
|
||||
Preprocesses the expressions to improve the effectiveness of `elimRecursion`.
|
||||
|
||||
* Beta reduce terms where the recursive function occurs in the lambda term.
|
||||
Example:
|
||||
|
||||
@@ -31,7 +31,7 @@ structure RecArgInfo where
|
||||
indGroupInst : IndGroupInst
|
||||
/--
|
||||
index of the inductive datatype of the argument we are recursing on.
|
||||
If `< indAll.all`, a normal data type, else an auxillary data type due to nested recursion
|
||||
If `< indAll.all`, a normal data type, else an auxiliary data type due to nested recursion
|
||||
-/
|
||||
indIdx : Nat
|
||||
deriving Inhabited
|
||||
@@ -52,7 +52,7 @@ def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array E
|
||||
return (indexMajorArgs, otherArgs)
|
||||
|
||||
/--
|
||||
Name of the recursive data type. Assumes that it is not one of the auxillary ones.
|
||||
Name of the recursive data type. Assumes that it is not one of the auxiliary ones.
|
||||
-/
|
||||
def RecArgInfo.indName! (info : RecArgInfo) : Name :=
|
||||
info.indGroupInst.all[info.indIdx]!
|
||||
|
||||
@@ -112,7 +112,7 @@ def TerminationArgument.delab (arity : Nat) (extraParams : Nat) (termArg : Termi
|
||||
let stxBody ← Delaborator.delab
|
||||
let hole : TSyntax `Lean.Parser.Term.hole ← `(hole|_)
|
||||
|
||||
-- any variable not mentioned syntatically (it may appear in the `Expr`, so do not just use
|
||||
-- any variable not mentioned syntactically (it may appear in the `Expr`, so do not just use
|
||||
-- `e.bindingBody!.hasLooseBVar`) should be delaborated as a hole.
|
||||
let vars : TSyntaxArray [`ident, `Lean.Parser.Term.hole] :=
|
||||
Array.map (fun (i : Ident) => if stxBody.raw.hasIdent i.getId then i else hole) vars
|
||||
|
||||
@@ -45,7 +45,7 @@ structure TerminationHints where
|
||||
decreasingBy? : Option DecreasingBy
|
||||
/--
|
||||
Here we record the number of parameters past the `:`. It is set by
|
||||
`TerminationHints.rememberExtraParams` and used as folows:
|
||||
`TerminationHints.rememberExtraParams` and used as follows:
|
||||
|
||||
* When we guess the termination argument in `GuessLex` and want to print it in surface-syntax
|
||||
compatible form.
|
||||
|
||||
@@ -12,7 +12,7 @@ namespace Lean.Elab.WF
|
||||
register_builtin_option debug.rawDecreasingByGoal : Bool := {
|
||||
defValue := false
|
||||
descr := "Shows the raw `decreasing_by` goal including internal implementation detail \
|
||||
intead of cleaning it up with the `clean_wf` tactic. Can be enabled for debugging \
|
||||
instead of cleaning it up with the `clean_wf` tactic. Can be enabled for debugging \
|
||||
purposes. Please report an issue if you have to use this option for other reasons."
|
||||
}
|
||||
|
||||
|
||||
@@ -66,7 +66,7 @@ private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
|
||||
else if let some mvarIds ← splitTarget? mvarId then
|
||||
mvarIds.forM go
|
||||
else
|
||||
-- At some point in the past, we looked for occurences of Wf.fix to fold on the
|
||||
-- At some point in the past, we looked for occurrences of Wf.fix to fold on the
|
||||
-- LHS (introduced in 096e4eb), but it seems that code path was never used,
|
||||
-- so #3133 removed it again (and can be recovered from there if this was premature).
|
||||
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
|
||||
|
||||
@@ -29,7 +29,7 @@ if given, or the default `decreasing_tactic`.
|
||||
|
||||
For mutual recursion, a single measure is not just one parameter, but one from each recursive
|
||||
function. Enumerating these can lead to a combinatoric explosion, so we bound
|
||||
the nubmer of measures tried.
|
||||
the number of measures tried.
|
||||
|
||||
In addition to measures derived from `sizeOf xᵢ`, it also considers measures
|
||||
that assign an order to the functions themselves. This way we can support mutual
|
||||
@@ -42,7 +42,7 @@ guessed lexicographic order.
|
||||
|
||||
The following optimizations are applied to make this feasible:
|
||||
|
||||
1. The crucial optimiziation is to look at each argument of each recursive call
|
||||
1. The crucial optimization is to look at each argument of each recursive call
|
||||
_once_, try to prove `<` and (if that fails `≤`), and then look at that table to
|
||||
pick a suitable measure.
|
||||
|
||||
@@ -80,7 +80,7 @@ register_builtin_option showInferredTerminationBy : Bool := {
|
||||
|
||||
|
||||
/--
|
||||
Given a predefinition, return the variabe names in the outermost lambdas.
|
||||
Given a predefinition, return the variable names in the outermost lambdas.
|
||||
Includes the “fixed prefix”.
|
||||
|
||||
The length of the returned array is also used to determine the arity
|
||||
@@ -550,7 +550,7 @@ where
|
||||
failure
|
||||
|
||||
/--
|
||||
Enumerate all meausures we want to try.
|
||||
Enumerate all measures we want to try.
|
||||
|
||||
All arguments (resp. combinations thereof) and
|
||||
possible orderings of functions (if more than one)
|
||||
|
||||
@@ -17,7 +17,7 @@ private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
|
||||
false
|
||||
|
||||
/--
|
||||
Preprocesses the expessions to improve the effectiveness of `wfRecursion`.
|
||||
Preprocesses the expressions to improve the effectiveness of `wfRecursion`.
|
||||
|
||||
* Floats out the RecApp markers.
|
||||
Example:
|
||||
|
||||
@@ -605,7 +605,7 @@ private partial def hasNoErrorIfUnused : Syntax → Bool
|
||||
|
||||
/--
|
||||
Given `rhss` the right-hand-sides of a `match`-syntax notation,
|
||||
We tag them with with fresh identifiers `alt_idx`. We use them to detect whether an alternative
|
||||
We tag them with fresh identifiers `alt_idx`. We use them to detect whether an alternative
|
||||
has been used or not.
|
||||
The result is a triple `(altIdxMap, ignoreIfUnused, rhssNew)` where
|
||||
- `altIdxMap` is a mapping from the `alt_idx` identifiers to right-hand-side indices.
|
||||
|
||||
@@ -29,7 +29,7 @@ def getRecAppSyntax? (e : Expr) : Option Syntax :=
|
||||
| _ => none
|
||||
|
||||
/--
|
||||
Checks if the `MData` is for a recursive applciation.
|
||||
Checks if the `MData` is for a recursive application.
|
||||
-/
|
||||
def MData.isRecApp (d : MData) : Bool :=
|
||||
d.contains recAppKey
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user