Compare commits

...

95 Commits

Author SHA1 Message Date
Leonardo de Moura
f155e80698 test: beta reduction tests for grind 2025-01-19 13:11:25 -08:00
Leonardo de Moura
fcf2fee6a4 fix: better support for beta and partial applications 2025-01-19 13:08:04 -08:00
Leonardo de Moura
a2cea4c870 feat: beta reduction during internalization 2025-01-19 12:53:14 -08:00
Leonardo de Moura
3f9d62562f feat: propagateBeta at addEqStep 2025-01-19 12:11:30 -08:00
Leonardo de Moura
f773936893 fix: ensure isEqv can be applied to terms that do not have a ENode 2025-01-19 11:27:35 -08:00
Leonardo de Moura
8b2a953a60 fix: registerParent should register even if child is not in an equivalence class 2025-01-19 11:11:53 -08:00
Leonardo de Moura
fd555a7cce feat: add foldEqc 2025-01-19 11:01:40 -08:00
Leonardo de Moura
4af0afbb03 feat: grind beta-reduction support skeleton 2025-01-19 10:53:22 -08:00
Leonardo de Moura
c300e59cc8 chore: register constant function symbols as children 2025-01-19 09:55:28 -08:00
Sebastian Ullrich
645bdea23c perf: optimize setImportedEntries (#6698)
A small boost before #6691 made `modifyState` more complex, a larger
boost after.
2025-01-19 14:27:18 +00:00
Kim Morrison
35bbb48916 feat: refactor List/Array.mapFinIdx to unbundle the Fin argument (#6697)
This PR changes the arguments of `List/Array.mapFinIdx` from `(f : Fin
as.size → α → β)` to `(f : (i : Nat) → α → (h : i < as.size) → β)`, in
line with the API design elsewhere for `List/Array`.
2025-01-19 10:30:18 +00:00
Kim Morrison
b289b660c7 chore: remove deprecations from 2024-06 (#6696)
This PR removes deprecations in the standard library from June 2024.
2025-01-19 08:46:24 +00:00
Kim Morrison
75c104ce06 feat: align List/Array/Vector.reverse lemmas (#6695)
This PR aligns `List/Array/Vector.reverse` lemmas.
2025-01-19 08:40:06 +00:00
Lean stage0 autoupdater
74bd40d34d chore: update stage0 2025-01-19 03:03:18 +00:00
Leonardo de Moura
4213862b0e chore: remove [grind_norm] attribute (#6692)
This PR removes the `[grind_norm]` attribute. The normalization theorems
used by `grind` are now fixed and cannot be modified by users. We use
normalization theorems to ensure the built-in procedures receive term
wish expected "shapes". We use it for types that have built-in support
in grind. Users could misuse this feature as a simplification rule. For
example, consider the following example:

```lean
def replicate : (n : Nat) → (a : α) → List α
  | 0,   _ => []
  | n+1, a => a :: replicate n a

-- I want `grind` to instantiate the equations theorems for me.
attribute [grind] replicate

-- I want it to use the equation theorems as simplication rules too.
attribute [grind_norm] replicate

/--
info: [grind.assert] n = 0
[grind.assert] ¬replicate n xs = []
[grind.ematch.instance] replicate.eq_1: replicate 0 xs = []
[grind.assert] True
-/
set_option trace.grind.ematch.instance true in
set_option trace.grind.assert true in
example (xs : List α) : n = 0 → replicate n xs = [] := by
  grind -- fails :(
```

In this example, `grind` starts by asserting the two propositions as
expected: `n = 0`, and `¬replicate n xs = []`. The normalizer cannot
reduce `replicate n xs` as expected.
Then, the E-matching module finds the instance `replicate 0 xs = []` for
the equation theorem `replicate.eq_1` also as expected. But, then the
normalizer kicks in and reduces the new instance to `True`. By removing
`[grind_norm]` we elimninate this kind of misuse. Users that want to
preprocess a formula before invoking `grind` should use `simp` instead.
2025-01-19 02:12:01 +00:00
Sebastian Ullrich
4d8bc22228 feat: Environment.addConstAsync (#6691)
This PR introduces the central API for making parallel changes to the
environment
2025-01-19 02:00:16 +00:00
Lean stage0 autoupdater
7ee938290b chore: update stage0 2025-01-19 01:04:01 +00:00
Leonardo de Moura
478d42105f feat: init_grind_norm elaborator (#6690)
Motivation: we will remove the `[grind_norm]` attribute.
2025-01-19 00:15:13 +00:00
Kim Morrison
5998ba545b feat: regression tests for grind adapted from lean-egg (#6688)
Adapts, with permission, unit tests from `lean-egg` written by Marcus
Rossel as regression tests for `grind`.
2025-01-18 23:46:55 +00:00
Sebastian Ullrich
8a8417f6e1 refactor: getUnfoldableConst*? (#5997)
Continuation from #5429: eliminates uses of these two functions that
care about something other than reducible defs/theorems, then restricts
the function definition to these cases to be more true to its name.
2025-01-18 23:30:40 +00:00
Lean stage0 autoupdater
26941793ff chore: update stage0 2025-01-18 23:46:01 +00:00
Leonardo de Moura
70050c3798 chore: init_grind_norm command parser (#6689) 2025-01-18 23:07:54 +00:00
Sebastian Ullrich
50a0a97b49 refactor: move registration of namespaces on kernel add into elaborator (#6214)
Kernel checking will be moved to a different thread but namespace
registration should stay on the elaboration thread
2025-01-18 23:01:29 +00:00
Lean stage0 autoupdater
5fb2e892c8 chore: update stage0 2025-01-18 19:28:20 +00:00
Sebastian Ullrich
3770808b58 feat: split Lean.Kernel.Environment from Lean.Environment (#5145)
This PR splits the environment used by the kernel from that used by the
elaborator, providing the foundation for tracking of asynchronously
elaborated declarations, which will exist as a concept only in the
latter.

Minor changes:
* kernel diagnostics are moved from an environment extension to a direct
environment as they are the only extension used directly by the kernel
* `initQuot` is moved from an environment header field to a direct
environment as it is the only header field used by the kernel; this also
makes the remaining header immutable after import
2025-01-18 18:42:57 +00:00
Andrés Goens
5e63dd292f chore: fix typo in docstring of mkMVar (#6687)
This PR fixes a very small typo in the docstring of `mkMVar` that
misspelled the function it recommends to use instead.
2025-01-18 12:28:33 +00:00
Kitamado
98e3d6f663 fix: make #check_failure's output be info (#6685)
This PR fixes the issue that `#check_failure`'s output is warning

Closes #6684
2025-01-18 07:27:44 +00:00
Leonardo de Moura
d4070d4bfb fix: grind parameter issues and configuration (#6686)
This PR fixes parameter processing, initialization, and attribute
handling issues in the `grind` tactic.
2025-01-18 03:15:59 +00:00
Leonardo de Moura
4d4c0941be feat: extensionality theorems in grind (#6682)
This PR adds support for extensionality theorems (using the `[ext]`
attribute) to the `grind` tactic. Users can disable this functionality
using `grind -ext` . Below are examples that demonstrate problems now
solvable by `grind`.

```lean
open List in
example : (replicate n a).map f = replicate n (f a) := by
  grind only [Option.map_some', Option.map_none', getElem?_map, getElem?_replicate]
```

```lean
@[ext] structure S where
  a : Nat
  b : Bool

example (x y : S) : x.a = y.a → y.b = x.b → x = y := by
  grind
```
2025-01-17 23:59:36 +00:00
Leonardo de Moura
9b629cc81f chore: update stage0
Manual update stage0 is required to get the test suite green.
2025-01-17 12:31:14 -08:00
Leonardo de Moura
f374ef154e refactor: move ext environment extension to Lean.Meta.Tactic 2025-01-17 12:31:14 -08:00
Lean stage0 autoupdater
e3fd954318 chore: update stage0 2025-01-17 04:30:58 +00:00
Cameron Zwarich
b7815b5684 feat: add lcAny constant to Prelude (#6665)
This PR adds a new lcAny constant to Prelude, which is meant for use in
LCNF to represent types whose dependency on another term has been erased
during compilation. This is in addition to the existing lcErased
constant, which represents types that are irrelevant.
2025-01-17 01:33:35 +00:00
Cameron Zwarich
7f0ae22e43 fix: don't filter out local instances in LCNF toMono pass (#6664)
This PR changes the toMono pass to longer filter out type class
instances, because they may actually be needed for later compilation.
2025-01-17 01:32:49 +00:00
Leonardo de Moura
35a4da28ac feat: add simp-like parameters to grind (#6675)
This PR adds `simp`-like parameters to `grind`, and `grind only` similar
to `simp only`.
2025-01-17 01:08:45 +00:00
Henrik Böving
60142c967c chore: remove unneeded instance (#6671)
This PR removes an `Inhabited` instance from the imported LRAT checker
code that is unneeded but also potentially triggers for each `Inhabited`
query.
2025-01-16 18:32:37 +00:00
Leonardo de Moura
17c0187252 fix: add workaround for MessageData limitations (#6669)
This PR adds a workaround for the discrepancy between Terminal/Emacs and
VS Code when displaying info trees.
2025-01-16 16:58:20 +00:00
Leonardo de Moura
e42f7d9fc3 feat: equality resolution for grind (#6663)
This PR implements a basic equality resolution procedure for the `grind`
tactic.
2025-01-16 16:33:11 +00:00
Luisa Cicolini
906aa1be4b feat: add Nat.[shiftLeft_or_distrib, shiftLeft_xor_distrib, shiftLeft_and_distrib, testBit_mul_two_pow, bitwise_mul_two_pow, shiftLeft_bitwise_distrib] (#6630)
This PR adds theorems `Nat.[shiftLeft_or_distrib`,
shiftLeft_xor_distrib`, shiftLeft_and_distrib`, `testBit_mul_two_pow`,
`bitwise_mul_two_pow`, `shiftLeft_bitwise_distrib]`, to prove
`Nat.shiftLeft_or_distrib` by emulating the proof strategy of
`shiftRight_and_distrib`.

In particular, `Nat.shiftLeft_or_distrib` is necessary to simplify the
proofs in #6476.

---------

Co-authored-by: Alex Keizer <alex@keizer.dev>
2025-01-16 10:59:00 +00:00
Kim Morrison
f01527142e feat: align List.replicate/Array.mkArray/Vector.mkVector lemmas (#6667)
This PR aligns `List.replicate`/`Array.mkArray`/`Vector.mkVector`
lemmas.
2025-01-16 09:48:01 +00:00
Kim Morrison
f4c9934171 feat: Vector.getElem_flatMap (#6661)
This PR adds array indexing lemmas for `Vector.flatMap`. (These were not
available for `List` and `Array` due to variable lengths.)
2025-01-16 06:33:54 +00:00
Kim Morrison
80ddbf45eb feat: align List/Array/Vector.flatMap (#6660)
This PR defines `Vector.flatMap`, changes the order of arguments in
`List.flatMap` for consistency, and aligns the lemmas for
`List`/`Array`/`Vector` `flatMap`.
2025-01-16 05:19:28 +00:00
Leonardo de Moura
3a6c5cf4f1 feat: canonicalizer diagnostics (#6662)
This PR improves the canonicalizer used in the `grind` tactic and the
diagnostics it produces. It also adds a new configuration option,
`canonHeartbeats`, to address (some of) the issues. Here is an example
illustrating the new diagnostics, where we intentionally create a
problem by using a very small number of heartbeats.

<img width="1173" alt="image"
src="https://github.com/user-attachments/assets/484005c8-dcaa-4164-8fbf-617864ed7350"
/>
2025-01-16 04:59:18 +00:00
Leonardo de Moura
af4a7d7e98 fix: grind term preprocessor (#6659)
This PR fixes a bug in the `grind` term preprocessor. It was abstracting
nested proofs **before** reducible constants were unfolded.

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
2025-01-16 01:22:06 +00:00
Leonardo de Moura
6259b4742c feat: improve case-split heuristic used in grind (#6658)
This PR ensures that `grind` avoids case-splitting on terms congruent to
those that have already been case-split.
2025-01-16 00:17:27 +00:00
Mac Malone
0050e9369c refactor: lake: use StateRefT for BuildStore (#6290)
This PR uses `StateRefT` instead of `StateT` to equip the Lake build
monad with a build store.

As a IO reference, different threads may now contend with the build
store. However, benchmark results indicate that this does not have a
significant performance impact. On a synchronization front, the lack of
a mutex should not be a concern because the build store is a
memorization data structure and thus order is theoretically irrelevant.
2025-01-15 23:42:32 +00:00
Leonardo de Moura
64cf5e5e6a feat: improve grind search procedure (#6657)
This PR improves the `grind` search procedure, and adds the new
configuration option: `failures`.
2025-01-15 23:08:41 +00:00
Kim Morrison
127b3f9191 feat: more grind tests (#6650)
This PR adds some tests for `grind`, working on `List` lemmas.
2025-01-15 23:00:23 +00:00
Leonardo de Moura
65175dc7d4 feat: improvegrind diagnostic information (#6656)
This PR improves the diagnostic information provided in `grind` failure
states. We now include the list of issues found during the search, and
all search thresholds that have been reached. This PR also improves its
formatting.
2025-01-15 20:57:28 +00:00
Leonardo de Moura
54f06ccd64 feat: better support for partial applications in the E-matching procedure (#6654)
This PR improves the support for partial applications in the E-matching
procedure used in `grind`.
2025-01-15 18:31:34 +00:00
Leonardo de Moura
b3f8feffd3 fix: improve E-matching pattern selection heuristics (#6653)
This PR improves the E-matching pattern selection heuristics in the
`grind` tactic. They now take into account type predicates and
transformers.
2025-01-15 16:43:59 +00:00
Lukas Gerlach
6665837232 feat: verify insertMany method for adding lists to HashMaps (#6211)
This PR verifies the `insertMany` method on `HashMap`s for the special
case of inserting lists.

---------

Co-authored-by: jt0202 <johannes.tantow@gmail.com>
Co-authored-by: monsterkrampe <monsterkrampe@users.noreply.github.com>
Co-authored-by: Johannes Tantow <44068763+jt0202@users.noreply.github.com>
2025-01-15 14:57:26 +00:00
Henrik Böving
c7fd873333 feat: tag lemmas 2025-01-15 15:17:36 +01:00
Henrik Böving
a10ce9492f chore: update stage0 2025-01-15 15:17:36 +01:00
Henrik Böving
838ad281f2 feat: add the int_toBitVec simpset 2025-01-15 15:17:36 +01:00
Henrik Böving
a1ef26bd8b perf: improve bv_decide preprocessing based on Bitwuzla optimisations (#6641)
This PR implements several optimisation tricks from Bitwuzla's
preprocessing passes into the Lean equivalent in `bv_decide`. Note that
these changes are mostly geared towards large proof states as for
example seen in SMT-Lib.
2025-01-15 12:09:43 +00:00
Leonardo de Moura
a955708b6c fix: grind canonicalizer state management (#6649)
This PR fixes a bug in the term canonicalizer used in the `grind`
tactic.
2025-01-15 05:51:54 +00:00
Kim Morrison
0f7f80aff5 fix: indicate dependency on pkgconf in ubuntu docs (#6646)
This PR changes the ubuntu docs to indicate that Lean now requires
pkgconf to build.

This is a companion to #6643, but I can't push directly to that branch.
2025-01-15 05:30:20 +00:00
Leonardo de Moura
8d69909b18 feat: literals, lower and upper bounds in the offset constraint module within grind (#6648)
This PR adds support for numerals, lower & upper bounds to the offset
constraint module in the `grind` tactic. `grind` can now solve examples
such as:
```
example (f : Nat → Nat) :
        f 2 = a →
        b ≤ 1 → b ≥ 1 →
        c = b + 1 →
        f c = a := by
  grind
```
In the example above, the literal `2` and the lower&upper bounds, `b ≤
1` and `b ≥ 1`, are now processed by offset constraint module.
2025-01-15 02:53:31 +00:00
Kim Morrison
f95d8108f4 chore: fib_correct monadic reasoning example as a test (#6647)
This PR records the `fib_impl n = fib_spec n` example, and a proof using
current technologies, as a test.

I'd like to think about eliminating `MProd` from the terms produced by
`do` notation; it seems (at least) a simproc would be required.
2025-01-15 01:58:15 +00:00
Kim Morrison
5d6bf75795 feat: align List/Array/Vector flatten lemmas (#6640)
This PR completes aligning `List`/`Array`/`Vector` lemmas about
`flatten`. `Vector.flatten` was previously missing, and has been added
(for rectangular sizes only). A small number of missing `Option` lemmas
were also need to get the proofs to go through.
2025-01-15 01:16:19 +00:00
Leonardo de Moura
563d5e8bcf feat: offset equalities in grind (#6645)
This PR implements support for offset equality constraints in the
`grind` tactic and exhaustive equality propagation for them. The `grind`
tactic can now solve problems such as the following:

```lean
example (f : Nat → Nat) (a b c d e : Nat) :
        f (a + 3) = b →
        f (c + 1) = d →
        c ≤ a + 2 →
        a + 1 ≤ e →
        e < c →
        b = d := by
  grind
```
2025-01-14 23:45:46 +00:00
Cameron Zwarich
3da7f70014 fix: indicate dependency on pkgconf in macOS docs (#6643)
This PR changes the macOS docs to indicate that Lean now requires
pkgconf to build.
2025-01-14 23:40:26 +00:00
Cameron Zwarich
8e5a3e416b chore: remove duplicate branch in LCNF.toMonoType (#6644) 2025-01-14 23:32:54 +00:00
Henrik Böving
9dbe5e6f9c refactor: bv_normalize simp set and implementation (#6639)
This PR puts the `bv_normalize` simp set into simp_nf and splits up the
bv_normalize implementation across multiple files in preparation for
upcoming changes.
2025-01-14 12:06:01 +00:00
Luisa Cicolini
c12b1d0a55 chore: fix docstring in Bitvec.toNat_add_of_lt (#6638)
This PR correct the docstring of theorem `Bitvec.toNat_add_of_lt`
2025-01-14 10:56:48 +00:00
Kim Morrison
85294b800f chore: update release checklist (#6637)
This PR updates the release checklist script to:
* validate the `releases/v4.X.0` branch
* check that the release has been tagged
* appears on the releases list
* and has release notes (and if not, prompts to run the script
* and when checking downstream repositories, if something is not tagged
properly, suggests the script to run to push the missing tag.
2025-01-14 10:18:46 +00:00
Paul Reichert
821c9b7af9 feat: faster, linear HashMap.alter and modify (#6573)
This PR replaces the existing implementations of `(D)HashMap.alter` and
`(D)HashMap.modify` with primitive, more efficient ones and in
particular provides proofs that they yield well-formed hash maps (`WF`
typeclass).

---------

Co-authored-by: Paul Reichert <6992158+datokrat@users.noreply.github.com>
2025-01-14 07:47:58 +00:00
Henrik Böving
e9bd9807ef fix: Windows stage0 linking (#6622)
This PR fixes stage0 linking on Windows against winsock.

---------

Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2025-01-14 09:09:50 +01:00
Leonardo de Moura
05aa256c99 feat: model construction for offset constraints (#6636)
This PR implements model construction for offset constraints in the
`grind` tactic.
2025-01-14 03:28:58 +00:00
Leonardo de Moura
d6f0c324c3 chore: display E-matching theorems in goalToMessageData (#6635)
This PR includes the activated E-matching theorems and their patterns in
`goalToMessageData`
2025-01-14 02:25:30 +00:00
Leonardo de Moura
f57745e9d4 feat: improve grind failure message (#6633)
This PR improves the failure message produced by the `grind` tactic. We
now include information about asserted facts, propositions that are
known to be true and false, and equivalence classes.
2025-01-14 01:10:47 +00:00
Mac Malone
749a82a8ce fix: lake: set MACOSX_DEPLOYMENT_TARGET for shared libs (#6631)
This PR sets `MACOSX_DEPLOYMENT_TARGET` for shared libraries (it was
previously only set for executables).
2025-01-13 21:18:09 +00:00
Cameron Zwarich
85560da3e4 chore: remove functions for compiling decls from Environment (#6600)
This PR removes functions from compiling decls from Environment, and
moves all users to functions on CoreM. This is required for supporting
the new code generator, since its implementation uses CoreM.
2025-01-13 18:51:06 +00:00
Henrik Böving
e6a643770f feat: implement basic async IO with timers (#6505)
This PR implements a basic async framework as well as asynchronously
running timers using libuv.

---------

Co-authored-by: Sofia Rodrigues <sofia@algebraic.dev>
Co-authored-by: Markus Himmel <markus@himmel-villmar.de>
Co-authored-by: Markus Himmel <markus@lean-fro.org>
2025-01-13 18:11:04 +00:00
Mac Malone
30ba383744 feat: lean --src-deps (#6427)
This PR adds the Lean CLI option `--src-deps` which parallels `--deps`.
It parses the Lean code's header and prints out the paths to the
(transitively) imported modules' source files (deduced from
`LEAN_SRC_PATH`).
2025-01-13 16:00:19 +00:00
Henrik Böving
734fca7b6a feat: UIntX.toBitVec lemmas (#6625)
This PR adds lemmas describing the behavior of `UIntX.toBitVec` on
`UIntX` operations.

I did not define them for the `IntX` half yet as that lemma file is non
existent so far and we can start working on `UIntX` in `bv_decide` with
this, then add `IntX` when we grow the `IntX` API.
2025-01-13 14:33:38 +00:00
Mac Malone
a6eea4b650 fix: lake: v4.16.0-rc1 trace issues (#6627)
This PR aims to fix the trace issues reported by Mathlib that are
breaking `lake exe cache` in downstream projects.
2025-01-13 14:16:07 +00:00
Sofia Rodrigues
8483ac7258 fix: adjustments to the datetime library (#6431)
This PR fixes the `Repr` instance of the `Timestamp` type and changes
the `PlainTime` type so that it always represents a clock time that may
be a leap second.

- Fix timestamp `Repr`.
- The `PlainTime` type now always represents a clock time that may be a
leap second.
- Changed `readlink -f` to `IO.FS.realPath`

---------

Co-authored-by: Mac Malone <tydeu@hatpress.net>
Co-authored-by: Markus Himmel <markus@himmel-villmar.de>
2025-01-13 11:02:30 +00:00
Sebastian Ullrich
5f41cc71ff fix: trace indentation in info view (#6597)
This PR fixes the indentation of nested traces nodes in the info view.


![image](https://github.com/user-attachments/assets/c13ac2a2-e994-4900-9201-0d86889f6a1b)

Fixes #6389
2025-01-13 10:36:01 +00:00
Leonardo de Moura
2421f7f799 feat: exhaustive offset constraint propagation in the grind tactic (#6618)
This PR implements exhaustive offset constraint propagation in the
`grind` tactic. This enhancement minimizes the number of case splits
performed by `grind`. For instance, it can solve the following example
without performing any case splits:

```lean
example (p q r s : Prop) (a b : Nat) : (a + 1 ≤ c ↔ p) → (a + 2 ≤ c ↔ s) → (a ≤ c ↔ q) → (a ≤ c + 4 ↔ r) → a ≤ b → b + 2 ≤ c → p ∧ q ∧ r ∧ s := by
  grind (splits := 0)
```

TODO: support for equational offset constraints.
2025-01-13 04:38:14 +00:00
Kim Morrison
40efbb9b7a doc: commit conventions and Mathlib CI (#6605)
This PR updates the commit conventions documentation to describe the new
changelog conventions, and adds brief documentation of integrated
Mathlib CI, with a link for further explanation.
2025-01-13 02:29:46 +00:00
Kim Morrison
603108e34c feat: finish alignment of List/Array/Vector.append lemmas (#6617)
This PR completes alignment of `List`/`Array`/`Vector` `append` lemmas.
2025-01-13 02:00:49 +00:00
Leonardo de Moura
aa95a1c03f chore: cleaunp grind tests (#6616)
Tests using `logInfo` were taking an additional two seconds on my
machine. This is a performance issue with the old code generator, where
we spend all this time specializing the logging functions for `GoalM`. I
have not checked whether the new code generator is also affected by this
performance issue.

Here is a small example that exposes the issue:
```lean
import Lean

set_option profiler true
open Lean Meta Grind in
def test (e : Expr): GoalM Unit := do
  logInfo e
```

cc @zwarich
2025-01-13 00:07:48 +00:00
Leonardo de Moura
af8f3d1ec1 feat: avoid some redundant proof terms in grind (#6615)
This PR adds two auxiliary functions `mkEqTrueCore` and `mkOfEqTrueCore`
that avoid redundant proof terms in proofs produced by `grind`.
2025-01-12 23:09:39 +00:00
Leonardo de Moura
c7939cfb03 feat: offset constraints support for the grind tactic (#6603)
This PR implements support for offset constraints in the `grind` tactic.
Several features are still missing, such as constraint propagation and
support for offset equalities, but `grind` can already solve examples
like the following:

```lean
example (a b c : Nat) : a ≤ b → b + 2 ≤ c → a + 1 ≤ c := by
  grind
example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by
  grind
example (a b c : Nat) : a + 1 ≤ b → b + 1 ≤ c → a + 2 ≤ c := by
  grind
example (a b c : Nat) : a + 1 ≤ b → b + 1 ≤ c → a + 1 ≤ c := by
  grind
example (a b c : Nat) : a + 1 ≤ b → b ≤ c + 2 → a ≤ c + 1 := by
  grind
example (a b c : Nat) : a + 2 ≤ b → b ≤ c + 2 → a ≤ c := by
  grind
```

---------

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
2025-01-12 20:38:39 +00:00
Parth Shastri
0da3624ec9 fix: allow dot idents to resolve to local names (#6602)
This PR allows the dot ident notation to resolve to the current
definition, or to any of the other definitions in the same mutual block.
Existing code that uses dot ident notation may need to have `nonrec`
added if the ident has the same name as the definition.

Closes #6601
2025-01-12 17:18:22 +00:00
Leonardo de Moura
349da6cae2 feat: improve [grind =] attribute (#6614)
This PR improves the usability of the `[grind =]` attribute by
automatically handling
forbidden pattern symbols. For example, consider the following theorem
tagged with this attribute:
```
getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a]
```
Here, the selected pattern is `xs.getLast? = some a`, but `Eq` is a
forbidden pattern symbol.
Instead of producing an error, this function converts the pattern into a
multi-pattern,
allowing the attribute to be used conveniently.
2025-01-12 16:51:09 +00:00
Leonardo de Moura
541902564b feat: improve case split heuristic used in grind (#6613)
This PR improves the case split heuristic used in the `grind` tactic,
ensuring it now avoids unnecessary case-splits on `Iff`.
2025-01-12 15:40:36 +00:00
Kim Morrison
8b1aabbb1e feat: lemmas about Array.append (#6612)
This PR adds lemmas about `Array.append`, improving alignment with the
`List` API.
2025-01-12 10:19:50 +00:00
Leonardo de Moura
ce1ff03af0 fix: checkParents in grind (#6611)
This PR fixes one of the sanity check tests used in `grind`.
2025-01-12 05:30:41 +00:00
Leonardo de Moura
c5c1278315 fix: bug in the grind propagator (#6610)
This PR fixes a bug in the `grind` core module responsible for merging
equivalence classes and propagating constraints.
2025-01-12 05:14:41 +00:00
Leonardo de Moura
5119528d20 feat: improve case-split heuristic used in grind (#6609)
This PR improves the case-split heuristic used in grind, prioritizing
case-splits with fewer cases.
2025-01-12 04:21:04 +00:00
Leonardo de Moura
4636091571 fix: simp_arith (#6608)
This PR fixes a bug in the `simp_arith` tactic. See new test.
2025-01-12 03:27:13 +00:00
Leonardo de Moura
7ea5504af2 feat: add support for splitting on <-> to grind (#6607)
This PR adds support for case-splitting on `<->` (and `@Eq Prop`) in the
`grind` tactic.
2025-01-12 02:25:02 +00:00
753 changed files with 16610 additions and 3164 deletions

View File

@@ -238,7 +238,7 @@ jobs:
"name": "Linux 32bit",
"os": "ubuntu-latest",
// Use 32bit on stage0 and stage1 to keep oleans compatible
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/",
"CMAKE_OPTIONS": "-DSTAGE0_USE_GMP=OFF -DSTAGE0_LEAN_EXTRA_CXX_FLAGS='-m32' -DSTAGE0_LEANC_OPTS='-m32' -DSTAGE0_MMAP=OFF -DUSE_GMP=OFF -DLEAN_EXTRA_CXX_FLAGS='-m32' -DLEANC_OPTS='-m32' -DMMAP=OFF -DLEAN_INSTALL_SUFFIX=-linux_x86 -DCMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DSTAGE0_CMAKE_LIBRARY_PATH=/usr/lib/i386-linux-gnu/ -DPKG_CONFIG_EXECUTABLE=/usr/bin/i386-linux-gnu-pkg-config",
"cmultilib": true,
"release": true,
"check-level": 2,
@@ -327,7 +327,7 @@ jobs:
run: |
sudo dpkg --add-architecture i386
sudo apt-get update
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
if: matrix.cmultilib
- name: Cache
uses: actions/cache@v4

View File

@@ -18,6 +18,9 @@ foreach(var ${vars})
if("${var}" MATCHES "LLVM*")
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
endif()
if("${var}" MATCHES "PKG_CONFIG*")
list(APPEND STAGE0_ARGS "-D${var}=${${var}}")
endif()
elseif(("${var}" MATCHES "CMAKE_.*") AND NOT ("${var}" MATCHES "CMAKE_BUILD_TYPE") AND NOT ("${var}" MATCHES "CMAKE_HOME_DIRECTORY"))
list(APPEND PLATFORM_ARGS "-D${var}=${${var}}")
endif()

View File

@@ -33,6 +33,9 @@ Format of the commit message
- chore (maintain, ex: travis-ci)
- perf (performance improvement, optimization, ...)
Every `feat` or `fix` commit must have a `changelog-*` label, and a commit message
beginning with "This PR " that will be included in the changelog.
``<subject>`` has the following constraints:
- use imperative, present tense: "change" not "changed" nor "changes"
@@ -44,6 +47,7 @@ Format of the commit message
- just as in ``<subject>``, use imperative, present tense
- includes motivation for the change and contrasts with previous
behavior
- If a `changelog-*` label is present, the body must begin with "This PR ".
``<footer>`` is optional and may contain two items:
@@ -60,17 +64,21 @@ Examples
fix: add declarations for operator<<(std::ostream&, expr const&) and operator<<(std::ostream&, context const&) in the kernel
This PR adds declarations `operator<<` for raw printing.
The actual implementation of these two operators is outside of the
kernel. They are implemented in the file 'library/printer.cpp'. We
declare them in the kernel to prevent the following problem. Suppose
there is a file 'foo.cpp' that does not include 'library/printer.h',
but contains
kernel. They are implemented in the file 'library/printer.cpp'.
expr a;
...
std::cout << a << "\n";
...
We declare them in the kernel to prevent the following problem.
Suppose there is a file 'foo.cpp' that does not include 'library/printer.h',
but contains
```cpp
expr a;
...
std::cout << a << "\n";
...
```
The compiler does not generate an error message. It silently uses the
operator bool() to coerce the expression into a Boolean. This produces
counter-intuitive behavior, and may confuse developers.

View File

@@ -80,3 +80,10 @@ Unlike most Lean projects, all submodules of the `Lean` module begin with the
`prelude` keyword. This disables the automated import of `Init`, meaning that
developers need to figure out their own subset of `Init` to import. This is done
such that changing files in `Init` doesn't force a full rebuild of `Lean`.
### Testing against Mathlib/Batteries
You can test a Lean PR against Mathlib and Batteries by rebasing your PR
on to `nightly-with-mathlib` branch. (It is fine to force push after rebasing.)
CI will generate a branch of Mathlib and Batteries called `lean-pr-testing-NNNN`
that uses the toolchain for your PR, and will report back to the Lean PR with results from Mathlib CI.
See https://leanprover-community.github.io/contribute/tags_and_branches.html for more details.

View File

@@ -32,12 +32,13 @@ following to use `g++`.
cmake -DCMAKE_CXX_COMPILER=g++ ...
```
## Required Packages: CMake, GMP, libuv
## Required Packages: CMake, GMP, libuv, pkgconf
```bash
brew install cmake
brew install gmp
brew install libuv
brew install pkgconf
```
## Recommended Packages: CCache

View File

@@ -8,5 +8,5 @@ follow the [generic build instructions](index.md).
## Basic packages
```bash
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
```

View File

@@ -28,7 +28,7 @@
stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
} ({
buildInputs = with pkgs; [
cmake gmp libuv ccache cadical
cmake gmp libuv ccache cadical pkg-config
lean-packages.llvmPackages.llvm # llvm-symbolizer for asan/lsan
gdb
tree # for CI

View File

@@ -1,12 +1,12 @@
{ src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
stdenv, lib, cmake, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
... } @ args:
with builtins;
lib.warn "The Nix-based build is deprecated" rec {
inherit stdenv;
sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
buildCMake = args: stdenv.mkDerivation ({
nativeBuildInputs = [ cmake ];
nativeBuildInputs = [ cmake pkg-config ];
buildInputs = [ gmp libuv llvmPackages.llvm ];
# https://github.com/NixOS/nixpkgs/issues/60919
hardeningDisable = [ "all" ];

69
script/push_repo_release_tag.py Executable file
View File

@@ -0,0 +1,69 @@
#!/usr/bin/env python3
import sys
import subprocess
import requests
def main():
if len(sys.argv) != 4:
print("Usage: ./push_repo_release_tag.py <repo> <branch> <version_tag>")
sys.exit(1)
repo, branch, version_tag = sys.argv[1], sys.argv[2], sys.argv[3]
if branch not in {"master", "main"}:
print(f"Error: Branch '{branch}' is not 'master' or 'main'.")
sys.exit(1)
# Get the `lean-toolchain` file content
lean_toolchain_url = f"https://raw.githubusercontent.com/{repo}/{branch}/lean-toolchain"
try:
response = requests.get(lean_toolchain_url)
response.raise_for_status()
except requests.exceptions.RequestException as e:
print(f"Error fetching 'lean-toolchain' file: {e}")
sys.exit(1)
lean_toolchain_content = response.text.strip()
expected_prefix = "leanprover/lean4:"
if not lean_toolchain_content.startswith(expected_prefix) or lean_toolchain_content != f"{expected_prefix}{version_tag}":
print(f"Error: 'lean-toolchain' content does not match '{expected_prefix}{version_tag}'.")
sys.exit(1)
# Create and push the tag using `gh`
try:
# Check if the tag already exists
list_tags_cmd = ["gh", "api", f"repos/{repo}/git/matching-refs/tags/v4", "--jq", ".[].ref"]
list_tags_output = subprocess.run(list_tags_cmd, capture_output=True, text=True)
if list_tags_output.returncode == 0:
existing_tags = list_tags_output.stdout.strip().splitlines()
if f"refs/tags/{version_tag}" in existing_tags:
print(f"Error: Tag '{version_tag}' already exists.")
print("Existing tags starting with 'v4':")
for tag in existing_tags:
print(tag.replace("refs/tags/", ""))
sys.exit(1)
# Get the SHA of the branch
get_sha_cmd = [
"gh", "api", f"repos/{repo}/git/ref/heads/{branch}", "--jq", ".object.sha"
]
sha_result = subprocess.run(get_sha_cmd, capture_output=True, text=True, check=True)
sha = sha_result.stdout.strip()
# Create the tag
create_tag_cmd = [
"gh", "api", f"repos/{repo}/git/refs",
"-X", "POST",
"-F", f"ref=refs/tags/{version_tag}",
"-F", f"sha={sha}"
]
subprocess.run(create_tag_cmd, capture_output=True, text=True, check=True)
print(f"Successfully created and pushed tag '{version_tag}' to {repo}.")
except subprocess.CalledProcessError as e:
print(f"Error while creating/pushing tag: {e.stderr.strip() if e.stderr else e}")
sys.exit(1)
if __name__ == "__main__":
main()

View File

@@ -22,6 +22,36 @@ def get_github_token():
print("Warning: 'gh' CLI not found. Some API calls may be rate-limited.")
return None
def strip_rc_suffix(toolchain):
"""Remove -rcX suffix from the toolchain."""
return toolchain.split("-")[0]
def branch_exists(repo_url, branch, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/branches/{branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def tag_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def release_page_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def get_release_notes(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
if response.status_code == 200:
return response.json().get("body", "").strip()
return None
def get_branch_content(repo_url, branch, file_path, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
@@ -35,11 +65,20 @@ def get_branch_content(repo_url, branch, file_path, github_token):
return None
return None
def tag_exists(repo_url, tag_name, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/git/refs/tags/{tag_name}"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
response = requests.get(api_url, headers=headers)
return response.status_code == 200
def parse_version(version_str):
# Remove 'v' prefix and extract version and release candidate suffix
if ':' in version_str:
version_str = version_str.split(':')[1]
version = version_str.lstrip('v')
parts = version.split('-')
base_version = tuple(map(int, parts[0].split('.')))
rc_part = parts[1] if len(parts) > 1 and parts[1].startswith('rc') else None
rc_number = int(rc_part[2:]) if rc_part else float('inf') # Treat non-rc as higher than rc
return base_version + (rc_number,)
def is_version_gte(version1, version2):
"""Check if version1 >= version2, including proper handling of release candidates."""
return parse_version(version1) >= parse_version(version2)
def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
# First get the commit SHA for the tag
@@ -64,23 +103,38 @@ def is_merged_into_stable(repo_url, tag_name, stable_branch, github_token):
stable_commits = [commit['sha'] for commit in commits_response.json()]
return tag_sha in stable_commits
def parse_version(version_str):
# Remove 'v' prefix and split into components
# Handle Lean toolchain format (leanprover/lean4:v4.x.y)
if ':' in version_str:
version_str = version_str.split(':')[1]
version = version_str.lstrip('v')
# Handle release candidates by removing -rc part for comparison
version = version.split('-')[0]
return tuple(map(int, version.split('.')))
def is_version_gte(version1, version2):
"""Check if version1 >= version2"""
return parse_version(version1) >= parse_version(version2)
def is_release_candidate(version):
return "-rc" in version
def check_cmake_version(repo_url, branch, version_major, version_minor, github_token):
"""Verify the CMake version settings in src/CMakeLists.txt."""
cmake_file_path = "src/CMakeLists.txt"
content = get_branch_content(repo_url, branch, cmake_file_path, github_token)
if content is None:
print(f" ❌ Could not retrieve {cmake_file_path} from {branch}")
return False
expected_lines = [
f"set(LEAN_VERSION_MAJOR {version_major})",
f"set(LEAN_VERSION_MINOR {version_minor})",
f"set(LEAN_VERSION_PATCH 0)",
f"set(LEAN_VERSION_IS_RELEASE 1)"
]
for line in expected_lines:
if not any(l.strip().startswith(line) for l in content.splitlines()):
print(f" ❌ Missing or incorrect line in {cmake_file_path}: {line}")
return False
print(f" ✅ CMake version settings are correct in {cmake_file_path}")
return True
def extract_org_repo_from_url(repo_url):
"""Extract the 'org/repo' part from a GitHub URL."""
if repo_url.startswith("https://github.com/"):
return repo_url.replace("https://github.com/", "").rstrip("/")
return repo_url
def main():
github_token = get_github_token()
@@ -89,6 +143,47 @@ def main():
sys.exit(1)
toolchain = sys.argv[1]
stripped_toolchain = strip_rc_suffix(toolchain)
lean_repo_url = "https://github.com/leanprover/lean4"
# Preliminary checks
print("\nPerforming preliminary checks...")
# Check for branch releases/v4.Y.0
version_major, version_minor, _ = map(int, stripped_toolchain.lstrip('v').split('.'))
branch_name = f"releases/v{version_major}.{version_minor}.0"
if branch_exists(lean_repo_url, branch_name, github_token):
print(f" ✅ Branch {branch_name} exists")
# Check CMake version settings
check_cmake_version(lean_repo_url, branch_name, version_major, version_minor, github_token)
else:
print(f" ❌ Branch {branch_name} does not exist")
# Check for tag v4.X.Y(-rcZ)
if tag_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Tag {toolchain} exists")
else:
print(f" ❌ Tag {toolchain} does not exist.")
# Check for release page
if release_page_exists(lean_repo_url, toolchain, github_token):
print(f" ✅ Release page for {toolchain} exists")
# Check the first line of the release notes
release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
if release_notes and release_notes.splitlines()[0].strip() == toolchain:
print(f" ✅ Release notes look good.")
else:
previous_minor_version = version_minor - 1
previous_stable_branch = f"releases/v{version_major}.{previous_minor_version}.0"
previous_release = f"v{version_major}.{previous_minor_version}.0"
print(f" ❌ Release notes not published. Please run `script/release_notes.py {previous_release}` on branch `{previous_stable_branch}`.")
else:
print(f" ❌ Release page for {toolchain} does not exist")
# Load repositories and perform further checks
print("\nChecking repositories...")
with open(os.path.join(os.path.dirname(__file__), "release_repos.yml")) as f:
repos = yaml.safe_load(f)["repositories"]
@@ -117,7 +212,7 @@ def main():
# Only check for tag if toolchain-tag is true
if check_tag:
if not tag_exists(url, toolchain, github_token):
print(f" ❌ Tag {toolchain} does not exist")
print(f" ❌ Tag {toolchain} does not exist. Run `script/push_repo_release_tag.py {extract_org_repo_from_url(url)} {branch} {toolchain}`.")
continue
print(f" ✅ Tag {toolchain} exists")

View File

@@ -295,14 +295,15 @@ index 5e8e0166..f3b29134 100644
PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
BUILD_IN_SOURCE ON
INSTALL_COMMAND "")
set(LIBUV_INCLUDE_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
set(LIBUV_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LDFLAGS "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
else()
find_package(LibUV 1.0.0 REQUIRED)
endif()
include_directories(${LIBUV_INCLUDE_DIR})
include_directories(${LIBUV_INCLUDE_DIRS})
if(NOT LEAN_STANDALONE)
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
string(JOIN " " LIBUV_LDFLAGS ${LIBUV_LDFLAGS})
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
endif()
# Windows SDK (for ICU)
@@ -698,12 +699,12 @@ else()
endif()
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
add_custom_target(lake_lib ALL
add_custom_target(lake_lib
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS leanshared
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make Lake
VERBATIM)
add_custom_target(lake_shared ALL
add_custom_target(lake_shared
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
DEPENDS lake_lib
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make libLake_shared

View File

@@ -244,8 +244,7 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
def range (n : Nat) : Array Nat :=
ofFn fun (i : Fin n) => i
def singleton (v : α) : Array α :=
mkArray 1 v
@[inline] protected def singleton (v : α) : Array α := #[v]
def back! [Inhabited α] (a : Array α) : α :=
a[a.size - 1]!
@@ -456,7 +455,7 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Array α) (f : Fin as.size α m β) : m (Array β) :=
(as : Array α) (f : (i : Nat) α (h : i < as.size) m β) : m (Array β) :=
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
match i, inv with
| 0, _ => pure bs
@@ -465,12 +464,12 @@ def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
have : i + (j + 1) = as.size := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this (bs.push ( f j, j_lt (as.get j j_lt)))
map i (j+1) this (bs.push ( f j (as.get j j_lt) j_lt))
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : Nat α m β) (as : Array α) : m (Array β) :=
as.mapFinIdxM fun i a => f i a
as.mapFinIdxM fun i a _ => f i a
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m (Option β)) (as : Array α) : m (Option β) := do
@@ -577,13 +576,19 @@ def foldl {α : Type u} {β : Type v} (f : β → α → β) (init : β) (as : A
def foldr {α : Type u} {β : Type v} (f : α β β) (init : β) (as : Array α) (start := as.size) (stop := 0) : β :=
Id.run <| as.foldrM f init start stop
/-- Sum of an array.
`Array.sum #[a, b, c] = a + (b + (c + 0))` -/
def sum {α} [Add α] [Zero α] : Array α α :=
foldr (· + ·) 0
@[inline]
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : (i : Nat) α (h : i < as.size) β) : Array β :=
Id.run <| as.mapFinIdxM f
@[inline]

View File

@@ -81,12 +81,18 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
apply ext'; simp only [toList_append, toList_empty, List.append_nil]
@[simp] theorem nil_append (as : Array α) : #[] ++ as = as := by
@[deprecated append_empty (since := "2025-01-13")]
abbrev append_nil := @append_empty
@[simp] theorem empty_append (as : Array α) : #[] ++ as = as := by
apply ext'; simp only [toList_append, toList_empty, List.nil_append]
@[deprecated empty_append (since := "2025-01-13")]
abbrev nil_append := @empty_append
@[simp] theorem append_assoc (as bs cs : Array α) : as ++ bs ++ cs = as ++ (bs ++ cs) := by
apply ext'; simp only [toList_append, List.append_assoc]

View File

@@ -74,12 +74,12 @@ theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (
theorem getElem?_zero_flatten (L : Array (Array α)) :
(flatten L)[0]? = L.findSome? fun l => l[0]? := by
cases L using array_array_induction
cases L using array_induction
simp [ List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
(L.findSome? fun l => l[0]?).isSome := by
cases L using array_array_induction
cases L using array_induction
simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
List.findSome?_isSome_iff, isSome_getElem?]
simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
@@ -95,7 +95,7 @@ theorem getElem_zero_flatten {L : Array (Array α)} (h) :
theorem back?_flatten {L : Array (Array α)} :
(flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
cases L using array_array_induction
cases L using array_induction
simp [List.getLast?_flatten, List.map_reverse, List.findSome?_map, Function.comp_def]
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
@@ -203,7 +203,7 @@ theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h ∈ xs := by
@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α Bool) :
xs.flatten.find? p = xs.findSome? (·.find? p) := by
cases xs using array_array_induction
cases xs using array_induction
simp [List.findSome?_map, Function.comp_def]
theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α Bool} :
@@ -220,7 +220,7 @@ theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α → Bool} {a : α}
p a (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
xs = as.push (ys.push a ++ zs) ++ bs
( a as, x a, !p x) ( x ys, !p x) := by
cases xs using array_array_induction
cases xs using array_induction
simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
intro w

File diff suppressed because it is too large Load Diff

View File

@@ -12,81 +12,82 @@ namespace Array
/-! ### mapFinIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
theorem mapFinIdx_induction (as : Array α) (f : Fin as.size α β)
theorem mapFinIdx_induction (as : Array α) (f : (i : Nat) α (h : i < as.size) β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
(p : (i : Nat) β (h : i < as.size) Prop)
(hs : i h, motive i p i (f i as[i] h) h motive (i + 1)) :
motive as.size eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
i h, p i ((Array.mapFinIdx as f)[i]) h := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i bs[i] h) (hm : motive j) :
let arr : Array β := Array.mapFinIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
motive as.size eq : arr.size = as.size, i h, p i arr[i] h := by
induction i generalizing j bs with simp [mapFinIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
| succ i ih =>
apply @ih (bs.push (f j, by omega as[j])) (j + 1) (by omega) (by simp; omega)
apply @ih (bs.push (f j as[j] (by omega))) (j + 1) (by omega) (by simp; omega)
· intro i i_lt h'
rw [getElem_push]
split
· apply h₂
· simp only [size_push] at h'
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
apply (hs i (by omega) hm).1
· exact (hs j (by omega) hm).2
simp [mapFinIdx, mapFinIdxM]; exact go rfl nofun h0
theorem mapFinIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
theorem mapFinIdx_spec (as : Array α) (f : (i : Nat) α (h : i < as.size) β)
(p : (i : Nat) β (h : i < as.size) Prop) (hs : i h, p i (f i as[i] h) h) :
eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) :=
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
i h, p i ((Array.mapFinIdx as f)[i]) h :=
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ _ => hs .., trivial).2
@[simp] theorem size_mapFinIdx (a : Array α) (f : Fin a.size α β) : (a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_mapFinIdx (a : Array α) (f : (i : Nat) α (h : i < a.size) β) :
(a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ _ => True) (hs := fun _ _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapFinIdx _ _
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : (i : Nat) α (h : i < a.size) β) (i : Nat)
(h : i < (mapFinIdx a f).size) :
(a.mapFinIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapFinIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
(a.mapFinIdx f)[i] = f i (a[i]'(by simp_all)) (by simp_all) :=
(mapFinIdx_spec _ _ (fun i b h => b = f i a[i] h) fun _ _ => rfl).2 i _
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : (i : Nat) α (h : i < a.size) β) (i : Nat) :
(a.mapFinIdx f)[i]? =
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
a[i]?.pbind fun b h => f i b (getElem?_eq_some_iff.1 h).1 := by
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
split <;> simp_all
@[simp] theorem toList_mapFinIdx (a : Array α) (f : Fin a.size α β) :
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a => f i, by simp a) := by
@[simp] theorem toList_mapFinIdx (a : Array α) (f : (i : Nat) α (h : i < a.size) β) :
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a h => f i a (by simpa)) := by
apply List.ext_getElem <;> simp
/-! ### mapIdx -/
theorem mapIdx_induction (f : Nat α β) (as : Array α)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
(p : (i : Nat) β (h : i < as.size) Prop)
(hs : i h, motive i p i (f i as[i]) h motive (i + 1)) :
motive as.size eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
i h, p i ((as.mapIdx f)[i]) h :=
mapFinIdx_induction as (fun i a _ => f i a) motive h0 p hs
theorem mapIdx_spec (f : Nat α β) (as : Array α)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
(p : (i : Nat) β (h : i < as.size) Prop) (hs : i h, p i (f i as[i]) h) :
eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
i h, p i ((as.mapIdx f)[i]) h :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (f : Nat α β) (as : Array α) : (as.mapIdx f).size = as.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
(mapIdx_spec (p := fun _ _ _ => True) (hs := fun _ _ => trivial)).1
@[simp] theorem getElem_mapIdx (f : Nat α β) (as : Array α) (i : Nat)
(h : i < (as.mapIdx f).size) :
(as.mapIdx f)[i] = f i (as[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i as[i]) fun _ => rfl).2 i (by simp_all)
(mapIdx_spec _ _ (fun i b h => b = f i as[i]) fun _ _ => rfl).2 i (by simp_all)
@[simp] theorem getElem?_mapIdx (f : Nat α β) (as : Array α) (i : Nat) :
(as.mapIdx f)[i]? =
@@ -101,7 +102,7 @@ end Array
namespace List
@[simp] theorem mapFinIdx_toArray (l : List α) (f : Fin l.length α β) :
@[simp] theorem mapFinIdx_toArray (l : List α) (f : (i : Nat) α (h : i < l.length) β) :
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
ext <;> simp

View File

@@ -1294,11 +1294,6 @@ theorem allOnes_shiftLeft_or_shiftLeft {x : BitVec w} {n : Nat} :
BitVec.allOnes w <<< n ||| x <<< n = BitVec.allOnes w <<< n := by
simp [ shiftLeft_or_distrib]
@[deprecated shiftLeft_add (since := "2024-06-02")]
theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
(x <<< n) <<< m = x <<< (n + m) := by
rw [shiftLeft_add]
/-! ### shiftLeft reductions from BitVec to Nat -/
@[simp]
@@ -1946,11 +1941,6 @@ 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
rw [shiftRight_add]
/-! ### rev -/
theorem getLsbD_rev (x : BitVec w) (i : Fin w) :
@@ -3539,7 +3529,7 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
/-! ### Non-overflow theorems -/
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
/-- If `x.toNat + y.toNat < 2^w`, then the addition `(x + y)` does not overflow. -/
theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
(x + y).toNat = x.toNat + y.toNat := by
rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]

View File

@@ -70,5 +70,3 @@ theorem utf8Size_eq (c : Char) : c.utf8Size = 1 c.utf8Size = 2 c.utf8Siz
rfl
end Char
@[deprecated Char.utf8Size (since := "2024-06-04")] abbrev String.csize := Char.utf8Size

View File

@@ -258,9 +258,6 @@ theorem ext_get? : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n)
have h0 : some a = some a' := h 0
injection h0 with aa; simp only [aa, ext_get? fun n => h (n+1)]
/-- Deprecated alias for `ext_get?`. The preferred extensionality theorem is now `ext_getElem?`. -/
@[deprecated ext_get? (since := "2024-06-07")] abbrev ext := @ext_get?
/-! ### getD -/
/--
@@ -606,11 +603,11 @@ set_option linter.missingDocs false in
to get a list of lists, and then concatenates them all together.
* `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
-/
@[inline] def flatMap {α : Type u} {β : Type v} (a : List α) (b : α List β) : List β := flatten (map b a)
@[inline] def flatMap {α : Type u} {β : Type v} (b : α List β) (a : List α) : List β := flatten (map b a)
@[simp] theorem flatMap_nil (f : α List β) : List.flatMap [] f = [] := by simp [flatten, List.flatMap]
@[simp] theorem flatMap_nil (f : α List β) : List.flatMap f [] = [] := by simp [flatten, List.flatMap]
@[simp] theorem flatMap_cons x xs (f : α List β) :
List.flatMap (x :: xs) f = f x ++ List.flatMap xs f := by simp [flatten, List.flatMap]
List.flatMap f (x :: xs) = f x ++ List.flatMap f xs := by simp [flatten, List.flatMap]
set_option linter.missingDocs false in
@[deprecated flatMap (since := "2024-10-16")] abbrev bind := @flatMap
@@ -619,11 +616,6 @@ set_option linter.missingDocs false in
set_option linter.missingDocs false in
@[deprecated flatMap_cons (since := "2024-10-16")] abbrev cons_flatMap := @flatMap_cons
set_option linter.missingDocs false in
@[deprecated flatMap_nil (since := "2024-06-15")] abbrev nil_bind := @flatMap_nil
set_option linter.missingDocs false in
@[deprecated flatMap_cons (since := "2024-06-15")] abbrev cons_bind := @flatMap_cons
/-! ### replicate -/
/--
@@ -713,11 +705,6 @@ def elem [BEq α] (a : α) : List α → Bool
theorem elem_cons [BEq α] {a : α} :
(b::bs).elem a = match a == b with | true => true | false => bs.elem a := rfl
/-- `notElem a l` is `!(elem a l)`. -/
@[deprecated "Use `!(elem a l)` instead."(since := "2024-06-15")]
def notElem [BEq α] (a : α) (as : List α) : Bool :=
!(as.elem a)
/-! ### contains -/
@[inherit_doc elem] abbrev contains [BEq α] (as : List α) (a : α) : Bool :=

View File

@@ -96,14 +96,14 @@ The following operations are given `@[csimp]` replacements below:
/-! ### flatMap -/
/-- Tail recursive version of `List.flatMap`. -/
@[inline] def flatMapTR (as : List α) (f : α List β) : List β := go as #[] where
@[inline] def flatMapTR (f : α List β) (as : List α) : List β := go as #[] where
/-- Auxiliary for `flatMap`: `flatMap.go f as = acc.toList ++ bind f as` -/
@[specialize] go : List α Array β List β
| [], acc => acc.toList
| x::xs, acc => go xs (acc ++ f x)
@[csimp] theorem flatMap_eq_flatMapTR : @List.flatMap = @flatMapTR := by
funext α β as f
funext α β f as
let rec go : as acc, flatMapTR.go f as acc = acc.toList ++ as.flatMap f
| [], acc => by simp [flatMapTR.go, flatMap]
| x::xs, acc => by simp [flatMapTR.go, flatMap, go xs]
@@ -112,7 +112,7 @@ The following operations are given `@[csimp]` replacements below:
/-! ### flatten -/
/-- Tail recursive version of `List.flatten`. -/
@[inline] def flattenTR (l : List (List α)) : List α := flatMapTR l id
@[inline] def flattenTR (l : List (List α)) : List α := l.flatMapTR id
@[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
funext α l; rw [ List.flatMap_id, List.flatMap_eq_flatMapTR]; rfl

View File

@@ -813,11 +813,6 @@ theorem getElem_cons_length (x : α) (xs : List α) (i : Nat) (h : i = xs.length
(x :: xs)[i]'(by simp [h]) = (x :: xs).getLast (cons_ne_nil x xs) := by
rw [getLast_eq_getElem]; cases h; rfl
@[deprecated getElem_cons_length (since := "2024-06-12")]
theorem get_cons_length (x : α) (xs : List α) (n : Nat) (h : n = xs.length) :
(x :: xs).get n, by simp [h] = (x :: xs).getLast (cons_ne_nil x xs) := by
simp [getElem_cons_length, h]
/-! ### getLast? -/
@[simp] theorem getLast?_singleton (a : α) : getLast? [a] = a := rfl
@@ -1026,21 +1021,10 @@ theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then n
| _ :: _, 0 => by simp
| _ :: l, i+1 => by simp [getElem?_map f l i]
@[deprecated getElem?_map (since := "2024-06-12")]
theorem get?_map (f : α β) : l i, (map f l).get? i = (l.get? i).map f
| [], _ => rfl
| _ :: _, 0 => rfl
| _ :: l, i+1 => get?_map f l i
@[simp] theorem getElem_map (f : α β) {l} {i : Nat} {h : i < (map f l).length} :
(map f l)[i] = f (l[i]'(length_map l f h)) :=
Option.some.inj <| by rw [ getElem?_eq_getElem, getElem?_map, getElem?_eq_getElem]; rfl
@[deprecated getElem_map (since := "2024-06-12")]
theorem get_map (f : α β) {l i} :
get (map f l) i = f (get l i, length_map l f i.2) := by
simp
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
@@ -1076,9 +1060,31 @@ theorem forall_mem_map {f : α → β} {l : List α} {P : β → Prop} :
@[deprecated forall_mem_map (since := "2024-07-25")] abbrev forall_mem_map_iff := @forall_mem_map
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
induction l <;> simp_all
theorem map_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
induction l generalizing l' with
| nil => simp
| cons a l ih =>
simp only [map_cons]
cases l' with
| nil => simp
| cons a' l' =>
simp only [map_cons, cons.injEq, ih, and_congr_left_iff]
intro h
constructor
· apply w
· simp +contextual
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
@@ -1087,14 +1093,6 @@ theorem map_inj : map f = map g ↔ f = g := by
· intro h; ext a; replace h := congrFun h [a]; simpa using h
· intro h; subst h; rfl
@[simp] theorem map_eq_nil_iff {f : α β} {l : List α} : map f l = [] l = [] := by
constructor <;> exact fun _ => match l with | [] => rfl
@[deprecated map_eq_nil_iff (since := "2024-09-05")] abbrev map_eq_nil := @map_eq_nil_iff
theorem eq_nil_of_map_eq_nil {f : α β} {l : List α} (h : map f l = []) : l = [] :=
map_eq_nil_iff.mp h
theorem map_eq_cons_iff {f : α β} {l : List α} :
map f l = b :: l₂ a l₁, l = a :: l₁ f a = b map f l₁ = l₂ := by
cases l
@@ -1272,8 +1270,6 @@ theorem filter_map (f : β → α) (l : List β) : filter p (map f l) = map f (f
| nil => rfl
| cons a l IH => by_cases h : p (f a) <;> simp [*]
@[deprecated filter_map (since := "2024-06-15")] abbrev map_filter := @filter_map
theorem map_filter_eq_foldr (f : α β) (p : α Bool) (as : List α) :
map f (filter p as) = foldr (fun a bs => bif p a then f a :: bs else bs) [] as := by
induction as with
@@ -1318,8 +1314,6 @@ theorem filter_congr {p q : α → Bool} :
· simp [pa, h.1 pa, filter_congr h.2]
· simp [pa, h.1 pa, filter_congr h.2]
@[deprecated filter_congr (since := "2024-06-20")] abbrev filter_congr' := @filter_congr
theorem head_filter_of_pos {p : α Bool} {l : List α} (w : l []) (h : p (l.head w)) :
(filter p l).head ((ne_nil_of_mem (mem_filter.2 head_mem w, h))) = l.head w := by
cases l with
@@ -1494,6 +1488,34 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
@[simp] theorem cons_append_fun (a : α) (as : List α) :
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
@[simp] theorem mem_append {a : α} {s t : List α} : a s ++ t a s a t := by
induction s <;> simp_all [or_assoc]
theorem not_mem_append {a : α} {s t : List α} (h₁ : a s) (h₂ : a t) : a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
@[deprecated mem_append (since := "2025-01-13")]
theorem mem_append_eq (a : α) (s t : List α) : (a s ++ t) = (a s a t) :=
propext mem_append
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
/--
See also `eq_append_cons_of_mem`, which proves a stronger version
in which the initial list must not contain the element.
-/
theorem append_of_mem {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t
| .head l => [], l, rfl
| .tail b h => let s, t, h' := append_of_mem h; b::s, t, by rw [h', cons_append]
theorem mem_iff_append {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t :=
append_of_mem, fun s, t, e => e by simp
theorem forall_mem_append {p : α Prop} {l₁ l₂ : List α} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem getElem_append {l₁ l₂ : List α} (i : Nat) (h : i < (l₁ ++ l₂).length) :
(l₁ ++ l₂)[i] = if h' : i < l₁.length then l₁[i] else l₂[i - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
split <;> rename_i h'
@@ -1519,11 +1541,6 @@ theorem getElem?_append {l₁ l₂ : List α} {i : Nat} :
· exact getElem?_append_left h
· exact getElem?_append_right (by simpa using h)
@[deprecated getElem?_append_right (since := "2024-06-12")]
theorem get?_append_right {l₁ l₂ : List α} {i : Nat} (h : l₁.length i) :
(l₁ ++ l₂).get? i = l₂.get? (i - l₁.length) := by
simp [getElem?_append_right, h]
/-- Variant of `getElem_append_left` useful for rewriting from the small list to the big list. -/
theorem getElem_append_left' (l₂ : List α) {l₁ : List α} {i : Nat} (hi : i < l₁.length) :
l₁[i] = (l₁ ++ l₂)[i]'(by simpa using Nat.lt_add_right l₂.length hi) := by
@@ -1534,41 +1551,11 @@ theorem getElem_append_right' (l₁ : List α) {l₂ : List α} {i : Nat} (hi :
l₂[i] = (l₁ ++ l₂)[i + l₁.length]'(by simpa [Nat.add_comm] using Nat.add_lt_add_left hi _) := by
rw [getElem_append_right] <;> simp [*, le_add_left]
@[deprecated "Deprecated without replacement." (since := "2024-06-12")]
theorem get_append_right_aux {l₁ l₂ : List α} {i : Nat}
(h₁ : l₁.length i) (h₂ : i < (l₁ ++ l₂).length) : i - l₁.length < l₂.length := by
rw [length_append] at h₂
exact Nat.sub_lt_left_of_lt_add h₁ h₂
set_option linter.deprecated false in
@[deprecated getElem_append_right (since := "2024-06-12")]
theorem get_append_right' {l₁ l₂ : List α} {i : Nat} (h₁ : l₁.length i) (h₂) :
(l₁ ++ l₂).get i, h₂ = l₂.get i - l₁.length, get_append_right_aux h₁ h₂ :=
Option.some.inj <| by rw [ get?_eq_get, get?_eq_get, get?_append_right h₁]
theorem getElem_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.length = i) :
l[i]'(eq h by simp_arith) = a := Option.some.inj <| by
rw [ getElem?_eq_getElem, eq, getElem?_append_right (h Nat.le_refl _), h]
simp
@[deprecated "Deprecated without replacement." (since := "2024-06-12")]
theorem get_of_append_proof {l : List α}
(eq : l = l₁ ++ a :: l₂) (h : l₁.length = i) : i < length l := eq h by simp_arith
set_option linter.deprecated false in
@[deprecated getElem_of_append (since := "2024-06-12")]
theorem get_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.length = i) :
l.get i, get_of_append_proof eq h = a := Option.some.inj <| by
rw [ get?_eq_get, eq, get?_append_right (h Nat.le_refl _), h, Nat.sub_self]; rfl
/--
See also `eq_append_cons_of_mem`, which proves a stronger version
in which the initial list must not contain the element.
-/
theorem append_of_mem {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t
| .head l => [], l, rfl
| .tail b h => let s, t, h' := append_of_mem h; b::s, t, by rw [h', cons_append]
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
theorem append_inj :
@@ -1585,8 +1572,8 @@ theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = le
/-- Variant of `append_inj` instead requiring equality of the lengths of the second lists. -/
theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ t₁ = t₂ :=
append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
let hap := congrArg length h; simp only [length_append, hl] at hap; exact hap
append_inj h <| @Nat.add_right_cancel _ t₁.length _ <| by
let hap := congrArg length h; simp only [length_append, hl] at hap; exact hap
/-- Variant of `append_inj_right` instead requiring equality of the lengths of the second lists. -/
theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
@@ -1614,33 +1601,58 @@ theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s
@[simp] theorem self_eq_append_right {x y : List α} : x = x ++ y y = [] := by
rw [eq_comm, append_right_eq_self]
@[simp] theorem append_eq_nil : p ++ q = [] p = [] q = [] := by
cases p <;> simp
theorem getLast_concat {a : α} : (l : List α), getLast (l ++ [a]) (by simp) = a
| [] => rfl
| a::t => by
simp [getLast_cons _, getLast_concat t]
@[deprecated getElem_append (since := "2024-06-12")]
theorem get_append {l₁ l₂ : List α} (n : Nat) (h : n < l₁.length) :
(l₁ ++ l₂).get n, length_append .. Nat.lt_add_right _ h = l₁.get n, h := by
simp [getElem_append, h]
@[simp] theorem append_eq_nil_iff : p ++ q = [] p = [] q = [] := by
cases p <;> simp
@[deprecated getElem_append_left (since := "2024-06-12")]
theorem get_append_left (as bs : List α) (h : i < as.length) {h'} :
(as ++ bs).get i, h' = as.get i, h := by
simp [getElem_append_left, h, h']
@[deprecated append_eq_nil_iff (since := "2025-01-13")] abbrev append_eq_nil := @append_eq_nil_iff
@[deprecated getElem_append_right (since := "2024-06-12")]
theorem get_append_right (as bs : List α) (h : as.length i) {h' h''} :
(as ++ bs).get i, h' = bs.get i - as.length, h'' := by
simp [getElem_append_right, h, h', h'']
@[simp] theorem nil_eq_append_iff : [] = a ++ b a = [] b = [] := by
rw [eq_comm, append_eq_nil_iff]
@[deprecated getElem?_append_left (since := "2024-06-12")]
theorem get?_append {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
(l₁ ++ l₂).get? n = l₁.get? n := by
simp [getElem?_append_left hn]
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
theorem append_ne_nil_of_right_ne_nil (s : List α) : t [] s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_right (s : List α) : t [] s ++ t [] := by simp_all
theorem append_eq_cons_iff :
a ++ b = x :: c (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
cases a with simp | cons a as => ?_
exact fun h => as, by simp [h], fun a', aeq, aseq, h => aeq, by rw [aseq, h]
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
theorem cons_eq_append_iff :
x :: c = a ++ b (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
rw [eq_comm, append_eq_cons_iff]
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
theorem append_eq_singleton_iff :
a ++ b = [x] (a = [] b = [x]) (a = [x] b = []) := by
cases a <;> cases b <;> simp
theorem singleton_eq_append_iff :
[x] = a ++ b (a = [] b = [x]) (a = [x] b = []) := by
cases a <;> cases b <;> simp [eq_comm]
theorem append_eq_append_iff {a b c d : List α} :
a ++ b = c ++ d ( a', c = a ++ a' b = a' ++ d) c', a = c ++ c' d = c' ++ b := by
induction a generalizing c with
| nil => simp_all
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
@[simp] theorem head_append_of_ne_nil {l : List α} {w₁} (w₂) :
head (l ++ l') w₁ = head l w₂ := by
@@ -1691,60 +1703,6 @@ theorem tail_append {l l' : List α} : (l ++ l').tail = if l.isEmpty then l'.tai
@[deprecated tail_append_of_ne_nil (since := "2024-07-24")] abbrev tail_append_left := @tail_append_of_ne_nil
theorem nil_eq_append_iff : [] = a ++ b a = [] b = [] := by
rw [eq_comm, append_eq_nil]
@[deprecated nil_eq_append_iff (since := "2024-07-24")] abbrev nil_eq_append := @nil_eq_append_iff
theorem append_ne_nil_of_left_ne_nil {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
theorem append_ne_nil_of_right_ne_nil (s : List α) : t [] s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_left_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_left {s : List α} (h : s []) (t : List α) : s ++ t [] := by simp_all
@[deprecated append_ne_nil_of_right_ne_nil (since := "2024-07-24")]
theorem append_ne_nil_of_ne_nil_right (s : List α) : t [] s ++ t [] := by simp_all
theorem append_eq_cons_iff :
a ++ b = x :: c (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
cases a with simp | cons a as => ?_
exact fun h => as, by simp [h], fun a', aeq, aseq, h => aeq, by rw [aseq, h]
@[deprecated append_eq_cons_iff (since := "2024-07-24")] abbrev append_eq_cons := @append_eq_cons_iff
theorem cons_eq_append_iff :
x :: c = a ++ b (a = [] b = x :: c) ( a', a = x :: a' c = a' ++ b) := by
rw [eq_comm, append_eq_cons_iff]
@[deprecated cons_eq_append_iff (since := "2024-07-24")] abbrev cons_eq_append := @cons_eq_append_iff
theorem append_eq_append_iff {a b c d : List α} :
a ++ b = c ++ d ( a', c = a ++ a' b = a' ++ d) c', a = c ++ c' d = c' ++ b := by
induction a generalizing c with
| nil => simp_all
| cons a as ih => cases c <;> simp [eq_comm, and_assoc, ih, and_or_left]
@[deprecated append_inj (since := "2024-07-24")] abbrev append_inj_of_length_left := @append_inj
@[deprecated append_inj' (since := "2024-07-24")] abbrev append_inj_of_length_right := @append_inj'
@[simp] theorem mem_append {a : α} {s t : List α} : a s ++ t a s a t := by
induction s <;> simp_all [or_assoc]
theorem not_mem_append {a : α} {s t : List α} (h₁ : a s) (h₂ : a t) : a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
theorem mem_append_eq (a : α) (s t : List α) : (a s ++ t) = (a s a t) :=
propext mem_append
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
theorem mem_iff_append {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t :=
append_of_mem, fun s, t, e => e by simp
theorem forall_mem_append {p : α Prop} {l₁ l₂ : List α} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem set_append {s t : List α} :
(s ++ t).set i x = if i < s.length then s.set i x ++ t else s ++ t.set (i - s.length) x := by
induction s generalizing i with
@@ -1873,7 +1831,7 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∃ L b, l = concat L b
/-! ### flatten -/
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
@[simp] theorem length_flatten (L : List (List α)) : L.flatten.length = (L.map length).sum := by
induction L with
| nil => rfl
| cons =>
@@ -1888,6 +1846,9 @@ theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
@[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] l L, l = [] := by
induction L <;> simp_all
@[simp] theorem nil_eq_flatten_iff {L : List (List α)} : [] = L.flatten l L, l = [] := by
rw [eq_comm, flatten_eq_nil_iff]
theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten [] x, x xs x [] := by
simp
@@ -1913,7 +1874,8 @@ theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun
-- `getLast?_flatten` is proved later, after the `reverse` section.
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
@[simp] theorem map_flatten (f : α β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
@[simp] theorem map_flatten (f : α β) (L : List (List α)) :
(flatten L).map f = (map (map f) L).flatten := by
induction L <;> simp_all
@[simp] theorem filterMap_flatten (f : α Option β) (L : List (List α)) :
@@ -1966,6 +1928,26 @@ theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
· rintro as, bs, cs, rfl, h₁, rfl
simp [flatten_eq_nil_iff.mpr h₁]
theorem cons_eq_flatten_iff {xs : List (List α)} {y : α} {ys : List α} :
y :: ys = xs.flatten
as bs cs, xs = as ++ (y :: bs) :: cs ( l, l as l = []) ys = bs ++ cs.flatten := by
rw [eq_comm, flatten_eq_cons_iff]
theorem flatten_eq_singleton_iff {xs : List (List α)} {y : α} :
xs.flatten = [y] as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [flatten_eq_cons_iff]
constructor
· rintro as, bs, cs, rfl, h₁, h₂
simp at h₂
obtain rfl, h₂ := h₂
exact as, cs, by simp, h₁, h₂
· rintro as, bs, rfl, h₁, h₂
exact as, [], bs, rfl, h₁, by simpa
theorem singleton_eq_flatten_iff {xs : List (List α)} {y : α} :
[y] = xs.flatten as bs, xs = as ++ [y] :: bs ( l, l as l = []) ( l, l bs l = []) := by
rw [eq_comm, flatten_eq_singleton_iff]
theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
xs.flatten = ys ++ zs
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
@@ -1974,8 +1956,8 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
constructor
· induction xs generalizing ys with
| nil =>
simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
exists_false, or_false, and_imp, List.cons_ne_nil]
simp only [flatten_nil, nil_eq, append_eq_nil_iff, and_false, cons_append, false_and,
exists_const, exists_false, or_false, and_imp, List.cons_ne_nil]
rintro rfl rfl
exact [], [], by simp
| cons x xs ih =>
@@ -1994,6 +1976,13 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
· simp
· simp
theorem append_eq_flatten_iff {xs : List (List α)} {ys zs : List α} :
ys ++ zs = xs.flatten
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ys = as.flatten ++ bs
zs = c :: cs ++ ds.flatten := by
rw [eq_comm, flatten_eq_append_iff]
/-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_flatten_eq : {L L' : List (List α)},
@@ -2014,12 +2003,14 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
theorem flatMap_def (l : List α) (f : α List β) : l.flatMap f = flatten (map f l) := by rfl
@[simp] theorem flatMap_id (l : List (List α)) : List.flatMap l id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id (l : List (List α)) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : List (List α)) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp]
theorem length_flatMap (l : List α) (f : α List β) :
length (l.flatMap f) = sum (map (length f) l) := by
rw [List.flatMap, length_flatten, map_map]
length (l.flatMap f) = sum (map (fun a => (f a).length) l) := by
rw [List.flatMap, length_flatten, map_map, Function.comp_def]
@[simp] theorem mem_flatMap {f : α List β} {b} {l : List α} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
@@ -2032,7 +2023,7 @@ theorem mem_flatMap_of_mem {b : β} {l : List α} {f : α → List β} {a} (al :
b l.flatMap f := mem_flatMap.2 a, al, h
@[simp]
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : List.flatMap l f = [] x l, f x = [] :=
theorem flatMap_eq_nil_iff {l : List α} {f : α List β} : l.flatMap f = [] x l, f x = [] :=
flatten_eq_nil_iff.trans <| by
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
@@ -2141,10 +2132,6 @@ theorem forall_mem_replicate {p : α → Prop} {a : α} {n} :
(replicate n a)[m] = a :=
eq_of_mem_replicate (getElem_mem _)
@[deprecated getElem_replicate (since := "2024-06-12")]
theorem get_replicate (a : α) {n : Nat} (m : Fin _) : (replicate n a).get m = a := by
simp
theorem getElem?_replicate : (replicate n a)[m]? = if m < n then some a else none := by
by_cases h : m < n
· rw [getElem?_eq_getElem (by simpa), getElem_replicate, if_pos h]
@@ -2216,7 +2203,7 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
· intro i h₁ h₂
simp [getElem_set]
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
@[simp] theorem replicate_append_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
rw [eq_replicate_iff]
constructor
· simp
@@ -2224,6 +2211,9 @@ theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.len
simp only [mem_append, mem_replicate, ne_eq]
rintro (-, rfl | _, rfl) <;> rfl
@[deprecated replicate_append_replicate (since := "2025-01-16")]
abbrev append_replicate_replicate := @replicate_append_replicate
theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
l₁ ++ l₂ = replicate n a
l₁.length + l₂.length = n l₁ = replicate l₁.length a l₂ = replicate l₂.length a := by
@@ -2234,6 +2224,11 @@ theorem append_eq_replicate_iff {l₁ l₂ : List α} {a : α} :
@[deprecated append_eq_replicate_iff (since := "2024-09-05")] abbrev append_eq_replicate := @append_eq_replicate_iff
theorem replicate_eq_append_iff {l₁ l₂ : List α} {a : α} :
replicate n a = l₁ ++ l₂
l₁.length + l₂.length = n l₁ = replicate l₁.length a l₂ = replicate l₂.length a := by
rw [eq_comm, append_eq_replicate_iff]
@[simp] theorem map_replicate : (replicate n a).map f = replicate n (f a) := by
ext1 n
simp only [getElem?_map, getElem?_replicate]
@@ -2285,7 +2280,7 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
induction n with
| zero => simp
| succ n ih =>
simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
simp only [replicate_succ, flatten_cons, ih, replicate_append_replicate, replicate_inj, or_true,
and_true, add_one_mul, Nat.add_comm]
theorem flatMap_replicate {β} (f : α List β) : (replicate n a).flatMap f = (replicate n (f a)).flatten := by
@@ -2337,6 +2332,9 @@ theorem replicateRecOn {α : Type _} {p : List α → Prop} (m : List α)
exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
termination_by m.length
@[simp] theorem sum_replicate_nat (n : Nat) (a : Nat) : (replicate n a).sum = n * a := by
induction n <;> simp_all [replicate_succ, Nat.add_mul, Nat.add_comm]
/-! ### reverse -/
@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
@@ -2369,10 +2367,6 @@ theorem getElem?_reverse' : ∀ {l : List α} (i j), i + j + 1 = length l →
rw [getElem?_append_left, getElem?_reverse' _ _ this]
rw [length_reverse, this]; apply Nat.lt_add_of_pos_right (Nat.succ_pos _)
@[deprecated getElem?_reverse' (since := "2024-06-12")]
theorem get?_reverse' {l : List α} (i j) (h : i + j + 1 = length l) : get? l.reverse i = get? l j := by
simp [getElem?_reverse' _ _ h]
@[simp]
theorem getElem?_reverse {l : List α} {i} (h : i < length l) :
l.reverse[i]? = l[l.length - 1 - i]? :=
@@ -2387,11 +2381,6 @@ theorem getElem_reverse {l : List α} {i} (h : i < l.reverse.length) :
rw [ getElem?_eq_getElem, getElem?_eq_getElem]
rw [getElem?_reverse (by simpa using h)]
@[deprecated getElem?_reverse (since := "2024-06-12")]
theorem get?_reverse {l : List α} {i} (h : i < length l) :
get? l.reverse i = get? l (l.length - 1 - i) := by
simp [getElem?_reverse h]
theorem reverseAux_reverseAux_nil (as bs : List α) : reverseAux (reverseAux as bs) [] = reverseAux bs as := by
induction as generalizing bs with
| nil => rfl
@@ -2432,10 +2421,6 @@ theorem mem_of_mem_getLast? {l : List α} {a : α} (h : a ∈ getLast? l) : a
@[simp] theorem map_reverse (f : α β) (l : List α) : l.reverse.map f = (l.map f).reverse := by
induction l <;> simp [*]
@[deprecated map_reverse (since := "2024-06-20")]
theorem reverse_map (f : α β) (l : List α) : (l.map f).reverse = l.reverse.map f := by
simp
@[simp] theorem filter_reverse (p : α Bool) (l : List α) : (l.reverse.filter p) = (l.filter p).reverse := by
induction l with
| nil => simp
@@ -2899,11 +2884,6 @@ are often used for theorems about `Array.pop`.
| _::_::_, 0, _ => rfl
| _::_::_, i+1, h => getElem_dropLast _ i (Nat.add_one_lt_add_one_iff.mp h)
@[deprecated getElem_dropLast (since := "2024-06-12")]
theorem get_dropLast (xs : List α) (i : Fin xs.dropLast.length) :
xs.dropLast.get i = xs.get i, Nat.lt_of_lt_of_le i.isLt (length_dropLast .. Nat.pred_le _) := by
simp
theorem getElem?_dropLast (xs : List α) (i : Nat) :
xs.dropLast[i]? = if i < xs.length - 1 then xs[i]? else none := by
split
@@ -3441,29 +3421,6 @@ theorem mem_iff_get? {a} {l : List α} : a ∈ l ↔ ∃ n, l.get? n = some a :=
/-! ### Deprecations -/
@[deprecated getD_eq_getElem?_getD (since := "2024-06-12")]
theorem getD_eq_get? : l n (a : α), getD l n a = (get? l n).getD a := by simp
@[deprecated getElem_singleton (since := "2024-06-12")]
theorem get_singleton (a : α) (n : Fin 1) : get [a] n = a := by simp
@[deprecated getElem?_concat_length (since := "2024-06-12")]
theorem get?_concat_length (l : List α) (a : α) : (l ++ [a]).get? l.length = some a := by simp
@[deprecated getElem_set_self (since := "2024-06-12")]
theorem get_set_eq {l : List α} {i : Nat} {a : α} (h : i < (l.set i a).length) :
(l.set i a).get i, h = a := by
simp
@[deprecated getElem_set_ne (since := "2024-06-12")]
theorem get_set_ne {l : List α} {i j : Nat} (h : i j) {a : α}
(hj : j < (l.set i a).length) :
(l.set i a).get j, hj = l.get j, by simp at hj; exact hj := by
simp [h]
@[deprecated getElem_set (since := "2024-06-12")]
theorem get_set {l : List α} {m n} {a : α} (h) :
(set l m a).get n, h = if m = n then a else l.get n, length_set .. h := by
simp [getElem_set]
@[deprecated cons_inj_right (since := "2024-06-15")] abbrev cons_inj := @cons_inj_right
@[deprecated ne_nil_of_length_eq_add_one (since := "2024-06-16")]
abbrev ne_nil_of_length_eq_succ := @ne_nil_of_length_eq_add_one
@[deprecated "Deprecated without replacement." (since := "2024-07-09")]
theorem get_cons_cons_one : (a₁ :: a₂ :: as).get (1 : Fin (as.length + 2)) = a₂ := rfl

View File

@@ -22,13 +22,13 @@ namespace List
Given a list `as = [a₀, a₁, ...]` function `f : Fin as.length → α → β`, returns the list
`[f 0 a₀, f 1 a₁, ...]`.
-/
@[inline] def mapFinIdx (as : List α) (f : Fin as.length α β) : List β := go as #[] (by simp) where
@[inline] def mapFinIdx (as : List α) (f : (i : Nat) α (h : i < as.length) β) : List β := go as #[] (by simp) where
/-- Auxiliary for `mapFinIdx`:
`mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
@[specialize] go : (bs : List α) (acc : Array β) bs.length + acc.size = as.length List β
| [], acc, h => acc.toList
| a :: as, acc, h =>
go as (acc.push (f acc.size, by simp at h; omega a)) (by simp at h ; omega)
go as (acc.push (f acc.size a (by simp at h; omega))) (by simp at h ; omega)
/--
Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁, ...]`, returns the list
@@ -44,7 +44,7 @@ Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁,
/-! ### mapFinIdx -/
@[simp]
theorem mapFinIdx_nil {f : Fin 0 α β} : mapFinIdx [] f = [] :=
theorem mapFinIdx_nil {f : (i : Nat) α (h : i < 0) β} : mapFinIdx [] f = [] :=
rfl
@[simp] theorem length_mapFinIdx_go :
@@ -53,13 +53,16 @@ theorem mapFinIdx_nil {f : Fin 0 → α → β} : mapFinIdx [] f = [] :=
| nil => simpa using h
| cons _ _ ih => simp [mapFinIdx.go, ih]
@[simp] theorem length_mapFinIdx {as : List α} {f : Fin as.length α β} :
@[simp] theorem length_mapFinIdx {as : List α} {f : (i : Nat) α (h : i < as.length) β} :
(as.mapFinIdx f).length = as.length := by
simp [mapFinIdx, length_mapFinIdx_go]
theorem getElem_mapFinIdx_go {as : List α} {f : Fin as.length α β} {i : Nat} {h} {w} :
theorem getElem_mapFinIdx_go {as : List α} {f : (i : Nat) α (h : i < as.length) β} {i : Nat} {h} {w} :
(mapFinIdx.go as f bs acc h)[i] =
if w' : i < acc.size then acc[i] else f i, by simp at w; omega (bs[i - acc.size]'(by simp at w; omega)) := by
if w' : i < acc.size then
acc[i]
else
f i (bs[i - acc.size]'(by simp at w; omega)) (by simp at w; omega) := by
induction bs generalizing acc with
| nil =>
simp only [length_mapFinIdx_go, length_nil, Nat.zero_add] at w h
@@ -78,29 +81,30 @@ theorem getElem_mapFinIdx_go {as : List α} {f : Fin as.length → α → β} {i
· have h₃ : i - acc.size = (i - (acc.size + 1)) + 1 := by omega
simp [h₃]
@[simp] theorem getElem_mapFinIdx {as : List α} {f : Fin as.length α β} {i : Nat} {h} :
(as.mapFinIdx f)[i] = f i, by simp at h; omega (as[i]'(by simp at h; omega)) := by
@[simp] theorem getElem_mapFinIdx {as : List α} {f : (i : Nat) α (h : i < as.length) β} {i : Nat} {h} :
(as.mapFinIdx f)[i] = f i (as[i]'(by simp at h; omega)) (by simp at h; omega) := by
simp [mapFinIdx, getElem_mapFinIdx_go]
theorem mapFinIdx_eq_ofFn {as : List α} {f : Fin as.length α β} :
as.mapFinIdx f = List.ofFn fun i : Fin as.length => f i as[i] := by
theorem mapFinIdx_eq_ofFn {as : List α} {f : (i : Nat) α (h : i < as.length) β} :
as.mapFinIdx f = List.ofFn fun i : Fin as.length => f i as[i] i.2 := by
apply ext_getElem <;> simp
@[simp] theorem getElem?_mapFinIdx {l : List α} {f : Fin l.length α β} {i : Nat} :
(l.mapFinIdx f)[i]? = l[i]?.pbind fun x m => f i, by simp [getElem?_eq_some_iff] at m; exact m.1 x := by
@[simp] theorem getElem?_mapFinIdx {l : List α} {f : (i : Nat) α (h : i < l.length) β} {i : Nat} :
(l.mapFinIdx f)[i]? = l[i]?.pbind fun x m => f i x (by simp [getElem?_eq_some_iff] at m; exact m.1) := by
simp only [getElem?_def, length_mapFinIdx, getElem_mapFinIdx]
split <;> simp
@[simp]
theorem mapFinIdx_cons {l : List α} {a : α} {f : Fin (l.length + 1) α β} :
mapFinIdx (a :: l) f = f 0 a :: mapFinIdx l (fun i => f i.succ) := by
theorem mapFinIdx_cons {l : List α} {a : α} {f : (i : Nat) α (h : i < l.length + 1) β} :
mapFinIdx (a :: l) f = f 0 a (by omega) :: mapFinIdx l (fun i a h => f (i + 1) a (by omega)) := by
apply ext_getElem
· simp
· rintro (_|i) h₁ h₂ <;> simp
theorem mapFinIdx_append {K L : List α} {f : Fin (K ++ L).length α β} :
theorem mapFinIdx_append {K L : List α} {f : (i : Nat) α (h : i < (K ++ L).length) β} :
(K ++ L).mapFinIdx f =
K.mapFinIdx (fun i => f (i.castLE (by simp))) ++ L.mapFinIdx (fun i => f ((i.natAdd K.length).cast (by simp))) := by
K.mapFinIdx (fun i a h => f i a (by simp; omega)) ++
L.mapFinIdx (fun i a h => f (i + K.length) a (by simp; omega)) := by
apply ext_getElem
· simp
· intro i h₁ h₂
@@ -108,60 +112,57 @@ theorem mapFinIdx_append {K L : List α} {f : Fin (K ++ L).length → α → β}
simp only [getElem_mapFinIdx, length_mapFinIdx]
split <;> rename_i h
· rw [getElem_append_left]
congr
· simp only [Nat.not_lt] at h
rw [getElem_append_right h]
congr
simp
omega
@[simp] theorem mapFinIdx_concat {l : List α} {e : α} {f : Fin (l ++ [e]).length α β}:
(l ++ [e]).mapFinIdx f = l.mapFinIdx (fun i => f (i.castLE (by simp))) ++ [f l.length, by simp e] := by
@[simp] theorem mapFinIdx_concat {l : List α} {e : α} {f : (i : Nat) α (h : i < (l ++ [e]).length) β}:
(l ++ [e]).mapFinIdx f = l.mapFinIdx (fun i a h => f i a (by simp; omega)) ++ [f l.length e (by simp)] := by
simp [mapFinIdx_append]
congr
theorem mapFinIdx_singleton {a : α} {f : Fin 1 α β} :
[a].mapFinIdx f = [f 0, by simp a] := by
theorem mapFinIdx_singleton {a : α} {f : (i : Nat) α (h : i < 1) β} :
[a].mapFinIdx f = [f 0 a (by simp)] := by
simp
theorem mapFinIdx_eq_enum_map {l : List α} {f : Fin l.length α β} :
theorem mapFinIdx_eq_enum_map {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = l.enum.attach.map
fun i, x, m =>
f i, by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1 x := by
f i x (by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
apply ext_getElem <;> simp
@[simp]
theorem mapFinIdx_eq_nil_iff {l : List α} {f : Fin l.length α β} :
theorem mapFinIdx_eq_nil_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = [] l = [] := by
rw [mapFinIdx_eq_enum_map, map_eq_nil_iff, attach_eq_nil_iff, enum_eq_nil_iff]
theorem mapFinIdx_ne_nil_iff {l : List α} {f : Fin l.length α β} :
theorem mapFinIdx_ne_nil_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f [] l [] := by
simp
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length α β}
(h : b l.mapFinIdx f) : (i : Fin l.length), f i l[i] = b := by
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : (i : Nat) α (h : i < l.length) β}
(h : b l.mapFinIdx f) : (i : Nat) (h : i < l.length), f i l[i] h = b := by
rw [mapFinIdx_eq_enum_map] at h
replace h := exists_of_mem_map h
simp only [mem_attach, true_and, Subtype.exists, Prod.exists, mk_mem_enum_iff_getElem?] at h
obtain i, b, h, rfl := h
rw [getElem?_eq_some_iff] at h
obtain h', rfl := h
exact i, h', rfl
exact i, h', rfl
@[simp] theorem mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length α β} :
b l.mapFinIdx f (i : Fin l.length), f i l[i] = b := by
@[simp] theorem mem_mapFinIdx {b : β} {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
b l.mapFinIdx f (i : Nat) (h : i < l.length), f i l[i] h = b := by
constructor
· intro h
exact exists_of_mem_mapFinIdx h
· rintro i, h, rfl
rw [mem_iff_getElem]
exact i, by simp
exact i, by simpa using h, by simp
theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : Fin l.length α β} :
theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = b :: l₂
(a : α) (l₁ : List α) (h : l = a :: l₁),
f 0, by simp [h] a = b l₁.mapFinIdx (fun i => f (i.succ.cast (by simp [h]))) = l₂ := by
(a : α) (l₁ : List α) (w : l = a :: l₁),
f 0 a (by simp [w]) = b l₁.mapFinIdx (fun i a h => f (i + 1) a (by simp [w]; omega)) = l₂ := by
cases l with
| nil => simp
| cons x l' =>
@@ -169,39 +170,48 @@ theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : Fin l.length → α
exists_and_left]
constructor
· rintro rfl, rfl
refine x, rfl, l', by simp
· rintro a, rfl, h, _, rfl, rfl, h
exact rfl, h
refine x, l', rfl, rfl, by simp
· rintro a, l', rfl, rfl, rfl, rfl
exact rfl, by simp
theorem mapFinIdx_eq_cons_iff' {l : List α} {b : β} {f : Fin l.length α β} :
theorem mapFinIdx_eq_cons_iff' {l : List α} {b : β} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = b :: l₂
l.head?.pbind (fun x m => (f 0, by cases l <;> simp_all x)) = some b
l.tail?.attach.map (fun t, m => t.mapFinIdx fun i => f (i.succ.cast (by cases l <;> simp_all))) = some l₂ := by
l.head?.pbind (fun x m => (f 0 x (by cases l <;> simp_all))) = some b
l.tail?.attach.map (fun t, m => t.mapFinIdx fun i a h => f (i + 1) a (by cases l <;> simp_all)) = some l₂ := by
cases l <;> simp
theorem mapFinIdx_eq_iff {l : List α} {f : Fin l.length α β} :
l.mapFinIdx f = l' h : l'.length = l.length, (i : Nat) (h : i < l.length), l'[i] = f i, h l[i] := by
theorem mapFinIdx_eq_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = l' h : l'.length = l.length, (i : Nat) (h : i < l.length), l'[i] = f i l[i] h := by
constructor
· rintro rfl
simp
· rintro h, w
apply ext_getElem <;> simp_all
theorem mapFinIdx_eq_mapFinIdx_iff {l : List α} {f g : Fin l.length α β} :
l.mapFinIdx f = l.mapFinIdx g (i : Fin l.length), f i l[i] = g i l[i] := by
theorem mapFinIdx_eq_mapFinIdx_iff {l : List α} {f g : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = l.mapFinIdx g (i : Nat) (h : i < l.length), f i l[i] h = g i l[i] h := by
rw [eq_comm, mapFinIdx_eq_iff]
simp [Fin.forall_iff]
@[simp] theorem mapFinIdx_mapFinIdx {l : List α} {f : Fin l.length α β} {g : Fin _ β γ} :
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i => g (i.cast (by simp)) f i) := by
@[simp] theorem mapFinIdx_mapFinIdx {l : List α}
{f : (i : Nat) α (h : i < l.length) β}
{g : (i : Nat) β (h : i < (l.mapFinIdx f).length) γ} :
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i a h => g i (f i a h) (by simpa)) := by
simp [mapFinIdx_eq_iff]
theorem mapFinIdx_eq_replicate_iff {l : List α} {f : Fin l.length α β} {b : β} :
l.mapFinIdx f = replicate l.length b (i : Fin l.length), f i l[i] = b := by
simp [eq_replicate_iff, length_mapFinIdx, mem_mapFinIdx, forall_exists_index, true_and]
theorem mapFinIdx_eq_replicate_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} {b : β} :
l.mapFinIdx f = replicate l.length b (i : Nat) (h : i < l.length), f i l[i] h = b := by
rw [eq_replicate_iff, length_mapFinIdx]
simp only [mem_mapFinIdx, forall_exists_index, true_and]
constructor
· intro w i h
exact w (f i l[i] h) i h rfl
· rintro w b i h rfl
exact w i h
@[simp] theorem mapFinIdx_reverse {l : List α} {f : Fin l.reverse.length α β} :
l.reverse.mapFinIdx f = (l.mapFinIdx (fun i => f l.length - 1 - i, by simp; omega)).reverse := by
@[simp] theorem mapFinIdx_reverse {l : List α} {f : (i : Nat) α (h : i < l.reverse.length) β} :
l.reverse.mapFinIdx f =
(l.mapFinIdx (fun i a h => f (l.length - 1 - i) a (by simp; omega))).reverse := by
simp [mapFinIdx_eq_iff]
intro i h
congr
@@ -262,13 +272,13 @@ theorem getElem?_mapIdx_go : ∀ {l : List α} {arr : Array β} {i : Nat},
rw [ getElem?_eq_getElem, getElem?_mapIdx, getElem?_eq_getElem (by simpa using h)]
simp
@[simp] theorem mapFinIdx_eq_mapIdx {l : List α} {f : Fin l.length α β} {g : Nat α β}
(h : (i : Fin l.length), f i l[i] = g i l[i]) :
@[simp] theorem mapFinIdx_eq_mapIdx {l : List α} {f : (i : Nat) α (h : i < l.length) β} {g : Nat α β}
(h : (i : Nat) (h : i < l.length), f i l[i] h = g i l[i]) :
l.mapFinIdx f = l.mapIdx g := by
simp_all [mapFinIdx_eq_iff]
theorem mapIdx_eq_mapFinIdx {l : List α} {f : Nat α β} :
l.mapIdx f = l.mapFinIdx (fun i => f i) := by
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
simp [mapFinIdx_eq_mapIdx]
theorem mapIdx_eq_enum_map {l : List α} :

View File

@@ -47,41 +47,16 @@ length `> i`. Version designed to rewrite from the small list to the big list. -
L[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
rw [length_take, Nat.lt_min] at h; rw [getElem_take' L _ h.1]
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the big list to the small list. -/
@[deprecated getElem_take' (since := "2024-06-12")]
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
get L i, hi = get (L.take j) i, length_take .. Nat.lt_min.mpr hj, hi := by
simp
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
@[deprecated getElem_take (since := "2024-06-12")]
theorem get_take' (L : List α) {j i} :
get (L.take j) i =
get L i.1, Nat.lt_of_lt_of_le i.2 (length_take_le' _ _) := by
simp [getElem_take]
theorem getElem?_take_eq_none {l : List α} {n m : Nat} (h : n m) :
(l.take n)[m]? = none :=
getElem?_eq_none <| Nat.le_trans (length_take_le _ _) h
@[deprecated getElem?_take_eq_none (since := "2024-06-12")]
theorem get?_take_eq_none {l : List α} {n m : Nat} (h : n m) :
(l.take n).get? m = none := by
simp [getElem?_take_eq_none h]
theorem getElem?_take {l : List α} {n m : Nat} :
(l.take n)[m]? = if m < n then l[m]? else none := by
split
· next h => exact getElem?_take_of_lt h
· next h => exact getElem?_take_eq_none (Nat.le_of_not_lt h)
@[deprecated getElem?_take (since := "2024-06-12")]
theorem get?_take_eq_if {l : List α} {n m : Nat} :
(l.take n).get? m = if m < n then l.get? m else none := by
simp [getElem?_take]
theorem head?_take {l : List α} {n : Nat} :
(l.take n).head? = if n = 0 then none else l.head? := by
simp [head?_eq_getElem?, getElem?_take]
@@ -226,13 +201,6 @@ theorem getElem_drop' (L : List α) {i j : Nat} (h : i + j < L.length) :
· simp [Nat.min_eq_left this, Nat.add_sub_cancel_left]
· simp [Nat.min_eq_left this, Nat.le_add_right]
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the big list to the small list. -/
@[deprecated getElem_drop' (since := "2024-06-12")]
theorem get_drop (L : List α) {i j : Nat} (h : i + j < L.length) :
get L i + j, h = get (L.drop i) j, lt_length_drop L h := by
simp [getElem_drop']
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
@[simp] theorem getElem_drop (L : List α) {i : Nat} {j : Nat} {h : j < (L.drop i).length} :
@@ -241,15 +209,6 @@ dropping the first `i` elements. Version designed to rewrite from the small list
exact Nat.add_lt_of_lt_sub (length_drop i L h)) := by
rw [getElem_drop']
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
@[deprecated getElem_drop' (since := "2024-06-12")]
theorem get_drop' (L : List α) {i j} :
get (L.drop i) j = get L i + j, by
rw [Nat.add_comm]
exact Nat.add_lt_of_lt_sub (length_drop i L j.2) := by
simp
@[simp]
theorem getElem?_drop (L : List α) (i j : Nat) : (L.drop i)[j]? = L[i + j]? := by
ext
@@ -261,10 +220,6 @@ theorem getElem?_drop (L : List α) (i j : Nat) : (L.drop i)[j]? = L[i + j]? :=
rw [Nat.add_comm] at h
apply Nat.lt_sub_of_add_lt h
@[deprecated getElem?_drop (since := "2024-06-12")]
theorem get?_drop (L : List α) (i j : Nat) : get? (L.drop i) j = get? L (i + j) := by
simp
theorem mem_take_iff_getElem {l : List α} {a : α} :
a l.take n (i : Nat) (hm : i < min n l.length), l[i] = a := by
rw [mem_iff_getElem]

View File

@@ -67,17 +67,9 @@ theorem getElem_cons_drop : ∀ (l : List α) (i : Nat) (h : i < l.length),
| _::_, 0, _ => rfl
| _::_, i+1, h => getElem_cons_drop _ i (Nat.add_one_lt_add_one_iff.mp h)
@[deprecated getElem_cons_drop (since := "2024-06-12")]
theorem get_cons_drop (l : List α) (i) : get l i :: drop (i + 1) l = drop i l := by
simp
theorem drop_eq_getElem_cons {n} {l : List α} (h : n < l.length) : drop n l = l[n] :: drop (n + 1) l :=
(getElem_cons_drop _ n h).symm
@[deprecated drop_eq_getElem_cons (since := "2024-06-12")]
theorem drop_eq_get_cons {n} {l : List α} (h) : drop n l = get l n, h :: drop (n + 1) l := by
simp [drop_eq_getElem_cons]
@[simp]
theorem getElem?_take_of_lt {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m]? = l[m]? := by
induction n generalizing l m with
@@ -91,10 +83,6 @@ theorem getElem?_take_of_lt {l : List α} {n m : Nat} (h : m < n) : (l.take n)[m
· simp
· simpa using hn (Nat.lt_of_succ_lt_succ h)
@[deprecated getElem?_take_of_lt (since := "2024-06-12")]
theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.get? m := by
simp [getElem?_take_of_lt, h]
theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? := by simp
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (m + n) l
@@ -111,10 +99,6 @@ theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (t
| _, _, [] => by simp
| _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
@[deprecated drop_drop (since := "2024-06-15")]
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop n (drop m l) := by
simp [drop_drop]
@[simp]
theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) := by
induction l generalizing n with

View File

@@ -46,7 +46,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
cases l <;> simp [Array.isEmpty]
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
@[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
simp only [back!, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
@@ -143,6 +143,9 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
subst h
rw [foldl_toList]
@[simp] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
simp [Array.sum, List.sum]
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
apply ext'
@@ -394,4 +397,24 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
@[deprecated toArray_replicate (since := "2024-12-13")]
abbrev _root_.Array.mkArray_eq_toArray_replicate := @toArray_replicate
@[simp] theorem flatMap_empty {β} (f : α Array β) : (#[] : Array α).flatMap f = #[] := rfl
theorem flatMap_toArray_cons {β} (f : α Array β) (a : α) (as : List α) :
(a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
simp [Array.flatMap]
suffices cs, List.foldl (fun bs a => bs ++ f a) (f a ++ cs) as =
f a ++ List.foldl (fun bs a => bs ++ f a) cs as by
erw [empty_append] -- Why doesn't this work via `simp`?
simpa using this #[]
intro cs
induction as generalizing cs <;> simp_all
@[simp] theorem flatMap_toArray {β} (f : α Array β) (as : List α) :
as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
induction as with
| nil => simp
| cons a as ih =>
apply ext'
simp [ih, flatMap_toArray_cons]
end List

View File

@@ -76,15 +76,6 @@ theorem getElem?_zip_eq_some {l₁ : List α} {l₂ : List β} {z : α × β} {i
· rintro h₀, h₁
exact _, _, h₀, h₁, rfl
@[deprecated getElem?_zipWith (since := "2024-06-12")]
theorem get?_zipWith {f : α β γ} :
(List.zipWith f as bs).get? i = match as.get? i, bs.get? i with
| some a, some b => some (f a b) | _, _ => none := by
simp [getElem?_zipWith]
set_option linter.deprecated false in
@[deprecated getElem?_zipWith (since := "2024-06-07")] abbrev zipWith_get? := @get?_zipWith
theorem head?_zipWith {f : α β γ} :
(List.zipWith f as bs).head? = match as.head?, bs.head? with
| some a, some b => some (f a b) | _, _ => none := by
@@ -203,11 +194,11 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
cases l₂ with
| nil =>
constructor
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
· simp only [zipWith_nil_right, nil_eq, append_eq_nil_iff, exists_and_left, and_imp]
rintro rfl rfl
exact [], x₁ :: l₁, [], by simp
· rintro w, x, y, z, h₁, _, h₃, rfl, rfl
simp only [nil_eq, append_eq_nil] at h₃
simp only [nil_eq, append_eq_nil_iff] at h₃
obtain rfl, rfl := h₃
simp
| cons x₂ l₂ =>
@@ -369,15 +360,6 @@ theorem getElem?_zipWithAll {f : Option α → Option β → γ} {i : Nat} :
cases i <;> simp_all
| cons b bs => cases i <;> simp_all
@[deprecated getElem?_zipWithAll (since := "2024-06-12")]
theorem get?_zipWithAll {f : Option α Option β γ} :
(zipWithAll f as bs).get? i = match as.get? i, bs.get? i with
| none, none => .none | a?, b? => some (f a? b?) := by
simp [getElem?_zipWithAll]
set_option linter.deprecated false in
@[deprecated getElem?_zipWithAll (since := "2024-06-07")] abbrev zipWithAll_get? := @get?_zipWithAll
theorem head?_zipWithAll {f : Option α Option β γ} :
(zipWithAll f as bs).head? = match as.head?, bs.head? with
| none, none => .none | a?, b? => some (f a? b?) := by

View File

@@ -788,9 +788,6 @@ theorem not_eq_zero_of_lt (h : b < a) : a ≠ 0 := by
theorem pred_lt_of_lt {n m : Nat} (h : m < n) : pred n < n :=
pred_lt (not_eq_zero_of_lt h)
set_option linter.missingDocs false in
@[deprecated pred_lt_of_lt (since := "2024-06-01")] abbrev pred_lt' := @pred_lt_of_lt
theorem sub_one_lt_of_lt {n m : Nat} (h : m < n) : n - 1 < n :=
sub_one_lt (not_eq_zero_of_lt h)
@@ -1074,9 +1071,6 @@ theorem pred_mul (n m : Nat) : pred n * m = n * m - m := by
| zero => simp
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
set_option linter.missingDocs false in
@[deprecated pred_mul (since := "2024-06-01")] abbrev mul_pred_left := @pred_mul
protected theorem sub_one_mul (n m : Nat) : (n - 1) * m = n * m - m := by
cases n with
| zero => simp
@@ -1086,9 +1080,6 @@ protected theorem sub_one_mul (n m : Nat) : (n - 1) * m = n * m - m := by
theorem mul_pred (n m : Nat) : n * pred m = n * m - n := by
rw [Nat.mul_comm, pred_mul, Nat.mul_comm]
set_option linter.missingDocs false in
@[deprecated mul_pred (since := "2024-06-01")] abbrev mul_pred_right := @mul_pred
theorem mul_sub_one (n m : Nat) : n * (m - 1) = n * m - n := by
rw [Nat.mul_comm, Nat.sub_one_mul , Nat.mul_comm]

View File

@@ -711,6 +711,32 @@ theorem mul_add_lt_is_or {b : Nat} (b_lt : b < 2^i) (a : Nat) : 2^i * a + b = 2^
rw [mod_two_eq_one_iff_testBit_zero, testBit_shiftLeft]
simp
theorem testBit_mul_two_pow (x i n : Nat) :
(x * 2 ^ n).testBit i = (decide (n i) && x.testBit (i - n)) := by
rw [ testBit_shiftLeft, shiftLeft_eq]
theorem bitwise_mul_two_pow (of_false_false : f false false = false := by rfl) :
(bitwise f x y) * 2 ^ n = bitwise f (x * 2 ^ n) (y * 2 ^ n) := by
apply Nat.eq_of_testBit_eq
simp only [testBit_mul_two_pow, testBit_bitwise of_false_false, Bool.if_false_right]
intro i
by_cases hn : n i
· simp [hn]
· simp [hn, of_false_false]
theorem shiftLeft_bitwise_distrib {a b : Nat} (of_false_false : f false false = false := by rfl) :
(bitwise f a b) <<< i = bitwise f (a <<< i) (b <<< i) := by
simp [shiftLeft_eq, bitwise_mul_two_pow of_false_false]
theorem shiftLeft_and_distrib {a b : Nat} : (a &&& b) <<< i = a <<< i &&& b <<< i :=
shiftLeft_bitwise_distrib
theorem shiftLeft_or_distrib {a b : Nat} : (a ||| b) <<< i = a <<< i ||| b <<< i :=
shiftLeft_bitwise_distrib
theorem shiftLeft_xor_distrib {a b : Nat} : (a ^^^ b) <<< i = a <<< i ^^^ b <<< i :=
shiftLeft_bitwise_distrib
@[simp] theorem decide_shiftRight_mod_two_eq_one :
decide (x >>> i % 2 = 1) = x.testBit i := by
simp only [testBit, one_and_eq_mod_two, mod_two_bne_zero]

View File

@@ -622,6 +622,14 @@ protected theorem pos_of_mul_pos_right {a b : Nat} (h : 0 < a * b) : 0 < a := by
0 < a * b 0 < a :=
Nat.pos_of_mul_pos_right, fun w => Nat.mul_pos w h
protected theorem pos_of_lt_mul_left {a b c : Nat} (h : a < b * c) : 0 < c := by
replace h : 0 < b * c := by omega
exact Nat.pos_of_mul_pos_left h
protected theorem pos_of_lt_mul_right {a b c : Nat} (h : a < b * c) : 0 < b := by
replace h : 0 < b * c := by omega
exact Nat.pos_of_mul_pos_right h
/-! ### div/mod -/
theorem mod_two_eq_zero_or_one (n : Nat) : n % 2 = 0 n % 2 = 1 :=
@@ -995,11 +1003,6 @@ theorem shiftLeft_add (m n : Nat) : ∀ k, m <<< (n + k) = (m <<< n) <<< k
| 0 => rfl
| k + 1 => by simp [ Nat.add_assoc, shiftLeft_add _ _ k, shiftLeft_succ]
@[deprecated shiftLeft_add (since := "2024-06-02")]
theorem shiftLeft_shiftLeft (m n : Nat) : k, (m <<< n) <<< k = m <<< (n + k)
| 0 => rfl
| k + 1 => by simp [ Nat.add_assoc, shiftLeft_shiftLeft _ _ k, shiftLeft_succ]
@[simp] theorem shiftLeft_shiftRight (x n : Nat) : x <<< n >>> n = x := by
rw [Nat.shiftLeft_eq, Nat.shiftRight_eq_div_pow, Nat.mul_div_cancel _ (Nat.two_pow_pos _)]

View File

@@ -208,6 +208,15 @@ theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘
theorem mem_map_of_mem (g : α β) (h : a x) : g a Option.map g x := h.symm map_some' ..
theorem map_inj_right {f : α β} {o o' : Option α} (w : x y, f x = f y x = y) :
o.map f = o'.map f o = o' := by
cases o with
| none => cases o' <;> simp
| some a =>
cases o' with
| none => simp
| some a' => simpa using fun h => w _ _ h, fun h => congrArg f h
@[simp] theorem map_if {f : α β} [Decidable c] :
(if c then some a else none).map f = if c then some (f a) else none := by
split <;> rfl
@@ -629,6 +638,15 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → a ∈ o → Option
· rintro h, rfl
rfl
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (o : Option α) (H) :
@pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
cases o <;> simp
theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (o H) :
Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
cases o <;> simp
/-! ### pelim -/
@[simp] theorem pelim_none : pelim none b f = b := rfl

View File

@@ -13,11 +13,17 @@ macro "declare_bitwise_uint_theorems" typeName:ident bits:term:arg : command =>
`(
namespace $typeName
@[simp] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
@[simp] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
@[simp] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
@[simp] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec / b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec % b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec % $bits) := rfl
@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec >>> (b.toBitVec % $bits) := rfl
@[simp] protected theorem toNat_and (a b : $typeName) : (a &&& b).toNat = a.toNat &&& b.toNat := by simp [toNat]
@[simp] protected theorem toNat_or (a b : $typeName) : (a ||| b).toNat = a.toNat ||| b.toNat := by simp [toNat]
@@ -37,3 +43,31 @@ declare_bitwise_uint_theorems UInt16 16
declare_bitwise_uint_theorems UInt32 32
declare_bitwise_uint_theorems UInt64 64
declare_bitwise_uint_theorems USize System.Platform.numBits
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt8 {b : Bool} :
b.toUInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
cases b <;> simp [toUInt8]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt16 {b : Bool} :
b.toUInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
cases b <;> simp [toUInt16]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt32 {b : Bool} :
b.toUInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
cases b <;> simp [toUInt32]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUInt64 {b : Bool} :
b.toUInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
cases b <;> simp [toUInt64]
@[simp, int_toBitVec]
theorem Bool.toBitVec_toUSize {b : Bool} :
b.toUSize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
cases b
· simp [toUSize]
· apply BitVec.eq_of_toNat_eq
simp [toUSize]

View File

@@ -41,9 +41,9 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
rw [toNat, toBitVec_eq_of_lt h]
theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
@[int_toBitVec] theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
@[int_toBitVec] theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
theorem le_iff_toNat_le {a b : $typeName} : a b a.toNat b.toNat := .rfl
@@ -74,6 +74,11 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
protected theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec a = b :=
Iff.intro eq_of_toBitVec_eq toBitVec_eq_of_eq
open $typeName (eq_of_toBitVec_eq toBitVec_eq_of_eq) in
@[int_toBitVec]
protected theorem eq_iff_toBitVec_eq {a b : $typeName} : a = b a.toBitVec = b.toBitVec :=
Iff.intro toBitVec_eq_of_eq eq_of_toBitVec_eq
open $typeName (eq_of_toBitVec_eq) in
protected theorem eq_of_val_eq {a b : $typeName} (h : a.val = b.val) : a = b := by
rcases a with _; rcases b with _; simp_all [val]
@@ -82,10 +87,19 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
protected theorem val_inj {a b : $typeName} : a.val = b.val a = b :=
Iff.intro eq_of_val_eq (congrArg val)
open $typeName (eq_of_toBitVec_eq) in
protected theorem toBitVec_ne_of_ne {a b : $typeName} (h : a b) : a.toBitVec b.toBitVec :=
fun h' => h (eq_of_toBitVec_eq h')
open $typeName (toBitVec_eq_of_eq) in
protected theorem ne_of_toBitVec_ne {a b : $typeName} (h : a.toBitVec b.toBitVec) : a b :=
fun h' => absurd (toBitVec_eq_of_eq h') h
open $typeName (ne_of_toBitVec_ne toBitVec_ne_of_ne) in
@[int_toBitVec]
protected theorem ne_iff_toBitVec_ne {a b : $typeName} : a b a.toBitVec b.toBitVec :=
Iff.intro toBitVec_ne_of_ne ne_of_toBitVec_ne
open $typeName (ne_of_toBitVec_ne) in
protected theorem ne_of_lt {a b : $typeName} (h : a < b) : a b := by
apply ne_of_toBitVec_ne
@@ -159,7 +173,7 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
@[simp]
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
@[simp]
@[simp, int_toBitVec]
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
@[simp]
@@ -220,23 +234,3 @@ theorem UInt32.toNat_le_of_le {n : UInt32} {m : Nat} (h : m < size) : n ≤ ofNa
theorem UInt32.le_toNat_of_le {n : UInt32} {m : Nat} (h : m < size) : ofNat m n m n.toNat := by
simp [le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
@[deprecated UInt8.toNat_zero (since := "2024-06-23")] protected abbrev UInt8.zero_toNat := @UInt8.toNat_zero
@[deprecated UInt8.toNat_div (since := "2024-06-23")] protected abbrev UInt8.div_toNat := @UInt8.toNat_div
@[deprecated UInt8.toNat_mod (since := "2024-06-23")] protected abbrev UInt8.mod_toNat := @UInt8.toNat_mod
@[deprecated UInt16.toNat_zero (since := "2024-06-23")] protected abbrev UInt16.zero_toNat := @UInt16.toNat_zero
@[deprecated UInt16.toNat_div (since := "2024-06-23")] protected abbrev UInt16.div_toNat := @UInt16.toNat_div
@[deprecated UInt16.toNat_mod (since := "2024-06-23")] protected abbrev UInt16.mod_toNat := @UInt16.toNat_mod
@[deprecated UInt32.toNat_zero (since := "2024-06-23")] protected abbrev UInt32.zero_toNat := @UInt32.toNat_zero
@[deprecated UInt32.toNat_div (since := "2024-06-23")] protected abbrev UInt32.div_toNat := @UInt32.toNat_div
@[deprecated UInt32.toNat_mod (since := "2024-06-23")] protected abbrev UInt32.mod_toNat := @UInt32.toNat_mod
@[deprecated UInt64.toNat_zero (since := "2024-06-23")] protected abbrev UInt64.zero_toNat := @UInt64.toNat_zero
@[deprecated UInt64.toNat_div (since := "2024-06-23")] protected abbrev UInt64.div_toNat := @UInt64.toNat_div
@[deprecated UInt64.toNat_mod (since := "2024-06-23")] protected abbrev UInt64.mod_toNat := @UInt64.toNat_mod
@[deprecated USize.toNat_zero (since := "2024-06-23")] protected abbrev USize.zero_toNat := @USize.toNat_zero
@[deprecated USize.toNat_div (since := "2024-06-23")] protected abbrev USize.div_toNat := @USize.toNat_div
@[deprecated USize.toNat_mod (since := "2024-06-23")] protected abbrev USize.mod_toNat := @USize.toNat_mod

View File

@@ -170,6 +170,13 @@ result is empty. If `stop` is greater than the size of the vector, the size is u
@[inline] def map (f : α β) (v : Vector α n) : Vector β n :=
v.toArray.map f, by simp
@[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
(v.toArray.map Vector.toArray).flatten,
by rcases v; simp_all [Function.comp_def, Array.map_const']
@[inline] def flatMap (v : Vector α n) (f : α Vector β m) : Vector β (n * m) :=
v.toArray.flatMap fun a => (f a).toArray, by simp [Array.map_const']
/-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α β φ) : Vector φ n :=
Array.zipWith a.toArray b.toArray f, by simp

View File

@@ -5,6 +5,7 @@ Authors: Shreyas Srinivas, Francois Dorais, Kim Morrison
-/
prelude
import Init.Data.Vector.Basic
import Init.Data.Array.Attach
/-!
## Vectors
@@ -27,6 +28,9 @@ namespace Vector
theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a := rfl
@[simp] theorem mk_toArray (v : Vector α n) : mk v.toArray v.2 = v := by
rfl
@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) :
(Vector.mk data size)[i] = data[i] := rfl
@@ -471,7 +475,7 @@ theorem singleton_inj : #v[a] = #v[b] ↔ a = b := by
theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
simp [mkVector, Array.mkArray_succ]
theorem mkVector_inj : mkVector n a = mkVector n b n = 0 a = b := by
@[simp] theorem mkVector_inj : mkVector n a = mkVector n b n = 0 a = b := by
simp [ toArray_inj, toArray_mkVector, Array.mkArray_inj]
/-! ## L[i] and L[i]? -/
@@ -693,6 +697,24 @@ theorem forall_getElem {l : Vector α n} {p : α → Prop} :
rcases l with l, rfl
simp [Array.forall_getElem]
/-! ### cast -/
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
(a.cast h)[i] = a[i] := by
cases a
simp
@[simp] theorem getElem?_cast {l : Vector α n} {m : Nat} {w : n = m} {i : Nat} :
(l.cast w)[i]? = l[i]? := by
rcases l with l, rfl
simp
@[simp] theorem mem_cast {a : α} {l : Vector α n} {m : Nat} {w : n = m} :
a l.cast w a l := by
rcases l with l, rfl
simp
/-! ### Decidability of bounded quantifiers -/
instance {xs : Vector α n} {p : α Prop} [DecidablePred p] :
@@ -1097,6 +1119,11 @@ theorem forall_mem_map {f : α → β} {l : Vector α n} {P : β → Prop} :
@[simp] theorem map_inj_left {f g : α β} : map f l = map g l a l, f a = g a := by
cases l <;> simp_all
theorem map_inj_right {f : α β} (w : x y, f x = f y x = y) : map f l = map f l' l = l' := by
cases l
cases l'
simp [Array.map_inj_right w]
theorem map_congr_left (h : a l, f a = g a) : map f l = map g l :=
map_inj_left.2 h
@@ -1167,6 +1194,644 @@ theorem map_eq_iff {f : α → β} {l : Vector α n} {l' : Vector β n} :
cases as
simp
/--
Use this as `induction ass using vector₂_induction` on a hypothesis of the form `ass : Vector (Vector α n) m`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array α)`
along with additional hypotheses `h₁ : ass.size = m` and `h₂ : ∀ xs ∈ ass, xs.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk xs ⋯)) ⋯`.
-/
-- We can't use `@[cases_eliminator]` here as
-- `Lean.Meta.getCustomEliminator?` only looks at the top-level constant.
theorem vector₂_induction (P : Vector (Vector α n) m Prop)
(of : (xss : Array (Array α)) (h₁ : xss.size = m) (h₂ : xs xss, xs.size = n),
P (mk (xss.attach.map (fun xs, m => mk xs (h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector α n) m) : P ass := by
specialize of (ass.map toArray).toArray (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/--
Use this as `induction ass using vector₃_induction` on a hypothesis of the form `ass : Vector (Vector (Vector α n) m) k`.
The hypothesis `ass` will be replaced with a hypothesis `ass : Array (Array (Array α))`
along with additional hypotheses `h₁ : ass.size = k`, `h₂ : ∀ xs ∈ ass, xs.size = m`,
and `h₃ : ∀ xs ∈ ass, ∀ x ∈ xs, x.size = n`.
Appearances of the original `ass` in the goal will be replaced with
`Vector.mk (xss.attach.map (fun ⟨xs, m⟩ => Vector.mk (xs.attach.map (fun ⟨x, m'⟩ => Vector.mk x ⋯)) ⋯)) ⋯`.
-/
theorem vector₃_induction (P : Vector (Vector (Vector α n) m) k Prop)
(of : (xss : Array (Array (Array α))) (h₁ : xss.size = k) (h₂ : xs xss, xs.size = m)
(h₃ : xs xss, x xs, x.size = n),
P (mk (xss.attach.map (fun xs, m =>
mk (xs.attach.map (fun x, m' =>
mk x (h₃ xs m x m'))) (by simpa using h₂ xs m))) (by simpa using h₁)))
(ass : Vector (Vector (Vector α n) m) k) : P ass := by
specialize of (ass.map (fun as => (as.map toArray).toArray)).toArray (by simp) (by simp) (by simp)
simpa [Array.map_attach, Array.pmap_map] using of
/-! ### singleton -/
@[simp] theorem singleton_def (v : α) : Vector.singleton v = #v[v] := rfl
/-! ### append -/
@[simp] theorem append_push {as : Vector α n} {bs : Vector α m} {a : α} :
as ++ bs.push a = (as ++ bs).push a := by
cases as
cases bs
simp
theorem singleton_eq_toVector_singleton (a : α) : #v[a] = #[a].toVector := rfl
@[simp] theorem mem_append {a : α} {s : Vector α n} {t : Vector α m} :
a s ++ t a s a t := by
cases s
cases t
simp
theorem mem_append_left {a : α} {s : Vector α n} {t : Vector α m} (h : a s) : a s ++ t :=
mem_append.2 (Or.inl h)
theorem mem_append_right {a : α} {s : Vector α n} {t : Vector α m} (h : a t) : a s ++ t :=
mem_append.2 (Or.inr h)
theorem not_mem_append {a : α} {s : Vector α n} {t : Vector α m} (h₁ : a s) (h₂ : a t) :
a s ++ t :=
mt mem_append.1 $ not_or.mpr h₁, h₂
/--
See also `eq_push_append_of_mem`, which proves a stronger version
in which the initial array must not contain the element.
-/
theorem append_of_mem {a : α} {l : Vector α n} (h : a l) :
(m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
l = (s.push a ++ t).cast w := by
rcases l with l, rfl
obtain s, t, rfl := Array.append_of_mem (by simpa using h)
refine _, _, by simp, s.toVector, t.toVector, by simp_all
theorem mem_iff_append {a : α} {l : Vector α n} :
a l (m k : Nat) (w : m + 1 + k = n) (s : Vector α m) (t : Vector α k),
l = (s.push a ++ t).cast w :=
append_of_mem, by rintro m, k, rfl, s, t, rfl; simp
theorem forall_mem_append {p : α Prop} {l₁ : Vector α n} {l₂ : Vector α m} :
( (x) (_ : x l₁ ++ l₂), p x) ( (x) (_ : x l₁), p x) ( (x) (_ : x l₂), p x) := by
simp only [mem_append, or_imp, forall_and]
theorem empty_append (as : Vector α n) : (#v[] : Vector α 0) ++ as = as.cast (by omega) := by
rcases as with as, rfl
simp
theorem append_empty (as : Vector α n) : as ++ (#v[] : Vector α 0) = as := by
rw [ toArray_inj, toArray_append, Array.append_empty]
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
rcases a with a, rfl
rcases b with b, rfl
simp [Array.getElem_append, hi]
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n i) :
(a ++ b)[i] = b[i - n] := by
rw [getElem_append, dif_neg (by omega)]
theorem getElem?_append_left {as : Vector α n} {bs : Vector α m} {i : Nat} (hn : i < n) :
(as ++ bs)[i]? = as[i]? := by
have hn' : i < n + m := by omega
simp_all [getElem?_eq_getElem, getElem_append]
theorem getElem?_append_right {as : Vector α n} {bs : Vector α m} {i : Nat} (h : n i) :
(as ++ bs)[i]? = bs[i - n]? := by
rcases as with as, rfl
rcases bs with bs, rfl
simp [Array.getElem?_append_right, h]
theorem getElem?_append {as : Vector α n} {bs : Vector α m} {i : Nat} :
(as ++ bs)[i]? = if i < n then as[i]? else bs[i - n]? := by
split <;> rename_i h
· exact getElem?_append_left h
· exact getElem?_append_right (by simpa using h)
/-- Variant of `getElem_append_left` useful for rewriting from the small array to the big array. -/
theorem getElem_append_left' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < m) :
l₁[i] = (l₁ ++ l₂)[i] := by
rw [getElem_append_left] <;> simp
/-- Variant of `getElem_append_right` useful for rewriting from the small array to the big array. -/
theorem getElem_append_right' (l₁ : Vector α m) {l₂ : Vector α n} {i : Nat} (hi : i < n) :
l₂[i] = (l₁ ++ l₂)[i + m] := by
rw [getElem_append_right] <;> simp [*, Nat.le_add_left]
theorem getElem_of_append {l : Vector α n} {l₁ : Vector α m} {l₂ : Vector α k}
(w : m + 1 + k = n) (eq : l = (l₁.push a ++ l₂).cast w) :
l[m] = a := Option.some.inj <| by
rw [ getElem?_eq_getElem, eq, getElem?_cast, getElem?_append_left (by simp)]
simp
@[simp 1100] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
cases as
simp
theorem append_inj {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m} (h : s₁ ++ t₁ = s₂ ++ t₂) :
s₁ = s₂ t₁ = t₂ := by
rcases s₁ with s₁, rfl
rcases s₂ with s₂, hs
rcases t₁ with t₁, rfl
rcases t₂ with t₂, ht
simpa using Array.append_inj (by simpa using h) (by omega)
theorem append_inj_right {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
(h : s₁ ++ t₁ = s₂ ++ t₂) : t₁ = t₂ :=
(append_inj h).right
theorem append_inj_left {s₁ s₂ : Vector α n} {t₁ t₂ : Vector α m}
(h : s₁ ++ t₁ = s₂ ++ t₂) : s₁ = s₂ :=
(append_inj h).left
theorem append_right_inj {t₁ t₂ : Vector α m} (s : Vector α n) : s ++ t₁ = s ++ t₂ t₁ = t₂ :=
fun h => append_inj_right h, congrArg _
theorem append_left_inj {s₁ s₂ : Vector α n} (t : Vector α m) : s₁ ++ t = s₂ ++ t s₁ = s₂ :=
fun h => append_inj_left h, congrArg (· ++ _)
theorem append_eq_append_iff {a : Vector α n} {b : Vector α m} {c : Vector α k} {d : Vector α l}
(w : k + l = n + m) :
a ++ b = (c ++ d).cast w
if h : n k then
a' : Vector α (k - n), c = (a ++ a').cast (by omega) b = (a' ++ d).cast (by omega)
else
c' : Vector α (n - k), a = (c ++ c').cast (by omega) d = (c' ++ b).cast (by omega) := by
rcases a with a, rfl
rcases b with b, rfl
rcases c with c, rfl
rcases d with d, rfl
simp only [mk_append_mk, Array.append_eq_append_iff, mk_eq, toArray_cast]
constructor
· rintro (a', rfl, rfl | c', rfl, rfl)
· rw [dif_pos (by simp)]
exact a'.toVector.cast (by simp; omega), by simp
· split <;> rename_i h
· have hc : c'.size = 0 := by simp at h; omega
simp at hc
exact #v[].cast (by simp; omega), by simp_all
· exact c'.toVector.cast (by simp; omega), by simp
· split <;> rename_i h
· rintro a', hc, rfl
left
refine a'.toArray, hc, rfl
· rintro c', ha, rfl
right
refine c'.toArray, ha, rfl
theorem set_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n + m) :
(s ++ t).set i x =
if h' : i < n then
s.set i x ++ t
else
s ++ t.set (i - n) x := by
rcases s with s, rfl
rcases t with t, rfl
simp only [mk_append_mk, set_mk, Array.set_append]
split <;> simp
@[simp] theorem set_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
(s ++ t).set i x = s.set i x ++ t := by
simp [set_append, h]
@[simp] theorem set_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
(h' : i < n + m) (h : n i) :
(s ++ t).set i x = s ++ t.set (i - n) x := by
rw [set_append, dif_neg (by omega)]
theorem setIfInBounds_append {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} :
(s ++ t).setIfInBounds i x =
if i < n then
s.setIfInBounds i x ++ t
else
s ++ t.setIfInBounds (i - n) x := by
rcases s with s, rfl
rcases t with t, rfl
simp only [mk_append_mk, setIfInBounds_mk, Array.setIfInBounds_append]
split <;> simp
@[simp] theorem setIfInBounds_append_left {s : Vector α n} {t : Vector α m} {i : Nat} {x : α} (h : i < n) :
(s ++ t).setIfInBounds i x = s.setIfInBounds i x ++ t := by
simp [setIfInBounds_append, h]
@[simp] theorem setIfInBounds_append_right {s : Vector α n} {t : Vector α m} {i : Nat} {x : α}
(h : n i) :
(s ++ t).setIfInBounds i x = s ++ t.setIfInBounds (i - n) x := by
rw [setIfInBounds_append, if_neg (by omega)]
@[simp] theorem map_append (f : α β) (l₁ : Vector α n) (l₂ : Vector α m) :
map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, rfl
simp
theorem map_eq_append_iff {f : α β} :
map f l = L₁ ++ L₂ l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rcases l with l, h
rcases L₁ with L₁, rfl
rcases L₂ with L₂, rfl
simp only [map_mk, mk_append_mk, eq_mk, Array.map_eq_append_iff, mk_eq, toArray_append,
toArray_map]
constructor
· rintro l₁, l₂, rfl, rfl, rfl
exact l₁.toVector.cast (by simp), l₂.toVector.cast (by simp), by simp
· rintro l₁, l₂, rfl, h₁, h₂
exact l₁, l₂, by simp_all
theorem append_eq_map_iff {f : α β} :
L₁ ++ L₂ = map f l l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rw [eq_comm, map_eq_append_iff]
/-! ### flatten -/
@[simp] theorem flatten_mk (L : Array (Vector α n)) (h : L.size = m) :
(mk L h).flatten =
mk (L.map toArray).flatten (by simp [Function.comp_def, Array.map_const', h]) := by
simp [flatten]
@[simp] theorem getElem_flatten (l : Vector (Vector β m) n) (i : Nat) (hi : i < n * m) :
l.flatten[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
l[i / m][i % m] := by
rcases l with l, rfl
simp only [flatten_mk, List.map_toArray, getElem_mk, List.getElem_toArray, Array.flatten_toArray]
induction l generalizing i with
| nil => simp at hi
| cons a l ih =>
simp only [List.map_cons, List.map_map, List.flatten_cons]
by_cases h : i < m
· rw [List.getElem_append_left (by simpa)]
have h₁ : i / m = 0 := Nat.div_eq_of_lt h
have h₂ : i % m = i := Nat.mod_eq_of_lt h
simp [h₁, h₂]
· have h₁ : a.toList.length i := by simp; omega
rw [List.getElem_append_right h₁]
simp only [Array.length_toList, size_toArray]
specialize ih (i - m) (by simp_all [Nat.add_one_mul]; omega)
have h₂ : i / m = (i - m) / m + 1 := by
conv => lhs; rw [show i = i - m + m by omega]
rw [Nat.add_div_right]
exact Nat.pos_of_lt_mul_left hi
simp only [Array.length_toList, size_toArray] at h₁
have h₃ : (i - m) % m = i % m := (Nat.mod_eq_sub_mod h₁).symm
simp_all
theorem getElem?_flatten (l : Vector (Vector β m) n) (i : Nat) :
l.flatten[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some l[i / m][i % m]
else
none := by
simp [getElem?_def]
@[simp] theorem flatten_singleton (l : Vector α n) : #v[l].flatten = l.cast (by simp) := by
simp [flatten]
theorem mem_flatten {L : Vector (Vector α n) m} : a L.flatten l, l L a l := by
rcases L with L, rfl
simp [Array.mem_flatten]
constructor
· rintro _, l, h₁, rfl, h₂
exact l, h₁, by simpa using h₂
· rintro l, h₁, h₂
exact l.toArray, l, h₁, rfl, by simpa using h₂
theorem exists_of_mem_flatten : a flatten L l, l L a l := mem_flatten.1
theorem mem_flatten_of_mem (lL : l L) (al : a l) : a flatten L := mem_flatten.2 l, lL, al
theorem forall_mem_flatten {p : α Prop} {L : Vector (Vector α n) m} :
( (x) (_ : x flatten L), p x) (l) (_ : l L) (x) (_ : x l), p x := by
simp only [mem_flatten, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
@[simp] theorem map_flatten (f : α β) (L : Vector (Vector α n) m) :
(flatten L).map f = (map (map f) L).flatten := by
induction L using vector₂_induction with
| of xss h₁ h₂ => simp
@[simp] theorem flatten_append (L₁ : Vector (Vector α n) m₁) (L₂ : Vector (Vector α n) m₂) :
flatten (L₁ ++ L₂) = (flatten L₁ ++ flatten L₂).cast (by simp [Nat.add_mul]) := by
induction L₁ using vector₂_induction
induction L₂ using vector₂_induction
simp
theorem flatten_push (L : Vector (Vector α n) m) (l : Vector α n) :
flatten (L.push l) = (flatten L ++ l).cast (by simp [Nat.add_mul]) := by
induction L using vector₂_induction
rcases l with l
simp [Array.flatten_push]
theorem flatten_flatten {L : Vector (Vector (Vector α n) m) k} :
flatten (flatten L) = (flatten (map flatten L)).cast (by simp [Nat.mul_assoc]) := by
induction L using vector₃_induction with
| of xss h₁ h₂ h₃ =>
-- simp [Array.flatten_flatten] -- FIXME: `simp` produces a bad proof here!
simp [Array.map_attach, Array.flatten_flatten, Array.map_pmap]
/-- Two vectors of constant length vectors are equal iff their flattens coincide. -/
theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
L = L' L.flatten = L'.flatten := by
induction L using vector₂_induction with | of L h₁ h₂ =>
induction L' using vector₂_induction with | of L' h₁' h₂' =>
simp only [eq_mk, flatten_mk, Array.map_map, Function.comp_apply, Array.map_subtype,
Array.unattach_attach, Array.map_id_fun', id_eq]
constructor
· intro h
suffices L = L' by simp_all
apply Array.ext_getElem?
intro i
replace h := congrArg (fun x => x[i]?.map (fun x => x.toArray)) h
simpa [Option.map_pmap] using h
· intro h
have w : L.map Array.size = L'.map Array.size := by
ext i h h'
· simp_all
· simp only [Array.getElem_map]
rw [h₂ _ (by simp), h₂' _ (by simp)]
have := Array.eq_iff_flatten_eq.mpr h, w
subst this
rfl
/-! ### flatMap -/
@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α Vector β n) :
(mk l h).flatMap f =
mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
simp [flatMap]
@[simp] theorem flatMap_toArray (l : Vector α n) (f : α Vector β m) :
l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
rcases l with l, rfl
simp
theorem flatMap_def (l : Vector α n) (f : α Vector β m) : l.flatMap f = flatten (map f l) := by
rcases l with l, rfl
simp [Array.flatMap_def, Function.comp_def]
@[simp] theorem getElem_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) (hi : i < n * m) :
(l.flatMap f)[i] =
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
(f (l[i / m]))[i % m] := by
rw [flatMap_def, getElem_flatten, getElem_map]
theorem getElem?_flatMap (l : Vector α n) (f : α Vector β m) (i : Nat) :
(l.flatMap f)[i]? =
if hi : i < n * m then
haveI : i / m < n := by rwa [Nat.div_lt_iff_lt_mul (Nat.pos_of_lt_mul_left hi)]
haveI : i % m < m := Nat.mod_lt _ (Nat.pos_of_lt_mul_left hi)
some ((f (l[i / m]))[i % m])
else
none := by
simp [getElem?_def]
@[simp] theorem flatMap_id (l : Vector (Vector α m) n) : l.flatMap id = l.flatten := by simp [flatMap_def]
@[simp] theorem flatMap_id' (l : Vector (Vector α m) n) : l.flatMap (fun a => a) = l.flatten := by simp [flatMap_def]
@[simp] theorem mem_flatMap {f : α Vector β m} {b} {l : Vector α n} : b l.flatMap f a, a l b f a := by
simp [flatMap_def, mem_flatten]
exact fun _, a, h₁, rfl, h₂ => a, h₁, h₂, fun a, h₁, h₂ => _, a, h₁, rfl, h₂
theorem exists_of_mem_flatMap {b : β} {l : Vector α n} {f : α Vector β m} :
b l.flatMap f a, a l b f a := mem_flatMap.1
theorem mem_flatMap_of_mem {b : β} {l : Vector α n} {f : α Vector β m} {a} (al : a l) (h : b f a) :
b l.flatMap f := mem_flatMap.2 a, al, h
theorem forall_mem_flatMap {p : β Prop} {l : Vector α n} {f : α Vector β m} :
( (x) (_ : x l.flatMap f), p x) (a) (_ : a l) (b) (_ : b f a), p b := by
simp only [mem_flatMap, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
theorem flatMap_singleton (f : α Vector β m) (x : α) : #v[x].flatMap f = (f x).cast (by simp) := by
simp [flatMap_def]
@[simp] theorem flatMap_singleton' (l : Vector α n) : (l.flatMap fun x => #v[x]) = l.cast (by simp) := by
rcases l with l, rfl
simp
@[simp] theorem flatMap_append (xs ys : Vector α n) (f : α Vector β m) :
(xs ++ ys).flatMap f = (xs.flatMap f ++ ys.flatMap f).cast (by simp [Nat.add_mul]) := by
rcases xs with xs
rcases ys with ys
simp [flatMap_def, flatten_append]
theorem flatMap_assoc {α β} (l : Vector α n) (f : α Vector β m) (g : β Vector γ k) :
(l.flatMap f).flatMap g = (l.flatMap fun x => (f x).flatMap g).cast (by simp [Nat.mul_assoc]) := by
rcases l with l, rfl
simp [Array.flatMap_assoc]
theorem map_flatMap (f : β γ) (g : α Vector β m) (l : Vector α n) :
(l.flatMap g).map f = l.flatMap fun a => (g a).map f := by
rcases l with l, rfl
simp [Array.map_flatMap]
theorem flatMap_map (f : α β) (g : β Vector γ k) (l : Vector α n) :
(map f l).flatMap g = l.flatMap (fun a => g (f a)) := by
rcases l with l, rfl
simp [Array.flatMap_map]
theorem map_eq_flatMap {α β} (f : α β) (l : Vector α n) :
map f l = (l.flatMap fun x => #v[f x]).cast (by simp) := by
rcases l with l, rfl
simp [Array.map_eq_flatMap]
/-! ### mkVector -/
@[simp] theorem mkVector_one : mkVector 1 a = #v[a] := rfl
/-- Variant of `mkVector_succ` that prepends `a` at the beginning of the vector. -/
theorem mkVector_succ' : mkVector (n + 1) a = (#v[a] ++ mkVector n a).cast (by omega) := by
rw [ toArray_inj]
simp [Array.mkArray_succ']
@[simp] theorem mem_mkVector {a b : α} {n} : b mkVector n a n 0 b = a := by
unfold mkVector
simp
theorem eq_of_mem_mkVector {a b : α} {n} (h : b mkVector n a) : b = a := (mem_mkVector.1 h).2
theorem forall_mem_mkVector {p : α Prop} {a : α} {n} :
( b, b mkVector n a p b) n = 0 p a := by
cases n <;> simp [mem_mkVector]
@[simp] theorem getElem_mkVector (a : α) (n i : Nat) (h : i < n) : (mkVector n a)[i] = a := by
simp [mkVector]
theorem getElem?_mkVector (a : α) (n i : Nat) : (mkVector n a)[i]? = if i < n then some a else none := by
simp [getElem?_def]
@[simp] theorem getElem?_mkVector_of_lt {n : Nat} {m : Nat} (h : m < n) : (mkVector n a)[m]? = some a := by
simp [getElem?_mkVector, h]
theorem eq_mkVector_of_mem {a : α} {l : Vector α n} (h : (b) (_ : b l), b = a) : l = mkVector n a := by
rw [ toArray_inj]
simpa using Array.eq_mkArray_of_mem (l := l.toArray) (by simpa using h)
theorem eq_mkVector_iff {a : α} {n} {l : Vector α n} :
l = mkVector n a (b) (_ : b l), b = a := by
rw [ toArray_inj]
simpa using Array.eq_mkArray_iff (l := l.toArray) (n := n)
theorem map_eq_mkVector_iff {l : Vector α n} {f : α β} {b : β} :
l.map f = mkVector n b x l, f x = b := by
simp [eq_mkVector_iff]
@[simp] theorem map_const (l : Vector α n) (b : β) : map (Function.const α b) l = mkVector n b :=
map_eq_mkVector_iff.mpr fun _ _ => rfl
@[simp] theorem map_const_fun (x : β) : map (n := n) (Function.const α x) = fun _ => mkVector n x := by
funext l
simp
/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
-- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
theorem map_const' (l : Vector α n) (b : β) : map (fun _ => b) l = mkVector n b :=
map_const l b
@[simp] theorem set_mkVector_self : (mkVector n a).set i a h = mkVector n a := by
rw [ toArray_inj]
simp
@[simp] theorem setIfInBounds_mkVector_self : (mkVector n a).setIfInBounds i a = mkVector n a := by
rw [ toArray_inj]
simp
@[simp] theorem mkVector_append_mkVector : mkVector n a ++ mkVector m a = mkVector (n + m) a := by
rw [ toArray_inj]
simp
theorem append_eq_mkVector_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
l₁ ++ l₂ = mkVector (n + m) a l₁ = mkVector n a l₂ = mkVector m a := by
simp [ toArray_inj, Array.append_eq_mkArray_iff]
theorem mkVector_eq_append_iff {l₁ : Vector α n} {l₂ : Vector α m} {a : α} :
mkVector (n + m) a = l₁ ++ l₂ l₁ = mkVector n a l₂ = mkVector m a := by
rw [eq_comm, append_eq_mkVector_iff]
@[simp] theorem map_mkVector : (mkVector n a).map f = mkVector n (f a) := by
rw [ toArray_inj]
simp
@[simp] theorem flatten_mkVector_empty : (mkVector n (#v[] : Vector α 0)).flatten = #v[] := by
rw [ toArray_inj]
simp
@[simp] theorem flatten_mkVector_singleton : (mkVector n #v[a]).flatten = (mkVector n a).cast (by simp) := by
ext i h
simp [h]
@[simp] theorem flatten_mkVector_mkVector : (mkVector n (mkVector m a)).flatten = mkVector (n * m) a := by
ext i h
simp [h]
theorem flatMap_mkArray {β} (f : α Vector β m) : (mkVector n a).flatMap f = (mkVector n (f a)).flatten := by
ext i h
simp [h]
@[simp] theorem sum_mkArray_nat (n : Nat) (a : Nat) : (mkVector n a).sum = n * a := by
simp [toArray_mkVector]
/-! ### reverse -/
@[simp] theorem reverse_push (as : Vector α n) (a : α) :
(as.push a).reverse = (#v[a] ++ as.reverse).cast (by omega) := by
rcases as with as, rfl
simp [Array.reverse_push]
@[simp] theorem mem_reverse {x : α} {as : Vector α n} : x as.reverse x as := by
cases as
simp
@[simp] theorem getElem_reverse (a : Vector α n) (i : Nat) (hi : i < n) :
(a.reverse)[i] = a[n - 1 - i] := by
rcases a with a, rfl
simp
/-- Variant of `getElem?_reverse` with a hypothesis giving the linear relation between the indices. -/
theorem getElem?_reverse' {l : Vector α n} (i j) (h : i + j + 1 = n) : l.reverse[i]? = l[j]? := by
rcases l with l, rfl
simpa using Array.getElem?_reverse' i j h
@[simp]
theorem getElem?_reverse {l : Vector α n} {i} (h : i < n) :
l.reverse[i]? = l[n - 1 - i]? := by
cases l
simp_all
@[simp] theorem reverse_reverse (as : Vector α n) : as.reverse.reverse = as := by
rcases as with as, rfl
simp [Array.reverse_reverse]
theorem reverse_eq_iff {as bs : Vector α n} : as.reverse = bs as = bs.reverse := by
constructor <;> (rintro rfl; simp)
@[simp] theorem reverse_inj {xs ys : Vector α n} : xs.reverse = ys.reverse xs = ys := by
simp [reverse_eq_iff]
@[simp] theorem reverse_eq_push_iff {xs : Vector α (n + 1)} {ys : Vector α n} {a : α} :
xs.reverse = ys.push a xs = (#v[a] ++ ys.reverse).cast (by omega) := by
rcases xs with xs, h
rcases ys with ys, rfl
simp [Array.reverse_eq_push_iff]
@[simp] theorem map_reverse (f : α β) (l : Vector α n) : l.reverse.map f = (l.map f).reverse := by
rcases l with l, rfl
simp [Array.map_reverse]
@[simp] theorem reverse_append (as : Vector α n) (bs : Vector α m) :
(as ++ bs).reverse = (bs.reverse ++ as.reverse).cast (by omega) := by
rcases as with as, rfl
rcases bs with bs, rfl
simp [Array.reverse_append]
@[simp] theorem reverse_eq_append_iff {xs : Vector α (n + m)} {ys : Vector α n} {zs : Vector α m} :
xs.reverse = ys ++ zs xs = (zs.reverse ++ ys.reverse).cast (by omega) := by
cases xs
cases ys
cases zs
simp
/-- Reversing a flatten is the same as reversing the order of parts and reversing all parts. -/
theorem reverse_flatten (L : Vector (Vector α m) n) :
L.flatten.reverse = (L.map reverse).reverse.flatten := by
cases L using vector₂_induction
simp [Array.reverse_flatten]
/-- Flattening a reverse is the same as reversing all parts and reversing the flattened result. -/
theorem flatten_reverse (L : Vector (Vector α m) n) :
L.reverse.flatten = (L.map reverse).flatten.reverse := by
cases L using vector₂_induction
simp [Array.flatten_reverse]
theorem reverse_flatMap {β} (l : Vector α n) (f : α Vector β m) :
(l.flatMap f).reverse = l.reverse.flatMap (reverse f) := by
rcases l with l, rfl
simp [Array.reverse_flatMap, Function.comp_def]
theorem flatMap_reverse {β} (l : Vector α n) (f : α Vector β m) :
(l.reverse.flatMap f) = (l.flatMap (reverse f)).reverse := by
rcases l with l, rfl
simp [Array.flatMap_reverse, Function.comp_def]
@[simp] theorem reverse_mkVector (n) (a : α) : reverse (mkVector n a) = mkVector n a := by
rw [ toArray_inj]
simp
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
@@ -1197,28 +1862,6 @@ defeq issues in the implicit size argument.
subst h
simp [pop, back, back!, Array.eq_push_pop_back!_of_size_ne_zero]
/-! ### append -/
theorem getElem_append (a : Vector α n) (b : Vector α m) (i : Nat) (hi : i < n + m) :
(a ++ b)[i] = if h : i < n then a[i] else b[i - n] := by
rcases a with a, rfl
rcases b with b, rfl
simp [Array.getElem_append, hi]
theorem getElem_append_left {a : Vector α n} {b : Vector α m} {i : Nat} (hi : i < n) :
(a ++ b)[i] = a[i] := by simp [getElem_append, hi]
theorem getElem_append_right {a : Vector α n} {b : Vector α m} {i : Nat} (h : i < n + m) (hi : n i) :
(a ++ b)[i] = b[i - n] := by
rw [getElem_append, dif_neg (by omega)]
/-! ### cast -/
@[simp] theorem getElem_cast (a : Vector α n) (h : n = m) (i : Nat) (hi : i < m) :
(a.cast h)[i] = a[i] := by
cases a
simp
/-! ### extract -/
@[simp] theorem getElem_extract (a : Vector α n) (start stop) (i : Nat) (hi : i < min stop n - start) :
@@ -1320,13 +1963,6 @@ theorem swap_comm (a : Vector α n) {i j : Nat} {hi hj} :
cases a
simp
/-! ### reverse -/
@[simp] theorem getElem_reverse (a : Vector α n) (i : Nat) (hi : i < n) :
(a.reverse)[i] = a[n - 1 - i] := by
rcases a with a, rfl
simp
/-! ### Decidable quantifiers. -/
theorem forall_zero_iff {P : Vector α 0 Prop} :

View File

@@ -11,3 +11,4 @@ import Init.Grind.Cases
import Init.Grind.Propagator
import Init.Grind.Util
import Init.Grind.Offset
import Init.Grind.PP

View File

@@ -12,6 +12,9 @@ import Init.Grind.Util
namespace Lean.Grind
theorem rfl_true : true = true :=
rfl
theorem intro_with_eq (p p' q : Prop) (he : p = p') (h : p' q) : p q :=
fun hp => h (he.mp hp)
@@ -66,6 +69,12 @@ theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by s
theorem eq_congr {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
/- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a b) (¬b a) := by
by_cases a <;> by_cases b <;> simp_all
theorem of_eq_eq_false {a b : Prop} (h : (a = b) = False) : (¬a ¬b) (b a) := by
by_cases a <;> by_cases b <;> simp_all
/-! Forall -/
theorem forall_propagator (p : Prop) (q : p Prop) (q' : Prop) (h₁ : p = True) (h₂ : q (of_eq_true h₁) = q') : ( hp : p, q hp) = q' := by

View File

@@ -12,110 +12,105 @@ import Init.ByCases
namespace Lean.Grind
/-!
Normalization theorems for the `grind` tactic.
We are also going to use simproc's in the future.
-/
-- Not
attribute [grind_norm] Classical.not_not
-- Ne
attribute [grind_norm] ne_eq
-- Iff
@[grind_norm] theorem iff_eq (p q : Prop) : (p q) = (p = q) := by
theorem iff_eq (p q : Prop) : (p q) = (p = q) := by
by_cases p <;> by_cases q <;> simp [*]
-- Eq
attribute [grind_norm] eq_self heq_eq_eq
-- Prop equality
@[grind_norm] theorem eq_true_eq (p : Prop) : (p = True) = p := by simp
@[grind_norm] theorem eq_false_eq (p : Prop) : (p = False) = ¬p := by simp
@[grind_norm] theorem not_eq_prop (p q : Prop) : (¬(p = q)) = (p = ¬q) := by
theorem eq_true_eq (p : Prop) : (p = True) = p := by simp
theorem eq_false_eq (p : Prop) : (p = False) = ¬p := by simp
theorem not_eq_prop (p q : Prop) : (¬(p = q)) = (p = ¬q) := by
by_cases p <;> by_cases q <;> simp [*]
-- True
attribute [grind_norm] not_true
-- False
attribute [grind_norm] not_false_eq_true
-- Remark: we disabled the following normalization rule because we want this information when implementing splitting heuristics
-- Implication as a clause
theorem imp_eq (p q : Prop) : (p q) = (¬ p q) := by
by_cases p <;> by_cases q <;> simp [*]
-- And
@[grind_norm] theorem not_and (p q : Prop) : (¬(p q)) = (¬p ¬q) := by
theorem true_imp_eq (p : Prop) : (True p) = p := by simp
theorem false_imp_eq (p : Prop) : (False p) = True := by simp
theorem imp_true_eq (p : Prop) : (p True) = True := by simp
theorem imp_false_eq (p : Prop) : (p False) = ¬p := by simp
theorem imp_self_eq (p : Prop) : (p p) = True := by simp
theorem not_and (p q : Prop) : (¬(p q)) = (¬p ¬q) := by
by_cases p <;> by_cases q <;> simp [*]
attribute [grind_norm] and_true true_and and_false false_and and_assoc
-- Or
attribute [grind_norm] not_or
attribute [grind_norm] or_true true_or or_false false_or or_assoc
-- ite
attribute [grind_norm] ite_true ite_false
@[grind_norm] theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
theorem not_ite {_ : Decidable p} (q r : Prop) : (¬ite p q r) = ite p (¬q) (¬r) := by
by_cases p <;> simp [*]
@[grind_norm] theorem ite_true_false {_ : Decidable p} : (ite p True False) = p := by
theorem ite_true_false {_ : Decidable p} : (ite p True False) = p := by
by_cases p <;> simp
@[grind_norm] theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
theorem ite_false_true {_ : Decidable p} : (ite p False True) = ¬p := by
by_cases p <;> simp
-- Forall
@[grind_norm] theorem not_forall (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] forall_and
theorem not_forall (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
-- Exists
@[grind_norm] theorem not_exists (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
attribute [grind_norm] exists_const exists_or exists_prop exists_and_left exists_and_right
theorem not_exists (p : α Prop) : (¬ x, p x) = x, ¬p x := by simp
-- Bool cond
@[grind_norm] theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
theorem cond_eq_ite (c : Bool) (a b : α) : cond c a b = ite c a b := by
cases c <;> simp [*]
-- Bool or
attribute [grind_norm]
Bool.or_false Bool.or_true Bool.false_or Bool.true_or Bool.or_eq_true Bool.or_assoc
-- Bool and
attribute [grind_norm]
Bool.and_false Bool.and_true Bool.false_and Bool.true_and Bool.and_eq_true Bool.and_assoc
-- Bool not
attribute [grind_norm]
Bool.not_not
-- beq
attribute [grind_norm] beq_iff_eq
-- bne
attribute [grind_norm] bne_iff_ne
-- Bool not eq true/false
attribute [grind_norm] Bool.not_eq_true Bool.not_eq_false
-- decide
attribute [grind_norm] decide_eq_true_eq decide_not not_decide_eq_true
-- Nat LE
attribute [grind_norm] Nat.le_zero_eq
-- Nat/Int LT
@[grind_norm] theorem Nat.lt_eq (a b : Nat) : (a < b) = (a + 1 b) := by
theorem Nat.lt_eq (a b : Nat) : (a < b) = (a + 1 b) := by
simp [Nat.lt, LT.lt]
@[grind_norm] theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 b) := by
theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 b) := by
simp [Int.lt, LT.lt]
-- GT GE
attribute [grind_norm] GT.gt GE.ge
theorem ge_eq [LE α] (a b : α) : (a b) = (b a) := rfl
theorem gt_eq [LT α] (a b : α) : (a > b) = (b < a) := rfl
-- Succ
attribute [grind_norm] Nat.succ_eq_add_one
init_grind_norm
/- Pre theorems -/
not_and not_or not_ite not_forall not_exists
|
/- Post theorems -/
Classical.not_not
ne_eq iff_eq eq_self heq_eq_eq
-- Prop equality
eq_true_eq eq_false_eq not_eq_prop
-- True
not_true
-- False
not_false_eq_true
-- Implication
true_imp_eq false_imp_eq imp_true_eq imp_false_eq imp_self_eq
-- And
and_true true_and and_false false_and and_assoc
-- Or
or_true true_or or_false false_or or_assoc
-- ite
ite_true ite_false ite_true_false ite_false_true
-- Forall
forall_and
-- Exists
exists_const exists_or exists_prop exists_and_left exists_and_right
-- Bool cond
cond_eq_ite
-- Bool or
Bool.or_false Bool.or_true Bool.false_or Bool.true_or Bool.or_eq_true Bool.or_assoc
-- Bool and
Bool.and_false Bool.and_true Bool.false_and Bool.true_and Bool.and_eq_true Bool.and_assoc
-- Bool not
Bool.not_not
-- beq
beq_iff_eq
-- bne
bne_iff_ne
-- Bool not eq true/false
Bool.not_eq_true Bool.not_eq_false
-- decide
decide_eq_true_eq decide_not not_decide_eq_true
-- Nat LE
Nat.le_zero_eq
-- Nat/Int LT
Nat.lt_eq
-- Nat.succ
Nat.succ_eq_add_one
-- Int
Int.lt_eq
-- GT GE
ge_eq gt_eq
end Lean.Grind

View File

@@ -7,159 +7,86 @@ prelude
import Init.Core
import Init.Omega
namespace Lean.Grind.Offset
namespace Lean.Grind
abbrev isLt (x y : Nat) : Bool := x < y
abbrev isLE (x y : Nat) : Bool := x y
abbrev Var := Nat
abbrev Context := Lean.RArray Nat
/-! Theorems for transitivity. -/
theorem Nat.le_ro (u w v k : Nat) : u w w v + k u v + k := by
omega
theorem Nat.le_lo (u w v k : Nat) : u w w + k v u + k v := by
omega
theorem Nat.lo_le (u w v k : Nat) : u + k w w v u + k v := by
omega
theorem Nat.lo_lo (u w v k₁ k₂ : Nat) : u + k₁ w w + k₂ v u + (k₁ + k₂) v := by
omega
theorem Nat.lo_ro_1 (u w v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ w w v + k₂ u + (k₁ - k₂) v := by
simp [isLt]; omega
theorem Nat.lo_ro_2 (u w v k₁ k₂ : Nat) : u + k₁ w w v + k₂ u v + (k₂ - k₁) := by
omega
theorem Nat.ro_le (u w v k : Nat) : u w + k w v u v + k := by
omega
theorem Nat.ro_lo_1 (u w v k₁ k₂ : Nat) : u w + k₁ w + k₂ v u v + (k₁ - k₂) := by
omega
theorem Nat.ro_lo_2 (u w v k₁ k₂ : Nat) : isLt k₁ k₂ = true u w + k₁ w + k₂ v u + (k₂ - k₁) v := by
simp [isLt]; omega
theorem Nat.ro_ro (u w v k₁ k₂ : Nat) : u w + k₁ w v + k₂ u v + (k₁ + k₂) := by
omega
def fixedVar := 100000000 -- Any big number should work here
/-! Theorems for negating constraints. -/
theorem Nat.of_le_eq_false (u v : Nat) : ((u v) = False) v + 1 u := by
simp; omega
theorem Nat.of_lo_eq_false_1 (u v : Nat) : ((u + 1 v) = False) v u := by
simp; omega
theorem Nat.of_lo_eq_false (u v k : Nat) : ((u + k v) = False) v u + (k-1) := by
simp; omega
theorem Nat.of_ro_eq_false (u v k : Nat) : ((u v + k) = False) v + (k+1) u := by
simp; omega
def Var.denote (ctx : Context) (v : Var) : Nat :=
bif v == fixedVar then 1 else ctx.get v
/-! Theorems for closing a goal. -/
theorem Nat.unsat_le_lo (u v k : Nat) : isLt 0 k = true u v v + k u False := by
simp [isLt]; omega
theorem Nat.unsat_lo_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true u + k₁ v v + k₂ u False := by
simp [isLt]; omega
theorem Nat.unsat_lo_ro (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ v v u + k₂ False := by
simp [isLt]; omega
structure Cnstr where
x : Var
y : Var
k : Nat := 0
l : Bool := true
deriving Repr, DecidableEq, Inhabited
/-! Theorems for propagating constraints to `True` -/
theorem Nat.lo_eq_true_of_lo (u v k₁ k₂ : Nat) : isLE k₂ k₁ = true u + k₁ v (u + k₂ v) = True :=
by simp [isLt]; omega
theorem Nat.le_eq_true_of_lo (u v k : Nat) : u + k v (u v) = True :=
by simp; omega
theorem Nat.le_eq_true_of_le (u v : Nat) : u v (u v) = True :=
by simp
theorem Nat.ro_eq_true_of_lo (u v k₁ k₂ : Nat) : u + k₁ v (u v + k₂) = True :=
by simp; omega
theorem Nat.ro_eq_true_of_le (u v k : Nat) : u v (u v + k) = True :=
by simp; omega
theorem Nat.ro_eq_true_of_ro (u v k₁ k₂ : Nat) : isLE k₁ k₂ = true u v + k₁ (u v + k₂) = True :=
by simp [isLE]; omega
def Cnstr.denote (c : Cnstr) (ctx : Context) : Prop :=
if c.l then
c.x.denote ctx + c.k c.y.denote ctx
else
c.x.denote ctx c.y.denote ctx + c.k
/-!
Theorems for propagating constraints to `False`.
They are variants of the theorems for closing a goal.
-/
theorem Nat.lo_eq_false_of_le (u v k : Nat) : isLt 0 k = true u v (v + k u) = False := by
simp [isLt]; omega
theorem Nat.le_eq_false_of_lo (u v k : Nat) : isLt 0 k = true u + k v (v u) = False := by
simp [isLt]; omega
theorem Nat.lo_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt 0 (k₁+k₂) = true u + k₁ v (v + k₂ u) = False := by
simp [isLt]; omega
theorem Nat.ro_eq_false_of_lo (u v k₁ k₂ : Nat) : isLt k₂ k₁ = true u + k₁ v (v u + k₂) = False := by
simp [isLt]; omega
theorem Nat.lo_eq_false_of_ro (u v k₁ k₂ : Nat) : isLt k₁ k₂ = true u v + k₁ (v + k₂ u) = False := by
simp [isLt]; omega
def trivialCnstr : Cnstr := { x := 0, y := 0, k := 0, l := true }
/-!
Helper theorems for equality propagation
-/
@[simp] theorem denote_trivial (ctx : Context) : trivialCnstr.denote ctx := by
simp [Cnstr.denote, trivialCnstr]
theorem Nat.le_of_eq_1 (u v : Nat) : u = v u v := by omega
theorem Nat.le_of_eq_2 (u v : Nat) : u = v v u := by omega
theorem Nat.eq_of_le_of_le (u v : Nat) : u v v u u = v := by omega
theorem Nat.le_offset (a k : Nat) : k a + k := by omega
def Cnstr.trans (c₁ c₂ : Cnstr) : Cnstr :=
if c₁.y = c₂.x then
let { x, k := k₁, l := l₁, .. } := c₁
let { y, k := k₂, l := l₂, .. } := c₂
match l₁, l₂ with
| false, false =>
{ x, y, k := k₁ + k₂, l := false }
| false, true =>
if k₁ < k₂ then
{ x, y, k := k₂ - k₁, l := true }
else
{ x, y, k := k₁ - k₂, l := false }
| true, false =>
if k₁ < k₂ then
{ x, y, k := k₂ - k₁, l := false }
else
{ x, y, k := k₁ - k₂, l := true }
| true, true =>
{ x, y, k := k₁ + k₂, l := true }
else
trivialCnstr
@[simp] theorem Cnstr.denote_trans_easy (ctx : Context) (c₁ c₂ : Cnstr) (h : c₁.y c₂.x) : (c₁.trans c₂).denote ctx := by
simp [*, Cnstr.trans]
@[simp] theorem Cnstr.denote_trans (ctx : Context) (c₁ c₂ : Cnstr) : c₁.denote ctx c₂.denote ctx (c₁.trans c₂).denote ctx := by
by_cases c₁.y = c₂.x
case neg => simp [*]
simp [trans, *]
let { x, k := k₁, l := l₁, .. } := c₁
let { y, k := k₂, l := l₂, .. } := c₂
simp_all; split
· simp [denote]; omega
· split <;> simp [denote] <;> omega
· split <;> simp [denote] <;> omega
· simp [denote]; omega
def Cnstr.isTrivial (c : Cnstr) : Bool := c.x == c.y && c.k == 0
theorem Cnstr.of_isTrivial (ctx : Context) (c : Cnstr) : c.isTrivial = true c.denote ctx := by
cases c; simp [isTrivial]; intros; simp [*, denote]
def Cnstr.isFalse (c : Cnstr) : Bool := c.x == c.y && c.k != 0 && c.l == true
theorem Cnstr.of_isFalse (ctx : Context) {c : Cnstr} : c.isFalse = true ¬c.denote ctx := by
cases c; simp [isFalse]; intros; simp [*, denote]; omega
def Cnstrs := List Cnstr
def Cnstrs.denoteAnd' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : Prop :=
match c₂ with
| [] => c₁.denote ctx
| c::cs => c₁.denote ctx Cnstrs.denoteAnd' ctx c cs
theorem Cnstrs.denote'_trans (ctx : Context) (c₁ c : Cnstr) (cs : Cnstrs) : c₁.denote ctx denoteAnd' ctx c cs denoteAnd' ctx (c₁.trans c) cs := by
induction cs
next => simp [denoteAnd', *]; apply Cnstr.denote_trans
next c cs ih => simp [denoteAnd']; intros; simp [*]
def Cnstrs.trans' (c₁ : Cnstr) (c₂ : Cnstrs) : Cnstr :=
match c₂ with
| [] => c₁
| c::c₂ => trans' (c₁.trans c) c₂
@[simp] theorem Cnstrs.denote'_trans' (ctx : Context) (c₁ : Cnstr) (c₂ : Cnstrs) : denoteAnd' ctx c₁ c₂ (trans' c₁ c₂).denote ctx := by
induction c₂ generalizing c₁
next => intros; simp_all [trans', denoteAnd']
next c cs ih => simp [denoteAnd']; intros; simp [trans']; apply ih; apply denote'_trans <;> assumption
def Cnstrs.denoteAnd (ctx : Context) (c : Cnstrs) : Prop :=
match c with
| [] => True
| c::cs => denoteAnd' ctx c cs
def Cnstrs.trans (c : Cnstrs) : Cnstr :=
match c with
| [] => trivialCnstr
| c::cs => trans' c cs
theorem Cnstrs.of_denoteAnd_trans {ctx : Context} {c : Cnstrs} : c.denoteAnd ctx c.trans.denote ctx := by
cases c <;> simp [*, trans, denoteAnd] <;> intros <;> simp [*]
def Cnstrs.isFalse (c : Cnstrs) : Bool :=
c.trans.isFalse
theorem Cnstrs.unsat' (ctx : Context) (c : Cnstrs) : c.isFalse = true ¬ c.denoteAnd ctx := by
simp [isFalse]; intro h₁ h₂
have := of_denoteAnd_trans h₂
have := Cnstr.of_isFalse ctx h₁
contradiction
/-- `denote ctx [c_1, ..., c_n] C` is `c_1.denote ctx → ... → c_n.denote ctx → C` -/
def Cnstrs.denote (ctx : Context) (cs : Cnstrs) (C : Prop) : Prop :=
match cs with
| [] => C
| c::cs => c.denote ctx denote ctx cs C
theorem Cnstrs.not_denoteAnd'_eq (ctx : Context) (c : Cnstr) (cs : Cnstrs) (C : Prop) : (denoteAnd' ctx c cs C) = denote ctx (c::cs) C := by
simp [denote]
induction cs generalizing c
next => simp [denoteAnd', denote]
next c' cs ih =>
simp [denoteAnd', denote, *]
theorem Cnstrs.not_denoteAnd_eq (ctx : Context) (cs : Cnstrs) (C : Prop) : (denoteAnd ctx cs C) = denote ctx cs C := by
cases cs
next => simp [denoteAnd, denote]
next c cs => apply not_denoteAnd'_eq
def Cnstr.isImpliedBy (cs : Cnstrs) (c : Cnstr) : Bool :=
cs.trans == c
/-! Main theorems used by `grind`. -/
/-- Auxiliary theorem used by `grind` to prove that a system of offset inequalities is unsatisfiable. -/
theorem Cnstrs.unsat (ctx : Context) (cs : Cnstrs) : cs.isFalse = true cs.denote ctx False := by
intro h
rw [ not_denoteAnd_eq]
apply unsat'
assumption
/-- Auxiliary theorem used by `grind` to prove an implied offset inequality. -/
theorem Cnstrs.imp (ctx : Context) (cs : Cnstrs) (c : Cnstr) (h : c.isImpliedBy cs = true) : cs.denote ctx (c.denote ctx) := by
rw [ eq_of_beq h]
rw [ not_denoteAnd_eq]
apply of_denoteAnd_trans
end Lean.Grind.Offset
end Lean.Grind

30
src/Init/Grind/PP.lean Normal file
View File

@@ -0,0 +1,30 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.NotationExtra
namespace Lean.Grind
/-!
This is a hackish module for hovering node information in the `grind` tactic state.
-/
inductive NodeDef where
| unit
set_option linter.unusedVariables false in
def node_def (_ : Nat) {α : Sort u} {a : α} : NodeDef := .unit
@[app_unexpander node_def]
def nodeDefUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $id:num) => return mkIdent <| Name.mkSimple $ "#" ++ toString id.getNat
| _ => throw ()
@[app_unexpander NodeDef]
def NodeDefUnexpander : PrettyPrinter.Unexpander := fun _ => do
return mkIdent <| Name.mkSimple "NodeDef"
end Lean.Grind

View File

@@ -14,7 +14,9 @@ syntax grindEqRhs := atomic("=" "_")
syntax grindBwd := ""
syntax grindFwd := ""
syntax (name := grind) "grind" (grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd)? : attr
syntax grindThmMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindBwd <|> grindFwd
syntax (name := grind) "grind" (grindThmMod)? : attr
end Lean.Parser.Attr
@@ -25,7 +27,7 @@ Passed to `grind` using, for example, the `grind (config := { matchEqs := true }
-/
structure Config where
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
splits : Nat := 5
splits : Nat := 8
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
ematch : Nat := 5
/--
@@ -45,6 +47,12 @@ structure Config where
If `splitIndPred` is `true`, `grind` performs case-splitting on inductive predicates.
Otherwise, it performs case-splitting only on types marked with `[grind_split]` attribute. -/
splitIndPred : Bool := true
/-- By default, `grind` halts as soon as it encounters a sub-goal where no further progress can be made. -/
failures : Nat := 1
/-- Maximum number of heartbeats (in thousands) the canonicalizer can spend per definitional equality test. -/
canonHeartbeats : Nat := 1000
/-- If `ext` is `true`, `grind` uses extensionality theorems available in the environment. -/
ext : Bool := true
deriving Inhabited, BEq
end Lean.Grind
@@ -55,7 +63,13 @@ namespace Lean.Parser.Tactic
`grind` tactic and related tactics.
-/
-- TODO: parameters
syntax (name := grind) "grind" optConfig ("on_failure " term)? : tactic
syntax grindErase := "-" ident
syntax grindLemma := (Attr.grindThmMod)? ident
syntax grindParam := grindErase <|> grindLemma
syntax (name := grind)
"grind" optConfig (&" only")?
(" [" withoutPosition(grindParam,*) "]")?
("on_failure " term)? : tactic
end Lean.Parser.Tactic

View File

@@ -9,7 +9,7 @@ import Init.Core
namespace Lean.Grind
/-- A helper gadget for annotating nested proofs in goals. -/
def nestedProof (p : Prop) (h : p) : p := h
def nestedProof (p : Prop) {h : p} : p := h
/--
Gadget for marking terms that should not be normalized by `grind`s simplifier.
@@ -28,7 +28,7 @@ When `EqMatch a b origin` is `True`, we mark `origin` as a resolved case-split.
-/
def EqMatch (a b : α) {_origin : α} : Prop := a = b
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (nestedProof p hp) (nestedProof q hq) := by
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
subst h; apply HEq.refl
end Lean.Grind

View File

@@ -150,6 +150,9 @@ It can also be written as `()`.
/-- Marker for information that has been erased by the code generator. -/
unsafe axiom lcErased : Type
/-- Marker for type dependency that has been erased by the code generator. -/
unsafe axiom lcAny : Type
/--
Auxiliary unsafe constant used by the Compiler when erasing proofs from code.

View File

@@ -1648,17 +1648,6 @@ If there are several with the same priority, it is uses the "most recent one". E
-/
syntax (name := simp) "simp" (Tactic.simpPre <|> Tactic.simpPost)? patternIgnore("" <|> "<- ")? (ppSpace prio)? : attr
/--
Theorems tagged with the `grind_norm` attribute are used by the `grind` tactic normalizer/pre-processor.
-/
syntax (name := grind_norm) "grind_norm" (Tactic.simpPre <|> Tactic.simpPost)? (ppSpace prio)? : attr
/--
Simplification procedures tagged with the `grind_norm_proc` attribute are used by the `grind` tactic normalizer/pre-processor.
-/
syntax (name := grind_norm_proc) "grind_norm_proc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
/-- The possible `norm_cast` kinds: `elim`, `move`, or `squash`. -/
syntax normCastLabel := &"elim" <|> &"move" <|> &"squash"

View File

@@ -14,26 +14,54 @@ register_builtin_option debug.skipKernelTC : Bool := {
descr := "skip kernel type checker. WARNING: setting this option to true may compromise soundness because your proofs will not be checked by the Lean kernel"
}
def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment :=
/-- Adds given declaration to the environment, respecting `debug.skipKernelTC`. -/
def Kernel.Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except Exception Environment :=
if debug.skipKernelTC.get opts then
addDeclWithoutChecking env decl
else
addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl cancelTk?
def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except KernelException Environment := do
let env addDecl env opts decl cancelTk?
compileDecl env opts decl
private def Environment.addDeclAux (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
env.addDeclCore (Core.getMaxHeartbeats opts).toUSize decl cancelTk? (!debug.skipKernelTC.get opts)
@[deprecated "use `Lean.addDecl` instead to ensure new namespaces are registered" (since := "2024-12-03")]
def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration)
(cancelTk? : Option IO.CancelToken := none) : Except Kernel.Exception Environment :=
Environment.addDeclAux env opts decl cancelTk?
private def isNamespaceName : Name Bool
| .str .anonymous _ => true
| .str p _ => isNamespaceName p
| _ => false
private def registerNamePrefixes (env : Environment) (name : Name) : Environment :=
match name with
| .str _ s =>
if s.get 0 == '_' then
-- Do not register namespaces that only contain internal declarations.
env
else
go env name
| _ => env
where go env
| .str p _ => if isNamespaceName p then go (env.registerNamespace p) p else env
| _ => env
def addDecl (decl : Declaration) : CoreM Unit := do
profileitM Exception "type checking" ( getOptions) do
withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
let mut env withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do
if !( MonadLog.hasErrors) && decl.hasSorry then
logWarning "declaration uses 'sorry'"
match ( getEnv).addDecl ( getOptions) decl ( read).cancelTk? with
| .ok env => setEnv env
| .error ex => throwKernelException ex
( getEnv).addDeclAux ( getOptions) decl ( read).cancelTk? |> ofExceptKernelException
-- register namespaces for newly added constants; this used to be done by the kernel itself
-- but that is incompatible with moving it to a separate task
env := decl.getNames.foldl registerNamePrefixes env
if let .inductDecl _ _ types _ := decl then
env := types.foldl (registerNamePrefixes · <| ·.name ++ `rec) env
setEnv env
def addAndCompile (decl : Declaration) : CoreM Unit := do
addDecl decl

View File

@@ -144,11 +144,7 @@ def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
let type := mkApp (mkConst `IO) (mkConst `Unit)
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
safety := DefinitionSafety.safe }
match ( getEnv).addAndCompile {} decl with
-- TODO: pretty print error
| Except.error e => do
let msg (e.toMessageData {}).toString
throwError "failed to emit registration code for builtin '{forDecl}': {msg}"
| Except.ok env => IO.ofExcept (setBuiltinInitAttr env name) >>= setEnv
addAndCompile decl
IO.ofExcept (setBuiltinInitAttr ( getEnv) name) >>= setEnv
end Lean

View File

@@ -74,8 +74,6 @@ partial def toMonoType (type : Expr) : CoreM Expr := do
let type := type.headBeta
if type.isErased then
return erasedExpr
else if type.isErased then
return erasedExpr
else if isTypeFormerType type then
return erasedExpr
else match type with

View File

@@ -150,18 +150,7 @@ where
def toMono : Pass where
name := `toMono
run := fun decls => do
let decls decls.filterM fun decl => do
if hasLocalInst decl.type then
/-
Declaration is a "template" for the code specialization pass.
So, we should delete it before going to next phase.
-/
decl.erase
return false
else
return true
decls.mapM (·.toMono)
run := (·.mapM (·.toMono))
phase := .base
phaseOut := .mono

View File

@@ -53,18 +53,3 @@ def isUnsafeRecName? : Name → Option Name
| _ => none
end Compiler
namespace Environment
/--
Compile the given block of mutual declarations.
Assumes the declarations have already been added to the environment using `addDecl`.
-/
@[extern "lean_compile_decls"]
opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name) : Except KernelException Environment
/-- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment :=
compileDecls env opt (Compiler.getDeclNamesForCodeGen decl)
end Environment

View File

@@ -514,16 +514,19 @@ register_builtin_option compiler.enableNew : Bool := {
@[extern "lean_lcnf_compile_decls"]
opaque compileDeclsNew (declNames : List Name) : CoreM Unit
@[extern "lean_compile_decls"]
opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List Name) : Except Kernel.Exception Environment
def compileDecl (decl : Declaration) : CoreM Unit := do
let opts getOptions
let decls := Compiler.getDeclNamesForCodeGen decl
if compiler.enableNew.get opts then
compileDeclsNew decls
let res withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
return ( getEnv).compileDecl opts decl
return compileDeclsOld ( getEnv) opts decls
match res with
| Except.ok env => setEnv env
| Except.error (KernelException.other msg) =>
| Except.error (.other msg) =>
checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
throwError msg
| Except.error ex =>
@@ -533,9 +536,9 @@ def compileDecls (decls : List Name) : CoreM Unit := do
let opts getOptions
if compiler.enableNew.get opts then
compileDeclsNew decls
match ( getEnv).compileDecls opts decls with
match compileDeclsOld ( getEnv) opts decls with
| Except.ok env => setEnv env
| Except.error (KernelException.other msg) =>
| Except.error (.other msg) =>
throwError msg
| Except.error ex =>
throwKernelException ex

View File

@@ -24,7 +24,7 @@ abbrev empty : AssocList α β :=
instance : EmptyCollection (AssocList α β) := empty
abbrev insert (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
abbrev insertNew (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
m.cons k v
def isEmpty : AssocList α β Bool
@@ -77,6 +77,12 @@ def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β
| true => cons a b es
| false => cons k v (replace a b es)
def insert [BEq α] (m : AssocList α β) (k : α) (v : β) : AssocList α β :=
if m.contains k then
m.replace k v
else
m.insertNew k v
def erase [BEq α] (a : α) : AssocList α β AssocList α β
| nil => nil
| cons k v es => match k == a with

View File

@@ -54,6 +54,10 @@ instance : EmptyCollection (NameTrie β) where
def NameTrie.find? (t : NameTrie β) (k : Name) : Option β :=
PrefixTree.find? t (toKey k)
@[inline, inherit_doc PrefixTree.findLongestPrefix?]
def NameTrie.findLongestPrefix? (t : NameTrie β) (k : Name) : Option β :=
PrefixTree.findLongestPrefix? t (toKey k)
@[inline]
def NameTrie.foldMatchingM [Monad m] (t : NameTrie β) (k : Name) (init : σ) (f : β σ m σ) : m σ :=
PrefixTree.foldMatchingM t (toKey k) init f

View File

@@ -48,6 +48,17 @@ partial def find? (t : PrefixTreeNode α β) (cmp : αα → Ordering) (k :
| some t => loop t ks
loop t k
/-- Returns the the value of the longest key in `t` that is a prefix of `k`, if any. -/
@[specialize]
partial def findLongestPrefix? (t : PrefixTreeNode α β) (cmp : α α Ordering) (k : List α) : Option β :=
let rec loop acc?
| PrefixTreeNode.Node val _, [] => val <|> acc?
| PrefixTreeNode.Node val m, k :: ks =>
match RBNode.find cmp m k with
| none => val
| some t => loop (val <|> acc?) t ks
loop none t k
@[specialize]
partial def foldMatchingM [Monad m] (t : PrefixTreeNode α β) (cmp : α α Ordering) (k : List α) (init : σ) (f : β σ m σ) : m σ :=
let rec fold : PrefixTreeNode α β σ m σ
@@ -92,6 +103,10 @@ def PrefixTree.insert (t : PrefixTree α β p) (k : List α) (v : β) : PrefixTr
def PrefixTree.find? (t : PrefixTree α β p) (k : List α) : Option β :=
t.val.find? p k
@[inline, inherit_doc PrefixTreeNode.findLongestPrefix?]
def PrefixTree.findLongestPrefix? (t : PrefixTree α β p) (k : List α) : Option β :=
t.val.findLongestPrefix? p k
@[inline]
def PrefixTree.foldMatchingM [Monad m] (t : PrefixTree α β p) (k : List α) (init : σ) (f : β σ m σ) : m σ :=
t.val.foldMatchingM p k init f

View File

@@ -193,6 +193,19 @@ def Declaration.definitionVal! : Declaration → DefinitionVal
| .defnDecl val => val
| _ => panic! "Expected a `Declaration.defnDecl`."
/--
Returns all top-level names to be defined by adding this declaration to the environment. This does
not include auxiliary definitions such as projections.
-/
def Declaration.getNames : Declaration List Name
| .axiomDecl val => [val.name]
| .defnDecl val => [val.name]
| .thmDecl val => [val.name]
| .opaqueDecl val => [val.name]
| .quotDecl => [``Quot, ``Quot.mk, ``Quot.lift, ``Quot.ind]
| .mutualDefnDecl defns => defns.map (·.name)
| .inductDecl _ _ types _ => types.map (·.name)
@[specialize] def Declaration.foldExprM {α} {m : Type Type} [Monad m] (d : Declaration) (f : α Expr m α) (a : α) : m α :=
match d with
| .quotDecl => pure a
@@ -469,6 +482,10 @@ def isInductive : ConstantInfo → Bool
| .inductInfo _ => true
| _ => false
def isDefinition : ConstantInfo Bool
| .defnInfo _ => true
| _ => false
def isTheorem : ConstantInfo Bool
| .thmInfo _ => true
| _ => false

View File

@@ -1474,7 +1474,7 @@ where
| field::fields, false => .fieldName field field.getId.getString! none fIdent :: toLVals fields false
/-- Resolve `(.$id:ident)` using the expected type to infer namespace. -/
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Name := do
private partial def resolveDotName (id : Syntax) (expectedType? : Option Expr) : TermElabM Expr := do
tryPostponeIfNoneOrMVar expectedType?
let some expectedType := expectedType?
| throwError "invalid dotted identifier notation, expected type must be known"
@@ -1489,7 +1489,7 @@ where
withForallBody body k
else
k body
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Name := do
go (resultType : Expr) (expectedType : Expr) (previousExceptions : Array Exception) : TermElabM Expr := do
let resultType instantiateMVars resultType
let resultTypeFn := resultType.cleanupAnnotations.getAppFn
try
@@ -1497,9 +1497,12 @@ where
let .const declName .. := resultTypeFn.cleanupAnnotations
| throwError "invalid dotted identifier notation, expected type is not of the form (... → C ...) where C is a constant{indentExpr expectedType}"
let idNew := declName ++ id.getId.eraseMacroScopes
unless ( getEnv).contains idNew do
if ( getEnv).contains idNew then
mkConst idNew
else if let some (fvar, []) resolveLocalName idNew then
return fvar
else
throwError "invalid dotted identifier notation, unknown identifier `{idNew}` from expected type{indentExpr expectedType}"
return idNew
catch
| ex@(.error ..) =>
match ( unfoldDefinition? resultType) with
@@ -1548,7 +1551,7 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
| `(_) => throwError "placeholders '_' cannot be used where a function is expected"
| `(.$id:ident) =>
addCompletionInfo <| CompletionInfo.dotId f id.getId ( getLCtx) expectedType?
let fConst mkConst ( resolveDotName id expectedType?)
let fConst resolveDotName id expectedType?
let s observing do
-- Use (force := true) because we want to record the result of .ident resolution even in patterns
let fConst addTermInfo f fConst expectedType? (force := true)

View File

@@ -124,9 +124,7 @@ private partial def elabChoiceAux (cmds : Array Syntax) (i : Nat) : CommandElabM
n[1].forArgsM addUnivLevel
@[builtin_command_elab «init_quot»] def elabInitQuot : CommandElab := fun _ => do
match ( getEnv).addDecl ( getOptions) Declaration.quotDecl with
| Except.ok env => setEnv env
| Except.error ex => throwError (ex.toMessageData ( getOptions))
liftCoreM <| addDecl Declaration.quotDecl
@[builtin_command_elab «export»] def elabExport : CommandElab := fun stx => do
let `(export $ns ($ids*)) := stx | throwUnsupportedSyntax
@@ -294,7 +292,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
modify fun s => { s with messages := {} };
pure messages
let restoreMessages (prevMessages : MessageLog) : CommandElabM Unit := do
modify fun s => { s with messages := prevMessages ++ s.messages.errorsToWarnings }
modify fun s => { s with messages := prevMessages ++ s.messages.errorsToInfos }
let prevMessages resetMessages
let succeeded try
x

View File

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura, Sebastian Ullrich
-/
prelude
import Lean.Parser.Module
import Lean.Data.Json
import Lean.Util.Paths
namespace Lean.Elab
@@ -42,4 +42,12 @@ def printImports (input : String) (fileName : Option String) : IO Unit := do
let fname findOLean dep.module
IO.println fname
@[export lean_print_import_srcs]
def printImportSrcs (input : String) (fileName : Option String) : IO Unit := do
let sp initSrcSearchPath
let (deps, _, _) parseImports input fileName
for dep in deps do
let fname findLean sp dep.module
IO.println fname
end Lean.Elab

View File

@@ -681,7 +681,7 @@ private partial def checkResultingUniversesForFields (fieldInfos : Array StructF
throwErrorAt info.ref msg
@[extern "lean_mk_projections"]
private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except KernelException Environment
private opaque mkProjections (env : Environment) (structName : Name) (projs : List Name) (isClass : Bool) : Except Kernel.Exception Environment
private def addProjections (r : ElabHeaderResult) (fieldInfos : Array StructFieldInfo) : TermElabM Unit := do
if r.type.isProp then

View File

@@ -38,6 +38,9 @@ declare_config_elab elabBVDecideConfig Lean.Elab.Tactic.BVDecide.Frontend.BVDeci
builtin_initialize bvNormalizeExt : Meta.SimpExtension
Meta.registerSimpAttr `bv_normalize "simp theorems used by bv_normalize"
builtin_initialize intToBitVecExt : Meta.SimpExtension
Meta.registerSimpAttr `int_toBitVec "simp theorems used to convert UIntX/IntX statements into BitVec ones"
/-- Builtin `bv_normalize` simprocs. -/
builtin_initialize builtinBVNormalizeSimprocsRef : IO.Ref Meta.Simp.Simprocs IO.mkRef {}

View File

@@ -4,342 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
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
import Std.Tactic.BVDecide.Normalize
import Std.Tactic.BVDecide.Syntax
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Simproc
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Rewrite
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
/-!
This module contains the implementation of `bv_normalize` which is effectively a custom `bv_normalize`
simp set that is called like this: `simp only [seval, bv_normalize]`. The rules in `bv_normalize`
fulfill two goals:
1. Turn all hypothesis involving `Bool` and `BitVec` into the form `x = true` where `x` only consists
of a operations on `Bool` and `BitVec`. In particular no `Prop` should be contained. This makes
the reflection procedure further down the pipeline much easier to implement.
2. Apply simplification rules from the Bitwuzla SMT solver.
This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
It is in essence a (slightly reduced) version of the Bitwuzla preprocessor together with Lean
specific details.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
open Std.Tactic.BVDecide.Normalize
builtin_simproc [bv_normalize] reduceCond (cond _ _ _) := fun e => do
let_expr f@cond α c tb eb := e | return .continue
let r Simp.simp c
if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := tb, proof? := pr }
else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := eb, proof? := pr }
else
return .continue
builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
let_expr Eq _ lhs rhs := e | return .continue
match_expr rhs with
| Bool.true => return .continue
| _ =>
let beqApp mkAppM ``BEq.beq #[lhs, rhs]
let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
return .done { expr := new, proof? := some proof }
builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, rhsValue getBitVecValue? rhs | return .continue
if rhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
return .visit { expr := lhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
return .visit { expr := rhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
let_expr BitVec.ult _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
return .visit { expr := toExpr Bool.false, proof? := some proof }
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
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
/-- Return a number `k` such that `2^k = n`. -/
private def Nat.log2Exact (n : Nat) : Option Nat := do
guard <| n 0
let k := n.log2
guard <| Nat.pow 2 k == n
return k
-- Build an expression for `x ^ y`.
def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
let some w, yVal getBitVecValue? y | return .continue
let n := yVal.toNat
-- BitVec.ofNat w n, where n =def= 2^k
let some k := Nat.log2Exact n | return .continue
-- check that k < w.
if k w then return .continue
let rhs mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
-- 2^k = n
let hk mkDecideProof ( mkEq ( mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
-- k < w
let hlt mkDecideProof ( mkLt (mkNatLit k) (mkNatLit w))
let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
#[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
return .done {
expr := rhs
proof? := some proof
}
/--
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
the goal fully, indicated by returning `none`.
-/
structure Pass where
name : Name
run : MVarId MetaM (Option MVarId)
namespace Pass
/--
Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
the goal anymore.
-/
partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : MetaM (Option MVarId) := do
let runPass (goal? : Option MVarId) (pass : Pass) : MetaM (Option MVarId) := do
let some goal := goal? | return none
withTraceNode `bv (fun _ => return s!"Running pass: {pass.name}") do
pass.run goal
let some newGoal := passes.foldlM (init := some goal) runPass | return none
if goal != newGoal then
trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
fixpointPipeline passes newGoal
else
trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
return newGoal
/--
Responsible for applying the Bitwuzla style rewrite rules.
-/
def rewriteRulesPass (maxSteps : Nat) : Pass where
name := `rewriteRules
run goal := do
let bvThms bvNormalizeExt.getTheorems
let bvSimprocs bvNormalizeSimprocExt.getSimprocs
let sevalThms getSEvalTheorems
let sevalSimprocs Simp.getSEvalSimprocs
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps })
(simpTheorems := #[bvThms, sevalThms])
(congrTheorems := ( getSimpCongrTheorems))
let hyps goal.getNondepPropHyps
let result?, _ simpGoal goal
(ctx := simpCtx)
(simprocs := #[bvSimprocs, sevalSimprocs])
(fvarIdsToSimp := hyps)
let some (_, newGoal) := result? | return none
return newGoal
/--
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
in embedded constraint substitution.
-/
partial def andFlatteningPass : Pass where
name := `andFlattening
run goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut newHyps := #[]
let mut oldHyps := #[]
for fvar in hyps do
let hyp : Hypothesis := {
userName := ( fvar.getDecl).userName
type := fvar.getType
value := mkFVar fvar
}
let sizeBefore := newHyps.size
newHyps splitAnds hyp newHyps
if newHyps.size > sizeBefore then
oldHyps := oldHyps.push fvar
if newHyps.size == 0 then
return goal
else
let (_, goal) goal.assertHypotheses newHyps
-- Given that we collected the hypotheses in the correct order above the invariant is given
let goal goal.tryClearMany oldHyps
return goal
where
splitAnds (hyp : Hypothesis) (hyps : Array Hypothesis) (first : Bool := true) :
MetaM (Array Hypothesis) := do
match trySplit hyp with
| some (left, right) =>
let hyps splitAnds left hyps false
splitAnds right hyps false
| none =>
if first then
return hyps
else
return hyps.push hyp
trySplit (hyp : Hypothesis) : MetaM (Option (Hypothesis × Hypothesis)) := do
let typ := hyp.type
let_expr Eq α eqLhs eqRhs := typ | return none
let_expr Bool.and lhs rhs := eqLhs | return none
let_expr Bool.true := eqRhs | return none
let_expr Bool := α | return none
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let leftHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
}
let rightHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
}
return some (leftHyp, rightHyp)
/--
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
them to substitute occurences of `x` within other hypotheses. Additionally this drops all
redundant top level hypotheses.
-/
def embeddedConstraintPass (maxSteps : Nat) : Pass where
name := `embeddedConstraintSubsitution
run goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut relevantHyps : SimpTheoremsArray := #[]
let mut seen : Std.HashSet Expr := {}
let mut duplicates : Array FVarId := #[]
for hyp in hyps do
let typ hyp.getType
let_expr Eq α lhs rhs := typ | continue
let_expr Bool.true := rhs | continue
let_expr Bool := α | continue
if seen.contains lhs then
-- collect and later remove duplicates on the fly
duplicates := duplicates.push hyp
else
seen := seen.insert lhs
let localDecl hyp.getDecl
let proof := localDecl.toExpr
relevantHyps relevantHyps.addTheorem (.fvar hyp) proof
let goal goal.tryClearMany duplicates
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, maxSteps })
(simpTheorems := relevantHyps)
(congrTheorems := ( getSimpCongrTheorems))
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := goal.getNondepPropHyps)
let some (_, newGoal) := result? | return none
return newGoal
/--
Normalize with respect to Associativity and Commutativity.
-/
def acNormalizePass : Pass where
name := `ac_nf
run 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
def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
let mut passPipeline := [rewriteRulesPass cfg.maxSteps]
def passPipeline : PreProcessM (List Pass) := do
let mut passPipeline := [rewriteRulesPass]
let cfg PreProcessM.getConfig
if cfg.acNf then
passPipeline := passPipeline ++ [acNormalizePass]
@@ -348,18 +34,20 @@ def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
passPipeline := passPipeline ++ [andFlatteningPass]
if cfg.embeddedConstraintSubst then
passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
passPipeline := passPipeline ++ [embeddedConstraintPass]
return passPipeline
end Pass
def bvNormalize (g : MVarId) (cfg : BVDecideConfig) : MetaM (Option MVarId) := do
withTraceNode `bv (fun _ => return "Normalizing goal") do
-- Contradiction proof
withTraceNode `bv (fun _ => return "Preprocessing goal") do
(go g).run cfg g
where
go (g : MVarId) : PreProcessM (Option MVarId) := do
let some g g.falseOrByContra | return none
trace[Meta.Tactic.bv] m!"Running preprocessing pipeline on:\n{g}"
Pass.fixpointPipeline (Pass.passPipeline cfg) g
let pipeline passPipeline
Pass.fixpointPipeline pipeline g
@[builtin_tactic Lean.Parser.Tactic.bvNormalize]
def evalBVNormalize : Tactic := fun

View File

@@ -0,0 +1,39 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.AC.Main
/-!
This module contains the implementation of the associativity and commutativity normalisation pass
in the fixpoint pipeline.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Normalize with respect to Associativity and Commutativity.
-/
def acNormalizePass : Pass where
name := `ac_nf
run' goal := do
let mut newGoal := goal
for hyp in ( goal.getNondepPropHyps) do
let result AC.acNfHypMeta newGoal hyp
if let .some nextGoal := result then
newGoal := nextGoal
else
return none
return newGoal
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -0,0 +1,99 @@
/-
Copyright (c) 2025 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.Normalize.Bool
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.Assert
/-!
This module contains the implementation of the and flattening pass in the fixpoint pipeline, taking
hypotheses of the form `h : x && y = true` and splitting them into `h1 : x = true` and
`h2 : y = true` recursively.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
structure AndFlattenState where
hypsToDelete : Array FVarId := #[]
hypsToAdd : Array Hypothesis := #[]
cache : Std.HashSet Expr := {}
/--
Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true` and replace them
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
in embedded constraint substitution.
-/
partial def andFlatteningPass : Pass where
name := `andFlattening
run' goal := do
let (_, { hypsToDelete, hypsToAdd, .. }) processGoal goal |>.run {}
if hypsToAdd.isEmpty then
return goal
else
let (_, goal) goal.assertHypotheses hypsToAdd
-- Given that we collected the hypotheses in the correct order above the invariant is given
let goal goal.tryClearMany hypsToDelete
return goal
where
processGoal (goal : MVarId) : StateRefT AndFlattenState MetaM Unit := do
goal.withContext do
let hyps goal.getNondepPropHyps
hyps.forM processFVar
processFVar (fvar : FVarId) : StateRefT AndFlattenState MetaM Unit := do
let type fvar.getType
if ( get).cache.contains type then
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
else
let hyp := {
userName := ( fvar.getDecl).userName
type := type
value := mkFVar fvar
}
let some (lhs, rhs) trySplit hyp | return ()
modify (fun s => { s with hypsToDelete := s.hypsToDelete.push fvar })
splitAnds [lhs, rhs]
splitAnds (worklist : List Hypothesis) : StateRefT AndFlattenState MetaM Unit := do
match worklist with
| [] => return ()
| hyp :: worklist =>
match trySplit hyp with
| some (left, right) => splitAnds <| left :: right :: worklist
| none =>
modify (fun s => { s with hypsToAdd := s.hypsToAdd.push hyp })
splitAnds worklist
trySplit (hyp : Hypothesis) :
StateRefT AndFlattenState MetaM (Option (Hypothesis × Hypothesis)) := do
let typ := hyp.type
if ( get).cache.contains typ then
return none
else
modify (fun s => { s with cache := s.cache.insert typ })
let_expr Eq _ eqLhs eqRhs := typ | return none
let_expr Bool.and lhs rhs := eqLhs | return none
let_expr Bool.true := eqRhs | return none
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let leftHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
}
let rightHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
}
return some (leftHyp, rightHyp)
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -0,0 +1,86 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Meta.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains the basic preprocessing pipeline framework for `bv_normalize`.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
structure PreProcessState where
/--
Contains `FVarId` that we already know are in `bv_normalize` simp normal form and thus don't
need to be processed again when we visit the next time.
-/
rewriteCache : Std.HashSet FVarId := {}
abbrev PreProcessM : Type Type := ReaderT BVDecideConfig <| StateRefT PreProcessState MetaM
namespace PreProcessM
def getConfig : PreProcessM BVDecideConfig := read
@[inline]
def checkRewritten (fvar : FVarId) : PreProcessM Bool := do
let val := ( get).rewriteCache.contains fvar
trace[Meta.Tactic.bv] m!"{mkFVar fvar} was already rewritten? {val}"
return val
@[inline]
def rewriteFinished (fvar : FVarId) : PreProcessM Unit := do
trace[Meta.Tactic.bv] m!"Adding {mkFVar fvar} to the rewritten set"
modify (fun s => { s with rewriteCache := s.rewriteCache.insert fvar })
def run (cfg : BVDecideConfig) (goal : MVarId) (x : PreProcessM α) : MetaM α := do
let hyps goal.getNondepPropHyps
ReaderT.run x cfg |>.run' { rewriteCache := Std.HashSet.empty hyps.size }
end PreProcessM
/--
A pass in the normalization pipeline. Takes the current goal and produces a refined one or closes
the goal fully, indicated by returning `none`.
-/
structure Pass where
name : Name
run' : MVarId PreProcessM (Option MVarId)
namespace Pass
def run (pass : Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
withTraceNode `bv (fun _ => return m!"Running pass: {pass.name} on\n{goal}") do
pass.run' goal
/--
Repeatedly run a list of `Pass` until they either close the goal or an iteration doesn't change
the goal anymore.
-/
partial def fixpointPipeline (passes : List Pass) (goal : MVarId) : PreProcessM (Option MVarId) := do
let mut newGoal := goal
for pass in passes do
if let some nextGoal pass.run newGoal then
newGoal := nextGoal
else
trace[Meta.Tactic.bv] "Fixpoint iteration solved the goal"
return none
if goal != newGoal then
trace[Meta.Tactic.bv] m!"Rerunning pipeline on:\n{newGoal}"
fixpointPipeline passes newGoal
else
trace[Meta.Tactic.bv] "Pipeline reached a fixpoint"
return newGoal
end Pass
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -0,0 +1,62 @@
/-
Copyright (c) 2025 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.Normalize.Bool
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.Simp
/-!
This module contains the implementation of the embedded constraint substitution pass in the fixpoint
pipeline, substituting hypotheses of the form `h : x = true` in other hypotheses.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
them to substitute occurences of `x` within other hypotheses. Additionally this drops all
redundant top level hypotheses.
-/
def embeddedConstraintPass : Pass where
name := `embeddedConstraintSubsitution
run' goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut relevantHyps : SimpTheoremsArray := #[]
let mut seen : Std.HashSet Expr := {}
let mut duplicates : Array FVarId := #[]
for hyp in hyps do
let typ hyp.getType
let_expr Eq _ lhs rhs := typ | continue
let_expr Bool.true := rhs | continue
if seen.contains lhs then
duplicates := duplicates.push hyp
else
seen := seen.insert lhs
let localDecl hyp.getDecl
let proof := localDecl.toExpr
relevantHyps relevantHyps.addTheorem (.fvar hyp) proof
let goal goal.tryClearMany duplicates
if relevantHyps.isEmpty then
return goal
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, maxSteps := cfg.maxSteps })
(simpTheorems := relevantHyps)
(congrTheorems := ( getSimpCongrTheorems))
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := goal.getNondepPropHyps)
let some (_, newGoal) := result? | return none
return newGoal
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -0,0 +1,61 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains the implementation of the rewriting pass in the fixpoint pipeline, applying
rules from the `bv_normalize` simp set.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Responsible for applying the Bitwuzla style rewrite rules.
-/
def rewriteRulesPass : Pass where
name := `rewriteRules
run' goal := do
let bvThms bvNormalizeExt.getTheorems
let bvSimprocs bvNormalizeSimprocExt.getSimprocs
let sevalThms getSEvalTheorems
let sevalSimprocs Simp.getSEvalSimprocs
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps := cfg.maxSteps })
(simpTheorems := #[bvThms, sevalThms])
(congrTheorems := ( getSimpCongrTheorems))
let hyps getHyps goal
if hyps.isEmpty then
return goal
else
let result?, _ simpGoal goal
(ctx := simpCtx)
(simprocs := #[bvSimprocs, sevalSimprocs])
(fvarIdsToSimp := hyps)
let some (_, newGoal) := result? | return none
newGoal.withContext do
( newGoal.getNondepPropHyps).forM PreProcessM.rewriteFinished
return newGoal
where
getHyps (goal : MVarId) : PreProcessM (Array FVarId) := do
goal.withContext do
let mut hyps goal.getNondepPropHyps
let filter hyp := do
return !( PreProcessM.checkRewritten hyp)
hyps.filterM filter
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -0,0 +1,164 @@
/-
Copyright (c) 2025 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.Normalize
import Std.Tactic.BVDecide.Syntax
import Lean.Elab.Tactic.Simp
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
/-!
This module contains implementations of simprocs used in the `bv_normalize` simp set.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
open Std.Tactic.BVDecide.Normalize
builtin_simproc [bv_normalize] reduceCond (cond _ _ _) := fun e => do
let_expr f@cond α c tb eb := e | return .continue
let r Simp.simp c
if r.expr.cleanupAnnotations.isConstOf ``Bool.true then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_pos f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := tb, proof? := pr }
else if r.expr.cleanupAnnotations.isConstOf ``Bool.false then
let pr := mkApp (mkApp4 (mkConst ``Bool.cond_neg f.constLevels!) α c tb eb) ( r.getProof)
return .visit { expr := eb, proof? := pr }
else
return .continue
builtin_simproc [bv_normalize] eqToBEq (((_ : Bool) = (_ : Bool))) := fun e => do
let_expr Eq _ lhs rhs := e | return .continue
match_expr rhs with
| Bool.true => return .continue
| _ =>
let beqApp mkAppM ``BEq.beq #[lhs, rhs]
let new := mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) beqApp (mkConst ``Bool.true)
let proof := mkApp2 (mkConst ``Bool.eq_to_beq) lhs rhs
return .done { expr := new, proof? := some proof }
builtin_simproc [bv_normalize] andOnes ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, rhsValue getBitVecValue? rhs | return .continue
if rhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.and_ones) (toExpr w) lhs
return .visit { expr := lhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] onesAnd ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
let_expr HAnd.hAnd _ _ _ _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ones_and) (toExpr w) rhs
return .visit { expr := rhs, proof? := some proof }
else
return .continue
builtin_simproc [bv_normalize] maxUlt (BitVec.ult (_ : BitVec _) (_ : BitVec _)) := fun e => do
let_expr BitVec.ult _ lhs rhs := e | return .continue
let some w, lhsValue getBitVecValue? lhs | return .continue
if lhsValue == -1#w then
let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.max_ult') (toExpr w) rhs
return .visit { expr := toExpr Bool.false, proof? := some proof }
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
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
/-- Return a number `k` such that `2^k = n`. -/
private def Nat.log2Exact (n : Nat) : Option Nat := do
guard <| n 0
let k := n.log2
guard <| Nat.pow 2 k == n
return k
-- Build an expression for `x ^ y`.
def mkPow (x y : Expr) : MetaM Expr := mkAppM ``HPow.hPow #[x, y]
builtin_simproc [bv_normalize] bv_udiv_of_two_pow (((_ : BitVec _) / (BitVec.ofNat _ _) : BitVec _)) := fun e => do
let_expr HDiv.hDiv _α _β _γ _self x y := e | return .continue
let some w, yVal getBitVecValue? y | return .continue
let n := yVal.toNat
-- BitVec.ofNat w n, where n =def= 2^k
let some k := Nat.log2Exact n | return .continue
-- check that k < w.
if k w then return .continue
let rhs mkAppM ``HShiftRight.hShiftRight #[x, mkNatLit k]
-- 2^k = n
let hk mkDecideProof ( mkEq ( mkPow (mkNatLit 2) (mkNatLit k)) (mkNatLit n))
-- k < w
let hlt mkDecideProof ( mkLt (mkNatLit k) (mkNatLit w))
let proof := mkAppN (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.udiv_ofNat_eq_of_lt)
#[mkNatLit w, x, mkNatLit n, mkNatLit k, hk, hlt]
return .done {
expr := rhs
proof? := some proof
}
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -5,6 +5,7 @@ Authors: Gabriel Ebner, Mario Carneiro
-/
prelude
import Init.Ext
import Lean.Meta.Tactic.Ext
import Lean.Elab.DeclarationRange
import Lean.Elab.Tactic.RCases
import Lean.Elab.Tactic.Repeat
@@ -174,65 +175,8 @@ def realizeExtIffTheorem (extName : Name) : Elab.Command.CommandElabM Name := do
### Attribute
-/
/-- Information about an extensionality theorem, stored in the environment extension. -/
structure ExtTheorem where
/-- Declaration name of the extensionality theorem. -/
declName : Name
/-- Priority of the extensionality theorem. -/
priority : Nat
/--
Key in the discrimination tree,
for the type in which the extensionality theorem holds.
-/
keys : Array DiscrTree.Key
deriving Inhabited, Repr, BEq, Hashable
/-- The state of the `ext` extension environment -/
structure ExtTheorems where
/-- The tree of `ext` extensions. -/
tree : DiscrTree ExtTheorem := {}
/-- Erased `ext`s via `attribute [-ext]`. -/
erased : PHashSet Name := {}
deriving Inhabited
/-- The environment extension to track `@[ext]` theorems. -/
builtin_initialize extExtension :
SimpleScopedEnvExtension ExtTheorem ExtTheorems
registerSimpleScopedEnvExtension {
addEntry := fun { tree, erased } thm =>
{ tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName }
initial := {}
}
/-- Gets the list of `@[ext]` theorems corresponding to the key `ty`,
ordered from high priority to low. -/
@[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
let extTheorems := extExtension.getState ( getEnv)
let arr extTheorems.tree.getMatch ty
let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
-- Using insertion sort because it is stable and the list of matches should be mostly sorted.
-- Most ext theorems have default priority.
return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse
/--
Erases a name marked `ext` by adding it to the state's `erased` field and
removing it from the state's list of `Entry`s.
This is triggered by `attribute [-ext] name`.
-/
def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
{ d with erased := d.erased.insert declName }
/--
Erases a name marked as a `ext` attribute.
Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
found somewhere in the state's tree, and is not erased.
-/
def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
m ExtTheorems := do
unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do
throwError "'{declName}' does not have [ext] attribute"
return d.eraseCore declName
abbrev extExtension := Meta.Ext.extExtension
abbrev getExtTheorems := Meta.Ext.getExtTheorems
builtin_initialize registerBuiltinAttribute {
name := `ext

View File

@@ -34,10 +34,69 @@ def elabGrindPattern : CommandElab := fun stx => do
Grind.addEMatchTheorem declName xs.size patterns.toList
| _ => throwUnsupportedSyntax
def grind (mvarId : MVarId) (config : Grind.Config) (mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
let mvarIds Grind.main mvarId config mainDeclName fallback
unless mvarIds.isEmpty do
throwError "`grind` failed\n{goalsToMessageData mvarIds}"
open Command Term in
@[builtin_command_elab Lean.Parser.Command.initGrindNorm]
def elabInitGrindNorm : CommandElab := fun stx =>
match stx with
| `(init_grind_norm $pre:ident* | $post*) =>
Command.liftTermElabM do
let pre pre.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
let post post.mapM fun id => realizeGlobalConstNoOverloadWithInfo id
Grind.registerNormTheorems pre post
| _ => throwUnsupportedSyntax
def elabGrindParams (params : Grind.Params) (ps : TSyntaxArray ``Parser.Tactic.grindParam) : MetaM Grind.Params := do
let mut params := params
for p in ps do
match p with
| `(Parser.Tactic.grindParam| - $id:ident) =>
let declName realizeGlobalConstNoOverloadWithInfo id
if ( isInductivePredicate declName) then
throwErrorAt p "NIY"
else
params := { params with ematch := ( params.ematch.eraseDecl declName) }
| `(Parser.Tactic.grindParam| $[$mod?:grindThmMod]? $id:ident) =>
let declName realizeGlobalConstNoOverloadWithInfo id
let kind if let some mod := mod? then Grind.getTheoremKindCore mod else pure .default
if ( isInductivePredicate declName) then
throwErrorAt p "NIY"
else
let info getConstInfo declName
match info with
| .thmInfo _ =>
if kind == .eqBoth then
params := { params with extra := params.extra.push ( Grind.mkEMatchTheoremForDecl declName .eqLhs) }
params := { params with extra := params.extra.push ( Grind.mkEMatchTheoremForDecl declName .eqRhs) }
else
params := { params with extra := params.extra.push ( Grind.mkEMatchTheoremForDecl declName kind) }
| .defnInfo _ =>
if ( isReducible declName) then
throwErrorAt p "`{declName}` is a reducible definition, `grind` automatically unfolds them"
if kind != .eqLhs && kind != .default then
throwErrorAt p "invalid `grind` parameter, `{declName}` is a definition, the only acceptable (and redundant) modifier is '='"
let some thms Grind.mkEMatchEqTheoremsForDef? declName
| throwErrorAt p "failed to genereate equation theorems for `{declName}`"
params := { params with extra := params.extra ++ thms.toPArray' }
| _ =>
throwErrorAt p "invalid `grind` parameter, `{declName}` is not a theorem, definition, or inductive type"
| _ => throwError "unexpected `grind` parameter{indentD p}"
return params
def mkGrindParams (config : Grind.Config) (only : Bool) (ps : TSyntaxArray ``Parser.Tactic.grindParam) : MetaM Grind.Params := do
let params Grind.mkParams config
let ematch if only then pure {} else Grind.getEMatchTheorems
let params := { params with ematch }
elabGrindParams params ps
def grind
(mvarId : MVarId) (config : Grind.Config)
(only : Bool)
(ps : TSyntaxArray ``Parser.Tactic.grindParam)
(mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
let params mkGrindParams config only ps
let goals Grind.main mvarId params mainDeclName fallback
unless goals.isEmpty do
throwError "`grind` failed\n{← Grind.goalsToMessageData goals config}"
private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
let some fallback := fallback? | return (pure ())
@@ -56,14 +115,16 @@ private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit
pure auxDeclName
unsafe evalConst (Grind.GoalM Unit) auxDeclName
@[builtin_tactic Lean.Parser.Tactic.grind] def evalApplyRfl : Tactic := fun stx => do
@[builtin_tactic Lean.Parser.Tactic.grind] def evalGrind : Tactic := fun stx => do
match stx with
| `(tactic| grind $config:optConfig $[on_failure $fallback?]?) =>
| `(tactic| grind $config:optConfig $[only%$only]? $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
let fallback elabFallback fallback?
let only := only.isSome
let params := if let some params := params then params.getElems else #[]
logWarningAt stx "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
let declName := ( Term.getDeclName?).getD `_grind
let config elabGrindConfig config
withMainContext do liftMetaFinishingTactic (grind · config declName fallback)
withMainContext do liftMetaFinishingTactic (grind · config only params declName fallback)
| _ => throwUnsupportedSyntax
end Lean.Elab.Tactic

View File

@@ -7,8 +7,10 @@ prelude
import Init.Control.StateRef
import Init.Data.Array.BinSearch
import Init.Data.Stream
import Init.System.Promise
import Lean.ImportingFlag
import Lean.Data.HashMap
import Lean.Data.NameTrie
import Lean.Data.SMap
import Lean.Declaration
import Lean.LocalContext
@@ -16,6 +18,50 @@ import Lean.Util.Path
import Lean.Util.FindExpr
import Lean.Util.Profile
import Lean.Util.InstantiateLevelParams
import Lean.PrivateName
/-!
# Note [Environment Branches]
The kernel environment type `Lean.Kernel.Environment` enforces a linear order on the addition of
declarations: `addDeclCore` takes an environment and returns a new one, assuming type checking
succeeded. On the other hand, the metaprogramming-level `Lean.Environment` wrapper must allow for
*branching* environment transformations so that multiple declarations can be elaborated
concurrently while still being able to access information about preceding declarations that have
also been branched out as soon as they are available.
The basic function to introduce such branches is `addConstAsync`, which takes an environment and
returns a structure containing two environments: one for the "main" branch that can be used in
further branching and eventually contains all the declarations of the file and one for the "async"
branch that can be used concurrently to the main branch to elaborate and add the declaration for
which the branch was introduced. Branches are "joined" back together implicitly via the kernel
environment, which as mentioned cannot be changed concurrently: when the main branch first tries to
access it, evaluation is blocked until the kernel environment on the async branch is complete.
Thus adding two declarations A and B concurrently can be visualized like this:
```text
o addConstAsync A
|\
| \
| \
o addConstAsync B
|\ \
| \ o elaborate A
| \ |
| o elaborate B
| | |
| | o addDeclCore A
| |/
| o addDeclCore B
| /
| /
|/
o .olean serialization calls Environment.toKernelEnv
```
While each edge represents a `Lean.Environment` that has its own view of the state of the module,
the kernel environment really lives only in the right-most path, with all other paths merely holding
an unfulfilled `Task` representing it and where forcing that task leads to the back-edges joining
paths back together.
-/
namespace Lean
/-- Opaque environment extension state. -/
@@ -88,11 +134,6 @@ structure EnvironmentHeader where
-/
trustLevel : UInt32 := 0
/--
`quotInit = true` if the command `init_quot` has already been executed for the environment, and
`Quot` declarations have been added to the environment.
-/
quotInit : Bool := false
/--
Name of the module being compiled.
-/
mainModule : Name := default
@@ -106,6 +147,15 @@ structure EnvironmentHeader where
moduleData : Array ModuleData := #[]
deriving Nonempty
namespace Kernel
structure Diagnostics where
/-- Number of times each declaration has been unfolded by the kernel. -/
unfoldCounter : PHashMap Name Nat := {}
/-- If `enabled = true`, kernel records declarations that have been unfolded. -/
enabled : Bool := false
deriving Inhabited
/--
An environment stores declarations provided by the user. The kernel
currently supports different kinds of declarations such as definitions, theorems,
@@ -121,10 +171,33 @@ declared by users are stored in an environment extension. Users can declare new
using meta-programming.
-/
structure Environment where
/-- The constructor of `Environment` is private to protect against modification
that bypasses the kernel. -/
/--
The constructor of `Environment` is private to protect against modification that bypasses the
kernel.
-/
private mk ::
/--
Mapping from constant name to `ConstantInfo`. It contains all constants (definitions, theorems,
axioms, etc) that have been already type checked by the kernel.
-/
constants : ConstMap
/--
`quotInit = true` if the command `init_quot` has already been executed for the environment, and
`Quot` declarations have been added to the environment. When the flag is set, the type checker can
assume that the `Quot` declarations in the environment have indeed been added by the kernel and
not by the user.
-/
quotInit : Bool := false
/--
Diagnostic information collected during kernel execution.
Remark: We store kernel diagnostic information in an environment field to simplify the interface
with the kernel implemented in C/C++. Thus, we can only track declarations in methods, such as
`addDecl`, which return a new environment. `Kernel.isDefEq` and `Kernel.whnf` do not update the
statistics. We claim this is ok since these methods are mainly used for debugging.
-/
diagnostics : Diagnostics := {}
/--
Mapping from constant name to module (index) where constant has been declared.
Recall that a Lean file has a header where previously compiled modules can be imported.
Each imported module has a unique `ModuleIdx`.
@@ -134,96 +207,23 @@ structure Environment where
the field `constants`. These auxiliary constants are invisible to the Lean kernel and elaborator.
Only the code generator uses them.
-/
const2ModIdx : Std.HashMap Name ModuleIdx
/--
Mapping from constant name to `ConstantInfo`. It contains all constants (definitions, theorems, axioms, etc)
that have been already type checked by the kernel.
-/
constants : ConstMap
const2ModIdx : Std.HashMap Name ModuleIdx
/--
Environment extensions. It also includes user-defined extensions.
-/
extensions : Array EnvExtensionState
private extensions : Array EnvExtensionState
/--
Constant names to be saved in the field `extraConstNames` at `ModuleData`.
It contains auxiliary declaration names created by the code generator which are not in `constants`.
When importing modules, we want to insert them at `const2ModIdx`.
-/
extraConstNames : NameSet
/-- The header contains additional information that is not updated often. -/
header : EnvironmentHeader := {}
deriving Nonempty
private extraConstNames : NameSet
/-- The header contains additional information that is set at import time. -/
header : EnvironmentHeader := {}
deriving Nonempty
namespace Environment
private def addAux (env : Environment) (cinfo : ConstantInfo) : Environment :=
{ env with constants := env.constants.insert cinfo.name cinfo }
/--
Save an extra constant name that is used to populate `const2ModIdx` when we import
.olean files. We use this feature to save in which module an auxiliary declaration
created by the code generator has been created.
-/
def addExtraName (env : Environment) (name : Name) : Environment :=
if env.constants.contains name then
env
else
{ env with extraConstNames := env.extraConstNames.insert name }
@[export lean_environment_find]
def find? (env : Environment) (n : Name) : Option ConstantInfo :=
/- It is safe to use `find'` because we never overwrite imported declarations. -/
env.constants.find?' n
def contains (env : Environment) (n : Name) : Bool :=
env.constants.contains n
def imports (env : Environment) : Array Import :=
env.header.imports
def allImportedModuleNames (env : Environment) : Array Name :=
env.header.moduleNames
@[export lean_environment_set_main_module]
def setMainModule (env : Environment) (m : Name) : Environment :=
{ env with header := { env.header with mainModule := m } }
@[export lean_environment_main_module]
def mainModule (env : Environment) : Name :=
env.header.mainModule
@[export lean_environment_mark_quot_init]
private def markQuotInit (env : Environment) : Environment :=
{ env with header := { env.header with quotInit := true } }
@[export lean_environment_quot_init]
private def isQuotInit (env : Environment) : Bool :=
env.header.quotInit
@[export lean_environment_trust_level]
private def getTrustLevel (env : Environment) : UInt32 :=
env.header.trustLevel
def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
env.const2ModIdx[declName]?
def isConstructor (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.ctorInfo _) => true
| _ => false
def isSafeDefinition (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.defnInfo { safety := .safe, .. }) => true
| _ => false
def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
env.header.moduleNames.findIdx? (· == moduleName)
end Environment
/-- Exceptions that can be raised by the Kernel when type checking new declarations. -/
inductive KernelException where
/-- Exceptions that can be raised by the kernel when type checking new declarations. -/
inductive Exception where
| unknownConstant (env : Environment) (name : Name)
| alreadyDeclared (env : Environment) (name : Name)
| declTypeMismatch (env : Environment) (decl : Declaration) (givenType : Expr)
@@ -244,21 +244,500 @@ inductive KernelException where
namespace Environment
/--
Type check given declaration and add it to the environment
-/
@[export lean_environment_find]
def find? (env : Environment) (n : Name) : Option ConstantInfo :=
/- It is safe to use `find'` because we never overwrite imported declarations. -/
env.constants.find?' n
@[export lean_environment_mark_quot_init]
private def markQuotInit (env : Environment) : Environment :=
{ env with quotInit := true }
@[export lean_environment_quot_init]
private def isQuotInit (env : Environment) : Bool :=
env.quotInit
/-- Type check given declaration and add it to the environment -/
@[extern "lean_add_decl"]
opaque addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
(cancelTk? : @& Option IO.CancelToken) : Except KernelException Environment
(cancelTk? : @& Option IO.CancelToken) : Except Exception Environment
/--
Add declaration to kernel without type checking it.
**WARNING** This function is meant for temporarily working around kernel performance issues.
It compromises soundness because, for example, a buggy tactic may produce an invalid proof,
and the kernel will not catch it if the new option is set to true.
-/
@[extern "lean_add_decl_without_checking"]
opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except KernelException Environment
opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except Exception Environment
@[export lean_environment_add]
private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
{ env with constants := env.constants.insert cinfo.name cinfo }
@[export lean_kernel_diag_is_enabled]
def Diagnostics.isEnabled (d : Diagnostics) : Bool :=
d.enabled
/-- Enables/disables kernel diagnostics. -/
def enableDiag (env : Environment) (flag : Bool) : Environment :=
{ env with diagnostics.enabled := flag }
def isDiagnosticsEnabled (env : Environment) : Bool :=
env.diagnostics.enabled
def resetDiag (env : Environment) : Environment :=
{ env with diagnostics.unfoldCounter := {} }
@[export lean_kernel_record_unfold]
def Diagnostics.recordUnfold (d : Diagnostics) (declName : Name) : Diagnostics :=
if d.enabled then
let cNew := if let some c := d.unfoldCounter.find? declName then c + 1 else 1
{ d with unfoldCounter := d.unfoldCounter.insert declName cNew }
else
d
@[export lean_kernel_get_diag]
def getDiagnostics (env : Environment) : Diagnostics :=
env.diagnostics
@[export lean_kernel_set_diag]
def setDiagnostics (env : Environment) (diag : Diagnostics) : Environment :=
{ env with diagnostics := diag}
end Kernel.Environment
@[deprecated Kernel.Exception (since := "2024-12-12")]
abbrev KernelException := Kernel.Exception
inductive ConstantKind where
| defn | thm | «axiom» | «opaque» | quot | induct | ctor | recursor
deriving Inhabited, BEq, Repr
def ConstantKind.ofConstantInfo : ConstantInfo ConstantKind
| .defnInfo _ => .defn
| .thmInfo _ => .thm
| .axiomInfo _ => .axiom
| .opaqueInfo _ => .opaque
| .quotInfo _ => .quot
| .inductInfo _ => .induct
| .ctorInfo _ => .ctor
| .recInfo _ => .recursor
/-- `ConstantInfo` variant that allows for asynchronous filling of components via tasks. -/
structure AsyncConstantInfo where
/-- The declaration name, known immediately. -/
name : Name
/-- The kind of the constant, known immediately. -/
kind : ConstantKind
/-- The "signature" including level params and type, potentially filled asynchronously. -/
sig : Task ConstantVal
/-- The final, complete constant info, potentially filled asynchronously. -/
constInfo : Task ConstantInfo
namespace AsyncConstantInfo
def toConstantVal (c : AsyncConstantInfo) : ConstantVal :=
c.sig.get
def toConstantInfo (c : AsyncConstantInfo) : ConstantInfo :=
c.constInfo.get
def ofConstantInfo (c : ConstantInfo) : AsyncConstantInfo where
name := c.name
kind := .ofConstantInfo c
sig := .pure c.toConstantVal
constInfo := .pure c
end AsyncConstantInfo
/--
Information about the current branch of the environment representing asynchronous elaboration.
-/
structure AsyncContext where
/--
Name of the declaration asynchronous elaboration was started for. All constants added to this
environment branch must have the name as a prefix, after erasing macro scopes and private name
prefixes.
-/
declPrefix : Name
deriving Nonempty
/--
Checks whether a declaration named `n` may be added to the environment in the given context. See
also `AsyncContext.declPrefix`.
-/
def AsyncContext.mayContain (ctx : AsyncContext) (n : Name) : Bool :=
ctx.declPrefix.isPrefixOf <| privateToUserName n.eraseMacroScopes
/--
Constant info and environment extension states eventually resulting from async elaboration.
-/
structure AsyncConst where
constInfo : AsyncConstantInfo
/--
Reported extension state eventually fulfilled by promise; may be missing for tasks (e.g. kernel
checking) that can eagerly guarantee they will not report any state.
-/
exts? : Option (Task (Array EnvExtensionState))
/-- Data structure holding a sequence of `AsyncConst`s optimized for efficient access. -/
structure AsyncConsts where
toArray : Array AsyncConst := #[]
/-- Map from declaration name to const for fast direct access. -/
private map : NameMap AsyncConst := {}
/-- Trie of declaration names without private name prefixes for fast longest-prefix access. -/
private normalizedTrie : NameTrie AsyncConst := {}
deriving Inhabited
def AsyncConsts.add (aconsts : AsyncConsts) (aconst : AsyncConst) : AsyncConsts :=
{ aconsts with
toArray := aconsts.toArray.push aconst
map := aconsts.map.insert aconst.constInfo.name aconst
normalizedTrie := aconsts.normalizedTrie.insert (privateToUserName aconst.constInfo.name) aconst
}
def AsyncConsts.find? (aconsts : AsyncConsts) (declName : Name) : Option AsyncConst :=
aconsts.map.find? declName
/-- Checks whether the name of any constant in the collection is a prefix of `declName`. -/
def AsyncConsts.hasPrefix (aconsts : AsyncConsts) (declName : Name) : Bool :=
-- as macro scopes are a strict suffix,
aconsts.normalizedTrie.findLongestPrefix? (privateToUserName declName.eraseMacroScopes) |>.isSome
/--
Elaboration-specific extension of `Kernel.Environment` that adds tracking of asynchronously
elaborated declarations.
-/
structure Environment where
/-
Like with `Kernel.Environment`, this constructor is private to protect consistency of the
environment, though there are no soundness concerns in this case given that it is used purely for
elaboration.
-/
private mk ::
/--
Kernel environment not containing any asynchronously elaborated declarations. Also stores
environment extension state for the current branch of the environment.
Ignoring extension state, this is guaranteed to be some prior version of `checked` that is eagerly
available. Thus we prefer taking information from it instead of `checked` whenever possible.
-/
checkedWithoutAsync : Kernel.Environment
/--
Kernel environment task that is fulfilled when all asynchronously elaborated declarations are
finished, containing the resulting environment. Also collects the environment extension state of
all environment branches that contributed contained declarations.
-/
checked : Task Kernel.Environment := .pure checkedWithoutAsync
/--
Container of asynchronously elaborated declarations, i.e.
`checked = checkedWithoutAsync ⨃ asyncConsts`.
-/
private asyncConsts : AsyncConsts := {}
/-- Information about this asynchronous branch of the environment, if any. -/
private asyncCtx? : Option AsyncContext := none
deriving Nonempty
namespace Environment
@[export lean_elab_environment_of_kernel_env]
def ofKernelEnv (env : Kernel.Environment) : Environment :=
{ checkedWithoutAsync := env }
@[export lean_elab_environment_to_kernel_env]
def toKernelEnv (env : Environment) : Kernel.Environment :=
env.checked.get
/-- Consistently updates synchronous and asynchronous parts of the environment without blocking. -/
private def modifyCheckedAsync (env : Environment) (f : Kernel.Environment Kernel.Environment) : Environment :=
{ env with checked := env.checked.map (sync := true) f, checkedWithoutAsync := f env.checkedWithoutAsync }
/-- Sets synchronous and asynchronous parts of the environment to the given kernel environment. -/
private def setCheckedSync (env : Environment) (newChecked : Kernel.Environment) : Environment :=
{ env with checked := .pure newChecked, checkedWithoutAsync := newChecked }
@[extern "lean_elab_add_decl"]
private opaque addDeclCheck (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
(cancelTk? : @& Option IO.CancelToken) : Except Kernel.Exception Environment
@[extern "lean_elab_add_decl_without_checking"]
private opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) :
Except Kernel.Exception Environment
/--
Adds given declaration to the environment, type checking it unless `doCheck` is false.
This is a plumbing function for the implementation of `Lean.addDecl`, most users should use it
instead.
-/
def addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
(cancelTk? : @& Option IO.CancelToken) (doCheck := true) :
Except Kernel.Exception Environment := do
if let some ctx := env.asyncCtx? then
if let some n := decl.getNames.find? (!ctx.mayContain ·) then
throw <| .other s!"cannot add declaration {n} to environment as it is restricted to the \
prefix {ctx.declPrefix}"
if doCheck then
addDeclCheck env maxHeartbeats decl cancelTk?
else
addDeclWithoutChecking env decl
@[inherit_doc Kernel.Environment.constants]
def constants (env : Environment) : ConstMap :=
env.toKernelEnv.constants
@[inherit_doc Kernel.Environment.const2ModIdx]
def const2ModIdx (env : Environment) : Std.HashMap Name ModuleIdx :=
env.toKernelEnv.const2ModIdx
-- only needed for the lakefile.lean cache
@[export lake_environment_add]
private def lakeAdd (env : Environment) (cinfo : ConstantInfo) : Environment :=
{ env with checked := .pure <| env.checked.get.add cinfo }
/--
Save an extra constant name that is used to populate `const2ModIdx` when we import
.olean files. We use this feature to save in which module an auxiliary declaration
created by the code generator has been created.
-/
def addExtraName (env : Environment) (name : Name) : Environment :=
if env.constants.contains name then
env
else
env.modifyCheckedAsync fun env => { env with extraConstNames := env.extraConstNames.insert name }
/-- Find base case: name did not match any asynchronous declaration. -/
private def findNoAsync (env : Environment) (n : Name) : Option ConstantInfo := do
if env.asyncConsts.hasPrefix n then
-- Constant generated in a different environment branch: wait for final kernel environment. Rare
-- case when only proofs are elaborated asynchronously as they are rarely inspected. Could be
-- optimized in the future by having the elaboration thread publish an (incremental?) map of
-- generated declarations before kernel checking (which must wait on all previous threads).
env.checked.get.constants.find?' n
else
-- Not in the kernel environment nor in the name prefix of environment branch: undefined by
-- `addDeclCore` invariant.
none
/--
Looks up the given declaration name in the environment, avoiding forcing any in-progress elaboration
tasks.
-/
def findAsync? (env : Environment) (n : Name) : Option AsyncConstantInfo := do
-- Check declarations already added to the kernel environment (e.g. because they were imported)
-- first as that should be the most common case. It is safe to use `find?'` because we never
-- overwrite imported declarations.
if let some c := env.checkedWithoutAsync.constants.find?' n then
some <| .ofConstantInfo c
else if let some asyncConst := env.asyncConsts.find? n then
-- Constant for which an asynchronous elaboration task was spawned
return asyncConst.constInfo
else env.findNoAsync n |>.map .ofConstantInfo
/--
Looks up the given declaration name in the environment, avoiding forcing any in-progress elaboration
tasks for declaration bodies (which are not accessible from `ConstantVal`).
-/
def findConstVal? (env : Environment) (n : Name) : Option ConstantVal := do
if let some c := env.checkedWithoutAsync.constants.find?' n then
some c.toConstantVal
else if let some asyncConst := env.asyncConsts.find? n then
return asyncConst.constInfo.toConstantVal
else env.findNoAsync n |>.map (·.toConstantVal)
/--
Looks up the given declaration name in the environment, blocking on the corresponding elaboration
task if not yet complete.
-/
def find? (env : Environment) (n : Name) : Option ConstantInfo :=
if let some c := env.checkedWithoutAsync.constants.find?' n then
some c
else if let some asyncConst := env.asyncConsts.find? n then
return asyncConst.constInfo.toConstantInfo
else
env.findNoAsync n
/-- Returns debug output about the asynchronous state of the environment. -/
def dbgFormatAsyncState (env : Environment) : BaseIO String :=
return s!"\
asyncCtx.declPrefix: {repr <| env.asyncCtx?.map (·.declPrefix)}\
\nasyncConsts: {repr <| env.asyncConsts.toArray.map (·.constInfo.name)}\
\ncheckedWithoutAsync.constants.map₂: {repr <|
env.checkedWithoutAsync.constants.map₂.toList.map (·.1)}"
/-- Returns debug output about the synchronous state of the environment. -/
def dbgFormatCheckedSyncState (env : Environment) : BaseIO String :=
return s!"checked.get.constants.map₂: {repr <| env.checked.get.constants.map₂.toList.map (·.1)}"
/--
Result of `Lean.Environment.addConstAsync` which is necessary to complete the asynchronous addition.
-/
structure AddConstAsyncResult where
/--
Resulting "main branch" environment which contains the declaration name as an asynchronous
constant. Accessing the constant or kernel environment will block until the corresponding
`AddConstAsyncResult.commit*` function has been called.
-/
mainEnv : Environment
/--
Resulting "async branch" environment which should be used to add the desired declaration in a new
task and then call `AddConstAsyncResult.commit*` to commit results back to the main environment.
One of `commitCheckEnv` or `commitFailure` must be called eventually to prevent deadlocks on main
branch accesses.
-/
asyncEnv : Environment
private constName : Name
private kind : ConstantKind
private sigPromise : IO.Promise ConstantVal
private infoPromise : IO.Promise ConstantInfo
private extensionsPromise : IO.Promise (Array EnvExtensionState)
private checkedEnvPromise : IO.Promise Kernel.Environment
/--
Starts the asynchronous addition of a constant to the environment. The environment is split into a
"main" branch that holds a reference to the constant to be added but will block on access until the
corresponding information has been added on the "async" environment branch and committed there; see
the respective fields of `AddConstAsyncResult` as well as the [Environment Branches] note for more
information.
-/
def addConstAsync (env : Environment) (constName : Name) (kind : ConstantKind) (reportExts := true) :
IO AddConstAsyncResult := do
let sigPromise IO.Promise.new
let infoPromise IO.Promise.new
let extensionsPromise IO.Promise.new
let checkedEnvPromise IO.Promise.new
let asyncConst := {
constInfo := {
name := constName
kind
sig := sigPromise.result
constInfo := infoPromise.result
}
exts? := guard reportExts *> some extensionsPromise.result
}
return {
constName, kind
mainEnv := { env with
asyncConsts := env.asyncConsts.add asyncConst
checked := checkedEnvPromise.result }
asyncEnv := { env with
asyncCtx? := some { declPrefix := privateToUserName constName.eraseMacroScopes }
}
sigPromise, infoPromise, extensionsPromise, checkedEnvPromise
}
/--
Commits the signature of the constant to the main environment branch. The declaration name must
match the name originally given to `addConstAsync`. It is optional to call this function but can
help in unblocking corresponding accesses to the constant on the main branch.
-/
def AddConstAsyncResult.commitSignature (res : AddConstAsyncResult) (sig : ConstantVal) :
IO Unit := do
if sig.name != res.constName then
throw <| .userError s!"AddConstAsyncResult.commitSignature: constant has name {sig.name} but expected {res.constName}"
res.sigPromise.resolve sig
/--
Commits the full constant info to the main environment branch. If `info?` is `none`, it is taken
from the given environment. The declaration name and kind must match the original values given to
`addConstAsync`. The signature must match the previous `commitSignature` call, if any.
-/
def AddConstAsyncResult.commitConst (res : AddConstAsyncResult) (env : Environment)
(info? : Option ConstantInfo := none) :
IO Unit := do
let info match info? <|> env.find? res.constName with
| some info => pure info
| none =>
throw <| .userError s!"AddConstAsyncResult.commitConst: constant {res.constName} not found in async context"
res.commitSignature info.toConstantVal
let kind' := .ofConstantInfo info
if res.kind != kind' then
throw <| .userError s!"AddConstAsyncResult.commitConst: constant has kind {repr kind'} but expected {repr res.kind}"
let sig := res.sigPromise.result.get
if sig.levelParams != info.levelParams then
throw <| .userError s!"AddConstAsyncResult.commitConst: constant has level params {info.levelParams} but expected {sig.levelParams}"
if sig.type != info.type then
throw <| .userError s!"AddConstAsyncResult.commitConst: constant has type {info.type} but expected {sig.type}"
res.infoPromise.resolve info
res.extensionsPromise.resolve env.checkedWithoutAsync.extensions
/--
Aborts async addition, filling in missing information with default values/sorries and leaving the
kernel environment unchanged.
-/
def AddConstAsyncResult.commitFailure (res : AddConstAsyncResult) : BaseIO Unit := do
let val := if ( IO.hasFinished res.sigPromise.result) then
res.sigPromise.result.get
else {
name := res.constName
levelParams := []
type := mkApp2 (mkConst ``sorryAx [0]) (mkSort 0) (mkConst ``true)
}
res.sigPromise.resolve val
res.infoPromise.resolve <| match res.kind with
| .defn => .defnInfo { val with
value := mkApp2 (mkConst ``sorryAx [0]) val.type (mkConst ``true)
hints := .abbrev
safety := .safe
}
| .thm => .thmInfo { val with
value := mkApp2 (mkConst ``sorryAx [0]) val.type (mkConst ``true)
}
| k => panic! s!"AddConstAsyncResult.commitFailure: unsupported constant kind {repr k}"
res.extensionsPromise.resolve #[]
let _ BaseIO.mapTask (t := res.asyncEnv.checked) (sync := true) res.checkedEnvPromise.resolve
/--
Assuming `Lean.addDecl` has been run for the constant to be added on the async environment branch,
commits the full constant info from that call to the main environment, waits for the final kernel
environment resulting from the `addDecl` call, and commits it to the main branch as well, unblocking
kernel additions there. All `commitConst` preconditions apply.
-/
def AddConstAsyncResult.commitCheckEnv (res : AddConstAsyncResult) (env : Environment) :
IO Unit := do
let some _ := env.findAsync? res.constName
| throw <| .userError s!"AddConstAsyncResult.checkAndCommitEnv: constant {res.constName} not \
found in async context"
res.commitConst env
res.checkedEnvPromise.resolve env.checked.get
def contains (env : Environment) (n : Name) : Bool :=
env.findAsync? n |>.isSome
def header (env : Environment) : EnvironmentHeader :=
-- can be assumed to be in sync with `env.checked`; see `setMainModule`, the only modifier of the header
env.checkedWithoutAsync.header
def imports (env : Environment) : Array Import :=
env.header.imports
def allImportedModuleNames (env : Environment) : Array Name :=
env.header.moduleNames
def setMainModule (env : Environment) (m : Name) : Environment :=
env.modifyCheckedAsync ({ · with header.mainModule := m })
def mainModule (env : Environment) : Name :=
env.header.mainModule
def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
-- async constants are always from the current module
env.checkedWithoutAsync.const2ModIdx[declName]?
def isConstructor (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.ctorInfo _) => true
| _ => false
def isSafeDefinition (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.defnInfo { safety := .safe, .. }) => true
| _ => false
def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
env.header.moduleNames.findIdx? (· == moduleName)
end Environment
@@ -385,20 +864,22 @@ opaque EnvExtensionInterfaceImp : EnvExtensionInterface
def EnvExtension (σ : Type) : Type := EnvExtensionInterfaceImp.ext σ
private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
let exts EnvExtensionInterfaceImp.ensureExtensionsSize env.extensions
return { env with extensions := exts }
let exts EnvExtensionInterfaceImp.ensureExtensionsSize env.checked.get.extensions
return env.modifyCheckedAsync ({ · with extensions := exts })
namespace EnvExtension
instance {σ} [s : Inhabited σ] : Inhabited (EnvExtension σ) := EnvExtensionInterfaceImp.inhabitedExt s
def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment :=
{ env with extensions := EnvExtensionInterfaceImp.setState ext env.extensions s }
let checked := env.checked.get
env.setCheckedSync { checked with extensions := EnvExtensionInterfaceImp.setState ext checked.extensions s }
def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σ σ) : Environment :=
{ env with extensions := EnvExtensionInterfaceImp.modifyState ext env.extensions f }
let checked := env.checked.get
env.setCheckedSync { checked with extensions := EnvExtensionInterfaceImp.modifyState ext checked.extensions f }
def getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment) : σ :=
EnvExtensionInterfaceImp.getState ext env.extensions
EnvExtensionInterfaceImp.getState ext env.checked.get.extensions
end EnvExtension
@@ -418,11 +899,13 @@ def mkEmptyEnvironment (trustLevel : UInt32 := 0) : IO Environment := do
if initializing then throw (IO.userError "environment objects cannot be created during initialization")
let exts mkInitialExtensionStates
pure {
const2ModIdx := {}
constants := {}
header := { trustLevel := trustLevel }
extraConstNames := {}
extensions := exts
checkedWithoutAsync := {
const2ModIdx := {}
constants := {}
header := { trustLevel }
extraConstNames := {}
extensions := exts
}
}
structure PersistentEnvExtensionState (α : Type) (σ : Type) where
@@ -706,11 +1189,12 @@ def mkModuleData (env : Environment) : IO ModuleData := do
let entries := pExts.map fun pExt =>
let state := pExt.getState env
(pExt.name, pExt.exportEntriesFn state)
let constNames := env.constants.foldStage2 (fun names name _ => names.push name) #[]
let constants := env.constants.foldStage2 (fun cs _ c => cs.push c) #[]
let kenv := env.toKernelEnv
let constNames := kenv.constants.foldStage2 (fun names name _ => names.push name) #[]
let constants := kenv.constants.foldStage2 (fun cs _ c => cs.push c) #[]
return {
imports := env.header.imports
extraConstNames := env.extraConstNames.toArray
extraConstNames := env.checked.get.extraConstNames.toArray
constNames, constants, entries
}
@@ -731,19 +1215,23 @@ def mkExtNameMap (startingAt : Nat) : IO (Std.HashMap Name Nat) := do
return result
private def setImportedEntries (env : Environment) (mods : Array ModuleData) (startingAt : Nat := 0) : IO Environment := do
let mut env := env
-- We work directly on the states array instead of `env` as `Environment.modifyState` introduces
-- significant overhead on such frequent calls
let mut states := env.checkedWithoutAsync.extensions
let extDescrs persistentEnvExtensionsRef.get
/- For extensions starting at `startingAt`, ensure their `importedEntries` array have size `mods.size`. -/
for extDescr in extDescrs[startingAt:] do
env := extDescr.toEnvExtension.modifyState env fun s => { s with importedEntries := mkArray mods.size #[] }
states := EnvExtensionInterfaceImp.modifyState extDescr.toEnvExtension states fun s =>
{ s with importedEntries := mkArray mods.size #[] }
/- For each module `mod`, and `mod.entries`, if the extension name is one of the extensions after `startingAt`, set `entries` -/
let extNameIdx mkExtNameMap startingAt
for h : modIdx in [:mods.size] do
let mod := mods[modIdx]
for (extName, entries) in mod.entries do
if let some entryIdx := extNameIdx[extName]? then
env := extDescrs[entryIdx]!.toEnvExtension.modifyState env fun s => { s with importedEntries := s.importedEntries.set! modIdx entries }
return env
states := EnvExtensionInterfaceImp.modifyState extDescrs[entryIdx]!.toEnvExtension states fun s =>
{ s with importedEntries := s.importedEntries.set! modIdx entries }
return env.setCheckedSync { env.checkedWithoutAsync with extensions := states }
/--
"Forward declaration" needed for updating the attribute table with user-defined attributes.
@@ -873,17 +1361,17 @@ def finalizeImport (s : ImportState) (imports : Array Import) (opts : Options) (
let constants : ConstMap := SMap.fromHashMap constantMap false
let exts mkInitialExtensionStates
let mut env : Environment := {
const2ModIdx := const2ModIdx
constants := constants
extraConstNames := {}
extensions := exts
header := {
quotInit := !imports.isEmpty -- We assume `core.lean` initializes quotient module
trustLevel := trustLevel
imports := imports
regions := s.regions
moduleNames := s.moduleNames
moduleData := s.moduleData
checkedWithoutAsync := {
const2ModIdx, constants
quotInit := !imports.isEmpty -- We assume `core.lean` initializes quotient module
extraConstNames := {}
extensions := exts
header := {
trustLevel, imports
regions := s.regions
moduleNames := s.moduleNames
moduleData := s.moduleData
}
}
}
env setImportedEntries env s.moduleData
@@ -946,54 +1434,21 @@ builtin_initialize namespacesExt : SimplePersistentEnvExtension Name NameSSet
addEntryFn := fun s n => s.insert n
}
structure Kernel.Diagnostics where
/-- Number of times each declaration has been unfolded by the kernel. -/
unfoldCounter : PHashMap Name Nat := {}
/-- If `enabled = true`, kernel records declarations that have been unfolded. -/
enabled : Bool := false
deriving Inhabited
@[inherit_doc Kernel.Environment.enableDiag]
def Kernel.enableDiag (env : Lean.Environment) (flag : Bool) : Lean.Environment :=
env.modifyCheckedAsync (·.enableDiag flag)
/--
Extension for storting diagnostic information.
def Kernel.isDiagnosticsEnabled (env : Lean.Environment) : Bool :=
env.checkedWithoutAsync.isDiagnosticsEnabled
Remark: We store kernel diagnostic information in an environment extension to simplify
the interface with the kernel implemented in C/C++. Thus, we can only track
declarations in methods, such as `addDecl`, which return a new environment.
`Kernel.isDefEq` and `Kernel.whnf` do not update the statistics. We claim
this is ok since these methods are mainly used for debugging.
-/
builtin_initialize diagExt : EnvExtension Kernel.Diagnostics
registerEnvExtension (pure {})
def Kernel.resetDiag (env : Lean.Environment) : Lean.Environment :=
env.modifyCheckedAsync (·.resetDiag)
@[export lean_kernel_diag_is_enabled]
def Kernel.Diagnostics.isEnabled (d : Diagnostics) : Bool :=
d.enabled
def Kernel.getDiagnostics (env : Lean.Environment) : Diagnostics :=
env.checked.get.diagnostics
/-- Enables/disables kernel diagnostics. -/
def Kernel.enableDiag (env : Environment) (flag : Bool) : Environment :=
diagExt.modifyState env fun s => { s with enabled := flag }
def Kernel.isDiagnosticsEnabled (env : Environment) : Bool :=
diagExt.getState env |>.enabled
def Kernel.resetDiag (env : Environment) : Environment :=
diagExt.modifyState env fun s => { s with unfoldCounter := {} }
@[export lean_kernel_record_unfold]
def Kernel.Diagnostics.recordUnfold (d : Diagnostics) (declName : Name) : Diagnostics :=
if d.enabled then
let cNew := if let some c := d.unfoldCounter.find? declName then c + 1 else 1
{ d with unfoldCounter := d.unfoldCounter.insert declName cNew }
else
d
@[export lean_kernel_get_diag]
def Kernel.getDiagnostics (env : Environment) : Diagnostics :=
diagExt.getState env
@[export lean_kernel_set_diag]
def Kernel.setDiagnostics (env : Environment) (diag : Diagnostics) : Environment :=
diagExt.setState env diag
def Kernel.setDiagnostics (env : Lean.Environment) (diag : Diagnostics) : Lean.Environment :=
env.modifyCheckedAsync (·.setDiagnostics diag)
namespace Environment
@@ -1009,27 +1464,9 @@ def isNamespace (env : Environment) (n : Name) : Bool :=
def getNamespaceSet (env : Environment) : NameSSet :=
namespacesExt.getState env
private def isNamespaceName : Name Bool
| .str .anonymous _ => true
| .str p _ => isNamespaceName p
| _ => false
private def registerNamePrefixes : Environment Name Environment
| env, .str p _ => if isNamespaceName p then registerNamePrefixes (registerNamespace env p) p else env
| env, _ => env
@[export lean_environment_add]
private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
let name := cinfo.name
let env := match name with
| .str _ s =>
if s.get 0 == '_' then
-- Do not register namespaces that only contain internal declarations.
env
else
registerNamePrefixes env name
| _ => env
env.addAux cinfo
@[export lean_elab_environment_update_base_after_kernel_add]
private def updateBaseAfterKernelAdd (env : Environment) (kernel : Kernel.Environment) : Environment :=
env.setCheckedSync kernel
@[export lean_display_stats]
def displayStats (env : Environment) : IO Unit := do
@@ -1039,7 +1476,7 @@ def displayStats (env : Environment) : IO Unit := do
IO.println ("number of memory-mapped modules: " ++ toString (env.header.regions.filter (·.isMemoryMapped) |>.size));
IO.println ("number of buckets for imported consts: " ++ toString env.constants.numBuckets);
IO.println ("trust level: " ++ toString env.header.trustLevel);
IO.println ("number of extensions: " ++ toString env.extensions.size);
IO.println ("number of extensions: " ++ toString env.checkedWithoutAsync.extensions.size);
pExtDescrs.forM fun extDescr => do
IO.println ("extension '" ++ toString extDescr.name ++ "'")
let s := extDescr.toEnvExtension.getState env
@@ -1085,27 +1522,33 @@ namespace Kernel
/--
Kernel isDefEq predicate. We use it mainly for debugging purposes.
Recall that the Kernel type checker does not support metavariables.
Recall that the kernel type checker does not support metavariables.
When implementing automation, consider using the `MetaM` methods. -/
-- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
-- `Kernel.Environment` base variant
@[extern "lean_kernel_is_def_eq"]
opaque isDefEq (env : Environment) (lctx : LocalContext) (a b : Expr) : Except KernelException Bool
opaque isDefEq (env : Lean.Environment) (lctx : LocalContext) (a b : Expr) : Except Kernel.Exception Bool
def isDefEqGuarded (env : Environment) (lctx : LocalContext) (a b : Expr) : Bool :=
def isDefEqGuarded (env : Lean.Environment) (lctx : LocalContext) (a b : Expr) : Bool :=
if let .ok result := isDefEq env lctx a b then result else false
/--
Kernel WHNF function. We use it mainly for debugging purposes.
Recall that the Kernel type checker does not support metavariables.
Recall that the kernel type checker does not support metavariables.
When implementing automation, consider using the `MetaM` methods. -/
-- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
-- `Kernel.Environment` base variant
@[extern "lean_kernel_whnf"]
opaque whnf (env : Environment) (lctx : LocalContext) (a : Expr) : Except KernelException Expr
opaque whnf (env : Lean.Environment) (lctx : LocalContext) (a : Expr) : Except Kernel.Exception Expr
/--
Kernel typecheck function. We use it mainly for debugging purposes.
Recall that the Kernel type checker does not support metavariables.
When implementing automation, consider using the `MetaM` methods. -/
-- We use `Lean.Environment` for ease of use; as this is a debugging function, we forgo a
-- `Kernel.Environment` base variant
@[extern "lean_kernel_check"]
opaque check (env : Environment) (lctx : LocalContext) (a : Expr) : Except KernelException Expr
opaque check (env : Lean.Environment) (lctx : LocalContext) (a : Expr) : Except Kernel.Exception Expr
end Kernel

View File

@@ -89,11 +89,11 @@ def ofExcept [Monad m] [MonadError m] [ToMessageData ε] (x : Except ε α) : m
/--
Throw an error exception for the given kernel exception.
-/
def throwKernelException [Monad m] [MonadError m] [MonadOptions m] (ex : KernelException) : m α := do
def throwKernelException [Monad m] [MonadError m] [MonadOptions m] (ex : Kernel.Exception) : m α := do
Lean.throwError <| ex.toMessageData ( getOptions)
/-- Lift from `Except KernelException` to `m` when `m` can throw kernel exceptions. -/
def ofExceptKernelException [Monad m] [MonadError m] [MonadOptions m] (x : Except KernelException α) : m α :=
def ofExceptKernelException [Monad m] [MonadError m] [MonadOptions m] (x : Except Kernel.Exception α) : m α :=
match x with
| .ok a => return a
| .error e => throwKernelException e

View File

@@ -639,7 +639,7 @@ def mkFVar (fvarId : FVarId) : Expr :=
/--
`.mvar mvarId` is now the preferred form.
This function is seldom used, metavariables are often created using functions such
as `mkFresheExprMVar` at `MetaM`.
as `mkFreshExprMVar` at `MetaM`.
-/
def mkMVar (mvarId : MVarId) : Expr :=
.mvar mvarId

View File

@@ -448,6 +448,9 @@ def markAllReported (log : MessageLog) : MessageLog :=
def errorsToWarnings (log : MessageLog) : MessageLog :=
{ unreported := log.unreported.map (fun m => match m.severity with | MessageSeverity.error => { m with severity := MessageSeverity.warning } | _ => m) }
def errorsToInfos (log : MessageLog) : MessageLog :=
{ unreported := log.unreported.map (fun m => match m.severity with | MessageSeverity.error => { m with severity := MessageSeverity.information } | _ => m) }
def getInfoMessages (log : MessageLog) : MessageLog :=
{ unreported := log.unreported.filter fun m => match m.severity with | MessageSeverity.information => true | _ => false }
@@ -537,12 +540,12 @@ macro_rules
def toMessageList (msgs : Array MessageData) : MessageData :=
indentD (MessageData.joinSep msgs.toList m!"\n\n")
namespace KernelException
namespace Kernel.Exception
private def mkCtx (env : Environment) (lctx : LocalContext) (opts : Options) (msg : MessageData) : MessageData :=
MessageData.withContext { env := env, mctx := {}, lctx := lctx, opts := opts } msg
MessageData.withContext { env := .ofKernelEnv env, mctx := {}, lctx := lctx, opts := opts } msg
def toMessageData (e : KernelException) (opts : Options) : MessageData :=
def toMessageData (e : Kernel.Exception) (opts : Options) : MessageData :=
match e with
| unknownConstant env constName => mkCtx env {} opts m!"(kernel) unknown constant '{constName}'"
| alreadyDeclared env constName => mkCtx env {} opts m!"(kernel) constant has already been declared '{.ofConstName constName true}'"
@@ -570,5 +573,5 @@ def toMessageData (e : KernelException) (opts : Options) : MessageData :=
| deepRecursion => "(kernel) deep recursion detected"
| interrupted => "(kernel) interrupted"
end KernelException
end Kernel.Exception
end Lean

View File

@@ -11,14 +11,14 @@ import Lean.Meta.DecLevel
namespace Lean.Meta
/-- Return `id e` -/
/-- Returns `id e` -/
def mkId (e : Expr) : MetaM Expr := do
let type inferType e
let u getLevel type
return mkApp2 (mkConst ``id [u]) type e
/--
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, return
Given `e` s.t. `inferType e` is definitionally equal to `expectedType`, returns
term `@id expectedType e`. -/
def mkExpectedTypeHint (e : Expr) (expectedType : Expr) : MetaM Expr := do
let u getLevel expectedType
@@ -38,13 +38,13 @@ def mkLetFun (x : Expr) (v : Expr) (e : Expr) : MetaM Expr := do
let u2 getLevel ety
return mkAppN (.const ``letFun [u1, u2]) #[α, β, v, f]
/-- Return `a = b`. -/
/-- Returns `a = b`. -/
def mkEq (a b : Expr) : MetaM Expr := do
let aType inferType a
let u getLevel aType
return mkApp3 (mkConst ``Eq [u]) aType a b
/-- Return `HEq a b`. -/
/-- Returns `HEq a b`. -/
def mkHEq (a b : Expr) : MetaM Expr := do
let aType inferType a
let bType inferType b
@@ -52,7 +52,7 @@ def mkHEq (a b : Expr) : MetaM Expr := do
return mkApp4 (mkConst ``HEq [u]) aType a bType b
/--
If `a` and `b` have definitionally equal types, return `Eq a b`, otherwise return `HEq a b`.
If `a` and `b` have definitionally equal types, returns `Eq a b`, otherwise returns `HEq a b`.
-/
def mkEqHEq (a b : Expr) : MetaM Expr := do
let aType inferType a
@@ -63,25 +63,25 @@ def mkEqHEq (a b : Expr) : MetaM Expr := do
else
return mkApp4 (mkConst ``HEq [u]) aType a bType b
/-- Return a proof of `a = a`. -/
/-- Returns a proof of `a = a`. -/
def mkEqRefl (a : Expr) : MetaM Expr := do
let aType inferType a
let u getLevel aType
return mkApp2 (mkConst ``Eq.refl [u]) aType a
/-- Return a proof of `HEq a a`. -/
/-- Returns a proof of `HEq a a`. -/
def mkHEqRefl (a : Expr) : MetaM Expr := do
let aType inferType a
let u getLevel aType
return mkApp2 (mkConst ``HEq.refl [u]) aType a
/-- Given `hp : P` and `nhp : Not P` returns an instance of type `e`. -/
/-- Given `hp : P` and `nhp : Not P`, returns an instance of type `e`. -/
def mkAbsurd (e : Expr) (hp hnp : Expr) : MetaM Expr := do
let p inferType hp
let u getLevel e
return mkApp4 (mkConst ``absurd [u]) p e hp hnp
/-- Given `h : False`, return an instance of type `e`. -/
/-- Given `h : False`, returns an instance of type `e`. -/
def mkFalseElim (e : Expr) (h : Expr) : MetaM Expr := do
let u getLevel e
return mkApp2 (mkConst ``False.elim [u]) e h
@@ -108,7 +108,7 @@ def mkEqSymm (h : Expr) : MetaM Expr := do
return mkApp4 (mkConst ``Eq.symm [u]) α a b h
| none => throwAppBuilderException ``Eq.symm ("equality proof expected" ++ hasTypeMsg h hType)
/-- Given `h₁ : a = b` and `h₂ : b = c` returns a proof of `a = c`. -/
/-- Given `h₁ : a = b` and `h₂ : b = c`, returns a proof of `a = c`. -/
def mkEqTrans (h₁ h₂ : Expr) : MetaM Expr := do
if h₁.isAppOf ``Eq.refl then
return h₂
@@ -185,7 +185,7 @@ def mkHEqOfEq (h : Expr) : MetaM Expr := do
return mkApp4 (mkConst ``heq_of_eq [u]) α a b h
/--
If `e` is `@Eq.refl α a`, return `a`.
If `e` is `@Eq.refl α a`, returns `a`.
-/
def isRefl? (e : Expr) : Option Expr := do
if e.isAppOfArity ``Eq.refl 2 then
@@ -194,7 +194,7 @@ def isRefl? (e : Expr) : Option Expr := do
none
/--
If `e` is `@congrArg α β a b f h`, return `α`, `f` and `h`.
If `e` is `@congrArg α β a b f h`, returns `α`, `f` and `h`.
Also works if `e` can be turned into such an application (e.g. `congrFun`).
-/
def congrArg? (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
@@ -336,13 +336,14 @@ private def withAppBuilderTrace [ToMessageData α] [ToMessageData β]
throw ex
/--
Return the application `constName xs`.
Returns the application `constName xs`.
It tries to fill the implicit arguments before the last element in `xs`.
Remark:
``mkAppM `arbitrary #[α]`` returns `@arbitrary.{u} α` without synthesizing
the implicit argument occurring after `α`.
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]`` returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
Given a `x : ([Decidable p] → Bool) × Nat`, ``mkAppM `Prod.fst #[x]``,
returns `@Prod.fst ([Decidable p] → Bool) Nat x`.
-/
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := do
withAppBuilderTrace constName xs do withNewMCtxDepth do
@@ -465,8 +466,9 @@ def mkPure (monad : Expr) (e : Expr) : MetaM Expr :=
mkAppOptM ``Pure.pure #[monad, none, none, e]
/--
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
Remark: `fieldName` may be a subfield of `s`. -/
`mkProjection s fieldName` returns an expression for accessing field `fieldName` of the structure `s`.
Remark: `fieldName` may be a subfield of `s`.
-/
partial def mkProjection (s : Expr) (fieldName : Name) : MetaM Expr := do
let type inferType s
let type whnf type
@@ -520,11 +522,11 @@ def mkSome (type value : Expr) : MetaM Expr := do
let u getDecLevel type
return mkApp2 (mkConst ``Option.some [u]) type value
/-- Return `Decidable.decide p` -/
/-- Returns `Decidable.decide p` -/
def mkDecide (p : Expr) : MetaM Expr :=
mkAppOptM ``Decidable.decide #[p, none]
/-- Return a proof for `p : Prop` using `decide p` -/
/-- Returns a proof for `p : Prop` using `decide p` -/
def mkDecideProof (p : Expr) : MetaM Expr := do
let decP mkDecide p
let decEqTrue mkEq decP (mkConst ``Bool.true)
@@ -532,59 +534,75 @@ def mkDecideProof (p : Expr) : MetaM Expr := do
let h mkExpectedTypeHint h decEqTrue
mkAppM ``of_decide_eq_true #[h]
/-- Return `a < b` -/
/-- Returns `a < b` -/
def mkLt (a b : Expr) : MetaM Expr :=
mkAppM ``LT.lt #[a, b]
/-- Return `a <= b` -/
/-- Returns `a <= b` -/
def mkLe (a b : Expr) : MetaM Expr :=
mkAppM ``LE.le #[a, b]
/-- Return `Inhabited.default α` -/
/-- Returns `Inhabited.default α` -/
def mkDefault (α : Expr) : MetaM Expr :=
mkAppOptM ``Inhabited.default #[α, none]
/-- Return `@Classical.ofNonempty α _` -/
/-- Returns `@Classical.ofNonempty α _` -/
def mkOfNonempty (α : Expr) : MetaM Expr := do
mkAppOptM ``Classical.ofNonempty #[α, none]
/-- Return `funext h` -/
/-- Returns `funext h` -/
def mkFunExt (h : Expr) : MetaM Expr :=
mkAppM ``funext #[h]
/-- Return `propext h` -/
/-- Returns `propext h` -/
def mkPropExt (h : Expr) : MetaM Expr :=
mkAppM ``propext #[h]
/-- Return `let_congr h₁ h₂` -/
/-- Returns `let_congr h₁ h₂` -/
def mkLetCongr (h₁ h₂ : Expr) : MetaM Expr :=
mkAppM ``let_congr #[h₁, h₂]
/-- Return `let_val_congr b h` -/
/-- Returns `let_val_congr b h` -/
def mkLetValCongr (b h : Expr) : MetaM Expr :=
mkAppM ``let_val_congr #[b, h]
/-- Return `let_body_congr a h` -/
/-- Returns `let_body_congr a h` -/
def mkLetBodyCongr (a h : Expr) : MetaM Expr :=
mkAppM ``let_body_congr #[a, h]
/-- Return `of_eq_true h` -/
def mkOfEqTrue (h : Expr) : MetaM Expr :=
mkAppM ``of_eq_true #[h]
/-- Returns `@of_eq_true p h` -/
def mkOfEqTrueCore (p : Expr) (h : Expr) : Expr :=
match_expr h with
| eq_true _ h => h
| _ => mkApp2 (mkConst ``of_eq_true) p h
/-- Return `eq_true h` -/
def mkEqTrue (h : Expr) : MetaM Expr :=
mkAppM ``eq_true #[h]
/-- Returns `of_eq_true h` -/
def mkOfEqTrue (h : Expr) : MetaM Expr := do
match_expr h with
| eq_true _ h => return h
| _ => mkAppM ``of_eq_true #[h]
/-- Returns `eq_true h` -/
def mkEqTrueCore (p : Expr) (h : Expr) : Expr :=
match_expr h with
| of_eq_true _ h => h
| _ => mkApp2 (mkConst ``eq_true) p h
/-- Returns `eq_true h` -/
def mkEqTrue (h : Expr) : MetaM Expr := do
match_expr h with
| of_eq_true _ h => return h
| _ => return mkApp2 (mkConst ``eq_true) ( inferType h) h
/--
Return `eq_false h`
Returns `eq_false h`
`h` must have type definitionally equal to `¬ p` in the current
reducibility setting. -/
def mkEqFalse (h : Expr) : MetaM Expr :=
mkAppM ``eq_false #[h]
/--
Return `eq_false' h`
Returns `eq_false' h`
`h` must have type definitionally equal to `p → False` in the current
reducibility setting. -/
def mkEqFalse' (h : Expr) : MetaM Expr :=
@@ -602,7 +620,7 @@ def mkImpDepCongrCtx (h₁ h₂ : Expr) : MetaM Expr :=
def mkForallCongr (h : Expr) : MetaM Expr :=
mkAppM ``forall_congr #[h]
/-- Return instance for `[Monad m]` if there is one -/
/-- Returns instance for `[Monad m]` if there is one -/
def isMonad? (m : Expr) : MetaM (Option Expr) :=
try
let monadType mkAppM `Monad #[m]
@@ -613,52 +631,52 @@ def isMonad? (m : Expr) : MetaM (Option Expr) :=
catch _ =>
pure none
/-- Return `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
/-- Returns `(n : type)`, a numeric literal of type `type`. The method fails if we don't have an instance `OfNat type n` -/
def mkNumeral (type : Expr) (n : Nat) : MetaM Expr := do
let u getDecLevel type
let inst synthInstance (mkApp2 (mkConst ``OfNat [u]) type (mkRawNatLit n))
return mkApp3 (mkConst ``OfNat.ofNat [u]) type (mkRawNatLit n) inst
/--
Return `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
We use heterogeneous operators to ensure we have a uniform representation.
-/
Returns `a op b`, where `op` has name `opName` and is implemented using the typeclass `className`.
This method assumes `a` and `b` have the same type, and typeclass `className` is heterogeneous.
Examples of supported classes: `HAdd`, `HSub`, `HMul`.
We use heterogeneous operators to ensure we have a uniform representation.
-/
private def mkBinaryOp (className : Name) (opName : Name) (a b : Expr) : MetaM Expr := do
let aType inferType a
let u getDecLevel aType
let inst synthInstance (mkApp3 (mkConst className [u, u, u]) aType aType aType)
return mkApp6 (mkConst opName [u, u, u]) aType aType aType inst a b
/-- Return `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
/-- Returns `a + b` using a heterogeneous `+`. This method assumes `a` and `b` have the same type. -/
def mkAdd (a b : Expr) : MetaM Expr := mkBinaryOp ``HAdd ``HAdd.hAdd a b
/-- Return `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
/-- Returns `a - b` using a heterogeneous `-`. This method assumes `a` and `b` have the same type. -/
def mkSub (a b : Expr) : MetaM Expr := mkBinaryOp ``HSub ``HSub.hSub a b
/-- Return `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
/-- Returns `a * b` using a heterogeneous `*`. This method assumes `a` and `b` have the same type. -/
def mkMul (a b : Expr) : MetaM Expr := mkBinaryOp ``HMul ``HMul.hMul a b
/--
Return `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
This method assumes `a` and `b` have the same type.
Examples of supported classes: `LE` and `LT`.
We use heterogeneous operators to ensure we have a uniform representation.
-/
Returns `a r b`, where `r` has name `rName` and is implemented using the typeclass `className`.
This method assumes `a` and `b` have the same type.
Examples of supported classes: `LE` and `LT`.
We use heterogeneous operators to ensure we have a uniform representation.
-/
private def mkBinaryRel (className : Name) (rName : Name) (a b : Expr) : MetaM Expr := do
let aType inferType a
let u getDecLevel aType
let inst synthInstance (mkApp (mkConst className [u]) aType)
return mkApp4 (mkConst rName [u]) aType inst a b
/-- Return `a ≤ b`. This method assumes `a` and `b` have the same type. -/
/-- Returns `a ≤ b`. This method assumes `a` and `b` have the same type. -/
def mkLE (a b : Expr) : MetaM Expr := mkBinaryRel ``LE ``LE.le a b
/-- Return `a < b`. This method assumes `a` and `b` have the same type. -/
/-- Returns `a < b`. This method assumes `a` and `b` have the same type. -/
def mkLT (a b : Expr) : MetaM Expr := mkBinaryRel ``LT ``LT.lt a b
/-- Given `h : a = b`, return a proof for `a ↔ b`. -/
/-- Given `h : a = b`, returns a proof for `a ↔ b`. -/
def mkIffOfEq (h : Expr) : MetaM Expr := do
if h.isAppOfArity ``propext 3 then
return h.appArg!

View File

@@ -1964,15 +1964,22 @@ def sortFVarIds (fvarIds : Array FVarId) : MetaM (Array FVarId) := do
end Methods
/--
Return `some info` if `declName` is an inductive predicate where `info : InductiveVal`.
That is, `inductive` type in `Prop`.
-/
def isInductivePredicate? (declName : Name) : MetaM (Option InductiveVal) := do
match ( getEnv).find? declName with
| some (.inductInfo info) =>
forallTelescopeReducing info.type fun _ type => do
match ( whnfD type) with
| .sort u .. => if u == levelZero then return some info else return none
| _ => return none
| _ => return none
/-- Return `true` if `declName` is an inductive predicate. That is, `inductive` type in `Prop`. -/
def isInductivePredicate (declName : Name) : MetaM Bool := do
match ( getEnv).find? declName with
| some (.inductInfo { type := type, ..}) =>
forallTelescopeReducing type fun _ type => do
match ( whnfD type) with
| .sort u .. => return u == levelZero
| _ => return false
| _ => return false
return ( isInductivePredicate? declName).isSome
def isListLevelDefEqAux : List Level List Level MetaM Bool
| [], [] => return true

View File

@@ -9,13 +9,13 @@ import Lean.Meta.Basic
namespace Lean
@[extern "lean_mk_cases_on"] opaque mkCasesOnImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
@[extern "lean_mk_cases_on"] opaque mkCasesOnImp (env : Kernel.Environment) (declName : @& Name) : Except Kernel.Exception Declaration
open Meta
def mkCasesOn (declName : Name) : MetaM Unit := do
let name := mkCasesOnName declName
let decl ofExceptKernelException (mkCasesOnImp ( getEnv) declName)
let decl ofExceptKernelException (mkCasesOnImp ( getEnv).toKernelEnv declName)
addDecl decl
setReducibleAttribute name
modifyEnv fun env => markAuxRecursor env name

View File

@@ -10,8 +10,8 @@ import Lean.Meta.CompletionName
namespace Lean
@[extern "lean_mk_no_confusion_type"] opaque mkNoConfusionTypeCoreImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
@[extern "lean_mk_no_confusion"] opaque mkNoConfusionCoreImp (env : Environment) (declName : @& Name) : Except KernelException Declaration
@[extern "lean_mk_no_confusion_type"] opaque mkNoConfusionTypeCoreImp (env : Environment) (declName : @& Name) : Except Kernel.Exception Declaration
@[extern "lean_mk_no_confusion"] opaque mkNoConfusionCoreImp (env : Environment) (declName : @& Name) : Except Kernel.Exception Declaration
open Meta

View File

@@ -72,12 +72,12 @@ def mkDiagSynthPendingFailure (failures : PHashMap Expr MessageData) : MetaM Dia
/--
We use below that this returns `m` unchanged if `s.isEmpty`
-/
def appendSection (m : MessageData) (cls : Name) (header : String) (s : DiagSummary) (resultSummary := true) : MessageData :=
def appendSection (m : Array MessageData) (cls : Name) (header : String) (s : DiagSummary) (resultSummary := true) : Array MessageData :=
if s.isEmpty then
m
else
let header := if resultSummary then s!"{header} (max: {s.max}, num: {s.data.size}):" else header
m ++ .trace { cls } header s.data
m.push <| .trace { cls } header s.data
def reportDiag : MetaM Unit := do
if ( isDiagnosticsEnabled) then
@@ -89,7 +89,7 @@ def reportDiag : MetaM Unit := do
let inst mkDiagSummaryForUsedInstances
let synthPending mkDiagSynthPendingFailure ( get).diag.synthPendingFailures
let unfoldKernel mkDiagSummary `kernel (Kernel.getDiagnostics ( getEnv)).unfoldCounter
let m := MessageData.nil
let m := #[]
let m := appendSection m `reduction "unfolded declarations" unfoldDefault
let m := appendSection m `reduction "unfolded instances" unfoldInstance
let m := appendSection m `reduction "unfolded reducible declarations" unfoldReducible
@@ -99,8 +99,8 @@ def reportDiag : MetaM Unit := do
synthPending (resultSummary := false)
let m := appendSection m `def_eq "heuristic for solving `f a =?= f b`" heu
let m := appendSection m `kernel "unfolded declarations" unfoldKernel
unless m matches .nil do
let m := m ++ "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
logInfo m
unless m.isEmpty do
let m := m.push "use `set_option diagnostics.threshold <num>` to control threshold for reporting counters"
logInfo <| .trace { cls := `diag, collapsed := false } "Diagnostics" m
end Lean.Meta

View File

@@ -1233,10 +1233,7 @@ private def processAssignment' (mvarApp : Expr) (v : Expr) : MetaM Bool := do
private def isDeltaCandidate? (t : Expr) : MetaM (Option ConstantInfo) := do
match t.getAppFn with
| .const c _ =>
match ( getUnfoldableConst? c) with
| r@(some info) => if info.hasValue then return r else return none
| _ => return none
| .const c _ => getUnfoldableConst? c
| _ => pure none
/-- Auxiliary method for isDefEqDelta -/

View File

@@ -30,7 +30,7 @@ def canUnfold (info : ConstantInfo) : MetaM Bool := do
/--
Look up a constant name, returning the `ConstantInfo`
if it should be unfolded at the current reducibility settings,
if it is a def/theorem that should be unfolded at the current reducibility settings,
or `none` otherwise.
This is part of the implementation of `whnf`.
@@ -40,7 +40,7 @@ def getUnfoldableConst? (constName : Name) : MetaM (Option ConstantInfo) := do
match ( getEnv).find? constName with
| some (info@(.thmInfo _)) => getTheoremInfo info
| some (info@(.defnInfo _)) => if ( canUnfold info) then return info else return none
| some info => return some info
| some _ => return none
| none => throwUnknownConstant constName
/--
@@ -50,7 +50,6 @@ def getUnfoldableConstNoEx? (constName : Name) : MetaM (Option ConstantInfo) :=
match ( getEnv).find? constName with
| some (info@(.thmInfo _)) => getTheoremInfo info
| some (info@(.defnInfo _)) => if ( canUnfold info) then return info else return none
| some info => return some info
| none => return none
| _ => return none
end Meta

View File

@@ -296,7 +296,7 @@ where
m.apply recursor
applyCtors (ms : List MVarId) : MetaM $ List MVarId := do
let mss ms.toArray.mapIdxM fun _ m => do
let mss ms.toArray.mapM fun m => do
let m introNPRec m
( m.getType).withApp fun below args =>
m.withContext do

View File

@@ -41,3 +41,4 @@ import Lean.Meta.Tactic.FunInd
import Lean.Meta.Tactic.Rfl
import Lean.Meta.Tactic.Rewrites
import Lean.Meta.Tactic.Grind
import Lean.Meta.Tactic.Ext

View File

@@ -0,0 +1,76 @@
/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Mario Carneiro
-/
prelude
import Init.Data.Array.InsertionSort
import Lean.Meta.DiscrTree
namespace Lean.Meta.Ext
/-!
### Environment extension for `ext` theorems
-/
/-- Information about an extensionality theorem, stored in the environment extension. -/
structure ExtTheorem where
/-- Declaration name of the extensionality theorem. -/
declName : Name
/-- Priority of the extensionality theorem. -/
priority : Nat
/--
Key in the discrimination tree,
for the type in which the extensionality theorem holds.
-/
keys : Array DiscrTree.Key
deriving Inhabited, Repr, BEq, Hashable
/-- The state of the `ext` extension environment -/
structure ExtTheorems where
/-- The tree of `ext` extensions. -/
tree : DiscrTree ExtTheorem := {}
/-- Erased `ext`s via `attribute [-ext]`. -/
erased : PHashSet Name := {}
deriving Inhabited
/-- The environment extension to track `@[ext]` theorems. -/
builtin_initialize extExtension :
SimpleScopedEnvExtension ExtTheorem ExtTheorems
registerSimpleScopedEnvExtension {
addEntry := fun { tree, erased } thm =>
{ tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName }
initial := {}
}
/-- Gets the list of `@[ext]` theorems corresponding to the key `ty`,
ordered from high priority to low. -/
@[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
let extTheorems := extExtension.getState ( getEnv)
let arr extTheorems.tree.getMatch ty
let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
-- Using insertion sort because it is stable and the list of matches should be mostly sorted.
-- Most ext theorems have default priority.
return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse
/--
Erases a name marked `ext` by adding it to the state's `erased` field and
removing it from the state's list of `Entry`s.
This is triggered by `attribute [-ext] name`.
-/
def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
{ d with erased := d.erased.insert declName }
/--
Erases a name marked as a `ext` attribute.
Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
found somewhere in the state's tree, and is not erased.
-/
def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
m ExtTheorems := do
unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do
throwError "'{declName}' does not have [ext] attribute"
return d.eraseCore declName
end Lean.Meta.Ext

View File

@@ -35,7 +35,7 @@ def insert (s : FVarSubst) (fvarId : FVarId) (v : Expr) : FVarSubst :=
if s.contains fvarId then s
else
let map := s.map.mapVal fun e => e.replaceFVarId fvarId v;
{ map := map.insert fvarId v }
{ map := map.insertNew fvarId v }
def erase (s : FVarSubst) (fvarId : FVarId) : FVarSubst :=
{ map := s.map.erase fvarId }

View File

@@ -24,6 +24,8 @@ import Lean.Meta.Tactic.Grind.EMatchTheorem
import Lean.Meta.Tactic.Grind.EMatch
import Lean.Meta.Tactic.Grind.Main
import Lean.Meta.Tactic.Grind.CasesMatch
import Lean.Meta.Tactic.Grind.Arith
import Lean.Meta.Tactic.Grind.Ext
namespace Lean
@@ -37,11 +39,21 @@ builtin_initialize registerTraceClass `grind.ematch.pattern
builtin_initialize registerTraceClass `grind.ematch.pattern.search
builtin_initialize registerTraceClass `grind.ematch.instance
builtin_initialize registerTraceClass `grind.ematch.instance.assignment
builtin_initialize registerTraceClass `grind.eqResolution
builtin_initialize registerTraceClass `grind.issues
builtin_initialize registerTraceClass `grind.simp
builtin_initialize registerTraceClass `grind.split
builtin_initialize registerTraceClass `grind.split.candidate
builtin_initialize registerTraceClass `grind.split.resolved
builtin_initialize registerTraceClass `grind.offset
builtin_initialize registerTraceClass `grind.offset.dist
builtin_initialize registerTraceClass `grind.offset.internalize
builtin_initialize registerTraceClass `grind.offset.internalize.term (inherited := true)
builtin_initialize registerTraceClass `grind.offset.propagate
builtin_initialize registerTraceClass `grind.offset.eq
builtin_initialize registerTraceClass `grind.offset.eq.to (inherited := true)
builtin_initialize registerTraceClass `grind.offset.eq.from (inherited := true)
builtin_initialize registerTraceClass `grind.beta
/-! Trace options for `grind` developers -/
builtin_initialize registerTraceClass `grind.debug
@@ -54,4 +66,9 @@ builtin_initialize registerTraceClass `grind.debug.final
builtin_initialize registerTraceClass `grind.debug.forallPropagator
builtin_initialize registerTraceClass `grind.debug.split
builtin_initialize registerTraceClass `grind.debug.canon
builtin_initialize registerTraceClass `grind.debug.offset
builtin_initialize registerTraceClass `grind.debug.offset.proof
builtin_initialize registerTraceClass `grind.debug.ematch.pattern
builtin_initialize registerTraceClass `grind.debug.beta
end Lean

View File

@@ -0,0 +1,10 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Arith.Util
import Lean.Meta.Tactic.Grind.Arith.Types
import Lean.Meta.Tactic.Grind.Arith.Offset
import Lean.Meta.Tactic.Grind.Arith.Main

View File

@@ -0,0 +1,14 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Arith.Offset
namespace Lean.Meta.Grind.Arith
def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
Offset.internalize e parent?
end Lean.Meta.Grind.Arith

View File

@@ -0,0 +1,14 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Arith.Offset
namespace Lean.Meta.Grind.Arith
def checkInvariants : GoalM Unit :=
Offset.checkInvariants
end Lean.Meta.Grind.Arith

View File

@@ -0,0 +1,34 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.PropagatorAttr
import Lean.Meta.Tactic.Grind.Arith.Offset
namespace Lean.Meta.Grind.Arith
namespace Offset
def isCnstr? (e : Expr) : GoalM (Option (Cnstr NodeId)) :=
return ( get).arith.offset.cnstrs.find? { expr := e }
def assertTrue (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
addEdge c.u c.v c.k ( mkOfEqTrue p)
def assertFalse (c : Cnstr NodeId) (p : Expr) : GoalM Unit := do
let p := mkOfNegEqFalse ( get').nodes c p
let c := c.neg
addEdge c.u c.v c.k p
end Offset
builtin_grind_propagator propagateLE LE.le := fun e => do
if ( isEqTrue e) then
if let some c Offset.isCnstr? e then
Offset.assertTrue c ( mkEqTrueProof e)
if ( isEqFalse e) then
if let some c Offset.isCnstr? e then
Offset.assertFalse c ( mkEqFalseProof e)
end Lean.Meta.Grind.Arith

View File

@@ -0,0 +1,46 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Basic
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Util
namespace Lean.Meta.Grind.Arith.Offset
/-- Construct a model that statisfies all offset constraints -/
def mkModel (goal : Goal) : MetaM (Array (Expr × Nat)) := do
let s := goal.arith.offset
let nodes := s.nodes
let mut pre : Array (Option Int) := mkArray nodes.size none
for u in [:nodes.size] do
let val? := s.sources[u]!.foldl (init := @none Int) fun val? v k => Id.run do
let some va := pre[v]! | return val?
let val' := va - k
let some val := val? | return val'
if val' > val then return val' else val?
let val? := s.targets[u]!.foldl (init := val?) fun val? v k => Id.run do
let some va := pre[v]! | return val?
let val' := va + k
let some val := val? | return val'
if val' < val then return val' else val?
let val := val?.getD 0
pre := pre.set! u (some val)
let min := pre.foldl (init := 0) fun min val? => Id.run do
let some val := val? | return min
if val < min then val else min
let mut r := {}
for u in [:nodes.size] do
let some val := pre[u]! | unreachable!
let val := (val - min).toNat
let e := nodes[u]!
/-
We should not include the assignment for auxiliary offset terms since
they do not provide any additional information.
-/
if (isNatOffset? e).isNone && isNatNum? e != some 0 then
r := r.push (e, val)
return r
end Lean.Meta.Grind.Arith.Offset

View File

@@ -0,0 +1,335 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Offset
import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Arith.ProofUtil
namespace Lean.Meta.Grind.Arith.Offset
/-!
This module implements a decision procedure for offset constraints of the form:
```
x + k ≤ y
x ≤ y + k
```
where `k` is a numeral.
Each constraint is represented as an edge in a weighted graph.
The constraint `x + k ≤ y` is represented as a negative edge.
The shortest path between two nodes in the graph corresponds to an implied inequality.
When adding a new edge, the state is considered unsatisfiable if the new edge creates a negative cycle.
An incremental Floyd-Warshall algorithm is used to find the shortest paths between all nodes.
This module can also handle offset equalities of the form `x + k = y` by representing them with two edges:
```
x + k ≤ y
y ≤ x + k
```
The main advantage of this module over a full linear integer arithmetic procedure is
its ability to efficiently detect all implied equalities and inequalities.
-/
def get' : GoalM State := do
return ( get).arith.offset
@[inline] def modify' (f : State State) : GoalM Unit := do
modify fun s => { s with arith.offset := f s.arith.offset }
def mkNode (expr : Expr) : GoalM NodeId := do
if let some nodeId := ( get').nodeMap.find? { expr } then
return nodeId
let nodeId : NodeId := ( get').nodes.size
trace[grind.offset.internalize.term] "{expr} ↦ #{nodeId}"
modify' fun s => { s with
nodes := s.nodes.push expr
nodeMap := s.nodeMap.insert { expr } nodeId
sources := s.sources.push {}
targets := s.targets.push {}
proofs := s.proofs.push {}
}
markAsOffsetTerm expr
return nodeId
private def getExpr (u : NodeId) : GoalM Expr := do
return ( get').nodes[u]!
private def getDist? (u v : NodeId) : GoalM (Option Int) := do
return ( get').targets[u]!.find? v
private def getProof? (u v : NodeId) : GoalM (Option ProofInfo) := do
return ( get').proofs[u]!.find? v
private def getNodeId (e : Expr) : GoalM NodeId := do
let some nodeId := ( get').nodeMap.find? { expr := e }
| throwError "internal `grind` error, term has not been internalized by offset module{indentExpr e}"
return nodeId
/--
Returns a proof for `u + k ≤ v` (or `u ≤ v + k`) where `k` is the
shortest path between `u` and `v`.
-/
private partial def mkProofForPath (u v : NodeId) : GoalM Expr := do
go ( getProof? u v).get!
where
go (p : ProofInfo) : GoalM Expr := do
if u == p.w then
return p.proof
else
let p' := ( getProof? u p.w).get!
go (mkTrans ( get').nodes p' p v)
/--
Given a new edge edge `u --(kuv)--> v` justified by proof `huv` s.t.
it creates a negative cycle with the existing path `v --{kvu}-->* u`, i.e., `kuv + kvu < 0`,
this function closes the current goal by constructing a proof of `False`.
-/
private def setUnsat (u v : NodeId) (kuv : Int) (huv : Expr) (kvu : Int) : GoalM Unit := do
assert! kuv + kvu < 0
let hvu mkProofForPath v u
let u getExpr u
let v getExpr v
closeGoal (mkUnsatProof u v kuv huv kvu hvu)
/-- Sets the new shortest distance `k` between nodes `u` and `v`. -/
private def setDist (u v : NodeId) (k : Int) : GoalM Unit := do
trace[grind.offset.dist] "{({ u, v, k : Cnstr NodeId})}"
modify' fun s => { s with
targets := s.targets.modify u fun es => es.insert v k
sources := s.sources.modify v fun es => es.insert u k
}
private def setProof (u v : NodeId) (p : ProofInfo) : GoalM Unit := do
modify' fun s => { s with
proofs := s.proofs.modify u fun es => es.insert v p
}
@[inline]
private def forEachSourceOf (u : NodeId) (f : NodeId Int GoalM Unit) : GoalM Unit := do
( get').sources[u]!.forM f
@[inline]
private def forEachTargetOf (u : NodeId) (f : NodeId Int GoalM Unit) : GoalM Unit := do
( get').targets[u]!.forM f
/-- Returns `true` if `k` is smaller than the shortest distance between `u` and `v` -/
private def isShorter (u v : NodeId) (k : Int) : GoalM Bool := do
if let some k' getDist? u v then
return k < k'
else
return true
/--
Tries to assign `e` to `True`, which is represented by constraint `c` (from `u` to `v`), using the
path `u --(k)--> v`.
-/
private def propagateTrue (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
if k c.k then
trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = True"
let kuv mkProofForPath u v
let u getExpr u
let v getExpr v
pushEqTrue e <| mkPropagateEqTrueProof u v k kuv c.k
return true
return false
/--
Tries to assign `e` to `False`, which is represented by constraint `c` (from `v` to `u`), using the
path `u --(k)--> v`.
-/
private def propagateFalse (u v : NodeId) (k : Int) (c : Cnstr NodeId) (e : Expr) : GoalM Bool := do
if k + c.k < 0 then
trace[grind.offset.propagate] "{{ u, v, k : Cnstr NodeId}} ==> {e} = False"
let kuv mkProofForPath u v
let u getExpr u
let v getExpr v
pushEqFalse e <| mkPropagateEqFalseProof u v k kuv c.k
return false
/--
Auxiliary function for implementing `propagateAll`.
Traverses the constraints `c` (representing an expression `e`) s.t.
`c.u = u` and `c.v = v`, it removes `c` from the list of constraints
associated with `(u, v)` IF
- `e` is already assigned, or
- `f c e` returns true
-/
@[inline]
private def updateCnstrsOf (u v : NodeId) (f : Cnstr NodeId Expr GoalM Bool) : GoalM Unit := do
if let some cs := ( get').cnstrsOf.find? (u, v) then
let cs' cs.filterM fun (c, e) => do
if ( isEqTrue e <||> isEqFalse e) then
return false -- constraint was already assigned
else
return !( f c e)
modify' fun s => { s with cnstrsOf := s.cnstrsOf.insert (u, v) cs' }
/-- Equality propagation. -/
private def propagateEq (u v : NodeId) (k : Int) : GoalM Unit := do
if k != 0 then return ()
let some k' getDist? v u | return ()
if k' != 0 then return ()
let ue getExpr u
let ve getExpr v
if ( isEqv ue ve) then return ()
let huv mkProofForPath u v
let hvu mkProofForPath v u
trace[grind.offset.eq.from] "{ue}, {ve}"
pushEq ue ve <| mkApp4 (mkConst ``Grind.Nat.eq_of_le_of_le) ue ve huv hvu
/-- Performs constraint propagation. -/
private def propagateAll (u v : NodeId) (k : Int) : GoalM Unit := do
updateCnstrsOf u v fun c e => return !( propagateTrue u v k c e)
updateCnstrsOf v u fun c e => return !( propagateFalse u v k c e)
propagateEq u v k
/--
If `isShorter u v k`, updates the shortest distance between `u` and `v`.
`w` is the penultimate node in the path from `u` to `v`.
-/
private def updateIfShorter (u v : NodeId) (k : Int) (w : NodeId) : GoalM Unit := do
if ( isShorter u v k) then
setDist u v k
setProof u v ( getProof? w v).get!
propagateAll u v k
/--
Adds an edge `u --(k) --> v` justified by the proof term `p`, and then
if no negative cycle was created, updates the shortest distance of affected
node pairs.
-/
def addEdge (u : NodeId) (v : NodeId) (k : Int) (p : Expr) : GoalM Unit := do
if ( isInconsistent) then return ()
if let some k' getDist? v u then
if k'+k < 0 then
setUnsat u v k p k'
return ()
if ( isShorter u v k) then
setDist u v k
setProof u v { w := u, k, proof := p }
propagateAll u v k
update
where
update : GoalM Unit := do
forEachTargetOf v fun j k₂ => do
/- Check whether new path: `u -(k)-> v -(k₂)-> j` is shorter -/
updateIfShorter u j (k+k₂) v
forEachSourceOf u fun i k₁ => do
/- Check whether new path: `i -(k₁)-> u -(k)-> v` is shorter -/
updateIfShorter i v (k₁+k) u
forEachTargetOf v fun j k₂ => do
/- Check whether new path: `i -(k₁)-> u -(k)-> v -(k₂) -> j` is shorter -/
updateIfShorter i j (k₁+k+k₂) v
private def internalizeCnstr (e : Expr) (c : Cnstr Expr) : GoalM Unit := do
let u mkNode c.u
let v mkNode c.v
let c := { c with u, v }
if let some k getDist? u v then
if ( propagateTrue u v k c e) then
return ()
if let some k getDist? v u then
if ( propagateFalse v u k c e) then
return ()
trace[grind.offset.internalize] "{e} ↦ {c}"
modify' fun s => { s with
cnstrs := s.cnstrs.insert { expr := e } c
cnstrsOf :=
let cs := if let some cs := s.cnstrsOf.find? (u, v) then (c, e) :: cs else [(c, e)]
s.cnstrsOf.insert (u, v) cs
}
private def getZeroNode : GoalM NodeId := do
mkNode ( getNatZeroExpr)
/-- Internalize `e` of the form `b + k` -/
private def internalizeTerm (e : Expr) (b : Expr) (k : Nat) : GoalM Unit := do
-- `e` is of the form `b + k`
let u mkNode e
let v mkNode b
-- `u = v + k`. So, we add edges for `u ≤ v + k` and `v + k ≤ u`.
let h := mkApp (mkConst ``Nat.le_refl) e
addEdge u v k h
addEdge v u (-k) h
-- `0 + k ≤ u`
let z getZeroNode
addEdge z u (-k) <| mkApp2 (mkConst ``Grind.Nat.le_offset) b (toExpr k)
/--
Returns `true`, if `parent?` is relevant for internalization.
For example, we do not want to internalize an offset term that
is the child of an addition. This kind of term will be processed by the
more general linear arithmetic module.
-/
private def isRelevantParent (parent? : Option Expr) : GoalM Bool := do
let some parent := parent? | return false
let z getNatZeroExpr
return !isNatAdd parent && (isNatOffsetCnstr? parent z).isNone
private def isEqParent (parent? : Option Expr) : Bool := Id.run do
let some parent := parent? | return false
return parent.isEq
def internalize (e : Expr) (parent? : Option Expr) : GoalM Unit := do
let z getNatZeroExpr
if let some c := isNatOffsetCnstr? e z then
internalizeCnstr e c
else if ( isRelevantParent parent?) then
if let some (b, k) := isNatOffset? e then
internalizeTerm e b k
else if let some k := isNatNum? e then
-- core module has support for detecting equality between literals
unless isEqParent parent? do
internalizeTerm e z k
@[export lean_process_new_offset_eq]
def processNewOffsetEqImpl (a b : Expr) : GoalM Unit := do
unless isSameExpr a b do
trace[grind.offset.eq.to] "{a}, {b}"
let u getNodeId a
let v getNodeId b
let h mkEqProof a b
addEdge u v 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
addEdge v u 0 <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
@[export lean_process_new_offset_eq_lit]
def processNewOffsetEqLitImpl (a b : Expr) : GoalM Unit := do
unless isSameExpr a b do
trace[grind.offset.eq.to] "{a}, {b}"
let some k := isNatNum? b | unreachable!
let u getNodeId a
let z mkNode ( getNatZeroExpr)
let h mkEqProof a b
addEdge u z k <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_1) a b h
addEdge z u (-k) <| mkApp3 (mkConst ``Grind.Nat.le_of_eq_2) a b h
def traceDists : GoalM Unit := do
let s get'
for u in [:s.targets.size], es in s.targets.toArray do
for (v, k) in es do
trace[grind.offset.dist] "#{u} -({k})-> #{v}"
def Cnstr.toExpr (c : Cnstr NodeId) : GoalM Expr := do
let u := ( get').nodes[c.u]!
let v := ( get').nodes[c.v]!
if c.k == 0 then
return mkNatLE u v
else if c.k < 0 then
return mkNatLE (mkNatAdd u (Lean.toExpr ((-c.k).toNat))) v
else
return mkNatLE u (mkNatAdd v (Lean.toExpr c.k.toNat))
def checkInvariants : GoalM Unit := do
let s get'
for u in [:s.targets.size], es in s.targets.toArray do
for (v, k) in es do
let c : Cnstr NodeId := { u, v, k }
trace[grind.debug.offset] "{c}"
let p mkProofForPath u v
trace[grind.debug.offset.proof] "{p} : {← inferType p}"
check p
unless ( withDefault <| isDefEq ( inferType p) ( Cnstr.toExpr c)) do
trace[grind.debug.offset.proof] "failed: {← inferType p} =?= {← Cnstr.toExpr c}"
unreachable!
end Lean.Meta.Grind.Arith.Offset

View File

@@ -0,0 +1,168 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Grind.Offset
import Init.Grind.Lemmas
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind.Arith
/-!
Helper functions for constructing proof terms in the arithmetic procedures.
-/
namespace Offset
/-- Returns a proof for `true = true` -/
def rfl_true : Expr := mkConst ``Grind.rfl_true
private def toExprN (n : Int) :=
assert! n >= 0
toExpr n.toNat
open Lean.Grind in
/--
Assume `pi₁` is `{ w := u, k := k₁, proof := p₁ }` and `pi₂` is `{ w := w, k := k₂, proof := p₂ }`
`p₁` is the proof for edge `u -(k₁) → w` and `p₂` the proof for edge `w -(k₂)-> v`.
Then, this function returns a proof for edge `u -(k₁+k₂) -> v`.
-/
def mkTrans (nodes : PArray Expr) (pi₁ : ProofInfo) (pi₂ : ProofInfo) (v : NodeId) : ProofInfo :=
let { w := u, k := k₁, proof := p₁ } := pi₁
let { w, k := k₂, proof := p₂ } := pi₂
let u := nodes[u]!
let w := nodes[w]!
let v := nodes[v]!
let p := if k₁ == 0 then
if k₂ == 0 then
-- u ≤ w, w ≤ v
mkApp5 (mkConst ``Nat.le_trans) u w v p₁ p₂
else if k₂ > 0 then
-- u ≤ v, w ≤ v + k₂
mkApp6 (mkConst ``Nat.le_ro) u w v (toExprN k₂) p₁ p₂
else
let k₂ := - k₂
-- u ≤ w, w + k₂ ≤ v
mkApp6 (mkConst ``Nat.le_lo) u w v (toExprN k₂) p₁ p₂
else if k₁ < 0 then
let k₁ := -k₁
if k₂ == 0 then
mkApp6 (mkConst ``Nat.lo_le) u w v (toExprN k₁) p₁ p₂
else if k₂ < 0 then
let k₂ := -k₂
mkApp7 (mkConst ``Nat.lo_lo) u w v (toExprN k₁) (toExprN k₂) p₁ p₂
else
let ke₁ := toExprN k₁
let ke₂ := toExprN k₂
if k₁ > k₂ then
mkApp8 (mkConst ``Nat.lo_ro_1) u w v ke₁ ke₂ rfl_true p₁ p₂
else
mkApp7 (mkConst ``Nat.lo_ro_2) u w v ke₁ ke₂ p₁ p₂
else
let ke₁ := toExprN k₁
if k₂ == 0 then
mkApp6 (mkConst ``Nat.ro_le) u w v ke₁ p₁ p₂
else if k₂ < 0 then
let k₂ := -k₂
let ke₂ := toExprN k₂
if k₂ > k₁ then
mkApp8 (mkConst ``Nat.ro_lo_2) u w v ke₁ ke₂ rfl_true p₁ p₂
else
mkApp7 (mkConst ``Nat.ro_lo_1) u w v ke₁ ke₂ p₁ p₂
else
let ke₂ := toExprN k₂
mkApp7 (mkConst ``Nat.ro_ro) u w v ke₁ ke₂ p₁ p₂
{ w := pi₁.w, k := k₁+k₂, proof := p }
open Lean.Grind in
def mkOfNegEqFalse (nodes : PArray Expr) (c : Cnstr NodeId) (h : Expr) : Expr :=
let u := nodes[c.u]!
let v := nodes[c.v]!
if c.k == 0 then
mkApp3 (mkConst ``Nat.of_le_eq_false) u v h
else if c.k == -1 then
mkApp3 (mkConst ``Nat.of_lo_eq_false_1) u v h
else if c.k < 0 then
mkApp4 (mkConst ``Nat.of_lo_eq_false) u v (toExprN (-c.k)) h
else
mkApp4 (mkConst ``Nat.of_ro_eq_false) u v (toExprN c.k) h
/--
Returns a proof of `False` using a negative cycle composed of
- `u --(kuv)--> v` with proof `huv`
- `v --(kvu)--> u` with proof `hvu`
-/
def mkUnsatProof (u v : Expr) (kuv : Int) (huv : Expr) (kvu : Int) (hvu : Expr) : Expr :=
if kuv == 0 then
assert! kvu < 0
mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) u v (toExprN (-kvu)) rfl_true huv hvu
else if kvu == 0 then
mkApp6 (mkConst ``Grind.Nat.unsat_le_lo) v u (toExprN (-kuv)) rfl_true hvu huv
else if kuv < 0 then
if kvu > 0 then
mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) u v (toExprN (-kuv)) (toExprN kvu) rfl_true huv hvu
else
assert! kvu < 0
mkApp7 (mkConst ``Grind.Nat.unsat_lo_lo) u v (toExprN (-kuv)) (toExprN (-kvu)) rfl_true huv hvu
else
assert! kuv > 0 && kvu < 0
mkApp7 (mkConst ``Grind.Nat.unsat_lo_ro) v u (toExprN (-kvu)) (toExprN kuv) rfl_true hvu huv
/--
Given a path `u --(kuv)--> v` justified by proof `huv`,
construct a proof of `e = True` where `e` is a term corresponding to the edgen `u --(k') --> v`
s.t. `k ≤ k'`
-/
def mkPropagateEqTrueProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
if k == 0 then
if k' == 0 then
mkApp3 (mkConst ``Grind.Nat.le_eq_true_of_le) u v huv
else
assert! k' > 0
mkApp4 (mkConst ``Grind.Nat.ro_eq_true_of_le) u v (toExprN k') huv
else if k < 0 then
let k := -k
if k' == 0 then
mkApp4 (mkConst ``Grind.Nat.le_eq_true_of_lo) u v (toExprN k) huv
else if k' < 0 then
let k' := -k'
mkApp6 (mkConst ``Grind.Nat.lo_eq_true_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
else
assert! k' > 0
mkApp5 (mkConst ``Grind.Nat.ro_eq_true_of_lo) u v (toExprN k) (toExprN k') huv
else
assert! k > 0
assert! k' > 0
mkApp6 (mkConst ``Grind.Nat.ro_eq_true_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
/--
Given a path `u --(kuv)--> v` justified by proof `huv`,
construct a proof of `e = False` where `e` is a term corresponding to the edgen `v --(k') --> u`
s.t. `k+k' < 0`
-/
def mkPropagateEqFalseProof (u v : Expr) (k : Int) (huv : Expr) (k' : Int) : Expr :=
if k == 0 then
assert! k' < 0
let k' := -k'
mkApp5 (mkConst ``Grind.Nat.lo_eq_false_of_le) u v (toExprN k') rfl_true huv
else if k < 0 then
let k := -k
if k' == 0 then
mkApp5 (mkConst ``Grind.Nat.le_eq_false_of_lo) u v (toExprN k) rfl_true huv
else if k' < 0 then
let k' := -k'
mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
else
assert! k' > 0
mkApp6 (mkConst ``Grind.Nat.ro_eq_false_of_lo) u v (toExprN k) (toExprN k') rfl_true huv
else
assert! k > 0
assert! k' < 0
let k' := -k'
mkApp6 (mkConst ``Grind.Nat.lo_eq_false_of_ro) u v (toExprN k) (toExprN k') rfl_true huv
end Offset
end Lean.Meta.Grind.Arith

View File

@@ -0,0 +1,66 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Data.PersistentArray
import Lean.Meta.Tactic.Grind.ENodeKey
import Lean.Meta.Tactic.Grind.Arith.Util
namespace Lean.Meta.Grind.Arith
namespace Offset
abbrev NodeId := Nat
instance : ToMessageData (Offset.Cnstr NodeId) where
toMessageData c := Offset.toMessageData (α := NodeId) (inst := { toMessageData n := m!"#{n}" }) c
/-- Auxiliary structure used for proof extraction. -/
structure ProofInfo where
w : NodeId
k : Int
proof : Expr
deriving Inhabited
/-- State of the constraint offset procedure. -/
structure State where
/-- Mapping from `NodeId` to the `Expr` represented by the node. -/
nodes : PArray Expr := {}
/-- Mapping from `Expr` to a node representing it. -/
nodeMap : PHashMap ENodeKey NodeId := {}
/-- Mapping from `Expr` representing inequalites to constraints. -/
cnstrs : PHashMap ENodeKey (Cnstr NodeId) := {}
/--
Mapping from pairs `(u, v)` to a list of offset constraints on `u` and `v`.
We use this mapping to implement exhaustive constraint propagation.
-/
cnstrsOf : PHashMap (NodeId × NodeId) (List (Cnstr NodeId × Expr)) := {}
/--
For each node with id `u`, `sources[u]` contains
pairs `(v, k)` s.t. there is a path from `v` to `u` with weight `k`.
-/
sources : PArray (AssocList NodeId Int) := {}
/--
For each node with id `u`, `targets[u]` contains
pairs `(v, k)` s.t. there is a path from `u` to `v` with weight `k`.
-/
targets : PArray (AssocList NodeId Int) := {}
/--
Proof reconstruction information. For each node with id `u`, `proofs[u]` contains
pairs `(v, { w, proof })` s.t. there is a path from `u` to `v`, and
`w` is the penultimate node in the path, and `proof` is the justification for
the last edge.
-/
proofs : PArray (AssocList NodeId ProofInfo) := {}
deriving Inhabited
end Offset
/-- State for the arithmetic procedures. -/
structure State where
offset : Offset.State := {}
deriving Inhabited
end Lean.Meta.Grind.Arith

View File

@@ -0,0 +1,102 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Expr
import Lean.Message
namespace Lean.Meta.Grind.Arith
/-- Returns `true` if `e` is of the form `Nat` -/
def isNatType (e : Expr) : Bool :=
e.isConstOf ``Nat
/-- Returns `true` if `e` is of the form `@instHAdd Nat instAddNat` -/
def isInstAddNat (e : Expr) : Bool :=
let_expr instHAdd a b := e | false
isNatType a && b.isConstOf ``instAddNat
/-- Returns `true` if `e` is `instLENat` -/
def isInstLENat (e : Expr) : Bool :=
e.isConstOf ``instLENat
/--
Returns `some (a, b)` if `e` is of the form
```
@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) a b
```
-/
def isNatAdd? (e : Expr) : Option (Expr × Expr) :=
let_expr HAdd.hAdd _ _ _ i a b := e | none
if isInstAddNat i then some (a, b) else none
/--
Returns `true` if `e` is of the form
```
@HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) _ _
```
-/
def isNatAdd (e : Expr) : Bool :=
let_expr HAdd.hAdd _ _ _ i _ _ := e | false
isInstAddNat i
/-- Returns `some k` if `e` `@OfNat.ofNat Nat _ (instOfNatNat k)` -/
def isNatNum? (e : Expr) : Option Nat := Id.run do
let_expr OfNat.ofNat _ _ inst := e | none
let_expr instOfNatNat k := inst | none
let .lit (.natVal k) := k | none
some k
/-- Returns `some (a, k)` if `e` is of the form `a + k`. -/
def isNatOffset? (e : Expr) : Option (Expr × Nat) := Id.run do
let some (a, b) := isNatAdd? e | none
let some k := isNatNum? b | none
some (a, k)
/-- An offset constraint. -/
structure Offset.Cnstr (α : Type) where
u : α
v : α
k : Int := 0
deriving Inhabited
def Offset.Cnstr.neg : Cnstr α Cnstr α
| { u, v, k } => { u := v, v := u, k := -k - 1 }
example (c : Offset.Cnstr α) : c.neg.neg = c := by
cases c; simp [Offset.Cnstr.neg]; omega
def Offset.toMessageData [inst : ToMessageData α] (c : Offset.Cnstr α) : MessageData :=
match c.k with
| .ofNat 0 => m!"{c.u} ≤ {c.v}"
| .ofNat k => m!"{c.u} ≤ {c.v} + {k}"
| .negSucc k => m!"{c.u} + {k + 1} ≤ {c.v}"
instance : ToMessageData (Offset.Cnstr Expr) where
toMessageData c := Offset.toMessageData c
/--
Returns `some cnstr` if `e` is offset constraint.
Remark: `z` is `0` numeral. It is an extra argument because we
want to be able to provide the one that has already been internalized.
-/
def isNatOffsetCnstr? (e : Expr) (z : Expr) : Option (Offset.Cnstr Expr) :=
match_expr e with
| LE.le _ inst a b => if isInstLENat inst then go a b else none
| _ => none
where
go (u v : Expr) :=
if let some (u, k) := isNatOffset? u then
some { u, k := - k, v }
else if let some (v, k) := isNatOffset? v then
some { u, v, k }
else if let some k := isNatNum? u then
some { u := z, v, k := - k }
else if let some k := isNatNum? v then
some { u, v := z, k }
else
some { u, v }
end Lean.Meta.Grind.Arith

View File

@@ -10,12 +10,6 @@ import Lean.Meta.Tactic.Simp.Simproc
namespace Lean.Meta.Grind
open Simp
builtin_initialize grindNormExt : SimpExtension
registerSimpAttr `grind_norm "simplification/normalization theorems for `grind`"
builtin_initialize grindNormSimprocExt : SimprocExtension
registerSimprocAttr `grind_norm_proc "simplification/normalization procedured for `grind`" none
builtin_initialize grindCasesExt : SimpleScopedEnvExtension Name NameSet
registerSimpleScopedEnvExtension {
initial := {}

View File

@@ -0,0 +1,77 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
/-- Returns all lambda expressions in the equivalence class with root `root`. -/
def getEqcLambdas (root : ENode) : GoalM (Array Expr) := do
unless root.hasLambdas do return #[]
foldEqc root.self (init := #[]) fun n lams =>
if n.self.isLambda then return lams.push n.self else return lams
/--
Returns the root of the functions in the equivalence class containing `e`.
That is, if `f a` is in `root`s equivalence class, results contains the root of `f`.
-/
def getFnRoots (e : Expr) : GoalM (Array Expr) := do
foldEqc e (init := #[]) fun n fns => do
let fn := n.self.getAppFn
let fnRoot := ( getRoot? fn).getD fn
if Option.isNone <| fns.find? (isSameExpr · fnRoot) then
return fns.push fnRoot
else
return fns
/--
For each `lam` in `lams` s.t. `lam` and `f` are in the same equivalence class,
propagate `f args = lam args`.
-/
def propagateBetaEqs (lams : Array Expr) (f : Expr) (args : Array Expr) : GoalM Unit := do
if args.isEmpty then return ()
for lam in lams do
let rhs := lam.beta args
unless rhs.isLambda do
let mut gen := Nat.max ( getGeneration lam) ( getGeneration f)
let lhs := mkAppN f args
if ( hasSameType f lam) then
let mut h mkEqProof f lam
for arg in args do
gen := Nat.max gen ( getGeneration arg)
h mkCongrFun h arg
let eq mkEq lhs rhs
trace[grind.beta] "{eq}, using {lam}"
addNewFact h eq (gen+1)
private def isPropagateBetaTarget (e : Expr) : GoalM Bool := do
let .app f _ := e | return false
go f
where
go (f : Expr) : GoalM Bool := do
if let some root getRootENode? f then
return root.hasLambdas
let .app f _ := f | return false
go f
/--
Applies beta-reduction for lambdas in `f`s equivalence class.
We use this function while internalizing new applications.
-/
def propagateBetaForNewApp (e : Expr) : GoalM Unit := do
unless ( isPropagateBetaTarget e) do return ()
let mut e := e
let mut args := #[]
repeat
unless args.isEmpty do
if let some root getRootENode? e then
if root.hasLambdas then
propagateBetaEqs ( getEqcLambdas root) e args.reverse
let .app f arg := e | return ()
e := f
args := args.push arg
end Lean.Meta.Grind

View File

@@ -10,6 +10,7 @@ import Lean.Meta.FunInfo
import Lean.Util.FVarSubset
import Lean.Util.PtrSet
import Lean.Util.FVarSubset
import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
namespace Canon
@@ -40,42 +41,37 @@ additions will still use structurally different (and definitionally different) i
Furthermore, `grind` will not be able to infer that `HEq (a + a) (b + b)` even if we add the assumptions `n = m` and `HEq a b`.
-/
structure State where
argMap : PHashMap (Expr × Nat) (List Expr) := {}
canon : PHashMap Expr Expr := {}
proofCanon : PHashMap Expr Expr := {}
deriving Inhabited
@[inline] private def get' : GoalM State :=
return ( get).canon
inductive CanonElemKind where
| /--
Type class instances are canonicalized using `TransparencyMode.instances`.
-/
instance
| /--
Types and Type formers are canonicalized using `TransparencyMode.default`.
Remark: propositions are just visited. We do not invoke `canonElemCore` for them.
-/
type
| /--
Implicit arguments that are not types, type formers, or instances, are canonicalized
using `TransparencyMode.reducible`
-/
implicit
deriving BEq
@[inline] private def modify' (f : State State) : GoalM Unit :=
modify fun s => { s with canon := f s.canon }
def CanonElemKind.explain : CanonElemKind String
| .instance => "type class instances"
| .type => "types (or type formers)"
| .implicit => "implicit arguments (which are not type class instances or types)"
/--
Helper function for `canonElemCore`. It tries `isDefEq a b` with default transparency, but using
at most `canonHeartbeats` heartbeats. It reports an issue if the threshold is reached.
Remark: `parent` is use only to report an issue
-/
private def isDefEqBounded (a b : Expr) (parent : Expr) : GoalM Bool := do
withCurrHeartbeats do
let config getConfig
tryCatchRuntimeEx
(withTheReader Core.Context (fun ctx => { ctx with maxHeartbeats := config.canonHeartbeats }) do
withDefault <| isDefEq a b)
fun ex => do
if ex.isRuntime then
let curr := ( getConfig).canonHeartbeats
reportIssue m!"failed to show that{indentExpr a}\nis definitionally equal to{indentExpr b}\nwhile canonicalizing{indentExpr parent}\nusing `{curr}*1000` heartbeats, `(canonHeartbeats := {curr})`"
return false
else
throw ex
/--
Helper function for canonicalizing `e` occurring as the `i`th argument of an `f`-application.
Thus, if diagnostics are enabled, we also re-check them using `TransparencyMode.default`. If the result is different
we report to the user.
If `useIsDefEqBounded` is `true`, we try `isDefEqBounded` before returning false
-/
def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : StateT State MetaM Expr := do
let s get
def canonElemCore (parent : Expr) (f : Expr) (i : Nat) (e : Expr) (useIsDefEqBounded : Bool) : GoalM Expr := do
let s get'
if let some c := s.canon.find? e then
return c
let key := (f, i)
@@ -85,20 +81,23 @@ def canonElemCore (f : Expr) (i : Nat) (e : Expr) (kind : CanonElemKind) : State
-- We used to check `c.fvarsSubset e` because it is not
-- in general safe to replace `e` with `c` if `c` has more free variables than `e`.
-- However, we don't revert previously canonicalized elements in the `grind` tactic.
modify fun s => { s with canon := s.canon.insert e c }
trace[grind.debug.canon] "found {e} ===> {c}"
-- Moreover, we store the canonicalizer state in the `Goal` because we case-split
-- and different locals are added in different branches.
modify' fun s => { s with canon := s.canon.insert e c }
trace[grind.debugn.canon] "found {e} ===> {c}"
return c
if kind != .type then
if ( isTracingEnabledFor `grind.issues <&&> (withDefault <| isDefEq e c)) then
-- TODO: consider storing this information in some structure that can be browsed later.
trace[grind.issues] "the following {kind.explain} are definitionally equal with `default` transparency but not with a more restrictive transparency{indentExpr e}\nand{indentExpr c}"
if useIsDefEqBounded then
if ( isDefEqBounded e c parent) then
modify' fun s => { s with canon := s.canon.insert e c }
trace[grind.debugn.canon] "found using `isDefEqBounded`: {e} ===> {c}"
return c
trace[grind.debug.canon] "({f}, {i}) ↦ {e}"
modify fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
modify' fun s => { s with canon := s.canon.insert e e, argMap := s.argMap.insert key (e::cs) }
return e
abbrev canonType (f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore f i e .type
abbrev canonInst (f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore f i e .instance
abbrev canonImplicit (f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore f i e .implicit
abbrev canonType (parent f : Expr) (i : Nat) (e : Expr) := withDefault <| canonElemCore parent f i e (useIsDefEqBounded := false)
abbrev canonInst (parent f : Expr) (i : Nat) (e : Expr) := withReducibleAndInstances <| canonElemCore parent f i e (useIsDefEqBounded := true)
abbrev canonImplicit (parent f : Expr) (i : Nat) (e : Expr) := withReducible <| canonElemCore parent f i e (useIsDefEqBounded := true)
/--
Return type for the `shouldCanon` function.
@@ -146,10 +145,10 @@ def shouldCanon (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Should
else
return .visit
unsafe def canonImpl (e : Expr) : StateT State MetaM Expr := do
unsafe def canonImpl (e : Expr) : GoalM Expr := do
visit e |>.run' mkPtrMap
where
visit (e : Expr) : StateRefT (PtrMap Expr Expr) (StateT State MetaM) Expr := do
visit (e : Expr) : StateRefT (PtrMap Expr Expr) GoalM Expr := do
unless e.isApp || e.isForall do return e
-- Check whether it is cached
if let some r := ( get).find? e then
@@ -159,11 +158,11 @@ where
if f.isConstOf ``Lean.Grind.nestedProof && args.size == 2 then
let prop := args[0]!
let prop' visit prop
if let some r := ( getThe State).proofCanon.find? prop' then
if let some r := ( get').proofCanon.find? prop' then
pure r
else
let e' := if ptrEq prop prop' then e else mkAppN f (args.set! 0 prop')
modifyThe State fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
modify' fun s => { s with proofCanon := s.proofCanon.insert prop' e' }
pure e'
else
let pinfos := ( getFunInfo f).paramInfo
@@ -173,9 +172,9 @@ where
let arg := args[i]
trace[grind.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
let arg' match ( shouldCanon pinfos i arg) with
| .canonType => canonType f i arg
| .canonInst => canonInst f i arg
| .canonImplicit => canonImplicit f i ( visit arg)
| .canonType => canonType e f i arg
| .canonInst => canonInst e f i arg
| .canonImplicit => canonImplicit e f i ( visit arg)
| .visit => visit arg
unless ptrEq arg arg' do
args := args.set i arg'
@@ -191,11 +190,11 @@ where
modify fun s => s.insert e e'
return e'
/-- Canonicalizes nested types, type formers, and instances in `e`. -/
def canon (e : Expr) : StateT State MetaM Expr := do
trace[grind.debug.canon] "{e}"
unsafe canonImpl e
end Canon
/-- Canonicalizes nested types, type formers, and instances in `e`. -/
def canon (e : Expr) : GoalM Expr := do
trace[grind.debug.canon] "{e}"
unsafe Canon.canonImpl e
end Lean.Meta.Grind

View File

@@ -10,6 +10,8 @@ import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Inv
import Lean.Meta.Tactic.Grind.PP
import Lean.Meta.Tactic.Grind.Ctor
import Lean.Meta.Tactic.Grind.Util
import Lean.Meta.Tactic.Grind.Beta
import Lean.Meta.Tactic.Grind.Internalize
namespace Lean.Meta.Grind
@@ -39,7 +41,7 @@ Remove `root` parents from the congruence table.
This is an auxiliary function performed while merging equivalence classes.
-/
private def removeParents (root : Expr) : GoalM ParentSet := do
let parents getParentsAndReset root
let parents getParents root
for parent in parents do
-- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
if ( pure parent.isApp <&&> isCongrRoot parent) then
@@ -86,6 +88,51 @@ private partial def updateMT (root : Expr) : GoalM Unit := do
setENode parent { node with mt := gmt }
updateMT parent
/--
Helper function for combining `ENode.offset?` fields and propagating an equality
to the offset constraint module.
-/
private def propagateOffsetEq (rhsRoot lhsRoot : ENode) : GoalM Unit := do
match lhsRoot.offset? with
| some lhsOffset =>
if let some rhsOffset := rhsRoot.offset? then
Arith.processNewOffsetEq lhsOffset rhsOffset
else if isNatNum rhsRoot.self then
Arith.processNewOffsetEqLit lhsOffset rhsRoot.self
else
-- We have to retrieve the node because other fields have been updated
let rhsRoot getENode rhsRoot.self
setENode rhsRoot.self { rhsRoot with offset? := lhsOffset }
| none =>
if isNatNum lhsRoot.self then
if let some rhsOffset := rhsRoot.offset? then
Arith.processNewOffsetEqLit rhsOffset lhsRoot.self
/--
Tries to apply beta-reductiong using the parent applications of the functions in `fns` with
the lambda expressions in `lams`.
-/
def propagateBeta (lams : Array Expr) (fns : Array Expr) : GoalM Unit := do
if lams.isEmpty then return ()
let lamRoot getRoot lams.back!
trace[grind.debug.beta] "fns: {fns}, lams: {lams}"
for fn in fns do
trace[grind.debug.beta] "fn: {fn}, parents: {(← getParents fn).toArray}"
for parent in ( getParents fn) do
let mut args := #[]
let mut curr := parent
trace[grind.debug.beta] "parent: {parent}"
repeat
trace[grind.debug.beta] "curr: {curr}"
if ( isEqv curr lamRoot) then
propagateBetaEqs lams curr args.reverse
let .app f arg := curr
| break
-- Remark: recall that we do not eagerly internalize partial applications.
internalize curr ( getGeneration parent)
args := args.push arg
curr := f
private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit := do
let lhsNode getENode lhs
let rhsNode getENode rhs
@@ -118,7 +165,7 @@ private partial def addEqStep (lhs rhs proof : Expr) (isHEq : Bool) : GoalM Unit
unless ( isInconsistent) do
if valueInconsistency then
closeGoalWithValuesEq lhsRoot.self rhsRoot.self
trace_goal[grind.debug] "after addEqStep, {← ppState}"
trace_goal[grind.debug] "after addEqStep, {← (← get).ppState}"
checkInvariants
where
go (lhs rhs : Expr) (lhsNode rhsNode lhsRoot rhsRoot : ENode) (flipped : Bool) : GoalM Unit := do
@@ -137,35 +184,43 @@ where
proof? := proof
flipped
}
let lams₁ getEqcLambdas lhsRoot
let lams₂ getEqcLambdas rhsRoot
let fns₁ if lams₁.isEmpty then pure #[] else getFnRoots rhsRoot.self
let fns₂ if lams₂.isEmpty then pure #[] else getFnRoots lhsRoot.self
let parents removeParents lhsRoot.self
updateRoots lhs rhsNode.root
trace_goal[grind.debug] "{← ppENodeRef lhs} new root {← ppENodeRef rhsNode.root}, {← ppENodeRef (← getRoot lhs)}"
reinsertParents parents
propagateEqcDown lhs
setENode lhsNode.root { ( getENode lhsRoot.self) with -- We must retrieve `lhsRoot` since it was updated.
next := rhsRoot.next
}
setENode rhsNode.root { rhsRoot with
next := lhsRoot.next
size := rhsRoot.size + lhsRoot.size
next := lhsRoot.next
size := rhsRoot.size + lhsRoot.size
hasLambdas := rhsRoot.hasLambdas || lhsRoot.hasLambdas
heqProofs := isHEq || rhsRoot.heqProofs || lhsRoot.heqProofs
}
propagateBeta lams₁ fns₁
propagateBeta lams₂ fns₂
resetParentsOf lhsRoot.self
copyParentsTo parents rhsNode.root
unless ( isInconsistent) do
updateMT rhsRoot.self
propagateOffsetEq rhsRoot lhsRoot
unless ( isInconsistent) do
for parent in parents do
propagateUp parent
unless ( isInconsistent) do
updateMT rhsRoot.self
updateRoots (lhs : Expr) (rootNew : Expr) : GoalM Unit := do
let rec loop (e : Expr) : GoalM Unit := do
let n getENode e
setENode e { n with root := rootNew }
traverseEqc lhs fun n =>
setENode n.self { n with root := rootNew }
propagateEqcDown (lhs : Expr) : GoalM Unit := do
traverseEqc lhs fun n =>
unless ( isInconsistent) do
propagateDown e
if isSameExpr lhs n.next then return ()
loop n.next
loop lhs
propagateDown n.self
/-- Ensures collection of equations to be processed is empty. -/
private def resetNewEqs : GoalM Unit :=
@@ -192,22 +247,28 @@ where
processTodo
/-- Adds a new equality `lhs = rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
def addEq (lhs rhs proof : Expr) : GoalM Unit := do
private def addEq (lhs rhs proof : Expr) : GoalM Unit := do
addEqCore lhs rhs proof false
/-- Adds a new heterogeneous equality `HEq lhs rhs`. It assumes `lhs` and `rhs` have already been internalized. -/
def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
private def addHEq (lhs rhs proof : Expr) : GoalM Unit := do
addEqCore lhs rhs proof true
/-- Save asserted facts for pretty printing goal. -/
private def storeFact (fact : Expr) : GoalM Unit := do
modify fun s => { s with facts := s.facts.push fact }
/-- Internalizes `lhs` and `rhs`, and then adds equality `lhs = rhs`. -/
def addNewEq (lhs rhs proof : Expr) (generation : Nat) : GoalM Unit := do
internalize lhs generation
internalize rhs generation
let eq mkEq lhs rhs
storeFact eq
internalize lhs generation eq
internalize rhs generation eq
addEq lhs rhs proof
/-- Adds a new `fact` justified by the given proof and using the given generation. -/
def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
storeFact fact
trace_goal[grind.assert] "{fact}"
if ( isInconsistent) then return ()
resetNewEqs
@@ -217,22 +278,30 @@ def add (fact : Expr) (proof : Expr) (generation := 0) : GoalM Unit := do
where
go (p : Expr) (isNeg : Bool) : GoalM Unit := do
match_expr p with
| Eq _ lhs rhs => goEq p lhs rhs isNeg false
| HEq _ lhs _ rhs => goEq p lhs rhs isNeg true
| _ =>
internalize p generation
if isNeg then
addEq p ( getFalseExpr) ( mkEqFalse proof)
| Eq α lhs rhs =>
if α.isProp then
-- It is morally an iff.
-- We do not use the `goEq` optimization because we want to register `p` as a case-split
goFact p isNeg
else
addEq p ( getTrueExpr) ( mkEqTrue proof)
goEq p lhs rhs isNeg false
| HEq _ lhs _ rhs => goEq p lhs rhs isNeg true
| _ => goFact p isNeg
goFact (p : Expr) (isNeg : Bool) : GoalM Unit := do
internalize p generation
if isNeg then
addEq p ( getFalseExpr) ( mkEqFalse proof)
else
addEq p ( getTrueExpr) ( mkEqTrue proof)
goEq (p : Expr) (lhs rhs : Expr) (isNeg : Bool) (isHEq : Bool) : GoalM Unit := do
if isNeg then
internalize p generation
addEq p ( getFalseExpr) ( mkEqFalse proof)
else
internalize lhs generation
internalize rhs generation
internalize lhs generation p
internalize rhs generation p
addEqCore lhs rhs proof isHEq
/-- Adds a new hypothesis. -/

View File

@@ -20,7 +20,7 @@ private partial def propagateInjEqs (eqs : Expr) (proof : Expr) : GoalM Unit :=
| HEq _ lhs _ rhs =>
pushHEq ( shareCommon lhs) ( shareCommon rhs) proof
| _ =>
trace_goal[grind.issues] "unexpected injectivity theorem result type{indentExpr eqs}"
reportIssue m!"unexpected injectivity theorem result type{indentExpr eqs}"
return ()
/--

View File

@@ -129,6 +129,16 @@ private partial def matchArgs? (c : Choice) (p : Expr) (e : Expr) : OptionT Goal
let c matchArg? c pArg eArg
matchArgs? c p.appFn! e.appFn!
/-- Similar to `matchArgs?` but if `p` has fewer arguments than `e`, we match `p` with a prefix of `e`. -/
private partial def matchArgsPrefix? (c : Choice) (p : Expr) (e : Expr) : OptionT GoalM Choice := do
let pn := p.getAppNumArgs
let en := e.getAppNumArgs
guard (pn <= en)
if pn == en then
matchArgs? c p e
else
matchArgs? c p (e.getAppPrefix pn)
/--
Matches pattern `p` with term `e` with respect to choice `c`.
We traverse the equivalence class of `e` looking for applications compatible with `p`.
@@ -194,7 +204,7 @@ private def processContinue (c : Choice) (p : Expr) : M Unit := do
let n getENode app
if n.generation < maxGeneration
&& (n.heqProofs || n.isCongrRoot) then
if let some c matchArgs? c p app |>.run then
if let some c matchArgsPrefix? c p app |>.run then
let gen := n.generation
let c := { c with gen := Nat.max gen c.gen }
modify fun s => { s with choiceStack := c :: s.choiceStack }
@@ -240,7 +250,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
assert! c.assignment.size == numParams
let (mvars, bis, _) forallMetaBoundedTelescope ( inferType proof) numParams
if mvars.size != thm.numParams then
trace_goal[grind.issues] "unexpected number of parameters at {← thm.origin.pp}"
reportIssue m!"unexpected number of parameters at {← thm.origin.pp}"
return ()
-- Apply assignment
for h : i in [:mvars.size] do
@@ -250,14 +260,14 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
let mvarIdType mvarId.getType
let vType inferType v
unless ( isDefEq mvarIdType vType <&&> mvarId.checkedAssign v) do
trace_goal[grind.issues] "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
reportIssue m!"type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
return ()
-- Synthesize instances
for mvar in mvars, bi in bis do
if bi.isInstImplicit && !( mvar.mvarId!.isAssigned) then
let type inferType mvar
unless ( synthesizeInstance mvar type) do
trace_goal[grind.issues] "failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
unless ( synthesizeInstanceAndAssign mvar type) do
reportIssue m!"failed to synthesize instance when instantiating {← thm.origin.pp}{indentExpr type}"
return ()
let proof := mkAppN proof mvars
if ( mvars.allM (·.mvarId!.isAssigned)) then
@@ -265,13 +275,9 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
else
let mvars mvars.filterM fun mvar => return !( mvar.mvarId!.isAssigned)
if let some mvarBad mvars.findM? fun mvar => return !( isProof mvar) then
trace_goal[grind.issues] "failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
reportIssue m!"failed to instantiate {← thm.origin.pp}, failed to instantiate non propositional argument with type{indentExpr (← inferType mvarBad)}"
let proof mkLambdaFVars (binderInfoForMVars := .default) mvars ( instantiateMVars proof)
addNewInstance thm.origin proof c.gen
where
synthesizeInstance (x type : Expr) : MetaM Bool := do
let .some val trySynthInstance type | return false
isDefEq x val
/-- Process choice stack until we don't have more choices to be processed. -/
private def processChoices : M Unit := do
@@ -300,7 +306,7 @@ private def main (p : Expr) (cnstrs : List Cnstr) : M Unit := do
if (n.heqProofs || n.isCongrRoot) &&
(!useMT || n.mt == gmt) then
withInitApp app do
if let some c matchArgs? { cnstrs, assignment, gen := n.generation } p app |>.run then
if let some c matchArgsPrefix? { cnstrs, assignment, gen := n.generation } p app |>.run then
modify fun s => { s with choiceStack := [c] }
processChoices
@@ -360,7 +366,4 @@ def ematchAndAssert : GrindTactic := fun goal => do
return none
assertAll goal
def ematchStar : GrindTactic :=
ematchAndAssert.iterate
end Lean.Meta.Grind

View File

@@ -170,11 +170,43 @@ private builtin_initialize ematchTheoremsExt : SimpleScopedEnvExtension EMatchTh
initial := {}
}
/--
Symbols with built-in support in `grind` are unsuitable as pattern candidates for E-matching.
This is because `grind` performs normalization operations and uses specialized data structures
to implement these symbols, which may interfere with E-matching behavior.
-/
-- TODO: create attribute?
private def forbiddenDeclNames := #[``Eq, ``HEq, ``Iff, ``And, ``Or, ``Not]
private def isForbidden (declName : Name) := forbiddenDeclNames.contains declName
/--
Auxiliary function to expand a pattern containing forbidden application symbols
into a multi-pattern.
This function enhances the usability of the `[grind =]` attribute by automatically handling
forbidden pattern symbols. For example, consider the following theorem tagged with this attribute:
```
getLast?_eq_some_iff {xs : List α} {a : α} : xs.getLast? = some a ↔ ∃ ys, xs = ys ++ [a]
```
Here, the selected pattern is `xs.getLast? = some a`, but `Eq` is a forbidden pattern symbol.
Instead of producing an error, this function converts the pattern into a multi-pattern,
allowing the attribute to be used conveniently.
The function recursively expands patterns with forbidden symbols by splitting them
into their sub-components. If the pattern does not contain forbidden symbols,
it is returned as-is.
-/
partial def splitWhileForbidden (pat : Expr) : List Expr :=
match_expr pat with
| Not p => splitWhileForbidden p
| And p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
| Or p₁ p₂ => splitWhileForbidden p₁ ++ splitWhileForbidden p₂
| Eq _ lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
| Iff lhs rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
| HEq _ lhs _ rhs => splitWhileForbidden lhs ++ splitWhileForbidden rhs
| _ => [pat]
private def dontCare := mkConst (Name.mkSimple "[grind_dontcare]")
def mkGroundPattern (e : Expr) : Expr :=
@@ -237,19 +269,36 @@ private def getPatternFn? (pattern : Expr) : Option Expr :=
/--
Returns a bit-mask `mask` s.t. `mask[i]` is true if the corresponding argument is
- a type (that is not a proposition) or type former, or
- a type (that is not a proposition) or type former (which has forward dependencies) or
- a proof, or
- an instance implicit argument
When `mask[i]`, we say the corresponding argument is a "support" argument.
-/
def getPatternSupportMask (f : Expr) (numArgs : Nat) : MetaM (Array Bool) := do
let pinfos := ( getFunInfoNArgs f numArgs).paramInfo
forallBoundedTelescope ( inferType f) numArgs fun xs _ => do
xs.mapM fun x => do
xs.mapIdxM fun idx x => do
if ( isProp x) then
return false
else if ( isTypeFormer x <||> isProof x) then
else if ( isProof x) then
return true
else if ( isTypeFormer x) then
if h : idx < pinfos.size then
/-
We originally wanted to ignore types and type formers in `grind` and treat them as supporting elements.
Thus, we would always return `true`. However, we changed our heuristic because of the following example:
```
example {α} (f : α → Type) (a : α) (h : ∀ x, Nonempty (f x)) : Nonempty (f a) := by
grind
```
In this example, we are reasoning about types. Therefore, we adjusted the heuristic as follows:
a type or type former is considered a supporting element only if it has forward dependencies.
Note that this is not the case for `Nonempty`.
-/
return pinfos[idx].hasFwdDeps
else
return true
else
return ( x.fvarId!.getDecl).binderInfo matches .instImplicit
@@ -467,8 +516,11 @@ def mkEMatchEqTheoremCore (origin : Origin) (levelParams : Array Name) (proof :
| HEq _ lhs _ rhs => pure (lhs, rhs)
| _ => throwError "invalid E-matching equality theorem, conclusion must be an equality{indentExpr type}"
let pat := if useLhs then lhs else rhs
trace[grind.debug.ematch.pattern] "mkEMatchEqTheoremCore: origin: {← origin.pp}, pat: {pat}, useLhs: {useLhs}"
let pat preprocessPattern pat normalizePattern
return (xs.size, [pat.abstract xs])
trace[grind.debug.ematch.pattern] "mkEMatchEqTheoremCore: after preprocessing: {pat}, {← normalize pat}"
let pats := splitWhileForbidden (pat.abstract xs)
return (xs.size, pats)
mkEMatchTheoremCore origin levelParams numParams proof patterns
/--
@@ -501,7 +553,7 @@ def getEMatchTheorems : CoreM EMatchTheorems :=
inductive TheoremKind where
| eqLhs | eqRhs | eqBoth | fwd | bwd | default
deriving Inhabited, BEq
deriving Inhabited, BEq, Repr
private def TheoremKind.toAttribute : TheoremKind String
| .eqLhs => "[grind =]"
@@ -601,9 +653,9 @@ private def collectPatterns? (proof : Expr) (xs : Array Expr) (searchPlaces : Ar
def mkEMatchTheoremWithKind? (origin : Origin) (levelParams : Array Name) (proof : Expr) (kind : TheoremKind) : MetaM (Option EMatchTheorem) := do
if kind == .eqLhs then
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := true))
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := true) (useLhs := true))
else if kind == .eqRhs then
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := false) (useLhs := false))
return ( mkEMatchEqTheoremCore origin levelParams proof (normalizePattern := true) (useLhs := false))
let type inferType proof
forallTelescopeReducing type fun xs type => do
let searchPlaces match kind with
@@ -627,28 +679,40 @@ where
levelParams, origin
}
private def getKind (stx : Syntax) : TheoremKind :=
/-- Return theorem kind for `stx` of the form `Attr.grindThmMod` -/
def getTheoremKindCore (stx : Syntax) : CoreM TheoremKind := do
match stx with
| `(Parser.Attr.grindThmMod| =) => return .eqLhs
| `(Parser.Attr.grindThmMod| ) => return .fwd
| `(Parser.Attr.grindThmMod| ) => return .bwd
| `(Parser.Attr.grindThmMod| =_) => return .eqRhs
| `(Parser.Attr.grindThmMod| _=_) => return .eqBoth
| _ => throwError "unexpected `grind` theorem kind: `{stx}`"
/-- Return theorem kind for `stx` of the form `(Attr.grindThmMod)?` -/
def getTheoremKindFromOpt (stx : Syntax) : CoreM TheoremKind := do
if stx[1].isNone then
.default
else if stx[1][0].getKind == ``Parser.Attr.grindEq then
.eqLhs
else if stx[1][0].getKind == ``Parser.Attr.grindFwd then
.fwd
else if stx[1][0].getKind == ``Parser.Attr.grindEqRhs then
.eqRhs
else if stx[1][0].getKind == ``Parser.Attr.grindEqBoth then
.eqBoth
return .default
else
.bwd
getTheoremKindCore stx[1][0]
def mkEMatchTheoremForDecl (declName : Name) (thmKind : TheoremKind) : MetaM EMatchTheorem := do
let some thm mkEMatchTheoremWithKind? (.decl declName) #[] ( getProofFor declName) thmKind
| throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
return thm
def mkEMatchEqTheoremsForDef? (declName : Name) : MetaM (Option (Array EMatchTheorem)) := do
let some eqns getEqnsFor? declName | return none
eqns.mapM fun eqn => do
mkEMatchEqTheorem eqn (normalizePattern := true)
private def addGrindEqAttr (declName : Name) (attrKind : AttributeKind) (thmKind : TheoremKind) (useLhs := true) : MetaM Unit := do
if ( getConstInfo declName).isTheorem then
ematchTheoremsExt.add ( mkEMatchEqTheorem declName (normalizePattern := true) (useLhs := useLhs)) attrKind
else if let some eqns getEqnsFor? declName then
else if let some thms mkEMatchEqTheoremsForDef? declName then
unless useLhs do
throwError "`{declName}` is a definition, you must only use the left-hand side for extracting patterns"
for eqn in eqns do
ematchTheoremsExt.add ( mkEMatchEqTheorem eqn) attrKind
thms.forM (ematchTheoremsExt.add · attrKind)
else
throwError s!"`{thmKind.toAttribute}` attribute can only be applied to equational theorems or function definitions"
@@ -663,10 +727,26 @@ private def addGrindAttr (declName : Name) (attrKind : AttributeKind) (thmKind :
else if !( getConstInfo declName).isTheorem then
addGrindEqAttr declName attrKind thmKind
else
let some thm mkEMatchTheoremWithKind? (.decl declName) #[] ( getProofFor declName) thmKind
| throwError "`@{thmKind.toAttribute} theorem {declName}` {thmKind.explainFailure}, consider using different options or the `grind_pattern` command"
let thm mkEMatchTheoremForDecl declName thmKind
ematchTheoremsExt.add thm attrKind
def EMatchTheorems.eraseDecl (s : EMatchTheorems) (declName : Name) : MetaM EMatchTheorems := do
let throwErr {α} : MetaM α :=
throwError "`{declName}` is not marked with the `[grind]` attribute"
let info getConstInfo declName
if !info.isTheorem then
if let some eqns getEqnsFor? declName then
let s := ematchTheoremsExt.getState ( getEnv)
unless eqns.all fun eqn => s.contains (.decl eqn) do
throwErr
return eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
else
throwErr
else
unless ematchTheoremsExt.getState ( getEnv) |>.contains (.decl declName) do
throwErr
return s.erase <| .decl declName
builtin_initialize
registerBuiltinAttribute {
name := `grind
@@ -689,7 +769,7 @@ builtin_initialize
`grind` will add an instance of this theorem to the local context whenever it encounters the pattern `foo (foo x)`."
applicationTime := .afterCompilation
add := fun declName stx attrKind => do
addGrindAttr declName attrKind (getKind stx) |>.run' {}
addGrindAttr declName attrKind ( getTheoremKindFromOpt stx) |>.run' {}
erase := fun declName => MetaM.run' do
/-
Remark: consider the following example
@@ -705,21 +785,9 @@ builtin_initialize
attribute [-grind] foo -- ok
```
-/
let throwErr := throwError "`{declName}` is not marked with the `[grind]` attribute"
let info getConstInfo declName
if !info.isTheorem then
if let some eqns getEqnsFor? declName then
let s := ematchTheoremsExt.getState ( getEnv)
unless eqns.all fun eqn => s.contains (.decl eqn) do
throwErr
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s =>
eqns.foldl (init := s) fun s eqn => s.erase (.decl eqn)
else
throwErr
else
unless ematchTheoremsExt.getState ( getEnv) |>.contains (.decl declName) do
throwErr
modifyEnv fun env => ematchTheoremsExt.modifyState env fun s => s.erase (.decl declName)
let s := ematchTheoremsExt.getState ( getEnv)
let s s.eraseDecl declName
modifyEnv fun env => ematchTheoremsExt.modifyState env fun _ => s
}
end Lean.Meta.Grind

View File

@@ -0,0 +1,30 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.Expr
namespace Lean.Meta.Grind
@[inline] def isSameExpr (a b : Expr) : Bool :=
-- It is safe to use pointer equality because we hashcons all expressions
-- inserted into the E-graph
unsafe ptrEq a b
/--
Key for the `ENodeMap` and `ParentMap` map.
We use pointer addresses and rely on the fact all internalized expressions
have been hash-consed, i.e., we have applied `shareCommon`.
-/
structure ENodeKey where
expr : Expr
instance : Hashable ENodeKey where
hash k := unsafe (ptrAddrUnsafe k.expr).toUInt64
instance : BEq ENodeKey where
beq k₁ k₂ := isSameExpr k₁.expr k₂.expr
end Lean.Meta.Grind

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