mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-19 03:14:08 +00:00
Compare commits
2 Commits
remove_lib
...
completion
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
00eea26632 | ||
|
|
2dbb13022d |
26
.github/workflows/check-prelude.yml
vendored
26
.github/workflows/check-prelude.yml
vendored
@@ -1,26 +0,0 @@
|
||||
name: Check for modules that should use `prelude`
|
||||
|
||||
on: [pull_request]
|
||||
|
||||
jobs:
|
||||
check-prelude:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
# the default is to use a virtual merge commit between the PR and master: just use the PR
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
sparse-checkout: src/Lean
|
||||
- name: Check Prelude
|
||||
run: |
|
||||
failed_files=""
|
||||
while IFS= read -r -d '' file; do
|
||||
if ! grep -q "^prelude$" "$file"; then
|
||||
failed_files="$failed_files$file\n"
|
||||
fi
|
||||
done < <(find src/Lean -name '*.lean' -print0)
|
||||
if [ -n "$failed_files" ]; then
|
||||
echo -e "The following files should use 'prelude':\n$failed_files"
|
||||
exit 1
|
||||
fi
|
||||
31
.github/workflows/ci.yml
vendored
31
.github/workflows/ci.yml
vendored
@@ -410,8 +410,7 @@ jobs:
|
||||
run: |
|
||||
cd build
|
||||
ulimit -c unlimited # coredumps
|
||||
# clean rebuild in case of Makefile changes
|
||||
make update-stage0 && rm -rf ./stage* && make -j4
|
||||
make update-stage0 && make -j4
|
||||
if: matrix.name == 'Linux' && needs.configure.outputs.quick == 'false'
|
||||
- name: CCache stats
|
||||
run: ccache -s
|
||||
@@ -422,21 +421,19 @@ jobs:
|
||||
progbin="$(file $c | sed "s/.*execfn: '\([^']*\)'.*/\1/")"
|
||||
echo bt | $GDB/bin/gdb -q $progbin $c || true
|
||||
done
|
||||
# has not been used in a long while, would need to be adapted to new
|
||||
# shared libs
|
||||
#- name: Upload coredumps
|
||||
# uses: actions/upload-artifact@v3
|
||||
# if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
|
||||
# with:
|
||||
# name: coredumps-${{ matrix.name }}
|
||||
# path: |
|
||||
# ./coredumps
|
||||
# ./build/stage0/bin/lean
|
||||
# ./build/stage0/lib/lean/libleanshared.so
|
||||
# ./build/stage1/bin/lean
|
||||
# ./build/stage1/lib/lean/libleanshared.so
|
||||
# ./build/stage2/bin/lean
|
||||
# ./build/stage2/lib/lean/libleanshared.so
|
||||
- name: Upload coredumps
|
||||
uses: actions/upload-artifact@v3
|
||||
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
|
||||
with:
|
||||
name: coredumps-${{ matrix.name }}
|
||||
path: |
|
||||
./coredumps
|
||||
./build/stage0/bin/lean
|
||||
./build/stage0/lib/lean/libleanshared.so
|
||||
./build/stage1/bin/lean
|
||||
./build/stage1/lib/lean/libleanshared.so
|
||||
./build/stage2/bin/lean
|
||||
./build/stage2/lib/lean/libleanshared.so
|
||||
|
||||
# This job collects results from all the matrix jobs
|
||||
# This can be made the “required” job, instead of listing each
|
||||
|
||||
233
RELEASES.md
233
RELEASES.md
@@ -8,15 +8,9 @@ This file contains work-in-progress notes for the upcoming release, as well as p
|
||||
Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
|
||||
of each version.
|
||||
|
||||
v4.7.0
|
||||
v4.7.0 (development in progress)
|
||||
---------
|
||||
|
||||
* `simp` and `rw` now use instance arguments found by unification,
|
||||
rather than always resynthesizing. For backwards compatibility, the original behaviour is
|
||||
available via `set_option tactic.skipAssignedInstances false`.
|
||||
[#3507](https://github.com/leanprover/lean4/pull/3507) and
|
||||
[#3509](https://github.com/leanprover/lean4/pull/3509).
|
||||
|
||||
* When the `pp.proofs` is false, now omitted proofs use `⋯` rather than `_`,
|
||||
which gives a more helpful error message when copied from the Infoview.
|
||||
The `pp.proofs.threshold` option lets small proofs always be pretty printed.
|
||||
@@ -24,10 +18,6 @@ v4.7.0
|
||||
|
||||
* `pp.proofs.withType` is now set to false by default to reduce noise in the info view.
|
||||
|
||||
* The pretty printer for applications now handles the case of over-application itself when applying app unexpanders.
|
||||
In particular, the ``| `($_ $a $b $xs*) => `(($a + $b) $xs*)`` case of an `app_unexpander` is no longer necessary.
|
||||
[#3495](https://github.com/leanprover/lean4/pull/3495).
|
||||
|
||||
* New `simp` (and `dsimp`) configuration option: `zetaDelta`. It is `false` by default.
|
||||
The `zeta` option is still `true` by default, but their meaning has changed.
|
||||
- When `zeta := true`, `simp` and `dsimp` reduce terms of the form
|
||||
@@ -36,7 +26,7 @@ v4.7.0
|
||||
the context. For example, suppose the context contains `x := val`. Then,
|
||||
any occurrence of `x` is replaced with `val`.
|
||||
|
||||
See [issue #2682](https://github.com/leanprover/lean4/pull/2682) for additional details. Here are some examples:
|
||||
See issue [#2682](https://github.com/leanprover/lean4/pull/2682) for additional details. Here are some examples:
|
||||
```
|
||||
example (h : z = 9) : let x := 5; let y := 4; x + y = z := by
|
||||
intro x
|
||||
@@ -77,7 +67,7 @@ v4.7.0
|
||||
```
|
||||
|
||||
* When adding new local theorems to `simp`, the system assumes that the function application arguments
|
||||
have been annotated with `no_index`. This modification, which addresses [issue #2670](https://github.com/leanprover/lean4/issues/2670),
|
||||
have been annotated with `no_index`. This modification, which addresses issue [#2670](https://github.com/leanprover/lean4/issues/2670),
|
||||
restores the Lean 3 behavior that users expect. With this modification, the following examples are now operational:
|
||||
```
|
||||
example {α β : Type} {f : α × β → β → β} (h : ∀ p : α × β, f p p.2 = p.2)
|
||||
@@ -91,175 +81,76 @@ v4.7.0
|
||||
In both cases, `h` is applicable because `simp` does not index f-arguments anymore when adding `h` to the `simp`-set.
|
||||
It's important to note, however, that global theorems continue to be indexed in the usual manner.
|
||||
|
||||
* Improved the error messages produced by the `decide` tactic. [#3422](https://github.com/leanprover/lean4/pull/3422)
|
||||
|
||||
* Improved auto-completion performance. [#3460](https://github.com/leanprover/lean4/pull/3460)
|
||||
|
||||
* Improved initial language server startup performance. [#3552](https://github.com/leanprover/lean4/pull/3552)
|
||||
|
||||
* Changed call hierarchy to sort entries and strip private header from names displayed in the call hierarchy. [#3482](https://github.com/leanprover/lean4/pull/3482)
|
||||
|
||||
* There is now a low-level error recovery combinator in the parsing framework, primarily intended for DSLs. [#3413](https://github.com/leanprover/lean4/pull/3413)
|
||||
|
||||
* You can now write `termination_by?` after a declaration to see the automatically inferred
|
||||
termination argument, and turn it into a `termination_by …` clause using the “Try this” widget or a code action. [#3514](https://github.com/leanprover/lean4/pull/3514)
|
||||
|
||||
* A large fraction of `Std` has been moved into the Lean repository.
|
||||
This was motivated by:
|
||||
1. Making universally useful tactics such as `ext`, `by_cases`, `change at`,
|
||||
`norm_cast`, `rcases`, `simpa`, `simp?`, `omega`, and `exact?`
|
||||
available to all users of Lean, without imports.
|
||||
2. Minimizing the syntactic changes between plain Lean and Lean with `import Std`.
|
||||
3. Simplifying the development process for the basic data types
|
||||
`Nat`, `Int`, `Fin` (and variants such as `UInt64`), `List`, `Array`,
|
||||
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`)
|
||||
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.
|
||||
|
||||
* The `/` and `%` notations in `Int` now use `Int.ediv` and `Int.emod`
|
||||
(i.e. the rounding conventions have changed).
|
||||
Previously `Std` overrode these notations, so this is no change for users of `Std`.
|
||||
There is now kernel support for these functions.
|
||||
[#3376](https://github.com/leanprover/lean4/pull/3376).
|
||||
|
||||
* `omega`, our integer linear arithmetic tactic, is now available in the core langauge.
|
||||
* 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).
|
||||
* `omega` now has support for `Fin` [#3427](https://github.com/leanprover/lean4/pull/3427),
|
||||
the `<<<` operator [#3433](https://github.com/leanprover/lean4/pull/3433).
|
||||
* During the port `omega` was modified to no longer identify atoms up to definitional equality
|
||||
(so in particular it can no longer prove `id x ≤ x`). [#3525](https://github.com/leanprover/lean4/pull/3525).
|
||||
This may cause some regressions.
|
||||
We plan to provide a general purpose preprocessing tactic later, or an `omega!` mode.
|
||||
* `omega` is now invoked in Lean's automation for termination proofs
|
||||
[#3503](https://github.com/leanprover/lean4/pull/3503) as well as in
|
||||
array indexing proofs [#3515](https://github.com/leanprover/lean4/pull/3515).
|
||||
This automation will be substantially revised in the medium term,
|
||||
and while `omega` does help automate some proofs, we plan to make this much more robust.
|
||||
|
||||
* The library search tactics `exact?` and `apply?` that were originally in
|
||||
Mathlib are now available in Lean itself. These use the implementation using
|
||||
lazy discrimination trees from `Std`, and thus do not require a disk cache but
|
||||
have a slightly longer startup time. The order used for selection lemmas has
|
||||
changed as well to favor goals purely based on how many terms in the head
|
||||
pattern match the current goal.
|
||||
|
||||
* The `solve_by_elim` tactic has been ported from `Std` to Lean so that library
|
||||
search can use it.
|
||||
|
||||
* New `#check_tactic` and `#check_simp` commands have been added. These are
|
||||
useful for checking tactics (particularly `simp`) behave as expected in test
|
||||
suites.
|
||||
|
||||
* Previously, app unexpanders would only be applied to entire applications. However, some notations produce
|
||||
functions, and these functions can be given additional arguments. The solution so far has been to write app unexpanders so that they can take an arbitrary number of additional arguments. However this leads to misleading hover information in the Infoview. For example, while `HAdd.hAdd f g 1` pretty prints as `(f + g) 1`, hovering over `f + g` shows `f`. There is no way to fix the situation from within an app unexpander; the expression position for `HAdd.hAdd f g` is absent, and app unexpanders cannot register TermInfo.
|
||||
|
||||
This commit changes the app delaborator to try running app unexpanders on every prefix of an application, from longest to shortest prefix. For efficiency, it is careful to only try this when app delaborators do in fact exist for the head constant, and it also ensures arguments are only delaborated once. Then, in `(f + g) 1`, the `f + g` gets TermInfo registered for that subexpression, making it properly hoverable.
|
||||
|
||||
[#3375](https://github.com/leanprover/lean4/pull/3375)
|
||||
|
||||
Breaking changes:
|
||||
* `Lean.withTraceNode` and variants got a stronger `MonadAlwaysExcept` assumption to
|
||||
fix trace trees not being built on elaboration runtime exceptions. Instances for most elaboration
|
||||
monads built on `EIO Exception` should be synthesized automatically.
|
||||
* The `match ... with.` and `fun.` notations previously in Std have been replaced by
|
||||
`nomatch ...` and `nofun`. [#3279](https://github.com/leanprover/lean4/pull/3279) and [#3286](https://github.com/leanprover/lean4/pull/3286)
|
||||
|
||||
|
||||
Other improvements:
|
||||
* Several bug fixes for `simp`:
|
||||
* we should not crash when `simp` loops [#3269](https://github.com/leanprover/lean4/pull/3269)
|
||||
* `simp` gets stuck on `autoParam` [#3315](https://github.com/leanprover/lean4/pull/3315)
|
||||
* `simp` fails when custom discharger makes no progress [#3317](https://github.com/leanprover/lean4/pull/3317)
|
||||
* `simp` fails to discharge `autoParam` premises even when it can reduce them to `True` [#3314](https://github.com/leanprover/lean4/pull/3314)
|
||||
* `simp?` suggests generated equations lemma names, fixes [#3547](https://github.com/leanprover/lean4/pull/3547) [#3573](https://github.com/leanprover/lean4/pull/3573)
|
||||
* Fixes for `match` expressions:
|
||||
* fix regression with builtin literals [#3521](https://github.com/leanprover/lean4/pull/3521)
|
||||
* accept `match` when patterns cover all cases of a `BitVec` finite type [#3538](https://github.com/leanprover/lean4/pull/3538)
|
||||
* fix matching `Int` literals [#3504](https://github.com/leanprover/lean4/pull/3504)
|
||||
* patterns containing int values and constructors [#3496](https://github.com/leanprover/lean4/pull/3496)
|
||||
* Improve `termination_by` error messages [#3255](https://github.com/leanprover/lean4/pull/3255)
|
||||
* Fix `rename_i` in macros, fixes [#3553](https://github.com/leanprover/lean4/pull/3553) [#3581](https://github.com/leanprover/lean4/pull/3581)
|
||||
* Fix excessive resource usage in `generalize`, fixes [#3524](https://github.com/leanprover/lean4/pull/3524) [#3575](https://github.com/leanprover/lean4/pull/3575)
|
||||
* An equation lemma with autoParam arguments fails to rewrite, fixing [#2243](https://github.com/leanprover/lean4/pull/2243) [#3316](https://github.com/leanprover/lean4/pull/3316)
|
||||
* `add_decl_doc` should check that declarations are local [#3311](https://github.com/leanprover/lean4/pull/3311)
|
||||
* Instantiate the types of inductives with the right parameters, closing [#3242](https://github.com/leanprover/lean4/pull/3242) [#3246](https://github.com/leanprover/lean4/pull/3246)
|
||||
* New simprocs for many basic types. [#3407](https://github.com/leanprover/lean4/pull/3407)
|
||||
|
||||
Lake fixes:
|
||||
* Warn on fetch cloud release failure [#3401](https://github.com/leanprover/lean4/pull/3401)
|
||||
* Cloud release trace & `lake build :release` errors [#3248](https://github.com/leanprover/lean4/pull/3248)
|
||||
|
||||
v4.6.0
|
||||
---------
|
||||
|
||||
* Add custom simplification procedures (aka `simproc`s) to `simp`. Simprocs can be triggered by the simplifier on a specified term-pattern. Here is an small example:
|
||||
```lean
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat
|
||||
```lean
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat
|
||||
|
||||
def foo (x : Nat) : Nat :=
|
||||
x + 10
|
||||
def foo (x : Nat) : Nat :=
|
||||
x + 10
|
||||
|
||||
/--
|
||||
The `simproc` `reduceFoo` is invoked on terms that match the pattern `foo _`.
|
||||
-/
|
||||
simproc reduceFoo (foo _) :=
|
||||
/- A term of type `Expr → SimpM Step -/
|
||||
fun e => do
|
||||
/-
|
||||
The `Step` type has three constructors: `.done`, `.visit`, `.continue`.
|
||||
* The constructor `.done` instructs `simp` that the result does
|
||||
not need to be simplied 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`.
|
||||
`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`.
|
||||
-/
|
||||
/- `simp` uses matching modulo reducibility. So, we ensure the term is a `foo`-application. -/
|
||||
unless e.isAppOfArity ``foo 1 do
|
||||
return .continue
|
||||
/- `Nat.fromExpr?` tries to convert an expression into a `Nat` value -/
|
||||
let some n ← Nat.fromExpr? e.appArg!
|
||||
| return .continue
|
||||
return .done { expr := Lean.mkNatLit (n+10) }
|
||||
```
|
||||
We disable simprocs support by using the command `set_option simprocs false`. This command is particularly useful when porting files to v4.6.0.
|
||||
Simprocs can be scoped, manually added to `simp` commands, and suppressed using `-`. They are also supported by `simp?`. `simp only` does not execute any `simproc`. Here are some examples for the `simproc` defined above.
|
||||
```lean
|
||||
example : x + foo 2 = 12 + x := by
|
||||
set_option simprocs false in
|
||||
/- This `simp` command does not make progress since `simproc`s are disabled. -/
|
||||
fail_if_success simp
|
||||
simp_arith
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/- `simp only` must not use the default simproc set. -/
|
||||
fail_if_success simp only
|
||||
simp_arith
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/--
|
||||
The `simproc` `reduceFoo` is invoked on terms that match the pattern `foo _`.
|
||||
-/
|
||||
simproc reduceFoo (foo _) :=
|
||||
/- A term of type `Expr → SimpM Step -/
|
||||
fun e => do
|
||||
/-
|
||||
`simp only` does not use the default simproc set,
|
||||
but we can provide simprocs as arguments. -/
|
||||
simp only [reduceFoo]
|
||||
simp_arith
|
||||
The `Step` type has three constructors: `.done`, `.visit`, `.continue`.
|
||||
* The constructor `.done` instructs `simp` that the result does
|
||||
not need to be simplied further.
|
||||
* The constructor `.visit` instructs `simp` to visit the resulting expression.
|
||||
* The constructor `.continue` instructs `simp` to try other simplification procedures.
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/- We can use `-` to disable `simproc`s. -/
|
||||
fail_if_success simp [-reduceFoo]
|
||||
simp_arith
|
||||
```
|
||||
The command `register_simp_attr <id>` now creates a `simp` **and** a `simproc` set with the name `<id>`. The following command instructs Lean to insert the `reduceFoo` simplification procedure into the set `my_simp`. If no set is specified, Lean uses the default `simp` set.
|
||||
```lean
|
||||
simproc [my_simp] reduceFoo (foo _) := ...
|
||||
```
|
||||
All three constructors take a `Result`. The `.continue` contructor 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`.
|
||||
-/
|
||||
/- `simp` uses matching modulo reducibility. So, we ensure the term is a `foo`-application. -/
|
||||
unless e.isAppOfArity ``foo 1 do
|
||||
return .continue
|
||||
/- `Nat.fromExpr?` tries to convert an expression into a `Nat` value -/
|
||||
let some n ← Nat.fromExpr? e.appArg!
|
||||
| return .continue
|
||||
return .done { expr := Lean.mkNatLit (n+10) }
|
||||
```
|
||||
We disable simprocs support by using the command `set_option simprocs false`. This command is particularly useful when porting files to v4.6.0.
|
||||
Simprocs can be scoped, manually added to `simp` commands, and suppressed using `-`. They are also supported by `simp?`. `simp only` does not execute any `simproc`. Here are some examples for the `simproc` defined above.
|
||||
```lean
|
||||
example : x + foo 2 = 12 + x := by
|
||||
set_option simprocs false in
|
||||
/- This `simp` command does not make progress since `simproc`s are disabled. -/
|
||||
fail_if_success simp
|
||||
simp_arith
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/- `simp only` must not use the default simproc set. -/
|
||||
fail_if_success simp only
|
||||
simp_arith
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/-
|
||||
`simp only` does not use the default simproc set,
|
||||
but we can provide simprocs as arguments. -/
|
||||
simp only [reduceFoo]
|
||||
simp_arith
|
||||
|
||||
example : x + foo 2 = 12 + x := by
|
||||
/- We can use `-` to disable `simproc`s. -/
|
||||
fail_if_success simp [-reduceFoo]
|
||||
simp_arith
|
||||
```
|
||||
The command `register_simp_attr <id>` now creates a `simp` **and** a `simproc` set with the name `<id>`. The following command instructs Lean to insert the `reduceFoo` simplification procedure into the set `my_simp`. If no set is specified, Lean uses the default `simp` set.
|
||||
```lean
|
||||
simproc [my_simp] reduceFoo (foo _) := ...
|
||||
```
|
||||
|
||||
* The syntax of the `termination_by` and `decreasing_by` termination hints is overhauled:
|
||||
|
||||
@@ -398,7 +289,7 @@ v4.6.0
|
||||
and hence greatly reduces the reliance on costly structure eta reduction. This has a large impact on mathlib,
|
||||
reducing total CPU instructions by 3% and enabling impactful refactors like leanprover-community/mathlib4#8386
|
||||
which reduces the build time by almost 20%.
|
||||
See [PR #2478](https://github.com/leanprover/lean4/pull/2478) and [RFC #2451](https://github.com/leanprover/lean4/issues/2451).
|
||||
See PR [#2478](https://github.com/leanprover/lean4/pull/2478) and RFC [#2451](https://github.com/leanprover/lean4/issues/2451).
|
||||
|
||||
* Add pretty printer settings to omit deeply nested terms (`pp.deepTerms false` and `pp.deepTerms.threshold`) ([PR #3201](https://github.com/leanprover/lean4/pull/3201))
|
||||
|
||||
@@ -417,7 +308,7 @@ Other improvements:
|
||||
* produce simpler proof terms in `rw` [#3121](https://github.com/leanprover/lean4/pull/3121)
|
||||
* fuse nested `mkCongrArg` calls in proofs generated by `simp` [#3203](https://github.com/leanprover/lean4/pull/3203)
|
||||
* `induction using` followed by a general term [#3188](https://github.com/leanprover/lean4/pull/3188)
|
||||
* allow generalization in `let` [#3060](https://github.com/leanprover/lean4/pull/3060), fixing [#3065](https://github.com/leanprover/lean4/issues/3065)
|
||||
* allow generalization in `let` [#3060](https://github.com/leanprover/lean4/pull/3060, fixing [#3065](https://github.com/leanprover/lean4/issues/3065)
|
||||
* reducing out-of-bounds `swap!` should return `a`, not `default`` [#3197](https://github.com/leanprover/lean4/pull/3197), fixing [#3196](https://github.com/leanprover/lean4/issues/3196)
|
||||
* derive `BEq` on structure with `Prop`-fields [#3191](https://github.com/leanprover/lean4/pull/3191), fixing [#3140](https://github.com/leanprover/lean4/issues/3140)
|
||||
* refine through more `casesOnApp`/`matcherApp` [#3176](https://github.com/leanprover/lean4/pull/3176), fixing [#3175](https://github.com/leanprover/lean4/pull/3175)
|
||||
|
||||
@@ -33,7 +33,7 @@ convert the pure non-monadic value `x / y` into the required `Except` object. S
|
||||
|
||||
Now this return typing would get tedious if you had to include it everywhere that you call this
|
||||
function, however, Lean type inference can clean this up. For example, you can define a test
|
||||
function that calls the `divide` function and you don't need to say anything here about the fact that
|
||||
function can calls the `divide` function and you don't need to say anything here about the fact that
|
||||
it might throw an error, because that is inferred:
|
||||
-/
|
||||
def test := divide 5 0
|
||||
|
||||
@@ -65,7 +65,12 @@ rec {
|
||||
installPhase = ''
|
||||
mkdir -p $out/bin $out/lib/lean
|
||||
mv bin/lean $out/bin/
|
||||
mv lib/lean/*.so $out/lib/lean
|
||||
mv lib/lean/libleanshared.* $out/lib/lean
|
||||
'' + lib.optionalString stdenv.isDarwin ''
|
||||
for lib in $(otool -L $out/bin/lean | tail -n +2 | cut -d' ' -f1); do
|
||||
if [[ "$lib" == *lean* ]]; then install_name_tool -change "$lib" "$out/lib/lean/$(basename $lib)" $out/bin/lean; fi
|
||||
done
|
||||
otool -L $out/bin/lean
|
||||
'';
|
||||
meta.mainProgram = "lean";
|
||||
});
|
||||
@@ -115,35 +120,29 @@ rec {
|
||||
iTree = symlinkJoin { name = "ileans"; paths = map (l: l.iTree) stdlib; };
|
||||
Leanc = build { name = "Leanc"; src = lean-bin-tools-unwrapped.leanc_src; deps = stdlib; roots = [ "Leanc" ]; };
|
||||
stdlibLinkFlags = "-L${Init.staticLib} -L${Lean.staticLib} -L${Lake.staticLib} -L${leancpp}/lib/lean";
|
||||
libInit_shared = runCommand "libInit_shared" { buildInputs = [ stdenv.cc ]; libName = "libInit_shared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
|
||||
mkdir $out
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared -Wl,-Bsymbolic \
|
||||
-Wl,--whole-archive -lInit ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++ -lm ${stdlibLinkFlags} \
|
||||
$(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
|
||||
-o $out/$libName
|
||||
'';
|
||||
leanshared = runCommand "leanshared" { buildInputs = [ stdenv.cc ]; libName = "libleanshared${stdenv.hostPlatform.extensions.sharedLibrary}"; } ''
|
||||
mkdir $out
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared -Wl,-Bsymbolic \
|
||||
${libInit_shared}/* -Wl,--whole-archive -lLean -lleancpp -Wl,--no-whole-archive -lstdc++ -lm ${stdlibLinkFlags} \
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${lean-bin-tools-unwrapped}/bin/leanc -shared ${lib.optionalString stdenv.isLinux "-Wl,-Bsymbolic"} \
|
||||
${if stdenv.isDarwin then "-Wl,-force_load,${Init.staticLib}/libInit.a -Wl,-force_load,${Lean.staticLib}/libLean.a -Wl,-force_load,${leancpp}/lib/lean/libleancpp.a ${leancpp}/lib/libleanrt_initial-exec.a -lc++"
|
||||
else "-Wl,--whole-archive -lInit -lLean -lleancpp ${leancpp}/lib/libleanrt_initial-exec.a -Wl,--no-whole-archive -lstdc++"} -lm ${stdlibLinkFlags} \
|
||||
$(${llvmPackages.libllvm.dev}/bin/llvm-config --ldflags --libs) \
|
||||
-o $out/$libName
|
||||
'';
|
||||
mods = foldl' (mods: pkg: mods // pkg.mods) {} stdlib;
|
||||
print-paths = Lean.makePrintPathsFor [] mods;
|
||||
leanc = writeShellScriptBin "leanc" ''
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${libInit_shared} -L${leanshared} "$@"
|
||||
LEAN_CC=${stdenv.cc}/bin/cc ${Leanc.executable}/bin/leanc -I${lean-bin-tools-unwrapped}/include ${stdlibLinkFlags} -L${leanshared} "$@"
|
||||
'';
|
||||
lean = runCommand "lean" { buildInputs = lib.optional stdenv.isDarwin darwin.cctools; } ''
|
||||
mkdir -p $out/bin
|
||||
${leanc}/bin/leanc ${leancpp}/lib/lean.cpp.o ${libInit_shared}/* ${leanshared}/* -o $out/bin/lean
|
||||
${leanc}/bin/leanc ${leancpp}/lib/lean.cpp.o ${leanshared}/* -o $out/bin/lean
|
||||
'';
|
||||
# derivation following the directory layout of the "basic" setup, mostly useful for running tests
|
||||
lean-all = stdenv.mkDerivation {
|
||||
name = "lean-${desc}";
|
||||
buildCommand = ''
|
||||
mkdir -p $out/bin $out/lib/lean
|
||||
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${libInit_shared}/* ${leanshared}/* $out/lib/lean/
|
||||
ln -sf ${leancpp}/lib/lean/* ${lib.concatMapStringsSep " " (l: "${l.modRoot}/* ${l.staticLib}/*") (lib.reverseList stdlib)} ${leanshared}/* $out/lib/lean/
|
||||
# put everything in a single final derivation so `IO.appDir` references work
|
||||
cp ${lean}/bin/lean ${leanc}/bin/leanc ${Lake-Main.executable}/bin/lake $out/bin
|
||||
# NOTE: `lndir` will not override existing `bin/leanc`
|
||||
|
||||
@@ -10,7 +10,7 @@ lib.makeOverridable (
|
||||
staticLibDeps ? [],
|
||||
# Whether to wrap static library inputs in a -Wl,--start-group [...] -Wl,--end-group to ensure dependencies are resolved.
|
||||
groupStaticLibs ? false,
|
||||
# Shared library dependencies included at interpretation with --load-dynlib and linked to. Each derivation `shared` should contain a
|
||||
# Shared library dependencies included at interpretation with --load-dynlib and linked to. Each derivation `shared` should contain a
|
||||
# shared library at the path `${shared}/${shared.libName or shared.name}` and a name to link to like `-l${shared.linkName or shared.name}`.
|
||||
# These libs are also linked to in packages that depend on this one.
|
||||
nativeSharedLibs ? [],
|
||||
@@ -88,9 +88,9 @@ with builtins; let
|
||||
allNativeSharedLibs =
|
||||
lib.unique (lib.flatten (nativeSharedLibs ++ (map (dep: dep.allNativeSharedLibs or []) allExternalDeps)));
|
||||
|
||||
# A flattened list of all static library dependencies: this and every dep module's explicitly provided `staticLibDeps`,
|
||||
# A flattened list of all static library dependencies: this and every dep module's explicitly provided `staticLibDeps`,
|
||||
# plus every dep module itself: `dep.staticLib`
|
||||
allStaticLibDeps =
|
||||
allStaticLibDeps =
|
||||
lib.unique (lib.flatten (staticLibDeps ++ (map (dep: [dep.staticLib] ++ dep.staticLibDeps or []) allExternalDeps)));
|
||||
|
||||
pathOfSharedLib = dep: dep.libPath or "${dep}/${dep.libName or dep.name}";
|
||||
@@ -249,7 +249,7 @@ in rec {
|
||||
${if stdenv.isDarwin then "-Wl,-force_load,${staticLib}/lib${libName}.a" else "-Wl,--whole-archive ${staticLib}/lib${libName}.a -Wl,--no-whole-archive"} \
|
||||
${lib.concatStringsSep " " (map (d: "${d.sharedLib}/*") deps)}'';
|
||||
executable = lib.makeOverridable ({ withSharedStdlib ? true }: let
|
||||
objPaths = map (drv: "${drv}/${drv.oPath}") (attrValues objects) ++ lib.optional withSharedStdlib "${lean-final.libInit_shared}/* ${lean-final.leanshared}/*";
|
||||
objPaths = map (drv: "${drv}/${drv.oPath}") (attrValues objects) ++ lib.optional withSharedStdlib "${lean-final.leanshared}/*";
|
||||
in runCommand executableName { buildInputs = [ stdenv.cc leanc ]; } ''
|
||||
mkdir -p $out/bin
|
||||
leanc ${staticLibLinkWrapper (lib.concatStringsSep " " (objPaths ++ map (d: "${d}/*.a") allStaticLibDeps))} \
|
||||
|
||||
@@ -25,8 +25,6 @@ cp -L llvm/bin/llvm-ar stage1/bin/
|
||||
# dependencies of the above
|
||||
$CP llvm/lib/lib{clang-cpp,LLVM}*.so* stage1/lib/
|
||||
$CP $ZLIB/lib/libz.so* stage1/lib/
|
||||
# general clang++ dependency, breaks cross-library C++ exceptions if linked statically
|
||||
$CP $GCC_LIB/lib/libgcc_s.so* stage1/lib/
|
||||
# bundle libatomic (referenced by LLVM >= 15, and required by the lean executable to run)
|
||||
$CP $GCC_LIB/lib/libatomic.so* stage1/lib/
|
||||
|
||||
@@ -62,7 +60,7 @@ fi
|
||||
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
|
||||
# but do not change sysroot so users can still link against system libs
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -static-libgcc -Wl,-Bstatic -lgmp -lunwind -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP dynamically/as usual
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -Wl,--no-as-needed'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
|
||||
@@ -11,7 +11,7 @@ project(LEAN CXX C)
|
||||
set(LEAN_VERSION_MAJOR 4)
|
||||
set(LEAN_VERSION_MINOR 7)
|
||||
set(LEAN_VERSION_PATCH 0)
|
||||
set(LEAN_VERSION_IS_RELEASE 1) # This number is 1 in the release revision, and 0 otherwise.
|
||||
set(LEAN_VERSION_IS_RELEASE 0) # This number is 1 in the release revision, and 0 otherwise.
|
||||
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
|
||||
set(LEAN_VERSION_STRING "${LEAN_VERSION_MAJOR}.${LEAN_VERSION_MINOR}.${LEAN_VERSION_PATCH}")
|
||||
if (LEAN_SPECIAL_VERSION_DESC)
|
||||
@@ -299,12 +299,13 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
cmake_path(GET ZLIB_LIBRARY PARENT_PATH ZLIB_LIBRARY_PARENT_PATH)
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -L ${ZLIB_LIBRARY_PARENT_PATH}")
|
||||
endif()
|
||||
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lleanrt")
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lleanrt")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lnodefs.js -lleanrt")
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lleancpp -lInit -lLean -lnodefs.js -lleanrt")
|
||||
else()
|
||||
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -Wl,--start-group -lleancpp -lLean -Wl,--end-group -Wl,--start-group -lInit -lleanrt -Wl,--end-group")
|
||||
endif()
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " -lLake")
|
||||
|
||||
set(LEAN_CXX_STDLIB "-lstdc++" CACHE STRING "C++ stdlib linker flags")
|
||||
|
||||
@@ -312,11 +313,8 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
set(LEAN_CXX_STDLIB "-lc++")
|
||||
endif()
|
||||
|
||||
string(APPEND TOOLCHAIN_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
|
||||
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
|
||||
|
||||
# flags for user binaries = flags for toolchain binaries + Lake
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " ${TOOLCHAIN_STATIC_LINKER_FLAGS} -lLake")
|
||||
string(APPEND LEANC_STATIC_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " ${LEAN_CXX_STDLIB}")
|
||||
|
||||
if (LLVM)
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -L${LLVM_CONFIG_LIBDIR} ${LLVM_CONFIG_LDFLAGS} ${LLVM_CONFIG_LIBS} ${LLVM_CONFIG_SYSTEM_LIBS}")
|
||||
@@ -344,9 +342,9 @@ endif()
|
||||
|
||||
# get rid of unused parts of C++ stdlib
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-dead_strip")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-dead_strip")
|
||||
elseif(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,--gc-sections")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,--gc-sections")
|
||||
endif()
|
||||
|
||||
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
@@ -356,20 +354,26 @@ endif()
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
|
||||
if(BSYMBOLIC)
|
||||
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
|
||||
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-Bsymbolic")
|
||||
endif()
|
||||
string(APPEND CMAKE_CXX_FLAGS " -fPIC -ftls-model=initial-exec")
|
||||
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
|
||||
string(APPEND TOOLCHAIN_SHARED_LINKER_FLAGS " -Wl,-rpath=\\$$ORIGIN/..:\\$$ORIGIN")
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath=\\\$ORIGIN/../lib:\\\$ORIGIN/../lib/lean")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,-rpath=\\$$ORIGIN/..:\\$$ORIGIN")
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared -Wl,-rpath=\\\$ORIGIN/../lib:\\\$ORIGIN/../lib/lean")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
string(APPEND CMAKE_CXX_FLAGS " -ftls-model=initial-exec")
|
||||
string(APPEND INIT_SHARED_LINKER_FLAGS " -install_name @rpath/libInit_shared.dylib")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -install_name @rpath/libleanshared.dylib")
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared -Wl,-rpath,@executable_path/../lib -Wl,-rpath,@executable_path/../lib/lean")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
string(APPEND CMAKE_CXX_FLAGS " -fPIC")
|
||||
string(APPEND LEANC_EXTRA_FLAGS " -fPIC")
|
||||
# We do not use dynamic linking via leanshared for Emscripten to keep things
|
||||
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
|
||||
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
|
||||
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -Wl,--whole-archive -lInit -lLean -lleancpp -lleanrt ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lleanshared")
|
||||
endif()
|
||||
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
|
||||
@@ -395,7 +399,7 @@ endif()
|
||||
# are already loaded) and probably fail unless we set up LD_LIBRARY_PATH.
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
|
||||
# import library created by the `leanshared` target
|
||||
string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared")
|
||||
string(APPEND LEANC_SHARED_LINKER_FLAGS " -lleanshared")
|
||||
elseif("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin")
|
||||
string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup")
|
||||
endif()
|
||||
@@ -501,25 +505,13 @@ string(REGEX REPLACE "^([a-zA-Z]):" "/\\1" LEAN_BIN "${CMAKE_BINARY_DIR}/bin")
|
||||
# (also looks nicer in the build log)
|
||||
file(RELATIVE_PATH LIB ${LEAN_SOURCE_DIR} ${CMAKE_BINARY_DIR}/lib)
|
||||
|
||||
# set up libInit_shared only on Windows; see also stdlib.make.in
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
|
||||
set(INIT_SHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a -Wl,--no-whole-archive -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libInit_shared.dll.a")
|
||||
endif()
|
||||
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Darwin")
|
||||
set(LEANSHARED_LINKER_FLAGS "-Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libInit.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libLean.a -Wl,-force_load,${CMAKE_BINARY_DIR}/lib/lean/libleancpp.a ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
|
||||
elseif(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
|
||||
set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive -lLean -lleancpp -Wl,--no-whole-archive -lInit_shared -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
|
||||
else()
|
||||
set(LEANSHARED_LINKER_FLAGS "-Wl,--whole-archive -lInit -lLean -lleancpp -Wl,--no-whole-archive ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS}")
|
||||
endif()
|
||||
|
||||
if (${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
# We do not use dynamic linking via leanshared for Emscripten to keep things
|
||||
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
|
||||
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
|
||||
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
|
||||
string(APPEND LEAN_EXE_LINKER_FLAGS " ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,--out-implib,${CMAKE_BINARY_DIR}/lib/lean/libleanshared.dll.a")
|
||||
endif()
|
||||
endif()
|
||||
|
||||
# Build the compiler using the bootstrapped C sources for stage0, and use
|
||||
@@ -528,6 +520,10 @@ if (LLVM AND ${STAGE} GREATER 0)
|
||||
set(EXTRA_LEANMAKE_OPTS "LLVM=1")
|
||||
endif()
|
||||
|
||||
# Escape for `make`. Yes, twice.
|
||||
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE "${CMAKE_EXE_LINKER_FLAGS}")
|
||||
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE_MAKE "${CMAKE_EXE_LINKER_FLAGS_MAKE}")
|
||||
configure_file(${LEAN_SOURCE_DIR}/stdlib.make.in ${CMAKE_BINARY_DIR}/stdlib.make)
|
||||
add_custom_target(make_stdlib ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
# The actual rule is in a separate makefile because we want to prefix it with '+' to use the Make job server
|
||||
@@ -545,33 +541,13 @@ endif()
|
||||
# We declare these as separate custom targets so they use separate `make` invocations, which makes `make` recompute which dependencies
|
||||
# (e.g. `libLean.a`) are now newer than the target file
|
||||
|
||||
if(${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
# dummy targets, see `MAIN_MODULE` discussion above
|
||||
add_custom_target(Init_shared ALL
|
||||
DEPENDS make_stdlib leanrt_initial-exec
|
||||
COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libInit_shared${CMAKE_SHARED_LIBRARY_SUFFIX}
|
||||
)
|
||||
add_custom_target(leanshared ALL
|
||||
DEPENDS Init_shared leancpp
|
||||
COMMAND touch ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/libleanshared${CMAKE_SHARED_LIBRARY_SUFFIX}
|
||||
)
|
||||
else()
|
||||
add_custom_target(Init_shared ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS make_stdlib leanrt_initial-exec
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Init_shared
|
||||
VERBATIM)
|
||||
add_custom_target(leanshared ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS make_stdlib leancpp leanrt_initial-exec
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanshared
|
||||
VERBATIM)
|
||||
|
||||
add_custom_target(leanshared ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS Init_shared leancpp
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanshared
|
||||
VERBATIM)
|
||||
|
||||
string(APPEND CMAKE_EXE_LINKER_FLAGS " -lInit_shared -lleanshared")
|
||||
endif()
|
||||
|
||||
if(${STAGE} GREATER 0 AND NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
if(${STAGE} GREATER 0)
|
||||
if(NOT EXISTS ${LEAN_SOURCE_DIR}/lake/Lake.lean)
|
||||
message(FATAL_ERROR "src/lake does not exist. Please check out the Lake submodule using `git submodule update --init src/lake`.")
|
||||
endif()
|
||||
@@ -592,7 +568,7 @@ endif()
|
||||
|
||||
# use Bash version for building, use Lean version in bin/ for tests & distribution
|
||||
configure_file("${LEAN_SOURCE_DIR}/bin/leanc.in" "${CMAKE_BINARY_DIR}/leanc.sh" @ONLY)
|
||||
if(${STAGE} GREATER 0 AND EXISTS ${LEAN_SOURCE_DIR}/Leanc.lean AND NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
if(${STAGE} GREATER 0 AND EXISTS ${LEAN_SOURCE_DIR}/Leanc.lean)
|
||||
configure_file("${LEAN_SOURCE_DIR}/Leanc.lean" "${CMAKE_BINARY_DIR}/leanc/Leanc.lean" @ONLY)
|
||||
add_custom_target(leanc ALL
|
||||
WORKING_DIRECTORY ${CMAKE_BINARY_DIR}/leanc
|
||||
@@ -643,8 +619,3 @@ if(LEAN_INSTALL_PREFIX)
|
||||
set(LEAN_INSTALL_SUFFIX "-${LOWER_SYSTEM_NAME}" CACHE STRING "If LEAN_INSTALL_PREFIX is set, append this value to CMAKE_INSTALL_PREFIX")
|
||||
set(CMAKE_INSTALL_PREFIX "${LEAN_INSTALL_PREFIX}/lean-${LEAN_VERSION_STRING}${LEAN_INSTALL_SUFFIX}")
|
||||
endif()
|
||||
|
||||
# Escape for `make`. Yes, twice.
|
||||
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE "${CMAKE_EXE_LINKER_FLAGS}")
|
||||
string(REPLACE "$" "$$" CMAKE_EXE_LINKER_FLAGS_MAKE_MAKE "${CMAKE_EXE_LINKER_FLAGS_MAKE}")
|
||||
configure_file(${LEAN_SOURCE_DIR}/stdlib.make.in ${CMAKE_BINARY_DIR}/stdlib.make)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Mario Carneiro
|
||||
-/
|
||||
|
||||
@@ -321,7 +321,7 @@ Helper definition used by the elaborator. It is not meant to be used directly by
|
||||
This is used for coercions between monads, in the case where we want to apply
|
||||
a monad lift and a coercion on the result type at the same time.
|
||||
-/
|
||||
@[coe_decl] abbrev Lean.Internal.liftCoeM {m : Type u → Type v} {n : Type u → Type w} {α β : Type u}
|
||||
@[inline, coe_decl] def Lean.Internal.liftCoeM {m : Type u → Type v} {n : Type u → Type w} {α β : Type u}
|
||||
[MonadLiftT m n] [∀ a, CoeT α a β] [Monad n] (x : m α) : n β := do
|
||||
let a ← liftM x
|
||||
pure (CoeT.coe a)
|
||||
@@ -331,7 +331,7 @@ Helper definition used by the elaborator. It is not meant to be used directly by
|
||||
|
||||
This is used for coercing the result type under a monad.
|
||||
-/
|
||||
@[coe_decl] abbrev Lean.Internal.coeM {m : Type u → Type v} {α β : Type u}
|
||||
@[inline, coe_decl] def Lean.Internal.coeM {m : Type u → Type v} {α β : Type u}
|
||||
[∀ a, CoeT α a β] [Monad m] (x : m α) : m β := do
|
||||
let a ← x
|
||||
pure (CoeT.coe a)
|
||||
|
||||
@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
|
||||
Notation for operators defined at Prelude.lean
|
||||
-/
|
||||
prelude
|
||||
import Init.Meta
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Lean.Parser.Tactic.Conv
|
||||
|
||||
|
||||
@@ -185,84 +185,3 @@ theorem anyM_stop_le_start [Monad m] (p : α → m Bool) (as : Array α) (start
|
||||
|
||||
theorem mem_def (a : α) (as : Array α) : a ∈ as ↔ a ∈ as.data :=
|
||||
⟨fun | .mk h => h, Array.Mem.mk⟩
|
||||
|
||||
/-- # get -/
|
||||
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
|
||||
|
||||
theorem getElem?_lt
|
||||
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some (a[i]) := dif_pos h
|
||||
|
||||
theorem getElem?_ge
|
||||
(a : Array α) {i : Nat} (h : i ≥ a.size) : a[i]? = none := dif_neg (Nat.not_lt_of_le h)
|
||||
|
||||
@[simp] theorem get?_eq_getElem? (a : Array α) (i : Nat) : a.get? i = a[i]? := rfl
|
||||
|
||||
theorem getElem?_len_le (a : Array α) {i : Nat} (h : a.size ≤ i) : a[i]? = none := by
|
||||
simp [getElem?_ge, h]
|
||||
|
||||
theorem getD_get? (a : Array α) (i : Nat) (d : α) :
|
||||
Option.getD a[i]? d = if p : i < a.size then a[i]'p else d := by
|
||||
if h : i < a.size then
|
||||
simp [setD, h, getElem?]
|
||||
else
|
||||
have p : i ≥ a.size := Nat.le_of_not_gt h
|
||||
simp [setD, getElem?_len_le _ p, h]
|
||||
|
||||
@[simp] theorem getD_eq_get? (a : Array α) (n d) : a.getD n d = (a[n]?).getD d := by
|
||||
simp only [getD, get_eq_getElem, get?_eq_getElem?]; split <;> simp [getD_get?, *]
|
||||
|
||||
theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl
|
||||
|
||||
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) : a.get! i = (a.get? i).getD default := by
|
||||
by_cases p : i < a.size <;> simp [getD_get?, get!_eq_getD, p]
|
||||
|
||||
/-- # set -/
|
||||
|
||||
@[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_data_get, ←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_data_get, List.get_set_ne _ h]
|
||||
|
||||
theorem getElem_set (a : Array α) (i : Fin a.size) (v : α) (j : Nat)
|
||||
(h : j < (a.set i v).size) :
|
||||
(a.set i v)[j]'h = if i = j then v else a[j]'(size_set a i v ▸ h) := by
|
||||
by_cases p : i.1 = j <;> simp [p]
|
||||
|
||||
@[simp] theorem getElem?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
|
||||
(a.set i v)[i.1]? = v := by simp [getElem?_lt, i.2]
|
||||
|
||||
@[simp] theorem getElem?_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α)
|
||||
(ne : i.val ≠ j) : (a.set i v)[j]? = a[j]? := by
|
||||
by_cases h : j < a.size <;> simp [getElem?_lt, getElem?_ge, Nat.ge_of_not_lt, ne, h]
|
||||
|
||||
/- # setD -/
|
||||
|
||||
@[simp] theorem set!_is_setD : @set! = @setD := rfl
|
||||
|
||||
@[simp] theorem size_setD (a : Array α) (index : Nat) (val : α) :
|
||||
(Array.setD a index val).size = a.size := by
|
||||
if h : index < a.size then
|
||||
simp [setD, h]
|
||||
else
|
||||
simp [setD, h]
|
||||
|
||||
@[simp] theorem getElem_setD_eq (a : Array α) {i : Nat} (v : α) (h : _) :
|
||||
(setD a i v)[i]'h = v := by
|
||||
simp at h
|
||||
simp only [setD, h, dite_true, getElem_set, ite_true]
|
||||
|
||||
@[simp]
|
||||
theorem getElem?_setD_eq (a : Array α) {i : Nat} (p : i < a.size) (v : α) : (a.setD i v)[i]? = some v := by
|
||||
simp [getElem?_lt, p]
|
||||
|
||||
/-- Simplifies a normal form from `get!` -/
|
||||
@[simp] theorem getD_get?_setD (a : Array α) (i : Nat) (v d : α) :
|
||||
Option.getD (setD a i v)[i]? d = if i < a.size then v else d := by
|
||||
by_cases h : i < a.size <;>
|
||||
simp [setD, Nat.not_lt_of_le, h, getD_get?]
|
||||
|
||||
end Array
|
||||
|
||||
@@ -8,6 +8,16 @@ import Init.Data.Array.Basic
|
||||
import Init.Data.Nat.Linear
|
||||
import Init.Data.List.BasicAux
|
||||
|
||||
theorem List.sizeOf_get_lt [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
|
||||
match as, i with
|
||||
| [], i => apply Fin.elim0 i
|
||||
| a::as, ⟨0, _⟩ => simp_arith [get]
|
||||
| a::as, ⟨i+1, h⟩ =>
|
||||
simp [get]
|
||||
have h : i < as.length := Nat.lt_of_succ_lt_succ h
|
||||
have ih := sizeOf_get_lt as ⟨i, h⟩
|
||||
exact Nat.lt_of_lt_of_le ih (Nat.le_add_left ..)
|
||||
|
||||
namespace Array
|
||||
|
||||
/-- `a ∈ as` is a predicate which asserts that `a` is in the array `as`. -/
|
||||
@@ -19,6 +29,10 @@ structure Mem (a : α) (as : Array α) : Prop where
|
||||
instance : Membership α (Array α) where
|
||||
mem a as := Mem a as
|
||||
|
||||
theorem sizeOf_get_lt [SizeOf α] (as : Array α) (i : Fin as.size) : sizeOf (as.get i) < sizeOf as := by
|
||||
cases as with | _ as =>
|
||||
exact Nat.lt_trans (List.sizeOf_get_lt as i) (by simp_arith)
|
||||
|
||||
theorem sizeOf_lt_of_mem [SizeOf α] {as : Array α} (h : a ∈ as) : sizeOf a < sizeOf as := by
|
||||
cases as with | _ as =>
|
||||
exact Nat.lt_trans (List.sizeOf_lt_of_mem h.val) (by simp_arith)
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2022 by the authors listed in the file AUTHORS and their
|
||||
institutional affiliations. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer
|
||||
-/
|
||||
@@ -8,6 +9,8 @@ import Init.Data.Fin.Basic
|
||||
import Init.Data.Nat.Bitwise.Lemmas
|
||||
import Init.Data.Nat.Power2
|
||||
|
||||
namespace Std
|
||||
|
||||
/-!
|
||||
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
|
||||
(Lean has special support for `Nat`), alignment with `UIntXY` types which are also represented
|
||||
@@ -33,8 +36,6 @@ structure BitVec (w : Nat) where
|
||||
O(1), because we use `Fin` as the internal representation of a bitvector. -/
|
||||
toFin : Fin (2^w)
|
||||
|
||||
@[deprecated] abbrev Std.BitVec := _root_.BitVec
|
||||
|
||||
-- We manually derive the `DecidableEq` instances for `BitVec` because
|
||||
-- we want to have builtin support for bit-vector literals, and we
|
||||
-- need a name for this function to implement `canUnfoldAtMatcher` at `WHNF.lean`.
|
||||
@@ -74,7 +75,7 @@ theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
|
||||
|
||||
/-- Theorem for normalizing the bit vector literal representation. -/
|
||||
-- TODO: This needs more usage data to assess which direction the simp should go.
|
||||
@[simp, bv_toNat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
|
||||
@[simp] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
|
||||
|
||||
-- Note. Mathlib would like this to go the other direction.
|
||||
@[simp] theorem natCast_eq_ofNat (w x : Nat) : @Nat.cast (BitVec w) _ x = .ofNat w x := rfl
|
||||
@@ -124,20 +125,13 @@ section Int
|
||||
|
||||
/-- Interpret the bitvector as an integer stored in two's complement form. -/
|
||||
protected def toInt (a : BitVec n) : Int :=
|
||||
if 2 * a.toNat < 2^n then
|
||||
a.toNat
|
||||
else
|
||||
(a.toNat : Int) - (2^n : Nat)
|
||||
if a.msb then Int.ofNat a.toNat - Int.ofNat (2^n) else a.toNat
|
||||
|
||||
/-- The `BitVec` with value `(2^n + (i mod 2^n)) mod 2^n`. -/
|
||||
protected def ofInt (n : Nat) (i : Int) : BitVec n := .ofNatLt (i % (Int.ofNat (2^n))).toNat (by
|
||||
apply (Int.toNat_lt _).mpr
|
||||
· apply Int.emod_lt_of_pos
|
||||
exact Int.ofNat_pos.mpr (Nat.two_pow_pos _)
|
||||
· apply Int.emod_nonneg
|
||||
intro eq
|
||||
apply Nat.ne_of_gt (Nat.two_pow_pos n)
|
||||
exact Int.ofNat_inj.mp eq)
|
||||
protected def ofInt (n : Nat) (i : Int) : BitVec n :=
|
||||
match i with
|
||||
| Int.ofNat x => .ofNat n x
|
||||
| Int.negSucc x => BitVec.ofNatLt (2^n - x % 2^n - 1) (by omega)
|
||||
|
||||
instance : IntCast (BitVec w) := ⟨BitVec.ofInt w⟩
|
||||
|
||||
@@ -173,7 +167,7 @@ protected def toHex {n : Nat} (x : BitVec n) : String :=
|
||||
let t := (List.replicate ((n+3) / 4 - s.length) '0').asString
|
||||
t ++ s
|
||||
|
||||
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
|
||||
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Format) ++ "#" ++ repr n
|
||||
instance : ToString (BitVec n) where toString a := toString (repr a)
|
||||
|
||||
end repr_toString
|
||||
@@ -613,5 +607,3 @@ section normalization_eqs
|
||||
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
|
||||
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
|
||||
end normalization_eqs
|
||||
|
||||
end BitVec
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2023 by the authors listed in the file AUTHORS and their
|
||||
institutional affiliations. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
|
||||
-/
|
||||
@@ -29,23 +30,9 @@ https://github.com/mhk119/lean-smt/blob/bitvec/Smt/Data/Bitwise.lean.
|
||||
|
||||
open Nat Bool
|
||||
|
||||
namespace Bool
|
||||
|
||||
/-- At least two out of three booleans are true. -/
|
||||
abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c
|
||||
|
||||
@[simp] theorem atLeastTwo_false_left : atLeastTwo false b c = (b && c) := by simp [atLeastTwo]
|
||||
@[simp] theorem atLeastTwo_false_mid : atLeastTwo a false c = (a && c) := by simp [atLeastTwo]
|
||||
@[simp] theorem atLeastTwo_false_right : atLeastTwo a b false = (a && b) := by simp [atLeastTwo]
|
||||
@[simp] theorem atLeastTwo_true_left : atLeastTwo true b c = (b || c) := by cases b <;> cases c <;> simp [atLeastTwo]
|
||||
@[simp] theorem atLeastTwo_true_mid : atLeastTwo a true c = (a || c) := by cases a <;> cases c <;> simp [atLeastTwo]
|
||||
@[simp] theorem atLeastTwo_true_right : atLeastTwo a b true = (a || b) := by cases a <;> cases b <;> simp [atLeastTwo]
|
||||
|
||||
end Bool
|
||||
|
||||
/-! ### Preliminaries -/
|
||||
|
||||
namespace BitVec
|
||||
namespace Std.BitVec
|
||||
|
||||
private theorem testBit_limit {x i : Nat} (x_lt_succ : x < 2^(i+1)) :
|
||||
testBit x i = decide (x ≥ 2^i) := by
|
||||
@@ -89,29 +76,18 @@ private theorem mod_two_pow_succ (x i : Nat) :
|
||||
have not_j_ge_i : ¬(j ≥ i) := Nat.not_le_of_lt j_lt_i
|
||||
simp [j_lt_i, j_le_i, not_j_ge_i, j_le_i_succ]
|
||||
|
||||
private theorem mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ
|
||||
(x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by
|
||||
have : c.toNat ≤ 1 := Bool.toNat_le c
|
||||
rw [Nat.pow_succ]
|
||||
omega
|
||||
private theorem mod_two_pow_lt (x i : Nat) : x % 2 ^ i < 2^i := Nat.mod_lt _ (Nat.two_pow_pos _)
|
||||
|
||||
/-! ### Addition -/
|
||||
|
||||
/-- carry i x y c returns true if the `i` carry bit is true when computing `x + y + c`. -/
|
||||
def carry (i : Nat) (x y : BitVec w) (c : Bool) : Bool :=
|
||||
decide (x.toNat % 2^i + y.toNat % 2^i + c.toNat ≥ 2^i)
|
||||
/-- carry w x y c returns true if the `w` carry bit is true when computing `x + y + c`. -/
|
||||
def carry (w x y : Nat) (c : Bool) : Bool := decide (x % 2^w + y % 2^w + c.toNat ≥ 2^w)
|
||||
|
||||
@[simp] theorem carry_zero : carry 0 x y c = c := by
|
||||
cases c <;> simp [carry, mod_one]
|
||||
|
||||
theorem carry_succ (i : Nat) (x y : BitVec w) (c : Bool) :
|
||||
carry (i+1) x y c = atLeastTwo (x.getLsb i) (y.getLsb i) (carry i x y c) := by
|
||||
simp only [carry, mod_two_pow_succ, atLeastTwo, getLsb]
|
||||
simp only [Nat.pow_succ']
|
||||
have sum_bnd : x.toNat%2^i + (y.toNat%2^i + c.toNat) < 2*2^i := by
|
||||
simp only [← Nat.pow_succ']
|
||||
exact mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ ..
|
||||
cases x.toNat.testBit i <;> cases y.toNat.testBit i <;> (simp; omega)
|
||||
/-- At least two out of three booleans are true. -/
|
||||
abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c
|
||||
|
||||
/-- Carry function for bitwise addition. -/
|
||||
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c))
|
||||
@@ -120,9 +96,25 @@ def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xo
|
||||
def adc (x y : BitVec w) : Bool → Bool × BitVec w :=
|
||||
iunfoldr fun (i : Fin w) c => adcb (x.getLsb i) (y.getLsb i) c
|
||||
|
||||
theorem adc_overflow_limit (x y i : Nat) (c : Bool) : x % 2^i + (y % 2^i + c.toNat) < 2^(i+1) := by
|
||||
have : c.toNat ≤ 1 := Bool.toNat_le_one c
|
||||
rw [Nat.pow_succ]
|
||||
omega
|
||||
|
||||
theorem carry_succ (w x y : Nat) (c : Bool) :
|
||||
carry (succ w) x y c = atLeastTwo (x.testBit w) (y.testBit w) (carry w x y c) := by
|
||||
simp only [carry, mod_two_pow_succ, atLeastTwo]
|
||||
simp only [Nat.pow_succ']
|
||||
generalize testBit x w = xh
|
||||
generalize testBit y w = yh
|
||||
have sum_bnd : x%2^w + (y%2^w + c.toNat) < 2*2^w := by
|
||||
simp only [← Nat.pow_succ']
|
||||
exact adc_overflow_limit x y w c
|
||||
cases xh <;> cases yh <;> (simp; omega)
|
||||
|
||||
theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
|
||||
getLsb (x + y + zeroExtend w (ofBool c)) i =
|
||||
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x y c)) := by
|
||||
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat c)) := by
|
||||
let ⟨x, x_lt⟩ := x
|
||||
let ⟨y, y_lt⟩ := y
|
||||
simp only [getLsb, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool,
|
||||
@@ -137,27 +129,33 @@ theorem getLsb_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool)
|
||||
Bool.true_and,
|
||||
Nat.add_assoc,
|
||||
Nat.add_left_comm (_%_) (_ * _) _,
|
||||
testBit_limit (mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ x y i c)
|
||||
testBit_limit (adc_overflow_limit x y i c)
|
||||
]
|
||||
simp [testBit_to_div_mod, carry, Nat.add_assoc]
|
||||
|
||||
theorem getLsb_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
|
||||
getLsb (x + y) i =
|
||||
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x y false)) := by
|
||||
Bool.xor (getLsb x i) (Bool.xor (getLsb y i) (carry i x.toNat y.toNat false)) := by
|
||||
simpa using getLsb_add_add_bool i_lt x y false
|
||||
|
||||
theorem adc_spec (x y : BitVec w) (c : Bool) :
|
||||
adc x y c = (carry w x y c, x + y + zeroExtend w (ofBool c)) := by
|
||||
adc x y c = (carry w x.toNat y.toNat c, x + y + zeroExtend w (ofBool c)) := by
|
||||
simp only [adc]
|
||||
apply iunfoldr_replace
|
||||
(fun i => carry i x y c)
|
||||
(fun i => carry i x.toNat y.toNat c)
|
||||
(x + y + zeroExtend w (ofBool c))
|
||||
c
|
||||
case init =>
|
||||
simp [carry, Nat.mod_one]
|
||||
cases c <;> rfl
|
||||
case step =>
|
||||
simp [adcb, Prod.mk.injEq, carry_succ, getLsb_add_add_bool]
|
||||
intro ⟨i, lt⟩
|
||||
simp only [adcb, Prod.mk.injEq, carry_succ]
|
||||
apply And.intro
|
||||
case left =>
|
||||
rw [testBit_toNat, testBit_toNat]
|
||||
case right =>
|
||||
simp [getLsb_add_add_bool lt]
|
||||
|
||||
theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := by
|
||||
simp [adc_spec]
|
||||
@@ -173,5 +171,3 @@ theorem add_eq_adc (w : Nat) (x y : BitVec w) : x + y = (adc x y false).snd := b
|
||||
/-- Subtracting `x` from the all ones bitvector is equivalent to taking its complement -/
|
||||
theorem allOnes_sub_eq_not (x : BitVec w) : allOnes w - x = ~~~x := by
|
||||
rw [← add_not_self x, BitVec.add_comm, add_sub_cancel]
|
||||
|
||||
end BitVec
|
||||
|
||||
@@ -8,7 +8,7 @@ import Init.Data.BitVec.Lemmas
|
||||
import Init.Data.Nat.Lemmas
|
||||
import Init.Data.Fin.Iterate
|
||||
|
||||
namespace BitVec
|
||||
namespace Std.BitVec
|
||||
|
||||
/--
|
||||
iunfoldr is an iterative operation that applies a function `f` repeatedly.
|
||||
@@ -57,5 +57,3 @@ theorem iunfoldr_replace
|
||||
(step : ∀(i : Fin w), f i (state i.val) = (state (i.val+1), value.getLsb i.val)) :
|
||||
iunfoldr f a = (state w, value) := by
|
||||
simp [iunfoldr.eq_test state value a init step]
|
||||
|
||||
end BitVec
|
||||
|
||||
@@ -9,7 +9,7 @@ import Init.Data.BitVec.Basic
|
||||
import Init.Data.Fin.Lemmas
|
||||
import Init.Data.Nat.Lemmas
|
||||
|
||||
namespace BitVec
|
||||
namespace Std.BitVec
|
||||
|
||||
/--
|
||||
This normalized a bitvec using `ofFin` to `ofNat`.
|
||||
@@ -23,12 +23,9 @@ theorem eq_of_toNat_eq {n} : ∀ {i j : BitVec n}, i.toNat = j.toNat → i = j
|
||||
|
||||
@[simp] theorem val_toFin (x : BitVec w) : x.toFin.val = x.toNat := rfl
|
||||
|
||||
@[bv_toNat] theorem toNat_eq (x y : BitVec n) : x = y ↔ x.toNat = y.toNat :=
|
||||
theorem toNat_eq (x y : BitVec n) : x = y ↔ x.toNat = y.toNat :=
|
||||
Iff.intro (congrArg BitVec.toNat) eq_of_toNat_eq
|
||||
|
||||
@[bv_toNat] theorem toNat_ne (x y : BitVec n) : x ≠ y ↔ x.toNat ≠ y.toNat := by
|
||||
rw [Ne, toNat_eq]
|
||||
|
||||
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.toFin.2
|
||||
|
||||
theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsb i := rfl
|
||||
@@ -81,8 +78,6 @@ theorem eq_of_getMsb_eq {x y : BitVec w}
|
||||
have q := pred ⟨w - 1 - i, q_lt⟩
|
||||
simpa [q_lt, Nat.sub_sub_self, r] using q
|
||||
|
||||
@[simp] theorem of_length_zero {x : BitVec 0} : x = 0#0 := by ext; simp
|
||||
|
||||
theorem eq_of_toFin_eq : ∀ {x y : BitVec w}, x.toFin = y.toFin → x = y
|
||||
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
|
||||
|
||||
@@ -95,7 +90,7 @@ theorem ofNat_one (n : Nat) : BitVec.ofNat 1 n = BitVec.ofBool (n % 2 = 1) := b
|
||||
theorem ofBool_eq_iff_eq : ∀(b b' : Bool), BitVec.ofBool b = BitVec.ofBool b' ↔ b = b' := by
|
||||
decide
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
|
||||
@[simp] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
|
||||
|
||||
@[simp] theorem toNat_ofNatLt (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
|
||||
|
||||
@@ -103,7 +98,7 @@ theorem ofBool_eq_iff_eq : ∀(b b' : Bool), BitVec.ofBool b = BitVec.ofBool b'
|
||||
getLsb (x#'lt) i = x.testBit i := by
|
||||
simp [getLsb, BitVec.ofNatLt]
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_ofNat (x w : Nat) : (x#w).toNat = x % 2^w := by
|
||||
@[simp] theorem toNat_ofNat (x w : Nat) : (x#w).toNat = x % 2^w := by
|
||||
simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat']
|
||||
|
||||
-- Remark: we don't use `[simp]` here because simproc` subsumes it for literals.
|
||||
@@ -112,9 +107,7 @@ theorem getLsb_ofNat (n : Nat) (x : Nat) (i : Nat) :
|
||||
getLsb (x#n) i = (i < n && x.testBit i) := by
|
||||
simp [getLsb, BitVec.ofNat, Fin.val_ofNat']
|
||||
|
||||
@[simp, deprecated toNat_ofNat] theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial
|
||||
|
||||
@[simp] theorem getLsb_zero : (0#w).getLsb i = false := by simp [getLsb]
|
||||
@[deprecated toNat_ofNat] theorem toNat_zero (n : Nat) : (0#n).toNat = 0 := by trivial
|
||||
|
||||
@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat :=
|
||||
Nat.mod_eq_of_lt x.isLt
|
||||
@@ -124,47 +117,21 @@ private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m ≤ n) :
|
||||
|
||||
/-! ### msb -/
|
||||
|
||||
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsb]
|
||||
|
||||
theorem msb_eq_getLsb_last (x : BitVec w) :
|
||||
x.msb = x.getLsb (w - 1) := by
|
||||
simp [BitVec.msb, getMsb, getLsb]
|
||||
rcases w with rfl | w
|
||||
· simp [BitVec.eq_nil x]
|
||||
· simp
|
||||
|
||||
@[bv_toNat] theorem getLsb_last (x : BitVec w) :
|
||||
x.getLsb (w-1) = decide (2 ^ (w-1) ≤ x.toNat) := by
|
||||
rcases w with rfl | w
|
||||
· simp
|
||||
· simp only [Nat.zero_lt_succ, decide_True, getLsb, Nat.testBit, Nat.succ_sub_succ_eq_sub,
|
||||
theorem msb_eq_decide (x : BitVec (Nat.succ w)) : BitVec.msb x = decide (2 ^ w ≤ x.toNat) := by
|
||||
simp only [BitVec.msb, getMsb, Nat.zero_lt_succ,
|
||||
decide_True, getLsb, Nat.testBit, Nat.succ_sub_succ_eq_sub,
|
||||
Nat.sub_zero, Nat.and_one_is_mod, Bool.true_and, Nat.shiftRight_eq_div_pow]
|
||||
rcases (Nat.lt_or_ge (BitVec.toNat x) (2 ^ w)) with h | h
|
||||
· simp [Nat.div_eq_of_lt h, h]
|
||||
· simp only [h]
|
||||
rw [Nat.div_eq_sub_div (Nat.two_pow_pos w) h, Nat.div_eq_of_lt]
|
||||
· decide
|
||||
· have : BitVec.toNat x < 2^w + 2^w := by simpa [Nat.pow_succ, Nat.mul_two] using x.isLt
|
||||
omega
|
||||
|
||||
@[bv_toNat] theorem getLsb_succ_last (x : BitVec (w + 1)) :
|
||||
x.getLsb w = decide (2 ^ w ≤ x.toNat) := getLsb_last x
|
||||
|
||||
@[bv_toNat] theorem msb_eq_decide (x : BitVec w) : BitVec.msb x = decide (2 ^ (w-1) ≤ x.toNat) := by
|
||||
simp [msb_eq_getLsb_last, getLsb_last]
|
||||
|
||||
theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat ≥ 2^(n-1) := by
|
||||
match n with
|
||||
| 0 =>
|
||||
simp [BitVec.msb, BitVec.getMsb] at p
|
||||
| n + 1 =>
|
||||
simp [BitVec.msb_eq_decide] at p
|
||||
simp only [Nat.add_sub_cancel]
|
||||
exact p
|
||||
rcases (Nat.lt_or_ge (BitVec.toNat x) (2 ^ w)) with h | h
|
||||
· simp [Nat.div_eq_of_lt h, h]
|
||||
· simp only [h]
|
||||
rw [Nat.div_eq_sub_div (Nat.two_pow_pos w) h, Nat.div_eq_of_lt]
|
||||
· decide
|
||||
· have : BitVec.toNat x < 2^w + 2^w := by simpa [Nat.pow_succ, Nat.mul_two] using x.isLt
|
||||
omega
|
||||
|
||||
/-! ### cast -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_cast (h : w = v) (x : BitVec w) : (cast h x).toNat = x.toNat := rfl
|
||||
@[simp] theorem toNat_cast (h : w = v) (x : BitVec w) : (cast h x).toNat = x.toNat := rfl
|
||||
@[simp] theorem toFin_cast (h : w = v) (x : BitVec w) :
|
||||
(cast h x).toFin = x.toFin.cast (by rw [h]) :=
|
||||
rfl
|
||||
@@ -177,61 +144,14 @@ theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat
|
||||
@[simp] theorem msb_cast (h : w = v) (x : BitVec w) : (cast h x).msb = x.msb := by
|
||||
simp [BitVec.msb]
|
||||
|
||||
/-! ### toInt/ofInt -/
|
||||
|
||||
/-- Prove equality of bitvectors in terms of nat operations. -/
|
||||
theorem toInt_eq_toNat_cond (i : BitVec n) :
|
||||
i.toInt =
|
||||
if 2*i.toNat < 2^n then
|
||||
(i.toNat : Int)
|
||||
else
|
||||
(i.toNat : Int) - (2^n : Nat) := by
|
||||
unfold BitVec.toInt
|
||||
split <;> omega
|
||||
|
||||
theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) := by
|
||||
simp only [toInt_eq_toNat_cond]
|
||||
split
|
||||
case inl g =>
|
||||
rw [Int.bmod_pos] <;> simp only [←Int.ofNat_emod, toNat_mod_cancel]
|
||||
omega
|
||||
case inr g =>
|
||||
rw [Int.bmod_neg] <;> simp only [←Int.ofNat_emod, toNat_mod_cancel]
|
||||
omega
|
||||
|
||||
/-- Prove equality of bitvectors in terms of nat operations. -/
|
||||
theorem eq_of_toInt_eq {i j : BitVec n} : i.toInt = j.toInt → i = j := by
|
||||
intro eq
|
||||
simp [toInt_eq_toNat_cond] at eq
|
||||
apply eq_of_toNat_eq
|
||||
revert eq
|
||||
have _ilt := i.isLt
|
||||
have _jlt := j.isLt
|
||||
split <;> split <;> omega
|
||||
|
||||
@[simp] theorem toNat_ofInt {n : Nat} (i : Int) :
|
||||
(BitVec.ofInt n i).toNat = (i % (2^n : Nat)).toNat := by
|
||||
unfold BitVec.ofInt
|
||||
simp
|
||||
|
||||
theorem toInt_ofNat {n : Nat} (x : Nat) :
|
||||
(BitVec.ofNat n x).toInt = (x : Int).bmod (2^n) := by
|
||||
simp [toInt_eq_toNat_bmod]
|
||||
|
||||
@[simp] theorem toInt_ofInt {n : Nat} (i : Int) :
|
||||
(BitVec.ofInt n i).toInt = i.bmod (2^n) := by
|
||||
have _ := Nat.two_pow_pos n
|
||||
have p : 0 ≤ i % (2^n : Nat) := by omega
|
||||
simp [toInt_eq_toNat_bmod, Int.toNat_of_nonneg p]
|
||||
|
||||
/-! ### zeroExtend and truncate -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_zeroExtend' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
|
||||
@[simp] theorem toNat_zeroExtend' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
|
||||
(zeroExtend' p x).toNat = x.toNat := by
|
||||
unfold zeroExtend'
|
||||
simp [p, x.isLt, Nat.mod_eq_of_lt]
|
||||
|
||||
@[bv_toNat] theorem toNat_zeroExtend (i : Nat) (x : BitVec n) :
|
||||
theorem toNat_zeroExtend (i : Nat) (x : BitVec n) :
|
||||
BitVec.toNat (zeroExtend i x) = x.toNat % 2^i := by
|
||||
let ⟨x, lt_n⟩ := x
|
||||
simp only [zeroExtend]
|
||||
@@ -241,7 +161,7 @@ theorem toInt_ofNat {n : Nat} (x : Nat) :
|
||||
else
|
||||
simp [n_le_i, toNat_ofNat]
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_truncate (x : BitVec n) : (truncate i x).toNat = x.toNat % 2^i :=
|
||||
@[simp] theorem toNat_truncate (x : BitVec n) : (truncate i x).toNat = x.toNat % 2^i :=
|
||||
toNat_zeroExtend i x
|
||||
|
||||
@[simp] theorem zeroExtend_eq (x : BitVec n) : zeroExtend n x = x := by
|
||||
@@ -259,24 +179,6 @@ theorem toInt_ofNat {n : Nat} (x : Nat) :
|
||||
apply eq_of_toNat_eq
|
||||
simp
|
||||
|
||||
/-- Moves one-sided left toNat equality to BitVec equality. -/
|
||||
theorem toNat_eq_nat (x : BitVec w) (y : Nat)
|
||||
: (x.toNat = y) ↔ (y < 2^w ∧ (x = y#w)) := by
|
||||
apply Iff.intro
|
||||
· intro eq
|
||||
simp at eq
|
||||
have lt := x.isLt
|
||||
simp [eq] at lt
|
||||
simp [←eq, lt, x.isLt]
|
||||
· intro eq
|
||||
simp [Nat.mod_eq_of_lt, eq]
|
||||
|
||||
/-- Moves one-sided right toNat equality to BitVec equality. -/
|
||||
theorem nat_eq_toNat (x : BitVec w) (y : Nat)
|
||||
: (y = x.toNat) ↔ (y < 2^w ∧ (x = y#w)) := by
|
||||
rw [@eq_comm _ _ x.toNat]
|
||||
apply toNat_eq_nat
|
||||
|
||||
@[simp] theorem getLsb_zeroExtend' (ge : m ≥ n) (x : BitVec n) (i : Nat) :
|
||||
getLsb (zeroExtend' ge x) i = getLsb x i := by
|
||||
simp [getLsb, toNat_zeroExtend']
|
||||
@@ -289,23 +191,6 @@ theorem nat_eq_toNat (x : BitVec w) (y : Nat)
|
||||
getLsb (truncate m x) i = (decide (i < m) && getLsb x i) :=
|
||||
getLsb_zeroExtend m x i
|
||||
|
||||
@[simp] theorem zeroExtend_zeroExtend_of_le (x : BitVec w) (h : k ≤ l) :
|
||||
(x.zeroExtend l).zeroExtend k = x.zeroExtend k := by
|
||||
ext i
|
||||
simp only [getLsb_zeroExtend, Fin.is_lt, decide_True, Bool.true_and]
|
||||
have p := lt_of_getLsb x i
|
||||
revert p
|
||||
cases getLsb x i <;> simp; omega
|
||||
|
||||
@[simp] theorem truncate_truncate_of_le (x : BitVec w) (h : k ≤ l) :
|
||||
(x.truncate l).truncate k = x.truncate k :=
|
||||
zeroExtend_zeroExtend_of_le x h
|
||||
|
||||
theorem msb_zeroExtend (x : BitVec w) : (x.zeroExtend v).msb = (decide (0 < v) && x.getLsb (v - 1)) := by
|
||||
rw [msb_eq_getLsb_last]
|
||||
simp only [getLsb_zeroExtend]
|
||||
cases getLsb x (v - 1) <;> simp; omega
|
||||
|
||||
/-! ## extractLsb -/
|
||||
|
||||
@[simp]
|
||||
@@ -386,7 +271,7 @@ protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) :
|
||||
|
||||
theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_not {x : BitVec v} : (~~~x).toNat = 2^v - 1 - x.toNat := by
|
||||
@[simp] theorem toNat_not {x : BitVec v} : (~~~x).toNat = 2^v - 1 - x.toNat := by
|
||||
rw [Nat.sub_sub, Nat.add_comm, not_def, toNat_xor]
|
||||
apply Nat.eq_of_testBit_eq
|
||||
intro i
|
||||
@@ -416,7 +301,7 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
|
||||
|
||||
/-! ### shiftLeft -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_shiftLeft {x : BitVec v} :
|
||||
@[simp] theorem toNat_shiftLeft {x : BitVec v} :
|
||||
BitVec.toNat (x <<< n) = BitVec.toNat x <<< n % 2^v :=
|
||||
BitVec.toNat_ofNat _ _
|
||||
|
||||
@@ -452,7 +337,7 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
|
||||
|
||||
/-! ### ushiftRight -/
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
|
||||
@[simp] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
|
||||
(x >>> i).toNat = x.toNat >>> i := rfl
|
||||
|
||||
@[simp] theorem getLsb_ushiftRight (x : BitVec n) (i j : Nat) :
|
||||
@@ -522,30 +407,6 @@ theorem truncate_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]
|
||||
|
||||
/-! ### concat -/
|
||||
|
||||
@[simp] theorem toNat_concat (x : BitVec w) (b : Bool) :
|
||||
(concat x b).toNat = x.toNat * 2 + b.toNat := by
|
||||
apply Nat.eq_of_testBit_eq
|
||||
simp only [concat, toNat_append, Nat.shiftLeft_eq, Nat.pow_one, toNat_ofBool, Nat.testBit_or]
|
||||
cases b
|
||||
· simp
|
||||
· rintro (_ | i)
|
||||
<;> simp [Nat.add_mod, Nat.add_comm, Nat.add_mul_div_right]
|
||||
|
||||
theorem getLsb_concat (x : BitVec w) (b : Bool) (i : Nat) :
|
||||
(concat x b).getLsb i = if i = 0 then b else x.getLsb (i - 1) := by
|
||||
simp only [concat, getLsb, 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]
|
||||
|
||||
@[simp] theorem getLsb_concat_zero : (concat x b).getLsb 0 = b := by
|
||||
simp [getLsb_concat]
|
||||
|
||||
@[simp] theorem getLsb_concat_succ : (concat x b).getLsb (i + 1) = x.getLsb i := by
|
||||
simp [getLsb_concat]
|
||||
|
||||
/-! ### add -/
|
||||
|
||||
theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl
|
||||
@@ -553,7 +414,7 @@ theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := r
|
||||
/--
|
||||
Definition of bitvector addition as a nat.
|
||||
-/
|
||||
@[simp, bv_toNat] theorem toNat_add (x y : BitVec w) : (x + y).toNat = (x.toNat + y.toNat) % 2^w := rfl
|
||||
@[simp] theorem toNat_add (x y : BitVec w) : (x + y).toNat = (x.toNat + y.toNat) % 2^w := rfl
|
||||
@[simp] theorem toFin_add (x y : BitVec w) : (x + y).toFin = toFin x + toFin y := rfl
|
||||
@[simp] theorem ofFin_add (x : Fin (2^n)) (y : BitVec n) :
|
||||
.ofFin x + y = .ofFin (x + y.toFin) := rfl
|
||||
@@ -577,7 +438,7 @@ protected theorem add_comm (x y : BitVec n) : x + y = y + x := by
|
||||
|
||||
theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n (x.toNat + (2^n - y.toNat)) := by rfl
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_sub {n} (x y : BitVec n) :
|
||||
@[simp] theorem toNat_sub {n} (x y : BitVec n) :
|
||||
(x - y).toNat = ((x.toNat + (2^n - y.toNat)) % 2^n) := rfl
|
||||
@[simp] theorem toFin_sub (x y : BitVec n) : (x - y).toFin = toFin x - toFin y := rfl
|
||||
|
||||
@@ -599,7 +460,7 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : x#n - y#n = .ofNat n (x + (2^n - y % 2
|
||||
· simp
|
||||
· exact Nat.le_of_lt x.isLt
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
|
||||
@[simp] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
|
||||
simp [Neg.neg, BitVec.neg]
|
||||
|
||||
theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by
|
||||
@@ -627,31 +488,12 @@ theorem negOne_eq_allOnes : -1#w = allOnes w := by
|
||||
|
||||
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
|
||||
|
||||
@[simp, bv_toNat] theorem toNat_mul (x y : BitVec n) : (x * y).toNat = (x.toNat * y.toNat) % 2 ^ n := rfl
|
||||
@[simp] theorem toNat_mul (x y : BitVec n) : (x * y).toNat = (x.toNat * y.toNat) % 2 ^ n := rfl
|
||||
@[simp] theorem toFin_mul (x y : BitVec n) : (x * y).toFin = (x.toFin * y.toFin) := rfl
|
||||
|
||||
protected theorem mul_comm (x y : BitVec w) : x * y = y * x := by
|
||||
apply eq_of_toFin_eq; simpa using Fin.mul_comm ..
|
||||
instance : Std.Commutative (fun (x y : BitVec w) => x * y) := ⟨BitVec.mul_comm⟩
|
||||
|
||||
protected theorem mul_assoc (x y z : BitVec w) : x * y * z = x * (y * z) := by
|
||||
apply eq_of_toFin_eq; simpa using Fin.mul_assoc ..
|
||||
instance : Std.Associative (fun (x y : BitVec w) => x * y) := ⟨BitVec.mul_assoc⟩
|
||||
|
||||
@[simp] protected theorem mul_one (x : BitVec w) : x * 1#w = x := by
|
||||
cases w
|
||||
· apply Subsingleton.elim
|
||||
· apply eq_of_toNat_eq; simp [Nat.mod_eq_of_lt]
|
||||
|
||||
@[simp] protected theorem one_mul (x : BitVec w) : 1#w * x = x := by
|
||||
rw [BitVec.mul_comm, BitVec.mul_one]
|
||||
|
||||
instance : Std.LawfulCommIdentity (fun (x y : BitVec w) => x * y) (1#w) where
|
||||
right_id := BitVec.mul_one
|
||||
|
||||
/-! ### le and lt -/
|
||||
|
||||
@[bv_toNat] theorem le_def (x y : BitVec n) :
|
||||
theorem le_def (x y : BitVec n) :
|
||||
x ≤ y ↔ x.toNat ≤ y.toNat := Iff.rfl
|
||||
|
||||
@[simp] theorem le_ofFin (x : BitVec n) (y : Fin (2^n)) :
|
||||
@@ -661,7 +503,7 @@ instance : Std.LawfulCommIdentity (fun (x y : BitVec w) => x * y) (1#w) where
|
||||
@[simp] theorem ofNat_le_ofNat {n} (x y : Nat) : (x#n) ≤ (y#n) ↔ x % 2^n ≤ y % 2^n := by
|
||||
simp [le_def]
|
||||
|
||||
@[bv_toNat] theorem lt_def (x y : BitVec n) :
|
||||
theorem lt_def (x y : BitVec n) :
|
||||
x < y ↔ x.toNat < y.toNat := Iff.rfl
|
||||
|
||||
@[simp] theorem lt_ofFin (x : BitVec n) (y : Fin (2^n)) :
|
||||
@@ -677,19 +519,3 @@ protected theorem lt_of_le_ne (x y : BitVec n) (h1 : x <= y) (h2 : ¬ x = y) : x
|
||||
let ⟨y, lt⟩ := y
|
||||
simp
|
||||
exact Nat.lt_of_le_of_ne
|
||||
|
||||
/- ! ### intMax -/
|
||||
|
||||
/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
|
||||
def intMax (w : Nat) : BitVec w := (2^w - 1)#w
|
||||
|
||||
theorem getLsb_intMax_eq (w : Nat) : (intMax w).getLsb i = decide (i < w) := by
|
||||
simp [intMax, getLsb]
|
||||
|
||||
theorem toNat_intMax_eq : (intMax w).toNat = 2^w - 1 := by
|
||||
have h : 2^w - 1 < 2^w := by
|
||||
have pos : 2^w > 0 := Nat.pow_pos (by decide)
|
||||
omega
|
||||
simp [intMax, Nat.shiftLeft_eq, Nat.one_mul, natCast_eq_ofNat, toNat_ofNat, Nat.mod_eq_of_lt h]
|
||||
|
||||
end BitVec
|
||||
|
||||
@@ -217,19 +217,9 @@ def toNat (b:Bool) : Nat := cond b 1 0
|
||||
|
||||
@[simp] theorem toNat_true : true.toNat = 1 := rfl
|
||||
|
||||
theorem toNat_le (c : Bool) : c.toNat ≤ 1 := by
|
||||
theorem toNat_le_one (c:Bool) : c.toNat ≤ 1 := by
|
||||
cases c <;> trivial
|
||||
|
||||
@[deprecated toNat_le] abbrev toNat_le_one := toNat_le
|
||||
|
||||
theorem toNat_lt (b : Bool) : b.toNat < 2 :=
|
||||
Nat.lt_succ_of_le (toNat_le _)
|
||||
|
||||
@[simp] theorem toNat_eq_zero (b : Bool) : b.toNat = 0 ↔ b = false := by
|
||||
cases b <;> simp
|
||||
@[simp] theorem toNat_eq_one (b : Bool) : b.toNat = 1 ↔ b = true := by
|
||||
cases b <;> simp
|
||||
|
||||
end Bool
|
||||
|
||||
/-! ### cond -/
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2023 by the authors listed in the file AUTHORS and their
|
||||
institutional affiliations. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix
|
||||
-/
|
||||
|
||||
@@ -793,12 +793,6 @@ protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by
|
||||
protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
|
||||
ext <| by rw [mul_def, mul_def, Nat.mul_comm]
|
||||
|
||||
protected theorem mul_assoc (a b c : Fin n) : a * b * c = a * (b * c) := by
|
||||
apply eq_of_val_eq
|
||||
simp only [val_mul]
|
||||
rw [← Nat.mod_eq_of_lt a.isLt, ← Nat.mod_eq_of_lt b.isLt, ← Nat.mod_eq_of_lt c.isLt]
|
||||
simp only [← Nat.mul_mod, Nat.mul_assoc]
|
||||
|
||||
protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by
|
||||
rw [Fin.mul_comm, Fin.mul_one]
|
||||
|
||||
|
||||
@@ -158,44 +158,4 @@ instance : Div Int where
|
||||
instance : Mod Int where
|
||||
mod := Int.emod
|
||||
|
||||
/-!
|
||||
# `bmod` ("balanced" mod)
|
||||
|
||||
Balanced mod (and balanced div) are a division and modulus pair such
|
||||
that `b * (Int.bdiv a b) + Int.bmod a b = a` and `b/2 ≤ Int.bmod a b <
|
||||
b/2` for all `a : Int` and `b > 0`.
|
||||
|
||||
This is used in Omega as well as signed bitvectors.
|
||||
-/
|
||||
|
||||
/--
|
||||
Balanced modulus. This version of Integer modulus uses the
|
||||
balanced rounding convention, which guarantees that
|
||||
`m/2 ≤ bmod x m < m/2` for `m ≠ 0` and `bmod x m` is congruent
|
||||
to `x` modulo `m`.
|
||||
|
||||
If `m = 0`, then `bmod x m = x`.
|
||||
-/
|
||||
def bmod (x : Int) (m : Nat) : Int :=
|
||||
let r := x % m
|
||||
if r < (m + 1) / 2 then
|
||||
r
|
||||
else
|
||||
r - m
|
||||
|
||||
/--
|
||||
Balanced division. This returns the unique integer so that
|
||||
`b * (Int.bdiv a b) + Int.bmod a b = a`.
|
||||
-/
|
||||
def bdiv (x : Int) (m : Nat) : Int :=
|
||||
if m = 0 then
|
||||
0
|
||||
else
|
||||
let q := x / m
|
||||
let r := x % m
|
||||
if r < (m + 1) / 2 then
|
||||
q
|
||||
else
|
||||
q + 1
|
||||
|
||||
end Int
|
||||
|
||||
@@ -325,78 +325,23 @@ theorem sub_ediv_of_dvd (a : Int) {b c : Int}
|
||||
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_ediv_of_dvd_right (Int.dvd_neg.2 hcb)]
|
||||
congr; exact Int.neg_ediv_of_dvd hcb
|
||||
|
||||
@[simp] theorem ediv_one : ∀ a : Int, a / 1 = a
|
||||
| (_:Nat) => congrArg Nat.cast (Nat.div_one _)
|
||||
| -[_+1] => congrArg negSucc (Nat.div_one _)
|
||||
/-!
|
||||
# `bmod` ("balanced" mod)
|
||||
|
||||
@[simp] theorem emod_one (a : Int) : a % 1 = 0 := by
|
||||
simp [emod_def, Int.one_mul, Int.sub_self]
|
||||
We use balanced mod in the omega algorithm,
|
||||
to make ±1 coefficients appear in equations without them.
|
||||
-/
|
||||
|
||||
@[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by
|
||||
have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this
|
||||
|
||||
@[simp]
|
||||
theorem Int.emod_sub_cancel (x y : Int): (x - y)%y = x%y := by
|
||||
if h : y = 0 then
|
||||
simp [h]
|
||||
/--
|
||||
Balanced mod, taking values in the range [- m/2, (m - 1)/2].
|
||||
-/
|
||||
def bmod (x : Int) (m : Nat) : Int :=
|
||||
let r := x % m
|
||||
if r < (m + 1) / 2 then
|
||||
r
|
||||
else
|
||||
simp only [Int.emod_def, Int.sub_ediv_of_dvd, Int.dvd_refl, Int.ediv_self h, Int.mul_sub]
|
||||
simp [Int.mul_one, Int.sub_sub, Int.add_comm y]
|
||||
|
||||
/-! bmod -/
|
||||
r - m
|
||||
|
||||
@[simp] theorem bmod_emod : bmod x m % m = x % m := by
|
||||
dsimp [bmod]
|
||||
split <;> simp [Int.sub_emod]
|
||||
|
||||
@[simp]
|
||||
theorem emod_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n) n = Int.bmod x n := by
|
||||
simp [bmod, Int.emod_emod]
|
||||
|
||||
theorem bmod_def (x : Int) (m : Nat) : bmod x m =
|
||||
if (x % m) < (m + 1) / 2 then
|
||||
x % m
|
||||
else
|
||||
(x % m) - m :=
|
||||
rfl
|
||||
|
||||
theorem bmod_pos (x : Int) (m : Nat) (p : x % m < (m + 1) / 2) : bmod x m = x % m := by
|
||||
simp [bmod_def, p]
|
||||
|
||||
theorem bmod_neg (x : Int) (m : Nat) (p : x % m ≥ (m + 1) / 2) : bmod x m = (x % m) - m := by
|
||||
simp [bmod_def, Int.not_lt.mpr p]
|
||||
|
||||
@[simp]
|
||||
theorem bmod_one_is_zero (x : Int) : Int.bmod x 1 = 0 := by
|
||||
simp [Int.bmod]
|
||||
|
||||
@[simp]
|
||||
theorem bmod_add_cancel (x : Int) (n : Nat) : Int.bmod (x + n) n = Int.bmod x n := by
|
||||
simp [bmod_def]
|
||||
|
||||
@[simp]
|
||||
theorem bmod_add_mul_cancel (x : Int) (n : Nat) (k : Int) : Int.bmod (x + n * k) n = Int.bmod x n := by
|
||||
simp [bmod_def]
|
||||
|
||||
@[simp]
|
||||
theorem bmod_sub_cancel (x : Int) (n : Nat) : Int.bmod (x - n) n = Int.bmod x n := by
|
||||
simp [bmod_def]
|
||||
|
||||
@[simp]
|
||||
theorem emod_add_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n + y) n = Int.bmod (x + y) n := by
|
||||
simp [Int.emod_def, Int.sub_eq_add_neg]
|
||||
rw [←Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
|
||||
|
||||
@[simp]
|
||||
theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n := by
|
||||
rw [bmod_def x n]
|
||||
split
|
||||
case inl p =>
|
||||
simp
|
||||
case inr p =>
|
||||
rw [Int.sub_eq_add_neg, Int.add_right_comm, ←Int.sub_eq_add_neg]
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
|
||||
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
|
||||
|
||||
@@ -321,27 +321,6 @@ theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by
|
||||
· exact (Nat.add_sub_cancel_left ..).symm
|
||||
· dsimp; rw [Nat.add_assoc, Nat.sub_eq_zero_of_le (Nat.le_add_right ..)]; rfl
|
||||
|
||||
/- ## add/sub injectivity -/
|
||||
|
||||
@[simp]
|
||||
protected theorem add_right_inj (i j k : Int) : (i + k = j + k) ↔ i = j := by
|
||||
apply Iff.intro
|
||||
· intro p
|
||||
rw [←Int.add_sub_cancel i k, ←Int.add_sub_cancel j k, p]
|
||||
· exact congrArg (· + k)
|
||||
|
||||
@[simp]
|
||||
protected theorem add_left_inj (i j k : Int) : (k + i = k + j) ↔ i = j := by
|
||||
simp [Int.add_comm k]
|
||||
|
||||
@[simp]
|
||||
protected theorem sub_left_inj (i j k : Int) : (k - i = k - j) ↔ i = j := by
|
||||
simp [Int.sub_eq_add_neg, Int.neg_inj]
|
||||
|
||||
@[simp]
|
||||
protected theorem sub_right_inj (i j k : Int) : (i - k = j - k) ↔ i = j := by
|
||||
simp [Int.sub_eq_add_neg]
|
||||
|
||||
/- ## Ring properties -/
|
||||
|
||||
@[simp] theorem ofNat_mul_negSucc (m n : Nat) : (m : Int) * -[n+1] = -↑(m * succ n) := rfl
|
||||
@@ -499,33 +478,6 @@ theorem eq_one_of_mul_eq_self_left {a b : Int} (Hpos : a ≠ 0) (H : b * a = a)
|
||||
theorem eq_one_of_mul_eq_self_right {a b : Int} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 :=
|
||||
Int.eq_of_mul_eq_mul_left Hpos <| by rw [Int.mul_one, H]
|
||||
|
||||
/-! # pow -/
|
||||
|
||||
protected theorem pow_zero (b : Int) : b^0 = 1 := rfl
|
||||
|
||||
protected theorem pow_succ (b : Int) (e : Nat) : b ^ (e+1) = (b ^ e) * b := rfl
|
||||
protected theorem pow_succ' (b : Int) (e : Nat) : b ^ (e+1) = b * (b ^ e) := by
|
||||
rw [Int.mul_comm, Int.pow_succ]
|
||||
|
||||
theorem pow_le_pow_of_le_left {n m : Nat} (h : n ≤ m) : ∀ (i : Nat), n^i ≤ m^i
|
||||
| 0 => Nat.le_refl _
|
||||
| succ i => Nat.mul_le_mul (pow_le_pow_of_le_left h i) h
|
||||
|
||||
theorem pow_le_pow_of_le_right {n : Nat} (hx : n > 0) {i : Nat} : ∀ {j}, i ≤ j → n^i ≤ n^j
|
||||
| 0, h =>
|
||||
have : i = 0 := eq_zero_of_le_zero h
|
||||
this.symm ▸ Nat.le_refl _
|
||||
| succ j, h =>
|
||||
match le_or_eq_of_le_succ h with
|
||||
| Or.inl h => show n^i ≤ n^j * n from
|
||||
have : n^i * 1 ≤ n^j * n := Nat.mul_le_mul (pow_le_pow_of_le_right hx h) hx
|
||||
Nat.mul_one (n^i) ▸ this
|
||||
| Or.inr h =>
|
||||
h.symm ▸ Nat.le_refl _
|
||||
|
||||
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 _)
|
||||
|
||||
/-! NatCast lemmas -/
|
||||
|
||||
/-!
|
||||
@@ -545,10 +497,4 @@ theorem natCast_one : ((1 : Nat) : Int) = (1 : Int) := rfl
|
||||
@[simp] theorem natCast_mul (a b : Nat) : ((a * b : Nat) : Int) = (a : Int) * (b : Int) := by
|
||||
simp
|
||||
|
||||
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]
|
||||
|
||||
end Int
|
||||
|
||||
@@ -192,11 +192,6 @@ protected theorem min_le_right (a b : Int) : min a b ≤ b := by rw [Int.min_def
|
||||
|
||||
protected theorem min_le_left (a b : Int) : min a b ≤ a := Int.min_comm .. ▸ Int.min_le_right ..
|
||||
|
||||
protected theorem min_eq_left {a b : Int} (h : a ≤ b) : min a b = a := by simp [Int.min_def, h]
|
||||
|
||||
protected theorem min_eq_right {a b : Int} (h : b ≤ a) : min a b = b := by
|
||||
rw [Int.min_comm a b]; exact Int.min_eq_left h
|
||||
|
||||
protected theorem le_min {a b c : Int} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c :=
|
||||
⟨fun h => ⟨Int.le_trans h (Int.min_le_left ..), Int.le_trans h (Int.min_le_right ..)⟩,
|
||||
fun ⟨h₁, h₂⟩ => by rw [Int.min_def]; split <;> assumption⟩
|
||||
@@ -215,12 +210,6 @@ protected theorem max_le {a b c : Int} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c :
|
||||
⟨fun h => ⟨Int.le_trans (Int.le_max_left ..) h, Int.le_trans (Int.le_max_right ..) h⟩,
|
||||
fun ⟨h₁, h₂⟩ => by rw [Int.max_def]; split <;> assumption⟩
|
||||
|
||||
protected theorem max_eq_right {a b : Int} (h : a ≤ b) : max a b = b := by
|
||||
simp [Int.max_def, h, Int.not_lt.2 h]
|
||||
|
||||
protected theorem max_eq_left {a b : Int} (h : b ≤ a) : max a b = a := by
|
||||
rw [← Int.max_comm b a]; exact Int.max_eq_right h
|
||||
|
||||
theorem eq_natAbs_of_zero_le {a : Int} (h : 0 ≤ a) : a = natAbs a := by
|
||||
let ⟨n, e⟩ := eq_ofNat_of_zero_le h
|
||||
rw [e]; rfl
|
||||
@@ -447,54 +436,3 @@ theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a :=
|
||||
|
||||
theorem ofNat_natAbs_of_nonpos {a : Int} (H : a ≤ 0) : (natAbs a : Int) = -a := by
|
||||
rw [← natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)]
|
||||
|
||||
/-! ### toNat -/
|
||||
|
||||
theorem toNat_eq_max : ∀ a : Int, (toNat a : Int) = max a 0
|
||||
| (n : Nat) => (Int.max_eq_left (ofNat_zero_le n)).symm
|
||||
| -[n+1] => (Int.max_eq_right (Int.le_of_lt (negSucc_lt_zero n))).symm
|
||||
|
||||
@[simp] theorem toNat_zero : (0 : Int).toNat = 0 := rfl
|
||||
|
||||
@[simp] theorem toNat_one : (1 : Int).toNat = 1 := rfl
|
||||
|
||||
@[simp] theorem toNat_of_nonneg {a : Int} (h : 0 ≤ a) : (toNat a : Int) = a := by
|
||||
rw [toNat_eq_max, Int.max_eq_left h]
|
||||
|
||||
@[simp] theorem toNat_ofNat (n : Nat) : toNat ↑n = n := rfl
|
||||
|
||||
@[simp] theorem toNat_ofNat_add_one {n : Nat} : ((n : Int) + 1).toNat = n + 1 := rfl
|
||||
|
||||
theorem self_le_toNat (a : Int) : a ≤ toNat a := by rw [toNat_eq_max]; apply Int.le_max_left
|
||||
|
||||
@[simp] theorem le_toNat {n : Nat} {z : Int} (h : 0 ≤ z) : n ≤ z.toNat ↔ (n : Int) ≤ z := by
|
||||
rw [← Int.ofNat_le, Int.toNat_of_nonneg h]
|
||||
|
||||
@[simp] theorem toNat_lt {n : Nat} {z : Int} (h : 0 ≤ z) : z.toNat < n ↔ z < (n : Int) := by
|
||||
rw [← Int.not_le, ← Nat.not_le, Int.le_toNat h]
|
||||
|
||||
theorem toNat_add {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : (a + b).toNat = a.toNat + b.toNat :=
|
||||
match a, b, eq_ofNat_of_zero_le ha, eq_ofNat_of_zero_le hb with
|
||||
| _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => rfl
|
||||
|
||||
theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toNat + n :=
|
||||
match a, eq_ofNat_of_zero_le ha with | _, ⟨_, rfl⟩ => rfl
|
||||
|
||||
@[simp] theorem pred_toNat : ∀ i : Int, (i - 1).toNat = i.toNat - 1
|
||||
| 0 => rfl
|
||||
| (n+1:Nat) => by simp [ofNat_add]
|
||||
| -[n+1] => rfl
|
||||
|
||||
@[simp] theorem toNat_sub_toNat_neg : ∀ n : Int, ↑n.toNat - ↑(-n).toNat = n
|
||||
| 0 => rfl
|
||||
| (_+1:Nat) => Int.sub_zero _
|
||||
| -[_+1] => Int.zero_sub _
|
||||
|
||||
@[simp] theorem toNat_add_toNat_neg_eq_natAbs : ∀ n : Int, n.toNat + (-n).toNat = n.natAbs
|
||||
| 0 => rfl
|
||||
| (_+1:Nat) => Nat.add_zero _
|
||||
| -[_+1] => Nat.zero_add _
|
||||
|
||||
@[simp] theorem toNat_neg_nat : ∀ n : Nat, (-(n : Int)).toNat = 0
|
||||
| 0 => rfl
|
||||
| _+1 => rfl
|
||||
|
||||
@@ -727,9 +727,9 @@ inductive lt [LT α] : List α → List α → Prop where
|
||||
instance [LT α] : LT (List α) := ⟨List.lt⟩
|
||||
|
||||
instance hasDecidableLt [LT α] [h : DecidableRel (α:=α) (·<·)] : (l₁ l₂ : List α) → Decidable (l₁ < l₂)
|
||||
| [], [] => isFalse nofun
|
||||
| [], [] => isFalse (fun h => nomatch h)
|
||||
| [], _::_ => isTrue (List.lt.nil _ _)
|
||||
| _::_, [] => isFalse nofun
|
||||
| _::_, [] => isFalse (fun h => nomatch h)
|
||||
| a::as, b::bs =>
|
||||
match h a b with
|
||||
| isTrue h₁ => isTrue (List.lt.head _ _ h₁)
|
||||
|
||||
@@ -227,23 +227,4 @@ where
|
||||
else
|
||||
go xs acc₁ (acc₂.push x)
|
||||
|
||||
/--
|
||||
Given a function `f : α → β ⊕ γ`, `partitionMap f l` maps the list by `f`
|
||||
whilst partitioning the result it into a pair of lists, `List β × List γ`,
|
||||
partitioning the `.inl _` into the left list, and the `.inr _` into the right List.
|
||||
```
|
||||
partitionMap (id : Nat ⊕ Nat → Nat ⊕ Nat) [inl 0, inr 1, inl 2] = ([0, 2], [1])
|
||||
```
|
||||
-/
|
||||
@[inline] def partitionMap (f : α → β ⊕ γ) (l : List α) : List β × List γ := go l #[] #[] where
|
||||
/-- Auxiliary for `partitionMap`:
|
||||
`partitionMap.go f l acc₁ acc₂ = (acc₁.toList ++ left, acc₂.toList ++ right)`
|
||||
if `partitionMap f l = (left, right)`. -/
|
||||
@[specialize] go : List α → Array β → Array γ → List β × List γ
|
||||
| [], acc₁, acc₂ => (acc₁.toList, acc₂.toList)
|
||||
| x :: xs, acc₁, acc₂ =>
|
||||
match f x with
|
||||
| .inl a => go xs (acc₁.push a) acc₂
|
||||
| .inr b => go xs acc₁ (acc₂.push b)
|
||||
|
||||
end List
|
||||
|
||||
@@ -242,31 +242,6 @@ theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1)
|
||||
@[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
|
||||
simp [getLast?_eq_get?, Nat.succ_sub_succ]
|
||||
|
||||
theorem getD_eq_get? : ∀ l n (a : α), getD l n a = (get? l n).getD a
|
||||
| [], _, _ => rfl
|
||||
| _a::_, 0, _ => rfl
|
||||
| _::l, _+1, _ => getD_eq_get? (l := l) ..
|
||||
|
||||
theorem get?_append_right : ∀ {l₁ l₂ : List α} {n : Nat}, l₁.length ≤ n →
|
||||
(l₁ ++ l₂).get? n = l₂.get? (n - l₁.length)
|
||||
| [], _, n, _ => rfl
|
||||
| a :: l, _, n+1, h₁ => by rw [cons_append]; simp [get?_append_right (Nat.lt_succ.1 h₁)]
|
||||
|
||||
theorem get?_reverse' : ∀ {l : List α} (i j), i + j + 1 = length l →
|
||||
get? l.reverse i = get? l j
|
||||
| [], _, _, _ => rfl
|
||||
| a::l, i, 0, h => by simp at h; simp [h, get?_append_right]
|
||||
| a::l, i, j+1, h => by
|
||||
have := Nat.succ.inj h; simp at this ⊢
|
||||
rw [get?_append, get?_reverse' _ j this]
|
||||
rw [length_reverse, ← this]; apply Nat.lt_add_of_pos_right (Nat.succ_pos _)
|
||||
|
||||
theorem get?_reverse {l : List α} (i) (h : i < length l) :
|
||||
get? l.reverse i = get? l (l.length - 1 - i) :=
|
||||
get?_reverse' _ _ <| by
|
||||
rw [Nat.add_sub_of_le (Nat.le_sub_one_of_lt h),
|
||||
Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) h)]
|
||||
|
||||
/-! ### take and drop -/
|
||||
|
||||
@[simp] theorem take_append_drop : ∀ (n : Nat) (l : List α), take n l ++ drop n l = l
|
||||
@@ -665,44 +640,3 @@ theorem minimum?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ≤ ·
|
||||
exact congrArg some <| anti.1
|
||||
((le_minimum?_iff le_min_iff (xs := x::xs) rfl _).1 (le_refl _) _ h₁)
|
||||
(h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl))
|
||||
|
||||
@[simp] theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} :
|
||||
(a :: as).get ⟨i+1, h⟩ = as.get ⟨i, Nat.lt_of_succ_lt_succ h⟩ := rfl
|
||||
|
||||
@[simp] theorem get_cons_succ' {as : List α} {i : Fin as.length} :
|
||||
(a :: as).get i.succ = as.get i := rfl
|
||||
|
||||
@[simp] theorem set_nil (n : Nat) (a : α) : [].set n a = [] := rfl
|
||||
|
||||
@[simp] theorem set_zero (x : α) (xs : List α) (a : α) :
|
||||
(x :: xs).set 0 a = a :: xs := rfl
|
||||
|
||||
@[simp] theorem set_succ (x : α) (xs : List α) (n : Nat) (a : α) :
|
||||
(x :: xs).set n.succ a = x :: xs.set n a := rfl
|
||||
|
||||
@[simp] theorem get_set_eq (l : List α) (i : Nat) (a : α) (h : i < (l.set i a).length) :
|
||||
(l.set i a).get ⟨i, h⟩ = a :=
|
||||
match l, i with
|
||||
| [], _ => by
|
||||
simp at h
|
||||
contradiction
|
||||
| _ :: _, 0 => by
|
||||
simp
|
||||
| _ :: l, i + 1 => by
|
||||
simp [get_set_eq l]
|
||||
|
||||
@[simp] theorem get_set_ne (l : List α) {i j : Nat} (h : i ≠ j) (a : α)
|
||||
(hj : j < (l.set i a).length) :
|
||||
(l.set i a).get ⟨j, hj⟩ = l.get ⟨j, by simp at hj; exact hj⟩ :=
|
||||
match l, i, j with
|
||||
| [], _, _ => by
|
||||
simp
|
||||
| _ :: _, 0, 0 => by
|
||||
contradiction
|
||||
| _ :: _, 0, _ + 1 => by
|
||||
simp
|
||||
| _ :: _, _ + 1, 0 => by
|
||||
simp
|
||||
| _ :: l, i + 1, j + 1 => by
|
||||
have g : i ≠ j := h ∘ congrArg (· + 1)
|
||||
simp [get_set_ne l g]
|
||||
|
||||
@@ -16,4 +16,3 @@ import Init.Data.Nat.Power2
|
||||
import Init.Data.Nat.Linear
|
||||
import Init.Data.Nat.SOM
|
||||
import Init.Data.Nat.Lemmas
|
||||
import Init.Data.Nat.Mod
|
||||
|
||||
@@ -189,7 +189,7 @@ protected theorem mul_comm : ∀ (n m : Nat), n * m = m * n
|
||||
Nat.mul_comm n 1 ▸ Nat.mul_one n
|
||||
|
||||
protected theorem left_distrib (n m k : Nat) : n * (m + k) = n * m + n * k := by
|
||||
induction n with
|
||||
induction n generalizing m k with
|
||||
| zero => repeat rw [Nat.zero_mul]
|
||||
| succ n ih => simp [succ_mul, ih]; rw [Nat.add_assoc, Nat.add_assoc (n*m)]; apply congrArg; apply Nat.add_left_comm
|
||||
|
||||
@@ -503,10 +503,10 @@ theorem eq_of_mul_eq_mul_right {n m k : Nat} (hm : 0 < m) (h : n * m = k * m) :
|
||||
|
||||
/-! # power -/
|
||||
|
||||
protected theorem pow_succ (n m : Nat) : n^(succ m) = n^m * n :=
|
||||
theorem pow_succ (n m : Nat) : n^(succ m) = n^m * n :=
|
||||
rfl
|
||||
|
||||
protected theorem pow_zero (n : Nat) : n^0 = 1 := rfl
|
||||
theorem pow_zero (n : Nat) : n^0 = 1 := rfl
|
||||
|
||||
theorem pow_le_pow_of_le_left {n m : Nat} (h : n ≤ m) : ∀ (i : Nat), n^i ≤ m^i
|
||||
| 0 => Nat.le_refl _
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2023 by the authors listed in the file AUTHORS and their
|
||||
institutional affiliations. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix
|
||||
-/
|
||||
@@ -23,13 +24,26 @@ namespace Nat
|
||||
private theorem one_div_two : 1/2 = 0 := by trivial
|
||||
|
||||
private theorem two_pow_succ_sub_succ_div_two : (2 ^ (n+1) - (x + 1)) / 2 = 2^n - (x/2 + 1) := by
|
||||
omega
|
||||
if h : x + 1 ≤ 2 ^ (n + 1) then
|
||||
apply fun x => (Nat.sub_eq_of_eq_add x).symm
|
||||
apply Eq.trans _
|
||||
apply Nat.add_mul_div_left _ _ Nat.zero_lt_two
|
||||
rw [← Nat.sub_add_comm h]
|
||||
rw [Nat.add_sub_assoc (by omega)]
|
||||
rw [Nat.pow_succ']
|
||||
rw [Nat.mul_add_div Nat.zero_lt_two]
|
||||
simp [show (2 * (x / 2 + 1) - (x + 1)) / 2 = 0 by omega]
|
||||
else
|
||||
rw [Nat.pow_succ'] at *
|
||||
omega
|
||||
|
||||
private theorem two_pow_succ_sub_one_div_two : (2 ^ (n+1) - 1) / 2 = 2^n - 1 :=
|
||||
two_pow_succ_sub_succ_div_two
|
||||
|
||||
private theorem two_mul_sub_one {n : Nat} (n_pos : n > 0) : (2*n - 1) % 2 = 1 := by
|
||||
omega
|
||||
match n with
|
||||
| 0 => contradiction
|
||||
| n + 1 => simp [Nat.mul_succ, Nat.mul_add_mod, mod_eq_of_lt]
|
||||
|
||||
/-! ### Preliminaries -/
|
||||
|
||||
@@ -226,7 +240,7 @@ theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) :
|
||||
rw [Nat.sub_eq_zero_iff_le] at i_sub_j_eq
|
||||
exact Nat.not_le_of_gt j_lt_i i_sub_j_eq
|
||||
| d+1 =>
|
||||
simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod]
|
||||
simp [pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod]
|
||||
|
||||
@[simp] theorem testBit_mod_two_pow (x j i : Nat) :
|
||||
testBit (x % 2^j) i = (decide (i < j) && testBit x i) := by
|
||||
@@ -267,18 +281,20 @@ theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) :
|
||||
| n+1 =>
|
||||
-- just logic + omega:
|
||||
simp only [zero_lt_succ, decide_True, Bool.true_and]
|
||||
rw [← decide_not, decide_eq_decide]
|
||||
rw [Nat.pow_succ', ← decide_not, decide_eq_decide]
|
||||
rw [Nat.pow_succ'] at h₂
|
||||
omega
|
||||
| succ i ih =>
|
||||
simp only [testBit_succ]
|
||||
match n with
|
||||
| 0 =>
|
||||
simp only [Nat.pow_zero, succ_sub_succ_eq_sub, Nat.zero_sub, Nat.zero_div, zero_testBit]
|
||||
simp only [pow_zero, succ_sub_succ_eq_sub, Nat.zero_sub, Nat.zero_div, zero_testBit]
|
||||
rw [decide_eq_false] <;> simp
|
||||
| n+1 =>
|
||||
rw [Nat.two_pow_succ_sub_succ_div_two, ih]
|
||||
· simp [Nat.succ_lt_succ_iff]
|
||||
· omega
|
||||
· rw [Nat.pow_succ'] at h₂
|
||||
omega
|
||||
|
||||
@[simp] theorem testBit_two_pow_sub_one (n i : Nat) : testBit (2^n-1) i = decide (i < n) := by
|
||||
rw [testBit_two_pow_sub_succ]
|
||||
@@ -337,7 +353,7 @@ private theorem eq_0_of_lt (x : Nat) : x < 2^ 0 ↔ x = 0 := eq_0_of_lt_one x
|
||||
private theorem zero_lt_pow (n : Nat) : 0 < 2^n := by
|
||||
induction n
|
||||
case zero => simp [eq_0_of_lt]
|
||||
case succ n hyp => simpa [Nat.pow_succ]
|
||||
case succ n hyp => simpa [pow_succ]
|
||||
|
||||
private theorem div_two_le_of_lt_two {m n : Nat} (p : m < 2 ^ succ n) : m / 2 < 2^n := by
|
||||
simp [div_lt_iff_lt_mul Nat.zero_lt_two]
|
||||
@@ -362,7 +378,7 @@ theorem bitwise_lt_two_pow (left : x < 2^n) (right : y < 2^n) : (Nat.bitwise f x
|
||||
simp only [x_zero, y_zero, if_neg]
|
||||
have hyp1 := hyp (div_two_le_of_lt_two left) (div_two_le_of_lt_two right)
|
||||
by_cases p : f (decide (x % 2 = 1)) (decide (y % 2 = 1)) = true <;>
|
||||
simp [p, Nat.pow_succ, mul_succ, Nat.add_assoc]
|
||||
simp [p, pow_succ, mul_succ, Nat.add_assoc]
|
||||
case pos =>
|
||||
apply lt_of_succ_le
|
||||
simp only [← Nat.succ_add]
|
||||
@@ -432,8 +448,12 @@ theorem testBit_mul_pow_two_add (a : Nat) {b i : Nat} (b_lt : b < 2^i) (j : Nat)
|
||||
cases Nat.lt_or_ge j i with
|
||||
| inl j_lt =>
|
||||
simp only [j_lt]
|
||||
have i_def : i = j + succ (pred (i-j)) := by
|
||||
rw [succ_pred_eq_of_pos] <;> omega
|
||||
have i_ge := Nat.le_of_lt j_lt
|
||||
have i_sub_j_nez : i-j ≠ 0 := Nat.sub_ne_zero_of_lt j_lt
|
||||
have i_def : i = j + succ (pred (i-j)) :=
|
||||
calc i = j + (i-j) := (Nat.add_sub_cancel' i_ge).symm
|
||||
_ = j + succ (pred (i-j)) := by
|
||||
rw [← congrArg (j+·) (Nat.succ_pred i_sub_j_nez)]
|
||||
rw [i_def]
|
||||
simp only [testBit_to_div_mod, Nat.pow_add, Nat.mul_assoc]
|
||||
simp only [Nat.mul_add_div (Nat.two_pow_pos _), Nat.mul_add_mod]
|
||||
|
||||
@@ -742,7 +742,7 @@ theorem shiftLeft_eq (a b : Nat) : a <<< b = a * 2 ^ b :=
|
||||
match b with
|
||||
| 0 => (Nat.mul_one _).symm
|
||||
| b+1 => (shiftLeft_eq _ b).trans <| by
|
||||
simp [Nat.pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm]
|
||||
simp [pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm]
|
||||
|
||||
theorem one_shiftLeft (n : Nat) : 1 <<< n = 2 ^ n := by rw [shiftLeft_eq, Nat.one_mul]
|
||||
|
||||
|
||||
@@ -1,76 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega
|
||||
|
||||
/-!
|
||||
# Further results about `mod`.
|
||||
|
||||
This file proves some results about `mod` that are useful for bitblasting,
|
||||
in particular
|
||||
`Nat.mod_mul : x % (a * b) = x % a + a * (x / a % b)`
|
||||
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 `/`,
|
||||
which should probably be moved to their own file.
|
||||
-/
|
||||
|
||||
namespace Nat
|
||||
|
||||
@[simp] protected theorem mul_lt_mul_left (a0 : 0 < a) : a * b < a * c ↔ b < c := by
|
||||
induction a with
|
||||
| zero => simp_all
|
||||
| succ a ih =>
|
||||
cases a
|
||||
· simp
|
||||
· simp_all [succ_eq_add_one, Nat.right_distrib]
|
||||
omega
|
||||
|
||||
@[simp] protected theorem mul_lt_mul_right (a0 : 0 < a) : b * a < c * a ↔ b < c := by
|
||||
rw [Nat.mul_comm b a, Nat.mul_comm c a, Nat.mul_lt_mul_left a0]
|
||||
|
||||
protected theorem lt_of_mul_lt_mul_left {a b c : Nat} (h : a * b < a * c) : b < c := by
|
||||
cases a <;> simp_all
|
||||
|
||||
protected theorem lt_of_mul_lt_mul_right {a b c : Nat} (h : b * a < c * a) : b < c := by
|
||||
rw [Nat.mul_comm b a, Nat.mul_comm c a] at h
|
||||
exact Nat.lt_of_mul_lt_mul_left h
|
||||
|
||||
protected theorem div_lt_of_lt_mul {m n k : Nat} (h : m < n * k) : m / n < k :=
|
||||
Nat.lt_of_mul_lt_mul_left <|
|
||||
calc
|
||||
n * (m / n) ≤ m % n + n * (m / n) := Nat.le_add_left _ _
|
||||
_ = m := mod_add_div _ _
|
||||
_ < n * k := h
|
||||
|
||||
theorem mod_mul_right_div_self (m n k : Nat) : m % (n * k) / n = m / n % k := by
|
||||
rcases Nat.eq_zero_or_pos n with (rfl | hn); simp [mod_zero]
|
||||
rcases Nat.eq_zero_or_pos k with (rfl | hk); simp [mod_zero]
|
||||
conv => rhs; rw [← mod_add_div m (n * k)]
|
||||
rw [Nat.mul_assoc, add_mul_div_left _ _ hn, add_mul_mod_self_left,
|
||||
mod_eq_of_lt (Nat.div_lt_of_lt_mul (mod_lt _ (Nat.mul_pos hn hk)))]
|
||||
|
||||
theorem mod_mul_left_div_self (m n k : Nat) : m % (k * n) / n = m / n % k := by
|
||||
rw [Nat.mul_comm k n, mod_mul_right_div_self]
|
||||
|
||||
@[simp 1100]
|
||||
theorem mod_mul_right_mod (a b c : Nat) : a % (b * c) % b = a % b :=
|
||||
Nat.mod_mod_of_dvd a (Nat.dvd_mul_right b c)
|
||||
|
||||
@[simp 1100]
|
||||
theorem mod_mul_left_mod (a b c : Nat) : a % (b * c) % c = a % c :=
|
||||
Nat.mod_mod_of_dvd a (Nat.mul_comm _ _ ▸ Nat.dvd_mul_left c b)
|
||||
|
||||
theorem mod_mul {a b x : Nat} : x % (a * b) = x % a + a * (x / a % b) := by
|
||||
rw [Nat.add_comm, ← Nat.div_add_mod (x % (a*b)) a, Nat.mod_mul_right_mod,
|
||||
Nat.mod_mul_right_div_self]
|
||||
|
||||
theorem mod_pow_succ {x b k : Nat} :
|
||||
x % b ^ (k + 1) = x % b ^ k + b ^ k * ((x / b ^ k) % b) := by
|
||||
rw [Nat.pow_succ, Nat.mod_mul]
|
||||
|
||||
end Nat
|
||||
@@ -4,7 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Control.Except
|
||||
import Init.Data.ByteArray
|
||||
import Init.SimpLemmas
|
||||
import Init.Util
|
||||
import Init.WFTactics
|
||||
|
||||
namespace String
|
||||
|
||||
|
||||
@@ -1362,19 +1362,6 @@ structure OmegaConfig where
|
||||
|
||||
end Omega
|
||||
|
||||
namespace CheckTactic
|
||||
|
||||
/--
|
||||
Type used to lift an arbitrary value into a type parameter so it can
|
||||
appear in a proof goal.
|
||||
|
||||
It is used by the #check_tactic command.
|
||||
-/
|
||||
inductive CheckGoalType {α : Sort u} : (val : α) → Prop where
|
||||
| intro : (val : α) → CheckGoalType val
|
||||
|
||||
end CheckTactic
|
||||
|
||||
end Meta
|
||||
|
||||
namespace Parser
|
||||
|
||||
@@ -503,25 +503,6 @@ applications of this function as `↑` when printing expressions.
|
||||
-/
|
||||
syntax (name := Attr.coe) "coe" : attr
|
||||
|
||||
/--
|
||||
This attribute marks a code action, which is used to suggest new tactics or replace existing ones.
|
||||
|
||||
* `@[command_code_action kind]`: This is a code action which applies to applications of the command
|
||||
`kind` (a command syntax kind), which can replace the command or insert things before or after it.
|
||||
|
||||
* `@[command_code_action kind₁ kind₂]`: shorthand for
|
||||
`@[command_code_action kind₁, command_code_action kind₂]`.
|
||||
|
||||
* `@[command_code_action]`: This is a command code action that applies to all commands.
|
||||
Use sparingly.
|
||||
-/
|
||||
syntax (name := command_code_action) "command_code_action" (ppSpace ident)* : attr
|
||||
|
||||
/--
|
||||
Builtin command code action. See `command_code_action`.
|
||||
-/
|
||||
syntax (name := builtin_command_code_action) "builtin_command_code_action" (ppSpace ident)* : attr
|
||||
|
||||
/--
|
||||
When `parent_dir` contains the current Lean file, `include_str "path" / "to" / "file"` becomes
|
||||
a string literal with the contents of the file at `"parent_dir" / "path" / "to" / "file"`. If this
|
||||
@@ -551,92 +532,3 @@ except that it doesn't print an empty diagnostic.
|
||||
(This is effectively a synonym for `run_elab`.)
|
||||
-/
|
||||
syntax (name := runMeta) "run_meta " doSeq : command
|
||||
|
||||
/-- Element that can be part of a `#guard_msgs` specification. -/
|
||||
syntax guardMsgsSpecElt := &"drop"? (&"info" <|> &"warning" <|> &"error" <|> &"all")
|
||||
|
||||
/-- Specification for `#guard_msgs` command. -/
|
||||
syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")"
|
||||
|
||||
/--
|
||||
`#guard_msgs` captures the messages generated by another command and checks that they
|
||||
match the contents of the docstring attached to the `#guard_msgs` command.
|
||||
|
||||
Basic example:
|
||||
```lean
|
||||
/--
|
||||
error: unknown identifier 'x'
|
||||
-/
|
||||
#guard_msgs in
|
||||
example : α := x
|
||||
```
|
||||
This checks that there is such an error and then consumes the message entirely.
|
||||
|
||||
By default, the command intercepts all messages, but there is a way to specify which types
|
||||
of messages to consider. For example, we can select only warnings:
|
||||
```lean
|
||||
/--
|
||||
warning: declaration uses 'sorry'
|
||||
-/
|
||||
#guard_msgs(warning) in
|
||||
example : α := sorry
|
||||
```
|
||||
or only errors
|
||||
```lean
|
||||
#guard_msgs(error) in
|
||||
example : α := sorry
|
||||
```
|
||||
In this last example, since the message is not intercepted there is a warning on `sorry`.
|
||||
We can drop the warning completely with
|
||||
```lean
|
||||
#guard_msgs(error, drop warning) in
|
||||
example : α := sorry
|
||||
```
|
||||
|
||||
Syntax description:
|
||||
```
|
||||
#guard_msgs (drop? info|warning|error|all,*)? in cmd
|
||||
```
|
||||
|
||||
If there is no specification, `#guard_msgs` intercepts all messages.
|
||||
Otherwise, if there is one, the specification is considered in left-to-right order, and the first
|
||||
that applies chooses the outcome of the message:
|
||||
- `info`, `warning`, `error`: intercept a message with the given severity level.
|
||||
- `all`: intercept any message (so `#guard_msgs in cmd` and `#guard_msgs (all) in cmd`
|
||||
are equivalent).
|
||||
- `drop info`, `drop warning`, `drop error`: intercept a message with the given severity
|
||||
level and then drop it. These messages are not checked.
|
||||
- `drop all`: intercept a message and drop it.
|
||||
|
||||
For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and then drop
|
||||
everything else.
|
||||
-/
|
||||
syntax (name := guardMsgsCmd)
|
||||
(docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command
|
||||
|
||||
namespace Parser
|
||||
|
||||
/--
|
||||
`#check_tactic t ~> r by commands` runs the tactic sequence `commands`
|
||||
on a goal with `t` and sees if the resulting expression has reduced it
|
||||
to `r`.
|
||||
-/
|
||||
syntax (name := checkTactic) "#check_tactic " term "~>" term "by" tactic : command
|
||||
|
||||
/--
|
||||
`#check_tactic_failure t by tac` runs the tactic `tac`
|
||||
on a goal with `t` and verifies it fails.
|
||||
-/
|
||||
syntax (name := checkTacticFailure) "#check_tactic_failure " term "by" tactic : command
|
||||
|
||||
/--
|
||||
`#check_simp t ~> r` checks `simp` reduces `t` to `r`.
|
||||
-/
|
||||
syntax (name := checkSimp) "#check_simp " term "~>" term : command
|
||||
|
||||
/--
|
||||
`#check_simp t !~>` checks `simp` fails on reducing `t`.
|
||||
-/
|
||||
syntax (name := checkSimpFailure) "#check_simp " term "!~>" : command
|
||||
|
||||
end Parser
|
||||
|
||||
@@ -170,6 +170,19 @@ See [Theorem Proving in Lean 4][tpil4] for more information.
|
||||
-/
|
||||
syntax (name := calcTactic) "calc" calcSteps : tactic
|
||||
|
||||
/--
|
||||
Denotes a term that was omitted by the pretty printer.
|
||||
This is only used for pretty printing, and it cannot be elaborated.
|
||||
The presence of `⋯` is controlled by the `pp.deepTerms` and `pp.proofs` options.
|
||||
-/
|
||||
syntax "⋯" : term
|
||||
|
||||
macro_rules | `(⋯) => Macro.throwError "\
|
||||
Error: The '⋯' token is used by the pretty printer to indicate omitted terms, \
|
||||
and it cannot be elaborated.\
|
||||
\n\nIts presence in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
|
||||
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
|
||||
|
||||
@[app_unexpander Unit.unit] def unexpandUnit : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_)) => `(())
|
||||
|
||||
@@ -453,19 +466,3 @@ syntax "{" term,+ "}" : term
|
||||
macro_rules
|
||||
| `({$x:term}) => `(singleton $x)
|
||||
| `({$x:term, $xs:term,*}) => `(insert $x {$xs:term,*})
|
||||
|
||||
namespace Lean
|
||||
|
||||
/-- Unexpander for the `{ x }` notation. -/
|
||||
@[app_unexpander singleton]
|
||||
def singletonUnexpander : Lean.PrettyPrinter.Unexpander
|
||||
| `($_ $a) => `({ $a:term })
|
||||
| _ => throw ()
|
||||
|
||||
/-- Unexpander for the `{ x, y, ... }` notation. -/
|
||||
@[app_unexpander insert]
|
||||
def insertUnexpander : Lean.PrettyPrinter.Unexpander
|
||||
| `($_ $a { $ts:term,* }) => `({$a:term, $ts,*})
|
||||
| _ => throw ()
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -20,7 +20,7 @@ There is an equivalent file setting up `Coeffs` as a type synonym for `AssocList
|
||||
currently in a private branch.
|
||||
Not all the theorems about the algebraic operations on that representation have been proved yet.
|
||||
When they are ready, we can replace the implementation in `omega` simply by importing
|
||||
`Init.Omega.IntDict` instead of `Init.Omega.IntList`.
|
||||
`Std.Tactic.Omega.Coeffs.IntDict` instead of `Std.Tactic.Omega.Coeffs.IntList`.
|
||||
|
||||
For small problems, the sparse representation is actually slightly slower,
|
||||
so it is not urgent to make this replacement.
|
||||
|
||||
@@ -12,7 +12,7 @@ import Init.Data.Nat.Lemmas
|
||||
# Lemmas about `Nat`, `Int`, and `Fin` needed internally by `omega`.
|
||||
|
||||
These statements are useful for constructing proof expressions,
|
||||
but unlikely to be widely useful, so are inside the `Lean.Omega` namespace.
|
||||
but unlikely to be widely useful, so are inside the `Std.Tactic.Omega` namespace.
|
||||
|
||||
If you do find a use for them, please move them into the appropriate file and namespace!
|
||||
-/
|
||||
|
||||
@@ -9,7 +9,7 @@ import Init.PropLemmas
|
||||
# Specializations of basic logic lemmas
|
||||
|
||||
These are useful for `omega` while constructing proofs, but not considered generally useful
|
||||
so are hidden in the `Lean.Omega` namespace.
|
||||
so are hidden in the `Std.Tactic.Omega` namespace.
|
||||
|
||||
If you find yourself needing them elsewhere, please move them first to another file.
|
||||
-/
|
||||
|
||||
@@ -947,8 +947,7 @@ return `t` or `e` depending on whether `c` is true or false. The explicit argume
|
||||
determines how to evaluate `c` to true or false. Write `if h : c then t else e`
|
||||
instead for a "dependent if-then-else" `dite`, which allows `t`/`e` to use the fact
|
||||
that `c` is true/false.
|
||||
-/
|
||||
/-
|
||||
|
||||
Because Lean uses a strict (call-by-value) evaluation strategy, the signature of this
|
||||
function is problematic in that it would require `t` and `e` to be evaluated before
|
||||
calling the `ite` function, which would cause both sides of the `if` to be evaluated.
|
||||
@@ -1635,8 +1634,8 @@ instance : LT Nat where
|
||||
lt := Nat.lt
|
||||
|
||||
theorem Nat.not_succ_le_zero : ∀ (n : Nat), LE.le (succ n) 0 → False
|
||||
| 0 => nofun
|
||||
| succ _ => nofun
|
||||
| 0, h => nomatch h
|
||||
| succ _, h => nomatch h
|
||||
|
||||
theorem Nat.not_lt_zero (n : Nat) : Not (LT.lt n 0) :=
|
||||
not_succ_le_zero n
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro
|
||||
|
||||
|
||||
@@ -673,13 +673,12 @@ It makes sure the "continuation" `?_` is the main goal after refining.
|
||||
macro "refine_lift " e:term : tactic => `(tactic| focus (refine no_implicit_lambda% $e; rotate_right))
|
||||
|
||||
/--
|
||||
The `have` tactic is for adding hypotheses to the local context of the main goal.
|
||||
* `have h : t := e` adds the hypothesis `h : t` if `e` is a term of type `t`.
|
||||
* `have h := e` uses the type of `e` for `t`.
|
||||
* `have : t := e` and `have := e` use `this` for the name of the hypothesis.
|
||||
* `have pat := e` for a pattern `pat` is equivalent to `match e with | pat => _`,
|
||||
where `_` stands for the tactics that follow this one.
|
||||
It is convenient for types that have only one applicable constructor.
|
||||
`have h : t := e` adds the hypothesis `h : t` to the current goal if `e` a term
|
||||
of type `t`.
|
||||
* If `t` is omitted, it will be inferred.
|
||||
* If `h` is omitted, the name `this` is used.
|
||||
* The variant `have pattern := e` is equivalent to `match e with | pattern => _`,
|
||||
and it is convenient for types that have only one applicable constructor.
|
||||
For example, given `h : p ∧ q ∧ r`, `have ⟨h₁, h₂, h₃⟩ := h` produces the
|
||||
hypotheses `h₁ : p`, `h₂ : q`, and `h₃ : r`.
|
||||
-/
|
||||
@@ -694,15 +693,12 @@ If `h :` is omitted, the name `this` is used.
|
||||
-/
|
||||
macro "suffices " d:sufficesDecl : tactic => `(tactic| refine_lift suffices $d; ?_)
|
||||
/--
|
||||
The `let` tactic is for adding definitions to the local context of the main goal.
|
||||
* `let x : t := e` adds the definition `x : t := e` if `e` is a term of type `t`.
|
||||
* `let x := e` uses the type of `e` for `t`.
|
||||
* `let : t := e` and `let := e` use `this` for the name of the hypothesis.
|
||||
* `let pat := e` for a pattern `pat` is equivalent to `match e with | pat => _`,
|
||||
where `_` stands for the tactics that follow this one.
|
||||
It is convenient for types that let only one applicable constructor.
|
||||
For example, given `p : α × β × γ`, `let ⟨x, y, z⟩ := p` produces the
|
||||
local variables `x : α`, `y : β`, and `z : γ`.
|
||||
`let h : t := e` adds the hypothesis `h : t := e` to the current goal if `e` a term of type `t`.
|
||||
If `t` is omitted, it will be inferred.
|
||||
The variant `let pattern := e` is equivalent to `match e with | pattern => _`,
|
||||
and it is convenient for types that have only applicable constructor.
|
||||
Example: given `h : p ∧ q ∧ r`, `let ⟨h₁, h₂, h₃⟩ := h` produces the hypotheses
|
||||
`h₁ : p`, `h₂ : q`, and `h₃ : r`.
|
||||
-/
|
||||
macro "let " d:letDecl : tactic => `(tactic| refine_lift let $d:letDecl; ?_)
|
||||
/--
|
||||
@@ -1092,13 +1088,6 @@ Currently, all of these are on by default.
|
||||
-/
|
||||
syntax (name := omega) "omega" (config)? : tactic
|
||||
|
||||
/--
|
||||
`bv_omega` is `omega` with an additional preprocessor that turns statements about `BitVec` into statements about `Nat`.
|
||||
Currently the preprocessor is implemented as `try simp only [bv_toNat] at *`.
|
||||
`bv_toNat` is a `@[simp]` attribute that you can (cautiously) add to more theorems.
|
||||
-/
|
||||
macro "bv_omega" : tactic => `(tactic| (try simp only [bv_toNat] at *) <;> omega)
|
||||
|
||||
/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/
|
||||
syntax (name := normCast0) "norm_cast0" (location)? : tactic
|
||||
|
||||
@@ -1291,45 +1280,6 @@ a lemma from the list until it gets stuck.
|
||||
syntax (name := applyRules) "apply_rules" (config)? (&" only")? (args)? (using_)? : tactic
|
||||
end SolveByElim
|
||||
|
||||
/--
|
||||
Searches environment for definitions or theorems that can solve the goal using `exact`
|
||||
with conditions resolved by `solve_by_elim`.
|
||||
|
||||
The optional `using` clause provides identifiers in the local context that must be
|
||||
used by `exact?` when closing the goal. This is most useful if there are multiple
|
||||
ways to resolve the goal, and one wants to guide which lemma is used.
|
||||
-/
|
||||
syntax (name := exact?) "exact?" (" using " (colGt ident),+)? : tactic
|
||||
|
||||
/--
|
||||
Searches environment for definitions or theorems that can refine the goal using `apply`
|
||||
with conditions resolved when possible with `solve_by_elim`.
|
||||
|
||||
The optional `using` clause provides identifiers in the local context that must be
|
||||
used when closing the goal.
|
||||
-/
|
||||
syntax (name := apply?) "apply?" (" using " (colGt term),+)? : tactic
|
||||
|
||||
/--
|
||||
`show_term tac` runs `tac`, then prints the generated term in the form
|
||||
"exact X Y Z" or "refine X ?_ Z" if there are remaining subgoals.
|
||||
|
||||
(For some tactics, the printed term will not be human readable.)
|
||||
-/
|
||||
syntax (name := showTerm) "show_term " tacticSeq : tactic
|
||||
|
||||
/--
|
||||
`show_term e` elaborates `e`, then prints the generated term.
|
||||
-/
|
||||
macro (name := showTermElab) tk:"show_term " t:term : term =>
|
||||
`(term| no_implicit_lambda% (show_term_elab%$tk $t))
|
||||
|
||||
/--
|
||||
The command `by?` will print a suggestion for replacing the proof block with a proof term
|
||||
using `show_term`.
|
||||
-/
|
||||
macro (name := by?) tk:"by?" t:tacticSeq : term => `(show_term%$tk by%$tk $t)
|
||||
|
||||
end Tactic
|
||||
|
||||
namespace Attr
|
||||
@@ -1449,14 +1399,13 @@ macro_rules | `(‹$type›) => `((by assumption : $type))
|
||||
by the notation `arr[i]` to prove any side conditions that arise when
|
||||
constructing the term (e.g. the index is in bounds of the array).
|
||||
The default behavior is to just try `trivial` (which handles the case
|
||||
where `i < arr.size` is in the context) and `simp_arith` and `omega`
|
||||
where `i < arr.size` is in the context) and `simp_arith`
|
||||
(for doing linear arithmetic in the index).
|
||||
-/
|
||||
syntax "get_elem_tactic_trivial" : tactic
|
||||
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| omega)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| simp (config := { arith := true }); done)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| trivial)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| simp (config := { arith := true }); done)
|
||||
|
||||
/--
|
||||
`get_elem_tactic` is the tactic automatically called by the notation `arr[i]`
|
||||
@@ -1467,24 +1416,6 @@ users are encouraged to extend `get_elem_tactic_trivial` instead of this tactic.
|
||||
-/
|
||||
macro "get_elem_tactic" : tactic =>
|
||||
`(tactic| first
|
||||
/-
|
||||
Recall that `macro_rules` are tried in reverse order.
|
||||
We want `assumption` to be tried first.
|
||||
This is important for theorems such as
|
||||
```
|
||||
[simp] theorem getElem_pop (a : Array α) (i : Nat) (hi : i < a.pop.size) :
|
||||
a.pop[i] = a[i]'(Nat.lt_of_lt_of_le (a.size_pop ▸ hi) (Nat.sub_le _ _)) :=
|
||||
```
|
||||
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
|
||||
they add new `macro_rules` for `get_elem_tactic_trivial`.
|
||||
|
||||
TODO: Implement priorities for `macro_rules`.
|
||||
TODO: Ensure we have a **high-priority** macro_rules for `get_elem_tactic_trivial` which is just `assumption`.
|
||||
-/
|
||||
| assumption
|
||||
| get_elem_tactic_trivial
|
||||
| fail "failed to prove index is valid, possible solutions:
|
||||
- Use `have`-expressions to prove the index is valid
|
||||
@@ -1500,9 +1431,3 @@ macro_rules | `($x[$i]) => `(getElem $x $i (by get_elem_tactic))
|
||||
@[inherit_doc getElem]
|
||||
syntax term noWs "[" withoutPosition(term) "]'" term:max : term
|
||||
macro_rules | `($x[$i]'$h) => `(getElem $x $i $h)
|
||||
|
||||
/--
|
||||
Searches environment for definitions or theorems that can be substituted in
|
||||
for `exact?% to solve the goal.
|
||||
-/
|
||||
syntax (name := Lean.Parser.Syntax.exact?) "exact?%" : term
|
||||
|
||||
@@ -22,8 +22,7 @@ macro_rules | `(tactic| decreasing_trivial) => `(tactic| linarith)
|
||||
-/
|
||||
syntax "decreasing_trivial" : tactic
|
||||
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| (simp (config := { arith := true, failIfUnchanged := false })) <;> done)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| omega)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| (simp (config := { arith := true, failIfUnchanged := false })); done)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| assumption)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| apply Nat.sub_succ_lt_self; assumption) -- a - (i+1) < a - i if i < a
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| apply Nat.pred_lt'; assumption) -- i-1 < i if j < i
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.ProjFns
|
||||
import Lean.Meta.CtorRecognizer
|
||||
import Lean.Compiler.BorrowedAnnotation
|
||||
import Lean.Compiler.LCNF.Types
|
||||
import Lean.Compiler.LCNF.Bind
|
||||
@@ -620,7 +619,7 @@ where
|
||||
let rhs ← liftMetaM do Meta.whnf args[inductVal.numParams + inductVal.numIndices + 2]!
|
||||
let lhs := lhs.toCtorIfLit
|
||||
let rhs := rhs.toCtorIfLit
|
||||
match (← liftMetaM <| Meta.isConstructorApp? lhs), (← liftMetaM <| Meta.isConstructorApp? rhs) with
|
||||
match lhs.isConstructorApp? (← getEnv), rhs.isConstructorApp? (← getEnv) with
|
||||
| some lhsCtorVal, some rhsCtorVal =>
|
||||
if lhsCtorVal.name == rhsCtorVal.name then
|
||||
etaIfUnderApplied e (arity+1) do
|
||||
|
||||
@@ -8,7 +8,6 @@ prelude
|
||||
import Init.Data.List.Control
|
||||
import Init.Data.Range
|
||||
import Init.Data.OfScientific
|
||||
import Init.Data.Hashable
|
||||
import Lean.Data.RBMap
|
||||
namespace Lean
|
||||
|
||||
@@ -16,7 +15,7 @@ namespace Lean
|
||||
structure JsonNumber where
|
||||
mantissa : Int
|
||||
exponent : Nat
|
||||
deriving DecidableEq, Hashable
|
||||
deriving DecidableEq
|
||||
|
||||
namespace JsonNumber
|
||||
|
||||
@@ -206,19 +205,6 @@ private partial def beq' : Json → Json → Bool
|
||||
instance : BEq Json where
|
||||
beq := beq'
|
||||
|
||||
private partial def hash' : Json → UInt64
|
||||
| null => 11
|
||||
| bool b => mixHash 13 <| hash b
|
||||
| num n => mixHash 17 <| hash n
|
||||
| str s => mixHash 19 <| hash s
|
||||
| arr elems =>
|
||||
mixHash 23 <| elems.foldl (init := 7) fun r a => mixHash r (hash' a)
|
||||
| obj kvPairs =>
|
||||
mixHash 29 <| kvPairs.fold (init := 7) fun r k v => mixHash r <| mixHash (hash k) (hash' v)
|
||||
|
||||
instance : Hashable Json where
|
||||
hash := hash'
|
||||
|
||||
-- HACK(Marc): temporary ugliness until we can use RBMap for JSON objects
|
||||
def mkObj (o : List (String × Json)) : Json :=
|
||||
obj <| Id.run do
|
||||
|
||||
@@ -47,19 +47,19 @@ structure CompletionItem where
|
||||
documentation? : Option MarkupContent := none
|
||||
kind? : Option CompletionItemKind := none
|
||||
textEdit? : Option InsertReplaceEdit := none
|
||||
sortText? : Option String := none
|
||||
data? : Option Json := none
|
||||
/-
|
||||
tags? : CompletionItemTag[]
|
||||
deprecated? : boolean
|
||||
preselect? : boolean
|
||||
sortText? : string
|
||||
filterText? : string
|
||||
insertText? : string
|
||||
insertTextFormat? : InsertTextFormat
|
||||
insertTextMode? : InsertTextMode
|
||||
additionalTextEdits? : TextEdit[]
|
||||
commitCharacters? : string[]
|
||||
command? : Command -/
|
||||
command? : Command
|
||||
data? : any -/
|
||||
deriving FromJson, ToJson, Inhabited
|
||||
|
||||
structure CompletionList where
|
||||
@@ -274,7 +274,7 @@ structure CallHierarchyItem where
|
||||
uri : DocumentUri
|
||||
range : Range
|
||||
selectionRange : Range
|
||||
data? : Option Json := none
|
||||
-- data? : Option unknown
|
||||
deriving FromJson, ToJson, BEq, Hashable, Inhabited
|
||||
|
||||
structure CallHierarchyIncomingCallsParams where
|
||||
|
||||
@@ -86,10 +86,6 @@ def leanPosToLspPos (text : FileMap) : Lean.Position → Lsp.Position
|
||||
def utf8PosToLspPos (text : FileMap) (pos : String.Pos) : Lsp.Position :=
|
||||
text.leanPosToLspPos (text.toPosition pos)
|
||||
|
||||
/-- Gets the LSP range from a `String.Range`. -/
|
||||
def utf8RangeToLspRange (text : FileMap) (range : String.Range) : Lsp.Range :=
|
||||
{ start := text.utf8PosToLspPos range.start, «end» := text.utf8PosToLspPos range.stop }
|
||||
|
||||
end FileMap
|
||||
end Lean
|
||||
|
||||
|
||||
@@ -84,14 +84,14 @@ partial def insertAtCollisionNodeAux [BEq α] : CollisionNode α β → Nat →
|
||||
else insertAtCollisionNodeAux n (i+1) k v
|
||||
else
|
||||
⟨Node.collision (keys.push k) (vals.push v) (size_push heq k v), IsCollisionNode.mk _ _ _⟩
|
||||
| ⟨Node.entries _, h⟩, _, _, _ => nomatch h
|
||||
| ⟨Node.entries _, h⟩, _, _, _ => False.elim (nomatch h)
|
||||
|
||||
def insertAtCollisionNode [BEq α] : CollisionNode α β → α → β → CollisionNode α β :=
|
||||
fun n k v => insertAtCollisionNodeAux n 0 k v
|
||||
|
||||
def getCollisionNodeSize : CollisionNode α β → Nat
|
||||
| ⟨Node.collision keys _ _, _⟩ => keys.size
|
||||
| ⟨Node.entries _, h⟩ => nomatch h
|
||||
| ⟨Node.entries _, h⟩ => False.elim (nomatch h)
|
||||
|
||||
def mkCollisionNode (k₁ : α) (v₁ : β) (k₂ : α) (v₂ : β) : Node α β :=
|
||||
let ks : Array α := Array.mkEmpty maxCollisions
|
||||
@@ -105,7 +105,7 @@ partial def insertAux [BEq α] [Hashable α] : Node α β → USize → USize
|
||||
let newNode := insertAtCollisionNode ⟨Node.collision keys vals heq, IsCollisionNode.mk _ _ _⟩ k v
|
||||
if depth >= maxDepth || getCollisionNodeSize newNode < maxCollisions then newNode.val
|
||||
else match newNode with
|
||||
| ⟨Node.entries _, h⟩ => nomatch h
|
||||
| ⟨Node.entries _, h⟩ => False.elim (nomatch h)
|
||||
| ⟨Node.collision keys vals heq, _⟩ =>
|
||||
let rec traverse (i : Nat) (entries : Node α β) : Node α β :=
|
||||
if h : i < keys.size then
|
||||
|
||||
@@ -47,6 +47,3 @@ import Lean.Elab.Eval
|
||||
import Lean.Elab.Calc
|
||||
import Lean.Elab.InheritDoc
|
||||
import Lean.Elab.ParseImportsFast
|
||||
import Lean.Elab.GuardMsgs
|
||||
import Lean.Elab.CheckTactic
|
||||
import Lean.Elab.MatchExpr
|
||||
|
||||
@@ -534,10 +534,10 @@ open Meta
|
||||
def elabCheckCore (ignoreStuckTC : Bool) : CommandElab
|
||||
| `(#check%$tk $term) => withoutModifyingEnv <| runTermElabM fun _ => Term.withDeclName `_check do
|
||||
-- show signature for `#check id`/`#check @id`
|
||||
if let `($id:ident) := term then
|
||||
if let `($_:ident) := term then
|
||||
try
|
||||
for c in (← resolveGlobalConstWithInfos term) do
|
||||
addCompletionInfo <| .id term id.getId (danglingDot := false) {} none
|
||||
addCompletionInfo <| .id term c (danglingDot := false) {} none
|
||||
logInfoAt tk <| .ofPPFormat { pp := fun
|
||||
| some ctx => ctx.runMetaM <| PrettyPrinter.ppSignature c
|
||||
| none => return f!"{c}" -- should never happen
|
||||
|
||||
@@ -99,14 +99,6 @@ private def elabOptLevel (stx : Syntax) : TermElabM Level :=
|
||||
else
|
||||
throwError "synthetic hole has already been defined with an incompatible local context"
|
||||
|
||||
@[builtin_term_elab Lean.Parser.Term.omission] def elabOmission : TermElab := fun stx expectedType? => do
|
||||
logWarning m!"\
|
||||
The '⋯' token is used by the pretty printer to indicate omitted terms, and it should not be used directly. \
|
||||
It logs this warning and then elaborates like `_`.\
|
||||
\n\nThe presence of `⋯` in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
|
||||
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
|
||||
elabHole stx expectedType?
|
||||
|
||||
@[builtin_term_elab «letMVar»] def elabLetMVar : TermElab := fun stx expectedType? => do
|
||||
match stx with
|
||||
| `(let_mvar% ? $n := $e; $b) =>
|
||||
@@ -166,10 +158,7 @@ private def mkTacticMVar (type : Expr) (tacticCode : Syntax) : TermElabM Expr :=
|
||||
@[builtin_term_elab noImplicitLambda] def elabNoImplicitLambda : TermElab := fun stx expectedType? =>
|
||||
elabTerm stx[1] (mkNoImplicitLambdaAnnotation <$> expectedType?)
|
||||
|
||||
@[builtin_term_elab Lean.Parser.Term.cdot] def elabBadCDot : TermElab := fun stx expectedType? => do
|
||||
if stx[0].getAtomVal == "." then
|
||||
-- Users may input bad cdots because they are trying to auto-complete them using the expected type
|
||||
addCompletionInfo <| CompletionInfo.dotId stx .anonymous (← getLCtx) expectedType?
|
||||
@[builtin_term_elab Lean.Parser.Term.cdot] def elabBadCDot : TermElab := fun _ _ =>
|
||||
throwError "invalid occurrence of `·` notation, it must be surrounded by parentheses (e.g. `(· + 1)`)"
|
||||
|
||||
@[builtin_term_elab str] def elabStrLit : TermElab := fun stx _ => do
|
||||
|
||||
@@ -1,95 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.ElabTerm
|
||||
import Lean.Elab.Command
|
||||
import Lean.Elab.Tactic.Meta
|
||||
|
||||
/-!
|
||||
Commands to validate tactic results.
|
||||
-/
|
||||
|
||||
namespace Lean.Elab.CheckTactic
|
||||
|
||||
open Lean.Meta CheckTactic
|
||||
open Lean.Elab.Tactic
|
||||
open Lean.Elab.Command
|
||||
|
||||
private def matchCheckGoalType (stx : Syntax) (goalType : Expr) : MetaM (Expr × Expr × Level) := do
|
||||
let u ← mkFreshLevelMVar
|
||||
let type ← mkFreshExprMVar (some (.sort u))
|
||||
let val ← mkFreshExprMVar (some type)
|
||||
let extType := mkAppN (.const ``CheckGoalType [u]) #[type, val]
|
||||
if !(← isDefEq goalType extType) then
|
||||
throwErrorAt stx "Goal{indentExpr goalType}\nis expected to match {indentExpr extType}"
|
||||
pure (val, type, u)
|
||||
|
||||
@[builtin_command_elab Lean.Parser.checkTactic]
|
||||
def elabCheckTactic : CommandElab := fun stx => do
|
||||
let `(#check_tactic $t ~> $result by $tac) := stx | throwUnsupportedSyntax
|
||||
withoutModifyingEnv $ do
|
||||
runTermElabM $ fun _vars => do
|
||||
let u ← Lean.Elab.Term.elabTerm t none
|
||||
let type ← inferType u
|
||||
let lvl ← mkFreshLevelMVar
|
||||
let checkGoalType : Expr := mkApp2 (mkConst ``CheckGoalType [lvl]) type u
|
||||
let mvar ← mkFreshExprMVar (.some checkGoalType)
|
||||
let (goals, _) ← Lean.Elab.runTactic mvar.mvarId! tac.raw
|
||||
let expTerm ← Lean.Elab.Term.elabTerm result (.some type)
|
||||
match goals with
|
||||
| [] =>
|
||||
throwErrorAt stx
|
||||
m!"{tac} closed goal, but is expected to reduce to {indentExpr expTerm}."
|
||||
| [next] => do
|
||||
let (val, _, _) ← matchCheckGoalType stx (←next.getType)
|
||||
if !(← Meta.withReducible <| isDefEq val expTerm) then
|
||||
throwErrorAt stx
|
||||
m!"Term reduces to{indentExpr val}\nbut is expected to reduce to {indentExpr expTerm}"
|
||||
| _ => do
|
||||
throwErrorAt stx
|
||||
m!"{tac} produced multiple goals, but is expected to reduce to {indentExpr expTerm}."
|
||||
pure ()
|
||||
|
||||
@[builtin_command_elab Lean.Parser.checkTacticFailure]
|
||||
def elabCheckTacticFailure : CommandElab := fun stx => do
|
||||
let `(#check_tactic_failure $t by $tactic) := stx | throwUnsupportedSyntax
|
||||
withoutModifyingEnv $ do
|
||||
runTermElabM $ fun _vars => do
|
||||
let val ← Lean.Elab.Term.elabTerm t none
|
||||
let type ← inferType val
|
||||
let lvl ← mkFreshLevelMVar
|
||||
let checkGoalType : Expr := mkApp2 (mkConst ``CheckGoalType [lvl]) type val
|
||||
let mvar ← mkFreshExprMVar (.some checkGoalType)
|
||||
let act := Lean.Elab.runTactic mvar.mvarId! tactic.raw
|
||||
match ← try (Term.withoutErrToSorry (some <$> act)) catch _ => pure none with
|
||||
| none =>
|
||||
pure ()
|
||||
| some (gls, _) =>
|
||||
let ppGoal (g : MVarId) := do
|
||||
let (val, _type, _u) ← matchCheckGoalType stx (← g.getType)
|
||||
pure m!"{indentExpr val}"
|
||||
let msg ←
|
||||
match gls with
|
||||
| [] => pure m!"{tactic} expected to fail on {val}, but closed goal."
|
||||
| [g] =>
|
||||
pure <| m!"{tactic} expected to fail on {val}, but returned: {←ppGoal g}"
|
||||
| gls =>
|
||||
let app m g := do pure <| m ++ (←ppGoal g)
|
||||
let init := m!"{tactic} expected to fail on {val}, but returned goals:"
|
||||
gls.foldlM (init := init) app
|
||||
throwErrorAt stx msg
|
||||
|
||||
@[builtin_macro Lean.Parser.checkSimp]
|
||||
def expandCheckSimp : Macro := fun stx => do
|
||||
let `(#check_simp $t ~> $exp) := stx | Macro.throwUnsupported
|
||||
`(command|#check_tactic $t ~> $exp by simp)
|
||||
|
||||
@[builtin_macro Lean.Parser.checkSimpFailure]
|
||||
def expandCheckSimpFailure : Macro := fun stx => do
|
||||
let `(#check_simp $t !~>) := stx | Macro.throwUnsupported
|
||||
`(command|#check_tactic_failure $t by simp)
|
||||
|
||||
end Lean.Elab.CheckTactic
|
||||
@@ -347,21 +347,7 @@ def elabMutual : CommandElab := fun stx => do
|
||||
let attrs ← elabAttrs attrInsts
|
||||
let idents := stx[4].getArgs
|
||||
for ident in idents do withRef ident <| liftTermElabM do
|
||||
/-
|
||||
HACK to allow `attribute` command to disable builtin simprocs.
|
||||
TODO: find a better solution. Example: have some "fake" declaration
|
||||
for builtin simprocs.
|
||||
-/
|
||||
let declNames ←
|
||||
try
|
||||
resolveGlobalConst ident
|
||||
catch _ =>
|
||||
let name := ident.getId.eraseMacroScopes
|
||||
if (← Simp.isBuiltinSimproc name) then
|
||||
pure [name]
|
||||
else
|
||||
throwUnknownConstant name
|
||||
let declName ← ensureNonAmbiguous ident declNames
|
||||
let declName ← resolveGlobalConstNoOverloadWithInfo ident
|
||||
Term.applyAttributes declName attrs
|
||||
for attrName in toErase do
|
||||
Attribute.erase declName attrName
|
||||
|
||||
@@ -131,31 +131,12 @@ abbrev Var := Syntax -- TODO: should be `Ident`
|
||||
|
||||
/-- A `doMatch` alternative. `vars` is the array of variables declared by `patterns`. -/
|
||||
structure Alt (σ : Type) where
|
||||
ref : Syntax
|
||||
vars : Array Var
|
||||
ref : Syntax
|
||||
vars : Array Var
|
||||
patterns : Syntax
|
||||
rhs : σ
|
||||
rhs : σ
|
||||
deriving Inhabited
|
||||
|
||||
/-- A `doMatchExpr` alternative. -/
|
||||
structure AltExpr (σ : Type) where
|
||||
ref : Syntax
|
||||
var? : Option Var
|
||||
funName : Syntax
|
||||
pvars : Array Syntax
|
||||
rhs : σ
|
||||
deriving Inhabited
|
||||
|
||||
def AltExpr.vars (alt : AltExpr σ) : Array Var := Id.run do
|
||||
let mut vars := #[]
|
||||
if let some var := alt.var? then
|
||||
vars := vars.push var
|
||||
for pvar in alt.pvars do
|
||||
match pvar with
|
||||
| `(_) => pure ()
|
||||
| _ => vars := vars.push pvar
|
||||
return vars
|
||||
|
||||
/--
|
||||
Auxiliary datastructure for representing a `do` code block, and compiling "reassignments" (e.g., `x := x + 1`).
|
||||
We convert `Code` into a `Syntax` term representing the:
|
||||
@@ -217,7 +198,6 @@ inductive Code where
|
||||
/-- Recall that an if-then-else may declare a variable using `optIdent` for the branches `thenBranch` and `elseBranch`. We store the variable name at `var?`. -/
|
||||
| ite (ref : Syntax) (h? : Option Var) (optIdent : Syntax) (cond : Syntax) (thenBranch : Code) (elseBranch : Code)
|
||||
| match (ref : Syntax) (gen : Syntax) (discrs : Syntax) (optMotive : Syntax) (alts : Array (Alt Code))
|
||||
| matchExpr (ref : Syntax) (meta : Bool) (discr : Syntax) (alts : Array (AltExpr Code)) (elseBranch : Code)
|
||||
| jmp (ref : Syntax) (jpName : Name) (args : Array Syntax)
|
||||
deriving Inhabited
|
||||
|
||||
@@ -232,7 +212,6 @@ def Code.getRef? : Code → Option Syntax
|
||||
| .return ref _ => ref
|
||||
| .ite ref .. => ref
|
||||
| .match ref .. => ref
|
||||
| .matchExpr ref .. => ref
|
||||
| .jmp ref .. => ref
|
||||
|
||||
abbrev VarSet := RBMap Name Syntax Name.cmp
|
||||
@@ -264,28 +243,19 @@ partial def CodeBlocl.toMessageData (codeBlock : CodeBlock) : MessageData :=
|
||||
| .match _ _ ds _ alts =>
|
||||
m!"match {ds} with"
|
||||
++ alts.foldl (init := m!"") fun acc alt => acc ++ m!"\n| {alt.patterns} => {loop alt.rhs}"
|
||||
| .matchExpr _ meta d alts elseCode =>
|
||||
let r := m!"match_expr {if meta then "" else "(meta := false)"} {d} with"
|
||||
let r := r ++ alts.foldl (init := m!"") fun acc alt =>
|
||||
let acc := acc ++ m!"\n| {if let some var := alt.var? then m!"{var}@" else ""}"
|
||||
let acc := acc ++ m!"{alt.funName}"
|
||||
let acc := acc ++ alt.pvars.foldl (init := m!"") fun acc pvar => acc ++ m!" {pvar}"
|
||||
acc ++ m!" => {loop alt.rhs}"
|
||||
r ++ m!"| _ => {loop elseCode}"
|
||||
loop codeBlock.code
|
||||
|
||||
/-- Return true if the give code contains an exit point that satisfies `p` -/
|
||||
partial def hasExitPointPred (c : Code) (p : Code → Bool) : Bool :=
|
||||
let rec loop : Code → Bool
|
||||
| .decl _ _ k => loop k
|
||||
| .reassign _ _ k => loop k
|
||||
| .joinpoint _ _ b k => loop b || loop k
|
||||
| .seq _ k => loop k
|
||||
| .ite _ _ _ _ t e => loop t || loop e
|
||||
| .match _ _ _ _ alts => alts.any (loop ·.rhs)
|
||||
| .matchExpr _ _ _ alts e => alts.any (loop ·.rhs) || loop e
|
||||
| .jmp .. => false
|
||||
| c => p c
|
||||
| .decl _ _ k => loop k
|
||||
| .reassign _ _ k => loop k
|
||||
| .joinpoint _ _ b k => loop b || loop k
|
||||
| .seq _ k => loop k
|
||||
| .ite _ _ _ _ t e => loop t || loop e
|
||||
| .match _ _ _ _ alts => alts.any (loop ·.rhs)
|
||||
| .jmp .. => false
|
||||
| c => p c
|
||||
loop c
|
||||
|
||||
def hasExitPoint (c : Code) : Bool :=
|
||||
@@ -330,18 +300,13 @@ partial def convertTerminalActionIntoJmp (code : Code) (jp : Name) (xs : Array V
|
||||
| .joinpoint n ps b k => return .joinpoint n ps (← loop b) (← loop k)
|
||||
| .seq e k => return .seq e (← loop k)
|
||||
| .ite ref x? h c t e => return .ite ref x? h c (← loop t) (← loop e)
|
||||
| .match ref g ds t alts => return .match ref g ds t (← alts.mapM fun alt => do pure { alt with rhs := (← loop alt.rhs) })
|
||||
| .action e => mkAuxDeclFor e fun y =>
|
||||
let ref := e
|
||||
-- We jump to `jp` with xs **and** y
|
||||
let jmpArgs := xs.push y
|
||||
return Code.jmp ref jp jmpArgs
|
||||
| .match ref g ds t alts =>
|
||||
return .match ref g ds t (← alts.mapM fun alt => do pure { alt with rhs := (← loop alt.rhs) })
|
||||
| .matchExpr ref meta d alts e => do
|
||||
let alts ← alts.mapM fun alt => do pure { alt with rhs := (← loop alt.rhs) }
|
||||
let e ← loop e
|
||||
return .matchExpr ref meta d alts e
|
||||
| c => return c
|
||||
| c => return c
|
||||
loop code
|
||||
|
||||
structure JPDecl where
|
||||
@@ -407,13 +372,14 @@ def mkJmp (ref : Syntax) (rs : VarSet) (val : Syntax) (mkJPBody : Syntax → Mac
|
||||
return Code.jmp ref jp args
|
||||
|
||||
/-- `pullExitPointsAux rs c` auxiliary method for `pullExitPoints`, `rs` is the set of update variable in the current path. -/
|
||||
partial def pullExitPointsAux (rs : VarSet) (c : Code) : StateRefT (Array JPDecl) TermElabM Code := do
|
||||
partial def pullExitPointsAux (rs : VarSet) (c : Code) : StateRefT (Array JPDecl) TermElabM Code :=
|
||||
match c with
|
||||
| .decl xs stx k => return .decl xs stx (← pullExitPointsAux (eraseVars rs xs) k)
|
||||
| .reassign xs stx k => return .reassign xs stx (← pullExitPointsAux (insertVars rs xs) k)
|
||||
| .joinpoint j ps b k => return .joinpoint j ps (← pullExitPointsAux rs b) (← pullExitPointsAux rs k)
|
||||
| .seq e k => return .seq e (← pullExitPointsAux rs k)
|
||||
| .ite ref x? o c t e => return .ite ref x? o c (← pullExitPointsAux (eraseOptVar rs x?) t) (← pullExitPointsAux (eraseOptVar rs x?) e)
|
||||
| .match ref g ds t alts => return .match ref g ds t (← alts.mapM fun alt => do pure { alt with rhs := (← pullExitPointsAux (eraseVars rs alt.vars) alt.rhs) })
|
||||
| .jmp .. => return c
|
||||
| .break ref => mkSimpleJmp ref rs (.break ref)
|
||||
| .continue ref => mkSimpleJmp ref rs (.continue ref)
|
||||
@@ -423,13 +389,6 @@ partial def pullExitPointsAux (rs : VarSet) (c : Code) : StateRefT (Array JPDecl
|
||||
mkAuxDeclFor e fun y =>
|
||||
let ref := e
|
||||
mkJmp ref rs y (fun yFresh => return .action (← ``(Pure.pure $yFresh)))
|
||||
| .match ref g ds t alts =>
|
||||
let alts ← alts.mapM fun alt => do pure { alt with rhs := (← pullExitPointsAux (eraseVars rs alt.vars) alt.rhs) }
|
||||
return .match ref g ds t alts
|
||||
| .matchExpr ref meta d alts e =>
|
||||
let alts ← alts.mapM fun alt => do pure { alt with rhs := (← pullExitPointsAux (eraseVars rs alt.vars) alt.rhs) }
|
||||
let e ← pullExitPointsAux rs e
|
||||
return .matchExpr ref meta d alts e
|
||||
|
||||
/--
|
||||
Auxiliary operation for adding new variables to the collection of updated variables in a CodeBlock.
|
||||
@@ -498,14 +457,6 @@ partial def extendUpdatedVarsAux (c : Code) (ws : VarSet) : TermElabM Code :=
|
||||
pullExitPoints c
|
||||
else
|
||||
return .match ref g ds t (← alts.mapM fun alt => do pure { alt with rhs := (← update alt.rhs) })
|
||||
| .matchExpr ref meta d alts e =>
|
||||
if alts.any fun alt => alt.vars.any fun x => ws.contains x.getId then
|
||||
-- If a pattern variable is shadowing a variable in ws, we `pullExitPoints`
|
||||
pullExitPoints c
|
||||
else
|
||||
let alts ← alts.mapM fun alt => do pure { alt with rhs := (← update alt.rhs) }
|
||||
let e ← update e
|
||||
return .matchExpr ref meta d alts e
|
||||
| .ite ref none o c t e => return .ite ref none o c (← update t) (← update e)
|
||||
| .ite ref (some h) o cond t e =>
|
||||
if ws.contains h.getId then
|
||||
@@ -619,16 +570,6 @@ def mkMatch (ref : Syntax) (genParam : Syntax) (discrs : Syntax) (optMotive : Sy
|
||||
return { ref := alt.ref, vars := alt.vars, patterns := alt.patterns, rhs := rhs.code : Alt Code }
|
||||
return { code := .match ref genParam discrs optMotive alts, uvars := ws }
|
||||
|
||||
def mkMatchExpr (ref : Syntax) (meta : Bool) (discr : Syntax) (alts : Array (AltExpr CodeBlock)) (elseBranch : CodeBlock) : TermElabM CodeBlock := do
|
||||
-- nary version of homogenize
|
||||
let ws := alts.foldl (union · ·.rhs.uvars) {}
|
||||
let ws := union ws elseBranch.uvars
|
||||
let alts ← alts.mapM fun alt => do
|
||||
let rhs ← extendUpdatedVars alt.rhs ws
|
||||
return { alt with rhs := rhs.code : AltExpr Code }
|
||||
let elseBranch ← extendUpdatedVars elseBranch ws
|
||||
return { code := .matchExpr ref meta discr alts elseBranch.code, uvars := ws }
|
||||
|
||||
/-- Return a code block that executes `terminal` and then `k` with the value produced by `terminal`.
|
||||
This method assumes `terminal` is a terminal -/
|
||||
def concat (terminal : CodeBlock) (kRef : Syntax) (y? : Option Var) (k : CodeBlock) : TermElabM CodeBlock := do
|
||||
@@ -765,19 +706,6 @@ private def expandDoIf? (stx : Syntax) : MacroM (Option Syntax) := match stx wit
|
||||
return some e
|
||||
| _ => pure none
|
||||
|
||||
/--
|
||||
If the given syntax is a `doLetExpr` or `doLetMetaExpr`, return an equivalent `doIf` that has an `else` but no `else if`s or `if let`s. -/
|
||||
private def expandDoLetExpr? (stx : Syntax) (doElems : List Syntax) : MacroM (Option Syntax) := match stx with
|
||||
| `(doElem| let_expr $pat:matchExprPat := $discr:term | $elseBranch:doSeq) =>
|
||||
return some (← `(doElem| match_expr (meta := false) $discr:term with
|
||||
| $pat:matchExprPat => $(mkDoSeq doElems.toArray)
|
||||
| _ => $elseBranch))
|
||||
| `(doElem| let_expr $pat:matchExprPat ← $discr:term | $elseBranch:doSeq) =>
|
||||
return some (← `(doElem| match_expr $discr:term with
|
||||
| $pat:matchExprPat => $(mkDoSeq doElems.toArray)
|
||||
| _ => $elseBranch))
|
||||
| _ => return none
|
||||
|
||||
structure DoIfView where
|
||||
ref : Syntax
|
||||
optIdent : Syntax
|
||||
@@ -1149,26 +1077,10 @@ where
|
||||
let mut termAlts := #[]
|
||||
for alt in alts do
|
||||
let rhs ← toTerm alt.rhs
|
||||
let termAlt := mkNode ``Parser.Term.matchAlt #[mkAtomFrom alt.ref "|", mkNullNode #[alt.patterns], mkAtomFrom alt.ref "=>", rhs]
|
||||
let termAlt := mkNode `Lean.Parser.Term.matchAlt #[mkAtomFrom alt.ref "|", mkNullNode #[alt.patterns], mkAtomFrom alt.ref "=>", rhs]
|
||||
termAlts := termAlts.push termAlt
|
||||
let termMatchAlts := mkNode ``Parser.Term.matchAlts #[mkNullNode termAlts]
|
||||
return mkNode ``Parser.Term.«match» #[mkAtomFrom ref "match", genParam, optMotive, discrs, mkAtomFrom ref "with", termMatchAlts]
|
||||
| .matchExpr ref meta d alts elseBranch => withFreshMacroScope do
|
||||
let d' ← `(discr)
|
||||
let mut termAlts := #[]
|
||||
for alt in alts do
|
||||
let rhs ← `(($(← toTerm alt.rhs) : $((← read).m) _))
|
||||
let optVar := if let some var := alt.var? then mkNullNode #[var, mkAtomFrom var "@"] else mkNullNode #[]
|
||||
let pat := mkNode ``Parser.Term.matchExprPat #[optVar, alt.funName, mkNullNode alt.pvars]
|
||||
let termAlt := mkNode ``Parser.Term.matchExprAlt #[mkAtomFrom alt.ref "|", pat, mkAtomFrom alt.ref "=>", rhs]
|
||||
termAlts := termAlts.push termAlt
|
||||
let elseBranch := mkNode ``Parser.Term.matchExprElseAlt #[mkAtomFrom ref "|", mkHole ref, mkAtomFrom ref "=>", (← toTerm elseBranch)]
|
||||
let termMatchExprAlts := mkNode ``Parser.Term.matchExprAlts #[mkNullNode termAlts, elseBranch]
|
||||
let body := mkNode ``Parser.Term.matchExpr #[mkAtomFrom ref "match_expr", d', mkAtomFrom ref "with", termMatchExprAlts]
|
||||
if meta then
|
||||
`(Bind.bind (instantiateMVarsIfMVarApp $d) fun discr => $body)
|
||||
else
|
||||
`(let discr := $d; $body)
|
||||
let termMatchAlts := mkNode `Lean.Parser.Term.matchAlts #[mkNullNode termAlts]
|
||||
return mkNode `Lean.Parser.Term.«match» #[mkAtomFrom ref "match", genParam, optMotive, discrs, mkAtomFrom ref "with", termMatchAlts]
|
||||
|
||||
def run (code : Code) (m : Syntax) (returnType : Syntax) (uvars : Array Var := #[]) (kind := Kind.regular) : MacroM Syntax :=
|
||||
toTerm code { m, returnType, kind, uvars }
|
||||
@@ -1621,24 +1533,6 @@ mutual
|
||||
let matchCode ← mkMatch ref genParam discrs optMotive alts
|
||||
concatWith matchCode doElems
|
||||
|
||||
/-- Generate `CodeBlock` for `doMatchExpr; doElems` -/
|
||||
partial def doMatchExprToCode (doMatchExpr : Syntax) (doElems: List Syntax) : M CodeBlock := do
|
||||
let ref := doMatchExpr
|
||||
let meta := doMatchExpr[1].isNone
|
||||
let discr := doMatchExpr[2]
|
||||
let alts := doMatchExpr[4][0].getArgs -- Array of `doMatchExprAlt`
|
||||
let alts ← alts.mapM fun alt => do
|
||||
let pat := alt[1]
|
||||
let var? := if pat[0].isNone then none else some pat[0][0]
|
||||
let funName := pat[1]
|
||||
let pvars := pat[2].getArgs
|
||||
let rhs := alt[3]
|
||||
let rhs ← doSeqToCode (getDoSeqElems rhs)
|
||||
pure { ref, var?, funName, pvars, rhs }
|
||||
let elseBranch ← doSeqToCode (getDoSeqElems doMatchExpr[4][1][3])
|
||||
let matchCode ← mkMatchExpr ref meta discr alts elseBranch
|
||||
concatWith matchCode doElems
|
||||
|
||||
/--
|
||||
Generate `CodeBlock` for `doTry; doElems`
|
||||
```
|
||||
@@ -1708,9 +1602,6 @@ mutual
|
||||
| none =>
|
||||
match (← liftMacroM <| expandDoIf? doElem) with
|
||||
| some doElem => doSeqToCode (doElem::doElems)
|
||||
| none =>
|
||||
match (← liftMacroM <| expandDoLetExpr? doElem doElems) with
|
||||
| some doElem => doSeqToCode [doElem]
|
||||
| none =>
|
||||
let (liftedDoElems, doElem) ← expandLiftMethod doElem
|
||||
if !liftedDoElems.isEmpty then
|
||||
@@ -1749,8 +1640,6 @@ mutual
|
||||
doForToCode doElem doElems
|
||||
else if k == ``Parser.Term.doMatch then
|
||||
doMatchToCode doElem doElems
|
||||
else if k == ``Parser.Term.doMatchExpr then
|
||||
doMatchExprToCode doElem doElems
|
||||
else if k == ``Parser.Term.doTry then
|
||||
doTryToCode doElem doElems
|
||||
else if k == ``Parser.Term.doBreak then
|
||||
|
||||
@@ -488,10 +488,8 @@ def elabBinRelCore (noProp : Bool) (stx : Syntax) (expectedType? : Option Expr)
|
||||
```
|
||||
We can improve this failure in the future by applying default instances before reporting a type mismatch.
|
||||
-/
|
||||
let lhsStx := stx[2]
|
||||
let rhsStx := stx[3]
|
||||
let lhs ← withRef lhsStx <| toTree lhsStx
|
||||
let rhs ← withRef rhsStx <| toTree rhsStx
|
||||
let lhs ← withRef stx[2] <| toTree stx[2]
|
||||
let rhs ← withRef stx[3] <| toTree stx[3]
|
||||
let tree := .binop stx .regular f lhs rhs
|
||||
let r ← analyze tree none
|
||||
trace[Elab.binrel] "hasUncomparable: {r.hasUncomparable}, maxType: {r.max?}"
|
||||
@@ -499,10 +497,10 @@ def elabBinRelCore (noProp : Bool) (stx : Syntax) (expectedType? : Option Expr)
|
||||
-- Use default elaboration strategy + `toBoolIfNecessary`
|
||||
let lhs ← toExprCore lhs
|
||||
let rhs ← toExprCore rhs
|
||||
let lhs ← withRef lhsStx <| toBoolIfNecessary lhs
|
||||
let rhs ← withRef rhsStx <| toBoolIfNecessary rhs
|
||||
let lhs ← toBoolIfNecessary lhs
|
||||
let rhs ← toBoolIfNecessary rhs
|
||||
let lhsType ← inferType lhs
|
||||
let rhs ← withRef rhsStx <| ensureHasType lhsType rhs
|
||||
let rhs ← ensureHasType lhsType rhs
|
||||
elabAppArgs f #[] #[Arg.expr lhs, Arg.expr rhs] expectedType? (explicit := false) (ellipsis := false) (resultIsOutParamSupport := false)
|
||||
else
|
||||
let mut maxType := r.max?.get!
|
||||
|
||||
@@ -1,136 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2023 Kyle Miller. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Kyle Miller
|
||||
-/
|
||||
prelude
|
||||
import Lean.Server.CodeActions.Attr
|
||||
|
||||
/-! `#guard_msgs` command for testing commands
|
||||
|
||||
This module defines a command to test that another command produces the expected messages.
|
||||
See the docstring on the `#guard_msgs` command.
|
||||
-/
|
||||
|
||||
open Lean Parser.Tactic Elab Command
|
||||
|
||||
namespace Lean.Elab.Tactic.GuardMsgs
|
||||
|
||||
/-- Gives a string representation of a message without source position information.
|
||||
Ensures the message ends with a '\n'. -/
|
||||
private def messageToStringWithoutPos (msg : Message) : IO String := do
|
||||
let mut str ← msg.data.toString
|
||||
unless msg.caption == "" do
|
||||
str := msg.caption ++ ":\n" ++ str
|
||||
if !("\n".isPrefixOf str) then str := " " ++ str
|
||||
match msg.severity with
|
||||
| MessageSeverity.information => str := "info:" ++ str
|
||||
| MessageSeverity.warning => str := "warning:" ++ str
|
||||
| MessageSeverity.error => str := "error:" ++ str
|
||||
if str.isEmpty || str.back != '\n' then
|
||||
str := str ++ "\n"
|
||||
return str
|
||||
|
||||
/-- The decision made by a specification for a message. -/
|
||||
inductive SpecResult
|
||||
/-- Capture the message and check it matches the docstring. -/
|
||||
| check
|
||||
/-- Drop the message and delete it. -/
|
||||
| drop
|
||||
/-- Do not capture the message. -/
|
||||
| passthrough
|
||||
|
||||
/-- Parses a `guardMsgsSpec`.
|
||||
- No specification: check everything.
|
||||
- With a specification: interpret the spec, and if nothing applies pass it through. -/
|
||||
def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) :
|
||||
CommandElabM (Message → SpecResult) := do
|
||||
if let some spec := spec? then
|
||||
match spec with
|
||||
| `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => do
|
||||
let mut p : Message → SpecResult := fun _ => .passthrough
|
||||
let pushP (s : MessageSeverity) (drop : Bool) (p : Message → SpecResult)
|
||||
(msg : Message) : SpecResult :=
|
||||
if msg.severity == s then if drop then .drop else .check
|
||||
else p msg
|
||||
for elt in elts.reverse do
|
||||
match elt with
|
||||
| `(guardMsgsSpecElt| $[drop%$drop?]? info) => p := pushP .information drop?.isSome p
|
||||
| `(guardMsgsSpecElt| $[drop%$drop?]? warning) => p := pushP .warning drop?.isSome p
|
||||
| `(guardMsgsSpecElt| $[drop%$drop?]? error) => p := pushP .error drop?.isSome p
|
||||
| `(guardMsgsSpecElt| $[drop%$drop?]? all) =>
|
||||
p := fun _ => if drop?.isSome then .drop else .check
|
||||
| _ => throwErrorAt elt "Invalid #guard_msgs specification element"
|
||||
return p
|
||||
| _ => throwErrorAt spec "Invalid #guard_msgs specification"
|
||||
else
|
||||
return fun _ => .check
|
||||
|
||||
/-- An info tree node corresponding to a failed `#guard_msgs` invocation,
|
||||
used for code action support. -/
|
||||
structure GuardMsgFailure where
|
||||
/-- The result of the nested command -/
|
||||
res : String
|
||||
deriving TypeName
|
||||
|
||||
@[builtin_command_elab Lean.guardMsgsCmd] def elabGuardMsgs : CommandElab
|
||||
| `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do
|
||||
let expected : String := (← dc?.mapM (getDocStringText ·)).getD "" |>.trim
|
||||
let specFn ← parseGuardMsgsSpec spec?
|
||||
let initMsgs ← modifyGet fun st => (st.messages, { st with messages := {} })
|
||||
elabCommandTopLevel cmd
|
||||
let msgs := (← get).messages
|
||||
let mut toCheck : MessageLog := .empty
|
||||
let mut toPassthrough : MessageLog := .empty
|
||||
for msg in msgs.toList do
|
||||
match specFn msg with
|
||||
| .check => toCheck := toCheck.add msg
|
||||
| .drop => pure ()
|
||||
| .passthrough => toPassthrough := toPassthrough.add msg
|
||||
let res := "---\n".intercalate (← toCheck.toList.mapM (messageToStringWithoutPos ·)) |>.trim
|
||||
-- We do some whitespace normalization here to allow users to break long lines.
|
||||
if expected.replace "\n" " " == res.replace "\n" " " then
|
||||
-- Passed. Only put toPassthrough messages back on the message log
|
||||
modify fun st => { st with messages := initMsgs ++ toPassthrough }
|
||||
else
|
||||
-- Failed. Put all the messages back on the message log and add an error
|
||||
modify fun st => { st with messages := initMsgs ++ msgs }
|
||||
logErrorAt tk m!"❌ Docstring on `#guard_msgs` does not match generated message:\n\n{res}"
|
||||
pushInfoLeaf (.ofCustomInfo { stx := ← getRef, value := Dynamic.mk (GuardMsgFailure.mk res) })
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
open CodeAction Server RequestM in
|
||||
/-- A code action which will update the doc comment on a `#guard_msgs` invocation. -/
|
||||
@[builtin_command_code_action guardMsgsCmd]
|
||||
def guardMsgsCodeAction : CommandCodeAction := fun _ _ _ node => do
|
||||
let .node _ ts := node | return #[]
|
||||
let res := ts.findSome? fun
|
||||
| .node (.ofCustomInfo { stx, value }) _ => return (stx, (← value.get? GuardMsgFailure).res)
|
||||
| _ => none
|
||||
let some (stx, res) := res | return #[]
|
||||
let doc ← readDoc
|
||||
let eager := {
|
||||
title := "Update #guard_msgs with tactic output"
|
||||
kind? := "quickfix"
|
||||
isPreferred? := true
|
||||
}
|
||||
pure #[{
|
||||
eager
|
||||
lazy? := some do
|
||||
let some start := stx.getPos? true | return eager
|
||||
let some tail := stx.setArg 0 mkNullNode |>.getPos? true | return eager
|
||||
let newText := if res.isEmpty then
|
||||
""
|
||||
else if res.length ≤ 100-7 && !res.contains '\n' then -- TODO: configurable line length?
|
||||
s!"/-- {res} -/\n"
|
||||
else
|
||||
s!"/--\n{res}\n-/\n"
|
||||
pure { eager with
|
||||
edit? := some <|.ofTextEdit doc.versionedIdentifier {
|
||||
range := doc.meta.text.utf8RangeToLspRange ⟨start, tail⟩
|
||||
newText
|
||||
}
|
||||
}
|
||||
}]
|
||||
|
||||
end Lean.Elab.Tactic.GuardMsgs
|
||||
@@ -49,25 +49,14 @@ def PartialContextInfo.mergeIntoOuter?
|
||||
some { outer with parentDecl? := innerParentDecl }
|
||||
|
||||
def CompletionInfo.stx : CompletionInfo → Syntax
|
||||
| dot i .. => i.stx
|
||||
| id stx .. => stx
|
||||
| dotId stx .. => stx
|
||||
| fieldId stx .. => stx
|
||||
| namespaceId stx => stx
|
||||
| option stx => stx
|
||||
| dot i .. => i.stx
|
||||
| id stx .. => stx
|
||||
| dotId stx .. => stx
|
||||
| fieldId stx .. => stx
|
||||
| namespaceId stx => stx
|
||||
| option stx => stx
|
||||
| endSection stx .. => stx
|
||||
| tactic stx .. => stx
|
||||
|
||||
/--
|
||||
Obtains the `LocalContext` from this `CompletionInfo` if available and yields an empty context
|
||||
otherwise.
|
||||
-/
|
||||
def CompletionInfo.lctx : CompletionInfo → LocalContext
|
||||
| dot i .. => i.lctx
|
||||
| id _ _ _ lctx .. => lctx
|
||||
| dotId _ _ lctx .. => lctx
|
||||
| fieldId _ _ lctx .. => lctx
|
||||
| _ => .empty
|
||||
| tactic stx .. => stx
|
||||
|
||||
def CustomInfo.format : CustomInfo → Format
|
||||
| i => f!"CustomInfo({i.value.typeName})"
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Util.ForEachExprWhere
|
||||
import Lean.Meta.CtorRecognizer
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Meta.GeneralizeVars
|
||||
import Lean.Meta.ForEachExpr
|
||||
@@ -443,7 +442,7 @@ private def applyRefMap (e : Expr) (map : ExprMap Expr) : Expr :=
|
||||
-/
|
||||
private def whnfPreservingPatternRef (e : Expr) : MetaM Expr := do
|
||||
let eNew ← whnf e
|
||||
if (← isConstructorApp eNew) then
|
||||
if eNew.isConstructorApp (← getEnv) then
|
||||
return eNew
|
||||
else
|
||||
return applyRefMap eNew (mkPatternRefMap e)
|
||||
@@ -474,7 +473,7 @@ partial def normalize (e : Expr) : M Expr := do
|
||||
let p ← normalize p
|
||||
addVar h
|
||||
return mkApp4 e.getAppFn (e.getArg! 0) x p h
|
||||
else if (← isMatchValue e) then
|
||||
else if isMatchValue e then
|
||||
return e
|
||||
else if e.isFVar then
|
||||
if (← isExplicitPatternVar e) then
|
||||
@@ -572,8 +571,8 @@ private partial def toPattern (e : Expr) : MetaM Pattern := do
|
||||
match e.getArg! 1, e.getArg! 3 with
|
||||
| Expr.fvar x, Expr.fvar h => return Pattern.as x p h
|
||||
| _, _ => throwError "unexpected occurrence of auxiliary declaration 'namedPattern'"
|
||||
else if (← isMatchValue e) then
|
||||
return Pattern.val (← normLitValue e)
|
||||
else if isMatchValue e then
|
||||
return Pattern.val e
|
||||
else if e.isFVar then
|
||||
return Pattern.var e.fvarId!
|
||||
else
|
||||
|
||||
@@ -1,217 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Term
|
||||
|
||||
namespace Lean.Elab.Term
|
||||
namespace MatchExpr
|
||||
/--
|
||||
`match_expr` alternative. Recall that it has the following structure.
|
||||
```
|
||||
| (ident "@")? ident bindeIdent* => rhs
|
||||
```
|
||||
|
||||
Example:
|
||||
```
|
||||
| c@Eq _ a b => f c a b
|
||||
```
|
||||
-/
|
||||
structure Alt where
|
||||
/--
|
||||
`some c` if there is a variable binding to the function symbol being matched.
|
||||
`c` is the variable name.
|
||||
-/
|
||||
var? : Option Ident
|
||||
/-- Function being matched. -/
|
||||
funName : Ident
|
||||
/-- Pattern variables. The list uses `none` for representing `_`, and `some a` for pattern variable `a`. -/
|
||||
pvars : List (Option Ident)
|
||||
/-- right-hand-side for the alternative. -/
|
||||
rhs : Syntax
|
||||
/-- Store the auxliary continuation function for each right-hand-side. -/
|
||||
k : Ident := ⟨.missing⟩
|
||||
/-- Actual value to be passed as an argument. -/
|
||||
actuals : List Term := []
|
||||
|
||||
/--
|
||||
`match_expr` else-alternative. Recall that it has the following structure.
|
||||
```
|
||||
| _ => rhs
|
||||
```
|
||||
-/
|
||||
structure ElseAlt where
|
||||
rhs : Syntax
|
||||
|
||||
open Parser Term
|
||||
|
||||
/--
|
||||
Converts syntax representing a `match_expr` else-alternative into an `ElseAlt`.
|
||||
-/
|
||||
def toElseAlt? (stx : Syntax) : Option ElseAlt :=
|
||||
if !stx.isOfKind ``matchExprElseAlt then none else
|
||||
some { rhs := stx[3] }
|
||||
|
||||
/--
|
||||
Converts syntax representing a `match_expr` alternative into an `Alt`.
|
||||
-/
|
||||
def toAlt? (stx : Syntax) : Option Alt :=
|
||||
if !stx.isOfKind ``matchExprAlt then none else
|
||||
match stx[1] with
|
||||
| `(matchExprPat| $[$var? @]? $funName:ident $pvars*) =>
|
||||
let pvars := pvars.toList.reverse.map fun arg =>
|
||||
match arg.raw with
|
||||
| `(_) => none
|
||||
| _ => some ⟨arg⟩
|
||||
let rhs := stx[3]
|
||||
some { var?, funName, pvars, rhs }
|
||||
| _ => none
|
||||
|
||||
/--
|
||||
Returns the function names of alternatives that do not have any pattern variable left.
|
||||
-/
|
||||
def getFunNamesToMatch (alts : List Alt) : List Ident := Id.run do
|
||||
let mut funNames := #[]
|
||||
for alt in alts do
|
||||
if alt.pvars.isEmpty then
|
||||
if Option.isNone <| funNames.find? fun funName => funName.getId == alt.funName.getId then
|
||||
funNames := funNames.push alt.funName
|
||||
return funNames.toList
|
||||
|
||||
/--
|
||||
Returns `true` if there is at least one alternative whose next pattern variable is not a `_`.
|
||||
-/
|
||||
def shouldSaveActual (alts : List Alt) : Bool :=
|
||||
alts.any fun alt => alt.pvars matches some _ :: _
|
||||
|
||||
/--
|
||||
Returns the first alternative whose function name is `funName` **and**
|
||||
does not have pattern variables left to match.
|
||||
-/
|
||||
def getAltFor? (alts : List Alt) (funName : Ident) : Option Alt :=
|
||||
alts.find? fun alt => alt.funName.getId == funName.getId && alt.pvars.isEmpty
|
||||
|
||||
/--
|
||||
Removes alternatives that do not have any pattern variable left to be matched.
|
||||
For the ones that still have pattern variables, remove the first one, and
|
||||
save `actual` if the removed pattern variable is not a `_`.
|
||||
-/
|
||||
def next (alts : List Alt) (actual : Term) : List Alt :=
|
||||
alts.filterMap fun alt =>
|
||||
if let some _ :: pvars := alt.pvars then
|
||||
some { alt with pvars, actuals := actual :: alt.actuals }
|
||||
else if let none :: pvars := alt.pvars then
|
||||
some { alt with pvars }
|
||||
else
|
||||
none
|
||||
|
||||
/--
|
||||
Creates a fresh identifier for representing the continuation function used to
|
||||
execute the RHS of the given alternative, and stores it in the field `k`.
|
||||
-/
|
||||
def initK (alt : Alt) : MacroM Alt := withFreshMacroScope do
|
||||
-- Remark: the compiler frontend implemented in C++ currently detects jointpoints created by
|
||||
-- the "do" notation by testing the name. See hack at method `visit_let` at `lcnf.cpp`
|
||||
-- We will remove this hack when we re-implement the compiler frontend in Lean.
|
||||
let k : Ident ← `(__do_jp)
|
||||
return { alt with k }
|
||||
|
||||
/--
|
||||
Generates parameters for the continuation function used to execute
|
||||
the RHS of the given alternative.
|
||||
-/
|
||||
def getParams (alt : Alt) : MacroM (Array (TSyntax ``bracketedBinder)) := do
|
||||
let mut params := #[]
|
||||
if let some var := alt.var? then
|
||||
params := params.push (← `(bracketedBinderF| ($var : Expr)))
|
||||
params := params ++ (← alt.pvars.toArray.reverse.filterMapM fun
|
||||
| none => return none
|
||||
| some arg => return some (← `(bracketedBinderF| ($arg : Expr))))
|
||||
if params.isEmpty then
|
||||
return #[(← `(bracketedBinderF| (_ : Unit)))]
|
||||
return params
|
||||
|
||||
/--
|
||||
Generates the actual arguments for invoking the auxiliary continuation function
|
||||
associated with the given alternative. The arguments are the actuals stored in `alt`.
|
||||
`discr` is also an argument if `alt.var?` is not none.
|
||||
-/
|
||||
def getActuals (discr : Term) (alt : Alt) : MacroM (Array Term) := do
|
||||
let mut actuals := #[]
|
||||
if alt.var?.isSome then
|
||||
actuals := actuals.push discr
|
||||
actuals := actuals ++ alt.actuals.toArray
|
||||
if actuals.isEmpty then
|
||||
return #[← `(())]
|
||||
return actuals
|
||||
|
||||
def toDoubleQuotedName (ident : Ident) : Term :=
|
||||
⟨mkNode ``Parser.Term.doubleQuotedName #[mkAtom "`", mkAtom "`", ident]⟩
|
||||
|
||||
/--
|
||||
Generates an `if-then-else` tree for implementing a `match_expr` with discriminant `discr`,
|
||||
alternatives `alts`, and else-alternative `elseAlt`.
|
||||
-/
|
||||
partial def generate (discr : Term) (alts : List Alt) (elseAlt : ElseAlt) : MacroM Syntax := do
|
||||
let alts ← alts.mapM initK
|
||||
let discr' ← `(__discr)
|
||||
-- Remark: the compiler frontend implemented in C++ currently detects jointpoints created by
|
||||
-- the "do" notation by testing the name. See hack at method `visit_let` at `lcnf.cpp`
|
||||
-- We will remove this hack when we re-implement the compiler frontend in Lean.
|
||||
let kElse ← `(__do_jp)
|
||||
let rec loop (discr : Term) (alts : List Alt) : MacroM Term := withFreshMacroScope do
|
||||
let funNamesToMatch := getFunNamesToMatch alts
|
||||
let saveActual := shouldSaveActual alts
|
||||
let actual ← if saveActual then `(a) else `(_)
|
||||
let altsNext := next alts actual
|
||||
let body ← if altsNext.isEmpty then
|
||||
`($kElse ())
|
||||
else
|
||||
let discr' ← `(__discr)
|
||||
let body ← loop discr' altsNext
|
||||
if saveActual then
|
||||
`(if h : ($discr).isApp then let a := Expr.appArg $discr h; let __discr := Expr.appFnCleanup $discr h; $body else $kElse ())
|
||||
else
|
||||
`(if h : ($discr).isApp then let __discr := Expr.appFnCleanup $discr h; $body else $kElse ())
|
||||
let mut result := body
|
||||
for funName in funNamesToMatch do
|
||||
if let some alt := getAltFor? alts funName then
|
||||
let actuals ← getActuals discr alt
|
||||
result ← `(if ($discr).isConstOf $(toDoubleQuotedName funName) then $alt.k $actuals* else $result)
|
||||
return result
|
||||
let body ← loop discr' alts
|
||||
let mut result ← `(let_delayed __do_jp (_ : Unit) := $(⟨elseAlt.rhs⟩):term; let __discr := Expr.cleanupAnnotations $discr:term; $body:term)
|
||||
for alt in alts do
|
||||
let params ← getParams alt
|
||||
result ← `(let_delayed $alt.k:ident $params:bracketedBinder* := $(⟨alt.rhs⟩):term; $result:term)
|
||||
return result
|
||||
|
||||
def main (discr : Term) (alts : Array Syntax) (elseAlt : Syntax) : MacroM Syntax := do
|
||||
let alts ← alts.toList.mapM fun alt =>
|
||||
if let some alt := toAlt? alt then
|
||||
pure alt
|
||||
else
|
||||
Macro.throwErrorAt alt "unexpected `match_expr` alternative"
|
||||
let some elseAlt := toElseAlt? elseAlt
|
||||
| Macro.throwErrorAt elseAlt "unexpected `match_expr` else-alternative"
|
||||
generate discr alts elseAlt
|
||||
|
||||
end MatchExpr
|
||||
|
||||
@[builtin_macro Lean.Parser.Term.matchExpr] def expandMatchExpr : Macro := fun stx =>
|
||||
match stx with
|
||||
| `(match_expr $discr:term with $alts) =>
|
||||
MatchExpr.main discr alts.raw[0].getArgs alts.raw[1]
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
@[builtin_macro Lean.Parser.Term.letExpr] def expandLetExpr : Macro := fun stx =>
|
||||
match stx with
|
||||
| `(let_expr $pat:matchExprPat := $discr:term | $elseBranch:term; $body:term) =>
|
||||
`(match_expr $discr with
|
||||
| $pat:matchExprPat => $body
|
||||
| _ => $elseBranch)
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
end Lean.Elab.Term
|
||||
@@ -107,10 +107,22 @@ def mkUnexpander (attrKind : TSyntax ``attrKind) (pat qrhs : Term) : OptionT Mac
|
||||
-- The reference is attached to the syntactic representation of the called function itself, not the entire function application
|
||||
let lhs ← `($$f:ident)
|
||||
let lhs := Syntax.mkApp lhs (.mk args)
|
||||
-- allow over-application, avoiding nested `app` nodes
|
||||
let lhsWithMoreArgs := flattenApp (← `($lhs $$moreArgs*))
|
||||
let patWithMoreArgs := flattenApp (← `($pat $$moreArgs*))
|
||||
`(@[$attrKind app_unexpander $(mkIdent c)]
|
||||
aux_def unexpand $(mkIdent c) : Lean.PrettyPrinter.Unexpander := fun
|
||||
| `($lhs) => withRef f `($pat)
|
||||
-- must be a separate case as the LHS and RHS above might not be `app` nodes
|
||||
| `($lhsWithMoreArgs) => withRef f `($patWithMoreArgs)
|
||||
| _ => throw ())
|
||||
where
|
||||
-- NOTE: we consider only one nesting level here
|
||||
flattenApp : Term → Term
|
||||
| stx@`($f $xs*) => match f with
|
||||
| `($f' $xs'*) => Syntax.mkApp f' (xs' ++ xs)
|
||||
| _ => stx
|
||||
| stx => stx
|
||||
|
||||
private def expandNotationAux (ref : Syntax) (currNamespace : Name)
|
||||
(doc? : Option (TSyntax ``docComment))
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Eqns
|
||||
import Lean.Meta.CtorRecognizer
|
||||
import Lean.Util.CollectFVars
|
||||
import Lean.Util.ForEachExprWhere
|
||||
import Lean.Meta.Tactic.Split
|
||||
@@ -219,14 +218,13 @@ where
|
||||
-/
|
||||
private def shouldUseSimpMatch (e : Expr) : MetaM Bool := do
|
||||
let env ← getEnv
|
||||
let find (root : Expr) : ExceptT Unit MetaM Unit :=
|
||||
root.forEach fun e => do
|
||||
if let some info := isMatcherAppCore? env e then
|
||||
let args := e.getAppArgs
|
||||
for discr in args[info.getFirstDiscrPos : info.getFirstDiscrPos + info.numDiscrs] do
|
||||
if (← Meta.isConstructorApp discr) then
|
||||
throwThe Unit ()
|
||||
return (← (find e).run) matches .error _
|
||||
return Option.isSome <| e.find? fun e => Id.run do
|
||||
if let some info := isMatcherAppCore? env e then
|
||||
let args := e.getAppArgs
|
||||
for discr in args[info.getFirstDiscrPos : info.getFirstDiscrPos + info.numDiscrs] do
|
||||
if discr.isConstructorApp env then
|
||||
return true
|
||||
return false
|
||||
|
||||
partial def mkEqnTypes (declNames : Array Name) (mvarId : MVarId) : MetaM (Array Expr) := do
|
||||
let (_, eqnTypes) ← go mvarId |>.run { declNames } |>.run #[]
|
||||
|
||||
@@ -121,7 +121,8 @@ def addPreDefinitions (preDefs : Array PreDefinition) : TermElabM Unit := withLC
|
||||
preDefs.forM (·.termination.ensureNone "partial")
|
||||
else
|
||||
try
|
||||
let hasHints := preDefs.any fun preDef => preDef.termination.isNotNone
|
||||
let hasHints := preDefs.any fun preDef =>
|
||||
preDef.termination.decreasing_by?.isSome || preDef.termination.termination_by?.isSome
|
||||
if hasHints then
|
||||
wfRecursion preDefs
|
||||
else
|
||||
|
||||
@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.Match.MatcherApp.Transform
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
import Lean.Elab.PreDefinition.Structural.Basic
|
||||
|
||||
@@ -37,12 +37,12 @@ where
|
||||
return ()
|
||||
else if (← tryContradiction mvarId) then
|
||||
return ()
|
||||
else if let some mvarId ← whnfReducibleLHS? mvarId then
|
||||
go mvarId
|
||||
else if let some mvarId ← simpMatch? mvarId then
|
||||
go mvarId
|
||||
else if let some mvarId ← simpIf? mvarId then
|
||||
go mvarId
|
||||
else if let some mvarId ← whnfReducibleLHS? mvarId then
|
||||
go mvarId
|
||||
else match (← simpTargetStar mvarId {} (simprocs := {})).1 with
|
||||
| TacticResultCNM.closed => return ()
|
||||
| TacticResultCNM.modified mvarId => go mvarId
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
import Lean.Elab.PreDefinition.Structural.Basic
|
||||
import Lean.Meta.Match.MatcherApp.Basic
|
||||
|
||||
namespace Lean.Elab.Structural
|
||||
open Meta
|
||||
|
||||
@@ -5,10 +5,9 @@ Authors: Joachim Breitner
|
||||
-/
|
||||
prelude
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.Match.MatcherApp.Transform
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Meta.Tactic.Cleanup
|
||||
import Lean.Meta.Tactic.Refl
|
||||
import Lean.Meta.Tactic.TryThis
|
||||
import Lean.Elab.Quotation
|
||||
import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
@@ -703,19 +702,17 @@ def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
|
||||
-- Collect all recursive calls and extract their context
|
||||
let recCalls ← collectRecCalls unaryPreDef fixedPrefixSize arities
|
||||
let recCalls := filterSubsumed recCalls
|
||||
let rcs ← recCalls.mapM (RecCallCache.mk (preDefs.map (·.termination.decreasingBy?)) ·)
|
||||
let rcs ← recCalls.mapM (RecCallCache.mk (preDefs.map (·.termination.decreasing_by?)) ·)
|
||||
let callMatrix := rcs.map (inspectCall ·)
|
||||
|
||||
match ← liftMetaM <| solve measures callMatrix with
|
||||
| .some solution => do
|
||||
let wf ← buildTermWF originalVarNamess varNamess solution
|
||||
|
||||
let wf' := trimTermWF extraParamss wf
|
||||
for preDef in preDefs, term in wf' do
|
||||
if showInferredTerminationBy.get (← getOptions) then
|
||||
logInfoAt preDef.ref m!"Inferred termination argument:\n{← term.unexpand}"
|
||||
if let some ref := preDef.termination.terminationBy?? then
|
||||
Tactic.TryThis.addSuggestion ref (← term.unexpand)
|
||||
if showInferredTerminationBy.get (← getOptions) then
|
||||
let wf' := trimTermWF extraParamss wf
|
||||
for preDef in preDefs, term in wf' do
|
||||
logInfoAt preDef.ref m!"Inferred termination argument: {← term.unexpand}"
|
||||
|
||||
return wf
|
||||
| .none =>
|
||||
|
||||
@@ -94,12 +94,12 @@ def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
|
||||
return (← packMutual fixedPrefixSize preDefs unaryPreDefs, fixedPrefixSize)
|
||||
|
||||
let wf ← do
|
||||
let (preDefsWith, preDefsWithout) := preDefs.partition (·.termination.terminationBy?.isSome)
|
||||
let (preDefsWith, preDefsWithout) := preDefs.partition (·.termination.termination_by?.isSome)
|
||||
if preDefsWith.isEmpty then
|
||||
-- No termination_by anywhere, so guess one
|
||||
guessLex preDefs unaryPreDef fixedPrefixSize
|
||||
else if preDefsWithout.isEmpty then
|
||||
pure <| preDefsWith.map (·.termination.terminationBy?.get!)
|
||||
pure <| preDefsWith.map (·.termination.termination_by?.get!)
|
||||
else
|
||||
-- Some have, some do not, so report errors
|
||||
preDefsWithout.forM fun preDef => do
|
||||
@@ -114,7 +114,7 @@ def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
|
||||
trace[Elab.definition.wf] "wfRel: {wfRel}"
|
||||
let (value, envNew) ← withoutModifyingEnv' do
|
||||
addAsAxiom unaryPreDef
|
||||
let value ← mkFix unaryPreDef prefixArgs wfRel (preDefs.map (·.termination.decreasingBy?))
|
||||
let value ← mkFix unaryPreDef prefixArgs wfRel (preDefs.map (·.termination.decreasing_by?))
|
||||
eraseRecAppSyntaxExpr value
|
||||
/- `mkFix` invokes `decreasing_tactic` which may add auxiliary theorems to the environment. -/
|
||||
let value ← unfoldDeclsFrom envNew value
|
||||
|
||||
@@ -68,14 +68,7 @@ def elabWFRel (preDefs : Array PreDefinition) (unaryPreDefName : Name) (fixedPre
|
||||
for (d, mvarId) in subgoals, element in wf, preDef in preDefs do
|
||||
let mvarId ← unpackUnary preDef fixedPrefixSize mvarId d element
|
||||
mvarId.withContext do
|
||||
let errorMsgHeader? := if preDefs.size > 1 then
|
||||
"The termination argument types differ for the different functions, or depend on the " ++
|
||||
"function's varying parameters. Try using `sizeOf` explicitly:\nThe termination argument"
|
||||
else
|
||||
"The termination argument depends on the function's varying parameters. Try using " ++
|
||||
"`sizeOf` explicitly:\nThe termination argument"
|
||||
let value ← Term.withSynthesize <| elabTermEnsuringType element.body (← mvarId.getType)
|
||||
(errorMsgHeader? := errorMsgHeader?)
|
||||
mvarId.assign value
|
||||
let wfRelVal ← synthInstance (← inferType (mkMVar wfRelMVarId))
|
||||
wfRelMVarId.assign wfRelVal
|
||||
|
||||
@@ -27,7 +27,7 @@ structure TerminationBy where
|
||||
deriving Inhabited
|
||||
|
||||
open Parser.Termination in
|
||||
def TerminationBy.unexpand (wf : TerminationBy) : MetaM (TSyntax ``terminationBy) := do
|
||||
def TerminationBy.unexpand (wf : TerminationBy) : MetaM Syntax := do
|
||||
-- TODO: Why can I not just use $wf.vars in the quotation below?
|
||||
let vars : TSyntaxArray `ident := wf.vars.map (⟨·.raw⟩)
|
||||
if vars.isEmpty then
|
||||
@@ -50,9 +50,8 @@ is what `Term.runTactic` expects.
|
||||
-/
|
||||
structure TerminationHints where
|
||||
ref : Syntax
|
||||
terminationBy?? : Option Syntax
|
||||
terminationBy? : Option TerminationBy
|
||||
decreasingBy? : Option DecreasingBy
|
||||
termination_by? : Option TerminationBy
|
||||
decreasing_by? : Option DecreasingBy
|
||||
/-- Here we record the number of parameters past the `:`. It is set by
|
||||
`TerminationHints.rememberExtraParams` and used as folows:
|
||||
|
||||
@@ -64,27 +63,19 @@ structure TerminationHints where
|
||||
extraParams : Nat
|
||||
deriving Inhabited
|
||||
|
||||
def TerminationHints.none : TerminationHints := ⟨.missing, .none, .none, .none, 0⟩
|
||||
def TerminationHints.none : TerminationHints := ⟨.missing, .none, .none, 0⟩
|
||||
|
||||
/-- Logs warnings when the `TerminationHints` are present. -/
|
||||
def TerminationHints.ensureNone (hints : TerminationHints) (reason : String): CoreM Unit := do
|
||||
match hints.terminationBy??, hints.terminationBy?, hints.decreasingBy? with
|
||||
| .none, .none, .none => pure ()
|
||||
| .none, .none, .some dec_by =>
|
||||
match hints.termination_by?, hints.decreasing_by? with
|
||||
| .none, .none => pure ()
|
||||
| .none, .some dec_by =>
|
||||
logErrorAt dec_by.ref m!"unused `decreasing_by`, function is {reason}"
|
||||
| .some term_by?, .none, .none =>
|
||||
logErrorAt term_by? m!"unused `termination_by?`, function is {reason}"
|
||||
| .none, .some term_by, .none =>
|
||||
| .some term_by, .none =>
|
||||
logErrorAt term_by.ref m!"unused `termination_by`, function is {reason}"
|
||||
| _, _, _ =>
|
||||
| .some _, .some _ =>
|
||||
logErrorAt hints.ref m!"unused termination hints, function is {reason}"
|
||||
|
||||
/-- True if any form of termination hint is present. -/
|
||||
def TerminationHints.isNotNone (hints : TerminationHints) : Bool :=
|
||||
hints.terminationBy??.isSome ||
|
||||
hints.terminationBy?.isSome ||
|
||||
hints.decreasingBy?.isSome
|
||||
|
||||
/--
|
||||
Remembers `extraParams` for later use. Needs to happen early enough where we still know
|
||||
how many parameters came from the function header (`headerParams`).
|
||||
@@ -120,23 +111,19 @@ def elabTerminationHints {m} [Monad m] [MonadError m] (stx : TSyntax ``suffix) :
|
||||
if let .missing := stx.raw then
|
||||
return { TerminationHints.none with ref := stx }
|
||||
match stx with
|
||||
| `(suffix| $[$t?]? $[$d?:decreasingBy]? ) => do
|
||||
let terminationBy?? : Option Syntax ← if let some t := t? then match t with
|
||||
| `(terminationBy?|termination_by?) => pure (some t)
|
||||
| _ => pure none
|
||||
else pure none
|
||||
let terminationBy? : Option TerminationBy ← if let some t := t? then match t with
|
||||
| `(terminationBy|termination_by => $_body) =>
|
||||
throwErrorAt t "no extra parameters bounds, please omit the `=>`"
|
||||
| `(terminationBy|termination_by $vars* => $body) => pure (some {ref := t, vars, body})
|
||||
| `(terminationBy|termination_by $body:term) => pure (some {ref := t, vars := #[], body})
|
||||
| `(terminationBy?|termination_by?) => pure none
|
||||
| `(suffix| $[$t?:terminationBy]? $[$d?:decreasingBy]? ) => do
|
||||
let termination_by? ← t?.mapM fun t => match t with
|
||||
| `(terminationBy|termination_by $vars* => $body) =>
|
||||
if vars.isEmpty then
|
||||
throwErrorAt t "no extra parameters bounds, please omit the `=>`"
|
||||
else
|
||||
pure {ref := t, vars, body}
|
||||
| `(terminationBy|termination_by $body:term) => pure {ref := t, vars := #[], body}
|
||||
| _ => throwErrorAt t "unexpected `termination_by` syntax"
|
||||
else pure none
|
||||
let decreasingBy? ← d?.mapM fun d => match d with
|
||||
let decreasing_by? ← d?.mapM fun d => match d with
|
||||
| `(decreasingBy|decreasing_by $tactic) => pure {ref := d, tactic}
|
||||
| _ => throwErrorAt d "unexpected `decreasing_by` syntax"
|
||||
return { ref := stx, terminationBy??, terminationBy?, decreasingBy?, extraParams := 0 }
|
||||
return { ref := stx, termination_by?, decreasing_by?, extraParams := 0 }
|
||||
| _ => throwErrorAt stx s!"Unexpected Termination.suffix syntax: {stx} of kind {stx.raw.getKind}"
|
||||
|
||||
end Lean.Elab.WF
|
||||
|
||||
@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Util.FoldConsts
|
||||
import Lean.Meta.Eqns
|
||||
import Lean.Elab.Command
|
||||
|
||||
namespace Lean.Elab.Command
|
||||
@@ -129,18 +128,4 @@ private def printAxiomsOf (constName : Name) : CommandElabM Unit := do
|
||||
cs.forM printAxiomsOf
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
private def printEqnsOf (constName : Name) : CommandElabM Unit := do
|
||||
let some eqns ← liftTermElabM <| Meta.getEqnsFor? constName (nonRec := true) |
|
||||
logInfo m!"'{constName}' does not have equations"
|
||||
let mut m := m!"equations:"
|
||||
for eq in eqns do
|
||||
let cinfo ← getConstInfo eq
|
||||
m := m ++ Format.line ++ (← mkHeader "theorem" eq cinfo.levelParams cinfo.type .safe)
|
||||
logInfo m
|
||||
|
||||
@[builtin_command_elab «printEqns»] def elabPrintEqns : CommandElab := fun stx => do
|
||||
let id := stx[2]
|
||||
let cs ← resolveGlobalConstWithInfos id
|
||||
cs.forM printEqnsOf
|
||||
|
||||
end Lean.Elab.Command
|
||||
|
||||
@@ -77,27 +77,9 @@ where
|
||||
go sources (sourcesNew.push source)
|
||||
else
|
||||
withFreshMacroScope do
|
||||
/-
|
||||
Recall that local variables starting with `__` are treated as impl detail.
|
||||
See `LocalContext.lean`.
|
||||
Moreover, implementation detail let-vars are unfolded by `simp`
|
||||
even when `zetaDelta := false`.
|
||||
Motivation: the following failure when `zetaDelta := true`
|
||||
```
|
||||
structure A where
|
||||
a : Nat
|
||||
structure B extends A where
|
||||
b : Nat
|
||||
w : a = b
|
||||
def x : A where a := 37
|
||||
@[simp] theorem x_a : x.a = 37 := rfl
|
||||
|
||||
def y : B := { x with b := 37, w := by simp }
|
||||
```
|
||||
-/
|
||||
let sourceNew ← `(__src)
|
||||
let sourceNew ← `(src)
|
||||
let r ← go sources (sourcesNew.push sourceNew)
|
||||
`(let __src := $source; $r)
|
||||
`(let src := $source; $r)
|
||||
|
||||
structure ExplicitSourceInfo where
|
||||
stx : Syntax
|
||||
@@ -802,8 +784,10 @@ partial def mkDefaultValueAux? (struct : Struct) : Expr → TermElabM (Option Ex
|
||||
let arg ← mkFreshExprMVar d
|
||||
mkDefaultValueAux? struct (b.instantiate1 arg)
|
||||
| e =>
|
||||
let_expr id _ a := e | return some e
|
||||
return some a
|
||||
if e.isAppOfArity ``id 2 then
|
||||
return some e.appArg!
|
||||
else
|
||||
return some e
|
||||
|
||||
def mkDefaultValue? (struct : Struct) (cinfo : ConstantInfo) : TermElabM (Option Expr) :=
|
||||
withRef struct.ref do
|
||||
|
||||
@@ -36,5 +36,3 @@ import Lean.Elab.Tactic.Simpa
|
||||
import Lean.Elab.Tactic.NormCast
|
||||
import Lean.Elab.Tactic.Symm
|
||||
import Lean.Elab.Tactic.SolveByElim
|
||||
import Lean.Elab.Tactic.LibrarySearch
|
||||
import Lean.Elab.Tactic.ShowTerm
|
||||
|
||||
@@ -352,21 +352,12 @@ def renameInaccessibles (mvarId : MVarId) (hs : TSyntaxArray ``binderIdent) : Ta
|
||||
let mut info := #[]
|
||||
let mut found : NameSet := {}
|
||||
let n := lctx.numIndices
|
||||
-- hypotheses are inaccessible if their scopes are different from the caller's (we assume that
|
||||
-- the scopes are the same for all the hypotheses in `hs`, which is reasonable to expect in
|
||||
-- practice and otherwise the expected semantics of `rename_i` really are not clear)
|
||||
let some callerScopes := hs.findSome? (fun
|
||||
| `(binderIdent| $h:ident) => some <| extractMacroScopes h.getId
|
||||
| _ => none)
|
||||
| return mvarId
|
||||
for i in [:n] do
|
||||
let j := n - i - 1
|
||||
match lctx.getAt? j with
|
||||
| none => pure ()
|
||||
| some localDecl =>
|
||||
let inaccessible := !(extractMacroScopes localDecl.userName |>.equalScope callerScopes)
|
||||
let shadowed := found.contains localDecl.userName
|
||||
if inaccessible || shadowed then
|
||||
if localDecl.userName.hasMacroScopes || found.contains localDecl.userName then
|
||||
if let `(binderIdent| $h:ident) := hs.back then
|
||||
let newName := h.getId
|
||||
lctx := lctx.setUserName localDecl.fvarId newName
|
||||
|
||||
@@ -372,24 +372,10 @@ private def preprocessPropToDecide (expectedType : Expr) : TermElabM Expr := do
|
||||
let expectedType ← preprocessPropToDecide expectedType
|
||||
let d ← mkDecide expectedType
|
||||
let d ← instantiateMVars d
|
||||
-- Get instance from `d`
|
||||
let s := d.appArg!
|
||||
-- Reduce the instance rather than `d` itself, since that gives a nicer error message on failure.
|
||||
let r ← withDefault <| whnf s
|
||||
if r.isAppOf ``isFalse then
|
||||
throwError "\
|
||||
tactic 'decide' proved that the proposition\
|
||||
{indentExpr expectedType}\n\
|
||||
is false"
|
||||
unless r.isAppOf ``isTrue do
|
||||
throwError "\
|
||||
tactic 'decide' failed for proposition\
|
||||
{indentExpr expectedType}\n\
|
||||
since its 'Decidable' instance reduced to\
|
||||
{indentExpr r}\n\
|
||||
rather than to the 'isTrue' constructor."
|
||||
-- While we have a proof from reduction, we do not embed it in the proof term,
|
||||
-- but rather we let the kernel recompute it during type checking from a more efficient term.
|
||||
let r ← withDefault <| whnf d
|
||||
unless r.isConstOf ``true do
|
||||
throwError "failed to reduce to 'true'{indentExpr r}"
|
||||
let s := d.appArg! -- get instance from `d`
|
||||
let rflPrf ← mkEqRefl (toExpr true)
|
||||
return mkApp3 (Lean.mkConst ``of_decide_eq_true) expectedType s rflPrf
|
||||
|
||||
|
||||
@@ -1,81 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021-2024 Gabriel Ebner and Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Joe Hendrix, Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.LibrarySearch
|
||||
import Lean.Meta.Tactic.TryThis
|
||||
import Lean.Elab.Tactic.ElabTerm
|
||||
|
||||
namespace Lean.Elab.LibrarySearch
|
||||
|
||||
open Lean Meta LibrarySearch
|
||||
open Elab Tactic Term TryThis
|
||||
|
||||
/--
|
||||
Implementation of the `exact?` tactic.
|
||||
|
||||
* `ref` contains the input syntax and is used for locations in error reporting.
|
||||
* `required` contains an optional list of terms that should be used in closing the goal.
|
||||
* `requireClose` indicates if the goal must be closed.
|
||||
It is `true` for `exact?` and `false` for `apply?`.
|
||||
-/
|
||||
def exact? (ref : Syntax) (required : Option (Array (TSyntax `term))) (requireClose : Bool) :
|
||||
TacticM Unit := do
|
||||
let mvar ← getMainGoal
|
||||
let (_, goal) ← (← getMainGoal).intros
|
||||
goal.withContext do
|
||||
let required := (← (required.getD #[]).mapM getFVarId).toList.map .fvar
|
||||
let tactic := fun exfalso =>
|
||||
solveByElim required (exfalso := exfalso) (maxDepth := 6)
|
||||
let allowFailure := fun g => do
|
||||
let g ← g.withContext (instantiateMVars (.mvar g))
|
||||
return required.all fun e => e.occurs g
|
||||
match ← librarySearch goal tactic allowFailure with
|
||||
-- Found goal that closed problem
|
||||
| none =>
|
||||
addExactSuggestion ref (← instantiateMVars (mkMVar mvar)).headBeta
|
||||
-- Found suggestions
|
||||
| some suggestions =>
|
||||
if requireClose then throwError
|
||||
"`exact?` could not close the goal. Try `apply?` to see partial suggestions."
|
||||
reportOutOfHeartbeats `library_search ref
|
||||
for (_, suggestionMCtx) in suggestions do
|
||||
withMCtx suggestionMCtx do
|
||||
addExactSuggestion ref (← instantiateMVars (mkMVar mvar)).headBeta (addSubgoalsMsg := true)
|
||||
if suggestions.isEmpty then logError "apply? didn't find any relevant lemmas"
|
||||
admitGoal goal
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.exact?]
|
||||
def evalExact : Tactic := fun stx => do
|
||||
let `(tactic| exact? $[using $[$required],*]?) := stx
|
||||
| throwUnsupportedSyntax
|
||||
exact? (← getRef) required true
|
||||
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.apply?]
|
||||
def evalApply : Tactic := fun stx => do
|
||||
let `(tactic| apply? $[using $[$required],*]?) := stx
|
||||
| throwUnsupportedSyntax
|
||||
exact? (← getRef) required false
|
||||
|
||||
@[builtin_term_elab Lean.Parser.Syntax.exact?]
|
||||
def elabExact?Term : TermElab := fun stx expectedType? => do
|
||||
let `(exact?%) := stx | throwUnsupportedSyntax
|
||||
withExpectedType expectedType? fun expectedType => do
|
||||
let goal ← mkFreshExprMVar expectedType
|
||||
let (_, introdGoal) ← goal.mvarId!.intros
|
||||
introdGoal.withContext do
|
||||
if let some suggestions ← librarySearch introdGoal then
|
||||
reportOutOfHeartbeats `library_search stx
|
||||
for suggestion in suggestions do
|
||||
withMCtx suggestion.2 do
|
||||
addTermSuggestion stx (← instantiateMVars goal).headBeta
|
||||
if suggestions.isEmpty then logError "exact?# didn't find any relevant lemmas"
|
||||
mkSorry expectedType (synthetic := true)
|
||||
else
|
||||
addTermSuggestion stx (← instantiateMVars goal).headBeta
|
||||
instantiateMVars goal
|
||||
|
||||
end Lean.Elab.LibrarySearch
|
||||
@@ -3,7 +3,6 @@ Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.NormCast
|
||||
import Lean.Elab.Tactic.Conv.Simp
|
||||
import Lean.Elab.ElabRules
|
||||
|
||||
@@ -3,7 +3,6 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.Omega.Frontend
|
||||
|
||||
/-!
|
||||
|
||||
@@ -3,8 +3,6 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.Constraint
|
||||
import Lean.Elab.Tactic.Omega.OmegaM
|
||||
import Lean.Elab.Tactic.Omega.MinNatAbs
|
||||
|
||||
|
||||
@@ -3,7 +3,6 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.Tactic.Omega.Core
|
||||
import Lean.Elab.Tactic.FalseOrByContra
|
||||
import Lean.Meta.Tactic.Cases
|
||||
@@ -24,13 +23,24 @@ Allow elaboration of `OmegaConfig` arguments to tactics.
|
||||
-/
|
||||
declare_config_elab elabOmegaConfig Lean.Meta.Omega.OmegaConfig
|
||||
|
||||
/-- Match on the two defeq expressions for successor: `n+1`, `n.succ`. -/
|
||||
def succ? (e : Expr) : Option Expr :=
|
||||
match e.getAppFnArgs with
|
||||
| (``Nat.succ, #[n]) => some n
|
||||
| (``HAdd.hAdd, #[_, _, _, _, a, b]) => do
|
||||
if b == toExpr (1 : Nat) then some a else none
|
||||
| _ => none
|
||||
|
||||
|
||||
|
||||
/--
|
||||
The current `ToExpr` instance for `Int` is bad,
|
||||
so we roll our own here.
|
||||
-/
|
||||
def mkInt (i : Int) : Expr :=
|
||||
if 0 ≤ i then
|
||||
mkNat i.toNat
|
||||
else
|
||||
mkApp3 (.const ``Neg.neg [0]) (.const ``Int []) (mkNat (-i).toNat)
|
||||
(.const ``Int.instNegInt [])
|
||||
where
|
||||
mkNat (n : Nat) : Expr :=
|
||||
let r := mkRawNatLit n
|
||||
mkApp3 (.const ``OfNat.ofNat [0]) (.const ``Int []) r
|
||||
(.app (.const ``instOfNat []) r)
|
||||
|
||||
/--
|
||||
A partially processed `omega` context.
|
||||
@@ -68,7 +78,7 @@ def mkEvalRflProof (e : Expr) (lc : LinearCombo) : OmegaM Expr := do
|
||||
`e = (coordinate n).eval atoms`. -/
|
||||
def mkCoordinateEvalAtomsEq (e : Expr) (n : Nat) : OmegaM Expr := do
|
||||
if n < 10 then
|
||||
let atoms ← atoms
|
||||
let atoms := (← getThe State).atoms
|
||||
let tail ← mkListLit (.const ``Int []) atoms[n+1:].toArray.toList
|
||||
let lem := .str ``LinearCombo s!"coordinate_eval_{n}"
|
||||
mkEqSymm (mkAppN (.const lem []) (atoms[:n+1].toArray.push tail))
|
||||
@@ -187,16 +197,16 @@ partial def asLinearComboImpl (e : Expr) : OmegaM (LinearCombo × OmegaM Expr ×
|
||||
| (``HMod.hMod, #[_, _, _, _, n, k]) =>
|
||||
match groundNat? k with
|
||||
| some k' => do
|
||||
let k' := toExpr (k' : Int)
|
||||
let k' := mkInt k'
|
||||
rewrite (← mkAppM ``HMod.hMod #[n, k']) (mkApp2 (.const ``Int.emod_def []) n k')
|
||||
| none => mkAtomLinearCombo e
|
||||
| (``HDiv.hDiv, #[_, _, _, _, x, z]) =>
|
||||
match groundInt? z with
|
||||
| some 0 => rewrite e (mkApp (.const ``Int.ediv_zero []) x)
|
||||
| some i => do
|
||||
let e' ← mkAppM ``HDiv.hDiv #[x, toExpr i]
|
||||
let e' ← mkAppM ``HDiv.hDiv #[x, mkInt i]
|
||||
if i < 0 then
|
||||
rewrite e' (mkApp2 (.const ``Int.ediv_neg []) x (toExpr (-i)))
|
||||
rewrite e' (mkApp2 (.const ``Int.ediv_neg []) x (mkInt (-i)))
|
||||
else
|
||||
mkAtomLinearCombo e'
|
||||
| _ => mkAtomLinearCombo e
|
||||
@@ -210,13 +220,6 @@ partial def asLinearComboImpl (e : Expr) : OmegaM (LinearCombo × OmegaM Expr ×
|
||||
rewrite e (mkApp2 (.const ``Int.max_def []) a b)
|
||||
else
|
||||
mkAtomLinearCombo e
|
||||
| (``HPow.hPow, #[_, _, _, _, b, k]) =>
|
||||
match succ? k with /- match for `e+1` and `e.succ` -/
|
||||
| none => mkAtomLinearCombo e
|
||||
| some k' =>
|
||||
match groundInt? b with
|
||||
| some _ => rewrite e (mkApp2 (.const ``Int.pow_succ []) b k')
|
||||
| none => mkAtomLinearCombo e
|
||||
| (``Nat.cast, #[.const ``Int [], i, n]) =>
|
||||
handleNatCast e i n
|
||||
| (``Prod.fst, #[α, β, p]) => match p with
|
||||
@@ -258,10 +261,9 @@ where
|
||||
| (``HMod.hMod, #[_, _, _, _, a, b]) => rewrite e (mkApp2 (.const ``Int.ofNat_emod []) a b)
|
||||
| (``HSub.hSub, #[_, _, _, _, mkApp6 (.const ``HSub.hSub _) _ _ _ _ a b, c]) =>
|
||||
rewrite e (mkApp3 (.const ``Int.ofNat_sub_sub []) a b c)
|
||||
| (``HPow.hPow, #[_, _, _, _, a, b]) =>
|
||||
match groundNat? a with
|
||||
| some _ => rewrite e (mkApp2 (.const ``Int.ofNat_pow []) a b)
|
||||
| none => mkAtomLinearCombo e
|
||||
| (``HPow.hPow, #[_, _, _, _, a, b]) => match groundNat? a, groundNat? b with
|
||||
| some _, some _ => rewrite e (mkApp2 (.const ``Int.ofNat_pow []) a b)
|
||||
| _, _ => mkAtomLinearCombo e
|
||||
| (``Prod.fst, #[_, β, p]) => match p with
|
||||
| .app (.app (.app (.app (.const ``Prod.mk [0, v]) _) _) x) y =>
|
||||
rewrite e (mkApp3 (.const ``Int.ofNat_fst_mk [v]) β x y)
|
||||
@@ -358,7 +360,6 @@ def addIntInequality (p : MetaProblem) (h y : Expr) : OmegaM MetaProblem := do
|
||||
/-- Given a fact `h` with type `¬ P`, return a more useful fact obtained by pushing the negation. -/
|
||||
def pushNot (h P : Expr) : MetaM (Option Expr) := do
|
||||
let P ← whnfR P
|
||||
trace[omega] "pushing negation: {P}"
|
||||
match P with
|
||||
| .forallE _ t b _ =>
|
||||
if (← isProp t) && (← isProp b) then
|
||||
@@ -367,42 +368,43 @@ def pushNot (h P : Expr) : MetaM (Option Expr) := do
|
||||
else
|
||||
return none
|
||||
| .app _ _ =>
|
||||
match_expr P with
|
||||
| LT.lt α _ x y => match_expr α with
|
||||
| Nat => return some (mkApp3 (.const ``Nat.le_of_not_lt []) x y h)
|
||||
| Int => return some (mkApp3 (.const ``Int.le_of_not_lt []) x y h)
|
||||
| Fin n => return some (mkApp4 (.const ``Fin.le_of_not_lt []) n x y h)
|
||||
| _ => return none
|
||||
| LE.le α _ x y => match_expr α with
|
||||
| Nat => return some (mkApp3 (.const ``Nat.lt_of_not_le []) x y h)
|
||||
| Int => return some (mkApp3 (.const ``Int.lt_of_not_le []) x y h)
|
||||
| Fin n => return some (mkApp4 (.const ``Fin.lt_of_not_le []) n x y h)
|
||||
| _ => return none
|
||||
| Eq α x y => match_expr α with
|
||||
| Nat => return some (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h)
|
||||
| Int => return some (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h)
|
||||
| Fin n => return some (mkApp4 (.const ``Fin.lt_or_gt_of_ne []) n x y h)
|
||||
| _ => return none
|
||||
| Dvd.dvd α _ k x => match_expr α with
|
||||
| Nat => return some (mkApp3 (.const ``Nat.emod_pos_of_not_dvd []) k x h)
|
||||
| Int =>
|
||||
-- This introduces a disjunction that could be avoided by checking `k ≠ 0`.
|
||||
return some (mkApp3 (.const ``Int.emod_pos_of_not_dvd []) k x h)
|
||||
| _ => return none
|
||||
| Prod.Lex _ _ _ _ _ _ => return some (← mkAppM ``Prod.of_not_lex #[h])
|
||||
| Not P =>
|
||||
return some (mkApp3 (.const ``Decidable.of_not_not []) P
|
||||
(.app (.const ``Classical.propDecidable []) P) h)
|
||||
| And P Q =>
|
||||
return some (mkApp5 (.const ``Decidable.or_not_not_of_not_and []) P Q
|
||||
(.app (.const ``Classical.propDecidable []) P)
|
||||
(.app (.const ``Classical.propDecidable []) Q) h)
|
||||
| Or P Q =>
|
||||
return some (mkApp3 (.const ``and_not_not_of_not_or []) P Q h)
|
||||
| Iff P Q =>
|
||||
return some (mkApp5 (.const ``Decidable.and_not_or_not_and_of_not_iff []) P Q
|
||||
(.app (.const ``Classical.propDecidable []) P)
|
||||
(.app (.const ``Classical.propDecidable []) Q) h)
|
||||
match P.getAppFnArgs with
|
||||
| (``LT.lt, #[.const ``Int [], _, x, y]) =>
|
||||
return some (mkApp3 (.const ``Int.le_of_not_lt []) x y h)
|
||||
| (``LE.le, #[.const ``Int [], _, x, y]) =>
|
||||
return some (mkApp3 (.const ``Int.lt_of_not_le []) x y h)
|
||||
| (``LT.lt, #[.const ``Nat [], _, x, y]) =>
|
||||
return some (mkApp3 (.const ``Nat.le_of_not_lt []) x y h)
|
||||
| (``LE.le, #[.const ``Nat [], _, x, y]) =>
|
||||
return some (mkApp3 (.const ``Nat.lt_of_not_le []) x y h)
|
||||
| (``LT.lt, #[.app (.const ``Fin []) n, _, x, y]) =>
|
||||
return some (mkApp4 (.const ``Fin.le_of_not_lt []) n x y h)
|
||||
| (``LE.le, #[.app (.const ``Fin []) n, _, x, y]) =>
|
||||
return some (mkApp4 (.const ``Fin.lt_of_not_le []) n x y h)
|
||||
| (``Eq, #[.const ``Nat [], x, y]) =>
|
||||
return some (mkApp3 (.const ``Nat.lt_or_gt_of_ne []) x y h)
|
||||
| (``Eq, #[.const ``Int [], x, y]) =>
|
||||
return some (mkApp3 (.const ``Int.lt_or_gt_of_ne []) x y h)
|
||||
| (``Prod.Lex, _) => return some (← mkAppM ``Prod.of_not_lex #[h])
|
||||
| (``Eq, #[.app (.const ``Fin []) n, x, y]) =>
|
||||
return some (mkApp4 (.const ``Fin.lt_or_gt_of_ne []) n x y h)
|
||||
| (``Dvd.dvd, #[.const ``Nat [], _, k, x]) =>
|
||||
return some (mkApp3 (.const ``Nat.emod_pos_of_not_dvd []) k x h)
|
||||
| (``Dvd.dvd, #[.const ``Int [], _, k, x]) =>
|
||||
-- This introduces a disjunction that could be avoided by checking `k ≠ 0`.
|
||||
return some (mkApp3 (.const ``Int.emod_pos_of_not_dvd []) k x h)
|
||||
| (``Or, #[P₁, P₂]) => return some (mkApp3 (.const ``and_not_not_of_not_or []) P₁ P₂ h)
|
||||
| (``And, #[P₁, P₂]) =>
|
||||
return some (mkApp5 (.const ``Decidable.or_not_not_of_not_and []) P₁ P₂
|
||||
(.app (.const ``Classical.propDecidable []) P₁)
|
||||
(.app (.const ``Classical.propDecidable []) P₂) h)
|
||||
| (``Not, #[P']) =>
|
||||
return some (mkApp3 (.const ``Decidable.of_not_not []) P'
|
||||
(.app (.const ``Classical.propDecidable []) P') h)
|
||||
| (``Iff, #[P₁, P₂]) =>
|
||||
return some (mkApp5 (.const ``Decidable.and_not_or_not_and_of_not_iff []) P₁ P₂
|
||||
(.app (.const ``Classical.propDecidable []) P₁)
|
||||
(.app (.const ``Classical.propDecidable []) P₂) h)
|
||||
| _ => return none
|
||||
| _ => return none
|
||||
|
||||
@@ -598,7 +600,7 @@ def omegaTactic (cfg : OmegaConfig) : TacticM Unit := do
|
||||
|
||||
/-- The `omega` tactic, for resolving integer and natural linear arithmetic problems. This
|
||||
`TacticM Unit` frontend with default configuration can be used as an Aesop rule, for example via
|
||||
the tactic call `aesop (add 50% tactic Lean.Omega.omegaDefault)`. -/
|
||||
the tactic call `aesop (add 50% tactic Std.Tactic.Omega.omegaDefault)`. -/
|
||||
def omegaDefault : TacticM Unit := omegaTactic {}
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.omega]
|
||||
@@ -607,7 +609,3 @@ def evalOmega : Tactic := fun
|
||||
let cfg ← elabOmegaConfig (mkOptionalNode cfg)
|
||||
omegaTactic cfg
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
builtin_initialize bvOmegaSimpExtension : SimpExtension ←
|
||||
registerSimpAttr `bv_toNat
|
||||
"simp lemmas converting `BitVec` goals to `Nat` goals, for the `bv_omega` preprocessor"
|
||||
|
||||
@@ -3,10 +3,6 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.BinderPredicates
|
||||
import Init.Data.List
|
||||
import Init.Data.Option
|
||||
|
||||
/-!
|
||||
# `List.nonzeroMinimum`, `List.minNatAbs`, `List.maxNatAbs`
|
||||
|
||||
@@ -3,11 +3,6 @@ Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Omega.LinearCombo
|
||||
import Init.Omega.Int
|
||||
import Init.Omega.Logic
|
||||
import Init.Data.BitVec
|
||||
import Lean.Meta.AppBuilder
|
||||
|
||||
/-!
|
||||
@@ -51,7 +46,7 @@ structure Context where
|
||||
/-- The internal state for the `OmegaM` monad, recording previously encountered atoms. -/
|
||||
structure State where
|
||||
/-- The atoms up-to-defeq encountered so far. -/
|
||||
atoms : HashMap Expr Nat := {}
|
||||
atoms : Array Expr := #[]
|
||||
|
||||
/-- An intermediate layer in the `OmegaM` monad. -/
|
||||
abbrev OmegaM' := StateRefT State (ReaderT Context MetaM)
|
||||
@@ -76,11 +71,10 @@ def OmegaM.run (m : OmegaM α) (cfg : OmegaConfig) : MetaM α :=
|
||||
def cfg : OmegaM OmegaConfig := do pure (← read).cfg
|
||||
|
||||
/-- Retrieve the list of atoms. -/
|
||||
def atoms : OmegaM (Array Expr) := do
|
||||
return (← getThe State).atoms.toArray.qsort (·.2 < ·.2) |>.map (·.1)
|
||||
def atoms : OmegaM (List Expr) := return (← getThe State).atoms.toList
|
||||
|
||||
/-- Return the `Expr` representing the list of atoms. -/
|
||||
def atomsList : OmegaM Expr := do mkListLit (.const ``Int []) (← atoms).toList
|
||||
def atomsList : OmegaM Expr := do mkListLit (.const ``Int []) (← atoms)
|
||||
|
||||
/-- Return the `Expr` representing the list of atoms as a `Coeffs`. -/
|
||||
def atomsCoeffs : OmegaM Expr := do
|
||||
@@ -175,8 +169,6 @@ def analyzeAtom (e : Expr) : OmegaM (HashSet Expr) := do
|
||||
r := r.insert (mkApp (.const ``Int.neg_le_natAbs []) x)
|
||||
| _, (``Fin.val, #[n, i]) =>
|
||||
r := r.insert (mkApp2 (.const ``Fin.isLt []) n i)
|
||||
| _, (``BitVec.toNat, #[n, x]) =>
|
||||
r := r.insert (mkApp2 (.const ``BitVec.toNat_lt []) n x)
|
||||
| _, _ => pure ()
|
||||
return r
|
||||
| (``HDiv.hDiv, #[_, _, _, _, x, k]) => match natCast? k with
|
||||
@@ -244,16 +236,15 @@ Return its index, and, if it is new, a collection of interesting facts about the
|
||||
-/
|
||||
def lookup (e : Expr) : OmegaM (Nat × Option (HashSet Expr)) := do
|
||||
let c ← getThe State
|
||||
match c.atoms.find? e with
|
||||
| some i => return (i, none)
|
||||
| none =>
|
||||
for h : i in [:c.atoms.size] do
|
||||
if ← isDefEq e c.atoms[i] then
|
||||
return (i, none)
|
||||
trace[omega] "New atom: {e}"
|
||||
let facts ← analyzeAtom e
|
||||
if ← isTracingEnabledFor `omega then
|
||||
unless facts.isEmpty do
|
||||
trace[omega] "New facts: {← facts.toList.mapM fun e => inferType e}"
|
||||
let i ← modifyGetThe State fun c =>
|
||||
(c.atoms.size, { c with atoms := c.atoms.insert e c.atoms.size })
|
||||
let i ← modifyGetThe State fun c => (c.atoms.size, { c with atoms := c.atoms.push e })
|
||||
return (i, some facts)
|
||||
|
||||
end Omega
|
||||
|
||||
@@ -1,28 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Scott Morrison. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.ElabRules
|
||||
import Lean.Meta.Tactic.TryThis
|
||||
|
||||
namespace Std.Tactic
|
||||
open Lean Elab Term Tactic Meta.Tactic.TryThis Parser.Tactic
|
||||
|
||||
@[builtin_tactic showTerm] def evalShowTerm : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| show_term%$tk $t) => withMainContext do
|
||||
let g ← getMainGoal
|
||||
evalTactic t
|
||||
addExactSuggestion tk (← instantiateMVars (mkMVar g)).headBeta (origSpan? := ← getRef)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/-- Implementation of `show_term` term elaborator. -/
|
||||
@[builtin_term_elab showTermElabImpl] def elabShowTerm : TermElab
|
||||
| `(show_term_elab%$tk $t), ty => do
|
||||
let e ← Term.elabTermEnsuringType t ty
|
||||
Term.synthesizeSyntheticMVarsNoPostponing
|
||||
addTermSuggestion tk (← instantiateMVars e).headBeta (origSpan? := ← getRef)
|
||||
pure e
|
||||
| _, _ => throwUnsupportedSyntax
|
||||
@@ -178,24 +178,13 @@ def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (simprocs : Simp.SimprocsAr
|
||||
-- We use `eraseCore` because the simp theorem for the hypothesis was not added yet
|
||||
thms := thms.eraseCore (.fvar fvar.fvarId!)
|
||||
else
|
||||
let id := arg[1]
|
||||
let declNames? ← try pure (some (← resolveGlobalConst id)) catch _ => pure none
|
||||
if let some declNames := declNames? then
|
||||
let declName ← ensureNonAmbiguous id declNames
|
||||
if (← Simp.isSimproc declName) then
|
||||
simprocs := simprocs.erase declName
|
||||
else if ctx.config.autoUnfold then
|
||||
thms := thms.eraseCore (.decl declName)
|
||||
else
|
||||
thms ← thms.erase (.decl declName)
|
||||
let declName ← resolveGlobalConstNoOverloadWithInfo arg[1]
|
||||
if (← Simp.isSimproc declName) then
|
||||
simprocs := simprocs.erase declName
|
||||
else if ctx.config.autoUnfold then
|
||||
thms := thms.eraseCore (.decl declName)
|
||||
else
|
||||
-- If `id` could not be resolved, we should check whether it is a builtin simproc.
|
||||
-- before returning error.
|
||||
let name := id.getId.eraseMacroScopes
|
||||
if (← Simp.isBuiltinSimproc name) then
|
||||
simprocs := simprocs.erase name
|
||||
else
|
||||
throwUnknownConstant name
|
||||
thms ← thms.erase (.decl declName)
|
||||
else if arg.getKind == ``Lean.Parser.Tactic.simpLemma then
|
||||
let post :=
|
||||
if arg[0].isNone then
|
||||
@@ -353,13 +342,14 @@ def mkSimpOnly (stx : Syntax) (usedSimps : UsedSimps) : MetaM Syntax := do
|
||||
| true => `(Parser.Tactic.simpLemma| $decl:term)
|
||||
| false => `(Parser.Tactic.simpLemma| ↓ $decl:term)
|
||||
args := args.push arg
|
||||
| .fvar fvarId =>
|
||||
-- local hypotheses in the context
|
||||
| .fvar fvarId => -- local hypotheses in the context
|
||||
-- `simp_all` always uses all propositional hypotheses (and it can't use
|
||||
-- any others). So `simp_all only [h]`, where `h` is a hypothesis, would
|
||||
-- be redundant. It would also be confusing since it suggests that only
|
||||
-- `h` is used.
|
||||
if isSimpAll then
|
||||
continue
|
||||
if let some ldecl := lctx.find? fvarId then
|
||||
-- `simp_all` always uses all propositional hypotheses.
|
||||
-- So `simp_all only [x]`, only makes sense if `ldecl` is a let-variable.
|
||||
if isSimpAll && !ldecl.hasValue then
|
||||
continue
|
||||
localsOrStar := localsOrStar.bind fun locals =>
|
||||
if !ldecl.userName.isInaccessibleUserName && !ldecl.userName.hasMacroScopes &&
|
||||
(lctx.findFromUserName? ldecl.userName).get!.fvarId == ldecl.fvarId then
|
||||
|
||||
@@ -3,7 +3,6 @@ Copyright (c) 2022 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Elab.ElabRules
|
||||
import Lean.Elab.Tactic.Simp
|
||||
import Lean.Meta.Tactic.TryThis
|
||||
@@ -25,12 +24,13 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
|
||||
@[builtin_tactic simpTrace] def evalSimpTrace : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic|
|
||||
simp?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => withMainContext do
|
||||
simp?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => do
|
||||
let stx ← if bang.isSome then
|
||||
`(tactic| simp!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
else
|
||||
`(tactic| simp%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
let { ctx, simprocs, dischargeWrapper } ← mkSimpContext stx (eraseLocal := false)
|
||||
let { ctx, simprocs, dischargeWrapper } ←
|
||||
withMainContext <| mkSimpContext stx (eraseLocal := false)
|
||||
let usedSimps ← dischargeWrapper.with fun discharge? =>
|
||||
simpLocation ctx (simprocs := simprocs) discharge? <|
|
||||
(loc.map expandLocation).getD (.targets #[] true)
|
||||
|
||||
@@ -3,7 +3,6 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Arthur Paulino, Gabriel Ebner, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Tactic.Assumption
|
||||
import Lean.Meta.Tactic.TryThis
|
||||
import Lean.Elab.Tactic.Simp
|
||||
|
||||
@@ -7,7 +7,7 @@ prelude
|
||||
import Lean.Meta.Tactic.SolveByElim
|
||||
import Lean.Elab.Tactic.Config
|
||||
|
||||
namespace Lean.Elab.Tactic.SolveByElim
|
||||
namespace Lean.Elab.Tactic
|
||||
open Meta
|
||||
|
||||
open Lean.Parser.Tactic
|
||||
@@ -110,4 +110,4 @@ def evalSolveByElim : Tactic := fun stx =>
|
||||
pure ()
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic.SolveByElim
|
||||
end Lean.Elab.Tactic
|
||||
|
||||
@@ -24,13 +24,6 @@ def MacroScopesView.format (view : MacroScopesView) (mainModule : Name) : Format
|
||||
else
|
||||
view.scopes.foldl Name.mkNum (view.name ++ view.imported ++ view.mainModule)
|
||||
|
||||
/--
|
||||
Two names are from the same lexical scope if their scoping information modulo `MacroScopesView.name`
|
||||
is equal.
|
||||
-/
|
||||
def MacroScopesView.equalScope (a b : MacroScopesView) : Bool :=
|
||||
a.scopes == b.scopes && a.mainModule == b.mainModule && a.imported == b.imported
|
||||
|
||||
namespace Elab
|
||||
|
||||
def expandOptNamedPrio (stx : Syntax) : MacroM Nat :=
|
||||
|
||||
@@ -69,7 +69,7 @@ protected def throwError [Monad m] [MonadError m] (msg : MessageData) : m α :=
|
||||
let (ref, msg) ← AddErrorMessageContext.add ref msg
|
||||
throw <| Exception.error ref msg
|
||||
|
||||
/-- Throw an unknown constant error message. -/
|
||||
/-- Thrown an unknown constant error message. -/
|
||||
def throwUnknownConstant [Monad m] [MonadError m] (constName : Name) : m α :=
|
||||
Lean.throwError m!"unknown constant '{mkConst constName}'"
|
||||
|
||||
|
||||
@@ -801,7 +801,7 @@ def isType0 : Expr → Bool
|
||||
|
||||
/-- Return `true` if the given expression is `.sort .zero` -/
|
||||
def isProp : Expr → Bool
|
||||
| sort .zero => true
|
||||
| sort (.zero ..) => true
|
||||
| _ => false
|
||||
|
||||
/-- Return `true` if the given expression is a bound variable. -/
|
||||
@@ -904,14 +904,6 @@ def appArg!' : Expr → Expr
|
||||
| app _ a => a
|
||||
| _ => panic! "application expected"
|
||||
|
||||
def appArg (e : Expr) (h : e.isApp) : Expr :=
|
||||
match e, h with
|
||||
| .app _ a, _ => a
|
||||
|
||||
def appFn (e : Expr) (h : e.isApp) : Expr :=
|
||||
match e, h with
|
||||
| .app f _, _ => f
|
||||
|
||||
def sortLevel! : Expr → Level
|
||||
| sort u => u
|
||||
| _ => panic! "sort expected"
|
||||
@@ -920,7 +912,7 @@ def litValue! : Expr → Literal
|
||||
| lit v => v
|
||||
| _ => panic! "literal expected"
|
||||
|
||||
def isRawNatLit : Expr → Bool
|
||||
def isNatLit : Expr → Bool
|
||||
| lit (Literal.natVal _) => true
|
||||
| _ => false
|
||||
|
||||
@@ -933,7 +925,7 @@ def isStringLit : Expr → Bool
|
||||
| _ => false
|
||||
|
||||
def isCharLit : Expr → Bool
|
||||
| app (const c _) a => c == ``Char.ofNat && a.isRawNatLit
|
||||
| app (const c _) a => c == ``Char.ofNat && a.isNatLit
|
||||
| _ => false
|
||||
|
||||
def constName! : Expr → Name
|
||||
@@ -1045,14 +1037,6 @@ def getAppFn : Expr → Expr
|
||||
| app f _ => getAppFn f
|
||||
| e => e
|
||||
|
||||
/--
|
||||
Similar to `getAppFn`, but skips `mdata`
|
||||
-/
|
||||
def getAppFn' : Expr → Expr
|
||||
| app f _ => getAppFn' f
|
||||
| mdata _ a => getAppFn' a
|
||||
| e => e
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns true if `f` is a constant with name `n`. -/
|
||||
def isAppOf (e : Expr) (n : Name) : Bool :=
|
||||
match e.getAppFn with
|
||||
@@ -1075,6 +1059,33 @@ def isAppOfArity' : Expr → Name → Nat → Bool
|
||||
| app f _, n, a+1 => isAppOfArity' f n a
|
||||
| _, _, _ => false
|
||||
|
||||
/--
|
||||
Checks if an expression is a "natural number numeral in normal form",
|
||||
i.e. of type `Nat`, and explicitly of the form `OfNat.ofNat n`
|
||||
where `n` matches `.lit (.natVal n)` for some literal natural number `n`.
|
||||
and if so returns `n`.
|
||||
-/
|
||||
-- Note that `Expr.lit (.natVal n)` is not considered in normal form!
|
||||
def nat? (e : Expr) : Option Nat := do
|
||||
guard <| e.isAppOfArity ``OfNat.ofNat 3
|
||||
let lit (.natVal n) := e.appFn!.appArg! | none
|
||||
n
|
||||
|
||||
/--
|
||||
Checks if an expression is an "integer numeral in normal form",
|
||||
i.e. of type `Nat` or `Int`, and either a natural number numeral in normal form (as specified by `nat?`),
|
||||
or the negation of a positive natural number numberal in normal form,
|
||||
and if so returns the integer.
|
||||
-/
|
||||
def int? (e : Expr) : Option Int :=
|
||||
if e.isAppOfArity ``Neg.neg 3 then
|
||||
match e.appArg!.nat? with
|
||||
| none => none
|
||||
| some 0 => none
|
||||
| some n => some (-n)
|
||||
else
|
||||
e.nat?
|
||||
|
||||
private def getAppNumArgsAux : Expr → Nat → Nat
|
||||
| app f _, n => getAppNumArgsAux f (n+1)
|
||||
| _, n => n
|
||||
@@ -1196,21 +1207,10 @@ def getRevArg! : Expr → Nat → Expr
|
||||
| app f _, i+1 => getRevArg! f i
|
||||
| _, _ => panic! "invalid index"
|
||||
|
||||
/-- Similar to `getRevArg!` but skips `mdata` -/
|
||||
def getRevArg!' : Expr → Nat → Expr
|
||||
| mdata _ a, i => getRevArg!' a i
|
||||
| app _ a, 0 => a
|
||||
| app f _, i+1 => getRevArg!' f i
|
||||
| _, _ => panic! "invalid index"
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or panics if out of bounds. -/
|
||||
@[inline] def getArg! (e : Expr) (i : Nat) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArg! e (n - i - 1)
|
||||
|
||||
/-- Similar to `getArg!`, but skips mdata -/
|
||||
@[inline] def getArg!' (e : Expr) (i : Nat) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArg!' e (n - i - 1)
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or returns `v₀` if out of bounds. -/
|
||||
@[inline] def getArgD (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArgD e (n - i - 1) v₀
|
||||
@@ -1597,45 +1597,12 @@ partial def cleanupAnnotations (e : Expr) : Expr :=
|
||||
let e' := e.consumeMData.consumeTypeAnnotations
|
||||
if e' == e then e else cleanupAnnotations e'
|
||||
|
||||
/--
|
||||
Similar to `appFn`, but also applies `cleanupAnnotations` to resulting function.
|
||||
This function is used compile the `match_expr` term.
|
||||
-/
|
||||
def appFnCleanup (e : Expr) (h : e.isApp) : Expr :=
|
||||
match e, h with
|
||||
| .app f _, _ => f.cleanupAnnotations
|
||||
|
||||
def isFalse (e : Expr) : Bool :=
|
||||
e.cleanupAnnotations.isConstOf ``False
|
||||
|
||||
def isTrue (e : Expr) : Bool :=
|
||||
e.cleanupAnnotations.isConstOf ``True
|
||||
|
||||
/--
|
||||
Checks if an expression is a "natural number numeral in normal form",
|
||||
i.e. of type `Nat`, and explicitly of the form `OfNat.ofNat n`
|
||||
where `n` matches `.lit (.natVal n)` for some literal natural number `n`.
|
||||
and if so returns `n`.
|
||||
-/
|
||||
-- Note that `Expr.lit (.natVal n)` is not considered in normal form!
|
||||
def nat? (e : Expr) : Option Nat := do
|
||||
let_expr OfNat.ofNat _ n _ := e | failure
|
||||
let lit (.natVal n) := n | failure
|
||||
n
|
||||
|
||||
/--
|
||||
Checks if an expression is an "integer numeral in normal form",
|
||||
i.e. of type `Nat` or `Int`, and either a natural number numeral in normal form (as specified by `nat?`),
|
||||
or the negation of a positive natural number numberal in normal form,
|
||||
and if so returns the integer.
|
||||
-/
|
||||
def int? (e : Expr) : Option Int :=
|
||||
let_expr Neg.neg _ _ a := e | e.nat?
|
||||
match a.nat? with
|
||||
| none => none
|
||||
| some 0 => none
|
||||
| some n => some (-n)
|
||||
|
||||
/-- Return true iff `e` contains a free variable which satisfies `p`. -/
|
||||
@[inline] def hasAnyFVar (e : Expr) (p : FVarId → Bool) : Bool :=
|
||||
let rec @[specialize] visit (e : Expr) := if !e.hasFVar then false else
|
||||
|
||||
@@ -45,5 +45,3 @@ import Lean.Meta.ExprTraverse
|
||||
import Lean.Meta.Eval
|
||||
import Lean.Meta.CoeAttr
|
||||
import Lean.Meta.Iterator
|
||||
import Lean.Meta.LazyDiscrTree
|
||||
import Lean.Meta.LitValues
|
||||
|
||||
@@ -254,7 +254,7 @@ structure PostponedEntry where
|
||||
ref : Syntax
|
||||
lhs : Level
|
||||
rhs : Level
|
||||
/-- Context for the surrounding `isDefEq` call when the entry was created. -/
|
||||
/-- Context for the surrounding `isDefEq` call when entry was created. -/
|
||||
ctx? : Option DefEqContext
|
||||
deriving Inhabited
|
||||
|
||||
@@ -264,7 +264,7 @@ structure PostponedEntry where
|
||||
structure State where
|
||||
mctx : MetavarContext := {}
|
||||
cache : Cache := {}
|
||||
/-- When `trackZetaDelta == true`, then any let-decl free variable that is zetaDelta-expanded by `MetaM` is stored in `zetaDeltaFVarIds`. -/
|
||||
/-- When `trackZetaDelta == true`, then any let-decl free variable that is zetaDelta expansion performed by `MetaM` is stored in `zetaDeltaFVarIds`. -/
|
||||
zetaDeltaFVarIds : FVarIdSet := {}
|
||||
/-- Array of postponed universe level constraints -/
|
||||
postponed : PersistentArray PostponedEntry := {}
|
||||
@@ -1067,23 +1067,6 @@ partial def withNewLocalInstances (fvars : Array Expr) (j : Nat) : n α → n α
|
||||
def forallTelescope (type : Expr) (k : Array Expr → Expr → n α) : n α :=
|
||||
map2MetaM (fun k => forallTelescopeImp type k) k
|
||||
|
||||
/--
|
||||
Given a monadic function `f` that takes a type and a term of that type and produces a new term,
|
||||
lifts this to the monadic function that opens a `∀` telescope, applies `f` to the body,
|
||||
and then builds the lambda telescope term for the new term.
|
||||
-/
|
||||
def mapForallTelescope' (f : Expr → Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do
|
||||
forallTelescope (← inferType forallTerm) fun xs ty => do
|
||||
mkLambdaFVars xs (← f ty (mkAppN forallTerm xs))
|
||||
|
||||
/--
|
||||
Given a monadic function `f` that takes a term and produces a new term,
|
||||
lifts this to the monadic function that opens a `∀` telescope, applies `f` to the body,
|
||||
and then builds the lambda telescope term for the new term.
|
||||
-/
|
||||
def mapForallTelescope (f : Expr → MetaM Expr) (forallTerm : Expr) : MetaM Expr := do
|
||||
mapForallTelescope' (fun _ e => f e) forallTerm
|
||||
|
||||
private def forallTelescopeReducingImp (type : Expr) (k : Array Expr → Expr → MetaM α) : MetaM α :=
|
||||
forallTelescopeReducingAux type (maxFVars? := none) k
|
||||
|
||||
@@ -1737,15 +1720,6 @@ def isDefEqNoConstantApprox (t s : Expr) : MetaM Bool :=
|
||||
def etaExpand (e : Expr) : MetaM Expr :=
|
||||
withDefault do forallTelescopeReducing (← inferType e) fun xs _ => mkLambdaFVars xs (mkAppN e xs)
|
||||
|
||||
/--
|
||||
If `e` is of the form `?m ...` instantiate metavars
|
||||
-/
|
||||
def instantiateMVarsIfMVarApp (e : Expr) : MetaM Expr := do
|
||||
if e.getAppFn.isMVar then
|
||||
instantiateMVars e
|
||||
else
|
||||
return e
|
||||
|
||||
end Meta
|
||||
|
||||
builtin_initialize
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2023 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
|
||||
import Lean.Meta.Basic
|
||||
import Lean.Meta.Match.MatcherInfo
|
||||
|
||||
@@ -29,21 +29,11 @@ builtin_initialize completionBlackListExt : TagDeclarationExtension ← mkTagDec
|
||||
def addToCompletionBlackList (env : Environment) (declName : Name) : Environment :=
|
||||
completionBlackListExt.tag env declName
|
||||
|
||||
/--
|
||||
Checks whether a given name is internal due to something other than `_private`.
|
||||
Correctly deals with names like `_private.<SomeNamespace>.0.<SomeType>._sizeOf_1` in a private type
|
||||
`SomeType`, which `n.isInternal && !isPrivateName n` does not.
|
||||
-/
|
||||
private def isInternalNameModuloPrivate : Name → Bool
|
||||
| n@(.str p s) => s.get 0 == '_' && n != privateHeader || isInternalNameModuloPrivate p
|
||||
| .num p _ => isInternalNameModuloPrivate p
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Return true if name is blacklisted for completion purposes.
|
||||
-/
|
||||
private def isBlacklisted (env : Environment) (declName : Name) : Bool :=
|
||||
isInternalNameModuloPrivate declName
|
||||
declName.isInternal && !isPrivateName declName
|
||||
|| isAuxRecursor env declName
|
||||
|| isNoConfusion env declName
|
||||
|| isRecCore env declName
|
||||
|
||||
@@ -1,74 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.LitValues
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
private def getConstructorVal? (env : Environment) (ctorName : Name) : Option ConstructorVal :=
|
||||
match env.find? ctorName with
|
||||
| some (.ctorInfo v) => v
|
||||
| _ => none
|
||||
|
||||
|
||||
/--
|
||||
If `e` is a constructor application or a builtin literal defeq to a constructor application,
|
||||
then return the corresponding `ConstructorVal`.
|
||||
-/
|
||||
def isConstructorApp? (e : Expr) : MetaM (Option ConstructorVal) := do
|
||||
let e ← litToCtor e
|
||||
let .const n _ := e.getAppFn | return none
|
||||
let some v := getConstructorVal? (← getEnv) n | return none
|
||||
if v.numParams + v.numFields == e.getAppNumArgs then
|
||||
return some v
|
||||
else
|
||||
return none
|
||||
|
||||
/--
|
||||
Similar to `isConstructorApp?`, but uses `whnf`.
|
||||
-/
|
||||
def isConstructorApp'? (e : Expr) : MetaM (Option ConstructorVal) := do
|
||||
if let some r ← isConstructorApp? e then
|
||||
return r
|
||||
isConstructorApp? (← whnf e)
|
||||
|
||||
/--
|
||||
Returns `true`, if `e` is constructor application of builtin literal defeq to
|
||||
a constructor application.
|
||||
-/
|
||||
def isConstructorApp (e : Expr) : MetaM Bool :=
|
||||
return (← isConstructorApp? e).isSome
|
||||
|
||||
/--
|
||||
Returns `true` if `isConstructorApp e` or `isConstructorApp (← whnf e)`
|
||||
-/
|
||||
def isConstructorApp' (e : Expr) : MetaM Bool := do
|
||||
if (← isConstructorApp e) then return true
|
||||
return (← isConstructorApp (← whnf e))
|
||||
|
||||
/--
|
||||
If `e` is a constructor application, return a pair containing the corresponding `ConstructorVal` and the constructor
|
||||
application arguments.
|
||||
-/
|
||||
def constructorApp? (e : Expr) : MetaM (Option (ConstructorVal × Array Expr)) := do
|
||||
let e ← litToCtor e
|
||||
let .const declName _ := e.getAppFn | return none
|
||||
let some v := getConstructorVal? (← getEnv) declName | return none
|
||||
if v.numParams + v.numFields == e.getAppNumArgs then
|
||||
return some (v, e.getAppArgs)
|
||||
else
|
||||
return none
|
||||
|
||||
/--
|
||||
Similar to `constructorApp?`, but on failure it puts `e` in WHNF and tries again.
|
||||
-/
|
||||
def constructorApp'? (e : Expr) : MetaM (Option (ConstructorVal × Array Expr)) := do
|
||||
if let some r ← constructorApp? e then
|
||||
return some r
|
||||
else
|
||||
constructorApp? (← whnf e)
|
||||
|
||||
end Lean.Meta
|
||||
@@ -172,7 +172,7 @@ private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Arr
|
||||
- `Nat.succ x` where `isNumeral x`
|
||||
- `OfNat.ofNat _ x _` where `isNumeral x` -/
|
||||
private partial def isNumeral (e : Expr) : Bool :=
|
||||
if e.isRawNatLit then true
|
||||
if e.isNatLit then true
|
||||
else
|
||||
let f := e.getAppFn
|
||||
if !f.isConst then false
|
||||
|
||||
@@ -51,8 +51,7 @@ private def shouldGenerateEqnThms (declName : Name) : MetaM Bool := do
|
||||
return false
|
||||
|
||||
structure EqnsExtState where
|
||||
map : PHashMap Name (Array Name) := {}
|
||||
mapInv : PHashMap Name Name := {}
|
||||
map : PHashMap Name (Array Name) := {}
|
||||
deriving Inhabited
|
||||
|
||||
/- We generate the equations on demand, and do not save them on .olean files. -/
|
||||
@@ -78,22 +77,7 @@ private def mkSimpleEqThm (declName : Name) : MetaM (Option Name) := do
|
||||
return none
|
||||
|
||||
/--
|
||||
Returns `some declName` if `thmName` is an equational theorem for `declName`.
|
||||
-/
|
||||
def isEqnThm? (thmName : Name) : CoreM (Option Name) := do
|
||||
return eqnsExt.getState (← getEnv) |>.mapInv.find? thmName
|
||||
|
||||
/--
|
||||
Stores in the `eqnsExt` environment extension that `eqThms` are the equational theorems for `declName`
|
||||
-/
|
||||
private def registerEqnThms (declName : Name) (eqThms : Array Name) : CoreM Unit := do
|
||||
modifyEnv fun env => eqnsExt.modifyState env fun s => { s with
|
||||
map := s.map.insert declName eqThms
|
||||
mapInv := eqThms.foldl (init := s.mapInv) fun mapInv eqThm => mapInv.insert eqThm declName
|
||||
}
|
||||
|
||||
/--
|
||||
Returns equation theorems for the given declaration.
|
||||
Return equation theorems for the given declaration.
|
||||
By default, we do not create equation theorems for nonrecursive definitions.
|
||||
You can use `nonRec := true` to override this behavior, a dummy `rfl` proof is created on the fly.
|
||||
-/
|
||||
@@ -103,12 +87,12 @@ def getEqnsFor? (declName : Name) (nonRec := false) : MetaM (Option (Array Name)
|
||||
else if (← shouldGenerateEqnThms declName) then
|
||||
for f in (← getEqnsFnsRef.get) do
|
||||
if let some r ← f declName then
|
||||
registerEqnThms declName r
|
||||
modifyEnv fun env => eqnsExt.modifyState env fun s => { s with map := s.map.insert declName r }
|
||||
return some r
|
||||
if nonRec then
|
||||
let some eqThm ← mkSimpleEqThm declName | return none
|
||||
let r := #[eqThm]
|
||||
registerEqnThms declName r
|
||||
modifyEnv fun env => eqnsExt.modifyState env fun s => { s with map := s.map.insert declName r }
|
||||
return some r
|
||||
return none
|
||||
|
||||
@@ -147,8 +131,8 @@ def registerGetUnfoldEqnFn (f : GetUnfoldEqnFn) : IO Unit := do
|
||||
getUnfoldEqnFnsRef.modify (f :: ·)
|
||||
|
||||
/--
|
||||
Return an "unfold" theorem for the given declaration.
|
||||
By default, we do not create unfold theorems for nonrecursive definitions.
|
||||
Return a "unfold" theorem for the given declaration.
|
||||
By default, we not create unfold theorems for nonrecursive definitions.
|
||||
You can use `nonRec := true` to override this behavior.
|
||||
-/
|
||||
def getUnfoldEqnFor? (declName : Name) (nonRec := false) : MetaM (Option Name) := withLCtx {} {} do
|
||||
|
||||
@@ -138,11 +138,11 @@ private def viewCoordRaw: Expr → Nat → M Expr
|
||||
| e , c => throwError "Bad coordinate {c} for {e}"
|
||||
|
||||
|
||||
/-- Given a valid `SubExpr`, return the raw current expression without performing any instantiation.
|
||||
If the given `SubExpr` has a type subexpression coordinate, then throw an error.
|
||||
/-- Given a valid SubExpr, will return the raw current expression without performing any instantiation.
|
||||
If the SubExpr has a type subexpression coordinate then will error.
|
||||
|
||||
This is a cheaper version of `Lean.Meta.viewSubexpr` and can be used to quickly view the
|
||||
subexpression at a position. Note that because the resulting expression may contain
|
||||
subexpression at a position. Note that because the resulting expression will contain
|
||||
loose bound variables it can't be used in any `MetaM` methods. -/
|
||||
def viewSubexpr (p : Pos) (root : Expr) : M Expr :=
|
||||
p.foldlM viewCoordRaw root
|
||||
@@ -172,3 +172,5 @@ def numBinders (p : Pos) (e : Expr) : M Nat :=
|
||||
end ViewRaw
|
||||
|
||||
end Lean.Core
|
||||
|
||||
|
||||
|
||||
@@ -26,8 +26,10 @@ private def mkAnd? (args : Array Expr) : Option Expr := Id.run do
|
||||
|
||||
def elimOptParam (type : Expr) : CoreM Expr := do
|
||||
Core.transform type fun e =>
|
||||
let_expr optParam _ a := e | return .continue
|
||||
return TransformStep.visit a
|
||||
if e.isAppOfArity ``optParam 2 then
|
||||
return TransformStep.visit (e.getArg! 0)
|
||||
else
|
||||
return .continue
|
||||
|
||||
private partial def mkInjectiveTheoremTypeCore? (ctorVal : ConstructorVal) (useEq : Bool) : MetaM (Option Expr) := do
|
||||
let us := ctorVal.levelParams.map mkLevelParam
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix
|
||||
-/
|
||||
|
||||
@@ -1,828 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Joe Hendrix, Scott Morrison
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.CompletionName
|
||||
import Lean.Meta.DiscrTree
|
||||
|
||||
/-!
|
||||
# Lazy Discrimination Tree
|
||||
|
||||
This file defines a new type of discrimination tree optimized for rapid
|
||||
population of imported modules for use in tactics. It uses a lazy
|
||||
initialization strategy.
|
||||
|
||||
The discrimination tree can be created through
|
||||
`createImportedEnvironment`. This creates a discrimination tree from all
|
||||
imported modules in an environment using a callback that provides the
|
||||
entries as `InitEntry` values.
|
||||
|
||||
The function `getMatch` can be used to get the values that match the
|
||||
expression as well as an updated lazy discrimination tree that has
|
||||
elaborated additional parts of the tree.
|
||||
-/
|
||||
namespace Lean.Meta.LazyDiscrTree
|
||||
|
||||
-- This namespace contains definitions copied from Lean.Meta.DiscrTree.
|
||||
namespace MatchClone
|
||||
|
||||
/--
|
||||
Discrimination tree key.
|
||||
-/
|
||||
private inductive Key where
|
||||
| const : Name → Nat → Key
|
||||
| fvar : FVarId → Nat → Key
|
||||
| lit : Literal → Key
|
||||
| star : Key
|
||||
| other : Key
|
||||
| arrow : Key
|
||||
| proj : Name → Nat → Nat → Key
|
||||
deriving Inhabited, BEq, Repr
|
||||
|
||||
namespace Key
|
||||
|
||||
/-- Hash function -/
|
||||
protected def hash : Key → UInt64
|
||||
| .const n a => mixHash 5237 $ mixHash n.hash (hash a)
|
||||
| .fvar n a => mixHash 3541 $ mixHash (hash n) (hash a)
|
||||
| .lit v => mixHash 1879 $ hash v
|
||||
| .star => 7883
|
||||
| .other => 2411
|
||||
| .arrow => 17
|
||||
| .proj s i a => mixHash (hash a) $ mixHash (hash s) (hash i)
|
||||
|
||||
instance : Hashable Key := ⟨Key.hash⟩
|
||||
|
||||
end Key
|
||||
|
||||
private def tmpMVarId : MVarId := { name := `_discr_tree_tmp }
|
||||
private def tmpStar := mkMVar tmpMVarId
|
||||
|
||||
/--
|
||||
Returns true iff the argument should be treated as a "wildcard" by the
|
||||
discrimination tree.
|
||||
|
||||
This includes proofs, instance implicit arguments, implicit arguments,
|
||||
and terms of the form `noIndexing t`
|
||||
|
||||
This is a clone of `Lean.Meta.DiscrTree.ignoreArg` and mainly added to
|
||||
avoid coupling between `DiscrTree` and `LazyDiscrTree` while both are
|
||||
potentially subject to independent changes.
|
||||
-/
|
||||
private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool := do
|
||||
if h : i < infos.size then
|
||||
let info := infos.get ⟨i, h⟩
|
||||
if info.isInstImplicit then
|
||||
return true
|
||||
else if info.isImplicit || info.isStrictImplicit then
|
||||
return not (← isType a)
|
||||
else
|
||||
isProof a
|
||||
else
|
||||
isProof a
|
||||
|
||||
private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → MetaM (Array Expr)
|
||||
| i, .app f a, todo => do
|
||||
if (← ignoreArg a i infos) then
|
||||
pushArgsAux infos (i-1) f (todo.push tmpStar)
|
||||
else
|
||||
pushArgsAux infos (i-1) f (todo.push a)
|
||||
| _, _, todo => return todo
|
||||
|
||||
/--
|
||||
Returns `true` if `e` is one of the following
|
||||
- A nat literal (numeral)
|
||||
- `Nat.zero`
|
||||
- `Nat.succ x` where `isNumeral x`
|
||||
- `OfNat.ofNat _ x _` where `isNumeral x` -/
|
||||
private partial def isNumeral (e : Expr) : Bool :=
|
||||
if e.isRawNatLit then true
|
||||
else
|
||||
let f := e.getAppFn
|
||||
if !f.isConst then false
|
||||
else
|
||||
let fName := f.constName!
|
||||
if fName == ``Nat.succ && e.getAppNumArgs == 1 then isNumeral e.appArg!
|
||||
else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then isNumeral (e.getArg! 1)
|
||||
else if fName == ``Nat.zero && e.getAppNumArgs == 0 then true
|
||||
else false
|
||||
|
||||
private partial def toNatLit? (e : Expr) : Option Literal :=
|
||||
if isNumeral e then
|
||||
if let some n := loop e then
|
||||
some (.natVal n)
|
||||
else
|
||||
none
|
||||
else
|
||||
none
|
||||
where
|
||||
loop (e : Expr) : OptionT Id Nat := do
|
||||
let f := e.getAppFn
|
||||
match f with
|
||||
| .lit (.natVal n) => return n
|
||||
| .const fName .. =>
|
||||
if fName == ``Nat.succ && e.getAppNumArgs == 1 then
|
||||
let r ← loop e.appArg!
|
||||
return r+1
|
||||
else if fName == ``OfNat.ofNat && e.getAppNumArgs == 3 then
|
||||
loop (e.getArg! 1)
|
||||
else if fName == ``Nat.zero && e.getAppNumArgs == 0 then
|
||||
return 0
|
||||
else
|
||||
failure
|
||||
| _ => failure
|
||||
|
||||
private def isNatType (e : Expr) : MetaM Bool :=
|
||||
return (← whnf e).isConstOf ``Nat
|
||||
|
||||
/--
|
||||
Returns `true` if `e` is one of the following
|
||||
- `Nat.add _ k` where `isNumeral k`
|
||||
- `Add.add Nat _ _ k` where `isNumeral k`
|
||||
- `HAdd.hAdd _ Nat _ _ k` where `isNumeral k`
|
||||
- `Nat.succ _`
|
||||
This function assumes `e.isAppOf fName`
|
||||
-/
|
||||
private def isNatOffset (fName : Name) (e : Expr) : MetaM Bool := do
|
||||
if fName == ``Nat.add && e.getAppNumArgs == 2 then
|
||||
return isNumeral e.appArg!
|
||||
else if fName == ``Add.add && e.getAppNumArgs == 4 then
|
||||
if (← isNatType (e.getArg! 0)) then return isNumeral e.appArg! else return false
|
||||
else if fName == ``HAdd.hAdd && e.getAppNumArgs == 6 then
|
||||
if (← isNatType (e.getArg! 1)) then return isNumeral e.appArg! else return false
|
||||
else
|
||||
return fName == ``Nat.succ && e.getAppNumArgs == 1
|
||||
|
||||
/-
|
||||
This is a hook to determine if we should add an expression as a wildcard pattern.
|
||||
|
||||
Clone of `Lean.Meta.DiscrTree.shouldAddAsStar`. See it for more discussion.
|
||||
-/
|
||||
private def shouldAddAsStar (fName : Name) (e : Expr) : MetaM Bool := do
|
||||
isNatOffset fName e
|
||||
|
||||
/--
|
||||
Eliminate loose bound variables via beta-reduction.
|
||||
|
||||
This is primarily used to reduce pi-terms `∀(x : P), T` into
|
||||
non-dependend functions `P → T`. The latter has a more specific
|
||||
discrimination tree key `.arrow..` and this improves the accuracy of the
|
||||
discrimination tree.
|
||||
|
||||
Clone of `Lean.Meta.DiscrTree.elimLooseBVarsByBeta`. See it for more
|
||||
discussion.
|
||||
-/
|
||||
private def elimLooseBVarsByBeta (e : Expr) : CoreM Expr :=
|
||||
Core.transform e
|
||||
(pre := fun e => do
|
||||
if !e.hasLooseBVars then
|
||||
return .done e
|
||||
else if e.isHeadBetaTarget then
|
||||
return .visit e.headBeta
|
||||
else
|
||||
return .continue)
|
||||
|
||||
private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) :
|
||||
MetaM (Key × Array Expr) := do
|
||||
let e ← DiscrTree.reduceDT e root config
|
||||
unless root do
|
||||
-- See pushArgs
|
||||
if let some v := toNatLit? e then
|
||||
return (.lit v, #[])
|
||||
match e.getAppFn with
|
||||
| .lit v => return (.lit v, #[])
|
||||
| .const c _ =>
|
||||
if (← getConfig).isDefEqStuckEx && e.hasExprMVar then
|
||||
if (← isReducible c) then
|
||||
/- `e` is a term `c ...` s.t. `c` is reducible and `e` has metavariables, but it was not
|
||||
unfolded. This can happen if the metavariables in `e` are "blocking" smart unfolding.
|
||||
If `isDefEqStuckEx` is enabled, then we must throw the `isDefEqStuck` exception to
|
||||
postpone TC resolution.
|
||||
-/
|
||||
Meta.throwIsDefEqStuck
|
||||
else if let some matcherInfo := isMatcherAppCore? (← getEnv) e then
|
||||
-- A matcher application is stuck if one of the discriminants has a metavariable
|
||||
let args := e.getAppArgs
|
||||
let start := matcherInfo.getFirstDiscrPos
|
||||
for arg in args[ start : start + matcherInfo.numDiscrs ] do
|
||||
if arg.hasExprMVar then
|
||||
Meta.throwIsDefEqStuck
|
||||
else if (← isRec c) then
|
||||
/- Similar to the previous case, but for `match` and recursor applications. It may be stuck
|
||||
(i.e., did not reduce) because of metavariables. -/
|
||||
Meta.throwIsDefEqStuck
|
||||
let nargs := e.getAppNumArgs
|
||||
return (.const c nargs, e.getAppRevArgs)
|
||||
| .fvar fvarId =>
|
||||
let nargs := e.getAppNumArgs
|
||||
return (.fvar fvarId nargs, e.getAppRevArgs)
|
||||
| .mvar mvarId =>
|
||||
if isMatch then
|
||||
return (.other, #[])
|
||||
else do
|
||||
let ctx ← read
|
||||
if ctx.config.isDefEqStuckEx then
|
||||
/-
|
||||
When the configuration flag `isDefEqStuckEx` is set to true,
|
||||
we want `isDefEq` to throw an exception whenever it tries to assign
|
||||
a read-only metavariable.
|
||||
This feature is useful for type class resolution where
|
||||
we may want to notify the caller that the TC problem may be solvable
|
||||
later after it assigns `?m`.
|
||||
The method `DiscrTree.getUnify e` returns candidates `c` that may "unify" with `e`.
|
||||
That is, `isDefEq c e` may return true. Now, consider `DiscrTree.getUnify d (Add ?m)`
|
||||
where `?m` is a read-only metavariable, and the discrimination tree contains the keys
|
||||
`HadAdd Nat` and `Add Int`. If `isDefEqStuckEx` is set to true, we must treat `?m` as
|
||||
a regular metavariable here, otherwise we return the empty set of candidates.
|
||||
This is incorrect because it is equivalent to saying that there is no solution even if
|
||||
the caller assigns `?m` and try again. -/
|
||||
return (.star, #[])
|
||||
else if (← mvarId.isReadOnlyOrSyntheticOpaque) then
|
||||
return (.other, #[])
|
||||
else
|
||||
return (.star, #[])
|
||||
| .proj s i a .. =>
|
||||
let nargs := e.getAppNumArgs
|
||||
return (.proj s i nargs, #[a] ++ e.getAppRevArgs)
|
||||
| .forallE _ d b _ =>
|
||||
-- See comment at elimLooseBVarsByBeta
|
||||
let b ← if b.hasLooseBVars then elimLooseBVarsByBeta b else pure b
|
||||
if b.hasLooseBVars then
|
||||
return (.other, #[])
|
||||
else
|
||||
return (.arrow, #[d, b])
|
||||
| .bvar _ | .letE _ _ _ _ _ | .lam _ _ _ _ | .mdata _ _ | .app _ _ | .sort _ =>
|
||||
return (.other, #[])
|
||||
|
||||
/-
|
||||
Given an expression we are looking for patterns that match, return the key and sub-expressions.
|
||||
-/
|
||||
private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) :
|
||||
MetaM (Key × Array Expr) :=
|
||||
getKeyArgs e (isMatch := true) (root := root) (config := config)
|
||||
|
||||
end MatchClone
|
||||
|
||||
export MatchClone (Key Key.const)
|
||||
|
||||
/--
|
||||
An unprocessed entry in the lazy discrimination tree.
|
||||
-/
|
||||
private abbrev LazyEntry α := Array Expr × ((LocalContext × LocalInstances) × α)
|
||||
|
||||
/--
|
||||
Index identifying trie in a discrimination tree.
|
||||
-/
|
||||
@[reducible]
|
||||
private def TrieIndex := Nat
|
||||
|
||||
/--
|
||||
Discrimination tree trie. See `LazyDiscrTree`.
|
||||
-/
|
||||
private structure Trie (α : Type) where
|
||||
node ::
|
||||
/-- Values for matches ending at this trie. -/
|
||||
values : Array α
|
||||
/-- Index of trie matching star. -/
|
||||
star : TrieIndex
|
||||
/-- Following matches based on key of trie. -/
|
||||
children : HashMap Key TrieIndex
|
||||
/-- Lazy entries at this trie that are not processed. -/
|
||||
pending : Array (LazyEntry α)
|
||||
deriving Inhabited
|
||||
|
||||
instance : EmptyCollection (Trie α) := ⟨.node #[] 0 {} #[]⟩
|
||||
|
||||
/-- Push lazy entry to trie. -/
|
||||
private def Trie.pushPending : Trie α → LazyEntry α → Trie α
|
||||
| .node vs star cs p, e => .node vs star cs (p.push e)
|
||||
|
||||
end LazyDiscrTree
|
||||
|
||||
/--
|
||||
`LazyDiscrTree` is a variant of the discriminator tree datatype
|
||||
`DiscrTree` in Lean core that is designed to be efficiently
|
||||
initializable with a large number of patterns. This is useful
|
||||
in contexts such as searching an entire Lean environment for
|
||||
expressions that match a pattern.
|
||||
|
||||
Lazy discriminator trees achieve good performance by minimizing
|
||||
the amount of work that is done up front to build the discriminator
|
||||
tree. When first adding patterns to the tree, only the root
|
||||
discriminator key is computed and processing the remaining
|
||||
terms is deferred until demanded by a match.
|
||||
-/
|
||||
structure LazyDiscrTree (α : Type) where
|
||||
/-- Configuration for normalization. -/
|
||||
config : Lean.Meta.WhnfCoreConfig := {}
|
||||
/-- Backing array of trie entries. Should be owned by this trie. -/
|
||||
tries : Array (LazyDiscrTree.Trie α) := #[default]
|
||||
/-- Map from discriminator trie roots to the index. -/
|
||||
roots : Lean.HashMap LazyDiscrTree.Key LazyDiscrTree.TrieIndex := {}
|
||||
|
||||
namespace LazyDiscrTree
|
||||
|
||||
open Lean Elab Meta
|
||||
|
||||
instance : Inhabited (LazyDiscrTree α) where
|
||||
default := {}
|
||||
|
||||
open Lean.Meta.DiscrTree (mkNoindexAnnotation hasNoindexAnnotation reduceDT)
|
||||
|
||||
/--
|
||||
Specialization of Lean.Meta.DiscrTree.pushArgs
|
||||
-/
|
||||
private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) :
|
||||
MetaM (Key × Array Expr) := do
|
||||
if hasNoindexAnnotation e then
|
||||
return (.star, todo)
|
||||
else
|
||||
let e ← reduceDT e root config
|
||||
let fn := e.getAppFn
|
||||
let push (k : Key) (nargs : Nat) (todo : Array Expr) : MetaM (Key × Array Expr) := do
|
||||
let info ← getFunInfoNArgs fn nargs
|
||||
let todo ← MatchClone.pushArgsAux info.paramInfo (nargs-1) e todo
|
||||
return (k, todo)
|
||||
match fn with
|
||||
| .lit v =>
|
||||
return (.lit v, todo)
|
||||
| .const c _ =>
|
||||
unless root do
|
||||
if let some v := MatchClone.toNatLit? e then
|
||||
return (.lit v, todo)
|
||||
if (← MatchClone.shouldAddAsStar c e) then
|
||||
return (.star, todo)
|
||||
let nargs := e.getAppNumArgs
|
||||
push (.const c nargs) nargs todo
|
||||
| .proj s i a =>
|
||||
/-
|
||||
If `s` is a class, then `a` is an instance. Thus, we annotate `a` with `no_index` since we do
|
||||
not index instances. This should only happen if users mark a class projection function as
|
||||
`[reducible]`.
|
||||
|
||||
TODO: add better support for projections that are functions
|
||||
-/
|
||||
let a := if isClass (← getEnv) s then mkNoindexAnnotation a else a
|
||||
let nargs := e.getAppNumArgs
|
||||
push (.proj s i nargs) nargs (todo.push a)
|
||||
| .fvar _fvarId =>
|
||||
return (.star, todo)
|
||||
| .mvar mvarId =>
|
||||
if mvarId == MatchClone.tmpMVarId then
|
||||
-- We use `tmp to mark implicit arguments and proofs
|
||||
return (.star, todo)
|
||||
else
|
||||
failure
|
||||
| .forallE _ d b _ =>
|
||||
-- See comment at elimLooseBVarsByBeta
|
||||
let b ← if b.hasLooseBVars then MatchClone.elimLooseBVarsByBeta b else pure b
|
||||
if b.hasLooseBVars then
|
||||
return (.other, todo)
|
||||
else
|
||||
return (.arrow, (todo.push d).push b)
|
||||
| _ =>
|
||||
return (.other, todo)
|
||||
|
||||
/-- Initial capacity for key and todo vector. -/
|
||||
private def initCapacity := 8
|
||||
|
||||
/--
|
||||
Get the root key and rest of terms of an expression using the specified config.
|
||||
-/
|
||||
private def rootKey (cfg: WhnfCoreConfig) (e : Expr) : MetaM (Key × Array Expr) :=
|
||||
pushArgs true (Array.mkEmpty initCapacity) e cfg
|
||||
|
||||
private partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key)
|
||||
(config : WhnfCoreConfig) : MetaM (Array Key) := do
|
||||
if todo.isEmpty then
|
||||
return keys
|
||||
else
|
||||
let e := todo.back
|
||||
let todo := todo.pop
|
||||
let (k, todo) ← pushArgs root todo e config
|
||||
mkPathAux false todo (keys.push k) config
|
||||
|
||||
/--
|
||||
Create a path from an expression.
|
||||
|
||||
This differs from Lean.Meta.DiscrTree.mkPath in that the expression
|
||||
should uses free variables rather than meta-variables for holes.
|
||||
-/
|
||||
private def mkPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do
|
||||
let todo : Array Expr := .mkEmpty initCapacity
|
||||
let keys : Array Key := .mkEmpty initCapacity
|
||||
mkPathAux (root := true) (todo.push e) keys config
|
||||
|
||||
/- Monad for finding matches while resolving deferred patterns. -/
|
||||
@[reducible]
|
||||
private def MatchM α := ReaderT WhnfCoreConfig (StateRefT (Array (Trie α)) MetaM)
|
||||
|
||||
private def runMatch (d : LazyDiscrTree α) (m : MatchM α β) : MetaM (β × LazyDiscrTree α) := do
|
||||
let { config := c, tries := a, roots := r } := d
|
||||
let (result, a) ← withReducible $ (m.run c).run a
|
||||
pure (result, { config := c, tries := a, roots := r})
|
||||
|
||||
private def setTrie (i : TrieIndex) (v : Trie α) : MatchM α Unit :=
|
||||
modify (·.set! i v)
|
||||
|
||||
/-- Create a new trie with the given lazy entry. -/
|
||||
private def newTrie [Monad m] [MonadState (Array (Trie α)) m] (e : LazyEntry α) : m TrieIndex := do
|
||||
modifyGet fun a => let sz := a.size; (sz, a.push (.node #[] 0 {} #[e]))
|
||||
|
||||
/-- Add a lazy entry to an existing trie. -/
|
||||
private def addLazyEntryToTrie (i:TrieIndex) (e : LazyEntry α) : MatchM α Unit :=
|
||||
modify (·.modify i (·.pushPending e))
|
||||
|
||||
/--
|
||||
This evaluates all lazy entries in a trie and updates `values`, `starIdx`, and `children`
|
||||
accordingly.
|
||||
-/
|
||||
private partial def evalLazyEntries (config : WhnfCoreConfig)
|
||||
(values : Array α) (starIdx : TrieIndex) (children : HashMap Key TrieIndex)
|
||||
(entries : Array (LazyEntry α)) :
|
||||
MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do
|
||||
let rec iter values starIdx children (i : Nat) : MatchM α _ := do
|
||||
if p : i < entries.size then
|
||||
let (todo, lctx, v) := entries[i]
|
||||
if todo.isEmpty then
|
||||
let values := values.push v
|
||||
iter values starIdx children (i+1)
|
||||
else
|
||||
let e := todo.back
|
||||
let todo := todo.pop
|
||||
let (k, todo) ← withLCtx lctx.1 lctx.2 $ pushArgs false todo e config
|
||||
if k == .star then
|
||||
if starIdx = 0 then
|
||||
let starIdx ← newTrie (todo, lctx, v)
|
||||
iter values starIdx children (i+1)
|
||||
else
|
||||
addLazyEntryToTrie starIdx (todo, lctx, v)
|
||||
iter values starIdx children (i+1)
|
||||
else
|
||||
match children.find? k with
|
||||
| none =>
|
||||
let children := children.insert k (← newTrie (todo, lctx, v))
|
||||
iter values starIdx children (i+1)
|
||||
| some idx =>
|
||||
addLazyEntryToTrie idx (todo, lctx, v)
|
||||
iter values starIdx children (i+1)
|
||||
else
|
||||
pure (values, starIdx, children)
|
||||
iter values starIdx children 0
|
||||
|
||||
private def evalNode (c : TrieIndex) :
|
||||
MatchM α (Array α × TrieIndex × HashMap Key TrieIndex) := do
|
||||
let .node vs star cs pending := (←get).get! c
|
||||
if pending.size = 0 then
|
||||
pure (vs, star, cs)
|
||||
else
|
||||
let config ← read
|
||||
setTrie c default
|
||||
let (vs, star, cs) ← evalLazyEntries config vs star cs pending
|
||||
setTrie c <| .node vs star cs #[]
|
||||
pure (vs, star, cs)
|
||||
|
||||
/--
|
||||
Return the information about the trie at the given idnex.
|
||||
|
||||
Used for internal debugging purposes.
|
||||
-/
|
||||
private def getTrie (d : LazyDiscrTree α) (idx : TrieIndex) :
|
||||
MetaM ((Array α × TrieIndex × HashMap Key TrieIndex) × LazyDiscrTree α) :=
|
||||
runMatch d (evalNode idx)
|
||||
|
||||
/--
|
||||
A match result contains the terms formed from matching a term against
|
||||
patterns in the discrimination tree.
|
||||
|
||||
-/
|
||||
private structure MatchResult (α : Type) where
|
||||
/--
|
||||
The elements in the match result.
|
||||
|
||||
The top-level array represents an array from `score` values to the
|
||||
results with that score. A `score` is the number of non-star matches
|
||||
in a pattern against the term, and thus bounded by the size of the
|
||||
term being matched against. The elements of this array are themselves
|
||||
arrays of non-empty arrays so that we can defer concatenating results until
|
||||
needed.
|
||||
-/
|
||||
elts : Array (Array (Array α)) := #[]
|
||||
|
||||
private def MatchResult.push (r : MatchResult α) (score : Nat) (e : Array α) : MatchResult α :=
|
||||
if e.isEmpty then
|
||||
r
|
||||
else if score < r.elts.size then
|
||||
{ elts := r.elts.modify score (·.push e) }
|
||||
else
|
||||
let rec loop (a : Array (Array (Array α))) :=
|
||||
if a.size < score then
|
||||
loop (a.push #[])
|
||||
else
|
||||
{ elts := a.push #[e] }
|
||||
termination_by score - a.size
|
||||
loop r.elts
|
||||
|
||||
private partial def MatchResult.toArray (mr : MatchResult α) : Array α :=
|
||||
loop (Array.mkEmpty n) mr.elts
|
||||
where n := mr.elts.foldl (fun i a => a.foldl (fun n a => n + a.size) i) 0
|
||||
loop (r : Array α) (a : Array (Array (Array α))) :=
|
||||
if a.isEmpty then
|
||||
r
|
||||
else
|
||||
loop (a.back.foldl (init := r) (fun r a => r ++ a)) a.pop
|
||||
|
||||
private partial def getMatchLoop (todo : Array Expr) (score : Nat) (c : TrieIndex)
|
||||
(result : MatchResult α) : MatchM α (MatchResult α) := do
|
||||
let (vs, star, cs) ← evalNode c
|
||||
if todo.isEmpty then
|
||||
return result.push score vs
|
||||
else if star == 0 && cs.isEmpty then
|
||||
return result
|
||||
else
|
||||
let e := todo.back
|
||||
let todo := todo.pop
|
||||
/- We must always visit `Key.star` edges since they are wildcards.
|
||||
Thus, `todo` is not used linearly when there is `Key.star` edge
|
||||
and there is an edge for `k` and `k != Key.star`. -/
|
||||
let visitStar (result : MatchResult α) : MatchM α (MatchResult α) :=
|
||||
if star != 0 then
|
||||
getMatchLoop todo score star result
|
||||
else
|
||||
return result
|
||||
let visitNonStar (k : Key) (args : Array Expr) (result : MatchResult α) :=
|
||||
match cs.find? k with
|
||||
| none => return result
|
||||
| some c => getMatchLoop (todo ++ args) (score + 1) c result
|
||||
let result ← visitStar result
|
||||
let (k, args) ← MatchClone.getMatchKeyArgs e (root := false) (←read)
|
||||
match k with
|
||||
| .star => return result
|
||||
/-
|
||||
Note: dep-arrow vs arrow
|
||||
Recall that dependent arrows are `(Key.other, #[])`, and non-dependent arrows are
|
||||
`(Key.arrow, #[a, b])`.
|
||||
A non-dependent arrow may be an instance of a dependent arrow (stored at `DiscrTree`).
|
||||
Thus, we also visit the `Key.other` child.
|
||||
-/
|
||||
| .arrow => visitNonStar .other #[] (← visitNonStar k args result)
|
||||
| _ => visitNonStar k args result
|
||||
|
||||
private def getStarResult (root : Lean.HashMap Key TrieIndex) : MatchM α (MatchResult α) :=
|
||||
match root.find? .star with
|
||||
| none =>
|
||||
pure <| {}
|
||||
| some idx => do
|
||||
let (vs, _) ← evalNode idx
|
||||
pure <| ({} : MatchResult α).push 0 vs
|
||||
|
||||
private def getMatchRoot (r : Lean.HashMap Key TrieIndex) (k : Key) (args : Array Expr)
|
||||
(result : MatchResult α) : MatchM α (MatchResult α) :=
|
||||
match r.find? k with
|
||||
| none => pure result
|
||||
| some c => getMatchLoop args 1 c result
|
||||
|
||||
/--
|
||||
Find values that match `e` in `root`.
|
||||
-/
|
||||
private def getMatchCore (root : Lean.HashMap Key TrieIndex) (e : Expr) :
|
||||
MatchM α (MatchResult α) := do
|
||||
let result ← getStarResult root
|
||||
let (k, args) ← MatchClone.getMatchKeyArgs e (root := true) (←read)
|
||||
match k with
|
||||
| .star => return result
|
||||
/- See note about "dep-arrow vs arrow" at `getMatchLoop` -/
|
||||
| .arrow =>
|
||||
getMatchRoot root k args (←getMatchRoot root .other #[] result)
|
||||
| _ =>
|
||||
getMatchRoot root k args result
|
||||
|
||||
/--
|
||||
Find values that match `e` in `d`.
|
||||
|
||||
The results are ordered so that the longest matches in terms of number of
|
||||
non-star keys are first with ties going to earlier operators first.
|
||||
-/
|
||||
def getMatch (d : LazyDiscrTree α) (e : Expr) : MetaM (Array α × LazyDiscrTree α) :=
|
||||
withReducible <| runMatch d <| (·.toArray) <$> getMatchCore d.roots e
|
||||
|
||||
/--
|
||||
Structure for quickly initializing a lazy discrimination tree with a large number
|
||||
of elements using concurrent functions for generating entries.
|
||||
-/
|
||||
private structure PreDiscrTree (α : Type) where
|
||||
/-- Maps keys to index in tries array. -/
|
||||
roots : HashMap Key Nat := {}
|
||||
/-- Lazy entries for root of trie. -/
|
||||
tries : Array (Array (LazyEntry α)) := #[]
|
||||
deriving Inhabited
|
||||
|
||||
namespace PreDiscrTree
|
||||
|
||||
private def modifyAt (d : PreDiscrTree α) (k : Key)
|
||||
(f : Array (LazyEntry α) → Array (LazyEntry α)) : PreDiscrTree α :=
|
||||
let { roots, tries } := d
|
||||
match roots.find? k with
|
||||
| .none =>
|
||||
let roots := roots.insert k tries.size
|
||||
{ roots, tries := tries.push (f #[]) }
|
||||
| .some i =>
|
||||
{ roots, tries := tries.modify i f }
|
||||
|
||||
/-- Add an entry to the pre-discrimination tree.-/
|
||||
private def push (d : PreDiscrTree α) (k : Key) (e : LazyEntry α) : PreDiscrTree α :=
|
||||
d.modifyAt k (·.push e)
|
||||
|
||||
/-- Convert a pre-discrimination tree to a lazy discrimination tree. -/
|
||||
private def toLazy (d : PreDiscrTree α) (config : WhnfCoreConfig := {}) : LazyDiscrTree α :=
|
||||
let { roots, tries } := d
|
||||
{ config, roots, tries := tries.map (.node {} 0 {}) }
|
||||
|
||||
/-- Merge two discrimination trees. -/
|
||||
protected def append (x y : PreDiscrTree α) : PreDiscrTree α :=
|
||||
let (x, y, f) :=
|
||||
if x.roots.size ≥ y.roots.size then
|
||||
(x, y, fun y x => x ++ y)
|
||||
else
|
||||
(y, x, fun x y => x ++ y)
|
||||
let { roots := yk, tries := ya } := y
|
||||
yk.fold (init := x) fun d k yi => d.modifyAt k (f ya[yi]!)
|
||||
|
||||
instance : Append (PreDiscrTree α) where
|
||||
append := PreDiscrTree.append
|
||||
|
||||
end PreDiscrTree
|
||||
|
||||
/-- Initial entry in lazy discrimination tree -/
|
||||
@[reducible]
|
||||
structure InitEntry (α : Type) where
|
||||
/-- Return root key for an entry. -/
|
||||
key : Key
|
||||
/-- Returns rest of entry for later insertion. -/
|
||||
entry : LazyEntry α
|
||||
|
||||
namespace InitEntry
|
||||
|
||||
/--
|
||||
Constructs an initial entry from an expression and value.
|
||||
-/
|
||||
def fromExpr (expr : Expr) (value : α) (config : WhnfCoreConfig := {}) : MetaM (InitEntry α) := do
|
||||
let lctx ← getLCtx
|
||||
let linst ← getLocalInstances
|
||||
let lctx := (lctx, linst)
|
||||
let (key, todo) ← LazyDiscrTree.rootKey config expr
|
||||
pure <| { key, entry := (todo, lctx, value) }
|
||||
|
||||
/--
|
||||
Creates an entry for a subterm of an initial entry.
|
||||
|
||||
This is slightly more efficient than using `fromExpr` on subterms since it avoids a redundant call
|
||||
to `whnf`.
|
||||
-/
|
||||
def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) (config : WhnfCoreConfig := {}) :
|
||||
MetaM (InitEntry α) := do
|
||||
let (todo, lctx, _) := e.entry
|
||||
let (key, todo) ← LazyDiscrTree.rootKey config todo[idx]!
|
||||
pure <| { key, entry := (todo, lctx, value) }
|
||||
|
||||
end InitEntry
|
||||
|
||||
/-- Information about a failed import. -/
|
||||
private structure ImportFailure where
|
||||
/-- Module with constant that import failed on. -/
|
||||
module : Name
|
||||
/-- Constant that import failed on. -/
|
||||
const : Name
|
||||
/-- Exception that triggers error. -/
|
||||
exception : Exception
|
||||
|
||||
#print Lean.Meta.Cache
|
||||
/-- Information generation from imported modules. -/
|
||||
private structure ImportData where
|
||||
errors : IO.Ref (Array ImportFailure)
|
||||
|
||||
private def ImportData.new : BaseIO ImportData := do
|
||||
let errors ← IO.mkRef #[]
|
||||
pure { errors }
|
||||
|
||||
private def addConstImportData
|
||||
(env : Environment)
|
||||
(modName : Name)
|
||||
(d : ImportData)
|
||||
(tree : PreDiscrTree α)
|
||||
(act : Name → ConstantInfo → MetaM (Array (InitEntry α)))
|
||||
(name : Name) (constInfo : ConstantInfo) : BaseIO (PreDiscrTree α) := do
|
||||
if constInfo.isUnsafe then return tree
|
||||
if !allowCompletion env name then return tree
|
||||
let mstate : Meta.State := { cache := {} }
|
||||
let ctx : Meta.Context := { config := { transparency := .reducible } }
|
||||
let cm := (act name constInfo).run ctx mstate
|
||||
let cctx : Core.Context := {
|
||||
fileName := default,
|
||||
fileMap := default
|
||||
}
|
||||
let cstate : Core.State := {env}
|
||||
match ←(cm.run cctx cstate).toBaseIO with
|
||||
| .ok ((a, _), _) =>
|
||||
pure <| a.foldl (fun t e => t.push e.key e.entry) tree
|
||||
| .error e =>
|
||||
let i : ImportFailure := {
|
||||
module := modName,
|
||||
const := name,
|
||||
exception := e
|
||||
}
|
||||
d.errors.modify (·.push i)
|
||||
pure tree
|
||||
|
||||
/--
|
||||
Contains the pre discrimination tree and any errors occuring during initialization of
|
||||
the library search tree.
|
||||
-/
|
||||
private structure InitResults (α : Type) where
|
||||
tree : PreDiscrTree α := {}
|
||||
errors : Array ImportFailure := #[]
|
||||
|
||||
instance : Inhabited (InitResults α) where
|
||||
default := {}
|
||||
|
||||
namespace InitResults
|
||||
|
||||
/-- Combine two initial results. -/
|
||||
protected def append (x y : InitResults α) : InitResults α :=
|
||||
let { tree := xv, errors := xe } := x
|
||||
let { tree := yv, errors := ye } := y
|
||||
{ tree := xv ++ yv, errors := xe ++ ye }
|
||||
|
||||
instance : Append (InitResults α) where
|
||||
append := InitResults.append
|
||||
|
||||
end InitResults
|
||||
|
||||
private def toFlat (d : ImportData) (tree : PreDiscrTree α) :
|
||||
BaseIO (InitResults α) := do
|
||||
let de ← d.errors.swap #[]
|
||||
pure ⟨tree, de⟩
|
||||
|
||||
private partial def loadImportedModule (env : Environment)
|
||||
(act : Name → ConstantInfo → MetaM (Array (InitEntry α)))
|
||||
(d : ImportData)
|
||||
(tree : PreDiscrTree α)
|
||||
(mname : Name)
|
||||
(mdata : ModuleData)
|
||||
(i : Nat := 0) : BaseIO (PreDiscrTree α) := do
|
||||
if h : i < mdata.constNames.size then
|
||||
let name := mdata.constNames[i]
|
||||
let constInfo := mdata.constants[i]!
|
||||
let tree ← addConstImportData env mname d tree act name constInfo
|
||||
loadImportedModule env act d tree mname mdata (i+1)
|
||||
else
|
||||
pure tree
|
||||
|
||||
private def createImportedEnvironmentSeq (env : Environment)
|
||||
(act : Name → ConstantInfo → MetaM (Array (InitEntry α)))
|
||||
(start stop : Nat) : BaseIO (InitResults α) :=
|
||||
do go (← ImportData.new) {} start stop
|
||||
where go d (tree : PreDiscrTree α) (start stop : Nat) : BaseIO _ := do
|
||||
if start < stop then
|
||||
let mname := env.header.moduleNames[start]!
|
||||
let mdata := env.header.moduleData[start]!
|
||||
let tree ← loadImportedModule env act d tree mname mdata
|
||||
go d tree (start+1) stop
|
||||
else
|
||||
toFlat d tree
|
||||
termination_by stop - start
|
||||
|
||||
/-- Get the results of each task and merge using combining function -/
|
||||
private def combineGet [Append α] (z : α) (tasks : Array (Task α)) : α :=
|
||||
tasks.foldl (fun x t => x ++ t.get) (init := z)
|
||||
|
||||
/-- Create an imported environment for tree. -/
|
||||
def createImportedEnvironment (env : Environment)
|
||||
(act : Name → ConstantInfo → MetaM (Array (InitEntry α)))
|
||||
(constantsPerTask : Nat := 1000) :
|
||||
EIO Exception (LazyDiscrTree α) := do
|
||||
let n := env.header.moduleData.size
|
||||
let rec
|
||||
/-- Allocate constants to tasks according to `constantsPerTask`. -/
|
||||
go tasks start cnt idx := do
|
||||
if h : idx < env.header.moduleData.size then
|
||||
let mdata := env.header.moduleData[idx]
|
||||
let cnt := cnt + mdata.constants.size
|
||||
if cnt > constantsPerTask then
|
||||
let t ← createImportedEnvironmentSeq env act start (idx+1) |>.asTask
|
||||
go (tasks.push t) (idx+1) 0 (idx+1)
|
||||
else
|
||||
go tasks start cnt (idx+1)
|
||||
else
|
||||
if start < n then
|
||||
tasks.push <$> (createImportedEnvironmentSeq env act start n).asTask
|
||||
else
|
||||
pure tasks
|
||||
termination_by env.header.moduleData.size - idx
|
||||
let tasks ← go #[] 0 0 0
|
||||
let r := combineGet default tasks
|
||||
if p : r.errors.size > 0 then
|
||||
throw r.errors[0].exception
|
||||
pure <| r.tree.toLazy
|
||||
@@ -1,148 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Lean.Meta.Basic
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
/-!
|
||||
Helper functions for recognizing builtin literal values.
|
||||
This module focus on recognizing the standard representation used in Lean for these literals.
|
||||
It also provides support for the following exceptional cases.
|
||||
- Raw natural numbers (i.e., natural numbers which are not encoded using `OfNat.ofNat`).
|
||||
- Bit-vectors encoded using `OfNat.ofNat` and `BitVec.ofNat`.
|
||||
- Negative integers encoded using raw natural numbers.
|
||||
- Characters encoded `Char.ofNat n` where `n` can be a raw natural number or an `OfNat.ofNat`.
|
||||
- Nested `Expr.mdata`.
|
||||
-/
|
||||
|
||||
/-- Returns `some n` if `e` is a raw natural number, i.e., it is of the form `.lit (.natVal n)`. -/
|
||||
def getRawNatValue? (e : Expr) : Option Nat :=
|
||||
match e.consumeMData with
|
||||
| .lit (.natVal n) => some n
|
||||
| _ => none
|
||||
|
||||
/-- Return `some (n, type)` if `e` is an `OfNat.ofNat`-application encoding `n` for a type with name `typeDeclName`. -/
|
||||
def getOfNatValue? (e : Expr) (typeDeclName : Name) : MetaM (Option (Nat × Expr)) := OptionT.run do
|
||||
let_expr OfNat.ofNat type n _ ← e | failure
|
||||
let type ← whnfD type
|
||||
guard <| type.getAppFn.isConstOf typeDeclName
|
||||
let .lit (.natVal n) := n.consumeMData | failure
|
||||
return (n, type)
|
||||
|
||||
/-- Return `some n` if `e` is a raw natural number or an `OfNat.ofNat`-application encoding `n`. -/
|
||||
def getNatValue? (e : Expr) : MetaM (Option Nat) := do
|
||||
let e := e.consumeMData
|
||||
if let some n := getRawNatValue? e then
|
||||
return some n
|
||||
let some (n, _) ← getOfNatValue? e ``Nat | return none
|
||||
return some n
|
||||
|
||||
/-- Return `some i` if `e` `OfNat.ofNat`-application encoding an integer, or `Neg.neg`-application of one. -/
|
||||
def getIntValue? (e : Expr) : MetaM (Option Int) := do
|
||||
if let some (n, _) ← getOfNatValue? e ``Int then
|
||||
return some n
|
||||
let_expr Neg.neg _ _ a ← e | return none
|
||||
let some (n, _) ← getOfNatValue? a ``Int | return none
|
||||
return some (-↑n)
|
||||
|
||||
/-- Return `some c` if `e` is a `Char.ofNat`-application encoding character `c`. -/
|
||||
def getCharValue? (e : Expr) : MetaM (Option Char) := do
|
||||
let_expr Char.ofNat n ← e | return none
|
||||
let some n ← getNatValue? n | return none
|
||||
return some (Char.ofNat n)
|
||||
|
||||
/-- Return `some s` if `e` is of the form `.lit (.strVal s)`. -/
|
||||
def getStringValue? (e : Expr) : (Option String) :=
|
||||
match e with
|
||||
| .lit (.strVal s) => some s
|
||||
| _ => none
|
||||
|
||||
/-- Return `some ⟨n, v⟩` if `e` is af `OfNat.ofNat` application encoding a `Fin n` with value `v` -/
|
||||
def getFinValue? (e : Expr) : MetaM (Option ((n : Nat) × Fin n)) := OptionT.run do
|
||||
let (v, type) ← getOfNatValue? e ``Fin
|
||||
let n ← getNatValue? (← whnfD type.appArg!)
|
||||
match n with
|
||||
| 0 => failure
|
||||
| m+1 => return ⟨m+1, Fin.ofNat v⟩
|
||||
|
||||
/-- Return `some ⟨n, v⟩` if `e` is af `OfNat.ofNat` application encoding a `BitVec n` with value `v` -/
|
||||
def getBitVecValue? (e : Expr) : MetaM (Option ((n : Nat) × BitVec n)) := OptionT.run do
|
||||
if e.isAppOfArity' ``BitVec.ofNat 2 then
|
||||
let n ← getNatValue? (e.getArg!' 0)
|
||||
let v ← getNatValue? (e.getArg!' 1)
|
||||
return ⟨n, BitVec.ofNat n v⟩
|
||||
let (v, type) ← getOfNatValue? e ``BitVec
|
||||
let n ← getNatValue? (← whnfD type.appArg!)
|
||||
return ⟨n, BitVec.ofNat n v⟩
|
||||
|
||||
/-- Return `some n` if `e` is an `OfNat.ofNat`-application encoding the `UInt8` with value `n`. -/
|
||||
def getUInt8Value? (e : Expr) : MetaM (Option UInt8) := OptionT.run do
|
||||
let (n, _) ← getOfNatValue? e ``UInt8
|
||||
return UInt8.ofNat n
|
||||
|
||||
/-- Return `some n` if `e` is an `OfNat.ofNat`-application encoding the `UInt16` with value `n`. -/
|
||||
def getUInt16Value? (e : Expr) : MetaM (Option UInt16) := OptionT.run do
|
||||
let (n, _) ← getOfNatValue? e ``UInt16
|
||||
return UInt16.ofNat n
|
||||
|
||||
/-- Return `some n` if `e` is an `OfNat.ofNat`-application encoding the `UInt32` with value `n`. -/
|
||||
def getUInt32Value? (e : Expr) : MetaM (Option UInt32) := OptionT.run do
|
||||
let (n, _) ← getOfNatValue? e ``UInt32
|
||||
return UInt32.ofNat n
|
||||
|
||||
/-- Return `some n` if `e` is an `OfNat.ofNat`-application encoding the `UInt64` with value `n`. -/
|
||||
def getUInt64Value? (e : Expr) : MetaM (Option UInt64) := OptionT.run do
|
||||
let (n, _) ← getOfNatValue? e ``UInt64
|
||||
return UInt64.ofNat n
|
||||
|
||||
/--
|
||||
If `e` is a literal value, ensure it is encoded using the standard representation.
|
||||
Otherwise, just return `e`.
|
||||
-/
|
||||
def normLitValue (e : Expr) : MetaM Expr := do
|
||||
let e ← instantiateMVars e
|
||||
if let some n ← getNatValue? e then return toExpr n
|
||||
if let some n ← getIntValue? e then return toExpr n
|
||||
if let some ⟨_, n⟩ ← getFinValue? e then return toExpr n
|
||||
if let some ⟨_, n⟩ ← getBitVecValue? e then return toExpr n
|
||||
if let some s := getStringValue? e then return toExpr s
|
||||
if let some c ← getCharValue? e then return toExpr c
|
||||
if let some n ← getUInt8Value? e then return toExpr n
|
||||
if let some n ← getUInt16Value? e then return toExpr n
|
||||
if let some n ← getUInt32Value? e then return toExpr n
|
||||
if let some n ← getUInt64Value? e then return toExpr n
|
||||
return e
|
||||
|
||||
/--
|
||||
If `e` is a `Nat`, `Int`, or `Fin` literal value, converts it into a constructor application.
|
||||
Otherwise, just return `e`.
|
||||
-/
|
||||
-- TODO: support other builtin literals if needed
|
||||
def litToCtor (e : Expr) : MetaM Expr := do
|
||||
let e ← instantiateMVars e
|
||||
if let some n ← getNatValue? e then
|
||||
if n = 0 then
|
||||
return mkConst ``Nat.zero
|
||||
else
|
||||
return .app (mkConst ``Nat.succ) (toExpr (n-1))
|
||||
if let some n ← getIntValue? e then
|
||||
if n < 0 then
|
||||
return .app (mkConst ``Int.negSucc) (toExpr (- (n+1)).toNat)
|
||||
else
|
||||
return .app (mkConst ``Int.ofNat) (toExpr n.toNat)
|
||||
if let some ⟨n, v⟩ ← getFinValue? e then
|
||||
let i := toExpr v.val
|
||||
let n := toExpr n
|
||||
-- Remark: we construct the proof manually here to avoid a cyclic dependency.
|
||||
let p := mkApp4 (mkConst ``LT.lt [0]) (mkConst ``Nat) (mkConst ``instLTNat) i n
|
||||
let h := mkApp3 (mkConst ``of_decide_eq_true) p
|
||||
(mkApp2 (mkConst ``Nat.decLt) i n)
|
||||
(mkApp2 (mkConst ``Eq.refl [1]) (mkConst ``Bool) (mkConst ``true))
|
||||
return mkApp3 (mkConst ``Fin.mk) n i h
|
||||
return e
|
||||
|
||||
end Lean.Meta
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user