mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-17 18:34:06 +00:00
Compare commits
82 Commits
decidableE
...
empty_suba
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
fd7377eb54 | ||
|
|
96adf04a62 | ||
|
|
0db6daa8f1 | ||
|
|
130b465aaf | ||
|
|
ccdf07b6a1 | ||
|
|
5605e0198a | ||
|
|
5f22ba7789 | ||
|
|
16a16898d5 | ||
|
|
4ea76aadd1 | ||
|
|
ef71f0beab | ||
|
|
9f4075be72 | ||
|
|
1b6572726f | ||
|
|
56b78a0ed1 | ||
|
|
e28bfedae2 | ||
|
|
e7691f37c6 | ||
|
|
48711ce6eb | ||
|
|
0733273a78 | ||
|
|
2221296d3c | ||
|
|
f22998edfe | ||
|
|
3817b16c35 | ||
|
|
9eef726204 | ||
|
|
9460f79d28 | ||
|
|
c38c07e1a1 | ||
|
|
062ecb5eae | ||
|
|
13969ad667 | ||
|
|
91a033488c | ||
|
|
1fb75b68ab | ||
|
|
26f508db87 | ||
|
|
3d1ac7cfa2 | ||
|
|
0196bca784 | ||
|
|
b320dcfef9 | ||
|
|
5dea30f169 | ||
|
|
90cb6e5da8 | ||
|
|
a3ca15d2b2 | ||
|
|
c2f6297554 | ||
|
|
1defa2028f | ||
|
|
78c40f380c | ||
|
|
3e2a465b13 | ||
|
|
1ec0c64c7b | ||
|
|
604bcf50ef | ||
|
|
145c9efb32 | ||
|
|
e4f2de0a53 | ||
|
|
7845a05cf1 | ||
|
|
57679eeff5 | ||
|
|
974cc3306c | ||
|
|
c7819bd6eb | ||
|
|
a4fb740d2f | ||
|
|
ea75c924a1 | ||
|
|
65f4b92505 | ||
|
|
a6f0112fc5 | ||
|
|
eee0553318 | ||
|
|
5d2c7fc1d9 | ||
|
|
94de4ae964 | ||
|
|
1129160d80 | ||
|
|
8cc62940e0 | ||
|
|
b612403980 | ||
|
|
6b0d4e50c0 | ||
|
|
0cae7165aa | ||
|
|
ba43ce18c3 | ||
|
|
3190be3058 | ||
|
|
a108644461 | ||
|
|
4b47a10bef | ||
|
|
2d5ebf3705 | ||
|
|
5017b2bfbf | ||
|
|
1b4ee185e8 | ||
|
|
27c4c366b4 | ||
|
|
405b5aa047 | ||
|
|
edf2327229 | ||
|
|
cda6733f97 | ||
|
|
624f1b9963 | ||
|
|
cf94f793a2 | ||
|
|
9185955692 | ||
|
|
9d583ab4ec | ||
|
|
50339e38d9 | ||
|
|
8b61dda964 | ||
|
|
fc20b5dfb4 | ||
|
|
7fba7ed7b6 | ||
|
|
2f2142ab37 | ||
|
|
e551a366a0 | ||
|
|
f4afbc2f8b | ||
|
|
8c8585536c | ||
|
|
c825b5a560 |
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]
|
||||
|
||||
|
||||
@@ -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,20 +415,17 @@ abbrev getElem_fin_eq_data_get := @getElem_fin_eq_toList_get
|
||||
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
|
||||
a[i] = a[i.toNat] := rfl
|
||||
|
||||
theorem getElem?_eq_getElem (a : Array α) (i : Nat) (h : i < a.size) : a[i]? = some a[i] :=
|
||||
getElem?_pos ..
|
||||
|
||||
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size ≤ i) : a[i]? = none := by
|
||||
simp [getElem?_neg, h]
|
||||
|
||||
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] ∈ a.toList := by
|
||||
simp only [getElem_eq_toList_getElem, List.getElem_mem]
|
||||
simp only [getElem_eq_getElem_toList, List.getElem_mem]
|
||||
|
||||
@[deprecated getElem_mem_toList (since := "2024-09-09")]
|
||||
abbrev getElem_mem_data := @getElem_mem_toList
|
||||
|
||||
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]; rfl
|
||||
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
|
||||
|
||||
@[deprecated getElem?_eq_toList_get? (since := "2024-09-09")]
|
||||
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
|
||||
@@ -399,7 +479,7 @@ abbrev data_set := @toList_set
|
||||
|
||||
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1] = v := by
|
||||
simp only [set, getElem_eq_toList_getElem, List.getElem_set_self]
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_self]
|
||||
|
||||
theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2]
|
||||
@@ -418,7 +498,7 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v :
|
||||
|
||||
@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size)
|
||||
(h : i.1 ≠ j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
|
||||
simp only [set, getElem_eq_toList_getElem, List.getElem_set_ne h]
|
||||
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
|
||||
|
||||
theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) :
|
||||
(setD a i v)[i] = v := by
|
||||
@@ -434,7 +514,7 @@ theorem swap_def (a : Array α) (i j : Fin a.size) :
|
||||
a.swap i j = (a.set i (a.get j)).set ⟨j.1, by simp [j.2]⟩ (a.get i) := by
|
||||
simp [swap, fin_cast_val]
|
||||
|
||||
theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
|
||||
(a.swap i j).toList = (a.toList.set i (a.get j)).set j (a.get i) := by simp [swap_def]
|
||||
|
||||
@[deprecated toList_swap (since := "2024-09-09")]
|
||||
@@ -447,7 +527,7 @@ theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]?
|
||||
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
|
||||
a.swapAt i v = (a[i.1], a.set i v) := rfl
|
||||
|
||||
-- @[simp] -- FIXME: gives a weird linter error
|
||||
@[simp]
|
||||
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
|
||||
a.swapAt! i v = (a[i], a.set ⟨i, h⟩ v) := by simp [swapAt!, h]
|
||||
|
||||
@@ -520,7 +600,7 @@ abbrev data_range := @toList_range
|
||||
|
||||
@[simp]
|
||||
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
|
||||
simp [getElem_eq_toList_getElem]
|
||||
simp [getElem_eq_getElem_toList]
|
||||
|
||||
set_option linter.deprecated false in
|
||||
@[simp] theorem reverse_toList (a : Array α) : a.reverse.toList = a.toList.reverse := by
|
||||
@@ -566,6 +646,32 @@ set_option linter.deprecated false in
|
||||
|
||||
/-! ### foldl / foldr -/
|
||||
|
||||
@[simp] theorem foldlM_loop_empty [Monad m] (f : β → α → m β) (init : β) (i j : Nat) :
|
||||
foldlM.loop f #[] s h i j init = pure init := by
|
||||
unfold foldlM.loop; split
|
||||
· split
|
||||
· rfl
|
||||
· simp at h
|
||||
omega
|
||||
· rfl
|
||||
|
||||
@[simp] theorem foldlM_empty [Monad m] (f : β → α → m β) (init : β) :
|
||||
foldlM f init #[] start stop = return init := by
|
||||
simp [foldlM]
|
||||
|
||||
@[simp] theorem foldrM_fold_empty [Monad m] (f : α → β → m β) (init : β) (i j : Nat) (h) :
|
||||
foldrM.fold f #[] i j h init = pure init := by
|
||||
unfold foldrM.fold
|
||||
split <;> rename_i h₁
|
||||
· rfl
|
||||
· split <;> rename_i h₂
|
||||
· rfl
|
||||
· simp at h₂
|
||||
|
||||
@[simp] theorem foldrM_empty [Monad m] (f : α → β → m β) (init : β) :
|
||||
foldrM f init #[] start stop = return init := by
|
||||
simp [foldrM]
|
||||
|
||||
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
|
||||
-- reproduced to avoid a dependency on `SatisfiesM`.
|
||||
theorem foldl_induction
|
||||
@@ -609,8 +715,8 @@ theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : A
|
||||
rw [mapM_eq_foldlM, foldlM_eq_foldlM_toList, ← List.foldrM_reverse]
|
||||
conv => rhs; rw [← List.reverse_reverse arr.toList]
|
||||
induction arr.toList.reverse with
|
||||
| nil => simp; rfl
|
||||
| cons a l ih => simp [ih]; simp [map_eq_pure_bind, push]
|
||||
| nil => simp
|
||||
| cons a l ih => simp [ih]
|
||||
|
||||
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
|
||||
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
|
||||
@@ -751,7 +857,7 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@[simp] theorem filter_toList (p : α → Bool) (l : Array α) :
|
||||
@[simp] theorem toList_filter (p : α → Bool) (l : Array α) :
|
||||
(l.filter p).toList = l.toList.filter p := by
|
||||
dsimp only [filter]
|
||||
rw [foldl_eq_foldl_toList]
|
||||
@@ -762,23 +868,23 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
|
||||
induction l with simp
|
||||
| cons => split <;> simp [*]
|
||||
|
||||
@[deprecated filter_toList (since := "2024-09-09")]
|
||||
abbrev filter_data := @filter_toList
|
||||
@[deprecated toList_filter (since := "2024-09-09")]
|
||||
abbrev filter_data := @toList_filter
|
||||
|
||||
@[simp] theorem filter_filter (q) (l : Array α) :
|
||||
filter p (filter q l) = filter (fun a => p a && q a) l := by
|
||||
apply ext'
|
||||
simp only [filter_toList, List.filter_filter]
|
||||
simp only [toList_filter, List.filter_filter]
|
||||
|
||||
@[simp] theorem mem_filter : x ∈ filter p as ↔ x ∈ as ∧ p x := by
|
||||
simp only [mem_def, filter_toList, List.mem_filter]
|
||||
simp only [mem_def, toList_filter, List.mem_filter]
|
||||
|
||||
theorem mem_of_mem_filter {a : α} {l} (h : a ∈ filter p l) : a ∈ l :=
|
||||
(mem_filter.mp h).1
|
||||
|
||||
/-! ### filterMap -/
|
||||
|
||||
@[simp] theorem filterMap_toList (f : α → Option β) (l : Array α) :
|
||||
@[simp] theorem toList_filterMap (f : α → Option β) (l : Array α) :
|
||||
(l.filterMap f).toList = l.toList.filterMap f := by
|
||||
dsimp only [filterMap, filterMapM]
|
||||
rw [foldlM_eq_foldlM_toList]
|
||||
@@ -791,12 +897,12 @@ theorem mem_of_mem_filter {a : α} {l} (h : a ∈ filter p l) : a ∈ l :=
|
||||
· simp_all [Id.run, List.filterMap_cons]
|
||||
split <;> simp_all
|
||||
|
||||
@[deprecated filterMap_toList (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @filterMap_toList
|
||||
@[deprecated toList_filterMap (since := "2024-09-09")]
|
||||
abbrev filterMap_data := @toList_filterMap
|
||||
|
||||
@[simp] theorem mem_filterMap {f : α → Option β} {l : Array α} {b : β} :
|
||||
b ∈ filterMap f l ↔ ∃ a, a ∈ l ∧ f a = some b := by
|
||||
simp only [mem_def, filterMap_toList, List.mem_filterMap]
|
||||
simp only [mem_def, toList_filterMap, List.mem_filterMap]
|
||||
|
||||
/-! ### empty -/
|
||||
|
||||
@@ -819,7 +925,7 @@ theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size :=
|
||||
|
||||
theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
|
||||
(as ++ bs)[i] = as[i] := by
|
||||
simp only [getElem_eq_toList_getElem]
|
||||
simp only [getElem_eq_getElem_toList]
|
||||
have h' : i < (as.toList ++ bs.toList).length := by rwa [← toList_length, append_toList] at h
|
||||
conv => rhs; rw [← List.getElem_append_left (bs := bs.toList) (h' := h')]
|
||||
apply List.get_of_eq; rw [append_toList]
|
||||
@@ -827,7 +933,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 +1081,33 @@ theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : a
|
||||
|
||||
/-! ### any -/
|
||||
|
||||
theorem anyM_loop_cons [Monad m] (p : α → m Bool) (a : α) (as : List α) (stop start : Nat) (h : stop + 1 ≤ (a :: as).length) :
|
||||
anyM.loop p ⟨a :: as⟩ (stop + 1) h (start + 1) = anyM.loop p ⟨as⟩ stop (by simpa using h) start := by
|
||||
rw [anyM.loop]
|
||||
conv => rhs; rw [anyM.loop]
|
||||
split <;> rename_i h'
|
||||
· simp only [Nat.add_lt_add_iff_right] at h'
|
||||
rw [dif_pos h']
|
||||
rw [anyM_loop_cons]
|
||||
simp
|
||||
· rw [dif_neg]
|
||||
omega
|
||||
|
||||
@[simp] theorem anyM_toList [Monad m] (p : α → m Bool) (as : Array α) :
|
||||
as.toList.anyM p = as.anyM p :=
|
||||
match as with
|
||||
| ⟨[]⟩ => rfl
|
||||
| ⟨a :: as⟩ => by
|
||||
simp only [List.anyM, anyM, size_toArray, List.length_cons, Nat.le_refl, ↓reduceDIte]
|
||||
rw [anyM.loop, dif_pos (by omega)]
|
||||
congr 1
|
||||
funext b
|
||||
split
|
||||
· simp
|
||||
· simp only [Bool.false_eq_true, ↓reduceIte]
|
||||
rw [anyM_loop_cons]
|
||||
simpa [anyM] using anyM_toList p ⟨as⟩
|
||||
|
||||
-- Auxiliary for `any_iff_exists`.
|
||||
theorem anyM_loop_iff_exists {p : α → Bool} {as : Array α} {start stop} (h : stop ≤ as.size) :
|
||||
anyM.loop (m := Id) p as stop h start = true ↔
|
||||
@@ -1019,6 +1152,17 @@ theorem any_def {p : α → Bool} (as : Array α) : as.any p = as.toList.any p :
|
||||
|
||||
/-! ### all -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
|
||||
dsimp [allM, anyM]
|
||||
simp
|
||||
|
||||
@[simp] theorem allM_toList [Monad m] [LawfulMonad m] (p : α → m Bool) (as : Array α) :
|
||||
as.toList.allM p = as.allM p := by
|
||||
rw [allM_eq_not_anyM_not]
|
||||
rw [← anyM_toList]
|
||||
rw [List.allM_eq_not_anyM_not]
|
||||
|
||||
theorem all_eq_not_any_not (p : α → Bool) (as : Array α) (start stop) :
|
||||
all as p start stop = !(any as (!p ·) start stop) := by
|
||||
dsimp [all, allM]
|
||||
@@ -1040,10 +1184,10 @@ theorem all_def {p : α → Bool} (as : Array α) : as.all p = as.toList.all p :
|
||||
rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]; simp only [List.mem_iff_getElem]
|
||||
constructor
|
||||
· rintro w x ⟨r, h, rfl⟩
|
||||
rw [← getElem_eq_toList_getElem]
|
||||
rw [← getElem_eq_getElem_toList]
|
||||
exact w ⟨r, h⟩
|
||||
· intro w i
|
||||
exact w as[i] ⟨i, i.2, (getElem_eq_toList_getElem as i.2).symm⟩
|
||||
exact w as[i] ⟨i, i.2, (getElem_eq_getElem_toList i.2).symm⟩
|
||||
|
||||
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p ↔ ∀ x, x ∈ l → p x := by
|
||||
simp only [all_def, List.all_eq_true, mem_def]
|
||||
@@ -1115,3 +1259,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
|
||||
|
||||
@@ -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,386 @@ theorem shiftLeft_eq_shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) :
|
||||
· simp [of_length_zero]
|
||||
· simp [shiftLeftRec_eq]
|
||||
|
||||
/-! # udiv/urem recurrence for bitblasting
|
||||
|
||||
In order to prove the correctness of the division algorithm on the integers,
|
||||
one shows that `n.div d = q` and `n.mod d = r` iff `n = d * q + r` and `0 ≤ r < d`.
|
||||
Mnemonic: `n` is the numerator, `d` is the denominator, `q` is the quotient, and `r` the remainder.
|
||||
|
||||
This *uniqueness of decomposition* is not true for bitvectors.
|
||||
For `n = 0, d = 3, w = 3`, we can write:
|
||||
- `0 = 0 * 3 + 0` (`q = 0`, `r = 0 < 3`.)
|
||||
- `0 = 2 * 3 + 2 = 6 + 2 ≃ 0 (mod 8)` (`q = 2`, `r = 2 < 3`).
|
||||
|
||||
Such examples can be created by choosing different `(q, r)` for a fixed `(d, n)`
|
||||
such that `(d * q + r)` overflows and wraps around to equal `n`.
|
||||
|
||||
This tells us that the division algorithm must have more restrictions than just the ones
|
||||
we have for integers. These restrictions are captured in `DivModState.Lawful`.
|
||||
The key idea is to state the relationship in terms of the toNat values of {n, d, q, r}.
|
||||
If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
|
||||
then `n.udiv d = q` and `n.umod d = r`.
|
||||
|
||||
Following this, we implement the division algorithm by repeated shift-subtract.
|
||||
|
||||
References:
|
||||
- Fast 32-bit Division on the DSP56800E: Minimized nonrestoring division algorithm by David Baca
|
||||
- Bitwuzla sources for bitblasting.h
|
||||
-/
|
||||
|
||||
private theorem Nat.div_add_eq_left_of_lt {x y z : Nat} (hx : z ∣ x) (hy : y < z) (hz : 0 < z) :
|
||||
(x + y) / z = x / z := by
|
||||
refine Nat.div_eq_of_lt_le ?lo ?hi
|
||||
· apply Nat.le_trans
|
||||
· exact div_mul_le_self x z
|
||||
· omega
|
||||
· simp only [succ_eq_add_one, Nat.add_mul, Nat.one_mul]
|
||||
apply Nat.add_lt_add_of_le_of_lt
|
||||
· apply Nat.le_of_eq
|
||||
exact (Nat.div_eq_iff_eq_mul_left hz hx).mp rfl
|
||||
· exact hy
|
||||
|
||||
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
|
||||
then `n.udiv d = q`. -/
|
||||
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
|
||||
(hrd : r < d)
|
||||
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
|
||||
n.udiv d = q := by
|
||||
apply BitVec.eq_of_toNat_eq
|
||||
rw [toNat_udiv]
|
||||
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
|
||||
simp [hdqnr]
|
||||
rw [Nat.div_add_eq_left_of_lt] at hdqnr
|
||||
· rw [← hdqnr]
|
||||
exact mul_div_right q.toNat hd
|
||||
· exact Nat.dvd_mul_right d.toNat q.toNat
|
||||
· exact hrd
|
||||
· exact hd
|
||||
|
||||
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
|
||||
then `n.umod d = r`. -/
|
||||
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
|
||||
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
|
||||
n.umod d = r := by
|
||||
apply BitVec.eq_of_toNat_eq
|
||||
rw [toNat_umod]
|
||||
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
|
||||
simp [hdqnr]
|
||||
rw [Nat.add_mod, Nat.mul_mod_right] at hdqnr
|
||||
simp only [Nat.zero_add, mod_mod] at hdqnr
|
||||
replace hrd : r.toNat < d.toNat := by
|
||||
simpa [BitVec.lt_def] using hrd
|
||||
rw [Nat.mod_eq_of_lt hrd] at hdqnr
|
||||
simp [hdqnr]
|
||||
|
||||
/-! ### DivModState -/
|
||||
|
||||
/-- `DivModState` is a structure that maintains the state of recursive `divrem` calls. -/
|
||||
structure DivModState (w : Nat) : Type where
|
||||
/-- The number of bits in the numerator that are not yet processed -/
|
||||
wn : Nat
|
||||
/-- The number of bits in the remainder (and quotient) -/
|
||||
wr : Nat
|
||||
/-- The current quotient. -/
|
||||
q : BitVec w
|
||||
/-- The current remainder. -/
|
||||
r : BitVec w
|
||||
|
||||
|
||||
/-- `DivModArgs` contains the arguments to a `divrem` call which remain constant throughout
|
||||
execution. -/
|
||||
structure DivModArgs (w : Nat) where
|
||||
/-- the numerator (aka, dividend) -/
|
||||
n : BitVec w
|
||||
/-- the denumerator (aka, divisor)-/
|
||||
d : BitVec w
|
||||
|
||||
/-- A `DivModState` is lawful if the remainder width `wr` plus the numerator width `wn` equals `w`,
|
||||
and the bitvectors `r` and `n` have values in the bounds given by bitwidths `wr`, resp. `wn`.
|
||||
|
||||
This is a proof engineering choice: an alternative world could have been
|
||||
`r : BitVec wr` and `n : BitVec wn`, but this required much more dependent typing coercions.
|
||||
|
||||
Instead, we choose to declare all involved bitvectors as length `w`, and then prove that
|
||||
the values are within their respective bounds.
|
||||
|
||||
We start with `wn = w` and `wr = 0`, and then in each step, we decrement `wn` and increment `wr`.
|
||||
In this way, we grow a legal remainder in each loop iteration.
|
||||
-/
|
||||
structure DivModState.Lawful {w : Nat} (args : DivModArgs w) (qr : DivModState w) : Prop where
|
||||
/-- The sum of widths of the dividend and remainder is `w`. -/
|
||||
hwrn : qr.wr + qr.wn = w
|
||||
/-- The denominator is positive. -/
|
||||
hdPos : 0 < args.d
|
||||
/-- The remainder is strictly less than the denominator. -/
|
||||
hrLtDivisor : qr.r.toNat < args.d.toNat
|
||||
/-- The remainder is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
|
||||
hrWidth : qr.r.toNat < 2^qr.wr
|
||||
/-- The quotient is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
|
||||
hqWidth : qr.q.toNat < 2^qr.wr
|
||||
/-- The low `(w - wn)` bits of `n` obey the invariant for division. -/
|
||||
hdiv : args.n.toNat >>> qr.wn = args.d.toNat * qr.q.toNat + qr.r.toNat
|
||||
|
||||
/-- A lawful DivModState implies `w > 0`. -/
|
||||
def DivModState.Lawful.hw {args : DivModArgs w} {qr : DivModState w}
|
||||
{h : DivModState.Lawful args qr} : 0 < w := by
|
||||
have hd := h.hdPos
|
||||
rcases w with rfl | w
|
||||
· have hcontra : args.d = 0#0 := by apply Subsingleton.elim
|
||||
rw [hcontra] at hd
|
||||
simp at hd
|
||||
· omega
|
||||
|
||||
/-- An initial value with both `q, r = 0`. -/
|
||||
def DivModState.init (w : Nat) : DivModState w := {
|
||||
wn := w
|
||||
wr := 0
|
||||
q := 0#w
|
||||
r := 0#w
|
||||
}
|
||||
|
||||
/-- The initial state is lawful. -/
|
||||
def DivModState.lawful_init {w : Nat} (args : DivModArgs w) (hd : 0#w < args.d) :
|
||||
DivModState.Lawful args (DivModState.init w) := by
|
||||
simp only [BitVec.DivModState.init]
|
||||
exact {
|
||||
hwrn := by simp only; omega,
|
||||
hdPos := by assumption
|
||||
hrLtDivisor := by simp [BitVec.lt_def] at hd ⊢; assumption
|
||||
hrWidth := by simp [DivModState.init],
|
||||
hqWidth := by simp [DivModState.init],
|
||||
hdiv := by
|
||||
simp only [DivModState.init, toNat_ofNat, zero_mod, Nat.mul_zero, Nat.add_zero];
|
||||
rw [Nat.shiftRight_eq_div_pow]
|
||||
apply Nat.div_eq_of_lt args.n.isLt
|
||||
}
|
||||
|
||||
/--
|
||||
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
|
||||
quotient has been correctly computed.
|
||||
-/
|
||||
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
|
||||
(h_lawful : DivModState.Lawful {n, d} qr)
|
||||
(h_final : qr.wn = 0) :
|
||||
n.udiv d = qr.q := by
|
||||
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
|
||||
have hdiv := h_lawful.hdiv
|
||||
simp only [h_final] at *
|
||||
omega
|
||||
|
||||
/--
|
||||
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
|
||||
remainder has been correctly computed.
|
||||
-/
|
||||
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
|
||||
(h : DivModState.Lawful {n, d} qr)
|
||||
(h_final : qr.wn = 0) :
|
||||
n.umod d = qr.r := by
|
||||
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
|
||||
have hdiv := h.hdiv
|
||||
simp only [shiftRight_zero] at hdiv
|
||||
simp only [h_final] at *
|
||||
exact hdiv.symm
|
||||
|
||||
/-! ### DivModState.Poised -/
|
||||
|
||||
/--
|
||||
A `Poised` DivModState is a state which is `Lawful` and furthermore, has at least
|
||||
one numerator bit left to process `(0 < wn)`
|
||||
|
||||
The input to the shift subtractor is a legal input to `divrem`, and we also need to have an
|
||||
input bit to perform shift subtraction on, and thus we need `0 < wn`.
|
||||
-/
|
||||
structure DivModState.Poised {w : Nat} (args : DivModArgs w) (qr : DivModState w)
|
||||
extends DivModState.Lawful args qr : Type where
|
||||
/-- Only perform a round of shift-subtract if we have dividend bits. -/
|
||||
hwn_lt : 0 < qr.wn
|
||||
|
||||
/--
|
||||
In the shift subtract input, the dividend is at least one bit long (`wn > 0`), so
|
||||
the remainder has bits to be computed (`wr < w`).
|
||||
-/
|
||||
def DivModState.wr_lt_w {qr : DivModState w} (h : qr.Poised args) : qr.wr < w := by
|
||||
have hwrn := h.hwrn
|
||||
have hwn_lt := h.hwn_lt
|
||||
omega
|
||||
|
||||
/-! ### Division shift subtractor -/
|
||||
|
||||
/--
|
||||
One round of the division algorithm, that tries to perform a subtract shift.
|
||||
Note that this should only be called when `r.msb = false`, so we will not overflow.
|
||||
-/
|
||||
def divSubtractShift (args : DivModArgs w) (qr : DivModState w) : DivModState w :=
|
||||
let {n, d} := args
|
||||
let wn := qr.wn - 1
|
||||
let wr := qr.wr + 1
|
||||
let r' := shiftConcat qr.r (n.getLsbD wn)
|
||||
if r' < d then {
|
||||
q := qr.q.shiftConcat false, -- If `r' < d`, then we do not have a quotient bit.
|
||||
r := r'
|
||||
wn, wr
|
||||
} else {
|
||||
q := qr.q.shiftConcat true, -- Otherwise, `r' ≥ d`, and we have a quotient bit.
|
||||
r := r' - d -- we subtract to maintain the invariant that `r < d`.
|
||||
wn, wr
|
||||
}
|
||||
|
||||
/-- The value of shifting right by `wn - 1` equals shifting by `wn` and grabbing the lsb at `(wn - 1)`. -/
|
||||
theorem DivModState.toNat_shiftRight_sub_one_eq
|
||||
{args : DivModArgs w} {qr : DivModState w} (h : qr.Poised args) :
|
||||
args.n.toNat >>> (qr.wn - 1)
|
||||
= (args.n.toNat >>> qr.wn) * 2 + (args.n.getLsbD (qr.wn - 1)).toNat := by
|
||||
show BitVec.toNat (args.n >>> (qr.wn - 1)) = _
|
||||
have {..} := h -- break the structure down for `omega`
|
||||
rw [shiftRight_sub_one_eq_shiftConcat args.n h.hwn_lt]
|
||||
rw [toNat_shiftConcat_eq_of_lt (k := w - qr.wn)]
|
||||
· simp
|
||||
· omega
|
||||
· apply BitVec.toNat_ushiftRight_lt
|
||||
omega
|
||||
|
||||
/--
|
||||
This is used when proving the correctness of the divison algorithm,
|
||||
where we know that `r < d`.
|
||||
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
|
||||
In arithmetic, this is the same as showing that
|
||||
`r * 2 + 1 - d < d`, which this theorem establishes.
|
||||
-/
|
||||
private theorem two_mul_add_sub_lt_of_lt_of_lt_two (h : a < x) (hy : y < 2) :
|
||||
2 * a + y - x < x := by omega
|
||||
|
||||
/-- We show that the output of `divSubtractShift` is lawful, which tells us that it
|
||||
obeys the division equation. -/
|
||||
theorem lawful_divSubtractShift (qr : DivModState w) (h : qr.Poised args) :
|
||||
DivModState.Lawful args (divSubtractShift args qr) := by
|
||||
rcases args with ⟨n, d⟩
|
||||
simp only [divSubtractShift, decide_eq_true_eq]
|
||||
-- We add these hypotheses for `omega` to find them later.
|
||||
have ⟨⟨hrwn, hd, hrd, hr, hn, hrnd⟩, hwn_lt⟩ := h
|
||||
have : d.toNat * (qr.q.toNat * 2) = d.toNat * qr.q.toNat * 2 := by rw [Nat.mul_assoc]
|
||||
by_cases rltd : shiftConcat qr.r (n.getLsbD (qr.wn - 1)) < d
|
||||
· simp only [rltd, ↓reduceIte]
|
||||
constructor <;> try bv_omega
|
||||
case pos.hrWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
|
||||
case pos.hqWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
|
||||
case pos.hdiv =>
|
||||
simp [qr.toNat_shiftRight_sub_one_eq h, h.hdiv, this,
|
||||
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth,
|
||||
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth]
|
||||
omega
|
||||
· simp only [rltd, ↓reduceIte]
|
||||
constructor <;> try bv_omega
|
||||
case neg.hrLtDivisor =>
|
||||
simp only [lt_def, Nat.not_lt] at rltd
|
||||
rw [BitVec.toNat_sub_of_le rltd,
|
||||
toNat_shiftConcat_eq_of_lt (hk := qr.wr_lt_w h) (hx := h.hrWidth),
|
||||
Nat.mul_comm]
|
||||
apply two_mul_add_sub_lt_of_lt_of_lt_two <;> bv_omega
|
||||
case neg.hrWidth =>
|
||||
simp only
|
||||
have hdr' : d ≤ (qr.r.shiftConcat (n.getLsbD (qr.wn - 1))) :=
|
||||
BitVec.not_lt_iff_le.mp rltd
|
||||
have hr' : ((qr.r.shiftConcat (n.getLsbD (qr.wn - 1)))).toNat < 2 ^ (qr.wr + 1) := by
|
||||
apply toNat_shiftConcat_lt_of_lt <;> bv_omega
|
||||
rw [BitVec.toNat_sub_of_le hdr']
|
||||
omega
|
||||
case neg.hqWidth =>
|
||||
apply toNat_shiftConcat_lt_of_lt <;> omega
|
||||
case neg.hdiv =>
|
||||
have rltd' := (BitVec.not_lt_iff_le.mp rltd)
|
||||
simp only [qr.toNat_shiftRight_sub_one_eq h,
|
||||
BitVec.toNat_sub_of_le rltd',
|
||||
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth]
|
||||
simp only [BitVec.le_def,
|
||||
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth] at rltd'
|
||||
simp only [toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth, h.hdiv, Nat.mul_add]
|
||||
bv_omega
|
||||
|
||||
/-! ### Core division algorithm circuit -/
|
||||
|
||||
/-- A recursive definition of division for bitblasting, in terms of a shift-subtraction circuit. -/
|
||||
def divRec {w : Nat} (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
|
||||
DivModState w :=
|
||||
match m with
|
||||
| 0 => qr
|
||||
| m + 1 => divRec m args <| divSubtractShift args qr
|
||||
|
||||
@[simp]
|
||||
theorem divRec_zero (qr : DivModState w) :
|
||||
divRec 0 args qr = qr := rfl
|
||||
|
||||
@[simp]
|
||||
theorem divRec_succ (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
|
||||
divRec (m + 1) args qr =
|
||||
divRec m args (divSubtractShift args qr) := rfl
|
||||
|
||||
/-- The output of `divRec` is a lawful state -/
|
||||
theorem lawful_divRec {args : DivModArgs w} {qr : DivModState w}
|
||||
(h : DivModState.Lawful args qr) :
|
||||
DivModState.Lawful args (divRec qr.wn args qr) := by
|
||||
generalize hm : qr.wn = m
|
||||
induction m generalizing qr
|
||||
case zero =>
|
||||
exact h
|
||||
case succ wn' ih =>
|
||||
simp only [divRec_succ]
|
||||
apply ih
|
||||
· apply lawful_divSubtractShift
|
||||
constructor
|
||||
· assumption
|
||||
· omega
|
||||
· simp only [divSubtractShift, hm]
|
||||
split <;> rfl
|
||||
|
||||
/-- The output of `divRec` has no more bits left to process (i.e., `wn = 0`) -/
|
||||
@[simp]
|
||||
theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
|
||||
(divRec qr.wn args qr).wn = 0 := by
|
||||
generalize hm : qr.wn = m
|
||||
induction m generalizing qr
|
||||
case zero =>
|
||||
assumption
|
||||
case succ wn' ih =>
|
||||
apply ih
|
||||
simp only [divSubtractShift, hm]
|
||||
split <;> rfl
|
||||
|
||||
/-- The result of `udiv` agrees with the result of the division recurrence. -/
|
||||
theorem udiv_eq_divRec (hd : 0#w < d) :
|
||||
let out := divRec w {n, d} (DivModState.init w)
|
||||
n.udiv d = out.q := by
|
||||
have := DivModState.lawful_init {n, d} hd
|
||||
have := lawful_divRec this
|
||||
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
|
||||
|
||||
/-- The result of `umod` agrees with the result of the division recurrence. -/
|
||||
theorem umod_eq_divRec (hd : 0#w < d) :
|
||||
let out := divRec w {n, d} (DivModState.init w)
|
||||
n.umod d = out.r := by
|
||||
have := DivModState.lawful_init {n, d} hd
|
||||
have := lawful_divRec this
|
||||
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
|
||||
|
||||
@[simp]
|
||||
theorem divRec_succ' (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
|
||||
divRec (m+1) args qr =
|
||||
let wn := qr.wn - 1
|
||||
let wr := qr.wr + 1
|
||||
let r' := shiftConcat qr.r (args.n.getLsbD wn)
|
||||
let input : DivModState _ :=
|
||||
if r' < args.d then {
|
||||
q := qr.q.shiftConcat false,
|
||||
r := r'
|
||||
wn, wr
|
||||
} else {
|
||||
q := qr.q.shiftConcat true,
|
||||
r := r' - args.d
|
||||
wn, wr
|
||||
}
|
||||
divRec m args input := by
|
||||
simp [divRec_succ, divSubtractShift]
|
||||
|
||||
/- ### Arithmetic shift right (sshiftRight) recurrence -/
|
||||
|
||||
/--
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -1314,11 +1314,16 @@ theorem map_eq_iff : map f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map f := by
|
||||
theorem map_eq_foldr (f : α → β) (l : List α) : map f l = foldr (fun a bs => f a :: bs) [] l := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
|
||||
(map f l).set n (f a) = map f (l.set n a) := by
|
||||
induction l generalizing n with
|
||||
@[simp] theorem map_set {f : α → β} {l : List α} {i : Nat} {a : α} :
|
||||
(l.set i a).map f = (l.map f).set i (f a) := by
|
||||
induction l generalizing i with
|
||||
| nil => simp
|
||||
| cons b l ih => cases n <;> simp_all
|
||||
| cons b l ih => cases i <;> simp_all
|
||||
|
||||
@[deprecated "Use the reverse direction of `map_set`." (since := "2024-09-20")]
|
||||
theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
|
||||
(map f l).set n (f a) = map f (l.set n a) := by
|
||||
simp
|
||||
|
||||
@[simp] theorem head_map (f : α → β) (l : List α) (w) :
|
||||
head (map f l) w = f (head l (by simpa using w)) := by
|
||||
@@ -1649,6 +1654,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,6 +2397,12 @@ theorem map_eq_replicate_iff {l : List α} {f : α → β} {b : β} :
|
||||
theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.length b :=
|
||||
map_const l b
|
||||
|
||||
@[simp] theorem set_replicate_self : (replicate n a).set i a = replicate n a := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
simp [getElem_set]
|
||||
|
||||
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
|
||||
rw [eq_replicate_iff]
|
||||
constructor
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -682,7 +682,12 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
|
||||
-- We add info to get reliable positions for messages from evaluating the tactic script.
|
||||
let info := field.ref.getHeadInfo
|
||||
let stx := stx.raw.rewriteBottomUp (·.setInfo info)
|
||||
cont (← elabTermEnsuringType stx (d.getArg! 0).consumeTypeAnnotations) field
|
||||
let type := (d.getArg! 0).consumeTypeAnnotations
|
||||
let mvar ← mkTacticMVar type stx (.fieldAutoParam fieldName s.structName)
|
||||
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
|
||||
-- (See the aformentioned `processExplicitArg` for a comment about this.)
|
||||
addTermInfo' stx mvar
|
||||
cont mvar field
|
||||
| _ =>
|
||||
if bi == .instImplicit then
|
||||
let val ← withRef field.ref <| mkFreshExprMVar d .synthetic
|
||||
|
||||
@@ -468,7 +468,8 @@ where
|
||||
if h : i < view.parents.size then
|
||||
let parentStx := view.parents.get ⟨i, h⟩
|
||||
withRef parentStx do
|
||||
let parentType ← Term.elabType parentStx
|
||||
let parentType ← Term.withSynthesize <| Term.elabType parentStx
|
||||
let parentType ← whnf parentType
|
||||
let parentStructName ← getStructureName parentType
|
||||
if let some existingFieldName ← findExistingField? infos parentStructName then
|
||||
if structureDiamondWarning.get (← getOptions) then
|
||||
@@ -772,7 +773,7 @@ private partial def mkCoercionToCopiedParent (levelParams : List Name) (params :
|
||||
let some fieldInfo := getFieldInfo? env parentStructName fieldName | unreachable!
|
||||
if fieldInfo.subobject?.isNone then throwError "failed to build coercion to parent structure"
|
||||
let resultType ← whnfD (← inferType result)
|
||||
unless resultType.isForall do throwError "failed to build coercion to parent structure, unexpect type{indentExpr resultType}"
|
||||
unless resultType.isForall do throwError "failed to build coercion to parent structure, unexpected type{indentExpr resultType}"
|
||||
let fieldVal ← copyFields resultType.bindingDomain!
|
||||
result := mkApp result fieldVal
|
||||
return result
|
||||
|
||||
@@ -21,7 +21,7 @@ private def resumeElabTerm (stx : Syntax) (expectedType? : Option Expr) (errToSo
|
||||
elabTerm stx expectedType? false
|
||||
|
||||
/--
|
||||
Try to elaborate `stx` that was postponed by an elaboration method using `Expection.postpone`.
|
||||
Try to elaborate `stx` that was postponed by an elaboration method using `Exception.postpone`.
|
||||
It returns `true` if it succeeded, and `false` otherwise.
|
||||
It is used to implement `synthesizeSyntheticMVars`. -/
|
||||
private def resumePostponed (savedContext : SavedContext) (stx : Syntax) (mvarId : MVarId) (postponeOnError : Bool) : TermElabM Bool :=
|
||||
@@ -86,7 +86,7 @@ private def synthesizePendingInstMVar (instMVar : MVarId) (extraErrorMsg? : Opti
|
||||
example (a : Int) (b c : Nat) : a = ↑b - ↑c := sorry
|
||||
```
|
||||
We have two pending coercions for the `↑` and `HSub ?m.220 ?m.221 ?m.222`.
|
||||
When we did not use a backtracking search here, then the homogenous default instance for `HSub`.
|
||||
When we did not use a backtracking search here, then the homogeneous default instance for `HSub`.
|
||||
```
|
||||
instance [Sub α] : HSub α α α where
|
||||
```
|
||||
@@ -306,7 +306,7 @@ inductive PostponeBehavior where
|
||||
| no
|
||||
/--
|
||||
Synthectic metavariables associated with type class resolution can be postponed.
|
||||
Motivation: this kind of metavariable are not synthethic opaque, and can be assigned by `isDefEq`.
|
||||
Motivation: this kind of metavariable are not synthetic opaque, and can be assigned by `isDefEq`.
|
||||
Unviverse constraints can also be postponed.
|
||||
-/
|
||||
| «partial»
|
||||
@@ -316,6 +316,18 @@ def PostponeBehavior.ofBool : Bool → PostponeBehavior
|
||||
| true => .yes
|
||||
| false => .no
|
||||
|
||||
private def TacticMVarKind.logError (tacticCode : Syntax) (kind : TacticMVarKind) : TermElabM Unit := do
|
||||
match kind with
|
||||
| term => pure ()
|
||||
| autoParam argName => logErrorAt tacticCode m!"could not synthesize default value for parameter '{argName}' using tactics"
|
||||
| fieldAutoParam fieldName structName => logErrorAt tacticCode m!"could not synthesize default value for field '{fieldName}' of '{structName}' using tactics"
|
||||
|
||||
private def TacticMVarKind.maybeWithoutRecovery (kind : TacticMVarKind) (m : TacticM α) : TacticM α := do
|
||||
if kind matches .autoParam .. | .fieldAutoParam .. then
|
||||
withoutErrToSorry <| Tactic.withoutRecover <| m
|
||||
else
|
||||
m
|
||||
|
||||
mutual
|
||||
|
||||
/--
|
||||
@@ -325,7 +337,7 @@ mutual
|
||||
|
||||
If `report := false`, then `runTactic` will not capture exceptions nor will report unsolved goals. Unsolved goals become exceptions.
|
||||
-/
|
||||
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
|
||||
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (kind : TacticMVarKind) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
|
||||
instantiateMVarDeclMVars mvarId
|
||||
/-
|
||||
TODO: consider using `runPendingTacticsAt` at `mvarId` local context and target type.
|
||||
@@ -342,7 +354,7 @@ mutual
|
||||
in more complicated scenarios.
|
||||
-/
|
||||
tryCatchRuntimeEx
|
||||
(do let remainingGoals ← withInfoHole mvarId <| Tactic.run mvarId do
|
||||
(do let remainingGoals ← withInfoHole mvarId <| Tactic.run mvarId <| kind.maybeWithoutRecovery do
|
||||
withTacticInfoContext tacticCode do
|
||||
-- also put an info node on the `by` keyword specifically -- the token may be `canonical` and thus shown in the info
|
||||
-- view even though it is synthetic while a node like `tacticCode` never is (#1990)
|
||||
@@ -354,10 +366,13 @@ mutual
|
||||
synthesizeSyntheticMVars (postpone := .no)
|
||||
unless remainingGoals.isEmpty do
|
||||
if report then
|
||||
kind.logError tacticCode
|
||||
reportUnsolvedGoals remainingGoals
|
||||
else
|
||||
throwError "unsolved goals\n{goalsToMessageData remainingGoals}")
|
||||
fun ex => do
|
||||
if report then
|
||||
kind.logError tacticCode
|
||||
if report && (← read).errToSorry then
|
||||
for mvarId in (← getMVars (mkMVar mvarId)) do
|
||||
mvarId.admit
|
||||
@@ -385,10 +400,10 @@ mutual
|
||||
return false
|
||||
-- NOTE: actual processing at `synthesizeSyntheticMVarsAux`
|
||||
| .postponed savedContext => resumePostponed savedContext mvarSyntheticDecl.stx mvarId postponeOnError
|
||||
| .tactic tacticCode savedContext =>
|
||||
| .tactic tacticCode savedContext kind =>
|
||||
withSavedContext savedContext do
|
||||
if runTactics then
|
||||
runTactic mvarId tacticCode
|
||||
runTactic mvarId tacticCode kind
|
||||
return true
|
||||
else
|
||||
return false
|
||||
@@ -512,7 +527,7 @@ private partial def withSynthesizeLightImp (k : TermElabM α) : TermElabM α :=
|
||||
finally
|
||||
modify fun s => { s with pendingMVars := s.pendingMVars ++ pendingMVarsSaved }
|
||||
|
||||
/-- Similar to `withSynthesize`, but uses `postpone := .true`, does not use use `synthesizeUsingDefault` -/
|
||||
/-- Similar to `withSynthesize`, but uses `postpone := .true`, does not use `synthesizeUsingDefault` -/
|
||||
@[inline] def withSynthesizeLight [MonadFunctorT TermElabM m] (k : m α) : m α :=
|
||||
monadMap (m := TermElabM) (withSynthesizeLightImp ·) k
|
||||
|
||||
@@ -529,9 +544,9 @@ the result of a tactic block.
|
||||
def runPendingTacticsAt (e : Expr) : TermElabM Unit := do
|
||||
for mvarId in (← getMVars e) do
|
||||
let mvarId ← getDelayedMVarRoot mvarId
|
||||
if let some { kind := .tactic tacticCode savedContext, .. } ← getSyntheticMVarDecl? mvarId then
|
||||
if let some { kind := .tactic tacticCode savedContext kind, .. } ← getSyntheticMVarDecl? mvarId then
|
||||
withSavedContext savedContext do
|
||||
runTactic mvarId tacticCode
|
||||
runTactic mvarId tacticCode kind
|
||||
markAsResolved mvarId
|
||||
|
||||
builtin_initialize
|
||||
|
||||
@@ -71,7 +71,7 @@ For the second kind more steps are involved:
|
||||
3. Verify that algorithm in `Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas`.
|
||||
4. Integrate it with either the expression or predicate bitblaster and use the proof above to verify it.
|
||||
5. Add simplification lemmas for the primitive to `bv_normalize` in `Std.Tactic.BVDecide.Normalize`.
|
||||
If there are mutliple ways to write the primitive (e.g. with TC based notation and without) you
|
||||
If there are multiple ways to write the primitive (e.g. with TC based notation and without) you
|
||||
should normalize for one notation here.
|
||||
6. Add the reflection code to `Lean.Elab.Tactic.BVDecide.Frontend.BVDecide`
|
||||
7. Add a test!
|
||||
|
||||
@@ -24,7 +24,7 @@ register_builtin_option sat.solver : String := {
|
||||
defValue := ""
|
||||
descr :=
|
||||
"Name of the SAT solver used by Lean.Elab.Tactic.BVDecide tactics.\n
|
||||
1. If this is set to something besides the emtpy string they will use that binary.\n
|
||||
1. If this is set to something besides the empty string they will use that binary.\n
|
||||
2. If this is set to the empty string they will check if there is a cadical binary next to the\
|
||||
executing program. Usually that program is going to be `lean` itself and we do ship a\
|
||||
`cadical` next to it.\n
|
||||
|
||||
@@ -44,7 +44,7 @@ def bvCheck (g : MVarId) (cfg : TacticContext) : MetaM Unit := do
|
||||
let unsatProver : UnsatProver := fun reflectionResult _ => do
|
||||
withTraceNode `sat (fun _ => return "Preparing LRAT reflection term") do
|
||||
let proof ← lratChecker cfg reflectionResult.bvExpr
|
||||
return ⟨proof, ""⟩
|
||||
return .ok ⟨proof, ""⟩
|
||||
let _ ← closeWithBVReflection g unsatProver
|
||||
return ()
|
||||
|
||||
|
||||
@@ -79,18 +79,26 @@ structure ReflectionResult where
|
||||
proveFalse : Expr → M Expr
|
||||
unusedHypotheses : Std.HashSet FVarId
|
||||
|
||||
/--
|
||||
A counter example generated from the bitblaster.
|
||||
-/
|
||||
structure CounterExample where
|
||||
/--
|
||||
The set of unused but potentially relevant hypotheses. Useful for diagnosing spurious counter
|
||||
examples.
|
||||
-/
|
||||
unusedHypotheses : Std.HashSet FVarId
|
||||
/--
|
||||
The actual counter example as a list of equations denoted as `expr = value` pairs.
|
||||
-/
|
||||
equations : Array (Expr × BVExpr.PackedBitVec)
|
||||
|
||||
structure UnsatProver.Result where
|
||||
proof : Expr
|
||||
lratCert : LratCert
|
||||
|
||||
abbrev UnsatProver := ReflectionResult → Std.HashMap Nat (Nat × Expr) → MetaM UnsatProver.Result
|
||||
|
||||
/--
|
||||
Contains values that will be used to diagnose spurious counter examples.
|
||||
-/
|
||||
structure DiagnosisInput where
|
||||
unusedHypotheses : Std.HashSet FVarId
|
||||
atomsAssignment : Std.HashMap Nat (Nat × Expr)
|
||||
abbrev UnsatProver := ReflectionResult → Std.HashMap Nat (Nat × Expr) →
|
||||
MetaM (Except CounterExample UnsatProver.Result)
|
||||
|
||||
/--
|
||||
The result of a spurious counter example diagnosis.
|
||||
@@ -99,20 +107,19 @@ structure Diagnosis where
|
||||
uninterpretedSymbols : Std.HashSet Expr := {}
|
||||
unusedRelevantHypotheses : Std.HashSet FVarId := {}
|
||||
|
||||
abbrev DiagnosisM : Type → Type := ReaderT DiagnosisInput <| StateRefT Diagnosis MetaM
|
||||
abbrev DiagnosisM : Type → Type := ReaderT CounterExample <| StateRefT Diagnosis MetaM
|
||||
|
||||
namespace DiagnosisM
|
||||
|
||||
def run (x : DiagnosisM Unit) (unusedHypotheses : Std.HashSet FVarId)
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) : MetaM Diagnosis := do
|
||||
let (_, issues) ← ReaderT.run x { unusedHypotheses, atomsAssignment } |>.run {}
|
||||
def run (x : DiagnosisM Unit) (counterExample : CounterExample) : MetaM Diagnosis := do
|
||||
let (_, issues) ← ReaderT.run x counterExample |>.run {}
|
||||
return issues
|
||||
|
||||
def unusedHyps : DiagnosisM (Std.HashSet FVarId) := do
|
||||
return (← read).unusedHypotheses
|
||||
|
||||
def atomsAssignment : DiagnosisM (Std.HashMap Nat (Nat × Expr)) := do
|
||||
return (← read).atomsAssignment
|
||||
def equations : DiagnosisM (Array (Expr × BVExpr.PackedBitVec)) := do
|
||||
return (← read).equations
|
||||
|
||||
def addUninterpretedSymbol (e : Expr) : DiagnosisM Unit :=
|
||||
modify fun s => { s with uninterpretedSymbols := s.uninterpretedSymbols.insert e }
|
||||
@@ -131,7 +138,7 @@ Diagnose spurious counter examples, currently this checks:
|
||||
- Whether all hypotheses which contain any variable that was bitblasted were included
|
||||
-/
|
||||
def diagnose : DiagnosisM Unit := do
|
||||
for (_, (_, expr)) in ← atomsAssignment do
|
||||
for (expr, _) in ← equations do
|
||||
match_expr expr with
|
||||
| BitVec.ofBool x =>
|
||||
match x with
|
||||
@@ -157,9 +164,8 @@ def unusedRelevantHypothesesExplainer (d : Diagnosis) : Option MessageData := do
|
||||
def explainers : List (Diagnosis → Option MessageData) :=
|
||||
[uninterpretedExplainer, unusedRelevantHypothesesExplainer]
|
||||
|
||||
def explainCounterExampleQuality (unusedHypotheses : Std.HashSet FVarId)
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) : MetaM MessageData := do
|
||||
let diagnosis ← DiagnosisM.run DiagnosisM.diagnose unusedHypotheses atomsAssignment
|
||||
def explainCounterExampleQuality (counterExample : CounterExample) : MetaM MessageData := do
|
||||
let diagnosis ← DiagnosisM.run DiagnosisM.diagnose counterExample
|
||||
let folder acc explainer := if let some m := explainer diagnosis then acc.push m else acc
|
||||
let explanations := explainers.foldl (init := #[]) folder
|
||||
|
||||
@@ -173,7 +179,7 @@ def explainCounterExampleQuality (unusedHypotheses : Std.HashSet FVarId)
|
||||
|
||||
def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
|
||||
MetaM UnsatProver.Result := do
|
||||
MetaM (Except CounterExample UnsatProver.Result) := do
|
||||
let bvExpr := reflectionResult.bvExpr
|
||||
let entry ←
|
||||
withTraceNode `bv (fun _ => return "Bitblasting BVLogicalExpr to AIG") do
|
||||
@@ -201,13 +207,10 @@ def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
match res with
|
||||
| .ok cert =>
|
||||
let proof ← cert.toReflectionProof cfg bvExpr ``verifyBVExpr ``unsat_of_verifyBVExpr_eq_true
|
||||
return ⟨proof, cert⟩
|
||||
return .ok ⟨proof, cert⟩
|
||||
| .error assignment =>
|
||||
let reconstructed := reconstructCounterExample map assignment aigSize atomsAssignment
|
||||
let mut error ← explainCounterExampleQuality reflectionResult.unusedHypotheses atomsAssignment
|
||||
for (var, value) in reconstructed do
|
||||
error := error ++ m!"{var} = {value.bv}\n"
|
||||
throwError error
|
||||
let equations := reconstructCounterExample map assignment aigSize atomsAssignment
|
||||
return .error { unusedHypotheses := reflectionResult.unusedHypotheses, equations }
|
||||
|
||||
|
||||
def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
|
||||
@@ -219,23 +222,24 @@ def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
|
||||
sats := sats.push reflected
|
||||
else
|
||||
unusedHypotheses := unusedHypotheses.insert hyp
|
||||
if sats.size = 0 then
|
||||
if h : sats.size = 0 then
|
||||
let mut error := "None of the hypotheses are in the supported BitVec fragment.\n"
|
||||
error := error ++ "There are two potential fixes for this:\n"
|
||||
error := error ++ "1. If you are using custom BitVec constructs simplify them to built-in ones.\n"
|
||||
error := error ++ "2. If your problem is using only built-in ones it might currently be out of reach.\n"
|
||||
error := error ++ " Consider expressing it in terms of different operations that are better supported."
|
||||
throwError error
|
||||
let sat := sats.foldl (init := SatAtBVLogical.trivial) SatAtBVLogical.and
|
||||
return {
|
||||
bvExpr := sat.bvExpr,
|
||||
proveFalse := sat.proveFalse,
|
||||
unusedHypotheses := unusedHypotheses
|
||||
}
|
||||
else
|
||||
let sat := sats[1:].foldl (init := sats[0]) SatAtBVLogical.and
|
||||
return {
|
||||
bvExpr := sat.bvExpr,
|
||||
proveFalse := sat.proveFalse,
|
||||
unusedHypotheses := unusedHypotheses
|
||||
}
|
||||
|
||||
|
||||
def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
|
||||
MetaM LratCert := M.run do
|
||||
MetaM (Except CounterExample LratCert) := M.run do
|
||||
g.withContext do
|
||||
let reflectionResult ←
|
||||
withTraceNode `bv (fun _ => return "Reflecting goal into BVLogicalExpr") do
|
||||
@@ -244,26 +248,54 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
|
||||
|
||||
let atomsPairs := (← getThe State).atoms.toList.map (fun (expr, ⟨width, ident⟩) => (ident, (width, expr)))
|
||||
let atomsAssignment := Std.HashMap.ofList atomsPairs
|
||||
let ⟨bvExprUnsat, cert⟩ ← unsatProver reflectionResult atomsAssignment
|
||||
let proveFalse ← reflectionResult.proveFalse bvExprUnsat
|
||||
g.assign proveFalse
|
||||
return cert
|
||||
match ← unsatProver reflectionResult atomsAssignment with
|
||||
| .ok ⟨bvExprUnsat, cert⟩ =>
|
||||
let proveFalse ← reflectionResult.proveFalse bvExprUnsat
|
||||
g.assign proveFalse
|
||||
return .ok cert
|
||||
| .error counterExample => return .error counterExample
|
||||
|
||||
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM LratCert := M.run do
|
||||
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample LratCert) := M.run do
|
||||
let unsatProver : UnsatProver := fun reflectionResult atomsAssignment => do
|
||||
withTraceNode `bv (fun _ => return "Preparing LRAT reflection term") do
|
||||
lratBitblaster cfg reflectionResult atomsAssignment
|
||||
closeWithBVReflection g unsatProver
|
||||
|
||||
/--
|
||||
The result of calling `bv_decide`.
|
||||
-/
|
||||
structure Result where
|
||||
/--
|
||||
Trace of the `simp` used in `bv_decide`'s normalization procedure.
|
||||
-/
|
||||
simpTrace : Simp.Stats
|
||||
/--
|
||||
If the normalization step was not enough to solve the goal this contains the LRAT proof
|
||||
certificate.
|
||||
-/
|
||||
lratCert : Option LratCert
|
||||
|
||||
def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
|
||||
/--
|
||||
Try to close `g` using a bitblaster. Return either a `CounterExample` if one is found or a `Result`
|
||||
if `g` is proven.
|
||||
-/
|
||||
def bvDecide' (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample Result) := do
|
||||
let ⟨g?, simpTrace⟩ ← Normalize.bvNormalize g
|
||||
let some g := g? | return ⟨simpTrace, none⟩
|
||||
let lratCert ← bvUnsat g cfg
|
||||
return ⟨simpTrace, some lratCert⟩
|
||||
let some g := g? | return .ok ⟨simpTrace, none⟩
|
||||
match ← bvUnsat g cfg with
|
||||
| .ok lratCert => return .ok ⟨simpTrace, some lratCert⟩
|
||||
| .error counterExample => return .error counterExample
|
||||
|
||||
/--
|
||||
Call `bvDecide'` and throw a pretty error if a counter example ends up being produced.
|
||||
-/
|
||||
def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
|
||||
match ← bvDecide' g cfg with
|
||||
| .ok result => return result
|
||||
| .error counterExample =>
|
||||
let error ← explainCounterExampleQuality counterExample
|
||||
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
|
||||
throwError counterExample.equations.foldl (init := error) folder
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.bvDecide]
|
||||
def evalBvTrace : Tactic := fun
|
||||
|
||||
@@ -75,9 +75,7 @@ instance : ToExpr Gate where
|
||||
toExpr x :=
|
||||
match x with
|
||||
| .and => mkConst ``Gate.and
|
||||
| .or => mkConst ``Gate.or
|
||||
| .xor => mkConst ``Gate.xor
|
||||
| .imp => mkConst ``Gate.imp
|
||||
| .beq => mkConst ``Gate.beq
|
||||
toTypeExpr := mkConst ``Gate
|
||||
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user