Compare commits

..

62 Commits

Author SHA1 Message Date
Kim Morrison
7fcae3cd3e chore: import orphaned Lean.Replay 2024-10-14 12:12:01 +11:00
Tobias Grosser
7fd2aa04ae chore: move BitVec.udiv/umod/sdiv/smod after add/sub/mul/lt (#5623)
Divison proofs are more likely to depend on add/sub/mul proofs than the
other way around. This cleans up
https://github.com/leanprover/lean4/pull/5609, which added division
proofs that rely on negation to already be defined.
2024-10-13 20:11:31 +00:00
Luisa Cicolini
47e0430b07 feat: complete BitVec.[getMsbD|getLsbD|msb] for shifts (#5604)
Co-authored-by: Tobias Grosser <github@grosser.es>
2024-10-13 17:45:19 +00:00
Tobias Grosser
5d6553029c feat: expand relationship with BitVec and toFin (#5680) 2024-10-13 16:28:28 +00:00
James Oswald
1d8555fe0b fix: help message flags, removes -f flag and adds -g flag (#5685)
Closes #5682

- Removes the broken `-f` flag from the help message which doesn't
behave as expected as an alternative to `--features`.
- Adds the `-g` flag to the help message which is a working alternative
to the `--githash` flag.
2024-10-13 06:37:09 +00:00
Mac Malone
068208091f refactor: lake: restrict cache fetch to leanprover* (#5642)
Lake will now only automatically fetch Reservoir build caches for
package in the the `leanprover` and `leanprover-community`
organizations. We are not planning to expand the Reservoir build cache
to other packages until farther in the future.
2024-10-12 22:56:49 +00:00
Marc Huisinga
a3bc4d2359 fix: make IO-bound tasks dedicated (#5678)
This PR ensures that all I/O-bound tasks in the language server use
dedicated tasks.
2024-10-11 15:23:11 +00:00
Henrik Böving
087219bf5d feat: make bv_decide error when the LRAT proof is invalid (#5676) 2024-10-11 15:04:23 +00:00
Henrik Böving
e5bbda1c3d fix: context tracking in bv_decide counter example (#5675)
Closes #5674.
2024-10-11 08:57:06 +00:00
Kyle Miller
742ca6afa7 feat: support let rec in #eval (#5663)
Makes `#eval` use the `elabMutualDef` machinery to process all the `let
rec`s that might appear in the expression. This now works:
```lean
#eval
  let rec fact (n : Nat) : Nat :=
    match n with
    | 0 => 1
    | n' + 1 => n * fact n'
  fact 5
```

Closes #2374
2024-10-11 06:46:16 +00:00
Kyle Miller
fe0fbc6bf7 feat: decide! tactic for using kernel reduction (#5665)
The `decide!` tactic is like `decide`, but when it tries reducing the
`Decidable` instance it uses kernel reduction rather than the
elaborator's reduction.

The kernel ignores transparency, so it can unfold all definitions (for
better or for worse). Furthermore, by using kernel reduction we can
cache the result as an auxiliary lemma — this is more efficient than
`decide`, which needs to reduce the instance twice: once in the
elaborator to check whether the tactic succeeds, and once again in the
kernel during final typechecking.

While RFC #5629 proposes a `decide!` that skips checking altogether
during elaboration, with this PR's `decide!` we can use `decide!` as
more-or-less a drop-in replacement for `decide`, since the tactic will
fail if kernel reduction fails.

This PR also includes two small fixes:
- `blameDecideReductionFailure` now uses `withIncRecDepth`.
- `Lean.Meta.zetaReduce` now instantiates metavariables while zeta
reducing.

Some profiling:
```lean
set_option maxRecDepth 2000
set_option trace.profiler true
set_option trace.profiler.threshold 0

theorem thm1 : 0 < 1 := by decide!
theorem thm1' : 0 < 1 := by decide
theorem thm2 : ∀ x < 400, x * x ≤ 160000 := by decide!
theorem thm2' : ∀ x < 400, x * x ≤ 160000 := by decide
/-
[Elab.command] [0.003655] theorem thm1 : 0 < 1 := by decide!
[Elab.command] [0.003164] theorem thm1' : 0 < 1 := by decide
[Elab.command] [0.133223] theorem thm2 : ∀ x < 400, x * x ≤ 160000 := by decide!
[Elab.command] [0.252310] theorem thm2' : ∀ x < 400, x * x ≤ 160000 := by decide
-/
```

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-10-11 06:40:57 +00:00
Kyle Miller
8e88e8061a chore: deprecate := variants of inductive and structure (#5542)
Deprecates `inductive ... :=`, `structure ... :=`, and `class ... :=` in
favor of the `... where` variant. Currently this syntax produces a
warning, controlled by the `linter.deprecated` option.

Breaking change: modifies `Lean.Linter.logLintIf` to use
`Lean.Linter.getLinterValue` to determine if a linter value is set. This
means that the `linter.all` option now is taken into account when the
linter option is not set.

Part of #5236
2024-10-11 05:54:18 +00:00
Henrik Böving
96e996e16d feat: ~~~(-x) bv_decide (#5670)
Co-authored-by: Siddharth <siddu.druid@gmail.com>
2024-10-10 19:44:31 +00:00
Kyle Miller
4614b758e1 fix: make @[elab_as_elim] require at least one discriminant (#5671)
This is an oversight in `getElabElimExprInfo`. If there are no
discriminants, then there is no point in elaborating as an eliminator.
2024-10-10 17:20:35 +00:00
Marc Huisinga
3930100b67 feat: whitespace tactic completion & tactic completion docs (#5666)
This PR enables tactic completion in the whitespace of a tactic proof
and adds tactic docstrings to the completion menu.

Future work:
- A couple of broken tactic completions: This is due to tactic
completion now using @david-christiansen's `Tactic.Doc.allTacticDocs` to
obtain the tactic docstrings and should be fixed soon.
- Whitespace tactic completion in tactic combinators: This requires
changing the syntax of tactic combinators to produce a syntax node that
makes it clear that a tactic is expected at the given position.

Closes #1651.
2024-10-10 13:28:34 +00:00
Kyle Miller
d10d41bc07 fix: store local context for 'don't know how to synthesize implicit argument' errors (#5658)
When named arguments introduce eta arguments, the full application
contains fvars for these eta arguments, so `MVarErrorKind.implicitArg`
needs to keep a local context for its error messages. This is because
the local context of the mvar associated to the `MVarErrorKind` is not
sufficient, since when an eta argument come after an implicit argument,
the implicit argument's mvar doesn't contain the eta argument's fvar in
its local context.

Closes #5475
2024-10-09 08:40:21 +00:00
Kyle Miller
79930af11e feat: allow explicit mode with field notation (#5528)
Now one can write `@x.f`, `@(x).f`, `@x.1`, `@(x).1`, and so on.

This fixes an issue where structure instance update notation (like `{x
with a := a'}`) could fail if the field `a` had a type with implicit,
optional, or auto parameters.

Closes #5406
2024-10-09 07:03:46 +00:00
Eric Wieser
b814be6d6a fix: use MessageData.tagged to mark maxHeartbeat exceptions (#5566)
Fixes #5565, by using tags instead of trying to string match on a
`MessageData`. This ends up reverting some unwanted test output changes
from #4781 too.

This changes `isMaxRecDepth` for good measure too.

This was a regression in Lean 4.11.0, so may be worth backporting to
4.12.x, if not also 4.11.x.
2024-10-09 02:08:50 +00:00
Kyle Miller
feb8185a83 fix: upgrade instance synth order issues to hard errors (#5399)
Motivated [by a user's
question](https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Confusing.20instance.20error/near/471539940),
this increases the severity of the "cannot find synthesization order"
message from a log error to throwing an exception. This saves some
confusion about whether the instance was added or not.
2024-10-08 23:29:59 +00:00
Mac Malone
7942b9eaae fix: lake: make package extraDep intransitive (#5641)
A Lake build of target within a a package will no longer build a
package's dependencies package-level extra targets dependencies. At the
technical level, a package's `extraDep` facet no longer transitively
builds its dependencies' `extraDep` facet.

Closes #5633.
2024-10-08 23:20:05 +00:00
Kyle Miller
15bb8a26d5 fix: have simpa ... using ... do exact-like checks (#5648)
Closes #5634. Before assigning the simplified `using` clause expression
to the goal, this adds a check that the expression has no new
metavariables. It also adjusts how new hypotheses are added to the goal
to prevent spurious "don't know how to synthesize placeholder" errors on
that goal metavariable. We also throw in an occurs check immediately
after elaboration to avoid some counterintuitive behavior when
simplifying such a term closes the goal.

Closes #4101. This also improves the type mismatch error message,
showing the elaborated `using` clause rather than `h✝`:
```lean
example : False := by
  simpa using (fun x : True => x)
/-
error: type mismatch, term
  fun x => x
after simplification has type
  True : Prop
but is expected to have type
  False : Prop
-/
```
2024-10-08 23:09:00 +00:00
Kyle Miller
a35e6f4af7 feat: infer Prop for inductive/structure when defining syntactic subsingletons (#5517)
A `Prop`-valued inductive type is a syntactic subsingleton if it has at
most one constructor and all the arguments to the constructor are in
`Prop`. Such types have large elimination, so they could be defined in
`Type` or `Prop` without any trouble, though users tend to expect that
such types define a `Prop` and need to learn to insert `: Prop`.

Currently, the default universe for types is `Type`. This PR adds a
heuristic: if a type is a syntactic subsingleton with exactly one
constructor, and the constructor has at least one parameter, then the
`inductive` command will prefer creating a `Prop` instead of a `Type`.
For `structure`, we ask for at least one field.

More generally, for mutual inductives, each type needs to be a syntactic
subsingleton, at least one type must have one constructor, and at least
one constructor must have at least one parameter. The motivation for
this restriction is that every inductive type starts with a zero
constructors and each constructor starts with zero fields, and
stubbed-out types shouldn't be `Prop`.

Thanks to @arthur-adjedj for the investigation in #2695 and to @digama0
for formulating the heuristic.

Closes #2690
2024-10-08 22:39:38 +00:00
Kyle Miller
fdd5aec172 feat: better #eval command (#5627)
This refactors and improves the `#eval` command, introducing some new
features.
* Now evaluated results can be represented using `ToExpr` and pretty
printing. This means **hoverable output**. If `ToExpr` fails, it then
tries `Repr` and then `ToString`. The `eval.pp` option controls whether
or not to try `ToExpr`.
* There is now **auto-derivation** of `Repr` instances, enabled with the
`pp.derive.repr` option (default to **true**). For example:
  ```lean
  inductive Baz
    | a | b

  #eval Baz.a
  -- Baz.a
  ```
It simply does `deriving instance Repr for Baz` when there's no way to
represent `Baz`. If core Lean gets `ToExpr` derive handlers, they could
be used here as well.
* The option `eval.type` controls whether or not to include the type in
the output. For now the default is false.
* Now things like `#eval do return 2` work. It tries using
`CommandElabM`, `TermElabM`, or `IO` when the monad is unknown.
* Now there is no longer `Lean.Eval` or `Lean.MetaEval`. These each used
to be responsible for both adapting monads and printing results. The
concerns have been split into two. (1) The `MonadEval` class is
responsible for adapting monads for evaluation (it is similar to
`MonadLift`, but instances are allowed to use default data when
initializing state) and (2) finding a way to represent results is
handled separately.
* Error messages about failed instance synthesis are now more precise.
Once it detects that a `MonadEval` class applies, then the error message
will be specific about missing `ToExpr`/`Repr`/`ToString` instances.
* Fixes a bug where `Repr`/`ToString` instances can't be found by
unfolding types "under the monad". For example, this works now:
  ```lean
  def Foo := List Nat
  def Foo.mk (l : List Nat) : Foo := l
  #eval show Lean.CoreM Foo from do return Foo.mk [1,2,3]
  ```
* Elaboration errors now abort evaluation. This eliminates some
not-so-relevant error messages.
* Now evaluating a value of type `m Unit` never prints a blank message.
* Fixes bugs where evaluating `MetaM` and `CoreM` wouldn't collect log
messages.

The `run_cmd`, `run_elab`, and `run_meta` commands are now frontends for
`#eval`.
2024-10-08 20:51:46 +00:00
Henrik Böving
81743d80e5 chore: reduce error on bv_check to warning (#5655) 2024-10-08 19:49:44 +00:00
Henrik Böving
248864c716 perf: benchmark for modulo on bv_decide (#5653)
This verifies a bit hack from here:
https://en.wikipedia.org/wiki/Lehmer_random_number_generator#Sample_C99_code

I previously ran the SMTLIB equivalent this with Bitwuzla in my crypto
class and got the following numbers:
- 22s with Bitwuzla
- Z3 and CVC5 don't yet terminate after > 2min

Now with`bv_decide` the overall timing is 33.7s, consisting of:
- 5s of checking the LRAT cert
- 5s of trimming the LRAT cert from 800k to 300k proof steps
- remainder actual solving time

So running `bv_decide` like a normal SMT solver without verifying the
result of the SAT solver would yield approximately ~24s.
2024-10-08 18:58:15 +00:00
Kyle Miller
bd46319aee feat: add option pp.mvars.delayed (#5643)
Where before we had
```lean
#check fun x : Nat => ?a
-- fun x ↦ ?m.7 x : (x : Nat) → ?m.6 x
```
Now by default we have
```lean
#check fun x : Nat => ?a
-- fun x => ?a : (x : Nat) → ?m.6 x
```
In particular, delayed assignment metavariables such as `?m.7` pretty
print using the name of the metavariable they are delayed assigned to,
suppressing the bound variables used in the delayed assignment (hence
`?a` rather than `?a x`). Hovering over `?a` shows `?m.7 x`.

The benefit is that users can see the user-provided name in local
contexts. A justification for this pretty printing choice is that `?m.7
x` is supposed to stand for `?a`, and furthermore it is just as opaque
to assignment in defeq as `?a` is (however, when synthetic opaque
metavariables are made assignable, delayed assignments can be a little
less assignable than true synthetic opaque metavariables).

The original pretty printing behavior can be recovered using `set_option
pp.mvars.delayed true`.

This PR also extends the documentation for holes and synthetic holes,
with some technical details about what delayed assignments are. This
likely should be moved to the reference manual, but for now it is
included in this docstring.

(This PR is a simplified version of #3494, which has a round-trippable
notation for delayed assignments. The pretty printing in this PR is
unlikely to round trip, but it is better than the current situation,
which is that delayed assignment metavariables never round trip, and
plus it does not require introducing a new notation.)
2024-10-08 17:48:52 +00:00
Kyle Miller
6cdede33fb fix: make sure name literals use escaping when pretty printing (#5639)
The app unexpanders for `Name.mkStr1` through `Name.mkStr8` weren't
respecting the escaping rules for names. For example, ``#check `«a.b»``
would show `` `a.b``.

This PR folds the unexpanders into the name literal delaborator, where
escaping is already handled.
2024-10-08 17:36:49 +00:00
Kyle Miller
f1d3527fe8 fix: have Lean.Meta.ppGoal use hard newlines (#5640)
This function uses soft newlines in many places where hard newlines are
more appropriate. Pointed out by @gebner in #1967.
2024-10-08 17:36:08 +00:00
Kyle Miller
b2b450d7cb fix: now linters in general do not run on #guard_msgs itself (#5644)
The `#guard_msgs` command runs the command it is attached to as if it
were a top-level command. This is because the top-level command
elaborator runs linters, and we are interested in capturing linter
warnings using `#guard_msgs`. However, the linters will run on
`#guard_msgs` itself, leading sometimes to duplicate warnings (like for
the unused variable linter).

Rather than special-casing `#guard_msgs` in every affected linter, this
PR special-cases it in the top-level command elaborator itself. **Now
linters are only run if the command doesn't contain `#guard_msgs`.**
This way, the linters are only run on the sub-command that `#guard_msgs`
runs itself. This rule also keeps linters from running multiple times in
cases such as `set_option pp.mvars false in /-- ... -/ #guard_msgs in
...`.
2024-10-08 17:35:07 +00:00
Henrik Böving
abae95e170 feat: support umod in bv_decide (#5652) 2024-10-08 12:47:03 +00:00
Henrik Böving
e9ea99f6c6 feat: support udiv in bv_decide (#5628)
Co-authored-by: Siddharth <siddu.druid@gmail.com>
2024-10-08 10:40:00 +00:00
Siddharth
2ed7924bae chore: define udiv normal form to be /, resp. umod and % (#5645)
This follows the norm for all other Bitvector operations, and makes the
symbols `/` and `%` the simp normal form.

I'd imagine that @hargonix would prefer that this be merged after
https://github.com/leanprover/lean4/pull/5628, so as to prevent churn
for his PR. I'm happy to rebase the PR once the other PR lands.

---------

Co-authored-by: Henrik Böving <hargonix@gmail.com>
2024-10-08 08:49:46 +00:00
Siddharth
4415a81f35 chore: add Siddharth to authors list of BitVec (#5647)
Add @bollu to the authors list of the BitVec files :)
2024-10-08 08:01:17 +00:00
Joachim Breitner
3e75d8f742 fix: FunInd: avoid over-eta-expanding in preprocessing step (#5619)
fixes #5602
2024-10-07 19:47:43 +00:00
Henrik Böving
f1ff9cebf2 feat: more getLsbD bitblaster theory (#5637) 2024-10-07 17:26:23 +00:00
Henrik Böving
99a9d9b381 doc: remarks about multiplication (#5636) 2024-10-07 17:25:22 +00:00
Henrik Böving
1914a2b3f2 feat: add auxiliary bitblasters for negation and subtraction (#5635) 2024-10-07 16:33:06 +00:00
Siddharth
6312787c30 feat: lemmas for Bitvector division when denominator is zero (#5609)
These lemmas explain what happens when the denominator is zero with
`udiv`, `umod`, `sdiv`, `smod`. A follow-up PR will show what happens
with `smtUDiv` and `smtSMod`, since these need some more bitvector
theory.
These lemmas will be used by `bv_decide` for bitblasting.

The theorems `{sdiv, smod}_zero` are located after `neg` theory has been
built for the purpose of writing terse proofs.

---------

Co-authored-by: Tobias Grosser <github@grosser.es>
Co-authored-by: Tobias Grosser <tobias@grosser.es>
2024-10-07 15:58:12 +00:00
Marc Huisinga
ec5f206d80 fix: shutdown deadlock and crash desync (#5340)
This PR fixes three problems:
- When the language server is being stopped in a non-normal way without
going through the regular LSP shutdown protocol (e.g. by closing VS
Code), it could sometimes happen that both the watchdog and the file
worker were not properly terminated and lingered around forever,
resulting in zombie processes (#5296)
- When the file worker crashes and the user restarts it by making a
change to the document, the file worker would produce incorrect
diagnostics for the document until the file is restarted.
- (Minor) When the file worker would crash during initialization, the
error diagnostic would be reported on stderr instead of stdout

The deadlock-induced termination issue from #5296 should be resolved by
the following measures:
- The watchdog main task is always terminated with `IO.Process.exit` to
ensure that it terminates even if some other tasks in the process are
still running.
- The file worker communication task in the watchdog no longer waits for
the file worker process to terminate when writing to the client fails,
only when reading from the file worker fails.
- When the watchdog shuts down (either as a result of an orderly or a
non-normal shutdown), instead of waiting for the file worker
communication tasks to complete, it kills the file worker process. The
rationale behind this is that the file worker currently should have no
essential work to complete if the server is being stopped anyways, and
so waiting for the communication task is not necessary.

The file worker diagnostic desync after a crash was caused by us
tracking changes to the document of a crashed file worker twice: Once as
part of the document, and once as part of the queued messages to the
file worker. This meant that when the file worker was restarted, it
would receive the changes made to the document while the file worker was
crashed twice, leading to a desynced document state.

(Probably) fixes #5296.
2024-10-07 14:10:42 +00:00
Markus Himmel
d835616573 chore: fix MSYS2 build instructions (#5617) 2024-10-07 12:42:37 +00:00
Siddharth
9dac514c2f feat: Document Bitblasting in a documentation comment (#5620)
As requested by @kim-em at
https://github.com/leanprover/lean4/pull/5281#issuecomment-2376102963.
We provide a high-level overview of the workflow for adding new
bitblasting theorems, by using the `BitVec.mul` as a prototypical
example.
2024-10-07 11:44:04 +00:00
Tobias Grosser
c0617da18d feat: support at in ac_nf and use it in bv_normalize (#5618)
... while at it also call `trivial` to close goals that can be trivially
closed.

---------

Co-authored-by: Siddharth <siddu.druid@gmail.com>
Co-authored-by: Henrik Böving <hargonix@gmail.com>
2024-10-07 11:37:17 +00:00
Sebastian Ullrich
a3ee11103c chore: update stage0 2024-10-07 13:26:07 +02:00
Sebastian Ullrich
13e3a3839c fix: Lake: brittle dependency on env ext name 2024-10-07 13:26:07 +02:00
Lean stage0 autoupdater
0178f2b70d chore: update stage0 2024-10-04 15:25:08 +00:00
Lean stage0 autoupdater
4f5f39294d chore: update stage0 2024-10-04 13:55:42 +00:00
Joachim Breitner
d4fdb5d7c0 fix: getFunInfo, inferType to use withAtLeastTransparency, not withTransparency (#5563)
when the transparency mode is `.all`, then one expects `getFunInfo` and
`inferType` to also work with that transparency mode.

Fixes #5562
Fixes #2975 
Fixes #2194
2024-10-04 13:04:35 +00:00
Siddharth
f9048c132d chore: add bv_toNat tag for toNat_ofInt (#5608)
These were missing from the `bv_toNat` simp-set,
discovered when refactoring LNSym's simp-set:
https://github.com/leanprover/LNSym/pull/208
2024-10-03 19:20:50 +00:00
Henrik Böving
53c5470200 perf: remove List.redLength (#5605) 2024-10-03 14:57:33 +00:00
Sebastian Ullrich
3584a62411 fix: call hierarchy into (builtin_)initialize (#5560)
While `initialize` pretended it had the declaration name of the constant
to be initialized, missing declaration ranges for the latter led call
hierarchy etc. to ignore the definition
2024-10-03 12:03:44 +00:00
Kim Morrison
a4fda010f3 feat: Array/Option.unattach (#5586)
More support for automatically removing `.attach`, for `Array` and
`Option`.
2024-10-03 07:29:00 +00:00
Kim Morrison
b7d6a4b222 feat: adding Insert/Singleton/Union instances for HashMap/Set.Raw (#5590)
These were missing from https://github.com/leanprover/lean4/pull/5581.
2024-10-03 06:26:21 +00:00
Lean stage0 autoupdater
341c64a306 chore: update stage0 2024-10-03 06:56:06 +00:00
Mac Malone
a01166f045 refactor: reduce Reservoir build fetch attempts & warnings (#5600)
Lake no longer attempts to fetch the Reservoir build cache if the build
directory is already present. Plus, failure of the automatic fetch now
only produces a trace message, not a warning.
2024-10-03 01:12:53 +00:00
Kim Morrison
14f80172bc chore: typo in fix-pr-release.yml (#5601) 2024-10-02 23:04:39 +00:00
euprunin
8f88d94d97 chore: fix spelling mistakes (#5599)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-10-02 21:32:22 +00:00
Markus Himmel
09dfe1c71c chore: induction-friendly List.min?_cons (#5594)
@kim-em, I'm happy to keep any subset of `foldl_min`, `foldl_min_right`,
`foldl_min_le`, `foldl_min_min_of_le` (should that one have been called
`foldl_min_le_of_le`?). Which ones do you like?
2024-10-02 14:10:15 +00:00
Kim Morrison
1b115eea42 feat: HashSet.Raw.all/any (#5591)
These were missing from #5582.
2024-10-02 06:04:59 +00:00
Kim Morrison
8da278e141 feat: variant of MVarId.tryClearMany (#5588)
Used in Aesop.
2024-10-02 05:26:40 +00:00
Kim Morrison
6a59a3a373 feat: allow MVarId.assertHypotheses to set BinderInfo/Kind (#5587)
This generalization of `assertHypotheses` is currently provided in
Batteries and used in Aesop.
2024-10-02 05:09:49 +00:00
Kim Morrison
1329a264c8 feat: HashSet.all/any (#5582)
I think the overhead (runtime/later proving) of using `for` is paid off
by being able to short-circuit.

These functions are needed downstream to switch over the Std.HashSet.
2024-10-02 04:23:27 +00:00
Kim Morrison
478a34f174 feat: Singleton/Insert/Union instances for HashMap/Set (#5581) 2024-10-02 04:23:17 +00:00
692 changed files with 7321 additions and 1333 deletions

View File

@@ -340,7 +340,7 @@ jobs:
# (This should no longer be possible once `nightly-testing-YYYY-MM-DD` is a tag, but it is still safe to merge.)
git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories
lake update batteries
get add lake-manifest.json
git add lake-manifest.json
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi

View File

@@ -181,7 +181,7 @@ v4.12.0
* [#4953](https://github.com/leanprover/lean4/pull/4953) defines "and-inverter graphs" (AIGs) as described in section 3 of [Davis-Swords 2013](https://arxiv.org/pdf/1304.7861.pdf).
* **Parsec**
* [#4774](https://github.com/leanprover/lean4/pull/4774) generalizes the `Parsec` library, allowing parsing of iterable data beyong `String` such as `ByteArray`. (See breaking changes.)
* [#4774](https://github.com/leanprover/lean4/pull/4774) generalizes the `Parsec` library, allowing parsing of iterable data beyond `String` such as `ByteArray`. (See breaking changes.)
* [#5115](https://github.com/leanprover/lean4/pull/5115) moves `Lean.Data.Parsec` to `Std.Internal.Parsec` for bootstrappng reasons.
* `Thunk`

View File

@@ -18,14 +18,14 @@ the stdlib.
## Installing dependencies
[The official webpage of MSYS2][msys2] provides one-click installers.
Once installed, you should run the "MSYS2 MinGW 64-bit shell" from the start menu (the one that runs `mingw64.exe`).
Do not run "MSYS2 MSYS" instead!
MSYS2 has a package management system, [pacman][pacman], which is used in Arch Linux.
Once installed, you should run the "MSYS2 CLANG64" shell from the start menu (the one that runs `clang64.exe`).
Do not run "MSYS2 MSYS" or "MSYS2 MINGW64" instead!
MSYS2 has a package management system, [pacman][pacman].
Here are the commands to install all dependencies needed to compile Lean on your machine.
```bash
pacman -S make python mingw-w64-x86_64-cmake mingw-w64-x86_64-clang mingw-w64-x86_64-ccache mingw-w64-x86_64-libuv mingw-w64-x86_64-gmp git unzip diffutils binutils
pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
```
You should now be able to run these commands:
@@ -61,8 +61,7 @@ If you want a version that can run independently of your MSYS install
then you need to copy the following dependent DLL's from where ever
they are installed in your MSYS setup:
- libgcc_s_seh-1.dll
- libstdc++-6.dll
- libc++.dll
- libgmp-10.dll
- libuv-1.dll
- libwinpthread-1.dll
@@ -82,6 +81,6 @@ version clang to your path.
**-bash: gcc: command not found**
Make sure `/mingw64/bin` is in your PATH environment. If it is not then
check you launched the MSYS2 MinGW 64-bit shell from the start menu.
(The one that runs `mingw64.exe`).
Make sure `/clang64/bin` is in your PATH environment. If it is not then
check you launched the MSYS2 CLANG64 shell from the start menu.
(The one that runs `clang64.exe`).

View File

@@ -5,6 +5,7 @@ Authors: Joachim Breitner, Mario Carneiro
-/
prelude
import Init.Data.Array.Mem
import Init.Data.Array.Lemmas
import Init.Data.List.Attach
namespace Array
@@ -26,4 +27,152 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
with the same elements but in the type `{x // x ∈ xs}`. -/
@[inline] def attach (xs : Array α) : Array {x // x xs} := xs.attachWith _ fun _ => id
@[simp] theorem _root_.List.attachWith_toArray {l : List α} {P : α Prop} {H : x l.toArray, P x} :
l.toArray.attachWith P H = (l.attachWith P (by simpa using H)).toArray := by
simp [attachWith]
@[simp] theorem _root_.List.attach_toArray {l : List α} :
l.toArray.attach = (l.attachWith (· l.toArray) (by simp)).toArray := by
simp [attach]
@[simp] theorem toList_attachWith {l : Array α} {P : α Prop} {H : x l, P x} :
(l.attachWith P H).toList = l.toList.attachWith P (by simpa [mem_toList] using H) := by
simp [attachWith]
@[simp] theorem toList_attach {α : Type _} {l : Array α} :
l.attach.toList = l.toList.attachWith (· l) (by simp [mem_toList]) := by
simp [attach]
/-! ## unattach
`Array.unattach` is the (one-sided) inverse of `Array.attach`. It is a synonym for `Array.map Subtype.val`.
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
functions applied to `l : Array { x // p x }` which only depend on the value, not the predicate, and rewrite these
in terms of a simpler function applied to `l.unattach`.
Further, we provide simp lemmas that push `unattach` inwards.
-/
/--
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
It is introduced as in intermediate step by lemmas such as `map_subtype`,
and is ideally subsequently simplified away by `unattach_attach`.
If not, usually the right approach is `simp [Array.unattach, -Array.map_subtype]` to unfold.
-/
def unattach {α : Type _} {p : α Prop} (l : Array { x // p x }) := l.map (·.val)
@[simp] theorem unattach_nil {p : α Prop} : (#[] : Array { x // p x }).unattach = #[] := rfl
@[simp] theorem unattach_push {p : α Prop} {a : { x // p x }} {l : Array { x // p x }} :
(l.push a).unattach = l.unattach.push a.1 := by
simp only [unattach, Array.map_push]
@[simp] theorem size_unattach {p : α Prop} {l : Array { x // p x }} :
l.unattach.size = l.size := by
unfold unattach
simp
@[simp] theorem _root_.List.unattach_toArray {p : α Prop} {l : List { x // p x }} :
l.toArray.unattach = l.unattach.toArray := by
simp only [unattach, List.map_toArray, List.unattach]
@[simp] theorem toList_unattach {p : α Prop} {l : Array { x // p x }} :
l.unattach.toList = l.toList.unattach := by
simp only [unattach, toList_map, List.unattach]
@[simp] theorem unattach_attach {l : Array α} : l.attach.unattach = l := by
cases l
simp
@[simp] theorem unattach_attachWith {p : α Prop} {l : Array α}
{H : a l, p a} :
(l.attachWith p H).unattach = l := by
cases l
simp
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--
This lemma identifies folds over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
theorem foldl_subtype {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
l.foldl f x = l.unattach.foldl g x := by
cases l
simp only [List.foldl_toArray', List.unattach_toArray]
rw [List.foldl_subtype] -- Why can't simp do this?
simp [hf]
/-- Variant of `foldl_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldl_subtype' {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} (h : stop = l.size) :
l.foldl f x 0 stop = l.unattach.foldl g x := by
subst h
rwa [foldl_subtype]
/--
This lemma identifies folds over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
theorem foldr_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
l.foldr f x = l.unattach.foldr g x := by
cases l
simp only [List.foldr_toArray', List.unattach_toArray]
rw [List.foldr_subtype]
simp [hf]
/-- Variant of `foldr_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldr_subtype' {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} (h : start = l.size) :
l.foldr f x start 0 = l.unattach.foldr g x := by
subst h
rwa [foldr_subtype]
/--
This lemma identifies maps over arrays of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
l.map f = l.unattach.map g := by
cases l
simp only [List.map_toArray, List.unattach_toArray]
rw [List.map_subtype]
simp [hf]
@[simp] theorem filterMap_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
l.filterMap f = l.unattach.filterMap g := by
cases l
simp only [size_toArray, List.filterMap_toArray', List.unattach_toArray, List.length_unattach,
mk.injEq]
rw [List.filterMap_subtype]
simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(l.filter f).unattach = l.unattach.filter g := by
cases l
simp [hf]
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem unattach_reverse {p : α Prop} {l : Array { x // p x }} :
l.reverse.unattach = l.unattach.reverse := by
cases l
simp
@[simp] theorem unattach_append {p : α Prop} {l₁ l₂ : Array { x // p x }} :
(l₁ ++ l₂).unattach = l₁.unattach ++ l₂.unattach := by
cases l₁
cases l₂
simp
end Array

View File

@@ -11,6 +11,7 @@ import Init.Data.UInt.Basic
import Init.Data.Repr
import Init.Data.ToString.Basic
import Init.GetElem
import Init.Data.List.ToArray
universe u v w
/-! ### Array literal syntax -/

View File

@@ -108,23 +108,52 @@ theorem toArray_concat {as : List α} {x : α} :
funext a
simp
@[simp] theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
l.toArray.foldrM f init = l.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList]
simp
@[simp] theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
l.toArray.foldlM f init = l.foldlM f init := by
rw [foldlM_eq_foldlM_toList]
@[simp] theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
l.toArray.foldr f init = l.foldr f init := by
rw [foldr_eq_foldr_toList]
@[simp] theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
l.toArray.foldl f init = l.foldl f init := by
rw [foldl_eq_foldl_toList]
/-- Variant of `foldrM_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldrM_toArray' [Monad m] (f : α β m β) (init : β) (l : List α)
(h : start = l.toArray.size) :
l.toArray.foldrM f init start 0 = l.foldrM f init := by
subst h
rw [foldrM_eq_reverse_foldlM_toList]
simp
/-- Variant of `foldlM_toArray` with a side condition for the `stop` argument. -/
@[simp] theorem foldlM_toArray' [Monad m] (f : β α m β) (init : β) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.foldlM f init 0 stop = l.foldlM f init := by
subst h
rw [foldlM_eq_foldlM_toList]
/-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldr_toArray' (f : α β β) (init : β) (l : List α)
(h : start = l.toArray.size) :
l.toArray.foldr f init start 0 = l.foldr f init := by
subst h
rw [foldr_eq_foldr_toList]
/-- Variant of `foldl_toArray` with a side condition for the `stop` argument. -/
@[simp] theorem foldl_toArray' (f : β α β) (init : β) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.foldl f init 0 stop = l.foldl f init := by
subst h
rw [foldl_eq_foldl_toList]
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
apply ext'
@@ -730,6 +759,18 @@ theorem foldr_induction
simp [foldr, foldrM]; split; {exact go _ h0}
· next h => exact (Nat.eq_zero_of_not_pos h h0)
@[congr]
theorem foldl_congr {as bs : Array α} (h₀ : as = bs) {f g : β α β} (h₁ : f = g)
{a b : β} (h₂ : a = b) {start start' stop stop' : Nat} (h₃ : start = start') (h₄ : stop = stop') :
as.foldl f a start stop = bs.foldl g b start' stop' := by
congr
@[congr]
theorem foldr_congr {as bs : Array α} (h₀ : as = bs) {f g : α β β} (h₁ : f = g)
{a b : β} (h₂ : a = b) {start start' stop stop' : Nat} (h₃ : start = start') (h₄ : stop = stop') :
as.foldr f a start stop = bs.foldr g b start' stop' := by
congr
/-! ### map -/
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
@@ -814,6 +855,13 @@ theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Pro
(as.map f)[i]? = as[i]?.map f := by
simp [getElem?_def]
@[simp] theorem map_push {f : α β} {as : Array α} {x : α} :
(as.push x).map f = (as.map f).push (f x) := by
ext
· simp
· simp only [getElem_map, get_push, size_map]
split <;> rfl
/-! ### mapIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
@@ -920,6 +968,13 @@ abbrev filter_data := @toList_filter
theorem mem_of_mem_filter {a : α} {l} (h : a filter p l) : a l :=
(mem_filter.mp h).1
@[congr]
theorem filter_congr {as bs : Array α} (h : as = bs)
{f : α Bool} {g : α Bool} (h' : f = g) {start stop start' stop' : Nat}
(h₁ : start = start') (h₂ : stop = stop') :
filter f as start stop = filter g bs start' stop' := by
congr
/-! ### filterMap -/
@[simp] theorem toList_filterMap (f : α Option β) (l : Array α) :
@@ -942,6 +997,13 @@ abbrev filterMap_data := @toList_filterMap
b filterMap f l a, a l f a = some b := by
simp only [mem_def, toList_filterMap, List.mem_filterMap]
@[congr]
theorem filterMap_congr {as bs : Array α} (h : as = bs)
{f : α Option β} {g : α Option β} (h' : f = g) {start stop start' stop' : Nat}
(h₁ : start = start') (h₂ : stop = stop') :
filterMap f as start stop = filterMap g bs start' stop' := by
congr
/-! ### empty -/
theorem size_empty : (#[] : Array α).size = 0 := rfl
@@ -1432,18 +1494,44 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
· simp
· simp_all [List.set_eq_of_length_le]
@[simp] theorem anyM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
theorem anyM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
l.toArray.anyM p = l.anyM p := by
rw [ anyM_toList]
@[simp] theorem any_toArray (p : α Bool) (l : List α) : l.toArray.any p = l.any p := by
theorem any_toArray (p : α Bool) (l : List α) : l.toArray.any p = l.any p := by
rw [any_toList]
@[simp] theorem allM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
theorem allM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
l.toArray.allM p = l.allM p := by
rw [ allM_toList]
@[simp] theorem all_toArray (p : α Bool) (l : List α) : l.toArray.all p = l.all p := by
theorem all_toArray (p : α Bool) (l : List α) : l.toArray.all p = l.all p := by
rw [all_toList]
/-- Variant of `anyM_toArray` with a side condition on `stop`. -/
@[simp] theorem anyM_toArray' [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.anyM p 0 stop = l.anyM p := by
subst h
rw [ anyM_toList]
/-- Variant of `any_toArray` with a side condition on `stop`. -/
@[simp] theorem any_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.any p 0 stop = l.any p := by
subst h
rw [any_toList]
/-- Variant of `allM_toArray` with a side condition on `stop`. -/
@[simp] theorem allM_toArray' [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.allM p 0 stop = l.allM p := by
subst h
rw [ allM_toList]
/-- Variant of `all_toArray` with a side condition on `stop`. -/
@[simp] theorem all_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.all p 0 stop = l.all p := by
subst h
rw [all_toList]
@[simp] theorem swap_toArray (l : List α) (i j : Fin l.toArray.size) :
@@ -1459,15 +1547,25 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
apply ext'
simp
@[simp] theorem filter_toArray (p : α Bool) (l : List α) :
l.toArray.filter p = (l.filter p).toArray := by
@[simp] theorem filter_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.filter p 0 stop = (l.filter p).toArray := by
subst h
apply ext'
erw [toList_filter] -- `erw` required to unify `l.length` with `l.toArray.size`.
rw [toList_filter]
@[simp] theorem filterMap_toArray (f : α Option β) (l : List α) :
l.toArray.filterMap f = (l.filterMap f).toArray := by
@[simp] theorem filterMap_toArray' (f : α Option β) (l : List α) (h : stop = l.toArray.size) :
l.toArray.filterMap f 0 stop = (l.filterMap f).toArray := by
subst h
apply ext'
erw [toList_filterMap] -- `erw` required to unify `l.length` with `l.toArray.size`.
rw [toList_filterMap]
theorem filter_toArray (p : α Bool) (l : List α) :
l.toArray.filter p = (l.filter p).toArray := by
simp
theorem filterMap_toArray (f : α Option β) (l : List α) :
l.toArray.filterMap f = (l.filterMap f).toArray := by
simp
@[simp] theorem flatten_toArray (l : List (List α)) : (l.toArray.map List.toArray).flatten = l.join.toArray := by
apply ext'

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed, Siddharth Bhat
-/
prelude
import Init.Data.Fin.Basic
@@ -718,6 +718,8 @@ section normalization_eqs
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
@[simp] theorem udiv_eq (x y : BitVec w) : BitVec.udiv x y = x / y := rfl
@[simp] theorem umod_eq (x y : BitVec w) : BitVec.umod x y = x % y := rfl
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
end normalization_eqs

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix, Siddharth Bhat
-/
prelude
import Init.Data.BitVec.Folds
@@ -18,6 +18,80 @@ as vectors of bits into proofs about Lean `BitVec` values.
The module is named for the bit-blasting operation in an SMT solver that converts bitvector
expressions into expressions about individual bits in each vector.
### Example: How bitblasting works for multiplication
We explain how the lemmas here are used for bitblasting,
by using multiplication as a prototypical example.
Other bitblasters for other operations follow the same pattern.
To bitblast a multiplication of the form `x * y`,
we must unfold the above into a form that the SAT solver understands.
We assume that the solver already knows how to bitblast addition.
This is known to `bv_decide`, by exploiting the lemma `add_eq_adc`,
which says that `x + y : BitVec w` equals `(adc x y false).2`,
where `adc` builds an add-carry circuit in terms of the primitive operations
(bitwise and, bitwise or, bitwise xor) that bv_decide already understands.
In this way, we layer bitblasters on top of each other,
by reducing the multiplication bitblaster to an addition operation.
The core lemma is given by `getLsbD_mul`:
```lean
x y : BitVec w ⊢ (x * y).getLsbD i = (mulRec x y w).getLsbD i
```
Which says that the `i`th bit of `x * y` can be obtained by
evaluating the `i`th bit of `(mulRec x y w)`.
Once again, we assume that `bv_decide` knows how to implement `getLsbD`,
given that `mulRec` can be understood by `bv_decide`.
We write two lemmas to enable `bv_decide` to unfold `(mulRec x y w)`
into a complete circuit, **when `w` is a known constant**`.
This is given by two recurrence lemmas, `mulRec_zero_eq` and `mulRec_succ_eq`,
which are applied repeatedly when the width is `0` and when the width is `w' + 1`:
```lean
mulRec_zero_eq :
mulRec x y 0 =
if y.getLsbD 0 then x else 0
mulRec_succ_eq
mulRec x y (s + 1) =
mulRec x y s +
if y.getLsbD (s + 1) then (x <<< (s + 1)) else 0 := rfl
```
By repeatedly applying the lemmas `mulRec_zero_eq` and `mulRec_succ_eq`,
one obtains a circuit for multiplication.
Note that this circuit uses `BitVec.add`, `BitVec.getLsbD`, `BitVec.shiftLeft`.
Here, `BitVec.add` and `BitVec.shiftLeft` are (recursively) bitblasted by `bv_decide`,
using the lemmas `add_eq_adc` and `shiftLeft_eq_shiftLeftRec`,
and `BitVec.getLsbD` is a primitive that `bv_decide` knows how to reduce to SAT.
The two lemmas, `mulRec_zero_eq`, and `mulRec_succ_eq`,
are used in `Std.Tactic.BVDecide.BVExpr.bitblast.blastMul`
to prove the correctness of the circuit that is built by `bv_decide`.
```lean
def blastMul (aig : AIG BVBit) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry BVBit w
theorem denote_blastMul (aig : AIG BVBit) (lhs rhs : BitVec w) (assign : Assignment) :
...
⟦(blastMul aig input).aig, (blastMul aig input).vec.get idx hidx, assign.toAIGAssignment⟧
=
(lhs * rhs).getLsbD idx
```
The definition and theorem above are internal to `bv_decide`,
and use `mulRec_{zero,succ}_eq` to prove that the circuit built by `bv_decide`
computes the correct value for multiplication.
To zoom out, therefore, we follow two steps:
First, we prove bitvector lemmas to unfold a high-level operation (such as multiplication)
into already bitblastable operations (such as addition and left shift).
We then use these lemmas to prove the correctness of the circuit that `bv_decide` builds.
We use this workflow to implement bitblasting for all SMT-LIB2 operations.
## Main results
* `x + y : BitVec w` is `(adc x y false).2`.
@@ -497,7 +571,7 @@ then `n.udiv d = q`. -/
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
(hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n.udiv d = q := by
n / d = q := by
apply BitVec.eq_of_toNat_eq
rw [toNat_udiv]
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
@@ -513,7 +587,7 @@ theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
then `n.umod d = r`. -/
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n.umod d = r := by
n % d = r := by
apply BitVec.eq_of_toNat_eq
rw [toNat_umod]
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
@@ -614,7 +688,7 @@ quotient has been correctly computed.
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
(h_lawful : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n.udiv d = qr.q := by
n / d = qr.q := by
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
have hdiv := h_lawful.hdiv
simp only [h_final] at *
@@ -627,7 +701,7 @@ remainder has been correctly computed.
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
(h : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n.umod d = qr.r := by
n % d = qr.r := by
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
have hdiv := h.hdiv
simp only [shiftRight_zero] at hdiv
@@ -693,7 +767,7 @@ theorem DivModState.toNat_shiftRight_sub_one_eq
omega
/--
This is used when proving the correctness of the divison algorithm,
This is used when proving the correctness of the division algorithm,
where we know that `r < d`.
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
In arithmetic, this is the same as showing that
@@ -801,7 +875,7 @@ theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
/-- The result of `udiv` agrees with the result of the division recurrence. -/
theorem udiv_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n.udiv d = out.q := by
n / d = out.q := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
@@ -809,7 +883,7 @@ theorem udiv_eq_divRec (hd : 0#w < d) :
/-- The result of `umod` agrees with the result of the division recurrence. -/
theorem umod_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n.umod d = out.r := by
n % d = out.r := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed,
Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed, Siddharth Bhat
-/
prelude
@@ -219,9 +219,25 @@ theorem getMsbD_of_zero_length (h : w = 0) (x : BitVec w) : x.getMsbD i = false
theorem msb_of_zero_length (h : w = 0) (x : BitVec w) : x.msb = false := by
subst h; simp [msb_zero_length]
theorem ofFin_ofNat (n : Nat) :
ofFin (no_index (OfNat.ofNat n : Fin (2^w))) = OfNat.ofNat n := by
simp only [OfNat.ofNat, Fin.ofNat', BitVec.ofNat, Nat.and_pow_two_sub_one_eq_mod]
theorem eq_of_toFin_eq : {x y : BitVec w}, x.toFin = y.toFin x = y
| _, _, _, _, rfl => rfl
theorem toFin_inj {x y : BitVec w} : x.toFin = y.toFin x = y := by
apply Iff.intro
case mp =>
exact @eq_of_toFin_eq w x y
case mpr =>
intro h
simp [toFin, h]
theorem toFin_zero : toFin (0 : BitVec w) = 0 := rfl
theorem toFin_one : toFin (1 : BitVec w) = 1 := by
rw [toFin_inj]; simp only [ofNat_eq_ofNat, ofFin_ofNat]
@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
cases b <;> rfl
@@ -434,7 +450,7 @@ theorem toInt_inj {x y : BitVec n} : x.toInt = y.toInt ↔ x = y :=
theorem toInt_ne {x y : BitVec n} : x.toInt y.toInt x y := by
rw [Ne, toInt_inj]
@[simp] theorem toNat_ofInt {n : Nat} (i : Int) :
@[simp, bv_toNat] theorem toNat_ofInt {n : Nat} (i : Int) :
(BitVec.ofInt n i).toNat = (i % (2^n : Nat)).toNat := by
unfold BitVec.ofInt
simp
@@ -919,6 +935,21 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
_ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w
· simp
@[simp] theorem ofInt_negSucc_eq_not_ofNat {w n : Nat} :
BitVec.ofInt w (Int.negSucc n) = ~~~.ofNat w n := by
simp only [BitVec.ofInt, Int.toNat, Int.ofNat_eq_coe, toNat_eq, toNat_ofNatLt, toNat_not,
toNat_ofNat]
cases h : Int.negSucc n % ((2 ^ w : Nat) : Int)
case ofNat =>
rw [Int.ofNat_eq_coe, Int.negSucc_emod] at h
· dsimp only
omega
· omega
case negSucc a =>
have neg := Int.negSucc_lt_zero a
have _ : 0 Int.negSucc n % ((2 ^ w : Nat) : Int) := Int.emod_nonneg _ (by omega)
omega
@[simp] theorem toFin_not (x : BitVec w) :
(~~~x).toFin = x.toFin.rev := by
apply Fin.val_inj.mp
@@ -961,6 +992,15 @@ theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
ext i
simp
theorem not_eq_comm {x y : BitVec w} : ~~~ x = y x = ~~~ y := by
constructor
· intro h
rw [ h]
simp
· intro h
rw [h]
simp
@[simp] theorem getMsb_not {x : BitVec w} :
(~~~x).getMsbD i = (decide (i < w) && !(x.getMsbD i)) := by
simp only [getMsbD]
@@ -1183,6 +1223,28 @@ theorem toNat_ushiftRight_lt (x : BitVec w) (n : Nat) (hn : n ≤ w) :
· apply hn
· apply Nat.pow_pos (by decide)
@[simp]
theorem getMsbD_ushiftRight {x : BitVec w} {i n : Nat} :
(x >>> n).getMsbD i = (decide (i < w) && (!decide (i < n) && x.getMsbD (i - n))) := by
simp only [getMsbD, getLsbD_ushiftRight]
by_cases h : i < n
· simp [getLsbD_ge, show w (n + (w - 1 - i)) by omega]
omega
· by_cases h₁ : i < w
· simp only [h, ushiftRight_eq, getLsbD_ushiftRight, show i - n < w by omega]
congr
omega
· simp [h, h₁]
@[simp]
theorem msb_ushiftRight {x : BitVec w} {n : Nat} :
(x >>> n).msb = (!decide (0 < n) && x.msb) := by
induction n
case zero =>
simp
case succ nn ih =>
simp [BitVec.ushiftRight_eq, getMsbD_ushiftRight, BitVec.msb, ih, show nn + 1 > 0 by omega]
/-! ### ushiftRight reductions from BitVec to Nat -/
@[simp]
@@ -1287,7 +1349,8 @@ theorem sshiftRight_or_distrib (x y : BitVec w) (n : Nat) :
<;> simp [*]
/-- The msb after arithmetic shifting right equals the original msb. -/
theorem sshiftRight_msb_eq_msb {n : Nat} {x : BitVec w} :
@[simp]
theorem msb_sshiftRight {n : Nat} {x : BitVec w} :
(x.sshiftRight n).msb = x.msb := by
rw [msb_eq_getLsbD_last, getLsbD_sshiftRight, msb_eq_getLsbD_last]
by_cases hw₀ : w = 0
@@ -1314,7 +1377,7 @@ theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
by_cases h₃ : m + (n + i) < w
· simp [h₃]
omega
· simp [h₃, sshiftRight_msb_eq_msb]
· simp [h₃, msb_sshiftRight]
theorem not_sshiftRight {b : BitVec w} :
~~~b.sshiftRight n = (~~~b).sshiftRight n := by
@@ -1332,98 +1395,55 @@ theorem not_sshiftRight_not {x : BitVec w} {n : Nat} :
~~~((~~~x).sshiftRight n) = x.sshiftRight n := by
simp [not_sshiftRight]
@[simp]
theorem getMsbD_sshiftRight {x : BitVec w} {i n : Nat} :
getMsbD (x.sshiftRight n) i = (decide (i < w) && if i < n then x.msb else getMsbD x (i - n)) := by
simp only [getMsbD, BitVec.getLsbD_sshiftRight]
by_cases h : i < w
· simp only [h, decide_True, Bool.true_and]
by_cases h₁ : w w - 1 - i
· simp [h₁]
omega
· simp only [h₁, decide_False, Bool.not_false, Bool.true_and]
by_cases h₂ : i < n
· simp only [h₂, reduceIte, ite_eq_right_iff]
omega
· simp only [show i - n < w by omega, h₂, reduceIte, decide_True, Bool.true_and]
by_cases h₄ : n + (w - 1 - i) < w <;> (simp only [h₄, reduceIte]; congr; omega)
· simp [h]
/-! ### sshiftRight reductions from BitVec to Nat -/
@[simp]
theorem sshiftRight_eq' (x : BitVec w) : x.sshiftRight' y = x.sshiftRight y.toNat := rfl
/-! ### udiv -/
@[simp]
theorem getLsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
getLsbD (x.sshiftRight' y) i =
(!decide (w i) && if y.toNat + i < w then x.getLsbD (y.toNat + i) else x.msb) := by
simp only [BitVec.sshiftRight', BitVec.getLsbD_sshiftRight]
theorem udiv_eq {x y : BitVec n} : x.udiv y = BitVec.ofNat n (x.toNat / y.toNat) := by
have h : x.toNat / y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
@[simp, bv_toNat]
theorem toNat_udiv {x y : BitVec n} : (x.udiv y).toNat = x.toNat / y.toNat := by
simp only [udiv_eq]
by_cases h : y = 0
@[simp]
theorem getMsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
(x.sshiftRight y.toNat).getMsbD i = (decide (i < w) && if i < y.toNat then x.msb else x.getMsbD (i - y.toNat)) := by
simp only [BitVec.sshiftRight', getMsbD, BitVec.getLsbD_sshiftRight]
by_cases h : i < w
· simp only [h, decide_True, Bool.true_and]
by_cases h₁ : w w - 1 - i
· simp [h₁]
omega
· simp only [h₁, decide_False, Bool.not_false, Bool.true_and]
by_cases h₂ : i < y.toNat
· simp only [h₂, reduceIte, ite_eq_right_iff]
omega
· simp only [show i - y.toNat < w by omega, h₂, reduceIte, decide_True, Bool.true_and]
by_cases h₄ : y.toNat + (w - 1 - i) < w <;> (simp only [h₄, reduceIte]; congr; omega)
· simp [h]
· rw [toNat_ofNat, Nat.mod_eq_of_lt]
exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
/-! ### umod -/
theorem umod_eq {x y : BitVec n} :
x.umod y = BitVec.ofNat n (x.toNat % y.toNat) := by
have h : x.toNat % y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt
simp [umod, bv_toNat, Nat.mod_eq_of_lt h]
@[simp, bv_toNat]
theorem toNat_umod {x y : BitVec n} :
(x.umod y).toNat = x.toNat % y.toNat := rfl
/-! ### sdiv -/
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
match x.msb, y.msb with
| false, false => udiv x y
| false, true => - (x.udiv (- y))
| true, false => - ((- x).udiv y)
| true, true => (- x).udiv (- y) := by
rw [BitVec.sdiv]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
match x.msb, y.msb with
| false, false => (udiv x y).toNat
| false, true => (- (x.udiv (- y))).toNat
| true, false => (- ((- x).udiv y)).toNat
| true, true => ((- x).udiv (- y)).toNat := by
simp only [sdiv_eq, toNat_udiv]
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
have hx : x = 0#1 x = 1#1 := by bv_omega
have hy : y = 0#1 y = 1#1 := by bv_omega
rcases hx with rfl | rfl <;>
rcases hy with rfl | rfl <;>
rfl
/-! ### smod -/
/-- Equation theorem for `smod` in terms of `umod`. -/
theorem smod_eq (x y : BitVec w) : x.smod y =
match x.msb, y.msb with
| false, false => x.umod y
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u else u + y)
| true, false =>
let u := umod (- x) y
(if u = 0#w then u else y - u)
| true, true => - ((- x).umod (- y)) := by
rw [BitVec.smod]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
match x.msb, y.msb with
| false, false => (x.umod y).toNat
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u.toNat else (u + y).toNat)
| true, false =>
let u := (-x).umod y
(if u = 0#w then u.toNat else (y - u).toNat)
| true, true => (- ((- x).umod (- y))).toNat := by
simp only [smod_eq, toNat_umod]
by_cases h : x.msb <;> by_cases h' : y.msb
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
<;> simp only [h, h', h'', h''']
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
<;> simp [h'', h''']
@[simp]
theorem msb_sshiftRight' {x y: BitVec w} :
(x.sshiftRight' y).msb = x.msb := by
simp [BitVec.sshiftRight', BitVec.msb_sshiftRight]
/-! ### signExtend -/
@@ -1640,6 +1660,11 @@ theorem shiftLeft_ushiftRight {x : BitVec w} {n : Nat}:
· simp [hi₂]
· simp [Nat.lt_one_iff, hi₂, show 1 + (i.val - 1) = i by omega]
@[simp]
theorem msb_shiftLeft {x : BitVec w} {n : Nat} :
(x <<< n).msb = x.getMsbD n := by
simp [BitVec.msb]
@[deprecated shiftRight_add (since := "2024-06-02")]
theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
(x >>> n) >>> m = x >>> (n + m) := by
@@ -2014,7 +2039,7 @@ theorem negOne_eq_allOnes : -1#w = allOnes w := by
have r : (2^w - 1) < 2^w := by omega
simp [Nat.mod_eq_of_lt q, Nat.mod_eq_of_lt r]
theorem neg_eq_not_add (x : BitVec w) : -x = ~~~x + 1 := by
theorem neg_eq_not_add (x : BitVec w) : -x = ~~~x + 1#w := by
apply eq_of_toNat_eq
simp only [toNat_neg, ofNat_eq_ofNat, toNat_add, toNat_not, toNat_ofNat, Nat.add_mod_mod]
congr
@@ -2034,11 +2059,36 @@ theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x ≠ y ↔ x ≠ -y := by
subst h'
simp at h
@[simp]
theorem neg_eq_zero_iff {x : BitVec w} : -x = 0#w x = 0#w := by
constructor
· intro h
have : - (- x) = - 0 := by simp [h]
simpa using this
· intro h
simp [h]
theorem sub_eq_xor {a b : BitVec 1} : a - b = a ^^^ b := by
have ha : a = 0 a = 1 := eq_zero_or_eq_one _
have hb : b = 0 b = 1 := eq_zero_or_eq_one _
rcases ha with h | h <;> (rcases hb with h' | h' <;> (simp [h, h']))
theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
rcases w with _ | w
· apply Subsingleton.elim
· rw [BitVec.not_eq_comm]
apply BitVec.eq_of_toNat_eq
simp only [BitVec.toNat_neg, BitVec.toNat_not, BitVec.toNat_add, BitVec.toNat_ofNat,
Nat.add_mod_mod]
by_cases hx : x.toNat = 0
· simp [hx]
· rw [show (_ - 1 % _) = _ by rw [Nat.mod_eq_of_lt (by omega)],
show _ + (_ - 1) = (x.toNat - 1) + 2^(w + 1) by omega,
Nat.add_mod_right,
show (x.toNat - 1) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)],
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
omega
/-! ### abs -/
@[simp, bv_toNat]
@@ -2173,7 +2223,7 @@ protected theorem ne_of_lt {x y : BitVec n} : x < y → x ≠ y := by
simp only [lt_def, ne_eq, toNat_eq]
apply Nat.ne_of_lt
protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y x.umod y < y := by
protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y x % y < y := by
simp only [ofNat_eq_ofNat, lt_def, toNat_ofNat, Nat.zero_mod, umod, toNat_ofNatLt]
apply Nat.mod_lt
@@ -2181,6 +2231,116 @@ theorem not_lt_iff_le {x y : BitVec w} : (¬ x < y) ↔ y ≤ x := by
constructor <;>
(intro h; simp only [lt_def, Nat.not_lt, le_def] at h ; omega)
/-! ### udiv -/
theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) := by
have h : x.toNat / y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
rw [ udiv_eq]
simp [udiv, bv_toNat, h, Nat.mod_eq_of_lt]
@[simp, bv_toNat]
theorem toNat_udiv {x y : BitVec n} : (x / y).toNat = x.toNat / y.toNat := by
rw [udiv_def]
by_cases h : y = 0
· simp [h]
· rw [toNat_ofNat, Nat.mod_eq_of_lt]
exact Nat.lt_of_le_of_lt (Nat.div_le_self ..) (by omega)
@[simp]
theorem udiv_zero {x : BitVec n} : x / 0#n = 0#n := by
simp [udiv_def]
/-! ### umod -/
theorem umod_def {x y : BitVec n} :
x % y = BitVec.ofNat n (x.toNat % y.toNat) := by
rw [ umod_eq]
have h : x.toNat % y.toNat < 2 ^ n := Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt
simp [umod, bv_toNat, Nat.mod_eq_of_lt h]
@[simp, bv_toNat]
theorem toNat_umod {x y : BitVec n} :
(x % y).toNat = x.toNat % y.toNat := rfl
@[simp]
theorem umod_zero {x : BitVec n} : x % 0#n = x := by
simp [umod_def]
/-! ### sdiv -/
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
match x.msb, y.msb with
| false, false => udiv x y
| false, true => - (x.udiv (- y))
| true, false => - ((- x).udiv y)
| true, true => (- x).udiv (- y) := by
rw [BitVec.sdiv]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
match x.msb, y.msb with
| false, false => (udiv x y).toNat
| false, true => (- (x.udiv (- y))).toNat
| true, false => (- ((- x).udiv y)).toNat
| true, true => ((- x).udiv (- y)).toNat := by
simp only [sdiv_eq, toNat_udiv]
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
have hx : x = 0#1 x = 1#1 := by bv_omega
have hy : y = 0#1 y = 1#1 := by bv_omega
rcases hx with rfl | rfl <;>
rcases hy with rfl | rfl <;>
rfl
@[simp]
theorem sdiv_zero {x : BitVec n} : x.sdiv 0#n = 0#n := by
simp only [sdiv_eq, msb_zero]
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq <;> simp
/-! ### smod -/
/-- Equation theorem for `smod` in terms of `umod`. -/
theorem smod_eq (x y : BitVec w) : x.smod y =
match x.msb, y.msb with
| false, false => x.umod y
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u else u + y)
| true, false =>
let u := umod (- x) y
(if u = 0#w then u else y - u)
| true, true => - ((- x).umod (- y)) := by
rw [BitVec.smod]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
match x.msb, y.msb with
| false, false => (x.umod y).toNat
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u.toNat else (u + y).toNat)
| true, false =>
let u := (-x).umod y
(if u = 0#w then u.toNat else (y - u).toNat)
| true, true => (- ((- x).umod (- y))).toNat := by
simp only [smod_eq, toNat_umod]
by_cases h : x.msb <;> by_cases h' : y.msb
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
<;> simp only [h, h', h'', h''']
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
<;> simp [h'', h''']
@[simp]
theorem smod_zero {x : BitVec n} : x.smod 0#n = x := by
simp only [smod_eq, msb_zero]
rcases x.msb with msb | msb <;> apply eq_of_toNat_eq
· simp
· by_cases h : x = 0#n <;> simp [h]
/-! ### ofBoolList -/
@[simp] theorem getMsbD_ofBoolListBE : (ofBoolListBE bs).getMsbD i = bs.getD i false := by
@@ -2884,4 +3044,7 @@ abbrev zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true
@[deprecated and_one_eq_setWidth_ofBool_getLsbD (since := "2024-09-18")]
abbrev and_one_eq_zeroExtend_ofBool_getLsbD := @and_one_eq_setWidth_ofBool_getLsbD
@[deprecated msb_sshiftRight (since := "2024-10-03")]
abbrev sshiftRight_msb_eq_msb := @msb_sshiftRight
end BitVec

View File

@@ -23,3 +23,4 @@ import Init.Data.List.TakeDrop
import Init.Data.List.Zip
import Init.Data.List.Perm
import Init.Data.List.Sort
import Init.Data.List.ToArray

View File

@@ -568,22 +568,22 @@ If not, usually the right approach is `simp [List.unattach, -List.map_subtype]`
-/
def unattach {α : Type _} {p : α Prop} (l : List { x // p x }) := l.map (·.val)
@[simp] theorem unattach_nil {α : Type _} {p : α Prop} : ([] : List { x // p x }).unattach = [] := rfl
@[simp] theorem unattach_cons {α : Type _} {p : α Prop} {a : { x // p x }} {l : List { x // p x }} :
@[simp] theorem unattach_nil {p : α Prop} : ([] : List { x // p x }).unattach = [] := rfl
@[simp] theorem unattach_cons {p : α Prop} {a : { x // p x }} {l : List { x // p x }} :
(a :: l).unattach = a.val :: l.unattach := rfl
@[simp] theorem length_unattach {α : Type _} {p : α Prop} {l : List { x // p x }} :
@[simp] theorem length_unattach {p : α Prop} {l : List { x // p x }} :
l.unattach.length = l.length := by
unfold unattach
simp
@[simp] theorem unattach_attach {α : Type _} (l : List α) : l.attach.unattach = l := by
@[simp] theorem unattach_attach {l : List α} : l.attach.unattach = l := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, Function.comp_def]
@[simp] theorem unattach_attachWith {α : Type _} {p : α Prop} {l : List α}
@[simp] theorem unattach_attachWith {p : α Prop} {l : List α}
{H : a l, p a} :
(l.attachWith p H).unattach = l := by
unfold unattach
@@ -647,7 +647,7 @@ and simplifies these to the function directly taking the value.
| nil => simp
| cons a l ih => simp [ih, hf]
@[simp] theorem filter_unattach {p : α Prop} {l : List { x // p x }}
@[simp] theorem unattach_filter {p : α Prop} {l : List { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(l.filter f).unattach = l.unattach.filter g := by
induction l with
@@ -658,20 +658,20 @@ and simplifies these to the function directly taking the value.
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem reverse_unattach {p : α Prop} {l : List { x // p x }} :
@[simp] theorem unattach_reverse {p : α Prop} {l : List { x // p x }} :
l.reverse.unattach = l.unattach.reverse := by
simp [unattach, -map_subtype]
@[simp] theorem append_unattach {p : α Prop} {l₁ l₂ : List { x // p x }} :
@[simp] theorem unattach_append {p : α Prop} {l₁ l₂ : List { x // p x }} :
(l₁ ++ l₂).unattach = l₁.unattach ++ l₂.unattach := by
simp [unattach, -map_subtype]
@[simp] theorem join_unattach {p : α Prop} {l : List (List { x // p x })} :
@[simp] theorem unattach_join {p : α Prop} {l : List (List { x // p x })} :
l.join.unattach = (l.map unattach).join := by
unfold unattach
induction l <;> simp_all
@[simp] theorem replicate_unattach {p : α Prop} {n : Nat} {x : { x // p x }} :
@[simp] theorem unattach_replicate {p : α Prop} {n : Nat} {x : { x // p x }} :
(List.replicate n x).unattach = List.replicate n x.1 := by
simp [unattach, -map_subtype]

View File

@@ -20,20 +20,28 @@ open Nat
@[simp] theorem min?_nil [Min α] : ([] : List α).min? = none := rfl
-- We don't put `@[simp]` on `min?_cons`,
-- We don't put `@[simp]` on `min?_cons'`,
-- because the definition in terms of `foldl` is not useful for proofs.
theorem min?_cons [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
theorem min?_cons' [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
@[simp] theorem min?_cons [Min α] [Std.Associative (min : α α α)] {xs : List α} :
(x :: xs).min? = some (xs.min?.elim x (min x)) := by
cases xs <;> simp [min?_cons', foldl_assoc]
@[simp] theorem min?_eq_none_iff {xs : List α} [Min α] : xs.min? = none xs = [] := by
cases xs <;> simp [min?]
theorem isSome_min?_of_mem {l : List α} [Min α] {a : α} (h : a l) :
l.min?.isSome := by
cases l <;> simp_all [List.min?_cons']
theorem min?_mem [Min α] (min_eq_or : a b : α, min a b = a min a b = b) :
{xs : List α} xs.min? = some a a xs := by
intro xs
match xs with
| nil => simp
| x :: xs =>
simp only [min?_cons, Option.some.injEq, List.mem_cons]
simp only [min?_cons', Option.some.injEq, List.mem_cons]
intro eq
induction xs generalizing x with
| nil =>
@@ -85,23 +93,35 @@ theorem min?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
(replicate n a).min? = if n = 0 then none else some a := by
induction n with
| zero => rfl
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons]
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons']
@[simp] theorem min?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
(replicate n a).min? = some a := by
simp [min?_replicate, Nat.ne_of_gt h, w]
theorem foldl_min [Min α] [Std.IdempotentOp (min : α α α)] [Std.Associative (min : α α α)]
{l : List α} {a : α} : l.foldl (init := a) min = min a (l.min?.getD a) := by
cases l <;> simp [min?, foldl_assoc, Std.IdempotentOp.idempotent]
/-! ### max? -/
@[simp] theorem max?_nil [Max α] : ([] : List α).max? = none := rfl
-- We don't put `@[simp]` on `max?_cons`,
-- We don't put `@[simp]` on `max?_cons'`,
-- because the definition in terms of `foldl` is not useful for proofs.
theorem max?_cons [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
theorem max?_cons' [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
@[simp] theorem max?_cons [Max α] [Std.Associative (max : α α α)] {xs : List α} :
(x :: xs).max? = some (xs.max?.elim x (max x)) := by
cases xs <;> simp [max?_cons', foldl_assoc]
@[simp] theorem max?_eq_none_iff {xs : List α} [Max α] : xs.max? = none xs = [] := by
cases xs <;> simp [max?]
theorem isSome_max?_of_mem {l : List α} [Max α] {a : α} (h : a l) :
l.max?.isSome := by
cases l <;> simp_all [List.max?_cons']
theorem max?_mem [Max α] (min_eq_or : a b : α, max a b = a max a b = b) :
{xs : List α} xs.max? = some a a xs
| nil => by simp
@@ -144,12 +164,16 @@ theorem max?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
(replicate n a).max? = if n = 0 then none else some a := by
induction n with
| zero => rfl
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons]
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons']
@[simp] theorem max?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
(replicate n a).max? = some a := by
simp [max?_replicate, Nat.ne_of_gt h, w]
theorem foldl_max [Max α] [Std.IdempotentOp (max : α α α)] [Std.Associative (max : α α α)]
{l : List α} {a : α} : l.foldl (init := a) max = max a (l.max?.getD a) := by
cases l <;> simp [max?, foldl_assoc, Std.IdempotentOp.idempotent]
@[deprecated min?_nil (since := "2024-09-29")] abbrev minimum?_nil := @min?_nil
@[deprecated min?_cons (since := "2024-09-29")] abbrev minimum?_cons := @min?_cons
@[deprecated min?_eq_none_iff (since := "2024-09-29")] abbrev mininmum?_eq_none_iff := @min?_eq_none_iff

View File

@@ -96,75 +96,22 @@ theorem min?_eq_some_iff' {xs : List Nat} :
(min_eq_or := fun _ _ => Nat.min_def .. by split <;> simp)
(le_min_iff := fun _ _ _ => Nat.le_min)
-- This could be generalized,
-- but will first require further work on order typeclasses in the core repository.
theorem min?_cons' {a : Nat} {l : List Nat} :
(a :: l).min? = some (match l.min? with
| none => a
| some m => min a m) := by
rw [min?_eq_some_iff']
split <;> rename_i h m
· simp_all
· rw [min?_eq_some_iff'] at m
obtain m, le := m
rw [Nat.min_def]
constructor
· split
· exact mem_cons_self a l
· exact mem_cons_of_mem a m
· intro b m
cases List.mem_cons.1 m with
| inl => split <;> omega
| inr h =>
specialize le b h
split <;> omega
theorem foldl_min
{α : Type _} [Min α] [Std.IdempotentOp (min : α α α)] [Std.Associative (min : α α α)]
{l : List α} {a : α} :
l.foldl (init := a) min = min a (l.min?.getD a) := by
cases l with
| nil => simp [Std.IdempotentOp.idempotent]
| cons b l =>
simp only [min?]
induction l generalizing a b with
| nil => simp
| cons c l ih => simp [ih, Std.Associative.assoc]
theorem foldl_min_right {α β : Type _}
[Min β] [Std.IdempotentOp (min : β β β)] [Std.Associative (min : β β β)]
{l : List α} {b : β} {f : α β} :
(l.foldl (init := b) fun acc a => min acc (f a)) = min b ((l.map f).min?.getD b) := by
rw [ foldl_map, foldl_min]
theorem foldl_min_le {l : List Nat} {a : Nat} : l.foldl (init := a) min a := by
induction l generalizing a with
| nil => simp
| cons c l ih =>
simp only [foldl_cons]
exact Nat.le_trans ih (Nat.min_le_left _ _)
theorem foldl_min_min_of_le {l : List Nat} {a b : Nat} (h : a b) :
l.foldl (init := a) min b :=
Nat.le_trans (foldl_min_le) h
theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a l) :
l.min?.getD k a := by
cases l with
theorem min?_get_le_of_mem {l : List Nat} {a : Nat} (h : a l) :
l.min?.get (isSome_min?_of_mem h) a := by
induction l with
| nil => simp at h
| cons b l =>
simp [min?_cons]
simp at h
rcases h with (rfl | h)
· exact foldl_min_le
· induction l generalizing b with
| nil => simp_all
| cons c l ih =>
simp only [foldl_cons]
simp at h
rcases h with (rfl | h)
· exact foldl_min_min_of_le (Nat.min_le_right _ _)
· exact ih _ h
| cons b t ih =>
simp only [min?_cons, Option.get_some] at ih
rcases mem_cons.1 h with (rfl|h)
· cases t.min? with
| none => simp
| some b => simpa using Nat.min_le_left _ _
· obtain q, hq := Option.isSome_iff_exists.1 (isSome_min?_of_mem h)
simp only [hq, Option.elim_some] at ih
exact Nat.le_trans (Nat.min_le_right _ _) (ih h)
theorem min?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a l) : l.min?.getD k a :=
Option.get_eq_getD _ min?_get_le_of_mem h
/-! ### max? -/
@@ -176,75 +123,23 @@ theorem max?_eq_some_iff' {xs : List Nat} :
(max_eq_or := fun _ _ => Nat.max_def .. by split <;> simp)
(max_le_iff := fun _ _ _ => Nat.max_le)
-- This could be generalized,
-- but will first require further work on order typeclasses in the core repository.
theorem max?_cons' {a : Nat} {l : List Nat} :
(a :: l).max? = some (match l.max? with
| none => a
| some m => max a m) := by
rw [max?_eq_some_iff']
split <;> rename_i h m
· simp_all
· rw [max?_eq_some_iff'] at m
obtain m, le := m
rw [Nat.max_def]
constructor
· split
· exact mem_cons_of_mem a m
· exact mem_cons_self a l
· intro b m
cases List.mem_cons.1 m with
| inl => split <;> omega
| inr h =>
specialize le b h
split <;> omega
theorem foldl_max
{α : Type _} [Max α] [Std.IdempotentOp (max : α α α)] [Std.Associative (max : α α α)]
{l : List α} {a : α} :
l.foldl (init := a) max = max a (l.max?.getD a) := by
cases l with
| nil => simp [Std.IdempotentOp.idempotent]
| cons b l =>
simp only [max?]
induction l generalizing a b with
| nil => simp
| cons c l ih => simp [ih, Std.Associative.assoc]
theorem foldl_max_right {α β : Type _}
[Max β] [Std.IdempotentOp (max : β β β)] [Std.Associative (max : β β β)]
{l : List α} {b : β} {f : α β} :
(l.foldl (init := b) fun acc a => max acc (f a)) = max b ((l.map f).max?.getD b) := by
rw [ foldl_map, foldl_max]
theorem le_foldl_max {l : List Nat} {a : Nat} : a l.foldl (init := a) max := by
induction l generalizing a with
| nil => simp
| cons c l ih =>
simp only [foldl_cons]
exact Nat.le_trans (Nat.le_max_left _ _) ih
theorem le_foldl_max_of_le {l : List Nat} {a b : Nat} (h : a b) :
a l.foldl (init := b) max :=
Nat.le_trans h (le_foldl_max)
theorem le_max?_get_of_mem {l : List Nat} {a : Nat} (h : a l) :
a l.max?.get (isSome_max?_of_mem h) := by
induction l with
| nil => simp at h
| cons b t ih =>
simp only [max?_cons, Option.get_some] at ih
rcases mem_cons.1 h with (rfl|h)
· cases t.max? with
| none => simp
| some b => simpa using Nat.le_max_left _ _
· obtain q, hq := Option.isSome_iff_exists.1 (isSome_max?_of_mem h)
simp only [hq, Option.elim_some] at ih
exact Nat.le_trans (ih h) (Nat.le_max_right _ _)
theorem le_max?_getD_of_mem {l : List Nat} {a k : Nat} (h : a l) :
a l.max?.getD k := by
cases l with
| nil => simp at h
| cons b l =>
simp [max?_cons]
simp at h
rcases h with (rfl | h)
· exact le_foldl_max
· induction l generalizing b with
| nil => simp_all
| cons c l ih =>
simp only [foldl_cons]
simp at h
rcases h with (rfl | h)
· exact le_foldl_max_of_le (Nat.le_max_right b a)
· exact ih _ h
a l.max?.getD k :=
Option.get_eq_getD _ le_max?_get_of_mem h
@[deprecated min?_eq_some_iff' (since := "2024-09-29")] abbrev minimum?_eq_some_iff' := @min?_eq_some_iff'
@[deprecated min?_cons' (since := "2024-09-29")] abbrev minimum?_cons' := @min?_cons'

View File

@@ -0,0 +1,23 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Init.Data.List.Basic
/--
Auxiliary definition for `List.toArray`.
`List.toArrayAux as r = r ++ as.toArray`
-/
@[inline_if_reduce]
def List.toArrayAux : List α Array α Array α
| nil, r => r
| cons a as, r => toArrayAux as (r.push a)
/-- Convert a `List α` into an `Array α`. This is O(n) in the length of the list. -/
-- This function is exported to C, where it is called by `Array.mk`
-- (the constructor) to implement this functionality.
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
def List.toArrayImpl (as : List α) : Array α :=
as.toArrayAux (Array.mkEmpty as.length)

View File

@@ -175,4 +175,68 @@ theorem filter_attach {o : Option α} {p : {x // x ∈ o} → Bool} :
o.attach.filter p = o.pbind fun a h => if p a, h then some a, h else none := by
cases o <;> simp [filter_some]
/-! ## unattach
`Option.unattach` is the (one-sided) inverse of `Option.attach`. It is a synonym for `Option.map Subtype.val`.
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
functions applied to `l : Option { x // p x }` which only depend on the value, not the predicate, and rewrite these
in terms of a simpler function applied to `l.unattach`.
Further, we provide simp lemmas that push `unattach` inwards.
-/
/--
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
It is introduced as an intermediate step by lemmas such as `map_subtype`,
and is ideally subsequently simplified away by `unattach_attach`.
If not, usually the right approach is `simp [Option.unattach, -Option.map_subtype]` to unfold.
-/
def unattach {α : Type _} {p : α Prop} (o : Option { x // p x }) := o.map (·.val)
@[simp] theorem unattach_none {p : α Prop} : (none : Option { x // p x }).unattach = none := rfl
@[simp] theorem unattach_some {p : α Prop} {a : { x // p x }} :
(some a).unattach = a.val := rfl
@[simp] theorem isSome_unattach {p : α Prop} {o : Option { x // p x }} :
o.unattach.isSome = o.isSome := by
simp [unattach]
@[simp] theorem isNone_unattach {p : α Prop} {o : Option { x // p x }} :
o.unattach.isNone = o.isNone := by
simp [unattach]
@[simp] theorem unattach_attach (o : Option α) : o.attach.unattach = o := by
cases o <;> simp
@[simp] theorem unattach_attachWith {p : α Prop} {o : Option α}
{H : a o, p a} :
(o.attachWith p H).unattach = o := by
cases o <;> simp
/-! ### Recognizing higher order functions on subtypes using a function that only depends on the value. -/
/--
This lemma identifies maps over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
o.map f = o.unattach.map g := by
cases o <;> simp [hf]
@[simp] theorem bind_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
(o.bind f) = o.unattach.bind g := by
cases o <;> simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(o.filter f).unattach = o.unattach.filter g := by
cases o
· simp
· simp only [filter_some, hf, unattach_some]
split <;> simp
end Option

View File

@@ -535,24 +535,21 @@ syntax (name := includeStr) "include_str " term : term
/--
The `run_cmd doSeq` command executes code in `CommandElabM Unit`.
This is almost the same as `#eval show CommandElabM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
This is the same as `#eval show CommandElabM Unit from discard do doSeq`.
-/
syntax (name := runCmd) "run_cmd " doSeq : command
/--
The `run_elab doSeq` command executes code in `TermElabM Unit`.
This is almost the same as `#eval show TermElabM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
This is the same as `#eval show TermElabM Unit from discard do doSeq`.
-/
syntax (name := runElab) "run_elab " doSeq : command
/--
The `run_meta doSeq` command executes code in `MetaM Unit`.
This is almost the same as `#eval show MetaM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
This is the same as `#eval show MetaM Unit from do discard doSeq`.
(This is effectively a synonym for `run_elab`.)
(This is effectively a synonym for `run_elab` since `MetaM` lifts to `TermElabM`.)
-/
syntax (name := runMeta) "run_meta " doSeq : command
@@ -675,6 +672,13 @@ Message ordering:
For example, `#guard_msgs (error, drop all) in cmd` means to check warnings and drop
everything else.
The command elaborator has special support for `#guard_msgs` for linting.
The `#guard_msgs` itself wants to capture linter warnings,
so it elaborates the command it is attached to as if it were a top-level command.
However, the command elaborator runs linters for *all* top-level commands,
which would include `#guard_msgs` itself, and would cause duplicate and/or uncaptured linter warnings.
The top-level command elaborator only runs the linters if `#guard_msgs` is not present.
-/
syntax (name := guardMsgsCmd)
(docComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command

View File

@@ -223,38 +223,6 @@ end Lean
| `($_ $array $index) => `($array[$index]?)
| _ => throw ()
@[app_unexpander Name.mkStr1] def unexpandMkStr1 : Lean.PrettyPrinter.Unexpander
| `($(_) $a:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr2] def unexpandMkStr2 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr3] def unexpandMkStr3 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr4] def unexpandMkStr4 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str $a4:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr5] def unexpandMkStr5 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr6] def unexpandMkStr6 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr7] def unexpandMkStr7 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str $a7:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString ++ "." ++ a7.getString)]
| _ => throw ()
@[app_unexpander Name.mkStr8] def unexpandMkStr8 : Lean.PrettyPrinter.Unexpander
| `($(_) $a1:str $a2:str $a3:str $a4:str $a5:str $a6:str $a7:str $a8:str) => return mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit ("`" ++ a1.getString ++ "." ++ a2.getString ++ "." ++ a3.getString ++ "." ++ a4.getString ++ "." ++ a5.getString ++ "." ++ a6.getString ++ "." ++ a7.getString ++ "." ++ a8.getString)]
| _ => throw ()
@[app_unexpander Array.empty] def unexpandArrayEmpty : Lean.PrettyPrinter.Unexpander
| _ => `(#[])

View File

@@ -2716,28 +2716,6 @@ def Array.extract (as : Array α) (start stop : Nat) : Array α :=
let sz' := Nat.sub (min stop as.size) start
loop sz' start (mkEmpty sz')
/--
Auxiliary definition for `List.toArray`.
`List.toArrayAux as r = r ++ as.toArray`
-/
@[inline_if_reduce]
def List.toArrayAux : List α Array α Array α
| nil, r => r
| cons a as, r => toArrayAux as (r.push a)
/-- A non-tail-recursive version of `List.length`, used for `List.toArray`. -/
@[inline_if_reduce]
def List.redLength : List α Nat
| nil => 0
| cons _ as => as.redLength.succ
/-- Convert a `List α` into an `Array α`. This is O(n) in the length of the list. -/
-- This function is exported to C, where it is called by `Array.mk`
-- (the constructor) to implement this functionality.
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
def List.toArrayImpl (as : List α) : Array α :=
as.toArrayAux (Array.mkEmpty as.redLength)
/-- The typeclass which supplies the `>>=` "bind" function. See `Monad`. -/
class Bind (m : Type u Type v) where
/-- If `x : m α` and `f : α → m β`, then `x >>= f : m β` represents the
@@ -2891,6 +2869,32 @@ instance (m n o) [MonadLift n o] [MonadLiftT m n] : MonadLiftT m o where
instance (m) : MonadLiftT m m where
monadLift x := x
/--
Typeclass used for adapting monads. This is similar to `MonadLift`, but instances are allowed to
make use of default state for the purpose of synthesizing such an instance, if necessary.
Every `MonadLift` instance gives a `MonadEval` instance.
The purpose of this class is for the `#eval` command,
which looks for a `MonadEval m CommandElabM` or `MonadEval m IO` instance.
-/
class MonadEval (m : semiOutParam (Type u Type v)) (n : Type u Type w) where
/-- Evaluates a value from monad `m` into monad `n`. -/
monadEval : {α : Type u} m α n α
instance [MonadLift m n] : MonadEval m n where
monadEval := MonadLift.monadLift
/-- The transitive closure of `MonadEval`. -/
class MonadEvalT (m : Type u Type v) (n : Type u Type w) where
/-- Evaluates a value from monad `m` into monad `n`. -/
monadEval : {α : Type u} m α n α
instance (m n o) [MonadEval n o] [MonadEvalT m n] : MonadEvalT m o where
monadEval x := MonadEval.monadEval (m := n) (MonadEvalT.monadEval x)
instance (m) : MonadEvalT m m where
monadEval x := x
/--
A functor in the category of monads. Can be used to lift monad-transforming functions.
Based on [`MFunctor`] from the `pipes` Haskell package, but not restricted to

View File

@@ -928,41 +928,6 @@ def withIsolatedStreams [Monad m] [MonadFinally m] [MonadLiftT BaseIO m] (x : m
end FS
end IO
universe u
namespace Lean
/-- Typeclass used for presenting the output of an `#eval` command. -/
class Eval (α : Type u) where
-- We default `hideUnit` to `true`, but set it to `false` in the direct call from `#eval`
-- so that `()` output is hidden in chained instances such as for some `IO Unit`.
-- We take `Unit → α` instead of `α` because α` may contain effectful debugging primitives (e.g., `dbg_trace`)
eval : (Unit α) (hideUnit : Bool := true) IO Unit
instance instEval [ToString α] : Eval α where
eval a _ := IO.println (toString (a ()))
instance [Repr α] : Eval α where
eval a _ := IO.println (repr (a ()))
instance : Eval Unit where
eval u hideUnit := if hideUnit then pure () else IO.println (repr (u ()))
instance [Eval α] : Eval (IO α) where
eval x _ := do
let a x ()
Eval.eval fun _ => a
instance [Eval α] : Eval (BaseIO α) where
eval x _ := do
let a x ()
Eval.eval fun _ => a
def runEval [Eval α] (a : Unit α) : IO (String × Except IO.Error Unit) :=
IO.FS.withIsolatedStreams (Eval.eval a false |>.toBaseIO)
end Lean
syntax "println! " (interpolatedStr(term) <|> term) : term
macro_rules

View File

@@ -375,12 +375,12 @@ The same as `rfl`, but without trying `eq_refl` at the end.
-/
syntax (name := applyRfl) "apply_rfl" : tactic
-- We try `apply_rfl` first, beause it produces a nice error message
-- We try `apply_rfl` first, because it produces a nice error message
macro_rules | `(tactic| rfl) => `(tactic| apply_rfl)
-- But, mostly for backward compatibility, we try `eq_refl` too (reduces more aggressively)
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
-- Als for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
-- Also for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
/--
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
@@ -399,19 +399,6 @@ example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by ac_rfl
-/
syntax (name := acRfl) "ac_rfl" : tactic
/--
`ac_nf` normalizes equalities up to application of an associative and commutative operator.
```
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by
ac_nf
-- goal: a + (b + (c + d)) = a + (b + (c + d))
```
-/
syntax (name := acNf) "ac_nf" : tactic
/--
The `sorry` tactic closes the goal using `sorryAx`. This is intended for stubbing out incomplete
parts of a proof while still having a syntactically correct proof skeleton. Lean will give
@@ -1172,6 +1159,9 @@ Currently the preprocessor is implemented as `try simp only [bv_toNat] at *`.
-/
macro "bv_omega" : tactic => `(tactic| (try simp only [bv_toNat] at *) <;> omega)
/-- Implementation of `ac_nf` (the full `ac_nf` calls `trivial` afterwards). -/
syntax (name := acNf0) "ac_nf0" (location)? : tactic
/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/
syntax (name := normCast0) "norm_cast0" (location)? : tactic
@@ -1222,6 +1212,24 @@ See also `push_cast`, which moves casts inwards rather than lifting them outward
macro "norm_cast" loc:(location)? : tactic =>
`(tactic| norm_cast0 $[$loc]? <;> try trivial)
/--
`ac_nf` normalizes equalities up to application of an associative and commutative operator.
- `ac_nf` normalizes all hypotheses and the goal target of the goal.
- `ac_nf at l` normalizes at location(s) `l`, where `l` is either `*` or a
list of hypotheses in the local context. In the latter case, a turnstile `⊢` or `|-`
can also be used, to signify the target of the goal.
```
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by
ac_nf
-- goal: a + (b + (c + d)) = a + (b + (c + d))
```
-/
macro "ac_nf" loc:(location)? : tactic =>
`(tactic| ac_nf0 $[$loc]? <;> try trivial)
/--
`push_cast` rewrites the goal to move certain coercions (*casts*) inward, toward the leaf nodes.
This uses `norm_cast` lemmas in the forward direction.

View File

@@ -20,7 +20,6 @@ import Lean.MetavarContext
import Lean.AuxRecursor
import Lean.Meta
import Lean.Util
import Lean.Eval
import Lean.Structure
import Lean.PrettyPrinter
import Lean.CoreM
@@ -38,3 +37,4 @@ import Lean.Linter
import Lean.SubExpr
import Lean.LabelAttribute
import Lean.AddDecl
import Lean.Replay

View File

@@ -7,7 +7,6 @@ prelude
import Lean.Util.RecDepth
import Lean.Util.Trace
import Lean.Log
import Lean.Eval
import Lean.ResolveName
import Lean.Elab.InfoTree.Types
import Lean.MonadEnv
@@ -277,12 +276,6 @@ def mkFreshUserName (n : Name) : CoreM Name :=
| Except.error (Exception.internal id _) => throw <| IO.userError <| "internal exception #" ++ toString id.idx
| Except.ok a => return a
instance [MetaEval α] : MetaEval (CoreM α) where
eval env opts x _ := do
let x : CoreM α := do try x finally printTraces
let (a, s) (withConsistentCtx x).toIO { fileName := "<CoreM>", fileMap := default, options := opts } { env := env }
MetaEval.eval s.env opts a (hideUnit := true)
-- withIncRecDepth for a monad `m` such that `[MonadControlT CoreM n]`
protected def withIncRecDepth [Monad m] [MonadControlT CoreM m] (x : m α) : m α :=
controlAt CoreM fun runInBase => withIncRecDepth (runInBase x)
@@ -309,7 +302,7 @@ register_builtin_option debug.moduleNameAtTimeout : Bool := {
def throwMaxHeartbeat (moduleName : Name) (optionName : Name) (max : Nat) : CoreM Unit := do
let includeModuleName := debug.moduleNameAtTimeout.get ( getOptions)
let atModuleName := if includeModuleName then s!" at `{moduleName}`" else ""
throw <| Exception.error ( getRef) m!"\
throw <| Exception.error ( getRef) <| .tagged `runtime.maxHeartbeats m!"\
(deterministic) timeout{atModuleName}, maximum number of heartbeats ({max/1000}) has been reached\n\
Use `set_option {optionName} <num>` to set the limit.\
{useDiagnosticMsg}"
@@ -395,10 +388,7 @@ export Core (CoreM mkFreshUserName checkSystem withCurrHeartbeats)
This function is a bit hackish. The heartbeat exception should probably be an internal exception.
We used a similar hack at `Exception.isMaxRecDepth` -/
def Exception.isMaxHeartbeat (ex : Exception) : Bool :=
match ex with
| Exception.error _ (MessageData.ofFormatWithInfos Std.Format.text msg, _) =>
"(deterministic) timeout".isPrefixOf msg
| _ => false
ex matches Exception.error _ (.tagged `runtime.maxHeartbeats _)
/-- Creates the expression `d → b` -/
def mkArrow (d b : Expr) : CoreM Expr :=

View File

@@ -42,8 +42,9 @@ builtin_initialize declRangeExt : MapDeclarationExtension DeclarationRanges ←
def addBuiltinDeclarationRanges (declName : Name) (declRanges : DeclarationRanges) : IO Unit :=
builtinDeclRanges.modify (·.insert declName declRanges)
def addDeclarationRanges [MonadEnv m] (declName : Name) (declRanges : DeclarationRanges) : m Unit :=
modifyEnv fun env => declRangeExt.insert env declName declRanges
def addDeclarationRanges [Monad m] [MonadEnv m] (declName : Name) (declRanges : DeclarationRanges) : m Unit := do
unless declRangeExt.contains ( getEnv) declName do
modifyEnv fun env => declRangeExt.insert env declName declRanges
def findDeclarationRangesCore? [Monad m] [MonadEnv m] (declName : Name) : m (Option DeclarationRanges) :=
return declRangeExt.find? ( getEnv) declName

View File

@@ -16,7 +16,7 @@ import Init.Data.String.Extra
namespace Lean
private builtin_initialize builtinDocStrings : IO.Ref (NameMap String) IO.mkRef {}
private builtin_initialize docStringExt : MapDeclarationExtension String mkMapDeclarationExtension
builtin_initialize docStringExt : MapDeclarationExtension String mkMapDeclarationExtension
def addBuiltinDocString (declName : Name) (docString : String) : IO Unit :=
builtinDocStrings.modify (·.insert declName docString.removeLeadingSpaces)

View File

@@ -42,6 +42,7 @@ import Lean.Elab.Notation
import Lean.Elab.Mixfix
import Lean.Elab.MacroRules
import Lean.Elab.BuiltinCommand
import Lean.Elab.BuiltinEvalCommand
import Lean.Elab.RecAppSyntax
import Lean.Elab.Eval
import Lean.Elab.Calc

View File

@@ -528,7 +528,7 @@ mutual
main
/--
Create a fresh metavariable for the implicit argument, add it to `f`, and thn execute the main loop.
Create a fresh metavariable for the implicit argument, add it to `f`, and then execute the main loop.
-/
private partial def addImplicitArg (argName : Name) : M Expr := do
let argType getArgExpectedType
@@ -777,7 +777,7 @@ def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
forallTelescopeReducing elimType fun xs type => do
let motive := type.getAppFn
let motiveArgs := type.getAppArgs
unless motive.isFVar do
unless motive.isFVar && motiveArgs.size > 0 do
throwError "unexpected eliminator resulting type{indentExpr type}"
let motiveType inferType motive
forallTelescopeReducing motiveType fun motiveParams motiveResultType => do
@@ -1394,8 +1394,6 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
private def elabAppLVals (f : Expr) (lvals : List LVal) (namedArgs : Array NamedArg) (args : Array Arg)
(expectedType? : Option Expr) (explicit ellipsis : Bool) : TermElabM Expr := do
if !lvals.isEmpty && explicit then
throwError "invalid use of field notation with `@` modifier"
elabAppLValsAux namedArgs args expectedType? explicit ellipsis f lvals
def elabExplicitUnivs (lvls : Array Syntax) : TermElabM (List Level) := do
@@ -1494,19 +1492,21 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
withReader (fun ctx => { ctx with errToSorry := false }) do
f.getArgs.foldlM (init := acc) fun acc f => elabAppFn f lvals namedArgs args expectedType? explicit ellipsis true acc
else
let elabFieldName (e field : Syntax) := do
let elabFieldName (e field : Syntax) (explicit : Bool) := do
let newLVals := field.identComponents.map fun comp =>
-- We use `none` in `suffix?` since `field` can't be part of a composite name
LVal.fieldName comp comp.getId.getString! none f
elabAppFn e (newLVals ++ lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
let elabFieldIdx (e idxStx : Syntax) := do
let elabFieldIdx (e idxStx : Syntax) (explicit : Bool) := do
let some idx := idxStx.isFieldIdx? | throwError "invalid field index"
elabAppFn e (LVal.fieldIdx idxStx idx :: lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
match f with
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx
| `($(e).$field:ident) => elabFieldName e field
| `($e |>.$field:ident) => elabFieldName e field
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx explicit
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx explicit
| `($(e).$field:ident) => elabFieldName e field explicit
| `($e |>.$field:ident) => elabFieldName e field explicit
| `(@$(e).$idx:fieldIdx) => elabFieldIdx e idx (explicit := true)
| `(@$(e).$field:ident) => elabFieldName e field (explicit := true)
| `($_:ident@$_:term) =>
throwError "unexpected occurrence of named pattern"
| `($id:ident) => do
@@ -1663,8 +1663,10 @@ private def elabAtom : TermElab := fun stx expectedType? => do
@[builtin_term_elab explicit] def elabExplicit : TermElab := fun stx expectedType? =>
match stx with
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
| `(@$_:ident.{$_us,*}) => elabAtom stx expectedType?
| `(@$(_).$_:fieldIdx) => elabAtom stx expectedType?
| `(@$(_).$_:ident) => elabAtom stx expectedType?
| `(@($t)) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
| `(@$t) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
| _ => throwUnsupportedSyntax

View File

@@ -311,167 +311,6 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
failIfSucceeds <| elabCheckCore (ignoreStuckTC := false) ( `(#check $term))
| _ => throwUnsupportedSyntax
private def mkEvalInstCore (evalClassName : Name) (e : Expr) : MetaM Expr := do
let α inferType e
let u getDecLevel α
let inst := mkApp (Lean.mkConst evalClassName [u]) α
try
synthInstance inst
catch _ =>
-- Put `α` in WHNF and try again
try
let α whnf α
synthInstance (mkApp (Lean.mkConst evalClassName [u]) α)
catch _ =>
-- Fully reduce `α` and try again
try
let α reduce (skipTypes := false) α
synthInstance (mkApp (Lean.mkConst evalClassName [u]) α)
catch _ =>
throwError "expression{indentExpr e}\nhas type{indentExpr α}\nbut instance{indentExpr inst}\nfailed to be synthesized, this instance instructs Lean on how to display the resulting value, recall that any type implementing the `Repr` class also implements the `{evalClassName}` class"
private def mkRunMetaEval (e : Expr) : MetaM Expr :=
withLocalDeclD `env (mkConst ``Lean.Environment) fun env =>
withLocalDeclD `opts (mkConst ``Lean.Options) fun opts => do
let α inferType e
let u getDecLevel α
let instVal mkEvalInstCore ``Lean.MetaEval e
let e := mkAppN (mkConst ``Lean.runMetaEval [u]) #[α, instVal, env, opts, e]
instantiateMVars ( mkLambdaFVars #[env, opts] e)
private def mkRunEval (e : Expr) : MetaM Expr := do
let α inferType e
let u getDecLevel α
let instVal mkEvalInstCore ``Lean.Eval e
instantiateMVars (mkAppN (mkConst ``Lean.runEval [u]) #[α, instVal, mkSimpleThunk e])
unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax): CommandElabM Unit := do
let declName := `_eval
let addAndCompile (value : Expr) : TermElabM Unit := do
let value Term.levelMVarToParam ( instantiateMVars value)
let type inferType value
let us := collectLevelParams {} value |>.params
let value instantiateMVars value
let decl := Declaration.defnDecl {
name := declName
levelParams := us.toList
type := type
value := value
hints := ReducibilityHints.opaque
safety := DefinitionSafety.unsafe
}
Term.ensureNoUnassignedMVars decl
addAndCompile decl
-- Check for sorry axioms
let checkSorry (declName : Name) : MetaM Unit := do
unless bang do
let axioms collectAxioms declName
if axioms.contains ``sorryAx then
throwError ("cannot evaluate expression that depends on the `sorry` axiom.\nUse `#eval!` to " ++
"evaluate nevertheless (which may cause lean to crash).")
-- Elaborate `term`
let elabEvalTerm : TermElabM Expr := do
let e Term.elabTerm term none
Term.synthesizeSyntheticMVarsNoPostponing
if ( Term.logUnassignedUsingErrorInfos ( getMVars e)) then throwAbortTerm
if ( isProp e) then
mkDecide e
else
return e
-- Evaluate using term using `MetaEval` class.
let elabMetaEval : CommandElabM Unit := do
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
-- we don't pollute the environment with auxliary declarations.
-- We have special support for `CommandElabM` to ensure `#eval` can be used to execute commands
-- that modify `CommandElabM` state not just the `Environment`.
let act : Sum (CommandElabM Unit) (Environment Options IO (String × Except IO.Error Environment))
runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
let e elabEvalTerm
let eType instantiateMVars ( inferType e)
if eType.isAppOfArity ``CommandElabM 1 then
let mut stx Term.exprToSyntax e
unless ( isDefEq eType.appArg! (mkConst ``Unit)) do
stx `($stx >>= fun v => IO.println (repr v))
let act Lean.Elab.Term.evalTerm (CommandElabM Unit) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) stx
pure <| Sum.inl act
else
let e mkRunMetaEval e
addAndCompile e
checkSorry declName
let act evalConst (Environment Options IO (String × Except IO.Error Environment)) declName
pure <| Sum.inr act
match act with
| .inl act => act
| .inr act =>
let (out, res) act ( getEnv) ( getOptions)
logInfoAt tk out
match res with
| Except.error e => throwError e.toString
| Except.ok env => setEnv env; pure ()
-- Evaluate using term using `Eval` class.
let elabEval : CommandElabM Unit := runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
-- fall back to non-meta eval if MetaEval hasn't been defined yet
-- modify e to `runEval e`
let e mkRunEval ( elabEvalTerm)
addAndCompile e
checkSorry declName
let act evalConst (IO (String × Except IO.Error Unit)) declName
let (out, res) liftM (m := IO) act
logInfoAt tk out
match res with
| Except.error e => throwError e.toString
| Except.ok _ => pure ()
if ( getEnv).contains ``Lean.MetaEval then do
elabMetaEval
else
elabEval
@[implemented_by elabEvalCoreUnsafe]
opaque elabEvalCore (bang : Bool) (tk term : Syntax): CommandElabM Unit
@[builtin_command_elab «eval»]
def elabEval : CommandElab
| `(#eval%$tk $term) => elabEvalCore false tk term
| _ => throwUnsupportedSyntax
@[builtin_command_elab evalBang]
def elabEvalBang : CommandElab
| `(Parser.Command.evalBang|#eval!%$tk $term) => elabEvalCore true tk term
| _ => throwUnsupportedSyntax
private def checkImportsForRunCmds : CommandElabM Unit := do
unless ( getEnv).contains ``CommandElabM do
throwError "to use this command, include `import Lean.Elab.Command`"
@[builtin_command_elab runCmd]
def elabRunCmd : CommandElab
| `(run_cmd $elems:doSeq) => do
checkImportsForRunCmds
( liftTermElabM <| Term.withDeclName `_run_cmd <|
unsafe Term.evalTerm (CommandElabM Unit)
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
( `(discard do $elems)))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runElab]
def elabRunElab : CommandElab
| `(run_elab $elems:doSeq) => do
checkImportsForRunCmds
( liftTermElabM <| Term.withDeclName `_run_elab <|
unsafe Term.evalTerm (CommandElabM Unit)
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
( `(Command.liftTermElabM <| discard do $elems)))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runMeta]
def elabRunMeta : CommandElab := fun stx =>
match stx with
| `(run_meta $elems:doSeq) => do
checkImportsForRunCmds
let stxNew `(command| run_elab (show Lean.Meta.MetaM Unit from do $elems))
withMacroExpansion stx stxNew do elabCommand stxNew
| _ => throwUnsupportedSyntax
@[builtin_command_elab «synth»] def elabSynth : CommandElab := fun stx => do
let term := stx[1]
withoutModifyingEnv <| runTermElabM fun _ => Term.withDeclName `_synth_cmd do

View File

@@ -0,0 +1,277 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
prelude
import Lean.Util.CollectAxioms
import Lean.Elab.Deriving.Basic
import Lean.Elab.MutualDef
/-!
# Implementation of `#eval` command
-/
namespace Lean.Elab.Command
open Meta
register_builtin_option eval.pp : Bool := {
defValue := true
descr := "('#eval' command) enables using 'ToExpr' instances to pretty print the result, \
otherwise uses 'Repr' or 'ToString' instances"
}
register_builtin_option eval.type : Bool := {
defValue := false -- TODO: set to 'true'
descr := "('#eval' command) enables pretty printing the type of the result"
}
register_builtin_option eval.derive.repr : Bool := {
defValue := true
descr := "('#eval' command) enables auto-deriving 'Repr' instances as a fallback"
}
builtin_initialize
registerTraceClass `Elab.eval
/--
Elaborates the term, ensuring the result has no expression metavariables.
If there would be unsolved-for metavariables, tries hinting that the resulting type
is a monadic value with the `CommandElabM`, `TermElabM`, or `IO` monads.
Throws errors if the term is a proof or a type, but lifts props to `Bool` using `mkDecide`.
-/
private def elabTermForEval (term : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
let ty expectedType?.getDM mkFreshTypeMVar
let e Term.elabTermEnsuringType term ty
synthesizeWithHinting ty
let e instantiateMVars e
if ( Term.logUnassignedUsingErrorInfos ( getMVars e)) then throwAbortTerm
if isProof e then
throwError m!"cannot evaluate, proofs are not computationally relevant"
let e if ( isProp e) then mkDecide e else pure e
if isType e then
throwError m!"cannot evaluate, types are not computationally relevant"
trace[Elab.eval] "elaborated term:{indentExpr e}"
return e
where
/-- Try different strategies to make `Term.synthesizeSyntheticMVarsNoPostponing` succeed. -/
synthesizeWithHinting (ty : Expr) : TermElabM Unit := do
Term.synthesizeSyntheticMVarsUsingDefault
let s saveState
try
Term.synthesizeSyntheticMVarsNoPostponing
catch ex =>
let exS saveState
-- Try hinting that `ty` is a monad application.
for m in #[``CommandElabM, ``TermElabM, ``IO] do
s.restore true
try
if isDefEq ty ( mkFreshMonadApp m) then
Term.synthesizeSyntheticMVarsNoPostponing
return
catch _ => pure ()
-- None of the hints worked, so throw the original error.
exS.restore true
throw ex
mkFreshMonadApp (n : Name) : MetaM Expr := do
let m mkConstWithFreshMVarLevels n
let (args, _, _) forallMetaBoundedTelescope ( inferType m) 1
return mkAppN m args
private def addAndCompileExprForEval (declName : Name) (value : Expr) (allowSorry := false) : TermElabM Unit := do
-- Use the `elabMutualDef` machinery to be able to support `let rec`.
-- Hack: since we are using the `TermElabM` version, we can insert the `value` as a metavariable via `exprToSyntax`.
-- An alternative design would be to make `elabTermForEval` into a term elaborator and elaborate the command all at once
-- with `unsafe def _eval := term_for_eval% $t`, which we did try, but unwanted error messages
-- such as "failed to infer definition type" can surface.
let defView := mkDefViewOfDef { isUnsafe := true }
( `(Parser.Command.definition|
def $(mkIdent <| `_root_ ++ declName) := $( Term.exprToSyntax value)))
Term.elabMutualDef #[] { header := "" } #[defView]
unless allowSorry do
let axioms collectAxioms declName
if axioms.contains ``sorryAx then
throwError "\
aborting evaluation since the expression depends on the 'sorry' axiom, \
which can lead to runtime instability and crashes.\n\n\
To attempt to evaluate anyway despite the risks, use the '#eval!' command."
/--
Try to make a `@projFn ty inst e` application, even if it takes unfolding the type `ty` of `e` to synthesize the instance `inst`.
-/
private partial def mkDeltaInstProj (inst projFn : Name) (e : Expr) (ty? : Option Expr := none) (tryReduce : Bool := true) : MetaM Expr := do
let ty ty?.getDM (inferType e)
if let .some inst trySynthInstance ( mkAppM inst #[ty]) then
mkAppOptM projFn #[ty, inst, e]
else
let ty whnfCore ty
let some ty unfoldDefinition? ty
| guard tryReduce
-- Reducing the type is a strategy `#eval` used before the refactor of #5627.
-- The test lean/run/hlistOverload.lean depends on it, so we preserve the behavior.
let ty reduce (skipTypes := false) ty
mkDeltaInstProj inst projFn e ty (tryReduce := false)
mkDeltaInstProj inst projFn e ty tryReduce
/-- Try to make a `toString e` application, even if it takes unfolding the type of `e` to find a `ToString` instance. -/
private def mkToString (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
mkDeltaInstProj ``ToString ``toString e ty?
/-- Try to make a `repr e` application, even if it takes unfolding the type of `e` to find a `Repr` instance. -/
private def mkRepr (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
mkDeltaInstProj ``Repr ``repr e ty?
/-- Try to make a `toExpr e` application, even if it takes unfolding the type of `e` to find a `ToExpr` instance. -/
private def mkToExpr (e : Expr) (ty? : Option Expr := none) : MetaM Expr := do
mkDeltaInstProj ``ToExpr ``toExpr e ty?
/--
Returns a representation of `e` using `Format`, or else fails.
If the `eval.derive.repr` option is true, then tries automatically deriving a `Repr` instance first.
Currently auto-derivation does not attempt to derive recursively.
-/
private def mkFormat (e : Expr) : MetaM Expr := do
mkRepr e <|> (do mkAppM ``Std.Format.text #[ mkToString e])
<|> do
if eval.derive.repr.get ( getOptions) then
if let .const name _ := ( whnf ( inferType e)).getAppFn then
try
trace[Elab.eval] "Attempting to derive a 'Repr' instance for '{MessageData.ofConstName name}'"
liftCommandElabM do applyDerivingHandlers ``Repr #[name] none
resetSynthInstanceCache
return mkRepr e
catch ex =>
trace[Elab.eval] "Failed to use derived 'Repr' instance. Exception: {ex.toMessageData}"
throwError m!"could not synthesize a 'Repr' or 'ToString' instance for type{indentExpr (← inferType e)}"
/--
Returns a representation of `e` using `MessageData`, or else fails.
Tries `mkFormat` if a `ToExpr` instance can't be synthesized.
-/
private def mkMessageData (e : Expr) : MetaM Expr := do
(do guard <| eval.pp.get ( getOptions); mkAppM ``MessageData.ofExpr #[ mkToExpr e])
<|> (return mkApp (mkConst ``MessageData.ofFormat) ( mkFormat e))
<|> do throwError m!"could not synthesize a 'ToExpr', 'Repr', or 'ToString' instance for type{indentExpr (← inferType e)}"
private structure EvalAction where
eval : CommandElabM MessageData
/-- Whether to print the result of evaluation.
If `some`, the expression is what type to use for the type ascription when `pp.type` is true. -/
printVal : Option Expr
unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax) (expectedType? : Option Expr) : CommandElabM Unit := withRef tk do
let declName := `_eval
-- `t` is either `MessageData` or `Format`, and `mkT` is for synthesizing an expression that yields a `t`.
-- The `toMessageData` function adapts `t` to `MessageData`.
let mkAct {t : Type} [Inhabited t] (toMessageData : t MessageData) (mkT : Expr MetaM Expr) (e : Expr) : TermElabM EvalAction := do
-- Create a monadic action given the name of the monad `mc`, the monad `m` itself,
-- and an expression `e` to evaluate in this monad.
-- A trick here is that `mkMAct?` makes use of `MonadEval` instances are currently available in this stage,
-- and we do not need them to be available in the target environment.
let mkMAct? (mc : Name) (m : Type Type) [Monad m] [MonadEvalT m CommandElabM] (e : Expr) : TermElabM (Option EvalAction) := do
let some e observing? (mkAppOptM ``MonadEvalT.monadEval #[none, mkConst mc, none, none, e])
| return none
let eType := e.appFn!.appArg!
if isDefEq eType (mkConst ``Unit) then
addAndCompileExprForEval declName e (allowSorry := bang)
let mf : m Unit evalConst (m Unit) declName
return some { eval := do MonadEvalT.monadEval mf; pure "", printVal := none }
else
let rf withLocalDeclD `x eType fun x => do mkLambdaFVars #[x] ( mkT x)
let r mkAppM ``Functor.map #[rf, e]
addAndCompileExprForEval declName r (allowSorry := bang)
let mf : m t evalConst (m t) declName
return some { eval := toMessageData <$> MonadEvalT.monadEval mf, printVal := some eType }
if let some act mkMAct? ``CommandElabM CommandElabM e
-- Fallbacks in case we are in the Lean package but don't have `CommandElabM` yet
<||> mkMAct? ``TermElabM TermElabM e <||> mkMAct? ``MetaM MetaM e <||> mkMAct? ``CoreM CoreM e
-- Fallback in case nothing is imported
<||> mkMAct? ``IO IO e then
return act
else
-- Otherwise, assume this is a pure value.
-- There is no need to adapt pure values to `CommandElabM`.
-- This enables `#eval` to work on pure values even when `CommandElabM` is not available.
let r try mkT e catch ex => do
-- Diagnose whether the value is monadic for a representable value, since it's better to mention `MonadEval` in that case.
try
let some (m, ty) isTypeApp? ( inferType e) | failure
guard <| ( isMonad? m).isSome
-- Verify that there is a way to form some representation:
discard <| withLocalDeclD `x ty fun x => mkT x
catch _ =>
throw ex
throwError m!"unable to synthesize '{MessageData.ofConstName ``MonadEval}' instance \
to adapt{indentExpr (← inferType e)}\n\
to '{MessageData.ofConstName ``IO}' or '{MessageData.ofConstName ``CommandElabM}'."
addAndCompileExprForEval declName r (allowSorry := bang)
-- `evalConst` may emit IO, but this is collected by `withIsolatedStreams` below.
let r toMessageData <$> evalConst t declName
return { eval := pure r, printVal := some ( inferType e) }
let (output, exOrRes) IO.FS.withIsolatedStreams do
try
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
-- we don't pollute the environment with auxiliary declarations.
let act : EvalAction liftTermElabM do Term.withDeclName declName do withoutModifyingEnv do
let e elabTermForEval term expectedType?
-- If there is an elaboration error, don't evaluate!
if e.hasSyntheticSorry then throwAbortTerm
-- We want `#eval` to work even in the core library, so if `ofFormat` isn't available,
-- we fall back on a `Format`-based approach.
if ( getEnv).contains ``Lean.MessageData.ofFormat then
mkAct id (mkMessageData ·) e
else
mkAct Lean.MessageData.ofFormat (mkFormat ·) e
let res act.eval
return Sum.inr (res, act.printVal)
catch ex =>
return Sum.inl ex
if !output.isEmpty then logInfoAt tk output
match exOrRes with
| .inl ex => logException ex
| .inr (_, none) => pure ()
| .inr (res, some type) =>
if eval.type.get ( getOptions) then
logInfo m!"{res} : {type}"
else
logInfo res
@[implemented_by elabEvalCoreUnsafe]
opaque elabEvalCore (bang : Bool) (tk term : Syntax) (expectedType? : Option Expr) : CommandElabM Unit
@[builtin_command_elab «eval»]
def elabEval : CommandElab
| `(#eval%$tk $term) => elabEvalCore false tk term none
| _ => throwUnsupportedSyntax
@[builtin_command_elab evalBang]
def elabEvalBang : CommandElab
| `(#eval!%$tk $term) => elabEvalCore true tk term none
| _ => throwUnsupportedSyntax
@[builtin_command_elab runCmd]
def elabRunCmd : CommandElab
| `(run_cmd%$tk $elems:doSeq) => do
unless ( getEnv).contains ``CommandElabM do
throwError "to use this command, include `import Lean.Elab.Command`"
elabEvalCore false tk ( `(discard do $elems)) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runElab]
def elabRunElab : CommandElab
| `(run_elab%$tk $elems:doSeq) => do
unless ( getEnv).contains ``TermElabM do
throwError "to use this command, include `import Lean.Elab.Term`"
elabEvalCore false tk ( `(discard do $elems)) (mkApp (mkConst ``TermElabM) (mkConst ``Unit))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runMeta]
def elabRunMeta : CommandElab := fun stx =>
match stx with
| `(run_meta%$tk $elems:doSeq) => do
unless ( getEnv).contains ``MetaM do
throwError "to use this command, include `import Lean.Meta.Basic`"
elabEvalCore false tk ( `(discard do $elems)) (mkApp (mkConst ``MetaM) (mkConst ``Unit))
| _ => throwUnsupportedSyntax
end Lean.Elab.Command

View File

@@ -520,8 +520,12 @@ def elabCommandTopLevel (stx : Syntax) : CommandElabM Unit := withRef stx do pro
-- recovery more coarse. In particular, If `c` in `set_option ... in $c` fails, the remaining
-- `end` command of the `in` macro would be skipped and the option would be leaked to the outside!
elabCommand stx
withLogging do
runLinters stx
-- Run the linters, unless `#guard_msgs` is present, which is special and runs `elabCommandTopLevel` itself,
-- so it is a "super-top-level" command. This is the only command that does this, so we just special case it here
-- rather than engineer a general solution.
unless (stx.find? (·.isOfKind ``Lean.guardMsgsCmd)).isSome do
withLogging do
runLinters stx
finally
-- note the order: first process current messages & info trees, then add back old messages & trees,
-- then convert new traces to messages
@@ -615,6 +619,9 @@ def liftTermElabM (x : TermElabM α) : CommandElabM α := do
let ((ea, _), _) runCore x
MonadExcept.ofExcept ea
instance : MonadEval TermElabM CommandElabM where
monadEval := liftTermElabM
/--
Execute the monadic action `elabFn xs` as a `CommandElabM` monadic action, where `xs` are free variables
corresponding to all active scoped variables declared using the `variable` command.
@@ -723,6 +730,12 @@ Commands that modify the processing of subsequent commands,
such as `open` and `namespace` commands,
only have an effect for the remainder of the `CommandElabM` computation passed here,
and do not affect subsequent commands.
*Warning:* when using this from `MetaM` monads, the caches are *not* reset.
If the command defines new instances for example, you should use `Lean.Meta.resetSynthInstanceCache`
to reset the instance cache.
While the `modifyEnv` function for `MetaM` clears its caches entirely,
`liftCommandElabM` has no way to reset these caches.
-/
def liftCommandElabM (cmd : CommandElabM α) : CoreM α := do
let (a, commandState)

View File

@@ -136,8 +136,8 @@ def elabAxiom (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
Term.applyAttributesAt declName modifiers.attrs AttributeApplicationTime.afterCompilation
/-
leading_parser "inductive " >> declId >> optDeclSig >> optional ":=" >> many ctor
leading_parser atomic (group ("class " >> "inductive ")) >> declId >> optDeclSig >> optional ":=" >> many ctor >> optDeriving
leading_parser "inductive " >> declId >> optDeclSig >> optional ("where" <|> ":=") >> many ctor
leading_parser atomic (group ("class " >> "inductive ")) >> declId >> optDeclSig >> optional ("where" <|> ":=") >> many ctor >> optDeriving
-/
private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : CommandElabM InductiveView := do
checkValidInductiveModifier modifiers
@@ -167,6 +167,10 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : Comm
let computedFields (decl[5].getOptional?.map (·[1].getArgs) |>.getD #[]).mapM fun cf => withRef cf do
return { ref := cf, modifiers := cf[0], fieldId := cf[1].getId, type := cf[3], matchAlts := cf[4] }
let classes liftCoreM <| getOptDerivingClasses decl[6]
if decl[3][0].isToken ":=" then
-- https://github.com/leanprover/lean4/issues/5236
withRef decl[0] <| Linter.logLintIf Linter.linter.deprecated decl[3]
"'inductive ... :=' has been deprecated in favor of 'inductive ... where'."
return {
ref := decl
shortDeclName := name
@@ -382,19 +386,28 @@ def elabMutual : CommandElab := fun stx => do
for attrName in toErase do
Attribute.erase declName attrName
@[builtin_macro Lean.Parser.Command.«initialize»] def expandInitialize : Macro
@[builtin_command_elab Lean.Parser.Command.«initialize»] def elabInitialize : CommandElab
| stx@`($declModifiers:declModifiers $kw:initializeKeyword $[$id? : $type? ]? $doSeq) => do
let attrId := mkIdentFrom stx <| if kw.raw[0].isToken "initialize" then `init else `builtin_init
if let (some id, some type) := (id?, type?) then
let `(Parser.Command.declModifiersT| $[$doc?:docComment]? $[@[$attrs?,*]]? $(vis?)? $[unsafe%$unsafe?]?) := stx[0]
| Macro.throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
`($[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% ?$id do $doSeq
$[$doc?:docComment]? @[$attrId:ident initFn, $(attrs?.getD ),*] $(vis?)? opaque $id : $type)
| throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
let defStx `($[$doc?:docComment]? @[$attrId:ident initFn, $(attrs?.getD ),*] $(vis?)? opaque $id : $type)
let mut fullId := ( getCurrNamespace) ++ id.getId
if vis?.any (·.raw.isOfKind ``Parser.Command.private) then
fullId := mkPrivateName ( getEnv) fullId
-- We need to add `id`'s ranges *before* elaborating `initFn` (and then `id` itself) as
-- otherwise the info context created by `with_decl_name` will be incomplete and break the
-- call hierarchy
addDeclarationRanges fullId defStx
elabCommand ( `(
$[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% $(mkIdent fullId) do $doSeq
$defStx:command))
else
let `(Parser.Command.declModifiersT| $[$doc?:docComment]? ) := declModifiers
| Macro.throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
`($[$doc?:docComment]? @[$attrId:ident] def initFn : IO Unit := do $doSeq)
| _ => Macro.throwUnsupported
| throwErrorAt declModifiers "invalid initialization command, unexpected modifiers"
elabCommand ( `($[$doc?:docComment]? @[$attrId:ident] def initFn : IO Unit := do $doSeq))
| _ => throwUnsupportedSyntax
builtin_initialize
registerTraceClass `Elab.axiom

View File

@@ -140,6 +140,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
|>.trim |> removeTrailingWhitespaceMarker
let (whitespace, ordering, specFn) parseGuardMsgsSpec spec?
let initMsgs modifyGet fun st => (st.messages, { st with messages := {} })
-- The `#guard_msgs` command is special-cased in `elabCommandTopLevel` to ensure linters only run once.
elabCommandTopLevel cmd
let msgs := ( get).messages
let mut toCheck : MessageLog := .empty

View File

@@ -425,9 +425,9 @@ where
levelMVarToParam' (type : Expr) : TermElabM Expr := do
Term.levelMVarToParam type (except := fun mvarId => univToInfer? == some mvarId)
def mkResultUniverse (us : Array Level) (rOffset : Nat) : Level :=
def mkResultUniverse (us : Array Level) (rOffset : Nat) (preferProp : Bool) : Level :=
if us.isEmpty && rOffset == 0 then
levelOne
if preferProp then levelZero else levelOne
else
let r := Level.mkNaryMax us.toList
if rOffset == 0 && !r.isZero && !r.isNeverZero then
@@ -512,6 +512,31 @@ where
for ctorParam in ctorParams[numParams:] do
accLevelAtCtor ctor ctorParam r rOffset
/--
Decides whether the inductive type should be `Prop`-valued when the universe is not given
and when the universe inference algorithm `collectUniverses` determines
that the inductive type could naturally be `Prop`-valued.
Recall: the natural universe level is the mimimum universe level for all the types of all the constructor parameters.
Heuristic:
- We want `Prop` when each inductive type is a syntactic subsingleton.
That's to say, when each inductive type has at most one constructor.
Such types carry no data anyway.
- Exception: if no inductive type has any constructors, these are likely stubbed-out declarations,
so we prefer `Type` instead.
- Exception: if each constructor has no parameters, then these are likely partially-written enumerations,
so we prefer `Type` instead.
-/
private def isPropCandidate (numParams : Nat) (indTypes : List InductiveType) : MetaM Bool := do
unless indTypes.foldl (fun n indType => max n indType.ctors.length) 0 == 1 do
return false
for indType in indTypes do
for ctor in indType.ctors do
let cparams forallTelescopeReducing ctor.type fun ctorParams _ => pure (ctorParams.size - numParams)
unless cparams == 0 do
return true
return false
private def updateResultingUniverse (views : Array InductiveView) (numParams : Nat) (indTypes : List InductiveType) : TermElabM (List InductiveType) := do
let r getResultingUniverse indTypes
let rOffset : Nat := r.getOffset
@@ -520,7 +545,7 @@ private def updateResultingUniverse (views : Array InductiveView) (numParams : N
throwError "failed to compute resulting universe level of inductive datatype, provide universe explicitly: {r}"
let us collectUniverses views r rOffset numParams indTypes
trace[Elab.inductive] "updateResultingUniverse us: {us}, r: {r}, rOffset: {rOffset}"
let rNew := mkResultUniverse us rOffset
let rNew := mkResultUniverse us rOffset ( isPropCandidate numParams indTypes)
assignLevelMVar r.mvarId! rNew
indTypes.mapM fun indType => do
let type instantiateMVars indType.type

View File

@@ -83,7 +83,7 @@ inductive CompletionInfo where
| namespaceId (stx : Syntax)
| option (stx : Syntax)
| endSection (stx : Syntax) (scopeNames : List String)
| tactic (stx : Syntax) (goals : List MVarId)
| tactic (stx : Syntax)
-- TODO `import`
/-- Info for an option reference (e.g. in `set_option`). -/

View File

@@ -473,7 +473,10 @@ private def getFieldIdx (structName : Name) (fieldNames : Array Name) (fieldName
def mkProjStx? (s : Syntax) (structName : Name) (fieldName : Name) : TermElabM (Option Syntax) := do
if (findField? ( getEnv) structName fieldName).isNone then
return none
return some <| mkNode ``Parser.Term.proj #[s, mkAtomFrom s ".", mkIdentFrom s fieldName]
return some <|
mkNode ``Parser.Term.explicit
#[mkAtomFrom s "@",
mkNode ``Parser.Term.proj #[s, mkAtomFrom s ".", mkIdentFrom s fieldName]]
def findField? (fields : Fields) (fieldName : Name) : Option (Field Struct) :=
fields.find? fun field =>
@@ -685,7 +688,7 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
let type := (d.getArg! 0).consumeTypeAnnotations
let mvar mkTacticMVar type stx (.fieldAutoParam fieldName s.structName)
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
-- (See the aformentioned `processExplicitArg` for a comment about this.)
-- (See the aforementioned `processExplicitArg` for a comment about this.)
addTermInfo' stx mvar
cont mvar field
| _ =>

View File

@@ -137,7 +137,12 @@ def structSimpleBinder := leading_parser atomic (declModifiers true >> ident)
def structFields := leading_parser many (structExplicitBinder <|> structImplicitBinder <|> structInstBinder)
```
-/
private def expandFields (structStx : Syntax) (structModifiers : Modifiers) (structDeclName : Name) : TermElabM (Array StructFieldView) :=
private def expandFields (structStx : Syntax) (structModifiers : Modifiers) (structDeclName : Name) : TermElabM (Array StructFieldView) := do
if structStx[5][0].isToken ":=" then
-- https://github.com/leanprover/lean4/issues/5236
let cmd := if structStx[0].getKind == ``Parser.Command.classTk then "class" else "structure"
withRef structStx[0] <| Linter.logLintIf Linter.linter.deprecated structStx[5][0]
s!"{cmd} ... :=' has been deprecated in favor of '{cmd} ... where'."
let fieldBinders := if structStx[5].isNone then #[] else structStx[5][2][0].getArgs
fieldBinders.foldlM (init := #[]) fun (views : Array StructFieldView) fieldBinder => withRef fieldBinder do
let mut fieldBinder := fieldBinder
@@ -632,6 +637,19 @@ where
msg := msg ++ "\nrecall that Lean only infers the resulting universe level automatically when there is a unique solution for the universe level constraints, consider explicitly providing the structure resulting universe level"
throwError msg
/--
Decides whether the structure should be `Prop`-valued when the universe is not given
and when the universe inference algorithm `collectUniversesFromFields` determines
that the inductive type could naturally be `Prop`-valued.
See `Lean.Elab.Command.isPropCandidate` for an explanation.
Specialized to structures, the heuristic is that we prefer a `Prop` instead of a `Type` structure
when it could be a syntactic subsingleton.
Exception: no-field structures are `Type` since they are likely stubbed-out declarations.
-/
private def isPropCandidate (fieldInfos : Array StructFieldInfo) : Bool :=
!fieldInfos.isEmpty
private def updateResultingUniverse (fieldInfos : Array StructFieldInfo) (type : Expr) : TermElabM Expr := do
let r getResultUniverse type
let rOffset : Nat := r.getOffset
@@ -639,7 +657,7 @@ private def updateResultingUniverse (fieldInfos : Array StructFieldInfo) (type :
match r with
| Level.mvar mvarId =>
let us collectUniversesFromFields r rOffset fieldInfos
let rNew := mkResultUniverse us rOffset
let rNew := mkResultUniverse us rOffset (isPropCandidate fieldInfos)
assignLevelMVar mvarId rNew
instantiateMVars type
| _ => throwError "failed to compute resulting universe level of structure, provide universe explicitly"
@@ -866,7 +884,8 @@ private def elabStructureView (view : StructView) : TermElabM Unit := do
addDefaults lctx defaultAuxDecls
/-
leading_parser (structureTk <|> classTk) >> declId >> many Term.bracketedBinder >> optional «extends» >> Term.optType >> " := " >> optional structCtor >> structFields >> optDeriving
leading_parser (structureTk <|> classTk) >> declId >> many Term.bracketedBinder >> optional «extends» >> Term.optType >>
optional (("where" <|> ":=") >> optional structCtor >> structFields) >> optDeriving
where
def «extends» := leading_parser " extends " >> sepBy1 termParser ", "

View File

@@ -52,6 +52,11 @@ register_builtin_option debug.bv.graphviz : Bool := {
descr := "Output the AIG of bv_decide as graphviz into a file called aig.gv in the working directory of the Lean process."
}
register_builtin_option bv.ac_nf : Bool := {
defValue := true
descr := "Canonicalize with respect to associativity and commutativitiy."
}
builtin_initialize bvNormalizeExt : Meta.SimpExtension
Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"

View File

@@ -41,7 +41,7 @@ def lratChecker (cfg : TacticContext) (bvExpr : BVLogicalExpr) : MetaM Expr := d
@[inherit_doc Lean.Parser.Tactic.bvCheck]
def bvCheck (g : MVarId) (cfg : TacticContext) : MetaM Unit := do
let unsatProver : UnsatProver := fun reflectionResult _ => do
let unsatProver : UnsatProver := fun _ reflectionResult _ => do
withTraceNode `sat (fun _ => return "Preparing LRAT reflection term") do
let proof lratChecker cfg reflectionResult.bvExpr
return .ok proof, ""
@@ -60,8 +60,8 @@ def evalBvCheck : Tactic := fun
| some g' => bvCheck g' cfg
| none =>
let bvNormalizeStx `(tactic| bv_normalize)
logWarning m!"This goal can be closed by only applying bv_normalize, no need to keep the LRAT proof around."
TryThis.addSuggestion tk bvNormalizeStx (origSpan? := getRef)
throwError m!"This goal can be closed by only applying bv_normalize, no need to keep the LRAT proof around."
| _ => throwUnsupportedSyntax
end Frontend.BVCheck

View File

@@ -83,6 +83,10 @@ structure ReflectionResult where
A counter example generated from the bitblaster.
-/
structure CounterExample where
/--
The goal in which to interpret this counter example.
-/
goal : MVarId
/--
The set of unused but potentially relevant hypotheses. Useful for diagnosing spurious counter
examples.
@@ -97,7 +101,7 @@ structure UnsatProver.Result where
proof : Expr
lratCert : LratCert
abbrev UnsatProver := ReflectionResult Std.HashMap Nat (Nat × Expr)
abbrev UnsatProver := MVarId ReflectionResult Std.HashMap Nat (Nat × Expr)
MetaM (Except CounterExample UnsatProver.Result)
/--
@@ -112,8 +116,9 @@ abbrev DiagnosisM : Type → Type := ReaderT CounterExample <| StateRefT Diagnos
namespace DiagnosisM
def run (x : DiagnosisM Unit) (counterExample : CounterExample) : MetaM Diagnosis := do
let (_, issues) ReaderT.run x counterExample |>.run {}
return issues
counterExample.goal.withContext do
let (_, issues) ReaderT.run x counterExample |>.run {}
return issues
def unusedHyps : DiagnosisM (Std.HashSet FVarId) := do
return ( read).unusedHypotheses
@@ -177,7 +182,7 @@ def explainCounterExampleQuality (counterExample : CounterExample) : MetaM Messa
err := err ++ m!"Consider the following assignment:\n"
return err
def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
def lratBitblaster (goal : MVarId) (cfg : TacticContext) (reflectionResult : ReflectionResult)
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
MetaM (Except CounterExample UnsatProver.Result) := do
let bvExpr := reflectionResult.bvExpr
@@ -206,11 +211,13 @@ def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
match res with
| .ok cert =>
trace[Meta.Tactic.sat] "SAT solver found a proof."
let proof cert.toReflectionProof cfg bvExpr ``verifyBVExpr ``unsat_of_verifyBVExpr_eq_true
return .ok proof, cert
| .error assignment =>
trace[Meta.Tactic.sat] "SAT solver found a counter example."
let equations := reconstructCounterExample map assignment aigSize atomsAssignment
return .error { unusedHypotheses := reflectionResult.unusedHypotheses, equations }
return .error { goal, unusedHypotheses := reflectionResult.unusedHypotheses, equations }
def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
@@ -248,7 +255,7 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
let atomsPairs := ( getThe State).atoms.toList.map (fun (expr, width, ident) => (ident, (width, expr)))
let atomsAssignment := Std.HashMap.ofList atomsPairs
match unsatProver reflectionResult atomsAssignment with
match unsatProver g reflectionResult atomsAssignment with
| .ok bvExprUnsat, cert =>
let proveFalse reflectionResult.proveFalse bvExprUnsat
g.assign proveFalse
@@ -256,9 +263,9 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
| .error counterExample => return .error counterExample
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample LratCert) := M.run do
let unsatProver : UnsatProver := fun reflectionResult atomsAssignment => do
let unsatProver : UnsatProver := fun g reflectionResult atomsAssignment => do
withTraceNode `bv (fun _ => return "Preparing LRAT reflection term") do
lratBitblaster cfg reflectionResult atomsAssignment
lratBitblaster g cfg reflectionResult atomsAssignment
closeWithBVReflection g unsatProver
/--
@@ -289,9 +296,11 @@ def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
match bvDecide' g cfg with
| .ok result => return result
| .error counterExample =>
let error explainCounterExampleQuality counterExample
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
throwError counterExample.equations.foldl (init := error) folder
counterExample.goal.withContext do
let error explainCounterExampleQuality counterExample
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
let errorMessage := counterExample.equations.foldl (init := error) folder
throwError ( addMessageContextFull errorMessage)
@[builtin_tactic Lean.Parser.Tactic.bvDecide]
def evalBvTrace : Tactic := fun

View File

@@ -27,6 +27,8 @@ instance : ToExpr BVBinOp where
| .xor => mkConst ``BVBinOp.xor
| .add => mkConst ``BVBinOp.add
| .mul => mkConst ``BVBinOp.mul
| .udiv => mkConst ``BVBinOp.udiv
| .umod => mkConst ``BVBinOp.umod
toTypeExpr := mkConst ``BVBinOp
instance : ToExpr BVUnOp where

View File

@@ -80,6 +80,10 @@ partial def of (x : Expr) : M (Option ReifiedBVExpr) := do
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
| Complement.complement _ _ innerExpr =>
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>

View File

@@ -105,7 +105,7 @@ instance : ToExpr LRAT.IntAction where
mkApp3 (mkConst ``LRAT.Action.del [.zero, .zero]) beta alpha (toExpr ids)
toTypeExpr := mkConst ``LRAT.IntAction
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : MetaM LratCert := do
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
let proofInput IO.FS.readBinFile lratPath
let proof
withTraceNode `sat (fun _ => return s!"Parsing LRAT file") do
@@ -139,8 +139,8 @@ Run an external SAT solver on the `CNF` to obtain an LRAT proof.
This will obtain an `LratCert` if the formula is UNSAT and throw errors otherwise.
-/
def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.FilePath)
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool)
: MetaM (Except (Array (Bool × Nat)) LratCert) := do
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool) :
CoreM (Except (Array (Bool × Nat)) LratCert) := do
IO.FS.withTempFile fun cnfHandle cnfPath => do
withTraceNode `sat (fun _ => return "Serializing SAT problem to DIMACS file") do
-- lazyPure to prevent compiler lifting
@@ -162,7 +162,7 @@ def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.Fi
/--
Add an auxiliary declaration. Only used to create constants that appear in our reflection proof.
-/
def mkAuxDecl (name : Name) (value type : Expr) : MetaM Unit :=
def mkAuxDecl (name : Name) (value type : Expr) : CoreM Unit :=
addAndCompile <| .defnDecl {
name := name,
levelParams := [],
@@ -181,8 +181,7 @@ function together with a correctness theorem for it.
`∀ (b : α) (c : LratCert), verifier b c = true → unsat b`
-/
def LratCert.toReflectionProof [ToExpr α] (cert : LratCert) (cfg : TacticContext) (reflected : α)
(verifier : Name) (unsat_of_verifier_eq_true : Name) :
MetaM Expr := do
(verifier : Name) (unsat_of_verifier_eq_true : Name) : MetaM Expr := do
withTraceNode `sat (fun _ => return "Compiling expr term") do
mkAuxDecl cfg.exprDef (toExpr reflected) (toTypeExpr α)
@@ -198,13 +197,20 @@ def LratCert.toReflectionProof [ToExpr α] (cert : LratCert) (cfg : TacticContex
let auxValue := mkApp2 (mkConst verifier) reflectedExpr certExpr
mkAuxDecl cfg.reflectionDef auxValue (mkConst ``Bool)
let nativeProof :=
let auxType mkEq (mkConst cfg.reflectionDef) (toExpr true)
let auxProof :=
mkApp3
(mkConst ``Lean.ofReduceBool)
(mkConst cfg.reflectionDef)
(toExpr true)
( mkEqRefl (toExpr true))
return mkApp3 (mkConst unsat_of_verifier_eq_true) reflectedExpr certExpr nativeProof
try
let auxLemma
withTraceNode `sat (fun _ => return "Verifying LRAT certificate") do
mkAuxLemma [] auxType auxProof
return mkApp3 (mkConst unsat_of_verifier_eq_true) reflectedExpr certExpr (mkConst auxLemma)
catch e =>
throwError m!"Failed to check the LRAT certificate in the kernel:\n{e.toMessageData}"
end Frontend

View File

@@ -5,6 +5,7 @@ Authors: Henrik Böving
-/
prelude
import Lean.Meta.AppBuilder
import Lean.Meta.Tactic.AC.Main
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.FalseOrByContra
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
@@ -64,6 +65,69 @@ builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _))
else
return .continue
-- A specialised version of BitVec.neg_eq_not_add so it doesn't trigger on -constant
builtin_simproc [bv_normalize] neg_eq_not_add (-(_ : BitVec _)) := fun e => do
let_expr Neg.neg typ _ val := e | return .continue
let_expr BitVec widthExpr := typ | return .continue
let some w getNatValue? widthExpr | return .continue
match getBitVecValue? val with
| some _ => return .continue
| none =>
let proof := mkApp2 (mkConst ``BitVec.neg_eq_not_add) (toExpr w) val
let expr mkAppM ``HAdd.hAdd #[ mkAppM ``Complement.complement #[val], (toExpr 1#w)]
return .visit { expr := expr, proof? := some proof }
builtin_simproc [bv_normalize] bv_add_const ((_ : BitVec _) + ((_ : BitVec _) + (_ : BitVec _))) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ exp1 rhs := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp2 exp3 := rhs | return .continue
let some w, exp1Val getBitVecValue? exp1 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp2 with
| some w', exp2Val =>
if h : w = w' then
let newLhs := exp1Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp3]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp3Val getBitVecValue? exp3 | return .continue
if h : w = w' then
let newLhs := exp1Val + h exp3Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right
return .visit { expr := expr, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] bv_add_const' (((_ : BitVec _) + (_ : BitVec _)) + (_ : BitVec _)) :=
fun e => do
let_expr HAdd.hAdd _ _ _ _ lhs exp3 := e | return .continue
let_expr HAdd.hAdd _ _ _ _ exp1 exp2 := lhs | return .continue
let some w, exp3Val getBitVecValue? exp3 | return .continue
let proofBuilder thm := mkApp4 (mkConst thm) (toExpr w) exp1 exp2 exp3
match getBitVecValue? exp1 with
| some w', exp1Val =>
if h : w = w' then
let newLhs := exp3Val + h exp1Val
-- TODO
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp2]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_left'
return .visit { expr := expr, proof? := some proof }
else
return .continue
| none =>
let some w', exp2Val getBitVecValue? exp2 | return .continue
if h : w = w' then
let newLhs := exp3Val + h exp2Val
let expr mkAppM ``HAdd.hAdd #[toExpr newLhs, exp1]
let proof := proofBuilder ``Std.Tactic.BVDecide.Normalize.BitVec.add_const_right'
return .visit { expr := expr, proof? := some proof }
else
return .continue
/--
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
the goal fully, indicated by returning `none`.
@@ -112,11 +176,36 @@ def rewriteRulesPass : Pass := fun goal => do
let some (_, newGoal) := result? | return none
return newGoal
/--
Normalize with respect to Associativity and Commutativity.
-/
def acNormalizePass : Pass := fun goal => do
let mut newGoal := goal
for hyp in ( goal.getNondepPropHyps) do
let result Lean.Meta.AC.acNfHypMeta newGoal hyp
if let .some nextGoal := result then
newGoal := nextGoal
else
return none
return newGoal
/--
The normalization passes used by `bv_normalize` and thus `bv_decide`.
-/
def defaultPipeline : List Pass := [rewriteRulesPass]
def passPipeline : MetaM (List Pass) := do
let opts getOptions
let mut passPipeline := defaultPipeline
if bv.ac_nf.get opts then
passPipeline := passPipeline ++ [acNormalizePass]
return passPipeline
end Pass
def bvNormalize (g : MVarId) : MetaM (Option MVarId) := do
@@ -124,7 +213,7 @@ def bvNormalize (g : MVarId) : MetaM (Option MVarId) := do
-- Contradiction proof
let some g g.falseOrByContra | return none
trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
Pass.fixpointPipeline Pass.defaultPipeline g
Pass.fixpointPipeline ( Pass.passPipeline) g
@[builtin_tactic Lean.Parser.Tactic.bvNormalize]
def evalBVNormalize : Tactic := fun
@@ -137,5 +226,3 @@ def evalBVNormalize : Tactic := fun
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -313,7 +313,7 @@ partial def evalChoiceAux (tactics : Array Syntax) (i : Nat) : TacticM Unit :=
@[builtin_tactic skip] def evalSkip : Tactic := fun _ => pure ()
@[builtin_tactic unknown] def evalUnknown : Tactic := fun stx => do
addCompletionInfo <| CompletionInfo.tactic stx ( getGoals)
addCompletionInfo <| CompletionInfo.tactic stx
@[builtin_tactic failIfSuccess] def evalFailIfSuccess : Tactic := fun stx =>
Term.withoutErrToSorry <| withoutRecover do

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Lean.Meta.Tactic.Constructor
import Lean.Meta.Tactic.Assert
import Lean.Meta.Tactic.AuxLemma
import Lean.Meta.Tactic.Clear
import Lean.Meta.Tactic.Rename
import Lean.Elab.Tactic.Basic
@@ -375,7 +376,7 @@ private def preprocessPropToDecide (expectedType : Expr) : TermElabM Expr := do
Given the decidable instance `inst`, reduces it and returns a decidable instance expression
in whnf that can be regarded as the reason for the failure of `inst` to fully reduce.
-/
private partial def blameDecideReductionFailure (inst : Expr) : MetaM Expr := do
private partial def blameDecideReductionFailure (inst : Expr) : MetaM Expr := withIncRecDepth do
let inst whnf inst
-- If it's the Decidable recursor, then blame the major premise.
if inst.isAppOfArity ``Decidable.rec 5 then
@@ -393,74 +394,100 @@ private partial def blameDecideReductionFailure (inst : Expr) : MetaM Expr := do
return blameDecideReductionFailure inst''
return inst
@[builtin_tactic Lean.Parser.Tactic.decide] def evalDecide : Tactic := fun _ =>
closeMainGoalUsing `decide fun expectedType => do
def evalDecideCore (tacticName : Name) (kernelOnly : Bool) : TacticM Unit :=
closeMainGoalUsing tacticName fun expectedType => 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 for diagnostics purposes.
let r withAtLeastTransparency .default <| whnf s
if r.isAppOf ``isTrue then
-- Success!
-- While we have a proof from reduction, we do not embed it in the proof term,
-- and instead we let the kernel recompute it during type checking from the following more
-- efficient term. The kernel handles the unification `e =?= true` specially.
let rflPrf mkEqRefl (toExpr true)
return mkApp3 (Lean.mkConst ``of_decide_eq_true) expectedType s rflPrf
let pf mkDecideProof expectedType
-- Get instance from `pf`
let s := pf.appFn!.appArg!
if kernelOnly then
-- Reduce the decidable instance to (hopefully!) `isTrue` by passing `pf` to the kernel.
-- The `mkAuxLemma` function caches the result in two ways:
-- 1. First, the function makes use of a `type`-indexed cache per module.
-- 2. Second, once the proof is added to the environment, the kernel doesn't need to check the proof again.
let levelsInType := (collectLevelParams {} expectedType).params
-- Level variables occurring in `expectedType`, in ambient order
let lemmaLevels := ( Term.getLevelNames).reverse.filter levelsInType.contains
try
let lemmaName mkAuxLemma lemmaLevels expectedType pf
return mkConst lemmaName (lemmaLevels.map .param)
catch _ =>
diagnose expectedType s none
else
-- Diagnose the failure, lazily so that there is no performance impact if `decide` isn't being used interactively.
throwError MessageData.ofLazyM (es := #[expectedType]) do
if r.isAppOf ``isFalse then
return m!"\
tactic 'decide' proved that the proposition\
let r withAtLeastTransparency .default <| whnf s
if r.isAppOf ``isTrue then
-- Success!
-- While we have a proof from reduction, we do not embed it in the proof term,
-- and instead we let the kernel recompute it during type checking from the following more
-- efficient term. The kernel handles the unification `e =?= true` specially.
return pf
else
diagnose expectedType s r
where
diagnose {α : Type} (expectedType s : Expr) (r? : Option Expr) : TacticM α :=
-- Diagnose the failure, lazily so that there is no performance impact if `decide` isn't being used interactively.
throwError MessageData.ofLazyM (es := #[expectedType]) do
let r r?.getDM (withAtLeastTransparency .default <| whnf s)
if r.isAppOf ``isTrue then
return m!"\
tactic '{tacticName}' failed. internal error: the elaborator is able to reduce the \
'{MessageData.ofConstName ``Decidable}' instance, but the kernel is not able to"
else if r.isAppOf ``isFalse then
return m!"\
tactic '{tacticName}' proved that the proposition\
{indentExpr expectedType}\n\
is false"
-- Re-reduce the instance and collect diagnostics, to get all unfolded Decidable instances
let (reason, unfoldedInsts) withoutModifyingState <| withOptions (fun opt => diagnostics.set opt true) do
modifyDiag (fun _ => {})
let reason withAtLeastTransparency .default <| blameDecideReductionFailure s
let unfolded := ( get).diag.unfoldCounter.foldl (init := #[]) fun cs n _ => cs.push n
let unfoldedInsts unfolded |>.qsort Name.lt |>.filterMapM fun n => do
let e mkConstWithLevelParams n
if ( Meta.isClass? ( inferType e)) == ``Decidable then
return m!"'{MessageData.ofConst e}'"
else
return none
return (reason, unfoldedInsts)
let stuckMsg :=
if unfoldedInsts.isEmpty then
m!"Reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
-- Re-reduce the instance and collect diagnostics, to get all unfolded Decidable instances
let (reason, unfoldedInsts) withoutModifyingState <| withOptions (fun opt => diagnostics.set opt true) do
modifyDiag (fun _ => {})
let reason withAtLeastTransparency .default <| blameDecideReductionFailure s
let unfolded := ( get).diag.unfoldCounter.foldl (init := #[]) fun cs n _ => cs.push n
let unfoldedInsts unfolded |>.qsort Name.lt |>.filterMapM fun n => do
let e mkConstWithLevelParams n
if ( Meta.isClass? ( inferType e)) == ``Decidable then
return m!"'{MessageData.ofConst e}'"
else
let instances := if unfoldedInsts.size == 1 then "instance" else "instances"
m!"After unfolding the {instances} {MessageData.andList unfoldedInsts.toList}, \
reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
let hint :=
if reason.isAppOf ``Eq.rec then
m!"\n\n\
Hint: Reduction got stuck on '▸' ({MessageData.ofConstName ``Eq.rec}), \
which suggests that one of the '{MessageData.ofConstName ``Decidable}' instances is defined using tactics such as 'rw' or 'simp'. \
To avoid tactics, make use of functions such as \
'{MessageData.ofConstName ``inferInstanceAs}' or '{MessageData.ofConstName ``decidable_of_decidable_of_iff}' \
to alter a proposition."
else if reason.isAppOf ``Classical.choice then
m!"\n\n\
Hint: Reduction got stuck on '{MessageData.ofConstName ``Classical.choice}', \
which indicates that a '{MessageData.ofConstName ``Decidable}' instance \
is defined using classical reasoning, proving an instance exists rather than giving a concrete construction. \
The 'decide' tactic works by evaluating a decision procedure via reduction, and it cannot make progress with such instances. \
This can occur due to the 'opened scoped Classical' command, which enables the instance \
'{MessageData.ofConstName ``Classical.propDecidable}'."
else
MessageData.nil
return m!"\
tactic 'decide' failed for proposition\
{indentExpr expectedType}\n\
since its '{MessageData.ofConstName ``Decidable}' instance\
{indentExpr s}\n\
did not reduce to '{MessageData.ofConstName ``isTrue}' or '{MessageData.ofConstName ``isFalse}'.\n\n\
{stuckMsg}{hint}"
return none
return (reason, unfoldedInsts)
let stuckMsg :=
if unfoldedInsts.isEmpty then
m!"Reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
else
let instances := if unfoldedInsts.size == 1 then "instance" else "instances"
m!"After unfolding the {instances} {MessageData.andList unfoldedInsts.toList}, \
reduction got stuck at the '{MessageData.ofConstName ``Decidable}' instance{indentExpr reason}"
let hint :=
if reason.isAppOf ``Eq.rec then
m!"\n\n\
Hint: Reduction got stuck on '▸' ({MessageData.ofConstName ``Eq.rec}), \
which suggests that one of the '{MessageData.ofConstName ``Decidable}' instances is defined using tactics such as 'rw' or 'simp'. \
To avoid tactics, make use of functions such as \
'{MessageData.ofConstName ``inferInstanceAs}' or '{MessageData.ofConstName ``decidable_of_decidable_of_iff}' \
to alter a proposition."
else if reason.isAppOf ``Classical.choice then
m!"\n\n\
Hint: Reduction got stuck on '{MessageData.ofConstName ``Classical.choice}', \
which indicates that a '{MessageData.ofConstName ``Decidable}' instance \
is defined using classical reasoning, proving an instance exists rather than giving a concrete construction. \
The '{tacticName}' tactic works by evaluating a decision procedure via reduction, \
and it cannot make progress with such instances. \
This can occur due to the 'opened scoped Classical' command, which enables the instance \
'{MessageData.ofConstName ``Classical.propDecidable}'."
else
MessageData.nil
return m!"\
tactic '{tacticName}' failed for proposition\
{indentExpr expectedType}\n\
since its '{MessageData.ofConstName ``Decidable}' instance\
{indentExpr s}\n\
did not reduce to '{MessageData.ofConstName ``isTrue}' or '{MessageData.ofConstName ``isFalse}'.\n\n\
{stuckMsg}{hint}"
@[builtin_tactic Lean.Parser.Tactic.decide] def evalDecide : Tactic := fun _ =>
evalDecideCore `decide false
@[builtin_tactic Lean.Parser.Tactic.decideBang] def evalDecideBang : Tactic := fun _ =>
evalDecideCore `decide! true
private def mkNativeAuxDecl (baseName : Name) (type value : Expr) : TermElabM Name := do
let auxName Term.mkAuxName baseName

View File

@@ -7,6 +7,7 @@ prelude
import Lean.Meta.Tactic.Assumption
import Lean.Meta.Tactic.TryThis
import Lean.Elab.Tactic.Simp
import Lean.Elab.App
import Lean.Linter.Basic
/--
@@ -46,27 +47,43 @@ deriving instance Repr for UseImplicitLambdaResult
return {}
g.withContext do
let stats if let some stx := usingArg then
setGoals [g]
g.withContext do
let mvarCounterSaved := ( getMCtx).mvarCounter
let e Tactic.elabTerm stx none (mayPostpone := true)
let (h, g) if let .fvar h instantiateMVars e then
pure (h, g)
else
( g.assert `h ( inferType e) e).intro1
let (result?, stats) simpGoal g ctx (simprocs := simprocs) (fvarIdsToSimp := #[h])
unless occursCheck g e do
throwError "occurs check failed, expression{indentExpr e}\ncontains the goal {Expr.mvar g}"
-- Copy the goal. We want to defer assigning `g := g'` to prevent `MVarId.note` from
-- partially assigning the goal in case we need to log unassigned metavariables.
-- Without deferring, this can cause `logUnassignedAndAbort` to report that `g` could not
-- be synthesized; recall that this function reports that a metavariable could not be
-- synthesized if, after mvar instantiation, it contains one of the provided mvars.
let gCopy mkFreshExprSyntheticOpaqueMVar ( g.getType) ( g.getTag)
let (h, g') gCopy.mvarId!.note `h e
let (result?, stats) simpGoal g' ctx (simprocs := simprocs) (fvarIdsToSimp := #[h])
(simplifyTarget := false) (stats := stats) (discharge? := discharge?)
match result? with
| some (xs, g) =>
let h := match xs with | #[h] | #[] => h | _ => unreachable!
let name mkFreshBinderNameForTactic `h
let g g.rename h name
g.assign <| g.withContext do
Tactic.elabTermEnsuringType (mkIdent name) ( g.getType)
| some (xs, g') =>
let h := xs[0]?.getD h
let name mkFreshUserName `h
let g' g'.rename h name
setGoals [g']
g'.withContext do
let gType g'.getType
let h Term.elabTerm (mkIdent name) gType
Term.synthesizeSyntheticMVarsNoPostponing
let hType inferType h
unless ( withAssignableSyntheticOpaque <| isDefEq gType hType) do
-- `e` still is valid in this new local context
Term.throwTypeMismatchError gType hType h
(header? := some m!"type mismatch, term{indentExpr e}\nafter simplification")
logUnassignedAndAbort ( filterOldMVars ( getMVars e) mvarCounterSaved)
closeMainGoal `simpa (checkUnassigned := false) h
| none =>
if getLinterUnnecessarySimpa ( getOptions) then
if ( getLCtx).getRoundtrippingUserName? h |>.isSome then
logLint linter.unnecessarySimpa ( getRef)
m!"try 'simp at {Expr.fvar h}' instead of 'simpa using {Expr.fvar h}'"
if let .fvar h := e then
if ( getLCtx).getRoundtrippingUserName? h |>.isSome then
logLint linter.unnecessarySimpa ( getRef)
m!"try 'simp at {Expr.fvar h}' instead of 'simpa using {Expr.fvar h}'"
g.assign gCopy
pure stats
else if let some ldecl := ( getLCtx).findFromUserName? `this then
if let (some (_, g), stats) simpGoal g ctx (simprocs := simprocs)

View File

@@ -80,8 +80,9 @@ structure SyntheticMVarDecl where
We have three different kinds of error context.
-/
inductive MVarErrorKind where
/-- Metavariable for implicit arguments. `ctx` is the parent application. -/
| implicitArg (ctx : Expr)
/-- Metavariable for implicit arguments. `ctx` is the parent application,
`lctx` is a local context where it is valid (necessary for eta feature for named arguments). -/
| implicitArg (lctx : LocalContext) (ctx : Expr)
/-- Metavariable for explicit holes provided by the user (e.g., `_` and `?m`) -/
| hole
/-- "Custom", `msgData` stores the additional error messages. -/
@@ -90,7 +91,7 @@ inductive MVarErrorKind where
instance : ToString MVarErrorKind where
toString
| .implicitArg _ => "implicitArg"
| .implicitArg _ _ => "implicitArg"
| .hole => "hole"
| .custom _ => "custom"
@@ -735,7 +736,7 @@ def registerMVarErrorHoleInfo (mvarId : MVarId) (ref : Syntax) : TermElabM Unit
registerMVarErrorInfo { mvarId, ref, kind := .hole }
def registerMVarErrorImplicitArgInfo (mvarId : MVarId) (ref : Syntax) (app : Expr) : TermElabM Unit := do
registerMVarErrorInfo { mvarId, ref, kind := .implicitArg app }
registerMVarErrorInfo { mvarId, ref, kind := .implicitArg ( getLCtx) app }
def registerMVarErrorCustomInfo (mvarId : MVarId) (ref : Syntax) (msgData : MessageData) : TermElabM Unit := do
registerMVarErrorInfo { mvarId, ref, kind := .custom msgData }
@@ -761,7 +762,7 @@ def throwMVarError (m : MessageData) : TermElabM α := do
def MVarErrorInfo.logError (mvarErrorInfo : MVarErrorInfo) (extraMsg? : Option MessageData) : TermElabM Unit := do
match mvarErrorInfo.kind with
| MVarErrorKind.implicitArg app => do
| MVarErrorKind.implicitArg lctx app => withLCtx lctx {} do
let app instantiateMVars app
let msg addArgName "don't know how to synthesize implicit argument"
let msg := msg ++ m!"{indentExpr app.setAppPPExplicitForExposingMVars}" ++ Format.line ++ "context:" ++ Format.line ++ MessageData.ofGoal mvarErrorInfo.mvarId
@@ -946,13 +947,13 @@ def applyAttributesAt (declName : Name) (attrs : Array Attribute) (applicationTi
def applyAttributes (declName : Name) (attrs : Array Attribute) : TermElabM Unit :=
applyAttributesCore declName attrs none
def mkTypeMismatchError (header? : Option String) (e : Expr) (eType : Expr) (expectedType : Expr) : TermElabM MessageData := do
def mkTypeMismatchError (header? : Option MessageData) (e : Expr) (eType : Expr) (expectedType : Expr) : TermElabM MessageData := do
let header : MessageData := match header? with
| some header => m!"{header} "
| none => m!"type mismatch{indentExpr e}\n"
return m!"{header}{← mkHasTypeButIsExpectedMsg eType expectedType}"
def throwTypeMismatchError (header? : Option String) (expectedType : Expr) (eType : Expr) (e : Expr)
def throwTypeMismatchError (header? : Option MessageData) (expectedType : Expr) (eType : Expr) (e : Expr)
(f? : Option Expr := none) (_extraMsg? : Option MessageData := none) : TermElabM α := do
/-
We ignore `extraMsg?` for now. In all our tests, it contained no useful information. It was
@@ -2047,13 +2048,6 @@ def TermElabM.toIO (x : TermElabM α)
let ((a, s), sCore, sMeta) (x.run ctx s).toIO ctxCore sCore ctxMeta sMeta
return (a, sCore, sMeta, s)
instance [MetaEval α] : MetaEval (TermElabM α) where
eval env opts x _ := do
let x : TermElabM α := do
try x finally
( Core.getMessageLog).forM fun msg => do IO.println ( msg.toString)
MetaEval.eval env opts (hideUnit := true) <| x.run' {}
/--
Execute `x` and then tries to solve pending universe constraints.
Note that, stuck constraints will not be discarded.

View File

@@ -1,27 +0,0 @@
/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
-/
prelude
import Lean.Environment
namespace Lean
universe u
/--
`Eval` extension that gives access to the current environment & options.
The basic `Eval` class is in the prelude and should not depend on these
types.
-/
class MetaEval (α : Type u) where
eval : Environment Options α (hideUnit : Bool) IO Environment
instance {α : Type u} [Eval α] : MetaEval α :=
fun env _ a hideUnit => do Eval.eval (fun _ => a) hideUnit; pure env
def runMetaEval {α : Type u} [MetaEval α] (env : Environment) (opts : Options) (a : α) : IO (String × Except IO.Error Environment) :=
IO.FS.withIsolatedStreams (MetaEval.eval env opts a false |>.toBaseIO)
end Lean

View File

@@ -120,7 +120,7 @@ instance [BEq α] [Hashable α] [Monad m] [STWorld ω m] [MonadRecDepth m] : Mon
Throw a "maximum recursion depth has been reached" exception using the given reference syntax.
-/
def throwMaxRecDepthAt [MonadError m] (ref : Syntax) : m α :=
throw <| .error ref (MessageData.ofFormat (Std.Format.text maxRecDepthErrorMessage))
throw <| .error ref (.tagged `runtime.maxRecDepth <| MessageData.ofFormat (Std.Format.text maxRecDepthErrorMessage))
/--
Return true if `ex` was generated by `throwMaxRecDepthAt`.
@@ -129,9 +129,7 @@ but it is also produced by `MacroM` which implemented in the prelude, and intern
been defined yet.
-/
def Exception.isMaxRecDepth (ex : Exception) : Bool :=
match ex with
| error _ (MessageData.ofFormatWithInfos Std.Format.text msg, _) => msg == maxRecDepthErrorMessage
| _ => false
ex matches error _ (.tagged `runtime.maxRecDepth _)
/--
Increment the current recursion depth and then execute `x`.

View File

@@ -23,8 +23,14 @@ def logLint [Monad m] [MonadLog m] [AddMessageContext m] [MonadOptions m]
let disable := m!"note: this linter can be disabled with `set_option {linterOption.name} false`"
logWarningAt stx (.tagged linterOption.name m!"{msg}\n{disable}")
/-- If `linterOption` is true, print a linter warning message at the position determined by `stx`.
/--
If `linterOption` is enabled, print a linter warning message at the position determined by `stx`.
Whether a linter option is enabled or not is determined by the following sequence:
1. If it is set, then the value determines whether or not it is enabled.
2. Otherwise, if `linter.all` is set, then its value determines whether or not the option is enabled.
3. Otherwise, the default value determines whether or not it is enabled.
-/
def logLintIf [Monad m] [MonadLog m] [AddMessageContext m] [MonadOptions m]
(linterOption : Lean.Option Bool) (stx : Syntax) (msg : MessageData) : m Unit := do
if linterOption.get ( getOptions) then logLint linterOption stx msg
if getLinterValue linterOption ( getOptions) then logLint linterOption stx msg

View File

@@ -255,10 +255,6 @@ builtin_initialize addBuiltinUnusedVariablesIgnoreFn (fun _ stack opts =>
(stx.isOfKind ``Lean.Parser.Term.matchAlt && pos == 1) ||
(stx.isOfKind ``Lean.Parser.Tactic.inductionAltLHS && pos == 2))
/-- `#guard_msgs in cmd` itself runs linters in `cmd` (via `elabCommandTopLevel`), so do not run them again. -/
builtin_initialize addBuiltinUnusedVariablesIgnoreFn (fun _ stack _ =>
stack.any fun (stx, _) => stx.isOfKind ``Lean.guardMsgsCmd)
/-- Get the current list of `IgnoreFunction`s. -/
def getUnusedVariablesIgnoreFns : CommandElabM (Array IgnoreFunction) := do
return (unusedVariablesIgnoreFnsExt.getState ( getEnv)).2

View File

@@ -246,12 +246,20 @@ structure DefEqCache where
all : PersistentHashMap (Expr × Expr) Bool := {}
deriving Inhabited
/--
A cache for `inferType` at transparency levels `.default` an `.all`.
-/
structure InferTypeCaches where
default : InferTypeCache
all : InferTypeCache
deriving Inhabited
/--
Cache datastructures for type inference, type class resolution, whnf, and definitional equality.
-/
structure Cache where
inferType : InferTypeCache := {}
funInfo : FunInfoCache := {}
inferType : InferTypeCaches := {}, {}
funInfo : FunInfoCache := {}
synthInstance : SynthInstanceCache := {}
whnfDefault : WhnfCache := {} -- cache for closed terms and `TransparencyMode.default`
whnfAll : WhnfCache := {} -- cache for closed terms and `TransparencyMode.all`
@@ -448,9 +456,6 @@ instance : MonadBacktrack SavedState MetaM where
let ((a, s), sCore) (x.run ctx s).toIO ctxCore sCore
pure (a, sCore, s)
instance [MetaEval α] : MetaEval (MetaM α) :=
fun env opts x _ => MetaEval.eval env opts x.run' true
protected def throwIsDefEqStuck : MetaM α :=
throw <| Exception.internal isDefEqStuckExceptionId
@@ -478,8 +483,11 @@ variable [MonadControlT MetaM n] [Monad n]
@[inline] def modifyCache (f : Cache Cache) : MetaM Unit :=
modify fun { mctx, cache, zetaDeltaFVarIds, postponed, diag } => { mctx, cache := f cache, zetaDeltaFVarIds, postponed, diag }
@[inline] def modifyInferTypeCache (f : InferTypeCache InferTypeCache) : MetaM Unit :=
modifyCache fun ic, c1, c2, c3, c4, c5, c6 => f ic, c1, c2, c3, c4, c5, c6
@[inline] def modifyInferTypeCacheDefault (f : InferTypeCache InferTypeCache) : MetaM Unit :=
modifyCache fun icd, ica, c1, c2, c3, c4, c5, c6 => f icd, ica, c1, c2, c3, c4, c5, c6
@[inline] def modifyInferTypeCacheAll (f : InferTypeCache InferTypeCache) : MetaM Unit :=
modifyCache fun icd, ica, c1, c2, c3, c4, c5, c6 => icd, f ica, c1, c2, c3, c4, c5, c6
@[inline] def modifyDefEqTransientCache (f : DefEqCache DefEqCache) : MetaM Unit :=
modifyCache fun c1, c2, c3, c4, c5, defeqTrans, c6 => c1, c2, c3, c4, c5, f defeqTrans, c6
@@ -490,6 +498,9 @@ variable [MonadControlT MetaM n] [Monad n]
@[inline] def resetDefEqPermCaches : MetaM Unit :=
modifyDefEqPermCache fun _ => {}
@[inline] def resetSynthInstanceCache : MetaM Unit :=
modifyCache fun c => {c with synthInstance := {}}
@[inline] def modifyDiag (f : Diagnostics Diagnostics) : MetaM Unit := do
if ( isDiagnosticsEnabled) then
modify fun { mctx, cache, zetaDeltaFVarIds, postponed, diag } => { mctx, cache, zetaDeltaFVarIds, postponed, diag := f diag }

View File

@@ -55,7 +55,7 @@ private def updateHasFwdDeps (pinfo : Array ParamInfo) (backDeps : Array Nat) :
private def getFunInfoAux (fn : Expr) (maxArgs? : Option Nat) : MetaM FunInfo :=
checkFunInfoCache fn maxArgs? do
let fnType inferType fn
withTransparency TransparencyMode.default do
withAtLeastTransparency TransparencyMode.default do
forallBoundedTelescope fnType maxArgs? fun fvars type => do
let mut paramInfo := #[]
let mut higherOrderOutParams : FVarIdSet := {}

View File

@@ -166,13 +166,24 @@ private def inferFVarType (fvarId : FVarId) : MetaM Expr := do
| none => fvarId.throwUnknown
@[inline] private def checkInferTypeCache (e : Expr) (inferType : MetaM Expr) : MetaM Expr := do
match ( get).cache.inferType.find? e with
| some type => return type
| none =>
let type inferType
unless e.hasMVar || type.hasMVar do
modifyInferTypeCache fun c => c.insert e type
return type
match ( getTransparency) with
| .default =>
match ( get).cache.inferType.default.find? e with
| some type => return type
| none =>
let type inferType
unless e.hasMVar || type.hasMVar do
modifyInferTypeCacheDefault fun c => c.insert e type
return type
| .all =>
match ( get).cache.inferType.all.find? e with
| some type => return type
| none =>
let type inferType
unless e.hasMVar || type.hasMVar do
modifyInferTypeCacheAll fun c => c.insert e type
return type
| _ => panic! "checkInferTypeCache: transparency mode not default or all"
@[export lean_infer_type]
def inferTypeImp (e : Expr) : MetaM Expr :=
@@ -191,7 +202,7 @@ def inferTypeImp (e : Expr) : MetaM Expr :=
| .forallE .. => checkInferTypeCache e (inferForallType e)
| .lam .. => checkInferTypeCache e (inferLambdaType e)
| .letE .. => checkInferTypeCache e (inferLambdaType e)
withIncRecDepth <| withTransparency TransparencyMode.default (infer e)
withIncRecDepth <| withAtLeastTransparency TransparencyMode.default (infer e)
/--
Return `LBool.true` if given level is always equivalent to universe level zero.

View File

@@ -208,7 +208,9 @@ private partial def computeSynthOrder (inst : Expr) (projInfo? : Option Projecti
let typeLines := ("" : MessageData).joinSep <| Array.toList <| toSynth.mapM fun i => do
let ty instantiateMVars ( inferType argMVars[i]!)
return indentExpr (ty.setPPExplicit true)
logError m!"cannot find synthesization order for instance {inst} with type{indentExpr instTy}\nall remaining arguments have metavariables:{typeLines}"
throwError m!"\
cannot find synthesization order for instance {inst} with type{indentExpr instTy}\n\
all remaining arguments have metavariables:{typeLines}"
pure toSynth[0]!
synthed := synthed.push next
toSynth := toSynth.filter (· != next)
@@ -218,9 +220,10 @@ private partial def computeSynthOrder (inst : Expr) (projInfo? : Option Projecti
if synthInstance.checkSynthOrder.get ( getOptions) then
let ty instantiateMVars ty
if ty.hasExprMVar then
logError m!"instance does not provide concrete values for (semi-)out-params{indentExpr (ty.setPPExplicit true)}"
throwError m!"instance does not provide concrete values for (semi-)out-params{indentExpr (ty.setPPExplicit true)}"
trace[Meta.synthOrder] "synthesizing the arguments of {inst} in the order {synthed}:{("" : MessageData).joinSep (← synthed.mapM fun i => return indentExpr (← inferType argVars[i]!)).toList}"
trace[Meta.synthOrder] "synthesizing the arguments of {inst} in the order {synthed}:\
{("" : MessageData).joinSep (← synthed.mapM fun i => return indentExpr (← inferType argVars[i]!)).toList}"
return synthed

View File

@@ -33,7 +33,7 @@ register_builtin_option pp.showLetValues : Bool := {
}
private def addLine (fmt : Format) : Format :=
if fmt.isNil then fmt else fmt ++ Format.line
if fmt.isNil then fmt else fmt ++ "\n"
def getGoalPrefix (mvarDecl : MetavarDecl) : String :=
if isLHSGoal? mvarDecl.type |>.isSome then
@@ -99,6 +99,6 @@ def ppGoal (mvarId : MVarId) : MetaM Format := do
let fmt := fmt ++ getGoalPrefix mvarDecl ++ Format.nest indent typeFmt
match mvarDecl.userName with
| Name.anonymous => return fmt
| name => return "case " ++ format name.eraseMacroScopes ++ Format.line ++ fmt
| name => return "case " ++ format name.eraseMacroScopes ++ "\n" ++ fmt
end Lean.Meta

View File

@@ -140,6 +140,25 @@ where
| .op l r => mkApp2 preContext.op (convertTarget vars l) (convertTarget vars r)
| .var x => vars[x]!
def post (e : Expr) : SimpM Simp.Step := do
let ctx Simp.getContext
match e, ctx.parent? with
| bin op₁ l r, some (bin op₂ _ _) =>
if isDefEq op₁ op₂ then
return Simp.Step.done { expr := e }
match preContext op₁ with
| some pc =>
let (proof, newTgt) buildNormProof pc l r
return Simp.Step.done { expr := newTgt, proof? := proof }
| none => return Simp.Step.done { expr := e }
| bin op l r, _ =>
match preContext op with
| some pc =>
let (proof, newTgt) buildNormProof pc l r
return Simp.Step.done { expr := newTgt, proof? := proof }
| none => return Simp.Step.done { expr := e }
| e, _ => return Simp.Step.done { expr := e }
def rewriteUnnormalized (mvarId : MVarId) : MetaM MVarId := do
let simpCtx :=
{
@@ -150,41 +169,48 @@ def rewriteUnnormalized (mvarId : MVarId) : MetaM MVarId := do
let tgt instantiateMVars ( mvarId.getType)
let (res, _) Simp.main tgt simpCtx (methods := { post })
applySimpResultToTarget mvarId tgt res
where
post (e : Expr) : SimpM Simp.Step := do
let ctx Simp.getContext
match e, ctx.parent? with
| bin op₁ l r, some (bin op₂ _ _) =>
if isDefEq op₁ op₂ then
return Simp.Step.done { expr := e }
match preContext op₁ with
| some pc =>
let (proof, newTgt) buildNormProof pc l r
return Simp.Step.done { expr := newTgt, proof? := proof }
| none => return Simp.Step.done { expr := e }
| bin op l r, _ =>
match preContext op with
| some pc =>
let (proof, newTgt) buildNormProof pc l r
return Simp.Step.done { expr := newTgt, proof? := proof }
| none => return Simp.Step.done { expr := e }
| e, _ => return Simp.Step.done { expr := e }
def rewriteUnnormalizedRefl (goal : MVarId) : MetaM Unit := do
let newGoal rewriteUnnormalized goal
newGoal.refl
def rewriteUnnormalizedNormalForm (goal : MVarId) : TacticM Unit := do
let newGoal rewriteUnnormalized goal
replaceMainGoal [newGoal]
( rewriteUnnormalized goal).refl
@[builtin_tactic acRfl] def acRflTactic : Lean.Elab.Tactic.Tactic := fun _ => do
let goal getMainGoal
goal.withContext <| rewriteUnnormalizedRefl goal
@[builtin_tactic acNf] def acNfTactic : Lean.Elab.Tactic.Tactic := fun _ => do
let goal getMainGoal
goal.withContext <| rewriteUnnormalizedNormalForm goal
def acNfHypMeta (goal : MVarId) (fvarId : FVarId) : MetaM (Option MVarId) := do
goal.withContext do
let simpCtx :=
{
simpTheorems := {}
congrTheorems := ( getSimpCongrTheorems)
config := Simp.neutralConfig
}
let tgt instantiateMVars ( fvarId.getType)
let (res, _) Simp.main tgt simpCtx (methods := { post })
return ( applySimpResultToLocalDecl goal fvarId res false).map (·.snd)
/-- Implementation of the `ac_nf` tactic when operating on the main goal. -/
def acNfTargetTactic : TacticM Unit :=
liftMetaTactic1 fun goal => rewriteUnnormalized goal
/-- Implementation of the `ac_nf` tactic when operating on a hypothesis. -/
def acNfHypTactic (fvarId : FVarId) : TacticM Unit :=
liftMetaTactic1 fun goal => acNfHypMeta goal fvarId
@[builtin_tactic acNf0]
def evalNf0 : Tactic := fun stx => do
match stx with
| `(tactic| ac_nf0 $[$loc?]?) =>
let loc := if let some loc := loc? then expandLocation loc else Location.targets #[] true
withMainContext do
match loc with
| Location.targets hyps target =>
if target then acNfTargetTactic
( getFVarIds hyps).forM acNfHypTactic
| Location.wildcard =>
acNfTargetTactic
( ( getMainGoal).getNondepPropHyps).forM acNfHypTactic
| _ => Lean.Elab.throwUnsupportedSyntax
builtin_initialize
registerTraceClass `Meta.AC

View File

@@ -43,9 +43,31 @@ def _root_.Lean.MVarId.tryClear (mvarId : MVarId) (fvarId : FVarId) : MetaM MVar
mvarId.clear fvarId <|> pure mvarId
/--
Try to erase the given free variables from the goal `mvarId`.
Try to clear the given fvars from the local context.
The fvars must be given in the order they appear in the local context.
See also `tryClearMany'` which takes care of reordering internally,
and returns the cleared hypotheses along with the new goal.
-/
def _root_.Lean.MVarId.tryClearMany (mvarId : MVarId) (fvarIds : Array FVarId) : MetaM MVarId := do
fvarIds.foldrM (init := mvarId) fun fvarId mvarId => mvarId.tryClear fvarId
/--
Try to clear the given fvars from the local context. Returns the new goal and
the hypotheses that were cleared.
Does not require the `hyps` to be given in the order in which they
appear in the local context.
-/
def _root_.Lean.MVarId.tryClearMany' (goal : MVarId) (fvarIds : Array FVarId) :
MetaM (MVarId × Array FVarId) :=
goal.withContext do
let fvarIds := ( getLCtx).sortFVarsByContextOrder fvarIds
fvarIds.foldrM (init := (goal, Array.mkEmpty fvarIds.size))
fun h (goal, cleared) => do
let goal' goal.tryClear h
let cleared := if goal == goal' then cleared else cleared.push h
return (goal', cleared)
end Lean.Meta

View File

@@ -662,8 +662,16 @@ def deriveUnaryInduction (name : Name) : MetaM Name := do
let varNames forallTelescope info.type fun xs _ => xs.mapM (·.fvarId!.getUserName)
-- Uses of WellFounded.fix can be partially applied. Here we eta-expand the body
-- to avoid dealing with this
let e lambdaTelescope info.value fun params body => do mkLambdaFVars params ( etaExpand body)
-- to make sure that `target` indeed the last parameter
let e := info.value
let e lambdaTelescope e fun params body => do
if body.isAppOfArity ``WellFounded.fix 5 then
forallBoundedTelescope ( inferType body) (some 1) fun xs _ => do
unless xs.size = 1 do
throwError "functional induction: Failed to eta-expand{indentExpr e}"
mkLambdaFVars (params ++ xs) (mkAppN body xs)
else
pure e
let e' lambdaTelescope e fun params funBody => MatcherApp.withUserNames params varNames do
match_expr funBody with
| fix@WellFounded.fix α _motive rel wf body target =>
@@ -710,7 +718,11 @@ def deriveUnaryInduction (name : Name) : MetaM Name := do
-- So for now lets just keep them around.
let e' mkLambdaFVars (binderInfoForMVars := .default) fixedParams e'
instantiateMVars e'
| _ => throwError "Function {name} not defined via WellFounded.fix:{indentExpr funBody}"
| _ =>
if funBody.isAppOf ``WellFounded.fix then
throwError "Function {name} defined via WellFounded.fix with unexpected arity {funBody.getAppNumArgs}:{indentExpr funBody}"
else
throwError "Function {name} not defined via WellFounded.fix:{indentExpr funBody}"
unless ( isTypeCorrect e') do
logError m!"failed to derive a type-correct induction principle:{indentExpr e'}"

View File

@@ -575,7 +575,7 @@ where
/--
Discharges assumptions of the form `∀ …, a = b` using `rfl`. This is particularly useful for higher
order assumptions of the form `∀ …, e = ?g x y` to instaniate a paramter `g` even if that does not
order assumptions of the form `∀ …, e = ?g x y` to instaniate a parameter `g` even if that does not
appear on the lhs of the rule.
-/
def dischargeRfl (e : Expr) : SimpM (Option Expr) := do

View File

@@ -145,7 +145,7 @@ def zetaReduce (e : Expr) : MetaM Expr := do
| none => return TransformStep.done e
| some localDecl =>
if let some value := localDecl.value? then
return TransformStep.visit value
return TransformStep.visit ( instantiateMVars value)
else
return TransformStep.done e
| _ => return .continue

View File

@@ -462,9 +462,33 @@ structure Pair (α : Type u) (β : Type v) : Type (max u v) where
"#check " >> termParser
@[builtin_command_parser] def check_failure := leading_parser
"#check_failure " >> termParser -- Like `#check`, but succeeds only if term does not type check
@[builtin_command_parser] def eval := leading_parser
/--
`#eval e` evaluates the expression `e` by compiling and evaluating it.
* The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result.
* If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m`
to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`.
Users can define `MonadEval` instances to extend the list of supported monads.
The `#eval` command gracefully degrades in capability depending on what is imported.
Importing the `Lean.Elab.Command` module provides full capabilities.
Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly,
since the presence of `sorry` can lead to runtime instability and crashes.
This check can be overridden with the `#eval! e` command.
Options:
* If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the
usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances.
* If `eval.type` is true (default: false) then pretty prints the type of the evaluated value.
* If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance
when there is no other way to print the result.
See also: `#reduce e` for evaluation by term reduction.
-/
@[builtin_command_parser, builtin_doc] def eval := leading_parser
"#eval " >> termParser
@[builtin_command_parser] def evalBang := leading_parser
@[builtin_command_parser, inherit_doc eval] def evalBang := leading_parser
"#eval! " >> termParser
@[builtin_command_parser] def synth := leading_parser
"#synth " >> termParser

View File

@@ -125,6 +125,16 @@ example : 1 + 1 = 2 := by rfl
@[builtin_tactic_parser] def decide := leading_parser
nonReservedSymbol "decide"
/--
`decide!` is a variant of the `decide` tactic that uses kernel reduction to prove the goal.
It has the following properties:
- Since it uses kernel reduction instead of elaborator reduction, it ignores transparency and can unfold everything.
- While `decide` needs to reduce the `Decidable` instance twice (once during elaboration to verify whether the tactic succeeds,
and once during kernel type checking), the `decide!` tactic reduces it exactly once.
-/
@[builtin_tactic_parser] def decideBang := leading_parser
nonReservedSymbol "decide!"
/-- `native_decide` will attempt to prove a goal of type `p` by synthesizing an instance
of `Decidable p` and then evaluating it to `isTrue ..`. Unlike `decide`, this
uses `#eval` to evaluate the decidability instance.

View File

@@ -140,11 +140,68 @@ def optSemicolon (p : Parser) : Parser :=
/-- The universe of propositions. `Prop ≡ Sort 0`. -/
@[builtin_term_parser] def prop := leading_parser
"Prop"
/-- A placeholder term, to be synthesized by unification. -/
/--
A *hole* (or *placeholder term*), which stands for an unknown term that is expected to be inferred based on context.
For example, in `@id _ Nat.zero`, the `_` must be the type of `Nat.zero`, which is `Nat`.
The way this works is that holes create fresh metavariables.
The elaborator is allowed to assign terms to metavariables while it is checking definitional equalities.
This is often known as *unification*.
Normally, all holes must be solved for. However, there are a few contexts where this is not necessary:
* In `match` patterns, holes are catch-all patterns.
* In some tactics, such as `refine'` and `apply`, unsolved-for placeholders become new goals.
Related concept: implicit parameters are automatically filled in with holes during the elaboration process.
See also `?m` syntax (synthetic holes).
-/
@[builtin_term_parser] def hole := leading_parser
"_"
/-- Parses a "synthetic hole", that is, `?foo` or `?_`.
This syntax is used to construct named metavariables. -/
/--
A *synthetic hole* (or *synthetic placeholder*), which stands for an unknown term that should be synthesized using tactics.
- `?_` creates a fresh metavariable with an auto-generated name.
- `?m` either refers to a pre-existing metavariable named `m` or creates a fresh metavariable with that name.
In particular, the synthetic hole syntax creates "synthetic opaque metavariables",
the same kind of metavariable used to represent goals in the tactic state.
Synthetic holes are similar to holes in that `_` also creates metavariables,
but synthetic opaque metavariables have some different properties:
- In tactics such as `refine`, only synthetic holes yield new goals.
- During elaboration, unification will not solve for synthetic opaque metavariables, they are "opaque".
This is to prevent counterintuitive behavior such as disappearing goals.
- When synthetic holes appear under binders, they capture local variables using a more complicated mechanism known as delayed assignment.
## Delayed assigned metavariables
This section gives an overview of some technical details of synthetic holes, which you should feel free to skip.
Understanding delayed assignments is mainly useful for those who are working on tactics and other metaprogramming.
It is included here until there is a suitable place for it in the reference manual.
When a synthetic hole appears under a binding construct, such as for example `fun (x : α) (y : β) => ?s`,
the system creates a *delayed assignment*. This consists of
1. A metavariable `?m` of type `(x : α) → (y : β) → γ x y` whose local context is the local context outside the `fun`,
where `γ x y` is the type of `?s`. Recall that `x` and `y` appear in the local context of `?s`.
2. A delayed assigment record associating `?m` to `?s` and the variables `#[x, y]` in the local context of `?s`
Then, this function elaborates as `fun (x : α) (y : β) => ?m x y`, where one should understand `x` and `y` here
as being De Bruijn indexes, since Lean uses the locally nameless encoding of lambda calculus.
Once `?s` is fully solved for, in the sense that after metavariable instantiation it is a metavariable-free term `e`,
then we can make the assignment `?m := fun (x' : α) (y' : β) => e[x := x', y := y']`.
(Implementation note: Lean only instantiates full applications `?m x' y'` of delayed assigned metavariables, to skip forming this function.)
This delayed assignment mechanism is essential to the operation of basic tactics like `intro`,
and a good mental model is that it is a way to "apply" the metavariable `?s` by substituting values in for some of its local variables.
While it would be easier to immediately assign `?s := ?m x y`,
delayed assigment preserves `?s` as an unsolved-for metavariable with a local context that still contains `x` and `y`,
which is exactly what tactics like `intro` need.
By default, delayed assigned metavariables pretty print with what they are delayed assigned to.
The delayed assigned metavariables themselves can be pretty printed using `set_option pp.mvars.delayed true`.
For more information, see the "Gruesome details" module docstrings in `Lean.MetavarContext`.
-/
@[builtin_term_parser] def syntheticHole := leading_parser
"?" >> (ident <|> "_")
/--
@@ -451,7 +508,7 @@ def withAnonymousAntiquot := leading_parser
@[builtin_term_parser] def «trailing_parser» := leading_parser:leadPrec
"trailing_parser" >> optExprPrecedence >> optExprPrecedence >> ppSpace >> termParser
/--
/--
Indicates that an argument to a function marked `@[extern]` is borrowed.
Being borrowed only affects the ABI and runtime behavior of the function when compiled or interpreted. From the perspective of Lean's type system, this annotation has no effect. It similarly has no effect on functions not marked `@[extern]`.

View File

@@ -570,6 +570,25 @@ def withOverApp (arity : Nat) (x : Delab) : Delab := do
withAnnotateTermInfo x
delabAppCore (n - arity) delabHead (unexpand := false)
@[builtin_delab app]
def delabDelayedAssignedMVar : Delab := whenNotPPOption getPPMVarsDelayed do
let .mvar mvarId := ( getExpr).getAppFn | failure
let some decl getDelayedMVarAssignment? mvarId | failure
withOverApp decl.fvars.size do
let args := ( getExpr).getAppArgs
-- Only delaborate using decl.mvarIdPending if the delayed mvar is applied to fvars
guard <| args.all Expr.isFVar
withTypeAscription (cond := getPPOption getPPMVarsWithType) do
if getPPOption getPPMVars then
let mvarDecl decl.mvarIdPending.getDecl
let n :=
match mvarDecl.userName with
| .anonymous => decl.mvarIdPending.name.replacePrefix `_uniq `m
| n => n
`(?$(mkIdent n))
else
`(?_)
/-- State for `delabAppMatch` and helpers. -/
structure AppMatchState where
info : MatcherInfo
@@ -1200,12 +1219,29 @@ def delabDo : Delab := whenPPOption getPPNotation do
`(do $items:doSeqItem*)
def reifyName : Expr DelabM Name
| .const ``Lean.Name.anonymous .. => return Name.anonymous
| .app (.app (.const ``Lean.Name.str ..) n) (.lit (.strVal s)) => return ( reifyName n).mkStr s
| .app (.app (.const ``Lean.Name.num ..) n) (.lit (.natVal i)) => return ( reifyName n).mkNum i
| .const ``Lean.Name.anonymous _ => return Name.anonymous
| mkApp2 (.const ``Lean.Name.str _) n (.lit (.strVal s)) => return ( reifyName n).mkStr s
| mkApp2 (.const ``Lean.Name.num _) n (.lit (.natVal i)) => return ( reifyName n).mkNum i
| mkApp (.const ``Lean.Name.mkStr1 _) (.lit (.strVal a)) => return Lean.Name.mkStr1 a
| mkApp2 (.const ``Lean.Name.mkStr2 _) (.lit (.strVal a1)) (.lit (.strVal a2)) =>
return Lean.Name.mkStr2 a1 a2
| mkApp3 (.const ``Lean.Name.mkStr3 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) =>
return Lean.Name.mkStr3 a1 a2 a3
| mkApp4 (.const ``Lean.Name.mkStr4 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) =>
return Lean.Name.mkStr4 a1 a2 a3 a4
| mkApp5 (.const ``Lean.Name.mkStr5 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) =>
return Lean.Name.mkStr5 a1 a2 a3 a4 a5
| mkApp6 (.const ``Lean.Name.mkStr6 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) =>
return Lean.Name.mkStr6 a1 a2 a3 a4 a5 a6
| mkApp7 (.const ``Lean.Name.mkStr7 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) =>
return Lean.Name.mkStr7 a1 a2 a3 a4 a5 a6 a7
| mkApp8 (.const ``Lean.Name.mkStr8 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) (.lit (.strVal a8)) =>
return Lean.Name.mkStr8 a1 a2 a3 a4 a5 a6 a7 a8
| _ => failure
@[builtin_delab app.Lean.Name.str]
@[builtin_delab app.Lean.Name.str,
builtin_delab app.Lean.Name.mkStr1, builtin_delab app.Lean.Name.mkStr2, builtin_delab app.Lean.Name.mkStr3, builtin_delab app.Lean.Name.mkStr4,
builtin_delab app.Lean.Name.mkStr5, builtin_delab app.Lean.Name.mkStr6, builtin_delab app.Lean.Name.mkStr7, builtin_delab app.Lean.Name.mkStr8]
def delabNameMkStr : Delab := whenPPOption getPPNotation do
let n reifyName ( getExpr)
-- not guaranteed to be a syntactically valid name, but usually more helpful than the explicit version

View File

@@ -95,6 +95,11 @@ register_builtin_option pp.mvars.withType : Bool := {
group := "pp"
descr := "(pretty printer) display metavariables with a type ascription"
}
register_builtin_option pp.mvars.delayed : Bool := {
defValue := false
group := "pp"
descr := "(pretty printer) display delayed assigned metavariables when true, otherwise display what they are assigned to"
}
register_builtin_option pp.beta : Bool := {
defValue := false
group := "pp"
@@ -244,6 +249,7 @@ def getPPPrivateNames (o : Options) : Bool := o.get pp.privateNames.name (getPPA
def getPPInstantiateMVars (o : Options) : Bool := o.get pp.instantiateMVars.name pp.instantiateMVars.defValue
def getPPMVars (o : Options) : Bool := o.get pp.mvars.name pp.mvars.defValue
def getPPMVarsWithType (o : Options) : Bool := o.get pp.mvars.withType.name pp.mvars.withType.defValue
def getPPMVarsDelayed (o : Options) : Bool := o.get pp.mvars.delayed.name (pp.mvars.delayed.defValue || getPPAll o)
def getPPBeta (o : Options) : Bool := o.get pp.beta.name pp.beta.defValue
def getPPSafeShadowing (o : Options) : Bool := o.get pp.safeShadowing.name pp.safeShadowing.defValue
def getPPProofs (o : Options) : Bool := o.get pp.proofs.name (pp.proofs.defValue || getPPAll o)

View File

@@ -13,6 +13,7 @@ import Lean.Data.Lsp.Utf16
import Lean.Meta.CompletionName
import Lean.Meta.Tactic.Apply
import Lean.Meta.Match.MatcherInfo
import Lean.Elab.Tactic.Doc
import Lean.Server.InfoUtils
import Lean.Parser.Extension
import Lean.Server.FileSource
@@ -651,20 +652,51 @@ private def optionCompletion
data? := toJson { params, id? := none : CompletionItemDataWithId } }, score)
return some { items := sortCompletionItems items, isIncomplete := true }
private def tacticCompletion (params : CompletionParams) (ctx : ContextInfo) : IO (Option CompletionList) :=
-- Just return the list of tactics for now.
ctx.runMetaM {} do
let table := Parser.getCategory (Parser.parserExtension.getState ( getEnv)).categories `tactic |>.get!.tables.leadingTable
let items : Array (CompletionItem × Float) := table.fold (init := #[]) fun items tk _ =>
-- TODO pretty print tactic syntax
items.push ({
label := tk.toString
detail? := none
documentation? := none
kind? := CompletionItemKind.keyword
data? := toJson { params, id? := none : CompletionItemDataWithId }
}, 1)
return some { items := sortCompletionItems items, isIncomplete := true }
private def tacticCompletion (params : CompletionParams) (ctx : ContextInfo)
: IO (Option CompletionList) := ctx.runMetaM .empty do
let allTacticDocs Tactic.Doc.allTacticDocs
let items : Array (CompletionItem × Float) := allTacticDocs.map fun tacticDoc =>
({
label := tacticDoc.userName
detail? := none
documentation? := tacticDoc.docString.map fun docString =>
{ value := docString, kind := MarkupKind.markdown : MarkupContent }
kind? := CompletionItemKind.keyword
data? := toJson { params, id? := none : CompletionItemDataWithId }
}, 1)
return some { items := sortCompletionItems items, isIncomplete := true }
private def findBest?
(infoTree : InfoTree)
(gt : α α Bool)
(f : ContextInfo Info PersistentArray InfoTree Option α)
: Option α :=
infoTree.visitM (m := Id) (postNode := choose) |>.join
where
choose
(ctx : ContextInfo)
(info : Info)
(cs : PersistentArray InfoTree)
(childValues : List (Option (Option α)))
: Option α :=
let bestChildValue := childValues.map (·.join) |>.foldl (init := none) fun v best =>
if isBetter v best then
v
else
best
if let some v := f ctx info cs then
if isBetter v bestChildValue then
v
else
bestChildValue
else
bestChildValue
isBetter (a b : Option α) : Bool :=
match a, b with
| none, none => false
| some _, none => true
| none, some _ => false
| some a, some b => gt a b
/--
If there are `Info`s that contain `hoverPos` and have a nonempty `LocalContext`,
@@ -675,76 +707,224 @@ private def findClosestInfoWithLocalContextAt?
(hoverPos : String.Pos)
(infoTree : InfoTree)
: Option (ContextInfo × Info) :=
infoTree.visitM (m := Id) (postNode := choose) |>.join
where
choose
(ctx : ContextInfo)
(info : Info)
(_ : PersistentArray InfoTree)
(childValues : List (Option (Option (ContextInfo × Info))))
: Option (ContextInfo × Info) :=
let bestChildValue := childValues.map (·.join) |>.foldl (init := none) fun v best =>
if isBetter v best then
v
else
best
if info.occursInOrOnBoundary hoverPos && isBetter (ctx, info) bestChildValue then
findBest? infoTree isBetter fun ctx info _ =>
if info.occursInOrOnBoundary hoverPos then
(ctx, info)
else
bestChildValue
none
where
isBetter (a b : ContextInfo × Info) : Bool :=
let (_, ia) := a
let (_, ib) := b
if !ia.lctx.isEmpty && ib.lctx.isEmpty then
true
else if ia.lctx.isEmpty && !ib.lctx.isEmpty then
false
else if ia.isSmaller ib then
true
else if ib.isSmaller ia then
false
else
false
isBetter (a b : Option (ContextInfo × Info)) : Bool :=
match a, b with
| none, none => false
| some _, none => true
| none, some _ => false
| some (_, ia), some (_, ib) =>
if !ia.lctx.isEmpty && ib.lctx.isEmpty then
true
else if ia.lctx.isEmpty && !ib.lctx.isEmpty then
false
else if ia.isSmaller ib then
true
else if ib.isSmaller ia then
false
else
false
private def findSyntheticIdentifierCompletion?
(hoverPos : String.Pos)
(infoTree : InfoTree)
: Option (HoverInfo × ContextInfo × CompletionInfo) := do
let some (ctx, info) := findClosestInfoWithLocalContextAt? hoverPos infoTree
| none
let some stack := info.stx.findStack? (·.getRange?.any (·.contains hoverPos (includeStop := true)))
| none
let stack := stack.dropWhile fun (stx, _) => !(stx matches `($_:ident) || stx matches `($_:ident.))
let some (stx, _) := stack.head?
| none
let isDotIdCompletion := stack.any fun (stx, _) => stx matches `(.$_:ident)
if isDotIdCompletion then
-- An identifier completion is never useful in a dotId completion context.
none
let some (id, danglingDot) :=
match stx with
| `($id:ident) => some (id.getId, false)
| `($id:ident.) => some (id.getId, true)
| _ => none
| none
let tailPos := stx.getTailPos?.get!
let hoverInfo :=
if hoverPos < tailPos then
HoverInfo.inside (tailPos - hoverPos).byteIdx
else
HoverInfo.after
some (hoverInfo, ctx, .id stx id danglingDot info.lctx none)
private partial def getIndentationAmount (fileMap : FileMap) (line : Nat) : Nat := Id.run do
let lineStartPos := fileMap.lineStart line
let lineEndPos := fileMap.lineStart (line + 1)
let mut it : String.Iterator := fileMap.source, lineStartPos
let mut indentationAmount := 0
while it.pos < lineEndPos do
let c := it.curr
if c = ' ' || c = '\t' then
indentationAmount := indentationAmount + 1
else
break
it := it.next
return indentationAmount
private partial def isSyntheticTacticCompletion
(fileMap : FileMap)
(hoverPos : String.Pos)
(cmdStx : Syntax)
: Bool := Id.run do
let hoverFilePos := fileMap.toPosition hoverPos
let mut hoverLineIndentation := getIndentationAmount fileMap hoverFilePos.line
if hoverFilePos.column < hoverLineIndentation then
-- Ignore trailing whitespace after the cursor
hoverLineIndentation := hoverFilePos.column
go hoverFilePos hoverLineIndentation cmdStx 0
where
go
(hoverFilePos : Position)
(hoverLineIndentation : Nat)
(stx : Syntax)
(leadingWs : Nat)
: Bool := Id.run do
match stx.getPos?, stx.getTailPos? with
| some startPos, some endPos =>
let isCursorInCompletionRange :=
startPos.byteIdx - leadingWs <= hoverPos.byteIdx
&& hoverPos.byteIdx <= endPos.byteIdx + stx.getTrailingSize
if ! isCursorInCompletionRange then
return false
let mut wsBeforeArg := leadingWs
for arg in stx.getArgs do
if go hoverFilePos hoverLineIndentation arg wsBeforeArg then
return true
-- We must account for the whitespace before an argument because the syntax nodes we use
-- to identify tactic blocks only start *after* the whitespace following a `by`, and we
-- want to provide tactic completions in that whitespace as well.
-- This method of computing whitespace assumes that there are no syntax nodes without tokens
-- after `by` and before the first proper tactic syntax.
wsBeforeArg := arg.getTrailingSize
return isCompletionInEmptyTacticBlock stx
|| isCompletionAfterSemicolon stx
|| isCompletionOnTacticBlockIndentation hoverFilePos hoverLineIndentation stx
| _, _ =>
-- Empty tactic blocks typically lack ranges since they do not contain any tokens.
-- We do not perform more precise range checking in this case because we assume that empty
-- tactic blocks always occur within other syntax with ranges that let us narrow down the
-- search to the degree that we can be sure that the cursor is indeed in this empty tactic
-- block.
return isCompletionInEmptyTacticBlock stx
isCompletionOnTacticBlockIndentation
(hoverFilePos : Position)
(hoverLineIndentation : Nat)
(stx : Syntax)
: Bool := Id.run do
let isCursorInIndentation := hoverFilePos.column <= hoverLineIndentation
if ! isCursorInIndentation then
-- Do not trigger tactic completion at the end of a properly indented tactic block line since
-- that line might already have entered term mode by that point.
return false
let some tacticsNode := getTacticsNode? stx
| return false
let some firstTacticPos := tacticsNode.getPos?
| return false
let firstTacticLine := fileMap.toPosition firstTacticPos |>.line
let firstTacticIndentation := getIndentationAmount fileMap firstTacticLine
-- This ensures that we do not accidentally provide tactic completions in a term mode proof -
-- tactic completions are only provided at the same indentation level as the other tactics in
-- that tactic block.
let isCursorInTacticBlock := hoverLineIndentation == firstTacticIndentation
return isCursorInProperWhitespace && isCursorInTacticBlock
isCompletionAfterSemicolon (stx : Syntax) : Bool := Id.run do
let some tacticsNode := getTacticsNode? stx
| return false
let tactics := tacticsNode.getArgs
-- We want to provide completions in the case of `skip;<CURSOR>`, so the cursor must only be on
-- whitespace, not in proper whitespace.
return isCursorOnWhitspace && tactics.any fun tactic => Id.run do
let some tailPos := tactic.getTailPos?
| return false
let isCursorAfterSemicolon :=
tactic.isToken ";"
&& tailPos.byteIdx <= hoverPos.byteIdx
&& hoverPos.byteIdx <= tailPos.byteIdx + tactic.getTrailingSize
return isCursorAfterSemicolon
getTacticsNode? (stx : Syntax) : Option Syntax :=
if stx.getKind == `Lean.Parser.Tactic.tacticSeq1Indented then
some stx[0]
else if stx.getKind == `Lean.Parser.Tactic.tacticSeqBracketed then
some stx[1]
else
none
isCompletionInEmptyTacticBlock (stx : Syntax) : Bool :=
isCursorInProperWhitespace && isEmptyTacticBlock stx
isCursorOnWhitspace : Bool :=
fileMap.source.atEnd hoverPos || (fileMap.source.get hoverPos).isWhitespace
isCursorInProperWhitespace : Bool :=
(fileMap.source.atEnd hoverPos || (fileMap.source.get hoverPos).isWhitespace)
&& (fileMap.source.get (hoverPos - 1)).isWhitespace
isEmptyTacticBlock (stx : Syntax) : Bool :=
stx.getKind == `Lean.Parser.Tactic.tacticSeq && isEmpty stx
|| stx.getKind == `Lean.Parser.Tactic.tacticSeq1Indented && isEmpty stx
|| stx.getKind == `Lean.Parser.Tactic.tacticSeqBracketed && isEmpty stx[1]
isEmpty : Syntax Bool
| .missing => true
| .ident .. => false
| .atom .. => false
| .node _ _ args => args.all isEmpty
private partial def findOutermostContextInfo? (i : InfoTree) : Option ContextInfo :=
go i
where
go (i : InfoTree) : Option ContextInfo := do
match i with
| .context ctx i =>
match ctx with
| .commandCtx ctxInfo =>
some { ctxInfo with }
| _ =>
-- This shouldn't happen (see the `PartialContextInfo` docstring),
-- but let's continue searching regardless
go i
| .node _ cs =>
cs.findSome? go
| .hole .. =>
none
private def findSyntheticTacticCompletion?
(fileMap : FileMap)
(hoverPos : String.Pos)
(cmdStx : Syntax)
(infoTree : InfoTree)
: Option (HoverInfo × ContextInfo × CompletionInfo) := do
let ctx findOutermostContextInfo? infoTree
if ! isSyntheticTacticCompletion fileMap hoverPos cmdStx then
none
-- Neither `HoverInfo` nor the syntax in `.tactic` are important for tactic completion.
return (HoverInfo.after, ctx, .tactic .missing)
private def findCompletionInfoAt?
(fileMap : FileMap)
(hoverPos : String.Pos)
(cmdStx : Syntax)
(infoTree : InfoTree)
: Option (HoverInfo × ContextInfo × CompletionInfo) :=
let hoverLine, _ := fileMap.toPosition hoverPos
match infoTree.foldInfo (init := none) (choose hoverLine) with
| some (hoverInfo, ctx, Info.ofCompletionInfo info) =>
some (hoverInfo, ctx, info)
| _ => do
-- No completion info => Attempt providing identifier completions
let some (ctx, info) := findClosestInfoWithLocalContextAt? hoverPos infoTree
| none
let some stack := info.stx.findStack? (·.getRange?.any (·.contains hoverPos (includeStop := true)))
| none
let stack := stack.dropWhile fun (stx, _) => !(stx matches `($_:ident) || stx matches `($_:ident.))
let some (stx, _) := stack.head?
| none
let isDotIdCompletion := stack.any fun (stx, _) => stx matches `(.$_:ident)
if isDotIdCompletion then
-- An identifier completion is never useful in a dotId completion context.
none
let some (id, danglingDot) :=
match stx with
| `($id:ident) => some (id.getId, false)
| `($id:ident.) => some (id.getId, true)
| _ => none
| none
let tailPos := stx.getTailPos?.get!
let hoverInfo :=
if hoverPos < tailPos then
HoverInfo.inside (tailPos - hoverPos).byteIdx
else
HoverInfo.after
some (hoverInfo, ctx, .id stx id danglingDot info.lctx none)
| _ =>
findSyntheticTacticCompletion? fileMap hoverPos cmdStx infoTree <|>
findSyntheticIdentifierCompletion? hoverPos infoTree
where
choose
(hoverLine : Nat)
@@ -817,10 +997,11 @@ partial def find?
(params : CompletionParams)
(fileMap : FileMap)
(hoverPos : String.Pos)
(cmdStx : Syntax)
(infoTree : InfoTree)
(caps : ClientCapabilities)
: IO (Option CompletionList) := do
let some (hoverInfo, ctx, info) := findCompletionInfoAt? fileMap hoverPos infoTree
let some (hoverInfo, ctx, info) := findCompletionInfoAt? fileMap hoverPos cmdStx infoTree
| return none
let completionList?
match info with
@@ -846,11 +1027,12 @@ in the context found at `hoverPos` in `infoTree`.
def resolveCompletionItem?
(fileMap : FileMap)
(hoverPos : String.Pos)
(cmdStx : Syntax)
(infoTree : InfoTree)
(item : CompletionItem)
(id : CompletionIdentifier)
: IO CompletionItem := do
let some (_, ctx, info) := findCompletionInfoAt? fileMap hoverPos infoTree
let some (_, ctx, info) := findCompletionInfoAt? fileMap hoverPos cmdStx infoTree
| return item
ctx.runMetaM info.lctx (item.resolve id)

View File

@@ -569,7 +569,7 @@ section MessageHandling
let text := st.doc.meta.text
match st.importCachingTask? with
| none => IO.asTask do
| none => IO.asTask (prio := Task.Priority.dedicated) do
let availableImports ImportCompletion.collectAvailableImports
let lastRequestTimestampMs IO.monoMsNow
let completions := ImportCompletion.find text st.doc.initSnap.stx params availableImports
@@ -660,8 +660,8 @@ section MainLoop
let filterFinishedTasks (acc : PendingRequestMap) (id : RequestID) (task : Task (Except IO.Error Unit))
: IO PendingRequestMap := do
if ( hasFinished task) then
/- Handler tasks are constructed so that the only possible errors here
are failures of writing a response into the stream. -/
-- Handler tasks are constructed so that the only possible errors here
-- are failures of writing a response into the stream.
if let Except.error e := task.get then
throwServerError s!"Failed responding to request {id}: {e}"
pure <| acc.erase id
@@ -697,7 +697,7 @@ end MainLoop
def runRefreshTask : WorkerM (Task (Except IO.Error Unit)) := do
let ctx read
IO.asTask do
IO.asTask (prio := Task.Priority.dedicated) do
while ! (IO.checkCanceled) do
let pastProcessingStates ctx.chanIsProcessing.recvAllCurrent
if pastProcessingStates.isEmpty then
@@ -709,37 +709,34 @@ def runRefreshTask : WorkerM (Task (Except IO.Error Unit)) := do
sendServerRequest ctx "workspace/semanticTokens/refresh" (none : Option Nat)
IO.sleep 2000
def initAndRunWorker (i o e : FS.Stream) (opts : Options) : IO UInt32 := do
def initAndRunWorker (i o e : FS.Stream) (opts : Options) : IO Unit := do
let i maybeTee "fwIn.txt" false i
let o maybeTee "fwOut.txt" true o
let initParams i.readLspRequestAs "initialize" InitializeParams
let _, param i.readLspNotificationAs "textDocument/didOpen" LeanDidOpenTextDocumentParams
let doc := param.textDocument
/- Note (kmill): LSP always refers to characters by (line, column),
so converting CRLF to LF preserves line and column numbers. -/
-- LSP always refers to characters by (line, column),
-- so converting CRLF to LF preserves line and column numbers.
let meta : DocumentMeta := doc.uri, doc.version, doc.text.crlfToLf.toFileMap, param.dependencyBuildMode?.getD .always
let e := e.withPrefix s!"[{param.textDocument.uri}] "
let _ IO.setStderr e
let (ctx, st) try
initializeWorker meta o e initParams.param opts
catch err =>
writeError meta err
return (1 : UInt32)
let exitCode StateRefT'.run' (s := st) <| ReaderT.run (r := ctx) do
writeErrorDiag meta err
throw err
StateRefT'.run' (s := st) <| ReaderT.run (r := ctx) do
try
let refreshTask runRefreshTask
mainLoop i
IO.cancel refreshTask
return 0
catch err =>
let st get
writeError st.doc.meta err
return 1
return exitCode
writeErrorDiag st.doc.meta err
throw err
where
writeError (meta : DocumentMeta) (err : Error) : IO Unit := do
IO.eprintln err
e.writeLspMessage <| mkPublishDiagnosticsNotification meta #[{
writeErrorDiag (meta : DocumentMeta) (err : Error) : IO Unit := do
o.writeLspMessage <| mkPublishDiagnosticsNotification meta #[{
range := 0, 0, 1, 0,
fullRange? := some 0, 0, meta.text.utf8PosToLspPos meta.text.source.endPos
severity? := DiagnosticSeverity.error
@@ -751,14 +748,10 @@ def workerMain (opts : Options) : IO UInt32 := do
let o IO.getStdout
let e IO.getStderr
try
let exitCode initAndRunWorker i o e opts
-- HACK: all `Task`s are currently "foreground", i.e. we join on them on main thread exit, but we definitely don't
-- want to do that in the case of the worker processes, which can produce non-terminating tasks evaluating user code
o.flush
e.flush
IO.Process.exit exitCode.toUInt8
initAndRunWorker i o e opts
IO.Process.exit 0 -- Terminate all tasks of this process
catch err =>
e.putStrLn s!"worker initialization error: {err}"
return (1 : UInt32)
e.putStrLn err.toString
IO.Process.exit 1 -- Terminate all tasks of this process
end Lean.Server.FileWorker

View File

@@ -28,14 +28,14 @@ open Snapshots
open Lean.Parser.Tactic.Doc (alternativeOfTactic getTacticExtensionString)
def findCompletionInfoTreeAtPos
def findCompletionCmdDataAtPos
(doc : EditableDocument)
(pos : String.Pos)
: Task (Option Elab.InfoTree) :=
-- NOTE: use `+ 1` since we sometimes want to consider invalid input technically after the command,
-- such as a trailing dot after an option name. This shouldn't be a problem since any subsequent
-- snapshot that is eligible for completion should be separated by some delimiter.
findInfoTreeAtPos doc (fun s => s.data.stx.getTailPos?.any (· + 1 >= pos)) pos
: Task (Option (Syntax × Elab.InfoTree)) :=
findCmdDataAtPos doc (pos := pos) fun s => Id.run do
let some tailPos := s.data.stx.getTailPos?
| return false
return pos.byteIdx <= tailPos.byteIdx + s.data.stx.getTrailingSize
def handleCompletion (p : CompletionParams)
: RequestM (RequestTask CompletionList) := do
@@ -43,11 +43,11 @@ def handleCompletion (p : CompletionParams)
let text := doc.meta.text
let pos := text.lspPosToUtf8Pos p.position
let caps := ( read).initParams.capabilities
mapTask (findCompletionInfoTreeAtPos doc pos) fun infoTree? => do
let some infoTree := infoTree?
mapTask (findCompletionCmdDataAtPos doc pos) fun cmdData? => do
let some (cmdStx, infoTree) := cmdData?
-- work around https://github.com/microsoft/vscode/issues/155738
| return { items := #[{label := "-"}], isIncomplete := true }
if let some r Completion.find? p doc.meta.text pos infoTree caps then
if let some r Completion.find? p doc.meta.text pos cmdStx infoTree caps then
return r
return { items := #[ ], isIncomplete := true }
@@ -67,10 +67,10 @@ def handleCompletionItemResolve (item : CompletionItem)
let some id := data.id?
| return .pure item
let pos := text.lspPosToUtf8Pos data.params.position
mapTask (findCompletionInfoTreeAtPos doc pos) fun infoTree? => do
let some infoTree := infoTree?
mapTask (findCompletionCmdDataAtPos doc pos) fun cmdData? => do
let some (cmdStx, infoTree) := cmdData?
| return item
Completion.resolveCompletionItem? text pos infoTree item id
Completion.resolveCompletionItem? text pos cmdStx infoTree item id
open Elab in
def handleHover (p : HoverParams)
@@ -248,7 +248,7 @@ def getInteractiveGoals (p : Lsp.PlainGoalParams) : RequestM (RequestTask (Optio
let goals ci.runMetaM {} (do
let goals := List.toArray <| if useAfter then ti.goalsAfter else ti.goalsBefore
let goals goals.mapM Widget.goalToInteractive
return {goals}
return goals
)
-- compute the goal diff
ciAfter.runMetaM {} (do

View File

@@ -172,11 +172,6 @@ def Info.isSmaller (i₁ i₂ : Info) : Bool :=
| some _, none => true
| _, _ => false
def Info.occursDirectlyBefore (i : Info) (hoverPos : String.Pos) : Bool := Id.run do
let some tailPos := i.tailPos?
| return false
return tailPos == hoverPos
def Info.occursInside? (i : Info) (hoverPos : String.Pos) : Option String.Pos := do
let headPos i.pos?
let tailPos i.tailPos?
@@ -359,26 +354,28 @@ structure GoalsAtResult where
where to show intermediate states by calling `withTacticInfoContext`) -/
partial def InfoTree.goalsAt? (text : FileMap) (t : InfoTree) (hoverPos : String.Pos) : List GoalsAtResult :=
let gs := t.collectNodesBottomUp fun ctx i cs gs => Id.run do
if let Info.ofTacticInfo ti := i then
if let (some pos, some tailPos) := (i.pos?, i.tailPos?) then
let trailSize := i.stx.getTrailingSize
-- show info at EOF even if strictly outside token + trail
let atEOF := tailPos.byteIdx + trailSize == text.source.endPos.byteIdx
-- include at least one trailing character (see also `priority` below)
if pos hoverPos (hoverPos.byteIdx < tailPos.byteIdx + max 1 trailSize || atEOF) then
-- overwrite bottom-up results according to "innermost" heuristics documented above
if gs.isEmpty || hoverPos tailPos && gs.all (·.indented) then
return [{
ctxInfo := ctx
tacticInfo := ti
useAfter := hoverPos > pos && !cs.any (hasNestedTactic pos tailPos)
-- consider every position unindented after an empty `by` to support "hanging" `by` uses
indented := (text.toPosition pos).column > (text.toPosition hoverPos).column && !isEmptyBy ti.stx
-- use goals just before cursor as fall-back only
-- thus for `(by foo)`, placing the cursor after `foo` shows its state as long
-- as there is no state on `)`
priority := if hoverPos.byteIdx == tailPos.byteIdx + trailSize then 0 else 1
}]
let Info.ofTacticInfo ti := i
| return gs
let (some pos, some tailPos) := (i.pos?, i.tailPos?)
| return gs
let trailSize := i.stx.getTrailingSize
-- show info at EOF even if strictly outside token + trail
let atEOF := tailPos.byteIdx + trailSize == text.source.endPos.byteIdx
-- include at least one trailing character (see also `priority` below)
if pos hoverPos (hoverPos.byteIdx < tailPos.byteIdx + max 1 trailSize || atEOF) then
-- overwrite bottom-up results according to "innermost" heuristics documented above
if gs.isEmpty || hoverPos tailPos && gs.all (·.indented) then
return [{
ctxInfo := ctx
tacticInfo := ti
useAfter := hoverPos > pos && !cs.any (hasNestedTactic pos tailPos)
-- consider every position unindented after an empty `by` to support "hanging" `by` uses
indented := (text.toPosition pos).column > (text.toPosition hoverPos).column && !isEmptyBy ti.stx
-- use goals just before cursor as fall-back only
-- thus for `(by foo)`, placing the cursor after `foo` shows its state as long
-- as there is no state on `)`
priority := if hoverPos.byteIdx == tailPos.byteIdx + trailSize then 0 else 1
}]
return gs
let maxPrio? := gs.map (·.priority) |>.max?
gs.filter (some ·.priority == maxPrio?)

View File

@@ -210,6 +210,28 @@ partial def findInfoTreeAtPos
some s.cmdState.infoState.trees[0]!
| none => .pure none
open Language in
/--
Finds the command syntax and info tree of the first snapshot task matching `isMatchingSnapshot` and
containing `pos`, asynchronously. The info tree may be from a nested snapshot,
such as a single tactic.
See `SnapshotTree.findInfoTreeAtPos` for details on how the search is done.
-/
def findCmdDataAtPos
(doc : EditableDocument)
(isMatchingSnapshot : Lean.CommandParsedSnapshot Bool)
(pos : String.Pos)
: Task (Option (Syntax × Elab.InfoTree)) :=
findCmdParsedSnap doc (isMatchingSnapshot ·) |>.bind (sync := true) fun
| some cmdParsed => toSnapshotTree cmdParsed |>.findInfoTreeAtPos pos |>.bind (sync := true) fun
| some infoTree => .pure <| some (cmdParsed.data.stx, infoTree)
| none => cmdParsed.data.finishedSnap.task.map (sync := true) fun s =>
-- the parser returns exactly one command per snapshot, and the elaborator creates exactly one node per command
assert! s.cmdState.infoState.trees.size == 1
some (cmdParsed.data.stx, s.cmdState.infoState.trees[0]!)
| none => .pure none
/--
Finds the info tree of the first snapshot task containing `pos` (including trailing whitespace),
asynchronously. The info tree may be from a nested snapshot, such as a single tactic.

View File

@@ -6,6 +6,7 @@ Authors: Marc Huisinga, Wojciech Nawrocki
-/
prelude
import Init.System.IO
import Init.System.Mutex
import Init.Data.ByteArray
import Lean.Data.RBMap
@@ -112,6 +113,7 @@ section FileWorker
structure FileWorker where
doc : DocumentMeta
proc : Process.Child workerCfg
exitCode : IO.Mutex (Option UInt32)
commTask : Task WorkerEvent
state : WorkerState
-- This should not be mutated outside of namespace FileWorker,
@@ -145,6 +147,29 @@ section FileWorker
| .running => #[]
| .crashed queuedMsgs _ => queuedMsgs
def waitForProc (fw : FileWorker) : IO UInt32 :=
fw.exitCode.atomically do
match get with
| none =>
let exitCode fw.proc.wait
set <| some exitCode
return exitCode
| some exitCode =>
return exitCode
def killProcAndWait (fw : FileWorker) : IO UInt32 :=
fw.exitCode.atomically do
match get with
| none =>
fw.proc.kill
let exitCode fw.proc.wait
set <| some exitCode
return exitCode
| some exitCode =>
-- Process is already dead
return exitCode
end FileWorker
end FileWorker
@@ -286,72 +311,76 @@ section ServerM
/-- Creates a Task which forwards a worker's messages into the output stream until an event
which must be handled in the main watchdog thread (e.g. an I/O error) happens. -/
private partial def forwardMessages (fw : FileWorker) : ServerM (Task WorkerEvent) := do
let o := (read).hOut
let rec loop : ServerM WorkerEvent := do
try
let msg fw.stdout.readLspMessage
-- Re. `o.writeLspMessage msg`:
-- Writes to Lean I/O channels are atomic, so these won't trample on each other.
match msg with
| Message.response id _ => do
fw.erasePendingRequest id
o.writeLspMessage msg
| Message.responseError id _ _ _ => do
fw.erasePendingRequest id
o.writeLspMessage msg
| Message.request id method params? =>
let globalID (read).serverRequestData.modifyGet
(·.trackOutboundRequest fw.doc.uri id)
o.writeLspMessage (Message.request globalID method params?)
| Message.notification "$/lean/ileanInfoUpdate" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleIleanInfoUpdate fw params
| Message.notification "$/lean/ileanInfoFinal" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleIleanInfoFinal fw params
| Message.notification "$/lean/importClosure" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleImportClosure fw params
| _ => o.writeLspMessage msg
catch err =>
-- If writeLspMessage from above errors we will block here, but the main task will
-- quit eventually anyways if that happens
let exitCode fw.proc.wait
-- Remove surviving descendant processes, if any, such as from nested builds.
-- On Windows, we instead rely on elan doing this.
try fw.proc.kill catch _ => pure ()
match exitCode with
| 0 =>
-- Worker was terminated
fw.errorPendingRequests o ErrorCode.contentModified
(s!"The file worker for {fw.doc.uri} has been terminated. "
++ "Either the header has changed, or the file was closed, "
++ " or the server is shutting down.")
-- one last message to clear the diagnostics for this file so that stale errors
-- do not remain in the editor forever.
o.writeLspMessage <| mkPublishDiagnosticsNotification fw.doc #[]
return WorkerEvent.terminated
| 2 =>
return .importsChanged
| _ =>
-- Worker crashed
let (errorCode, errorCausePointer) :=
if exitCode = 1 then
(ErrorCode.workerExited, "see stderr for exception")
else
(ErrorCode.workerCrashed, "likely due to a stack overflow or a bug")
fw.errorPendingRequests o errorCode
s!"Server process for {fw.doc.uri} crashed, {errorCausePointer}."
o.writeLspMessage <| mkFileProgressAtPosNotification fw.doc 0 (kind := LeanFileProgressKind.fatalError)
return WorkerEvent.crashed err
loop
let task IO.asTask (loop $ read) Task.Priority.dedicated
return task.map fun
| Except.ok ev => ev
| Except.error e => WorkerEvent.ioError e
where
loop : ServerM WorkerEvent := do
let o := (read).hOut
let msg
try
fw.stdout.readLspMessage
catch err =>
let exitCode fw.waitForProc
-- Remove surviving descendant processes, if any, such as from nested builds.
-- On Windows, we instead rely on elan doing this.
try fw.proc.kill catch _ => pure ()
-- TODO: Wait for process group to finish
match exitCode with
| 0 =>
-- Worker was terminated
fw.errorPendingRequests o ErrorCode.contentModified
(s!"The file worker for {fw.doc.uri} has been terminated. "
++ "Either the header has changed, or the file was closed, "
++ " or the server is shutting down.")
-- one last message to clear the diagnostics for this file so that stale errors
-- do not remain in the editor forever.
o.writeLspMessage <| mkPublishDiagnosticsNotification fw.doc #[]
return WorkerEvent.terminated
| 2 =>
return .importsChanged
| _ =>
-- Worker crashed
let (errorCode, errorCausePointer) :=
if exitCode = 1 then
(ErrorCode.workerExited, "see stderr for exception")
else
(ErrorCode.workerCrashed, "likely due to a stack overflow or a bug")
fw.errorPendingRequests o errorCode
s!"Server process for {fw.doc.uri} crashed, {errorCausePointer}."
o.writeLspMessage <| mkFileProgressAtPosNotification fw.doc 0 (kind := LeanFileProgressKind.fatalError)
return WorkerEvent.crashed err
-- Re. `o.writeLspMessage msg`:
-- Writes to Lean I/O channels are atomic, so these won't trample on each other.
match msg with
| Message.response id _ => do
fw.erasePendingRequest id
o.writeLspMessage msg
| Message.responseError id _ _ _ => do
fw.erasePendingRequest id
o.writeLspMessage msg
| Message.request id method params? =>
let globalID (read).serverRequestData.modifyGet
(·.trackOutboundRequest fw.doc.uri id)
o.writeLspMessage (Message.request globalID method params?)
| Message.notification "$/lean/ileanInfoUpdate" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleIleanInfoUpdate fw params
| Message.notification "$/lean/ileanInfoFinal" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleIleanInfoFinal fw params
| Message.notification "$/lean/importClosure" params =>
if let some params := params then
if let Except.ok params := FromJson.fromJson? <| ToJson.toJson params then
handleImportClosure fw params
| _ =>
o.writeLspMessage msg
loop
def startFileWorker (m : DocumentMeta) : ServerM Unit := do
( read).hOut.writeLspMessage <| mkFileProgressAtPosNotification m 0
@@ -363,6 +392,7 @@ section ServerM
-- open session for `kill` above
setsid := true
}
let exitCode IO.Mutex.new none
let pendingRequestsRef IO.mkRef (RBMap.empty : PendingRequestMap)
let initialDependencyBuildMode := m.dependencyBuildMode
let updatedDependencyBuildMode :=
@@ -376,6 +406,7 @@ section ServerM
let fw : FileWorker := {
doc := { m with dependencyBuildMode := updatedDependencyBuildMode}
proc := workerProc
exitCode
commTask := Task.pure WorkerEvent.terminated
state := WorkerState.running
pendingRequestsRef := pendingRequestsRef
@@ -756,7 +787,9 @@ section NotificationHandling
let newDoc : DocumentMeta := doc.uri, newVersion, newDocText, oldDoc.dependencyBuildMode
updateFileWorkers { fw with doc := newDoc }
let notification := Notification.mk "textDocument/didChange" p
tryWriteMessage doc.uri notification (restartCrashedWorker := true)
-- Don't queue failed `didChange` notifications because we already accumulate them in the
-- document and hand the updated document to the file worker when restarting it.
tryWriteMessage doc.uri notification (restartCrashedWorker := true) (queueFailedMessage := false)
/--
When a file is saved, notifies all file workers for files that depend on this file that this
@@ -948,7 +981,8 @@ section MainLoop
for uri, _ in fileWorkers do
terminateFileWorker uri
for _, fw in fileWorkers do
discard <| IO.wait fw.commTask
-- TODO: Wait for process group to finish instead
try let _ fw.killProcAndWait catch _ => pure ()
inductive ServerEvent where
| workerEvent (fw : FileWorker) (ev : WorkerEvent)
@@ -961,7 +995,7 @@ section MainLoop
/- Runs asynchronously. -/
let msg st.hIn.readLspMessage
pure <| ServerEvent.clientMsg msg
let clientTask := ( IO.asTask readMsgAction).map fun
let clientTask := ( IO.asTask (prio := Task.Priority.dedicated) readMsgAction).map fun
| Except.ok ev => ev
| Except.error e => ServerEvent.clientError e
return clientTask
@@ -1127,7 +1161,7 @@ results in requests that need references.
def startLoadingReferences (references : IO.Ref References) : IO Unit := do
-- Discard the task; there isn't much we can do about this failing,
-- but we should try to continue server operations regardless
let _ IO.asTask do
let _ IO.asTask (prio := Task.Priority.dedicated) do
let oleanSearchPath Lean.searchPathRef.get
for path in oleanSearchPath.findAllWithExt "ilean" do
try
@@ -1188,9 +1222,9 @@ def watchdogMain (args : List String) : IO UInt32 := do
let e IO.getStderr
try
initAndRunWatchdog args i o e
return 0
IO.Process.exit 0 -- Terminate all tasks of this process
catch err =>
e.putStrLn s!"Watchdog error: {err}"
return 1
IO.Process.exit 1 -- Terminate all tasks of this process
end Lean.Server.Watchdog

View File

@@ -75,6 +75,13 @@ instance [BEq α] [Hashable α] : Inhabited (DHashMap α β) where
(b : β a) : DHashMap α β :=
Raw₀.insert m.1, m.2.size_buckets_pos a b, .insert₀ m.2
instance : Singleton ((a : α) × β a) (DHashMap α β) := fun a, b => DHashMap.empty.insert a b
instance : Insert ((a : α) × β a) (DHashMap α β) := fun a, b s => s.insert a b
instance : LawfulSingleton ((a : α) × β a) (DHashMap α β) :=
fun _ => rfl
@[inline, inherit_doc Raw.insertIfNew] def insertIfNew (m : DHashMap α β)
(a : α) (b : β a) : DHashMap α β :=
Raw₀.insertIfNew m.1, m.2.size_buckets_pos a b, .insertIfNew₀ m.2
@@ -261,6 +268,12 @@ instance [BEq α] [Hashable α] : ForIn m (DHashMap α β) ((a : α) × β a) wh
DHashMap α β :=
insertMany l
/-- Computes the union of the given hash maps, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : DHashMap α β) : DHashMap α β :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (DHashMap α β) := union
@[inline, inherit_doc Raw.Const.ofList] def Const.ofList {β : Type v} [BEq α] [Hashable α]
(l : List (α × β)) : DHashMap α (fun _ => β) :=
Const.insertMany l

View File

@@ -87,6 +87,12 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] :
m.isEmpty = true a, ¬a m := by
simpa [mem_iff_contains] using isEmpty_iff_forall_contains
@[simp] theorem insert_eq_insert {p : (a : α) × β a} : Insert.insert p m = m.insert p.1 p.2 := rfl
@[simp] theorem singleton_eq_insert {p : (a : α) × β a} :
Singleton.singleton p = ( : DHashMap α β).insert p.1 p.2 :=
rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] {k a : α} {v : β k} :
(m.insert k v).contains a = (k == a || m.contains a) :=

View File

@@ -65,6 +65,15 @@ Inserts the given mapping into the map, replacing an existing mapping for the ke
(Raw₀.insert m, h a b).1
else m -- will never happen for well-formed inputs
instance [BEq α] [Hashable α] : Singleton ((a : α) × β a) (Raw α β) :=
fun a, b => Raw.empty.insert a b
instance [BEq α] [Hashable α] : Insert ((a : α) × β a) (Raw α β) :=
fun a, b s => s.insert a b
instance [BEq α] [Hashable α] : LawfulSingleton ((a : α) × β a) (Raw α β) :=
fun _ => rfl
/--
If there is no mapping for the given key, inserts the given mapping into the map. Otherwise,
returns the map unaltered.
@@ -399,6 +408,12 @@ occurrence takes precedence. -/
@[inline] def ofList [BEq α] [Hashable α] (l : List ((a : α) × β a)) : Raw α β :=
insertMany l
/-- Computes the union of the given hash maps, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : Raw α β) : Raw α β :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (Raw α β) := union
@[inline, inherit_doc Raw.ofList] def Const.ofList {β : Type v} [BEq α] [Hashable α]
(l : List (α × β)) : Raw α (fun _ => β) :=
Const.insertMany l

View File

@@ -153,6 +153,12 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] (h : m.WF)
m.isEmpty = true a, ¬a m := by
simpa [mem_iff_contains] using isEmpty_iff_forall_contains h
@[simp] theorem insert_eq_insert {p : (a : α) × β a} : Insert.insert p m = m.insert p.1 p.2 := rfl
@[simp] theorem singleton_eq_insert {p : (a : α) × β a} :
Singleton.singleton p = ( : Raw α β).insert p.1 p.2 :=
rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] (h : m.WF) {a k : α} {v : β k} :
(m.insert k v).contains a = (k == a || m.contains a) := by

View File

@@ -76,6 +76,12 @@ instance [BEq α] [Hashable α] : Inhabited (HashMap α β) where
(b : β) : HashMap α β :=
m.inner.insert a b
instance : Singleton (α × β) (HashMap α β) := fun a, b => HashMap.empty.insert a b
instance : Insert (α × β) (HashMap α β) := fun a, b s => s.insert a b
instance : LawfulSingleton (α × β) (HashMap α β) := fun _ => rfl
@[inline, inherit_doc DHashMap.insertIfNew] def insertIfNew (m : HashMap α β)
(a : α) (b : β) : HashMap α β :=
m.inner.insertIfNew a b
@@ -251,6 +257,12 @@ instance [BEq α] [Hashable α] {m : Type w → Type w} : ForIn m (HashMap α β
HashMap α β :=
DHashMap.Const.ofList l
/-- Computes the union of the given hash maps, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : HashMap α β) : HashMap α β :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (HashMap α β) := union
@[inline, inherit_doc DHashMap.Const.unitOfList] def unitOfList [BEq α] [Hashable α] (l : List α) :
HashMap α Unit :=
DHashMap.Const.unitOfList l

View File

@@ -95,6 +95,12 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] :
m.isEmpty = true a, ¬a m :=
DHashMap.isEmpty_iff_forall_not_mem
@[simp] theorem insert_eq_insert {p : α × β} : Insert.insert p m = m.insert p.1 p.2 := rfl
@[simp] theorem singleton_eq_insert {p : α × β} :
Singleton.singleton p = ( : HashMap α β).insert p.1 p.2 :=
rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] {k a : α} {v : β} :
(m.insert k v).contains a = (k == a || m.contains a) :=

View File

@@ -74,6 +74,12 @@ set_option linter.unusedVariables false in
(a : α) (b : β) : Raw α β :=
m.inner.insert a b
instance [BEq α] [Hashable α] : Singleton (α × β) (Raw α β) := fun a, b => Raw.empty.insert a b
instance [BEq α] [Hashable α] : Insert (α × β) (Raw α β) := fun a, b s => s.insert a b
instance [BEq α] [Hashable α] : LawfulSingleton (α × β) (Raw α β) := fun _ => rfl
@[inline, inherit_doc DHashMap.Raw.insertIfNew] def insertIfNew [BEq α] [Hashable α] (m : Raw α β)
(a : α) (b : β) : Raw α β :=
m.inner.insertIfNew a b
@@ -231,10 +237,20 @@ m.inner.values
(l : List (α × β)) : Raw α β :=
DHashMap.Raw.Const.ofList l
/-- Computes the union of the given hash maps, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : Raw α β) : Raw α β :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (Raw α β) := union
@[inline, inherit_doc DHashMap.Raw.Const.unitOfList] def unitOfList [BEq α] [Hashable α]
(l : List α) : Raw α Unit :=
DHashMap.Raw.Const.unitOfList l
@[inline, inherit_doc DHashMap.Raw.Const.unitOfArray] def unitOfArray [BEq α] [Hashable α]
(l : Array α) : Raw α Unit :=
DHashMap.Raw.Const.unitOfArray l
@[inherit_doc DHashMap.Raw.Internal.numBuckets] def Internal.numBuckets (m : Raw α β) : Nat :=
DHashMap.Raw.Internal.numBuckets m.inner

View File

@@ -108,6 +108,12 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] (h : m.WF)
m.isEmpty = true a, ¬a m :=
DHashMap.Raw.isEmpty_iff_forall_not_mem h.out
@[simp] theorem insert_eq_insert {p : α × β} : Insert.insert p m = m.insert p.1 p.2 := rfl
@[simp] theorem singleton_eq_insert {p : α × β} :
Singleton.singleton p = ( : Raw α β).insert p.1 p.2 :=
rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] (h : m.WF) {k a : α} {v : β} :
(m.insert k v).contains a = (k == a || m.contains a) :=

View File

@@ -77,6 +77,10 @@ equal (with regard to `==`) to the given element, then the hash set is returned
@[inline] def insert (m : HashSet α) (a : α) : HashSet α :=
m.inner.insertIfNew a ()
instance : Singleton α (HashSet α) := fun a => HashSet.empty.insert a
instance : Insert α (HashSet α) := fun a s => s.insert a
/--
Checks whether an element is present in a set and inserts the element if it was not found.
If the hash set already contains an element that is equal (with regard to `==`) to the given
@@ -192,6 +196,18 @@ instance [BEq α] [Hashable α] {m : Type v → Type v} : ForM m (HashSet α) α
instance [BEq α] [Hashable α] {m : Type v Type v} : ForIn m (HashSet α) α where
forIn m init f := m.forIn f init
/-- Check if all elements satisfy the predicate, short-circuiting if a predicate fails. -/
@[inline] def all (m : HashSet α) (p : α Bool) : Bool := Id.run do
for a in m do
if ¬ p a then return false
return true
/-- Check if any element satisfies the predicate, short-circuiting if a predicate succeeds. -/
@[inline] def any (m : HashSet α) (p : α Bool) : Bool := Id.run do
for a in m do
if p a then return true
return false
/-- Transforms the hash set into a list of elements in some order. -/
@[inline] def toList (m : HashSet α) : List α :=
m.inner.keys
@@ -225,10 +241,12 @@ in the collection will be present in the returned hash set.
@[inline] def ofArray [BEq α] [Hashable α] (l : Array α) : HashSet α :=
HashMap.unitOfArray l
/-- Computes the union of the given hash sets. -/
/-- Computes the union of the given hash sets, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : HashSet α) : HashSet α :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (HashSet α) := union
/--
Returns the number of buckets in the internal representation of the hash set. This function may
be useful for things like monitoring system health, but it should be considered an internal

View File

@@ -89,6 +89,10 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] :
m.isEmpty = true a, ¬a m :=
HashMap.isEmpty_iff_forall_not_mem
@[simp] theorem insert_eq_insert {a : α} : Insert.insert a m = m.insert a := rfl
@[simp] theorem singleton_eq_insert {a : α} : Singleton.singleton a = ( : HashSet α).insert a := rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] {k a : α} :
(m.insert k).contains a = (k == a || m.contains a) :=

View File

@@ -78,6 +78,12 @@ equal (with regard to `==`) to the given element, then the hash set is returned
@[inline] def insert [BEq α] [Hashable α] (m : Raw α) (a : α) : Raw α :=
m.inner.insertIfNew a ()
instance [BEq α] [Hashable α] : Singleton α (Raw α) := fun a => Raw.empty.insert a
instance [BEq α] [Hashable α] : Insert α (Raw α) := fun a s => s.insert a
instance [BEq α] [Hashable α] : LawfulSingleton α (Raw α) := fun _ => rfl
/--
Checks whether an element is present in a set and inserts the element if it was not found.
If the hash set already contains an element that is equal (with regard to `==`) to the given
@@ -188,6 +194,18 @@ instance {m : Type v → Type v} : ForM m (Raw α) α where
instance {m : Type v Type v} : ForIn m (Raw α) α where
forIn m init f := m.forIn f init
/-- Check if all elements satisfy the predicate, short-circuiting if a predicate fails. -/
@[inline] def all (m : Raw α) (p : α Bool) : Bool := Id.run do
for a in m do
if ¬ p a then return false
return true
/-- Check if any element satisfies the predicate, short-circuiting if a predicate succeeds. -/
@[inline] def any (m : Raw α) (p : α Bool) : Bool := Id.run do
for a in m do
if p a then return true
return false
/-- Transforms the hash set into a list of elements in some order. -/
@[inline] def toList (m : Raw α) : List α :=
m.inner.keys
@@ -213,6 +231,20 @@ in the collection will be present in the returned hash set.
@[inline] def ofList [BEq α] [Hashable α] (l : List α) : Raw α :=
HashMap.Raw.unitOfList l
/--
Creates a hash set from an array of elements. Note that unlike repeatedly calling `insert`, if the
collection contains multiple elements that are equal (with regard to `==`), then the last element
in the collection will be present in the returned hash set.
-/
@[inline] def ofArray [BEq α] [Hashable α] (l : Array α) : Raw α :=
HashMap.Raw.unitOfArray l
/-- Computes the union of the given hash sets, by traversing `m₂` and inserting its elements into `m₁`. -/
@[inline] def union [BEq α] [Hashable α] (m₁ m₂ : Raw α) : Raw α :=
m₂.fold (init := m₁) fun acc x => acc.insert x
instance [BEq α] [Hashable α] : Union (Raw α) := union
/--
Returns the number of buckets in the internal representation of the hash set. This function may
be useful for things like monitoring system health, but it should be considered an internal

View File

@@ -104,6 +104,10 @@ theorem isEmpty_iff_forall_not_mem [EquivBEq α] [LawfulHashable α] (h : m.WF)
m.isEmpty = true a, ¬a m :=
HashMap.Raw.isEmpty_iff_forall_not_mem h.out
@[simp] theorem insert_eq_insert {a : α} : Insert.insert a m = m.insert a := rfl
@[simp] theorem singleton_eq_insert {a : α} : Singleton.singleton a = ( : Raw α).insert a := rfl
@[simp]
theorem contains_insert [EquivBEq α] [LawfulHashable α] (h : m.WF) {k a : α} :
(m.insert k).contains a = (k == a || m.contains a) :=

View File

@@ -65,6 +65,14 @@ inductive BVBinOp where
Multiplication.
-/
| mul
/--
Unsigned division.
-/
| udiv
/--
Unsigned modulo.
-/
| umod
namespace BVBinOp
@@ -74,6 +82,8 @@ def toString : BVBinOp → String
| xor => "^"
| add => "+"
| mul => "*"
| udiv => "/ᵤ"
| umod => "%ᵤ"
instance : ToString BVBinOp := toString
@@ -86,12 +96,16 @@ def eval : BVBinOp → (BitVec w → BitVec w → BitVec w)
| xor => (· ^^^ ·)
| add => (· + ·)
| mul => (· * ·)
| udiv => (· / ·)
| umod => (· % · )
@[simp] theorem eval_and : eval .and = ((· &&& ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_or : eval .or = ((· ||| ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_xor : eval .xor = ((· ^^^ ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_add : eval .add = ((· + ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_mul : eval .mul = ((· * ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_udiv : eval .udiv = ((· / ·) : BitVec w BitVec w BitVec w) := by rfl
@[simp] theorem eval_umod : eval .umod = ((· % ·) : BitVec w BitVec w BitVec w) := by rfl
end BVBinOp

View File

@@ -18,6 +18,8 @@ import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.RotateLeft
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.RotateRight
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.SignExtend
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Mul
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Udiv
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Umod
/-!
This module contains the implementation of a bitblaster for `BitVec` expressions (`BVExpr`).
@@ -100,6 +102,20 @@ where
dsimp only at hlaig hraig
omega
res, this
| .udiv =>
let res := bitblast.blastUdiv aig lhs, rhs
have := by
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := bitblast.blastUdiv)
dsimp only at hlaig hraig
omega
res, this
| .umod =>
let res := bitblast.blastUmod aig lhs, rhs
have := by
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := bitblast.blastUmod)
dsimp only at hlaig hraig
omega
res, this
| .un op expr =>
let eaig, evec, heaig := go aig expr
match op with
@@ -210,7 +226,7 @@ theorem bitblast.go_decl_eq (aig : AIG BVBit) (expr : BVExpr w) :
rw [AIG.LawfulVecOperator.decl_eq (f := blastConst)]
| bin lhs op rhs lih rih =>
match op with
| .and | .or | .xor | .add | .mul =>
| .and | .or | .xor | .add | .mul | .udiv | .umod =>
dsimp only [go]
have := (bitblast.go aig lhs).property
have := (go (go aig lhs).1.aig rhs).property

View File

@@ -19,6 +19,8 @@ import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.ShiftRight
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.SignExtend
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Ult
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.ZeroExtend
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Udiv
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Umod
/-!
This directory contains the implementations of bitblasters for all basic operations on `BVExpr`

View File

@@ -15,8 +15,9 @@ circuit mirrors the behavior of `BitVec.mulRec`.
Note that the implementation performs a symbolic branch over the bits of the right hand side.
Thus if the right hand side is (partially) known through constant propagation etc. the symbolic
branches will be (partially) constant folded away by the AIG optimizer. The preprocessing simp set
of `bv_decide` ensures that constants always end up on the right hand side for this reason.
branches will be (partially) constant folded away by the AIG optimizer. The preprocessing of
`blastMul` ensures that the value with more known bits always end up on the right hand side for
this reason.
-/
namespace Std.Tactic.BVDecide

View File

@@ -0,0 +1,61 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Add
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Not
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Const
/-!
This module contains the implementation of a bitblaster for `BitVec.neg`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
def blastNeg (aig : AIG α) (input : AIG.RefVec aig w) : AIG.RefVecEntry α w :=
let res := blastNot aig input
let aig := res.aig
let notInput := res.vec
let res := blastConst aig 1#w
let aig := res.aig
let one := res.vec
let notInput := notInput.cast <| AIG.LawfulVecOperator.le_size (f := blastConst) ..
blastAdd aig notInput, one
instance : AIG.LawfulVecOperator α AIG.RefVec blastNeg where
le_size := by
intros
unfold blastNeg
dsimp only
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastAdd)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastConst)
apply AIG.LawfulVecOperator.le_size (f := blastNot)
decl_eq := by
intros
unfold blastNeg
dsimp only
rw [AIG.LawfulVecOperator.decl_eq (f := blastAdd)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastConst)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastNot)]
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastNot)
assumption
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastNot)
assumption
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,50 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Neg
/-!
This module contains the implementation of a bitblaster for `BitVec.sub`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
def blastSub (aig : AIG α) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry α w :=
let lhs, rhs := input
let res := blastNeg aig rhs
let aig := res.aig
let negRhs := res.vec
let lhs := lhs.cast <| AIG.LawfulVecOperator.le_size (f := blastNeg) ..
blastAdd aig lhs, negRhs
instance : AIG.LawfulVecOperator α AIG.BinaryRefVec blastSub where
le_size := by
intros
unfold blastSub
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastAdd)
apply AIG.LawfulVecOperator.le_size (f := blastNeg)
decl_eq := by
intros
unfold blastSub
rw [AIG.LawfulVecOperator.decl_eq (f := blastAdd)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastNeg)]
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastNeg)
assumption
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,342 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Sub
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Eq
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Ult
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.ZeroExtend
import Std.Sat.AIG.If
/-!
This module contains the implementation of a bitblaster for `BitVec.udiv`. The implemented
circuit is a shift subtractor.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
namespace blastUdiv
structure ShiftConcatInput (aig : AIG α) (len : Nat) where
lhs : AIG.RefVec aig len
bit : AIG.Ref aig
def blastShiftConcat (aig : AIG α) (input : ShiftConcatInput aig w) : AIG.RefVecEntry α w :=
let lhs, bit := input
let bit := AIG.RefVec.empty.push bit
let new := bit.append lhs
blastZeroExtend aig _, new
instance : AIG.LawfulVecOperator α ShiftConcatInput blastShiftConcat where
le_size := by
intros
unfold blastShiftConcat
dsimp only
apply AIG.LawfulVecOperator.le_size (f := blastZeroExtend)
decl_eq := by
intros
unfold blastShiftConcat
dsimp only
rw [AIG.LawfulVecOperator.decl_eq (f := blastZeroExtend)]
structure BlastDivSubtractShiftOutput (old : AIG α) (w : Nat) where
aig : AIG α
wn : Nat
wr : Nat
q : AIG.RefVec aig w
r : AIG.RefVec aig w
hle : old.decls.size aig.decls.size
def blastDivSubtractShift (aig : AIG α) (falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w) (wn wr : Nat)
(q r : AIG.RefVec aig w) : BlastDivSubtractShiftOutput aig w :=
let wn := wn - 1
let wr := wr + 1
let res := blastUdiv.blastShiftConcat aig r, n.getD wn falseRef
let aig := res.aig
let r' := res.vec
have := AIG.LawfulVecOperator.le_size (f := blastUdiv.blastShiftConcat) ..
let falseRef := falseRef.cast this
let trueRef := trueRef.cast this
let d := d.cast this
let q := q.cast this
let res := blastUdiv.blastShiftConcat aig q, falseRef
let aig := res.aig
let posQ := res.vec
have := AIG.LawfulVecOperator.le_size (f := blastUdiv.blastShiftConcat) ..
let trueRef := trueRef.cast this
let d := d.cast this
let q := q.cast this
let r' := r'.cast this
let res := blastUdiv.blastShiftConcat aig q, trueRef
let aig := res.aig
let negQ := res.vec
have := AIG.LawfulVecOperator.le_size (f := blastUdiv.blastShiftConcat) ..
let d := d.cast this
let r' := r'.cast this
let posQ := posQ.cast this
let res := blastSub aig r', d
let aig := res.aig
let negR := res.vec
have := AIG.LawfulVecOperator.le_size (f := blastSub) ..
let d := d.cast this
let r' := r'.cast this
let posQ := posQ.cast this
let negQ := negQ.cast this
let posR := r'
let res := BVPred.mkUlt aig r', d
let aig := res.aig
let discr := res.ref
have := AIG.LawfulOperator.le_size (f := BVPred.mkUlt) ..
let posQ := posQ.cast this
let negQ := negQ.cast this
let posR := posR.cast this
let negR := negR.cast this
let res := AIG.RefVec.ite aig discr, posQ, negQ
let aig := res.aig
let nextQ := res.vec
have := AIG.LawfulVecOperator.le_size (f := AIG.RefVec.ite) ..
let posR := posR.cast this
let negR := negR.cast this
let discr := discr.cast this
let res := AIG.RefVec.ite aig discr, posR, negR
let aig := res.aig
let nextR := res.vec
have := AIG.LawfulVecOperator.le_size (f := AIG.RefVec.ite) ..
let nextQ := nextQ.cast this
have := by
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := BVPred.mkUlt)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastShiftConcat)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastShiftConcat)
apply AIG.LawfulVecOperator.le_size (f := blastShiftConcat)
aig, wn, wr, nextQ, nextR, this
theorem blastDivSubtractShift_le_size (aig : AIG α) (falseRef trueRef : AIG.Ref aig)
(n d : AIG.RefVec aig w) (wn wr : Nat) (q r : AIG.RefVec aig w) :
aig.decls.size (blastDivSubtractShift aig falseRef trueRef n d wn wr q r).aig.decls.size := by
unfold blastDivSubtractShift
dsimp only
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := BVPred.mkUlt)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.le_size (f := blastUdiv.blastShiftConcat)
theorem blastDivSubtractShift_decl_eq (aig : AIG α) (falseRef trueRef : AIG.Ref aig)
(n d : AIG.RefVec aig w) (wn wr : Nat) (q r : AIG.RefVec aig w) :
(idx : Nat) (h1) (h2),
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).aig.decls[idx]'h2 = aig.decls[idx]'h1 := by
generalize hres : blastDivSubtractShift aig falseRef trueRef n d wn wr q r = res
unfold blastDivSubtractShift at hres
dsimp only at hres
rw [ hres]
intros
rw [AIG.LawfulVecOperator.decl_eq (f := AIG.RefVec.ite)]
rw [AIG.LawfulVecOperator.decl_eq (f := AIG.RefVec.ite)]
rw [AIG.LawfulOperator.decl_eq (f := BVPred.mkUlt)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastSub)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastUdiv.blastShiftConcat)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastUdiv.blastShiftConcat)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastUdiv.blastShiftConcat)]
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkUlt)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkUlt)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastUdiv.blastShiftConcat)
assumption
structure BlastUdivOutput (old : AIG α) (w : Nat) where
aig : AIG α
q : AIG.RefVec aig w
r : AIG.RefVec aig w
hle : old.decls.size aig.decls.size
def go (aig : AIG α) (curr : Nat) (falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w)
(wn wr : Nat) (q r : AIG.RefVec aig w) : BlastUdivOutput aig w :=
match curr with
| 0 => aig, q, r, by omega
| curr + 1 =>
let res := blastDivSubtractShift aig falseRef trueRef n d wn wr q r
let aig := res.aig
let wn := res.wn
let wr := res.wr
let q := res.q
let r := res.r
have := res.hle
let falseRef := falseRef.cast this
let trueRef := trueRef.cast this
let n := n.cast this
let d := d.cast this
let res := go aig curr falseRef trueRef n d wn wr q r
let aig := res.aig
let q := res.q
let r := res.r
have := by
refine Nat.le_trans ?_ res.hle
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := BVPred.mkUlt)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastSub)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastShiftConcat)
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := blastShiftConcat)
apply AIG.LawfulVecOperator.le_size (f := blastShiftConcat)
aig, q, r, this
theorem go_le_size (aig : AIG α) (curr : Nat) (falseRef trueRef : AIG.Ref aig)
(n d : AIG.RefVec aig w) (wn wr : Nat) (q r : AIG.RefVec aig w) :
aig.decls.size (go aig curr falseRef trueRef n d wn wr q r).aig.decls.size := by
unfold go
dsimp only
split
· simp
· refine Nat.le_trans ?_ (by apply go_le_size)
apply blastUdiv.blastDivSubtractShift_le_size
theorem go_decl_eq (aig : AIG α) (curr : Nat) (falseRef trueRef : AIG.Ref aig)
(n d : AIG.RefVec aig w) (wn wr : Nat) (q r : AIG.RefVec aig w) :
(idx : Nat) (h1) (h2),
(go aig curr falseRef trueRef n d wn wr q r).aig.decls[idx]'h2 = aig.decls[idx]'h1 := by
generalize hgo : go aig curr falseRef trueRef n d wn wr q r = res
unfold go at hgo
dsimp only at hgo
split at hgo
· simp [ hgo]
· rw [ hgo]
intro idx h1 h2
rw [go_decl_eq]
rw [blastDivSubtractShift_decl_eq]
apply Nat.lt_of_lt_of_le
· exact h1
· apply blastDivSubtractShift_le_size
end blastUdiv
def blastUdiv (aig : AIG α) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry α w :=
let res := blastConst aig 0#w
let aig := res.aig
let zero := res.vec
let input := input.cast <| AIG.LawfulVecOperator.le_size (f := blastConst) ..
let res := aig.mkConstCached false
let aig := res.aig
let falseRef := res.ref
have := AIG.LawfulOperator.le_size (f := AIG.mkConstCached) ..
let zero := zero.cast this
let input := input.cast this
let res := aig.mkConstCached true
let aig := res.aig
let trueRef := res.ref
have := AIG.LawfulOperator.le_size (f := AIG.mkConstCached) ..
let falseRef := falseRef.cast this
let zero := zero.cast this
let input := input.cast this
let lhs, rhs := input
let res := BVPred.mkEq aig rhs, zero
let aig := res.aig
let discr := res.ref
have := AIG.LawfulOperator.le_size (f := BVPred.mkEq) ..
let falseRef := falseRef.cast this
let trueRef := trueRef.cast this
let zero := zero.cast this
let lhs := lhs.cast this
let rhs := rhs.cast this
let res := blastUdiv.go aig w falseRef trueRef lhs rhs w 0 zero zero
let aig := res.aig
let divRes := res.q
have := blastUdiv.go_le_size ..
let zero := zero.cast this
let discr := discr.cast this
AIG.RefVec.ite aig discr, zero, divRes
instance : AIG.LawfulVecOperator α AIG.BinaryRefVec blastUdiv where
le_size := by
intros
unfold blastUdiv
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
refine Nat.le_trans ?_ (by apply blastUdiv.go_le_size)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.le_size (f := blastConst)
decl_eq := by
intros
unfold blastUdiv
rw [AIG.LawfulVecOperator.decl_eq (f := AIG.RefVec.ite)]
rw [blastUdiv.go_decl_eq]
rw [AIG.LawfulOperator.decl_eq (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.decl_eq (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.decl_eq (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastConst)]
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· refine Nat.le_trans ?_ (by apply blastUdiv.go_le_size)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,109 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Udiv
/-!
This module contains the implementation of a bitblaster for `BitVec.umod`. The implemented
circuit is a shift subtractor.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
def blastUmod (aig : AIG α) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry α w :=
let res := blastConst aig 0#w
let aig := res.aig
let zero := res.vec
let input := input.cast <| AIG.LawfulVecOperator.le_size (f := blastConst) ..
let res := aig.mkConstCached false
let aig := res.aig
let falseRef := res.ref
have := AIG.LawfulOperator.le_size (f := AIG.mkConstCached) ..
let zero := zero.cast this
let input := input.cast this
let res := aig.mkConstCached true
let aig := res.aig
let trueRef := res.ref
have := AIG.LawfulOperator.le_size (f := AIG.mkConstCached) ..
let falseRef := falseRef.cast this
let zero := zero.cast this
let input := input.cast this
let lhs, rhs := input
let res := BVPred.mkEq aig rhs, zero
let aig := res.aig
let discr := res.ref
have := AIG.LawfulOperator.le_size (f := BVPred.mkEq) ..
let falseRef := falseRef.cast this
let trueRef := trueRef.cast this
let zero := zero.cast this
let lhs := lhs.cast this
let rhs := rhs.cast this
let res := blastUdiv.go aig w falseRef trueRef lhs rhs w 0 zero zero
let aig := res.aig
let modRes := res.r
have := blastUdiv.go_le_size ..
let discr := discr.cast this
let lhs := lhs.cast this
AIG.RefVec.ite aig discr, lhs, modRes
instance : AIG.LawfulVecOperator α AIG.BinaryRefVec blastUmod where
le_size := by
intros
unfold blastUmod
apply AIG.LawfulVecOperator.le_size_of_le_aig_size (f := AIG.RefVec.ite)
refine Nat.le_trans ?_ (by apply blastUdiv.go_le_size)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.le_size (f := blastConst)
decl_eq := by
intros
unfold blastUmod
rw [AIG.LawfulVecOperator.decl_eq (f := AIG.RefVec.ite)]
rw [blastUdiv.go_decl_eq]
rw [AIG.LawfulOperator.decl_eq (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.decl_eq (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.decl_eq (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.decl_eq (f := blastConst)]
· apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
· refine Nat.le_trans ?_ (by apply blastUdiv.go_le_size)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := BVPred.mkEq)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulOperator.lt_size_of_lt_aig_size (f := AIG.mkConstCached)
apply AIG.LawfulVecOperator.lt_size_of_lt_aig_size (f := blastConst)
assumption
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -18,8 +18,10 @@ import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Extract
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.RotateLeft
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.RotateRight
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.SignExtend
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Expr
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Mul
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Udiv
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Umod
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Expr
/-!
This module contains the verification of the `BitVec` expressions (`BVExpr`) bitblaster from
@@ -192,6 +194,30 @@ theorem go_denote_eq (aig : AIG BVBit) (expr : BVExpr w) (assign : Assignment) :
· simp [Ref.hgate]
· intros
rw [ rih]
| udiv =>
simp only [go, eval_bin, BVBinOp.eval_udiv]
apply denote_blastUdiv
· intros
dsimp only
rw [go_denote_mem_prefix]
rw [ lih (aig := aig)]
· simp
· assumption
· simp [Ref.hgate]
· intros
rw [ rih]
| umod =>
simp only [go, eval_bin, BVBinOp.eval_umod]
apply denote_blastUmod
· intros
dsimp only
rw [go_denote_mem_prefix]
rw [ lih (aig := aig)]
· simp
· assumption
· simp [Ref.hgate]
· intros
rw [ rih]
| un op expr ih =>
cases op with
| not => simp [go, ih, hidx]

View File

@@ -20,6 +20,20 @@ namespace BVPred
variable [Hashable α] [DecidableEq α]
theorem denote_getD_eq_getLsbD (aig : AIG α) (assign : α Bool) (x : BitVec w)
(xv : AIG.RefVec aig w) (falseRef : AIG.Ref aig)
(hx : idx hidx, aig, xv.get idx hidx, assign = x.getLsbD idx)
(hfalse : aig, falseRef, assign = false) :
idx, aig, xv.getD idx falseRef, assign = x.getLsbD idx := by
intro idx
rw [AIG.RefVec.getD]
split
· rw [hx]
· rw [hfalse]
symm
apply BitVec.getLsbD_ge
omega
@[simp]
theorem denote_blastGetLsbD (aig : AIG α) (target : GetLsbDTarget aig)
(assign : α Bool) :

View File

@@ -0,0 +1,51 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Const
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Neg
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Not
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Add
/-!
This module contains the verification of the bitblaster for `BitVec.neg` from `Impl.Operations.Neg`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
open Std.Sat.AIG
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
theorem denote_blastNeg (aig : AIG α) (value : BitVec w) (target : RefVec aig w)
(assign : α Bool)
(htarget : (idx : Nat) (hidx : idx < w), aig, target.get idx hidx, assign = value.getLsbD idx) :
(idx : Nat) (hidx : idx < w),
(blastNeg aig target).aig, (blastNeg aig target).vec.get idx hidx, assign
=
(-value).getLsbD idx := by
intro idx hidx
rw [BitVec.neg_eq_not_add]
unfold blastNeg
dsimp only
rw [denote_blastAdd]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp only [RefVec.get_cast, Ref.gate_cast, BitVec.getLsbD_not, hidx, decide_True,
Bool.true_and]
rw [denote_blastNot, htarget]
· simp [Ref.hgate]
· simp
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,48 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Neg
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Sub
/-!
This module contains the verification of the bitblaster for `BitVec.sub` from `Impl.Operations.Sub`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
open Std.Sat.AIG
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
theorem denote_blastSub (aig : AIG α) (lhs rhs : BitVec w) (assign : α Bool)
(input : BinaryRefVec aig w)
(hleft : (idx : Nat) (hidx : idx < w), aig, input.lhs.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, input.rhs.get idx hidx, assign = rhs.getLsbD idx) :
(idx : Nat) (hidx : idx < w),
(blastSub aig input).aig, (blastSub aig input).vec.get idx hidx, assign
=
(lhs - rhs).getLsbD idx := by
intro idx hidx
rw [BitVec.sub_toAdd]
unfold blastSub
rw [denote_blastAdd]
· intros
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastNeg)]
· simp [hleft]
· simp [Ref.hgate]
· intros
rw [denote_blastNeg]
exact hright
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,492 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Basic
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Const
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Sub
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.ZeroExtend
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Eq
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Ult
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.GetLsbD
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Udiv
import Std.Tactic.BVDecide.Normalize.BitVec
/-!
This module contains the verification of the `BitVec.udiv` bitblaster from `Impl.Operations.Udiv`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
open Std.Sat.AIG
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
namespace blastUdiv
theorem denote_blastShiftConcat (aig : AIG α) (target : ShiftConcatInput aig w)
(assign : α Bool) :
(idx : Nat) (hidx : idx < w),
(blastShiftConcat aig target).aig, (blastShiftConcat aig target).vec.get idx hidx, assign
=
if idx = 0 then
aig, target.bit, assign
else
aig, target.lhs.get (idx - 1) (by omega), assign
:= by
intro idx hidx
unfold blastShiftConcat
have hidx_lt : idx < 1 + w := by omega
by_cases hidx_eq : idx = 0 <;> simp_arith [hidx_lt, hidx_eq, RefVec.get_append]
theorem denote_blastShiftConcat_eq_shiftConcat (aig : AIG α) (target : ShiftConcatInput aig w)
(x : BitVec w) (b : Bool) (assign : α Bool)
(hx : idx hidx, aig, target.lhs.get idx hidx, assign = x.getLsbD idx)
(hb : aig, target.bit, assign = b) :
(idx : Nat) (hidx : idx < w),
(blastShiftConcat aig target).aig, (blastShiftConcat aig target).vec.get idx hidx, assign
=
(BitVec.shiftConcat x b).getLsbD idx := by
intro idx hidx
simp [BitVec.getLsbD_shiftConcat, hidx, denote_blastShiftConcat, hx, hb]
theorem blastDivSubtractShift_denote_mem_prefix (aig : AIG α) (falseRef trueRef : AIG.Ref aig)
(n d q r : AIG.RefVec aig w) (wn wr : Nat) (start : Nat) (hstart) :
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).aig,
start, by apply Nat.lt_of_lt_of_le; exact hstart; apply blastDivSubtractShift_le_size,
assign
=
aig, start, hstart, assign := by
apply denote.eq_of_isPrefix (entry := aig, start,hstart)
apply IsPrefix.of
· intros
apply blastDivSubtractShift_decl_eq
· intros
apply blastDivSubtractShift_le_size
theorem denote_blastDivSubtractShift_q (aig : AIG α) (assign : α Bool) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w) (wn wr : Nat)
(q r : AIG.RefVec aig w) (qbv rbv : BitVec w)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hq : (idx : Nat) (hidx : idx < w), aig, q.get idx hidx, assign = qbv.getLsbD idx)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = rbv.getLsbD idx)
(hfalse : aig, falseRef, assign = false)
(htrue : aig, trueRef, assign = true)
:
(idx : Nat) (hidx : idx < w),
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).aig,
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).q.get idx hidx,
assign
=
(BitVec.divSubtractShift { n := lhs, d := rhs } { wn := wn, wr := wr, q := qbv, r := rbv }).q.getLsbD idx := by
intro idx hidx
unfold blastDivSubtractShift BitVec.divSubtractShift
dsimp only
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := AIG.RefVec.ite)]
. simp only [RefVec.get_cast, Ref.gate_cast]
rw [AIG.RefVec.denote_ite]
rw [BVPred.mkUlt_denote_eq (lhs := rbv.shiftConcat (lhs.getLsbD (wn - 1))) (rhs := rhs)]
· split
· next hdiscr =>
rw [ Normalize.BitVec.lt_ult] at hdiscr
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.get_cast, hdiscr, reduceIte]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkUlt)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [denote_blastShiftConcat_eq_shiftConcat]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
· simp [hq]
· simp [Ref.hgate]
· rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
· simp [hfalse]
· simp [Ref.hgate]
· next hdiscr =>
rw [ Normalize.BitVec.lt_ult] at hdiscr
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.get_cast, hdiscr, reduceIte]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkUlt)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [denote_blastShiftConcat_eq_shiftConcat]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
· simp [hq]
· simp [Ref.hgate]
· rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
· simp [htrue]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
. simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.get_cast]
rw [denote_blastShiftConcat_eq_shiftConcat]
. simp [hr]
. dsimp only
rw [BVPred.denote_getD_eq_getLsbD]
· exact hleft
· exact hfalse
. simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
. simp [hright]
. simp [Ref.hgate]
. simp [Ref.hgate]
theorem denote_blastDivSubtractShift_r (aig : AIG α) (assign : α Bool) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w) (wn wr : Nat)
(q r : AIG.RefVec aig w) (qbv rbv : BitVec w)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = rbv.getLsbD idx)
(hfalse : aig, falseRef, assign = false)
:
(idx : Nat) (hidx : idx < w),
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).aig,
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).r.get idx hidx,
assign
=
(BitVec.divSubtractShift { n := lhs, d := rhs } { wn := wn, wr := wr, q := qbv, r := rbv }).r.getLsbD idx := by
intro idx hidx
unfold blastDivSubtractShift BitVec.divSubtractShift
simp only [RefVec.denote_ite, LawfulVecOperator.denote_cast_entry, RefVec.get_cast]
rw [BVPred.mkUlt_denote_eq (lhs := rbv.shiftConcat (lhs.getLsbD (wn - 1))) (rhs := rhs)]
· split
· next hdiscr =>
rw [ Normalize.BitVec.lt_ult] at hdiscr
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, hdiscr, reduceIte]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := AIG.RefVec.ite)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkUlt)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [denote_blastShiftConcat_eq_shiftConcat]
· intro idx hidx
simp [hr]
· rw [BVPred.denote_getD_eq_getLsbD]
· exact hleft
· exact hfalse
· next hdiscr =>
rw [ Normalize.BitVec.lt_ult] at hdiscr
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, hdiscr, reduceIte]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := AIG.RefVec.ite)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkUlt)]
rw [denote_blastSub]
· intro idx hidx
simp only [Int.reduceNeg, RefVec.get_cast, Ref.cast_eq]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [denote_blastShiftConcat_eq_shiftConcat]
· simp [hr]
· rw [BVPred.denote_getD_eq_getLsbD]
· exact hleft
· exact hfalse
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
. simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.get_cast]
rw [denote_blastShiftConcat_eq_shiftConcat]
. simp [hr]
. dsimp only
rw [BVPred.denote_getD_eq_getLsbD]
· exact hleft
· exact hfalse
. simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastSub)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastShiftConcat)]
. simp [hright]
. simp [Ref.hgate]
@[simp]
theorem denote_blastDivSubtractShift_wn (aig : AIG α) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w) (wn wr : Nat)
(q r : AIG.RefVec aig w) (qbv rbv : BitVec w)
:
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).wn
=
(BitVec.divSubtractShift { n := lhs, d := rhs } { wn := wn, wr := wr, q := qbv, r := rbv }).wn := by
unfold blastDivSubtractShift BitVec.divSubtractShift
dsimp only
split <;> simp
@[simp]
theorem denote_blastDivSubtractShift_wr (aig : AIG α) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d : AIG.RefVec aig w) (wn wr : Nat)
(q r : AIG.RefVec aig w) (qbv rbv : BitVec w)
:
(blastDivSubtractShift aig falseRef trueRef n d wn wr q r).wr
=
(BitVec.divSubtractShift { n := lhs, d := rhs } { wn := wn, wr := wr, q := qbv, r := rbv }).wr := by
unfold blastDivSubtractShift BitVec.divSubtractShift
dsimp only
split <;> simp
theorem denote_go_eq_divRec_q (aig : AIG α) (assign : α Bool) (curr : Nat) (lhs rhs rbv qbv : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d q r : AIG.RefVec aig w) (wn wr : Nat)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hq : (idx : Nat) (hidx : idx < w), aig, q.get idx hidx, assign = qbv.getLsbD idx)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = rbv.getLsbD idx)
(hfalse : aig, falseRef, assign = false)
(htrue : aig, trueRef, assign = true)
:
(idx : Nat) (hidx : idx < w),
(go aig curr falseRef trueRef n d wn wr q r).aig,
(go aig curr falseRef trueRef n d wn wr q r).q.get idx hidx,
assign
=
(BitVec.divRec curr { n := lhs, d := rhs} { wn, wr, q := qbv, r := rbv }).q.getLsbD idx := by
induction curr generalizing aig wn wr q r qbv rbv with
| zero =>
intro idx hidx
simp [go, hq]
| succ curr ih =>
intro idx hidx
rw [go, BitVec.divRec_succ, BitVec.divSubtractShift]
split
· next hdiscr =>
rw [ih]
· rfl
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [denote_blastDivSubtractShift_q (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hq
· exact hr
· exact hfalse
· exact htrue
· intro idx hidx
rw [denote_blastDivSubtractShift_r (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hr
· exact hfalse
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hfalse]
· simp [Ref.hgate]
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [htrue]
· simp [Ref.hgate]
· next hdiscr =>
rw [ih]
· rfl
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [denote_blastDivSubtractShift_q (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hq
· exact hr
· exact hfalse
· exact htrue
· intro idx hidx
rw [denote_blastDivSubtractShift_r (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hr
· exact hfalse
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hfalse]
· simp [Ref.hgate]
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [htrue]
· simp [Ref.hgate]
theorem denote_go (aig : AIG α) (assign : α Bool) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d q r : AIG.RefVec aig w)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hq : (idx : Nat) (hidx : idx < w), aig, q.get idx hidx, assign = false)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = false)
(hfalse : aig, falseRef, assign = false)
(htrue : aig, trueRef, assign = true)
(hzero : 0#w < rhs)
:
(idx : Nat) (hidx : idx < w),
(go aig w falseRef trueRef n d w 0 q r).aig,
(go aig w falseRef trueRef n d w 0 q r).q.get idx hidx,
assign
=
(lhs / rhs).getLsbD idx := by
intro idx hidx
rw [BitVec.udiv_eq_divRec hzero]
rw [BitVec.DivModState.init]
rw [denote_go_eq_divRec_q (lhs := lhs) (rhs := rhs) (qbv := 0#w) (rbv := 0#w)]
· exact hleft
· exact hright
· simp [hq]
· simp [hr]
· exact hfalse
· exact htrue
theorem go_denote_mem_prefix (aig : AIG α) (curr : Nat) (falseRef trueRef : AIG.Ref aig)
(n d q r : AIG.RefVec aig w) (wn wr : Nat) (start : Nat) (hstart) :
(go aig curr falseRef trueRef n d wn wr q r).aig,
start, by apply Nat.lt_of_lt_of_le; exact hstart; apply go_le_size,
assign
=
aig, start, hstart, assign := by
apply denote.eq_of_isPrefix (entry := aig, start,hstart)
apply IsPrefix.of
· intros
apply go_decl_eq
· intros
apply go_le_size
end blastUdiv
theorem denote_blastUdiv (aig : AIG α) (lhs rhs : BitVec w) (assign : α Bool)
(input : BinaryRefVec aig w)
(hleft : (idx : Nat) (hidx : idx < w), aig, input.lhs.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, input.rhs.get idx hidx, assign = rhs.getLsbD idx) :
(idx : Nat) (hidx : idx < w),
(blastUdiv aig input).aig, (blastUdiv aig input).vec.get idx hidx, assign
=
(lhs / rhs).getLsbD idx := by
intro idx hidx
unfold blastUdiv
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.denote_ite,
LawfulVecOperator.denote_input_entry, RefVec.get_cast]
split
· next hdiscr =>
rw [blastUdiv.go_denote_mem_prefix] at hdiscr
rw [BVPred.mkEq_denote_eq (lhs := rhs) (rhs := 0#w)] at hdiscr
· simp only [beq_iff_eq] at hdiscr
rw [hdiscr]
rw [blastUdiv.go_denote_mem_prefix]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [denote_blastConst]
simp
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq, BitVec.getLsbD_zero]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· next hdiscr =>
rw [blastUdiv.go_denote_mem_prefix] at hdiscr
rw [BVPred.mkEq_denote_eq (lhs := rhs) (rhs := 0#w)] at hdiscr
· have hzero : 0#w < rhs := by
rw [Normalize.BitVec.zero_lt_iff_zero_neq]
simpa using hdiscr
rw [blastUdiv.denote_go (hzero := hzero)]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp
· simp [Ref.hgate]
· rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
· simp
· simp [Ref.hgate]
· intro idx hdix
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hdix
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq, BitVec.getLsbD_zero]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -0,0 +1,254 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas.Operations.Udiv
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Umod
/-!
This module contains the verification of the `BitVec.umod` bitblaster from `Impl.Operations.Umod`.
-/
namespace Std.Tactic.BVDecide
open Std.Sat
open Std.Sat.AIG
namespace BVExpr
namespace bitblast
variable [Hashable α] [DecidableEq α]
namespace blastUmod
open blastUdiv
theorem denote_go_eq_divRec_r (aig : AIG α) (assign : α Bool) (curr : Nat) (lhs rhs rbv qbv : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d q r : AIG.RefVec aig w) (wn wr : Nat)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hq : (idx : Nat) (hidx : idx < w), aig, q.get idx hidx, assign = qbv.getLsbD idx)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = rbv.getLsbD idx)
(hfalse : aig, falseRef, assign = false)
(htrue : aig, trueRef, assign = true)
:
(idx : Nat) (hidx : idx < w),
(go aig curr falseRef trueRef n d wn wr q r).aig,
(go aig curr falseRef trueRef n d wn wr q r).r.get idx hidx,
assign
=
(BitVec.divRec curr { n := lhs, d := rhs} { wn, wr, q := qbv, r := rbv }).r.getLsbD idx := by
induction curr generalizing aig wn wr q r qbv rbv with
| zero =>
intro idx hidx
simp [go, hr]
| succ curr ih =>
intro idx hidx
rw [go, BitVec.divRec_succ, BitVec.divSubtractShift]
split
· next hdiscr =>
rw [ih]
· rfl
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [denote_blastDivSubtractShift_q (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hq
· exact hr
· exact hfalse
· exact htrue
· intro idx hidx
rw [denote_blastDivSubtractShift_r (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hr
· exact hfalse
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hfalse]
· simp [Ref.hgate]
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [htrue]
· simp [Ref.hgate]
· next hdiscr =>
rw [ih]
· rfl
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [denote_blastDivSubtractShift_q (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hq
· exact hr
· exact hfalse
· exact htrue
· intro idx hidx
rw [denote_blastDivSubtractShift_r (rbv := rbv) (qbv := qbv) (lhs := lhs) (rhs := rhs)]
· rw [BitVec.divSubtractShift]
simp [hdiscr]
· exact hleft
· exact hright
· exact hr
· exact hfalse
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [hfalse]
· simp [Ref.hgate]
· rw [blastDivSubtractShift_denote_mem_prefix]
· simp [htrue]
· simp [Ref.hgate]
theorem denote_go (aig : AIG α) (assign : α Bool) (lhs rhs : BitVec w)
(falseRef trueRef : AIG.Ref aig) (n d q r : AIG.RefVec aig w)
(hleft : (idx : Nat) (hidx : idx < w), aig, n.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, d.get idx hidx, assign = rhs.getLsbD idx)
(hq : (idx : Nat) (hidx : idx < w), aig, q.get idx hidx, assign = false)
(hr : (idx : Nat) (hidx : idx < w), aig, r.get idx hidx, assign = false)
(hfalse : aig, falseRef, assign = false)
(htrue : aig, trueRef, assign = true)
(hzero : 0#w < rhs)
:
(idx : Nat) (hidx : idx < w),
(go aig w falseRef trueRef n d w 0 q r).aig,
(go aig w falseRef trueRef n d w 0 q r).r.get idx hidx,
assign
=
(lhs % rhs).getLsbD idx := by
intro idx hidx
rw [BitVec.umod_eq_divRec hzero]
rw [BitVec.DivModState.init]
rw [denote_go_eq_divRec_r (lhs := lhs) (rhs := rhs) (qbv := 0#w) (rbv := 0#w)]
· exact hleft
· exact hright
· simp [hq]
· simp [hr]
· exact hfalse
· exact htrue
end blastUmod
theorem denote_blastUmod (aig : AIG α) (lhs rhs : BitVec w) (assign : α Bool)
(input : BinaryRefVec aig w)
(hleft : (idx : Nat) (hidx : idx < w), aig, input.lhs.get idx hidx, assign = lhs.getLsbD idx)
(hright : (idx : Nat) (hidx : idx < w), aig, input.rhs.get idx hidx, assign = rhs.getLsbD idx) :
(idx : Nat) (hidx : idx < w),
(blastUmod aig input).aig, (blastUmod aig input).vec.get idx hidx, assign
=
(lhs % rhs).getLsbD idx := by
intro idx hidx
unfold blastUmod
simp only [Ref.cast_eq, id_eq, Int.reduceNeg, RefVec.denote_ite,
LawfulVecOperator.denote_input_entry, RefVec.get_cast]
split
· next hdiscr =>
rw [blastUdiv.go_denote_mem_prefix] at hdiscr
rw [BVPred.mkEq_denote_eq (lhs := rhs) (rhs := 0#w)] at hdiscr
· simp only [beq_iff_eq] at hdiscr
rw [hdiscr]
rw [blastUdiv.go_denote_mem_prefix]
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq, BitVec.getLsbD_zero]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· next hdiscr =>
rw [blastUdiv.go_denote_mem_prefix] at hdiscr
rw [BVPred.mkEq_denote_eq (lhs := rhs) (rhs := 0#w)] at hdiscr
· have hzero : 0#w < rhs := by
rw [Normalize.BitVec.zero_lt_iff_zero_neq]
simpa using hdiscr
rw [blastUmod.denote_go (hzero := hzero)]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hleft]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· intro idx hidx
rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
· rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp
· simp [Ref.hgate]
· rw [AIG.LawfulOperator.denote_mem_prefix (f := BVPred.mkEq)]
· simp
· simp [Ref.hgate]
· intro idx hdix
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulVecOperator.denote_mem_prefix (f := blastConst)]
· simp [hright]
· simp [Ref.hgate]
· intro idx hdix
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
rw [AIG.LawfulOperator.denote_mem_prefix (f := AIG.mkConstCached)]
· simp only [RefVec.get_cast, Ref.cast_eq, BitVec.getLsbD_zero]
rw [denote_blastConst]
simp
· simp [Ref.hgate]
end bitblast
end BVExpr
end Std.Tactic.BVDecide

View File

@@ -5,6 +5,7 @@ Authors: Henrik Böving
-/
prelude
import Init.Data.BitVec.Bitblast
import Init.Data.AC
import Std.Tactic.BVDecide.Normalize.Bool
import Std.Tactic.BVDecide.Normalize.Canonicalize
@@ -18,7 +19,6 @@ namespace Normalize
section Reduce
attribute [bv_normalize] BitVec.neg_eq_not_add
attribute [bv_normalize] BitVec.sub_toAdd
@[bv_normalize]
@@ -109,23 +109,57 @@ theorem BitVec.not_add (a : BitVec w) : ~~~a + a = (-1#w) := by
@[bv_normalize]
theorem BitVec.add_neg (a : BitVec w) : a + (~~~a + 1#w) = 0#w := by
rw [ BitVec.ofNat_eq_ofNat]
rw [ BitVec.neg_eq_not_add]
rw [ BitVec.sub_toAdd]
rw [BitVec.sub_self]
@[bv_normalize]
theorem BitVec.add_neg' (a : BitVec w) : a + (1#w + ~~~a) = 0#w := by
rw [BitVec.add_comm 1#w (~~~a)]
rw [BitVec.add_neg]
@[bv_normalize]
theorem BitVec.neg_add (a : BitVec w) : (~~~a + 1#w) + a = 0#w := by
rw [ BitVec.ofNat_eq_ofNat]
rw [ BitVec.neg_eq_not_add]
rw [BitVec.add_comm]
rw [ BitVec.sub_toAdd]
rw [BitVec.sub_self]
@[bv_normalize]
theorem BitVec.neg_add' (a : BitVec w) : (1#w + ~~~a) + a = 0#w := by
rw [BitVec.add_comm 1#w (~~~a)]
rw [BitVec.neg_add]
@[bv_normalize]
theorem BitVec.not_neg (x : BitVec w) : ~~~(~~~x + 1#w) = x + -1#w := by
rw [ BitVec.neg_eq_not_add x]
rw [_root_.BitVec.not_neg]
@[bv_normalize]
theorem BitVec.not_neg' (x : BitVec w) : ~~~(1#w + ~~~x) = x + -1#w := by
rw [BitVec.add_comm 1#w (~~~x)]
rw [BitVec.not_neg]
@[bv_normalize]
theorem BitVec.not_neg'' (x : BitVec w) : ~~~(x + 1#w) = ~~~x + -1#w := by
rw [ BitVec.not_not (b := x)]
rw [BitVec.not_neg]
simp
@[bv_normalize]
theorem BitVec.not_neg''' (x : BitVec w) : ~~~(1#w + x) = ~~~x + -1#w := by
rw [BitVec.add_comm 1#w x]
rw [BitVec.not_neg'']
@[bv_normalize]
theorem BitVec.add_same (a : BitVec w) : a + a = a * 2#w := by
rw [BitVec.mul_two]
theorem BitVec.add_const_left (a b c : BitVec w) : a + (b + c) = (a + b) + c := by ac_rfl
theorem BitVec.add_const_right (a b c : BitVec w) : a + (b + c) = (a + c) + b := by ac_rfl
theorem BitVec.add_const_left' (a b c : BitVec w) : (a + b) + c = (a + c) + b := by ac_rfl
theorem BitVec.add_const_right' (a b c : BitVec w) : (a + b) + c = (b + c) + a := by ac_rfl
@[bv_normalize]
theorem BitVec.zero_sshiftRight : BitVec.sshiftRight 0#w a = 0#w := by
ext
@@ -176,13 +210,13 @@ theorem BitVec.shiftRight_zero' (n : BitVec w) : n >>> 0 = n := by
ext i
simp
theorem BitVec.zero_lt_iff_zero_neq (a : BitVec w) : (0#w < a) (0#w a) := by
theorem BitVec.zero_lt_iff_zero_neq (a : BitVec w) : (0#w < a) (a 0#w) := by
constructor <;>
simp_all only [BitVec.lt_def, BitVec.toNat_ofNat, Nat.zero_mod, ne_eq, BitVec.toNat_eq] <;>
omega
@[bv_normalize]
theorem BitVec.zero_ult' (a : BitVec w) : (BitVec.ult 0#w a) = (0#w != a) := by
theorem BitVec.zero_ult' (a : BitVec w) : (BitVec.ult 0#w a) = (a != 0#w) := by
have := BitVec.zero_lt_iff_zero_neq a
rw [BitVec.lt_ult] at this
match h:BitVec.ult 0#w a with
@@ -220,5 +254,8 @@ theorem BitVec.getElem_eq_getLsbD (a : BitVec w) (i : Nat) (h : i < w) :
attribute [bv_normalize] BitVec.add_eq_xor
attribute [bv_normalize] BitVec.mul_eq_and
attribute [bv_normalize] BitVec.udiv_zero
attribute [bv_normalize] BitVec.umod_zero
end Normalize
end Std.Tactic.BVDecide

View File

@@ -97,6 +97,8 @@ attribute [bv_normalize] BitVec.add_eq
attribute [bv_normalize] BitVec.sub_eq
attribute [bv_normalize] BitVec.neg_eq
attribute [bv_normalize] BitVec.mul_eq
attribute [bv_normalize] BitVec.udiv_eq
attribute [bv_normalize] BitVec.umod_eq
@[bv_normalize]
theorem Bool.and_eq_and (x y : Bool) : x.and y = (x && y) := by

View File

@@ -110,6 +110,14 @@ theorem getLsbD_congr (i : Nat) (w : Nat) (e e' : BitVec w) (h : e' = e) :
theorem ofBool_congr (b : Bool) (e' : BitVec 1) (h : e' = BitVec.ofBool b) : e'.getLsbD 0 = b := by
cases b <;> simp [h]
theorem udiv_congr (lhs rhs lhs' rhs' : BitVec w) (h1 : lhs' = lhs) (h2 : rhs' = rhs) :
(lhs' / rhs') = (lhs / rhs) := by
simp[*]
theorem umod_congr (lhs rhs lhs' rhs' : BitVec w) (h1 : lhs' = lhs) (h2 : rhs' = rhs) :
(lhs' % rhs') = (lhs % rhs) := by
simp[*]
end BitVec
namespace Bool

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