Compare commits

...

172 Commits

Author SHA1 Message Date
Kim Morrison
0cce9ff119 benchmark 2024-11-28 10:36:59 +11:00
Kim Morrison
6e41298f30 merge master 2024-11-28 10:19:32 +11: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
Kim Morrison
cfc8c6ad8e . 2024-11-27 21:51:52 +11:00
Kim Morrison
8457fca519 oops 2024-11-27 21:22:17 +11: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
Kim Morrison
e3b05c13e1 . 2024-11-27 16:16:08 +11: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
0fc4ed91d1 merge 2024-11-27 15:34:37 +11: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
66ebec97ca feat: relate Nat.fold/foldRev/any/all to List.finRange 2024-11-27 15:22:36 +11: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
Kim Morrison
afd398678b Merge branch 'finRange' into insertionSort 2024-11-27 15:07:00 +11:00
Kim Morrison
7791ec7844 feat: upstream List.finRange from Batteries 2024-11-27 15:05:52 +11:00
Kim Morrison
8f0d0995d6 . 2024-11-27 15:00:19 +11:00
Kim Morrison
e04e923b82 Merge branch 'vector_lemmas' into insertionSort 2024-11-27 14:59:10 +11:00
Kim Morrison
438a1dc989 merge master 2024-11-27 14:57:36 +11: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
9221d9d4db wip 2024-11-25 11:31:54 +11: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
Kim Morrison
427dc66af3 Merge branch 'vector' into vector_lemmas 2024-11-25 09:48:14 +11:00
Kim Morrison
1391f847bd fix tests 2024-11-25 09:40:25 +11:00
Kim Morrison
85700f1fa4 fix tests 2024-11-25 09:26:05 +11:00
Kim Morrison
5a23cefd80 . 2024-11-25 09:02:54 +11:00
Kim Morrison
5cfe1ca35b . 2024-11-25 09:01:56 +11:00
Kim Morrison
9052d3daef chore: upstream Vector lemmas 2024-11-25 09:01:39 +11:00
Kim Morrison
c1b887b1c1 Merge remote-tracking branch 'origin/master' into vector 2024-11-24 20:49:38 +11:00
Kim Morrison
90f2cb4226 feat: upstream definition of Vector from Batteries 2024-11-24 20:47:58 +11:00
Kim Morrison
62d869f267 Merge branch 'mv_array_Setd' into vector 2024-11-24 20:10:57 +11:00
Kim Morrison
4e885be96d feat: rename Array.setD to setIfInBounds (#6195)
This PR renames `Array.setD` to `Array.setIfInBounds`.
2024-11-24 08:54:19 +00:00
Kim Morrison
29ff22c560 chore: rename Array.setD to setIfInBounds 2024-11-24 19:23:21 +11:00
Kim Morrison
42e98bd3c9 feat: Array.swap takes Nat arguments, with tactic provided proofs (#6194)
This PR changes the signature of `Array.swap`, so it takes `Nat`
arguments with tactic provided bounds checking. It also renames
`Array.swap!` to `Array.swapIfInBounds`.
2024-11-24 07:59:57 +00:00
Kim Morrison
884a9ea2ff feat: remove partial keyword and runtime bounds checks from Array.binSearch (#6193)
This PR completes the TODO in `Init.Data.Array.BinSearch`, removing the
`partial` keyword and converting runtime bounds checks to compile time
bounds checks.
2024-11-24 06:08:16 +00:00
Kyle Miller
2f5c7d0465 fix: structures with copied parents can now use other parents as instances (#6175)
This PR fixes a bug with the `structure`/`class` command where if there
are parents that are not represented as subobjects but which used other
parents as instances, then there would be a kernel error. Closes #2611.

Note: there is still the limitation that parents that are not
represented as subobjects do not themselves provide instances to other
parents.
2024-11-24 04:22:39 +00:00
Kim Morrison
a5ffef7e13 feat: Array.zipWithAll (#6191)
This PR adds `Array.zipWithAll`, and the basic lemmas relating it to
`List.zipWithAll`.
2024-11-24 03:49:57 +00:00
Kim Morrison
442c3d5097 chore: missing deprecations for Lean.HashMap (#6192)
This PR adds deprecations for `Lean.HashMap` functions which did not
receive deprecation attributes initially.

(Requested on
[zulip](https://leanprover.zulipchat.com/#narrow/channel/348111-batteries/topic/Unifying.20.60Batteries.2EHashMap.60.20and.20.60Std.2EHashMap.60.2E/near/484113660).)

Note that I've used the original deprecation date of 2024-08-08, when
the type itself was deprecated; this will not delay removal.
2024-11-24 03:29:48 +00:00
Joachim Breitner
bf13b24692 doc: refine kernel code comments (#6150)
I just spent too much time being confused about the kernel type checker
until I noticed that `lazy_delta_reduction` modifies its arguments.
2024-11-23 17:13:51 +00:00
Andrii Kurdiumov
51d1cc61d7 fix: remove obsolete sentence in doc-string (#6185)
Even if this sentence is technically true, it do not add anything to the
explanation of typechecker and code.
2024-11-23 07:56:31 +00:00
Siddharth
107a2e8b2e feat: BitVec.toInt BitVec.signExtend (#6157)
This PR adds toInt theorems for BitVec.signExtend.

If the current width `w` is larger than the extended width `v`,
then the value when interpreted as an integer is truncated,
and we compute a modulo by `2^v`.

```lean
theorem toInt_signExtend_of_le (x : BitVec w) (hv : v ≤ w) :
    (x.signExtend v).toInt = Int.bmod (x.toNat) (2^v)
```

Co-authored-by: Siddharth Bhat <siddu.druid@gmail.com>
Co-authored-by: Harun Khan <harun19@stanford.edu>


Stacked on top of #6155

---------

Co-authored-by: Harun Khan <harun19@stanford.edu>
2024-11-23 07:29:08 +00:00
Kim Morrison
c4b0b94c91 chore: use Array.findFinIdx? where it is better than findIdx? (#6184)
This PR uses `Array.findFinIdx?` in preference to `Array.findIdx?` where
it allows converting a runtime bounds check to a compile time bounds
check.

(and some other minor cleanup)
2024-11-23 07:22:31 +00:00
Kyle Miller
ba3f2b3ecf fix: make sure #check id heeds pp.raw (#6181)
This PR fixes a bug where the signature pretty printer would ignore the
current setting of `pp.raw`. This fixes an issue where `#check ident`
would not heed `pp.raw`. Closes #6090.
2024-11-23 00:39:58 +00:00
Leonardo de Moura
4a69643858 fix: nontermination while generating equation lemmas for match-expressions (#6180)
This PR fixes a non-termination bug that occurred when generating the
match-expression equation theorems. The bug was triggered when the proof
automation for the equation theorem repeatedly applied `injection(` to
the same local declaration, as it could not be removed due to forward
dependencies. See issue #6067 for an example that reproduces this issue.

closes #6067
2024-11-23 00:06:34 +00:00
Kyle Miller
b6a0d63612 feat: have "motive is not type correct" come with an explanation (#6168)
This PR extends the "motive is not type correct" error message for the
rewrite tactic to explain what it means. It also pretty prints the
type-incorrect motive and reports the type error.

Suggested [on
Zulip](https://leanprover.zulipchat.com/#narrow/channel/113489-new-members/topic/tactic.20'rewrite'.20failed.2C.20motive.20is.20not.20type.20correct/near/483545154).
2024-11-22 23:56:17 +00:00
Kyle Miller
5145030ff4 chore: refactor Elab.StructInst to use mutual for its structures/inductives (#6174)
Making use of #6125.
2024-11-22 19:17:48 +00:00
Kyle Miller
d3cb812fb6 chore: add test for recursive structures (#6173)
Closes #6140. This was fixed by #6125.
2024-11-22 18:53:59 +00:00
Lean stage0 autoupdater
e066c17a65 chore: update stage0 2024-11-22 18:29:01 +00:00
Sebastian Ullrich
38cff08888 feat: creation and reporting for asynchronous elaboration tasks (#6170)
This PR adds core metaprogramming functions for forking off background
tasks from elaboration such that their results are visible to reporting
and the language server
2024-11-22 17:12:30 +00:00
David Thrane Christiansen
3388fc8d06 doc: fix typo and make docstring more precise (#6009)
This PR fixes a typo in the docstring for prec and makes the text
slightly more precise.
2024-11-22 16:30:01 +00:00
Eric Wieser
5adcd520fa fix: make the stack handling more robust to sanitizers and -O3 (#6143)
This PR should make lean better-behaved around sanitizers, per
https://github.com/google/sanitizers/issues/1688.
As far as I can tell,
https://github.com/google/sanitizers/wiki/AddressSanitizerUseAfterReturn#algorithm
replaces local variables with heap allocations, and so taking the
address of a local is not effective at producing a monotonic measure of
stack usage.

The approach used here is the same as the one used by clang.
2024-11-22 15:10:20 +00:00
David Thrane Christiansen
1126407d9b feat: create temporary directories (#6148)
This PR adds a primitive for creating temporary directories, akin to the
existing functionality for creating temporary files.
2024-11-22 12:24:32 +00:00
Kyle Miller
a19ff61e15 feat: allow structure in mutual blocks (#6125)
This PR adds support for `structure` in `mutual` blocks, allowing
inductive types defined by `inductive` and `structure` to be mutually
recursive. The limitations are (1) that the parents in the `extends`
clause must be defined before the `mutual` block and (2) mutually
recursive classes are not allowed (a limitation shared by `class
inductive`). There are also improvements to universe level inference for
inductive types and structures. Breaking change: structure parents now
elaborate with the structure in scope (fix: use qualified names or
rename the structure to avoid shadowing), and structure parents no
longer elaborate with autoimplicits enabled.

Internally, this is a large refactor of both the `inductive` and
`structure` commands. Common material is now in
`Lean.Elab.MutualInductive`, and each command plugs into this mutual
inductive elaboration framework with the logic specific to the
respective command. For example, `structure` has code to add projections
after the inductive types are added to the environment.

Closes #4182
2024-11-22 09:20:07 +00:00
Lean stage0 autoupdater
6202461a21 chore: update stage0 2024-11-22 04:42:45 +00:00
Kim Morrison
ea221f3283 feat: Nat.(fold|foldRev|any|all)M? take a function which sees the upper bound (#6139)
This PR modifies the signature of the functions `Nat.fold`,
`Nat.foldRev`, `Nat.any`, `Nat.all`, so that the function is passed the
upper bound. This allows us to change runtime array bounds checks to
compile time checks in many places.
2024-11-22 03:05:51 +00:00
Kyle Miller
7c50d597c3 feat: add builtin attribute to support elaboration of mutual inductives/structures (#6166)
This PR is a prerequisite for #6125.
2024-11-22 01:48:37 +00:00
Tony Beta Lambda
99031695bd feat: display coercions with a type ascription (#6119)
This PR adds a new delab option `pp.coercions.types` which, when
enabled, will display all coercions with an explicit type ascription.

[Link to Zulip
discussion](https://leanprover.zulipchat.com/#narrow/channel/239415-metaprogramming-.2F-tactics/topic/Roundtripping.20delaboration.20involving.20coercions)

Towards #4315
2024-11-21 23:02:47 +00:00
JovanGerb
b7248d5295 fix: revert creates natural metavariable goal (#6145)
This PR fixes the `revert` tactic so that it creates a `syntheticOpaque`
metavariable as the new goal, instead of a `natural` metavariable

I reported it on
[Zulip](https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/.60revert.60.20gives.20natural.20metavariable.20goal/near/483388096)
2024-11-21 23:00:57 +00:00
Tobias Grosser
7f2e7e56d2 feat: BitVec.getMsbD_[ofNatLt|allOnes|not] (#6149)
This PR completes the elementwise accessors for `ofNatLt`, `allOnes`,
and `not` by adding their implementations of `getMsbD`.
2024-11-21 22:13:09 +00:00
Tobias Grosser
1fe66737ad feat: BitVec.toInt_[or|and|xor|not] (#6151)
This PR completes the `toInt` interface for `BitVec` bitwise operations.
2024-11-21 22:10:33 +00:00
Bhavik Mehta
765eb02279 doc: adjust file reference in Data.Sum (#6158)
This file was upstreamed from batteries; I just got bitten by the
invalid reference and it took quite a while to figure out that this one
had been moved!
2024-11-21 21:48:27 +00:00
Henrik Böving
a101377054 perf: speed up reflection of if in bv_decide (#6162)
This PR adds a slight performance improvement to reflection of `if`
statements that I noticed by profiling Leanwuzla against SMTCOMP's
`non-incremental/QF_BV/fft/Sz256_6616.smt2`.

In particular:
1. The profile showed about 4 percent of the total run time were spent
constructing these decidable instances in reflection of `if` statements.
We can construct them much quicker by hand as they always have the same
structure
2. This delays construction of these statements until we actually
generate the reflection proof that we wish to submit to the kernel. Thus
if we encounter a SAT instad of an UNSAT problem we will not spend time
generating these expressions anymore.

```
baseline
  Time (mean ± σ):     31.236 s ±  0.258 s
  Range (min … max):   30.899 s … 31.661 s    10 runs

after
  Time (mean ± σ):     30.671 s ±  0.288 s
  Range (min … max):   30.350 s … 31.156 s    10 runs
```
2024-11-21 19:40:14 +00:00
Kyle Miller
aca9929d84 fix: make sure whitespace is printed before tactic configuration (#6161)
This PR ensures whitespace is printed before `+opt` and `-opt`
configuration options when pretty printing, improving the experience of
tactics such as `simp?`.

Reported [on
Zulip](https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/Minor.20simp.3F.20annoyances/near/483736310)
2024-11-21 19:21:59 +00:00
Sebastian Ullrich
19a701e5c9 refactor: one more recursive structure (#6159) 2024-11-21 18:30:28 +00:00
Leonardo de Moura
fc4305ab15 fix: nontermination when generating the match-expression splitter theorem (#6146)
This PR fixes a non-termination bug that occurred when generating the
match-expression splitter theorem. The bug was triggered when the proof
automation for the splitter theorem repeatedly applied `injection` to
the same local declaration, as it could not be removed due to forward
dependencies. See issue #6065 for an example that reproduces this issue.

closes #6065
2024-11-21 17:20:33 +00:00
Kim Morrison
9cf83706e7 chore: add changelog-* labels via comment (#6147)
This PR enables contributors to modify `changelog-*` labels simply by
writing a comment with the desired label.
2024-11-21 07:23:13 +00:00
Tobias Grosser
459c6e2a46 feat: BitVec.getElem_[sub|neg|sshiftRight'|abs] (#6126)
This PR adds lemmas for extracting a given bit of a `BitVec` obtained
via `sub`/`neg`/`sshiftRight'`/`abs`.

---------

Co-authored-by: Kim Morrison <scott@tqft.net>
2024-11-21 07:01:11 +00:00
Kim Morrison
72e952eadc chore: avoid runtime array bounds checks (#6134)
This PR avoids runtime array bounds checks in places where it can
trivially be done at compile time.

None of these changes are of particular consequence: I mostly wanted to
learn how much we do this, and what the obstacles are to doing it less.
2024-11-21 05:04:52 +00:00
damiano
56a80dec1b doc: doc-strings to module docs in Data/Array/Lemmas (#6144)
This PR converts 3 doc-string to module docs since it seems that this is
what they were intended to be!
2024-11-21 05:04:09 +00:00
JovanGerb
b894464191 fix: type occurs check bug (#6128)
This PR does the same fix as #6104, but such that it doesn't break the
test/the file in `Plausible`. This is done by not creating unused let
binders in metavariable types that are made by `elimMVar`. (This is also
a positive thing for users looking at metavariable types, for example in
error messages)

We get rid of `skipAtMostNumBinders`. This function was originally
defined for the purpose of making this test work, but it is a hack
because it allows cycles in the metavariable context.

It would make sense to split these changes into 2 PRs, but I combined
them here to show that the combination of them closes #6013 without
breaking anything

Closes #6013
2024-11-21 00:28:36 +00:00
Sebastian Ullrich
b30903d1fc refactor: make use of recursive structures in snapshot types (#6141) 2024-11-20 15:15:14 +00:00
Sebastian Ullrich
7fbe8e3b36 fix: Inhabited Float produced a bogus run-time value (#6136)
This PR fixes the run-time evaluation of `(default : Float)`.
2024-11-20 10:43:59 +00:00
Sebastian Ullrich
2fbc46641d fix: trace.profiler pretty-printing (#6138)
This PR fixes `trace.profiler.pp` not using the term pretty printer.

Fixes #5872
2024-11-20 10:21:02 +00:00
Sebastian Ullrich
17419aca7f feat: thread support for trace.profiler.output (#6137)
This PR adds support for displaying multiple threads in the trace
profiler output.

`TraceState.tid` needs to be adjusted for this purpose, which is not
done yet by the Lean elaborator as it is still single-threaded.
2024-11-20 10:02:39 +00:00
Kim Morrison
f85c66789d feat: Array.insertIdx/eraseIdx take a tactic-provided proof (#6133)
This PR replaces `Array.feraseIdx` and `Array.insertAt` with
`Array.eraseIdx` and `Array.insertIdx`, both of which take a `Nat`
argument and a tactic-provided proof that it is in bounds. We also have
`eraseIdxIfInBounds` and `insertIdxIfInBounds` which are noops if the
index is out of bounds. We also provide a `Fin` valued version of
`Array.findIdx?`. Together, these quite ergonomically improve the array
indexing safety at a number of places in the compiler/elaborator.
2024-11-20 09:52:38 +00:00
Kim Morrison
c8b4f6b511 feat: duplicate List.attach/attachWith/pmap API for Array (#6132)
This PR duplicates the verification API for
`List.attach`/`attachWith`/`pmap` over to `Array`.
2024-11-20 01:16:48 +00:00
Luisa Cicolini
3c7555168d feat: add BitVec.(msb, getMsbD)_(rotateLeft, rotateRight) (#6120)
This PR adds theorems `BitVec.(getMsbD, msb)_(rotateLeft, rotateRight)`.

We follow the same strategy taken for `getLsbD`, constructing the
necessary auxilliary theorems first (relying on different hypotheses)
and then generalizing.

---------

Co-authored-by: Siddharth <siddu.druid@gmail.com>
Co-authored-by: Tobias Grosser <tobias@grosser.es>
2024-11-19 23:04:14 +00:00
Kyle Miller
5eef3d27fb feat: have #print show precise fields of structures (#6096)
This PR improves the `#print` command for structures to show all fields
and which parents the fields were inherited from, hiding internal
details such as which parents are represented as subobjects. This
information is still present in the constructor if needed. The pretty
printer for private constants is also improved, and it now handles
private names from the current module like any other name; private names
from other modules are made hygienic.

Example output for `#print Monad`:
```
class Monad.{u, v} (m : Type u → Type v) : Type (max (u + 1) v)
number of parameters: 1
parents:
  Monad.toApplicative : Applicative m
  Monad.toBind : Bind m
fields:
  Functor.map : {α β : Type u} → (α → β) → m α → m β
  Functor.mapConst : {α β : Type u} → α → m β → m α
  Pure.pure : {α : Type u} → α → m α
  Seq.seq : {α β : Type u} → m (α → β) → (Unit → m α) → m β
  SeqLeft.seqLeft : {α β : Type u} → m α → (Unit → m β) → m α
  SeqRight.seqRight : {α β : Type u} → m α → (Unit → m β) → m β
  Bind.bind : {α β : Type u} → m α → (α → m β) → m β
constructor:
  Monad.mk.{u, v} {m : Type u → Type v} [toApplicative : Applicative m] [toBind : Bind m] : Monad m
resolution order:
  Monad, Applicative, Bind, Functor, Pure, Seq, SeqLeft, SeqRight
```

Suggested by Floris van Doorn [on
Zulip](https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/.23print.20command.20for.20structures/near/482503637).
2024-11-19 21:54:45 +00:00
Leonardo de Moura
75d1504af2 fix: isDefEq for constants with different universe parameters (#6131)
This PR fixes a bug at the definitional equality test (`isDefEq`). At
unification constraints of the form `c.{u} =?= c.{v}`, it was not trying
to unfold `c`. This bug did not affect the kernel.

closes #6117
2024-11-19 21:39:13 +00:00
Mario Carneiro
a00cf6330f fix: add a missing case to Level.geq (#2689)
This PR adds a case to `Level.geq` that is present in the kernel's level
`is_geq` procedure, making them consistent with one another.

This came up during testing of `lean4lean`. Currently `Level.geq`
differs from `level::is_geq` in the case of `max u v >= imax u v`. The
elaborator function is overly pessimistic and yields `false` on this
while the kernel function yields true. This comes up concretely in the
`Trans` class:
```lean
class Trans (r : α → β → Sort u) (s : β → γ → Sort v) (t : outParam (α → γ → Sort w)) where
  trans : r a b → s b c → t a c
```
The type of this class is `Sort (max (max (max (max (max (max 1 u) u_1)
u_2) u_3) v) w)` (where `u_1 u_2 u_3` are the levels of `α β γ`), but if
you try writing that type explicitly then the `class` command fails.
Omitting the type leaves the `class` to infer the universe level (the
command assumes the level is correct, and the kernel agrees it is), but
including the type then the elaborator checks the level inequality with
`Level.geq` and fails.

---------

Co-authored-by: Kyle Miller <kmill31415@gmail.com>
2024-11-19 21:27:00 +00:00
Leonardo de Moura
1f32477385 fix: isDefEq when zetaDelta := false (#6129)
This PR fixes a bug at `isDefEq` when `zetaDelta := false`. See new test
for a small example that exposes the issue.
2024-11-19 21:22:02 +00:00
Thomas Köppe
91c14c7ee9 fix: only consider salient bytes in sharecommon eq, hash (#5840)
This PR changes `lean_sharecommon_{eq,hash}` to only consider the
salient bytes of an object, and not any bytes of any
unspecified/uninitialized unused capacity.

Accessing uninitialized storage results in undefined behaviour.

This does not seem to have any semantics disadvantages: If objects
compare equal after this change, their salient bytes are still equal. By
contrast, if the actual identity of allocations needs to be
distinguished, that can be done by just comparing pointers to the
storage.

If we wanted to retain the current logic, we would need initialize the
otherwise unused parts to some specific value to avoid the undefined
behaviour.

Closes #5831
2024-11-19 13:56:46 +00:00
Lean stage0 autoupdater
69530afdf9 chore: update stage0 2024-11-19 13:06:43 +00:00
Marc Huisinga
b7667c1604 fix: don't issue atomic id completions when there is a dangling dot (#5837)
This PR fixes an old auto-completion bug where `x.` would issue
nonsensical completions when `x.` could not be elaborated as a dot
completion.
2024-11-19 12:23:41 +00:00
Eric Wieser
d6f898001b chore: generalize List.get_mem (#6095)
This is syntactically more general than before, though up to eta
expansion it make no difference.
2024-11-19 11:08:10 +00:00
Marc Huisinga
a38566693b test: fix brittle structure instance completion test (#6127)
#5835 contains a brittle test that uses an FVar ID, which caused a
failure on master. This PR changes that test to use a declaration
instead.
2024-11-19 10:13:51 +00:00
Marc Huisinga
4bef3588b5 chore: update stage0 2024-11-19 09:26:58 +01:00
Marc Huisinga
64538cf6e8 chore: prepare for bootstrap
Co-Authored-By: Sebastian Ullrich <sebasti@nullri.ch>
2024-11-19 09:26:58 +01:00
Marc Huisinga
aadf3f1d2c feat: use new structInstFields parser to tag structure instance fields 2024-11-19 09:26:58 +01:00
Marc Huisinga
95bf45ff8b refactor: split Completion.lean 2024-11-19 09:26:58 +01:00
Marc Huisinga
2a02c121cf feat: structure auto-completion & partial InfoTrees 2024-11-19 09:26:58 +01:00
Mac Malone
4600bb16fc feat: use BaseIO at IO.rand (#6102)
This PR moves `IO.rand` and `IO.setRandSeed` to be in the `BaseIO`
monad.

This is their proper monad as neither can error.
2024-11-19 05:26:03 +00:00
Kim Morrison
7ccdfc30ff chore: turn off pp.mvars in apply? results (#6108)
Per request on
[zulip](https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/apply.3F.20using.20tombstones/near/482895588).
2024-11-19 02:02:32 +00:00
Kim Morrison
7f0bdefb6e chore: fix apply? error reporting when out of heartbeats (#6121) 2024-11-19 00:57:59 +00:00
Joachim Breitner
799b2b6628 fix: handle reordered indices in structural recursion (#6116)
This PR fixes a bug where structural recursion did not work when indices
of the recursive argument appeared as function parameters in a different
order than in the argument's type's definition.

Fixes #6015.
2024-11-18 11:28:02 +00:00
David Thrane Christiansen
b8d6e44c4f fix: liberalize rules for atoms by allowing leading '' (#6114)
This PR liberalizes atom rules by allowing `''` to be a prefix of an
atom, after #6012 only added an exception for `''` alone, and also adds
some unit tests for atom validation.
2024-11-18 10:19:20 +00:00
Kim Morrison
5a99cb326c chore: make Lean.Elab.Command.mkMetaContext public (#6113) 2024-11-18 06:14:34 +00:00
Kim Morrison
e10fac93a6 feat: lemmas for Array.findSome? and find? (#6111)
This PR fills in the API for `Array.findSome?` and `Array.find?`,
transferring proofs from the corresponding List statements.
2024-11-18 04:19:56 +00:00
Kyle Miller
62ae320e1c chore: document Lean.Elab.StructInst, refactor (#6110)
This PR does some mild refactoring of the `Lean.Elab.StructInst` module
while adding documentation.

Documentation is drawn from @thorimur's #1928.
2024-11-18 02:57:22 +00:00
Leonardo de Moura
98b1edfc1f fix: backtrack at injection failure (#6109)
This PR fixes an issue in the `injection` tactic. This tactic may
execute multiple sub-tactics. If any of them fail, we must backtrack the
partial assignment. This issue was causing the error: "`mvarId` is
already assigned" in issue #6066. The issue is not yet resolved, as the
equation generator for the match expressions is failing in the example
provided in this issue.
2024-11-18 02:26:06 +00:00
Leonardo de Moura
ab162b3f52 fix: isDefEq, whnf, simp caching and configuration (#6053)
This PR fixes the caching infrastructure for `whnf` and `isDefEq`,
ensuring the cache accounts for all relevant configuration flags. It
also cleans up the `WHNF.lean` module and improves the configuration of
`whnf`.
2024-11-18 01:17:26 +00:00
Kim Morrison
b8a13ab755 chore: fix naming of left/right injectivity lemmas (#6106)
We've been internally inconsistent on the naming of these lemmas in
Lean; this changes them to match Mathlib (which, moreover, I think is
correct).
2024-11-18 00:53:46 +00:00
Sebastian Ullrich
405593ea28 chore: avoid stack overflow in debug tests (#6103) 2024-11-17 14:54:49 +00:00
Kim Morrison
24f305c0e3 chore: fix canonicalizer handling over forall/lambda (#6082)
This PR changes how the canonicalizer handles `forall` and `lambda`,
replacing bvars with temporary fvars. Fixes a bug reported by @hrmacbeth
on
[zulip](https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/Quantifiers.20in.20CanonM/near/482483448).
2024-11-17 07:34:45 +00:00
Leonardo de Moura
5d553d6369 fix: circular assignment at structure instance elaborator (#6105)
This PR fixes a stack overflow caused by a cyclic assignment in the
metavariable context. The cycle is unintentionally introduced by the
structure instance elaborator.

closes #3150
2024-11-17 00:56:52 +00:00
Sebastian Ullrich
a449e3fdd6 feat: IO.getTID (#6049)
This PR adds a primitive for accessing the current thread ID

To be used in a thread-aware trace profiler
2024-11-16 19:13:11 +00:00
Kyle Miller
764386734c fix: improvements to change tactic (#6022)
This PR makes the `change` tactic and conv tactic use the same
elaboration strategy. It works uniformly for both the target and local
hypotheses. Now `change` can assign metavariables, for example:
```lean
example (x y z : Nat) : x + y = z := by
  change ?a = _
  let w := ?a
  -- now `w : Nat := x + y`
```
2024-11-16 07:08:29 +00:00
Kyle Miller
7f1d7a595b fix: use Expr.equal instead of == in MVarId.replaceTargetDefEq and MVarId.replaceLocalDeclDefEq (#6098)
This PR modifies `Lean.MVarId.replaceTargetDefEq` and
`Lean.MVarId.replaceLocalDeclDefEq` to use `Expr.equal` instead of
`Expr.eqv` when determining whether the expression has changed. This is
justified on the grounds that binder names and binder infos are
user-visible and affect elaboration.
2024-11-16 02:03:16 +00:00
Leonardo de Moura
f13e5ca852 chore: naming convention and NaN normalization (#6097)
Changes:
- `Float.fromBits` => `Float.ofBits`
- NaN normalization
2024-11-16 00:14:28 +00:00
Leonardo de Moura
ecbaeff24b feat: add Float.toBits and Float.fromBits (#6094)
This PR adds raw transmutation of floating-point numbers to and from
`UInt64`. Floats and UInts share the same endianness across all
supported platforms. The IEEE 754 standard precisely specifies the bit
layout of floats. Note that `Float.toBits` is distinct from
`Float.toUInt64`, which attempts to preserve the numeric value rather
than the bitwise value.

closes #6071
2024-11-15 19:45:19 +00:00
Kyle Miller
691acde696 feat: pp.parens option to pretty print with all parentheses (#2934)
This PR adds the option `pp.parens` (default: false) that causes the
pretty printer to eagerly insert parentheses, which can be useful for
teaching and for understanding the structure of expressions. For
example, it causes `p → q → r` to pretty print as `p → (q → r)`.

Any notations with precedence greater than or equal to `maxPrec` do not
receive such discretionary parentheses, since this precedence level is
considered to be infinity.

This option was a feature in the Lean 3 community edition.
2024-11-15 19:11:54 +00:00
Kyle Miller
b1e0c1b594 chore: remove decide! tactic (#6016)
This PR removes the `decide!` tactic in favor of `decide +kernel`
(breaking change).
2024-11-15 17:49:33 +00:00
Joachim Breitner
93b4ec0351 refactor: use mkFreshUserName in ArgsPacker (#6093)
and other small refinements done while investigating an issue; not
actually user-visible.
2024-11-15 15:59:14 +00:00
JovanGerb
f06fc30c0b perf: remove @[specialize] from mkBinding (#6019)
This PR removes @[specilize] from `MkBinding.mkBinding`, which is a
function that cannot be specialized (as none of its arguments are
functions). As a result, the specializable function `Nat.foldRevM.loop`
doesn't get specialized, which leads to worse performing code.

As expected, the mathlib bench shows a very small improvement. About 95%
of files show a speedup.
(http://speed.lean-fro.org/mathlib4/compare/e7b27246-a3e6-496a-b552-ff4b45c7236e/to/6033df75-aa53-44d9-819d-51f93fc05e94?hash1=b28f0d7f7e9cc3949a9a3556a6b36513f37f690d)
2024-11-15 15:06:49 +00:00
Markus Himmel
64b35a8c19 perf: add LEAN_ALWAYS_INLINE to some functions (#6045)
Otherwise, clang refuses to inline them for large functions which leads
to a performance cliff.
2024-11-15 15:05:32 +00:00
Markus Himmel
688ee4c887 fix: constant folding for Nat.ble and Nat.blt (#6087)
This PR fixes a bug in the constant folding for the `Nat.ble` and
`Nat.blt` function in the old code generator, leading to a
miscompilation.

Closes #6086
2024-11-15 12:09:52 +00:00
Henrik Böving
9a3dd615e0 chore: bv_decide remove noop rewrites (#6080)
Merely removes rules that are actually just syntactic aliases but equal
at the `Expr` level.
2024-11-15 11:41:54 +00:00
Violeta Hernández
7e6363dc05 chore: join → flatten in docstring (#6040)
Update the docstring of `List.flatten`.
2024-11-15 10:11:42 +00:00
Kim Morrison
a074bd9a2b feat: implementation of Array.pmap (#6052)
This PR adds `Array.pmap`, as well as a `@[csimp]` lemma in terms of the
no-copy `Array.attachWith`.
2024-11-15 02:10:04 +00:00
Kyle Miller
498d41633b fix: pretty print .coeFun with terminfo of coercee (#6085)
This PR improves the term info for coercions marked with
`CoeFnType.coeFun` (such as `DFunLike.coe` in Mathlib), making "go to
definition" on the function name work. Hovering over such a coerced
function will show the coercee rather than the coercion expression. The
coercion expression can still be seen by hovering over the whitespace in
the function application.
2024-11-15 01:45:38 +00:00
Sofia Rodrigues
e0d7c3ac79 feat: add date and time functionality (#4904)
This PR introduces date and time functionality to the Lean 4 Std.

Breaking Changes:
- `Lean.Data.Rat` is now `Std.Internal.Rat` because it's used by the
DateTime library.

---------

Co-authored-by: Markus Himmel <markus@himmel-villmar.de>
Co-authored-by: Mac Malone <tydeu@hatpress.net>
2024-11-14 14:04:19 +00:00
Joachim Breitner
6a5b122b40 perf: use RArray in simp_arith meta code (#6068 part 2)
This PR makes `simp_arith` use `RArray` for the context of the
reflection proofs, which scales better when there are many variables.

On our synthetic benchmark:
```
simp_arith1               instructions    -25.1% (-4892.6 σ)
```

No effect on mathlib, though, guess it’s not used much on large goals there:
http://speed.lean-fro.org/mathlib4/compare/873b982b-2038-462a-9b68-0c0fc457f90d/to/56e66691-2f1f-4947-a922-37b80680315d
2024-11-14 14:08:48 +01:00
Joachim Breitner
bf9ddf2c74 chore: update stage0 2024-11-14 14:08:48 +01:00
Joachim Breitner
3f47871e73 perf: use RArray in simp_arith meta code (#6068 part 1)
This PR prepares #6068 by using the `RArray` data structure in
`simp_arith` the simp-arith meta code.

After the subsequent stage0 we can change the simp-arith theorems in
`Init`.
2024-11-14 14:08:48 +01:00
Joachim Breitner
85f25967ea feat: Lean.RArray (#6070)
This PR adds the Lean.RArray data structure.

This data structure is equivalent to `Fin n → α` or `Array α`, but
optimized for a fast kernel-reduction `get` operation.

It is not suitable as a general-purpose data structure. The primary
intended use case is the “denote” function of a typical proof by
reflection proof, where only the `get` operation is necessary, and where
using `List.get` unnecessarily slows down proofs with more than a
hand-full of atomic expressions.


There is no well-formedness invariant attached to this data structure,
to keep it concise; it's semantics is given through `RArray.get`. In
that way one can also view an `RArray` as a decision tree implementing
`Nat → α`.

In #6068 this data structure is used in `simp_arith`.
2024-11-14 10:56:50 +00:00
David Thrane Christiansen
8e1ddbc5aa fix: validate atoms modulo leading and trailing whitespace (#6012)
This PR improves the validation of new syntactic tokens. Previously, the
validation code had inconsistencies: some atoms would be accepted only
if they had a leading space as a pretty printer hint. Additionally,
atoms with internal whitespace are no longer allowed.

Closes #6011
2024-11-14 10:40:17 +00:00
Henrik Böving
e6e39f502f feat: add options to configure all of bv_decide's preprocessing (#6077)
This PR adds options to `bv_decide`'s configuration structure such that
all non mandatory preprocessing passes can be disabled.
2024-11-14 09:22:23 +00:00
Henrik Böving
debb82bc20 perf: make andFlattening work on deeply nested hyps in one pass (#6075)
No changelog as this PR improves performance of a feature that is not
yet released.
2024-11-14 09:09:25 +00:00
Violeta Hernández
9a85433477 refactor: allow Sort u in Squash (#6074)
Co-authored-by: Kim Morrison <kim@tqft.net>
2024-11-14 05:55:21 +00:00
Mac Malone
4616c0ac3e refactor: lake: avoid v! in builtin code (#6073)
Use of `v!` in Lake code can cause bootstrapping failures and is easily
avoided. It is perfectly safe in user code.
2024-11-14 05:00:02 +00:00
Leonardo de Moura
e55b681774 feat: add Context.setConfig (#6072)
This PR adds `Lean.Simp.Context.setConfig` function.
2024-11-14 00:32:13 +00:00
Kim Morrison
63132105ba feat: lemmas about for loops over Array (#6055)
This PR adds lemmas about for loops over `Array`, following the existing
lemmas for `List`.
2024-11-13 23:23:55 +00:00
Kim Morrison
350b36411c chore: upstream some NameMap functions (#6056) 2024-11-13 23:22:01 +00:00
Kim Morrison
1c30c76e72 chore: remove >6 month old deprecations (#6057) 2024-11-13 23:21:23 +00:00
Alissa Tung
d5adadc00e chore: add newline at end of file for lake new templates (#6026)
This PR adds a newline at end of each Lean file generated by `lake new`
templates.

I have tested it with a locally compiled Lean with this commit. I hope
these changes make `lake new`'s behavior more consistent with the Lean 4
plugins and libraries newlines convention.
2024-11-13 19:39:47 +00:00
Mac Malone
f08805e5c4 feat: message kinds (#5945)
This PR adds a new definition `Message.kind` which returns the top-level
tag of a message. This is serialized as the new field `kind` in
`SerialMessaege` so that i can be used by external consumers (e.g.,
Lake) to identify messages via `lean --json`.

The tag of trace messages has also been changed from `_traceMsg` to the
more friendly `trace`.
2024-11-13 18:05:52 +00:00
Joachim Breitner
256b49bda9 perf: optimize Nat.Linear.Poly.norm (#6064)
Not a huge benefit, but actually reduces the code complexity (no need
for the `.fuse` function), and can help with problems with many repeated
varibles.
2024-11-13 17:36:51 +00:00
Kyle Miller
28cf146d00 fix: make sure monad lift coercion elaborator has no side effects (#6024)
This PR fixes a bug where the monad lift coercion elaborator would
partially unify expressions even if they were not monads. This could be
taken advantage of to propagate information that could help elaboration
make progress, for example the first `change` worked because the monad
lift coercion elaborator was unifying `@Eq _ _` with `@Eq (Nat × Nat)
p`:
```lean
example (p : Nat × Nat) : p = p := by
  change _ = ⟨_, _⟩ -- used to work (yielding `p = (p.fst, p.snd)`), now it doesn't
  change ⟨_, _⟩ = _ -- never worked
```
As such, this is a breaking change; you may need to adjust expressions
to include additional implicit arguments.
2024-11-13 16:22:31 +00:00
Joachim Breitner
970261b1e1 perf: optimize Nat.Linear.Expr.toPoly (#6062) 2024-11-13 15:54:29 +00:00
Joachim Breitner
6b811f8c92 test: synthetic simp_arith benchmark (#6061)
This PR adds a simp_arith benchmark.

This benchmark highlights some improvable asymptotics in `Nat.Linear`,
which
will be fixed subsequently.
2024-11-13 15:49:52 +00:00
Henrik Böving
f721f94045 feat: Bool.to(U)IntX (#6060)
This PR implements conversion functions from `Bool` to all `UIntX` and
`IntX` types.

Note that `Bool.toUInt64` already existed in previous versions of Lean.
2024-11-13 15:49:16 +00:00
Sebastian Ullrich
86524d5c23 fix: line break in simp? output (#6048)
This PR fixes `simp?` suggesting output with invalid indentation 

Fixes #6006
2024-11-13 15:49:11 +00:00
Joachim Breitner
f18d9e04bc refactor: omega: avoid MVar machinery (#5991)
This PR simplifies the implementation of `omega`.

When constructing the proof, `omega` is using MVars only for the purpose
of doing case analysis on `Or`. We can simplify the implementation a
fair bit if we just produce the proof directly using `Or.elim`.

While it didn’t yield the performance benefits I was hoping for, this
still seems a worthwhile simplification, now that we already have it.
2024-11-13 15:49:03 +00:00
Joachim Breitner
fa33423c84 chore: pr-body: run as part of merge_group, but do not do anything (#6069) 2024-11-13 15:47:58 +00:00
Leonardo de Moura
1315266dd3 refactor: mark the Simp.Context constructor as private
motivation: this is the first step to fix the mismatch
between `isDefEq` and the discrimination tree indexing.
2024-11-13 14:12:55 +11:00
Leonardo de Moura
b1e52f1475 chore: mark Meta.Context.config as private (#6051)
Motivation: we want to modify the internal representation and improve
`isDefEq` caching.
This PR is preparing the stage for future modifications.
2024-11-13 13:30:06 +11:00
Kim Morrison
985600f448 chore: update stage0 2024-11-13 11:16:34 +11:00
Kim Morrison
ace6248e20 chore: deprecate Array.sequenceMap 2024-11-13 11:16:34 +11:00
Lean stage0 autoupdater
9f42368e1a chore: update stage0 2024-11-12 13:28:14 +00:00
Kim Morrison
a401368384 feat: various minor changes to List/Array API (#6044)
Minor emendations to the List/Array API, collected from other PRs that
are still in the pipeline.
2024-11-12 08:27:36 +00:00
Kim Morrison
5e01e628b2 chore: review Array operations argument order (#6041)
This PR modifies the order of arguments for higher-order `Array`
functions, preferring to put the `Array` last (besides positional
arguments with defaults). This is more consistent with the `List` API,
and is more flexible, as dot notation allows two different partially
applied versions.
2024-11-12 04:55:03 +00:00
1192 changed files with 26837 additions and 5885 deletions

View File

@@ -1,7 +1,8 @@
# This workflow allows any user to add one of the `awaiting-review`, `awaiting-author`, `WIP`,
# or `release-ci` labels by commenting on the PR or issue.
# `release-ci`, or a `changelog-XXX` label by commenting on the PR or issue.
# If any labels from the set {`awaiting-review`, `awaiting-author`, `WIP`} are added, other labels
# from that set are removed automatically at the same time.
# Similarly, if any `changelog-XXX` label is added, other `changelog-YYY` labels are removed.
name: Label PR based on Comment
@@ -11,7 +12,7 @@ on:
jobs:
update-label:
if: github.event.issue.pull_request != null && (contains(github.event.comment.body, 'awaiting-review') || contains(github.event.comment.body, 'awaiting-author') || contains(github.event.comment.body, 'WIP') || contains(github.event.comment.body, 'release-ci'))
if: github.event.issue.pull_request != null && (contains(github.event.comment.body, 'awaiting-review') || contains(github.event.comment.body, 'awaiting-author') || contains(github.event.comment.body, 'WIP') || contains(github.event.comment.body, 'release-ci') || contains(github.event.comment.body, 'changelog-'))
runs-on: ubuntu-latest
steps:
@@ -20,13 +21,14 @@ jobs:
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
script: |
const { owner, repo, number: issue_number } = context.issue;
const { owner, repo, number: issue_number } = context.issue;
const commentLines = context.payload.comment.body.split('\r\n');
const awaitingReview = commentLines.includes('awaiting-review');
const awaitingAuthor = commentLines.includes('awaiting-author');
const wip = commentLines.includes('WIP');
const releaseCI = commentLines.includes('release-ci');
const changelogMatch = commentLines.find(line => line.startsWith('changelog-'));
if (awaitingReview || awaitingAuthor || wip) {
await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'awaiting-review' }).catch(() => {});
@@ -47,3 +49,19 @@ jobs:
if (releaseCI) {
await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['release-ci'] });
}
if (changelogMatch) {
const changelogLabel = changelogMatch.trim();
const { data: existingLabels } = await github.rest.issues.listLabelsOnIssue({ owner, repo, issue_number });
const changelogLabels = existingLabels.filter(label => label.name.startsWith('changelog-'));
// Remove all other changelog labels
for (const label of changelogLabels) {
if (label.name !== changelogLabel) {
await github.rest.issues.removeLabel({ owner, repo, issue_number, name: label.name }).catch(() => {});
}
}
// Add the new changelog label
await github.rest.issues.addLabels({ owner, repo, issue_number, labels: [changelogLabel] });
}

View File

@@ -1,6 +1,7 @@
name: Check PR body for changelog convention
on:
merge_group:
pull_request:
types: [opened, synchronize, reopened, edited, labeled, converted_to_draft, ready_for_review]
@@ -9,6 +10,7 @@ jobs:
runs-on: ubuntu-latest
steps:
- name: Check PR body
if: github.event_name == 'pull_request'
uses: actions/github-script@v7
with:
script: |

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

@@ -82,9 +82,7 @@ theorem Expr.typeCheck_correct (h₁ : HasType e ty) (h₂ : e.typeCheck ≠ .un
/-!
Now, we prove that if `Expr.typeCheck e` returns `Maybe.unknown`, then forall `ty`, `HasType e ty` does not hold.
The notation `e.typeCheck` is sugar for `Expr.typeCheck e`. Lean can infer this because we explicitly said that `e` has type `Expr`.
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used to rename "inaccessible" variables.
We say a variable is inaccessible if it is introduced by a tactic (e.g., `cases`) or has been shadowed by another variable introduced
by the user. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
The proof is by induction on `e` and case analysis. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
the cases corresponding to the constructors `Expr.nat` and `Expr.bool`.
-/
theorem Expr.typeCheck_complete {e : Expr} : e.typeCheck = .unknown ¬ HasType e ty := by

View File

@@ -170,7 +170,7 @@ lib.warn "The Nix-based build is deprecated" rec {
ln -sf ${lean-all}/* .
'';
buildPhase = ''
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi' -j$NIX_BUILD_CORES
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi|leanruntest_timeIO' -j$NIX_BUILD_CORES
'';
installPhase = ''
mkdir $out

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

@@ -1922,12 +1922,12 @@ represents an element of `Squash α` the same as `α` itself
`Squash.lift` will extract a value in any subsingleton `β` from a function on `α`,
while `Nonempty.rec` can only do the same when `β` is a proposition.
-/
def Squash (α : Type u) := Quot (fun (_ _ : α) => True)
def Squash (α : Sort u) := Quot (fun (_ _ : α) => True)
/-- The canonical quotient map into `Squash α`. -/
def Squash.mk {α : Type u} (x : α) : Squash α := Quot.mk _ x
def Squash.mk {α : Sort u} (x : α) : Squash α := Quot.mk _ x
theorem Squash.ind {α : Type u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
theorem Squash.ind {α : Sort u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
Quot.ind h
/-- If `β` is a subsingleton, then a function `α → β` lifts to `Squash α → β`. -/

View File

@@ -42,3 +42,5 @@ import Init.Data.PLift
import Init.Data.Zero
import Init.Data.NeZero
import Init.Data.Function
import Init.Data.RArray
import Init.Data.Vector

View File

@@ -18,3 +18,5 @@ import Init.Data.Array.Bootstrap
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

View File

@@ -10,6 +10,17 @@ import Init.Data.List.Attach
namespace Array
/--
`O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on
`a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l`
but is defined only when all members of `l` satisfy `P`, using the proof
to apply `f`.
We replace this at runtime with a more efficient version via the `csimp` lemma `pmap_eq_pmapImpl`.
-/
def pmap {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) : Array β :=
(l.toList.pmap f (fun a m => H a (mem_def.mpr m))).toArray
/--
Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
`Array {x // P x}` is the same as the input `Array α`.
@@ -35,6 +46,10 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
l.toArray.attach = (l.attachWith (· l.toArray) (by simp)).toArray := by
simp [attach]
@[simp] theorem _root_.List.pmap_toArray {l : List α} {P : α Prop} {f : a, P a β} {H : a l.toArray, P a} :
l.toArray.pmap f H = (l.pmap f (by simpa using H)).toArray := by
simp [pmap]
@[simp] theorem toList_attachWith {l : Array α} {P : α Prop} {H : x l, P x} :
(l.attachWith P H).toList = l.toList.attachWith P (by simpa [mem_toList] using H) := by
simp [attachWith]
@@ -43,6 +58,387 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
l.attach.toList = l.toList.attachWith (· l) (by simp [mem_toList]) := by
simp [attach]
@[simp] theorem toList_pmap {l : Array α} {P : α Prop} {f : a, P a β} {H : a l, P a} :
(l.pmap f H).toList = l.toList.pmap f (fun a m => H a (mem_def.mpr m)) := by
simp [pmap]
/-- Implementation of `pmap` using the zero-copy version of `attach`. -/
@[inline] private def pmapImpl {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) :
Array β := (l.attachWith _ H).map fun x, h' => f x h'
@[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by
funext α β p f L h'
cases L
simp only [pmap, pmapImpl, List.attachWith_toArray, List.map_toArray, mk.injEq, List.map_attachWith]
apply List.pmap_congr_left
intro a m h₁ h₂
congr
@[simp] theorem pmap_empty {P : α Prop} (f : a, P a β) : pmap f #[] (by simp) = #[] := rfl
@[simp] theorem pmap_push {P : α Prop} (f : a, P a β) (a : α) (l : Array α) (h : b l.push a, P b) :
pmap f (l.push a) h =
(pmap f l (fun a m => by simp at h; exact h a (.inl m))).push (f a (h a (by simp))) := by
simp [pmap]
@[simp] theorem attach_empty : (#[] : Array α).attach = #[] := rfl
@[simp] theorem attachWith_empty {P : α Prop} (H : x #[], P x) : (#[] : Array α).attachWith P H = #[] := rfl
@[simp] theorem _root_.List.attachWith_mem_toArray {l : List α} :
l.attachWith (fun x => x l.toArray) (fun x h => by simpa using h) =
l.attach.map fun x, h => x, by simpa using h := by
simp only [List.attachWith, List.attach, List.map_pmap]
apply List.pmap_congr_left
simp
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (l : Array α) (H) :
@pmap _ _ p (fun a _ => f a) l H = map f l := by
cases l; simp
theorem pmap_congr_left {p q : α Prop} {f : a, p a β} {g : a, q a β} (l : Array α) {H₁ H₂}
(h : a l, (h₁ h₂), f a h₁ = g a h₂) : pmap f l H₁ = pmap g l H₂ := by
cases l
simp only [mem_toArray] at h
simp only [List.pmap_toArray, mk.injEq]
rw [List.pmap_congr_left _ h]
theorem map_pmap {p : α Prop} (g : β γ) (f : a, p a β) (l H) :
map g (pmap f l H) = pmap (fun a h => g (f a h)) l H := by
cases l
simp [List.map_pmap]
theorem pmap_map {p : β Prop} (g : b, p b γ) (f : α β) (l H) :
pmap g (map f l) H = pmap (fun a h => g (f a) h) l fun _ h => H _ (mem_map_of_mem _ h) := by
cases l
simp [List.pmap_map]
theorem attach_congr {l₁ l₂ : Array α} (h : l₁ = l₂) :
l₁.attach = l₂.attach.map (fun x => x.1, h x.2) := by
subst h
simp
theorem attachWith_congr {l₁ l₂ : Array α} (w : l₁ = l₂) {P : α Prop} {H : x l₁, P x} :
l₁.attachWith P H = l₂.attachWith P fun _ h => H _ (w h) := by
subst w
simp
@[simp] theorem attach_push {a : α} {l : Array α} :
(l.push a).attach =
(l.attach.map (fun x, h => x, mem_push_of_mem a h)).push a, by simp := by
cases l
rw [attach_congr (List.push_toArray _ _)]
simp [Function.comp_def]
@[simp] theorem attachWith_push {a : α} {l : Array α} {P : α Prop} {H : x l.push a, P x} :
(l.push a).attachWith P H =
(l.attachWith P (fun x h => by simp at H; exact H x (.inl h))).push a, H a (by simp) := by
cases l
simp [attachWith_congr (List.push_toArray _ _)]
theorem pmap_eq_map_attach {p : α Prop} (f : a, p a β) (l H) :
pmap f l H = l.attach.map fun x => f x.1 (H _ x.2) := by
cases l
simp [List.pmap_eq_map_attach]
theorem attach_map_coe (l : Array α) (f : α β) :
(l.attach.map fun (i : {i // i l}) => f i) = l.map f := by
cases l
simp [List.attach_map_coe]
theorem attach_map_val (l : Array α) (f : α β) : (l.attach.map fun i => f i.val) = l.map f :=
attach_map_coe _ _
@[simp]
theorem attach_map_subtype_val (l : Array α) : l.attach.map Subtype.val = l := by
cases l; simp
theorem attachWith_map_coe {p : α Prop} (f : α β) (l : Array α) (H : a l, p a) :
((l.attachWith p H).map fun (i : { i // p i}) => f i) = l.map f := by
cases l; simp
theorem attachWith_map_val {p : α Prop} (f : α β) (l : Array α) (H : a l, p a) :
((l.attachWith p H).map fun i => f i.val) = l.map f :=
attachWith_map_coe _ _ _
@[simp]
theorem attachWith_map_subtype_val {p : α Prop} (l : Array α) (H : a l, p a) :
(l.attachWith p H).map Subtype.val = l := by
cases l; simp
@[simp]
theorem mem_attach (l : Array α) : x, x l.attach
| a, h => by
have := mem_map.1 (by rw [attach_map_subtype_val] <;> exact h)
rcases this with _, _, m, rfl
exact m
@[simp]
theorem mem_pmap {p : α Prop} {f : a, p a β} {l H b} :
b pmap f l H (a : _) (h : a l), f a (H a h) = b := by
simp only [pmap_eq_map_attach, mem_map, mem_attach, true_and, Subtype.exists, eq_comm]
theorem mem_pmap_of_mem {p : α Prop} {f : a, p a β} {l H} {a} (h : a l) :
f a (H a h) pmap f l H := by
rw [mem_pmap]
exact a, h, rfl
@[simp]
theorem size_pmap {p : α Prop} {f : a, p a β} {l H} : (pmap f l H).size = l.size := by
cases l; simp
@[simp]
theorem size_attach {L : Array α} : L.attach.size = L.size := by
cases L; simp
@[simp]
theorem size_attachWith {p : α Prop} {l : Array α} {H} : (l.attachWith p H).size = l.size := by
cases l; simp
@[simp]
theorem pmap_eq_empty_iff {p : α Prop} {f : a, p a β} {l H} : pmap f l H = #[] l = #[] := by
cases l; simp
theorem pmap_ne_empty_iff {P : α Prop} (f : (a : α) P a β) {xs : Array α}
(H : (a : α), a xs P a) : xs.pmap f H #[] xs #[] := by
cases xs; simp
theorem pmap_eq_self {l : Array α} {p : α Prop} (hp : (a : α), a l p a)
(f : (a : α) p a α) : l.pmap f hp = l a (h : a l), f a (hp a h) = a := by
cases l; simp [List.pmap_eq_self]
@[simp]
theorem attach_eq_empty_iff {l : Array α} : l.attach = #[] l = #[] := by
cases l; simp
theorem attach_ne_empty_iff {l : Array α} : l.attach #[] l #[] := by
cases l; simp
@[simp]
theorem attachWith_eq_empty_iff {l : Array α} {P : α Prop} {H : a l, P a} :
l.attachWith P H = #[] l = #[] := by
cases l; simp
theorem attachWith_ne_empty_iff {l : Array α} {P : α Prop} {H : a l, P a} :
l.attachWith P H #[] l #[] := by
cases l; simp
@[simp]
theorem getElem?_pmap {p : α Prop} (f : a, p a β) {l : Array α} (h : a l, p a) (n : Nat) :
(pmap f l h)[n]? = Option.pmap f l[n]? fun x H => h x (mem_of_getElem? H) := by
cases l; simp
@[simp]
theorem getElem_pmap {p : α Prop} (f : a, p a β) {l : Array α} (h : a l, p a) {n : Nat}
(hn : n < (pmap f l h).size) :
(pmap f l h)[n] =
f (l[n]'(@size_pmap _ _ p f l h hn))
(h _ (getElem_mem (@size_pmap _ _ p f l h hn))) := by
cases l; simp
@[simp]
theorem getElem?_attachWith {xs : Array α} {i : Nat} {P : α Prop} {H : a xs, P a} :
(xs.attachWith P H)[i]? = xs[i]?.pmap Subtype.mk (fun _ a => H _ (mem_of_getElem? a)) :=
getElem?_pmap ..
@[simp]
theorem getElem?_attach {xs : Array α} {i : Nat} :
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => mem_of_getElem? a) :=
getElem?_attachWith
@[simp]
theorem getElem_attachWith {xs : Array α} {P : α Prop} {H : a xs, P a}
{i : Nat} (h : i < (xs.attachWith P H).size) :
(xs.attachWith P H)[i] = xs[i]'(by simpa using h), H _ (getElem_mem (by simpa using h)) :=
getElem_pmap ..
@[simp]
theorem getElem_attach {xs : Array α} {i : Nat} (h : i < xs.attach.size) :
xs.attach[i] = xs[i]'(by simpa using h), getElem_mem (by simpa using h) :=
getElem_attachWith h
theorem foldl_pmap (l : Array α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : γ β γ) (x : γ) :
(l.pmap f H).foldl g x = l.attach.foldl (fun acc a => g acc (f a.1 (H _ a.2))) x := by
rw [pmap_eq_map_attach, foldl_map]
theorem foldr_pmap (l : Array α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : β γ γ) (x : γ) :
(l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
rw [pmap_eq_map_attach, foldr_map]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldl_subtype` below.
-/
theorem foldl_attach (l : Array α) (f : β α β) (b : β) :
l.attach.foldl (fun acc t => f acc t.1) b = l.foldl f b := by
rcases l with l
simp only [List.attach_toArray, List.attachWith_mem_toArray, List.map_attach, size_toArray,
List.length_pmap, List.foldl_toArray', mem_toArray, List.foldl_subtype]
congr
ext
simpa using fun a => List.mem_of_getElem? a
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldr_subtype` below.
-/
theorem foldr_attach (l : Array α) (f : α β β) (b : β) :
l.attach.foldr (fun t acc => f t.1 acc) b = l.foldr f b := by
rcases l with l
simp only [List.attach_toArray, List.attachWith_mem_toArray, List.map_attach, size_toArray,
List.length_pmap, List.foldr_toArray', mem_toArray, List.foldr_subtype]
congr
ext
simpa using fun a => List.mem_of_getElem? a
theorem attach_map {l : Array α} (f : α β) :
(l.map f).attach = l.attach.map (fun x, h => f x, mem_map_of_mem f h) := by
cases l
ext <;> simp
theorem attachWith_map {l : Array α} (f : α β) {P : β Prop} {H : (b : β), b l.map f P b} :
(l.map f).attachWith P H = (l.attachWith (P f) (fun _ h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
cases l
ext
· simp
· simp only [List.map_toArray, List.attachWith_toArray, List.getElem_toArray,
List.getElem_attachWith, List.getElem_map, Function.comp_apply]
erw [List.getElem_attachWith] -- Why is `erw` needed here?
theorem map_attachWith {l : Array α} {P : α Prop} {H : (a : α), a l P a}
(f : { x // P x } β) :
(l.attachWith P H).map f =
l.pmap (fun a (h : a l P a) => f a, H _ h.1) (fun a h => h, H a h) := by
cases l
ext <;> simp
/-- See also `pmap_eq_map_attach` for writing `pmap` in terms of `map` and `attach`. -/
theorem map_attach {l : Array α} (f : { x // x l } β) :
l.attach.map f = l.pmap (fun a h => f a, h) (fun _ => id) := by
cases l
ext <;> simp
theorem attach_filterMap {l : Array α} {f : α Option β} :
(l.filterMap f).attach = l.attach.filterMap
fun x, h => (f x).pbind (fun b m => some b, mem_filterMap.mpr x, h, m) := by
cases l
rw [attach_congr (List.filterMap_toArray f _)]
simp [List.attach_filterMap, List.map_filterMap, Function.comp_def]
theorem attach_filter {l : Array α} (p : α Bool) :
(l.filter p).attach = l.attach.filterMap
fun x => if w : p x.1 then some x.1, mem_filter.mpr x.2, w else none := by
cases l
rw [attach_congr (List.filter_toArray p _)]
simp [List.attach_filter, List.map_filterMap, Function.comp_def]
-- We are still missing here `attachWith_filterMap` and `attachWith_filter`.
-- Also missing are `filterMap_attach`, `filter_attach`, `filterMap_attachWith` and `filter_attachWith`.
theorem pmap_pmap {p : α Prop} {q : β Prop} (g : a, p a β) (f : b, q b γ) (l H₁ H₂) :
pmap f (pmap g l H₁) H₂ =
pmap (α := { x // x l }) (fun a h => f (g a h) (H₂ (g a h) (mem_pmap_of_mem a.2))) l.attach
(fun a _ => H₁ a a.2) := by
cases l
simp [List.pmap_pmap, List.pmap_map]
@[simp] theorem pmap_append {p : ι Prop} (f : a : ι, p a α) (l₁ l₂ : Array ι)
(h : a l₁ ++ l₂, p a) :
(l₁ ++ l₂).pmap f h =
(l₁.pmap f fun a ha => h a (mem_append_left l₂ ha)) ++
l₂.pmap f fun a ha => h a (mem_append_right l₁ ha) := by
cases l₁
cases l₂
simp
theorem pmap_append' {p : α Prop} (f : a : α, p a β) (l₁ l₂ : Array α)
(h₁ : a l₁, p a) (h₂ : a l₂, p a) :
((l₁ ++ l₂).pmap f fun a ha => (mem_append.1 ha).elim (h₁ a) (h₂ a)) =
l₁.pmap f h₁ ++ l₂.pmap f h₂ :=
pmap_append f l₁ l₂ _
@[simp] theorem attach_append (xs ys : Array α) :
(xs ++ ys).attach = xs.attach.map (fun x, h => x, mem_append_left ys h) ++
ys.attach.map fun x, h => x, mem_append_right xs h := by
cases xs
cases ys
rw [attach_congr (List.append_toArray _ _)]
simp [List.attach_append, Function.comp_def]
@[simp] theorem attachWith_append {P : α Prop} {xs ys : Array α}
{H : (a : α), a xs ++ ys P a} :
(xs ++ ys).attachWith P H = xs.attachWith P (fun a h => H a (mem_append_left ys h)) ++
ys.attachWith P (fun a h => H a (mem_append_right xs h)) := by
simp [attachWith, attach_append, map_pmap, pmap_append]
@[simp] theorem pmap_reverse {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs.reverse P a) :
xs.reverse.pmap f H = (xs.pmap f (fun a h => H a (by simpa using h))).reverse := by
induction xs <;> simp_all
theorem reverse_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) :
(xs.pmap f H).reverse = xs.reverse.pmap f (fun a h => H a (by simpa using h)) := by
rw [pmap_reverse]
@[simp] theorem attachWith_reverse {P : α Prop} {xs : Array α}
{H : (a : α), a xs.reverse P a} :
xs.reverse.attachWith P H =
(xs.attachWith P (fun a h => H a (by simpa using h))).reverse := by
cases xs
simp
theorem reverse_attachWith {P : α Prop} {xs : Array α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).reverse = (xs.reverse.attachWith P (fun a h => H a (by simpa using h))) := by
cases xs
simp
@[simp] theorem attach_reverse (xs : Array α) :
xs.reverse.attach = xs.attach.reverse.map fun x, h => x, by simpa using h := by
cases xs
rw [attach_congr (List.reverse_toArray _)]
simp
theorem reverse_attach (xs : Array α) :
xs.attach.reverse = xs.reverse.attach.map fun x, h => x, by simpa using h := by
cases xs
simp
@[simp] theorem back?_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) :
(xs.pmap f H).back? = xs.attach.back?.map fun a, m => f a (H a m) := by
cases xs
simp
@[simp] theorem back?_attachWith {P : α Prop} {xs : Array α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).back? = xs.back?.pbind (fun a h => some a, H _ (mem_of_back?_eq_some h)) := by
cases xs
simp
@[simp]
theorem back?_attach {xs : Array α} :
xs.attach.back? = xs.back?.pbind fun a h => some a, mem_of_back?_eq_some h := by
cases xs
simp
/-! ## unattach
`Array.unattach` is the (one-sided) inverse of `Array.attach`. It is a synonym for `Array.map Subtype.val`.
@@ -83,7 +479,7 @@ def unattach {α : Type _} {p : α → Prop} (l : Array { x // p x }) := l.map (
@[simp] theorem unattach_attach {l : Array α} : l.attach.unattach = l := by
cases l
simp
simp only [List.attach_toArray, List.unattach_toArray, List.unattach_attachWith]
@[simp] theorem unattach_attachWith {p : α Prop} {l : Array α}
{H : a l, p a} :
@@ -91,6 +487,15 @@ def unattach {α : Type _} {p : α → Prop} (l : Array { x // p x }) := l.map (
cases l
simp
@[simp] theorem getElem?_unattach {p : α Prop} {l : Array { x // p x }} (i : Nat) :
l.unattach[i]? = l[i]?.map Subtype.val := by
simp [unattach]
@[simp] theorem getElem_unattach
{p : α Prop} {l : Array { x // p x }} (i : Nat) (h : i < l.unattach.size) :
l.unattach[i] = (l[i]'(by simpa using h)).1 := by
simp [unattach]
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--

View File

@@ -13,6 +13,7 @@ import Init.Data.ToString.Basic
import Init.GetElem
import Init.Data.List.ToArray
import Init.Data.Array.Set
universe u v w
/-! ### Array literal syntax -/
@@ -165,15 +166,15 @@ This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_fswap"]
def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
def swap (a : Array α) (i j : @& Nat) (hi : i < a.size := by get_elem_tactic) (hj : j < a.size := by get_elem_tactic) : Array α :=
let v₁ := a[i]
let v₂ := a[j]
let a' := a.set i v₂
a'.set j v₁ (Nat.lt_of_lt_of_eq j.isLt (size_set a i v₂ _).symm)
a'.set j v₁ (Nat.lt_of_lt_of_eq hj (size_set a i v₂ _).symm)
@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
@[simp] theorem size_swap (a : Array α) (i j : Nat) {hi hj} : (a.swap i j hi hj).size = a.size := by
show ((a.set i a[j]).set j a[i]
(Nat.lt_of_lt_of_eq j.isLt (size_set a i a[j] _).symm)).size = a.size
(Nat.lt_of_lt_of_eq hj (size_set a i a[j] _).symm)).size = a.size
rw [size_set, size_set]
/--
@@ -183,12 +184,14 @@ This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_swap"]
def swap! (a : Array α) (i j : @& Nat) : Array α :=
def swapIfInBounds (a : Array α) (i j : @& Nat) : Array α :=
if h₁ : i < a.size then
if h₂ : j < a.size then swap a i, h₁ j, h₂
if h₂ : j < a.size then swap a i j
else a
else a
@[deprecated swapIfInBounds (since := "2024-11-24")] abbrev swap! := @swapIfInBounds
/-! ### GetElem instance for `USize`, backed by `uget` -/
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
@@ -233,7 +236,7 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
/-- The array `#[0, 1, ..., n - 1]`. -/
def range (n : Nat) : Array Nat :=
n.fold (flip Array.push) (mkEmpty n)
ofFn fun (i : Fin n) => i
def singleton (v : α) : Array α :=
mkArray 1 v
@@ -247,9 +250,9 @@ def get? (a : Array α) (i : Nat) : Option α :=
if h : i < a.size then some a[i] else none
def back? (a : Array α) : Option α :=
a.get? (a.size - 1)
a[a.size - 1]?
@[inline] def swapAt (a : Array α) (i : Fin a.size) (v : α) : α × Array α :=
@[inline] def swapAt (a : Array α) (i : Nat) (v : α) (hi : i < a.size := by get_elem_tactic) : α × Array α :=
let e := a[i]
let a := a.set i v
(e, a)
@@ -257,7 +260,7 @@ def back? (a : Array α) : Option α :=
@[inline]
def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
if h : i < a.size then
swapAt a i, h v
swapAt a i v
else
have : Inhabited (α × Array α) := (v, a)
panic! ("index " ++ toString i ++ " out of bounds")
@@ -442,6 +445,8 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
@[deprecated mapM (since := "2024-11-11")] abbrev sequenceMap := @mapM
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
@@ -458,11 +463,11 @@ def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Nat α m β) : m (Array β) :=
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : Nat α m β) (as : Array α) : m (Array β) :=
as.mapFinIdxM fun i a => f i a
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m (Option β)) : m (Option β) := do
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m (Option β)) (as : Array α) : m (Option β) := do
for a in as do
match ( f a) with
| some b => return b
@@ -470,14 +475,14 @@ def findSomeM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as
return none
@[inline]
def findM? {α : Type} {m : Type Type} [Monad m] (as : Array α) (p : α m Bool) : m (Option α) := do
def findM? {α : Type} {m : Type Type} [Monad m] (p : α m Bool) (as : Array α) : m (Option α) := do
for a in as do
if ( p a) then
return a
return none
@[inline]
def findIdxM? [Monad m] (as : Array α) (p : α m Bool) : m (Option Nat) := do
def findIdxM? [Monad m] (p : α m Bool) (as : Array α) : m (Option Nat) := do
let mut i := 0
for a in as do
if ( p a) then
@@ -529,7 +534,7 @@ def allM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as :
return !( as.anyM (start := start) (stop := stop) fun v => return !( p v))
@[inline]
def findSomeRevM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m (Option β)) : m (Option β) :=
def findSomeRevM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m (Option β)) (as : Array α) : m (Option β) :=
let rec @[specialize] find : (i : Nat) i as.size m (Option β)
| 0, _ => pure none
| i+1, h => do
@@ -543,7 +548,7 @@ def findSomeRevM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
find as.size (Nat.le_refl _)
@[inline]
def findRevM? {α : Type} {m : Type Type w} [Monad m] (as : Array α) (p : α m Bool) : m (Option α) :=
def findRevM? {α : Type} {m : Type Type w} [Monad m] (p : α m Bool) (as : Array α) : m (Option α) :=
as.findSomeRevM? fun a => return if ( p a) then some a else none
@[inline]
@@ -572,7 +577,7 @@ def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size →
Id.run <| as.mapFinIdxM f
@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Nat α β) : Array β :=
def mapIdx {α : Type u} {β : Type v} (f : Nat α β) (as : Array α) : Array β :=
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
@@ -580,29 +585,29 @@ def zipWithIndex (arr : Array α) : Array (α × Nat) :=
arr.mapIdx fun i a => (a, i)
@[inline]
def find? {α : Type} (as : Array α) (p : α Bool) : Option α :=
def find? {α : Type} (p : α Bool) (as : Array α) : Option α :=
Id.run <| as.findM? p
@[inline]
def findSome? {α : Type u} {β : Type v} (as : Array α) (f : α Option β) : Option β :=
def findSome? {α : Type u} {β : Type v} (f : α Option β) (as : Array α) : Option β :=
Id.run <| as.findSomeM? f
@[inline]
def findSome! {α : Type u} {β : Type v} [Inhabited β] (a : Array α) (f : α Option β) : β :=
match findSome? a f with
def findSome! {α : Type u} {β : Type v} [Inhabited β] (f : α Option β) (a : Array α) : β :=
match a.findSome? f with
| some b => b
| none => panic! "failed to find element"
@[inline]
def findSomeRev? {α : Type u} {β : Type v} (as : Array α) (f : α Option β) : Option β :=
def findSomeRev? {α : Type u} {β : Type v} (f : α Option β) (as : Array α) : Option β :=
Id.run <| as.findSomeRevM? f
@[inline]
def findRev? {α : Type} (as : Array α) (p : α Bool) : Option α :=
def findRev? {α : Type} (p : α Bool) (as : Array α) : Option α :=
Id.run <| as.findRevM? p
@[inline]
def findIdx? {α : Type u} (as : Array α) (p : α Bool) : Option Nat :=
def findIdx? {α : Type u} (p : α Bool) (as : Array α) : Option Nat :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) :=
if h : j < as.size then
@@ -611,8 +616,15 @@ def findIdx? {α : Type u} (as : Array α) (p : α → Bool) : Option Nat :=
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop 0
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v
@[inline]
def findFinIdx? {α : Type u} (p : α Bool) (as : Array α) : Option (Fin as.size) :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) :=
if h : j < as.size then
if p as[j] then some j, h else loop (j + 1)
else none
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop 0
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
@@ -625,6 +637,10 @@ decreasing_by simp_wf; decreasing_trivial_pre_omega
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@[deprecated indexOf? (since := "2024-11-20")]
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v
@[inline]
def any (as : Array α) (p : α Bool) (start := 0) (stop := as.size) : Bool :=
Id.run <| as.anyM p start stop
@@ -733,7 +749,7 @@ where
loop (as : Array α) (i : Nat) (j : Fin as.size) :=
if h : i < j then
have := termination h
let as := as.swap i, Nat.lt_trans h j.2 j
let as := as.swap i j (Nat.lt_trans h j.2)
have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
loop as (i+1) j-1, this
else
@@ -764,49 +780,63 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
decreasing_by simp_wf; decreasing_trivial_pre_omega
go 0 #[]
/-- Remove the element at a given index from an array without bounds checks, using a `Fin` index.
/--
Remove the element at a given index from an array without a runtime bounds checks,
using a `Nat` index and a tactic-provided bound.
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
if h : i.val + 1 < a.size then
let a' := a.swap i.val + 1, h i
let i' : Fin a'.size := i.val + 1, by simp [a', h]
a'.feraseIdx i'
def eraseIdx (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) : Array α :=
if h' : i + 1 < a.size then
let a' := a.swap (i + 1) i
a'.eraseIdx (i + 1) (by simp [a', h'])
else
a.pop
termination_by a.size - i.val
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ i.isLt
termination_by a.size - i
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ h
-- This is required in `Lean.Data.PersistentHashMap`.
@[simp] theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
induction a, i using Array.feraseIdx.induct with
| @case1 a i h a' _ ih =>
unfold feraseIdx
simp [h, a', ih]
| case2 a i h =>
unfold feraseIdx
simp [h]
@[simp] theorem size_eraseIdx (a : Array α) (i : Nat) (h) : (a.eraseIdx i h).size = a.size - 1 := by
induction a, i, h using Array.eraseIdx.induct with
| @case1 a i h h' a' ih =>
unfold eraseIdx
simp [h', a', ih]
| case2 a i h h' =>
unfold eraseIdx
simp [h']
/-- Remove the element at a given index from an array, or do nothing if the index is out of bounds.
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
def eraseIdx (a : Array α) (i : Nat) : Array α :=
if h : i < a.size then a.feraseIdx i, h else a
def eraseIdxIfInBounds (a : Array α) (i : Nat) : Array α :=
if h : i < a.size then a.eraseIdx i h else a
/-- Remove the element at a given index from an array, or panic if the index is out of bounds.
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`. -/
def eraseIdx! (a : Array α) (i : Nat) : Array α :=
if h : i < a.size then a.eraseIdx i h else panic! "invalid index"
def erase [BEq α] (as : Array α) (a : α) : Array α :=
match as.indexOf? a with
| none => as
| some i => as.feraseIdx i
| some i => as.eraseIdx i
/-- Erase the first element that satisfies the predicate `p`. -/
def eraseP (as : Array α) (p : α Bool) : Array α :=
match as.findIdx? p with
| none => as
| some i => as.eraseIdxIfInBounds i
/-- Insert element `a` at position `i`. -/
@[inline] def insertAt (as : Array α) (i : Fin (as.size + 1)) (a : α) : Array α :=
@[inline] def insertIdx (as : Array α) (i : Nat) (a : α) (_ : i as.size := by get_elem_tactic) : Array α :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (as : Array α) (j : Fin as.size) :=
if i.1 < j then
let j' := j-1, Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
if i < j then
let j' : Fin as.size := j-1, Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
let as := as.swap j' j
loop as j', by rw [size_swap]; exact j'.2
else
@@ -816,12 +846,23 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
let as := as.push a
loop as j, size_push .. j.lt_succ_self
@[deprecated insertIdx (since := "2024-11-20")] abbrev insertAt := @insertIdx
/-- Insert element `a` at position `i`. Panics if `i` is not `i ≤ as.size`. -/
def insertAt! (as : Array α) (i : Nat) (a : α) : Array α :=
def insertIdx! (as : Array α) (i : Nat) (a : α) : Array α :=
if h : i as.size then
insertAt as i, Nat.lt_succ_of_le h a
insertIdx as i a
else panic! "invalid index"
@[deprecated insertIdx! (since := "2024-11-20")] abbrev insertAt! := @insertIdx!
/-- Insert element `a` at position `i`, or do nothing if `as.size < i`. -/
def insertIdxIfInBounds (as : Array α) (i : Nat) (a : α) : Array α :=
if h : i as.size then
insertIdx as i a
else
as
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size bs.size) (i : Nat) : Bool :=
if h : i < as.size then
@@ -845,12 +886,12 @@ def isPrefixOf [BEq α] (as bs : Array α) : Bool :=
false
@[semireducible, specialize] -- This is otherwise irreducible because it uses well-founded recursion.
def zipWithAux (f : α β γ) (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) : Array γ :=
def zipWithAux (as : Array α) (bs : Array β) (f : α β γ) (i : Nat) (cs : Array γ) : Array γ :=
if h : i < as.size then
let a := as[i]
if h : i < bs.size then
let b := bs[i]
zipWithAux f as bs (i+1) <| cs.push <| f a b
zipWithAux as bs f (i+1) <| cs.push <| f a b
else
cs
else
@@ -858,11 +899,23 @@ def zipWithAux (f : α → β → γ) (as : Array α) (bs : Array β) (i : Nat)
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α β γ) : Array γ :=
zipWithAux f as bs 0 #[]
zipWithAux as bs f 0 #[]
def zip (as : Array α) (bs : Array β) : Array (α × β) :=
zipWith as bs Prod.mk
def zipWithAll (as : Array α) (bs : Array β) (f : Option α Option β γ) : Array γ :=
go as bs 0 #[]
where go (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) :=
if i < max as.size bs.size then
let a := as[i]?
let b := bs[i]?
go as bs (i+1) (cs.push (f a b))
else
cs
termination_by max as.size bs.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
def unzip (as : Array (α × β)) : Array α × Array β :=
as.foldl (init := (#[], #[])) fun (as, bs) (a, b) => (as.push a, bs.push b)

View File

@@ -5,59 +5,64 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Omega
universe u v
-- TODO: CLEANUP
namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
-- TODO: remove `partial` using well-founded recursion
@[specialize] partial def binSearchAux {α : Type u} {β : Type v} [Inhabited β] (lt : α α Bool) (found : Option α β) (as : Array α) (k : α) : Nat Nat β
| lo, hi =>
if lo <= hi then
let _ := Inhabited.mk k
let m := (lo + hi)/2
let a := as.get! m
if lt a k then binSearchAux lt found as k (m+1) hi
else if lt k a then
if m == 0 then found none
else binSearchAux lt found as k lo (m-1)
else found (some a)
else found none
@[specialize] def binSearchAux {α : Type u} {β : Type v} (lt : α α Bool) (found : Option α β) (as : Array α) (k : α) :
(lo : Fin (as.size + 1)) (hi : Fin as.size) (lo.1 hi.1) β
| lo, hi, h =>
let m := (lo.1 + hi.1)/2
let a := as[m]
if lt a k then
if h' : m + 1 hi.1 then
binSearchAux lt found as k m+1, by omega hi h'
else found none
else if lt k a then
if h' : m = 0 m - 1 < lo.1 then found none
else binSearchAux lt found as k lo m-1, by omega (by simp; omega)
else found (some a)
termination_by lo hi => hi.1 - lo.1
@[inline] def binSearch {α : Type} (as : Array α) (k : α) (lt : α α Bool) (lo := 0) (hi := as.size - 1) : Option α :=
if lo < as.size then
if h : lo < as.size then
let hi := if hi < as.size then hi else as.size - 1
binSearchAux lt id as k lo hi
if w : lo hi then
binSearchAux lt id as k lo, by omega hi, by simp [hi]; split <;> omega (by simp [hi]; omega)
else
none
else
none
@[inline] def binSearchContains {α : Type} (as : Array α) (k : α) (lt : α α Bool) (lo := 0) (hi := as.size - 1) : Bool :=
if lo < as.size then
if h : lo < as.size then
let hi := if hi < as.size then hi else as.size - 1
binSearchAux lt Option.isSome as k lo hi
if w : lo hi then
binSearchAux lt Option.isSome as k lo, by omega hi, by simp [hi]; split <;> omega (by simp [hi]; omega)
else
false
else
false
@[specialize] private partial def binInsertAux {α : Type u} {m : Type u Type v} [Monad m]
@[specialize] private def binInsertAux {α : Type u} {m : Type u Type v} [Monad m]
(lt : α α Bool)
(merge : α m α)
(add : Unit m α)
(as : Array α)
(k : α) : Nat Nat m (Array α)
| lo, hi =>
let _ := Inhabited.mk k
-- as[lo] < k < as[hi]
let mid := (lo + hi)/2
let midVal := as.get! mid
if lt midVal k then
if mid == lo then do let v add (); pure <| as.insertAt! (lo+1) v
else binInsertAux lt merge add as k mid hi
else if lt k midVal then
binInsertAux lt merge add as k lo mid
(k : α) : (lo : Fin as.size) (hi : Fin as.size) (lo.1 hi.1) (lt as[lo] k) m (Array α)
| lo, hi, h, w =>
let mid := (lo.1 + hi.1)/2
let midVal := as[mid]
if w₁ : lt midVal k then
if h' : mid = lo then do let v add (); pure <| as.insertIdx (lo+1) v
else binInsertAux lt merge add as k mid, by omega hi (by simp; omega) w₁
else if w₂ : lt k midVal then
have : mid lo := fun z => by simp [midVal, z] at w₁; simp_all
binInsertAux lt merge add as k lo mid, by omega (by simp; omega) w
else do
as.modifyM mid <| fun v => merge v
termination_by lo hi => hi.1 - lo.1
@[specialize] def binInsertM {α : Type u} {m : Type u Type v} [Monad m]
(lt : α α Bool)
@@ -65,13 +70,12 @@ namespace Array
(add : Unit m α)
(as : Array α)
(k : α) : m (Array α) :=
let _ := Inhabited.mk k
if as.isEmpty then do let v add (); pure <| as.push v
else if lt k (as.get! 0) then do let v add (); pure <| as.insertAt! 0 v
else if !lt (as.get! 0) k then as.modifyM 0 <| merge
else if lt as.back! k then do let v add (); pure <| as.push v
else if !lt k as.back! then as.modifyM (as.size - 1) <| merge
else binInsertAux lt merge add as k 0 (as.size - 1)
if h : as.size = 0 then do let v add (); pure <| as.push v
else if lt k as[0] then do let v add (); pure <| as.insertIdx 0 v
else if h' : !lt as[0] k then as.modifyM 0 <| merge
else if lt as[as.size - 1] k then do let v add (); pure <| as.push v
else if !lt k as[as.size - 1] then as.modifyM (as.size - 1) <| merge
else binInsertAux lt merge add as k 0, by omega as.size - 1, by omega (by simp) (by simpa using h')
@[inline] def binInsert {α : Type u} (lt : α α Bool) (as : Array α) (k : α) : Array α :=
Id.run <| binInsertM lt (fun _ => k) (fun _ => k) as k

View File

@@ -15,26 +15,26 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
namespace Array
theorem foldlM_eq_foldlM_toList.aux [Monad m]
theorem foldlM_toList.aux [Monad m]
(f : β α m β) (arr : Array α) (i j) (H : arr.size i + j) (b) :
foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.toList.drop j).foldlM f b := by
unfold foldlM.loop
split; split
· cases Nat.not_le_of_gt _ (Nat.zero_add _ H)
· rename_i i; rw [Nat.succ_add] at H
simp [foldlM_eq_foldlM_toList.aux f arr i (j+1) H]
rw (occs := .pos [2]) [ List.getElem_cons_drop_succ_eq_drop _]
simp [foldlM_toList.aux f arr i (j+1) H]
rw (occs := [2]) [ List.getElem_cons_drop_succ_eq_drop _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
theorem foldlM_eq_foldlM_toList [Monad m]
@[simp] theorem foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.toList.foldlM f init := by
simp [foldlM, foldlM_eq_foldlM_toList.aux]
arr.toList.foldlM f init = arr.foldlM f init := by
simp [foldlM, foldlM_toList.aux]
theorem foldl_eq_foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init :=
List.foldl_eq_foldlM .. foldlM_eq_foldlM_toList ..
@[simp] theorem foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.toList.foldl f init = arr.foldl f init :=
List.foldl_eq_foldlM .. foldlM_toList ..
theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
(f : α β m β) (arr : Array α) (init : β) (i h) :
@@ -51,23 +51,23 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_
simp [foldrM, h, foldrM_eq_reverse_foldlM_toList.aux, List.take_length]
theorem foldrM_eq_foldrM_toList [Monad m]
@[simp] theorem foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.foldrM f init := by
arr.toList.foldrM f init = arr.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList, List.foldlM_reverse]
theorem foldr_eq_foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init :=
List.foldr_eq_foldrM .. foldrM_eq_foldrM_toList ..
@[simp] theorem foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.toList.foldr f init = arr.foldr f init :=
List.foldr_eq_foldrM .. foldrM_toList ..
@[simp] theorem push_toList (arr : Array α) (a : α) : (arr.push a).toList = arr.toList ++ [a] := by
simp [push, List.concat_eq_append]
@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.toList ++ l := by
simp [toListAppend, foldr_eq_foldr_toList]
simp [toListAppend, foldr_toList]
@[simp] theorem toListImpl_eq (arr : Array α) : arr.toListImpl = arr.toList := by
simp [toListImpl, foldr_eq_foldr_toList]
simp [toListImpl, foldr_toList]
@[simp] theorem pop_toList (arr : Array α) : arr.pop.toList = arr.toList.dropLast := rfl
@@ -76,7 +76,7 @@ theorem foldr_eq_foldr_toList (f : α → β → β) (init : β) (arr : Array α
@[simp] theorem toList_append (arr arr' : Array α) :
(arr ++ arr').toList = arr.toList ++ arr'.toList := by
rw [ append_eq_append]; unfold Array.append
rw [foldl_eq_foldl_toList]
rw [ foldl_toList]
induction arr'.toList generalizing arr <;> simp [*]
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@@ -98,20 +98,44 @@ theorem foldr_eq_foldr_toList (f : α → β → β) (init : β) (arr : Array α
rw [ appendList_eq_append]; unfold Array.appendList
induction l generalizing arr <;> simp [*]
@[deprecated foldlM_eq_foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_eq_foldlM_toList
@[deprecated "Use the reverse direction of `foldrM_toList`." (since := "2024-11-13")]
theorem foldrM_eq_foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.foldrM f init := by
simp
@[deprecated foldl_eq_foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_eq_foldl_toList
@[deprecated "Use the reverse direction of `foldlM_toList`." (since := "2024-11-13")]
theorem foldlM_eq_foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.toList.foldlM f init:= by
simp
@[deprecated "Use the reverse direction of `foldr_toList`." (since := "2024-11-13")]
theorem foldr_eq_foldr_toList
(f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init := by
simp
@[deprecated "Use the reverse direction of `foldl_toList`." (since := "2024-11-13")]
theorem foldl_eq_foldl_toList
(f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init:= by
simp
@[deprecated foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_toList
@[deprecated foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_toList
@[deprecated foldrM_eq_reverse_foldlM_toList (since := "2024-09-09")]
abbrev foldrM_eq_reverse_foldlM_data := @foldrM_eq_reverse_foldlM_toList
@[deprecated foldrM_eq_foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_eq_foldrM_toList
@[deprecated foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_toList
@[deprecated foldr_eq_foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_eq_foldr_toList
@[deprecated foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_toList
@[deprecated push_toList (since := "2024-09-09")]
abbrev push_data := @push_toList

View File

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Array.Basic
import Init.Data.BEq
import Init.Data.Nat.Lemmas
import Init.Data.List.Nat.BEq
import Init.ByCases

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

@@ -0,0 +1,281 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Find
import Init.Data.Array.Lemmas
import Init.Data.Array.Attach
/-!
# Lemmas about `Array.findSome?`, `Array.find?`.
-/
namespace Array
open Nat
/-! ### findSome? -/
@[simp] theorem findSomeRev?_push_of_isSome (l : Array α) (h : (f a).isSome) : (l.push a).findSomeRev? f = f a := by
cases l; simp_all
@[simp] theorem findSomeRev?_push_of_isNone (l : Array α) (h : (f a).isNone) : (l.push a).findSomeRev? f = l.findSomeRev? f := by
cases l; simp_all
theorem exists_of_findSome?_eq_some {f : α Option β} {l : Array α} (w : l.findSome? f = some b) :
a, a l f a = b := by
cases l; simp_all [List.exists_of_findSome?_eq_some]
@[simp] theorem findSome?_eq_none_iff : findSome? p l = none x l, p x = none := by
cases l; simp
@[simp] theorem findSome?_isSome_iff {f : α Option β} {l : Array α} :
(l.findSome? f).isSome x, x l (f x).isSome := by
cases l; simp
theorem findSome?_eq_some_iff {f : α Option β} {l : Array α} {b : β} :
l.findSome? f = some b (l₁ : Array α) (a : α) (l₂ : Array α), l = l₁.push a ++ l₂ f a = some b x l₁, f x = none := by
cases l
simp only [List.findSome?_toArray, List.findSome?_eq_some_iff]
constructor
· rintro l₁, a, l₂, rfl, h₁, h₂
exact l₁.toArray, a, l₂.toArray, by simp_all
· rintro l₁, a, l₂, h₀, h₁, h₂
exact l₁.toList, a, l₂.toList, by simpa using congrArg toList h₀, h₁, by simpa
@[simp] theorem findSome?_guard (l : Array α) : findSome? (Option.guard fun x => p x) l = find? p l := by
cases l; simp
@[simp] theorem getElem?_zero_filterMap (f : α Option β) (l : Array α) : (l.filterMap f)[0]? = l.findSome? f := by
cases l; simp [ List.head?_eq_getElem?]
@[simp] theorem getElem_zero_filterMap (f : α Option β) (l : Array α) (h) :
(l.filterMap f)[0] = (l.findSome? f).get (by cases l; simpa [List.length_filterMap_eq_countP] using h) := by
cases l; simp [ List.head_eq_getElem, getElem?_zero_filterMap]
@[simp] theorem back?_filterMap (f : α Option β) (l : Array α) : (l.filterMap f).back? = l.findSomeRev? f := by
cases l; simp
@[simp] theorem back!_filterMap [Inhabited β] (f : α Option β) (l : Array α) :
(l.filterMap f).back! = (l.findSomeRev? f).getD default := by
cases l; simp
@[simp] theorem map_findSome? (f : α Option β) (g : β γ) (l : Array α) :
(l.findSome? f).map g = l.findSome? (Option.map g f) := by
cases l; simp
theorem findSome?_map (f : β γ) (l : Array β) : findSome? p (l.map f) = l.findSome? (p f) := by
cases l; simp [List.findSome?_map]
theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (l₁.findSome? f).or (l₂.findSome? f) := by
cases l₁; cases l₂; simp [List.findSome?_append]
theorem getElem?_zero_flatten (L : Array (Array α)) :
(flatten L)[0]? = L.findSome? fun l => l[0]? := by
cases L using array_array_induction
simp [ List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
(L.findSome? fun l => l[0]?).isSome := by
cases L using array_array_induction
simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
List.findSome?_isSome_iff, List.isSome_getElem?]
simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
Nat.sum_pos_iff_exists_pos, List.mem_map] at h
obtain _, xs, m, rfl, h := h
exact xs, m, by simpa using h
theorem getElem_zero_flatten {L : Array (Array α)} (h) :
(flatten L)[0] = (L.findSome? fun l => l[0]?).get (getElem_zero_flatten.proof h) := by
have t := getElem?_zero_flatten L
simp [getElem?_eq_getElem, h] at t
simp [ t]
theorem back?_flatten {L : Array (Array α)} :
(flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
cases L using array_array_induction
simp [List.getLast?_flatten, List.map_reverse, List.findSome?_map, Function.comp_def]
theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
simp [mkArray_eq_toArray_replicate, List.findSome?_replicate]
@[simp] theorem findSome?_mkArray_of_pos (h : 0 < n) : findSome? f (mkArray n a) = f a := by
simp [findSome?_mkArray, Nat.ne_of_gt h]
-- Argument is unused, but used to decide whether `simp` should unfold.
@[simp] theorem findSome?_mkArray_of_isSome (_ : (f a).isSome) :
findSome? f (mkArray n a) = if n = 0 then none else f a := by
simp [findSome?_mkArray]
@[simp] theorem findSome?_mkArray_of_isNone (h : (f a).isNone) :
findSome? f (mkArray n a) = none := by
rw [Option.isNone_iff_eq_none] at h
simp [findSome?_mkArray, h]
/-! ### find? -/
@[simp] theorem find?_singleton (a : α) (p : α Bool) :
#[a].find? p = if p a then some a else none := by
simp [singleton_eq_toArray_singleton]
@[simp] theorem findRev?_push_of_pos (l : Array α) (h : p a) :
findRev? p (l.push a) = some a := by
cases l; simp [h]
@[simp] theorem findRev?_cons_of_neg (l : Array α) (h : ¬p a) :
findRev? p (l.push a) = findRev? p l := by
cases l; simp [h]
@[simp] theorem find?_eq_none : find? p l = none x l, ¬ p x := by
cases l; simp
theorem find?_eq_some_iff_append {xs : Array α} :
xs.find? p = some b p b (as bs : Array α), xs = as.push b ++ bs a as, !p a := by
rcases xs with xs
simp only [List.find?_toArray, List.find?_eq_some_iff_append, Bool.not_eq_eq_eq_not,
Bool.not_true, exists_and_right, and_congr_right_iff]
intro w
constructor
· rintro as, x, rfl, h
exact as.toArray, x.toArray, by simp , by simpa using h
· rintro as, x, h', h
exact as.toList, x.toList, by simpa using congrArg Array.toList h',
by simpa using h
@[simp]
theorem find?_push_eq_some {xs : Array α} :
(xs.push a).find? p = some b xs.find? p = some b (xs.find? p = none (p a a = b)) := by
cases xs; simp
@[simp] theorem find?_isSome {xs : Array α} {p : α Bool} : (xs.find? p).isSome x, x xs p x := by
cases xs; simp
theorem find?_some {xs : Array α} (h : find? p xs = some a) : p a := by
cases xs
simp at h
exact List.find?_some h
theorem mem_of_find?_eq_some {xs : Array α} (h : find? p xs = some a) : a xs := by
cases xs
simp at h
simpa using List.mem_of_find?_eq_some h
theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h xs := by
cases xs
simp [List.get_find?_mem]
@[simp] theorem find?_filter {xs : Array α} (p q : α Bool) :
(xs.filter p).find? q = xs.find? (fun a => p a q a) := by
cases xs; simp
@[simp] theorem getElem?_zero_filter (p : α Bool) (l : Array α) :
(l.filter p)[0]? = l.find? p := by
cases l; simp [ List.head?_eq_getElem?]
@[simp] theorem getElem_zero_filter (p : α Bool) (l : Array α) (h) :
(l.filter p)[0] =
(l.find? p).get (by cases l; simpa [ List.countP_eq_length_filter] using h) := by
cases l
simp [List.getElem_zero_eq_head]
@[simp] theorem back?_filter (p : α Bool) (l : Array α) : (l.filter p).back? = l.findRev? p := by
cases l; simp
@[simp] theorem back!_filter [Inhabited α] (p : α Bool) (l : Array α) :
(l.filter p).back! = (l.findRev? p).get! := by
cases l; simp [Option.get!_eq_getD]
@[simp] theorem find?_filterMap (xs : Array α) (f : α Option β) (p : β Bool) :
(xs.filterMap f).find? p = (xs.find? (fun a => (f a).any p)).bind f := by
cases xs; simp
@[simp] theorem find?_map (f : β α) (xs : Array β) :
find? p (xs.map f) = (xs.find? (p f)).map f := by
cases xs; simp
@[simp] theorem find?_append {l₁ l₂ : Array α} :
(l₁ ++ l₂).find? p = (l₁.find? p).or (l₂.find? p) := by
cases l₁
cases l₂
simp
@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α Bool) :
xs.flatten.find? p = xs.findSome? (·.find? p) := by
cases xs using array_array_induction
simp [List.findSome?_map, Function.comp_def]
theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α Bool} :
xs.flatten.find? p = none ys xs, x ys, !p x := by
simp
/--
If `find? p` returns `some a` from `xs.flatten`, then `p a` holds, and
some array in `xs` contains `a`, and no earlier element of that array satisfies `p`.
Moreover, no earlier array in `xs` has an element satisfying `p`.
-/
theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α Bool} {a : α} :
xs.flatten.find? p = some a
p a (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
xs = as.push (ys.push a ++ zs) ++ bs
( a as, x a, !p x) ( x ys, !p x) := by
cases xs using array_array_induction
simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
intro w
constructor
· rintro as, ys, zs, bs, rfl, h₁, h₂
exact as.toArray.map List.toArray, ys.toArray,
zs.toArray, bs.toArray.map List.toArray, by simp, by simpa using h₁, by simpa using h₂
· rintro as, ys, zs, bs, h, h₁, h₂
replace h := congrArg (·.map Array.toList) (congrArg Array.toList h)
simp [Function.comp_def] at h
exact as.toList.map Array.toList, ys.toList,
zs.toList, bs.toList.map Array.toList, by simpa using h,
by simpa using h₁, by simpa using h₂
@[simp] theorem find?_flatMap (xs : Array α) (f : α Array β) (p : β Bool) :
(xs.flatMap f).find? p = xs.findSome? (fun x => (f x).find? p) := by
cases xs
simp [List.find?_flatMap, Array.flatMap_toArray]
theorem find?_flatMap_eq_none {xs : Array α} {f : α Array β} {p : β Bool} :
(xs.flatMap f).find? p = none x xs, y f x, !p y := by
simp
theorem find?_mkArray :
find? p (mkArray n a) = if n = 0 then none else if p a then some a else none := by
simp [mkArray_eq_toArray_replicate, List.find?_replicate]
@[simp] theorem find?_mkArray_of_length_pos (h : 0 < n) :
find? p (mkArray n a) = if p a then some a else none := by
simp [find?_mkArray, Nat.ne_of_gt h]
@[simp] theorem find?_mkArray_of_pos (h : p a) :
find? p (mkArray n a) = if n = 0 then none else some a := by
simp [find?_mkArray, h]
@[simp] theorem find?_mkArray_of_neg (h : ¬ p a) : find? p (mkArray n a) = none := by
simp [find?_mkArray, h]
-- This isn't a `@[simp]` lemma since there is already a lemma for `l.find? p = none` for any `l`.
theorem find?_mkArray_eq_none {n : Nat} {a : α} {p : α Bool} :
(mkArray n a).find? p = none n = 0 !p a := by
simp [mkArray_eq_toArray_replicate, List.find?_replicate_eq_none, Classical.or_iff_not_imp_left]
@[simp] theorem find?_mkArray_eq_some {n : Nat} {a b : α} {p : α Bool} :
(mkArray n a).find? p = some b n 0 p a a = b := by
simp [mkArray_eq_toArray_replicate]
@[simp] theorem get_find?_mkArray (n : Nat) (a : α) (p : α Bool) (h) :
((mkArray n a).find? p).get h = a := by
simp [mkArray_eq_toArray_replicate]
theorem find?_pmap {P : α Prop} (f : (a : α) P a β) (xs : Array α)
(H : (a : α), a xs P a) (p : β Bool) :
(xs.pmap f H).find? p = (xs.attach.find? (fun a, m => p (f a (H a m)))).map fun a, m => f a (H a m) := by
simp only [pmap_eq_map_attach, find?_map]
rfl
end Array

View File

@@ -5,24 +5,91 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Nat.Fold
import Init.Data.Vector.Lemmas
@[inline] def Array.insertionSort (a : Array α) (lt : α α Bool) : Array α :=
traverse a 0 a.size
where
@[specialize] traverse (a : Array α) (i : Nat) (fuel : Nat) : Array α :=
match fuel with
| 0 => a
| fuel+1 =>
if h : i < a.size then
traverse (swapLoop a i h) (i+1) fuel
else
a
@[specialize] swapLoop (a : Array α) (j : Nat) (h : j < a.size) : Array α :=
match (generalizing := false) he:j with -- using `generalizing` because we don't want to refine the type of `h`
| 0 => a
| j'+1 =>
have h' : j' < a.size := by subst j; exact Nat.lt_trans (Nat.lt_succ_self _) h
if lt a[j] a[j'] then
swapLoop (a.swap j, h j', h') j' (by rw [size_swap]; assumption; done)
else
a
namespace Vector
/-- Swap the `i`-th element repeatedly to the left, while the element to its left is not `lt` it. -/
@[specialize, inline] def swapLeftWhileLT {n} (a : Vector α n) (i : Nat) (h : i < n)
(lt : α α Bool := by exact (· < ·)) : Vector α n :=
match h' : i with
| 0 => a
| i'+1 =>
if lt a[i] a[i'] then
swapLeftWhileLT (a.swap i' i) i' (by omega) lt
else
a
end Vector
open Vector
namespace Array
/-- Sort an array in place using insertion sort. -/
@[inline] def insertionSort (a : Array α) (lt : α α Bool := by exact (· < ·)) : Array α :=
a.size.fold (init := a, rfl) (fun i h acc => swapLeftWhileLT acc i h lt) |>.toArray
/-- Insert an element into an array, after the last element which is not `lt` the inserted element. -/
def orderedInsert (a : Array α) (x : α) (lt : α α Bool := by exact (· < ·)) : Array α :=
swapLeftWhileLT a.push x, rfl a.size (by simp) lt |>.toArray
end Array
/-! ### Verification -/
namespace Vector
theorem swapLeftWhileLT_push {n} (a : Vector α n) (x : α) (j : Nat) (h : j < n) :
swapLeftWhileLT (a.push x) j (by omega) lt = (swapLeftWhileLT a j h lt).push x := by
induction j generalizing a with
| zero => simp [swapLeftWhileLT]
| succ j ih =>
simp [swapLeftWhileLT]
split <;> rename_i h
· rw [Vector.getElem_push_lt (by omega), Vector.getElem_push_lt (by omega)] at h
rw [ Vector.push_swap, ih, if_pos h]
· rw [Vector.getElem_push_lt (by omega), Vector.getElem_push_lt (by omega)] at h
rw [if_neg h]
theorem swapLeftWhileLT_cast {n m} (a : Vector α n) (j : Nat) (h : j < n) (h' : n = m) :
swapLeftWhileLT (a.cast h') j (by omega) lt = (swapLeftWhileLT a j h lt).cast h' := by
subst h'
simp
end Vector
namespace Array
@[simp] theorem size_insertionSort (a : Array α) : (a.insertionSort lt).size = a.size := by
simp [insertionSort]
private theorem insertionSort_push' (a : Array α) (x : α) :
(a.push x).insertionSort lt =
(swapLeftWhileLT (a.insertionSort lt).push x, rfl a.size (by simp) lt).toArray := by
rw [insertionSort, Nat.fold_congr (size_push a x), Nat.fold]
have : (a.size.fold (fun i h acc => swapLeftWhileLT acc i (by simp; omega) lt) a.push x, rfl) =
((a.size.fold (fun i h acc => swapLeftWhileLT acc i h lt) a, rfl).push x).cast (by simp) := by
rw [Vector.eq_cast_iff]
simp only [Nat.fold_eq_finRange_foldl]
rw [ List.foldl_hom (fun a => (Vector.push x a)) _ (fun v i, h => swapLeftWhileLT v i (by omega) lt)]
rw [Vector.push_mk]
rw [ List.foldl_hom (Vector.cast _) _ (fun v i, h => swapLeftWhileLT v i (by omega) lt)]
· simp
· intro v i
simp only
rw [swapLeftWhileLT_cast]
· simp [swapLeftWhileLT_push]
rw [this]
simp only [Nat.lt_add_one, swapLeftWhileLT_cast, Vector.toArray_cast]
unfold insertionSort
simp only [Vector.push]
congr
all_goals simp
theorem insertionSort_push (a : Array α) (x : α) :
(a.push x).insertionSort lt = (a.insertionSort lt).orderedInsert x lt := by
rw [insertionSort_push', orderedInsert]
simp
end Array

View File

@@ -23,6 +23,9 @@ import Init.TacticsExtra
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
@@ -36,12 +39,21 @@ 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
@@ -66,6 +78,35 @@ theorem getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size)
@[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! [Inhabited α] (a : Array α) (i : Nat) : a.get! i = a[i]! := by
simp [getElem!_def, get!, getD]
split <;> rename_i h
@@ -76,6 +117,8 @@ theorem getElem_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size)
theorem singleton_inj : #[a] = #[b] a = b := by
simp
theorem singleton_eq_toArray_singleton (a : α) : #[a] = [a].toArray := rfl
end Array
namespace List
@@ -91,9 +134,6 @@ We prefer to pull `List.toArray` outwards.
(a.toArrayAux b).size = b.size + a.length := by
simp [size]
@[simp] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
simp [mem_def]
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
apply ext'
simp
@@ -111,6 +151,9 @@ We prefer to pull `List.toArray` outwards.
@[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
simp only [back!, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
@[simp] theorem back?_toArray (l : List α) : l.toArray.back? = l.getLast? := by
simp [back?, List.getLast?_eq_getElem?]
@[simp] theorem forIn'_loop_toArray [Monad m] (l : List α) (f : (a : α) a l.toArray β m (ForInStep β)) (i : Nat)
(h : i l.length) (b : β) :
Array.forIn'.loop l.toArray f i h b =
@@ -146,15 +189,15 @@ theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List
theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
l.toArray.foldlM f init = l.foldlM f init := by
rw [foldlM_eq_foldlM_toList]
rw [foldlM_toList]
theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
l.toArray.foldr f init = l.foldr f init := by
rw [foldr_eq_foldr_toList]
rw [foldr_toList]
theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
l.toArray.foldl f init = l.foldl f init := by
rw [foldl_eq_foldl_toList]
rw [foldl_toList]
/-- Variant of `foldrM_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldrM_toArray' [Monad m] (f : α β m β) (init : β) (l : List α)
@@ -169,21 +212,21 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
(h : stop = l.toArray.size) :
l.toArray.foldlM f init 0 stop = l.foldlM f init := by
subst h
rw [foldlM_eq_foldlM_toList]
rw [foldlM_toList]
/-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldr_toArray' (f : α β β) (init : β) (l : List α)
(h : start = l.toArray.size) :
l.toArray.foldr f init start 0 = l.foldr f init := by
subst h
rw [foldr_eq_foldr_toList]
rw [foldr_toList]
/-- Variant of `foldl_toArray` with a side condition for the `stop` argument. -/
@[simp] theorem foldl_toArray' (f : β α β) (init : β) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.foldl f init 0 stop = l.foldl f init := by
subst h
rw [foldl_eq_foldl_toList]
rw [foldl_toList]
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
@@ -197,6 +240,9 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
@[simp] theorem foldl_push {l : List α} {as : Array α} : l.foldl Array.push as = as ++ l.toArray := by
induction l generalizing as <;> simp [*]
@[simp] theorem foldr_push {l : List α} {as : Array α} : l.foldr (fun a b => push b a) as = as ++ l.reverse.toArray := by
rw [foldr_eq_foldl_reverse, foldl_push]
@[simp] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α m (Option β)) (l : List α) :
l.toArray.findSomeM? f = l.findSomeM? f := by
rw [Array.findSomeM?]
@@ -210,7 +256,7 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
theorem findSomeRevM?_find_toArray [Monad m] [LawfulMonad m] (f : α m (Option β)) (l : List α)
(i : Nat) (h) :
findSomeRevM?.find l.toArray f i h = (l.take i).reverse.findSomeM? f := by
findSomeRevM?.find f l.toArray i h = (l.take i).reverse.findSomeM? f := by
induction i generalizing l with
| zero => simp [Array.findSomeRevM?.find.eq_def]
| succ i ih =>
@@ -297,8 +343,8 @@ theorem isPrefixOfAux_toArray_zero [BEq α] (l₁ l₂ : List α) (hle : l₁.le
rw [ih]
simp_all
theorem zipWithAux_toArray_succ (f : α β γ) (as : List α) (bs : List β) (i : Nat) (cs : Array γ) :
zipWithAux f as.toArray bs.toArray (i + 1) cs = zipWithAux f as.tail.toArray bs.tail.toArray i cs := by
theorem zipWithAux_toArray_succ (as : List α) (bs : List β) (f : α β γ) (i : Nat) (cs : Array γ) :
zipWithAux as.toArray bs.toArray f (i + 1) cs = zipWithAux as.tail.toArray bs.tail.toArray f i cs := by
rw [zipWithAux]
conv => rhs; rw [zipWithAux]
simp only [size_toArray, getElem_toArray, length_tail, getElem_tail]
@@ -309,8 +355,8 @@ theorem zipWithAux_toArray_succ (f : α → β → γ) (as : List α) (bs : List
rw [dif_neg (by omega)]
· rw [dif_neg (by omega)]
theorem zipWithAux_toArray_succ' (f : α β γ) (as : List α) (bs : List β) (i : Nat) (cs : Array γ) :
zipWithAux f as.toArray bs.toArray (i + 1) cs = zipWithAux f (as.drop (i+1)).toArray (bs.drop (i+1)).toArray 0 cs := by
theorem zipWithAux_toArray_succ' (as : List α) (bs : List β) (f : α β γ) (i : Nat) (cs : Array γ) :
zipWithAux as.toArray bs.toArray f (i + 1) cs = zipWithAux (as.drop (i+1)).toArray (bs.drop (i+1)).toArray f 0 cs := by
induction i generalizing as bs cs with
| zero => simp [zipWithAux_toArray_succ]
| succ i ih =>
@@ -318,7 +364,7 @@ theorem zipWithAux_toArray_succ' (f : α → β → γ) (as : List α) (bs : Lis
simp
theorem zipWithAux_toArray_zero (f : α β γ) (as : List α) (bs : List β) (cs : Array γ) :
zipWithAux f as.toArray bs.toArray 0 cs = cs ++ (List.zipWith f as bs).toArray := by
zipWithAux as.toArray bs.toArray f 0 cs = cs ++ (List.zipWith f as bs).toArray := by
rw [Array.zipWithAux]
match as, bs with
| [], _ => simp
@@ -326,7 +372,7 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
| a :: as, b :: bs =>
simp [zipWith_cons_cons, zipWithAux_toArray_succ', zipWithAux_toArray_zero, push_append_toArray]
@[simp] theorem zipWith_toArray (f : α β γ) (as : List α) (bs : List β) :
@[simp] theorem zipWith_toArray (as : List α) (bs : List β) (f : α β γ) :
Array.zipWith as.toArray bs.toArray f = (List.zipWith f as bs).toArray := by
rw [Array.zipWith]
simp [zipWithAux_toArray_zero]
@@ -335,6 +381,44 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
Array.zip as.toArray bs.toArray = (List.zip as bs).toArray := by
simp [Array.zip, zipWith_toArray, zip]
theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α Option β γ) (i : Nat) (cs : Array γ) :
zipWithAll.go f as.toArray bs.toArray i cs = cs ++ (List.zipWithAll f (as.drop i) (bs.drop i)).toArray := by
unfold zipWithAll.go
split <;> rename_i h
· rw [zipWithAll_go_toArray]
simp at h
simp only [getElem?_toArray, push_append_toArray]
if ha : i < as.length then
if hb : i < bs.length then
rw [List.drop_eq_getElem_cons ha, List.drop_eq_getElem_cons hb]
simp only [ha, hb, getElem?_eq_getElem, zipWithAll_cons_cons]
else
simp only [Nat.not_lt] at hb
rw [List.drop_eq_getElem_cons ha]
rw [(drop_eq_nil_iff (l := bs)).mpr (by omega), (drop_eq_nil_iff (l := bs)).mpr (by omega)]
simp only [zipWithAll_nil, map_drop, map_cons]
rw [getElem?_eq_getElem ha]
rw [getElem?_eq_none hb]
else
if hb : i < bs.length then
simp only [Nat.not_lt] at ha
rw [List.drop_eq_getElem_cons hb]
rw [(drop_eq_nil_iff (l := as)).mpr (by omega), (drop_eq_nil_iff (l := as)).mpr (by omega)]
simp only [nil_zipWithAll, map_drop, map_cons]
rw [getElem?_eq_getElem hb]
rw [getElem?_eq_none ha]
else
omega
· simp only [size_toArray, Nat.not_lt] at h
rw [drop_eq_nil_of_le (by omega), drop_eq_nil_of_le (by omega)]
simp
termination_by max as.length bs.length - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[simp] theorem zipWithAll_toArray (f : Option α Option β γ) (as : List α) (bs : List β) :
Array.zipWithAll as.toArray bs.toArray f = (List.zipWithAll f as bs).toArray := by
simp [Array.zipWithAll, zipWithAll_go_toArray]
end List
namespace Array
@@ -357,7 +441,8 @@ namespace Array
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp [foldrM_eq_reverse_foldlM_toList, -size_push]
simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
/--
Variant of `foldrM_push` with `h : start = arr.size + 1`
@@ -383,11 +468,11 @@ rather than `(arr.push a).size` as the argument.
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_eq_foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
rw [toListRev, foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
rw [mapM, aux, foldlM_eq_foldlM_toList]; rfl
rw [mapM, aux, foldlM_toList]; rfl
where
aux (i r) :
mapM.map f arr i r = (arr.toList.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
@@ -402,7 +487,7 @@ where
@[simp] theorem toList_map (f : α β) (arr : Array α) : (arr.map f).toList = arr.toList.map f := by
rw [map, mapM_eq_foldlM]
apply congrArg toList (foldl_eq_foldl_toList (fun bs a => push bs (f a)) #[] arr) |>.trans
apply congrArg toList (foldl_toList (fun bs a => push bs (f a)) #[] arr).symm |>.trans
have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = arr.toList ++ l.map f := by
induction l generalizing arr <;> simp [*]
simp [H]
@@ -411,6 +496,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 α) :
@@ -466,10 +556,10 @@ theorem getElem?_len_le (a : Array α) {i : Nat} (h : a.size ≤ i) : a[i]? = no
theorem getD_get? (a : Array α) (i : Nat) (d : α) :
Option.getD a[i]? d = if p : i < a.size then a[i]'p else d := by
if h : i < a.size then
simp [setD, h, getElem?_def]
simp [setIfInBounds, h, getElem?_def]
else
have p : i a.size := Nat.le_of_not_gt h
simp [setD, getElem?_len_le _ p, h]
simp [setIfInBounds, getElem?_len_le _ p, h]
@[simp] theorem getD_eq_get? (a : Array α) (n d) : a.getD n d = (a[n]?).getD d := by
simp only [getD, get_eq_getElem, get?_eq_getElem?]; split <;> simp [getD_get?, *]
@@ -505,31 +595,46 @@ theorem getElem_set (a : Array α) (i : Nat) (h' : i < a.size) (v : α) (j : Nat
(ne : i j) : (a.set i v)[j]? = a[j]? := by
by_cases h : j < a.size <;> simp [getElem?_lt, getElem?_ge, Nat.ge_of_not_lt, ne, h]
/-! # setD -/
theorem push_set (a : Array α) (x y : α) {i : Nat} {hi} :
(a.set i x).push y = (a.push y).set i x (by simp; omega):= by
ext j h₁ h₂
· simp
· if h' : j = a.size then
rw [getElem_push, getElem_set_ne, dif_neg]
all_goals simp_all <;> omega
else
rw [getElem_push_lt, getElem_set, getElem_set]
split
· rfl
· rw [getElem_push_lt]
simp_all; omega
@[simp] theorem set!_is_setD : @set! = @setD := rfl
/-! # setIfInBounds -/
@[simp] theorem size_setD (a : Array α) (index : Nat) (val : α) :
(Array.setD a index val).size = a.size := by
@[simp] theorem set!_is_setIfInBounds : @set! = @setIfInBounds := rfl
@[simp] theorem size_setIfInBounds (a : Array α) (index : Nat) (val : α) :
(Array.setIfInBounds a index val).size = a.size := by
if h : index < a.size then
simp [setD, h]
simp [setIfInBounds, h]
else
simp [setD, h]
simp [setIfInBounds, h]
@[simp] theorem getElem_setD_eq (a : Array α) {i : Nat} (v : α) (h : _) :
(setD a i v)[i]'h = v := by
@[simp] theorem getElem_setIfInBounds_eq (a : Array α) {i : Nat} (v : α) (h : _) :
(setIfInBounds a i v)[i]'h = v := by
simp at h
simp only [setD, h, reduceDIte, getElem_set_eq]
simp only [setIfInBounds, h, reduceDIte, getElem_set_eq]
@[simp]
theorem getElem?_setD_eq (a : Array α) {i : Nat} (p : i < a.size) (v : α) : (a.setD i v)[i]? = some v := by
theorem getElem?_setIfInBounds_eq (a : Array α) {i : Nat} (p : i < a.size) (v : α) :
(a.setIfInBounds i v)[i]? = some v := by
simp [getElem?_lt, p]
/-- Simplifies a normal form from `get!` -/
@[simp] theorem getD_get?_setD (a : Array α) (i : Nat) (v d : α) :
Option.getD (setD a i v)[i]? d = if i < a.size then v else d := by
@[simp] theorem getD_get?_setIfInBounds (a : Array α) (i : Nat) (v d : α) :
Option.getD (setIfInBounds a i v)[i]? d = if i < a.size then v else d := by
by_cases h : i < a.size <;>
simp [setD, Nat.not_lt_of_le, h, getD_get?]
simp [setIfInBounds, Nat.not_lt_of_le, h, getD_get?]
/-! # ofFn -/
@@ -574,13 +679,28 @@ theorem getElem?_ofFn (f : Fin n → α) (i : Nat) :
(ofFn f)[i]? = if h : i < n then some (f i, h) else none := by
simp [getElem?_def]
/-- # mkArray -/
@[simp] theorem ofFn_zero (f : Fin 0 α) : ofFn f = #[] := rfl
theorem ofFn_succ (f : Fin (n+1) α) :
ofFn f = (ofFn (fun (i : Fin n) => f i.castSucc)).push (f n, by omega) := by
ext i h₁ h₂
· simp
· simp [getElem_push]
split <;> rename_i h₃
· rfl
· congr
simp at h₁ h₂
omega
/-! # mkArray -/
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
List.length_replicate ..
@[simp] theorem toList_mkArray (n : Nat) (v : α) : (mkArray n v).toList = List.replicate n v := rfl
theorem mkArray_eq_toArray_replicate (n : Nat) (v : α) : mkArray n v = (List.replicate n v).toArray := rfl
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
(mkArray n v)[i] = v := by simp [Array.getElem_eq_getElem_toList]
@@ -588,42 +708,29 @@ theorem getElem?_mkArray (n : Nat) (v : α) (i : Nat) :
(mkArray n v)[i]? = if i < n then some v else none := by
simp [getElem?_def]
/-- # mem -/
/-! # mem -/
theorem mem_toList {a : α} {l : Array α} : a l.toList a l := mem_def.symm
@[simp] theorem mem_toList {a : α} {l : Array α} : a l.toList a l := mem_def.symm
theorem not_mem_nil (a : α) : ¬ a #[] := nofun
theorem getElem_of_mem {a : α} {as : Array α} :
a as ( (n : Nat) (h : n < as.size), as[n]'h = a) := by
intro ha
rcases List.getElem_of_mem ha.val with i, hbound, hi
exists i
exists hbound
theorem getElem?_of_mem {a : α} {as : Array α} :
a as (n : Nat), as[n]? = some a := by
intro ha
rcases List.getElem?_of_mem ha.val with i, hi
exists i
@[simp] theorem mem_dite_empty_left {x : α} [Decidable p] {l : ¬ p Array α} :
(x if h : p then #[] else l h) h : ¬ p, x l h := by
split <;> simp_all [mem_def]
split <;> simp_all
@[simp] theorem mem_dite_empty_right {x : α} [Decidable p] {l : p Array α} :
(x if h : p then l h else #[]) h : p, x l h := by
split <;> simp_all [mem_def]
split <;> simp_all
@[simp] theorem mem_ite_empty_left {x : α} [Decidable p] {l : Array α} :
(x if p then #[] else l) ¬ p x l := by
split <;> simp_all [mem_def]
split <;> simp_all
@[simp] theorem mem_ite_empty_right {x : α} [Decidable p] {l : Array α} :
(x if p then l else #[]) p x l := by
split <;> simp_all [mem_def]
split <;> simp_all
/-- # get lemmas -/
/-! # get lemmas -/
theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size} (_ : a[idx] = x) :
idx < a.size :=
@@ -648,10 +755,6 @@ theorem get?_eq_get?_toList (a : Array α) (i : Nat) : a.get? i = a.toList.get?
theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
simp only [get!_eq_getElem?, get?_eq_getElem?]
theorem getElem?_eq_some_iff {as : Array α} : as[n]? = some a h : n < as.size, as[n] = a := by
cases as
simp [List.getElem?_eq_some_iff]
theorem back!_eq_back? [Inhabited α] (a : Array α) : a.back! = a.back?.getD default := by
simp only [back!, get!_eq_getElem?, get?_eq_getElem?, back?]
@@ -661,6 +764,10 @@ theorem back!_eq_back? [Inhabited α] (a : Array α) : a.back! = a.back?.getD de
@[simp] theorem back!_push [Inhabited α] (a : Array α) : (a.push x).back! = x := by
simp [back!_eq_back?]
theorem mem_of_back?_eq_some {xs : Array α} {a : α} (h : xs.back? = some a) : a xs := by
cases xs
simpa using List.mem_of_getLast?_eq_some (by simpa using h)
theorem getElem?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
(a.push x)[i]? = some a[i] := by
rw [getElem?_pos, getElem_push_lt]
@@ -719,32 +826,32 @@ theorem get_set (a : Array α) (i : Nat) (hi : i < a.size) (j : Nat) (hj : j < a
(h : i j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) :
(setD a i v)[i] = v := by
theorem getElem_setIfInBounds (a : Array α) (i : Nat) (v : α) (h : i < (setIfInBounds a i v).size) :
(setIfInBounds a i v)[i] = v := by
simp at h
simp only [setD, h, reduceDIte, getElem_set_eq]
simp only [setIfInBounds, h, reduceDIte, getElem_set_eq]
theorem set_set (a : Array α) (i : Nat) (h) (v v' : α) :
(a.set i v h).set i v' (by simp [h]) = a.set i v' := by simp [set, List.set_set]
private theorem fin_cast_val (e : n = n') (i : Fin n) : e i = i.1, e i.2 := by cases e; rfl
theorem swap_def (a : Array α) (i j : Fin a.size) :
a.swap i j = (a.set i a[j]).set j a[i] := by
theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
simp [swap, fin_cast_val]
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
(a.swap i j).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
(a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
theorem getElem?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]? =
if j = k then some a[i.1] else if i = k then some a[j.1] else a[k]? := by
theorem getElem?_swap (a : Array α) (i j : Nat) (hi hj) (k : Nat) : (a.swap i j hi hj)[k]? =
if j = k then some a[i] else if i = k then some a[j] else a[k]? := by
simp [swap_def, get?_set, getElem_fin_eq_getElem_toList]
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
a.swapAt i v = (a[i.1], a.set i v) := rfl
@[simp] theorem swapAt_def (a : Array α) (i : Nat) (v : α) (hi) :
a.swapAt i v hi = (a[i], a.set i v) := rfl
@[simp] theorem size_swapAt (a : Array α) (i : Fin a.size) (v : α) :
(a.swapAt i v).2.size = a.size := by simp [swapAt_def]
@[simp] theorem size_swapAt (a : Array α) (i : Nat) (v : α) (hi) :
(a.swapAt i v hi).2.size = a.size := by simp [swapAt_def]
@[simp]
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
@@ -791,8 +898,10 @@ theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size ≠ 0) :
theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rfl
@[simp] theorem size_swap! (a : Array α) (i j) :
(a.swap! i j).size = a.size := by unfold swap!; split <;> (try split) <;> simp [size_swap]
@[simp] theorem size_swapIfInBounds (a : Array α) (i j) :
(a.swapIfInBounds i j).size = a.size := by unfold swapIfInBounds; split <;> (try split) <;> simp [size_swap]
@[deprecated size_swapIfInBounds (since := "2024-11-24")] abbrev size_swap! := @size_swapIfInBounds
@[simp] theorem size_reverse (a : Array α) : a.reverse.size = a.size := by
let rec go (as : Array α) (i j) : (reverse.loop as i j).size = as.size := by
@@ -804,16 +913,10 @@ theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rf
simp only [reverse]; split <;> simp [go]
@[simp] theorem size_range {n : Nat} : (range n).size = n := by
unfold range
induction n with
| zero => simp [Nat.fold]
| succ k ih =>
rw [Nat.fold, flip]
simp only [mkEmpty_eq, size_push] at *
omega
induction n <;> simp [range]
@[simp] theorem toList_range (n : Nat) : (range n).toList = List.range n := by
induction n <;> simp_all [range, Nat.fold, flip, List.range_succ]
apply List.ext_getElem <;> simp [range]
@[simp]
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
@@ -1009,14 +1112,46 @@ 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
simp only [mem_def, toList_map, List.mem_map]
theorem exists_of_mem_map (h : b map f l) : a, a l f a = b := mem_map.1 h
theorem mem_map_of_mem (f : α β) (h : a l) : f a map f l := mem_map.2 _, h, rfl
theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
rw [mapM_eq_foldlM, foldlM_eq_foldlM_toList, List.foldrM_reverse]
rw [mapM_eq_foldlM, foldlM_toList, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.toList]
induction arr.toList.reverse with
| nil => simp
@@ -1141,7 +1276,7 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : αα} {j : Nat} :
@[simp] theorem toList_filter (p : α Bool) (l : Array α) :
(l.filter p).toList = l.toList.filter p := by
dsimp only [filter]
rw [foldl_eq_foldl_toList]
rw [ foldl_toList]
generalize l.toList = l
suffices a, (List.foldl (fun r a => if p a = true then push r a else r) a l).toList =
a.toList ++ List.filter p l by
@@ -1172,7 +1307,7 @@ theorem filter_congr {as bs : Array α} (h : as = bs)
@[simp] theorem toList_filterMap (f : α Option β) (l : Array α) :
(l.filterMap f).toList = l.toList.filterMap f := by
dsimp only [filterMap, filterMapM]
rw [foldlM_eq_foldlM_toList]
rw [ foldlM_toList]
generalize l.toList = l
have this : a : Array β, (Id.run (List.foldlM (m := Id) ?_ a l)).toList =
a.toList ++ List.filterMap f l := ?_
@@ -1204,9 +1339,23 @@ theorem push_eq_append_singleton (as : Array α) (x) : as.push x = as ++ #[x] :=
@[simp] theorem mem_append {a : α} {s t : Array α} : a s ++ t a s a t := by
simp only [mem_def, toList_append, List.mem_append]
theorem mem_append_left {a : α} {l₁ : Array α} (l₂ : Array α) (h : a l₁) : a l₁ ++ l₂ :=
mem_append.2 (Or.inl h)
theorem mem_append_right {a : α} (l₁ : Array α) {l₂ : Array α} (h : a l₂) : a l₁ ++ l₂ :=
mem_append.2 (Or.inr h)
@[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
simp only [size, toList_append, List.length_append]
@[simp] theorem empty_append (as : Array α) : #[] ++ as = as := by
cases as
simp
@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
cases as
simp
theorem getElem_append {as bs : Array α} (h : i < (as ++ bs).size) :
(as ++ bs)[i] = if h' : i < as.size then as[i] else bs[i - as.size]'(by simp at h; omega) := by
cases as; cases bs
@@ -1251,7 +1400,7 @@ theorem getElem?_append {as bs : Array α} {n : Nat} :
@[simp] theorem toList_flatten {l : Array (Array α)} :
l.flatten.toList = (l.toList.map toList).flatten := by
dsimp [flatten]
simp only [foldl_eq_foldl_toList]
simp only [ foldl_toList]
generalize l.toList = l
have : a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
exact this #[]
@@ -1470,7 +1619,7 @@ termination_by stop - start
-- This could also be proved from `SatisfiesM_anyM_iff_exists` in `Batteries.Data.Array.Init.Monadic`
theorem any_iff_exists {p : α Bool} {as : Array α} {start stop} :
any as p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
as.any p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
dsimp [any, anyM, Id.run]
split
· rw [anyM_loop_iff_exists]; rfl
@@ -1482,7 +1631,7 @@ theorem any_iff_exists {p : α → Bool} {as : Array α} {start stop} :
exact i, by omega, by omega, h
theorem any_eq_true {p : α Bool} {as : Array α} :
any as p i : Fin as.size, p as[i] := by simp [any_iff_exists, Fin.isLt]
as.any p i : Fin as.size, p as[i] := by simp [any_iff_exists, Fin.isLt]
theorem any_toList {p : α Bool} (as : Array α) : as.toList.any p = as.any p := by
rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]; simp only [List.mem_iff_get]
@@ -1502,20 +1651,20 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
rw [List.allM_eq_not_anyM_not]
theorem all_eq_not_any_not (p : α Bool) (as : Array α) (start stop) :
all as p start stop = !(any as (!p ·) start stop) := by
as.all p start stop = !(as.any (!p ·) start stop) := by
dsimp [all, allM]
rfl
theorem all_iff_forall {p : α Bool} {as : Array α} {start stop} :
all as p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
as.all p start stop i : Fin as.size, start i.1 i.1 < stop p as[i] := by
rw [all_eq_not_any_not]
suffices ¬(any as (!p ·) start stop = true)
suffices ¬(as.any (!p ·) start stop = true)
i : Fin as.size, start i.1 i.1 < stop p as[i] by
simp_all
rw [any_iff_exists]
simp
theorem all_eq_true {p : α Bool} {as : Array α} : all as p i : Fin as.size, p as[i] := by
theorem all_eq_true {p : α Bool} {as : Array α} : as.all p i : Fin as.size, p as[i] := by
simp [all_iff_forall, Fin.isLt]
theorem all_toList {p : α Bool} (as : Array α) : as.toList.all p = as.all p := by
@@ -1542,28 +1691,30 @@ instance [DecidableEq α] (a : α) (as : Array α) : Decidable (a ∈ as) :=
open Fin
@[simp] theorem getElem_swap_right (a : Array α) {i j : Fin a.size} : (a.swap i j)[j.1] = a[i] := by
@[simp] theorem getElem_swap_right (a : Array α) {i j : Nat} {hi hj} :
(a.swap i j hi hj)[j]'(by simpa using hj) = a[i] := by
simp [swap_def, getElem_set]
@[simp] theorem getElem_swap_left (a : Array α) {i j : Fin a.size} : (a.swap i j)[i.1] = a[j] := by
@[simp] theorem getElem_swap_left (a : Array α) {i j : Nat} {hi hj} :
(a.swap i j hi hj)[i]'(by simpa using hi) = a[j] := by
simp +contextual [swap_def, getElem_set]
@[simp] theorem getElem_swap_of_ne (a : Array α) {i j : Fin a.size} (hp : p < a.size)
(hi : p i) (hj : p j) : (a.swap i j)[p]'(a.size_swap .. |>.symm hp) = a[p] := by
simp [swap_def, getElem_set, hi.symm, hj.symm]
@[simp] theorem getElem_swap_of_ne (a : Array α) {i j : Nat} {hi hj} (hp : p < a.size)
(hi' : p i) (hj' : p j) : (a.swap i j hi hj)[p]'(a.size_swap .. |>.symm hp) = a[p] := by
simp [swap_def, getElem_set, hi'.symm, hj'.symm]
theorem getElem_swap' (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < a.size) :
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
theorem getElem_swap' (a : Array α) (i j : Nat) {hi hj} (k : Nat) (hk : k < a.size) :
(a.swap i j hi hj)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
split
· simp_all only [getElem_swap_left]
· split <;> simp_all
theorem getElem_swap (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < (a.swap i j).size) :
(a.swap i j)[k] = if k = i then a[j] else if k = j then a[i] else a[k]'(by simp_all) := by
theorem getElem_swap (a : Array α) (i j : Nat) {hi hj}(k : Nat) (hk : k < (a.swap i j).size) :
(a.swap i j hi hj)[k] = if k = i then a[j] else if k = j then a[i] else a[k]'(by simp_all) := by
apply getElem_swap'
@[simp] theorem swap_swap (a : Array α) {i j : Fin a.size} :
(a.swap i j).swap i.1, (a.size_swap ..).symm i.2 j.1, (a.size_swap ..).symm j.2 = a := by
@[simp] theorem swap_swap (a : Array α) {i j : Nat} (hi hj) :
(a.swap i j hi hj).swap i j ((a.size_swap ..).symm hi) ((a.size_swap ..).symm hj) = a := by
apply ext
· simp only [size_swap]
· intros
@@ -1572,7 +1723,7 @@ theorem getElem_swap (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < (a.sw
· simp_all
· split <;> simp_all
theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i := by
theorem swap_comm (a : Array α) {i j : Nat} {hi hj} : a.swap i j hi hj = a.swap j i hj hi := by
apply ext
· simp only [size_swap]
· intros
@@ -1581,11 +1732,16 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
· split <;> simp_all
· split <;> simp_all
theorem push_swap (a : Array α) (x : α) {i j : Nat} {hi hj} :
(a.swap i j hi hj).push x = (a.push x).swap i j (by simp; omega) (by simp; omega) := by
rw [swap_def, swap_def]
simp [push_set, getElem_push_lt, hi, hj]
/-! ### eraseIdx -/
theorem feraseIdx_eq_eraseIdx {a : Array α} {i : Fin a.size} :
a.feraseIdx i = a.eraseIdx i.1 := by
simp [eraseIdx]
theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size) :
a.eraseIdx i h = a.eraseIdxIfInBounds i := by
simp [eraseIdxIfInBounds, h]
/-! ### isPrefixOf -/
@@ -1607,6 +1763,20 @@ theorem feraseIdx_eq_eraseIdx {a : Array α} {i : Fin a.size} :
(Array.zip as bs).toList = List.zip as.toList bs.toList := by
simp [zip, toList_zipWith, List.zip]
@[simp] theorem toList_zipWithAll (f : Option α Option β γ) (as : Array α) (bs : Array β) :
(Array.zipWithAll as bs f).toList = List.zipWithAll f as.toList bs.toList := by
cases as
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 α) :
@@ -1681,10 +1851,10 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
apply ext'
simp
@[simp] theorem setD_toArray (l : List α) (i : Nat) (a : α) :
l.toArray.setD i a = (l.set i a).toArray := by
@[simp] theorem setIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
l.toArray.setIfInBounds i a = (l.set i a).toArray := by
apply ext'
simp only [setD]
simp only [setIfInBounds]
split
· simp
· simp_all [List.set_eq_of_length_le]
@@ -1729,8 +1899,8 @@ theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p
subst h
rw [all_toList]
@[simp] theorem swap_toArray (l : List α) (i j : Fin l.toArray.size) :
l.toArray.swap i j = ((l.set i l[j]).set j l[i]).toArray := by
@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
apply ext'
simp
@@ -1815,16 +1985,15 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
l.toArray.takeWhile p = (l.takeWhile p).toArray := by
simp [Array.takeWhile, takeWhile_go_toArray]
@[simp] theorem feraseIdx_toArray (l : List α) (i : Fin l.toArray.size) :
l.toArray.feraseIdx i = (l.eraseIdx i).toArray := by
rw [feraseIdx]
split <;> rename_i h
· rw [feraseIdx_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]
split <;> rename_i h'
· rw [eraseIdx_toArray]
simp only [swap_toArray, Fin.getElem_fin, toList_toArray, mk.injEq]
rw [eraseIdx_set_gt (by simp), eraseIdx_set_eq]
simp
· rcases i with i, w
simp at h w
· simp at h h'
have t : i = l.length - 1 := by omega
simp [t]
termination_by l.length - i
@@ -1834,9 +2003,9 @@ decreasing_by
simp
omega
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) :
l.toArray.eraseIdx i = (l.eraseIdx i).toArray := by
rw [Array.eraseIdx]
@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
rw [Array.eraseIdxIfInBounds]
split
· simp
· simp_all [eraseIdx_eq_self.2]
@@ -1855,16 +2024,100 @@ namespace Array
(as.takeWhile p).toList = as.toList.takeWhile p := by
induction as; simp
@[simp] theorem toList_feraseIdx (as : Array α) (i : Fin as.size) :
(as.feraseIdx i).toList = as.toList.eraseIdx i.1 := by
@[simp] theorem toList_eraseIdx (as : Array α) (i : Nat) (h : i < as.size) :
(as.eraseIdx i h).toList = as.toList.eraseIdx i := by
induction as
simp
@[simp] theorem toList_eraseIdx (as : Array α) (i : Nat) :
(as.eraseIdx i).toList = as.toList.eraseIdx i := by
@[simp] theorem toList_eraseIdxIfInBounds (as : Array α) (i : Nat) :
(as.eraseIdxIfInBounds i).toList = as.toList.eraseIdx i := by
induction as
simp
/-! ### map -/
@[simp] theorem map_map {f : α β} {g : β γ} {as : Array α} :
(as.map f).map g = as.map (g f) := by
cases as; simp
@[simp] theorem map_id_fun : map (id : α α) = id := by
funext l
induction l <;> simp_all
/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
theorem map_id (as : Array α) : map (id : α α) as = as := by
cases as <;> simp_all
/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
theorem map_id' (as : Array α) : map (fun (a : α) => a) as = as := map_id as
/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
theorem map_id'' {f : α α} (h : x, f x = x) (as : Array α) : map f as = as := by
simp [show f = id from funext h]
theorem array_array_induction (P : Array (Array α) Prop) (h : (xss : List (List α)), P (xss.map List.toArray).toArray)
(ass : Array (Array α)) : P ass := by
specialize h (ass.toList.map toList)
simpa [ toList_map, Function.comp_def, map_id] using h
theorem foldl_map (f : β₁ β₂) (g : α β₂ α) (l : Array β₁) (init : α) :
(l.map f).foldl g init = l.foldl (fun x y => g x (f y)) init := by
cases l; simp [List.foldl_map]
theorem foldr_map (f : α₁ α₂) (g : α₂ β β) (l : Array α₁) (init : β) :
(l.map f).foldr g init = l.foldr (fun x y => g (f x) y) init := by
cases l; simp [List.foldr_map]
theorem foldl_filterMap (f : α Option β) (g : γ β γ) (l : Array α) (init : γ) :
(l.filterMap f).foldl g init = l.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
cases l
simp [List.foldl_filterMap]
rfl
theorem foldr_filterMap (f : α Option β) (g : β γ γ) (l : Array α) (init : γ) :
(l.filterMap f).foldr g init = l.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
cases l
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
@[simp] theorem flatten_toArray_map_toArray (xss : List (List α)) :
(xss.map List.toArray).toArray.flatten = xss.flatten.toArray := by
simp [flatten]
suffices as, List.foldl (fun r a => r ++ a) as (List.map List.toArray xss) = as ++ xss.flatten.toArray by
simpa using this #[]
intro as
induction xss generalizing as with
| nil => simp
| cons xs xss ih => simp [ih]
/-! ### reverse -/
@[simp] theorem mem_reverse {x : α} {as : Array α} : x as.reverse x as := by
cases as
simp
/-! ### findSomeRevM?, findRevM?, findSomeRev?, findRev? -/
@[simp] theorem findSomeRevM?_eq_findSomeM?_reverse
@@ -1929,6 +2182,27 @@ namespace Array
cases as
simp
@[simp] theorem flatMap_empty {β} (f : α Array β) : (#[] : Array α).flatMap f = #[] := rfl
@[simp] theorem flatMap_toArray_cons {β} (f : α Array β) (a : α) (as : List α) :
(a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
simp [flatMap]
suffices cs, List.foldl (fun bs a => bs ++ f a) (f a ++ cs) as =
f a ++ List.foldl (fun bs a => bs ++ f a) cs as by
erw [empty_append] -- Why doesn't this work via `simp`?
simpa using this #[]
intro cs
induction as generalizing cs <;> simp_all
@[simp] theorem flatMap_toArray {β} (f : α Array β) (as : List α) :
as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
induction as with
| nil => simp
| cons a as ih =>
apply ext'
simp [ih]
end Array
/-! ### Deprecations -/
@@ -1946,6 +2220,8 @@ theorem toArray_concat {as : List α} {x : α} :
@[deprecated back!_toArray (since := "2024-10-31")] abbrev back_toArray := @back!_toArray
@[deprecated setIfInBounds_toArray (since := "2024-11-24")] abbrev setD_toArray := @setIfInBounds_toArray
end List
namespace Array
@@ -2091,4 +2367,11 @@ abbrev get_swap' := @getElem_swap'
@[deprecated eq_push_pop_back!_of_size_ne_zero (since := "2024-10-31")]
abbrev eq_push_pop_back_of_size_ne_zero := @eq_push_pop_back!_of_size_ne_zero
@[deprecated set!_is_setIfInBounds (since := "2024-11-24")] abbrev set_is_setIfInBounds := @set!_is_setIfInBounds
@[deprecated size_setIfInBounds (since := "2024-11-24")] abbrev size_setD := @size_setIfInBounds
@[deprecated getElem_setIfInBounds_eq (since := "2024-11-24")] abbrev getElem_setD_eq := @getElem_setIfInBounds_eq
@[deprecated getElem?_setIfInBounds_eq (since := "2024-11-24")] abbrev get?_setD_eq := @getElem?_setIfInBounds_eq
@[deprecated getD_get?_setIfInBounds (since := "2024-11-24")] abbrev getD_setD := @getD_get?_setIfInBounds
@[deprecated getElem_setIfInBounds (since := "2024-11-24")] abbrev getElem_setD := @getElem_setIfInBounds
end Array

View File

@@ -66,35 +66,35 @@ theorem mapFinIdx_spec (as : Array α) (f : Fin as.size → α → β)
/-! ### mapIdx -/
theorem mapIdx_induction (as : Array α) (f : Nat α β)
theorem mapIdx_induction (f : Nat α β) (as : Array α)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
motive as.size eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
theorem mapIdx_spec (as : Array α) (f : Nat α β)
theorem mapIdx_spec (f : Nat α β) (as : Array α)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
eq : (as.mapIdx f).size = as.size,
i h, p i, h ((as.mapIdx f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (a : Array α) (f : Nat α β) : (a.mapIdx f).size = a.size :=
@[simp] theorem size_mapIdx (f : Nat α β) (as : Array α) : (as.mapIdx f).size = as.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem getElem_mapIdx (a : Array α) (f : Nat α β) (i : Nat)
(h : i < (mapIdx a f).size) :
(a.mapIdx f)[i] = f i (a[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i (by simp_all)
@[simp] theorem getElem_mapIdx (f : Nat α β) (as : Array α) (i : Nat)
(h : i < (as.mapIdx f).size) :
(as.mapIdx f)[i] = f i (as[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i as[i]) fun _ => rfl).2 i (by simp_all)
@[simp] theorem getElem?_mapIdx (a : Array α) (f : Nat α β) (i : Nat) :
(a.mapIdx f)[i]? =
a[i]?.map (f i) := by
@[simp] theorem getElem?_mapIdx (f : Nat α β) (as : Array α) (i : Nat) :
(as.mapIdx f)[i]? =
as[i]?.map (f i) := by
simp [getElem?_def, size_mapIdx, getElem_mapIdx]
@[simp] theorem toList_mapIdx (a : Array α) (f : Nat α β) :
(a.mapIdx f).toList = a.toList.mapIdx (fun i a => f i a) := by
@[simp] theorem toList_mapIdx (f : Nat α β) (as : Array α) :
(as.mapIdx f).toList = as.toList.mapIdx (fun i a => f i a) := by
apply List.ext_getElem <;> simp
end Array
@@ -105,7 +105,7 @@ namespace List
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
ext <;> simp
@[simp] theorem mapIdx_toArray (l : List α) (f : Nat α β) :
@[simp] theorem mapIdx_toArray (f : Nat α β) (l : List α) :
l.toArray.mapIdx f = (l.mapIdx f).toArray := by
ext <;> simp

View File

@@ -0,0 +1,159 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.Array.Attach
import Init.Data.List.Monadic
/-!
# Lemmas about `Array.forIn'` and `Array.forIn`.
-/
namespace Array
open Nat
/-! ## Monadic operations -/
/-! ### mapM -/
theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α m β) (l : Array α) :
mapM f l = l.foldlM (fun acc a => return (acc.push ( f a))) #[] := by
rcases l with l
simp only [List.mapM_toArray, bind_pure_comp, size_toArray, List.foldlM_toArray']
rw [List.mapM_eq_reverse_foldlM_cons]
simp only [bind_pure_comp, Functor.map_map]
suffices (k), (fun a => a.reverse.toArray) <$> List.foldlM (fun acc a => (fun a => a :: acc) <$> f a) k l =
List.foldlM (fun acc a => acc.push <$> f a) k.reverse.toArray l by
exact this []
intro k
induction l generalizing k with
| nil => simp
| cons a as ih =>
simp [ih, List.foldlM_cons]
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Array β₁) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : Array β₁)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_map]
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldlM g init =
l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filterMap]
rfl
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldrM g init =
l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filterMap]
rfl
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β) (l : Array α) (init : β) :
(l.filter p).foldlM g init =
l.foldlM (fun x y => if p y then g x y else pure x) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filter]
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β) (l : Array α) (init : β) :
(l.filter p).foldrM g init =
l.foldrM (fun x y => if p x then g x y else pure y) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filter]
/-! ### forIn' -/
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m (ForInStep β)) (init : β) :
forIn' l init f = ForInStep.value <$>
l.attach.foldlM (fun b a, m => match b with
| .yield b => f a m b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp only [List.forIn'_toArray, List.forIn'_eq_foldlM, List.attachWith_mem_toArray, size_toArray,
List.length_map, List.length_attach, List.foldlM_toArray', List.foldlM_map]
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn'_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m γ) (g : (a : α) a l β γ β) (init : β) :
forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
l.attach.foldlM (fun b a, m => g a m b <$> f a m b) init := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' l init (fun a m b => pure (.yield (f a m b))) =
pure (f := m) (l.attach.foldl (fun b a, h => f a h b) init) := by
cases l
simp [List.forIn'_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn'_yield_eq_foldl
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' (m := Id) l init (fun a m b => .yield (f a m b)) =
l.attach.foldl (fun b a, h => f a h b) init := by
cases l
simp [List.foldl_map]
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn_eq_foldlM [Monad m] [LawfulMonad m]
(f : α β m (ForInStep β)) (init : β) (l : Array α) :
forIn l init f = ForInStep.value <$>
l.foldlM (fun b a => match b with
| .yield b => f a b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
simp only [List.forIn_toArray, List.forIn_eq_foldlM, size_toArray, List.foldlM_toArray']
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : α β m γ) (g : α β γ β) (init : β) :
forIn l init (fun a b => (fun c => .yield (g a b c)) <$> f a b) =
l.foldlM (fun b a => g a b <$> f a b) init := by
cases l
simp [List.foldlM_map]
theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : α β β) (init : β) :
forIn l init (fun a b => pure (.yield (f a b))) =
pure (f := m) (l.foldl (fun b a => f a b) init) := by
cases l
simp [List.forIn_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn_yield_eq_foldl
(l : Array α) (f : α β β) (init : β) :
forIn (m := Id) l init (fun a b => .yield (f a b)) =
l.foldl (fun b a => f a b) init := by
cases l
simp [List.foldl_map]
end Array

View File

@@ -13,19 +13,19 @@ namespace Array
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
let mid := (lo + hi) / 2
let as := if lt (as.get! mid) (as.get! lo) then as.swap! lo mid else as
let as := if lt (as.get! hi) (as.get! lo) then as.swap! lo hi else as
let as := if lt (as.get! mid) (as.get! hi) then as.swap! mid hi else as
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) :=
if h : j < hi then
if lt (as.get! j) pivot then
let as := as.swap! i j
let as := as.swapIfInBounds i j
loop as (i+1) (j+1)
else
loop as i (j+1)
else
let as := as.swap! i hi
let as := as.swapIfInBounds i hi
(i, as)
termination_by hi - j
decreasing_by all_goals simp_wf; decreasing_trivial_pre_omega

View File

@@ -25,9 +25,11 @@ Set an element in an array, or do nothing if the index is out of bounds.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[inline] def Array.setD (a : Array α) (i : Nat) (v : α) : Array α :=
@[inline] def Array.setIfInBounds (a : Array α) (i : Nat) (v : α) : Array α :=
dite (LT.lt i a.size) (fun h => a.set i v h) (fun _ => a)
@[deprecated Array.setIfInBounds (since := "2024-11-24")] abbrev Array.setD := @Array.setIfInBounds
/--
Set an element in an array, or panic if the index is out of bounds.
@@ -36,4 +38,4 @@ count of 1 when called.
-/
@[extern "lean_array_set"]
def Array.set! (a : Array α) (i : @& Nat) (v : α) : Array α :=
Array.setD a i v
Array.setIfInBounds a i v

View File

@@ -15,15 +15,6 @@ structure Subarray (α : Type u) where
start_le_stop : start stop
stop_le_array_size : stop array.size
@[deprecated Subarray.array (since := "2024-04-13")]
abbrev Subarray.as (s : Subarray α) : Array α := s.array
@[deprecated Subarray.start_le_stop (since := "2024-04-13")]
theorem Subarray.h₁ (s : Subarray α) : s.start s.stop := s.start_le_stop
@[deprecated Subarray.stop_le_array_size (since := "2024-04-13")]
theorem Subarray.h₂ (s : Subarray α) : s.stop s.array.size := s.stop_le_array_size
namespace Subarray
def size (s : Subarray α) : Nat :=

View File

@@ -23,16 +23,13 @@ def split (s : Subarray α) (i : Fin s.size.succ) : (Subarray α × Subarray α)
let i', isLt := i
have := s.start_le_stop
have := s.stop_le_array_size
have : i' s.stop - s.start := Nat.lt_succ.mp isLt
have : s.start + i' s.stop := by omega
have : s.start + i' s.array.size := by omega
have : s.start + i' s.stop := by
simp only [size] at isLt
omega
let pre := {s with
stop := s.start + i',
start_le_stop := by omega,
stop_le_array_size := by assumption
stop_le_array_size := by omega
}
let post := {s with
start := s.start + i'
@@ -48,9 +45,7 @@ def drop (arr : Subarray α) (i : Nat) : Subarray α where
array := arr.array
start := min (arr.start + i) arr.stop
stop := arr.stop
start_le_stop := by
rw [Nat.min_def]
split <;> simp only [Nat.le_refl, *]
start_le_stop := by omega
stop_le_array_size := arr.stop_le_array_size
/--
@@ -63,9 +58,7 @@ def take (arr : Subarray α) (i : Nat) : Subarray α where
stop := min (arr.start + i) arr.stop
start_le_stop := by
have := arr.start_le_stop
rw [Nat.min_def]
split <;> omega
omega
stop_le_array_size := by
have := arr.stop_le_array_size
rw [Nat.min_def]
split <;> omega
omega

View File

@@ -29,9 +29,6 @@ section Nat
instance natCastInst : NatCast (BitVec w) := BitVec.ofNat w
@[deprecated isLt (since := "2024-03-12")]
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
/-- Theorem for normalizing the bit vector literal representation. -/
-- TODO: This needs more usage data to assess which direction the simp should go.
@[simp, bv_toNat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl

View File

@@ -346,6 +346,10 @@ theorem getMsbD_sub {i : Nat} {i_lt : i < w} {x y : BitVec w} :
· rfl
· omega
theorem getElem_sub {i : Nat} {x y : BitVec w} (h : i < w) :
(x - y)[i] = (x[i] ^^ ((~~~y + 1#w)[i] ^^ carry i x (~~~y + 1#w) false)) := by
simp [ getLsbD_eq_getElem, getLsbD_sub, h]
theorem msb_sub {x y: BitVec w} :
(x - y).msb
= (x.msb ^^ ((~~~y + 1#w).msb ^^ carry (w - 1 - 0) x (~~~y + 1#w) false)) := by
@@ -403,13 +407,17 @@ theorem getLsbD_neg {i : Nat} {x : BitVec w} :
rw [carry_succ_one _ _ (by omega), Bool.xor_not, decide_not]
simp only [add_one_ne_zero, decide_false, getLsbD_not, and_eq_true, decide_eq_true_eq,
not_eq_eq_eq_not, Bool.not_true, false_bne, not_exists, _root_.not_and, not_eq_true,
bne_left_inj, decide_eq_decide]
bne_right_inj, decide_eq_decide]
constructor
· rintro h j hj; exact And.right <| h j (by omega)
· rintro h j hj; exact by omega, h j (by omega)
· have h_ge : w i := by omega
simp [getLsbD_ge _ _ h_ge, h_ge, hi]
theorem getElem_neg {i : Nat} {x : BitVec w} (h : i < w) :
(-x)[i] = (x[i] ^^ decide ( j < i, x.getLsbD j = true)) := by
simp [ getLsbD_eq_getElem, getLsbD_neg, h]
theorem getMsbD_neg {i : Nat} {x : BitVec w} :
getMsbD (-x) i =
(getMsbD x i ^^ decide ( j < w, i < j getMsbD x j = true)) := by
@@ -419,7 +427,7 @@ theorem getMsbD_neg {i : Nat} {x : BitVec w} :
simp [hi]; omega
case pos =>
have h₁ : w - 1 - i < w := by omega
simp only [hi, decide_true, h₁, Bool.true_and, Bool.bne_left_inj, decide_eq_decide]
simp only [hi, decide_true, h₁, Bool.true_and, Bool.bne_right_inj, decide_eq_decide]
constructor
· rintro j, hj, h
refine w - 1 - j, by omega, by omega, by omega, _root_.cast ?_ h

View File

@@ -269,6 +269,10 @@ theorem ofBool_eq_iff_eq : ∀ {b b' : Bool}, BitVec.ofBool b = BitVec.ofBool b'
getLsbD (x#'lt) i = x.testBit i := by
simp [getLsbD, BitVec.ofNatLt]
@[simp] theorem getMsbD_ofNatLt {n x i : Nat} (h : x < 2^n) :
getMsbD (x#'h) i = (decide (i < n) && x.testBit (n - 1 - i)) := by
simp [getMsbD, getLsbD]
@[simp, bv_toNat] theorem toNat_ofNat (x w : Nat) : (BitVec.ofNat w x).toNat = x % 2^w := by
simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat']
@@ -561,6 +565,10 @@ theorem zeroExtend_eq_setWidth {v : Nat} {x : BitVec w} :
else
simp [n_le_i, toNat_ofNat]
@[simp] theorem toInt_setWidth (x : BitVec w) :
(x.setWidth v).toInt = Int.bmod x.toNat (2^v) := by
simp [toInt_eq_toNat_bmod, toNat_setWidth, Int.emod_bmod]
theorem setWidth'_eq {x : BitVec w} (h : w v) : x.setWidth' h = x.setWidth v := by
apply eq_of_toNat_eq
rw [toNat_setWidth, toNat_setWidth']
@@ -755,6 +763,10 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
@[simp] theorem getLsbD_allOnes : (allOnes v).getLsbD i = decide (i < v) := by
simp [allOnes]
@[simp] theorem getMsbD_allOnes : (allOnes v).getMsbD i = decide (i < v) := by
simp [allOnes]
omega
@[simp] theorem getElem_allOnes (i : Nat) (h : i < v) : (allOnes v)[i] = true := by
simp [getElem_eq_testBit_toNat, h]
@@ -772,6 +784,12 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
@[simp] theorem toNat_or (x y : BitVec v) :
BitVec.toNat (x ||| y) = BitVec.toNat x ||| BitVec.toNat y := rfl
@[simp] theorem toInt_or (x y : BitVec w) :
BitVec.toInt (x ||| y) = Int.bmod (BitVec.toNat x ||| BitVec.toNat y) (2^w) := by
rw_mod_cast [Int.bmod_def, BitVec.toInt, toNat_or, Nat.mod_eq_of_lt
(Nat.or_lt_two_pow (BitVec.isLt x) (BitVec.isLt y))]
omega
@[simp] theorem toFin_or (x y : BitVec v) :
BitVec.toFin (x ||| y) = BitVec.toFin x ||| BitVec.toFin y := by
apply Fin.eq_of_val_eq
@@ -839,6 +857,12 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· ||| · ) (0#n) where
@[simp] theorem toNat_and (x y : BitVec v) :
BitVec.toNat (x &&& y) = BitVec.toNat x &&& BitVec.toNat y := rfl
@[simp] theorem toInt_and (x y : BitVec w) :
BitVec.toInt (x &&& y) = Int.bmod (BitVec.toNat x &&& BitVec.toNat y) (2^w) := by
rw_mod_cast [Int.bmod_def, BitVec.toInt, toNat_and, Nat.mod_eq_of_lt
(Nat.and_lt_two_pow x.toNat (BitVec.isLt y))]
omega
@[simp] theorem toFin_and (x y : BitVec v) :
BitVec.toFin (x &&& y) = BitVec.toFin x &&& BitVec.toFin y := by
apply Fin.eq_of_val_eq
@@ -906,6 +930,12 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· &&& · ) (allOnes n) wher
@[simp] theorem toNat_xor (x y : BitVec v) :
BitVec.toNat (x ^^^ y) = BitVec.toNat x ^^^ BitVec.toNat y := rfl
@[simp] theorem toInt_xor (x y : BitVec w) :
BitVec.toInt (x ^^^ y) = Int.bmod (BitVec.toNat x ^^^ BitVec.toNat y) (2^w) := by
rw_mod_cast [Int.bmod_def, BitVec.toInt, toNat_xor, Nat.mod_eq_of_lt
(Nat.xor_lt_two_pow (BitVec.isLt x) (BitVec.isLt y))]
omega
@[simp] theorem toFin_xor (x y : BitVec v) :
BitVec.toFin (x ^^^ y) = BitVec.toFin x ^^^ BitVec.toFin y := by
apply Fin.eq_of_val_eq
@@ -983,6 +1013,13 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
_ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w
· simp
@[simp] theorem toInt_not {x : BitVec w} :
(~~~x).toInt = Int.bmod (2^w - 1 - x.toNat) (2^w) := by
rw_mod_cast [BitVec.toInt, BitVec.toNat_not, Int.bmod_def]
simp [show ((2^w : Nat) : Int) - 1 - x.toNat = ((2^w - 1 - x.toNat) : Nat) by omega]
rw_mod_cast [Nat.mod_eq_of_lt (by omega)]
omega
@[simp] theorem ofInt_negSucc_eq_not_ofNat {w n : Nat} :
BitVec.ofInt w (Int.negSucc n) = ~~~.ofNat w n := by
simp only [BitVec.ofInt, Int.toNat, Int.ofNat_eq_coe, toNat_eq, toNat_ofNatLt, toNat_not,
@@ -1007,6 +1044,10 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
@[simp] theorem getLsbD_not {x : BitVec v} : (~~~x).getLsbD i = (decide (i < v) && ! x.getLsbD i) := by
by_cases h' : i < v <;> simp_all [not_def]
@[simp] theorem getMsbD_not {x : BitVec v} :
(~~~x).getMsbD i = (decide (i < v) && ! x.getMsbD i) := by
by_cases h' : i < v <;> simp_all [not_def]
@[simp] theorem getElem_not {x : BitVec w} {i : Nat} (h : i < w) : (~~~x)[i] = !x[i] := by
simp only [getElem_eq_testBit_toNat, toNat_not]
rw [ Nat.sub_add_eq, Nat.add_comm 1]
@@ -1480,6 +1521,12 @@ theorem getLsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
(!decide (w i) && if y.toNat + i < w then x.getLsbD (y.toNat + i) else x.msb) := by
simp only [BitVec.sshiftRight', BitVec.getLsbD_sshiftRight]
@[simp]
theorem getElem_sshiftRight' {x y : BitVec w} {i : Nat} (h : i < w) :
(x.sshiftRight' y)[i] =
(!decide (w i) && if y.toNat + i < w then x.getLsbD (y.toNat + i) else x.msb) := by
simp only [ getLsbD_eq_getElem, BitVec.sshiftRight', BitVec.getLsbD_sshiftRight]
@[simp]
theorem getMsbD_sshiftRight' {x y: BitVec w} {i : Nat} :
(x.sshiftRight y.toNat).getMsbD i = (decide (i < w) && if i < y.toNat then x.msb else x.getMsbD (i - y.toNat)) := by
@@ -1572,6 +1619,82 @@ theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v ≤ w):
theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
rw [signExtend_eq_setWidth_of_lt _ (Nat.le_refl _), setWidth_eq]
/-- 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. -/
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 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
· simp [hi]; omega
· simp [hi]; omega
· simp [hi, show ¬ (i < w + k) by omega, show ¬ (i < w) by omega]
omega
· 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
· simp [hi]
· simp [hi, show ¬ (i < w + k) by omega, show ¬ (i < w) by omega, getLsbD_ge x i (by omega)]
/-- 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 (x : BitVec w) {v : Nat} :
(x.signExtend v).toNat = (x.setWidth v).toNat + if x.msb then 2^v - 2^w else 0 := by
by_cases h : v w
· have : 2^v 2^w := Nat.pow_le_pow_of_le_right Nat.two_pos h
simp [signExtend_eq_setWidth_of_lt x h, toNat_setWidth, Nat.sub_eq_zero_of_le this]
· have : 2^w 2^v := Nat.pow_le_pow_of_le_right Nat.two_pos (by omega)
rw [toNat_signExtend_of_le x (by omega), toNat_setWidth, Nat.mod_eq_of_lt (by omega)]
/-
If the current width `w` is smaller than the extended width `v`,
then the value when interpreted as an integer does not change.
-/
theorem toInt_signExtend_of_lt {x : BitVec w} (hv : w < v):
(x.signExtend v).toInt = x.toInt := by
simp only [toInt_eq_msb_cond, toNat_signExtend]
have : (x.signExtend v).msb = x.msb := by
rw [msb_eq_getLsbD_last, getLsbD_eq_getElem (Nat.sub_one_lt_of_lt hv)]
simp [getElem_signExtend, Nat.le_sub_one_of_lt hv]
have H : 2^w 2^v := Nat.pow_le_pow_of_le_right (by omega) (by omega)
simp only [this, toNat_setWidth, Int.natCast_add, Int.ofNat_emod, Int.natCast_mul]
by_cases h : x.msb
<;> norm_cast
<;> simp [h, Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.isLt H)]
omega
/-
If the current width `w` is larger than the extended width `v`,
then the value when interpreted as an integer is truncated,
and we compute a modulo by `2^v`.
-/
theorem toInt_signExtend_of_le {x : BitVec w} (hv : v w) :
(x.signExtend v).toInt = Int.bmod x.toNat (2^v) := by
simp [signExtend_eq_setWidth_of_lt _ hv]
/-
Interpreting the sign extension of `(x : BitVec w)` to width `v`
computes `x % 2^v` (where `%` is the balanced mod).
-/
theorem toInt_signExtend (x : BitVec w) :
(x.signExtend v).toInt = Int.bmod x.toNat (2^(min v w)) := by
by_cases hv : v w
· simp [toInt_signExtend_of_le hv, Nat.min_eq_left hv]
· simp only [Nat.not_le] at hv
rw [toInt_signExtend_of_lt hv, Nat.min_eq_right (by omega), toInt_eq_toNat_bmod]
/-! ### append -/
theorem append_def (x : BitVec v) (y : BitVec w) :
@@ -2611,7 +2734,7 @@ theorem getLsbD_rotateLeftAux_of_geq {x : BitVec w} {r : Nat} {i : Nat} (hi : i
apply getLsbD_ge
omega
/-- When `r < w`, we give a formula for `(x.rotateRight r).getLsbD i`. -/
/-- When `r < w`, we give a formula for `(x.rotateLeft r).getLsbD i`. -/
theorem getLsbD_rotateLeft_of_le {x : BitVec w} {r i : Nat} (hr: r < w) :
(x.rotateLeft r).getLsbD i =
cond (i < r)
@@ -2638,6 +2761,64 @@ 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]
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]
simp [show i < w - r by omega, Nat.add_comm]
theorem getMsbD_rotateLeftAux_of_ge {x : BitVec w} {r : Nat} {i : Nat} (hi : i w - r) :
(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
rcases w with rfl | w
· simp
· rw [BitVec.rotateLeft_eq_rotateLeftAux_of_lt (by omega)]
by_cases h : n < (w + 1) - r
· simp [getMsbD_rotateLeftAux_of_lt h, Nat.mod_eq_of_lt, show r + n < (w + 1) by omega, show n < w + 1 by omega]
· simp [getMsbD_rotateLeftAux_of_ge <| Nat.ge_of_not_lt h]
by_cases h₁ : n < w + 1
· simp only [h₁, decide_true, Bool.true_and]
have h₂ : (r + n) < 2 * (w + 1) := 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₁]
theorem getMsbD_rotateLeft {r n w : Nat} {x : BitVec w} :
(x.rotateLeft r).getMsbD n = (decide (n < w) && x.getMsbD ((r + n) % w)) := by
rcases w with rfl | w
· simp
· by_cases h : r < w
· rw [getMsbD_rotateLeft_of_lt (by omega)]
· rw [ rotateLeft_mod_eq_rotateLeft, getMsbD_rotateLeft_of_lt (by apply Nat.mod_lt; simp)]
simp
@[simp]
theorem msb_rotateLeft {m w : Nat} {x : BitVec w} :
(x.rotateLeft m).msb = x.getMsbD (m % w) := by
simp only [BitVec.msb, getMsbD_rotateLeft]
by_cases h : w = 0
· simp [h]
· simp
omega
/-! ## Rotate Right -/
/--
@@ -2699,7 +2880,7 @@ theorem rotateRight_mod_eq_rotateRight {x : BitVec w} {r : Nat} :
simp only [rotateRight, Nat.mod_mod]
/-- When `r < w`, we give a formula for `(x.rotateRight r).getLsb i`. -/
theorem getLsbD_rotateRight_of_le {x : BitVec w} {r i : Nat} (hr: r < w) :
theorem getLsbD_rotateRight_of_lt {x : BitVec w} {r i : Nat} (hr: r < w) :
(x.rotateRight r).getLsbD i =
cond (i < w - r)
(x.getLsbD (r + i))
@@ -2717,7 +2898,7 @@ theorem getLsbD_rotateRight {x : BitVec w} {r i : Nat} :
(decide (i < w) && x.getLsbD (i - (w - (r % w)))) := by
rcases w with rfl, w
· simp
· rw [ rotateRight_mod_eq_rotateRight, getLsbD_rotateRight_of_le (Nat.mod_lt _ (by omega))]
· rw [ rotateRight_mod_eq_rotateRight, getLsbD_rotateRight_of_lt (Nat.mod_lt _ (by omega))]
@[simp]
theorem getElem_rotateRight {x : BitVec w} {r i : Nat} (h : i < w) :
@@ -2725,6 +2906,56 @@ theorem getElem_rotateRight {x : BitVec w} {r i : Nat} (h : i < w) :
simp only [ BitVec.getLsbD_eq_getElem]
simp [getLsbD_rotateRight, h]
theorem getMsbD_rotateRightAux_of_lt {x : BitVec w} {r : Nat} {i : Nat} (hi : i < r) :
(x.rotateRightAux r).getMsbD i = x.getMsbD (i + (w - r)) := by
rw [rotateRightAux, getMsbD_or, getMsbD_ushiftRight]
simp [show i < r by omega]
theorem getMsbD_rotateRightAux_of_ge {x : BitVec w} {r : Nat} {i : Nat} (hi : i r) :
(x.rotateRightAux r).getMsbD i = (decide (i < w) && x.getMsbD (i - r)) := by
simp [rotateRightAux, show ¬ i < r by omega, show i + (w - r) w by omega]
/-- When `m < w`, we give a formula for `(x.rotateLeft m).getMsbD i`. -/
@[simp]
theorem getMsbD_rotateRight_of_lt {w n m : Nat} {x : BitVec w} (hr : m < w):
(x.rotateRight m).getMsbD n = (decide (n < w) && (if (n < m % w)
then x.getMsbD ((w + n - m % w) % w) else x.getMsbD (n - m % w))):= by
rcases w with rfl | w
· simp
· rw [rotateRight_eq_rotateRightAux_of_lt (by omega)]
by_cases h : n < m
· simp only [getMsbD_rotateRightAux_of_lt h, show n < w + 1 by omega, decide_true,
show m % (w + 1) = m by rw [Nat.mod_eq_of_lt hr], h, reduceIte,
show (w + 1 + n - m) < (w + 1) by omega, Nat.mod_eq_of_lt, Bool.true_and]
congr 1
omega
· simp [h, getMsbD_rotateRightAux_of_ge <| Nat.ge_of_not_lt h]
by_cases h₁ : n < w + 1
· simp [h, h₁, decide_true, Bool.true_and, Nat.mod_eq_of_lt hr]
· simp [h₁]
@[simp]
theorem getMsbD_rotateRight {w n m : Nat} {x : BitVec w} :
(x.rotateRight m).getMsbD n = (decide (n < w) && (if (n < m % w)
then x.getMsbD ((w + n - m % w) % w) else x.getMsbD (n - m % w))):= by
rcases w with rfl | w
· simp
· by_cases h₀ : m < w
· rw [getMsbD_rotateRight_of_lt (by omega)]
· rw [ rotateRight_mod_eq_rotateRight, getMsbD_rotateRight_of_lt (by apply Nat.mod_lt; simp)]
simp
@[simp]
theorem msb_rotateRight {r w : Nat} {x : BitVec w} :
(x.rotateRight r).msb = x.getMsbD ((w - r % w) % w) := by
simp only [BitVec.msb, getMsbD_rotateRight]
by_cases h₀ : 0 < w
· simp only [h₀, decide_true, Nat.add_zero, Nat.zero_le, Nat.sub_eq_zero_of_le, Bool.true_and,
ite_eq_left_iff, Nat.not_lt, Nat.le_zero_eq]
intro h₁
simp [h₁]
· simp [show w = 0 by omega]
/- ## twoPow -/
theorem twoPow_eq (w : Nat) (i : Nat) : twoPow w i = 1#w <<< i := by
@@ -2883,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 =
@@ -3002,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
@@ -3124,13 +3346,84 @@ theorem toNat_abs {x : BitVec w} : x.abs.toNat = if x.msb then 2^w - x.toNat els
· simp [h]
theorem getLsbD_abs {i : Nat} {x : BitVec w} :
getLsbD x.abs i = if x.msb then getLsbD (-x) i else getLsbD x i := by
getLsbD x.abs i = if x.msb then getLsbD (-x) i else getLsbD x i := by
by_cases h : x.msb <;> simp [BitVec.abs, h]
theorem getElem_abs {i : Nat} {x : BitVec w} (h : i < w) :
x.abs[i] = if x.msb then (-x)[i] else x[i] := by
by_cases h : x.msb <;> simp [BitVec.abs, h]
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

@@ -238,8 +238,8 @@ theorem not_bne_not : ∀ (x y : Bool), ((!x) != (!y)) = (x != y) := by simp
@[simp] theorem bne_assoc : (x y z : Bool), ((x != y) != z) = (x != (y != z)) := by decide
instance : Std.Associative (· != ·) := bne_assoc
@[simp] theorem bne_left_inj : {x y z : Bool}, (x != y) = (x != z) y = z := by decide
@[simp] theorem bne_right_inj : {x y z : Bool}, (x != z) = (y != z) x = y := by decide
@[simp] theorem bne_right_inj : {x y z : Bool}, (x != y) = (x != z) y = z := by decide
@[simp] theorem bne_left_inj : {x y z : Bool}, (x != z) = (y != z) x = y := by decide
theorem eq_not_of_ne : {x y : Bool}, x y x = !y := by decide
@@ -295,9 +295,9 @@ theorem xor_right_comm : ∀ (x y z : Bool), ((x ^^ y) ^^ z) = ((x ^^ z) ^^ y) :
theorem xor_assoc : (x y z : Bool), ((x ^^ y) ^^ z) = (x ^^ (y ^^ z)) := bne_assoc
theorem xor_left_inj : {x y z : Bool}, (x ^^ y) = (x ^^ z) y = z := bne_left_inj
theorem xor_right_inj : {x y z : Bool}, (x ^^ y) = (x ^^ z) y = z := bne_right_inj
theorem xor_right_inj : {x y z : Bool}, (x ^^ z) = (y ^^ z) x = y := bne_right_inj
theorem xor_left_inj : {x y z : Bool}, (x ^^ z) = (y ^^ z) x = y := bne_left_inj
/-! ### le/lt -/

View File

@@ -108,8 +108,18 @@ def toList (bs : ByteArray) : List UInt8 :=
@[inline] def findIdx? (a : ByteArray) (p : UInt8 Bool) (start := 0) : Option Nat :=
let rec @[specialize] loop (i : Nat) :=
if i < a.size then
if p (a.get! i) then some i else loop (i+1)
if h : i < a.size then
if p a[i] then some i else loop (i+1)
else
none
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
loop start
@[inline] def findFinIdx? (a : ByteArray) (p : UInt8 Bool) (start := 0) : Option (Fin a.size) :=
let rec @[specialize] loop (i : Nat) :=
if h : i < a.size then
if p a[i] then some i, h else loop (i+1)
else
none
termination_by a.size - i

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

@@ -642,7 +642,7 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
ext
simp
@[simp] theorem subNat_one_succ (i : Fin (n + 1)) (h : 1 i) : (subNat 1 i h).succ = i := by
@[simp] theorem subNat_one_succ (i : Fin (n + 1)) (h : 1 (i : Nat)) : (subNat 1 i h).succ = i := by
ext
simp
omega

View File

@@ -31,7 +31,7 @@ opaque floatSpec : FloatSpec := {
structure Float where
val : floatSpec.float
instance : Inhabited Float := { val := floatSpec.val }
instance : Nonempty Float := { val := floatSpec.val }
@[extern "lean_float_add"] opaque Float.add : Float Float Float
@[extern "lean_float_sub"] opaque Float.sub : Float Float Float
@@ -47,6 +47,25 @@ def Float.lt : Float → Float → Prop := fun a b =>
def Float.le : Float Float Prop := fun a b =>
floatSpec.le a.val b.val
/--
Raw transmutation from `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
-/
@[extern "lean_float_of_bits"] opaque Float.ofBits : UInt64 Float
/--
Raw transmutation to `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
Note that this function is distinct from `Float.toUInt64`, which attempts
to preserve the numeric value, and not the bitwise value.
-/
@[extern "lean_float_to_bits"] opaque Float.toBits : Float UInt64
instance : Add Float := Float.add
instance : Sub Float := Float.sub
instance : Mul Float := Float.mul
@@ -117,6 +136,9 @@ instance : ToString Float where
@[extern "lean_uint64_to_float"] opaque UInt64.toFloat (n : UInt64) : Float
instance : Inhabited Float where
default := UInt64.toFloat 0
instance : Repr Float where
reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n

View File

@@ -329,22 +329,22 @@ theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by
/- ## add/sub injectivity -/
@[simp]
protected theorem add_right_inj {i j : Int} (k : Int) : (i + k = j + k) i = j := by
protected theorem add_left_inj {i j : Int} (k : Int) : (i + k = j + k) i = j := by
apply Iff.intro
· intro p
rw [Int.add_sub_cancel i k, Int.add_sub_cancel j k, p]
· exact congrArg (· + k)
@[simp]
protected theorem add_left_inj {i j : Int} (k : Int) : (k + i = k + j) i = j := by
protected theorem add_right_inj {i j : Int} (k : Int) : (k + i = k + j) i = j := by
simp [Int.add_comm k]
@[simp]
protected theorem sub_left_inj {i j : Int} (k : Int) : (k - i = k - j) i = j := by
protected theorem sub_right_inj {i j : Int} (k : Int) : (k - i = k - j) i = j := by
simp [Int.sub_eq_add_neg, Int.neg_inj]
@[simp]
protected theorem sub_right_inj {i j : Int} (k : Int) : (i - k = j - k) i = j := by
protected theorem sub_left_inj {i j : Int} (k : Int) : (i - k = j - k) i = j := by
simp [Int.sub_eq_add_neg]
/- ## Ring properties -/

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

@@ -13,7 +13,7 @@ namespace List
`a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l`
but is defined only when all members of `l` satisfy `P`, using the proof
to apply `f`. -/
@[simp] def pmap {P : α Prop} (f : a, P a β) : l : List α, (H : a l, P a) List β
def pmap {P : α Prop} (f : a, P a β) : l : List α, (H : a l, P a) List β
| [], _ => []
| a :: l, H => f a (forall_mem_cons.1 H).1 :: pmap f l (forall_mem_cons.1 H).2
@@ -46,6 +46,11 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
| cons _ L', hL' => congrArg _ <| go L' fun _ hx => hL' (.tail _ hx)
exact go L h'
@[simp] theorem pmap_nil {P : α Prop} (f : a, P a β) : pmap f [] (by simp) = [] := rfl
@[simp] theorem pmap_cons {P : α Prop} (f : a, P a β) (a : α) (l : List α) (h : b a :: l, P b) :
pmap f (a :: l) h = f a (forall_mem_cons.1 h).1 :: pmap f l (forall_mem_cons.1 h).2 := rfl
@[simp] theorem attach_nil : ([] : List α).attach = [] := rfl
@[simp] theorem attachWith_nil : ([] : List α).attachWith P H = [] := rfl
@@ -148,7 +153,7 @@ theorem mem_pmap_of_mem {p : α → Prop} {f : ∀ a, p a → β} {l H} {a} (h :
exact a, h, rfl
@[simp]
theorem length_pmap {p : α Prop} {f : a, p a β} {l H} : length (pmap f l H) = length l := by
theorem length_pmap {p : α Prop} {f : a, p a β} {l H} : (pmap f l H).length = l.length := by
induction l
· rfl
· simp only [*, pmap, length]
@@ -199,7 +204,7 @@ theorem attachWith_ne_nil_iff {l : List α} {P : α → Prop} {H : ∀ a ∈ l,
@[simp]
theorem getElem?_pmap {p : α Prop} (f : a, p a β) {l : List α} (h : a l, p a) (n : Nat) :
(pmap f l h)[n]? = Option.pmap f l[n]? fun x H => h x (getElem?_mem H) := by
(pmap f l h)[n]? = Option.pmap f l[n]? fun x H => h x (mem_of_getElem? H) := by
induction l generalizing n with
| nil => simp
| cons hd tl hl =>
@@ -215,7 +220,7 @@ theorem getElem?_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h
· simp_all
theorem get?_pmap {p : α Prop} (f : a, p a β) {l : List α} (h : a l, p a) (n : Nat) :
get? (pmap f l h) n = Option.pmap f (get? l n) fun x H => h x (get?_mem H) := by
get? (pmap f l h) n = Option.pmap f (get? l n) fun x H => h x (mem_of_get? H) := by
simp only [get?_eq_getElem?]
simp [getElem?_pmap, h]
@@ -238,18 +243,18 @@ theorem get_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h :
(hn : n < (pmap f l h).length) :
get (pmap f l h) n, hn =
f (get l n, @length_pmap _ _ p f l h hn)
(h _ (get_mem l n (@length_pmap _ _ p f l h hn))) := by
(h _ (getElem_mem (@length_pmap _ _ p f l h hn))) := by
simp only [get_eq_getElem]
simp [getElem_pmap]
@[simp]
theorem getElem?_attachWith {xs : List α} {i : Nat} {P : α Prop} {H : a xs, P a} :
(xs.attachWith P H)[i]? = xs[i]?.pmap Subtype.mk (fun _ a => H _ (getElem?_mem a)) :=
(xs.attachWith P H)[i]? = xs[i]?.pmap Subtype.mk (fun _ a => H _ (mem_of_getElem? a)) :=
getElem?_pmap ..
@[simp]
theorem getElem?_attach {xs : List α} {i : Nat} :
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => getElem?_mem a) :=
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => mem_of_getElem? a) :=
getElem?_attachWith
@[simp]
@@ -333,6 +338,7 @@ This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldl_subtype` below.
-/
theorem foldl_attach (l : List α) (f : β α β) (b : β) :
l.attach.foldl (fun acc t => f acc t.1) b = l.foldl f b := by
@@ -348,6 +354,7 @@ This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
See however `foldr_subtype` below.
-/
theorem foldr_attach (l : List α) (f : α β β) (b : β) :
l.attach.foldr (fun t acc => f t.1 acc) b = l.foldr f b := by
@@ -452,16 +459,16 @@ theorem pmap_append' {p : α → Prop} (f : ∀ a : α, p a → β) (l₁ l₂ :
pmap_append f l₁ l₂ _
@[simp] theorem attach_append (xs ys : List α) :
(xs ++ ys).attach = xs.attach.map (fun x, h => x, mem_append_of_mem_left ys h) ++
ys.attach.map fun x, h => x, mem_append_of_mem_right xs h := by
(xs ++ ys).attach = xs.attach.map (fun x, h => x, mem_append_left ys h) ++
ys.attach.map fun x, h => x, mem_append_right xs h := by
simp only [attach, attachWith, pmap, map_pmap, pmap_append]
congr 1 <;>
exact pmap_congr_left _ fun _ _ _ _ => rfl
@[simp] theorem attachWith_append {P : α Prop} {xs ys : List α}
{H : (a : α), a xs ++ ys P a} :
(xs ++ ys).attachWith P H = xs.attachWith P (fun a h => H a (mem_append_of_mem_left ys h)) ++
ys.attachWith P (fun a h => H a (mem_append_of_mem_right xs h)) := by
(xs ++ ys).attachWith P H = xs.attachWith P (fun a h => H a (mem_append_left ys h)) ++
ys.attachWith P (fun a h => H a (mem_append_right xs h)) := by
simp only [attachWith, attach_append, map_pmap, pmap_append]
@[simp] theorem pmap_reverse {P : α Prop} (f : (a : α) P a β) (xs : List α)
@@ -598,6 +605,15 @@ def unattach {α : Type _} {p : α → Prop} (l : List { x // p x }) := l.map (
| nil => simp
| cons a l ih => simp [ih, Function.comp_def]
@[simp] theorem getElem?_unattach {p : α Prop} {l : List { x // p x }} (i : Nat) :
l.unattach[i]? = l[i]?.map Subtype.val := by
simp [unattach]
@[simp] theorem getElem_unattach
{p : α Prop} {l : List { x // p x }} (i : Nat) (h : i < l.unattach.length) :
l.unattach[i] = (l[i]'(by simpa using h)).1 := by
simp [unattach]
/-! ### Recognizing higher order functions on subtypes using a function that only depends on the value. -/
/--

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 -/
@@ -551,7 +551,7 @@ theorem reverseAux_eq_append (as bs : List α) : reverseAux as bs = reverseAux a
/-! ### flatten -/
/--
`O(|flatten L|)`. `join L` concatenates all the lists in `L` into one list.
`O(|flatten L|)`. `flatten L` concatenates all the lists in `L` into one list.
* `flatten [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
-/
def flatten : List (List α) List α
@@ -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)
@@ -726,13 +726,13 @@ theorem elem_eq_true_of_mem [BEq α] [LawfulBEq α] {a : α} {as : List α} (h :
instance [BEq α] [LawfulBEq α] (a : α) (as : List α) : Decidable (a as) :=
decidable_of_decidable_of_iff (Iff.intro mem_of_elem_eq_true elem_eq_true_of_mem)
theorem mem_append_of_mem_left {a : α} {as : List α} (bs : List α) : a as a as ++ bs := by
theorem mem_append_left {a : α} {as : List α} (bs : List α) : a as a as ++ bs := by
intro h
induction h with
| head => apply Mem.head
| tail => apply Mem.tail; assumption
theorem mem_append_of_mem_right {b : α} {bs : List α} (as : List α) : b bs b as ++ bs := by
theorem mem_append_right {b : α} {bs : List α} (as : List α) : b bs b as ++ bs := by
intro h
induction as with
| nil => simp [h]
@@ -1427,10 +1427,10 @@ def zipWithAll (f : Option α → Option β → γ) : List α → List β → Li
| a :: as, [] => (a :: as).map fun a => f (some a) none
| a :: as, b :: bs => f a b :: zipWithAll f as bs
@[simp] theorem zipWithAll_nil_right :
@[simp] theorem zipWithAll_nil :
zipWithAll f as [] = as.map fun a => f (some a) none := by
cases as <;> rfl
@[simp] theorem zipWithAll_nil_left :
@[simp] theorem nil_zipWithAll :
zipWithAll f [] bs = bs.map fun b => f none (some b) := rfl
@[simp] theorem zipWithAll_cons_cons :
zipWithAll f (a :: as) (b :: bs) = f (some a) (some b) :: zipWithAll f as bs := rfl

View File

@@ -256,7 +256,7 @@ theorem findM?_eq_findSomeM? [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
have : a as := by
have bs, h := h
subst h
exact mem_append_of_mem_right _ (Mem.head ..)
exact mem_append_right _ (Mem.head ..)
match ( f a this b) with
| ForInStep.done b => pure b
| ForInStep.yield b =>

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

@@ -10,7 +10,8 @@ import Init.Data.List.Sublist
import Init.Data.List.Range
/-!
# Lemmas about `List.findSome?`, `List.find?`, `List.findIdx`, `List.findIdx?`, and `List.indexOf`.
Lemmas about `List.findSome?`, `List.find?`, `List.findIdx`, `List.findIdx?`, `List.indexOf`,
and `List.lookup`.
-/
namespace List
@@ -95,22 +96,22 @@ theorem findSome?_eq_some_iff {f : α → Option β} {l : List α} {b : β} :
· simp only [Option.guard_eq_none] at h
simp [ih, h]
@[simp] theorem filterMap_head? (f : α Option β) (l : List α) : (l.filterMap f).head? = l.findSome? f := by
@[simp] theorem head?_filterMap (f : α Option β) (l : List α) : (l.filterMap f).head? = l.findSome? f := by
induction l with
| nil => simp
| cons x xs ih =>
simp only [filterMap_cons, findSome?_cons]
split <;> simp [*]
@[simp] theorem filterMap_head (f : α Option β) (l : List α) (h) :
(l.filterMap f).head h = (l.findSome? f).get (by simp_all [Option.isSome_iff_ne_none]) := by
@[simp] theorem head_filterMap (f : α Option β) (l : List α) (h) :
(l.filterMap f).head h = (l.findSome? f).get (by simp_all [Option.isSome_iff_ne_none]) := by
simp [head_eq_iff_head?_eq_some]
@[simp] theorem filterMap_getLast? (f : α Option β) (l : List α) : (l.filterMap f).getLast? = l.reverse.findSome? f := by
@[simp] theorem getLast?_filterMap (f : α Option β) (l : List α) : (l.filterMap f).getLast? = l.reverse.findSome? f := by
rw [getLast?_eq_head?_reverse]
simp [ filterMap_reverse]
@[simp] theorem filterMap_getLast (f : α Option β) (l : List α) (h) :
@[simp] theorem getLast_filterMap (f : α Option β) (l : List α) (h) :
(l.filterMap f).getLast h = (l.reverse.findSome? f).get (by simp_all [Option.isSome_iff_ne_none]) := by
simp [getLast_eq_iff_getLast_eq_some]
@@ -291,18 +292,18 @@ theorem get_find?_mem (xs : List α) (p : α → Bool) (h) : (xs.find? p).get h
· simp only [find?_cons]
split <;> simp_all
@[simp] theorem filter_head? (p : α Bool) (l : List α) : (l.filter p).head? = l.find? p := by
rw [ filterMap_eq_filter, filterMap_head?, findSome?_guard]
@[simp] theorem head?_filter (p : α Bool) (l : List α) : (l.filter p).head? = l.find? p := by
rw [ filterMap_eq_filter, head?_filterMap, findSome?_guard]
@[simp] theorem filter_head (p : α Bool) (l : List α) (h) :
@[simp] theorem head_filter (p : α Bool) (l : List α) (h) :
(l.filter p).head h = (l.find? p).get (by simp_all [Option.isSome_iff_ne_none]) := by
simp [head_eq_iff_head?_eq_some]
@[simp] theorem filter_getLast? (p : α Bool) (l : List α) : (l.filter p).getLast? = l.reverse.find? p := by
@[simp] theorem getLast?_filter (p : α Bool) (l : List α) : (l.filter p).getLast? = l.reverse.find? p := by
rw [getLast?_eq_head?_reverse]
simp [ filter_reverse]
@[simp] theorem filter_getLast (p : α Bool) (l : List α) (h) :
@[simp] theorem getLast_filter (p : α Bool) (l : List α) (h) :
(l.filter p).getLast h = (l.reverse.find? p).get (by simp_all [Option.isSome_iff_ne_none]) := by
simp [getLast_eq_iff_getLast_eq_some]

View File

@@ -91,7 +91,7 @@ The following operations are given `@[csimp]` replacements below:
@[specialize] def foldrTR (f : α β β) (init : β) (l : List α) : β := l.toArray.foldr f init
@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by
funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_toList, -Array.size_toArray]
funext α β f init l; simp [foldrTR, Array.foldr_toList, -Array.size_toArray]
/-! ### flatMap -/
@@ -331,7 +331,7 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) :=
| a::as, n => by
rw [ show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as]
simp [enumFrom, f]
rw [Array.foldr_eq_foldr_toList]
rw [ Array.foldr_toList]
simp [go]
/-! ## Other list operations -/

View File

@@ -101,7 +101,7 @@ theorem tail_eq_of_cons_eq (H : h₁ :: t₁ = h₂ :: t₂) : t₁ = t₂ := (c
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
@[deprecated cons_inj_right (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
@@ -171,7 +171,7 @@ theorem get_cons_succ {as : List α} {h : i + 1 < (a :: as).length} :
theorem get_cons_succ' {as : List α} {i : Fin as.length} :
(a :: as).get i.succ = as.get i := rfl
@[deprecated (since := "2024-07-09")]
@[deprecated "Deprecated without replacement." (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)
@@ -372,6 +372,17 @@ theorem getElem?_concat_length (l : List α) (a : α) : (l ++ [a])[l.length]? =
@[deprecated getElem?_concat_length (since := "2024-06-12")]
theorem get?_concat_length (l : List α) (a : α) : (l ++ [a]).get? l.length = some a := 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]
/-! ### mem -/
@[simp] theorem not_mem_nil (a : α) : ¬ a [] := nofun
@@ -383,9 +394,9 @@ theorem get?_concat_length (l : List α) (a : α) : (l ++ [a]).get? l.length = s
theorem mem_cons_self (a : α) (l : List α) : a a :: l := .head ..
theorem mem_concat_self (xs : List α) (a : α) : a xs ++ [a] :=
mem_append_of_mem_right xs (mem_cons_self a _)
mem_append_right xs (mem_cons_self a _)
theorem mem_append_cons_self : a xs ++ a :: ys := mem_append_of_mem_right _ (mem_cons_self _ _)
theorem mem_append_cons_self : a xs ++ a :: ys := mem_append_right _ (mem_cons_self _ _)
theorem eq_append_cons_of_mem {a : α} {xs : List α} (h : a xs) :
as bs, xs = as ++ a :: bs a as := by
@@ -492,16 +503,20 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n : Nat, l[n]? = s
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 h, get l n, h l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
theorem get_mem : (l : List α) n, get l n l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
theorem getElem?_mem {l : List α} {n : Nat} {a : α} (e : l[n]? = some a) : a 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 ..
theorem get?_mem {l : List α} {n a} (e : l.get? n = some a) : a l :=
@[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 ..
@@ -776,6 +791,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
@@ -841,6 +874,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
@@ -1025,6 +1064,10 @@ theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
| _ :: _ :: _, _ => by
simp [getLast, get, Nat.succ_sub_succ, getLast_eq_getElem]
theorem getElem_length_sub_one_eq_getLast (l : List α) (h) :
l[l.length - 1] = getLast l (by cases l; simp at h; simp) := by
rw [ getLast_eq_getElem]
@[deprecated getLast_eq_getElem (since := "2024-07-15")]
theorem getLast_eq_get (l : List α) (h : l []) :
getLast l h = l.get l.length - 1, by
@@ -1045,7 +1088,7 @@ theorem getLast_eq_getLastD (a l h) : @getLast α (a::l) h = getLastD l a := by
@[simp] theorem getLast_singleton (a h) : @getLast α [a] h = a := rfl
theorem getLast!_cons [Inhabited α] : @getLast! α _ (a::l) = getLastD l a := by
theorem getLast!_cons_eq_getLastD [Inhabited α] : @getLast! α _ (a::l) = getLastD l a := by
simp [getLast!, getLast_eq_getLastD]
@[simp] theorem getLast_mem : {l : List α} (h : l []), getLast l h l
@@ -1109,7 +1152,12 @@ theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by
/-! ### getLast! -/
@[simp] theorem getLast!_nil [Inhabited α] : ([] : List α).getLast! = default := rfl
theorem getLast!_nil [Inhabited α] : ([] : List α).getLast! = default := rfl
@[simp] theorem getLast!_eq_getLast?_getD [Inhabited α] {l : List α} : getLast! l = (getLast? l).getD default := by
cases l with
| nil => simp [getLast!_nil]
| cons _ _ => simp [getLast!, getLast?_eq_getLast]
theorem getLast!_of_getLast? [Inhabited α] : {l : List α}, getLast? l = some a getLast! l = a
| _ :: _, rfl => rfl
@@ -1144,6 +1192,11 @@ theorem head_eq_getElem (l : List α) (h : l ≠ []) : head l h = l[0]'(length_p
| nil => simp at h
| cons _ _ => simp
theorem getElem_zero_eq_head (l : List α) (h) : l[0] = head l (by simpa [length_pos] using h) := by
cases l with
| nil => simp at h
| cons _ _ => simp
theorem head_eq_iff_head?_eq_some {xs : List α} (h) : xs.head h = a xs.head? = some a := by
cases xs with
| nil => simp at h
@@ -1771,7 +1824,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₂
@@ -1788,7 +1841,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
@@ -1972,11 +2025,8 @@ theorem not_mem_append {a : α} {s t : List α} (h₁ : a ∉ s) (h₂ : a ∉ t
theorem mem_append_eq (a : α) (s t : List α) : (a s ++ t) = (a s a t) :=
propext mem_append
theorem mem_append_left {a : α} {l₁ : List α} (l₂ : List α) (h : a l₁) : a l₁ ++ l₂ :=
mem_append.2 (Or.inl h)
theorem mem_append_right {a : α} (l₁ : List α) {l₂ : List α} (h : a l₂) : a l₁ ++ l₂ :=
mem_append.2 (Or.inr h)
@[deprecated mem_append_left (since := "2024-11-20")] abbrev mem_append_of_mem_left := @mem_append_left
@[deprecated mem_append_right (since := "2024-11-20")] abbrev mem_append_of_mem_right := @mem_append_right
theorem mem_iff_append {a : α} {l : List α} : a l s t : List α, l = s ++ a :: t :=
append_of_mem, fun s, t, e => e by simp
@@ -2390,7 +2440,7 @@ theorem forall_mem_replicate {p : α → Prop} {a : α} {n} :
@[simp] theorem getElem_replicate (a : α) {n : Nat} {m} (h : m < (replicate n a).length) :
(replicate n a)[m] = a :=
eq_of_mem_replicate (get_mem _ _ _)
eq_of_mem_replicate (getElem_mem _)
@[deprecated getElem_replicate (since := "2024-06-12")]
theorem get_replicate (a : α) {n : Nat} (m : Fin _) : (replicate n a).get m = a := by
@@ -3307,10 +3357,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} :

View File

@@ -9,7 +9,7 @@ import Init.Data.List.Basic
namespace List
/-! ### isEqv-/
/-! ### isEqv -/
theorem isEqv_eq_decide (a b : List α) (r) :
isEqv a b r = if h : a.length = b.length then

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

@@ -417,7 +417,7 @@ theorem Sublist.of_sublist_append_left (w : ∀ a, a ∈ l → a ∉ l₂) (h :
obtain l₁', l₂', rfl, h₁, h₂ := h
have : l₂' = [] := by
rw [eq_nil_iff_forall_not_mem]
exact fun x m => w x (mem_append_of_mem_right l₁' m) (h₂.mem m)
exact fun x m => w x (mem_append_right l₁' m) (h₂.mem m)
simp_all
theorem Sublist.of_sublist_append_right (w : a, a l a l₁) (h : l <+ l₁ ++ l₂) : l <+ l₂ := by
@@ -425,7 +425,7 @@ theorem Sublist.of_sublist_append_right (w : ∀ a, a ∈ l → a ∉ l₁) (h :
obtain l₁', l₂', rfl, h₁, h₂ := h
have : l₁' = [] := by
rw [eq_nil_iff_forall_not_mem]
exact fun x m => w x (mem_append_of_mem_left l₂' m) (h₁.mem m)
exact fun x m => w x (mem_append_left l₂' m) (h₁.mem m)
simp_all
theorem Sublist.middle {l : List α} (h : l <+ l₁ ++ l₂) (a : α) : l <+ l₁ ++ a :: l₂ := by
@@ -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

@@ -224,7 +224,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

@@ -20,3 +20,4 @@ import Init.Data.Nat.Mod
import Init.Data.Nat.Lcm
import Init.Data.Nat.Compare
import Init.Data.Nat.Simproc
import Init.Data.Nat.Fold

View File

@@ -35,52 +35,6 @@ Used as the default `Nat` eliminator by the `cases` tactic. -/
protected abbrev casesAuxOn {motive : Nat Sort u} (t : Nat) (zero : motive 0) (succ : (n : Nat) motive (n + 1)) : motive t :=
Nat.casesOn t zero succ
/--
`Nat.fold` evaluates `f` on the numbers up to `n` exclusive, in increasing order:
* `Nat.fold f 3 init = init |> f 0 |> f 1 |> f 2`
-/
@[specialize] def fold {α : Type u} (f : Nat α α) : (n : Nat) (init : α) α
| 0, a => a
| succ n, a => f n (fold f n a)
/-- Tail-recursive version of `Nat.fold`. -/
@[inline] def foldTR {α : Type u} (f : Nat α α) (n : Nat) (init : α) : α :=
let rec @[specialize] loop
| 0, a => a
| succ m, a => loop m (f (n - succ m) a)
loop n init
/--
`Nat.foldRev` evaluates `f` on the numbers up to `n` exclusive, in decreasing order:
* `Nat.foldRev f 3 init = f 0 <| f 1 <| f 2 <| init`
-/
@[specialize] def foldRev {α : Type u} (f : Nat α α) : (n : Nat) (init : α) α
| 0, a => a
| succ n, a => foldRev f n (f n a)
/-- `any f n = true` iff there is `i in [0, n-1]` s.t. `f i = true` -/
@[specialize] def any (f : Nat Bool) : Nat Bool
| 0 => false
| succ n => any f n || f n
/-- Tail-recursive version of `Nat.any`. -/
@[inline] def anyTR (f : Nat Bool) (n : Nat) : Bool :=
let rec @[specialize] loop : Nat Bool
| 0 => false
| succ m => f (n - succ m) || loop m
loop n
/-- `all f n = true` iff every `i in [0, n-1]` satisfies `f i = true` -/
@[specialize] def all (f : Nat Bool) : Nat Bool
| 0 => true
| succ n => all f n && f n
/-- Tail-recursive version of `Nat.all`. -/
@[inline] def allTR (f : Nat Bool) (n : Nat) : Bool :=
let rec @[specialize] loop : Nat Bool
| 0 => true
| succ m => f (n - succ m) && loop m
loop n
/--
`Nat.repeat f n a` is `f^(n) a`; that is, it iterates `f` `n` times on `a`.
@@ -835,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)
@@ -1121,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
@@ -1133,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]
@@ -1158,33 +1112,6 @@ theorem not_lt_eq (a b : Nat) : (¬ (a < b)) = (b ≤ a) :=
theorem not_gt_eq (a b : Nat) : (¬ (a > b)) = (a b) :=
not_lt_eq b a
/-! # csimp theorems -/
@[csimp] theorem fold_eq_foldTR : @fold = @foldTR :=
funext fun α => funext fun f => funext fun n => funext fun init =>
let rec go : m n, foldTR.loop f (m + n) m (fold f n init) = fold f (m + n) init
| 0, n => by simp [foldTR.loop]
| succ m, n => by rw [foldTR.loop, add_sub_self_left, succ_add]; exact go m (succ n)
(go n 0).symm
@[csimp] theorem any_eq_anyTR : @any = @anyTR :=
funext fun f => funext fun n =>
let rec go : m n, (any f n || anyTR.loop f (m + n) m) = any f (m + n)
| 0, n => by simp [anyTR.loop]
| succ m, n => by
rw [anyTR.loop, add_sub_self_left, Bool.or_assoc, succ_add]
exact go m (succ n)
(go n 0).symm
@[csimp] theorem all_eq_allTR : @all = @allTR :=
funext fun f => funext fun n =>
let rec go : m n, (all f n && allTR.loop f (m + n) m) = all f (m + n)
| 0, n => by simp [allTR.loop]
| succ m, n => by
rw [allTR.loop, add_sub_self_left, Bool.and_assoc, succ_add]
exact go m (succ n)
(go n 0).symm
@[csimp] theorem repeat_eq_repeatTR : @repeat = @repeatTR :=
funext fun α => funext fun f => funext fun n => funext fun init =>
let rec go : m n, repeatTR.loop f m (repeat f n init) = repeat f (m + n) init
@@ -1193,31 +1120,3 @@ theorem not_gt_eq (a b : Nat) : (¬ (a > b)) = (a ≤ b) :=
(go n 0).symm
end Nat
namespace Prod
/--
`(start, stop).foldI f a` evaluates `f` on all the numbers
from `start` (inclusive) to `stop` (exclusive) in increasing order:
* `(5, 8).foldI f init = init |> f 5 |> f 6 |> f 7`
-/
@[inline] def foldI {α : Type u} (f : Nat α α) (i : Nat × Nat) (a : α) : α :=
Nat.foldTR.loop f i.2 (i.2 - i.1) a
/--
`(start, stop).anyI f a` returns true if `f` is true for some natural number
from `start` (inclusive) to `stop` (exclusive):
* `(5, 8).anyI f = f 5 || f 6 || f 7`
-/
@[inline] def anyI (f : Nat Bool) (i : Nat × Nat) : Bool :=
Nat.anyTR.loop f i.2 (i.2 - i.1)
/--
`(start, stop).allI f a` returns true if `f` is true for all natural numbers
from `start` (inclusive) to `stop` (exclusive):
* `(5, 8).anyI f = f 5 && f 6 && f 7`
-/
@[inline] def allI (f : Nat Bool) (i : Nat × Nat) : Bool :=
Nat.allTR.loop f i.2 (i.2 - i.1)
end Prod

View File

@@ -6,50 +6,51 @@ Author: Leonardo de Moura
prelude
import Init.Control.Basic
import Init.Data.Nat.Basic
import Init.Omega
namespace Nat
universe u v
@[inline] def forM {m} [Monad m] (n : Nat) (f : Nat m Unit) : m Unit :=
let rec @[specialize] loop
| 0 => pure ()
| i+1 => do f (n-i-1); loop i
loop n
@[inline] def forM {m} [Monad m] (n : Nat) (f : (i : Nat) i < n m Unit) : m Unit :=
let rec @[specialize] loop : i, i n m Unit
| 0, _ => pure ()
| i+1, h => do f (n-i-1) (by omega); loop i (Nat.le_of_succ_le h)
loop n (by simp)
@[inline] def forRevM {m} [Monad m] (n : Nat) (f : Nat m Unit) : m Unit :=
let rec @[specialize] loop
| 0 => pure ()
| i+1 => do f i; loop i
loop n
@[inline] def forRevM {m} [Monad m] (n : Nat) (f : (i : Nat) i < n m Unit) : m Unit :=
let rec @[specialize] loop : i, i n m Unit
| 0, _ => pure ()
| i+1, h => do f i (by omega); loop i (Nat.le_of_succ_le h)
loop n (by simp)
@[inline] def foldM {α : Type u} {m : Type u Type v} [Monad m] (f : Nat α m α) (init : α) (n : Nat) : m α :=
let rec @[specialize] loop
| 0, a => pure a
| i+1, a => f (n-i-1) a >>= loop i
loop n init
@[inline] def foldM {α : Type u} {m : Type u Type v} [Monad m] (n : Nat) (f : (i : Nat) i < n α m α) (init : α) : m α :=
let rec @[specialize] loop : i, i n α m α
| 0, h, a => pure a
| i+1, h, a => f (n-i-1) (by omega) a >>= loop i (Nat.le_of_succ_le h)
loop n (by omega) init
@[inline] def foldRevM {α : Type u} {m : Type u Type v} [Monad m] (f : Nat α m α) (init : α) (n : Nat) : m α :=
let rec @[specialize] loop
| 0, a => pure a
| i+1, a => f i a >>= loop i
loop n init
@[inline] def foldRevM {α : Type u} {m : Type u Type v} [Monad m] (n : Nat) (f : (i : Nat) i < n α m α) (init : α) : m α :=
let rec @[specialize] loop : i, i n α m α
| 0, h, a => pure a
| i+1, h, a => f i (by omega) a >>= loop i (Nat.le_of_succ_le h)
loop n (by omega) init
@[inline] def allM {m} [Monad m] (n : Nat) (p : Nat m Bool) : m Bool :=
let rec @[specialize] loop
| 0 => pure true
| i+1 => do
match ( p (n-i-1)) with
| true => loop i
@[inline] def allM {m} [Monad m] (n : Nat) (p : (i : Nat) i < n m Bool) : m Bool :=
let rec @[specialize] loop : i, i n m Bool
| 0, _ => pure true
| i+1 , h => do
match ( p (n-i-1) (by omega)) with
| true => loop i (by omega)
| false => pure false
loop n
loop n (by simp)
@[inline] def anyM {m} [Monad m] (n : Nat) (p : Nat m Bool) : m Bool :=
let rec @[specialize] loop
| 0 => pure false
| i+1 => do
match ( p (n-i-1)) with
@[inline] def anyM {m} [Monad m] (n : Nat) (p : (i : Nat) i < n m Bool) : m Bool :=
let rec @[specialize] loop : i, i n m Bool
| 0, _ => pure false
| i+1, h => do
match ( p (n-i-1) (by omega)) with
| true => pure true
| false => loop i
loop n
| false => loop i (Nat.le_of_succ_le h)
loop n (by simp)
end Nat

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]

217
src/Init/Data/Nat/Fold.lean Normal file
View File

@@ -0,0 +1,217 @@
/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
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
namespace Nat
/--
`Nat.fold` evaluates `f` on the numbers up to `n` exclusive, in increasing order:
* `Nat.fold f 3 init = init |> f 0 |> f 1 |> f 2`
-/
@[specialize] def fold {α : Type u} : (n : Nat) (f : (i : Nat) i < n α α) (init : α) α
| 0, f, a => a
| succ n, f, a => f n (by omega) (fold n (fun i h => f i (by omega)) a)
/-- Tail-recursive version of `Nat.fold`. -/
@[inline] def foldTR {α : Type u} (n : Nat) (f : (i : Nat) i < n α α) (init : α) : α :=
let rec @[specialize] loop : j, j n α α
| 0, h, a => a
| succ m, h, a => loop m (by omega) (f (n - succ m) (by omega) a)
loop n (by omega) init
/--
`Nat.foldRev` evaluates `f` on the numbers up to `n` exclusive, in decreasing order:
* `Nat.foldRev f 3 init = f 0 <| f 1 <| f 2 <| init`
-/
@[specialize] def foldRev {α : Type u} : (n : Nat) (f : (i : Nat) i < n α α) (init : α) α
| 0, f, a => a
| succ n, f, a => foldRev n (fun i h => f i (by omega)) (f n (by omega) a)
/-- `any f n = true` iff there is `i in [0, n-1]` s.t. `f i = true` -/
@[specialize] def any : (n : Nat) (f : (i : Nat) i < n Bool) Bool
| 0, f => false
| succ n, f => any n (fun i h => f i (by omega)) || f n (by omega)
/-- Tail-recursive version of `Nat.any`. -/
@[inline] def anyTR (n : Nat) (f : (i : Nat) i < n Bool) : Bool :=
let rec @[specialize] loop : (i : Nat) i n Bool
| 0, h => false
| succ m, h => f (n - succ m) (by omega) || loop m (by omega)
loop n (by omega)
/-- `all f n = true` iff every `i in [0, n-1]` satisfies `f i = true` -/
@[specialize] def all : (n : Nat) (f : (i : Nat) i < n Bool) Bool
| 0, f => true
| succ n, f => all n (fun i h => f i (by omega)) && f n (by omega)
/-- Tail-recursive version of `Nat.all`. -/
@[inline] def allTR (n : Nat) (f : (i : Nat) i < n Bool) : Bool :=
let rec @[specialize] loop : (i : Nat) i n Bool
| 0, h => true
| succ m, h => f (n - succ m) (by omega) && loop m (by omega)
loop n (by omega)
/-! # csimp theorems -/
theorem fold_congr {α : Type u} {n m : Nat} (w : n = m)
(f : (i : Nat) i < n α α) (init : α) :
fold n f init = fold m (fun i h => f i (by omega)) init := by
subst m
rfl
theorem foldTR_loop_congr {α : Type u} {n m : Nat} (w : n = m)
(f : (i : Nat) i < n α α) (j : Nat) (h : j n) (init : α) :
foldTR.loop n f j h init = foldTR.loop m (fun i h => f i (by omega)) j (by omega) init := by
subst m
rfl
@[csimp] theorem fold_eq_foldTR : @fold = @foldTR :=
funext fun α => funext fun n => funext fun f => funext fun init =>
let rec go : m n f, fold (m + n) f init = foldTR.loop (m + n) f m (by omega) (fold n (fun i h => f i (by omega)) init)
| 0, n, f => by
simp only [foldTR.loop]
have t : 0 + n = n := by omega
rw [fold_congr t]
| succ m, n, f => by
have t : (m + 1) + n = m + (n + 1) := by omega
rw [foldTR.loop]
simp only [succ_eq_add_one, Nat.add_sub_cancel]
rw [fold_congr t, foldTR_loop_congr t, go, fold]
congr
omega
go n 0 f
theorem any_congr {n m : Nat} (w : n = m) (f : (i : Nat) i < n Bool) : any n f = any m (fun i h => f i (by omega)) := by
subst m
rfl
theorem anyTR_loop_congr {n m : Nat} (w : n = m) (f : (i : Nat) i < n Bool) (j : Nat) (h : j n) :
anyTR.loop n f j h = anyTR.loop m (fun i h => f i (by omega)) j (by omega) := by
subst m
rfl
@[csimp] theorem any_eq_anyTR : @any = @anyTR :=
funext fun n => funext fun f =>
let rec go : m n f, any (m + n) f = (any n (fun i h => f i (by omega)) || anyTR.loop (m + n) f m (by omega))
| 0, n, f => by
simp [anyTR.loop]
have t : 0 + n = n := by omega
rw [any_congr t]
| succ m, n, f => by
have t : (m + 1) + n = m + (n + 1) := by omega
rw [anyTR.loop]
simp only [succ_eq_add_one]
rw [any_congr t, anyTR_loop_congr t, go, any, Bool.or_assoc]
congr
omega
go n 0 f
theorem all_congr {n m : Nat} (w : n = m) (f : (i : Nat) i < n Bool) : all n f = all m (fun i h => f i (by omega)) := by
subst m
rfl
theorem allTR_loop_congr {n m : Nat} (w : n = m) (f : (i : Nat) i < n Bool) (j : Nat) (h : j n) : allTR.loop n f j h = allTR.loop m (fun i h => f i (by omega)) j (by omega) := by
subst m
rfl
@[csimp] theorem all_eq_allTR : @all = @allTR :=
funext fun n => funext fun f =>
let rec go : m n f, all (m + n) f = (all n (fun i h => f i (by omega)) && allTR.loop (m + n) f m (by omega))
| 0, n, f => by
simp [allTR.loop]
have t : 0 + n = n := by omega
rw [all_congr t]
| succ m, n, f => by
have t : (m + 1) + n = m + (n + 1) := by omega
rw [allTR.loop]
simp only [succ_eq_add_one]
rw [all_congr t, allTR_loop_congr t, go, all, Bool.and_assoc]
congr
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
/--
`(start, stop).foldI f a` evaluates `f` on all the numbers
from `start` (inclusive) to `stop` (exclusive) in increasing order:
* `(5, 8).foldI f init = init |> f 5 |> f 6 |> f 7`
-/
@[inline] def foldI {α : Type u} (i : Nat × Nat) (f : (j : Nat) i.1 j j < i.2 α α) (a : α) : α :=
(i.2 - i.1).fold (fun j _ => f (i.1 + j) (by omega) (by omega)) a
/--
`(start, stop).anyI f a` returns true if `f` is true for some natural number
from `start` (inclusive) to `stop` (exclusive):
* `(5, 8).anyI f = f 5 || f 6 || f 7`
-/
@[inline] def anyI (i : Nat × Nat) (f : (j : Nat) i.1 j j < i.2 Bool) : Bool :=
(i.2 - i.1).any (fun j _ => f (i.1 + j) (by omega) (by omega))
/--
`(start, stop).allI f a` returns true if `f` is true for all natural numbers
from `start` (inclusive) to `stop` (exclusive):
* `(5, 8).anyI f = f 5 && f 6 && f 7`
-/
@[inline] def allI (i : Nat × Nat) (f : (j : Nat) i.1 j j < i.2 Bool) : Bool :=
(i.2 - i.1).all (fun j _ => f (i.1 + j) (by omega) (by omega))
end 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
@@ -1029,3 +1045,12 @@ instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m
instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => m : Nat, m n p m :=
fun n => decidable_of_iff ( m, m < n + 1 p m)
(exists_congr fun _ => and_congr_left' Nat.lt_succ_iff)
/-! ### Results about `List.sum` specialized to `Nat` -/
protected theorem sum_pos_iff_exists_pos {l : List Nat} : 0 < l.sum x l, 0 < x := by
induction l with
| nil => simp
| cons x xs ih =>
simp [ ih]
omega

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.ByCases
import Init.Data.Prod
import Init.Data.RArray
namespace Nat.Linear
@@ -15,7 +16,7 @@ namespace Nat.Linear
abbrev Var := Nat
abbrev Context := List Nat
abbrev Context := Lean.RArray Nat
/--
When encoding polynomials. We use `fixedVar` for encoding numerals.
@@ -23,12 +24,7 @@ abbrev Context := List Nat
def fixedVar := 100000000 -- Any big number should work here
def Var.denote (ctx : Context) (v : Var) : Nat :=
bif v == fixedVar then 1 else go ctx v
where
go : List Nat Nat Nat
| [], _ => 0
| a::_, 0 => a
| _::as, i+1 => go as i
bif v == fixedVar then 1 else ctx.get v
inductive Expr where
| num (v : Nat)
@@ -52,25 +48,23 @@ def Poly.denote (ctx : Context) (p : Poly) : Nat :=
| [] => 0
| (k, v) :: p => Nat.add (Nat.mul k (v.denote ctx)) (denote ctx p)
def Poly.insertSorted (k : Nat) (v : Var) (p : Poly) : Poly :=
def Poly.insert (k : Nat) (v : Var) (p : Poly) : Poly :=
match p with
| [] => [(k, v)]
| (k', v') :: p => bif Nat.blt v v' then (k, v) :: (k', v') :: p else (k', v') :: insertSorted k v p
| (k', v') :: p =>
bif Nat.blt v v' then
(k, v) :: (k', v') :: p
else bif Nat.beq v v' then
(k + k', v') :: p
else
(k', v') :: insert k v p
def Poly.sort (p : Poly) : Poly :=
let rec go (p : Poly) (r : Poly) : Poly :=
def Poly.norm (p : Poly) : Poly := go p []
where
go (p : Poly) (r : Poly) : Poly :=
match p with
| [] => r
| (k, v) :: p => go p (r.insertSorted k v)
go p []
def Poly.fuse (p : Poly) : Poly :=
match p with
| [] => []
| (k, v) :: p =>
match fuse p with
| [] => [(k, v)]
| (k', v') :: p' => bif v == v' then (Nat.add k k', v)::p' else (k, v) :: (k', v') :: p'
| (k, v) :: p => go p (r.insert k v)
def Poly.mul (k : Nat) (p : Poly) : Poly :=
bif k == 0 then
@@ -146,15 +140,17 @@ def Poly.combineAux (fuel : Nat) (p₁ p₂ : Poly) : Poly :=
def Poly.combine (p₁ p₂ : Poly) : Poly :=
combineAux hugeFuel p₁ p₂
def Expr.toPoly : Expr Poly
| Expr.num k => bif k == 0 then [] else [ (k, fixedVar) ]
| Expr.var i => [(1, i)]
| Expr.add a b => a.toPoly ++ b.toPoly
| Expr.mulL k a => a.toPoly.mul k
| Expr.mulR a k => a.toPoly.mul k
def Poly.norm (p : Poly) : Poly :=
p.sort.fuse
def Expr.toPoly (e : Expr) :=
go 1 e []
where
-- Implementation note: This assembles the result using difference lists
-- to avoid `++` on lists.
go (coeff : Nat) : Expr (Poly Poly)
| Expr.num k => bif k == 0 then id else ((coeff * k, fixedVar) :: ·)
| Expr.var i => ((coeff, i) :: ·)
| Expr.add a b => go coeff a go coeff b
| Expr.mulL k a
| Expr.mulR a k => bif k == 0 then id else go (coeff * k) a
def Expr.toNormPoly (e : Expr) : Poly :=
e.toPoly.norm
@@ -201,7 +197,7 @@ def PolyCnstr.denote (ctx : Context) (c : PolyCnstr) : Prop :=
Poly.denote_le ctx (c.lhs, c.rhs)
def PolyCnstr.norm (c : PolyCnstr) : PolyCnstr :=
let (lhs, rhs) := Poly.cancel c.lhs.sort.fuse c.rhs.sort.fuse
let (lhs, rhs) := Poly.cancel c.lhs.norm c.rhs.norm
{ eq := c.eq, lhs, rhs }
def PolyCnstr.isUnsat (c : PolyCnstr) : Bool :=
@@ -268,24 +264,32 @@ def PolyCnstr.toExpr (c : PolyCnstr) : ExprCnstr :=
{ c with lhs := c.lhs.toExpr, rhs := c.rhs.toExpr }
attribute [local simp] Nat.add_comm Nat.add_assoc Nat.add_left_comm Nat.right_distrib Nat.left_distrib Nat.mul_assoc Nat.mul_comm
attribute [local simp] Poly.denote Expr.denote Poly.insertSorted Poly.sort Poly.sort.go Poly.fuse Poly.cancelAux
attribute [local simp] Poly.denote Expr.denote Poly.insert Poly.norm Poly.norm.go Poly.cancelAux
attribute [local simp] Poly.mul Poly.mul.go
theorem Poly.denote_insertSorted (ctx : Context) (k : Nat) (v : Var) (p : Poly) : (p.insertSorted k v).denote ctx = p.denote ctx + k * v.denote ctx := by
theorem Poly.denote_insert (ctx : Context) (k : Nat) (v : Var) (p : Poly) :
(p.insert k v).denote ctx = p.denote ctx + k * v.denote ctx := by
match p with
| [] => simp
| (k', v') :: p => by_cases h : Nat.blt v v' <;> simp [h, denote_insertSorted]
| (k', v') :: p =>
by_cases h₁ : Nat.blt v v'
· simp [h₁]
· by_cases h₂ : Nat.beq v v'
· simp only [insert, h₁, h₂, cond_false, cond_true]
simp [Nat.eq_of_beq_eq_true h₂]
· simp only [insert, h₁, h₂, cond_false, cond_true]
simp [denote_insert]
attribute [local simp] Poly.denote_insertSorted
attribute [local simp] Poly.denote_insert
theorem Poly.denote_sort_go (ctx : Context) (p : Poly) (r : Poly) : (sort.go p r).denote ctx = p.denote ctx + r.denote ctx := by
theorem Poly.denote_norm_go (ctx : Context) (p : Poly) (r : Poly) : (norm.go p r).denote ctx = p.denote ctx + r.denote ctx := by
match p with
| [] => simp
| (k, v):: p => simp [denote_sort_go]
| (k, v):: p => simp [denote_norm_go]
attribute [local simp] Poly.denote_sort_go
attribute [local simp] Poly.denote_norm_go
theorem Poly.denote_sort (ctx : Context) (m : Poly) : m.sort.denote ctx = m.denote ctx := by
theorem Poly.denote_sort (ctx : Context) (m : Poly) : m.norm.denote ctx = m.denote ctx := by
simp
attribute [local simp] Poly.denote_sort
@@ -316,18 +320,6 @@ theorem Poly.denote_reverse (ctx : Context) (p : Poly) : denote ctx (List.revers
attribute [local simp] Poly.denote_reverse
theorem Poly.denote_fuse (ctx : Context) (p : Poly) : p.fuse.denote ctx = p.denote ctx := by
match p with
| [] => rfl
| (k, v) :: p =>
have ih := denote_fuse ctx p
simp
split
case _ h => simp [ ih, h]
case _ k' v' p' h => by_cases he : v == v' <;> simp [he, ih, h]; rw [eq_of_beq he]
attribute [local simp] Poly.denote_fuse
theorem Poly.denote_mul (ctx : Context) (k : Nat) (p : Poly) : (p.mul k).denote ctx = k * p.denote ctx := by
simp
by_cases h : k == 0 <;> simp [h]; simp [eq_of_beq h]
@@ -516,13 +508,25 @@ theorem Poly.denote_combine (ctx : Context) (p₁ p₂ : Poly) : (p₁.combine p
attribute [local simp] Poly.denote_combine
theorem Expr.denote_toPoly_go (ctx : Context) (e : Expr) :
(toPoly.go k e p).denote ctx = k * e.denote ctx + p.denote ctx := by
induction k, e using Expr.toPoly.go.induct generalizing p with
| case1 k k' =>
simp only [toPoly.go]
by_cases h : k' == 0
· simp [h, eq_of_beq h]
· simp [h, Var.denote]
| case2 k i => simp [toPoly.go]
| case3 k a b iha ihb => simp [toPoly.go, iha, ihb]
| case4 k k' a ih
| case5 k a k' ih =>
simp only [toPoly.go, denote, mul_eq]
by_cases h : k' == 0
· simp [h, eq_of_beq h]
· simp [h, cond_false, ih, Nat.mul_assoc]
theorem Expr.denote_toPoly (ctx : Context) (e : Expr) : e.toPoly.denote ctx = e.denote ctx := by
induction e with
| num k => by_cases h : k == 0 <;> simp [toPoly, h, Var.denote]; simp [eq_of_beq h]
| var i => simp [toPoly]
| add a b iha ihb => simp [toPoly, iha, ihb]
| mulL k a ih => simp [toPoly, ih, -Poly.mul]
| mulR k a ih => simp [toPoly, ih, -Poly.mul]
simp [toPoly, Expr.denote_toPoly_go]
attribute [local simp] Expr.denote_toPoly
@@ -554,8 +558,8 @@ theorem ExprCnstr.denote_toPoly (ctx : Context) (c : ExprCnstr) : c.toPoly.denot
cases c; rename_i eq lhs rhs
simp [ExprCnstr.denote, PolyCnstr.denote, ExprCnstr.toPoly];
by_cases h : eq = true <;> simp [h]
· simp [Poly.denote_eq, Expr.toPoly]
· simp [Poly.denote_le, Expr.toPoly]
· simp [Poly.denote_eq]
· simp [Poly.denote_le]
attribute [local simp] ExprCnstr.denote_toPoly

View File

@@ -16,22 +16,22 @@ def getM [Alternative m] : Option α → m α
| none => failure
| some a => pure a
@[deprecated getM (since := "2024-04-17")]
-- `[Monad m]` is not needed here.
def toMonad [Monad m] [Alternative m] : Option α m α := getM
/-- Returns `true` on `some x` and `false` on `none`. -/
@[inline] def isSome : Option α Bool
| some _ => true
| none => false
@[deprecated isSome (since := "2024-04-17"), inline] def toBool : Option α Bool := isSome
@[simp] theorem isSome_none : @isSome α none = false := rfl
@[simp] theorem isSome_some : isSome (some a) = true := rfl
/-- Returns `true` on `none` and `false` on `some x`. -/
@[inline] def isNone : Option α Bool
| some _ => false
| none => true
@[simp] theorem isNone_none : @isNone α none = true := rfl
@[simp] theorem isNone_some : isNone (some a) = false := rfl
/--
`x?.isEqSome y` is equivalent to `x? == some y`, but avoids an allocation.
-/
@@ -134,6 +134,10 @@ def merge (fn : ααα) : Option α → Option α → Option α
@[inline] def get {α : Type u} : (o : Option α) isSome o α
| some x, _ => x
@[simp] theorem some_get : {x : Option α} (h : isSome x), some (x.get h) = x
| some _, _ => rfl
@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
/-- `guard p a` returns `some a` if `p a` holds, otherwise `none`. -/
@[inline] def guard (p : α Prop) [DecidablePred p] (a : α) : Option α :=
if p a then some a else none

View File

@@ -36,11 +36,6 @@ theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a
theorem not_mem_none (a : α) : a (none : Option α) := nofun
@[simp] theorem some_get : {x : Option α} (h : isSome x), some (x.get h) = x
| some _, _ => rfl
@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
theorem getD_of_ne_none {x : Option α} (hx : x none) (y : α) : some (x.getD y) = x := by
cases x; {contradiction}; rw [getD_some]
@@ -60,7 +55,9 @@ theorem get_eq_getD {fallback : α} : (o : Option α) → {h : o.isSome} → o.g
theorem some_get! [Inhabited α] : (o : Option α) o.isSome some (o.get!) = o
| some _, _ => rfl
theorem get!_eq_getD_default [Inhabited α] (o : Option α) : o.get! = o.getD default := rfl
theorem get!_eq_getD [Inhabited α] (o : Option α) : o.get! = o.getD default := rfl
@[deprecated get!_eq_getD (since := "2024-11-18")] abbrev get!_eq_getD_default := @get!_eq_getD
theorem mem_unique {o : Option α} {a b : α} (ha : a o) (hb : b o) : a = b :=
some.inj <| ha hb
@@ -73,19 +70,11 @@ theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a
theorem eq_none_iff_forall_not_mem : o = none a, a o :=
fun e a h => by rw [e] at h; (cases h), fun h => ext <| by simp; exact h
@[simp] theorem isSome_none : @isSome α none = false := rfl
@[simp] theorem isSome_some : isSome (some a) = true := rfl
theorem isSome_iff_exists : isSome x a, x = some a := by cases x <;> simp [isSome]
theorem isSome_eq_isSome : (isSome x = isSome y) (x = none y = none) := by
cases x <;> cases y <;> simp
@[simp] theorem isNone_none : @isNone α none = true := rfl
@[simp] theorem isNone_some : isNone (some a) = false := rfl
@[simp] theorem not_isSome : isSome a = false a.isNone = true := by
cases a <;> simp

69
src/Init/Data/RArray.lean Normal file
View File

@@ -0,0 +1,69 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.PropLemmas
namespace Lean
/--
A `RArray` can model `Fin n → α` or `Array α`, but is optimized for a fast kernel-reducible `get`
operation.
The primary intended use case is the “denote” function of a typical proof by reflection proof, where
only the `get` operation is necessary. It is not suitable as a general-purpose data structure.
There is no well-formedness invariant attached to this data structure, to keep it concise; it's
semantics is given through `RArray.get`. In that way one can also view an `RArray` as a decision
tree implementing `Nat → α`.
See `RArray.ofFn` and `RArray.ofArray` in module `Lean.Data.RArray` for functions that construct an
`RArray`.
It is not universe-polymorphic. ; smaller proof objects and no complication with the `ToExpr` type
class.
-/
inductive RArray (α : Type) : Type where
| leaf : α RArray α
| branch : Nat RArray α RArray α RArray α
variable {α : Type}
/-- The crucial operation, written with very little abstractional overhead -/
noncomputable def RArray.get (a : RArray α) (n : Nat) : α :=
RArray.rec (fun x => x) (fun p _ _ l r => (Nat.ble p n).rec l r) a
private theorem RArray.get_eq_def (a : RArray α) (n : Nat) :
a.get n = match a with
| .leaf x => x
| .branch p l r => (Nat.ble p n).rec (l.get n) (r.get n) := by
conv => lhs; unfold RArray.get
split <;> rfl
/-- `RArray.get`, implemented conventionally -/
def RArray.getImpl (a : RArray α) (n : Nat) : α :=
match a with
| .leaf x => x
| .branch p l r => if n < p then l.getImpl n else r.getImpl n
@[csimp]
theorem RArray.get_eq_getImpl : @RArray.get = @RArray.getImpl := by
funext α a n
induction a with
| leaf _ => rfl
| branch p l r ihl ihr =>
rw [RArray.getImpl, RArray.get_eq_def]
simp only [ihl, ihr, Nat.not_le, Nat.ble_eq, ite_not]
cases hnp : Nat.ble p n <;> rfl
instance : GetElem (RArray α) Nat α (fun _ _ => True) where
getElem a n _ := a.get n
def RArray.size : RArray α Nat
| leaf _ => 1
| branch _ l r => l.size + r.size
end Lean

View File

@@ -113,10 +113,10 @@ initialize IO.stdGenRef : IO.Ref StdGen ←
let seed := UInt64.toNat (ByteArray.toUInt64LE! ( IO.getRandomBytes 8))
IO.mkRef (mkStdGen seed)
def IO.setRandSeed (n : Nat) : IO Unit :=
def IO.setRandSeed (n : Nat) : BaseIO Unit :=
IO.stdGenRef.set (mkStdGen n)
def IO.rand (lo hi : Nat) : IO Nat := do
def IO.rand (lo hi : Nat) : BaseIO Nat := do
let gen IO.stdGenRef.get
let (r, gen) := randNat gen lo hi
IO.stdGenRef.set gen

View File

@@ -148,6 +148,9 @@ instance : ShiftLeft Int8 := ⟨Int8.shiftLeft⟩
instance : ShiftRight Int8 := Int8.shiftRight
instance : DecidableEq Int8 := Int8.decEq
@[extern "lean_bool_to_int8"]
def Bool.toInt8 (b : Bool) : Int8 := if b then 1 else 0
@[extern "lean_int8_dec_lt"]
def Int8.decLt (a b : Int8) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
@@ -249,6 +252,9 @@ instance : ShiftLeft Int16 := ⟨Int16.shiftLeft⟩
instance : ShiftRight Int16 := Int16.shiftRight
instance : DecidableEq Int16 := Int16.decEq
@[extern "lean_bool_to_int16"]
def Bool.toInt16 (b : Bool) : Int16 := if b then 1 else 0
@[extern "lean_int16_dec_lt"]
def Int16.decLt (a b : Int16) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
@@ -354,6 +360,9 @@ instance : ShiftLeft Int32 := ⟨Int32.shiftLeft⟩
instance : ShiftRight Int32 := Int32.shiftRight
instance : DecidableEq Int32 := Int32.decEq
@[extern "lean_bool_to_int32"]
def Bool.toInt32 (b : Bool) : Int32 := if b then 1 else 0
@[extern "lean_int32_dec_lt"]
def Int32.decLt (a b : Int32) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
@@ -463,6 +472,9 @@ instance : ShiftLeft Int64 := ⟨Int64.shiftLeft⟩
instance : ShiftRight Int64 := Int64.shiftRight
instance : DecidableEq Int64 := Int64.decEq
@[extern "lean_bool_to_int64"]
def Bool.toInt64 (b : Bool) : Int64 := if b then 1 else 0
@[extern "lean_int64_dec_lt"]
def Int64.decLt (a b : Int64) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
@@ -574,6 +586,9 @@ instance : ShiftLeft ISize := ⟨ISize.shiftLeft⟩
instance : ShiftRight ISize := ISize.shiftRight
instance : DecidableEq ISize := ISize.decEq
@[extern "lean_bool_to_isize"]
def Bool.toISize (b : Bool) : ISize := if b then 1 else 0
@[extern "lean_isize_dec_lt"]
def ISize.decLt (a b : ISize) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))

View File

@@ -514,9 +514,6 @@ instance : Inhabited String := ⟨""⟩
instance : Append String := String.append
@[deprecated push (since := "2024-04-06")]
def str : String Char String := push
@[inline] def pushn (s : String) (c : Char) (n : Nat) : String :=
n.repeat (fun s => s.push c) s

View File

@@ -31,7 +31,7 @@ This file defines basic operations on the the sum type `α ⊕ β`.
## Further material
See `Batteries.Data.Sum.Lemmas` for theorems about these definitions.
See `Init.Data.Sum.Lemmas` for theorems about these definitions.
## Notes

View File

@@ -56,6 +56,9 @@ instance : Xor UInt8 := ⟨UInt8.xor⟩
instance : ShiftLeft UInt8 := UInt8.shiftLeft
instance : ShiftRight UInt8 := UInt8.shiftRight
@[extern "lean_bool_to_uint8"]
def Bool.toUInt8 (b : Bool) : UInt8 := if b then 1 else 0
@[extern "lean_uint8_dec_lt"]
def UInt8.decLt (a b : UInt8) : Decidable (a < b) :=
inferInstanceAs (Decidable (a.toBitVec < b.toBitVec))
@@ -116,6 +119,9 @@ instance : Xor UInt16 := ⟨UInt16.xor⟩
instance : ShiftLeft UInt16 := UInt16.shiftLeft
instance : ShiftRight UInt16 := UInt16.shiftRight
@[extern "lean_bool_to_uint16"]
def Bool.toUInt16 (b : Bool) : UInt16 := if b then 1 else 0
set_option bootstrap.genMatcherCode false in
@[extern "lean_uint16_dec_lt"]
def UInt16.decLt (a b : UInt16) : Decidable (a < b) :=
@@ -174,6 +180,9 @@ instance : Xor UInt32 := ⟨UInt32.xor⟩
instance : ShiftLeft UInt32 := UInt32.shiftLeft
instance : ShiftRight UInt32 := UInt32.shiftRight
@[extern "lean_bool_to_uint32"]
def Bool.toUInt32 (b : Bool) : UInt32 := if b then 1 else 0
@[extern "lean_uint64_add"]
def UInt64.add (a b : UInt64) : UInt64 := a.toBitVec + b.toBitVec
@[extern "lean_uint64_sub"]
@@ -237,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"]
@@ -255,10 +270,29 @@ 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_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
@@ -278,5 +312,8 @@ instance : Xor USize := ⟨USize.xor⟩
instance : ShiftLeft USize := USize.shiftLeft
instance : ShiftRight USize := USize.shiftRight
@[extern "lean_bool_to_usize"]
def Bool.toUSize (b : Bool) : USize := if b then 1 else 0
instance : Max USize := maxOfLe
instance : Min USize := minOfLe

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

@@ -133,6 +133,9 @@ declare_uint_theorems UInt32
declare_uint_theorems UInt64
declare_uint_theorems USize
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 +148,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,253 @@
/-
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
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,172 @@
/-
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
theorem length_toList {α n} (xs : Vector α n) : xs.toList.length = n := by simp
@[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
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
@[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 swap_mk {data : Array α} {size : data.size = n} {i j : Nat} {hi hj} :
(Vector.mk data size).swap i j hi hj = Vector.mk (data.swap i j) (by simp_all) := 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]
theorem push_swap (a : Vector α n) (x : α) {i j : Nat} {hi hj} :
(a.swap i j hi hj).push x = (a.push x).swap i j := by
cases a
simp [Array.push_swap]
/-! ### cast -/
@[simp] theorem cast_mk {n m} (a : Array α) (w : a.size = n) (h : n = m) :
(Vector.mk a w).cast h = a, h w := by
simp [Vector.cast]
@[simp] theorem cast_refl {n} (a : Vector α n) : a.cast rfl = a := by
cases a
simp
@[simp] theorem toArray_cast {n m} (a : Vector α n) (h : n = m) :
(a.cast h).toArray = a.toArray := by
subst h
simp
theorem cast_inj {n m} (a : Vector α n) (b : Vector α n) (h : n = m) :
a.cast h = b.cast h a = b := by
cases h
simp
theorem cast_eq_iff {n m} (a : Vector α n) (b : Vector α m) (h : n = m) :
a.cast h = b a = b.cast h.symm := by
cases h
simp
theorem eq_cast_iff {n m} (a : Vector α n) (b : Vector α m) (h : m = n) :
a = b.cast h a.cast h.symm = b := by
cases h
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

@@ -166,6 +166,12 @@ theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem d
have : Decidable (dom c i) := .isFalse h
simp [getElem!_def, getElem?_def, h]
@[simp] theorem get_getElem? [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
(c : cont) (i : idx) [Decidable (dom c i)] (h) :
c[i]?.get h = c[i]'(by simp only [getElem?_def] at h; split at h <;> simp_all) := by
simp only [getElem?_def] at h
split <;> simp_all
namespace Fin
instance instGetElemFinVal [GetElem cont Nat elem dom] : GetElem cont (Fin n) elem fun xs i => dom xs i where
@@ -200,12 +206,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 ..
@@ -217,7 +223,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

@@ -374,6 +374,9 @@ partial def structEq : Syntax → Syntax → Bool
instance : BEq Lean.Syntax := structEq
instance : BEq (Lean.TSyntax k) := (·.raw == ·.raw)
/--
Finds the first `SourceInfo` from the back of `stx` or `none` if no `SourceInfo` can be found.
-/
partial def getTailInfo? : Syntax Option SourceInfo
| atom info _ => info
| ident info .. => info
@@ -382,14 +385,39 @@ partial def getTailInfo? : Syntax → Option SourceInfo
| node info _ _ => info
| _ => none
/--
Finds the first `SourceInfo` from the back of `stx` or `SourceInfo.none`
if no `SourceInfo` can be found.
-/
def getTailInfo (stx : Syntax) : SourceInfo :=
stx.getTailInfo?.getD SourceInfo.none
/--
Finds the trailing size of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains no
trailing whitespace, the result is `0`.
-/
def getTrailingSize (stx : Syntax) : Nat :=
match stx.getTailInfo? with
| some (SourceInfo.original (trailing := trailing) ..) => trailing.bsize
| _ => 0
/--
Finds the trailing whitespace substring of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains
no trailing whitespace, the result is `none`.
-/
def getTrailing? (stx : Syntax) : Option Substring :=
stx.getTailInfo.getTrailing?
/--
Finds the tail position of the trailing whitespace of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains
no trailing whitespace and lacks a tail position, the result is `none`.
-/
def getTrailingTailPos? (stx : Syntax) (canonicalOnly := false) : Option String.Pos :=
stx.getTailInfo.getTrailingTailPos? canonicalOnly
/--
Return substring of original input covering `stx`.
Result is meaningful only if all involved `SourceInfo.original`s refer to the same string (as is the case after parsing). -/
@@ -403,21 +431,20 @@ def getSubstring? (stx : Syntax) (withLeading := true) (withTrailing := true) :
}
| _, _ => none
@[specialize] private partial def updateLast {α} [Inhabited α] (a : Array α) (f : α Option α) (i : Nat) : Option (Array α) :=
if i == 0 then
none
else
let i := i - 1
let v := a[i]!
@[specialize] private partial def updateLast {α} (a : Array α) (f : α Option α) (i : Fin (a.size + 1)) : Option (Array α) :=
match i with
| 0 => none
| i + 1, h =>
let v := a[i]'(Nat.succ_lt_succ_iff.mp h)
match f v with
| some v => some <| a.set! i v
| none => updateLast a f i
| some v => some <| a.set i v (Nat.succ_lt_succ_iff.mp h)
| none => updateLast a f i, Nat.lt_of_succ_lt h
partial def setTailInfoAux (info : SourceInfo) : Syntax Option Syntax
| atom _ val => some <| atom info val
| ident _ rawVal val pre => some <| ident info rawVal val pre
| node info' k args =>
match updateLast args (setTailInfoAux info) args.size with
match updateLast args (setTailInfoAux info) args.size, by simp with
| some args => some <| node info' k args
| none => none
| _ => none

View File

@@ -251,10 +251,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

@@ -71,9 +71,9 @@ def prio : Category := {}
/-- `prec` is a builtin syntax category for precedences. A precedence is a value
that expresses how tightly a piece of syntax binds: for example `1 + 2 * 3` is
parsed as `1 + (2 * 3)` because `*` has a higher pr0ecedence than `+`.
parsed as `1 + (2 * 3)` because `*` has a higher precedence than `+`.
Higher numbers denote higher precedence.
In addition to literals like `37`, there are some special named priorities:
In addition to literals like `37`, there are some special named precedence levels:
* `arg` for the precedence of function arguments
* `max` for the highest precedence used in term parsers (not actually the maximum possible value)
* `lead` for the precedence of terms not supposed to be used as arguments

View File

@@ -22,28 +22,28 @@ syntax explicitBinders := (ppSpace bracketedExplicitBinders)+ <|> unb
open TSyntax.Compat in
def expandExplicitBindersAux (combinator : Syntax) (idents : Array Syntax) (type? : Option Syntax) (body : Syntax) : MacroM Syntax :=
let rec loop (i : Nat) (acc : Syntax) := do
let rec loop (i : Nat) (h : i idents.size) (acc : Syntax) := do
match i with
| 0 => pure acc
| i+1 =>
let ident := idents[i]![0]
| i + 1 =>
let ident := idents[i][0]
let acc match ident.isIdent, type? with
| true, none => `($combinator fun $ident => $acc)
| true, some type => `($combinator fun $ident : $type => $acc)
| false, none => `($combinator fun _ => $acc)
| false, some type => `($combinator fun _ : $type => $acc)
loop i acc
loop idents.size body
loop i (Nat.le_of_succ_le h) acc
loop idents.size (by simp) body
def expandBrackedBindersAux (combinator : Syntax) (binders : Array Syntax) (body : Syntax) : MacroM Syntax :=
let rec loop (i : Nat) (acc : Syntax) := do
let rec loop (i : Nat) (h : i binders.size) (acc : Syntax) := do
match i with
| 0 => pure acc
| i+1 =>
let idents := binders[i]![1].getArgs
let type := binders[i]![3]
loop i ( expandExplicitBindersAux combinator idents (some type) acc)
loop binders.size body
let idents := binders[i][1].getArgs
let type := binders[i][3]
loop i (Nat.le_of_succ_le h) ( expandExplicitBindersAux combinator idents (some type) acc)
loop binders.size (by simp) body
def expandExplicitBinders (combinatorDeclName : Name) (explicitBinders : Syntax) (body : Syntax) : MacroM Syntax := do
let combinator := mkCIdentFrom ( getRef) combinatorDeclName

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).
@@ -2829,17 +2817,6 @@ instance {α : Type u} {m : Type u → Type v} [Monad m] [Inhabited α] : Inhabi
instance [Monad m] : [Nonempty α] Nonempty (m α)
| x => pure x
/-- A fusion of Haskell's `sequence` and `map`. Used in syntax quotations. -/
def Array.sequenceMap {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m β) : m (Array β) :=
let rec loop (i : Nat) (j : Nat) (bs : Array β) : m (Array β) :=
dite (LT.lt j as.size)
(fun hlt =>
match i with
| 0 => pure bs
| Nat.succ i' => Bind.bind (f (as.get j hlt)) fun b => loop i' (hAdd j 1) (bs.push b))
(fun _ => pure bs)
loop as.size 0 (Array.mkEmpty as.size)
/--
A function for lifting a computation from an inner `Monad` to an outer `Monad`.
Like Haskell's [`MonadTrans`], but `n` does not have to be a monad transformer.
@@ -3443,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
@@ -3665,7 +3623,8 @@ namespace SourceInfo
/--
Gets the position information from a `SourceInfo`, if available.
If `originalOnly` is true, then `.synthetic` syntax will also return `none`.
If `canonicalOnly` is true, then `.synthetic` syntax with `canonical := false`
will also return `none`.
-/
def getPos? (info : SourceInfo) (canonicalOnly := false) : Option String.Pos :=
match info, canonicalOnly with
@@ -3676,7 +3635,8 @@ def getPos? (info : SourceInfo) (canonicalOnly := false) : Option String.Pos :=
/--
Gets the end position information from a `SourceInfo`, if available.
If `originalOnly` is true, then `.synthetic` syntax will also return `none`.
If `canonicalOnly` is true, then `.synthetic` syntax with `canonical := false`
will also return `none`.
-/
def getTailPos? (info : SourceInfo) (canonicalOnly := false) : Option String.Pos :=
match info, canonicalOnly with
@@ -3685,6 +3645,24 @@ def getTailPos? (info : SourceInfo) (canonicalOnly := false) : Option String.Pos
| synthetic (endPos := endPos) .., false => some endPos
| _, _ => none
/--
Gets the substring representing the trailing whitespace of a `SourceInfo`, if available.
-/
def getTrailing? (info : SourceInfo) : Option Substring :=
match info with
| original (trailing := trailing) .. => some trailing
| _ => none
/--
Gets the end position information of the trailing whitespace of a `SourceInfo`, if available.
If `canonicalOnly` is true, then `.synthetic` syntax with `canonical := false`
will also return `none`.
-/
def getTrailingTailPos? (info : SourceInfo) (canonicalOnly := false) : Option String.Pos :=
match info.getTrailing? with
| some trailing => some trailing.stopPos
| none => info.getTailPos? canonicalOnly
end SourceInfo
/--
@@ -3983,7 +3961,6 @@ position information.
def getPos? (stx : Syntax) (canonicalOnly := false) : Option String.Pos :=
stx.getHeadInfo.getPos? canonicalOnly
/--
Get the ending position of the syntax, if possible.
If `canonicalOnly` is true, non-canonical `synthetic` nodes are treated as not carrying

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

@@ -30,7 +30,7 @@ Does nothing for non-`node` nodes, or if `i` is out of bounds of the node list.
-/
def setArg (stx : Syntax) (i : Nat) (arg : Syntax) : Syntax :=
match stx with
| node info k args => node info k (args.setD i arg)
| node info k args => node info k (args.setIfInBounds i arg)
| stx => stx
end Lean.Syntax

View File

@@ -462,6 +462,16 @@ Note that it is the caller's job to remove the file after use.
-/
@[extern "lean_io_create_tempfile"] opaque createTempFile : IO (Handle × FilePath)
/--
Creates a temporary directory in the most secure manner possible. There are no race conditions in the
directorys creation. The directory is readable and writable only by the creating user ID.
Returns the new directory's path.
It is the caller's job to remove the directory after use.
-/
@[extern "lean_io_create_tempdir"] opaque createTempDir : IO FilePath
end FS
@[extern "lean_io_getenv"] opaque getEnv (var : @& String) : BaseIO (Option String)
@@ -474,17 +484,6 @@ namespace FS
def withFile (fn : FilePath) (mode : Mode) (f : Handle IO α) : IO α :=
Handle.mk fn mode >>= f
/--
Like `createTempFile` but also takes care of removing the file after usage.
-/
def withTempFile [Monad m] [MonadFinally m] [MonadLiftT IO m] (f : Handle FilePath m α) :
m α := do
let (handle, path) createTempFile
try
f handle path
finally
removeFile path
def Handle.putStrLn (h : Handle) (s : String) : IO Unit :=
h.putStr (s.push '\n')
@@ -675,8 +674,10 @@ def appDir : IO FilePath := do
| throw <| IO.userError s!"System.IO.appDir: unexpected filename '{p}'"
FS.realPath p
namespace FS
/-- Create given path and all missing parents as directories. -/
partial def FS.createDirAll (p : FilePath) : IO Unit := do
partial def createDirAll (p : FilePath) : IO Unit := do
if p.isDir then
return ()
if let some parent := p.parent then
@@ -693,7 +694,7 @@ partial def FS.createDirAll (p : FilePath) : IO Unit := do
/--
Fully remove given directory by deleting all contained files and directories in an unspecified order.
Fails if any contained entry cannot be deleted or was newly created during execution. -/
partial def FS.removeDirAll (p : FilePath) : IO Unit := do
partial def removeDirAll (p : FilePath) : IO Unit := do
for ent in ( p.readDir) do
if ( ent.path.isDir : Bool) then
removeDirAll ent.path
@@ -701,6 +702,32 @@ partial def FS.removeDirAll (p : FilePath) : IO Unit := do
removeFile ent.path
removeDir p
/--
Like `createTempFile`, but also takes care of removing the file after usage.
-/
def withTempFile [Monad m] [MonadFinally m] [MonadLiftT IO m] (f : Handle FilePath m α) :
m α := do
let (handle, path) createTempFile
try
f handle path
finally
removeFile path
/--
Like `createTempDir`, but also takes care of removing the directory after usage.
All files in the directory are recursively deleted, regardless of how or when they were created.
-/
def withTempDir [Monad m] [MonadFinally m] [MonadLiftT IO m] (f : FilePath m α) :
m α := do
let path createTempDir
try
f path
finally
removeDirAll path
end FS
namespace Process
/-- Returns the current working directory of the calling process. -/
@@ -802,6 +829,9 @@ def run (args : SpawnArgs) : IO String := do
end Process
/-- Returns the thread ID of the calling thread. -/
@[extern "lean_io_get_tid"] opaque getTID : BaseIO UInt64
structure AccessRight where
read : Bool := false
write : Bool := false

View File

@@ -29,13 +29,13 @@ def decodeUri (uri : String) : String := Id.run do
let len := rawBytes.size
let mut i := 0
let percent := '%'.toNat.toUInt8
while i < len do
let c := rawBytes[i]!
(decoded, i) := if c == percent && i + 1 < len then
let h1 := rawBytes[i + 1]!
while h : i < len do
let c := rawBytes[i]
(decoded, i) := if h₁ : c == percent i + 1 < len then
let h1 := rawBytes[i + 1]
if let some hd1 := hexDigitToUInt8? h1 then
if i + 2 < len then
let h2 := rawBytes[i + 2]!
if h₂ : i + 2 < len then
let h2 := rawBytes[i + 2]
if let some hd2 := hexDigitToUInt8? h2 then
-- decode the hex digits into a byte.
(decoded.push (hd1 * 16 + hd2), i + 3)

View File

@@ -428,11 +428,11 @@ macro "infer_instance" : tactic => `(tactic| exact inferInstance)
/--
`+opt` is short for `(opt := true)`. It sets the `opt` configuration option to `true`.
-/
syntax posConfigItem := "+" noWs ident
syntax posConfigItem := " +" noWs ident
/--
`-opt` is short for `(opt := false)`. It sets the `opt` configuration option to `false`.
-/
syntax negConfigItem := "-" noWs ident
syntax negConfigItem := " -" noWs ident
/--
`(opt := val)` sets the `opt` configuration option to `val`.
@@ -466,7 +466,7 @@ hypotheses or the goal. It can have one of the forms:
* `at h₁ h₂ ⊢`: target the hypotheses `h₁` and `h₂`, and the goal
* `at *`: target all hypotheses and the goal
-/
syntax location := withPosition(" at" (locationWildcard <|> locationHyp))
syntax location := withPosition(ppGroup(" at" (locationWildcard <|> locationHyp)))
/--
* `change tgt'` will change the goal from `tgt` to `tgt'`,
@@ -1155,7 +1155,7 @@ Configuration for the `decide` tactic family.
structure DecideConfig where
/-- If true (default: false), then use only kernel reduction when reducing the `Decidable` instance.
This is more efficient, since the default mode reduces twice (once in the elaborator and again in the kernel),
however kernel reduction ignores transparency settings. The `decide!` tactic is a synonym for `decide +kernel`. -/
however kernel reduction ignores transparency settings. -/
kernel : Bool := false
/-- If true (default: false), then uses the native code compiler to evaluate the `Decidable` instance,
admitting the result via the axiom `Lean.ofReduceBool`. This can be significantly more efficient,
@@ -1165,7 +1165,9 @@ structure DecideConfig where
native : Bool := false
/-- If true (default: true), then when preprocessing the goal, do zeta reduction to attempt to eliminate free variables. -/
zetaReduce : Bool := true
/-- If true (default: false), then when preprocessing reverts free variables. -/
/-- If true (default: false), then when preprocessing, removes irrelevant variables and reverts the local context.
A variable is *relevant* if it appears in the target, if it appears in a relevant variable,
or if it is a proposition that refers to a relevant variable. -/
revert : Bool := false
/--
@@ -1240,17 +1242,6 @@ example : 1 + 1 = 2 := by rfl
-/
syntax (name := decide) "decide" optConfig : tactic
/--
`decide!` is a variant of the `decide` tactic that uses kernel reduction to prove the goal.
It has the following properties:
- Since it uses kernel reduction instead of elaborator reduction, it ignores transparency and can unfold everything.
- While `decide` needs to reduce the `Decidable` instance twice (once during elaboration to verify whether the tactic succeeds,
and once during kernel type checking), the `decide!` tactic reduces it exactly once.
The `decide!` syntax is short for `decide +kernel`.
-/
syntax (name := decideBang) "decide!" optConfig : tactic
/--
`native_decide` is a synonym for `decide +native`.
It will attempt to prove a goal of type `p` by synthesizing an instance

View File

@@ -90,10 +90,14 @@ def withPtrAddr {α : Type u} {β : Type v} (a : α) (k : USize → β) (h : ∀
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. -/
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"]
def Runtime.markPersistent (a : α) : α := a
unsafe def Runtime.markPersistent (a : α) : α := a

View File

@@ -133,8 +133,8 @@ def foldNatBinBoolPred (fn : Nat → Nat → Bool) (a₁ a₂ : Expr) : Option E
return mkConst ``Bool.false
def foldNatBeq := fun _ : Bool => foldNatBinBoolPred (fun a b => a == b)
def foldNatBle := fun _ : Bool => foldNatBinBoolPred (fun a b => a < b)
def foldNatBlt := fun _ : Bool => foldNatBinBoolPred (fun a b => a b)
def foldNatBlt := fun _ : Bool => foldNatBinBoolPred (fun a b => a < b)
def foldNatBle := fun _ : Bool => foldNatBinBoolPred (fun a b => a b)
def natFoldFns : List (Name × BinFoldFn) :=
[(``Nat.add, foldNatAdd),

View File

@@ -205,8 +205,8 @@ def getParamInfo (k : ParamMap.Key) : M (Array Param) := do
/-- For each ps[i], if ps[i] is owned, then mark xs[i] as owned. -/
def ownArgsUsingParams (xs : Array Arg) (ps : Array Param) : M Unit :=
xs.size.forM fun i => do
let x := xs[i]!
xs.size.forM fun i _ => do
let x := xs[i]
let p := ps[i]!
unless p.borrow do ownArg x
@@ -216,8 +216,8 @@ def ownArgsUsingParams (xs : Array Arg) (ps : Array Param) : M Unit :=
we would have to insert a `dec xs[i]` after `f xs` and consequently
"break" the tail call. -/
def ownParamsUsingArgs (xs : Array Arg) (ps : Array Param) : M Unit :=
xs.size.forM fun i => do
let x := xs[i]!
xs.size.forM fun i _ => do
let x := xs[i]
let p := ps[i]!
match x with
| Arg.var x => if ( isOwned x) then ownVar p.x

View File

@@ -48,9 +48,9 @@ def requiresBoxedVersion (env : Environment) (decl : Decl) : Bool :=
def mkBoxedVersionAux (decl : Decl) : N Decl := do
let ps := decl.params
let qs ps.mapM fun _ => do let x N.mkFresh; pure { x := x, ty := IRType.object, borrow := false : Param }
let (newVDecls, xs) qs.size.foldM (init := (#[], #[])) fun i (newVDecls, xs) => do
let (newVDecls, xs) qs.size.foldM (init := (#[], #[])) fun i _ (newVDecls, xs) => do
let p := ps[i]!
let q := qs[i]!
let q := qs[i]
if !p.ty.isScalar then
pure (newVDecls, xs.push (Arg.var q.x))
else

View File

@@ -63,7 +63,7 @@ partial def merge (v₁ v₂ : Value) : Value :=
| top, _ => top
| _, top => top
| v₁@(ctor i₁ vs₁), v₂@(ctor i₂ vs₂) =>
if i₁ == i₂ then ctor i₁ <| vs₁.size.fold (init := #[]) fun i r => r.push (merge vs₁[i]! vs₂[i]!)
if i₁ == i₂ then ctor i₁ <| vs₁.size.fold (init := #[]) fun i _ r => r.push (merge vs₁[i] vs₂[i]!)
else choice [v₁, v₂]
| choice vs₁, choice vs₂ => choice <| vs₁.foldl (addChoice merge) vs₂
| choice vs, v => choice <| addChoice merge vs v
@@ -225,8 +225,8 @@ def updateCurrFnSummary (v : Value) : M Unit := do
def updateJPParamsAssignment (ys : Array Param) (xs : Array Arg) : M Bool := do
let ctx read
let currFnIdx := ctx.currFnIdx
ys.size.foldM (init := false) fun i r => do
let y := ys[i]!
ys.size.foldM (init := false) fun i _ r => do
let y := ys[i]
let x := xs[i]!
let yVal findVarValue y.x
let xVal findArgValue x
@@ -282,8 +282,8 @@ partial def interpFnBody : FnBody → M Unit
def inferStep : M Bool := do
let ctx read
modify fun s => { s with assignments := ctx.decls.map fun _ => {} }
ctx.decls.size.foldM (init := false) fun idx modified => do
match ctx.decls[idx]! with
ctx.decls.size.foldM (init := false) fun idx _ modified => do
match ctx.decls[idx] with
| .fdecl (xs := ys) (body := b) .. => do
let s get
let currVals := s.funVals[idx]!
@@ -336,8 +336,8 @@ def elimDeadBranches (decls : Array Decl) : CompilerM (Array Decl) := do
let funVals := s.funVals
let assignments := s.assignments
modify fun s =>
let env := decls.size.fold (init := s.env) fun i env =>
addFunctionSummary env decls[i]!.name funVals[i]!
let env := decls.size.fold (init := s.env) fun i _ env =>
addFunctionSummary env decls[i].name funVals[i]!
{ s with env := env }
return decls.mapIdx fun i decl => elimDead assignments[i]! decl

View File

@@ -108,9 +108,9 @@ def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M U
if ps.size > closureMaxArgs && isBoxedName decl.name then
emit "lean_object**"
else
ps.size.forM fun i => do
ps.size.forM fun i _ => do
if i > 0 then emit ", "
emit (toCType ps[i]!.ty)
emit (toCType ps[i].ty)
emit ")"
emitLn ";"
@@ -271,9 +271,9 @@ def emitTag (x : VarId) (xType : IRType) : M Unit := do
emit x
def isIf (alts : Array Alt) : Option (Nat × FnBody × FnBody) :=
if alts.size != 2 then none
else match alts[0]! with
| Alt.ctor c b => some (c.cidx, b, alts[1]!.body)
if h : alts.size 2 then none
else match alts[0] with
| Alt.ctor c b => some (c.cidx, b, alts[1].body)
| _ => none
def emitInc (x : VarId) (n : Nat) (checkRef : Bool) : M Unit := do
@@ -321,20 +321,22 @@ def emitSSet (x : VarId) (n : Nat) (offset : Nat) (y : VarId) (t : IRType) : M U
def emitJmp (j : JoinPointId) (xs : Array Arg) : M Unit := do
let ps getJPParams j
unless xs.size == ps.size do throw "invalid goto"
xs.size.forM fun i => do
let p := ps[i]!
let x := xs[i]!
emit p.x; emit " = "; emitArg x; emitLn ";"
emit "goto "; emit j; emitLn ";"
if h : xs.size = ps.size then
xs.size.forM fun i _ => do
let p := ps[i]
let x := xs[i]
emit p.x; emit " = "; emitArg x; emitLn ";"
emit "goto "; emit j; emitLn ";"
else
do throw "invalid goto"
def emitLhs (z : VarId) : M Unit := do
emit z; emit " = "
def emitArgs (ys : Array Arg) : M Unit :=
ys.size.forM fun i => do
ys.size.forM fun i _ => do
if i > 0 then emit ", "
emitArg ys[i]!
emitArg ys[i]
def emitCtorScalarSize (usize : Nat) (ssize : Nat) : M Unit := do
if usize == 0 then emit ssize
@@ -346,8 +348,8 @@ def emitAllocCtor (c : CtorInfo) : M Unit := do
emitCtorScalarSize c.usize c.ssize; emitLn ");"
def emitCtorSetArgs (z : VarId) (ys : Array Arg) : M Unit :=
ys.size.forM fun i => do
emit "lean_ctor_set("; emit z; emit ", "; emit i; emit ", "; emitArg ys[i]!; emitLn ");"
ys.size.forM fun i _ => do
emit "lean_ctor_set("; emit z; emit ", "; emit i; emit ", "; emitArg ys[i]; emitLn ");"
def emitCtor (z : VarId) (c : CtorInfo) (ys : Array Arg) : M Unit := do
emitLhs z;
@@ -358,7 +360,7 @@ def emitCtor (z : VarId) (c : CtorInfo) (ys : Array Arg) : M Unit := do
def emitReset (z : VarId) (n : Nat) (x : VarId) : M Unit := do
emit "if (lean_is_exclusive("; emit x; emitLn ")) {";
n.forM fun i => do
n.forM fun i _ => do
emit " lean_ctor_release("; emit x; emit ", "; emit i; emitLn ");"
emit " "; emitLhs z; emit x; emitLn ";";
emitLn "} else {";
@@ -399,12 +401,12 @@ def emitSimpleExternalCall (f : String) (ps : Array Param) (ys : Array Arg) : M
emit f; emit "("
-- We must remove irrelevant arguments to extern calls.
discard <| ys.size.foldM
(fun i (first : Bool) =>
(fun i _ (first : Bool) =>
if ps[i]!.ty.isIrrelevant then
pure first
else do
unless first do emit ", "
emitArg ys[i]!
emitArg ys[i]
pure false)
true
emitLn ");"
@@ -431,8 +433,8 @@ def emitPartialApp (z : VarId) (f : FunId) (ys : Array Arg) : M Unit := do
let decl getDecl f
let arity := decl.params.size;
emitLhs z; emit "lean_alloc_closure((void*)("; emitCName f; emit "), "; emit arity; emit ", "; emit ys.size; emitLn ");";
ys.size.forM fun i => do
let y := ys[i]!
ys.size.forM fun i _ => do
let y := ys[i]
emit "lean_closure_set("; emit z; emit ", "; emit i; emit ", "; emitArg y; emitLn ");"
def emitApp (z : VarId) (f : VarId) (ys : Array Arg) : M Unit :=
@@ -544,34 +546,36 @@ That is, we have
-/
def overwriteParam (ps : Array Param) (ys : Array Arg) : Bool :=
let n := ps.size;
n.any fun i =>
let p := ps[i]!
(i+1, n).anyI fun j => paramEqArg p ys[j]!
n.any fun i _ =>
let p := ps[i]
(i+1, n).anyI fun j _ _ => paramEqArg p ys[j]!
def emitTailCall (v : Expr) : M Unit :=
match v with
| Expr.fap _ ys => do
let ctx read
let ps := ctx.mainParams
unless ps.size == ys.size do throw "invalid tail call"
if overwriteParam ps ys then
emitLn "{"
ps.size.forM fun i => do
let p := ps[i]!
let y := ys[i]!
unless paramEqArg p y do
emit (toCType p.ty); emit " _tmp_"; emit i; emit " = "; emitArg y; emitLn ";"
ps.size.forM fun i => do
let p := ps[i]!
let y := ys[i]!
unless paramEqArg p y do emit p.x; emit " = _tmp_"; emit i; emitLn ";"
emitLn "}"
if h : ps.size = ys.size then
if overwriteParam ps ys then
emitLn "{"
ps.size.forM fun i _ => do
let p := ps[i]
let y := ys[i]
unless paramEqArg p y do
emit (toCType p.ty); emit " _tmp_"; emit i; emit " = "; emitArg y; emitLn ";"
ps.size.forM fun i _ => do
let p := ps[i]
let y := ys[i]
unless paramEqArg p y do emit p.x; emit " = _tmp_"; emit i; emitLn ";"
emitLn "}"
else
ys.size.forM fun i _ => do
let p := ps[i]
let y := ys[i]
unless paramEqArg p y do emit p.x; emit " = "; emitArg y; emitLn ";"
emitLn "goto _start;"
else
ys.size.forM fun i => do
let p := ps[i]!
let y := ys[i]!
unless paramEqArg p y do emit p.x; emit " = "; emitArg y; emitLn ";"
emitLn "goto _start;"
throw "invalid tail call"
| _ => throw "bug at emitTailCall"
mutual
@@ -654,16 +658,16 @@ def emitDeclAux (d : Decl) : M Unit := do
if xs.size > closureMaxArgs && isBoxedName d.name then
emit "lean_object** _args"
else
xs.size.forM fun i => do
xs.size.forM fun i _ => do
if i > 0 then emit ", "
let x := xs[i]!
let x := xs[i]
emit (toCType x.ty); emit " "; emit x.x
emit ")"
else
emit ("_init_" ++ baseName ++ "()")
emitLn " {";
if xs.size > closureMaxArgs && isBoxedName d.name then
xs.size.forM fun i => do
xs.size.forM fun i _ => do
let x := xs[i]!
emit "lean_object* "; emit x.x; emit " = _args["; emit i; emitLn "];"
emitLn "_start:";

View File

@@ -571,9 +571,9 @@ def emitAllocCtor (builder : LLVM.Builder llvmctx)
def emitCtorSetArgs (builder : LLVM.Builder llvmctx)
(z : VarId) (ys : Array Arg) : M llvmctx Unit := do
ys.size.forM fun i => do
ys.size.forM fun i _ => do
let zv emitLhsVal builder z
let (_yty, yv) emitArgVal builder ys[i]!
let (_yty, yv) emitArgVal builder ys[i]
let iv constIntUnsigned i
callLeanCtorSet builder zv iv yv
emitLhsSlotStore builder z zv
@@ -702,8 +702,8 @@ def emitPartialApp (builder : LLVM.Builder llvmctx) (z : VarId) (f : FunId) (ys
( constIntUnsigned arity)
( constIntUnsigned ys.size)
LLVM.buildStore builder zval zslot
ys.size.forM fun i => do
let (yty, yslot) emitArgSlot_ builder ys[i]!
ys.size.forM fun i _ => do
let (yty, yslot) emitArgSlot_ builder ys[i]
let yval LLVM.buildLoad2 builder yty yslot
callLeanClosureSetFn builder zval ( constIntUnsigned i) yval
@@ -922,7 +922,7 @@ def emitReset (builder : LLVM.Builder llvmctx) (z : VarId) (n : Nat) (x : VarId)
buildIfThenElse_ builder "isExclusive" isExclusive
(fun builder => do
let xv emitLhsVal builder x
n.forM fun i => do
n.forM fun i _ => do
callLeanCtorRelease builder xv ( constIntUnsigned i)
emitLhsSlotStore builder z xv
return ShouldForwardControlFlow.yes
@@ -1172,8 +1172,8 @@ def emitFnArgs (builder : LLVM.Builder llvmctx)
(needsPackedArgs? : Bool) (llvmfn : LLVM.Value llvmctx) (params : Array Param) : M llvmctx Unit := do
if needsPackedArgs? then do
let argsp LLVM.getParam llvmfn 0 -- lean_object **args
for i in List.range params.size do
let param := params[i]!
for h : i in [:params.size] do
let param := params[i]
-- argsi := (args + i)
let argsi LLVM.buildGEP2 builder ( LLVM.voidPtrType llvmctx) argsp #[ constIntUnsigned i] s!"packed_arg_{i}_slot"
let llvmty toLLVMType param.ty
@@ -1182,15 +1182,16 @@ def emitFnArgs (builder : LLVM.Builder llvmctx)
-- slot for arg[i] which is always void* ?
let alloca buildPrologueAlloca builder llvmty s!"arg_{i}"
LLVM.buildStore builder pv alloca
addVartoState params[i]!.x alloca llvmty
addVartoState param.x alloca llvmty
else
let n LLVM.countParams llvmfn
for i in (List.range n.toNat) do
let llvmty toLLVMType params[i]!.ty
for i in [:n.toNat] do
let param := params[i]!
let llvmty toLLVMType param.ty
let alloca buildPrologueAlloca builder llvmty s!"arg_{i}"
let arg LLVM.getParam llvmfn (UInt64.ofNat i)
let _ LLVM.buildStore builder arg alloca
addVartoState params[i]!.x alloca llvmty
addVartoState param.x alloca llvmty
def emitDeclAux (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) (d : Decl) : M llvmctx Unit := do
let env getEnv

View File

@@ -54,7 +54,7 @@ abbrev Mask := Array (Option VarId)
partial def eraseProjIncForAux (y : VarId) (bs : Array FnBody) (mask : Mask) (keep : Array FnBody) : Array FnBody × Mask :=
let done (_ : Unit) := (bs ++ keep.reverse, mask)
let keepInstr (b : FnBody) := eraseProjIncForAux y bs.pop mask (keep.push b)
if bs.size < 2 then done ()
if h : bs.size < 2 then done ()
else
let b := bs.back!
match b with
@@ -62,7 +62,7 @@ partial def eraseProjIncForAux (y : VarId) (bs : Array FnBody) (mask : Mask) (ke
| .vdecl _ _ (.uproj _ _) _ => keepInstr b
| .inc z n c p _ =>
if n == 0 then done () else
let b' := bs[bs.size - 2]!
let b' := bs[bs.size - 2]
match b' with
| .vdecl w _ (.proj i x) _ =>
if w == z && y == x then
@@ -134,15 +134,15 @@ abbrev M := ReaderT Context (StateM Nat)
modifyGet fun n => ({ idx := n }, n + 1)
def releaseUnreadFields (y : VarId) (mask : Mask) (b : FnBody) : M FnBody :=
mask.size.foldM (init := b) fun i b =>
match mask.get! i with
mask.size.foldM (init := b) fun i _ b =>
match mask[i] with
| some _ => pure b -- code took ownership of this field
| none => do
let fld mkFresh
pure (FnBody.vdecl fld IRType.object (Expr.proj i y) (FnBody.dec fld 1 true false b))
def setFields (y : VarId) (zs : Array Arg) (b : FnBody) : FnBody :=
zs.size.fold (init := b) fun i b => FnBody.set y i (zs.get! i) b
zs.size.fold (init := b) fun i _ b => FnBody.set y i zs[i] b
/-- Given `set x[i] := y`, return true iff `y := proj[i] x` -/
def isSelfSet (ctx : Context) (x : VarId) (i : Nat) (y : Arg) : Bool :=

View File

@@ -79,13 +79,13 @@ private def addDecForAlt (ctx : Context) (caseLiveVars altLiveVars : LiveVarSet)
/-- `isFirstOcc xs x i = true` if `xs[i]` is the first occurrence of `xs[i]` in `xs` -/
private def isFirstOcc (xs : Array Arg) (i : Nat) : Bool :=
let x := xs[i]!
i.all fun j => xs[j]! != x
i.all fun j _ => xs[j]! != x
/-- Return true if `x` also occurs in `ys` in a position that is not consumed.
That is, it is also passed as a borrow reference. -/
private def isBorrowParamAux (x : VarId) (ys : Array Arg) (consumeParamPred : Nat Bool) : Bool :=
ys.size.any fun i =>
let y := ys[i]!
ys.size.any fun i _ =>
let y := ys[i]
match y with
| Arg.irrelevant => false
| Arg.var y => x == y && !consumeParamPred i
@@ -99,15 +99,15 @@ Return `n`, the number of times `x` is consumed.
- `consumeParamPred i = true` if parameter `i` is consumed.
-/
private def getNumConsumptions (x : VarId) (ys : Array Arg) (consumeParamPred : Nat Bool) : Nat :=
ys.size.fold (init := 0) fun i n =>
let y := ys[i]!
ys.size.fold (init := 0) fun i _ n =>
let y := ys[i]
match y with
| Arg.irrelevant => n
| Arg.var y => if x == y && consumeParamPred i then n+1 else n
private def addIncBeforeAux (ctx : Context) (xs : Array Arg) (consumeParamPred : Nat Bool) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
xs.size.fold (init := b) fun i b =>
let x := xs[i]!
xs.size.fold (init := b) fun i _ b =>
let x := xs[i]
match x with
| Arg.irrelevant => b
| Arg.var x =>
@@ -128,8 +128,8 @@ private def addIncBefore (ctx : Context) (xs : Array Arg) (ps : Array Param) (b
/-- See `addIncBeforeAux`/`addIncBefore` for the procedure that inserts `inc` operations before an application. -/
private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody :=
xs.size.fold (init := b) fun i b =>
match xs[i]! with
xs.size.fold (init := b) fun i _ b =>
match xs[i] with
| Arg.irrelevant => b
| Arg.var x =>
/- We must add a `dec` if `x` must be consumed, it is alive after the application,

View File

@@ -366,10 +366,10 @@ to be updated.
@[implemented_by updateFunDeclCoreImp] opaque FunDeclCore.updateCore (decl: FunDecl) (type : Expr) (params : Array Param) (value : Code) : FunDecl
def CasesCore.extractAlt! (cases : Cases) (ctorName : Name) : Alt × Cases :=
let found (i : Nat) := (cases.alts[i]!, { cases with alts := cases.alts.eraseIdx i })
if let some i := cases.alts.findIdx? fun | .alt ctorName' .. => ctorName == ctorName' | _ => false then
let found i := (cases.alts[i], { cases with alts := cases.alts.eraseIdx i })
if let some i := cases.alts.findFinIdx? fun | .alt ctorName' .. => ctorName == ctorName' | _ => false then
found i
else if let some i := cases.alts.findIdx? fun | .default _ => true | _ => false then
else if let some i := cases.alts.findFinIdx? fun | .default _ => true | _ => false then
found i
else
unreachable!

View File

@@ -587,15 +587,15 @@ def Decl.elimDeadBranches (decls : Array Decl) : CompilerM (Array Decl) := do
refer to the docstring of `Decl.safe`.
-/
if decls[i]!.safe then .bot else .top
let mut funVals := decls.size.fold (init := .empty) fun i p => p.push (initialVal i)
let mut funVals := decls.size.fold (init := .empty) fun i _ p => p.push (initialVal i)
let ctx := { decls }
let mut state := { assignments, funVals }
(_, state) inferMain |>.run ctx |>.run state
funVals := state.funVals
assignments := state.assignments
modifyEnv fun e =>
decls.size.fold (init := e) fun i env =>
addFunctionSummary env decls[i]!.name funVals[i]!
decls.size.fold (init := e) fun i _ env =>
addFunctionSummary env decls[i].name funVals[i]!
decls.mapIdxM fun i decl => if decl.safe then elimDead assignments[i]! decl else return decl

View File

@@ -76,8 +76,8 @@ def getType (fvarId : FVarId) : InferTypeM Expr := do
def mkForallFVars (xs : Array Expr) (type : Expr) : InferTypeM Expr :=
let b := type.abstract xs
xs.size.foldRevM (init := b) fun i b => do
let x := xs[i]!
xs.size.foldRevM (init := b) fun i _ b => do
let x := xs[i]
let n InferType.getBinderName x.fvarId!
let ty InferType.getType x.fvarId!
let ty := ty.abstractRange i xs;

View File

@@ -134,9 +134,9 @@ def withEachOccurrence (targetName : Name) (f : Nat → PassInstaller) : PassIns
def installAfter (targetName : Name) (p : Pass Pass) (occurrence : Nat := 0) : PassInstaller where
install passes :=
if let some idx := passes.findIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
let passUnderTest := passes[idx]!
return passes.insertAt! (idx + 1) (p passUnderTest)
if let some idx := passes.findFinIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
let passUnderTest := passes[idx]
return passes.insertIdx (idx + 1) (p passUnderTest)
else
throwError s!"Tried to insert pass after {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
@@ -145,9 +145,9 @@ def installAfterEach (targetName : Name) (p : Pass → Pass) : PassInstaller :=
def installBefore (targetName : Name) (p : Pass Pass) (occurrence : Nat := 0): PassInstaller where
install passes :=
if let some idx := passes.findIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
let passUnderTest := passes[idx]!
return passes.insertAt! idx (p passUnderTest)
if let some idx := passes.findFinIdx? (fun p => p.name == targetName && p.occurrence == occurrence) then
let passUnderTest := passes[idx]
return passes.insertIdx idx (p passUnderTest)
else
throwError s!"Tried to insert pass after {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
@@ -157,9 +157,7 @@ def installBeforeEachOccurrence (targetName : Name) (p : Pass → Pass) : PassIn
def replacePass (targetName : Name) (p : Pass Pass) (occurrence : Nat := 0) : PassInstaller where
install passes := do
let some idx := passes.findIdx? (fun p => p.name == targetName && p.occurrence == occurrence) | throwError s!"Tried to replace {targetName}, occurrence {occurrence} but {targetName} is not in the pass list"
let target := passes[idx]!
let replacement := p target
return passes.set! idx replacement
return passes.modify idx p
def replaceEachOccurrence (targetName : Name) (p : Pass Pass) : PassInstaller :=
withEachOccurrence targetName (replacePass targetName p ·)

View File

@@ -152,8 +152,8 @@ def saveSpecParamInfo (decls : Array Decl) : CompilerM Unit := do
let specArgs? := getSpecializationArgs? ( getEnv) decl.name
let contains (i : Nat) : Bool := specArgs?.getD #[] |>.contains i
let mut paramsInfo : Array SpecParamInfo := #[]
for i in [:decl.params.size] do
let param := decl.params[i]!
for h :i in [:decl.params.size] do
let param := decl.params[i]
let info
if contains i then
pure .user
@@ -181,14 +181,14 @@ def saveSpecParamInfo (decls : Array Decl) : CompilerM Unit := do
declsInfo := declsInfo.push paramsInfo
if declsInfo.any fun paramsInfo => paramsInfo.any (· matches .user | .fixedInst | .fixedHO) then
let m := mkFixedParamsMap decls
for i in [:decls.size] do
let decl := decls[i]!
for hi : i in [:decls.size] do
let decl := decls[i]
let mut paramsInfo := declsInfo[i]!
let some mask := m.find? decl.name | unreachable!
trace[Compiler.specialize.info] "{decl.name} {mask}"
paramsInfo := paramsInfo.zipWith mask fun info fixed => if fixed || info matches .user then info else .other
for j in [:paramsInfo.size] do
let mut info := paramsInfo[j]!
let mut info := paramsInfo[j]!
if info matches .fixedNeutral && !hasFwdDeps decl paramsInfo j then
paramsInfo := paramsInfo.set! j .other
if paramsInfo.any fun info => info matches .fixedInst | .fixedHO | .user then

View File

@@ -499,8 +499,8 @@ where
match app with
| .fvar f =>
let mut argsNew := #[]
for i in [arity : args.size] do
argsNew := argsNew.push ( visitAppArg args[i]!)
for h :i in [arity : args.size] do
argsNew := argsNew.push ( visitAppArg args[i])
letValueToArg <| .fvar f argsNew
| .erased | .type .. => return .erased

View File

@@ -26,13 +26,14 @@ private def elabSpecArgs (declName : Name) (args : Array Syntax) : MetaM (Array
if let some idx := arg.isNatLit? then
if idx == 0 then throwErrorAt arg "invalid specialization argument index, index must be greater than 0"
let idx := idx - 1
if idx >= argNames.size then
if h : idx >= argNames.size then
throwErrorAt arg "invalid argument index, `{declName}` has #{argNames.size} arguments"
if result.contains idx then throwErrorAt arg "invalid specialization argument index, `{argNames[idx]!}` has already been specified as a specialization candidate"
result := result.push idx
else
if result.contains idx then throwErrorAt arg "invalid specialization argument index, `{argNames[idx]}` has already been specified as a specialization candidate"
result := result.push idx
else
let argName := arg.getId
if let some idx := argNames.getIdx? argName then
if let some idx := argNames.indexOf? argName then
if result.contains idx then throwErrorAt arg "invalid specialization argument name `{argName}`, it has already been specified as a specialization candidate"
result := result.push idx
else

View File

@@ -11,6 +11,7 @@ import Lean.ResolveName
import Lean.Elab.InfoTree.Types
import Lean.MonadEnv
import Lean.Elab.Exception
import Lean.Language.Basic
namespace Lean
register_builtin_option diagnostics : Bool := {
@@ -30,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}"`.
@@ -72,6 +78,13 @@ structure State where
messages : MessageLog := {}
/-- Info tree. We have the info tree here because we want to update it while adding attributes. -/
infoState : Elab.InfoState := {}
/--
Snapshot trees of asynchronous subtasks. As these are untyped and reported only at the end of the
command's main elaboration thread, they are only useful for basic message log reporting; for
incremental reporting and reuse within a long-running elaboration thread, types rooted in
`CommandParsedSnapshot` need to be adjusted.
-/
snapshotTasks : Array (Language.SnapshotTask Language.SnapshotTree) := #[]
deriving Nonempty
/-- Context for the CoreM monad. -/
@@ -180,7 +193,8 @@ instance : Elab.MonadInfoTree CoreM where
modifyInfoState f := modify fun s => { s with infoState := f s.infoState }
@[inline] def modifyCache (f : Cache Cache) : CoreM Unit :=
modify fun env, next, ngen, trace, cache, messages, infoState => env, next, ngen, trace, f cache, messages, infoState
modify fun env, next, ngen, trace, cache, messages, infoState, snaps =>
env, next, ngen, trace, f cache, messages, infoState, snaps
@[inline] def modifyInstLevelTypeCache (f : InstantiateLevelCache InstantiateLevelCache) : CoreM Unit :=
modifyCache fun c₁, c₂ => f c₁, c₂
@@ -355,13 +369,83 @@ instance : MonadLog CoreM where
if ( read).suppressElabErrors then
-- discard elaboration errors, except for a few important and unlikely misleading ones, on
-- parse error
unless msg.data.hasTag (· matches `Elab.synthPlaceholder | `Tactic.unsolvedGoals) do
unless msg.data.hasTag (· matches `Elab.synthPlaceholder | `Tactic.unsolvedGoals | `trace) do
return
let ctx read
let msg := { msg with data := MessageData.withNamingContext { currNamespace := ctx.currNamespace, openDecls := ctx.openDecls } msg.data };
modify fun s => { s with messages := s.messages.add msg }
/--
Includes a given task (such as from `wrapAsyncAsSnapshot`) in the overall snapshot tree for this
command's elaboration, making its result available to reporting and the language server. The
reporter will not know about this snapshot tree node until the main elaboration thread for this
command has finished so this function is not useful for incremental reporting within a longer
elaboration thread but only for tasks that outlive it such as background kernel checking or proof
elaboration.
-/
def logSnapshotTask (task : Language.SnapshotTask Language.SnapshotTree) : CoreM Unit :=
modify fun s => { s with snapshotTasks := s.snapshotTasks.push task }
/-- Wraps the given action for use in `EIO.asTask` etc., discarding its final monadic state. -/
def wrapAsync (act : Unit CoreM α) : CoreM (EIO Exception α) := do
let st get
let ctx read
let heartbeats := ( IO.getNumHeartbeats) - ctx.initHeartbeats
return withCurrHeartbeats (do
-- include heartbeats since start of elaboration in new thread as well such that forking off
-- an action doesn't suddenly allow it to succeed from a lower heartbeat count
IO.addHeartbeats heartbeats.toUInt64
act () : CoreM _)
|>.run' ctx st
/-- Option for capturing output to stderr during elaboration. -/
register_builtin_option stderrAsMessages : Bool := {
defValue := true
group := "server"
descr := "(server) capture output to the Lean stderr channel (such as from `dbg_trace`) during elaboration of a command as a diagnostic message"
}
open Language in
/--
Wraps the given action for use in `BaseIO.asTask` etc., discarding its final state except for
`logSnapshotTask` tasks, which are reported as part of the returned tree.
-/
def wrapAsyncAsSnapshot (act : Unit CoreM Unit) (desc : String := by exact decl_name%.toString) :
CoreM (BaseIO SnapshotTree) := do
let t wrapAsync fun _ => do
IO.FS.withIsolatedStreams (isolateStderr := stderrAsMessages.get ( getOptions)) do
let tid IO.getTID
-- reset trace state and message log so as not to report them twice
modify ({ · with messages := {}, traceState := { tid } })
try
withTraceNode `Elab.async (fun _ => return desc) do
act ()
catch e =>
logError e.toMessageData
finally
addTraceAsMessages
get
let ctx readThe Core.Context
return do
match ( t.toBaseIO) with
| .ok (output, st) =>
let mut msgs := st.messages
if !output.isEmpty then
msgs := msgs.add {
fileName := ctx.fileName
severity := MessageSeverity.information
pos := ctx.fileMap.toPosition <| ctx.ref.getPos?.getD 0
data := output
}
return .mk {
desc
diagnostics := ( Language.Snapshot.Diagnostics.ofMessageLog msgs)
traces := st.traceState
} st.snapshotTasks
-- interrupt or abort exception as `try catch` above should have caught any others
| .error _ => default
end Core
export Core (CoreM mkFreshUserName checkSystem withCurrHeartbeats)

View File

@@ -29,4 +29,4 @@ import Lean.Data.Xml
import Lean.Data.NameTrie
import Lean.Data.RBTree
import Lean.Data.RBMap
import Lean.Data.Rat
import Lean.Data.RArray

View File

@@ -277,4 +277,23 @@ attribute [deprecated Std.HashMap.empty (since := "2024-08-08")] mkHashMap
attribute [deprecated Std.HashMap.empty (since := "2024-08-08")] HashMap.empty
attribute [deprecated Std.HashMap.ofList (since := "2024-08-08")] HashMap.ofList
attribute [deprecated Std.HashMap.insert (since := "2024-08-08")] HashMap.insert
attribute [deprecated Std.HashMap.containsThenInsert (since := "2024-08-08")] HashMap.insert'
attribute [deprecated Std.HashMap.insertIfNew (since := "2024-08-08")] HashMap.insertIfNew
attribute [deprecated Std.HashMap.erase (since := "2024-08-08")] HashMap.erase
attribute [deprecated "Use `m[k]?` instead." (since := "2024-08-08")] HashMap.findEntry?
attribute [deprecated "Use `m[k]?` instead." (since := "2024-08-08")] HashMap.find?
attribute [deprecated "Use `m[k]?.getD` instead." (since := "2024-08-08")] HashMap.findD
attribute [deprecated "Use `m[k]!` instead." (since := "2024-08-08")] HashMap.find!
attribute [deprecated Std.HashMap.contains (since := "2024-08-08")] HashMap.contains
attribute [deprecated Std.HashMap.foldM (since := "2024-08-08")] HashMap.foldM
attribute [deprecated Std.HashMap.fold (since := "2024-08-08")] HashMap.fold
attribute [deprecated Std.HashMap.forM (since := "2024-08-08")] HashMap.forM
attribute [deprecated Std.HashMap.size (since := "2024-08-08")] HashMap.size
attribute [deprecated Std.HashMap.isEmpty (since := "2024-08-08")] HashMap.isEmpty
attribute [deprecated Std.HashMap.toList (since := "2024-08-08")] HashMap.toList
attribute [deprecated Std.HashMap.toArray (since := "2024-08-08")] HashMap.toArray
attribute [deprecated "Deprecateed without a replacement." (since := "2024-08-08")] HashMap.numBuckets
attribute [deprecated "Deprecateed without a replacement." (since := "2024-08-08")] HashMap.ofListWith
end Lean.HashMap

View File

@@ -365,6 +365,7 @@ structure TextDocumentRegistrationOptions where
inductive MarkupKind where
| plaintext | markdown
deriving DecidableEq, Hashable
instance : FromJson MarkupKind := fun
| str "plaintext" => Except.ok MarkupKind.plaintext
@@ -378,7 +379,7 @@ instance : ToJson MarkupKind := ⟨fun
structure MarkupContent where
kind : MarkupKind
value : String
deriving ToJson, FromJson
deriving ToJson, FromJson, DecidableEq, Hashable
/-- Reference to the progress of some in-flight piece of work.

View File

@@ -25,7 +25,7 @@ inductive CompletionItemKind where
| unit | value | enum | keyword | snippet
| color | file | reference | folder | enumMember
| constant | struct | event | operator | typeParameter
deriving Inhabited, DecidableEq, Repr
deriving Inhabited, DecidableEq, Repr, Hashable
instance : ToJson CompletionItemKind where
toJson a := toJson (a.toCtorIdx + 1)
@@ -39,11 +39,11 @@ structure InsertReplaceEdit where
newText : String
insert : Range
replace : Range
deriving FromJson, ToJson
deriving FromJson, ToJson, BEq, Hashable
inductive CompletionItemTag where
| deprecated
deriving Inhabited, DecidableEq, Repr
deriving Inhabited, DecidableEq, Repr, Hashable
instance : ToJson CompletionItemTag where
toJson t := toJson (t.toCtorIdx + 1)
@@ -73,7 +73,7 @@ structure CompletionItem where
commitCharacters? : string[]
command? : Command
-/
deriving FromJson, ToJson, Inhabited
deriving FromJson, ToJson, Inhabited, BEq, Hashable
structure CompletionList where
isIncomplete : Bool

View File

@@ -33,6 +33,16 @@ def find? (m : NameMap α) (n : Name) : Option α := RBMap.find? m n
instance : ForIn m (NameMap α) (Name × α) :=
inferInstanceAs (ForIn _ (RBMap ..) ..)
/-- `filter f m` returns the `NameMap` consisting of all
"`key`/`val`"-pairs in `m` where `f key val` returns `true`. -/
def filter (f : Name α Bool) (m : NameMap α) : NameMap α := RBMap.filter f m
/-- `filterMap f m` filters an `NameMap` and simultaneously modifies the filtered values.
It takes a function `f : Name → α → Option β` and applies `f name` to the value with key `name`.
The resulting entries with non-`none` value are collected to form the output `NameMap`. -/
def filterMap (f : Name α Option β) (m : NameMap α) : NameMap β := RBMap.filterMap f m
end NameMap
def NameSet := RBTree Name Name.quickCmp
@@ -53,6 +63,9 @@ def append (s t : NameSet) : NameSet :=
instance : Append NameSet where
append := NameSet.append
/-- `filter f s` returns the `NameSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name Bool) (s : NameSet) : NameSet := RBTree.filter f s
end NameSet
def NameSSet := SSet Name
@@ -73,6 +86,9 @@ instance : EmptyCollection NameHashSet := ⟨empty⟩
instance : Inhabited NameHashSet := {}
def insert (s : NameHashSet) (n : Name) := Std.HashSet.insert s n
def contains (s : NameHashSet) (n : Name) : Bool := Std.HashSet.contains s n
/-- `filter f s` returns the `NameHashSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name Bool) (s : NameHashSet) : NameHashSet := Std.HashSet.filter f s
end NameHashSet
def MacroScopesView.isPrefixOf (v₁ v₂ : MacroScopesView) : Bool :=

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