Compare commits

...

53 Commits

Author SHA1 Message Date
Kim Morrison
06c955902c import all 2024-12-01 19:12:25 +11:00
Kim Morrison
c94934e2ae Merge remote-tracking branch 'origin/master' into array_perm 2024-12-01 19:10:53 +11:00
Kim Morrison
77ad0769fb feat: Array.swap_perm 2024-12-01 19:10:26 +11:00
Kim Morrison
819cb879e1 chore: upstream Vector lemmas (#6271)
This PR upstreams existing lemmas about `Vector` from Batteries.

Thanks to @fgdorais for preparing these in
https://github.com/leanprover-community/batteries/pull/1062. Further
contributions to the `Vector` API welcome via PR here.
2024-12-01 06:44:14 +00:00
Kim Morrison
3ee2842e77 feat: remove runtime bounds checks and partial from qsort (#6241)
This PR refactors `Array.qsort` to remove runtime array bounds checks,
and avoids the use of `partial`. We use the `Vector` API, along with
auto_params, to avoid having to write any proofs. The new code
benchmarks indistinguishably from the old.
2024-12-01 06:26:00 +00:00
Kyle Miller
7b8504cf06 chore: post-stage0 cleanup for #6165 (#6268)
This PR puts code in terms of syntax quotations now that there has been
a stage0 update. Fixes a lingering bug in StructInst where some
intermediate syntax was malformed, but this had no observable effects
outside of some debug messages.
2024-12-01 00:20:59 +00:00
Lean stage0 autoupdater
ca96922b4b chore: update stage0 2024-11-30 21:22:30 +00:00
Kyle Miller
a1c3a36433 feat: parity between structure instance notation and where notation (#6165)
This PR modifies structure instance notation and `where` notation to use
the same notation for fields. Structure instance notation now admits
binders, type ascriptions, and equations, and `where` notation admits
full structure lvals. Examples of these for structure instance notation:
```lean
structure PosFun where
  f : Nat → Nat
  pos : ∀ n, 0 < f n

def p : PosFun :=
  { f n := n + 1
    pos := by simp }

def p' : PosFun :=
  { f | 0 => 1
      | n + 1 => n + 1
    pos := by rintro (_|_) <;> simp }
```
Just like for the structure `where` notation, a field `f x y z : ty :=
val` expands to `f := fun x y z => (val : ty)`. The type ascription is
optional.

The PR also is setting things up for future expansion. Pending some
discussion, in the future structure/`where` notation could have have
embedded `where` clauses; rather than `{ a := { x := 1, y := z } }` one
could write `{ a where x := 1; y := z }`.
2024-11-30 20:27:25 +00:00
Lean stage0 autoupdater
734ea3071d chore: update stage0 2024-11-30 12:58:59 +00:00
Kyle Miller
f3f00451c8 feat: add structInstFieldDecl syntax category (#6265)
This PR is preparation for changes to structure instance notation in
#6165. It adds a syntax category that will be used for field syntax.
2024-11-30 12:12:53 +00:00
Leonardo de Moura
27df5e968a feat: Simp.Config.implicitDefEqProofs (#4595)
This PR implements `Simp.Config.implicitDefEqsProofs`. When `true`
(default: `true`), `simp` will **not** create a proof term for a
rewriting rule associated with an `rfl`-theorem. Rewriting rules are
provided by users by annotating theorems with the attribute `@[simp]`.
If the proof of the theorem is just `rfl` (reflexivity), and
`implicitDefEqProofs := true`, `simp` will **not** create a proof term
which is an application of the annotated theorem.

The default setting does change the existing behavior. Users can use
`simp -implicitDefEqProofs` to force `simp` to create a proof term for
`rfl`-theorems. This can positively impact proof checking time in the
kernel.

This PR also fixes an issue in the `split` tactic that has been exposed
by this feature. It was looking for `split` candidates in proofs and
implicit arguments. See new test for issue exposed by the previous
feature.

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
2024-11-29 22:29:27 +00:00
Lean stage0 autoupdater
3752241edd chore: update stage0 2024-11-29 21:32:14 +00:00
Marc Huisinga
39bffb6fda fix: don't walk full project file tree on every file save (#6246)
This PR fixes a performance issue where the Lean language server would
walk the full project file tree every time a file was saved, blocking
the processing of all other requests and notifications and significantly
increasing overall language server latency after saving.

This issue was originally reported at
https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/Compiling.20too.20slow/near/484386515
and uncovered in a lengthy investigation. The performance bug that
causes the Lean language server to walk the full project file tree when
the file watcher for .ilean files is triggered was introduced when the
.ileans were first introduced, whereas the specific issue of file saving
also triggering the walk was introduced by #3247 in 4.8.0 and the use of
the file watcher for .lean files, which would then also trigger the
directory walk. Combining this with VS Code's auto-save feature causes
the language server to walk the full project file tree on every change
of the document.

It somehow hasn't really been much of an issue until now, but we still
do way too much work in the watchdog main loop. I'll look into resolving
that more general issue in the future.
2024-11-29 15:34:44 +00:00
Sebastian Ullrich
86f303774a chore: harden markPersistent uses (#6257)
This API may or may not have been a footgun, better to be safe than
`sorry`
2024-11-29 14:33:33 +00:00
Sebastian Ullrich
d97af36867 feat: simpler trace timing annotation logic (#6259)
This PR ensures that nesting trace nodes are annotated with timing
information iff `trace.profiler` is active.

The previous connection to the otherwise unrelated `profiler` option was
a remnant from before `trace.profiler` existed; if users want to
annotate explicitly activated trace classes only, they can instead
increase `trace.profiler.threshold`.
2024-11-29 14:03:01 +00:00
Mac Malone
27cc0c8039 feat: USize.reduceToNat (#6190)
This PR adds the builtin simproc `USize.reduceToNat` which reduces the
`USize.toNat` operation on literals less than `UInt32.size` (i.e.,
`4294967296`).
2024-11-29 08:24:40 +00:00
Mac Malone
c9ee66fb1f chore: lake: fix typo in materialize error (#6250) 2024-11-29 06:20:51 +00:00
Kim Morrison
5c7e027b03 chore: cleanup of List/Array lemmas (#6249)
This PR performs further cleanup of `List/Lemmas.lean` and
`Array/Lemmas.lean`, trying to make them more parallel.

Still a long way to go.
2024-11-29 06:12:38 +00:00
Mac Malone
4969ec9cdb feat: more UInt lemmas (#6205)
This PR upstreams some UInt theorems from Batteries and adds more
`toNat`-related theorems. It also adds the missing `UInt8` and `UInt16`
to/from `USize` conversions so that the the interface is uniform across
the UInt types.

**Summary of all changes:**

* Upstreamed and added `toNat` constructors lemmas: `toNat_mk`,
`ofNat_toNat`, `toNat_ofNat`, `toNat_ofNatCore`, and
`USize.toNat_ofNat32`
* Upstreamed and added `toNat` canonicalization; `val_val_eq_toNat` and
`toNat_toBitVec_eq_toNat`
* Added injectivity iffs: `toBitVec_inj`, `toNat_inj`, and `val_inj`
* Added inequality iffs: `le_iff_toNat_le` and `lt_iff_toNat_lt`
* Upstreamed antisymmetry lemmas: `le_antisymm` and `le_antisymm_iff`
* Upstreamed missing `toNat` lemmas on arithmetic operations:
`toNat_add`, `toNat_sub`, `toNat_mul`
* Upstreamed and added missing conversion lemmas: `toNat_toUInt*` and
`toNat_USize`
* Added missing `USize` conversions: `USize.toUInt8`, `UInt8.toUSize`,
`USize.toUInt16`, `UInt16.toUSize`
2024-11-29 02:08:52 +00:00
Mac Malone
827062f807 feat: System.Platform.numBits inequalities (#6247)
This PR adds the theorems `numBits_pos`, `le_numBits`, `numBits_le` ,
which make proving inequalities about `System.Platform.numBits` easier.
2024-11-28 21:20:47 +00:00
Kim Morrison
6d495586a1 chore: deprecate Fin.ofNat (replaced by Fin.ofNat', subsequently to be renamed) (#6242)
This PR deprecates `Fin.ofNat` in favour of `Fin.ofNat'` (which takes an
`[NeZero]` instance, rather than returning an element of `Fin (n+1)`).

After leaving the deprecation warning in place for some time, we will
then rename `ofNat'` back to `ofNat`.
2024-11-28 05:23:23 +00:00
Kim Morrison
10d1d2cc25 chore: cleanup in Array/Lemmas (#6243) 2024-11-28 03:50:41 +00:00
Wojciech Nawrocki
2325f5c7b9 doc: explain abstraction order (#6239)
This PR explains the order in which `Expr.abstract` introduces de Bruijn
indices.
2024-11-28 01:37:30 +00:00
Sofia Rodrigues
88e3a2b1ab fix: improve directory fallback on Linux and trim local time identifier (#6221)
This PR fixes:
- Problems in other linux distributions that the default `tzdata`
directory is not the same as previously defined by ensuring it with a
fallback behavior when directory is missing.
- Trim unnecessary characters from local time identifier.
2024-11-27 14:52:35 +00:00
Lean stage0 autoupdater
b378fe98a7 chore: update stage0 2024-11-27 14:20:47 +00:00
Sebastian Ullrich
5f1ff42a15 fix: Runtime.markPersistent is unsafe (#6209)
This PR documents under which conditions `Runtime.markPersistent` is
unsafe and adjusts the elaborator accordingly
2024-11-27 13:32:05 +00:00
Jens Petersen
30d01f7a9a fix: add cmake COPY_CADICAL option to allow turning off install copy (#5931)
This PR adds a cmake knob to allow turning off installing a copy of
`cadical`.
This can be useful for custom builds/installs where cadical is already
available in the system.

Closes: #5603
2024-11-27 13:21:20 +00:00
Sebastian Ullrich
81b85d8e2f fix: reparsing may need to backtrack two commands (#6236)
This PR fixes an issue where edits to a command containing a nested
docstring fail to reparse the entire command.

Fixes #6227
2024-11-27 13:06:57 +00:00
Sebastian Ullrich
5982a6d230 chore: default parseQuotWithCurrentStage to true in stage 0 (#6212)
Use the default that solves bootstrapping issues in exchange for an
insignificant(?) perf overhead
2024-11-27 12:58:44 +00:00
Mac Malone
ac1197ff59 feat: Lean.loadPlugin (#6130)
This PR adds `Lean.loadPlugin` which exposes functionality similar to
the `lean` executable's `--plugin` option to Lean code.

This will allow custom Lean frontends (e.g., Lake, the Lean language
server) to also load plugins.

---------

Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-11-27 09:56:31 +00:00
Kim Morrison
609346f5e0 feat: relate Nat.fold/foldRev/any/all to List.finRange (#6235)
This PR relates that operations `Nat.fold`/`foldRev`/`any`/`all` to the
corresponding List operations over `List.finRange`.
2024-11-27 05:38:18 +00:00
Mac Malone
04f80a1f9f feat: lake: detailed Reservoir fetch error (#6231)
This PR improves the errors Lake produces when it fails to fetch a
dependency from Reservoir. If the package is not indexed, it will
produce a suggestion about how to require it from GitHub.

Closes #5330.
2024-11-27 05:07:09 +00:00
Kim Morrison
7e9dd5668b feat: upstream List.finRange from Batteries (#6234)
This PR upstreams the definition and basic lemmas about `List.finRange`
from Batteries.

Thanks for contributors to Batteries and Mathlib who've previously
worked on this material. Further PRs are welcome here. I'll be adding
more API later.
2024-11-27 04:27:22 +00:00
Kim Morrison
79f050b816 feat: upstream Vector lemmas (#6233)
This PR upstreams lemmas about `Vector` from Batteries.

I'll be adding more soon, and PRs are welcome, particularly from those
who have previously contributed to `Vector` in Batteries.
2024-11-27 04:19:30 +00:00
Siddharth
af4a3f2251 feat: BitVec.toInt_abs (#6154)
This PR implements `BitVec.toInt_abs`.


The absolute value of `x : BitVec w` is naively a case split on the sign
of `x`.
However, recall that when `x = intMin w`, `-x = x`.
Thus, the full value of `abs x` is computed by the case split:
- If `x : BitVec w` is `intMin`, then its absolute value is also `intMin
w`, and
  thus `toInt` will equal `intMin.toInt`.
- Otherwise, if `x` is negative, then `x.abs.toInt = (-x).toInt`.
- Finally, when `x` is nonnegative, then `x.abs.toInt = x.toInt`.

```lean
theorem toInt_abs {x : BitVec w} :
  x.abs.toInt =
    if x = intMin w then (intMin w).toInt
    else if x.msb then -x.toInt
    else x.toInt
```

We also provide a variant of `toInt_abs` that
hides the case split for `x` being positive or negative by using
`natAbs`.
```lean
theorem toInt_abs_eq_natAbs {x : BitVec w} : x.abs.toInt =
    if x = intMin w then (intMin w).toInt else x.toInt.natAbs
```

Supercedes https://github.com/leanprover/lean4/pull/5787

---------

Co-authored-by: Tobias Grosser <github@grosser.es>
2024-11-27 03:50:55 +00:00
Siddharth
7692343720 feat: BitVec.toNat BitVec.signExtend (#6155)
This PR adds `toNat` theorems for `BitVec.signExtend.`

Sign extending to a larger bitwidth depends on the msb. If the msb is
false, then the result equals the original value. If the msb is true,
then we add a value of `(2^v - 2^w)`, which arises from the sign
extension.

```lean
theorem toNat_signExtend (x : BitVec w) {v : Nat} :
    (x.signExtend v).toNat = (x.setWidth v).toNat + if x.msb then 2^v - 2^w else 0
```

Co-authored-by: Harun Khan <harun19@stanford.edu>
2024-11-27 03:50:15 +00:00
Luisa Cicolini
597ef8cfee feat: add Nat.mod_eq_sub and fix dependencies from Nat.sub_mul_eq_mod_of_lt_of_le (#6160)
This PR adds theorem `mod_eq_sub`, makes theorem
`sub_mul_eq_mod_of_lt_of_le` not private anymore and moves its location
within the `rotate*` section to use it in other proofs.
2024-11-27 03:48:59 +00:00
Kim Morrison
321e148f51 feat: Array fold lemmas (#6230)
This PR copies some lemmas about `List.foldX` to `Array`.
2024-11-27 02:09:41 +00:00
Kyle Miller
ce692436f4 feat: expose diff at "synthesized type class instance is not definitionally equal" error (#6213)
This PR exposes the difference in "synthesized type class instance is
not definitionally equal" errors.
2024-11-27 00:52:58 +00:00
Mac Malone
23bec25fce feat: Nat.lt_pow_self (#6200)
This PR upstreams `Nat.lt_pow_self` and `Nat.lt_two_pow` from Mathlib
and uses them to prove the simp theorem `Nat.mod_two_pow`.

This simplifies expressions like `System.Platform.numBits % 2 ^
System.Platform.numBits = System.Platform.numBits`, which is needed for
#6188.
2024-11-26 23:42:23 +00:00
Mac Malone
3d511a582a feat: USize.size inequalities (#6203)
This PR adds the theorems `le_usize_size` and `usize_size_le`, which
make proving inequalities about `USize.size` easier.

It also deprecates `usize_size_gt_zero` in favor of `usize_size_pos` (as
that seems more consistent with our naming covention) and adds
`USize.toNat_ofNat_of_lt_32` for dealing with small USize literals.

It also moves `USize.ofNat32` and `USize.toUInt64` to
`Init.Data.UInt.Basic` as neither are used in `Init.Prelude` anymore.

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
2024-11-26 23:42:15 +00:00
Mac Malone
51015bf5c0 fix: lake: eager logging when materializing deps (#6225)
This PR makes `lake build` also eagerly print package materialization
log lines. Previously, only a `lake update` performed eager logging.
2024-11-26 22:11:23 +00:00
Mac Malone
3ece36de9d feat: GitHub cloud releases do not clobber prebuilt artifacts (#6218)
This PR makes Lake no longer automatically fetch GitHub cloud releases
if the package build directory is already present (mirroring the
behavior of the Reservoir cache). This prevents the cache from
clobbering existing prebuilt artifacts. Users can still manually fetch
the cache and clobber the build directory by running `lake build
<pkg>:release`.
2024-11-26 22:10:42 +00:00
Leonardo de Moura
54c48363ca feat: proper let_fun support in simp (#6220)
This PR adds proper support for `let_fun` in `simp`.
2024-11-26 21:42:08 +00:00
Markus Himmel
0a22f8fa6f chore: improve consistency & documentation for hash table insert and insertMany (#6222)
This PR changes the definition of `HashSet.insertMany` and
`HashSet.Raw.insertMany` so that it is equivalent to repeatedly calling
`HashSet.insert`/`HashSet.Raw.insert`. It also clarifies the docstrings
of all the `insert` and `insertMany` functions.

---------

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
2024-11-26 11:22:23 +00:00
Kim Morrison
f70b7e5722 feat: @[deprecated] requires a replacement identifier or message, and a since field (#6112)
This PR makes stricter requirements for the `@[deprecated]` attribute,
requiring either a replacement identifier as `@[deprecated bar]` or
suggestion text `@[deprecated "Past its use by date"]`, and also
requires a `since := "..."` field.
2024-11-26 08:45:54 +00:00
Kim Morrison
9a17919ef1 feat: missing lemmas about List's BEq (#6217)
This PR adds `simp` lemmas about `List`'s `==` operation.
2024-11-25 22:55:03 +00:00
Kyle Miller
606aeddf06 feat: make dot notation be affected by export/open (#6189)
This PR changes how generalized field notation ("dot notation") resolves
the function. The new resolution rule is that if `x : S`, then `x.f`
resolves the name `S.f` relative to the root namespace (hence it now
affected by `export` and `open`). Breaking change: aliases now resolve
differently. Before, if `x : S`, and if `S.f` is an alias for `S'.f`,
then `x.f` would use `S'.f` and look for an argument of type `S'`. Now,
it looks for an argument of type `S`, which is more generally useful
behavior. Code making use of the old behavior should consider defining
`S` or `S'` in terms of the other, since dot notation can unfold
definitions during resolution.

This also fixes a bug in explicit-mode generalized field notation
(`@x.f`) where `x` could be passed as the wrong argument. This was not a
bug for explicit-mode structure projections.

Closes #3031. Addresses the `Function` namespace issue in #1629.
2024-11-25 18:38:17 +00:00
Kyle Miller
0eca3bd55d feat: add a coercion from List Nat to Lean.Meta.Occurrences (#6206)
This PR makes it possible to write `rw (occs := [1,2]) ...` instead of
`rw (occs := .pos [1,2]) ...` by adding a coercion from `List.Nat` to
`Lean.Meta.Occurrences`.
2024-11-25 13:19:23 +00:00
Kim Morrison
43dfc2a25f chore: fix Vector.indexOf? (#6208)
Just a better defeq.
2024-11-25 10:47:58 +00:00
Mac Malone
935fcfb6ec feat: non-opaque UInt64.toUSize (#6202)
This PR makes `USize.toUInt64` a regular non-opaque definition. 

It also moves it to `Init.Data.UInt.Basic`, as it is not actually used
in `Init.Prelude` anymore.
2024-11-25 08:33:53 +00:00
Kim Morrison
20acc72a29 feat: ensure Fin.foldl/r are semireducible (#6207)
This PR ensures the `Fin.foldl` and `Fin.foldr` are semireducible.
Without this the defeq `example (f : Fin 3 → ℕ) : List.ofFn f = [f 0, f
1, f 2] := rfl` was failing.

Thanks @eric-wieser and @digama0 for diagnosing on
[Zulip](https://leanprover.zulipchat.com/#narrow/channel/287929-mathlib4/topic/.60List.2EfinRange.60.20in.20Mathlib/near/484191814).
2024-11-25 03:21:36 +00:00
Kim Morrison
c3948cba24 feat: upstream definition of Vector from Batteries (#6197)
This PR upstreams the definition of `Vector` from Batteries, along with
the basic functions.
2024-11-24 23:01:32 +00:00
502 changed files with 3889 additions and 1293 deletions

View File

@@ -103,10 +103,21 @@ your PR using rebase merge, bypassing the merge queue.
As written above, changes in meta code in the current stage usually will only
affect later stages. This is an issue in two specific cases.
* For the special case of *quotations*, it is desirable to have changes in builtin parsers affect them immediately: when the changes in the parser become active in the next stage, builtin macros implemented via quotations should generate syntax trees compatible with the new parser, and quotation patterns in builtin macros and elaborators should be able to match syntax created by the new parser and macros.
Since quotations capture the syntax tree structure during execution of the current stage and turn it into code for the next stage, we need to run the current stage's builtin parsers in quotations via the interpreter for this to work.
Caveats:
* We activate this behavior by default when building stage 1 by setting `-Dinternal.parseQuotWithCurrentStage=true`.
We force-disable it inside `macro/macro_rules/elab/elab_rules` via `suppressInsideQuot` as they are guaranteed not to run in the next stage and may need to be run in the current one, so the stage 0 parser is the correct one to use for them.
It may be necessary to extend this disabling to functions that contain quotations and are (exclusively) used by one of the mentioned commands. A function using quotations should never be used by both builtin and non-builtin macros/elaborators. Example: https://github.com/leanprover/lean4/blob/f70b7e5722da6101572869d87832494e2f8534b7/src/Lean/Elab/Tactic/Config.lean#L118-L122
* The parser needs to be reachable via an `import` statement, otherwise the version of the previous stage will silently be used.
* Only the parser code (`Parser.fn`) is affected; all metadata such as leading tokens is taken from the previous stage.
For an example, see https://github.com/leanprover/lean4/commit/f9dcbbddc48ccab22c7674ba20c5f409823b4cc1#diff-371387aed38bb02bf7761084fd9460e4168ae16d1ffe5de041b47d3ad2d22422R13
* For *non-builtin* meta code such as `notation`s or `macro`s in
`Notation.lean`, we expect changes to affect the current file and all later
files of the same stage immediately, just like outside the stdlib. To ensure
this, we need to build the stage using `-Dinterpreter.prefer_native=false` -
this, we build stage 1 using `-Dinterpreter.prefer_native=false` -
otherwise, when executing a macro, the interpreter would notice that there is
already a native symbol available for this function and run it instead of the
new IR, but the symbol is from the previous stage!
@@ -124,26 +135,11 @@ affect later stages. This is an issue in two specific cases.
further stages (e.g. after an `update-stage0`) will then need to be compiled
with the flag set to `false` again since they will expect the new signature.
For an example, see https://github.com/leanprover/lean4/commit/da4c46370d85add64ef7ca5e7cc4638b62823fbb.
When enabling `prefer_native`, we usually want to *disable* `parseQuotWithCurrentStage` as it would otherwise make quotations use the interpreter after all.
However, there is a specific case where we want to set both options to `true`: when we make changes to a non-builtin parser like `simp` that has a builtin elaborator, we cannot have the new parser be active outside of quotations in stage 1 as the builtin elaborator from stage 0 would not understand them; on the other hand, we need quotations in e.g. the builtin `simp` elaborator to produce the new syntax in the next stage.
As this issue usually affects only tactics, enabling `debug.byAsSorry` instead of `prefer_native` can be a simpler solution.
* For the special case of *quotations*, it is desirable to have changes in
built-in parsers affect them immediately: when the changes in the parser
become active in the next stage, macros implemented via quotations should
generate syntax trees compatible with the new parser, and quotation patterns
in macro and elaborators should be able to match syntax created by the new
parser and macros. Since quotations capture the syntax tree structure during
execution of the current stage and turn it into code for the next stage, we
need to run the current stage's built-in parsers in quotation via the
interpreter for this to work. Caveats:
* Since interpreting full parsers is not nearly as cheap and we rarely change
built-in syntax, this needs to be opted in using `-Dinternal.parseQuotWithCurrentStage=true`.
* The parser needs to be reachable via an `import` statement, otherwise the
version of the previous stage will silently be used.
* Only the parser code (`Parser.fn`) is affected; all metadata such as leading
tokens is taken from the previous stage.
For an example, see https://github.com/leanprover/lean4/commit/f9dcbbddc48ccab22c7674ba20c5f409823b4cc1#diff-371387aed38bb02bf7761084fd9460e4168ae16d1ffe5de041b47d3ad2d22422
(from before the flag defaulted to `false`).
For a `prefer_native` example, see https://github.com/leanprover/lean4/commit/da4c46370d85add64ef7ca5e7cc4638b62823fbb.
To modify either of these flags both for building and editing the stdlib, adjust
the code in `stage0/src/stdlib_flags.h`. The flags will automatically be reset

View File

@@ -12,17 +12,17 @@ Remark: this example is based on an example found in the Idris manual.
Vectors
--------
A `Vector` is a list of size `n` whose elements belong to a type `α`.
A `Vec` is a list of size `n` whose elements belong to a type `α`.
-/
inductive Vector (α : Type u) : Nat Type u
| nil : Vector α 0
| cons : α Vector α n Vector α (n+1)
inductive Vec (α : Type u) : Nat Type u
| nil : Vec α 0
| cons : α Vec α n Vec α (n+1)
/-!
We can overload the `List.cons` notation `::` and use it to create `Vector`s.
We can overload the `List.cons` notation `::` and use it to create `Vec`s.
-/
infix:67 " :: " => Vector.cons
infix:67 " :: " => Vec.cons
/-!
Now, we define the types of our simple functional language.
@@ -50,11 +50,11 @@ the builtin instance for `Add Int` as the solution.
/-!
Expressions are indexed by the types of the local variables, and the type of the expression itself.
-/
inductive HasType : Fin n Vector Ty n Ty Type where
inductive HasType : Fin n Vec Ty n Ty Type where
| stop : HasType 0 (ty :: ctx) ty
| pop : HasType k ctx ty HasType k.succ (u :: ctx) ty
inductive Expr : Vector Ty n Ty Type where
inductive Expr : Vec Ty n Ty Type where
| var : HasType i ctx ty Expr ctx ty
| val : Int Expr ctx Ty.int
| lam : Expr (a :: ctx) ty Expr ctx (Ty.fn a ty)
@@ -102,8 +102,8 @@ indexed over the types in scope. Since an environment is just another form of li
to the vector of local variable types, we overload again the notation `::` so that we can use the usual list syntax.
Given a proof that a variable is defined in the context, we can then produce a value from the environment.
-/
inductive Env : Vector Ty n Type where
| nil : Env Vector.nil
inductive Env : Vec Ty n Type where
| nil : Env Vec.nil
| cons : Ty.interp a Env ctx Env (a :: ctx)
infix:67 " :: " => Env.cons

View File

@@ -51,6 +51,8 @@ option(LLVM "LLVM" OFF)
option(USE_GITHASH "GIT_HASH" ON)
# When ON we install LICENSE files to CMAKE_INSTALL_PREFIX
option(INSTALL_LICENSE "INSTALL_LICENSE" ON)
# When ON we install a copy of cadical
option(INSTALL_CADICAL "Install a copy of cadical" ON)
# When ON thread storage is automatically finalized, it assumes platform support pthreads.
# This option is important when using Lean as library that is invoked from a different programming language (e.g., Haskell).
option(AUTO_THREAD_FINALIZATION "AUTO_THREAD_FINALIZATION" ON)
@@ -616,7 +618,7 @@ else()
OUTPUT_NAME leancpp)
endif()
if((${STAGE} GREATER 0) AND CADICAL)
if((${STAGE} GREATER 0) AND CADICAL AND INSTALL_CADICAL)
add_custom_target(copy-cadical
COMMAND cmake -E copy_if_different "${CADICAL}" "${CMAKE_BINARY_DIR}/bin/cadical${CMAKE_EXECUTABLE_SUFFIX}")
add_dependencies(leancpp copy-cadical)
@@ -738,7 +740,7 @@ file(COPY ${LEAN_SOURCE_DIR}/bin/leanmake DESTINATION ${CMAKE_BINARY_DIR}/bin)
install(DIRECTORY "${CMAKE_BINARY_DIR}/bin/" USE_SOURCE_PERMISSIONS DESTINATION bin)
if (${STAGE} GREATER 0 AND CADICAL)
if (${STAGE} GREATER 0 AND CADICAL AND INSTALL_CADICAL)
install(PROGRAMS "${CADICAL}" DESTINATION bin)
endif()

View File

@@ -43,3 +43,4 @@ import Init.Data.Zero
import Init.Data.NeZero
import Init.Data.Function
import Init.Data.RArray
import Init.Data.Vector

View File

@@ -19,3 +19,5 @@ import Init.Data.Array.GetLit
import Init.Data.Array.MapIdx
import Init.Data.Array.Set
import Init.Data.Array.Monadic
import Init.Data.Array.FinRange
import Init.Data.Array.Perm

View File

@@ -23,7 +23,7 @@ theorem foldlM_toList.aux [Monad m]
· cases Nat.not_le_of_gt _ (Nat.zero_add _ H)
· rename_i i; rw [Nat.succ_add] at H
simp [foldlM_toList.aux f arr i (j+1) H]
rw (occs := .pos [2]) [ List.getElem_cons_drop_succ_eq_drop _]
rw (occs := [2]) [ List.getElem_cons_drop_succ_eq_drop _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl

View File

@@ -0,0 +1,14 @@
/-
Copyright (c) 2024 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: François G. Dorais
-/
prelude
import Init.Data.List.FinRange
namespace Array
/-- `finRange n` is the array of all elements of `Fin n` in order. -/
protected def finRange (n : Nat) : Array (Fin n) := ofFn fun i => i
end Array

View File

@@ -21,15 +21,14 @@ import Init.TacticsExtra
## Theorems about `Array`.
-/
/-! ### Preliminaries about `Array` needed for `List.toArray` lemmas.
This section contains only the bare minimum lemmas about `Array`
that we need to write lemmas about `List.toArray`.
-/
namespace Array
@[simp] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
simp [mem_def]
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := rfl
theorem getElem?_eq_getElem {a : Array α} {i : Nat} (h : i < a.size) : a[i]? = some a[i] :=
getElem?_pos ..
@@ -39,96 +38,26 @@ theorem getElem?_eq_getElem {a : Array α} {i : Nat} (h : i < a.size) : a[i]? =
· rw [getElem?_neg a i h]
simp_all
@[simp] theorem none_eq_getElem?_iff {a : Array α} {i : Nat} : none = a[i]? a.size i := by
simp [eq_comm (a := none)]
theorem getElem?_eq {a : Array α} {i : Nat} :
a[i]? = if h : i < a.size then some a[i] else none := by
split
· simp_all [getElem?_eq_getElem]
· simp_all
theorem getElem?_eq_some_iff {a : Array α} : a[i]? = some b h : i < a.size, a[i] = b := by
simp [getElem?_eq]
theorem some_eq_getElem?_iff {a : Array α} : some b = a[i]? h : i < a.size, a[i] = b := by
rw [eq_comm, getElem?_eq_some_iff]
theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
rw [getElem?_eq]
split <;> simp_all
theorem getElem_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
@[simp] theorem getElem_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
theorem getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
by_cases h' : i < a.size
· simp [getElem_push_lt, h']
· simp at h
simp [getElem_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
@[deprecated getElem_push (since := "2024-10-21")] abbrev get_push := @getElem_push
@[deprecated getElem_push_lt (since := "2024-10-21")] abbrev get_push_lt := @getElem_push_lt
@[deprecated getElem_push_eq (since := "2024-10-21")] abbrev get_push_eq := @getElem_push_eq
@[simp] theorem mem_push {a : Array α} {x y : α} : x a.push y x a x = y := by
simp [mem_def]
theorem mem_push_self {a : Array α} {x : α} : x a.push x :=
mem_push.2 (Or.inr rfl)
theorem mem_push_of_mem {a : Array α} {x : α} (y : α) (h : x a) : x a.push y :=
mem_push.2 (Or.inl h)
theorem getElem_of_mem {a} {l : Array α} (h : a l) : (n : Nat) (h : n < l.size), l[n]'h = a := by
cases l
simp [List.getElem_of_mem (by simpa using h)]
theorem getElem?_of_mem {a} {l : Array α} (h : a l) : n : Nat, l[n]? = some a :=
let n, _, e := getElem_of_mem h; n, e getElem?_eq_getElem _
theorem mem_of_getElem? {l : Array α} {n : Nat} {a : α} (e : l[n]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
theorem mem_iff_getElem {a} {l : Array α} : a l (n : Nat) (h : n < l.size), l[n]'h = a :=
getElem_of_mem, fun _, _, e => e getElem_mem ..
theorem mem_iff_getElem? {a} {l : Array α} : a l n : Nat, l[n]? = some a := by
simp [getElem?_eq_some_iff, mem_iff_getElem]
theorem forall_getElem {l : Array α} {p : α Prop} :
( (n : Nat) h, p (l[n]'h)) a, a l p a := by
cases l; simp [List.forall_getElem]
@[simp] theorem get_eq_getElem (a : Array α) (i : Nat) (h) : a.get i h = a[i] := rfl
@[simp] theorem get!_eq_getElem! [Inhabited α] (a : Array α) (i : Nat) : a.get! i = a[i]! := by
simp [getElem!_def, get!, getD]
split <;> rename_i h
· simp [getElem?_eq_getElem h]
rfl
· simp [getElem?_eq_none_iff.2 (by simpa using h)]
theorem singleton_inj : #[a] = #[b] a = b := by
simp
theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
@[simp] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
simp [mem_def]
end Array
namespace List
open Array
/-! ### Lemmas about `List.toArray`.
We prefer to pull `List.toArray` outwards.
-/
namespace List
open Array
@[simp] theorem size_toArrayAux {a : List α} {b : Array α} :
(a.toArrayAux b).size = b.size + a.length := by
@@ -419,10 +348,243 @@ theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α → O
Array.zipWithAll as.toArray bs.toArray f = (List.zipWithAll f as bs).toArray := by
simp [Array.zipWithAll, zipWithAll_go_toArray]
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
apply ext'
simp
theorem takeWhile_go_succ (p : α Bool) (a : α) (l : List α) (i : Nat) :
takeWhile.go p (a :: l).toArray (i+1) r = takeWhile.go p l.toArray i r := by
rw [takeWhile.go, takeWhile.go]
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
getElem_toArray, getElem_cons_succ]
split
rw [takeWhile_go_succ]
rfl
theorem takeWhile_go_toArray (p : α Bool) (l : List α) (i : Nat) :
Array.takeWhile.go p l.toArray i r = r ++ (takeWhile p (l.drop i)).toArray := by
induction l generalizing i r with
| nil => simp [takeWhile.go]
| cons a l ih =>
rw [takeWhile.go]
cases i with
| zero =>
simp [takeWhile_go_succ, ih, takeWhile_cons]
split <;> simp
| succ i =>
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
getElem_toArray, getElem_cons_succ, drop_succ_cons]
split <;> rename_i h₁
· rw [takeWhile_go_succ, ih]
rw [ getElem_cons_drop_succ_eq_drop h₁, takeWhile_cons]
split <;> simp_all
· simp_all [drop_eq_nil_of_le]
@[simp] theorem takeWhile_toArray (p : α Bool) (l : List α) :
l.toArray.takeWhile p = (l.takeWhile p).toArray := by
simp [Array.takeWhile, takeWhile_go_toArray]
end List
namespace Array
/-! ## Preliminaries -/
/-! ### empty -/
@[simp] theorem empty_eq {xs : Array α} : #[] = xs xs = #[] := by
cases xs <;> simp
/-! ### size -/
theorem eq_empty_of_size_eq_zero (h : l.size = 0) : l = #[] := by
cases l
simp_all
theorem ne_empty_of_size_eq_add_one (h : l.size = n + 1) : l #[] := by
cases l
simpa using List.ne_nil_of_length_eq_add_one h
theorem ne_empty_of_size_pos (h : 0 < l.size) : l #[] := by
cases l
simpa using List.ne_nil_of_length_pos h
@[simp] theorem size_eq_zero : l.size = 0 l = #[] :=
eq_empty_of_size_eq_zero, fun h => h rfl
theorem size_pos_of_mem {a : α} {l : Array α} (h : a l) : 0 < l.size := by
cases l
simp only [mem_toArray] at h
simpa using List.length_pos_of_mem h
theorem exists_mem_of_size_pos {l : Array α} (h : 0 < l.size) : a, a l := by
cases l
simpa using List.exists_mem_of_length_pos h
theorem size_pos_iff_exists_mem {l : Array α} : 0 < l.size a, a l :=
exists_mem_of_size_pos, fun _, h => size_pos_of_mem h
theorem exists_mem_of_size_eq_add_one {l : Array α} (h : l.size = n + 1) : a, a l := by
cases l
simpa using List.exists_mem_of_length_eq_add_one h
theorem size_pos {l : Array α} : 0 < l.size l #[] :=
Nat.pos_iff_ne_zero.trans (not_congr size_eq_zero)
theorem size_eq_one {l : Array α} : l.size = 1 a, l = #[a] := by
cases l
simpa using List.length_eq_one
/-! ### push -/
theorem push_ne_empty {a : α} {xs : Array α} : xs.push a #[] := by
cases xs
simp
@[simp] theorem push_ne_self {a : α} {xs : Array α} : xs.push a xs := by
cases xs
simp
@[simp] theorem ne_push_self {a : α} {xs : Array α} : xs xs.push a := by
rw [ne_eq, eq_comm]
simp
theorem back_eq_of_push_eq {a b : α} {xs ys : Array α} (h : xs.push a = ys.push b) : a = b := by
cases xs
cases ys
simp only [List.push_toArray, mk.injEq] at h
replace h := List.append_inj_right' h (by simp)
simpa using h
theorem pop_eq_of_push_eq {a b : α} {xs ys : Array α} (h : xs.push a = ys.push b) : xs = ys := by
cases xs
cases ys
simp at h
replace h := List.append_inj_left' h (by simp)
simp [h]
theorem push_inj_left {a : α} {xs ys : Array α} : xs.push a = ys.push a xs = ys :=
pop_eq_of_push_eq, fun h => by simp [h]
theorem push_inj_right {a b : α} {xs : Array α} : xs.push a = xs.push b a = b :=
back_eq_of_push_eq, fun h => by simp [h]
theorem push_eq_push {a b : α} {xs ys : Array α} : xs.push a = ys.push b a = b xs = ys := by
constructor
· intro h
exact back_eq_of_push_eq h, pop_eq_of_push_eq h
· rintro rfl, rfl
rfl
theorem exists_push_of_ne_empty {xs : Array α} (h : xs #[]) :
(ys : Array α) (a : α), xs = ys.push a := by
rcases xs with xs
simp only [ne_eq, mk.injEq] at h
exact (xs.take (xs.length - 1)).toArray, xs.getLast h, by simp
theorem ne_empty_iff_exists_push {xs : Array α} :
xs #[] (ys : Array α) (a : α), xs = ys.push a :=
exists_push_of_ne_empty, fun _, _, eq => eq.symm push_ne_empty
theorem exists_push_of_size_pos {xs : Array α} (h : 0 < xs.size) :
(ys : Array α) (a : α), xs = ys.push a := by
replace h : xs #[] := size_pos.mp h
exact exists_push_of_ne_empty h
theorem size_pos_iff_exists_push {xs : Array α} :
0 < xs.size (ys : Array α) (a : α), xs = ys.push a :=
exists_push_of_size_pos, fun _, _, eq => by simp [eq]
theorem exists_push_of_size_eq_add_one {xs : Array α} (h : xs.size = n + 1) :
(ys : Array α) (a : α), xs = ys.push a :=
exists_push_of_size_pos (by simp [h])
/-! ## L[i] and L[i]? -/
@[deprecated List.getElem_toArray (since := "2024-11-29")]
theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := rfl
@[simp] theorem none_eq_getElem?_iff {a : Array α} {i : Nat} : none = a[i]? a.size i := by
simp [eq_comm (a := none)]
theorem getElem?_eq {a : Array α} {i : Nat} :
a[i]? = if h : i < a.size then some a[i] else none := by
split
· simp_all [getElem?_eq_getElem]
· simp_all
theorem getElem?_eq_some_iff {a : Array α} : a[i]? = some b h : i < a.size, a[i] = b := by
simp [getElem?_eq]
theorem some_eq_getElem?_iff {a : Array α} : some b = a[i]? h : i < a.size, a[i] = b := by
rw [eq_comm, getElem?_eq_some_iff]
theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
rw [getElem?_eq]
split <;> simp_all
theorem getElem_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
@[simp] theorem getElem_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
theorem getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
by_cases h' : i < a.size
· simp [getElem_push_lt, h']
· simp at h
simp [getElem_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
@[deprecated getElem_push (since := "2024-10-21")] abbrev get_push := @getElem_push
@[deprecated getElem_push_lt (since := "2024-10-21")] abbrev get_push_lt := @getElem_push_lt
@[deprecated getElem_push_eq (since := "2024-10-21")] abbrev get_push_eq := @getElem_push_eq
@[simp] theorem mem_push {a : Array α} {x y : α} : x a.push y x a x = y := by
simp [mem_def]
theorem mem_push_self {a : Array α} {x : α} : x a.push x :=
mem_push.2 (Or.inr rfl)
theorem mem_push_of_mem {a : Array α} {x : α} (y : α) (h : x a) : x a.push y :=
mem_push.2 (Or.inl h)
theorem getElem_of_mem {a} {l : Array α} (h : a l) : (n : Nat) (h : n < l.size), l[n]'h = a := by
cases l
simp [List.getElem_of_mem (by simpa using h)]
theorem getElem?_of_mem {a} {l : Array α} (h : a l) : n : Nat, l[n]? = some a :=
let n, _, e := getElem_of_mem h; n, e getElem?_eq_getElem _
theorem mem_of_getElem? {l : Array α} {n : Nat} {a : α} (e : l[n]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
theorem mem_iff_getElem {a} {l : Array α} : a l (n : Nat) (h : n < l.size), l[n]'h = a :=
getElem_of_mem, fun _, _, e => e getElem_mem ..
theorem mem_iff_getElem? {a} {l : Array α} : a l n : Nat, l[n]? = some a := by
simp [getElem?_eq_some_iff, mem_iff_getElem]
theorem forall_getElem {l : Array α} {p : α Prop} :
( (n : Nat) h, p (l[n]'h)) a, a l p a := by
cases l; simp [List.forall_getElem]
theorem singleton_inj : #[a] = #[b] a = b := by
simp
theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-- This is a duplicate of `List.toArray_toList`.
@@ -496,6 +658,11 @@ where
simp only [ length_toList]
simp
@[simp] theorem mapM_empty [Monad m] (f : α m β) : mapM f #[] = pure #[] := by
rw [mapM, mapM.map]; rfl
@[simp] theorem map_empty (f : α β) : map f #[] = #[] := mapM_empty f
@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp)
@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) :
@@ -535,8 +702,6 @@ theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by si
/-! # get -/
@[simp] theorem get_eq_getElem (a : Array α) (i : Nat) (h) : a.get i h = a[i] := rfl
theorem getElem?_lt
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some a[i] := dif_pos h
@@ -855,11 +1020,6 @@ theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
a.pop[i] = a[i]'(Nat.lt_of_lt_of_le (a.size_pop hi) (Nat.sub_le _ _)) :=
List.getElem_dropLast ..
theorem eq_empty_of_size_eq_zero {as : Array α} (h : as.size = 0) : as = #[] := by
apply ext
· simp [h]
· intros; contradiction
theorem eq_push_pop_back!_of_size_ne_zero [Inhabited α] {as : Array α} (h : as.size 0) :
as = as.pop.push as.back! := by
apply ext
@@ -1093,6 +1253,34 @@ theorem foldr_congr {as bs : Array α} (h₀ : as = bs) {f g : α → β → β}
as.foldr f a start stop = bs.foldr g b start' stop' := by
congr
theorem foldl_eq_foldlM (f : β α β) (b) (l : Array α) :
l.foldl f b = l.foldlM (m := Id) f b := by
cases l
simp [List.foldl_eq_foldlM]
theorem foldr_eq_foldrM (f : α β β) (b) (l : Array α) :
l.foldr f b = l.foldrM (m := Id) f b := by
cases l
simp [List.foldr_eq_foldrM]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : Array α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : Array α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : Array β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
cases l
simp
rw [List.foldl_hom _ _ _ _ _ H]
theorem foldr_hom (f : β₁ β₂) (g₁ : α β₁ β₁) (g₂ : α β₂ β₂) (l : Array α) (init : β₁)
(H : x y, g₂ x (f y) = f (g₁ x y)) : l.foldr g₂ (f init) = f (l.foldr g₁ init) := by
cases l
simp
rw [List.foldr_hom _ _ _ _ _ H]
/-! ### map -/
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
@@ -1348,6 +1536,18 @@ theorem getElem?_append {as bs : Array α} {n : Nat} :
· exact getElem?_append_left h
· exact getElem?_append_right (by simpa using h)
@[simp] theorem toArray_eq_append_iff {xs : List α} {as bs : Array α} :
xs.toArray = as ++ bs xs = as.toList ++ bs.toList := by
cases as
cases bs
simp
@[simp] theorem append_eq_toArray_iff {as bs : Array α} {xs : List α} :
as ++ bs = xs.toArray as.toList ++ bs.toList = xs := by
cases as
cases bs
simp
/-! ### flatten -/
@[simp] theorem toList_flatten {l : Array (Array α)} :
@@ -1717,6 +1917,14 @@ theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size)
cases bs
simp
@[simp] theorem size_zipWith (as : Array α) (bs : Array β) (f : α β γ) :
(as.zipWith bs f).size = min as.size bs.size := by
rw [size_eq_length_toList, toList_zipWith, List.length_zipWith]
@[simp] theorem size_zip (as : Array α) (bs : Array β) :
(as.zip bs).size = min as.size bs.size :=
as.size_zipWith bs Prod.mk
/-! ### findSomeM?, findM?, findSome?, find? -/
@[simp] theorem findSomeM?_toList [Monad m] [LawfulMonad m] (p : α m (Option β)) (as : Array α) :
@@ -1776,11 +1984,6 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
apply ext'
simp
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp] theorem set_toArray (l : List α) (i : Fin l.toArray.size) (a : α) :
l.toArray.set i a = (l.set i a).toArray := by
apply ext'
@@ -1844,10 +2047,6 @@ theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p
apply ext'
simp
@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
apply ext'
simp
@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
apply ext'
simp
@@ -1893,38 +2092,6 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
@[simp] theorem toArray_ofFn (f : Fin n α) : (ofFn f).toArray = Array.ofFn f := by
ext <;> simp
theorem takeWhile_go_succ (p : α Bool) (a : α) (l : List α) (i : Nat) :
takeWhile.go p (a :: l).toArray (i+1) r = takeWhile.go p l.toArray i r := by
rw [takeWhile.go, takeWhile.go]
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
getElem_toArray, getElem_cons_succ]
split
rw [takeWhile_go_succ]
rfl
theorem takeWhile_go_toArray (p : α Bool) (l : List α) (i : Nat) :
Array.takeWhile.go p l.toArray i r = r ++ (takeWhile p (l.drop i)).toArray := by
induction l generalizing i r with
| nil => simp [takeWhile.go]
| cons a l ih =>
rw [takeWhile.go]
cases i with
| zero =>
simp [takeWhile_go_succ, ih, takeWhile_cons]
split <;> simp
| succ i =>
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
getElem_toArray, getElem_cons_succ, drop_succ_cons]
split <;> rename_i h₁
· rw [takeWhile_go_succ, ih]
rw [ getElem_cons_drop_succ_eq_drop h₁, takeWhile_cons]
split <;> simp_all
· simp_all [drop_eq_nil_of_le]
@[simp] theorem takeWhile_toArray (p : α Bool) (l : List α) :
l.toArray.takeWhile p = (l.takeWhile p).toArray := by
simp [Array.takeWhile, takeWhile_go_toArray]
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
rw [Array.eraseIdx]
@@ -2024,6 +2191,20 @@ theorem foldr_filterMap (f : α → Option β) (g : β → γγ) (l : Array
simp [List.foldr_filterMap]
rfl
theorem foldl_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : Array α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldl f' (g a) = g (l.foldl f a) := by
cases l
simp
rw [List.foldl_map' _ _ _ _ _ h]
theorem foldr_map' (g : α β) (f : α α α) (f' : β β β) (a : α) (l : List α)
(h : x y, f' (g x) (g y) = g (f x y)) :
(l.map g).foldr f' (g a) = g (l.foldr f a) := by
cases l
simp
rw [List.foldr_map' _ _ _ _ _ h]
/-! ### flatten -/
@[simp] theorem flatten_empty : flatten (#[] : Array (Array α)) = #[] := rfl

View File

@@ -0,0 +1,65 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Nat.Perm
import Init.Data.Array.Lemmas
namespace Array
open List
/--
`Perm as bs` asserts that `as` and `bs` are permutations of each other.
This is a wrapper around `List.Perm`, and for now has much less API.
For more complicated verification, use `perm_iff_toList_perm` and the `List` API.
-/
def Perm (as bs : Array α) : Prop :=
as.toList ~ bs.toList
@[inherit_doc] scoped infixl:50 " ~ " => Perm
theorem perm_iff_toList_perm {as bs : Array α} : as ~ bs as.toList ~ bs.toList := Iff.rfl
@[simp] theorem perm_toArray (as bs : List α) : as.toArray ~ bs.toArray as ~ bs := by
simp [perm_iff_toList_perm]
@[simp, refl] protected theorem Perm.refl (l : Array α) : l ~ l := by
cases l
simp
protected theorem Perm.rfl {l : List α} : l ~ l := .refl _
theorem Perm.of_eq {l₁ l₂ : Array α} (h : l₁ = l₂) : l₁ ~ l₂ := h .rfl
protected theorem Perm.symm {l₁ l₂ : Array α} (h : l₁ ~ l₂) : l₂ ~ l₁ := by
cases l₁; cases l₂
simp only [perm_toArray] at h
simpa using h.symm
protected theorem Perm.trans {l₁ l₂ l₃ : Array α} (h₁ : l₁ ~ l₂) (h₂ : l₂ ~ l₃) : l₁ ~ l₃ := by
cases l₁; cases l₂; cases l₃
simp only [perm_toArray] at h₁ h₂
simpa using h₁.trans h₂
instance : Trans (Perm (α := α)) (Perm (α := α)) (Perm (α := α)) where
trans h₁ h₂ := Perm.trans h₁ h₂
theorem perm_comm {l₁ l₂ : Array α} : l₁ ~ l₂ l₂ ~ l₁ := Perm.symm, Perm.symm
theorem Perm.push (x y : α) {l₁ l₂ : Array α} (p : l₁ ~ l₂) :
(l₁.push x).push y ~ (l₂.push y).push x := by
cases l₁; cases l₂
simp only [perm_toArray] at p
simp only [push_toArray, List.append_assoc, singleton_append, perm_toArray]
exact p.append (Perm.swap' _ _ Perm.nil)
theorem swap_perm {as : Array α} {i j : Nat} (h₁ : i < as.size) (h₂ : j < as.size) :
as.swap i j ~ as := by
simp only [swap, perm_iff_toList_perm, toList_set]
apply set_set_perm
end Array

View File

@@ -4,46 +4,46 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Vector.Basic
import Init.Data.Ord
namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
def qpartition (as : Array α) (lt : α α Bool) (lo hi : Nat) : Nat × Array α :=
if h : as.size = 0 then (0, as) else have : Inhabited α := as[0]'(by revert h; cases as.size <;> simp) -- TODO: remove
private def qpartition {n} (as : Vector α n) (lt : α α Bool) (lo hi : Nat)
(hlo : lo < n := by omega) (hhi : hi < n := by omega) : {n : Nat // lo n} × Vector α n :=
let mid := (lo + hi) / 2
let as := if lt (as.get! mid) (as.get! lo) then as.swapIfInBounds lo mid else as
let as := if lt (as.get! hi) (as.get! lo) then as.swapIfInBounds lo hi else as
let as := if lt (as.get! mid) (as.get! hi) then as.swapIfInBounds mid hi else as
let pivot := as.get! hi
let rec loop (as : Array α) (i j : Nat) :=
let as := if lt as[mid] as[lo] then as.swap lo mid else as
let as := if lt as[hi] as[lo] then as.swap lo hi else as
let as := if lt as[mid] as[hi] then as.swap mid hi else as
let pivot := as[hi]
let rec loop (as : Vector α n) (i j : Nat)
(ilo : lo i := by omega) (jh : j < n := by omega) (w : i j := by omega) :=
if h : j < hi then
if lt (as.get! j) pivot then
let as := as.swapIfInBounds i j
loop as (i+1) (j+1)
if lt as[j] pivot then
loop (as.swap i j) (i+1) (j+1)
else
loop as i (j+1)
else
let as := as.swapIfInBounds i hi
(i, as)
termination_by hi - j
decreasing_by all_goals simp_wf; decreasing_trivial_pre_omega
(i, ilo, as.swap i hi)
loop as lo lo
@[inline] partial def qsort (as : Array α) (lt : α α Bool) (low := 0) (high := as.size - 1) : Array α :=
let rec @[specialize] sort (as : Array α) (low high : Nat) :=
if low < high then
let p := qpartition as lt low high;
-- TODO: fix `partial` support in the equation compiler, it breaks if we use `let (mid, as) := partition as lt low high`
let mid := p.1
let as := p.2
if mid >= high then as
@[inline] def qsort (as : Array α) (lt : α α Bool := by exact (· < ·))
(low := 0) (high := as.size - 1) : Array α :=
let rec @[specialize] sort {n} (as : Vector α n) (lo hi : Nat)
(hlo : lo < n := by omega) (hhi : hi < n := by omega) :=
if h₁ : lo < hi then
let mid, hmid, as := qpartition as lt lo hi
if h₂ : mid hi then
as
else
let as := sort as low mid
sort as (mid+1) high
sort (sort as lo mid) (mid+1) hi
else as
sort as low high
if h : as.size = 0 then
as
else
let low := min low (as.size - 1)
let high := min high (as.size - 1)
sort as, rfl low high |>.toArray
set_option linter.unusedVariables.funArgs false in
/--

View File

@@ -1622,14 +1622,16 @@ theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
/-- Sign extending to a larger bitwidth depends on the msb.
If the msb is false, then the result equals the original value.
If the msb is true, then we add a value of `(2^v - 2^w)`, which arises from the sign extension. -/
theorem toNat_signExtend_of_le (x : BitVec w) {v : Nat} (hv : w v) :
private theorem toNat_signExtend_of_le (x : BitVec w) {v : Nat} (hv : w v) :
(x.signExtend v).toNat = x.toNat + if x.msb then 2^v - 2^w else 0 := by
apply Nat.eq_of_testBit_eq
intro i
have k, hk := Nat.exists_eq_add_of_le hv
rw [hk, testBit_toNat, getLsbD_signExtend, Nat.pow_add, Nat.mul_sub_one, Nat.add_comm (x.toNat)]
by_cases hx : x.msb
· simp [hx, Nat.testBit_mul_pow_two_add _ x.isLt, testBit_toNat]
· simp only [hx, Bool.if_true_right, reduceIte,
Nat.testBit_mul_pow_two_add _ x.isLt,
testBit_toNat, Nat.testBit_two_pow_sub_one]
-- Case analysis on i being in the intervals [0..w), [w..w + k), [w+k..∞)
have hi : i < w (w i i < w + k) w + k i := by omega
rcases hi with hi | hi | hi
@@ -1637,7 +1639,8 @@ theorem toNat_signExtend_of_le (x : BitVec w) {v : Nat} (hv : w ≤ v) :
· simp [hi]; omega
· simp [hi, show ¬ (i < w + k) by omega, show ¬ (i < w) by omega]
omega
· simp [hx, Nat.testBit_mul_pow_two_add _ x.isLt, testBit_toNat]
· simp only [hx, Bool.if_false_right,
Bool.false_eq_true, reduceIte, Nat.zero_add, testBit_toNat]
have hi : i < w (w i i < w + k) w + k i := by omega
rcases hi with hi | hi | hi
· simp [hi]; omega
@@ -2758,12 +2761,6 @@ theorem getElem_rotateLeft {x : BitVec w} {r i : Nat} (h : i < w) :
if h' : i < r % w then x[(w - (r % w) + i)] else x[i - (r % w)] := by
simp [ BitVec.getLsbD_eq_getElem, h]
/-- If `w ≤ x < 2 * w`, then `x % w = x - w` -/
theorem mod_eq_sub_of_le_of_lt {x w : Nat} (x_le : w x) (x_lt : x < 2 * w) :
x % w = x - w := by
rw [Nat.mod_eq_sub_mod, Nat.mod_eq_of_lt (by omega)]
omega
theorem getMsbD_rotateLeftAux_of_lt {x : BitVec w} {r : Nat} {i : Nat} (hi : i < w - r) :
(x.rotateLeftAux r).getMsbD i = x.getMsbD (r + i) := by
rw [rotateLeftAux, getMsbD_or]
@@ -2773,6 +2770,20 @@ theorem getMsbD_rotateLeftAux_of_ge {x : BitVec w} {r : Nat} {i : Nat} (hi : i
(x.rotateLeftAux r).getMsbD i = (decide (i < w) && x.getMsbD (i - (w - r))) := by
simp [rotateLeftAux, getMsbD_or, show i + r w by omega, show ¬i < w - r by omega]
/--
If a number `w * n ≤ i < w * (n + 1)`, then `i - w * n` equals `i % w`.
This is true by subtracting `w * n` from the inequality, giving
`0 ≤ i - w * n < w`, which uniquely identifies `i % w`.
-/
private theorem Nat.sub_mul_eq_mod_of_lt_of_le (hlo : w * n i) (hhi : i < w * (n + 1)) :
i - w * n = i % w := by
rw [Nat.mod_def]
congr
symm
apply Nat.div_eq_of_lt_le
(by rw [Nat.mul_comm]; omega)
(by rw [Nat.mul_comm]; omega)
/-- When `r < w`, we give a formula for `(x.rotateLeft r).getMsbD i`. -/
theorem getMsbD_rotateLeft_of_lt {n w : Nat} {x : BitVec w} (hi : r < w):
(x.rotateLeft r).getMsbD n = (decide (n < w) && x.getMsbD ((r + n) % w)) := by
@@ -2785,8 +2796,8 @@ theorem getMsbD_rotateLeft_of_lt {n w : Nat} {x : BitVec w} (hi : r < w):
by_cases h₁ : n < w + 1
· simp only [h₁, decide_true, Bool.true_and]
have h₂ : (r + n) < 2 * (w + 1) := by omega
rw [mod_eq_sub_of_le_of_lt (by omega) (by omega)]
congr 1
rw [ Nat.sub_mul_eq_mod_of_lt_of_le (n := 1) (by omega) (by omega), Nat.mul_one]
omega
· simp [h₁]
@@ -3103,20 +3114,6 @@ theorem replicate_succ_eq {x : BitVec w} :
(x ++ replicate n x).cast (by rw [Nat.mul_succ]; omega) := by
simp [replicate]
/--
If a number `w * n ≤ i < w * (n + 1)`, then `i - w * n` equals `i % w`.
This is true by subtracting `w * n` from the inequality, giving
`0 ≤ i - w * n < w`, which uniquely identifies `i % w`.
-/
private theorem Nat.sub_mul_eq_mod_of_lt_of_le (hlo : w * n i) (hhi : i < w * (n + 1)) :
i - w * n = i % w := by
rw [Nat.mod_def]
congr
symm
apply Nat.div_eq_of_lt_le
(by rw [Nat.mul_comm]; omega)
(by rw [Nat.mul_comm]; omega)
@[simp]
theorem getLsbD_replicate {n w : Nat} (x : BitVec w) :
(x.replicate n).getLsbD i =
@@ -3222,6 +3219,11 @@ theorem toInt_neg_of_ne_intMin {x : BitVec w} (rs : x ≠ intMin w) :
have := @Nat.two_pow_pred_mul_two w (by omega)
split <;> split <;> omega
theorem toInt_neg_eq_ite {x : BitVec w} :
(-x).toInt = if x = intMin w then x.toInt else -(x.toInt) := by
by_cases hx : x = intMin w <;>
simp [hx, neg_intMin, toInt_neg_of_ne_intMin]
theorem msb_intMin {w : Nat} : (intMin w).msb = decide (0 < w) := by
simp only [msb_eq_decide, toNat_intMin, decide_eq_decide]
by_cases h : 0 < w <;> simp_all
@@ -3355,6 +3357,73 @@ theorem getMsbD_abs {i : Nat} {x : BitVec w} :
getMsbD (x.abs) i = if x.msb then getMsbD (-x) i else getMsbD x i := by
by_cases h : x.msb <;> simp [BitVec.abs, h]
/-
The absolute value of `x : BitVec w` is naively a case split on the sign of `x`.
However, recall that when `x = intMin w`, `-x = x`.
Thus, the full value of `abs x` is computed by the case split:
- If `x : BitVec w` is `intMin`, then its absolute value is also `intMin w`, and
thus `toInt` will equal `intMin.toInt`.
- Otherwise, if `x` is negative, then `x.abs.toInt = (-x).toInt`.
- If `x` is positive, then it is equal to `x.abs.toInt = x.toInt`.
-/
theorem toInt_abs_eq_ite {x : BitVec w} :
x.abs.toInt =
if x = intMin w then (intMin w).toInt
else if x.msb then -x.toInt
else x.toInt := by
by_cases hx : x = intMin w
· simp [hx]
· simp [hx]
by_cases hx₂ : x.msb
· simp [hx₂, abs_eq, toInt_neg_of_ne_intMin hx]
· simp [hx₂, abs_eq]
/-
The absolute value of `x : BitVec w` is a case split on the sign of `x`, when `x ≠ intMin w`.
This is a variant of `toInt_abs_eq_ite`.
-/
theorem toInt_abs_eq_ite_of_ne_intMin {x : BitVec w} (hx : x intMin w) :
x.abs.toInt = if x.msb then -x.toInt else x.toInt := by
simp [toInt_abs_eq_ite, hx]
/--
The absolute value of `x : BitVec w`, interpreted as an integer, is a case split:
- When `x = intMin w`, then `x.abs = intMin w`
- Otherwise, `x.abs.toInt` equals the absolute value (`x.toInt.natAbs`).
This is a simpler version of `BitVec.toInt_abs_eq_ite`, which hides a case split on `x.msb`.
-/
theorem toInt_abs_eq_natAbs {x : BitVec w} : x.abs.toInt =
if x = intMin w then (intMin w).toInt else x.toInt.natAbs := by
rw [toInt_abs_eq_ite]
by_cases hx : x = intMin w
· simp [hx]
· simp [hx]
by_cases h : x.msb
· simp only [h, reduceIte]
have : x.toInt < 0 := by
rw [toInt_neg_iff]
have := msb_eq_true_iff_two_mul_ge.mp h
omega
omega
· simp only [h, Bool.false_eq_true, reduceIte]
have : 0 x.toInt := by
rw [toInt_pos_iff]
exact msb_eq_false_iff_two_mul_lt.mp (by simp [h])
omega
/-
The absolute value of `(x : BitVec w)`, when interpreted as an integer,
is the absolute value of `x.toInt` when `(x ≠ intMin)`.
-/
theorem toInt_abs_eq_natAbs_of_ne_intMin {x : BitVec w} (hx : x intMin w) :
x.abs.toInt = x.toInt.natAbs := by
simp [toInt_abs_eq_natAbs, hx]
/-! ### Decidable quantifiers -/
theorem forall_zero_iff {P : BitVec 0 Prop} :

View File

@@ -36,12 +36,6 @@ def succ : Fin n → Fin (n + 1)
variable {n : Nat}
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
protected def ofNat {n : Nat} (a : Nat) : Fin (n + 1) :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
/--
Returns `a` modulo `n` as a `Fin n`.
@@ -50,9 +44,12 @@ The assumption `NeZero n` ensures that `Fin n` is nonempty.
protected def ofNat' (n : Nat) [NeZero n] (a : Nat) : Fin n :=
a % n, Nat.mod_lt _ (pos_of_neZero n)
-- We intend to deprecate `Fin.ofNat` in favor of `Fin.ofNat'` (and later rename).
-- This is waiting on https://github.com/leanprover/lean4/pull/5323
-- attribute [deprecated Fin.ofNat' (since := "2024-09-16")] Fin.ofNat
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
@[deprecated Fin.ofNat' (since := "2024-11-27")]
protected def ofNat {n : Nat} (a : Nat) : Fin (n + 1) :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
private theorem mlt {b : Nat} : {a : Nat} a < n b % n < n
| 0, h => Nat.mod_lt _ h

View File

@@ -13,17 +13,17 @@ namespace Fin
/-- Folds over `Fin n` from the left: `foldl 3 f x = f (f (f x 0) 1) 2`. -/
@[inline] def foldl (n) (f : α Fin n α) (init : α) : α := loop init 0 where
/-- Inner loop for `Fin.foldl`. `Fin.foldl.loop n f x i = f (f (f x i) ...) (n-1)` -/
loop (x : α) (i : Nat) : α :=
@[semireducible] loop (x : α) (i : Nat) : α :=
if h : i < n then loop (f x i, h) (i+1) else x
termination_by n - i
decreasing_by decreasing_trivial_pre_omega
/-- Folds over `Fin n` from the right: `foldr 3 f x = f 0 (f 1 (f 2 x))`. -/
@[inline] def foldr (n) (f : Fin n α α) (init : α) : α := loop n, Nat.le_refl n init where
@[inline] def foldr (n) (f : Fin n α α) (init : α) : α := loop n (Nat.le_refl n) init where
/-- Inner loop for `Fin.foldr`. `Fin.foldr.loop n f i x = f 0 (f ... (f (i-1) x))` -/
loop : {i // i n} α α
| 0, _, x => x
| i+1, h, x => loop i, Nat.le_of_lt h (f i, h x)
loop : (i : _) i n α α
| 0, _, x => x
| i+1, h, x => loop i (Nat.le_of_lt h) (f i, h x)
termination_by structural i => i
/--
Folds a monadic function over `Fin n` from left to right:
@@ -176,17 +176,19 @@ theorem foldl_eq_foldlM (f : α → Fin n → α) (x) :
/-! ### foldr -/
theorem foldr_loop_zero (f : Fin n α α) (x) :
foldr.loop n f 0, Nat.zero_le _ x = x := by
foldr.loop n f 0 (Nat.zero_le _) x = x := by
rw [foldr.loop]
theorem foldr_loop_succ (f : Fin n α α) (x) (h : i < n) :
foldr.loop n f i+1, h x = foldr.loop n f i, Nat.le_of_lt h (f i, h x) := by
foldr.loop n f (i+1) h x = foldr.loop n f i (Nat.le_of_lt h) (f i, h x) := by
rw [foldr.loop]
theorem foldr_loop (f : Fin (n+1) α α) (x) (h : i+1 n+1) :
foldr.loop (n+1) f i+1, h x =
f 0 (foldr.loop n (fun j => f j.succ) i, Nat.le_of_succ_le_succ h x) := by
induction i generalizing x <;> simp [foldr_loop_zero, foldr_loop_succ, *]
foldr.loop (n+1) f (i+1) h x =
f 0 (foldr.loop n (fun j => f j.succ) i (Nat.le_of_succ_le_succ h) x) := by
induction i generalizing x with
| zero => simp [foldr_loop_succ, foldr_loop_zero]
| succ i ih => rw [foldr_loop_succ, ih]; rfl
@[simp] theorem foldr_zero (f : Fin 0 α α) (x) : foldr 0 f x = x :=
foldr_loop_zero ..

View File

@@ -26,3 +26,4 @@ import Init.Data.List.Sort
import Init.Data.List.ToArray
import Init.Data.List.MapIdx
import Init.Data.List.OfFn
import Init.Data.List.FinRange

View File

@@ -231,7 +231,7 @@ theorem ext_get? : ∀ {l₁ l₂ : List α}, (∀ n, l₁.get? n = l₂.get? n)
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 (since := "2024-06-07")] abbrev ext := @ext_get?
@[deprecated ext_get? (since := "2024-06-07")] abbrev ext := @ext_get?
/-! ### getD -/
@@ -682,7 +682,7 @@ 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 (since := "2024-06-15")]
@[deprecated "Use `!(elem a l)` instead."(since := "2024-06-15")]
def notElem [BEq α] (a : α) (as : List α) : Bool :=
!(as.elem a)

View File

@@ -0,0 +1,48 @@
/-
Copyright (c) 2024 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: François G. Dorais
-/
prelude
import Init.Data.List.OfFn
namespace List
/-- `finRange n` lists all elements of `Fin n` in order -/
def finRange (n : Nat) : List (Fin n) := ofFn fun i => i
@[simp] theorem length_finRange (n) : (List.finRange n).length = n := by
simp [List.finRange]
@[simp] theorem getElem_finRange (i : Nat) (h : i < (List.finRange n).length) :
(finRange n)[i] = Fin.cast (length_finRange n) i, h := by
simp [List.finRange]
@[simp] theorem finRange_zero : finRange 0 = [] := by simp [finRange, ofFn]
theorem finRange_succ (n) : finRange (n+1) = 0 :: (finRange n).map Fin.succ := by
apply List.ext_getElem; simp; intro i; cases i <;> simp
theorem finRange_succ_last (n) :
finRange (n+1) = (finRange n).map Fin.castSucc ++ [Fin.last n] := by
apply List.ext_getElem
· simp
· intros
simp only [List.finRange, List.getElem_ofFn, getElem_append, length_map, length_ofFn,
getElem_map, Fin.castSucc_mk, getElem_singleton]
split
· rfl
· next h => exact Fin.eq_last_of_not_lt h
theorem finRange_reverse (n) : (finRange n).reverse = (finRange n).map Fin.rev := by
induction n with
| zero => simp
| succ n ih =>
conv => lhs; rw [finRange_succ_last]
conv => rhs; rw [finRange_succ]
rw [reverse_append, reverse_cons, reverse_nil, nil_append, singleton_append, map_reverse,
map_cons, ih, map_map, map_map]
congr; funext
simp [Fin.rev_succ]
end List

View File

@@ -83,44 +83,12 @@ open Nat
@[simp] theorem nil_eq {α} {xs : List α} : [] = xs xs = [] := by
cases xs <;> simp
/-! ### cons -/
theorem cons_ne_nil (a : α) (l : List α) : a :: l [] := nofun
@[simp]
theorem cons_ne_self (a : α) (l : List α) : a :: l l := mt (congrArg length) (Nat.succ_ne_self _)
@[simp] theorem ne_cons_self {a : α} {l : List α} : l a :: l := by
rw [ne_eq, eq_comm]
simp
theorem head_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : h₁ = h₂ := (cons.inj H).1
theorem tail_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : t₁ = t₂ := (cons.inj H).2
theorem cons_inj_right (a : α) {l l' : List α} : a :: l = a :: l' l = l' :=
tail_eq_of_cons_eq, congrArg _
@[deprecated (since := "2024-06-15")] abbrev cons_inj := @cons_inj_right
theorem cons_eq_cons {a b : α} {l l' : List α} : a :: l = b :: l' a = b l = l' :=
List.cons.injEq .. .rfl
theorem exists_cons_of_ne_nil : {l : List α}, l [] b L, l = b :: L
| c :: l', _ => c, l', rfl
theorem singleton_inj {α : Type _} {a b : α} : [a] = [b] a = b := by
simp
/-! ### length -/
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
theorem ne_nil_of_length_eq_add_one (_ : length l = n + 1) : l [] := fun _ => nomatch l
@[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
theorem ne_nil_of_length_pos (_ : 0 < length l) : l [] := fun _ => nomatch l
@[simp] theorem length_eq_zero : length l = 0 l = [] :=
@@ -156,6 +124,36 @@ theorem length_pos {l : List α} : 0 < length l ↔ l ≠ [] :=
theorem length_eq_one {l : List α} : length l = 1 a, l = [a] :=
fun h => match l, h with | [_], _ => _, rfl, fun _, h => by simp [h]
/-! ### cons -/
theorem cons_ne_nil (a : α) (l : List α) : a :: l [] := nofun
@[simp]
theorem cons_ne_self (a : α) (l : List α) : a :: l l := mt (congrArg length) (Nat.succ_ne_self _)
@[simp] theorem ne_cons_self {a : α} {l : List α} : l a :: l := by
rw [ne_eq, eq_comm]
simp
theorem head_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : h₁ = h₂ := (cons.inj H).1
theorem tail_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : t₁ = t₂ := (cons.inj H).2
theorem cons_inj_right (a : α) {l l' : List α} : a :: l = a :: l' l = l' :=
tail_eq_of_cons_eq, congrArg _
theorem cons_eq_cons {a b : α} {l l' : List α} : a :: l = b :: l' a = b l = l' :=
List.cons.injEq .. .rfl
theorem exists_cons_of_ne_nil : {l : List α}, l [] b L, l = b :: L
| c :: l', _ => c, l', rfl
theorem ne_nil_iff_exists_cons {l : List α} : l [] b L, l = b :: L :=
exists_cons_of_ne_nil, fun _, _, eq => eq.symm cons_ne_nil _ _
theorem singleton_inj {α : Type _} {a b : α} : [a] = [b] a = b := by
simp
/-! ## L[i] and L[i]? -/
/-! ### `get` and `get?`.
@@ -163,57 +161,29 @@ theorem length_eq_one {l : List α} : length l = 1 ↔ ∃ a, l = [a] :=
We simplify `l.get i` to `l[i.1]'i.2` and `l.get? i` to `l[i]?`.
-/
theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl
@[simp] theorem get_eq_getElem (l : List α) (i : Fin l.length) : l.get i = l[i.1]'i.2 := rfl
theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} :
(a :: as).get i+1, h = as.get i, Nat.lt_of_succ_lt_succ h := rfl
theorem get_cons_succ' {as : List α} {i : Fin as.length} :
(a :: as).get i.succ = as.get i := rfl
@[deprecated (since := "2024-07-09")]
theorem get_cons_cons_one : (a₁ :: a₂ :: as).get (1 : Fin (as.length + 2)) = a₂ := rfl
theorem get_mk_zero : {l : List α} (h : 0 < l.length), l.get 0, h = l.head (length_pos.mp h)
| _::_, _ => rfl
theorem get?_zero (l : List α) : l.get? 0 = l.head? := by cases l <;> rfl
theorem get?_len_le : {l : List α} {n}, length l n l.get? n = none
theorem get?_eq_none : {l : List α} {n}, length l n l.get? n = none
| [], _, _ => rfl
| _ :: l, _+1, h => get?_len_le (l := l) <| Nat.le_of_succ_le_succ h
| _ :: l, _+1, h => get?_eq_none (l := l) <| Nat.le_of_succ_le_succ h
theorem get?_eq_get : {l : List α} {n} (h : n < l.length), l.get? n = some (get l n, h)
| _ :: _, 0, _ => rfl
| _ :: l, _+1, _ => get?_eq_get (l := l) _
theorem get?_eq_some : l.get? n = some a h, get l n, h = a :=
theorem get?_eq_some_iff : l.get? n = some a h, get l n, h = a :=
fun e =>
have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn e
have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_eq_none hn e
this, by rwa [get?_eq_get this, Option.some.injEq] at e,
fun _, e => e get?_eq_get _
theorem get?_eq_none : l.get? n = none length l n :=
fun e => Nat.ge_of_not_lt (fun h' => by cases e get?_eq_some.2 h', rfl), get?_len_le
theorem get?_eq_none_iff : l.get? n = none length l n :=
fun e => Nat.ge_of_not_lt (fun h' => by cases e get?_eq_some_iff.2 h', rfl), get?_eq_none
@[simp] theorem get?_eq_getElem? (l : List α) (i : Nat) : l.get? i = l[i]? := by
simp only [getElem?, decidableGetElem?]; split
simp only [getElem?_def]; split
· exact (get?_eq_get _)
· exact (get?_eq_none.2 <| Nat.not_lt.1 _)
@[simp] theorem get_eq_getElem (l : List α) (i : Fin l.length) : l.get i = l[i.1]'i.2 := rfl
theorem getElem?_eq_some {l : List α} : l[i]? = some a h : i < l.length, l[i]'h = a := by
simpa using get?_eq_some
/--
If one has `l.get i` in an expression (with `i : Fin l.length`) and `h : l = l'`,
`rw [h]` will give a "motive it not type correct" error, as it cannot rewrite the
`i : Fin l.length` to `Fin l'.length` directly. The theorem `get_of_eq` can be used to make
such a rewrite, with `rw [get_of_eq h]`.
-/
theorem get_of_eq {l l' : List α} (h : l = l') (i : Fin l.length) :
get l i = get l' i, h i.2 := by cases h; rfl
· exact (get?_eq_none_iff.2 <| Nat.not_lt.1 _)
/-! ### getD
@@ -224,42 +194,29 @@ Because of this, there is only minimal API for `getD`.
@[simp] theorem getD_eq_getElem?_getD (l) (n) (a : α) : getD l n a = (l[n]?).getD a := by
simp [getD]
@[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
/-! ### get!
We simplify `l.get! n` to `l[n]!`.
-/
theorem get!_of_get? [Inhabited α] : {l : List α} {n}, get? l n = some a get! l n = a
| _a::_, 0, rfl => rfl
| _::l, _+1, e => get!_of_get? (l := l) e
theorem get!_eq_getD [Inhabited α] : (l : List α) n, l.get! n = l.getD n default
| [], _ => rfl
| _a::_, 0 => rfl
| _a::l, n+1 => get!_eq_getD l n
theorem get!_len_le [Inhabited α] : {l : List α} {n}, length l n l.get! n = (default : α)
| [], _, _ => rfl
| _ :: l, _+1, h => get!_len_le (l := l) <| Nat.le_of_succ_le_succ h
@[simp] theorem get!_eq_getElem! [Inhabited α] (l : List α) (n) : l.get! n = l[n]! := by
simp [get!_eq_getD]
rfl
/-! ### getElem! -/
/-! ### getElem!
@[simp] theorem getElem!_nil [Inhabited α] {n : Nat} : ([] : List α)[n]! = default := rfl
We simplify `l[n]!` to `(l[n]?).getD default`.
-/
@[simp] theorem getElem!_cons_zero [Inhabited α] {l : List α} : (a::l)[0]! = a := by
rw [getElem!_pos] <;> simp
@[simp] theorem getElem!_cons_succ [Inhabited α] {l : List α} : (a::l)[n+1]! = l[n]! := by
by_cases h : n < l.length
· rw [getElem!_pos, getElem!_pos] <;> simp_all [Nat.succ_lt_succ_iff]
· rw [getElem!_neg, getElem!_neg] <;> simp_all [Nat.succ_lt_succ_iff]
@[simp] theorem getElem!_eq_getElem?_getD [Inhabited α] (l : List α) (n : Nat) :
l[n]! = (l[n]?).getD (default : α) := by
simp only [getElem!_def]
split <;> simp_all
/-! ### getElem? and getElem -/
@@ -267,23 +224,19 @@ theorem get!_len_le [Inhabited α] : ∀ {l : List α} {n}, length l ≤ n → l
simp only [getElem?_def, h, reduceDIte]
theorem getElem?_eq_some_iff {l : List α} : l[n]? = some a h : n < l.length, l[n] = a := by
simp only [ get?_eq_getElem?, get?_eq_some, get_eq_getElem]
simp only [ get?_eq_getElem?, get?_eq_some_iff, get_eq_getElem]
theorem some_eq_getElem?_iff {l : List α} : some a = l[n]? h : n < l.length, l[n] = a := by
rw [eq_comm, getElem?_eq_some_iff]
@[simp] theorem getElem?_eq_none_iff : l[n]? = none length l n := by
simp only [ get?_eq_getElem?, get?_eq_none]
simp only [ get?_eq_getElem?, get?_eq_none_iff]
@[simp] theorem none_eq_getElem?_iff {l : List α} {n : Nat} : none = l[n]? length l n := by
simp [eq_comm (a := none)]
theorem getElem?_eq_none (h : length l n) : l[n]? = none := getElem?_eq_none_iff.mpr h
theorem getElem?_eq (l : List α) (i : Nat) :
l[i]? = if h : i < l.length then some l[i] else none := by
split <;> simp_all
@[simp] theorem some_getElem_eq_getElem?_iff {α} (xs : List α) (i : Nat) (h : i < xs.length) :
(some xs[i] = xs[i]?) True := by
simp [h]
@@ -300,9 +253,6 @@ theorem getElem_eq_getElem?_get (l : List α) (i : Nat) (h : i < l.length) :
l[i] = l[i]?.get (by simp [getElem?_eq_getElem, h]) := by
simp [getElem_eq_iff]
@[deprecated getElem_eq_getElem?_get (since := "2024-09-04")] abbrev getElem_eq_getElem? :=
@getElem_eq_getElem?_get
@[simp] theorem getElem?_nil {n : Nat} : ([] : List α)[n]? = none := rfl
theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := by simp
@@ -314,11 +264,6 @@ theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := by simp
theorem getElem?_cons : (a :: l)[i]? = if i = 0 then some a else l[i-1]? := by
cases i <;> simp
theorem getElem?_len_le : {l : List α} {n}, length l n l[n]? = none
| [], _, _ => rfl
| _ :: l, _+1, h => by
rw [getElem?_cons_succ, getElem?_len_le (l := l) <| Nat.le_of_succ_le_succ h]
/--
If one has `l[i]` in an expression and `h : l = l'`,
`rw [h]` will give a "motive it not type correct" error, as it cannot rewrite the
@@ -332,20 +277,10 @@ theorem getElem_of_eq {l l' : List α} (h : l = l') {i : Nat} (w : i < l.length)
match i, h with
| 0, _ => rfl
@[deprecated getElem_singleton (since := "2024-06-12")]
theorem get_singleton (a : α) (n : Fin 1) : get [a] n = a := by simp
theorem getElem_zero {l : List α} (h : 0 < l.length) : l[0] = l.head (length_pos.mp h) :=
match l, h with
| _ :: _, _ => rfl
theorem getElem!_of_getElem? [Inhabited α] : {l : List α} {n : Nat}, l[n]? = some a l[n]! = a
| _a::_, 0, _ => by
rw [getElem!_pos] <;> simp_all
| _::l, _+1, e => by
simp at e
simp_all [getElem!_of_getElem? (l := l) e]
@[ext] theorem ext_getElem? {l₁ l₂ : List α} (h : n : Nat, l₁[n]? = l₂[n]?) : l₁ = l₂ :=
ext_get? fun n => by simp_all
@@ -356,11 +291,7 @@ theorem ext_getElem {l₁ l₂ : List α} (hl : length l₁ = length l₂)
simp_all [getElem?_eq_getElem]
else by
have h₁ := Nat.le_of_not_lt h₁
rw [getElem?_len_le h₁, getElem?_len_le]; rwa [ hl]
theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂)
(h : n h₁ h₂, get l₁ n, h₁ = get l₂ n, h₂) : l₁ = l₂ :=
ext_getElem hl (by simp_all)
rw [getElem?_eq_none h₁, getElem?_eq_none]; rwa [ hl]
@[simp] theorem getElem_concat_length : (l : List α) (a : α) (i) (_ : i = l.length) (w), (l ++ [a])[i]'w = a
| [], a, _, h, _ => by subst h; simp
@@ -369,19 +300,11 @@ theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂)
theorem getElem?_concat_length (l : List α) (a : α) : (l ++ [a])[l.length]? = some 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
theorem isSome_getElem? {l : List α} {n : Nat} : l[n]?.isSome n < l.length := by
simp
@[simp] theorem isSome_getElem? {l : List α} {n : Nat} : l[n]?.isSome n < l.length := by
by_cases h : n < l.length
· simp_all
· simp [h]
simp_all
@[simp] theorem isNone_getElem? {l : List α} {n : Nat} : l[n]?.isNone l.length n := by
by_cases h : n < l.length
· simp_all
· simp [h]
theorem isNone_getElem? {l : List α} {n : Nat} : l[n]?.isNone l.length n := by
simp
/-! ### mem -/
@@ -493,42 +416,18 @@ theorem getElem_of_mem : ∀ {a} {l : List α}, a ∈ l → ∃ (n : Nat) (h : n
| _, _ :: _, .head .. => 0, Nat.succ_pos _, rfl
| _, _ :: _, .tail _ m => let n, h, e := getElem_of_mem m; n+1, Nat.succ_lt_succ h, e
theorem get_of_mem {a} {l : List α} (h : a l) : n, get l n = a := by
obtain n, h, e := getElem_of_mem h
exact n, h, e
theorem getElem?_of_mem {a} {l : List α} (h : a l) : n : Nat, l[n]? = some a :=
let n, _, e := getElem_of_mem h; n, e getElem?_eq_getElem _
theorem get?_of_mem {a} {l : List α} (h : a l) : n, l.get? n = some a :=
let n, _, e := get_of_mem h; n, e get?_eq_get _
theorem get_mem : (l : List α) n, get l n l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
theorem mem_of_getElem? {l : List α} {n : Nat} {a : α} (e : l[n]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
@[deprecated mem_of_getElem? (since := "2024-09-06")] abbrev getElem?_mem := @mem_of_getElem?
theorem mem_of_get? {l : List α} {n a} (e : l.get? n = some a) : a l :=
let _, e := get?_eq_some.1 e; e get_mem ..
@[deprecated mem_of_get? (since := "2024-09-06")] abbrev get?_mem := @mem_of_get?
theorem mem_iff_getElem {a} {l : List α} : a l (n : Nat) (h : n < l.length), l[n]'h = a :=
getElem_of_mem, fun _, _, e => e getElem_mem ..
theorem mem_iff_get {a} {l : List α} : a l n, get l n = a :=
get_of_mem, fun _, e => e get_mem ..
theorem mem_iff_getElem? {a} {l : List α} : a l n : Nat, l[n]? = some a := by
simp [getElem?_eq_some_iff, mem_iff_getElem]
theorem mem_iff_get? {a} {l : List α} : a l n, l.get? n = some a := by
simp [getElem?_eq_some_iff, Fin.exists_iff, mem_iff_get]
theorem forall_getElem {l : List α} {p : α Prop} :
( (n : Nat) h, p (l[n]'h)) a, a l p a := by
induction l with
@@ -579,18 +478,6 @@ theorem isEmpty_iff_length_eq_zero {l : List α} : l.isEmpty ↔ l.length = 0 :=
/-! ### any / all -/
theorem any_beq [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => a == x) a l := by
induction l <;> simp_all
theorem any_beq' [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => x == a) a l := by
induction l <;> simp_all [eq_comm (a := a)]
theorem all_bne [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => a != x) a l := by
induction l <;> simp_all
theorem all_bne' [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => x != a) a l := by
induction l <;> simp_all [eq_comm (a := a)]
theorem any_eq {l : List α} : l.any p = decide ( x, x l p x) := by induction l <;> simp [*]
theorem all_eq {l : List α} : l.all p = decide ( x, x l p x) := by induction l <;> simp [*]
@@ -615,6 +502,18 @@ theorem decide_forall_mem {l : List α} {p : α → Prop} [DecidablePred p] :
@[simp] theorem all_eq_false {l : List α} : l.all p = false x, x l ¬p x := by
simp [all_eq]
theorem any_beq [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => a == x) a l := by
simp
theorem any_beq' [BEq α] [LawfulBEq α] {l : List α} : (l.any fun x => x == a) a l := by
simp
theorem all_bne [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => a != x) a l := by
induction l <;> simp_all
theorem all_bne' [BEq α] [LawfulBEq α] {l : List α} : (l.all fun x => x != a) a l := by
induction l <;> simp_all [eq_comm (a := a)]
/-! ### set -/
-- As `List.set` is defined in `Init.Prelude`, we write the basic simplification lemmas here.
@@ -632,19 +531,10 @@ theorem decide_forall_mem {l : List α} {p : α → Prop} [DecidablePred p] :
| _ :: _, 0 => by simp
| _ :: l, i + 1 => by simp [getElem_set_self]
@[deprecated getElem_set_self (since := "2024-09-04")] abbrev getElem_set_eq := @getElem_set_self
@[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
@[simp] theorem getElem?_set_self {l : List α} {i : Nat} {a : α} (h : i < l.length) :
(l.set i a)[i]? = some a := by
simp_all [getElem?_eq_some_iff]
@[deprecated getElem?_set_self (since := "2024-09-04")] abbrev getElem?_set_eq := @getElem?_set_self
/-- This differs from `getElem?_set_self` by monadically mapping `Function.const _ a` over the `Option`
returned by `l[i]?`. -/
theorem getElem?_set_self' {l : List α} {i : Nat} {a : α} :
@@ -666,12 +556,6 @@ theorem getElem?_set_self' {l : List α} {i : Nat} {a : α} :
have g : i j := h congrArg (· + 1)
simp [getElem_set_ne g]
@[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]
@[simp] theorem getElem?_set_ne {l : List α} {i j : Nat} (h : i j) {a : α} :
(l.set i a)[j]? = l[j]? := by
by_cases hj : j < (l.set i a).length
@@ -686,11 +570,6 @@ theorem getElem_set {l : List α} {m n} {a} (h) :
else
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]
theorem getElem?_set {l : List α} {i j : Nat} {a : α} :
(l.set i a)[j]? = if i = j then if i < l.length then some a else none else l[j]? := by
if h : i = j then
@@ -710,6 +589,14 @@ theorem getElem?_set' {l : List α} {i j : Nat} {a : α} :
· simp only [getElem?_set_self', Option.map_eq_map, reduceIte, *]
· simp only [ne_eq, not_false_eq_true, getElem?_set_ne, reduceIte, *]
@[simp] theorem set_getElem_self {as : List α} {i : Nat} (h : i < as.length) :
as.set i as[i] = as := by
apply ext_getElem
· simp
· intro n h₁ h₂
rw [getElem_set]
split <;> simp_all
theorem set_eq_of_length_le {l : List α} {n : Nat} (h : l.length n) {a : α} :
l.set n a = l := by
induction l generalizing n with
@@ -724,8 +611,6 @@ theorem set_eq_of_length_le {l : List α} {n : Nat} (h : l.length ≤ n) {a : α
@[simp] theorem set_eq_nil_iff {l : List α} (n : Nat) (a : α) : l.set n a = [] l = [] := by
cases l <;> cases n <;> simp [set]
@[deprecated set_eq_nil_iff (since := "2024-09-05")] abbrev set_eq_nil := @set_eq_nil_iff
theorem set_comm (a b : α) : {n m : Nat} (l : List α), n m
(l.set n a).set m b = (l.set m b).set n a
| _, _, [], _ => by simp
@@ -791,6 +676,24 @@ theorem mem_or_eq_of_mem_set : ∀ {l : List α} {n : Nat} {a b : α}, a ∈ l.s
· intro a
simp
@[simp] theorem beq_nil_iff [BEq α] {l : List α} : (l == []) = l.isEmpty := by
cases l <;> rfl
@[simp] theorem nil_beq_iff [BEq α] {l : List α} : ([] == l) = l.isEmpty := by
cases l <;> rfl
@[simp] theorem cons_beq_cons [BEq α] {a b : α} {l₁ l₂ : List α} :
(a :: l₁ == b :: l₂) = (a == b && l₁ == l₂) := rfl
theorem length_eq_of_beq [BEq α] {l₁ l₂ : List α} (h : l₁ == l₂) : l₁.length = l₂.length :=
match l₁, l₂ with
| [], [] => rfl
| [], _ :: _ => by simp [beq_nil_iff] at h
| _ :: _, [] => by simp [nil_beq_iff] at h
| a :: l₁, b :: l₂ => by
simp at h
simpa [Nat.add_one_inj]using length_eq_of_beq h.2
/-! ### Lexicographic ordering -/
protected theorem lt_irrefl [LT α] (lt_irrefl : x : α, ¬x < x) (l : List α) : ¬l < l := by
@@ -856,6 +759,12 @@ theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
@[simp] theorem id_run_foldlM (f : β α Id β) (b) (l : List α) :
Id.run (l.foldlM f b) = l.foldl f b := (foldl_eq_foldlM f b l).symm
@[simp] theorem id_run_foldrM (f : α β Id β) (b) (l : List α) :
Id.run (l.foldrM f b) = l.foldr f b := (foldr_eq_foldrM f b l).symm
/-! ### foldl and foldr -/
@[simp] theorem foldr_cons_eq_append (l : List α) : l.foldr cons l' = l ++ l' := by
@@ -1800,7 +1709,7 @@ theorem getElem_append_right' (l₁ : List α) {l₂ : List α} {n : Nat} (hn :
l₂[n] = (l₁ ++ l₂)[n + l₁.length]'(by simpa [Nat.add_comm] using Nat.add_lt_add_left hn _) := by
rw [getElem_append_right] <;> simp [*, le_add_left]
@[deprecated (since := "2024-06-12")]
@[deprecated "Deprecated without replacement." (since := "2024-06-12")]
theorem get_append_right_aux {l₁ l₂ : List α} {n : Nat}
(h₁ : l₁.length n) (h₂ : n < (l₁ ++ l₂).length) : n - l₁.length < l₂.length := by
rw [length_append] at h₂
@@ -1817,7 +1726,7 @@ theorem getElem_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.l
rw [ getElem?_eq_getElem, eq, getElem?_append_right (h Nat.le_refl _), h]
simp
@[deprecated (since := "2024-06-12")]
@[deprecated "Deprecated without replacement." (since := "2024-06-12")]
theorem get_of_append_proof {l : List α}
(eq : l = l₁ ++ a :: l₂) (h : l₁.length = n) : n < length l := eq h by simp_arith
@@ -3333,10 +3242,10 @@ theorem any_eq_not_all_not (l : List α) (p : α → Bool) : l.any p = !l.all (!
theorem all_eq_not_any_not (l : List α) (p : α Bool) : l.all p = !l.any (!p .) := by
simp only [not_any_eq_all_not, Bool.not_not]
@[simp] theorem any_map {l : List α} {p : α Bool} : (l.map f).any p = l.any (p f) := by
@[simp] theorem any_map {l : List α} {p : β Bool} : (l.map f).any p = l.any (p f) := by
induction l with simp | cons _ _ ih => rw [ih]
@[simp] theorem all_map {l : List α} {p : α Bool} : (l.map f).all p = l.all (p f) := by
@[simp] theorem all_map {l : List α} {p : β Bool} : (l.map f).all p = l.all (p f) := by
induction l with simp | cons _ _ ih => rw [ih]
@[simp] theorem any_filter {l : List α} {p q : α Bool} :
@@ -3421,17 +3330,137 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
(l.insert a).all f = (f a && l.all f) := by
simp [all_eq]
/-! ### Legacy lemmas about `get`, `get?`, and `get!`.
Hopefully these should not be needed, in favour of lemmas about `xs[i]`, `xs[i]?`, and `xs[i]!`,
to which these simplify.
We may consider deprecating or downstreaming these lemmas.
-/
theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl
theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} :
(a :: as).get i+1, h = as.get i, Nat.lt_of_succ_lt_succ h := rfl
theorem get_cons_succ' {as : List α} {i : Fin as.length} :
(a :: as).get i.succ = as.get i := rfl
theorem get_mk_zero : {l : List α} (h : 0 < l.length), l.get 0, h = l.head (length_pos.mp h)
| _::_, _ => rfl
theorem get?_zero (l : List α) : l.get? 0 = l.head? := by cases l <;> rfl
/--
If one has `l.get i` in an expression (with `i : Fin l.length`) and `h : l = l'`,
`rw [h]` will give a "motive is not type correct" error, as it cannot rewrite the
`i : Fin l.length` to `Fin l'.length` directly. The theorem `get_of_eq` can be used to make
such a rewrite, with `rw [get_of_eq h]`.
-/
theorem get_of_eq {l l' : List α} (h : l = l') (i : Fin l.length) :
get l i = get l' i, h i.2 := by cases h; rfl
theorem get!_of_get? [Inhabited α] : {l : List α} {n}, get? l n = some a get! l n = a
| _a::_, 0, rfl => rfl
| _::l, _+1, e => get!_of_get? (l := l) e
theorem get!_len_le [Inhabited α] : {l : List α} {n}, length l n l.get! n = (default : α)
| [], _, _ => rfl
| _ :: l, _+1, h => get!_len_le (l := l) <| Nat.le_of_succ_le_succ h
theorem getElem!_nil [Inhabited α] {n : Nat} : ([] : List α)[n]! = default := rfl
theorem getElem!_cons_zero [Inhabited α] {l : List α} : (a::l)[0]! = a := by
rw [getElem!_pos] <;> simp
theorem getElem!_cons_succ [Inhabited α] {l : List α} : (a::l)[n+1]! = l[n]! := by
by_cases h : n < l.length
· rw [getElem!_pos, getElem!_pos] <;> simp_all [Nat.succ_lt_succ_iff]
· rw [getElem!_neg, getElem!_neg] <;> simp_all [Nat.succ_lt_succ_iff]
theorem getElem!_of_getElem? [Inhabited α] : {l : List α} {n : Nat}, l[n]? = some a l[n]! = a
| _a::_, 0, _ => by
rw [getElem!_pos] <;> simp_all
| _::l, _+1, e => by
simp at e
simp_all [getElem!_of_getElem? (l := l) e]
theorem ext_get {l₁ l₂ : List α} (hl : length l₁ = length l₂)
(h : n h₁ h₂, get l₁ n, h₁ = get l₂ n, h₂) : l₁ = l₂ :=
ext_getElem hl (by simp_all)
theorem get_of_mem {a} {l : List α} (h : a l) : n, get l n = a := by
obtain n, h, e := getElem_of_mem h
exact n, h, e
theorem get?_of_mem {a} {l : List α} (h : a l) : n, l.get? n = some a :=
let n, _, e := get_of_mem h; n, e get?_eq_get _
theorem get_mem : (l : List α) n, get l n l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
theorem mem_of_get? {l : List α} {n a} (e : l.get? n = some a) : a l :=
let _, e := get?_eq_some_iff.1 e; e get_mem ..
theorem mem_iff_get {a} {l : List α} : a l n, get l n = a :=
get_of_mem, fun _, e => e get_mem ..
theorem mem_iff_get? {a} {l : List α} : a l n, l.get? n = some a := by
simp [getElem?_eq_some_iff, Fin.exists_iff, mem_iff_get]
/-! ### 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
@[deprecated filter_flatten (since := "2024-08-26")]
theorem join_map_filter (p : α Bool) (l : List (List α)) :
(l.map (filter p)).flatten = (l.flatten).filter p := by
rw [filter_flatten]
@[deprecated getElem_eq_getElem?_get (since := "2024-09-04")] abbrev getElem_eq_getElem? :=
@getElem_eq_getElem?_get
@[deprecated flatten_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @flatten_eq_nil_iff
@[deprecated flatten_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @flatten_ne_nil_iff
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons_iff := @flatten_eq_cons_iff
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @flatten_eq_cons_iff
@[deprecated flatten_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @flatten_eq_append_iff
@[deprecated mem_of_getElem? (since := "2024-09-06")] abbrev getElem?_mem := @mem_of_getElem?
@[deprecated mem_of_get? (since := "2024-09-06")] abbrev get?_mem := @mem_of_get?
@[deprecated getElem_set_self (since := "2024-09-04")] abbrev getElem_set_eq := @getElem_set_self
@[deprecated getElem?_set_self (since := "2024-09-04")] abbrev getElem?_set_eq := @getElem?_set_self
@[deprecated set_eq_nil_iff (since := "2024-09-05")] abbrev set_eq_nil := @set_eq_nil_iff
@[deprecated flatten_nil (since := "2024-10-14")] abbrev join_nil := @flatten_nil
@[deprecated flatten_cons (since := "2024-10-14")] abbrev join_cons := @flatten_cons
@[deprecated length_flatten (since := "2024-10-14")] abbrev length_join := @length_flatten
@[deprecated flatten_singleton (since := "2024-10-14")] abbrev join_singleton := @flatten_singleton
@[deprecated mem_flatten (since := "2024-10-14")] abbrev mem_join := @mem_flatten
@[deprecated flatten_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @flatten_eq_nil_iff
@[deprecated flatten_eq_nil_iff (since := "2024-10-14")] abbrev join_eq_nil_iff := @flatten_eq_nil_iff
@[deprecated flatten_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @flatten_ne_nil_iff
@[deprecated flatten_ne_nil_iff (since := "2024-10-14")] abbrev join_ne_nil_iff := @flatten_ne_nil_iff
@[deprecated exists_of_mem_flatten (since := "2024-10-14")] abbrev exists_of_mem_join := @exists_of_mem_flatten
@[deprecated mem_flatten_of_mem (since := "2024-10-14")] abbrev mem_join_of_mem := @mem_flatten_of_mem
@@ -3445,16 +3474,9 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
@[deprecated filter_flatten (since := "2024-10-14")] abbrev filter_join := @filter_flatten
@[deprecated flatten_filter_not_isEmpty (since := "2024-10-14")] abbrev join_filter_not_isEmpty := @flatten_filter_not_isEmpty
@[deprecated flatten_filter_ne_nil (since := "2024-10-14")] abbrev join_filter_ne_nil := @flatten_filter_ne_nil
@[deprecated filter_flatten (since := "2024-08-26")]
theorem join_map_filter (p : α Bool) (l : List (List α)) :
(l.map (filter p)).flatten = (l.flatten).filter p := by
rw [filter_flatten]
@[deprecated flatten_append (since := "2024-10-14")] abbrev join_append := @flatten_append
@[deprecated flatten_concat (since := "2024-10-14")] abbrev join_concat := @flatten_concat
@[deprecated flatten_flatten (since := "2024-10-14")] abbrev join_join := @flatten_flatten
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons_iff := @flatten_eq_cons_iff
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @flatten_eq_cons_iff
@[deprecated flatten_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @flatten_eq_append_iff
@[deprecated flatten_eq_append_iff (since := "2024-10-14")] abbrev join_eq_append_iff := @flatten_eq_append_iff
@[deprecated eq_iff_flatten_eq (since := "2024-10-14")] abbrev eq_iff_join_eq := @eq_iff_flatten_eq
@[deprecated flatten_replicate_nil (since := "2024-10-14")] abbrev join_replicate_nil := @flatten_replicate_nil
@@ -3489,4 +3511,18 @@ theorem join_map_filter (p : α → Bool) (l : List (List α)) :
@[deprecated any_flatMap (since := "2024-10-16")] abbrev any_bind := @any_flatMap
@[deprecated all_flatMap (since := "2024-10-16")] abbrev all_bind := @all_flatMap
@[deprecated get?_eq_none (since := "2024-11-29")] abbrev get?_len_le := @get?_eq_none
@[deprecated getElem?_eq_some_iff (since := "2024-11-29")]
abbrev getElem?_eq_some := @getElem?_eq_some_iff
@[deprecated get?_eq_some_iff (since := "2024-11-29")]
abbrev get?_eq_some := @get?_eq_some_iff
@[deprecated LawfulGetElem.getElem?_def (since := "2024-11-29")]
theorem getElem?_eq (l : List α) (i : Nat) :
l[i]? = if h : i < l.length then some l[i] else none :=
getElem?_def _ _
@[deprecated getElem?_eq_none (since := "2024-11-29")] abbrev getElem?_len_le := @getElem?_eq_none
end List

View File

@@ -87,8 +87,8 @@ theorem mapFinIdx_eq_ofFn {as : List α} {f : Fin as.length → α → β} :
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] at m; exact m.1 x := by
simp only [getElem?_eq, length_mapFinIdx, getElem_mapFinIdx]
(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 only [getElem?_def, length_mapFinIdx, getElem_mapFinIdx]
split <;> simp
@[simp]
@@ -126,7 +126,8 @@ theorem mapFinIdx_singleton {a : α} {f : Fin 1 → α → β} :
theorem mapFinIdx_eq_enum_map {l : List α} {f : Fin 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] at m; exact m.1 x := by
fun i, x, m =>
f i, by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1 x := by
apply ext_getElem <;> simp
@[simp]
@@ -235,7 +236,7 @@ theorem getElem?_mapIdx_go : ∀ {l : List α} {arr : Array β} {i : Nat},
(mapIdx.go f l arr)[i]? =
if h : i < arr.size then some arr[i] else Option.map (f i) l[i - arr.size]?
| [], arr, i => by
simp only [mapIdx.go, Array.toListImpl_eq, getElem?_eq, Array.length_toList,
simp only [mapIdx.go, Array.toListImpl_eq, getElem?_def, Array.length_toList,
Array.getElem_eq_getElem_toList, length_nil, Nat.not_lt_zero, reduceDIte, Option.map_none']
| a :: l, arr, i => by
rw [mapIdx.go, getElem?_mapIdx_go]

View File

@@ -15,3 +15,4 @@ import Init.Data.List.Nat.Find
import Init.Data.List.Nat.BEq
import Init.Data.List.Nat.Modify
import Init.Data.List.Nat.InsertIdx
import Init.Data.List.Nat.Perm

View File

@@ -0,0 +1,54 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Perm
namespace List
/-- Helper lemma for `set_set_perm`-/
private theorem set_set_perm' {as : List α} {i j : Nat} (h₁ : i < as.length) (h₂ : i + j < as.length)
(hj : 0 < j) :
(as.set i as[i + j]).set (i + j) as[i] ~ as := by
have : as =
as.take i ++ as[i] :: (as.take (i + j)).drop (i + 1) ++ as[i + j] :: as.drop (i + j + 1) := by
simp only [getElem_cons_drop, append_assoc, cons_append]
rw [ drop_append_of_le_length]
· simp
· simp; omega
conv => lhs; congr; congr; rw [this]
conv => rhs; rw [this]
rw [set_append_left _ _ (by simp; omega)]
rw [set_append_right _ _ (by simp; omega)]
rw [set_append_right _ _ (by simp; omega)]
simp only [length_append, length_take, length_set, length_cons, length_drop]
rw [(show i - min i as.length = 0 by omega)]
rw [(show i + j - (min i as.length + (min (i + j) as.length - (i + 1) + 1)) = 0 by omega)]
simp only [set_cons_zero]
simp only [append_assoc]
apply Perm.append_left
apply cons_append_cons_perm
theorem set_set_perm {as : List α} {i j : Nat} (h₁ : i < as.length) (h₂ : j < as.length) :
(as.set i as[j]).set j as[i] ~ as := by
if h₃ : i = j then
simp [h₃]
else
if h₃ : i < j then
let j' := j - i
have t : j = i + j' := by omega
generalize j' = j' at t
subst t
exact set_set_perm' _ _ (by omega)
else
rw [set_comm _ _ _ (by omega)]
let i' := i - j
have t : i = j + i' := by omega
generalize i' = i' at t
subst t
apply set_set_perm' _ _ (by omega)
end List

View File

@@ -345,7 +345,7 @@ theorem drop_append {l₁ l₂ : List α} (i : Nat) : drop (l₁.length + i) (l
rw [drop_append_eq_append_drop, drop_eq_nil_of_le] <;>
simp [Nat.add_sub_cancel_left, Nat.le_add_right]
theorem set_eq_take_append_cons_drop {l : List α} {n : Nat} {a : α} :
theorem set_eq_take_append_cons_drop (l : List α) (n : Nat) (a : α) :
l.set n a = if n < l.length then l.take n ++ a :: l.drop (n + 1) else l := by
split <;> rename_i h
· ext1 m

View File

@@ -39,6 +39,9 @@ protected theorem Perm.symm {l₁ l₂ : List α} (h : l₁ ~ l₂) : l₂ ~ l
| swap => exact swap ..
| trans _ _ ih₁ ih₂ => exact trans ih₂ ih₁
instance : Trans (Perm (α := α)) (Perm (α := α)) (Perm (α := α)) where
trans h₁ h₂ := Perm.trans h₁ h₂
theorem perm_comm {l₁ l₂ : List α} : l₁ ~ l₂ l₂ ~ l₁ := Perm.symm, Perm.symm
theorem Perm.swap' (x y : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : y :: x :: l₁ ~ x :: y :: l₂ :=
@@ -102,7 +105,7 @@ theorem perm_append_comm : ∀ {l₁ l₂ : List α}, l₁ ++ l₂ ~ l₂ ++ l
| _ :: _, _ => (perm_append_comm.cons _).trans perm_middle.symm
theorem perm_append_comm_assoc (l₁ l₂ l₃ : List α) :
Perm (l₁ ++ (l₂ ++ l₃)) (l₂ ++ (l₁ ++ l₃)) := by
(l₁ ++ (l₂ ++ l₃)) ~ (l₂ ++ (l₁ ++ l₃)) := by
simpa only [List.append_assoc] using perm_append_comm.append_right _
theorem concat_perm (l : List α) (a : α) : concat l a ~ a :: l := by simp
@@ -133,7 +136,7 @@ theorem Perm.nil_eq {l : List α} (p : [] ~ l) : [] = l := p.symm.eq_nil.symm
theorem not_perm_nil_cons (x : α) (l : List α) : ¬[] ~ x :: l := (nomatch ·.symm.eq_nil)
theorem not_perm_cons_nil {l : List α} {a : α} : ¬(Perm (a::l) []) :=
theorem not_perm_cons_nil {l : List α} {a : α} : ¬((a::l) ~ []) :=
fun h => by simpa using h.length_eq
theorem Perm.isEmpty_eq {l l' : List α} (h : Perm l l') : l.isEmpty = l'.isEmpty := by
@@ -478,6 +481,15 @@ theorem Perm.flatten {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.flatt
@[deprecated Perm.flatten (since := "2024-10-14")] abbrev Perm.join := @Perm.flatten
theorem cons_append_cons_perm {a b : α} {as bs : List α} :
a :: as ++ b :: bs ~ b :: as ++ a :: bs := by
suffices [[a], as, [b], bs].flatten ~ [[b], as, [a], bs].flatten by simpa
apply Perm.flatten
calc
[[a], as, [b], bs] ~ [as, [a], [b], bs] := Perm.swap as [a] _
_ ~ [as, [b], [a], bs] := Perm.cons _ (Perm.swap [b] [a] _)
_ ~ [[b], as, [a], bs] := Perm.swap [b] as _
theorem Perm.flatMap_right {l₁ l₂ : List α} (f : α List β) (p : l₁ ~ l₂) : l₁.flatMap f ~ l₂.flatMap f :=
(p.map _).flatten

View File

@@ -293,7 +293,7 @@ theorem sorted_mergeSort
apply sorted_mergeSort trans total
termination_by l => l.length
@[deprecated (since := "2024-09-02")] abbrev mergeSort_sorted := @sorted_mergeSort
@[deprecated sorted_mergeSort (since := "2024-09-02")] abbrev mergeSort_sorted := @sorted_mergeSort
/--
If the input list is already sorted, then `mergeSort` does not change the list.
@@ -429,7 +429,8 @@ theorem sublist_mergeSort
((fun w => Sublist.of_sublist_append_right w h') fun b m₁ m₃ =>
(Bool.eq_not_self true).mp ((rel_of_pairwise_cons hc m₁).symm.trans (h₃ b m₃))))
@[deprecated (since := "2024-09-02")] abbrev mergeSort_stable := @sublist_mergeSort
@[deprecated sublist_mergeSort (since := "2024-09-02")]
abbrev mergeSort_stable := @sublist_mergeSort
/--
Another statement of stability of merge sort.
@@ -442,7 +443,8 @@ theorem pair_sublist_mergeSort
(hab : le a b) (h : [a, b] <+ l) : [a, b] <+ mergeSort l le :=
sublist_mergeSort trans total (pairwise_pair.mpr hab) h
@[deprecated (since := "2024-09-02")] abbrev mergeSort_stable_pair := @pair_sublist_mergeSort
@[deprecated pair_sublist_mergeSort(since := "2024-09-02")]
abbrev mergeSort_stable_pair := @pair_sublist_mergeSort
theorem map_merge {f : α β} {r : α α Bool} {s : β β Bool} {l l' : List α}
(hl : a l, b l', r a b = s (f a) (f b)) :

View File

@@ -835,7 +835,7 @@ theorem isPrefix_iff : l₁ <+: l₂ ↔ ∀ i (h : i < l₁.length), l₂[i]? =
simpa using 0, by simp
| cons b l₂ =>
simp only [cons_append, cons_prefix_cons, ih]
rw (occs := .pos [2]) [ Nat.and_forall_add_one]
rw (occs := [2]) [ Nat.and_forall_add_one]
simp [Nat.succ_lt_succ_iff, eq_comm]
theorem isPrefix_iff_getElem {l₁ l₂ : List α} :

View File

@@ -192,6 +192,24 @@ theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) :
Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by
rw [concat_eq_append, append_assoc, singleton_append, getElem_cons_drop_succ_eq_drop, take_append_drop]
@[simp] theorem take_append_getElem (l : List α) (i : Nat) (h : i < l.length) :
(l.take i) ++ [l[i]] = l.take (i+1) := by
simpa using take_concat_get l i h
@[simp] theorem take_append_getLast (l : List α) (h : l []) :
(l.take (l.length - 1)) ++ [l.getLast h] = l := by
rw [getLast_eq_getElem]
cases l
· contradiction
· simp
@[simp] theorem take_append_getLast? (l : List α) :
(l.take (l.length - 1)) ++ l.getLast?.toList = l := by
match l with
| [] => simp
| x :: xs =>
simpa using take_append_getLast (x :: xs) (by simp)
@[deprecated take_succ_cons (since := "2024-07-25")]
theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl
@@ -224,7 +242,7 @@ theorem take_succ {l : List α} {n : Nat} : l.take (n + 1) = l.take n ++ l[n]?.t
· simp only [take, Option.toList, getElem?_cons_zero, nil_append]
· simp only [take, hl, getElem?_cons_succ, cons_append]
@[deprecated (since := "2024-07-25")]
@[deprecated "Deprecated without replacement." (since := "2024-07-25")]
theorem drop_sizeOf_le [SizeOf α] (l : List α) (n : Nat) : sizeOf (l.drop n) sizeOf l := by
induction l generalizing n with
| nil => rw [drop_nil]; apply Nat.le_refl

View File

@@ -789,7 +789,7 @@ 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 (since := "2024-06-01")] abbrev pred_lt' := @pred_lt_of_lt
@[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)
@@ -1075,7 +1075,7 @@ theorem pred_mul (n m : Nat) : pred n * m = n * m - m := by
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
set_option linter.missingDocs false in
@[deprecated (since := "2024-06-01")] abbrev mul_pred_left := @pred_mul
@[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
@@ -1087,7 +1087,7 @@ 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 (since := "2024-06-01")] abbrev mul_pred_right := @mul_pred
@[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

@@ -92,7 +92,7 @@ protected theorem div_mul_cancel {n m : Nat} (H : n m) : m / n * n = m := by
rw [Nat.mul_comm, Nat.mul_div_cancel' H]
@[simp] theorem mod_mod_of_dvd (a : Nat) (h : c b) : a % b % c = a % c := by
rw (occs := .pos [2]) [ mod_add_div a b]
rw (occs := [2]) [ mod_add_div a b]
have x, h := h
subst h
rw [Nat.mul_assoc, add_mul_mod_self_left]

View File

@@ -5,6 +5,7 @@ Authors: Floris van Doorn, Leonardo de Moura, Kim Morrison
-/
prelude
import Init.Omega
import Init.Data.List.FinRange
set_option linter.missingDocs true -- keep it documented
universe u
@@ -137,6 +138,54 @@ theorem allTR_loop_congr {n m : Nat} (w : n = m) (f : (i : Nat) → i < n → Bo
omega
go n 0 f
@[simp] theorem fold_zero {α : Type u} (f : (i : Nat) i < 0 α α) (init : α) :
fold 0 f init = init := by simp [fold]
@[simp] theorem fold_succ {α : Type u} (n : Nat) (f : (i : Nat) i < n + 1 α α) (init : α) :
fold (n + 1) f init = f n (by omega) (fold n (fun i h => f i (by omega)) init) := by simp [fold]
theorem fold_eq_finRange_foldl {α : Type u} (n : Nat) (f : (i : Nat) i < n α α) (init : α) :
fold n f init = (List.finRange n).foldl (fun acc i, h => f i h acc) init := by
induction n with
| zero => simp
| succ n ih =>
simp [ih, List.finRange_succ_last, List.foldl_map]
@[simp] theorem foldRev_zero {α : Type u} (f : (i : Nat) i < 0 α α) (init : α) :
foldRev 0 f init = init := by simp [foldRev]
@[simp] theorem foldRev_succ {α : Type u} (n : Nat) (f : (i : Nat) i < n + 1 α α) (init : α) :
foldRev (n + 1) f init = foldRev n (fun i h => f i (by omega)) (f n (by omega) init) := by
simp [foldRev]
theorem foldRev_eq_finRange_foldr {α : Type u} (n : Nat) (f : (i : Nat) i < n α α) (init : α) :
foldRev n f init = (List.finRange n).foldr (fun i, h acc => f i h acc) init := by
induction n generalizing init with
| zero => simp
| succ n ih => simp [ih, List.finRange_succ_last, List.foldr_map]
@[simp] theorem any_zero {f : (i : Nat) i < 0 Bool} : any 0 f = false := by simp [any]
@[simp] theorem any_succ {n : Nat} (f : (i : Nat) i < n + 1 Bool) :
any (n + 1) f = (any n (fun i h => f i (by omega)) || f n (by omega)) := by simp [any]
theorem any_eq_finRange_any {n : Nat} (f : (i : Nat) i < n Bool) :
any n f = (List.finRange n).any (fun i, h => f i h) := by
induction n with
| zero => simp
| succ n ih => simp [ih, List.finRange_succ_last, List.any_map, Function.comp_def]
@[simp] theorem all_zero {f : (i : Nat) i < 0 Bool} : all 0 f = true := by simp [all]
@[simp] theorem all_succ {n : Nat} (f : (i : Nat) i < n + 1 Bool) :
all (n + 1) f = (all n (fun i h => f i (by omega)) && f n (by omega)) := by simp [all]
theorem all_eq_finRange_all {n : Nat} (f : (i : Nat) i < n Bool) :
all n f = (List.finRange n).all (fun i, h => f i h) := by
induction n with
| zero => simp
| succ n ih => simp [ih, List.finRange_succ_last, List.all_map, Function.comp_def]
end Nat
namespace Prod

View File

@@ -651,8 +651,8 @@ theorem sub_mul_mod {x k n : Nat} (h₁ : n*k ≤ x) : (x - n*k) % n = x % n :=
| .inr npos => Nat.mod_eq_of_lt (mod_lt _ npos)
theorem mul_mod (a b n : Nat) : a * b % n = (a % n) * (b % n) % n := by
rw (occs := .pos [1]) [ mod_add_div a n]
rw (occs := .pos [1]) [ mod_add_div b n]
rw (occs := [1]) [ mod_add_div a n]
rw (occs := [1]) [ mod_add_div b n]
rw [Nat.add_mul, Nat.mul_add, Nat.mul_add,
Nat.mul_assoc, Nat.mul_assoc, Nat.mul_add n, add_mul_mod_self_left,
Nat.mul_comm _ (n * (b / n)), Nat.mul_assoc, add_mul_mod_self_left]
@@ -679,6 +679,10 @@ theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by
@[simp] theorem mod_mul_mod {a b c : Nat} : (a % c * b) % c = a * b % c := by
rw [mul_mod, mod_mod, mul_mod]
theorem mod_eq_sub (x w : Nat) : x % w = x - w * (x / w) := by
conv => rhs; congr; rw [ mod_add_div x w]
simp
/-! ### pow -/
theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by
@@ -846,6 +850,18 @@ protected theorem pow_lt_pow_iff_pow_mul_le_pow {a n m : Nat} (h : 1 < a) :
rw [Nat.pow_add_one, Nat.pow_le_pow_iff_right (by omega), Nat.pow_lt_pow_iff_right (by omega)]
omega
protected theorem lt_pow_self {n a : Nat} (h : 1 < a) : n < a ^ n := by
induction n with
| zero => exact Nat.zero_lt_one
| succ _ ih => exact Nat.lt_of_lt_of_le (Nat.add_lt_add_right ih 1) (Nat.pow_lt_pow_succ h)
protected theorem lt_two_pow_self : n < 2 ^ n :=
Nat.lt_pow_self Nat.one_lt_two
@[simp]
protected theorem mod_two_pow_self : n % 2 ^ n = n :=
Nat.mod_eq_of_lt Nat.lt_two_pow_self
@[simp]
theorem two_pow_pred_mul_two (h : 0 < w) :
2 ^ (w - 1) * 2 = 2 ^ w := by

View File

@@ -36,3 +36,7 @@ theorem neZero_iff {n : R} : NeZero n ↔ n ≠ 0 :=
@[simp] theorem neZero_zero_iff_false {α : Type _} [Zero α] : NeZero (0 : α) False :=
fun _ NeZero.ne (0 : α) rfl, fun h h.elim
instance {p : Prop} [Decidable p] {n m : Nat} [NeZero n] [NeZero m] :
NeZero (if p then n else m) := by
split <;> infer_instance

View File

@@ -246,6 +246,12 @@ instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
instance : Max UInt64 := maxOfLe
instance : Min UInt64 := minOfLe
theorem usize_size_le : USize.size 18446744073709551616 := by
cases usize_size_eq <;> next h => rw [h]; decide
theorem le_usize_size : 4294967296 USize.size := by
cases usize_size_eq <;> next h => rw [h]; decide
@[extern "lean_usize_mul"]
def USize.mul (a b : USize) : USize := a.toBitVec * b.toBitVec
@[extern "lean_usize_div"]
@@ -264,10 +270,39 @@ def USize.xor (a b : USize) : USize := ⟨a.toBitVec ^^^ b.toBitVec⟩
def USize.shiftLeft (a b : USize) : USize := a.toBitVec <<< (mod b (USize.ofNat System.Platform.numBits)).toBitVec
@[extern "lean_usize_shift_right"]
def USize.shiftRight (a b : USize) : USize := a.toBitVec >>> (mod b (USize.ofNat System.Platform.numBits)).toBitVec
/--
Upcast a `Nat` less than `2^32` to a `USize`.
This is lossless because `USize.size` is either `2^32` or `2^64`.
This function is overridden with a native implementation.
-/
@[extern "lean_usize_of_nat"]
def USize.ofNat32 (n : @& Nat) (h : n < 4294967296) : USize :=
USize.ofNatCore n (Nat.lt_of_lt_of_le h le_usize_size)
@[extern "lean_uint8_to_usize"]
def UInt8.toUSize (a : UInt8) : USize :=
USize.ofNat32 a.toBitVec.toNat (Nat.lt_trans a.toBitVec.isLt (by decide))
@[extern "lean_usize_to_uint8"]
def USize.toUInt8 (a : USize) : UInt8 := a.toNat.toUInt8
@[extern "lean_uint16_to_usize"]
def UInt16.toUSize (a : UInt16) : USize :=
USize.ofNat32 a.toBitVec.toNat (Nat.lt_trans a.toBitVec.isLt (by decide))
@[extern "lean_usize_to_uint16"]
def USize.toUInt16 (a : USize) : UInt16 := a.toNat.toUInt16
@[extern "lean_uint32_to_usize"]
def UInt32.toUSize (a : UInt32) : USize := USize.ofNat32 a.toBitVec.toNat a.toBitVec.isLt
@[extern "lean_usize_to_uint32"]
def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32
/-- Converts a `UInt64` to a `USize` by reducing modulo `USize.size`. -/
@[extern "lean_uint64_to_usize"]
def UInt64.toUSize (a : UInt64) : USize := a.toNat.toUSize
/--
Upcast a `USize` to a `UInt64`.
This is lossless because `USize.size` is either `2^32` or `2^64`.
This function is overridden with a native implementation.
-/
@[extern "lean_usize_to_uint64"]
def USize.toUInt64 (a : USize) : UInt64 :=
UInt64.ofNatCore a.toBitVec.toNat (Nat.lt_of_lt_of_le a.toBitVec.isLt usize_size_le)
instance : Mul USize := USize.mul
instance : Mod USize := USize.mod

View File

@@ -94,10 +94,8 @@ def UInt32.toUInt64 (a : UInt32) : UInt64 := ⟨⟨a.toNat, Nat.lt_trans a.toBit
instance UInt64.instOfNat : OfNat UInt64 n := UInt64.ofNat n
theorem usize_size_gt_zero : USize.size > 0 := by
cases usize_size_eq with
| inl h => rw [h]; decide
| inr h => rw [h]; decide
@[deprecated usize_size_pos (since := "2024-11-24")] theorem usize_size_gt_zero : USize.size > 0 :=
usize_size_pos
def USize.val (x : USize) : Fin USize.size := x.toBitVec.toFin
@[extern "lean_usize_of_nat"]

View File

@@ -1,7 +1,7 @@
/-
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
Authors: Leonardo de Moura, François G. Dorais, Mario Carneiro, Mac Malone
-/
prelude
import Init.Data.UInt.Basic
@@ -9,129 +9,205 @@ import Init.Data.Fin.Lemmas
import Init.Data.BitVec.Lemmas
import Init.Data.BitVec.Bitblast
open Lean in
set_option hygiene false in
macro "declare_uint_theorems" typeName:ident : command =>
`(
namespace $typeName
macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
let mut cmds Syntax.getArgs <$> `(
namespace $typeName
instance : Inhabited $typeName where
default := 0
theorem zero_def : (0 : $typeName) = 0 := rfl
theorem one_def : (1 : $typeName) = 1 := rfl
theorem sub_def (a b : $typeName) : a - b = a.toBitVec - b.toBitVec := rfl
theorem mul_def (a b : $typeName) : a * b = a.toBitVec * b.toBitVec := rfl
theorem mod_def (a b : $typeName) : a % b = a.toBitVec % b.toBitVec := rfl
theorem add_def (a b : $typeName) : a + b = a.toBitVec + b.toBitVec := rfl
theorem zero_def : (0 : $typeName) = 0 := rfl
theorem one_def : (1 : $typeName) = 1 := rfl
theorem sub_def (a b : $typeName) : a - b = a.toBitVec - b.toBitVec := rfl
theorem mul_def (a b : $typeName) : a * b = a.toBitVec * b.toBitVec := rfl
theorem mod_def (a b : $typeName) : a % b = a.toBitVec % b.toBitVec := rfl
theorem add_def (a b : $typeName) : a + b = a.toBitVec + b.toBitVec := rfl
@[simp] theorem toNat_mk : (mk a).toNat = a.toNat := rfl
@[simp] theorem mk_toBitVec_eq : (a : $typeName), mk a.toBitVec = a
| _, _ => rfl
@[simp] theorem toNat_ofNat {n : Nat} : (ofNat n).toNat = n % 2 ^ $bits := BitVec.toNat_ofNat ..
theorem toBitVec_eq_of_lt {a : Nat} : a < size (ofNat a).toBitVec.toNat = a :=
Nat.mod_eq_of_lt
@[simp] theorem toNat_ofNatCore {n : Nat} {h : n < size} : (ofNatCore n h).toNat = n := BitVec.toNat_ofNatLt ..
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
rw [toNat, toBitVec_eq_of_lt h]
@[simp] theorem val_val_eq_toNat (x : $typeName) : x.val.val = x.toNat := rfl
theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
theorem toNat_toBitVec_eq_toNat (x : $typeName) : x.toBitVec.toNat = x.toNat := rfl
theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
@[simp] theorem mk_toBitVec_eq : (a : $typeName), mk a.toBitVec = a
| _, _ => rfl
@[simp] protected theorem not_le {a b : $typeName} : ¬ a b b < a := by simp [le_def, lt_def]
theorem toBitVec_eq_of_lt {a : Nat} : a < size (ofNat a).toBitVec.toNat = a :=
Nat.mod_eq_of_lt
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b b a := by simp [le_def, lt_def]
theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
rw [toNat, toBitVec_eq_of_lt h]
@[simp] protected theorem le_refl (a : $typeName) : a a := by simp [le_def]
theorem le_def {a b : $typeName} : a b a.toBitVec b.toBitVec := .rfl
@[simp] protected theorem lt_irrefl (a : $typeName) : ¬ a < a := by simp
theorem lt_def {a b : $typeName} : a < b a.toBitVec < b.toBitVec := .rfl
protected theorem le_trans {a b c : $typeName} : a b b c a c := BitVec.le_trans
theorem le_iff_toNat_le {a b : $typeName} : a b a.toNat b.toNat := .rfl
protected theorem lt_trans {a b c : $typeName} : a < b b < c a < c := BitVec.lt_trans
theorem lt_iff_toNat_lt {a b : $typeName} : a < b a.toNat < b.toNat := .rfl
protected theorem le_total (a b : $typeName) : a b b a := BitVec.le_total ..
@[simp] protected theorem not_le {a b : $typeName} : ¬ a b b < a := by simp [le_def, lt_def]
protected theorem lt_asymm {a b : $typeName} : a < b ¬ b < a := BitVec.lt_asymm
@[simp] protected theorem not_lt {a b : $typeName} : ¬ a < b b a := by simp [le_def, lt_def]
protected theorem toBitVec_eq_of_eq {a b : $typeName} (h : a = b) : a.toBitVec = b.toBitVec := h rfl
@[simp] protected theorem le_refl (a : $typeName) : a a := by simp [le_def]
protected theorem eq_of_toBitVec_eq {a b : $typeName} (h : a.toBitVec = b.toBitVec) : a = b := by
cases a; cases b; simp_all
@[simp] protected theorem lt_irrefl (a : $typeName) : ¬ a < a := by simp
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]
protected theorem le_trans {a b c : $typeName} : a b b c a c := BitVec.le_trans
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
protected theorem lt_trans {a b c : $typeName} : a < b b < c a < c := BitVec.lt_trans
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
apply BitVec.ne_of_lt
simpa [lt_def] using h
protected theorem le_total (a b : $typeName) : a b b a := BitVec.le_total ..
@[simp] protected theorem toNat_zero : (0 : $typeName).toNat = 0 := Nat.zero_mod _
protected theorem lt_asymm {a b : $typeName} : a < b ¬ b < a := BitVec.lt_asymm
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := BitVec.toNat_umod ..
protected theorem toBitVec_eq_of_eq {a b : $typeName} (h : a = b) : a.toBitVec = b.toBitVec := h rfl
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := BitVec.toNat_udiv ..
protected theorem eq_of_toBitVec_eq {a b : $typeName} (h : a.toBitVec = b.toBitVec) : a = b := by
cases a; cases b; simp_all
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b a (a - b).toNat = a.toNat - b.toNat := BitVec.toNat_sub_of_le
open $typeName (eq_of_toBitVec_eq toBitVec_eq_of_eq) in
protected theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec a = b :=
Iff.intro eq_of_toBitVec_eq toBitVec_eq_of_eq
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.toBitVec.isLt
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]
open $typeName (toNat_mod toNat_lt_size) in
protected theorem toNat_mod_lt {m : Nat} : (u : $typeName), m > 0 toNat (u % ofNat m) < m := by
intro u h1
by_cases h2 : m < size
· rw [toNat_mod, toNat_ofNat_of_lt h2]
apply Nat.mod_lt _ h1
· apply Nat.lt_of_lt_of_le
· apply toNat_lt_size
· simpa using h2
open $typeName (eq_of_val_eq) in
protected theorem val_inj {a b : $typeName} : a.val = b.val a = b :=
Iff.intro eq_of_val_eq (congrArg val)
open $typeName (toNat_mod_lt) in
set_option linter.deprecated false in
@[deprecated toNat_mod_lt (since := "2024-09-24")]
protected theorem modn_lt {m : Nat} : (u : $typeName), m > 0 toNat (u % m) < m := by
intro u
simp only [(· % ·)]
simp only [gt_iff_lt, toNat, modn, Fin.modn_val, BitVec.natCast_eq_ofNat, BitVec.toNat_ofNat,
Nat.reducePow]
rw [Nat.mod_eq_of_lt]
· apply Nat.mod_lt
· apply Nat.lt_of_le_of_lt
· apply Nat.mod_le
· apply Fin.is_lt
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
protected theorem mod_lt (a : $typeName) {b : $typeName} : 0 < b a % b < b := by
simp only [lt_def, mod_def]
apply BitVec.umod_lt
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
apply BitVec.ne_of_lt
simpa [lt_def] using h
protected theorem toNat.inj : {a b : $typeName}, a.toNat = b.toNat a = b
| _, _, _, _, rfl => rfl
@[simp] protected theorem toNat_zero : (0 : $typeName).toNat = 0 := Nat.zero_mod _
@[simp] protected theorem ofNat_one : ofNat 1 = 1 := rfl
@[simp] protected theorem toNat_add (a b : $typeName) : (a + b).toNat = (a.toNat + b.toNat) % 2 ^ $bits := BitVec.toNat_add ..
@[simp]
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
protected theorem toNat_sub (a b : $typeName) : (a - b).toNat = (2 ^ $bits - b.toNat + a.toNat) % 2 ^ $bits := BitVec.toNat_sub ..
@[simp]
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
@[simp] protected theorem toNat_mul (a b : $typeName) : (a * b).toNat = a.toNat * b.toNat % 2 ^ $bits := BitVec.toNat_mul ..
@[simp]
theorem mk_ofNat (n : Nat) : mk (BitVec.ofNat _ n) = OfNat.ofNat n := rfl
@[simp] protected theorem toNat_mod (a b : $typeName) : (a % b).toNat = a.toNat % b.toNat := BitVec.toNat_umod ..
end $typeName
)
@[simp] protected theorem toNat_div (a b : $typeName) : (a / b).toNat = a.toNat / b.toNat := BitVec.toNat_udiv ..
declare_uint_theorems UInt8
declare_uint_theorems UInt16
declare_uint_theorems UInt32
declare_uint_theorems UInt64
declare_uint_theorems USize
@[simp] protected theorem toNat_sub_of_le (a b : $typeName) : b a (a - b).toNat = a.toNat - b.toNat := BitVec.toNat_sub_of_le
protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.toBitVec.isLt
open $typeName (toNat_mod toNat_lt_size) in
protected theorem toNat_mod_lt {m : Nat} : (u : $typeName), m > 0 toNat (u % ofNat m) < m := by
intro u h1
by_cases h2 : m < size
· rw [toNat_mod, toNat_ofNat_of_lt h2]
apply Nat.mod_lt _ h1
· apply Nat.lt_of_lt_of_le
· apply toNat_lt_size
· simpa using h2
open $typeName (toNat_mod_lt) in
set_option linter.deprecated false in
@[deprecated toNat_mod_lt (since := "2024-09-24")]
protected theorem modn_lt {m : Nat} : (u : $typeName), m > 0 toNat (u % m) < m := by
intro u
simp only [(· % ·)]
simp only [gt_iff_lt, toNat, modn, Fin.modn_val, BitVec.natCast_eq_ofNat, BitVec.toNat_ofNat,
Nat.reducePow]
rw [Nat.mod_eq_of_lt]
· apply Nat.mod_lt
· apply Nat.lt_of_le_of_lt
· apply Nat.mod_le
· apply Fin.is_lt
protected theorem mod_lt (a : $typeName) {b : $typeName} : 0 < b a % b < b := by
simp only [lt_def, mod_def]
apply BitVec.umod_lt
protected theorem toNat.inj : {a b : $typeName}, a.toNat = b.toNat a = b
| _, _, _, _, rfl => rfl
protected theorem toNat_inj : {a b : $typeName}, a.toNat = b.toNat a = b :=
Iff.intro toNat.inj (congrArg toNat)
open $typeName (toNat_inj) in
protected theorem le_antisymm_iff {a b : $typeName} : a = b a b b a :=
toNat_inj.symm.trans Nat.le_antisymm_iff
open $typeName (le_antisymm_iff) in
protected theorem le_antisymm {a b : $typeName} (h₁ : a b) (h₂ : b a) : a = b :=
le_antisymm_iff.2 h₁, h₂
@[simp] protected theorem ofNat_one : ofNat 1 = 1 := rfl
@[simp] protected theorem ofNat_toNat {x : $typeName} : ofNat x.toNat = x := by
apply toNat.inj
simp [Nat.mod_eq_of_lt x.toNat_lt_size]
@[simp]
theorem val_ofNat (n : Nat) : val (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
@[simp]
theorem toBitVec_ofNat (n : Nat) : toBitVec (no_index (OfNat.ofNat n)) = BitVec.ofNat _ n := rfl
@[simp]
theorem mk_ofNat (n : Nat) : mk (BitVec.ofNat _ n) = OfNat.ofNat n := rfl
)
if let some nbits := bits.raw.isNatLit? then
if nbits > 8 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt8 (x : $typeName) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl)
if nbits < 16 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt16 (x : $typeName) : x.toUInt16.toNat = x.toNat := rfl)
else if nbits > 16 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt16 (x : $typeName) : x.toUInt16.toNat = x.toNat % 2 ^ 16 := rfl)
if nbits < 32 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt32 (x : $typeName) : x.toUInt32.toNat = x.toNat := rfl)
else if nbits > 32 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt32 (x : $typeName) : x.toUInt32.toNat = x.toNat % 2 ^ 32 := rfl)
if nbits 32 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUSize (x : $typeName) : x.toUSize.toNat = x.toNat := rfl)
else
cmds := cmds.push <|
`(@[simp] theorem toNat_toUSize (x : $typeName) : x.toUSize.toNat = x.toNat % 2 ^ System.Platform.numBits := rfl)
if nbits < 64 then
cmds := cmds.push <|
`(@[simp] theorem toNat_toUInt64 (x : $typeName) : x.toUInt64.toNat = x.toNat := rfl)
cmds := cmds.push <| `(end $typeName)
return mkNullNode cmds
declare_uint_theorems UInt8 8
declare_uint_theorems UInt16 16
declare_uint_theorems UInt32 32
declare_uint_theorems UInt64 64
declare_uint_theorems USize System.Platform.numBits
@[simp] theorem USize.toNat_ofNat32 {n : Nat} {h : n < 4294967296} : (ofNat32 n h).toNat = n := rfl
@[simp] theorem USize.toNat_toUInt32 (x : USize) : x.toUInt32.toNat = x.toNat % 2 ^ 32 := rfl
@[simp] theorem USize.toNat_toUInt64 (x : USize) : x.toUInt64.toNat = x.toNat := rfl
theorem USize.toNat_ofNat_of_lt_32 {n : Nat} (h : n < 4294967296) : toNat (ofNat n) = n :=
toNat_ofNat_of_lt (Nat.lt_of_lt_of_le h le_usize_size)
theorem UInt32.toNat_lt_of_lt {n : UInt32} {m : Nat} (h : m < size) : n < ofNat m n.toNat < m := by
simp [lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
@@ -145,22 +221,22 @@ 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 (since := "2024-06-23")] protected abbrev UInt8.zero_toNat := @UInt8.toNat_zero
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.div_toNat := @UInt8.toNat_div
@[deprecated (since := "2024-06-23")] protected abbrev UInt8.mod_toNat := @UInt8.toNat_mod
@[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 (since := "2024-06-23")] protected abbrev UInt16.zero_toNat := @UInt16.toNat_zero
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.div_toNat := @UInt16.toNat_div
@[deprecated (since := "2024-06-23")] protected abbrev UInt16.mod_toNat := @UInt16.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 (since := "2024-06-23")] protected abbrev UInt32.zero_toNat := @UInt32.toNat_zero
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.div_toNat := @UInt32.toNat_div
@[deprecated (since := "2024-06-23")] protected abbrev UInt32.mod_toNat := @UInt32.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 (since := "2024-06-23")] protected abbrev UInt64.zero_toNat := @UInt64.toNat_zero
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.div_toNat := @UInt64.toNat_div
@[deprecated (since := "2024-06-23")] protected abbrev UInt64.mod_toNat := @UInt64.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 (since := "2024-06-23")] protected abbrev USize.zero_toNat := @USize.toNat_zero
@[deprecated (since := "2024-06-23")] protected abbrev USize.div_toNat := @USize.toNat_div
@[deprecated (since := "2024-06-23")] protected abbrev USize.mod_toNat := @USize.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

@@ -0,0 +1,7 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Vector.Basic

View File

@@ -0,0 +1,256 @@
/-
Copyright (c) 2024 Shreyas Srinivas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shreyas Srinivas, François G. Dorais, Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
/-!
# Vectors
`Vector α n` is a thin wrapper around `Array α` for arrays of fixed size `n`.
-/
/-- `Vector α n` is an `Array α` with size `n`. -/
structure Vector (α : Type u) (n : Nat) extends Array α where
/-- Array size. -/
size_toArray : toArray.size = n
deriving Repr, DecidableEq
attribute [simp] Vector.size_toArray
/-- Convert `xs : Array α` to `Vector α xs.size`. -/
abbrev Array.toVector (xs : Array α) : Vector α xs.size := .mk xs rfl
namespace Vector
/-- Syntax for `Vector α n` -/
syntax "#v[" withoutPosition(sepBy(term, ", ")) "]" : term
open Lean in
macro_rules
| `(#v[ $elems,* ]) => `(Vector.mk (n := $(quote elems.getElems.size)) #[$elems,*] rfl)
/-- Custom eliminator for `Vector α n` through `Array α` -/
@[elab_as_elim]
def elimAsArray {motive : Vector α n Sort u}
(mk : (a : Array α) (ha : a.size = n), motive a, ha) :
(v : Vector α n) motive v
| a, ha => mk a ha
/-- Custom eliminator for `Vector α n` through `List α` -/
@[elab_as_elim]
def elimAsList {motive : Vector α n Sort u}
(mk : (a : List α) (ha : a.length = n), motive a, ha) :
(v : Vector α n) motive v
| a, ha => mk a ha
/-- Make an empty vector with pre-allocated capacity. -/
@[inline] def mkEmpty (capacity : Nat) : Vector α 0 := .mkEmpty capacity, rfl
/-- Makes a vector of size `n` with all cells containing `v`. -/
@[inline] def mkVector (n) (v : α) : Vector α n := mkArray n v, by simp
/-- Returns a vector of size `1` with element `v`. -/
@[inline] def singleton (v : α) : Vector α 1 := #[v], rfl
instance [Inhabited α] : Inhabited (Vector α n) where
default := mkVector n default
/-- Get an element of a vector using a `Fin` index. -/
@[inline] def get (v : Vector α n) (i : Fin n) : α :=
v.toArray[(i.cast v.size_toArray.symm).1]
/-- Get an element of a vector using a `USize` index and a proof that the index is within bounds. -/
@[inline] def uget (v : Vector α n) (i : USize) (h : i.toNat < n) : α :=
v.toArray.uget i (v.size_toArray.symm h)
instance : GetElem (Vector α n) Nat α fun _ i => i < n where
getElem x i h := get x i, h
/--
Get an element of a vector using a `Nat` index. Returns the given default value if the index is out
of bounds.
-/
@[inline] def getD (v : Vector α n) (i : Nat) (default : α) : α := v.toArray.getD i default
/-- The last element of a vector. Panics if the vector is empty. -/
@[inline] def back! [Inhabited α] (v : Vector α n) : α := v.toArray.back!
/-- The last element of a vector, or `none` if the array is empty. -/
@[inline] def back? (v : Vector α n) : Option α := v.toArray.back?
/-- The last element of a non-empty vector. -/
@[inline] def back [NeZero n] (v : Vector α n) : α :=
-- TODO: change to just `v[n]`
have : Inhabited α := v[0]'(Nat.pos_of_neZero n)
v.back!
/-- The first element of a non-empty vector. -/
@[inline] def head [NeZero n] (v : Vector α n) := v[0]'(Nat.pos_of_neZero n)
/-- Push an element `x` to the end of a vector. -/
@[inline] def push (x : α) (v : Vector α n) : Vector α (n + 1) :=
v.toArray.push x, by simp
/-- Remove the last element of a vector. -/
@[inline] def pop (v : Vector α n) : Vector α (n - 1) :=
Array.pop v.toArray, by simp
/--
Set an element in a vector using a `Nat` index, with a tactic provided proof that the index is in
bounds.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def set (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic): Vector α n :=
v.toArray.set i x (by simp [*]), by simp
/--
Set an element in a vector using a `Nat` index. Returns the vector unchanged if the index is out of
bounds.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def setIfInBounds (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
v.toArray.setIfInBounds i x, by simp
/--
Set an element in a vector using a `Nat` index. Panics if the index is out of bounds.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n :=
v.toArray.set! i x, by simp
/-- Append two vectors. -/
@[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) :=
v.toArray ++ w.toArray, by simp
instance : HAppend (Vector α n) (Vector α m) (Vector α (n + m)) where
hAppend := append
/-- Creates a vector from another with a provably equal length. -/
@[inline] protected def cast (h : n = m) (v : Vector α n) : Vector α m :=
v.toArray, by simp [*]
/--
Extracts the slice of a vector from indices `start` to `stop` (exclusive). If `start ≥ stop`, the
result is empty. If `stop` is greater than the size of the vector, the size is used instead.
-/
@[inline] def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) :=
v.toArray.extract start stop, by simp
/-- Maps elements of a vector using the function `f`. -/
@[inline] def map (f : α β) (v : Vector α n) : Vector β n :=
v.toArray.map f, by simp
/-- 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
/-- The vector of length `n` whose `i`-th element is `f i`. -/
@[inline] def ofFn (f : Fin n α) : Vector α n :=
Array.ofFn f, by simp
/--
Swap two elements of a vector using `Fin` indices.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def swap (v : Vector α n) (i j : Nat)
(hi : i < n := by get_elem_tactic) (hj : j < n := by get_elem_tactic) : Vector α n :=
v.toArray.swap i j (by simpa using hi) (by simpa using hj), by simp
/--
Swap two elements of a vector using `Nat` indices. Panics if either index is out of bounds.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def swapIfInBounds (v : Vector α n) (i j : Nat) : Vector α n :=
v.toArray.swapIfInBounds i j, by simp
/--
Swaps an element of a vector with a given value using a `Fin` index. The original value is returned
along with the updated vector.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def swapAt (v : Vector α n) (i : Nat) (x : α) (hi : i < n := by get_elem_tactic) :
α × Vector α n :=
let a := v.toArray.swapAt i x (by simpa using hi)
a.fst, a.snd, by simp [a]
/--
Swaps an element of a vector with a given value using a `Nat` index. Panics if the index is out of
bounds. The original value is returned along with the updated vector.
This will perform the update destructively provided that the vector has a reference count of 1.
-/
@[inline] def swapAt! (v : Vector α n) (i : Nat) (x : α) : α × Vector α n :=
let a := v.toArray.swapAt! i x
a.fst, a.snd, by simp [a]
/-- The vector `#v[0,1,2,...,n-1]`. -/
@[inline] def range (n : Nat) : Vector Nat n := Array.range n, by simp
/--
Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the vector is returned unchanged.
-/
@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) :=
v.toArray.take m, by simp
/--
Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the empty vector is returned.
-/
@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) :=
v.toArray.extract m v.size, by simp
/--
Compares two vectors of the same size using a given boolean relation `r`. `isEqv v w r` returns
`true` if and only if `r v[i] w[i]` is true for all indices `i`.
-/
@[inline] def isEqv (v w : Vector α n) (r : α α Bool) : Bool :=
Array.isEqvAux v.toArray w.toArray (by simp) r n (by simp)
instance [BEq α] : BEq (Vector α n) where
beq a b := isEqv a b (· == ·)
/-- Reverse the elements of a vector. -/
@[inline] def reverse (v : Vector α n) : Vector α n :=
v.toArray.reverse, by simp
/-- Delete an element of a vector using a `Nat` index and a tactic provided proof. -/
@[inline] def eraseIdx (v : Vector α n) (i : Nat) (h : i < n := by get_elem_tactic) :
Vector α (n-1) :=
v.toArray.eraseIdx i (v.size_toArray.symm h), by simp [Array.size_eraseIdx]
/-- Delete an element of a vector using a `Nat` index. Panics if the index is out of bounds. -/
@[inline] def eraseIdx! (v : Vector α n) (i : Nat) : Vector α (n-1) :=
if _ : i < n then
v.eraseIdx i
else
have : Inhabited (Vector α (n-1)) := v.pop
panic! "index out of bounds"
/-- Delete the first element of a vector. Returns the empty vector if the input vector is empty. -/
@[inline] def tail (v : Vector α n) : Vector α (n-1) :=
if _ : 0 < n then
v.eraseIdx 0
else
v.cast (by omega)
/--
Finds the first index of a given value in a vector using `==` for comparison. Returns `none` if the
no element of the index matches the given value.
-/
@[inline] def indexOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) :=
(v.toArray.indexOf? x).map (Fin.cast v.size_toArray)
/-- Returns `true` when `v` is a prefix of the vector `w`. -/
@[inline] def isPrefixOf [BEq α] (v : Vector α m) (w : Vector α n) : Bool :=
v.toArray.isPrefixOf w.toArray

View File

@@ -0,0 +1,280 @@
/-
Copyright (c) 2024 Shreyas Srinivas. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shreyas Srinivas, Francois Dorais
-/
prelude
import Init.Data.Vector.Basic
/-!
## Vectors
Lemmas about `Vector α n`
-/
namespace Vector
@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) :
(Vector.mk data size)[i] = data[i] := rfl
@[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) :
xs.toArray[i] = xs[i]'(by simpa using h) := by
cases xs
simp
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
/-- The empty vector maps to the empty vector. -/
@[simp]
theorem map_empty (f : α β) : map f #v[] = #v[] := by
rw [map, mk.injEq]
exact Array.map_empty f
theorem toArray_inj : {v w : Vector α n}, v.toArray = w.toArray v = w
| {..}, {..}, rfl => rfl
/-- A vector of length `0` is the empty vector. -/
protected theorem eq_empty (v : Vector α 0) : v = #v[] := by
apply Vector.toArray_inj
apply Array.eq_empty_of_size_eq_zero v.2
/--
`Vector.ext` is an extensionality theorem.
Vectors `a` and `b` are equal to each other if their elements are equal for each valid index.
-/
@[ext]
protected theorem ext {a b : Vector α n} (h : (i : Nat) (_ : i < n) a[i] = b[i]) : a = b := by
apply Vector.toArray_inj
apply Array.ext
· rw [a.size_toArray, b.size_toArray]
· intro i hi _
rw [a.size_toArray] at hi
exact h i hi
@[simp] theorem push_mk {data : Array α} {size : data.size = n} {x : α} :
(Vector.mk data size).push x =
Vector.mk (data.push x) (by simp [size, Nat.succ_eq_add_one]) := rfl
@[simp] theorem pop_mk {data : Array α} {size : data.size = n} :
(Vector.mk data size).pop = Vector.mk data.pop (by simp [size]) := rfl
@[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
rcases v with data, rfl
simp
@[simp] theorem getElem_push_lt {v : Vector α n} {x : α} {i : Nat} (h : i < n) :
(v.push x)[i] = v[i] := by
rcases v with data, rfl
simp [Array.getElem_push_lt, h]
@[simp] theorem getElem_pop {v : Vector α n} {i : Nat} (h : i < n - 1) : (v.pop)[i] = v[i] := by
rcases v with data, rfl
simp
/--
Variant of `getElem_pop` that will sometimes fire when `getElem_pop` gets stuck because of
defeq issues in the implicit size argument.
-/
@[simp] theorem getElem_pop' (v : Vector α (n + 1)) (i : Nat) (h : i < n + 1 - 1) :
@getElem (Vector α n) Nat α (fun _ i => i < n) instGetElemNatLt v.pop i h = v[i] :=
getElem_pop h
@[simp] theorem push_pop_back (v : Vector α (n + 1)) : v.pop.push v.back = v := by
ext i
by_cases h : i < n
· simp [h]
· replace h : i = v.size - 1 := by rw [size_toArray]; omega
subst h
simp [pop, back, back!, Array.eq_push_pop_back!_of_size_ne_zero]
/-! ### mk lemmas -/
theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a := rfl
@[simp] theorem allDiff_mk [BEq α] (a : Array α) (h : a.size = n) :
(Vector.mk a h).allDiff = a.allDiff := rfl
@[simp] theorem mk_append_mk (a b : Array α) (ha : a.size = n) (hb : b.size = m) :
Vector.mk a ha ++ Vector.mk b hb = Vector.mk (a ++ b) (by simp [ha, hb]) := rfl
@[simp] theorem back!_mk [Inhabited α] (a : Array α) (h : a.size = n) :
(Vector.mk a h).back! = a.back! := rfl
@[simp] theorem back?_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).back? = a.back? := rfl
@[simp] theorem drop_mk (a : Array α) (h : a.size = n) (m) :
(Vector.mk a h).drop m = Vector.mk (a.extract m a.size) (by simp [h]) := rfl
@[simp] theorem eraseIdx_mk (a : Array α) (h : a.size = n) (i) (h') :
(Vector.mk a h).eraseIdx i h' = Vector.mk (a.eraseIdx i) (by simp [h]) := rfl
@[simp] theorem eraseIdx!_mk (a : Array α) (h : a.size = n) (i) (hi : i < n) :
(Vector.mk a h).eraseIdx! i = Vector.mk (a.eraseIdx i) (by simp [h, hi]) := by
simp [Vector.eraseIdx!, hi]
@[simp] theorem extract_mk (a : Array α) (h : a.size = n) (start stop) :
(Vector.mk a h).extract start stop = Vector.mk (a.extract start stop) (by simp [h]) := rfl
@[simp] theorem indexOf?_mk [BEq α] (a : Array α) (h : a.size = n) (x : α) :
(Vector.mk a h).indexOf? x = (a.indexOf? x).map (Fin.cast h) := rfl
@[simp] theorem mk_isEqv_mk (r : α α Bool) (a b : Array α) (ha : a.size = n) (hb : b.size = n) :
Vector.isEqv (Vector.mk a ha) (Vector.mk b hb) r = Array.isEqv a b r := by
simp [Vector.isEqv, Array.isEqv, ha, hb]
@[simp] theorem mk_isPrefixOf_mk [BEq α] (a b : Array α) (ha : a.size = n) (hb : b.size = m) :
(Vector.mk a ha).isPrefixOf (Vector.mk b hb) = a.isPrefixOf b := rfl
@[simp] theorem map_mk (a : Array α) (h : a.size = n) (f : α β) :
(Vector.mk a h).map f = Vector.mk (a.map f) (by simp [h]) := rfl
@[simp] theorem reverse_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).reverse = Vector.mk a.reverse (by simp [h]) := rfl
@[simp] theorem set_mk (a : Array α) (h : a.size = n) (i x w) :
(Vector.mk a h).set i x = Vector.mk (a.set i x) (by simp [h]) := rfl
@[simp] theorem set!_mk (a : Array α) (h : a.size = n) (i x) :
(Vector.mk a h).set! i x = Vector.mk (a.set! i x) (by simp [h]) := rfl
@[simp] theorem setIfInBounds_mk (a : Array α) (h : a.size = n) (i x) :
(Vector.mk a h).setIfInBounds i x = Vector.mk (a.setIfInBounds i x) (by simp [h]) := rfl
@[simp] theorem swap_mk (a : Array α) (h : a.size = n) (i j) (hi hj) :
(Vector.mk a h).swap i j = Vector.mk (a.swap i j) (by simp [h]) :=
rfl
@[simp] theorem swapIfInBounds_mk (a : Array α) (h : a.size = n) (i j) :
(Vector.mk a h).swapIfInBounds i j = Vector.mk (a.swapIfInBounds i j) (by simp [h]) := rfl
@[simp] theorem swapAt_mk (a : Array α) (h : a.size = n) (i x) (hi) :
(Vector.mk a h).swapAt i x =
((a.swapAt i x).fst, Vector.mk (a.swapAt i x).snd (by simp [h])) :=
rfl
@[simp] theorem swapAt!_mk (a : Array α) (h : a.size = n) (i x) : (Vector.mk a h).swapAt! i x =
((a.swapAt! i x).fst, Vector.mk (a.swapAt! i x).snd (by simp [h])) := rfl
@[simp] theorem take_mk (a : Array α) (h : a.size = n) (m) :
(Vector.mk a h).take m = Vector.mk (a.take m) (by simp [h]) := rfl
@[simp] theorem mk_zipWith_mk (f : α β γ) (a : Array α) (b : Array β)
(ha : a.size = n) (hb : b.size = n) : zipWith (Vector.mk a ha) (Vector.mk b hb) f =
Vector.mk (Array.zipWith a b f) (by simp [ha, hb]) := rfl
/-! ### toArray lemmas -/
@[simp] theorem toArray_append (a : Vector α m) (b : Vector α n) :
(a ++ b).toArray = a.toArray ++ b.toArray := rfl
@[simp] theorem toArray_drop (a : Vector α n) (m) :
(a.drop m).toArray = a.toArray.extract m a.size := rfl
@[simp] theorem toArray_empty : (#v[] : Vector α 0).toArray = #[] := rfl
@[simp] theorem toArray_mkEmpty (cap) :
(Vector.mkEmpty (α := α) cap).toArray = Array.mkEmpty cap := rfl
@[simp] theorem toArray_eraseIdx (a : Vector α n) (i) (h) :
(a.eraseIdx i h).toArray = a.toArray.eraseIdx i (by simp [h]) := rfl
@[simp] theorem toArray_eraseIdx! (a : Vector α n) (i) (hi : i < n) :
(a.eraseIdx! i).toArray = a.toArray.eraseIdx! i := by
cases a; simp_all [Array.eraseIdx!]
@[simp] theorem toArray_extract (a : Vector α n) (start stop) :
(a.extract start stop).toArray = a.toArray.extract start stop := rfl
@[simp] theorem toArray_map (f : α β) (a : Vector α n) :
(a.map f).toArray = a.toArray.map f := rfl
@[simp] theorem toArray_ofFn (f : Fin n α) : (Vector.ofFn f).toArray = Array.ofFn f := rfl
@[simp] theorem toArray_pop (a : Vector α n) : a.pop.toArray = a.toArray.pop := rfl
@[simp] theorem toArray_push (a : Vector α n) (x) : (a.push x).toArray = a.toArray.push x := rfl
@[simp] theorem toArray_range : (Vector.range n).toArray = Array.range n := rfl
@[simp] theorem toArray_reverse (a : Vector α n) : a.reverse.toArray = a.toArray.reverse := rfl
@[simp] theorem toArray_set (a : Vector α n) (i x h) :
(a.set i x).toArray = a.toArray.set i x (by simpa using h):= rfl
@[simp] theorem toArray_set! (a : Vector α n) (i x) :
(a.set! i x).toArray = a.toArray.set! i x := rfl
@[simp] theorem toArray_setIfInBounds (a : Vector α n) (i x) :
(a.setIfInBounds i x).toArray = a.toArray.setIfInBounds i x := rfl
@[simp] theorem toArray_singleton (x : α) : (Vector.singleton x).toArray = #[x] := rfl
@[simp] theorem toArray_swap (a : Vector α n) (i j) (hi hj) : (a.swap i j).toArray =
a.toArray.swap i j (by simp [hi, hj]) (by simp [hi, hj]) := rfl
@[simp] theorem toArray_swapIfInBounds (a : Vector α n) (i j) :
(a.swapIfInBounds i j).toArray = a.toArray.swapIfInBounds i j := rfl
@[simp] theorem toArray_swapAt (a : Vector α n) (i x h) :
((a.swapAt i x).fst, (a.swapAt i x).snd.toArray) =
((a.toArray.swapAt i x (by simpa using h)).fst,
(a.toArray.swapAt i x (by simpa using h)).snd) := rfl
@[simp] theorem toArray_swapAt! (a : Vector α n) (i x) :
((a.swapAt! i x).fst, (a.swapAt! i x).snd.toArray) =
((a.toArray.swapAt! i x).fst, (a.toArray.swapAt! i x).snd) := rfl
@[simp] theorem toArray_take (a : Vector α n) (m) : (a.take m).toArray = a.toArray.take m := rfl
@[simp] theorem toArray_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) :
(Vector.zipWith a b f).toArray = Array.zipWith a.toArray b.toArray f := rfl
/-! ### toList lemmas -/
theorem length_toList {α n} (xs : Vector α n) : xs.toList.length = n := by simp
theorem getElem_toList {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toList.length) :
xs.toList[i] = xs[i]'(by simpa using h) := by simp
/-! ### Decidable quantifiers. -/
theorem forall_zero_iff {P : Vector α 0 Prop} :
( v, P v) P #v[] := by
constructor
· intro h
apply h
· intro h v
obtain (rfl : v = #v[]) := (by ext i h; simp at h)
apply h
theorem forall_cons_iff {P : Vector α (n + 1) Prop} :
( v : Vector α (n + 1), P v) ( (x : α) (v : Vector α n), P (v.push x)) := by
constructor
· intro h _ _
apply h
· intro h v
have w : v = v.pop.push v.back := by simp
rw [w]
apply h
instance instDecidableForallVectorZero (P : Vector α 0 Prop) :
[Decidable (P #v[])], Decidable ( v, P v)
| .isTrue h => .isTrue fun v, s => by
obtain (rfl : v = .empty) := (by ext i h₁ h₂; exact s; cases h₂)
exact h
| .isFalse h => .isFalse (fun w => h (w _))
instance instDecidableForallVectorSucc (P : Vector α (n+1) Prop)
[Decidable ( (x : α) (v : Vector α n), P (v.push x))] : Decidable ( v, P v) :=
decidable_of_iff' ( x (v : Vector α n), P (v.push x)) forall_cons_iff
instance instDecidableExistsVectorZero (P : Vector α 0 Prop) [Decidable (P #v[])] :
Decidable ( v, P v) :=
decidable_of_iff (¬ v, ¬ P v) Classical.not_forall_not
instance instDecidableExistsVectorSucc (P : Vector α (n+1) Prop)
[Decidable ( (x : α) (v : Vector α n), ¬ P (v.push x))] : Decidable ( v, P v) :=
decidable_of_iff (¬ v, ¬ P v) Classical.not_forall_not

View File

@@ -172,6 +172,16 @@ theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem d
simp only [getElem?_def] at h
split <;> simp_all
@[simp] theorem isNone_getElem? [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
(c : cont) (i : idx) [Decidable (dom c i)] : c[i]?.isNone = ¬dom c i := by
simp only [getElem?_def]
split <;> simp_all
@[simp] theorem isSome_getElem? [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
(c : cont) (i : idx) [Decidable (dom c i)] : c[i]?.isSome = dom c i := by
simp only [getElem?_def]
split <;> simp_all
namespace Fin
instance instGetElemFinVal [GetElem cont Nat elem dom] : GetElem cont (Fin n) elem fun xs i => dom xs i where
@@ -206,12 +216,12 @@ instance : GetElem (List α) Nat α fun as i => i < as.length where
@[simp] theorem getElem_cons_zero (a : α) (as : List α) (h : 0 < (a :: as).length) : getElem (a :: as) 0 h = a := by
rfl
@[deprecated (since := "2024-06-12")] abbrev cons_getElem_zero := @getElem_cons_zero
@[deprecated getElem_cons_zero (since := "2024-06-12")] abbrev cons_getElem_zero := @getElem_cons_zero
@[simp] theorem getElem_cons_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
rfl
@[deprecated (since := "2024-06-12")] abbrev cons_getElem_succ := @getElem_cons_succ
@[deprecated getElem_cons_succ (since := "2024-06-12")] abbrev cons_getElem_succ := @getElem_cons_succ
@[simp] theorem getElem_mem : {l : List α} {n} (h : n < l.length), l[n]'h l
| _ :: _, 0, _ => .head ..
@@ -223,7 +233,8 @@ theorem getElem_cons_drop_succ_eq_drop {as : List α} {i : Nat} (h : i < as.leng
| _::_, 0 => rfl
| _::_, i+1 => getElem_cons_drop_succ_eq_drop (i := i) _
@[deprecated (since := "2024-11-05")] abbrev get_drop_eq_drop := @getElem_cons_drop_succ_eq_drop
@[deprecated getElem_cons_drop_succ_eq_drop (since := "2024-11-05")]
abbrev get_drop_eq_drop := @getElem_cons_drop_succ_eq_drop
end List

View File

@@ -224,7 +224,8 @@ structure Config where
-/
index : Bool := true
/--
This option does not have any effect (yet).
If `implicitDefEqProofs := true`, `simp` does not create proof terms when the
input and output terms are definitionally equal.
-/
implicitDefEqProofs : Bool := true
deriving Inhabited, BEq
@@ -251,10 +252,16 @@ def neutralConfig : Simp.Config := {
end Simp
/-- Configuration for which occurrences that match an expression should be rewritten. -/
inductive Occurrences where
/-- All occurrences should be rewritten. -/
| all
/-- A list of indices for which occurrences should be rewritten. -/
| pos (idxs : List Nat)
/-- A list of indices for which occurrences should not be rewritten. -/
| neg (idxs : List Nat)
deriving Inhabited, BEq
instance : Coe (List Nat) Occurrences := .pos
end Lean.Meta

View File

@@ -48,6 +48,10 @@ def tactic : Category := {}
For example, `let x ← e` is a `doElem`, and a `do` block consists of a list of `doElem`s. -/
def doElem : Category := {}
/-- `structInstFieldDecl` is the syntax category for value declarations for fields in structure instance notation.
For example, the `:= 1` and `| 0 => 0 | n + 1 => n` in `{ x := 1, f | 0 => 0 | n + 1 => n }` are in the `structInstFieldDecl` class. -/
def structInstFieldDecl : Category := {}
/-- `level` is a builtin syntax category for universe levels.
This is the `u` in `Sort u`: it can contain `max` and `imax`, addition with
constants, and variables. -/

View File

@@ -32,13 +32,9 @@ theorem get_map {xs : IntList} (h : f 0 = 0) : get (xs.map f) i = f (xs.get i) :
cases xs[i]? <;> simp_all
theorem get_of_length_le {xs : IntList} (h : xs.length i) : xs.get i = 0 := by
rw [get, List.get?_eq_none.mpr h]
rw [get, List.get?_eq_none_iff.mpr h]
rfl
-- theorem lt_length_of_get_nonzero {xs : IntList} (h : xs.get i ≠ 0) : i < xs.length := by
-- revert h
-- simpa using mt get_of_length_le
/-- Like `List.set`, but right-pad with zeroes as necessary first. -/
def set (xs : IntList) (i : Nat) (y : Int) : IntList :=
match xs, i with

View File

@@ -2116,6 +2116,11 @@ theorem usize_size_eq : Or (Eq USize.size 4294967296) (Eq USize.size 18446744073
| _, Or.inl rfl => Or.inl (of_decide_eq_true rfl)
| _, Or.inr rfl => Or.inr (of_decide_eq_true rfl)
theorem usize_size_pos : LT.lt 0 USize.size :=
match USize.size, usize_size_eq with
| _, Or.inl rfl => of_decide_eq_true rfl
| _, Or.inr rfl => of_decide_eq_true rfl
/--
A `USize` is an unsigned integer with the size of a word
for the platform's architecture.
@@ -2155,24 +2160,7 @@ def USize.decEq (a b : USize) : Decidable (Eq a b) :=
instance : DecidableEq USize := USize.decEq
instance : Inhabited USize where
default := USize.ofNatCore 0 (match USize.size, usize_size_eq with
| _, Or.inl rfl => of_decide_eq_true rfl
| _, Or.inr rfl => of_decide_eq_true rfl)
/--
Upcast a `Nat` less than `2^32` to a `USize`.
This is lossless because `USize.size` is either `2^32` or `2^64`.
This function is overridden with a native implementation.
-/
@[extern "lean_usize_of_nat"]
def USize.ofNat32 (n : @& Nat) (h : LT.lt n 4294967296) : USize where
toBitVec :=
BitVec.ofNatLt n (
match System.Platform.numBits, System.Platform.numBits_eq with
| _, Or.inl rfl => h
| _, Or.inr rfl => Nat.lt_trans h (of_decide_eq_true rfl)
)
default := USize.ofNatCore 0 usize_size_pos
/--
A `Nat` denotes a valid unicode codepoint if it is less than `0x110000`, and
it is also not a "surrogate" character (the range `0xd800` to `0xdfff` inclusive).
@@ -3432,25 +3420,6 @@ class Hashable (α : Sort u) where
export Hashable (hash)
/-- Converts a `UInt64` to a `USize` by reducing modulo `USize.size`. -/
@[extern "lean_uint64_to_usize"]
opaque UInt64.toUSize (u : UInt64) : USize
/--
Upcast a `USize` to a `UInt64`.
This is lossless because `USize.size` is either `2^32` or `2^64`.
This function is overridden with a native implementation.
-/
@[extern "lean_usize_to_uint64"]
def USize.toUInt64 (u : USize) : UInt64 where
toBitVec := BitVec.ofNatLt u.toBitVec.toNat (
let n, h := u
show LT.lt n _ from
match System.Platform.numBits, System.Platform.numBits_eq, h with
| _, Or.inl rfl, h => Nat.lt_trans h (of_decide_eq_true rfl)
| _, Or.inr rfl, h => h
)
/-- An opaque hash mixing operation, used to implement hashing for tuples. -/
@[extern "lean_uint64_mix_hash"]
opaque mixHash (u₁ u₂ : UInt64) : UInt64

View File

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Util
import Init.Data.UInt.Basic
namespace ShareCommon
/-

View File

@@ -72,6 +72,21 @@ theorem let_body_congr {α : Sort u} {β : α → Sort v} {b b' : (a : α) →
(a : α) (h : x, b x = b' x) : (let x := a; b x) = (let x := a; b' x) :=
(funext h : b = b') rfl
theorem letFun_unused {α : Sort u} {β : Sort v} (a : α) {b b' : β} (h : b = b') : @letFun α (fun _ => β) a (fun _ => b) = b' :=
h
theorem letFun_congr {α : Sort u} {β : Sort v} {a a' : α} {f f' : α β} (h₁ : a = a') (h₂ : x, f x = f' x)
: @letFun α (fun _ => β) a f = @letFun α (fun _ => β) a' f' := by
rw [h₁, funext h₂]
theorem letFun_body_congr {α : Sort u} {β : Sort v} (a : α) {f f' : α β} (h : x, f x = f' x)
: @letFun α (fun _ => β) a f = @letFun α (fun _ => β) a f' := by
rw [funext h]
theorem letFun_val_congr {α : Sort u} {β : Sort v} {a a' : α} {f : α β} (h : a = a')
: @letFun α (fun _ => β) a f = @letFun α (fun _ => β) a' f := by
rw [h]
@[congr]
theorem ite_congr {x y u v : α} {s : Decidable b} [Decidable c]
(h₁ : b = c) (h₂ : c x = u) (h₃ : ¬ c y = v) : ite b x y = ite c u v := by

View File

@@ -959,3 +959,25 @@ syntax "println! " (interpolatedStr(term) <|> term) : term
macro_rules
| `(println! $msg:interpolatedStr) => `((IO.println (s! $msg) : IO Unit))
| `(println! $msg:term) => `((IO.println $msg : IO Unit))
/--
Marks given value and its object graph closure as multi-threaded if currently
marked single-threaded. This will make reference counter updates atomic and
thus more costly. It can still be useful to do eagerly when the value will be
shared between threads later anyway and there is available time budget to mark
it now. -/
@[extern "lean_runtime_mark_multi_threaded"]
def Runtime.markMultiThreaded (a : α) : BaseIO α := return a
/--
Marks given value and its object graph closure as persistent. This will remove
reference counter updates but prevent the closure from being deallocated until
the end of the process! It can still be useful to do eagerly when the value
will be marked persistent later anyway and there is available time budget to
mark it now or it would be unnecessarily marked multi-threaded in between.
This function is only safe to use on objects (in the full closure) which are
not used concurrently or which are already persistent.
-/
@[extern "lean_runtime_mark_persistent"]
unsafe def Runtime.markPersistent (a : α) : BaseIO α := return a

View File

@@ -23,5 +23,14 @@ def isEmscripten : Bool := getIsEmscripten ()
/-- The LLVM target triple of the current platform. Empty if missing at Lean compile time. -/
def target : String := getTarget ()
theorem numBits_pos : 0 < numBits := by
cases numBits_eq <;> next h => simp [h]
theorem le_numBits : 32 numBits := by
cases numBits_eq <;> next h => simp [h]
theorem numBits_le : numBits 64 := by
cases numBits_eq <;> next h => simp [h]
end Platform
end System

View File

@@ -79,21 +79,3 @@ def withPtrEq {α : Type u} (a b : α) (k : Unit → Bool) (h : a = b → k () =
@[implemented_by withPtrAddrUnsafe]
def withPtrAddr {α : Type u} {β : Type v} (a : α) (k : USize β) (h : u₁ u₂, k u₁ = k u₂) : β := k 0
/--
Marks given value and its object graph closure as multi-threaded if currently
marked single-threaded. This will make reference counter updates atomic and
thus more costly. It can still be useful to do eagerly when the value will be
shared between threads later anyway and there is available time budget to mark
it now. -/
@[extern "lean_runtime_mark_multi_threaded"]
def Runtime.markMultiThreaded (a : α) : α := a
/--
Marks given value and its object graph closure as persistent. This will remove
reference counter updates but prevent the closure from being deallocated until
the end of the process! It can still be useful to do eagerly when the value
will be marked persistent later anyway and there is available time budget to
mark it now or it would be unnecessarily marked multi-threaded in between. -/
@[extern "lean_runtime_mark_persistent"]
def Runtime.markPersistent (a : α) : α := a

View File

@@ -31,6 +31,11 @@ register_builtin_option maxHeartbeats : Nat := {
descr := "maximum amount of heartbeats per command. A heartbeat is number of (small) memory allocations (in thousands), 0 means no limit"
}
register_builtin_option Elab.async : Bool := {
defValue := false
descr := "perform elaboration using multiple threads where possible"
}
/--
If the `diagnostics` option is not already set, gives a message explaining this option.
Begins with a `\n`, so an error message can look like `m!"some error occurred{useDiagnosticMsg}"`.

View File

@@ -1150,48 +1150,33 @@ private def throwLValError (e : Expr) (eType : Expr) (msg : MessageData) : TermE
throwError "{msg}{indentExpr e}\nhas type{indentExpr eType}"
/--
`findMethod? S fName` tries the following for each namespace `S'` in the resolution order for `S`:
- If `env` contains `S' ++ fName`, returns `(S', S' ++ fName)`
- Otherwise if `env` contains private name `prv` for `S' ++ fName`, returns `(S', prv)`
`findMethod? S fName` tries the for each namespace `S'` in the resolution order for `S` to resolve the name `S'.fname`.
If it resolves to `name`, returns `(S', name)`.
-/
private partial def findMethod? (structName fieldName : Name) : MetaM (Option (Name × Name)) := do
let env getEnv
let find? structName' : MetaM (Option (Name × Name)) := do
let fullName := structName' ++ fieldName
if env.contains fullName then
return some (structName', fullName)
let fullNamePrv := mkPrivateName env fullName
if env.contains fullNamePrv then
return some (structName', fullNamePrv)
return none
-- We do not want to make use of the current namespace for resolution.
let candidates := ResolveName.resolveGlobalName ( getEnv) Name.anonymous ( getOpenDecls) fullName
|>.filter (fun (_, fieldList) => fieldList.isEmpty)
|>.map Prod.fst
match candidates with
| [] => return none
| [fullName'] => return some (structName', fullName')
| _ => throwError "\
invalid field notation '{fieldName}', the name '{fullName}' is ambiguous, possible interpretations: \
{MessageData.joinSep (candidates.map (m!"'{.ofConstName ·}'")) ", "}"
-- Optimization: the first element of the resolution order is `structName`,
-- so we can skip computing the resolution order in the common case
-- of the name resolving in the `structName` namespace.
find? structName <||> do
let resolutionOrder if isStructure env structName then getStructureResolutionOrder structName else pure #[structName]
for h : i in [1:resolutionOrder.size] do
if let some res find? resolutionOrder[i] then
for ns in resolutionOrder[1:resolutionOrder.size] do
if let some res find? ns then
return res
return none
/--
Return `some (structName', fullName)` if `structName ++ fieldName` is an alias for `fullName`, and
`fullName` is of the form `structName' ++ fieldName`.
TODO: if there is more than one applicable alias, it returns `none`. We should consider throwing an error or
warning.
-/
private def findMethodAlias? (env : Environment) (structName fieldName : Name) : Option (Name × Name) :=
let fullName := structName ++ fieldName
-- We never skip `protected` aliases when resolving dot-notation.
let aliasesCandidates := getAliases env fullName (skipProtected := false) |>.filterMap fun alias =>
match alias.eraseSuffix? fieldName with
| none => none
| some structName' => some (structName', alias)
match aliasesCandidates with
| [r] => some r
| _ => none
private def throwInvalidFieldNotation (e eType : Expr) : TermElabM α :=
throwLValError e eType "invalid field notation, type is not of the form (C ...) where C is a constant"
@@ -1223,30 +1208,22 @@ private def resolveLValAux (e : Expr) (eType : Expr) (lval : LVal) : TermElabM L
throwLValError e eType m!"invalid projection, structure has only {numFields} field(s)"
| some structName, LVal.fieldName _ fieldName _ _ =>
let env getEnv
let searchEnv : Unit TermElabM LValResolution := fun _ => do
if let some (baseStructName, fullName) findMethod? structName (.mkSimple fieldName) then
return LValResolution.const baseStructName structName fullName
else if let some (structName', fullName) := findMethodAlias? env structName (.mkSimple fieldName) then
return LValResolution.const structName' structName' fullName
else
throwLValError e eType
m!"invalid field '{fieldName}', the environment does not contain '{Name.mkStr structName fieldName}'"
-- search local context first, then environment
let searchCtx : Unit TermElabM LValResolution := fun _ => do
let fullName := Name.mkStr structName fieldName
for localDecl in ( getLCtx) do
if localDecl.isAuxDecl then
if let some localDeclFullName := ( read).auxDeclToFullName.find? localDecl.fvarId then
if fullName == (privateToUserName? localDeclFullName).getD localDeclFullName then
/- LVal notation is being used to make a "local" recursive call. -/
return LValResolution.localRec structName fullName localDecl.toExpr
searchEnv ()
if isStructure env structName then
match findField? env structName (Name.mkSimple fieldName) with
| some baseStructName => return LValResolution.projFn baseStructName structName (Name.mkSimple fieldName)
| none => searchCtx ()
else
searchCtx ()
if let some baseStructName := findField? env structName (Name.mkSimple fieldName) then
return LValResolution.projFn baseStructName structName (Name.mkSimple fieldName)
-- Search the local context first
let fullName := Name.mkStr structName fieldName
for localDecl in ( getLCtx) do
if localDecl.isAuxDecl then
if let some localDeclFullName := ( read).auxDeclToFullName.find? localDecl.fvarId then
if fullName == (privateToUserName? localDeclFullName).getD localDeclFullName then
/- LVal notation is being used to make a "local" recursive call. -/
return LValResolution.localRec structName fullName localDecl.toExpr
-- Then search the environment
if let some (baseStructName, fullName) findMethod? structName (.mkSimple fieldName) then
return LValResolution.const baseStructName structName fullName
throwLValError e eType
m!"invalid field '{fieldName}', the environment does not contain '{Name.mkStr structName fieldName}'"
| none, LVal.fieldName _ _ (some suffix) _ =>
if e.isConst then
throwUnknownConstant (e.constName! ++ suffix)
@@ -1326,7 +1303,7 @@ Otherwise, if there isn't another parameter with the same name, we add `e` to `n
Remark: `fullName` is the name of the resolved "field" access function. It is used for reporting errors
-/
private partial def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (f : Expr) :
private partial def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (f : Expr) (explicit : Bool) :
MetaM (Array Arg × Array NamedArg) := do
withoutModifyingState <| go f ( inferType f) 0 namedArgs (namedArgs.map (·.name)) true
where
@@ -1351,11 +1328,11 @@ where
/- If there is named argument with name `xDecl.userName`, then it is accounted for and we can't make use of it. -/
remainingNamedArgs := remainingNamedArgs.eraseIdx idx
else
if ( typeMatchesBaseName xDecl.type baseName) then
/- We found a type of the form (baseName ...).
First, we check if the current argument is an explicit one,
if typeMatchesBaseName xDecl.type baseName then
/- We found a type of the form (baseName ...), or we found the first explicit argument in useFirstExplicit mode.
First, we check if the current argument is one that can be used positionally,
and if the current explicit position "fits" at `args` (i.e., it must be ≤ arg.size) -/
if h : argIdx args.size bInfo.isExplicit then
if h : argIdx args.size (explicit || bInfo.isExplicit) then
/- We can insert `e` as an explicit argument -/
return (args.insertIdx argIdx (Arg.expr e), namedArgs)
else
@@ -1363,13 +1340,13 @@ where
if there isn't an argument with the same name occurring before it. -/
if !allowNamed || unusableNamedArgs.contains xDecl.userName then
throwError "\
invalid field notation, function '{fullName}' has argument with the expected type\
invalid field notation, function '{.ofConstName fullName}' has argument with the expected type\
{indentExpr xDecl.type}\n\
but it cannot be used"
else
return (args, namedArgs.push { name := xDecl.userName, val := Arg.expr e })
/- Advance `argIdx` and update seen named arguments. -/
if bInfo.isExplicit then
if explicit || bInfo.isExplicit then
argIdx := argIdx + 1
unusableNamedArgs := unusableNamedArgs.push xDecl.userName
/- If named arguments aren't allowed, then it must still be possible to pass the value as an explicit argument.
@@ -1380,7 +1357,7 @@ where
if let some f' coerceToFunction? (mkAppN f xs) then
return go f' ( inferType f') argIdx remainingNamedArgs unusableNamedArgs false
throwError "\
invalid field notation, function '{fullName}' does not have argument with type ({baseName} ...) that can be used, \
invalid field notation, function '{.ofConstName fullName}' does not have argument with type ({.ofConstName baseName} ...) that can be used, \
it must be explicit or implicit with a unique name"
/-- Adds the `TermInfo` for the field of a projection. See `Lean.Parser.Term.identProjKind`. -/
@@ -1426,7 +1403,7 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
let projFn mkConst constName
let projFn addProjTermInfo lval.getRef projFn
if lvals.isEmpty then
let (args, namedArgs) addLValArg baseStructName constName f args namedArgs projFn
let (args, namedArgs) addLValArg baseStructName constName f args namedArgs projFn explicit
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs projFn #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)
@@ -1434,7 +1411,7 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
| LValResolution.localRec baseName fullName fvar =>
let fvar addProjTermInfo lval.getRef fvar
if lvals.isEmpty then
let (args, namedArgs) addLValArg baseName fullName f args namedArgs fvar
let (args, namedArgs) addLValArg baseName fullName f args namedArgs fvar explicit
elabAppArgs fvar namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs fvar #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)

View File

@@ -282,52 +282,36 @@ private partial def withFunLocalDecls {α} (headers : Array DefViewElabHeader) (
k fvars
loop 0 #[]
private def expandWhereStructInst : Macro
| whereStx@`(Parser.Command.whereStructInst|where%$whereTk $[$decls:letDecl];* $[$whereDecls?:whereDecls]?) => do
let letIdDecls decls.mapM fun stx => match stx with
| `(letDecl|$_decl:letPatDecl) => Macro.throwErrorAt stx "patterns are not allowed here"
| `(letDecl|$decl:letEqnsDecl) => expandLetEqnsDecl decl (useExplicit := false)
| `(letDecl|$decl:letIdDecl) => pure decl
| _ => Macro.throwUnsupported
let structInstFields letIdDecls.mapM fun
| stx@`(letIdDecl|$id:ident $binders* $[: $ty?]? := $val) => withRef stx do
let mut val := val
if let some ty := ty? then
val `(($val : $ty))
-- HACK: this produces invalid syntax, but the fun elaborator supports letIdBinders as well
have : Coe (TSyntax ``letIdBinder) (TSyntax ``funBinder) := (·)
val if binders.size > 0 then `(fun $binders* => $val) else pure val
`(structInstField|$id:ident := $val)
| stx@`(letIdDecl|_ $_* $[: $_]? := $_) => Macro.throwErrorAt stx "'_' is not allowed here"
| _ => Macro.throwUnsupported
private def expandWhereStructInst : Macro := fun whereStx => do
let `(Parser.Command.whereStructInst| where%$whereTk $[$structInstFields];* $[$whereDecls?:whereDecls]?) := whereStx
| Macro.throwUnsupported
let startOfStructureTkInfo : SourceInfo :=
match whereTk.getPos? with
| some pos => .synthetic pos pos.byteIdx + 1 true
| none => .none
-- Position the closing `}` at the end of the trailing whitespace of `where $[$_:letDecl];*`.
-- We need an accurate range of the generated structure instance in the generated `TermInfo`
-- so that we can determine the expected type in structure field completion.
let structureStxTailInfo :=
whereStx[1].getTailInfo?
<|> whereStx[0].getTailInfo?
let endOfStructureTkInfo : SourceInfo :=
match structureStxTailInfo with
| some (SourceInfo.original _ _ trailing _) =>
let tokenPos := trailing.str.prev trailing.stopPos
let tokenEndPos := trailing.stopPos
.synthetic tokenPos tokenEndPos true
| _ => .none
let startOfStructureTkInfo : SourceInfo :=
match whereTk.getPos? with
| some pos => .synthetic pos pos.byteIdx + 1 true
| none => .none
-- Position the closing `}` at the end of the trailing whitespace of `where $[$_:letDecl];*`.
-- We need an accurate range of the generated structure instance in the generated `TermInfo`
-- so that we can determine the expected type in structure field completion.
let structureStxTailInfo :=
whereStx[1].getTailInfo?
<|> whereStx[0].getTailInfo?
let endOfStructureTkInfo : SourceInfo :=
match structureStxTailInfo with
| some (SourceInfo.original _ _ trailing _) =>
let tokenPos := trailing.str.prev trailing.stopPos
let tokenEndPos := trailing.stopPos
.synthetic tokenPos tokenEndPos true
| _ => .none
let body `(structInst| { $structInstFields,* })
let body := body.raw.setInfo <|
match startOfStructureTkInfo.getPos?, endOfStructureTkInfo.getTailPos? with
| some startPos, some endPos => .synthetic startPos endPos true
| _, _ => .none
match whereDecls? with
| some whereDecls => expandWhereDecls whereDecls body
| none => return body
| _ => Macro.throwUnsupported
let body `(structInst| { $structInstFields,* })
let body := body.raw.setInfo <|
match startOfStructureTkInfo.getPos?, endOfStructureTkInfo.getTailPos? with
| some startPos, some endPos => .synthetic startPos endPos true
| _, _ => .none
match whereDecls? with
| some whereDecls => expandWhereDecls whereDecls body
| none => return body
/-
Recall that

View File

@@ -265,7 +265,7 @@ partial def collect (stx : Syntax) : M Syntax := withRef stx <| withFreshMacroSc
| `(Parser.Term.structInstField| $lval:structInstLVal := $val) => do
let newVal collect val
`(Parser.Term.structInstField| $lval:structInstLVal := $newVal)
| _ => throwInvalidPattern -- `structInstFieldAbbrev` should be expanded at this point
| _ => throwInvalidPattern -- `structInstField` should be expanded at this point
`({ $[$srcs?,* with]? $fields,* $[..%$ell?]? $[: $ty?]? })
| _ => throwInvalidPattern

View File

@@ -31,13 +31,32 @@ open Meta
open TSyntax.Compat
/-!
Recall that structure instances are of the form:
```
"{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
>> manyIndent (group ((structInstFieldAbbrev <|> structInstField) >> optional ", "))
Recall that structure instances are (after removing parsing and pretty printing hints):
```lean
def structInst := leading_parser
"{ " >> optional (sepBy1 termParser ", " >> " with ")
>> structInstFields (sepByIndent structInstField ", " (allowTrailingSep := true))
>> optEllipsis
>> optional (" : " >> termParser)
>> " }"
>> optional (" : " >> termParser) >> " }"
def structInstField := leading_parser
structInstLVal >> optional (many structInstFieldBinder >> optType >> structInstFieldDecl)
@[builtin_structInstFieldDecl_parser]
def structInstFieldDef := leading_parser
" := " >> termParser
@[builtin_structInstFieldDecl_parser]
def structInstFieldEqns := leading_parser
matchAlts
def structInstWhereBody := leading_parser
structInstFields (sepByIndent structInstField "; " (allowTrailingSep := true))
@[builtin_structInstFieldDecl_parser]
def structInstFieldWhere := leading_parser
"where" >> structInstWhereBody
```
-/
@@ -54,22 +73,57 @@ Structure instance notation makes use of the expected type.
let stxNew := stx.setArg 4 mkNullNode
`(($stxNew : $expected))
def mkStructInstField (lval : TSyntax ``Parser.Term.structInstLVal) (binders : TSyntaxArray ``Parser.Term.structInstFieldBinder)
(type? : Option Term) (val : Term) : MacroM (TSyntax ``Parser.Term.structInstField) := do
let mut val := val
if let some type := type? then
val `(($val : $type))
if !binders.isEmpty then
-- HACK: this produces invalid syntax, but the fun elaborator supports structInstFieldBinder as well
val `(fun $binders* => $val)
`(Parser.Term.structInstField| $lval := $val)
/--
Expands field abbreviation notation.
Example: `{ x, y := 0 }` expands to `{ x := x, y := 0 }`.
Takes an arbitrary `structInstField` and expands it to be a `structInstFieldDef` without any binders or type ascription.
-/
@[builtin_macro Lean.Parser.Term.structInst] def expandStructInstFieldAbbrev : Macro
| `({ $[$srcs,* with]? $fields,* $[..%$ell]? $[: $ty]? }) =>
if fields.getElems.raw.any (·.getKind == ``Lean.Parser.Term.structInstFieldAbbrev) then do
let fieldsNew fields.getElems.mapM fun
| `(Parser.Term.structInstFieldAbbrev| $id:ident) =>
`(Parser.Term.structInstField| $id:ident := $id:ident)
| field => return field
`({ $[$srcs,* with]? $fieldsNew,* $[..%$ell]? $[: $ty]? })
else
Macro.throwUnsupported
private def expandStructInstField (stx : Syntax) : MacroM (Option Syntax) := withRef stx do
match stx with
| `(Parser.Term.structInstField| $_:structInstLVal := $_) =>
-- Already expanded.
return none
| `(Parser.Term.structInstField| $lval:structInstLVal $[$binders]* $[: $ty?]? $decl:structInstFieldDecl) =>
match decl with
| `(Parser.Term.structInstFieldDef| := $val) =>
mkStructInstField lval binders ty? val
| `(Parser.Term.structInstFieldEqns| $alts:matchAlts) =>
let val expandMatchAltsIntoMatch stx alts (useExplicit := false)
mkStructInstField lval binders ty? val
| _ => Macro.throwUnsupported
| `(Parser.Term.structInstField| $lval:structInstLVal) =>
-- Abbreviation
match lval with
| `(Parser.Term.structInstLVal| $id:ident) =>
mkStructInstField lval #[] none id
| _ =>
Macro.throwErrorAt lval "unsupported structure instance field abbreviation, expecting identifier"
| _ => Macro.throwUnsupported
/--
Expands fields.
* Abbrevations. Example: `{ x }` expands to `{ x := x }`.
* Equations. Example: `{ f | 0 => 0 | n + 1 => n }` expands to `{ f := fun x => match x with | 0 => 0 | n + 1 => n }`.
* Binders and types. Example: `{ f n : Nat := n + 1 }` expands to `{ f := fun n => (n + 1 : Nat) }`.
-/
@[builtin_macro Lean.Parser.Term.structInst] def expandStructInstFields : Macro | stx => do
let structInstFields := stx[2]
let fields := structInstFields[0].getSepArgs
let fields? fields.mapM expandStructInstField
if fields?.all (·.isNone) then
Macro.throwUnsupported
let fields := fields?.zipWith fields Option.getD
let structInstFields := structInstFields.setArg 0 <| Syntax.mkSep fields (mkAtomFrom stx ", ")
return stx.setArg 2 structInstFields
/--
If `stx` is of the form `{ s₁, ..., sₙ with ... }` and `sᵢ` is not a local variable,
expands into `let __src := sᵢ; { ..., __src, ... with ... }`.
@@ -187,12 +241,13 @@ def structInstArrayRef := leading_parser "[" >> termParser >>"]"
-/
private def isModifyOp? (stx : Syntax) : TermElabM (Option Syntax) := do
let s? stx[2][0].getSepArgs.foldlM (init := none) fun s? arg => do
/- arg is of the form `structInstFieldAbbrev <|> structInstField` -/
if arg.getKind == ``Lean.Parser.Term.structInstField then
/- Remark: the syntax for `structInstField` is
/- arg is of the form `structInstField`. It should be macro expanded at this point, but we make sure it's the case. -/
if arg[1][2].getKind == ``Lean.Parser.Term.structInstFieldDef then
/- Remark: the syntax for `structInstField` after macro expansion is
```
def structInstLVal := leading_parser (ident <|> numLit <|> structInstArrayRef) >> many (group ("." >> (ident <|> numLit)) <|> structInstArrayRef)
def structInstField := leading_parser structInstLVal >> " := " >> termParser
def structInstFieldDef := leading_parser
structInstLVal >> group (null >> null >> group (" := " >> termParser))
```
-/
let lval := arg[0]
@@ -235,7 +290,7 @@ private def elabModifyOp (stx modifyOp : Syntax) (sources : Array ExplicitSource
withMacroExpansion stx stxNew <| elabTerm stxNew expectedType?
let rest := modifyOp[0][1]
if rest.isNone then
cont modifyOp[2]
cont modifyOp[1][2][1]
else
let s `(s)
let valFirst := rest[0]
@@ -388,7 +443,7 @@ Converts a `FieldLHS` back into syntax. This assumes the `ref` fields have the c
Recall that `structInstField` elements have the form
```lean
def structInstField := leading_parser structInstLVal >> " := " >> termParser
def structInstField := leading_parser structInstLVal >> group (null >> null >> group (" := " >> termParser))
def structInstLVal := leading_parser (ident <|> numLit <|> structInstArrayRef) >> many (("." >> (ident <|> numLit)) <|> structInstArrayRef)
def structInstArrayRef := leading_parser "[" >> termParser >>"]"
```
@@ -412,9 +467,9 @@ Converts a `Field StructInstView` back into syntax. Used to construct synthetic
private def Field.toSyntax : Field Syntax
| field =>
let stx := field.ref
let stx := stx.setArg 2 field.val.toSyntax
let stx := stx.setArg 1 <| stx[1].setArg 2 <| stx[1][2].setArg 1 field.val.toSyntax
match field.lhs with
| first::rest => stx.setArg 0 <| mkNullNode #[first.toSyntax true, mkNullNode <| rest.toArray.map (FieldLHS.toSyntax false) ]
| first::rest => stx.setArg 0 <| mkNode ``Parser.Term.structInstLVal #[first.toSyntax true, mkNullNode <| rest.toArray.map (FieldLHS.toSyntax false) ]
| _ => unreachable!
/-- Creates a view of a field left-hand side. -/
@@ -428,7 +483,7 @@ private def toFieldLHS (stx : Syntax) : MacroM FieldLHS :=
return FieldLHS.fieldName stx stx.getId.eraseMacroScopes
else match stx.isFieldIdx? with
| some idx => return FieldLHS.fieldIndex stx idx
| none => Macro.throwError "unexpected structure syntax"
| none => Macro.throwErrorAt stx "unexpected structure syntax"
/--
Creates a structure instance view from structure instance notation
@@ -436,21 +491,21 @@ and the computed structure name (from `Lean.Elab.Term.StructInst.getStructName`)
and structure source view (from `Lean.Elab.Term.StructInst.getStructSources`).
-/
private def mkStructView (stx : Syntax) (structName : Name) (sources : SourcesView) : MacroM StructInstView := do
/- Recall that `stx` is of the form
```
leading_parser "{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
>> structInstFields (sepByIndent (structInstFieldAbbrev <|> structInstField) ...)
>> optional ".."
>> optional (" : " >> termParser)
>> " }"
```
This method assumes that `structInstFieldAbbrev` had already been expanded.
/-
Recall that `stx` is of the form
```
leading_parser "{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
>> structInstFields (sepByIndent structInstField ...)
>> optional ".."
>> optional (" : " >> termParser)
>> " }"
```
This method assumes that `structInstField` had already been expanded by the macro `expandStructInstFields`.
-/
let fields stx[2][0].getSepArgs.toList.mapM fun fieldStx => do
let val := fieldStx[2]
let first toFieldLHS fieldStx[0][0]
let rest fieldStx[0][1].getArgs.toList.mapM toFieldLHS
let `(Parser.Term.structInstField| $lval:structInstLVal := $val) := fieldStx | Macro.throwUnsupported
let first toFieldLHS lval.raw[0]
let rest lval.raw[1].getArgs.toList.mapM toFieldLHS
return { ref := fieldStx, lhs := first :: rest, val := FieldVal.term val : Field }
return { ref := stx, structName, params := #[], fields, sources }
@@ -596,7 +651,7 @@ mutual
let updateSource (structStx : Syntax) : TermElabM Syntax := do
let sourcesNew s.sources.explicit.filterMapM fun source => mkProjStx? source.stx source.structName fieldName
let explicitSourceStx := if sourcesNew.isEmpty then mkNullNode else mkSourcesWithSyntax sourcesNew
let implicitSourceStx := s.sources.implicit.getD mkNullNode
let implicitSourceStx := s.sources.implicit.getD (mkNode ``Parser.Term.optEllipsis #[mkNullNode])
return (structStx.setArg 1 explicitSourceStx).setArg 3 implicitSourceStx
let valStx := s.ref -- construct substructure syntax using s.ref as template
let valStx := valStx.setArg 4 mkNullNode -- erase optional expected type

View File

@@ -1079,7 +1079,9 @@ def synthesizeInstMVarCore (instMVar : MVarId) (maxResultSize? : Option Nat := n
let oldValType inferType oldVal
let valType inferType val
unless ( isDefEq oldValType valType) do
let (oldValType, valType) addPPExplicitToExposeDiff oldValType valType
throwError "synthesized type class instance type is not definitionally equal to expected type, synthesized{indentExpr val}\nhas type{indentExpr valType}\nexpected{indentExpr oldValType}{extraErrorMsg}"
let (oldVal, val) addPPExplicitToExposeDiff oldVal val
throwError "synthesized type class instance is not definitionally equal to expression inferred by typing rules, synthesized{indentExpr val}\ninferred{indentExpr oldVal}{extraErrorMsg}"
else
unless ( isDefEq (mkMVar instMVar) val) do

View File

@@ -897,13 +897,18 @@ def finalizeImport (s : ImportState) (imports : Array Import) (opts : Options) (
initialized constant. We have seen significant savings in `open Mathlib`
timings, where we have both a big environment and interpreted environment
extensions, from this. There is no significant extra cost to calling
`markPersistent` multiple times like this. -/
env := Runtime.markPersistent env
`markPersistent` multiple times like this.
Safety: There are no concurrent accesses to `env` at this point. -/
env unsafe Runtime.markPersistent env
env finalizePersistentExtensions env s.moduleData opts
if leakEnv then
/- Ensure the final environment including environment extension states is
marked persistent as documented. -/
env := Runtime.markPersistent env
marked persistent as documented.
Safety: There are no concurrent accesses to `env` at this point, assuming
extensions' `addImportFn`s did not spawn any unbound tasks. -/
env unsafe Runtime.markPersistent env
pure env
@[export lean_import_modules]

View File

@@ -1366,7 +1366,11 @@ See also `Lean.Expr.instantiateRange`, which instantiates with the "backwards" i
@[extern "lean_expr_instantiate_rev_range"]
opaque instantiateRevRange (e : @& Expr) (beginIdx endIdx : @& Nat) (subst : @& Array Expr) : Expr
/-- Replace free (or meta) variables `xs` with loose bound variables. -/
/-- Replace free (or meta) variables `xs` with loose bound variables,
with `xs` ordered from outermost to innermost de Bruijn index.
For example, `e := f x y` with `xs := #[x, y]` goes to `f #1 #0`,
whereas `e := f x y` with `xs := #[y, x]` goes to `f #0 #1`. -/
@[extern "lean_expr_abstract"]
opaque abstract (e : @& Expr) (xs : @& Array Expr) : Expr

View File

@@ -46,17 +46,33 @@ delete the space after private, it becomes a syntactically correct structure wit
privateaxiom! So clearly, because of uses of atomic in the grammar, an edit can affect a command
syntax tree even across multiple tokens.
Now, what we do today, and have done since Lean 3, is to always reparse the last command completely
preceding the edit location. If its syntax tree is unchanged, we preserve its data and reprocess all
following commands only, otherwise we reprocess it fully as well. This seems to have worked well so
far but it does seem a bit arbitrary given that even if it works for our current grammar, it can
certainly be extended in ways that break the assumption.
What we did in Lean 3 was to always reparse the last command completely preceding the edit location.
If its syntax tree is unchanged, we preserve its data and reprocess all following commands only,
otherwise we reprocess it fully as well. This worked well but did seem a bit arbitrary given that
even if it works for a grammar at some point, it can certainly be extended in ways that break the
assumption.
With grammar changes in Lean 4, we found that the following example indeed breaks this assumption:
```
structure Signature where
/-- a docstring -/
Sort : Type
--^ insert: "s"
```
As the keyword `Sort` is not a valid start of a structure field and the parser backtracks across the
docstring in that case, this is parsed as the complete command `structure Signature where` followed
by the partial command `/-- a docstring -/ <missing>`. If we insert an `s` after the `t`, the last
command completely preceding the edit location is the partial command containing the docstring. Thus
we need to go up two commands to ensure we reparse the `structure` command as well. This kind of
nested docstring is the only part of the grammar to our knowledge that requires going up at least
two commands; as we never backtrack across more than one docstring, going up two commands should
also be sufficient.
Finally, a more actually principled and generic solution would be to invalidate a syntax tree when
the parser has reached the edit location during parsing. If it did not, surely the edit cannot have
an effect on the syntax tree in question. Sadly such a "high-water mark" parser position does not
exist currently and likely it could at best be approximated by e.g. "furthest `tokenFn` parse". Thus
we remain at "go two commands up" at this point.
we remain at "go up two commands" at this point.
-/
/-!
@@ -231,7 +247,7 @@ structure SetupImportsResult where
/-- Performance option used by cmdline driver. -/
register_builtin_option internal.cmdlineSnapshots : Bool := {
defValue := false
descr := "mark persistent and reduce information stored in snapshots to the minimum necessary \
descr := "reduce information stored in snapshots to the minimum necessary \
for the cmdline driver: diagnostics per command and final full snapshot"
}
@@ -340,11 +356,12 @@ where
if let some old := old? then
if let some oldSuccess := old.result? then
if let some (some processed) old.processedResult.get? then
-- ...and the edit location is after the next command (see note [Incremental Parsing])...
-- ...and the edit is after the second-next command (see note [Incremental Parsing])...
if let some nextCom processed.firstCmdSnap.get? then
if ( isBeforeEditPos nextCom.parserState.pos) then
-- ...go immediately to next snapshot
return ( unchanged old old.stx oldSuccess.parserState)
if let some nextNextCom processed.firstCmdSnap.get? then
if ( isBeforeEditPos nextNextCom.parserState.pos) then
-- ...go immediately to next snapshot
return ( unchanged old old.stx oldSuccess.parserState)
withHeaderExceptions ({ · with
ictx, stx := .missing, result? := none, cancelTk? := none }) do
@@ -437,11 +454,6 @@ where
traceState
}
let prom IO.Promise.new
-- The speedup of these `markPersistent`s is negligible but they help in making unexpected
-- `inc_ref_cold`s more visible
let parserState := Runtime.markPersistent parserState
let cmdState := Runtime.markPersistent cmdState
let ctx := Runtime.markPersistent ctx
parseCmd none parserState cmdState prom (sync := true) ctx
return {
diagnostics
@@ -473,11 +485,12 @@ where
prom.resolve <| { old with nextCmdSnap? := some { range? := none, task := newProm.result } }
else prom.resolve old -- terminal command, we're done!
-- fast path, do not even start new task for this snapshot
-- fast path, do not even start new task for this snapshot (see [Incremental Parsing])
if let some old := old? then
if let some nextCom old.nextCmdSnap?.bindM (·.get?) then
if ( isBeforeEditPos nextCom.parserState.pos) then
return ( unchanged old old.parserState)
if let some nextNextCom nextCom.nextCmdSnap?.bindM (·.get?) then
if ( isBeforeEditPos nextNextCom.parserState.pos) then
return ( unchanged old old.parserState)
let beginPos := parserState.pos
let scope := cmdState.scopes.head!
@@ -626,22 +639,21 @@ where
pos := ctx.fileMap.toPosition beginPos
data := output
}
let cmdState := { cmdState with messages }
let cmdState : Command.State := { cmdState with messages }
let mut reportedCmdState := cmdState
-- definitely resolve eventually
snap.new.resolve <| .ofTyped { diagnostics := .empty : SnapshotLeaf }
let mut infoTree := cmdState.infoState.trees[0]!
let infoTree : InfoTree := cmdState.infoState.trees[0]!
let cmdline := internal.cmdlineSnapshots.get scope.opts && !Parser.isTerminalCommand stx
if cmdline then
infoTree := Runtime.markPersistent infoTree
-- discard all metadata apart from the environment; see `internal.cmdlineSnapshots`
reportedCmdState := { env := reportedCmdState.env, maxRecDepth := 0 }
finishedPromise.resolve {
diagnostics := ( Snapshot.Diagnostics.ofMessageLog cmdState.messages)
infoTree? := infoTree
traces := cmdState.traceState
cmdState := if cmdline then {
env := Runtime.markPersistent cmdState.env
maxRecDepth := 0
} else cmdState
cmdState := reportedCmdState
}
-- The reported `cmdState` in the snapshot may be minimized as seen above, so we return the full
-- state here for further processing on the same thread

View File

@@ -31,6 +31,10 @@ builtin_initialize deprecatedAttr : ParametricAttribute DeprecationEntry ←
let newName? id?.mapM Elab.realizeGlobalConstNoOverloadWithInfo
let text? := text?.map TSyntax.getString
let since? := since?.map TSyntax.getString
if id?.isNone && text?.isNone then
logWarning "`[deprecated]` attribute should specify either a new name or a deprecation message"
if since?.isNone then
logWarning "`[deprecated]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := \"...\")`"
return { newName?, text?, since? }
}
@@ -46,7 +50,9 @@ def getDeprecatedNewName (env : Environment) (declName : Name) : Option Name :=
def checkDeprecated [Monad m] [MonadEnv m] [MonadLog m] [AddMessageContext m] [MonadOptions m] (declName : Name) : m Unit := do
if getLinterValue linter.deprecated ( getOptions) then
let some attr := deprecatedAttr.getParam? ( getEnv) declName | pure ()
logWarning <| .tagged ``deprecatedAttr <| attr.text?.getD <|
match attr.newName? with
| none => s!"`{declName}` has been deprecated"
| some newName => s!"`{declName}` has been deprecated, use `{newName}` instead"
logWarning <| .tagged ``deprecatedAttr <|
s!"`{declName}` has been deprecated" ++ match attr.text? with
| some text => s!": {text}"
| none => match attr.newName? with
| some newName => s!": use `{newName}` instead"
| none => ""

View File

@@ -248,7 +248,7 @@ builtin_initialize addBuiltinUnusedVariablesIgnoreFn (fun _ stack opts =>
!getLinterUnusedVariablesFunArgs opts &&
stack.matches [`null, none, `null, ``Lean.Parser.Term.letIdDecl, none] &&
(stack.get? 3 |>.any fun (_, pos) => pos == 1) &&
(stack.get? 5 |>.any fun (stx, _) => !stx.isOfKind ``Lean.Parser.Command.whereStructField))
(stack.get? 5 |>.any fun (stx, _) => !stx.isOfKind ``Lean.Parser.Term.structInstField))
/--
Function argument in declaration signature (when `linter.unusedVariables.funArgs` is false)

View File

@@ -5,14 +5,40 @@ Authors: Mac Malone
-/
prelude
import Init.System.IO
namespace Lean
/--
Dynamically loads a shared library so that its symbols can be used by
the Lean interpreter (e.g., for interpreting `@[extern]` declarations).
Equivalent to passing `--load-dynlib=lib` to `lean`.
Equivalent to passing `--load-dynlib=path` to `lean`.
Note that Lean never unloads libraries.
**Lean never unloads libraries.** Attempting to load a library that defines
symbols shared with a previously loaded library (including itself) will error.
If multiple libraries share common symbols, those symbols should be linked
and loaded as separate libraries.
-/
@[extern "lean_load_dynlib"]
opaque loadDynlib (path : @& System.FilePath) : IO Unit
/--
Loads a Lean plugin and runs its initializers.
A Lean plugin is a shared library built from a Lean module.
This means it has an `initialize_<module-name>` symbol that runs the
module's initializers (including its imports' initializers). Initializers
are declared with the `initialize` or `builtin_initialize` commands.
This is similar to passing `--plugin=path` to `lean`.
Lean environment initializers, such as definitions calling
`registerEnvExtension`, also require `Lean.initializing` to be `true`.
To enable them, use `loadPlugin` within a `withImporting` block. This will
set `Lean.initializing` (but not `IO.initializing`).
**Lean never unloads plugins.** Attempting to load a plugin that defines
symbols shared with a previously loaded plugin (including itself) will error.
If multiple plugins share common symbols (e.g., imports), those symbols
should be linked and loaded separately.
-/
@[extern "lean_load_plugin"]
opaque loadPlugin (path : @& System.FilePath) : IO Unit

View File

@@ -229,7 +229,7 @@ structure ParamInfo where
hasFwdDeps : Bool := false
/-- `backDeps` contains the backwards dependencies. That is, the (0-indexed) position of previous parameters that this one depends on. -/
backDeps : Array Nat := #[]
/-- `isProp` is true if the parameter is always a proposition. -/
/-- `isProp` is true if the parameter type is always a proposition. -/
isProp : Bool := false
/--
`isDecInst` is true if the parameter's type is of the form `Decidable ...`.

View File

@@ -68,7 +68,7 @@ def getFinValue? (e : Expr) : MetaM (Option ((n : Nat) × Fin n)) := OptionT.run
let n getNatValue? ( whnfD type.appArg!)
match n with
| 0 => failure
| m+1 => return m+1, Fin.ofNat v
| m+1 => return m+1, Fin.ofNat' _ v
/--
Return `some ⟨n, v⟩` if `e` is:

View File

@@ -84,8 +84,22 @@ declare_uint_simprocs UInt8
declare_uint_simprocs UInt16
declare_uint_simprocs UInt32
declare_uint_simprocs UInt64
/-
We disabled the simprocs for USize since the result of most operations depend on an opaque value: `System.Platform.numBits`.
We could reduce some cases using the fact that this opaque value is `32` or `64`, but it is unclear whether it would be useful in practice.
We do not use the normal simprocs for `USize` since the result of most operations depend on an opaque value: `System.Platform.numBits`.
However, we do reduce natural literals using the fact this opaque value is at least `32`.
-/
-- declare_uint_simprocs USize
namespace USize
def fromExpr (e : Expr) : SimpM (Option USize) := do
let some (n, _) getOfNatValue? e ``USize | return none
return USize.ofNat n
builtin_simproc [simp, seval] reduceToNat (USize.toNat _) := fun e => do
let_expr USize.toNat e e | return .continue
let some (n, _) getOfNatValue? e ``USize | return .continue
unless n < UInt32.size do return .continue
let e := toExpr n
let p mkDecideProof ( mkLT e (mkNatLit UInt32.size))
let p := mkApp2 (mkConst ``USize.toNat_ofNat_of_lt_32) e p
return .done { expr := e, proof? := p }

View File

@@ -571,10 +571,127 @@ def congr (e : Expr) : SimpM Result := do
else
congrDefault e
/--
Returns `true` if `e` is of the form `@letFun _ (fun _ => β) _ _`
`β` must not contain loose bound variables. Recall that `simp` does not have support for `let_fun`s
where resulting type depends on the `let`-value. Example:
```
let_fun n := 10;
BitVec.zero n
```
-/
def isNonDepLetFun (e : Expr) : Bool :=
let_expr letFun _ beta _ body := e | false
beta.isLambda && !beta.bindingBody!.hasLooseBVars && body.isLambda
/--
Auxiliary structure used to represent the return value of `simpNonDepLetFun.go`.
-/
private structure SimpLetFunResult where
/--
The simplified expression. Note that is may contain loose bound variables.
`simpNonDepLetFun.go` attempts to minimize the quadratic overhead imposed
by the locally nameless discipline in a sequence of `let_fun` declarations.
-/
expr : Expr
/--
The proof that the simplified expression is equal to the input one.
It may containt loose bound variables. See `expr` field.
-/
proof : Expr
/--
`modified := false` iff `expr` is structurally equal to the input expression.
-/
modified : Bool
/--
Simplifies a sequence of `let_fun` declarations.
It attempts to minimize the quadratic overhead imposed by
the locally nameless discipline.
-/
partial def simpNonDepLetFun (e : Expr) : SimpM Result := do
let rec go (xs : Array Expr) (e : Expr) : SimpM SimpLetFunResult := do
/-
Helper function applied when `e` is not a `let_fun` or
is a non supported `let_fun` (e.g., the resulting type depends on the value).
-/
let stop : SimpM SimpLetFunResult := do
let e := e.instantiateRev xs
let r simp e
return { expr := r.expr.abstract xs, proof := ( r.getProof).abstract xs, modified := r.expr != e }
let_expr f@letFun alpha betaFun val body := e | stop
let us := f.constLevels!
let [_, v] := us | stop
/-
Recall that `let_fun x : α := val; e[x]` is encoded at
```
@letFun α (fun x : α => β[x]) val (fun x : α => e[x])
```
`betaFun` is `(fun x : α => β[x])`. If `β[x]` does not have loose bound variables then the resulting type
does not depend on the value since it does not depend on `x`.
We also check whether `alpha` does not depend on the previous `let_fun`s in the sequence.
This check is just to make the code simpler. It is not common to have a type depending on the value of a previous `let_fun`.
-/
if alpha.hasLooseBVars || !betaFun.isLambda || !body.isLambda || betaFun.bindingBody!.hasLooseBVars then
stop
else if !body.bindingBody!.hasLooseBVar 0 then
/-
Redundant `let_fun`. The simplifier will remove it.
Remark: the `hasLooseBVar` check here may introduce a quadratic overhead in the worst case.
If observe that in practice, we may use a separate step for removing unused variables.
Remark: note that we do **not** simplify the value in this case.
-/
let x := mkConst `__no_used_dummy__ -- dummy value
let { expr, proof, .. } go (xs.push x) body.bindingBody!
let proof := mkApp6 (mkConst ``letFun_unused us) alpha betaFun.bindingBody! val body.bindingBody! expr proof
return { expr, proof, modified := true }
else
let beta := betaFun.bindingBody!
let valInst := val.instantiateRev xs
let valResult simp valInst
withLocalDecl body.bindingName! body.bindingInfo! alpha fun x => do
let valIsNew := valResult.expr != valInst
let { expr, proof, modified := bodyIsNew } go (xs.push x) body.bindingBody!
if !valIsNew && !bodyIsNew then
/-
Value and body were not simplified. We just return `e` and a new refl proof.
We must use the low-level `Expr` APIs because `e` may contain loose bound variables.
-/
let proof := mkApp2 (mkConst ``Eq.refl [v]) beta e
return { expr := e, proof, modified := false }
else
let body' := mkLambda body.bindingName! body.bindingInfo! alpha expr
let val' := valResult.expr.abstract xs
let e' := mkApp4 f alpha betaFun val' body'
if valIsNew && bodyIsNew then
-- Value and body were simplified
let valProof := ( valResult.getProof).abstract xs
let proof := mkApp8 (mkConst ``letFun_congr us) alpha beta val val' body body' valProof (mkLambda body.bindingName! body.bindingInfo! alpha proof)
return { expr := e', proof, modified := true }
else if valIsNew then
-- Only the value was simplified.
let valProof := ( valResult.getProof).abstract xs
let proof := mkApp6 (mkConst ``letFun_val_congr us) alpha beta val val' body valProof
return { expr := e', proof, modified := true }
else
-- Only the body was simplified.
let proof := mkApp6 (mkConst ``letFun_body_congr us) alpha beta val body body' (mkLambda body.bindingName! body.bindingInfo! alpha proof)
return { expr := e', proof, modified := true }
let { expr, proof, modified } go #[] e
if !modified then
return { expr := e }
else
return { expr, proof? := proof }
def simpApp (e : Expr) : SimpM Result := do
if isOfNatNatLit e || isOfScientificLit e || isCharLit e then
-- Recall that we fold "orphan" kernel Nat literals `n` into `OfNat.ofNat n`
return { expr := e }
else if isNonDepLetFun e then
simpNonDepLetFun e
else
congr e

View File

@@ -108,13 +108,19 @@ where
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to synthesize instance{indentExpr type}"
return false
private def useImplicitDefEqProof (thm : SimpTheorem) : SimpM Bool := do
if thm.rfl then
return ( getConfig).implicitDefEqProofs
else
return false
private def tryTheoremCore (lhs : Expr) (xs : Array Expr) (bis : Array BinderInfo) (val : Expr) (type : Expr) (e : Expr) (thm : SimpTheorem) (numExtraArgs : Nat) : SimpM (Option Result) := do
recordTriedSimpTheorem thm.origin
let rec go (e : Expr) : SimpM (Option Result) := do
if ( isDefEq lhs e) then
unless ( synthesizeArgs thm.origin bis xs) do
return none
let proof? if thm.rfl then
let proof? if ( useImplicitDefEqProof thm) then
pure none
else
let proof instantiateMVars (mkAppN val xs)

View File

@@ -269,7 +269,7 @@ def mkDiscrGenErrorMsg (e : Expr) : MessageData :=
def throwDiscrGenError (e : Expr) : MetaM α :=
throwError (mkDiscrGenErrorMsg e)
def splitMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := do
def splitMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := mvarId.withContext do
let some app matchMatcherApp? e | throwError "internal error in `split` tactic: match application expected{indentExpr e}\nthis error typically occurs when the `split` tactic internal functions have been used in a new meta-program"
let matchEqns Match.getEquationsFor app.matcherName
let mvarIds applyMatchSplitter mvarId app.matcherName app.matcherLevels app.params app.discrs
@@ -278,43 +278,14 @@ def splitMatch (mvarId : MVarId) (e : Expr) : MetaM (List MVarId) := do
return (i+1, mvarId::mvarIds)
return mvarIds.reverse
/-- Return an `if-then-else` or `match-expr` to split. -/
partial def findSplit? (env : Environment) (e : Expr) (splitIte := true) (exceptionSet : ExprSet := {}) : Option Expr :=
go e
where
go (e : Expr) : Option Expr :=
if let some target := e.find? isCandidate then
if e.isIte || e.isDIte then
let cond := target.getArg! 1 5
-- Try to find a nested `if` in `cond`
go cond |>.getD target
else
some target
else
none
isCandidate (e : Expr) : Bool := Id.run do
if exceptionSet.contains e then
false
else if splitIte && (e.isIte || e.isDIte) then
!(e.getArg! 1 5).hasLooseBVars
else if let some info := isMatcherAppCore? env e then
let args := e.getAppArgs
for i in [info.getFirstDiscrPos : info.getFirstDiscrPos + info.numDiscrs] do
if args[i]!.hasLooseBVars then
return false
return true
else
false
end Split
open Split
partial def splitTarget? (mvarId : MVarId) (splitIte := true) : MetaM (Option (List MVarId)) := commitWhenSome? do
partial def splitTarget? (mvarId : MVarId) (splitIte := true) : MetaM (Option (List MVarId)) := commitWhenSome? do mvarId.withContext do
let target instantiateMVars ( mvarId.getType)
let rec go (badCases : ExprSet) : MetaM (Option (List MVarId)) := do
if let some e := findSplit? ( getEnv) target splitIte badCases then
if let some e findSplit? target (if splitIte then .both else .match) badCases then
if e.isIte || e.isDIte then
return ( splitIfTarget? mvarId).map fun (s₁, s₂) => [s₁.mvarId, s₂.mvarId]
else
@@ -333,7 +304,7 @@ partial def splitTarget? (mvarId : MVarId) (splitIte := true) : MetaM (Option (L
def splitLocalDecl? (mvarId : MVarId) (fvarId : FVarId) : MetaM (Option (List MVarId)) := commitWhenSome? do
mvarId.withContext do
if let some e := findSplit? ( getEnv) ( instantiateMVars ( inferType (mkFVar fvarId))) then
if let some e findSplit? ( instantiateMVars ( inferType (mkFVar fvarId))) then
if e.isIte || e.isDIte then
return ( splitIfLocalDecl? mvarId fvarId).map fun (mvarId₁, mvarId₂) => [mvarId₁, mvarId₂]
else

View File

@@ -8,6 +8,124 @@ import Lean.Meta.Tactic.Cases
import Lean.Meta.Tactic.Simp.Main
namespace Lean.Meta
inductive SplitKind where
| ite | match | both
def SplitKind.considerIte : SplitKind Bool
| .ite | .both => true
| _ => false
def SplitKind.considerMatch : SplitKind Bool
| .match | .both => true
| _ => false
namespace FindSplitImpl
structure Context where
exceptionSet : ExprSet := {}
kind : SplitKind := .both
unsafe abbrev FindM := ReaderT Context $ StateT (PtrSet Expr) MetaM
/--
Checks whether `e` is a candidate for `split`.
Returns `some e'` if a prefix is a candidate.
Example: suppose `e` is `(if b then f else g) x`, then
the result is `some e'` where `e'` is the subterm `(if b then f else g)`
-/
private def isCandidate? (env : Environment) (ctx : Context) (e : Expr) : Option Expr := Id.run do
let ret (e : Expr) : Option Expr :=
if ctx.exceptionSet.contains e then none else some e
if ctx.kind.considerIte then
if e.isAppOf ``ite || e.isAppOf ``dite then
let numArgs := e.getAppNumArgs
if numArgs >= 5 && !(e.getArg! 1 5).hasLooseBVars then
return ret (e.getBoundedAppFn (numArgs - 5))
if ctx.kind.considerMatch then
if let some info := isMatcherAppCore? env e then
let args := e.getAppArgs
for i in [info.getFirstDiscrPos : info.getFirstDiscrPos + info.numDiscrs] do
if args[i]!.hasLooseBVars then
return none
return ret (e.getBoundedAppFn (args.size - info.arity))
return none
@[inline] unsafe def checkVisited (e : Expr) : OptionT FindM Unit := do
if ( get).contains e then
failure
modify fun s => s.insert e
unsafe def visit (e : Expr) : OptionT FindM Expr := do
checkVisited e
if let some e := isCandidate? ( getEnv) ( read) e then
return e
else
-- We do not look for split candidates in proofs.
unless e.hasLooseBVars do
if ( isProof e) then
failure
match e with
| .lam _ _ b _ | .proj _ _ b -- We do not look for split candidates in the binder of lambdas.
| .mdata _ b => visit b
| .forallE _ d b _ => visit d <|> visit b -- We want to look for candidates at `A → B`
| .letE _ _ v b _ => visit v <|> visit b
| .app .. => visitApp? e
| _ => failure
where
visitApp? (e : Expr) : FindM (Option Expr) :=
e.withApp fun f args => do
-- See comment at `Canonicalizer.lean` regarding the case where
-- `f` has loose bound variables.
let info if f.hasLooseBVars then
pure {}
else
getFunInfo f
for u : i in [0:args.size] do
let arg := args[i]
if h : i < info.paramInfo.size then
let info := info.paramInfo[i]
unless info.isProp do
if info.isExplicit then
let some found visit arg | pure ()
return found
else
let some found visit arg | pure ()
return found
visit f
end FindSplitImpl
/-- Return an `if-then-else` or `match-expr` to split. -/
partial def findSplit? (e : Expr) (kind : SplitKind := .both) (exceptionSet : ExprSet := {}) : MetaM (Option Expr) := do
go ( instantiateMVars e)
where
go (e : Expr) : MetaM (Option Expr) := do
if let some target find? e then
if target.isIte || target.isDIte then
let cond := target.getArg! 1 5
-- Try to find a nested `if` in `cond`
return ( go cond).getD target
else
return some target
else
return none
find? (e : Expr) : MetaM (Option Expr) := do
let some candidate unsafe FindSplitImpl.visit e { kind, exceptionSet } |>.run' mkPtrSet
| return none
trace[split.debug] "candidate:{indentExpr candidate}"
return some candidate
/-- Return the condition and decidable instance of an `if` expression to case split. -/
private partial def findIfToSplit? (e : Expr) : MetaM (Option (Expr × Expr)) := do
if let some iteApp findSplit? e .ite then
let cond := iteApp.getArg! 1 5
let dec := iteApp.getArg! 2 5
return (cond, dec)
else
return none
namespace SplitIf
/--
@@ -62,19 +180,9 @@ private def discharge? (numIndices : Nat) (useDecide : Bool) : Simp.Discharge :=
def mkDischarge? (useDecide := false) : MetaM Simp.Discharge :=
return discharge? ( getLCtx).numIndices useDecide
/-- Return the condition and decidable instance of an `if` expression to case split. -/
private partial def findIfToSplit? (e : Expr) : Option (Expr × Expr) :=
if let some iteApp := e.find? fun e => (e.isIte || e.isDIte) && !(e.getArg! 1 5).hasLooseBVars then
let cond := iteApp.getArg! 1 5
let dec := iteApp.getArg! 2 5
-- Try to find a nested `if` in `cond`
findIfToSplit? cond |>.getD (cond, dec)
else
none
def splitIfAt? (mvarId : MVarId) (e : Expr) (hName? : Option Name) : MetaM (Option (ByCasesSubgoal × ByCasesSubgoal)) := do
def splitIfAt? (mvarId : MVarId) (e : Expr) (hName? : Option Name) : MetaM (Option (ByCasesSubgoal × ByCasesSubgoal)) := mvarId.withContext do
let e instantiateMVars e
if let some (cond, decInst) := findIfToSplit? e then
if let some (cond, decInst) findIfToSplit? e then
let hName match hName? with
| none => mkFreshUserName `h
| some hName => pure hName
@@ -106,6 +214,7 @@ def splitIfTarget? (mvarId : MVarId) (hName? : Option Name := none) : MetaM (Opt
let mvarId₁ simpIfTarget s₁.mvarId
let mvarId₂ simpIfTarget s₂.mvarId
if s₁.mvarId == mvarId₁ && s₂.mvarId == mvarId₂ then
trace[split.failure] "`split` tactic failed to simplify target using new hypotheses Goals:\n{mvarId₁}\n{mvarId₂}"
return none
else
return some ({ s₁ with mvarId := mvarId₁ }, { s₂ with mvarId := mvarId₂ })
@@ -118,6 +227,7 @@ def splitIfLocalDecl? (mvarId : MVarId) (fvarId : FVarId) (hName? : Option Name
let mvarId₁ simpIfLocalDecl s₁.mvarId fvarId
let mvarId₂ simpIfLocalDecl s₂.mvarId fvarId
if s₁.mvarId == mvarId₁ && s₂.mvarId == mvarId₂ then
trace[split.failure] "`split` tactic failed to simplify target using new hypotheses Goals:\n{mvarId₁}\n{mvarId₂}"
return none
else
return some (mvarId₁, mvarId₂)

View File

@@ -134,10 +134,8 @@ def declValSimple := leading_parser
" :=" >> ppHardLineUnlessUngrouped >> declBody >> Termination.suffix >> optional Term.whereDecls
def declValEqns := leading_parser
Term.matchAltsWhereDecls
def whereStructField := leading_parser
Term.letDecl
def whereStructInst := leading_parser
ppIndent ppSpace >> "where" >> Term.structInstFields (sepByIndent (ppGroup whereStructField) "; " (allowTrailingSep := true)) >>
ppIndent ppSpace >> "where" >> Term.structInstFields (sepByIndent Term.structInstField "; " (allowTrailingSep := true)) >>
optional Term.whereDecls
/-- `declVal` matches the right-hand side of a declaration, one of:
* `:= expr` (a "simple declaration")

View File

@@ -269,38 +269,6 @@ an optional `x :`, then a term `ty`, then `from val` or `by tac`. -/
@[builtin_term_parser] def «suffices» := leading_parser:leadPrec
withPosition ("suffices " >> sufficesDecl) >> optSemicolon termParser
@[builtin_term_parser] def «show» := leading_parser:leadPrec "show " >> termParser >> ppSpace >> showRhs
def structInstArrayRef := leading_parser
"[" >> withoutPosition termParser >> "]"
def structInstLVal := leading_parser
(ident <|> fieldIdx <|> structInstArrayRef) >>
many (group ("." >> (ident <|> fieldIdx)) <|> structInstArrayRef)
def structInstField := ppGroup $ leading_parser
structInstLVal >> " := " >> termParser
def structInstFieldAbbrev := leading_parser
-- `x` is an abbreviation for `x := x`
atomic (ident >> notFollowedBy ("." <|> ":=" <|> symbol "[") "invalid field abbreviation")
def optEllipsis := leading_parser
optional " .."
/-
Tags the structure instance field syntax with a `Lean.Parser.Term.structInstFields` syntax node.
This node is used to enable structure instance field completion in the whitespace
of a structure instance notation.
-/
def structInstFields (p : Parser) : Parser := node `Lean.Parser.Term.structInstFields p
/--
Structure instance. `{ x := e, ... }` assigns `e` to field `x`, which may be
inherited. If `e` is itself a variable called `x`, it can be elided:
`fun y => { x := 1, y }`.
A *structure update* of an existing value can be given via `with`:
`{ point with x := 1 }`.
The structure type can be specified if not inferable:
`{ x := 1, y := 2 : Point }`.
-/
@[builtin_term_parser] def structInst := leading_parser
"{ " >> withoutPosition (optional (atomic (sepBy1 termParser ", " >> " with "))
>> structInstFields (sepByIndent (structInstFieldAbbrev <|> structInstField) ", " (allowTrailingSep := true))
>> optEllipsis
>> optional (" : " >> termParser)) >> " }"
def typeSpec := leading_parser " : " >> termParser
def optType : Parser := optional typeSpec
/--
@@ -488,6 +456,56 @@ e.g. because it has no constructors.
@[builtin_term_parser] def «nofun» := leading_parser "nofun"
/-
Syntax category for structure instance notation fields.
Does not initialize `registerBuiltinDynamicParserAttribute` since this category is not meant to be user-extensible.
-/
builtin_initialize
registerBuiltinParserAttribute `builtin_structInstFieldDecl_parser ``Category.structInstFieldDecl
@[inline] def structInstFieldDeclParser (rbp : Nat := 0) : Parser :=
categoryParser `structInstFieldDecl rbp
def optEllipsis := leading_parser
optional " .."
def structInstArrayRef := leading_parser
"[" >> withoutPosition termParser >> "]"
def structInstLVal := leading_parser
(ident <|> fieldIdx <|> structInstArrayRef) >>
many (group ("." >> (ident <|> fieldIdx)) <|> structInstArrayRef)
def structInstFieldBinder :=
withAntiquot (mkAntiquot "structInstFieldBinder" decl_name% (isPseudoKind := true)) <|
binderIdent <|> bracketedBinder
def optTypeForStructInst : Parser := optional (atomic (typeSpec >> notFollowedBy "}" "}"))
/- `x` is an abbreviation for `x := x` -/
def structInstField := ppGroup <| leading_parser
structInstLVal >> optional (many (checkColGt >> structInstFieldBinder) >> optTypeForStructInst >> ppDedent structInstFieldDeclParser)
/-
Tags the structure instance field syntax with a `Lean.Parser.Term.structInstFields` syntax node.
This node is used to enable structure instance field completion in the whitespace
of a structure instance notation.
-/
def structInstFields (p : Parser) : Parser := node `Lean.Parser.Term.structInstFields p
/--
Structure instance. `{ x := e, ... }` assigns `e` to field `x`, which may be
inherited. If `e` is itself a variable called `x`, it can be elided:
`fun y => { x := 1, y }`.
A *structure update* of an existing value can be given via `with`:
`{ point with x := 1 }`.
The structure type can be specified if not inferable:
`{ x := 1, y := 2 : Point }`.
-/
@[builtin_term_parser] def structInst := leading_parser
"{ " >> withoutPosition (optional (atomic (sepBy1 termParser ", " >> " with "))
>> structInstFields (sepByIndent structInstField ", " (allowTrailingSep := true))
>> optEllipsis
>> optional (" : " >> termParser)) >> " }"
@[builtin_structInstFieldDecl_parser]
def structInstFieldDef := leading_parser
" := " >> termParser
@[builtin_structInstFieldDecl_parser]
def structInstFieldEqns := leading_parser
matchAlts
def funImplicitBinder := withAntiquot (mkAntiquot "implicitBinder" ``implicitBinder) <|
atomic (lookahead ("{" >> many1 binderIdent >> (symbol " : " <|> "}"))) >> implicitBinder
def funStrictImplicitBinder :=

View File

@@ -811,33 +811,35 @@ section NotificationHandling
terminateFileWorker p.textDocument.uri
def handleDidChangeWatchedFiles (p : DidChangeWatchedFilesParams) : ServerM Unit := do
let importData ( read).importData.get
let references := ( read).references
let oleanSearchPath Lean.searchPathRef.get
let ileans oleanSearchPath.findAllWithExt "ilean"
for change in p.changes do
let some path := fileUriToPath? change.uri
| continue
match path.extension with
| "lean" =>
let dependents := importData.importedBy.findD change.uri
let changes := p.changes.filterMap fun c => do return (c, fileUriToPath? c.uri)
let leanChanges := changes.filter fun (_, path) => path.extension == "lean"
let ileanChanges := changes.filter fun (_, path) => path.extension == "ilean"
if ! leanChanges.isEmpty then
let importData ( read).importData.get
for (c, _) in leanChanges do
let dependents := importData.importedBy.findD c.uri
for dependent in dependents do
notifyAboutStaleDependency dependent change.uri
| "ilean" =>
if let FileChangeType.Deleted := change.type then
notifyAboutStaleDependency dependent c.uri
if ! ileanChanges.isEmpty then
let references := ( read).references
let oleanSearchPath Lean.searchPathRef.get
for (c, path) in ileanChanges do
if let FileChangeType.Deleted := c.type then
references.modify (fun r => r.removeIlean path)
else if ileans.contains path then
try
let ilean Ilean.load path
if let FileChangeType.Changed := change.type then
references.modify (fun r => r.removeIlean path |>.addIlean path ilean)
else
references.modify (fun r => r.addIlean path ilean)
catch
-- ilean vanished, ignore error
| .noFileOrDirectory .. => references.modify (·.removeIlean path)
| e => throw e
| _ => continue
continue
let isIleanInSearchPath := ( searchModuleNameOfFileName path oleanSearchPath).isSome
if ! isIleanInSearchPath then
continue
try
let ilean Ilean.load path
if let FileChangeType.Changed := c.type then
references.modify (fun r => r.removeIlean path |>.addIlean path ilean)
else
references.modify (fun r => r.addIlean path ilean)
catch
-- ilean vanished, ignore error
| .noFileOrDirectory .. => references.modify (·.removeIlean path)
| e => throw e
def handleCancelRequest (p : CancelParams) : ServerM Unit := do
let fileWorkers (read).fileWorkersRef.get

View File

@@ -260,7 +260,7 @@ def withTraceNode [always : MonadAlwaysExcept ε m] [MonadLiftT BaseIO m] (cls :
let ref getRef
let mut m try msg res catch _ => pure m!"<exception thrown while producing trace node message>"
let mut data := { cls, collapsed, tag }
if profiler.get opts || aboveThresh then
if trace.profiler.get opts then
data := { data with startTime := start, stopTime := stop }
addTraceNode oldTraces data ref m
MonadExcept.ofExcept res
@@ -356,7 +356,7 @@ def withTraceNodeBefore [MonadRef m] [AddMessageContext m] [MonadOptions m]
return ( MonadExcept.ofExcept res)
let mut msg := m!"{ExceptToEmoji.toEmoji res} {msg}"
let mut data := { cls, collapsed, tag }
if profiler.get opts || aboveThresh then
if trace.profiler.get opts then
data := { data with startTime := start, stopTime := stop }
addTraceNode oldTraces data ref msg
MonadExcept.ofExcept res

View File

@@ -291,11 +291,11 @@ but will later become a primitive operation.
(Raw₀.Const.insertMany m.1, m.2.size_buckets_pos l).1,
(Raw₀.Const.insertMany m.1, m.2.size_buckets_pos l).2 _ Raw.WF.insert₀ m.2
@[inline, inherit_doc Raw.Const.insertManyUnit] def Const.insertManyUnit
@[inline, inherit_doc Raw.Const.insertManyIfNewUnit] def Const.insertManyIfNewUnit
{ρ : Type w} [ForIn Id ρ α] (m : DHashMap α (fun _ => Unit)) (l : ρ) :
DHashMap α (fun _ => Unit) :=
(Raw₀.Const.insertManyUnit m.1, m.2.size_buckets_pos l).1,
(Raw₀.Const.insertManyUnit m.1, m.2.size_buckets_pos l).2 _ Raw.WF.insert₀ m.2
(Raw₀.Const.insertManyIfNewUnit m.1, m.2.size_buckets_pos l).1,
(Raw₀.Const.insertManyIfNewUnit m.1, m.2.size_buckets_pos l).2 _ Raw.WF.insertIfNew m.2
@[inline, inherit_doc Raw.ofList] def ofList [BEq α] [Hashable α] (l : List ((a : α) × β a)) :
DHashMap α β :=
@@ -313,11 +313,11 @@ instance [BEq α] [Hashable α] : Union (DHashMap α β) := ⟨union⟩
@[inline, inherit_doc Raw.Const.unitOfList] def Const.unitOfList [BEq α] [Hashable α] (l : List α) :
DHashMap α (fun _ => Unit) :=
Const.insertManyUnit l
Const.insertManyIfNewUnit l
@[inline, inherit_doc Raw.Const.unitOfArray] def Const.unitOfArray [BEq α] [Hashable α] (l : Array α) :
DHashMap α (fun _ => Unit) :=
Const.insertManyUnit l
Const.insertManyIfNewUnit l
@[inherit_doc Raw.Internal.numBuckets] def Internal.numBuckets
(m : DHashMap α β) : Nat :=

View File

@@ -407,14 +407,14 @@ variable {β : Type v}
return r
/-- Internal implementation detail of the hash map -/
@[inline] def Const.insertManyUnit {ρ : Type w} [ForIn Id ρ α] [BEq α] [Hashable α]
@[inline] def Const.insertManyIfNewUnit {ρ : Type w} [ForIn Id ρ α] [BEq α] [Hashable α]
(m : Raw₀ α (fun _ => Unit)) (l : ρ) :
{ m' : Raw₀ α (fun _ => Unit) // (P : Raw₀ α (fun _ => Unit) Prop),
( {m'' a b}, P m'' P (m''.insert a b)) P m P m' } := Id.run do
( {m'' a b}, P m'' P (m''.insertIfNew a b)) P m P m' } := Id.run do
let mut r : { m' : Raw₀ α (fun _ => Unit) // (P : Raw₀ α (fun _ => Unit) Prop),
( {m'' a b}, P m'' P (m''.insert a b)) P m P m' } := m, fun _ _ => id
( {m'' a b}, P m'' P (m''.insertIfNew a b)) P m P m' } := m, fun _ _ => id
for a in l do
r := r.1.insert a (), fun _ h hm => h (r.2 _ h hm)
r := r.1.insertIfNew a (), fun _ h hm => h (r.2 _ h hm)
return r
end

View File

@@ -738,9 +738,9 @@ theorem Const.wfImp_insertMany {β : Type v} [BEq α] [Hashable α] [EquivBEq α
{l : ρ} (h : Raw.WFImp m.1) : Raw.WFImp (Const.insertMany m l).1.1 :=
Raw.WF.out ((Const.insertMany m l).2 _ Raw.WF.insert₀ (.wf m.2 h))
theorem Const.wfImp_insertManyUnit [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] {ρ : Type w}
theorem Const.wfImp_insertManyIfNewUnit [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] {ρ : Type w}
[ForIn Id ρ α] {m : Raw₀ α (fun _ => Unit)} {l : ρ} (h : Raw.WFImp m.1) :
Raw.WFImp (Const.insertManyUnit m l).1.1 :=
Raw.WF.out ((Const.insertManyUnit m l).2 _ Raw.WF.insert₀ (.wf m.2 h))
Raw.WFImp (Const.insertManyIfNewUnit m l).1.1 :=
Raw.WF.out ((Const.insertManyIfNewUnit m l).2 _ Raw.WF.insertIfNew (.wf m.2 h))
end Raw₀

View File

@@ -58,7 +58,12 @@ instance : Inhabited (Raw α β) where
default :=
/--
Inserts the given mapping into the map, replacing an existing mapping for the key if there is one.
Inserts the given mapping into the map. If there is already a mapping for the given key, then both
key and value will be replaced.
Note: this replacement behavior is true for `HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw`.
The `insert` function on `HashSet` and `HashSet.Raw` behaves differently: it will return the set
unchanged if a matching key is already present.
-/
@[inline] def insert [BEq α] [Hashable α] (m : Raw α β) (a : α) (b : β a) : Raw α β :=
if h : 0 < m.buckets.size then
@@ -373,6 +378,10 @@ instance : ForIn m (Raw α β) ((a : α) × β a) where
/--
Inserts multiple mappings into the hash map by iterating over the given collection and calling
`insert`. If the same key appears multiple times, the last occurrence takes precedence.
Note: this precedence behavior is true for `HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw`.
The `insertMany` function on `HashSet` and `HashSet.Raw` behaves differently: it will prefer the first
appearance.
-/
@[inline] def insertMany [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ ((a : α) × β a)]
(m : Raw α β) (l : ρ) : Raw α β :=
@@ -388,15 +397,16 @@ Inserts multiple mappings into the hash map by iterating over the given collecti
/--
Inserts multiple keys with the value `()` into the hash map by iterating over the given collection
and calling `insert`. If the same key appears multiple times, the last occurrence takes precedence.
and calling `insertIfNew`. If the same key appears multiple times, the first occurrence takes
precedence.
This is mainly useful to implement `HashSet.insertMany`, so if you are considering using this,
`HashSet` or `HashSet.Raw` might be a better fit for you.
-/
@[inline] def Const.insertManyUnit [BEq α] [Hashable α] {ρ : Type w}
@[inline] def Const.insertManyIfNewUnit [BEq α] [Hashable α] {ρ : Type w}
[ForIn Id ρ α] (m : Raw α (fun _ => Unit)) (l : ρ) : Raw α (fun _ => Unit) :=
if h : 0 < m.buckets.size then
(Raw₀.Const.insertManyUnit m, h l).1
(Raw₀.Const.insertManyIfNewUnit m, h l).1
else m -- will never happen for well-formed inputs
/-- Creates a hash map from a list of mappings. If the same key appears multiple times, the last
@@ -420,7 +430,7 @@ This is mainly useful to implement `HashSet.ofList`, so if you are considering u
`HashSet` or `HashSet.Raw` might be a better fit for you. -/
@[inline] def Const.unitOfList [BEq α] [Hashable α] (l : List α) :
Raw α (fun _ => Unit) :=
Const.insertManyUnit l
Const.insertManyIfNewUnit l
/-- Creates a hash map from an array of keys, associating the value `()` with each key.
@@ -428,7 +438,7 @@ This is mainly useful to implement `HashSet.ofArray`, so if you are considering
`HashSet` or `HashSet.Raw` might be a better fit for you. -/
@[inline] def Const.unitOfArray [BEq α] [Hashable α] (l : Array α) :
Raw α (fun _ => Unit) :=
Const.insertManyUnit l
Const.insertManyIfNewUnit l
/--
Returns the number of buckets in the internal representation of the hash map. This function may be
@@ -547,10 +557,10 @@ theorem WF.Const.insertMany {β : Type v} [BEq α] [Hashable α] {ρ : Type w} [
simpa [Raw.Const.insertMany, h.size_buckets_pos] using
(Raw₀.Const.insertMany m, h.size_buckets_pos l).2 _ WF.insert₀ h
theorem WF.Const.insertManyUnit [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ α]
{m : Raw α (fun _ => Unit)} {l : ρ} (h : m.WF) : (Const.insertManyUnit m l).WF := by
simpa [Raw.Const.insertManyUnit, h.size_buckets_pos] using
(Raw₀.Const.insertManyUnit m, h.size_buckets_pos l).2 _ WF.insert₀ h
theorem WF.Const.insertManyIfNewUnit [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ α]
{m : Raw α (fun _ => Unit)} {l : ρ} (h : m.WF) : (Const.insertManyIfNewUnit m l).WF := by
simpa [Raw.Const.insertManyIfNewUnit, h.size_buckets_pos] using
(Raw₀.Const.insertManyIfNewUnit m, h.size_buckets_pos l).2 _ WF.insertIfNew h
theorem WF.ofList [BEq α] [Hashable α] {l : List ((a : α) × β a)} :
(ofList l : Raw α β).WF :=
@@ -562,7 +572,7 @@ theorem WF.Const.ofList {β : Type v} [BEq α] [Hashable α] {l : List (α × β
theorem WF.Const.unitOfList [BEq α] [Hashable α] {l : List α} :
(Const.unitOfList l : Raw α (fun _ => Unit)).WF :=
Const.insertManyUnit WF.empty
Const.insertManyIfNewUnit WF.empty
end WF

View File

@@ -265,9 +265,9 @@ instance [BEq α] [Hashable α] {m : Type w → Type w} : ForIn m (HashMap α β
[ForIn Id ρ (α × β)] (m : HashMap α β) (l : ρ) : HashMap α β :=
DHashMap.Const.insertMany m.inner l
@[inline, inherit_doc DHashMap.Const.insertManyUnit] def insertManyUnit
@[inline, inherit_doc DHashMap.Const.insertManyIfNewUnit] def insertManyIfNewUnit
{ρ : Type w} [ForIn Id ρ α] (m : HashMap α Unit) (l : ρ) : HashMap α Unit :=
DHashMap.Const.insertManyUnit m.inner l
DHashMap.Const.insertManyIfNewUnit m.inner l
@[inline, inherit_doc DHashMap.Const.ofList] def ofList [BEq α] [Hashable α] (l : List (α × β)) :
HashMap α β :=

View File

@@ -694,11 +694,11 @@ theorem contains_keys [EquivBEq α] [LawfulHashable α] {k : α} :
@[simp]
theorem mem_keys [LawfulBEq α] [LawfulHashable α] {k : α} :
k m.keys k m :=
k m.keys k m :=
DHashMap.mem_keys
theorem distinct_keys [EquivBEq α] [LawfulHashable α] :
m.keys.Pairwise (fun a b => (a == b) = false) :=
m.keys.Pairwise (fun a b => (a == b) = false) :=
DHashMap.distinct_keys
end

View File

@@ -229,9 +229,9 @@ m.inner.values
{ρ : Type w} [ForIn Id ρ (α × β)] (m : Raw α β) (l : ρ) : Raw α β :=
DHashMap.Raw.Const.insertMany m.inner l
@[inline, inherit_doc DHashMap.Raw.Const.insertManyUnit] def insertManyUnit [BEq α] [Hashable α]
{ρ : Type w} [ForIn Id ρ α] (m : Raw α Unit) (l : ρ) : Raw α Unit :=
DHashMap.Raw.Const.insertManyUnit m.inner l
@[inline, inherit_doc DHashMap.Raw.Const.insertManyIfNewUnit] def insertManyIfNewUnit [BEq α]
[Hashable α] {ρ : Type w} [ForIn Id ρ α] (m : Raw α Unit) (l : ρ) : Raw α Unit :=
DHashMap.Raw.Const.insertManyIfNewUnit m.inner l
@[inline, inherit_doc DHashMap.Raw.Const.ofList] def ofList [BEq α] [Hashable α]
(l : List (α × β)) : Raw α β :=
@@ -306,9 +306,9 @@ theorem WF.insertMany [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ (α ×
(h : m.WF) : (m.insertMany l).WF :=
DHashMap.Raw.WF.Const.insertMany h.out
theorem WF.insertManyUnit [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ α] {m : Raw α Unit} {l : ρ}
(h : m.WF) : (m.insertManyUnit l).WF :=
DHashMap.Raw.WF.Const.insertManyUnit h.out
theorem WF.insertManyIfNewUnit [BEq α] [Hashable α] {ρ : Type w} [ForIn Id ρ α] {m : Raw α Unit}
{l : ρ} (h : m.WF) : (m.insertManyIfNewUnit l).WF :=
DHashMap.Raw.WF.Const.insertManyIfNewUnit h.out
theorem WF.ofList [BEq α] [Hashable α] {l : List (α × β)} : (ofList l).WF :=
DHashMap.Raw.WF.Const.ofList

View File

@@ -73,6 +73,10 @@ instance [BEq α] [Hashable α] : Inhabited (HashSet α) where
/--
Inserts the given element into the set. If the hash set already contains an element that is
equal (with regard to `==`) to the given element, then the hash set is returned unchanged.
Note: this non-replacement behavior is true for `HashSet` and `HashSet.Raw`.
The `insert` function on `HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw` behaves
differently: it will overwrite an existing mapping.
-/
@[inline] def insert (m : HashSet α) (a : α) : HashSet α :=
m.inner.insertIfNew a ()
@@ -218,13 +222,16 @@ instance [BEq α] [Hashable α] {m : Type v → Type v} : ForIn m (HashSet α)
m.inner.keysArray
/--
Inserts multiple elements into the hash set. Note that unlike repeatedly calling `insert`, if the
collection contains multiple elements that are equal (with regard to `==`), then the last element
in the collection will be present in the returned hash set.
Inserts multiple mappings into the hash set by iterating over the given collection and calling
`insert`. If the same key appears multiple times, the first occurrence takes precedence.
Note: this precedence behavior is true for `HashSet` and `HashSet.Raw`. The `insertMany` function on
`HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw` behaves differently: it will prefer the last
appearance.
-/
@[inline] def insertMany {ρ : Type v} [ForIn Id ρ α] (m : HashSet α) (l : ρ) :
HashSet α :=
m.inner.insertManyUnit l
m.inner.insertManyIfNewUnit l
/--
Creates a hash set from a list of elements. Note that unlike repeatedly calling `insert`, if the

View File

@@ -74,6 +74,10 @@ instance : Inhabited (Raw α) where
/--
Inserts the given element into the set. If the hash set already contains an element that is
equal (with regard to `==`) to the given element, then the hash set is returned unchanged.
Note: this non-replacement behavior is true for `HashSet` and `HashSet.Raw`.
The `insert` function on `HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw` behaves
differently: it will overwrite an existing mapping.
-/
@[inline] def insert [BEq α] [Hashable α] (m : Raw α) (a : α) : Raw α :=
m.inner.insertIfNew a ()
@@ -216,13 +220,16 @@ instance {m : Type v → Type v} : ForIn m (Raw α) α where
m.inner.keysArray
/--
Inserts multiple elements into the hash set. Note that unlike repeatedly calling `insert`, if the
collection contains multiple elements that are equal (with regard to `==`), then the last element
in the collection will be present in the returned hash set.
Inserts multiple mappings into the hash set by iterating over the given collection and calling
`insert`. If the same key appears multiple times, the first occurrence takes precedence.
Note: this precedence behavior is true for `HashSet` and `HashSet.Raw`. The `insertMany` function on
`HashMap`, `DHashMap`, `HashMap.Raw` and `DHashMap.Raw` behaves differently: it will prefer the last
appearance.
-/
@[inline] def insertMany [BEq α] [Hashable α] {ρ : Type v} [ForIn Id ρ α] (m : Raw α) (l : ρ) :
Raw α :=
m.inner.insertManyUnit l
m.inner.insertManyIfNewUnit l
/--
Creates a hash set from a list of elements. Note that unlike repeatedly calling `insert`, if the
@@ -290,7 +297,7 @@ theorem WF.filter [BEq α] [Hashable α] {m : Raw α} {f : α → Bool} (h : m.W
theorem WF.insertMany [BEq α] [Hashable α] {ρ : Type v} [ForIn Id ρ α] {m : Raw α} {l : ρ}
(h : m.WF) : (m.insertMany l).WF :=
HashMap.Raw.WF.insertManyUnit h.out
HashMap.Raw.WF.insertManyIfNewUnit h.out
theorem WF.ofList [BEq α] [Hashable α] {l : List α} :
(ofList l : Raw α).WF :=

View File

@@ -106,7 +106,7 @@ def ofTimestampAssumingUTC (stamp : Timestamp) : PlainDateTime := Id.run do
break
remDays := remDays - monLen
let mday : Fin 31 := Fin.ofNat (Int.toNat remDays)
let mday : Fin 31 := Fin.ofNat' _ (Int.toNat remDays)
let hmon
if h₁ : mon.val > 10

View File

@@ -22,7 +22,7 @@ def Ordinal := Bounded.LE 0 999999999
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n where
ofNat := Bounded.LE.ofFin (Fin.ofNat n)
ofNat := Bounded.LE.ofFin (Fin.ofNat' _ n)
instance : Inhabited Ordinal where
default := 0

View File

@@ -27,10 +27,10 @@ structure TZdb where
localPath : System.FilePath := "/etc/localtime"
/--
The path to the directory containing all available time zone files. These files define various
All the possible paths to the directories containing all available time zone files. These files define various
time zones and their rules.
-/
zonesPath : System.FilePath := "/usr/share/zoneinfo/"
zonesPaths : Array System.FilePath := #["/usr/share/zoneinfo", "/share/zoneinfo", "/etc/zoneinfo", "/usr/share/lib/zoneinfo"]
namespace TZdb
open TimeZone
@@ -52,7 +52,7 @@ def parseTZif (bin : ByteArray) (id : String) : Except String ZoneRules := do
Reads a TZif file from disk and retrieves the zone rules for the specified timezone ID.
-/
def parseTZIfFromDisk (path : System.FilePath) (id : String) : IO ZoneRules := do
let binary try IO.FS.readBinFile path catch _ => throw <| IO.userError s!"cannot find {id} in the local timezone database"
let binary try IO.FS.readBinFile path catch _ => throw <| IO.userError s!"unable to locate {id} in the local timezone database at '{path}'"
IO.ofExcept (parseTZif binary id)
/--
@@ -64,8 +64,8 @@ def idFromPath (path : System.FilePath) : Option String := do
let last₁ res.get? (res.size - 2)
if last₁ = some "zoneinfo"
then last
else last₁ ++ "/" ++ last
then last.trim
else last₁.trim ++ "/" ++ last.trim
/--
Retrieves the timezone rules from the local timezone data file.
@@ -89,4 +89,17 @@ def readRulesFromDisk (path : System.FilePath) (id : String) : IO ZoneRules := d
instance : Std.Time.Database TZdb where
getLocalZoneRules db := localRules db.localPath
getZoneRules db id := readRulesFromDisk db.zonesPath id
getZoneRules db id := do
let env IO.getEnv "TZDIR"
if let some path := env then
let result readRulesFromDisk path id
return result
for path in db.zonesPaths do
if System.FilePath.pathExists path then
let result readRulesFromDisk path id
return result
throw <| IO.userError s!"cannot find {id} in the local timezone database"

View File

@@ -1692,6 +1692,7 @@ static inline uint8_t lean_uint8_dec_le(uint8_t a1, uint8_t a2) { return a1 <= a
static inline uint16_t lean_uint8_to_uint16(uint8_t a) { return ((uint16_t)a); }
static inline uint32_t lean_uint8_to_uint32(uint8_t a) { return ((uint32_t)a); }
static inline uint64_t lean_uint8_to_uint64(uint8_t a) { return ((uint64_t)a); }
static inline size_t lean_uint8_to_usize(uint8_t a) { return ((size_t)a); }
/* UInt16 */
@@ -1727,6 +1728,7 @@ static inline uint8_t lean_uint16_dec_le(uint16_t a1, uint16_t a2) { return a1 <
static inline uint8_t lean_uint16_to_uint8(uint16_t a) { return ((uint8_t)a); }
static inline uint32_t lean_uint16_to_uint32(uint16_t a) { return ((uint32_t)a); }
static inline uint64_t lean_uint16_to_uint64(uint16_t a) { return ((uint64_t)a); }
static inline size_t lean_uint16_to_usize(uint16_t a) { return ((size_t)a); }
/* UInt32 */
@@ -1762,7 +1764,7 @@ static inline uint8_t lean_uint32_dec_le(uint32_t a1, uint32_t a2) { return a1 <
static inline uint8_t lean_uint32_to_uint8(uint32_t a) { return ((uint8_t)a); }
static inline uint16_t lean_uint32_to_uint16(uint32_t a) { return ((uint16_t)a); }
static inline uint64_t lean_uint32_to_uint64(uint32_t a) { return ((uint64_t)a); }
static inline size_t lean_uint32_to_usize(uint32_t a) { return a; }
static inline size_t lean_uint32_to_usize(uint32_t a) { return ((size_t)a); }
/* UInt64 */
@@ -1834,6 +1836,8 @@ static inline uint8_t lean_usize_dec_le(size_t a1, size_t a2) { return a1 <= a2;
/* usize -> other */
static inline uint8_t lean_usize_to_uint8(size_t a) { return ((uint8_t)a); }
static inline uint16_t lean_usize_to_uint16(size_t a) { return ((uint16_t)a); }
static inline uint32_t lean_usize_to_uint32(size_t a) { return ((uint32_t)a); }
static inline uint64_t lean_usize_to_uint64(size_t a) { return ((uint64_t)a); }
@@ -2801,16 +2805,6 @@ static inline lean_obj_res lean_nat_pred(b_lean_obj_arg n) {
return lean_nat_sub(n, lean_box(1));
}
static inline lean_obj_res lean_runtime_mark_multi_threaded(lean_obj_arg a) {
lean_mark_mt(a);
return a;
}
static inline lean_obj_res lean_runtime_mark_persistent(lean_obj_arg a) {
lean_mark_persistent(a);
return a;
}
#ifdef __cplusplus
}
#endif

View File

@@ -63,7 +63,7 @@ def compileLeanModule
unless txt.isEmpty do
logInfo s!"stdout:\n{txt}"
unless out.stderr.isEmpty do
logInfo s!"stderr:\n{out.stderr}"
logInfo s!"stderr:\n{out.stderr.trim}"
if out.exitCode 0 then
error s!"Lean exited with code {out.exitCode}"

View File

@@ -120,5 +120,6 @@ Logs a build step with `message`.
As a result, this no longer functions the way it used to. It now just logs the
`message` via `logVerbose`.
-/
@[deprecated (since := "2024-05-25"), inline] def logStep [Monad m] [MonadLog m] (message : String) : m Unit := do
@[deprecated "See doc-string for deprecation information." (since := "2024-05-25"), inline]
def logStep [Monad m] [MonadLog m] (message : String) : m Unit := do
logVerbose message

View File

@@ -152,7 +152,7 @@ Will NOT cause the whole build to fail if the release cannot be fetched.
abbrev Package.optGitHubReleaseFacet := `optRelease
package_data optRelease : BuildJob Bool
@[deprecated (since := "2024-09-27")]
@[deprecated optGitHubReleaseFacet (since := "2024-09-27")]
abbrev Package.optReleaseFacet := optGitHubReleaseFacet
/--
@@ -162,7 +162,7 @@ Will cause the whole build to fail if the release cannot be fetched.
abbrev Package.gitHubReleaseFacet := `release
package_data release : BuildJob Unit
@[deprecated (since := "2024-09-27")]
@[deprecated gitHubReleaseFacet (since := "2024-09-27")]
abbrev Package.releaseFacet := gitHubReleaseFacet
/-- A package's `extraDepTargets` mixed with its transitive dependencies'. -/

View File

@@ -241,10 +241,10 @@ abbrev Package.gitHubRelease (self : Package) : BuildInfo :=
abbrev Package.optGitHubRelease (self : Package) : BuildInfo :=
self.facet optGitHubReleaseFacet
@[deprecated (since := "2024-09-27")]
@[deprecated gitHubRelease (since := "2024-09-27")]
abbrev Package.release := @gitHubRelease
@[deprecated (since := "2024-09-27")]
@[deprecated optGitHubRelease (since := "2024-09-27")]
abbrev Package.optRelease := @optGitHubRelease
@[inherit_doc extraDepFacet]

View File

@@ -47,10 +47,10 @@ def Package.optBuildCacheFacetConfig : PackageFacetConfig optBuildCacheFacet :=
def Package.maybeFetchBuildCache (self : Package) : FetchM (BuildJob Bool) := do
let shouldFetch :=
( getTryCache) &&
!( self.buildDir.pathExists) && -- do not automatically clobber prebuilt artifacts
(self.preferReleaseBuild || -- GitHub release
((self.scope == "leanprover" || self.scope == "leanprover-community")
&& !( getElanToolchain).isEmpty
&& !( self.buildDir.pathExists))) -- Reservoir
&& !( getElanToolchain).isEmpty)) -- Reservoir
if shouldFetch then
self.optBuildCache.fetch
else
@@ -185,14 +185,14 @@ def Package.barrelFacetConfig : PackageFacetConfig reservoirBarrelFacet :=
def Package.optGitHubReleaseFacetConfig : PackageFacetConfig optGitHubReleaseFacet :=
mkOptBuildArchiveFacetConfig buildArchiveFile getReleaseUrl
@[deprecated (since := "2024-09-27")]
@[deprecated optGitHubReleaseFacetConfig (since := "2024-09-27")]
abbrev Package.optReleaseFacetConfig := optGitHubReleaseFacetConfig
/-- The `PackageFacetConfig` for the builtin `gitHubReleaseFacet`. -/
def Package.gitHubReleaseFacetConfig : PackageFacetConfig gitHubReleaseFacet :=
mkBuildArchiveFacetConfig optGitHubReleaseFacet "GitHub release"
@[deprecated (since := "2024-09-27")]
@[deprecated gitHubReleaseFacetConfig (since := "2024-09-27")]
abbrev Package.releaseFacetConfig := gitHubReleaseFacetConfig
/--

View File

@@ -305,7 +305,9 @@ If not, check if the info is newer than this trace's modification time.
**Deprecated:** Should not be done manually,
but as part of `buildUnlessUpToDate`.
-/
@[deprecated (since := "2024-06-14"), specialize] def checkAgainstFile
@[deprecated "Should not be done manually, but as part of `buildUnlessUpToDate`."
(since := "2024-06-14"), specialize]
def checkAgainstFile
[CheckExists i] [GetMTime i]
(info : i) (traceFile : FilePath) (self : BuildTrace)
: BaseIO Bool := do
@@ -320,7 +322,8 @@ Write trace to a file.
**Deprecated:** Should not be done manually,
but as part of `buildUnlessUpToDate`.
-/
@[deprecated (since := "2024-06-14")] def writeToFile (traceFile : FilePath) (self : BuildTrace) : IO PUnit := do
@[deprecated "Should not be done manually, but as part of `buildUnlessUpToDate`." (since := "2024-06-14")]
def writeToFile (traceFile : FilePath) (self : BuildTrace) : IO PUnit := do
createParentDirs traceFile
IO.FS.writeFile traceFile self.hash.toString

View File

@@ -104,6 +104,25 @@ structure MaterializedDep where
@[inline] def MaterializedDep.configFile (self : MaterializedDep) :=
self.manifestEntry.configFile
def pkgNotIndexed (scope name : String) (rev? : Option String := none) : String :=
let (leanRev, tomlRev) :=
if let some rev := rev? then
(s!" @ {repr rev}", s! "\n rev = {repr rev}")
else ("", "")
s!"{scope}/{name}: package not found on Reservoir.
If the package is on GitHub, you can add a Git source. For example:
require ...
from git \"https://github.com/{scope}/{name}\"{leanRev}
or, if using TOML:
[[require]]
git = \"https://github.com/{scope}/{name}\"{tomlRev}
...
"
/--
Materializes a configuration dependency.
For Git dependencies, updates it to the latest input revision.
@@ -129,11 +148,16 @@ def Dependency.materialize
if ver.startsWith "git#" then
return ver.drop 4
else
error s!"{dep.name}: unsupported dependency version format '{ver}' (should be \"git#>rev>\")"
error s!"{dep.name}: unsupported dependency version format '{ver}' (should be \"git#<rev>\")"
let depName := dep.name.toString (escape := false)
let some pkg Reservoir.fetchPkg? lakeEnv dep.scope depName
| error s!"{dep.scope}/{depName}: could not materialize package: \
dependency has no explicit source and was not found on Reservoir"
let pkg
match ( Reservoir.fetchPkg? lakeEnv dep.scope depName |>.toLogT) with
| .ok (some pkg) => pure pkg
| .ok none => error <| pkgNotIndexed dep.scope depName verRev?
| .error e =>
logError s!"{dep.scope}/{depName}: could not materialize package: \
this may be a transient error or a bug in Lake or Reservoir"
throw e
let relPkgDir := relPkgsDir / pkg.name
match pkg.gitSrc? with
| some (.git _ url githubUrl? defaultBranch? subDir?) =>

View File

@@ -30,7 +30,6 @@ in their Lake configuration file with
require {newName} from
git \"https://github.com/leanprover-community/{newName}\"{rev}
"
/--
@@ -146,7 +145,7 @@ Also, move the packages directory if its location has changed.
-/
private def reuseManifest
(ws : Workspace) (toUpdate : NameSet)
: UpdateT LogIO PUnit := do
: UpdateT LoggerIO PUnit := do
let rootName := ws.root.name.toString (escape := false)
match ( Manifest.load ws.manifestFile |>.toBaseIO) with
| .ok manifest =>
@@ -174,7 +173,7 @@ private def reuseManifest
logWarning s!"{rootName}: ignoring previous manifest because it failed to load: {e}"
/-- Add a package dependency's manifest entries to the update state. -/
private def addDependencyEntries (pkg : Package) : UpdateT LogIO PUnit := do
private def addDependencyEntries (pkg : Package) : UpdateT LoggerIO PUnit := do
match ( Manifest.load pkg.manifestFile |>.toBaseIO) with
| .ok manifest =>
manifest.packages.forM fun entry => do
@@ -189,7 +188,7 @@ private def addDependencyEntries (pkg : Package) : UpdateT LogIO PUnit := do
/-- Materialize a single dependency, updating it if desired. -/
private def updateAndMaterializeDep
(ws : Workspace) (pkg : Package) (dep : Dependency)
: UpdateT LogIO MaterializedDep := do
: UpdateT LoggerIO MaterializedDep := do
if let some entry fetch? dep.name then
entry.materialize ws.lakeEnv ws.dir ws.relPkgsDir
else
@@ -210,7 +209,7 @@ private def updateAndMaterializeDep
/-- Verify that a dependency was loaded with the correct name. -/
private def validateDep
(pkg : Package) (dep : Dependency) (matDep : MaterializedDep) (depPkg : Package)
: LogIO PUnit := do
: LoggerIO PUnit := do
if depPkg.name dep.name then
if dep.name = .mkSimple "std" then
let rev :=
@@ -352,7 +351,7 @@ where
@[inline] updateAndLoadDep pkg dep := do
let matDep updateAndMaterializeDep ( getWorkspace) pkg dep
loadUpdatedDep pkg dep matDep
@[inline] loadUpdatedDep pkg dep matDep : StateT Workspace (UpdateT LogIO) Package := do
@[inline] loadUpdatedDep pkg dep matDep : StateT Workspace (UpdateT LoggerIO) Package := do
let depPkg loadDepPackage matDep dep.opts leanOpts true
validateDep pkg dep matDep depPkg
addDependencyEntries depPkg
@@ -361,7 +360,7 @@ where
/-- Write package entries to the workspace manifest. -/
def Workspace.writeManifest
(ws : Workspace) (entries : NameMap PackageEntry)
: LogIO PUnit := do
: IO PUnit := do
let manifestEntries := ws.packages.foldl (init := #[]) fun arr pkg =>
match entries.find? pkg.name with
| some entry => arr.push <|
@@ -376,7 +375,7 @@ def Workspace.writeManifest
manifest.saveToFile ws.manifestFile
/-- Run a package's `post_update` hooks. -/
def Package.runPostUpdateHooks (pkg : Package) : LakeT LogIO PUnit := do
def Package.runPostUpdateHooks (pkg : Package) : LakeT LoggerIO PUnit := do
unless pkg.postUpdateHooks.isEmpty do
logInfo s!"{pkg.name}: running post-update hooks"
pkg.postUpdateHooks.forM fun hook => hook.get.fn pkg
@@ -405,7 +404,7 @@ reporting warnings and/or errors as appropriate.
-/
def validateManifest
(pkgEntries : NameMap PackageEntry) (deps : Array Dependency)
: LogIO PUnit := do
: LoggerIO PUnit := do
if pkgEntries.isEmpty && !deps.isEmpty then
error "missing manifest; use `lake update` to generate one"
deps.forM fun dep => do
@@ -429,7 +428,7 @@ downloading and/or updating them as necessary.
def Workspace.materializeDeps
(ws : Workspace) (manifest : Manifest)
(leanOpts : Options := {}) (reconfigure := false)
: LogIO Workspace := do
: LoggerIO Workspace := do
if !manifest.packages.isEmpty && manifest.packagesDir? != some (mkRelPathString ws.relPkgsDir) then
logWarning <|
"manifest out of date: packages directory changed; \

View File

@@ -172,8 +172,9 @@ def uriEncodeChar (c : Char) (s := "") : String :=
def uriEncode (s : String) : String :=
s.foldl (init := "") fun s c => uriEncodeChar c s
/-- Perform a HTTP `GET` request of a URL (using `curl`) and return the body. -/
def getUrl (url : String) (headers : Array String := #[]) : LogIO String := do
let args := #["-s", "-L"]
let args := #["-s", "-L", "--retry", "3"] -- intermittent network errors can occur
let args := headers.foldl (init := args) (· ++ #["-H", ·])
captureProc {cmd := "curl", args := args.push url}
@@ -206,9 +207,9 @@ def Reservoir.fetchPkg? (lakeEnv : Lake.Env) (owner pkg : String) : LogIO (Optio
let out
try
getUrl url Reservoir.lakeHeaders
catch _ =>
catch e =>
logError s!"{owner}/{pkg}: Reservoir lookup failed"
return none
throw e
match Json.parse out >>= fromJson? with
| .ok json =>
match fromJson? json with
@@ -220,11 +221,14 @@ def Reservoir.fetchPkg? (lakeEnv : Lake.Env) (owner pkg : String) : LogIO (Optio
if status == 404 then
return none
else
logError s!"{owner}/{pkg}: Reservoir lookup failed: {msg}"
return none
error s!"{owner}/{pkg}: Reservoir lookup failed: {msg}"
| .error e =>
errorWithLog do
logError s!"{owner}/{pkg}: Reservoir lookup failed; server returned unsupported JSON: {e}"
return none
logVerbose s!"{owner}/{pkg}: Reservoir responded with:\n{out.trim}"
failure
| .error e =>
errorWithLog do
logError s!"{owner}/{pkg}: Reservoir lookup failed; server returned invalid JSON: {e}"
return none
logVerbose s!"{owner}/{pkg}: Reservoir responded with:\n{out.trim}"
failure

View File

@@ -130,9 +130,9 @@ protected def LogEntry.toString (self : LogEntry) (useAnsi := false) : String :=
if useAnsi then
let {level := lv, message := msg} := self
let pre := Ansi.chalk lv.ansiColor s!"{lv.toString}:"
s!"{pre} {msg.trim}"
s!"{pre} {msg}"
else
s!"{self.level}: {self.message.trim}"
s!"{self.level}: {self.message}"
instance : ToString LogEntry := LogEntry.toString
@@ -161,7 +161,8 @@ export MonadLog (logEntry)
message := mkErrorStringWithPos msg.fileName msg.pos str none
}
@[deprecated (since := "2024-05-18")] def logToIO (e : LogEntry) (minLv : LogLevel) : BaseIO PUnit := do
@[deprecated "No deprecation message available." (since := "2024-05-18")]
def logToIO (e : LogEntry) (minLv : LogLevel) : BaseIO PUnit := do
match e.level with
| .trace => if minLv .trace then
IO.println e.message.trim |>.catchExceptions fun _ => pure ()
@@ -189,7 +190,8 @@ abbrev lift [MonadLiftT m n] (self : MonadLog m) : MonadLog n where
instance [MonadLift m n] [methods : MonadLog m] : MonadLog n := methods.lift
set_option linter.deprecated false in
@[deprecated (since := "2024-05-18")] abbrev io [MonadLiftT BaseIO m] (minLv := LogLevel.info) : MonadLog m where
@[deprecated "Deprecated without replacement." (since := "2024-05-18")]
abbrev io [MonadLiftT BaseIO m] (minLv := LogLevel.info) : MonadLog m where
logEntry e := logToIO e minLv
abbrev stream [MonadLiftT BaseIO m]
@@ -399,7 +401,7 @@ from an `ELogT` (e.g., `LogIO`).
[Monad m] [MonadLiftT BaseIO m] [MonadLog m] [MonadFinally m] (x : m α)
: m α := do
let (out, a) IO.FS.withIsolatedStreams x
unless out.isEmpty do logInfo s!"stdout/stderr:\n{out}"
unless out.isEmpty do logInfo s!"stdout/stderr:\n{out.trim}"
return a
/-- Throw with the logged error `message`. -/

View File

@@ -18,9 +18,9 @@ def mkCmdLog (args : IO.Process.SpawnArgs) : String :=
[Monad m] (out : IO.Process.Output) (log : String m PUnit)
: m Unit := do
unless out.stdout.isEmpty do
log s!"stdout:\n{out.stdout}"
log s!"stdout:\n{out.stdout.trim}"
unless out.stderr.isEmpty do
log s!"stderr:\n{out.stderr}"
log s!"stderr:\n{out.stderr.trim}"
@[inline] def rawProc (args : IO.Process.SpawnArgs) (quiet := false) : LogIO IO.Process.Output := do
withLogErrorPos do

View File

@@ -8,7 +8,12 @@ export ELAN_TOOLCHAIN=test
./clean.sh
# Tests requiring a package not in the index
($LAKE -f bogus-dep.toml update 2>&1 && exit 1 || true) |
grep --color "error: bogus/bogus: could not materialize package: dependency has no explicit source and was not found on Reservoir"
grep --color "package not found on Reservoir"
# Tests a request error
(RESERVOIR_API_URL=example.com $LAKE -f bogus-dep.toml update 2>&1 && exit 1 || true) |
grep --color "server returned invalid JSON"
(RESERVOIR_API_URL=example.com $LAKE -f bogus-dep.toml update -v 2>&1 && exit 1 || true) |
grep --color "Reservoir responded with"
./clean.sh
$LAKE -f git.toml update --keep-toolchain

View File

@@ -692,7 +692,7 @@ extern "C" LEAN_EXPORT obj_res lean_windows_get_next_transition(b_obj_arg timezo
tm = (int64_t)(nextTransition / 1000.0);
}
int32_t dst_offset = ucal_get(cal, UCAL_DST_OFFSET, &status);
if (U_FAILURE(status)) {
@@ -1450,6 +1450,16 @@ extern "C" LEAN_EXPORT obj_res lean_io_exit(uint8_t code, obj_arg /* w */) {
exit(code);
}
extern "C" LEAN_EXPORT obj_res lean_runtime_mark_multi_threaded(obj_arg a, obj_arg /* w */) {
lean_mark_mt(a);
return io_result_mk_ok(a);
}
extern "C" LEAN_EXPORT obj_res lean_runtime_mark_persistent(obj_arg a, obj_arg /* w */) {
lean_mark_persistent(a);
return io_result_mk_ok(a);
}
void initialize_io() {
g_io_error_nullptr_read = lean_mk_io_user_error(mk_ascii_string_unchecked("null reference read"));
mark_persistent(g_io_error_nullptr_read);

View File

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Mac Malone
*/
#include "util/io.h"
#include "runtime/io.h"
#include "runtime/object.h"
#include "runtime/sstream.h"
@@ -41,4 +42,78 @@ extern "C" LEAN_EXPORT obj_res lean_load_dynlib(b_obj_arg path, obj_arg) {
return io_result_mk_error(ex.what());
}
}
/* loadPlugin : System.FilePath -> IO Unit */
extern "C" LEAN_EXPORT obj_res lean_load_plugin(b_obj_arg path, obj_arg) {
// we never want to look up plugins using the system library search
std::string rpath;
#if defined(LEAN_EMSCRIPTEN)
rpath = string_to_std(path);
auto sep = rpath.rfind('/');
#elif defined(LEAN_WINDOWS)
constexpr unsigned BufferSize = 8192;
char buffer[BufferSize];
DWORD retval = GetFullPathName(string_cstr(path), BufferSize, buffer, nullptr);
if (retval == 0 || retval > BufferSize) {
rpath = string_to_std(path);
} else {
rpath = std::string(buffer);
}
auto sep = rpath.rfind('\\');
#else
char buffer[PATH_MAX];
char * tmp = realpath(string_cstr(path), buffer);
if (tmp) {
rpath = std::string(tmp);
} else {
inc(path);
return io_result_mk_error(lean_mk_io_error_no_file_or_directory(path, ENOENT, mk_string("")));
}
auto sep = rpath.rfind('/');
#endif
if (sep == std::string::npos) {
sep = 0;
} else {
sep++;
}
auto dot = rpath.rfind(".");
if (dot == std::string::npos) {
dot = rpath.size();
}
std::string pkg = rpath.substr(sep, dot - sep);
std::string sym = "initialize_" + pkg;
void * init;
#ifdef LEAN_WINDOWS
HMODULE h = LoadLibrary(rpath.c_str());
if (!h) {
return io_result_mk_error((sstream()
<< "error loading plugin " << rpath << ": " << GetLastError()).str());
}
init = reinterpret_cast<void *>(GetProcAddress(h, sym.c_str()));
#else
// Like lean_load_dynlib, the library is loaded with RTLD_GLOBAL.
// This ensures the interpreter has access to plugin definitions that are also
// imported (e.g., an environment extension defined with builtin_initialize).
// In either case, loading the same symbol twice (and thus e.g. running initializers
// manipulating global `IO.Ref`s twice) should be avoided; the common module
// should instead be factored out into a separate shared library
void *handle = dlopen(rpath.c_str(), RTLD_LAZY | RTLD_GLOBAL);
if (!handle) {
return io_result_mk_error((sstream()
<< "error loading plugin, " << dlerror()).str());
}
init = dlsym(handle, sym.c_str());
#endif
if (!init) {
return io_result_mk_error((sstream()
<< "error, plugin " << rpath << " does not seem to contain a module '" << pkg << "'").str());
}
auto init_fn = reinterpret_cast<object *(*)(uint8_t, object *)>(init);
return init_fn(1 /* builtin */, io_mk_world());
// NOTE: we never unload plugins
}
void load_plugin(std::string path) {
consume_io_result(lean_load_plugin(mk_string(path), io_mk_world()));
}
}

View File

@@ -9,4 +9,5 @@ Author: Mac Malone
namespace lean {
LEAN_EXPORT void load_dynlib(std::string path);
LEAN_EXPORT void load_plugin(std::string path);
}

View File

@@ -5,11 +5,18 @@ options get_default_options() {
options opts;
// see https://lean-lang.org/lean4/doc/dev/bootstrap.html#further-bootstrapping-complications
#if LEAN_IS_STAGE0 == 1
// switch to `true` for ABI-breaking changes affecting meta code
// set to true to generally avoid bootstrapping issues limited to tactic
// blocks in stage 1
opts = opts.update({"debug", "byAsSorry"}, false);
// switch to `true` for ABI-breaking changes affecting meta code;
// see also next option!
opts = opts.update({"interpreter", "prefer_native"}, false);
// switch to `true` for changing built-in parsers used in quotations
opts = opts.update({"internal", "parseQuotWithCurrentStage"}, false);
// toggling `parseQuotWithCurrentStage` may also require toggling the following option if macros/syntax
// switch to `false` when enabling `prefer_native` should also affect use
// of built-in parsers in quotations; this is usually the case, but setting
// both to `true` may be necessary for handling non-builtin parsers with
// builtin elaborators
opts = opts.update({"internal", "parseQuotWithCurrentStage"}, true);
// changes to builtin parsers may also require toggling the following option if macros/syntax
// with custom precheck hooks were affected
opts = opts.update({"quotPrecheck"}, true);

View File

@@ -54,8 +54,6 @@ Author: Leonardo de Moura
#ifdef LEAN_WINDOWS
#include <windows.h>
#else
#include <dlfcn.h>
#endif
#ifdef _MSC_VER
@@ -323,34 +321,6 @@ options set_config_option(options const & opts, char const * in) {
}
}
void load_plugin(std::string path) {
void * init;
// we never want to look up plugins using the system library search
path = lrealpath(path);
std::string pkg = stem(path);
std::string sym = "initialize_" + pkg;
#ifdef LEAN_WINDOWS
HMODULE h = LoadLibrary(path.c_str());
if (!h) {
throw exception(sstream() << "error loading plugin " << path << ": " << GetLastError());
}
init = reinterpret_cast<void *>(GetProcAddress(h, sym.c_str()));
#else
void *handle = dlopen(path.c_str(), RTLD_LAZY);
if (!handle) {
throw exception(sstream() << "error loading plugin, " << dlerror());
}
init = dlsym(handle, sym.c_str());
#endif
if (!init) {
throw exception(sstream() << "error, plugin " << path << " does not seem to contain a module '" << pkg << "'");
}
auto init_fn = reinterpret_cast<object *(*)(uint8_t, object *)>(init);
object *r = init_fn(1 /* builtin */, io_mk_world());
consume_io_result(r);
// NOTE: we never unload plugins
}
namespace lean {
extern "C" object * lean_run_frontend(
object * input,
@@ -619,7 +589,7 @@ extern "C" LEAN_EXPORT int lean_main(int argc, char ** argv) {
#endif
case 'p':
check_optarg("p");
load_plugin(optarg);
lean::load_plugin(optarg);
forwarded_args.push_back(string_ref("--plugin=" + std::string(optarg)));
break;
case 'l':

Binary file not shown.

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