mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-29 00:04:11 +00:00
Compare commits
37 Commits
foldM_push
...
array_eras
| Author | SHA1 | Date | |
|---|---|---|---|
|
836a5843d4 | ||
|
|
0e3f26e6df | ||
|
|
1148e6e142 | ||
|
|
02baaa42ff | ||
|
|
e573676db1 | ||
|
|
4dab6a108c | ||
|
|
a4d521cf96 | ||
|
|
99070bf304 | ||
|
|
93dd6f2b36 | ||
|
|
c61ced3f15 | ||
|
|
c779f3a039 | ||
|
|
fc17468f78 | ||
|
|
8b7e3b8942 | ||
|
|
9129990833 | ||
|
|
1659f3bfe2 | ||
|
|
87d3f1f2c8 | ||
|
|
b75cc35db2 | ||
|
|
3952689fb1 | ||
|
|
cd24e9dad4 | ||
|
|
0de925eafc | ||
|
|
79428827b8 | ||
|
|
3c15ab3c09 | ||
|
|
3f33cd6fcd | ||
|
|
1f8d7561fa | ||
|
|
16e5e09ffd | ||
|
|
5549e0509f | ||
|
|
c7f5fd9a83 | ||
|
|
a4057d373e | ||
|
|
fd08c92060 | ||
|
|
be6507fe5b | ||
|
|
c723ae7f97 | ||
|
|
0973ba3e42 | ||
|
|
a75a03c077 | ||
|
|
6922832327 | ||
|
|
f1707117f0 | ||
|
|
3b80d1eb1f | ||
|
|
7730ddd1a0 |
4
.github/workflows/ci.yml
vendored
4
.github/workflows/ci.yml
vendored
@@ -217,7 +217,7 @@ jobs:
|
||||
"release": true,
|
||||
"check-level": 2,
|
||||
"shell": "msys2 {0}",
|
||||
"CMAKE_OPTIONS": "-G \"Unix Makefiles\" -DUSE_GMP=OFF",
|
||||
"CMAKE_OPTIONS": "-G \"Unix Makefiles\"",
|
||||
// for reasons unknown, interactivetests are flaky on Windows
|
||||
"CTEST_OPTIONS": "--repeat until-pass:2",
|
||||
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-w64-windows-gnu.tar.zst",
|
||||
@@ -227,7 +227,7 @@ jobs:
|
||||
{
|
||||
"name": "Linux aarch64",
|
||||
"os": "nscloud-ubuntu-22.04-arm64-4x8",
|
||||
"CMAKE_OPTIONS": "-DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-linux_aarch64",
|
||||
"CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-linux_aarch64",
|
||||
"release": true,
|
||||
"check-level": 2,
|
||||
"shell": "nix develop .#oldGlibcAArch -c bash -euxo pipefail {0}",
|
||||
|
||||
323
RELEASES.md
323
RELEASES.md
@@ -8,6 +8,329 @@ This file contains work-in-progress notes for the upcoming release, as well as p
|
||||
Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
|
||||
of each version.
|
||||
|
||||
v4.15.0
|
||||
----------
|
||||
|
||||
Development in progress.
|
||||
|
||||
v4.14.0
|
||||
----------
|
||||
|
||||
Release candidate, release notes will be copied from the branch `releases/v4.14.0` once completed.
|
||||
|
||||
v4.13.0
|
||||
----------
|
||||
|
||||
**Full Changelog**: https://github.com/leanprover/lean4/compare/v4.12.0...v4.13.0
|
||||
|
||||
### Language features, tactics, and metaprograms
|
||||
|
||||
* `structure` command
|
||||
* [#5511](https://github.com/leanprover/lean4/pull/5511) allows structure parents to be type synonyms.
|
||||
* [#5531](https://github.com/leanprover/lean4/pull/5531) allows default values for structure fields to be noncomputable.
|
||||
|
||||
* `rfl` and `apply_rfl` tactics
|
||||
* [#3714](https://github.com/leanprover/lean4/pull/3714), [#3718](https://github.com/leanprover/lean4/pull/3718) improve the `rfl` tactic and give better error messages.
|
||||
* [#3772](https://github.com/leanprover/lean4/pull/3772) makes `rfl` no longer use kernel defeq for ground terms.
|
||||
* [#5329](https://github.com/leanprover/lean4/pull/5329) tags `Iff.refl` with `@[refl]` (@Parcly-Taxel)
|
||||
* [#5359](https://github.com/leanprover/lean4/pull/5359) ensures that the `rfl` tactic tries `Iff.rfl` (@Parcly-Taxel)
|
||||
|
||||
* `unfold` tactic
|
||||
* [#4834](https://github.com/leanprover/lean4/pull/4834) let `unfold` do zeta-delta reduction of local definitions, incorporating functionality of the Mathlib `unfold_let` tactic.
|
||||
|
||||
* `omega` tactic
|
||||
* [#5382](https://github.com/leanprover/lean4/pull/5382) fixes spurious error in [#5315](https://github.com/leanprover/lean4/issues/5315)
|
||||
* [#5523](https://github.com/leanprover/lean4/pull/5523) supports `Int.toNat`
|
||||
|
||||
* `simp` tactic
|
||||
* [#5479](https://github.com/leanprover/lean4/pull/5479) lets `simp` apply rules with higher-order patterns.
|
||||
|
||||
* `induction` tactic
|
||||
* [#5494](https://github.com/leanprover/lean4/pull/5494) fixes `induction`’s "pre-tactic" block to always be indented, avoiding unintended uses of it.
|
||||
|
||||
* `ac_nf` tactic
|
||||
* [#5524](https://github.com/leanprover/lean4/pull/5524) adds `ac_nf`, a counterpart to `ac_rfl`, for normalizing expressions with respect to associativity and commutativity. Tests it with `BitVec` expressions.
|
||||
|
||||
* `bv_decide`
|
||||
* [#5211](https://github.com/leanprover/lean4/pull/5211) makes `extractLsb'` the primitive `bv_decide` understands, rather than `extractLsb` (@alexkeizer)
|
||||
* [#5365](https://github.com/leanprover/lean4/pull/5365) adds `bv_decide` diagnoses.
|
||||
* [#5375](https://github.com/leanprover/lean4/pull/5375) adds `bv_decide` normalization rules for `ofBool (a.getLsbD i)` and `ofBool a[i]` (@alexkeizer)
|
||||
* [#5423](https://github.com/leanprover/lean4/pull/5423) enhances the rewriting rules of `bv_decide`
|
||||
* [#5433](https://github.com/leanprover/lean4/pull/5433) presents the `bv_decide` counterexample at the API
|
||||
* [#5484](https://github.com/leanprover/lean4/pull/5484) handles `BitVec.ofNat` with `Nat` fvars in `bv_decide`
|
||||
* [#5506](https://github.com/leanprover/lean4/pull/5506), [#5507](https://github.com/leanprover/lean4/pull/5507) add `bv_normalize` rules.
|
||||
* [#5568](https://github.com/leanprover/lean4/pull/5568) generalize the `bv_normalize` pipeline to support more general preprocessing passes
|
||||
* [#5573](https://github.com/leanprover/lean4/pull/5573) gets `bv_normalize` up-to-date with the current `BitVec` rewrites
|
||||
* Cleanups: [#5408](https://github.com/leanprover/lean4/pull/5408), [#5493](https://github.com/leanprover/lean4/pull/5493), [#5578](https://github.com/leanprover/lean4/pull/5578)
|
||||
|
||||
|
||||
* Elaboration improvements
|
||||
* [#5266](https://github.com/leanprover/lean4/pull/5266) preserve order of overapplied arguments in `elab_as_elim` procedure.
|
||||
* [#5510](https://github.com/leanprover/lean4/pull/5510) generalizes `elab_as_elim` to allow arbitrary motive applications.
|
||||
* [#5283](https://github.com/leanprover/lean4/pull/5283), [#5512](https://github.com/leanprover/lean4/pull/5512) refine how named arguments suppress explicit arguments. Breaking change: some previously omitted explicit arguments may need explicit `_` arguments now.
|
||||
* [#5376](https://github.com/leanprover/lean4/pull/5376) modifies projection instance binder info for instances, making parameters that are instance implicit in the type be implicit.
|
||||
* [#5402](https://github.com/leanprover/lean4/pull/5402) localizes universe metavariable errors to `let` bindings and `fun` binders if possible. Makes "cannot synthesize metavariable" errors take precedence over unsolved universe level errors.
|
||||
* [#5419](https://github.com/leanprover/lean4/pull/5419) must not reduce `ite` in the discriminant of `match`-expression when reducibility setting is `.reducible`
|
||||
* [#5474](https://github.com/leanprover/lean4/pull/5474) have autoparams report parameter/field on failure
|
||||
* [#5530](https://github.com/leanprover/lean4/pull/5530) makes automatic instance names about types with hygienic names be hygienic.
|
||||
|
||||
* Deriving handlers
|
||||
* [#5432](https://github.com/leanprover/lean4/pull/5432) makes `Repr` deriving instance handle explicit type parameters
|
||||
|
||||
* Functional induction
|
||||
* [#5364](https://github.com/leanprover/lean4/pull/5364) adds more equalities in context, more careful cleanup.
|
||||
|
||||
* Linters
|
||||
* [#5335](https://github.com/leanprover/lean4/pull/5335) fixes the unused variables linter complaining about match/tactic combinations
|
||||
* [#5337](https://github.com/leanprover/lean4/pull/5337) fixes the unused variables linter complaining about some wildcard patterns
|
||||
|
||||
* Other fixes
|
||||
* [#4768](https://github.com/leanprover/lean4/pull/4768) fixes a parse error when `..` appears with a `.` on the next line
|
||||
|
||||
* Metaprogramming
|
||||
* [#3090](https://github.com/leanprover/lean4/pull/3090) handles level parameters in `Meta.evalExpr` (@eric-wieser)
|
||||
* [#5401](https://github.com/leanprover/lean4/pull/5401) instance for `Inhabited (TacticM α)` (@alexkeizer)
|
||||
* [#5412](https://github.com/leanprover/lean4/pull/5412) expose Kernel.check for debugging purposes
|
||||
* [#5556](https://github.com/leanprover/lean4/pull/5556) improves the "invalid projection" type inference error in `inferType`.
|
||||
* [#5587](https://github.com/leanprover/lean4/pull/5587) allows `MVarId.assertHypotheses` to set `BinderInfo` and `LocalDeclKind`.
|
||||
* [#5588](https://github.com/leanprover/lean4/pull/5588) adds `MVarId.tryClearMany'`, a variant of `MVarId.tryClearMany`.
|
||||
|
||||
|
||||
|
||||
### Language server, widgets, and IDE extensions
|
||||
|
||||
* [#5205](https://github.com/leanprover/lean4/pull/5205) decreases the latency of auto-completion in tactic blocks.
|
||||
* [#5237](https://github.com/leanprover/lean4/pull/5237) fixes symbol occurrence highlighting in VS Code not highlighting occurrences when moving the text cursor into the identifier from the right.
|
||||
* [#5257](https://github.com/leanprover/lean4/pull/5257) fixes several instances of incorrect auto-completions being reported.
|
||||
* [#5299](https://github.com/leanprover/lean4/pull/5299) allows auto-completion to report completions for global identifiers when the elaborator fails to provide context-specific auto-completions.
|
||||
* [#5312](https://github.com/leanprover/lean4/pull/5312) fixes the server breaking when changing whitespace after the module header.
|
||||
* [#5322](https://github.com/leanprover/lean4/pull/5322) fixes several instances of auto-completion reporting non-existent namespaces.
|
||||
* [#5428](https://github.com/leanprover/lean4/pull/5428) makes sure to always report some recent file range as progress when waiting for elaboration.
|
||||
|
||||
|
||||
### Pretty printing
|
||||
|
||||
* [#4979](https://github.com/leanprover/lean4/pull/4979) make pretty printer escape identifiers that are tokens.
|
||||
* [#5389](https://github.com/leanprover/lean4/pull/5389) makes formatter use the current token table.
|
||||
* [#5513](https://github.com/leanprover/lean4/pull/5513) use breakable instead of unbreakable whitespace when formatting tokens.
|
||||
|
||||
|
||||
### Library
|
||||
|
||||
* [#5222](https://github.com/leanprover/lean4/pull/5222) reduces allocations in `Json.compress`.
|
||||
* [#5231](https://github.com/leanprover/lean4/pull/5231) upstreams `Zero` and `NeZero`
|
||||
* [#5292](https://github.com/leanprover/lean4/pull/5292) refactors `Lean.Elab.Deriving.FromToJson` (@arthur-adjedj)
|
||||
* [#5415](https://github.com/leanprover/lean4/pull/5415) implements `Repr Empty` (@TomasPuverle)
|
||||
* [#5421](https://github.com/leanprover/lean4/pull/5421) implements `To/FromJSON Empty` (@TomasPuverle)
|
||||
|
||||
* Logic
|
||||
* [#5263](https://github.com/leanprover/lean4/pull/5263) allows simplifying `dite_not`/`decide_not` with only `Decidable (¬p)`.
|
||||
* [#5268](https://github.com/leanprover/lean4/pull/5268) fixes binders on `ite_eq_left_iff`
|
||||
* [#5284](https://github.com/leanprover/lean4/pull/5284) turns off `Inhabited (Sum α β)` instances
|
||||
* [#5355](https://github.com/leanprover/lean4/pull/5355) adds simp lemmas for `LawfulBEq`
|
||||
* [#5374](https://github.com/leanprover/lean4/pull/5374) add `Nonempty` instances for products, allowing more `partial` functions to elaborate successfully
|
||||
* [#5447](https://github.com/leanprover/lean4/pull/5447) updates Pi instance names
|
||||
* [#5454](https://github.com/leanprover/lean4/pull/5454) makes some instance arguments implicit
|
||||
* [#5456](https://github.com/leanprover/lean4/pull/5456) adds `heq_comm`
|
||||
* [#5529](https://github.com/leanprover/lean4/pull/5529) moves `@[simp]` from `exists_prop'` to `exists_prop`
|
||||
|
||||
* `Bool`
|
||||
* [#5228](https://github.com/leanprover/lean4/pull/5228) fills gaps in Bool lemmas
|
||||
* [#5332](https://github.com/leanprover/lean4/pull/5332) adds notation `^^` for Bool.xor
|
||||
* [#5351](https://github.com/leanprover/lean4/pull/5351) removes `_root_.and` (and or/not/xor) and instead exports/uses `Bool.and` (etc.).
|
||||
|
||||
* `BitVec`
|
||||
* [#5240](https://github.com/leanprover/lean4/pull/5240) removes BitVec simps with complicated RHS
|
||||
* [#5247](https://github.com/leanprover/lean4/pull/5247) `BitVec.getElem_zeroExtend`
|
||||
* [#5248](https://github.com/leanprover/lean4/pull/5248) simp lemmas for BitVec, improving confluence
|
||||
* [#5249](https://github.com/leanprover/lean4/pull/5249) removes `@[simp]` from some BitVec lemmas
|
||||
* [#5252](https://github.com/leanprover/lean4/pull/5252) changes `BitVec.intMin/Max` from abbrev to def
|
||||
* [#5278](https://github.com/leanprover/lean4/pull/5278) adds `BitVec.getElem_truncate` (@tobiasgrosser)
|
||||
* [#5281](https://github.com/leanprover/lean4/pull/5281) adds udiv/umod bitblasting for `bv_decide` (@bollu)
|
||||
* [#5297](https://github.com/leanprover/lean4/pull/5297) `BitVec` unsigned order theoretic results
|
||||
* [#5313](https://github.com/leanprover/lean4/pull/5313) adds more basic BitVec ordering theory for UInt
|
||||
* [#5314](https://github.com/leanprover/lean4/pull/5314) adds `toNat_sub_of_le` (@bollu)
|
||||
* [#5357](https://github.com/leanprover/lean4/pull/5357) adds `BitVec.truncate` lemmas
|
||||
* [#5358](https://github.com/leanprover/lean4/pull/5358) introduces `BitVec.setWidth` to unify zeroExtend and truncate (@tobiasgrosser)
|
||||
* [#5361](https://github.com/leanprover/lean4/pull/5361) some BitVec GetElem lemmas
|
||||
* [#5385](https://github.com/leanprover/lean4/pull/5385) adds `BitVec.ofBool_[and|or|xor]_ofBool` theorems (@tobiasgrosser)
|
||||
* [#5404](https://github.com/leanprover/lean4/pull/5404) more of `BitVec.getElem_*` (@tobiasgrosser)
|
||||
* [#5410](https://github.com/leanprover/lean4/pull/5410) BitVec analogues of `Nat.{mul_two, two_mul, mul_succ, succ_mul}` (@bollu)
|
||||
* [#5411](https://github.com/leanprover/lean4/pull/5411) `BitVec.toNat_{add,sub,mul_of_lt}` for BitVector non-overflow reasoning (@bollu)
|
||||
* [#5413](https://github.com/leanprover/lean4/pull/5413) adds `_self`, `_zero`, and `_allOnes` for `BitVec.[and|or|xor]` (@tobiasgrosser)
|
||||
* [#5416](https://github.com/leanprover/lean4/pull/5416) adds LawCommIdentity + IdempotentOp for `BitVec.[and|or|xor]` (@tobiasgrosser)
|
||||
* [#5418](https://github.com/leanprover/lean4/pull/5418) decidable quantifers for BitVec
|
||||
* [#5450](https://github.com/leanprover/lean4/pull/5450) adds `BitVec.toInt_[intMin|neg|neg_of_ne_intMin]` (@tobiasgrosser)
|
||||
* [#5459](https://github.com/leanprover/lean4/pull/5459) missing BitVec lemmas
|
||||
* [#5469](https://github.com/leanprover/lean4/pull/5469) adds `BitVec.[not_not, allOnes_shiftLeft_or_shiftLeft, allOnes_shiftLeft_and_shiftLeft]` (@luisacicolini)
|
||||
* [#5478](https://github.com/leanprover/lean4/pull/5478) adds `BitVec.(shiftLeft_add_distrib, shiftLeft_ushiftRight)` (@luisacicolini)
|
||||
* [#5487](https://github.com/leanprover/lean4/pull/5487) adds `sdiv_eq`, `smod_eq` to allow `sdiv`/`smod` bitblasting (@bollu)
|
||||
* [#5491](https://github.com/leanprover/lean4/pull/5491) adds `BitVec.toNat_[abs|sdiv|smod]` (@tobiasgrosser)
|
||||
* [#5492](https://github.com/leanprover/lean4/pull/5492) `BitVec.(not_sshiftRight, not_sshiftRight_not, getMsb_not, msb_not)` (@luisacicolini)
|
||||
* [#5499](https://github.com/leanprover/lean4/pull/5499) `BitVec.Lemmas` - drop non-terminal simps (@tobiasgrosser)
|
||||
* [#5505](https://github.com/leanprover/lean4/pull/5505) unsimps `BitVec.divRec_succ'`
|
||||
* [#5508](https://github.com/leanprover/lean4/pull/5508) adds `BitVec.getElem_[add|add_add_bool|mul|rotateLeft|rotateRight…` (@tobiasgrosser)
|
||||
* [#5554](https://github.com/leanprover/lean4/pull/5554) adds `Bitvec.[add, sub, mul]_eq_xor` and `width_one_cases` (@luisacicolini)
|
||||
|
||||
* `List`
|
||||
* [#5242](https://github.com/leanprover/lean4/pull/5242) improve naming for `List.mergeSort` lemmas
|
||||
* [#5302](https://github.com/leanprover/lean4/pull/5302) provide `mergeSort` comparator autoParam
|
||||
* [#5373](https://github.com/leanprover/lean4/pull/5373) fix name of `List.length_mergeSort`
|
||||
* [#5377](https://github.com/leanprover/lean4/pull/5377) upstream `map_mergeSort`
|
||||
* [#5378](https://github.com/leanprover/lean4/pull/5378) modify signature of lemmas about `mergeSort`
|
||||
* [#5245](https://github.com/leanprover/lean4/pull/5245) avoid importing `List.Basic` without List.Impl
|
||||
* [#5260](https://github.com/leanprover/lean4/pull/5260) review of List API
|
||||
* [#5264](https://github.com/leanprover/lean4/pull/5264) review of List API
|
||||
* [#5269](https://github.com/leanprover/lean4/pull/5269) remove HashMap's duplicated Pairwise and Sublist
|
||||
* [#5271](https://github.com/leanprover/lean4/pull/5271) remove @[simp] from `List.head_mem` and similar
|
||||
* [#5273](https://github.com/leanprover/lean4/pull/5273) lemmas about `List.attach`
|
||||
* [#5275](https://github.com/leanprover/lean4/pull/5275) reverse direction of `List.tail_map`
|
||||
* [#5277](https://github.com/leanprover/lean4/pull/5277) more `List.attach` lemmas
|
||||
* [#5285](https://github.com/leanprover/lean4/pull/5285) `List.count` lemmas
|
||||
* [#5287](https://github.com/leanprover/lean4/pull/5287) use boolean predicates in `List.filter`
|
||||
* [#5289](https://github.com/leanprover/lean4/pull/5289) `List.mem_ite_nil_left` and analogues
|
||||
* [#5293](https://github.com/leanprover/lean4/pull/5293) cleanup of `List.findIdx` / `List.take` lemmas
|
||||
* [#5294](https://github.com/leanprover/lean4/pull/5294) switch primes on `List.getElem_take`
|
||||
* [#5300](https://github.com/leanprover/lean4/pull/5300) more `List.findIdx` theorems
|
||||
* [#5310](https://github.com/leanprover/lean4/pull/5310) fix `List.all/any` lemmas
|
||||
* [#5311](https://github.com/leanprover/lean4/pull/5311) fix `List.countP` lemmas
|
||||
* [#5316](https://github.com/leanprover/lean4/pull/5316) `List.tail` lemma
|
||||
* [#5331](https://github.com/leanprover/lean4/pull/5331) fix implicitness of `List.getElem_mem`
|
||||
* [#5350](https://github.com/leanprover/lean4/pull/5350) `List.replicate` lemmas
|
||||
* [#5352](https://github.com/leanprover/lean4/pull/5352) `List.attachWith` lemmas
|
||||
* [#5353](https://github.com/leanprover/lean4/pull/5353) `List.head_mem_head?`
|
||||
* [#5360](https://github.com/leanprover/lean4/pull/5360) lemmas about `List.tail`
|
||||
* [#5391](https://github.com/leanprover/lean4/pull/5391) review of `List.erase` / `List.find` lemmas
|
||||
* [#5392](https://github.com/leanprover/lean4/pull/5392) `List.fold` / `attach` lemmas
|
||||
* [#5393](https://github.com/leanprover/lean4/pull/5393) `List.fold` relators
|
||||
* [#5394](https://github.com/leanprover/lean4/pull/5394) lemmas about `List.maximum?`
|
||||
* [#5403](https://github.com/leanprover/lean4/pull/5403) theorems about `List.toArray`
|
||||
* [#5405](https://github.com/leanprover/lean4/pull/5405) reverse direction of `List.set_map`
|
||||
* [#5448](https://github.com/leanprover/lean4/pull/5448) add lemmas about `List.IsPrefix` (@Command-Master)
|
||||
* [#5460](https://github.com/leanprover/lean4/pull/5460) missing `List.set_replicate_self`
|
||||
* [#5518](https://github.com/leanprover/lean4/pull/5518) rename `List.maximum?` to `max?`
|
||||
* [#5519](https://github.com/leanprover/lean4/pull/5519) upstream `List.fold` lemmas
|
||||
* [#5520](https://github.com/leanprover/lean4/pull/5520) restore `@[simp]` on `List.getElem_mem` etc.
|
||||
* [#5521](https://github.com/leanprover/lean4/pull/5521) List simp fixes
|
||||
* [#5550](https://github.com/leanprover/lean4/pull/5550) `List.unattach` and simp lemmas
|
||||
* [#5594](https://github.com/leanprover/lean4/pull/5594) induction-friendly `List.min?_cons`
|
||||
|
||||
* `Array`
|
||||
* [#5246](https://github.com/leanprover/lean4/pull/5246) cleanup imports of Array.Lemmas
|
||||
* [#5255](https://github.com/leanprover/lean4/pull/5255) split Init.Data.Array.Lemmas for better bootstrapping
|
||||
* [#5288](https://github.com/leanprover/lean4/pull/5288) rename `Array.data` to `Array.toList`
|
||||
* [#5303](https://github.com/leanprover/lean4/pull/5303) cleanup of `List.getElem_append` variants
|
||||
* [#5304](https://github.com/leanprover/lean4/pull/5304) `Array.not_mem_empty`
|
||||
* [#5400](https://github.com/leanprover/lean4/pull/5400) reorganization in Array/Basic
|
||||
* [#5420](https://github.com/leanprover/lean4/pull/5420) make `Array` functions either semireducible or use structural recursion
|
||||
* [#5422](https://github.com/leanprover/lean4/pull/5422) refactor `DecidableEq (Array α)`
|
||||
* [#5452](https://github.com/leanprover/lean4/pull/5452) refactor of Array
|
||||
* [#5458](https://github.com/leanprover/lean4/pull/5458) cleanup of Array docstrings after refactor
|
||||
* [#5461](https://github.com/leanprover/lean4/pull/5461) restore `@[simp]` on `Array.swapAt!_def`
|
||||
* [#5465](https://github.com/leanprover/lean4/pull/5465) improve Array GetElem lemmas
|
||||
* [#5466](https://github.com/leanprover/lean4/pull/5466) `Array.foldX` lemmas
|
||||
* [#5472](https://github.com/leanprover/lean4/pull/5472) @[simp] lemmas about `List.toArray`
|
||||
* [#5485](https://github.com/leanprover/lean4/pull/5485) reverse simp direction for `toArray_concat`
|
||||
* [#5514](https://github.com/leanprover/lean4/pull/5514) `Array.eraseReps`
|
||||
* [#5515](https://github.com/leanprover/lean4/pull/5515) upstream `Array.qsortOrd`
|
||||
* [#5516](https://github.com/leanprover/lean4/pull/5516) upstream `Subarray.empty`
|
||||
* [#5526](https://github.com/leanprover/lean4/pull/5526) fix name of `Array.length_toList`
|
||||
* [#5527](https://github.com/leanprover/lean4/pull/5527) reduce use of deprecated lemmas in Array
|
||||
* [#5534](https://github.com/leanprover/lean4/pull/5534) cleanup of Array GetElem lemmas
|
||||
* [#5536](https://github.com/leanprover/lean4/pull/5536) fix `Array.modify` lemmas
|
||||
* [#5551](https://github.com/leanprover/lean4/pull/5551) upstream `Array.flatten` lemmas
|
||||
* [#5552](https://github.com/leanprover/lean4/pull/5552) switch obvious cases of array "bang"`[]!` indexing to rely on hypothesis (@TomasPuverle)
|
||||
* [#5577](https://github.com/leanprover/lean4/pull/5577) add missing simp to `Array.size_feraseIdx`
|
||||
* [#5586](https://github.com/leanprover/lean4/pull/5586) `Array/Option.unattach`
|
||||
|
||||
* `Option`
|
||||
* [#5272](https://github.com/leanprover/lean4/pull/5272) remove @[simp] from `Option.pmap/pbind` and add simp lemmas
|
||||
* [#5307](https://github.com/leanprover/lean4/pull/5307) restoring Option simp confluence
|
||||
* [#5354](https://github.com/leanprover/lean4/pull/5354) remove @[simp] from `Option.bind_map`
|
||||
* [#5532](https://github.com/leanprover/lean4/pull/5532) `Option.attach`
|
||||
* [#5539](https://github.com/leanprover/lean4/pull/5539) fix explicitness of `Option.mem_toList`
|
||||
|
||||
* `Nat`
|
||||
* [#5241](https://github.com/leanprover/lean4/pull/5241) add @[simp] to `Nat.add_eq_zero_iff`
|
||||
* [#5261](https://github.com/leanprover/lean4/pull/5261) Nat bitwise lemmas
|
||||
* [#5262](https://github.com/leanprover/lean4/pull/5262) `Nat.testBit_add_one` should not be a global simp lemma
|
||||
* [#5267](https://github.com/leanprover/lean4/pull/5267) protect some Nat bitwise theorems
|
||||
* [#5305](https://github.com/leanprover/lean4/pull/5305) rename Nat bitwise lemmas
|
||||
* [#5306](https://github.com/leanprover/lean4/pull/5306) add `Nat.self_sub_mod` lemma
|
||||
* [#5503](https://github.com/leanprover/lean4/pull/5503) restore @[simp] to upstreamed `Nat.lt_off_iff`
|
||||
|
||||
* `Int`
|
||||
* [#5301](https://github.com/leanprover/lean4/pull/5301) rename `Int.div/mod` to `Int.tdiv/tmod`
|
||||
* [#5320](https://github.com/leanprover/lean4/pull/5320) add `ediv_nonneg_of_nonpos_of_nonpos` to DivModLemmas (@sakehl)
|
||||
|
||||
* `Fin`
|
||||
* [#5250](https://github.com/leanprover/lean4/pull/5250) missing lemma about `Fin.ofNat'`
|
||||
* [#5356](https://github.com/leanprover/lean4/pull/5356) `Fin.ofNat'` uses `NeZero`
|
||||
* [#5379](https://github.com/leanprover/lean4/pull/5379) remove some @[simp]s from Fin lemmas
|
||||
* [#5380](https://github.com/leanprover/lean4/pull/5380) missing Fin @[simp] lemmas
|
||||
|
||||
* `HashMap`
|
||||
* [#5244](https://github.com/leanprover/lean4/pull/5244) (`DHashMap`|`HashMap`|`HashSet`).(`getKey?`|`getKey`|`getKey!`|`getKeyD`)
|
||||
* [#5362](https://github.com/leanprover/lean4/pull/5362) remove the last use of `Lean.(HashSet|HashMap)`
|
||||
* [#5369](https://github.com/leanprover/lean4/pull/5369) `HashSet.ofArray`
|
||||
* [#5370](https://github.com/leanprover/lean4/pull/5370) `HashSet.partition`
|
||||
* [#5581](https://github.com/leanprover/lean4/pull/5581) `Singleton`/`Insert`/`Union` instances for `HashMap`/`Set`
|
||||
* [#5582](https://github.com/leanprover/lean4/pull/5582) `HashSet.all`/`any`
|
||||
* [#5590](https://github.com/leanprover/lean4/pull/5590) adding `Insert`/`Singleton`/`Union` instances for `HashMap`/`Set.Raw`
|
||||
* [#5591](https://github.com/leanprover/lean4/pull/5591) `HashSet.Raw.all/any`
|
||||
|
||||
* `Monads`
|
||||
* [#5463](https://github.com/leanprover/lean4/pull/5463) upstream some monad lemmas
|
||||
* [#5464](https://github.com/leanprover/lean4/pull/5464) adjust simp attributes on monad lemmas
|
||||
* [#5522](https://github.com/leanprover/lean4/pull/5522) more monadic simp lemmas
|
||||
|
||||
* Simp lemma cleanup
|
||||
* [#5251](https://github.com/leanprover/lean4/pull/5251) remove redundant simp annotations
|
||||
* [#5253](https://github.com/leanprover/lean4/pull/5253) remove Int simp lemmas that can't fire
|
||||
* [#5254](https://github.com/leanprover/lean4/pull/5254) variables appearing on both sides of an iff should be implicit
|
||||
* [#5381](https://github.com/leanprover/lean4/pull/5381) cleaning up redundant simp lemmas
|
||||
|
||||
|
||||
### Compiler, runtime, and FFI
|
||||
|
||||
* [#4685](https://github.com/leanprover/lean4/pull/4685) fixes a typo in the C `run_new_frontend` signature
|
||||
* [#4729](https://github.com/leanprover/lean4/pull/4729) has IR checker suggest using `noncomputable`
|
||||
* [#5143](https://github.com/leanprover/lean4/pull/5143) adds a shared library for Lake
|
||||
* [#5437](https://github.com/leanprover/lean4/pull/5437) removes (syntactically) duplicate imports (@euprunin)
|
||||
* [#5462](https://github.com/leanprover/lean4/pull/5462) updates `src/lake/lakefile.toml` to the adjusted Lake build process
|
||||
* [#5541](https://github.com/leanprover/lean4/pull/5541) removes new shared libs before build to better support Windows
|
||||
* [#5558](https://github.com/leanprover/lean4/pull/5558) make `lean.h` compile with MSVC (@kant2002)
|
||||
* [#5564](https://github.com/leanprover/lean4/pull/5564) removes non-conforming size-0 arrays (@eric-wieser)
|
||||
|
||||
|
||||
### Lake
|
||||
* Reservoir build cache. Lake will now attempt to fetch a pre-built copy of the package from Reservoir before building it. This is only enabled for packages in the leanprover or leanprover-community organizations on versions indexed by Reservoir. Users can force Lake to build packages from the source by passing --no-cache on the CLI or by setting the LAKE_NO_CACHE environment variable to true. [#5486](https://github.com/leanprover/lean4/pull/5486), [#5572](https://github.com/leanprover/lean4/pull/5572), [#5583](https://github.com/leanprover/lean4/pull/5583), [#5600](https://github.com/leanprover/lean4/pull/5600), [#5641](https://github.com/leanprover/lean4/pull/5641), [#5642](https://github.com/leanprover/lean4/pull/5642).
|
||||
* [#5504](https://github.com/leanprover/lean4/pull/5504) lake new and lake init now produce TOML configurations by default.
|
||||
* [#5878](https://github.com/leanprover/lean4/pull/5878) fixes a serious issue where Lake would delete path dependencies when attempting to cleanup a dependency required with an incorrect name.
|
||||
|
||||
* **Breaking changes**
|
||||
* [#5641](https://github.com/leanprover/lean4/pull/5641) A Lake build of target within a package will no longer build a package's dependencies package-level extra target dependencies. At the technical level, a package's extraDep facet no longer transitively builds its dependencies’ extraDep facets (which include their extraDepTargets).
|
||||
|
||||
### Documentation fixes
|
||||
|
||||
* [#3918](https://github.com/leanprover/lean4/pull/3918) `@[builtin_doc]` attribute (@digama0)
|
||||
* [#4305](https://github.com/leanprover/lean4/pull/4305) explains the borrow syntax (@eric-wieser)
|
||||
* [#5349](https://github.com/leanprover/lean4/pull/5349) adds documentation for `groupBy.loop` (@vihdzp)
|
||||
* [#5473](https://github.com/leanprover/lean4/pull/5473) fixes typo in `BitVec.mul` docstring (@llllvvuu)
|
||||
* [#5476](https://github.com/leanprover/lean4/pull/5476) fixes typos in `Lean.MetavarContext`
|
||||
* [#5481](https://github.com/leanprover/lean4/pull/5481) removes mention of `Lean.withSeconds` (@alexkeizer)
|
||||
* [#5497](https://github.com/leanprover/lean4/pull/5497) updates documentation and tests for `toUIntX` functions (@TomasPuverle)
|
||||
* [#5087](https://github.com/leanprover/lean4/pull/5087) mentions that `inferType` does not ensure type correctness
|
||||
* Many fixes to spelling across the doc-strings, (@euprunin): [#5425](https://github.com/leanprover/lean4/pull/5425) [#5426](https://github.com/leanprover/lean4/pull/5426) [#5427](https://github.com/leanprover/lean4/pull/5427) [#5430](https://github.com/leanprover/lean4/pull/5430) [#5431](https://github.com/leanprover/lean4/pull/5431) [#5434](https://github.com/leanprover/lean4/pull/5434) [#5435](https://github.com/leanprover/lean4/pull/5435) [#5436](https://github.com/leanprover/lean4/pull/5436) [#5438](https://github.com/leanprover/lean4/pull/5438) [#5439](https://github.com/leanprover/lean4/pull/5439) [#5440](https://github.com/leanprover/lean4/pull/5440) [#5599](https://github.com/leanprover/lean4/pull/5599)
|
||||
|
||||
### Changes to CI
|
||||
|
||||
* [#5343](https://github.com/leanprover/lean4/pull/5343) allows addition of `release-ci` label via comment (@thorimur)
|
||||
* [#5344](https://github.com/leanprover/lean4/pull/5344) sets check level correctly during workflow (@thorimur)
|
||||
* [#5444](https://github.com/leanprover/lean4/pull/5444) Mathlib's `lean-pr-testing-NNNN` branches should use Batteries' `lean-pr-testing-NNNN` branches
|
||||
* [#5489](https://github.com/leanprover/lean4/pull/5489) commit `lake-manifest.json` when updating `lean-pr-testing` branches
|
||||
* [#5490](https://github.com/leanprover/lean4/pull/5490) use separate secrets for commenting and branching in `pr-release.yml`
|
||||
|
||||
v4.12.0
|
||||
----------
|
||||
|
||||
|
||||
@@ -38,7 +38,11 @@
|
||||
# more convenient `ctest` output
|
||||
CTEST_OUTPUT_ON_FAILURE = 1;
|
||||
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
|
||||
GMP = pkgsDist.gmp.override { withStatic = true; };
|
||||
GMP = (pkgsDist.gmp.override { withStatic = true; }).overrideAttrs (attrs:
|
||||
pkgs.lib.optionalAttrs (pkgs.stdenv.system == "aarch64-linux") {
|
||||
# would need additional linking setup on Linux aarch64, we don't use it anywhere else either
|
||||
hardeningDisable = [ "stackprotector" ];
|
||||
});
|
||||
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: {
|
||||
configureFlags = ["--enable-static"];
|
||||
hardeningDisable = [ "stackprotector" ];
|
||||
|
||||
@@ -10,7 +10,7 @@ endif()
|
||||
include(ExternalProject)
|
||||
project(LEAN CXX C)
|
||||
set(LEAN_VERSION_MAJOR 4)
|
||||
set(LEAN_VERSION_MINOR 14)
|
||||
set(LEAN_VERSION_MINOR 15)
|
||||
set(LEAN_VERSION_PATCH 0)
|
||||
set(LEAN_VERSION_IS_RELEASE 0) # This number is 1 in the release revision, and 0 otherwise.
|
||||
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
|
||||
|
||||
@@ -35,6 +35,15 @@ instance (priority := 500) instForInOfForIn' [ForIn' m ρ α d] : ForIn m ρ α
|
||||
simp [h]
|
||||
rfl
|
||||
|
||||
/-- Extract the value from a `ForInStep`, ignoring whether it is `done` or `yield`. -/
|
||||
def ForInStep.value (x : ForInStep α) : α :=
|
||||
match x with
|
||||
| ForInStep.done b => b
|
||||
| ForInStep.yield b => b
|
||||
|
||||
@[simp] theorem ForInStep.value_done (b : β) : (ForInStep.done b).value = b := rfl
|
||||
@[simp] theorem ForInStep.value_yield (b : β) : (ForInStep.yield b).value = b := rfl
|
||||
|
||||
@[reducible]
|
||||
def Functor.mapRev {f : Type u → Type v} [Functor f] {α β : Type u} : f α → (α → β) → f β :=
|
||||
fun a f => f <$> a
|
||||
|
||||
@@ -7,6 +7,7 @@ Notation for operators defined at Prelude.lean
|
||||
-/
|
||||
prelude
|
||||
import Init.Tactics
|
||||
import Init.Meta
|
||||
|
||||
namespace Lean.Parser.Tactic.Conv
|
||||
|
||||
@@ -46,12 +47,20 @@ scoped syntax (name := withAnnotateState)
|
||||
/-- `skip` does nothing. -/
|
||||
syntax (name := skip) "skip" : conv
|
||||
|
||||
/-- Traverses into the left subterm of a binary operator.
|
||||
(In general, for an `n`-ary operator, it traverses into the second to last argument.) -/
|
||||
/--
|
||||
Traverses into the left subterm of a binary operator.
|
||||
|
||||
In general, for an `n`-ary operator, it traverses into the second to last argument.
|
||||
It is a synonym for `arg -2`.
|
||||
-/
|
||||
syntax (name := lhs) "lhs" : conv
|
||||
|
||||
/-- Traverses into the right subterm of a binary operator.
|
||||
(In general, for an `n`-ary operator, it traverses into the last argument.) -/
|
||||
/--
|
||||
Traverses into the right subterm of a binary operator.
|
||||
|
||||
In general, for an `n`-ary operator, it traverses into the last argument.
|
||||
It is a synonym for `arg -1`.
|
||||
-/
|
||||
syntax (name := rhs) "rhs" : conv
|
||||
|
||||
/-- Traverses into the function of a (unary) function application.
|
||||
@@ -74,13 +83,17 @@ subgoals for all the function arguments. For example, if the target is `f x y` t
|
||||
`congr` produces two subgoals, one for `x` and one for `y`. -/
|
||||
syntax (name := congr) "congr" : conv
|
||||
|
||||
syntax argArg := "@"? "-"? num
|
||||
|
||||
/--
|
||||
* `arg i` traverses into the `i`'th argument of the target. For example if the
|
||||
target is `f a b c d` then `arg 1` traverses to `a` and `arg 3` traverses to `c`.
|
||||
The index may be negative; `arg -1` traverses into the last argument,
|
||||
`arg -2` into the second-to-last argument, and so on.
|
||||
* `arg @i` is the same as `arg i` but it counts all arguments instead of just the
|
||||
explicit arguments.
|
||||
* `arg 0` traverses into the function. If the target is `f a b c d`, `arg 0` traverses into `f`. -/
|
||||
syntax (name := arg) "arg " "@"? num : conv
|
||||
syntax (name := arg) "arg " argArg : conv
|
||||
|
||||
/-- `ext x` traverses into a binder (a `fun x => e` or `∀ x, e` expression)
|
||||
to target `e`, introducing name `x` in the process. -/
|
||||
@@ -130,11 +143,11 @@ For example, if we are searching for `f _` in `f (f a) = f b`:
|
||||
syntax (name := pattern) "pattern " (occs)? term : conv
|
||||
|
||||
/-- `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. -/
|
||||
syntax (name := rewrite) "rewrite" (config)? rwRuleSeq : conv
|
||||
syntax (name := rewrite) "rewrite" optConfig rwRuleSeq : conv
|
||||
|
||||
/-- `simp [thm]` performs simplification using `thm` and marked `@[simp]` lemmas.
|
||||
See the `simp` tactic for more information. -/
|
||||
syntax (name := simp) "simp" (config)? (discharger)? (&" only")?
|
||||
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
/--
|
||||
@@ -151,7 +164,7 @@ example (a : Nat): (0 + 0) = a - a := by
|
||||
rw [← Nat.sub_self a]
|
||||
```
|
||||
-/
|
||||
syntax (name := dsimp) "dsimp" (config)? (discharger)? (&" only")?
|
||||
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : conv
|
||||
|
||||
/-- `simp_match` simplifies match expressions. For example,
|
||||
@@ -247,12 +260,12 @@ macro (name := failIfSuccess) tk:"fail_if_success " s:convSeq : conv =>
|
||||
|
||||
/-- `rw [rules]` applies the given list of rewrite rules to the target.
|
||||
See the `rw` tactic for more information. -/
|
||||
macro "rw" c:(config)? s:rwRuleSeq : conv => `(conv| rewrite $[$c]? $s)
|
||||
macro "rw" c:optConfig s:rwRuleSeq : conv => `(conv| rewrite $c:optConfig $s)
|
||||
|
||||
/-- `erw [rules]` is a shorthand for `rw (config := { transparency := .default }) [rules]`.
|
||||
/-- `erw [rules]` is a shorthand for `rw (transparency := .default) [rules]`.
|
||||
This does rewriting up to unfolding of regular definitions (by comparison to regular `rw`
|
||||
which only unfolds `@[reducible]` definitions). -/
|
||||
macro "erw" s:rwRuleSeq : conv => `(conv| rw (config := { transparency := .default }) $s:rwRuleSeq)
|
||||
macro "erw" c:optConfig s:rwRuleSeq : conv => `(conv| rw $[$(getConfigItems c)]* (transparency := .default) $s:rwRuleSeq)
|
||||
|
||||
/-- `args` traverses into all arguments. Synonym for `congr`. -/
|
||||
macro "args" : conv => `(conv| congr)
|
||||
@@ -263,7 +276,7 @@ macro "right" : conv => `(conv| rhs)
|
||||
/-- `intro` traverses into binders. Synonym for `ext`. -/
|
||||
macro "intro" xs:(ppSpace colGt ident)* : conv => `(conv| ext $xs*)
|
||||
|
||||
syntax enterArg := ident <|> ("@"? num)
|
||||
syntax enterArg := ident <|> argArg
|
||||
|
||||
/-- `enter [arg, ...]` is a compact way to describe a path to a subterm.
|
||||
It is a shorthand for other conv tactics as follows:
|
||||
@@ -272,12 +285,7 @@ It is a shorthand for other conv tactics as follows:
|
||||
* `enter [x]` (where `x` is an identifier) is equivalent to `ext x`.
|
||||
For example, given the target `f (g a (fun x => x b))`, `enter [1, 2, x, 1]`
|
||||
will traverse to the subterm `b`. -/
|
||||
syntax "enter" " [" withoutPosition(enterArg,+) "]" : conv
|
||||
macro_rules
|
||||
| `(conv| enter [$i:num]) => `(conv| arg $i)
|
||||
| `(conv| enter [@$i]) => `(conv| arg @$i)
|
||||
| `(conv| enter [$id:ident]) => `(conv| ext $id)
|
||||
| `(conv| enter [$arg, $args,*]) => `(conv| (enter [$arg]; enter [$args,*]))
|
||||
syntax (name := enter) "enter" " [" withoutPosition(enterArg,+) "]" : conv
|
||||
|
||||
/-- The `apply thm` conv tactic is the same as `apply thm` the tactic.
|
||||
There are no restrictions on `thm`, but strange results may occur if `thm`
|
||||
|
||||
@@ -23,7 +23,7 @@ theorem foldlM_eq_foldlM_toList.aux [Monad m]
|
||||
· cases Nat.not_le_of_gt ‹_› (Nat.zero_add _ ▸ H)
|
||||
· rename_i i; rw [Nat.succ_add] at H
|
||||
simp [foldlM_eq_foldlM_toList.aux f arr i (j+1) H]
|
||||
rw (config := {occs := .pos [2]}) [← List.get_drop_eq_drop _ _ ‹_›]
|
||||
rw (occs := .pos [2]) [← List.getElem_cons_drop_succ_eq_drop ‹_›]
|
||||
rfl
|
||||
· rw [List.drop_of_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
|
||||
|
||||
|
||||
@@ -41,6 +41,6 @@ where
|
||||
getLit_eq (as : Array α) (i : Nat) (h₁ : as.size = n) (h₂ : i < n) : as.getLit i h₁ h₂ = getElem as.toList i ((id (α := as.toList.length = n) h₁) ▸ h₂) :=
|
||||
rfl
|
||||
go (i : Nat) (hi : i ≤ as.size) : toListLitAux as n hsz i hi (as.toList.drop i) = as.toList := by
|
||||
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.get_drop_eq_drop, *]
|
||||
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.getElem_cons_drop_succ_eq_drop, *]
|
||||
|
||||
end Array
|
||||
|
||||
@@ -10,7 +10,9 @@ import Init.Data.List.Monadic
|
||||
import Init.Data.List.Range
|
||||
import Init.Data.List.Nat.TakeDrop
|
||||
import Init.Data.List.Nat.Modify
|
||||
import Init.Data.List.Nat.Erase
|
||||
import Init.Data.List.Monadic
|
||||
import Init.Data.List.OfFn
|
||||
import Init.Data.Array.Mem
|
||||
import Init.Data.Array.DecidableEq
|
||||
import Init.TacticsExtra
|
||||
@@ -245,7 +247,7 @@ where
|
||||
aux (i r) :
|
||||
mapM.map f arr i r = (arr.toList.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
|
||||
unfold mapM.map; split
|
||||
· rw [← List.get_drop_eq_drop _ i ‹_›]
|
||||
· rw [← List.getElem_cons_drop_succ_eq_drop ‹_›]
|
||||
simp only [aux (i + 1), map_eq_pure_bind, length_toList, List.foldlM_cons, bind_assoc,
|
||||
pure_bind]
|
||||
rfl
|
||||
@@ -908,7 +910,7 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
|
||||
obtain ⟨m, eq, w⟩ := t
|
||||
· refine ⟨m, by simpa [map_eq_foldl] using eq, ?_⟩
|
||||
intro i h
|
||||
simp [eq] at w
|
||||
simp only [eq] at w
|
||||
specialize w ⟨i, h⟩ h
|
||||
simpa [map_eq_foldl] using w
|
||||
· exact ⟨h0, rfl, nofun⟩
|
||||
@@ -1459,6 +1461,10 @@ 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 feraseIdx_eq_eraseIdx {a : Array α} {i : Fin a.size} :
|
||||
a.feraseIdx i = a.eraseIdx i.1 := by
|
||||
simp [eraseIdx]
|
||||
|
||||
end Array
|
||||
|
||||
open Array
|
||||
@@ -1610,11 +1616,72 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_extract (l : List α) (start stop : Nat) :
|
||||
@[simp] theorem extract_toArray (l : List α) (start stop : Nat) :
|
||||
l.toArray.extract start stop = ((l.drop start).take (stop - start)).toArray := by
|
||||
apply ext'
|
||||
simp
|
||||
|
||||
@[simp] theorem toArray_ofFn (f : Fin n → α) : (ofFn f).toArray = Array.ofFn f := by
|
||||
ext <;> simp
|
||||
|
||||
theorem takeWhile_go_succ (p : α → Bool) (a : α) (l : List α) (i : Nat) :
|
||||
takeWhile.go p (a :: l).toArray (i+1) r = takeWhile.go p l.toArray i r := by
|
||||
rw [takeWhile.go, takeWhile.go]
|
||||
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
|
||||
getElem_toArray, getElem_cons_succ]
|
||||
split
|
||||
rw [takeWhile_go_succ]
|
||||
rfl
|
||||
|
||||
theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
|
||||
Array.takeWhile.go p l.toArray i r = r ++ (takeWhile p (l.drop i)).toArray := by
|
||||
induction l generalizing i r with
|
||||
| nil => simp [takeWhile.go]
|
||||
| cons a l ih =>
|
||||
rw [takeWhile.go]
|
||||
cases i with
|
||||
| zero =>
|
||||
simp [takeWhile_go_succ, ih, takeWhile_cons]
|
||||
split <;> simp
|
||||
| succ i =>
|
||||
simp only [size_toArray, length_cons, Nat.add_lt_add_iff_right, Array.get_eq_getElem,
|
||||
getElem_toArray, getElem_cons_succ, drop_succ_cons]
|
||||
split <;> rename_i h₁
|
||||
· rw [takeWhile_go_succ, ih]
|
||||
rw [← getElem_cons_drop_succ_eq_drop h₁, takeWhile_cons]
|
||||
split <;> simp_all
|
||||
· simp_all [drop_eq_nil_of_le]
|
||||
|
||||
@[simp] theorem takeWhile_toArray (p : α → Bool) (l : List α) :
|
||||
l.toArray.takeWhile p = (l.takeWhile p).toArray := by
|
||||
simp [Array.takeWhile, takeWhile_go_toArray]
|
||||
|
||||
@[simp] theorem 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 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
|
||||
have t : i = l.length - 1 := by omega
|
||||
simp [t]
|
||||
termination_by l.length - i
|
||||
decreasing_by
|
||||
rename_i h
|
||||
simp at h
|
||||
simp
|
||||
omega
|
||||
|
||||
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) :
|
||||
l.toArray.eraseIdx i = (l.eraseIdx i).toArray := by
|
||||
rw [Array.eraseIdx]
|
||||
split
|
||||
· simp
|
||||
· simp_all [eraseIdx_eq_self.2]
|
||||
|
||||
end List
|
||||
|
||||
namespace Array
|
||||
@@ -1622,6 +1689,23 @@ namespace Array
|
||||
@[simp] theorem mapM_id {l : Array α} {f : α → Id β} : l.mapM f = l.map f := by
|
||||
induction l; simp_all
|
||||
|
||||
@[simp] theorem toList_ofFn (f : Fin n → α) : (Array.ofFn f).toList = List.ofFn f := by
|
||||
apply List.ext_getElem <;> simp
|
||||
|
||||
@[simp] theorem toList_takeWhile (p : α → Bool) (as : 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
|
||||
induction as
|
||||
simp
|
||||
|
||||
@[simp] theorem toList_eraseIdx (as : Array α) (i : Nat) :
|
||||
(as.eraseIdx i).toList = as.toList.eraseIdx i := by
|
||||
induction as
|
||||
simp
|
||||
|
||||
end Array
|
||||
|
||||
/-! ### Deprecations -/
|
||||
|
||||
@@ -60,6 +60,10 @@ theorem mapFinIdx_spec (as : Array α) (f : Fin as.size → α → β)
|
||||
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
|
||||
split <;> simp_all
|
||||
|
||||
@[simp] theorem toList_mapFinIdx (a : Array α) (f : Fin a.size → α → β) :
|
||||
(a.mapFinIdx f).toList = a.toList.mapFinIdx (fun i a => f ⟨i, by simp⟩ a) := by
|
||||
apply List.ext_getElem <;> simp
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
theorem mapIdx_induction (as : Array α) (f : Nat → α → β)
|
||||
@@ -89,4 +93,20 @@ theorem mapIdx_spec (as : Array α) (f : Nat → α → β)
|
||||
a[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
|
||||
apply List.ext_getElem <;> simp
|
||||
|
||||
end Array
|
||||
|
||||
namespace List
|
||||
|
||||
@[simp] theorem mapFinIdx_toArray (l : List α) (f : Fin l.length → α → β) :
|
||||
l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
|
||||
ext <;> simp
|
||||
|
||||
@[simp] theorem mapIdx_toArray (l : List α) (f : Nat → α → β) :
|
||||
l.toArray.mapIdx f = (l.mapIdx f).toArray := by
|
||||
ext <;> simp
|
||||
|
||||
end List
|
||||
|
||||
@@ -174,6 +174,30 @@ theorem carry_succ (i : Nat) (x y : BitVec w) (c : Bool) :
|
||||
exact mod_two_pow_add_mod_two_pow_add_bool_lt_two_pow_succ ..
|
||||
cases x.toNat.testBit i <;> cases y.toNat.testBit i <;> (simp; omega)
|
||||
|
||||
theorem carry_succ_one (i : Nat) (x : BitVec w) (h : 0 < w) :
|
||||
carry (i+1) x (1#w) false = decide (∀ j ≤ i, x.getLsbD j = true) := by
|
||||
induction i with
|
||||
| zero => simp [carry_succ, h]
|
||||
| succ i ih =>
|
||||
rw [carry_succ, ih]
|
||||
simp only [getLsbD_one, add_one_ne_zero, decide_False, Bool.and_false, atLeastTwo_false_mid]
|
||||
cases hx : x.getLsbD (i+1)
|
||||
case false =>
|
||||
have : ∃ j ≤ i + 1, x.getLsbD j = false :=
|
||||
⟨i+1, by omega, hx⟩
|
||||
simpa
|
||||
case true =>
|
||||
suffices
|
||||
(∀ (j : Nat), j ≤ i → x.getLsbD j = true)
|
||||
↔ (∀ (j : Nat), j ≤ i + 1 → x.getLsbD j = true) by
|
||||
simpa
|
||||
constructor
|
||||
· intro h j hj
|
||||
rcases Nat.le_or_eq_of_le_succ hj with (hj' | rfl)
|
||||
· apply h; assumption
|
||||
· exact hx
|
||||
· intro h j hj; apply h; omega
|
||||
|
||||
/--
|
||||
If `x &&& y = 0`, then the carry bit `(x + y + 0)` is always `false` for any index `i`.
|
||||
Intuitively, this is because a carry is only produced when at least two of `x`, `y`, and the
|
||||
@@ -352,6 +376,117 @@ theorem bit_neg_eq_neg (x : BitVec w) : -x = (adc (((iunfoldr (fun (i : Fin w) c
|
||||
simp [← sub_toAdd, BitVec.sub_add_cancel]
|
||||
· simp [bit_not_testBit x _]
|
||||
|
||||
/--
|
||||
Remember that negating a bitvector is equal to incrementing the complement
|
||||
by one, i.e., `-x = ~~~x + 1`. See also `neg_eq_not_add`.
|
||||
|
||||
This computation has two crucial properties:
|
||||
- The least significant bit of `-x` is the same as the least significant bit of `x`, and
|
||||
- The `i+1`-th least significant bit of `-x` is the complement of the `i+1`-th bit of `x`, unless
|
||||
all of the preceding bits are `false`, in which case the bit is equal to the `i+1`-th bit of `x`
|
||||
-/
|
||||
theorem getLsbD_neg {i : Nat} {x : BitVec w} :
|
||||
getLsbD (-x) i =
|
||||
(getLsbD x i ^^ decide (i < w) && decide (∃ j < i, getLsbD x j = true)) := by
|
||||
rw [neg_eq_not_add]
|
||||
by_cases hi : i < w
|
||||
· rw [getLsbD_add hi]
|
||||
have : 0 < w := by omega
|
||||
simp only [getLsbD_not, hi, decide_True, Bool.true_and, getLsbD_one, this, not_bne,
|
||||
_root_.true_and, not_eq_eq_eq_not]
|
||||
cases i with
|
||||
| zero =>
|
||||
have carry_zero : carry 0 ?x ?y false = false := by
|
||||
simp [carry]; omega
|
||||
simp [hi, carry_zero]
|
||||
| succ =>
|
||||
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]
|
||||
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 getMsbD_neg {i : Nat} {x : BitVec w} :
|
||||
getMsbD (-x) i =
|
||||
(getMsbD x i ^^ decide (∃ j < w, i < j ∧ getMsbD x j = true)) := by
|
||||
simp only [getMsbD, getLsbD_neg, Bool.decide_and, Bool.and_eq_true, decide_eq_true_eq]
|
||||
by_cases hi : i < w
|
||||
case neg =>
|
||||
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]
|
||||
constructor
|
||||
· rintro ⟨j, hj, h⟩
|
||||
refine ⟨w - 1 - j, by omega, by omega, by omega, _root_.cast ?_ h⟩
|
||||
congr; omega
|
||||
· rintro ⟨j, hj₁, hj₂, -, h⟩
|
||||
exact ⟨w - 1 - j, by omega, h⟩
|
||||
|
||||
theorem msb_neg {w : Nat} {x : BitVec w} :
|
||||
(-x).msb = ((x != 0#w && x != intMin w) ^^ x.msb) := by
|
||||
simp only [BitVec.msb, getMsbD_neg]
|
||||
by_cases hmin : x = intMin _
|
||||
case pos =>
|
||||
have : (∃ j, j < w ∧ 0 < j ∧ 0 < w ∧ j = 0) ↔ False := by
|
||||
simp; omega
|
||||
simp [hmin, getMsbD_intMin, this]
|
||||
case neg =>
|
||||
by_cases hzero : x = 0#w
|
||||
case pos => simp [hzero]
|
||||
case neg =>
|
||||
have w_pos : 0 < w := by
|
||||
cases w
|
||||
· rw [@of_length_zero x] at hzero
|
||||
contradiction
|
||||
· omega
|
||||
suffices ∃ j, j < w ∧ 0 < j ∧ x.getMsbD j = true
|
||||
by simp [show x != 0#w by simpa, show x != intMin w by simpa, this]
|
||||
false_or_by_contra
|
||||
rename_i getMsbD_x
|
||||
simp only [not_exists, _root_.not_and, not_eq_true] at getMsbD_x
|
||||
/- `getMsbD` says that all bits except the msb are `false` -/
|
||||
cases hmsb : x.msb
|
||||
case true =>
|
||||
apply hmin
|
||||
apply eq_of_getMsbD_eq
|
||||
rintro ⟨i, hi⟩
|
||||
simp only [getMsbD_intMin, w_pos, decide_True, Bool.true_and]
|
||||
cases i
|
||||
case zero => exact hmsb
|
||||
case succ => exact getMsbD_x _ hi (by omega)
|
||||
case false =>
|
||||
apply hzero
|
||||
apply eq_of_getMsbD_eq
|
||||
rintro ⟨i, hi⟩
|
||||
simp only [getMsbD_zero]
|
||||
cases i
|
||||
case zero => exact hmsb
|
||||
case succ => exact getMsbD_x _ hi (by omega)
|
||||
|
||||
/-! ### abs -/
|
||||
|
||||
theorem msb_abs {w : Nat} {x : BitVec w} :
|
||||
x.abs.msb = (decide (x = intMin w) && decide (0 < w)) := by
|
||||
simp only [BitVec.abs, getMsbD_neg, ne_eq, decide_not, Bool.not_bne]
|
||||
by_cases h₀ : 0 < w
|
||||
· by_cases h₁ : x = intMin w
|
||||
· simp [h₁, msb_intMin]
|
||||
· simp only [neg_eq, h₁, decide_False]
|
||||
by_cases h₂ : x.msb
|
||||
· simp [h₂, msb_neg]
|
||||
and_intros
|
||||
· by_cases h₃ : x = 0#w
|
||||
· simp [h₃] at h₂
|
||||
· simp [h₃]
|
||||
· simp [h₁]
|
||||
· simp [h₂]
|
||||
· simp [BitVec.msb, show w = 0 by omega]
|
||||
|
||||
/-! ### Inequalities (le / lt) -/
|
||||
|
||||
theorem ult_eq_not_carry (x y : BitVec w) : x.ult y = !carry w x (~~~y) true := by
|
||||
|
||||
@@ -2026,9 +2026,9 @@ theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toN
|
||||
|
||||
@[simp] theorem toFin_sub (x y : BitVec n) : (x - y).toFin = toFin x - toFin y := rfl
|
||||
|
||||
@[simp] theorem ofFin_sub (x : Fin (2^n)) (y : BitVec n) : .ofFin x - y = .ofFin (x - y.toFin) :=
|
||||
theorem ofFin_sub (x : Fin (2^n)) (y : BitVec n) : .ofFin x - y = .ofFin (x - y.toFin) :=
|
||||
rfl
|
||||
@[simp] theorem sub_ofFin (x : BitVec n) (y : Fin (2^n)) : x - .ofFin y = .ofFin (x.toFin - y) :=
|
||||
theorem sub_ofFin (x : BitVec n) (y : Fin (2^n)) : x - .ofFin y = .ofFin (x.toFin - y) :=
|
||||
rfl
|
||||
|
||||
-- Remark: we don't use `[simp]` here because simproc` subsumes it for literals.
|
||||
@@ -2146,19 +2146,6 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
|
||||
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
|
||||
omega
|
||||
|
||||
/-! ### abs -/
|
||||
|
||||
theorem abs_eq (x : BitVec w) : x.abs = if x.msb then -x else x := by rfl
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_abs {x : BitVec w} : x.abs.toNat = if x.msb then 2^w - x.toNat else x.toNat := by
|
||||
simp only [BitVec.abs, neg_eq]
|
||||
by_cases h : x.msb = true
|
||||
· simp only [h, ↓reduceIte, toNat_neg]
|
||||
have : 2 * x.toNat ≥ 2 ^ w := BitVec.msb_eq_true_iff_two_mul_ge.mp h
|
||||
rw [Nat.mod_eq_of_lt (by omega)]
|
||||
· simp [h]
|
||||
|
||||
/-! ### mul -/
|
||||
|
||||
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
|
||||
@@ -2899,6 +2886,14 @@ theorem getLsbD_intMin (w : Nat) : (intMin w).getLsbD i = decide (i + 1 = w) :=
|
||||
simp only [intMin, getLsbD_twoPow, boolToPropSimps]
|
||||
omega
|
||||
|
||||
theorem getMsbD_intMin {w i : Nat} :
|
||||
(intMin w).getMsbD i = (decide (0 < w) && decide (i = 0)) := by
|
||||
simp only [getMsbD, getLsbD_intMin]
|
||||
match w, i with
|
||||
| 0, _ => simp
|
||||
| w+1, 0 => simp
|
||||
| w+1, i+1 => simp; omega
|
||||
|
||||
/--
|
||||
The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
|
||||
-/
|
||||
@@ -2943,6 +2938,10 @@ theorem neg_intMin {w : Nat} : -intMin w = intMin w := by
|
||||
· simp only [Nat.not_lt, Nat.le_zero_eq] at h
|
||||
simp [bv_toNat, h]
|
||||
|
||||
@[simp]
|
||||
theorem abs_intMin {w : Nat} : (intMin w).abs = intMin w := by
|
||||
simp [BitVec.abs, bv_toNat]
|
||||
|
||||
theorem toInt_neg_of_ne_intMin {x : BitVec w} (rs : x ≠ intMin w) :
|
||||
(-x).toInt = -(x.toInt) := by
|
||||
simp only [ne_eq, toNat_eq, toNat_intMin] at rs
|
||||
@@ -2959,6 +2958,10 @@ 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 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
|
||||
|
||||
/-! ### intMax -/
|
||||
|
||||
/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
|
||||
@@ -3051,6 +3054,38 @@ theorem sub_le_sub_iff_le {x y z : BitVec w} (hxz : z ≤ x) (hyz : z ≤ y) :
|
||||
BitVec.toNat_sub_of_le (by rw [BitVec.le_def]; omega)]
|
||||
omega
|
||||
|
||||
/-! ### neg -/
|
||||
|
||||
theorem msb_eq_toInt {x : BitVec w}:
|
||||
x.msb = decide (x.toInt < 0) := by
|
||||
by_cases h : x.msb <;>
|
||||
· simp [h, toInt_eq_msb_cond]
|
||||
omega
|
||||
|
||||
theorem msb_eq_toNat {x : BitVec w}:
|
||||
x.msb = decide (x.toNat ≥ 2 ^ (w - 1)) := by
|
||||
simp only [msb_eq_decide, ge_iff_le]
|
||||
|
||||
/-! ### abs -/
|
||||
|
||||
theorem abs_eq (x : BitVec w) : x.abs = if x.msb then -x else x := by rfl
|
||||
|
||||
@[simp, bv_toNat]
|
||||
theorem toNat_abs {x : BitVec w} : x.abs.toNat = if x.msb then 2^w - x.toNat else x.toNat := by
|
||||
simp only [BitVec.abs, neg_eq]
|
||||
by_cases h : x.msb = true
|
||||
· simp only [h, ↓reduceIte, toNat_neg]
|
||||
have : 2 * x.toNat ≥ 2 ^ w := BitVec.msb_eq_true_iff_two_mul_ge.mp h
|
||||
rw [Nat.mod_eq_of_lt (by omega)]
|
||||
· 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
|
||||
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]
|
||||
|
||||
/-! ### Decidable quantifiers -/
|
||||
|
||||
|
||||
@@ -5,6 +5,8 @@ Authors: François G. Dorais
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Nat.Linear
|
||||
import Init.Control.Lawful.Basic
|
||||
import Init.Data.Fin.Lemmas
|
||||
|
||||
namespace Fin
|
||||
|
||||
@@ -23,4 +25,195 @@ namespace Fin
|
||||
| ⟨0, _⟩, x => x
|
||||
| ⟨i+1, h⟩, x => loop ⟨i, Nat.le_of_lt h⟩ (f ⟨i, h⟩ x)
|
||||
|
||||
/--
|
||||
Folds a monadic function over `Fin n` from left to right:
|
||||
```
|
||||
Fin.foldlM n f x₀ = do
|
||||
let x₁ ← f x₀ 0
|
||||
let x₂ ← f x₁ 1
|
||||
...
|
||||
let xₙ ← f xₙ₋₁ (n-1)
|
||||
pure xₙ
|
||||
```
|
||||
-/
|
||||
@[inline] def foldlM [Monad m] (n) (f : α → Fin n → m α) (init : α) : m α := loop init 0 where
|
||||
/--
|
||||
Inner loop for `Fin.foldlM`.
|
||||
```
|
||||
Fin.foldlM.loop n f xᵢ i = do
|
||||
let xᵢ₊₁ ← f xᵢ i
|
||||
...
|
||||
let xₙ ← f xₙ₋₁ (n-1)
|
||||
pure xₙ
|
||||
```
|
||||
-/
|
||||
loop (x : α) (i : Nat) : m α := do
|
||||
if h : i < n then f x ⟨i, h⟩ >>= (loop · (i+1)) else pure x
|
||||
termination_by n - i
|
||||
decreasing_by decreasing_trivial_pre_omega
|
||||
|
||||
/--
|
||||
Folds a monadic function over `Fin n` from right to left:
|
||||
```
|
||||
Fin.foldrM n f xₙ = do
|
||||
let xₙ₋₁ ← f (n-1) xₙ
|
||||
let xₙ₋₂ ← f (n-2) xₙ₋₁
|
||||
...
|
||||
let x₀ ← f 0 x₁
|
||||
pure x₀
|
||||
```
|
||||
-/
|
||||
@[inline] def foldrM [Monad m] (n) (f : Fin n → α → m α) (init : α) : m α :=
|
||||
loop ⟨n, Nat.le_refl n⟩ init where
|
||||
/--
|
||||
Inner loop for `Fin.foldrM`.
|
||||
```
|
||||
Fin.foldrM.loop n f i xᵢ = do
|
||||
let xᵢ₋₁ ← f (i-1) xᵢ
|
||||
...
|
||||
let x₁ ← f 1 x₂
|
||||
let x₀ ← f 0 x₁
|
||||
pure x₀
|
||||
```
|
||||
-/
|
||||
loop : {i // i ≤ n} → α → m α
|
||||
| ⟨0, _⟩, x => pure x
|
||||
| ⟨i+1, h⟩, x => f ⟨i, h⟩ x >>= loop ⟨i, Nat.le_of_lt h⟩
|
||||
|
||||
/-! ### foldlM -/
|
||||
|
||||
theorem foldlM_loop_lt [Monad m] (f : α → Fin n → m α) (x) (h : i < n) :
|
||||
foldlM.loop n f x i = f x ⟨i, h⟩ >>= (foldlM.loop n f . (i+1)) := by
|
||||
rw [foldlM.loop, dif_pos h]
|
||||
|
||||
theorem foldlM_loop_eq [Monad m] (f : α → Fin n → m α) (x) : foldlM.loop n f x n = pure x := by
|
||||
rw [foldlM.loop, dif_neg (Nat.lt_irrefl _)]
|
||||
|
||||
theorem foldlM_loop [Monad m] (f : α → Fin (n+1) → m α) (x) (h : i < n+1) :
|
||||
foldlM.loop (n+1) f x i = f x ⟨i, h⟩ >>= (foldlM.loop n (fun x j => f x j.succ) . i) := by
|
||||
if h' : i < n then
|
||||
rw [foldlM_loop_lt _ _ h]
|
||||
congr; funext
|
||||
rw [foldlM_loop_lt _ _ h', foldlM_loop]; rfl
|
||||
else
|
||||
cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h')
|
||||
rw [foldlM_loop_lt]
|
||||
congr; funext
|
||||
rw [foldlM_loop_eq, foldlM_loop_eq]
|
||||
termination_by n - i
|
||||
|
||||
@[simp] theorem foldlM_zero [Monad m] (f : α → Fin 0 → m α) (x) : foldlM 0 f x = pure x :=
|
||||
foldlM_loop_eq ..
|
||||
|
||||
theorem foldlM_succ [Monad m] (f : α → Fin (n+1) → m α) (x) :
|
||||
foldlM (n+1) f x = f x 0 >>= foldlM n (fun x j => f x j.succ) := foldlM_loop ..
|
||||
|
||||
/-! ### foldrM -/
|
||||
|
||||
theorem foldrM_loop_zero [Monad m] (f : Fin n → α → m α) (x) :
|
||||
foldrM.loop n f ⟨0, Nat.zero_le _⟩ x = pure x := by
|
||||
rw [foldrM.loop]
|
||||
|
||||
theorem foldrM_loop_succ [Monad m] (f : Fin n → α → m α) (x) (h : i < n) :
|
||||
foldrM.loop n f ⟨i+1, h⟩ x = f ⟨i, h⟩ x >>= foldrM.loop n f ⟨i, Nat.le_of_lt h⟩ := by
|
||||
rw [foldrM.loop]
|
||||
|
||||
theorem foldrM_loop [Monad m] [LawfulMonad m] (f : Fin (n+1) → α → m α) (x) (h : i+1 ≤ n+1) :
|
||||
foldrM.loop (n+1) f ⟨i+1, h⟩ x =
|
||||
foldrM.loop n (fun j => f j.succ) ⟨i, Nat.le_of_succ_le_succ h⟩ x >>= f 0 := by
|
||||
induction i generalizing x with
|
||||
| zero =>
|
||||
rw [foldrM_loop_zero, foldrM_loop_succ, pure_bind]
|
||||
conv => rhs; rw [←bind_pure (f 0 x)]
|
||||
congr; funext; exact foldrM_loop_zero ..
|
||||
| succ i ih =>
|
||||
rw [foldrM_loop_succ, foldrM_loop_succ, bind_assoc]
|
||||
congr; funext; exact ih ..
|
||||
|
||||
@[simp] theorem foldrM_zero [Monad m] (f : Fin 0 → α → m α) (x) : foldrM 0 f x = pure x :=
|
||||
foldrM_loop_zero ..
|
||||
|
||||
theorem foldrM_succ [Monad m] [LawfulMonad m] (f : Fin (n+1) → α → m α) (x) :
|
||||
foldrM (n+1) f x = foldrM n (fun i => f i.succ) x >>= f 0 := foldrM_loop ..
|
||||
|
||||
/-! ### foldl -/
|
||||
|
||||
theorem foldl_loop_lt (f : α → Fin n → α) (x) (h : i < n) :
|
||||
foldl.loop n f x i = foldl.loop n f (f x ⟨i, h⟩) (i+1) := by
|
||||
rw [foldl.loop, dif_pos h]
|
||||
|
||||
theorem foldl_loop_eq (f : α → Fin n → α) (x) : foldl.loop n f x n = x := by
|
||||
rw [foldl.loop, dif_neg (Nat.lt_irrefl _)]
|
||||
|
||||
theorem foldl_loop (f : α → Fin (n+1) → α) (x) (h : i < n+1) :
|
||||
foldl.loop (n+1) f x i = foldl.loop n (fun x j => f x j.succ) (f x ⟨i, h⟩) i := by
|
||||
if h' : i < n then
|
||||
rw [foldl_loop_lt _ _ h]
|
||||
rw [foldl_loop_lt _ _ h', foldl_loop]; rfl
|
||||
else
|
||||
cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h')
|
||||
rw [foldl_loop_lt]
|
||||
rw [foldl_loop_eq, foldl_loop_eq]
|
||||
|
||||
@[simp] theorem foldl_zero (f : α → Fin 0 → α) (x) : foldl 0 f x = x :=
|
||||
foldl_loop_eq ..
|
||||
|
||||
theorem foldl_succ (f : α → Fin (n+1) → α) (x) :
|
||||
foldl (n+1) f x = foldl n (fun x i => f x i.succ) (f x 0) :=
|
||||
foldl_loop ..
|
||||
|
||||
theorem foldl_succ_last (f : α → Fin (n+1) → α) (x) :
|
||||
foldl (n+1) f x = f (foldl n (f · ·.castSucc) x) (last n) := by
|
||||
rw [foldl_succ]
|
||||
induction n generalizing x with
|
||||
| zero => simp [foldl_succ, Fin.last]
|
||||
| succ n ih => rw [foldl_succ, ih (f · ·.succ), foldl_succ]; simp [succ_castSucc]
|
||||
|
||||
theorem foldl_eq_foldlM (f : α → Fin n → α) (x) :
|
||||
foldl n f x = foldlM (m:=Id) n f x := by
|
||||
induction n generalizing x <;> simp [foldl_succ, foldlM_succ, *]
|
||||
|
||||
/-! ### foldr -/
|
||||
|
||||
theorem foldr_loop_zero (f : Fin n → α → α) (x) :
|
||||
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
|
||||
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, *]
|
||||
|
||||
@[simp] theorem foldr_zero (f : Fin 0 → α → α) (x) : foldr 0 f x = x :=
|
||||
foldr_loop_zero ..
|
||||
|
||||
theorem foldr_succ (f : Fin (n+1) → α → α) (x) :
|
||||
foldr (n+1) f x = f 0 (foldr n (fun i => f i.succ) x) := foldr_loop ..
|
||||
|
||||
theorem foldr_succ_last (f : Fin (n+1) → α → α) (x) :
|
||||
foldr (n+1) f x = foldr n (f ·.castSucc) (f (last n) x) := by
|
||||
induction n generalizing x with
|
||||
| zero => simp [foldr_succ, Fin.last]
|
||||
| succ n ih => rw [foldr_succ, ih (f ·.succ), foldr_succ]; simp [succ_castSucc]
|
||||
|
||||
theorem foldr_eq_foldrM (f : Fin n → α → α) (x) :
|
||||
foldr n f x = foldrM (m:=Id) n f x := by
|
||||
induction n <;> simp [foldr_succ, foldrM_succ, *]
|
||||
|
||||
theorem foldl_rev (f : Fin n → α → α) (x) :
|
||||
foldl n (fun x i => f i.rev x) x = foldr n f x := by
|
||||
induction n generalizing x with
|
||||
| zero => simp
|
||||
| succ n ih => rw [foldl_succ, foldr_succ_last, ← ih]; simp [rev_succ]
|
||||
|
||||
theorem foldr_rev (f : α → Fin n → α) (x) :
|
||||
foldr n (fun i x => f x i.rev) x = foldl n f x := by
|
||||
induction n generalizing x with
|
||||
| zero => simp
|
||||
| succ n ih => rw [foldl_succ_last, foldr_succ, ← ih]; simp [rev_succ]
|
||||
|
||||
end Fin
|
||||
|
||||
@@ -1267,7 +1267,7 @@ theorem bmod_le {x : Int} {m : Nat} (h : 0 < m) : bmod x m ≤ (m - 1) / 2 := by
|
||||
_ = ((m + 1 - 2) + 2)/2 := by simp
|
||||
_ = (m - 1) / 2 + 1 := by
|
||||
rw [add_ediv_of_dvd_right]
|
||||
· simp (config := {decide := true}) only [Int.ediv_self]
|
||||
· simp +decide only [Int.ediv_self]
|
||||
congr 2
|
||||
rw [Int.add_sub_assoc, ← Int.sub_neg]
|
||||
congr
|
||||
@@ -1285,7 +1285,7 @@ theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1
|
||||
simp only [bmod, ofNat_eq_coe, natAbs_ofNat, natCast_add, ofNat_one,
|
||||
emod_self_add_one (ofNat_nonneg x)]
|
||||
match x with
|
||||
| 0 => rw [if_pos] <;> simp (config := {decide := true})
|
||||
| 0 => rw [if_pos] <;> simp +decide
|
||||
| (x+1) =>
|
||||
rw [if_neg]
|
||||
· simp [← Int.sub_sub]
|
||||
|
||||
@@ -1007,9 +1007,9 @@ theorem sign_eq_neg_one_iff_neg {a : Int} : sign a = -1 ↔ a < 0 :=
|
||||
match x with
|
||||
| 0 => rfl
|
||||
| .ofNat (_ + 1) =>
|
||||
simp (config := { decide := true }) only [sign, true_iff]
|
||||
simp +decide only [sign, true_iff]
|
||||
exact Int.le_add_one (ofNat_nonneg _)
|
||||
| .negSucc _ => simp (config := { decide := true }) [sign]
|
||||
| .negSucc _ => simp +decide [sign]
|
||||
|
||||
theorem mul_sign : ∀ i : Int, i * sign i = natAbs i
|
||||
| succ _ => Int.mul_one _
|
||||
|
||||
@@ -25,3 +25,4 @@ import Init.Data.List.Perm
|
||||
import Init.Data.List.Sort
|
||||
import Init.Data.List.ToArray
|
||||
import Init.Data.List.MapIdx
|
||||
import Init.Data.List.OfFn
|
||||
|
||||
@@ -169,6 +169,13 @@ theorem pmap_ne_nil_iff {P : α → Prop} (f : (a : α) → P a → β) {xs : Li
|
||||
(H : ∀ (a : α), a ∈ xs → P a) : xs.pmap f H ≠ [] ↔ xs ≠ [] := by
|
||||
simp
|
||||
|
||||
theorem pmap_eq_self {l : List α} {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
|
||||
rw [pmap_eq_map_attach]
|
||||
conv => lhs; rhs; rw [← attach_map_subtype_val l]
|
||||
rw [map_inj_left]
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem attach_eq_nil_iff {l : List α} : l.attach = [] ↔ l = [] :=
|
||||
pmap_eq_nil_iff
|
||||
|
||||
@@ -153,7 +153,7 @@ theorem countP_filterMap (p : β → Bool) (f : α → Option β) (l : List α)
|
||||
simp only [length_filterMap_eq_countP]
|
||||
congr
|
||||
ext a
|
||||
simp (config := { contextual := true }) [Option.getD_eq_iff, Option.isSome_eq_isSome]
|
||||
simp +contextual [Option.getD_eq_iff, Option.isSome_eq_isSome]
|
||||
|
||||
@[simp] theorem countP_flatten (l : List (List α)) :
|
||||
countP p l.flatten = (l.map (countP p)).sum := by
|
||||
@@ -315,7 +315,7 @@ theorem replicate_count_eq_of_count_eq_length {l : List α} (h : count a l = len
|
||||
theorem count_le_count_map [DecidableEq β] (l : List α) (f : α → β) (x : α) :
|
||||
count x l ≤ count (f x) (map f l) := by
|
||||
rw [count, count, countP_map]
|
||||
apply countP_mono_left; simp (config := { contextual := true })
|
||||
apply countP_mono_left; simp +contextual
|
||||
|
||||
theorem count_filterMap {α} [BEq β] (b : β) (f : α → Option β) (l : List α) :
|
||||
count b (filterMap f l) = countP (fun a => f a == some b) l := by
|
||||
|
||||
@@ -179,7 +179,7 @@ theorem IsPrefix.findSome?_eq_some {l₁ l₂ : List α} {f : α → Option β}
|
||||
List.findSome? f l₁ = some b → List.findSome? f l₂ = some b := by
|
||||
rw [IsPrefix] at h
|
||||
obtain ⟨t, rfl⟩ := h
|
||||
simp (config := {contextual := true}) [findSome?_append]
|
||||
simp +contextual [findSome?_append]
|
||||
|
||||
theorem IsPrefix.findSome?_eq_none {l₁ l₂ : List α} {f : α → Option β} (h : l₁ <+: l₂) :
|
||||
List.findSome? f l₂ = none → List.findSome? f l₁ = none :=
|
||||
@@ -436,7 +436,7 @@ theorem IsPrefix.find?_eq_some {l₁ l₂ : List α} {p : α → Bool} (h : l₁
|
||||
List.find? p l₁ = some b → List.find? p l₂ = some b := by
|
||||
rw [IsPrefix] at h
|
||||
obtain ⟨t, rfl⟩ := h
|
||||
simp (config := {contextual := true}) [find?_append]
|
||||
simp +contextual [find?_append]
|
||||
|
||||
theorem IsPrefix.find?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l₁ <+: l₂) :
|
||||
List.find? p l₂ = none → List.find? p l₁ = none :=
|
||||
@@ -562,7 +562,7 @@ theorem not_of_lt_findIdx {p : α → Bool} {xs : List α} {i : Nat} (h : i < xs
|
||||
| inr e =>
|
||||
have ipm := Nat.succ_pred_eq_of_pos e
|
||||
have ilt := Nat.le_trans ho (findIdx_le_length p)
|
||||
simp (config := { singlePass := true }) only [← ipm, getElem_cons_succ]
|
||||
simp +singlePass only [← ipm, getElem_cons_succ]
|
||||
rw [← ipm, Nat.succ_lt_succ_iff] at h
|
||||
simpa using ih h
|
||||
|
||||
|
||||
@@ -3328,7 +3328,7 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
|
||||
|
||||
@[simp] theorem all_replicate {n : Nat} {a : α} :
|
||||
(replicate n a).all f = if n = 0 then true else f a := by
|
||||
cases n <;> simp (config := {contextual := true}) [replicate_succ]
|
||||
cases n <;> simp +contextual [replicate_succ]
|
||||
|
||||
@[simp] theorem any_insert [BEq α] [LawfulBEq α] {l : List α} {a : α} :
|
||||
(l.insert a).any f = (f a || l.any f) := by
|
||||
|
||||
@@ -7,6 +7,9 @@ Authors: Kim Morrison, Mario Carneiro
|
||||
prelude
|
||||
import Init.Data.Array.Lemmas
|
||||
import Init.Data.List.Nat.Range
|
||||
import Init.Data.List.OfFn
|
||||
import Init.Data.Fin.Lemmas
|
||||
import Init.Data.Option.Attach
|
||||
|
||||
namespace List
|
||||
|
||||
@@ -14,8 +17,21 @@ namespace List
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
|
||||
/--
|
||||
Given a function `f : Nat → α → β` and `as : list α`, `as = [a₀, a₁, ...]`, returns the list
|
||||
Given a list `as = [a₀, a₁, ...]` function `f : Fin as.length → α → β`, returns the list
|
||||
`[f 0 a₀, f 1 a₁, ...]`.
|
||||
-/
|
||||
@[inline] def mapFinIdx (as : List α) (f : Fin as.length → α → β) : List β := go as #[] (by simp) where
|
||||
/-- Auxiliary for `mapFinIdx`:
|
||||
`mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
|
||||
@[specialize] go : (bs : List α) → (acc : Array β) → bs.length + acc.size = as.length → List β
|
||||
| [], acc, h => acc.toList
|
||||
| a :: as, acc, h =>
|
||||
go as (acc.push (f ⟨acc.size, by simp at h; omega⟩ a)) (by simp at h ⊢; omega)
|
||||
|
||||
/--
|
||||
Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁, ...]`, returns the list
|
||||
`[f 0 a₀, f 1 a₁, ...]`.
|
||||
-/
|
||||
@[inline] def mapIdx (f : Nat → α → β) (as : List α) : List β := go as #[] where
|
||||
@@ -25,34 +41,177 @@ Given a function `f : Nat → α → β` and `as : list α`, `as = [a₀, a₁,
|
||||
| [], acc => acc.toList
|
||||
| a :: as, acc => go as (acc.push (f acc.size a))
|
||||
|
||||
/-! ### mapFinIdx -/
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_nil {f : Fin 0 → α → β} : mapFinIdx [] f = [] :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem length_mapFinIdx_go :
|
||||
(mapFinIdx.go as f bs acc h).length = as.length := by
|
||||
induction bs generalizing acc with
|
||||
| nil => simpa using h
|
||||
| cons _ _ ih => simp [mapFinIdx.go, ih]
|
||||
|
||||
@[simp] theorem length_mapFinIdx {as : List α} {f : Fin as.length → α → β} :
|
||||
(as.mapFinIdx f).length = as.length := by
|
||||
simp [mapFinIdx, length_mapFinIdx_go]
|
||||
|
||||
theorem getElem_mapFinIdx_go {as : List α} {f : Fin as.length → α → β} {i : Nat} {h} {w} :
|
||||
(mapFinIdx.go as f bs acc h)[i] =
|
||||
if w' : i < acc.size then acc[i] else f ⟨i, by simp at w; omega⟩ (bs[i - acc.size]'(by simp at w; omega)) := by
|
||||
induction bs generalizing acc with
|
||||
| nil =>
|
||||
simp only [length_mapFinIdx_go, length_nil, Nat.zero_add] at w h
|
||||
simp only [mapFinIdx.go, Array.getElem_toList]
|
||||
rw [dif_pos]
|
||||
| cons _ _ ih =>
|
||||
simp [mapFinIdx.go]
|
||||
rw [ih]
|
||||
simp
|
||||
split <;> rename_i h₁ <;> split <;> rename_i h₂
|
||||
· rw [Array.getElem_push_lt]
|
||||
· have h₃ : i = acc.size := by omega
|
||||
subst h₃
|
||||
simp
|
||||
· omega
|
||||
· have h₃ : i - acc.size = (i - (acc.size + 1)) + 1 := by omega
|
||||
simp [h₃]
|
||||
|
||||
@[simp] theorem getElem_mapFinIdx {as : List α} {f : Fin as.length → α → β} {i : Nat} {h} :
|
||||
(as.mapFinIdx f)[i] = f ⟨i, by simp at h; omega⟩ (as[i]'(by simp at h; omega)) := by
|
||||
simp [mapFinIdx, getElem_mapFinIdx_go]
|
||||
|
||||
theorem mapFinIdx_eq_ofFn {as : List α} {f : Fin as.length → α → β} :
|
||||
as.mapFinIdx f = List.ofFn fun i : Fin as.length => f i as[i] := by
|
||||
apply ext_getElem <;> simp
|
||||
|
||||
@[simp] theorem getElem?_mapFinIdx {l : List α} {f : Fin l.length → α → β} {i : Nat} :
|
||||
(l.mapFinIdx f)[i]? = l[i]?.pbind fun x m => f ⟨i, by simp [getElem?_eq_some] at m; exact m.1⟩ x := by
|
||||
simp only [getElem?_eq, length_mapFinIdx, getElem_mapFinIdx]
|
||||
split <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_cons {l : List α} {a : α} {f : Fin (l.length + 1) → α → β} :
|
||||
mapFinIdx (a :: l) f = f 0 a :: mapFinIdx l (fun i => f i.succ) := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· rintro (_|i) h₁ h₂ <;> simp
|
||||
|
||||
theorem mapFinIdx_append {K L : List α} {f : Fin (K ++ L).length → α → β} :
|
||||
(K ++ L).mapFinIdx f =
|
||||
K.mapFinIdx (fun i => f (i.castLE (by simp))) ++ L.mapFinIdx (fun i => f ((i.natAdd K.length).cast (by simp))) := by
|
||||
apply ext_getElem
|
||||
· simp
|
||||
· intro i h₁ h₂
|
||||
rw [getElem_append]
|
||||
simp only [getElem_mapFinIdx, length_mapFinIdx]
|
||||
split <;> rename_i h
|
||||
· rw [getElem_append_left]
|
||||
congr
|
||||
· simp only [Nat.not_lt] at h
|
||||
rw [getElem_append_right h]
|
||||
congr
|
||||
simp
|
||||
omega
|
||||
|
||||
@[simp] theorem mapFinIdx_concat {l : List α} {e : α} {f : Fin (l ++ [e]).length → α → β}:
|
||||
(l ++ [e]).mapFinIdx f = l.mapFinIdx (fun i => f (i.castLE (by simp))) ++ [f ⟨l.length, by simp⟩ e] := by
|
||||
simp [mapFinIdx_append]
|
||||
congr
|
||||
|
||||
theorem mapFinIdx_singleton {a : α} {f : Fin 1 → α → β} :
|
||||
[a].mapFinIdx f = [f ⟨0, by simp⟩ a] := by
|
||||
simp
|
||||
|
||||
theorem mapFinIdx_eq_enum_map {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l.enum.attach.map
|
||||
fun ⟨⟨i, x⟩, m⟩ => f ⟨i, by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some] at m; exact m.1⟩ x := by
|
||||
apply ext_getElem <;> simp
|
||||
|
||||
@[simp]
|
||||
theorem mapFinIdx_eq_nil_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = [] ↔ l = [] := by
|
||||
rw [mapFinIdx_eq_enum_map, map_eq_nil_iff, attach_eq_nil_iff, enum_eq_nil_iff]
|
||||
|
||||
theorem mapFinIdx_ne_nil_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f ≠ [] ↔ l ≠ [] := by
|
||||
simp
|
||||
|
||||
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length → α → β}
|
||||
(h : b ∈ l.mapFinIdx f) : ∃ (i : Fin l.length), f i l[i] = b := by
|
||||
rw [mapFinIdx_eq_enum_map] at h
|
||||
replace h := exists_of_mem_map h
|
||||
simp only [mem_attach, true_and, Subtype.exists, Prod.exists, mk_mem_enum_iff_getElem?] at h
|
||||
obtain ⟨i, b, h, rfl⟩ := h
|
||||
rw [getElem?_eq_some_iff] at h
|
||||
obtain ⟨h', rfl⟩ := h
|
||||
exact ⟨⟨i, h'⟩, rfl⟩
|
||||
|
||||
@[simp] theorem mem_mapFinIdx {b : β} {l : List α} {f : Fin l.length → α → β} :
|
||||
b ∈ l.mapFinIdx f ↔ ∃ (i : Fin l.length), f i l[i] = b := by
|
||||
constructor
|
||||
· intro h
|
||||
exact exists_of_mem_mapFinIdx h
|
||||
· rintro ⟨i, h, rfl⟩
|
||||
rw [mem_iff_getElem]
|
||||
exact ⟨i, by simp⟩
|
||||
|
||||
theorem mapFinIdx_eq_cons_iff {l : List α} {b : β} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = b :: l₂ ↔
|
||||
∃ (a : α) (l₁ : List α) (h : l = a :: l₁),
|
||||
f ⟨0, by simp [h]⟩ a = b ∧ l₁.mapFinIdx (fun i => f (i.succ.cast (by simp [h]))) = l₂ := by
|
||||
cases l with
|
||||
| nil => simp
|
||||
| cons x l' =>
|
||||
simp only [mapFinIdx_cons, cons.injEq, length_cons, Fin.zero_eta, Fin.cast_succ_eq,
|
||||
exists_and_left]
|
||||
constructor
|
||||
· rintro ⟨rfl, rfl⟩
|
||||
refine ⟨x, rfl, l', by simp⟩
|
||||
· rintro ⟨a, ⟨rfl, h⟩, ⟨_, ⟨rfl, rfl⟩, h⟩⟩
|
||||
exact ⟨rfl, h⟩
|
||||
|
||||
theorem mapFinIdx_eq_cons_iff' {l : List α} {b : β} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = b :: l₂ ↔
|
||||
l.head?.pbind (fun x m => (f ⟨0, by cases l <;> simp_all⟩ x)) = some b ∧
|
||||
l.tail?.attach.map (fun ⟨t, m⟩ => t.mapFinIdx fun i => f (i.succ.cast (by cases l <;> simp_all))) = some l₂ := by
|
||||
cases l <;> simp
|
||||
|
||||
theorem mapFinIdx_eq_iff {l : List α} {f : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l' ↔ ∃ h : l'.length = l.length, ∀ (i : Nat) (h : i < l.length), l'[i] = f ⟨i, h⟩ l[i] := by
|
||||
constructor
|
||||
· rintro rfl
|
||||
simp
|
||||
· rintro ⟨h, w⟩
|
||||
apply ext_getElem <;> simp_all
|
||||
|
||||
theorem mapFinIdx_eq_mapFinIdx_iff {l : List α} {f g : Fin l.length → α → β} :
|
||||
l.mapFinIdx f = l.mapFinIdx g ↔ ∀ (i : Fin l.length), f i l[i] = g i l[i] := by
|
||||
rw [eq_comm, mapFinIdx_eq_iff]
|
||||
simp [Fin.forall_iff]
|
||||
|
||||
@[simp] theorem mapFinIdx_mapFinIdx {l : List α} {f : Fin l.length → α → β} {g : Fin _ → β → γ} :
|
||||
(l.mapFinIdx f).mapFinIdx g = l.mapFinIdx (fun i => g (i.cast (by simp)) ∘ f i) := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapFinIdx_eq_replicate_iff {l : List α} {f : Fin l.length → α → β} {b : β} :
|
||||
l.mapFinIdx f = replicate l.length b ↔ ∀ (i : Fin l.length), f i l[i] = b := by
|
||||
simp [eq_replicate_iff, length_mapFinIdx, mem_mapFinIdx, forall_exists_index, true_and]
|
||||
|
||||
@[simp] theorem mapFinIdx_reverse {l : List α} {f : Fin l.reverse.length → α → β} :
|
||||
l.reverse.mapFinIdx f = (l.mapFinIdx (fun i => f ⟨l.length - 1 - i, by simp; omega⟩)).reverse := by
|
||||
simp [mapFinIdx_eq_iff]
|
||||
intro i h
|
||||
congr
|
||||
omega
|
||||
|
||||
/-! ### mapIdx -/
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_nil {f : Nat → α → β} : mapIdx f [] = [] :=
|
||||
rfl
|
||||
|
||||
theorem mapIdx_go_append {l₁ l₂ : List α} {arr : Array β} :
|
||||
mapIdx.go f (l₁ ++ l₂) arr = mapIdx.go f l₂ (List.toArray (mapIdx.go f l₁ arr)) := by
|
||||
generalize h : (l₁ ++ l₂).length = len
|
||||
induction len generalizing l₁ arr with
|
||||
| zero =>
|
||||
have l₁_nil : l₁ = [] := by
|
||||
cases l₁
|
||||
· rfl
|
||||
· contradiction
|
||||
have l₂_nil : l₂ = [] := by
|
||||
cases l₂
|
||||
· rfl
|
||||
· rw [List.length_append] at h; contradiction
|
||||
rw [l₁_nil, l₂_nil]; simp only [mapIdx.go, List.toArray_toList]
|
||||
| succ len ih =>
|
||||
cases l₁ with
|
||||
| nil =>
|
||||
simp only [mapIdx.go, nil_append, List.toArray_toList]
|
||||
| cons head tail =>
|
||||
simp only [mapIdx.go, List.append_eq]
|
||||
rw [ih]
|
||||
· simp only [cons_append, length_cons, length_append, Nat.succ.injEq] at h
|
||||
simp only [length_append, h]
|
||||
|
||||
theorem mapIdx_go_length {arr : Array β} :
|
||||
length (mapIdx.go f l arr) = length l + arr.size := by
|
||||
induction l generalizing arr with
|
||||
@@ -60,16 +219,6 @@ theorem mapIdx_go_length {arr : Array β} :
|
||||
| cons _ _ ih =>
|
||||
simp only [mapIdx.go, ih, Array.size_push, Nat.add_succ, length_cons, Nat.add_comm]
|
||||
|
||||
@[simp] theorem mapIdx_concat {l : List α} {e : α} :
|
||||
mapIdx f (l ++ [e]) = mapIdx f l ++ [f l.length e] := by
|
||||
unfold mapIdx
|
||||
rw [mapIdx_go_append]
|
||||
simp only [mapIdx.go, Array.size_toArray, mapIdx_go_length, length_nil, Nat.add_zero,
|
||||
Array.push_toList]
|
||||
|
||||
@[simp] theorem mapIdx_singleton {a : α} : mapIdx f [a] = [f 0 a] := by
|
||||
simpa using mapIdx_concat (l := [])
|
||||
|
||||
theorem length_mapIdx_go : ∀ {l : List α} {arr : Array β},
|
||||
(mapIdx.go f l arr).length = l.length + arr.size
|
||||
| [], _ => by simp [mapIdx.go]
|
||||
@@ -112,6 +261,15 @@ theorem getElem?_mapIdx_go : ∀ {l : List α} {arr : Array β} {i : Nat},
|
||||
rw [← getElem?_eq_getElem, getElem?_mapIdx, getElem?_eq_getElem (by simpa using h)]
|
||||
simp
|
||||
|
||||
@[simp] theorem mapFinIdx_eq_mapIdx {l : List α} {f : Fin l.length → α → β} {g : Nat → α → β}
|
||||
(h : ∀ (i : Fin l.length), f i l[i] = g i l[i]) :
|
||||
l.mapFinIdx f = l.mapIdx g := by
|
||||
simp_all [mapFinIdx_eq_iff]
|
||||
|
||||
theorem mapIdx_eq_mapFinIdx {l : List α} {f : Nat → α → β} :
|
||||
l.mapIdx f = l.mapFinIdx (fun i => f i) := by
|
||||
simp [mapFinIdx_eq_mapIdx]
|
||||
|
||||
theorem mapIdx_eq_enum_map {l : List α} :
|
||||
l.mapIdx f = l.enum.map (Function.uncurry f) := by
|
||||
ext1 i
|
||||
@@ -130,9 +288,16 @@ theorem mapIdx_append {K L : List α} :
|
||||
| nil => rfl
|
||||
| cons _ _ ih => simp [ih (f := fun i => f (i + 1)), Nat.add_assoc]
|
||||
|
||||
@[simp] theorem mapIdx_concat {l : List α} {e : α} :
|
||||
mapIdx f (l ++ [e]) = mapIdx f l ++ [f l.length e] := by
|
||||
simp [mapIdx_append]
|
||||
|
||||
theorem mapIdx_singleton {a : α} : mapIdx f [a] = [f 0 a] := by
|
||||
simp
|
||||
|
||||
@[simp]
|
||||
theorem mapIdx_eq_nil_iff {l : List α} : List.mapIdx f l = [] ↔ l = [] := by
|
||||
rw [List.mapIdx_eq_enum_map, List.map_eq_nil_iff, List.enum_eq_nil]
|
||||
rw [List.mapIdx_eq_enum_map, List.map_eq_nil_iff, List.enum_eq_nil_iff]
|
||||
|
||||
theorem mapIdx_ne_nil_iff {l : List α} :
|
||||
List.mapIdx f l ≠ [] ↔ l ≠ [] := by
|
||||
@@ -140,13 +305,8 @@ theorem mapIdx_ne_nil_iff {l : List α} :
|
||||
|
||||
theorem exists_of_mem_mapIdx {b : β} {l : List α}
|
||||
(h : b ∈ mapIdx f l) : ∃ (i : Nat) (h : i < l.length), f i l[i] = b := by
|
||||
rw [mapIdx_eq_enum_map] at h
|
||||
replace h := exists_of_mem_map h
|
||||
simp only [Prod.exists, mk_mem_enum_iff_getElem?, Function.uncurry_apply_pair] at h
|
||||
obtain ⟨i, b, h, rfl⟩ := h
|
||||
rw [getElem?_eq_some_iff] at h
|
||||
obtain ⟨h, rfl⟩ := h
|
||||
exact ⟨i, h, rfl⟩
|
||||
rw [mapIdx_eq_mapFinIdx] at h
|
||||
simpa [Fin.exists_iff] using exists_of_mem_mapFinIdx h
|
||||
|
||||
@[simp] theorem mem_mapIdx {b : β} {l : List α} :
|
||||
b ∈ mapIdx f l ↔ ∃ (i : Nat) (h : i < l.length), f i l[i] = b := by
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.TakeDrop
|
||||
import Init.Data.List.Attach
|
||||
|
||||
/-!
|
||||
# Lemmas about `List.mapM` and `List.forM`.
|
||||
@@ -75,6 +76,16 @@ theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α → m β)
|
||||
reverse_cons, reverse_nil, nil_append, singleton_append]
|
||||
simp [bind_pure_comp]
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : List β₁) (init : α) :
|
||||
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : List β₁)
|
||||
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
/-! ### forM -/
|
||||
|
||||
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
|
||||
@@ -154,6 +165,65 @@ theorem forIn'_loop_congr [Monad m] {as bs : List α}
|
||||
intro a m b
|
||||
exact h a (mem_cons_of_mem _ m) b
|
||||
|
||||
/--
|
||||
We can express a for loop over a list 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 : List α) (f : (a : α) → a ∈ l → β → m (ForInStep β)) (init : β) :
|
||||
forIn' l init f = ForInStep.value <$>
|
||||
l.attach.foldlM (fun b a => match b with
|
||||
| .yield b => f a.1 a.2 b
|
||||
| .done b => pure (.done b)) (ForInStep.yield init) := by
|
||||
induction l generalizing init with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [forIn'_cons, attach_cons, foldlM_cons, _root_.map_bind]
|
||||
congr 1
|
||||
funext x
|
||||
match x with
|
||||
| .done b =>
|
||||
clear ih
|
||||
dsimp
|
||||
induction as with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [attach_cons, map_cons, map_map, Function.comp_def, foldlM_cons, pure_bind]
|
||||
specialize ih (fun a m b => f a (by
|
||||
simp only [mem_cons] at m
|
||||
rcases m with rfl|m
|
||||
· apply mem_cons_self
|
||||
· exact mem_cons_of_mem _ (mem_cons_of_mem _ m)) b)
|
||||
simp [ih, List.foldlM_map]
|
||||
| .yield b =>
|
||||
simp [ih, List.foldlM_map]
|
||||
|
||||
/--
|
||||
We can express a for loop over a list 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 : List α) :
|
||||
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
|
||||
induction l generalizing init with
|
||||
| nil => simp
|
||||
| cons a as ih =>
|
||||
simp only [foldlM_cons, bind_pure_comp, forIn_cons, _root_.map_bind]
|
||||
congr 1
|
||||
funext x
|
||||
match x with
|
||||
| .done b =>
|
||||
clear ih
|
||||
dsimp
|
||||
induction as with
|
||||
| nil => simp
|
||||
| cons a as ih => simp [ih]
|
||||
| .yield b =>
|
||||
simp [ih]
|
||||
|
||||
/-! ### allM -/
|
||||
|
||||
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : List α) :
|
||||
@@ -166,14 +236,4 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
|
||||
funext b
|
||||
split <;> simp_all
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : List β₁) (init : α) :
|
||||
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : List β₁)
|
||||
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
|
||||
induction l generalizing g init <;> simp [*]
|
||||
|
||||
end List
|
||||
|
||||
@@ -64,3 +64,82 @@ theorem getElem_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : j < (l.era
|
||||
(l.eraseIdx i)[j] = l[j + 1]'(by rw [length_eraseIdx] at h; split at h <;> omega) := by
|
||||
rw [getElem_eraseIdx, dif_neg]
|
||||
omega
|
||||
|
||||
theorem eraseIdx_set_eq {l : List α} {i : Nat} {a : α} :
|
||||
(l.set i a).eraseIdx i = l.eraseIdx i := by
|
||||
apply ext_getElem
|
||||
· simp [length_eraseIdx]
|
||||
· intro n h₁ h₂
|
||||
rw [getElem_eraseIdx, getElem_eraseIdx]
|
||||
split <;>
|
||||
· rw [getElem_set_ne]
|
||||
omega
|
||||
|
||||
theorem eraseIdx_set_lt {l : List α} {i : Nat} {j : Nat} {a : α} (h : j < i) :
|
||||
(l.set i a).eraseIdx j = (l.eraseIdx j).set (i - 1) a := by
|
||||
apply ext_getElem
|
||||
· simp [length_eraseIdx]
|
||||
· intro n h₁ h₂
|
||||
simp only [length_eraseIdx, length_set] at h₁
|
||||
simp only [getElem_eraseIdx, getElem_set]
|
||||
split
|
||||
· split
|
||||
· split
|
||||
· rfl
|
||||
· omega
|
||||
· split
|
||||
· omega
|
||||
· rfl
|
||||
· split
|
||||
· split
|
||||
· rfl
|
||||
· omega
|
||||
· have t : i - 1 ≠ n := by omega
|
||||
simp [t]
|
||||
|
||||
theorem eraseIdx_set_gt {l : List α} {i : Nat} {j : Nat} {a : α} (h : i < j) :
|
||||
(l.set i a).eraseIdx j = (l.eraseIdx j).set i a := by
|
||||
apply ext_getElem
|
||||
· simp [length_eraseIdx]
|
||||
· intro n h₁ h₂
|
||||
simp only [length_eraseIdx, length_set] at h₁
|
||||
simp only [getElem_eraseIdx, getElem_set]
|
||||
split
|
||||
· rfl
|
||||
· split
|
||||
· split
|
||||
· rfl
|
||||
· omega
|
||||
· have t : i ≠ n := by omega
|
||||
simp [t]
|
||||
|
||||
@[simp] theorem set_getElem_succ_eraseIdx_succ
|
||||
{l : List α} {i : Nat} (h : i + 1 < l.length) :
|
||||
(l.eraseIdx (i + 1)).set i l[i + 1] = l.eraseIdx i := by
|
||||
apply ext_getElem
|
||||
· simp only [length_set, length_eraseIdx, h, ↓reduceIte]
|
||||
rw [if_pos]
|
||||
omega
|
||||
· intro n h₁ h₂
|
||||
simp [getElem_set, getElem_eraseIdx]
|
||||
split
|
||||
· split
|
||||
· omega
|
||||
· simp_all
|
||||
· split
|
||||
· split
|
||||
· rfl
|
||||
· omega
|
||||
· have t : ¬ n < i := by omega
|
||||
simp [t]
|
||||
|
||||
@[simp] theorem eraseIdx_length_sub_one (l : List α) :
|
||||
(l.eraseIdx (l.length - 1)) = l.dropLast := by
|
||||
apply ext_getElem
|
||||
· simp [length_eraseIdx]
|
||||
omega
|
||||
· intro n h₁ h₂
|
||||
rw [getElem_eraseIdx_of_lt, getElem_dropLast]
|
||||
simp_all
|
||||
|
||||
end List
|
||||
|
||||
@@ -169,7 +169,7 @@ theorem not_mem_range_self {n : Nat} : n ∉ range n := by simp
|
||||
theorem self_mem_range_succ (n : Nat) : n ∈ range (n + 1) := by simp
|
||||
|
||||
theorem pairwise_lt_range (n : Nat) : Pairwise (· < ·) (range n) := by
|
||||
simp (config := {decide := true}) only [range_eq_range', pairwise_lt_range']
|
||||
simp +decide only [range_eq_range', pairwise_lt_range']
|
||||
|
||||
theorem pairwise_le_range (n : Nat) : Pairwise (· ≤ ·) (range n) :=
|
||||
Pairwise.imp Nat.le_of_lt (pairwise_lt_range _)
|
||||
@@ -177,10 +177,10 @@ theorem pairwise_le_range (n : Nat) : Pairwise (· ≤ ·) (range n) :=
|
||||
theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
|
||||
apply List.ext_getElem
|
||||
· simp
|
||||
· simp (config := { contextual := true }) [getElem_take, Nat.lt_min]
|
||||
· simp +contextual [getElem_take, Nat.lt_min]
|
||||
|
||||
theorem nodup_range (n : Nat) : Nodup (range n) := by
|
||||
simp (config := {decide := true}) only [range_eq_range', nodup_range']
|
||||
simp +decide only [range_eq_range', nodup_range']
|
||||
|
||||
@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
|
||||
(range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
|
||||
@@ -430,7 +430,10 @@ theorem enumFrom_eq_append_iff {l : List α} {n : Nat} :
|
||||
/-! ### enum -/
|
||||
|
||||
@[simp]
|
||||
theorem enum_eq_nil {l : List α} : List.enum l = [] ↔ l = [] := enumFrom_eq_nil
|
||||
theorem enum_eq_nil_iff {l : List α} : List.enum l = [] ↔ l = [] := enumFrom_eq_nil
|
||||
|
||||
@[deprecated enum_eq_nil_iff (since := "2024-11-04")]
|
||||
theorem enum_eq_nil {l : List α} : List.enum l = [] ↔ l = [] := enum_eq_nil_iff
|
||||
|
||||
@[simp] theorem enum_singleton (x : α) : enum [x] = [(0, x)] := rfl
|
||||
|
||||
|
||||
55
src/Init/Data/List/OfFn.lean
Normal file
55
src/Init/Data/List/OfFn.lean
Normal file
@@ -0,0 +1,55 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Kim Morrison
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.Basic
|
||||
import Init.Data.Fin.Fold
|
||||
|
||||
/-!
|
||||
# Theorems about `List.ofFn`
|
||||
-/
|
||||
|
||||
namespace List
|
||||
|
||||
/--
|
||||
`ofFn f` with `f : fin n → α` returns the list whose ith element is `f i`
|
||||
```
|
||||
ofFn f = [f 0, f 1, ... , f (n - 1)]
|
||||
```
|
||||
-/
|
||||
def ofFn {n} (f : Fin n → α) : List α := Fin.foldr n (f · :: ·) []
|
||||
|
||||
@[simp]
|
||||
theorem length_ofFn (f : Fin n → α) : (ofFn f).length = n := by
|
||||
simp only [ofFn]
|
||||
induction n with
|
||||
| zero => simp
|
||||
| succ n ih => simp [Fin.foldr_succ, ih]
|
||||
|
||||
@[simp]
|
||||
protected theorem getElem_ofFn (f : Fin n → α) (i : Nat) (h : i < (ofFn f).length) :
|
||||
(ofFn f)[i] = f ⟨i, by simp_all⟩ := by
|
||||
simp only [ofFn]
|
||||
induction n generalizing i with
|
||||
| zero => simp at h
|
||||
| succ n ih =>
|
||||
match i with
|
||||
| 0 => simp [Fin.foldr_succ]
|
||||
| i+1 =>
|
||||
simp only [Fin.foldr_succ]
|
||||
apply ih
|
||||
simp_all
|
||||
|
||||
@[simp]
|
||||
protected theorem getElem?_ofFn (f : Fin n → α) (i) : (ofFn f)[i]? = if h : i < n then some (f ⟨i, h⟩) else none :=
|
||||
if h : i < (ofFn f).length
|
||||
then by
|
||||
rw [getElem?_eq_getElem h, List.getElem_ofFn]
|
||||
· simp only [length_ofFn] at h; simp [h]
|
||||
else by
|
||||
rw [dif_neg] <;>
|
||||
simpa using h
|
||||
|
||||
end List
|
||||
@@ -76,11 +76,11 @@ theorem pairwise_of_forall {l : List α} (H : ∀ x y, R x y) : Pairwise R l :=
|
||||
|
||||
theorem Pairwise.and_mem {l : List α} :
|
||||
Pairwise R l ↔ Pairwise (fun x y => x ∈ l ∧ y ∈ l ∧ R x y) l :=
|
||||
Pairwise.iff_of_mem <| by simp (config := { contextual := true })
|
||||
Pairwise.iff_of_mem <| by simp +contextual
|
||||
|
||||
theorem Pairwise.imp_mem {l : List α} :
|
||||
Pairwise R l ↔ Pairwise (fun x y => x ∈ l → y ∈ l → R x y) l :=
|
||||
Pairwise.iff_of_mem <| by simp (config := { contextual := true })
|
||||
Pairwise.iff_of_mem <| by simp +contextual
|
||||
|
||||
theorem Pairwise.forall_of_forall_of_flip (h₁ : ∀ x ∈ l, R x x) (h₂ : Pairwise R l)
|
||||
(h₃ : l.Pairwise (flip R)) : ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → R x y := by
|
||||
|
||||
@@ -116,7 +116,7 @@ fun s => Subset.trans s <| subset_append_right _ _
|
||||
theorem replicate_subset {n : Nat} {a : α} {l : List α} : replicate n a ⊆ l ↔ n = 0 ∨ a ∈ l := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
| succ n ih => simp (config := {contextual := true}) [replicate_succ, ih, cons_subset]
|
||||
| succ n ih => simp +contextual [replicate_succ, ih, cons_subset]
|
||||
|
||||
theorem subset_replicate {n : Nat} {a : α} {l : List α} (h : n ≠ 0) : l ⊆ replicate n a ↔ ∀ x ∈ l, x = a := by
|
||||
induction l with
|
||||
@@ -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 (config := {occs := .pos [2]}) [← Nat.and_forall_add_one]
|
||||
rw (occs := .pos [2]) [← Nat.and_forall_add_one]
|
||||
simp [Nat.succ_lt_succ_iff, eq_comm]
|
||||
|
||||
theorem isPrefix_iff_getElem {l₁ l₂ : List α} :
|
||||
|
||||
@@ -190,7 +190,7 @@ theorem set_drop {l : List α} {n m : Nat} {a : α} :
|
||||
theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) :
|
||||
(l.take i).concat l[i] = l.take (i+1) :=
|
||||
Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by
|
||||
rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop]
|
||||
rw [concat_eq_append, append_assoc, singleton_append, getElem_cons_drop_succ_eq_drop, take_append_drop]
|
||||
|
||||
@[deprecated take_succ_cons (since := "2024-07-25")]
|
||||
theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl
|
||||
|
||||
@@ -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 (config := {occs := .pos [2]}) [← mod_add_div a b]
|
||||
rw (occs := .pos [2]) [← mod_add_div a b]
|
||||
have ⟨x, h⟩ := h
|
||||
subst h
|
||||
rw [Nat.mul_assoc, add_mul_mod_self_left]
|
||||
|
||||
@@ -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 (config := {occs := .pos [1]}) [← mod_add_div a n]
|
||||
rw (config := {occs := .pos [1]}) [← mod_add_div b n]
|
||||
rw (occs := .pos [1]) [← mod_add_div a n]
|
||||
rw (occs := .pos [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]
|
||||
|
||||
@@ -374,9 +374,15 @@ end choice
|
||||
|
||||
-- See `Init.Data.Option.List` for lemmas about `toList`.
|
||||
|
||||
@[simp] theorem or_some : (some a).or o = some a := rfl
|
||||
@[simp] theorem some_or : (some a).or o = some a := rfl
|
||||
@[simp] theorem none_or : none.or o = o := rfl
|
||||
|
||||
@[deprecated some_or (since := "2024-11-03")] theorem or_some : (some a).or o = some a := rfl
|
||||
|
||||
/-- This will be renamed to `or_some` once the existing deprecated lemma is removed. -/
|
||||
@[simp] theorem or_some' {o : Option α} : o.or (some a) = o.getD a := by
|
||||
cases o <;> rfl
|
||||
|
||||
theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
|
||||
cases o <;> rfl
|
||||
|
||||
|
||||
@@ -22,6 +22,36 @@ structure Int8 where
|
||||
-/
|
||||
toUInt8 : UInt8
|
||||
|
||||
/--
|
||||
The type of signed 16-bit integers. This type has special support in the
|
||||
compiler to make it actually 16 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure Int16 where
|
||||
/--
|
||||
Obtain the `UInt16` that is 2's complement equivalent to the `Int16`.
|
||||
-/
|
||||
toUInt16 : UInt16
|
||||
|
||||
/--
|
||||
The type of signed 32-bit integers. This type has special support in the
|
||||
compiler to make it actually 32 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure Int32 where
|
||||
/--
|
||||
Obtain the `UInt32` that is 2's complement equivalent to the `Int32`.
|
||||
-/
|
||||
toUInt32 : UInt32
|
||||
|
||||
/--
|
||||
The type of signed 64-bit integers. This type has special support in the
|
||||
compiler to make it actually 64 bits rather than wrapping a `Nat`.
|
||||
-/
|
||||
structure Int64 where
|
||||
/--
|
||||
Obtain the `UInt64` that is 2's complement equivalent to the `Int64`.
|
||||
-/
|
||||
toUInt64 : UInt64
|
||||
|
||||
/-- The size of type `Int8`, that is, `2^8 = 256`. -/
|
||||
abbrev Int8.size : Nat := 256
|
||||
|
||||
@@ -32,12 +62,16 @@ Obtain the `BitVec` that contains the 2's complement representation of the `Int8
|
||||
|
||||
@[extern "lean_int8_of_int"]
|
||||
def Int8.ofInt (i : @& Int) : Int8 := ⟨⟨BitVec.ofInt 8 i⟩⟩
|
||||
@[extern "lean_int8_of_int"]
|
||||
@[extern "lean_int8_of_nat"]
|
||||
def Int8.ofNat (n : @& Nat) : Int8 := ⟨⟨BitVec.ofNat 8 n⟩⟩
|
||||
abbrev Int.toInt8 := Int8.ofInt
|
||||
abbrev Nat.toInt8 := Int8.ofNat
|
||||
@[extern "lean_int8_to_int"]
|
||||
def Int8.toInt (i : Int8) : Int := i.toBitVec.toInt
|
||||
/--
|
||||
This function has the same behavior as `Int.toNat` for negative numbers.
|
||||
If you want to obtain the 2's complement representation use `toBitVec`.
|
||||
-/
|
||||
@[inline] def Int8.toNat (i : Int8) : Nat := i.toInt.toNat
|
||||
@[extern "lean_int8_neg"]
|
||||
def Int8.neg (i : Int8) : Int8 := ⟨⟨-i.toBitVec⟩⟩
|
||||
@@ -58,7 +92,7 @@ def Int8.mul (a b : Int8) : Int8 := ⟨⟨a.toBitVec * b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_div"]
|
||||
def Int8.div (a b : Int8) : Int8 := ⟨⟨BitVec.sdiv a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_mod"]
|
||||
def Int8.mod (a b : Int8) : Int8 := ⟨⟨BitVec.smod a.toBitVec b.toBitVec⟩⟩
|
||||
def Int8.mod (a b : Int8) : Int8 := ⟨⟨BitVec.srem a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_land"]
|
||||
def Int8.land (a b : Int8) : Int8 := ⟨⟨a.toBitVec &&& b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_lor"]
|
||||
@@ -66,9 +100,9 @@ def Int8.lor (a b : Int8) : Int8 := ⟨⟨a.toBitVec ||| b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_xor"]
|
||||
def Int8.xor (a b : Int8) : Int8 := ⟨⟨a.toBitVec ^^^ b.toBitVec⟩⟩
|
||||
@[extern "lean_int8_shift_left"]
|
||||
def Int8.shiftLeft (a b : Int8) : Int8 := ⟨⟨a.toBitVec <<< (mod b 8).toBitVec⟩⟩
|
||||
def Int8.shiftLeft (a b : Int8) : Int8 := ⟨⟨a.toBitVec <<< (b.toBitVec.smod 8)⟩⟩
|
||||
@[extern "lean_int8_shift_right"]
|
||||
def Int8.shiftRight (a b : Int8) : Int8 := ⟨⟨BitVec.sshiftRight' a.toBitVec (mod b 8).toBitVec⟩⟩
|
||||
def Int8.shiftRight (a b : Int8) : Int8 := ⟨⟨BitVec.sshiftRight' a.toBitVec (b.toBitVec.smod 8)⟩⟩
|
||||
@[extern "lean_int8_complement"]
|
||||
def Int8.complement (a : Int8) : Int8 := ⟨⟨~~~a.toBitVec⟩⟩
|
||||
|
||||
@@ -114,3 +148,318 @@ instance (a b : Int8) : Decidable (a < b) := Int8.decLt a b
|
||||
instance (a b : Int8) : Decidable (a ≤ b) := Int8.decLe a b
|
||||
instance : Max Int8 := maxOfLe
|
||||
instance : Min Int8 := minOfLe
|
||||
|
||||
/-- The size of type `Int16`, that is, `2^16 = 65536`. -/
|
||||
abbrev Int16.size : Nat := 65536
|
||||
|
||||
/--
|
||||
Obtain the `BitVec` that contains the 2's complement representation of the `Int16`.
|
||||
-/
|
||||
@[inline] def Int16.toBitVec (x : Int16) : BitVec 16 := x.toUInt16.toBitVec
|
||||
|
||||
@[extern "lean_int16_of_int"]
|
||||
def Int16.ofInt (i : @& Int) : Int16 := ⟨⟨BitVec.ofInt 16 i⟩⟩
|
||||
@[extern "lean_int16_of_nat"]
|
||||
def Int16.ofNat (n : @& Nat) : Int16 := ⟨⟨BitVec.ofNat 16 n⟩⟩
|
||||
abbrev Int.toInt16 := Int16.ofInt
|
||||
abbrev Nat.toInt16 := Int16.ofNat
|
||||
@[extern "lean_int16_to_int"]
|
||||
def Int16.toInt (i : Int16) : Int := i.toBitVec.toInt
|
||||
/--
|
||||
This function has the same behavior as `Int.toNat` for negative numbers.
|
||||
If you want to obtain the 2's complement representation use `toBitVec`.
|
||||
-/
|
||||
@[inline] def Int16.toNat (i : Int16) : Nat := i.toInt.toNat
|
||||
@[extern "lean_int16_to_int8"]
|
||||
def Int16.toInt8 (a : Int16) : Int8 := ⟨⟨a.toBitVec.signExtend 8⟩⟩
|
||||
@[extern "lean_int8_to_int16"]
|
||||
def Int8.toInt16 (a : Int8) : Int16 := ⟨⟨a.toBitVec.signExtend 16⟩⟩
|
||||
@[extern "lean_int16_neg"]
|
||||
def Int16.neg (i : Int16) : Int16 := ⟨⟨-i.toBitVec⟩⟩
|
||||
|
||||
instance : ToString Int16 where
|
||||
toString i := toString i.toInt
|
||||
|
||||
instance : OfNat Int16 n := ⟨Int16.ofNat n⟩
|
||||
instance : Neg Int16 where
|
||||
neg := Int16.neg
|
||||
|
||||
@[extern "lean_int16_add"]
|
||||
def Int16.add (a b : Int16) : Int16 := ⟨⟨a.toBitVec + b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_sub"]
|
||||
def Int16.sub (a b : Int16) : Int16 := ⟨⟨a.toBitVec - b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_mul"]
|
||||
def Int16.mul (a b : Int16) : Int16 := ⟨⟨a.toBitVec * b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_div"]
|
||||
def Int16.div (a b : Int16) : Int16 := ⟨⟨BitVec.sdiv a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_mod"]
|
||||
def Int16.mod (a b : Int16) : Int16 := ⟨⟨BitVec.srem a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_land"]
|
||||
def Int16.land (a b : Int16) : Int16 := ⟨⟨a.toBitVec &&& b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_lor"]
|
||||
def Int16.lor (a b : Int16) : Int16 := ⟨⟨a.toBitVec ||| b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_xor"]
|
||||
def Int16.xor (a b : Int16) : Int16 := ⟨⟨a.toBitVec ^^^ b.toBitVec⟩⟩
|
||||
@[extern "lean_int16_shift_left"]
|
||||
def Int16.shiftLeft (a b : Int16) : Int16 := ⟨⟨a.toBitVec <<< (b.toBitVec.smod 16)⟩⟩
|
||||
@[extern "lean_int16_shift_right"]
|
||||
def Int16.shiftRight (a b : Int16) : Int16 := ⟨⟨BitVec.sshiftRight' a.toBitVec (b.toBitVec.smod 16)⟩⟩
|
||||
@[extern "lean_int16_complement"]
|
||||
def Int16.complement (a : Int16) : Int16 := ⟨⟨~~~a.toBitVec⟩⟩
|
||||
|
||||
@[extern "lean_int16_dec_eq"]
|
||||
def Int16.decEq (a b : Int16) : Decidable (a = b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
if h : n = m then
|
||||
isTrue <| h ▸ rfl
|
||||
else
|
||||
isFalse (fun h' => Int16.noConfusion h' (fun h' => absurd h' h))
|
||||
|
||||
def Int16.lt (a b : Int16) : Prop := a.toBitVec.slt b.toBitVec
|
||||
def Int16.le (a b : Int16) : Prop := a.toBitVec.sle b.toBitVec
|
||||
|
||||
instance : Inhabited Int16 where
|
||||
default := 0
|
||||
|
||||
instance : Add Int16 := ⟨Int16.add⟩
|
||||
instance : Sub Int16 := ⟨Int16.sub⟩
|
||||
instance : Mul Int16 := ⟨Int16.mul⟩
|
||||
instance : Mod Int16 := ⟨Int16.mod⟩
|
||||
instance : Div Int16 := ⟨Int16.div⟩
|
||||
instance : LT Int16 := ⟨Int16.lt⟩
|
||||
instance : LE Int16 := ⟨Int16.le⟩
|
||||
instance : Complement Int16 := ⟨Int16.complement⟩
|
||||
instance : AndOp Int16 := ⟨Int16.land⟩
|
||||
instance : OrOp Int16 := ⟨Int16.lor⟩
|
||||
instance : Xor Int16 := ⟨Int16.xor⟩
|
||||
instance : ShiftLeft Int16 := ⟨Int16.shiftLeft⟩
|
||||
instance : ShiftRight Int16 := ⟨Int16.shiftRight⟩
|
||||
instance : DecidableEq Int16 := Int16.decEq
|
||||
|
||||
@[extern "lean_int16_dec_lt"]
|
||||
def Int16.decLt (a b : Int16) : Decidable (a < b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
|
||||
|
||||
@[extern "lean_int16_dec_le"]
|
||||
def Int16.decLe (a b : Int16) : Decidable (a ≤ b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.sle b.toBitVec))
|
||||
|
||||
instance (a b : Int16) : Decidable (a < b) := Int16.decLt a b
|
||||
instance (a b : Int16) : Decidable (a ≤ b) := Int16.decLe a b
|
||||
instance : Max Int16 := maxOfLe
|
||||
instance : Min Int16 := minOfLe
|
||||
|
||||
/-- The size of type `Int32`, that is, `2^32 = 4294967296`. -/
|
||||
abbrev Int32.size : Nat := 4294967296
|
||||
|
||||
/--
|
||||
Obtain the `BitVec` that contains the 2's complement representation of the `Int32`.
|
||||
-/
|
||||
@[inline] def Int32.toBitVec (x : Int32) : BitVec 32 := x.toUInt32.toBitVec
|
||||
|
||||
@[extern "lean_int32_of_int"]
|
||||
def Int32.ofInt (i : @& Int) : Int32 := ⟨⟨BitVec.ofInt 32 i⟩⟩
|
||||
@[extern "lean_int32_of_nat"]
|
||||
def Int32.ofNat (n : @& Nat) : Int32 := ⟨⟨BitVec.ofNat 32 n⟩⟩
|
||||
abbrev Int.toInt32 := Int32.ofInt
|
||||
abbrev Nat.toInt32 := Int32.ofNat
|
||||
@[extern "lean_int32_to_int"]
|
||||
def Int32.toInt (i : Int32) : Int := i.toBitVec.toInt
|
||||
/--
|
||||
This function has the same behavior as `Int.toNat` for negative numbers.
|
||||
If you want to obtain the 2's complement representation use `toBitVec`.
|
||||
-/
|
||||
@[inline] def Int32.toNat (i : Int32) : Nat := i.toInt.toNat
|
||||
@[extern "lean_int32_to_int8"]
|
||||
def Int32.toInt8 (a : Int32) : Int8 := ⟨⟨a.toBitVec.signExtend 8⟩⟩
|
||||
@[extern "lean_int32_to_int16"]
|
||||
def Int32.toInt16 (a : Int32) : Int16 := ⟨⟨a.toBitVec.signExtend 16⟩⟩
|
||||
@[extern "lean_int8_to_int32"]
|
||||
def Int8.toInt32 (a : Int8) : Int32 := ⟨⟨a.toBitVec.signExtend 32⟩⟩
|
||||
@[extern "lean_int16_to_int32"]
|
||||
def Int16.toInt32 (a : Int16) : Int32 := ⟨⟨a.toBitVec.signExtend 32⟩⟩
|
||||
@[extern "lean_int32_neg"]
|
||||
def Int32.neg (i : Int32) : Int32 := ⟨⟨-i.toBitVec⟩⟩
|
||||
|
||||
instance : ToString Int32 where
|
||||
toString i := toString i.toInt
|
||||
|
||||
instance : OfNat Int32 n := ⟨Int32.ofNat n⟩
|
||||
instance : Neg Int32 where
|
||||
neg := Int32.neg
|
||||
|
||||
@[extern "lean_int32_add"]
|
||||
def Int32.add (a b : Int32) : Int32 := ⟨⟨a.toBitVec + b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_sub"]
|
||||
def Int32.sub (a b : Int32) : Int32 := ⟨⟨a.toBitVec - b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_mul"]
|
||||
def Int32.mul (a b : Int32) : Int32 := ⟨⟨a.toBitVec * b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_div"]
|
||||
def Int32.div (a b : Int32) : Int32 := ⟨⟨BitVec.sdiv a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_mod"]
|
||||
def Int32.mod (a b : Int32) : Int32 := ⟨⟨BitVec.srem a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_land"]
|
||||
def Int32.land (a b : Int32) : Int32 := ⟨⟨a.toBitVec &&& b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_lor"]
|
||||
def Int32.lor (a b : Int32) : Int32 := ⟨⟨a.toBitVec ||| b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_xor"]
|
||||
def Int32.xor (a b : Int32) : Int32 := ⟨⟨a.toBitVec ^^^ b.toBitVec⟩⟩
|
||||
@[extern "lean_int32_shift_left"]
|
||||
def Int32.shiftLeft (a b : Int32) : Int32 := ⟨⟨a.toBitVec <<< (b.toBitVec.smod 32)⟩⟩
|
||||
@[extern "lean_int32_shift_right"]
|
||||
def Int32.shiftRight (a b : Int32) : Int32 := ⟨⟨BitVec.sshiftRight' a.toBitVec (b.toBitVec.smod 32)⟩⟩
|
||||
@[extern "lean_int32_complement"]
|
||||
def Int32.complement (a : Int32) : Int32 := ⟨⟨~~~a.toBitVec⟩⟩
|
||||
|
||||
@[extern "lean_int32_dec_eq"]
|
||||
def Int32.decEq (a b : Int32) : Decidable (a = b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
if h : n = m then
|
||||
isTrue <| h ▸ rfl
|
||||
else
|
||||
isFalse (fun h' => Int32.noConfusion h' (fun h' => absurd h' h))
|
||||
|
||||
def Int32.lt (a b : Int32) : Prop := a.toBitVec.slt b.toBitVec
|
||||
def Int32.le (a b : Int32) : Prop := a.toBitVec.sle b.toBitVec
|
||||
|
||||
instance : Inhabited Int32 where
|
||||
default := 0
|
||||
|
||||
instance : Add Int32 := ⟨Int32.add⟩
|
||||
instance : Sub Int32 := ⟨Int32.sub⟩
|
||||
instance : Mul Int32 := ⟨Int32.mul⟩
|
||||
instance : Mod Int32 := ⟨Int32.mod⟩
|
||||
instance : Div Int32 := ⟨Int32.div⟩
|
||||
instance : LT Int32 := ⟨Int32.lt⟩
|
||||
instance : LE Int32 := ⟨Int32.le⟩
|
||||
instance : Complement Int32 := ⟨Int32.complement⟩
|
||||
instance : AndOp Int32 := ⟨Int32.land⟩
|
||||
instance : OrOp Int32 := ⟨Int32.lor⟩
|
||||
instance : Xor Int32 := ⟨Int32.xor⟩
|
||||
instance : ShiftLeft Int32 := ⟨Int32.shiftLeft⟩
|
||||
instance : ShiftRight Int32 := ⟨Int32.shiftRight⟩
|
||||
instance : DecidableEq Int32 := Int32.decEq
|
||||
|
||||
@[extern "lean_int32_dec_lt"]
|
||||
def Int32.decLt (a b : Int32) : Decidable (a < b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
|
||||
|
||||
@[extern "lean_int32_dec_le"]
|
||||
def Int32.decLe (a b : Int32) : Decidable (a ≤ b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.sle b.toBitVec))
|
||||
|
||||
instance (a b : Int32) : Decidable (a < b) := Int32.decLt a b
|
||||
instance (a b : Int32) : Decidable (a ≤ b) := Int32.decLe a b
|
||||
instance : Max Int32 := maxOfLe
|
||||
instance : Min Int32 := minOfLe
|
||||
|
||||
/-- The size of type `Int64`, that is, `2^64 = 18446744073709551616`. -/
|
||||
abbrev Int64.size : Nat := 18446744073709551616
|
||||
|
||||
/--
|
||||
Obtain the `BitVec` that contains the 2's complement representation of the `Int64`.
|
||||
-/
|
||||
@[inline] def Int64.toBitVec (x : Int64) : BitVec 64 := x.toUInt64.toBitVec
|
||||
|
||||
@[extern "lean_int64_of_int"]
|
||||
def Int64.ofInt (i : @& Int) : Int64 := ⟨⟨BitVec.ofInt 64 i⟩⟩
|
||||
@[extern "lean_int64_of_nat"]
|
||||
def Int64.ofNat (n : @& Nat) : Int64 := ⟨⟨BitVec.ofNat 64 n⟩⟩
|
||||
abbrev Int.toInt64 := Int64.ofInt
|
||||
abbrev Nat.toInt64 := Int64.ofNat
|
||||
@[extern "lean_int64_to_int_sint"]
|
||||
def Int64.toInt (i : Int64) : Int := i.toBitVec.toInt
|
||||
/--
|
||||
This function has the same behavior as `Int.toNat` for negative numbers.
|
||||
If you want to obtain the 2's complement representation use `toBitVec`.
|
||||
-/
|
||||
@[inline] def Int64.toNat (i : Int64) : Nat := i.toInt.toNat
|
||||
@[extern "lean_int64_to_int8"]
|
||||
def Int64.toInt8 (a : Int64) : Int8 := ⟨⟨a.toBitVec.signExtend 8⟩⟩
|
||||
@[extern "lean_int64_to_int16"]
|
||||
def Int64.toInt16 (a : Int64) : Int16 := ⟨⟨a.toBitVec.signExtend 16⟩⟩
|
||||
@[extern "lean_int64_to_int32"]
|
||||
def Int64.toInt32 (a : Int64) : Int32 := ⟨⟨a.toBitVec.signExtend 32⟩⟩
|
||||
@[extern "lean_int8_to_int64"]
|
||||
def Int8.toInt64 (a : Int8) : Int64 := ⟨⟨a.toBitVec.signExtend 64⟩⟩
|
||||
@[extern "lean_int16_to_int64"]
|
||||
def Int16.toInt64 (a : Int16) : Int64 := ⟨⟨a.toBitVec.signExtend 64⟩⟩
|
||||
@[extern "lean_int32_to_int64"]
|
||||
def Int32.toInt64 (a : Int32) : Int64 := ⟨⟨a.toBitVec.signExtend 64⟩⟩
|
||||
@[extern "lean_int64_neg"]
|
||||
def Int64.neg (i : Int64) : Int64 := ⟨⟨-i.toBitVec⟩⟩
|
||||
|
||||
instance : ToString Int64 where
|
||||
toString i := toString i.toInt
|
||||
|
||||
instance : OfNat Int64 n := ⟨Int64.ofNat n⟩
|
||||
instance : Neg Int64 where
|
||||
neg := Int64.neg
|
||||
|
||||
@[extern "lean_int64_add"]
|
||||
def Int64.add (a b : Int64) : Int64 := ⟨⟨a.toBitVec + b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_sub"]
|
||||
def Int64.sub (a b : Int64) : Int64 := ⟨⟨a.toBitVec - b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_mul"]
|
||||
def Int64.mul (a b : Int64) : Int64 := ⟨⟨a.toBitVec * b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_div"]
|
||||
def Int64.div (a b : Int64) : Int64 := ⟨⟨BitVec.sdiv a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_mod"]
|
||||
def Int64.mod (a b : Int64) : Int64 := ⟨⟨BitVec.srem a.toBitVec b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_land"]
|
||||
def Int64.land (a b : Int64) : Int64 := ⟨⟨a.toBitVec &&& b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_lor"]
|
||||
def Int64.lor (a b : Int64) : Int64 := ⟨⟨a.toBitVec ||| b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_xor"]
|
||||
def Int64.xor (a b : Int64) : Int64 := ⟨⟨a.toBitVec ^^^ b.toBitVec⟩⟩
|
||||
@[extern "lean_int64_shift_left"]
|
||||
def Int64.shiftLeft (a b : Int64) : Int64 := ⟨⟨a.toBitVec <<< (b.toBitVec.smod 64)⟩⟩
|
||||
@[extern "lean_int64_shift_right"]
|
||||
def Int64.shiftRight (a b : Int64) : Int64 := ⟨⟨BitVec.sshiftRight' a.toBitVec (b.toBitVec.smod 64)⟩⟩
|
||||
@[extern "lean_int64_complement"]
|
||||
def Int64.complement (a : Int64) : Int64 := ⟨⟨~~~a.toBitVec⟩⟩
|
||||
|
||||
@[extern "lean_int64_dec_eq"]
|
||||
def Int64.decEq (a b : Int64) : Decidable (a = b) :=
|
||||
match a, b with
|
||||
| ⟨n⟩, ⟨m⟩ =>
|
||||
if h : n = m then
|
||||
isTrue <| h ▸ rfl
|
||||
else
|
||||
isFalse (fun h' => Int64.noConfusion h' (fun h' => absurd h' h))
|
||||
|
||||
def Int64.lt (a b : Int64) : Prop := a.toBitVec.slt b.toBitVec
|
||||
def Int64.le (a b : Int64) : Prop := a.toBitVec.sle b.toBitVec
|
||||
|
||||
instance : Inhabited Int64 where
|
||||
default := 0
|
||||
|
||||
instance : Add Int64 := ⟨Int64.add⟩
|
||||
instance : Sub Int64 := ⟨Int64.sub⟩
|
||||
instance : Mul Int64 := ⟨Int64.mul⟩
|
||||
instance : Mod Int64 := ⟨Int64.mod⟩
|
||||
instance : Div Int64 := ⟨Int64.div⟩
|
||||
instance : LT Int64 := ⟨Int64.lt⟩
|
||||
instance : LE Int64 := ⟨Int64.le⟩
|
||||
instance : Complement Int64 := ⟨Int64.complement⟩
|
||||
instance : AndOp Int64 := ⟨Int64.land⟩
|
||||
instance : OrOp Int64 := ⟨Int64.lor⟩
|
||||
instance : Xor Int64 := ⟨Int64.xor⟩
|
||||
instance : ShiftLeft Int64 := ⟨Int64.shiftLeft⟩
|
||||
instance : ShiftRight Int64 := ⟨Int64.shiftRight⟩
|
||||
instance : DecidableEq Int64 := Int64.decEq
|
||||
|
||||
@[extern "lean_int64_dec_lt"]
|
||||
def Int64.decLt (a b : Int64) : Decidable (a < b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.slt b.toBitVec))
|
||||
|
||||
@[extern "lean_int64_dec_le"]
|
||||
def Int64.decLe (a b : Int64) : Decidable (a ≤ b) :=
|
||||
inferInstanceAs (Decidable (a.toBitVec.sle b.toBitVec))
|
||||
|
||||
instance (a b : Int64) : Decidable (a < b) := Int64.decLt a b
|
||||
instance (a b : Int64) : Decidable (a ≤ b) := Int64.decLe a b
|
||||
instance : Max Int64 := maxOfLe
|
||||
instance : Min Int64 := minOfLe
|
||||
|
||||
@@ -211,10 +211,13 @@ instance : GetElem (List α) Nat α fun as i => i < as.length where
|
||||
| _ :: _, 0, _ => .head ..
|
||||
| _ :: l, _+1, _ => .tail _ (getElem_mem (l := l) ..)
|
||||
|
||||
theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
|
||||
theorem getElem_cons_drop_succ_eq_drop {as : List α} {i : Nat} (h : i < as.length) :
|
||||
as[i] :: as.drop (i+1) = as.drop i :=
|
||||
match as, i with
|
||||
| _::_, 0 => rfl
|
||||
| _::_, i+1 => get_drop_eq_drop _ i _
|
||||
| _::_, 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
|
||||
|
||||
end List
|
||||
|
||||
|
||||
@@ -1412,65 +1412,87 @@ namespace Parser
|
||||
|
||||
namespace Tactic
|
||||
|
||||
/-- `erw [rules]` is a shorthand for `rw (config := { transparency := .default }) [rules]`.
|
||||
/--
|
||||
Extracts the items from a tactic configuration,
|
||||
either a `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`, or these wrapped in null nodes.
|
||||
-/
|
||||
partial def getConfigItems (c : Syntax) : TSyntaxArray ``configItem :=
|
||||
if c.isOfKind nullKind then
|
||||
c.getArgs.flatMap getConfigItems
|
||||
else
|
||||
match c with
|
||||
| `(optConfig| $items:configItem*) => items
|
||||
| `(config| (config := $_)) => #[⟨c⟩] -- handled by mkConfigItemViews
|
||||
| _ => #[]
|
||||
|
||||
def mkOptConfig (items : TSyntaxArray ``configItem) : TSyntax ``optConfig :=
|
||||
⟨Syntax.node1 .none ``optConfig (mkNullNode items)⟩
|
||||
|
||||
/--
|
||||
Appends two tactic configurations.
|
||||
The configurations can be `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`,
|
||||
or these wrapped in null nodes (for example because the syntax is `(config)?`).
|
||||
-/
|
||||
def appendConfig (cfg cfg' : Syntax) : TSyntax ``optConfig :=
|
||||
mkOptConfig <| getConfigItems cfg ++ getConfigItems cfg'
|
||||
|
||||
/-- `erw [rules]` is a shorthand for `rw (transparency := .default) [rules]`.
|
||||
This does rewriting up to unfolding of regular definitions (by comparison to regular `rw`
|
||||
which only unfolds `@[reducible]` definitions). -/
|
||||
macro "erw" s:rwRuleSeq loc:(location)? : tactic =>
|
||||
`(tactic| rw (config := { transparency := .default }) $s $(loc)?)
|
||||
macro "erw" c:optConfig s:rwRuleSeq loc:(location)? : tactic => do
|
||||
`(tactic| rw $[$(getConfigItems c)]* (transparency := .default) $s:rwRuleSeq $(loc)?)
|
||||
|
||||
syntax simpAllKind := atomic(" (" &"all") " := " &"true" ")"
|
||||
syntax dsimpKind := atomic(" (" &"dsimp") " := " &"true" ")"
|
||||
|
||||
macro (name := declareSimpLikeTactic) doc?:(docComment)?
|
||||
"declare_simp_like_tactic" opt:((simpAllKind <|> dsimpKind)?)
|
||||
ppSpace tacName:ident ppSpace tacToken:str ppSpace updateCfg:term : command => do
|
||||
ppSpace tacName:ident ppSpace tacToken:str ppSpace cfg:optConfig : command => do
|
||||
let (kind, tkn, stx) ←
|
||||
if opt.raw.isNone then
|
||||
pure (← `(``simp), ← `("simp"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str (config)? (discharger)? (&" only")? (" [" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic))
|
||||
pure (← `(``simp), ← `("simp"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str optConfig (discharger)? (&" only")? (" [" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic))
|
||||
else if opt.raw[0].getKind == ``simpAllKind then
|
||||
pure (← `(``simpAll), ← `("simp_all"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str (config)? (discharger)? (&" only")? (" [" (simpErase <|> simpLemma),* "]")? : tactic))
|
||||
pure (← `(``simpAll), ← `("simp_all"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str optConfig (discharger)? (&" only")? (" [" (simpErase <|> simpLemma),* "]")? : tactic))
|
||||
else
|
||||
pure (← `(``dsimp), ← `("dsimp"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str (config)? (discharger)? (&" only")? (" [" (simpErase <|> simpLemma),* "]")? (location)? : tactic))
|
||||
pure (← `(``dsimp), ← `("dsimp"), ← `($[$doc?:docComment]? syntax (name := $tacName) $tacToken:str optConfig (discharger)? (&" only")? (" [" (simpErase <|> simpLemma),* "]")? (location)? : tactic))
|
||||
`($stx:command
|
||||
@[macro $tacName] def expandSimp : Macro := fun s => do
|
||||
let c ← match s[1][0] with
|
||||
| `(config| (config := $$c)) => `(config| (config := $updateCfg $$c))
|
||||
| _ => `(config| (config := $updateCfg {}))
|
||||
let cfg ← `(optConfig| $cfg)
|
||||
let s := s.setKind $kind
|
||||
let s := s.setArg 0 (mkAtomFrom s[0] $tkn (canonical := true))
|
||||
let s := s.setArg 1 (mkNullNode #[c])
|
||||
let s := s.setArg 1 (appendConfig s[1] cfg)
|
||||
let s := s.mkSynthetic
|
||||
return s)
|
||||
|
||||
/-- `simp!` is shorthand for `simp` with `autoUnfold := true`.
|
||||
This will rewrite with all equation lemmas, which can be used to
|
||||
partially evaluate many definitions. -/
|
||||
declare_simp_like_tactic simpAutoUnfold "simp! " fun (c : Lean.Meta.Simp.Config) => { c with autoUnfold := true }
|
||||
declare_simp_like_tactic simpAutoUnfold "simp! " (autoUnfold := true)
|
||||
|
||||
/-- `simp_arith` is shorthand for `simp` with `arith := true` and `decide := true`.
|
||||
This enables the use of normalization by linear arithmetic. -/
|
||||
declare_simp_like_tactic simpArith "simp_arith " fun (c : Lean.Meta.Simp.Config) => { c with arith := true, decide := true }
|
||||
declare_simp_like_tactic simpArith "simp_arith " (arith := true) (decide := true)
|
||||
|
||||
/-- `simp_arith!` is shorthand for `simp_arith` with `autoUnfold := true`.
|
||||
This will rewrite with all equation lemmas, which can be used to
|
||||
partially evaluate many definitions. -/
|
||||
declare_simp_like_tactic simpArithAutoUnfold "simp_arith! " fun (c : Lean.Meta.Simp.Config) => { c with arith := true, autoUnfold := true, decide := true }
|
||||
declare_simp_like_tactic simpArithAutoUnfold "simp_arith! " (arith := true) (autoUnfold := true) (decide := true)
|
||||
|
||||
/-- `simp_all!` is shorthand for `simp_all` with `autoUnfold := true`.
|
||||
This will rewrite with all equation lemmas, which can be used to
|
||||
partially evaluate many definitions. -/
|
||||
declare_simp_like_tactic (all := true) simpAllAutoUnfold "simp_all! " fun (c : Lean.Meta.Simp.ConfigCtx) => { c with autoUnfold := true }
|
||||
declare_simp_like_tactic (all := true) simpAllAutoUnfold "simp_all! " (autoUnfold := true)
|
||||
|
||||
/-- `simp_all_arith` combines the effects of `simp_all` and `simp_arith`. -/
|
||||
declare_simp_like_tactic (all := true) simpAllArith "simp_all_arith " fun (c : Lean.Meta.Simp.ConfigCtx) => { c with arith := true, decide := true }
|
||||
declare_simp_like_tactic (all := true) simpAllArith "simp_all_arith " (arith := true) (decide := true)
|
||||
|
||||
/-- `simp_all_arith!` combines the effects of `simp_all`, `simp_arith` and `simp!`. -/
|
||||
declare_simp_like_tactic (all := true) simpAllArithAutoUnfold "simp_all_arith! " fun (c : Lean.Meta.Simp.ConfigCtx) => { c with arith := true, autoUnfold := true, decide := true }
|
||||
declare_simp_like_tactic (all := true) simpAllArithAutoUnfold "simp_all_arith! " (arith := true) (autoUnfold := true) (decide := true)
|
||||
|
||||
/-- `dsimp!` is shorthand for `dsimp` with `autoUnfold := true`.
|
||||
This will rewrite with all equation lemmas, which can be used to
|
||||
partially evaluate many definitions. -/
|
||||
declare_simp_like_tactic (dsimp := true) dsimpAutoUnfold "dsimp! " fun (c : Lean.Meta.DSimp.Config) => { c with autoUnfold := true }
|
||||
declare_simp_like_tactic (dsimp := true) dsimpAutoUnfold "dsimp! " (autoUnfold := true)
|
||||
|
||||
end Tactic
|
||||
|
||||
|
||||
@@ -54,6 +54,13 @@ theorem forall_prop_domain_congr {p₁ p₂ : Prop} {q₁ : p₁ → Prop} {q₂
|
||||
: (∀ a : p₁, q₁ a) = (∀ a : p₂, q₂ a) := by
|
||||
subst h₁; simp [← h₂]
|
||||
|
||||
theorem forall_prop_congr_dom {p₁ p₂ : Prop} (h : p₁ = p₂) (q : p₁ → Prop) :
|
||||
(∀ a : p₁, q a) = (∀ a : p₂, q (h.substr a)) :=
|
||||
h ▸ rfl
|
||||
|
||||
theorem pi_congr {α : Sort u} {β β' : α → Sort v} (h : ∀ a, β a = β' a) : (∀ a, β a) = ∀ a, β' a :=
|
||||
(funext h : β = β') ▸ rfl
|
||||
|
||||
theorem let_congr {α : Sort u} {β : Sort v} {a a' : α} {b b' : α → β}
|
||||
(h₁ : a = a') (h₂ : ∀ x, b x = b' x) : (let x := a; b x) = (let x := a'; b' x) :=
|
||||
h₁ ▸ (funext h₂ : b = b') ▸ rfl
|
||||
|
||||
@@ -272,12 +272,20 @@ macro nextTk:"next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
|
||||
-- Limit ref variability for incrementality; see Note [Incremental Macros]
|
||||
withRef arrowTk `(tactic| case%$nextTk _ $args* =>%$arrowTk $tac)
|
||||
|
||||
/-- `all_goals tac` runs `tac` on each goal, concatenating the resulting goals, if any. -/
|
||||
/--
|
||||
`all_goals tac` runs `tac` on each goal, concatenating the resulting goals.
|
||||
If the tactic fails on any goal, the entire `all_goals` tactic fails.
|
||||
|
||||
See also `any_goals tac`.
|
||||
-/
|
||||
syntax (name := allGoals) "all_goals " tacticSeq : tactic
|
||||
|
||||
/--
|
||||
`any_goals tac` applies the tactic `tac` to every goal, and succeeds if at
|
||||
least one application succeeds.
|
||||
`any_goals tac` applies the tactic `tac` to every goal,
|
||||
concating the resulting goals for successful tactic applications.
|
||||
If the tactic fails on all of the goals, the entire `any_goals` tactic fails.
|
||||
|
||||
This tactic is like `all_goals try tac` except that it fails if none of the applications of `tac` succeeds.
|
||||
-/
|
||||
syntax (name := anyGoals) "any_goals " tacticSeq : tactic
|
||||
|
||||
@@ -430,12 +438,12 @@ syntax negConfigItem := "-" noWs ident
|
||||
|
||||
As a special case, `(config := ...)` sets the entire configuration.
|
||||
-/
|
||||
syntax valConfigItem := atomic("(" (ident <|> &"config")) " := " withoutPosition(term) ")"
|
||||
syntax valConfigItem := atomic(" (" notFollowedBy(&"discharger" <|> &"disch") (ident <|> &"config")) " := " withoutPosition(term) ")"
|
||||
/-- A configuration item for a tactic configuration. -/
|
||||
syntax configItem := posConfigItem <|> negConfigItem <|> valConfigItem
|
||||
|
||||
/-- Configuration options for tactics. -/
|
||||
syntax optConfig := configItem*
|
||||
syntax optConfig := (colGt configItem)*
|
||||
|
||||
/-- Optional configuration option for tactics. (Deprecated. Replace `(config)?` with `optConfig`.) -/
|
||||
syntax config := atomic(" (" &"config") " := " withoutPosition(term) ")"
|
||||
@@ -494,25 +502,25 @@ This provides a convenient way to unfold `e`.
|
||||
list of hypotheses in the local context. In the latter case, a turnstile `⊢` or `|-`
|
||||
can also be used, to signify the target of the goal.
|
||||
|
||||
Using `rw (config := {occs := .pos L}) [e]`,
|
||||
Using `rw (occs := .pos L) [e]`,
|
||||
where `L : List Nat`, you can control which "occurrences" are rewritten.
|
||||
(This option applies to each rule, so usually this will only be used with a single rule.)
|
||||
Occurrences count from `1`.
|
||||
At each allowed occurrence, arguments of the rewrite rule `e` may be instantiated,
|
||||
restricting which later rewrites can be found.
|
||||
(Disallowed occurrences do not result in instantiation.)
|
||||
`{occs := .neg L}` allows skipping specified occurrences.
|
||||
`(occs := .neg L)` allows skipping specified occurrences.
|
||||
-/
|
||||
syntax (name := rewriteSeq) "rewrite" (config)? rwRuleSeq (location)? : tactic
|
||||
syntax (name := rewriteSeq) "rewrite" optConfig rwRuleSeq (location)? : tactic
|
||||
|
||||
/--
|
||||
`rw` is like `rewrite`, but also tries to close the goal by "cheap" (reducible) `rfl` afterwards.
|
||||
-/
|
||||
macro (name := rwSeq) "rw " c:(config)? s:rwRuleSeq l:(location)? : tactic =>
|
||||
macro (name := rwSeq) "rw " c:optConfig s:rwRuleSeq l:(location)? : tactic =>
|
||||
match s with
|
||||
| `(rwRuleSeq| [$rs,*]%$rbrak) =>
|
||||
-- We show the `rfl` state on `]`
|
||||
`(tactic| (rewrite $(c)? [$rs,*] $(l)?; with_annotate_state $rbrak (try (with_reducible rfl))))
|
||||
`(tactic| (rewrite $c [$rs,*] $(l)?; with_annotate_state $rbrak (try (with_reducible rfl))))
|
||||
| _ => Macro.throwUnsupported
|
||||
|
||||
/-- `rwa` is short-hand for `rw; assumption`. -/
|
||||
@@ -581,14 +589,14 @@ non-dependent hypotheses. It has many variants:
|
||||
- `simp [*] at *` simplifies target and all (propositional) hypotheses using the
|
||||
other hypotheses.
|
||||
-/
|
||||
syntax (name := simp) "simp" (config)? (discharger)? (&" only")?
|
||||
syntax (name := simp) "simp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*,?) "]")? (location)? : tactic
|
||||
/--
|
||||
`simp_all` is a stronger version of `simp [*] at *` where the hypotheses and target
|
||||
are simplified multiple times until no simplification is applicable.
|
||||
Only non-dependent propositional hypotheses are considered.
|
||||
-/
|
||||
syntax (name := simpAll) "simp_all" (config)? (discharger)? (&" only")?
|
||||
syntax (name := simpAll) "simp_all" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*,?) "]")? : tactic
|
||||
|
||||
/--
|
||||
@@ -596,7 +604,7 @@ The `dsimp` tactic is the definitional simplifier. It is similar to `simp` but o
|
||||
applies theorems that hold by reflexivity. Thus, the result is guaranteed to be
|
||||
definitionally equal to the input.
|
||||
-/
|
||||
syntax (name := dsimp) "dsimp" (config)? (discharger)? (&" only")?
|
||||
syntax (name := dsimp) "dsimp" optConfig (discharger)? (&" only")?
|
||||
(" [" withoutPosition((simpErase <|> simpLemma),*,?) "]")? (location)? : tactic
|
||||
|
||||
/--
|
||||
@@ -618,7 +626,7 @@ def dsimpArg := simpErase.binary `orelse simpLemma
|
||||
syntax dsimpArgs := " [" dsimpArg,* "]"
|
||||
|
||||
/-- The common arguments of `simp?` and `simp?!`. -/
|
||||
syntax simpTraceArgsRest := (config)? (discharger)? (&" only")? (simpArgs)? (ppSpace location)?
|
||||
syntax simpTraceArgsRest := optConfig (discharger)? (&" only")? (simpArgs)? (ppSpace location)?
|
||||
|
||||
/--
|
||||
`simp?` takes the same arguments as `simp`, but reports an equivalent call to `simp only`
|
||||
@@ -637,7 +645,7 @@ syntax (name := simpTrace) "simp?" "!"? simpTraceArgsRest : tactic
|
||||
macro tk:"simp?!" rest:simpTraceArgsRest : tactic => `(tactic| simp?%$tk ! $rest)
|
||||
|
||||
/-- The common arguments of `simp_all?` and `simp_all?!`. -/
|
||||
syntax simpAllTraceArgsRest := (config)? (discharger)? (&" only")? (dsimpArgs)?
|
||||
syntax simpAllTraceArgsRest := optConfig (discharger)? (&" only")? (dsimpArgs)?
|
||||
|
||||
@[inherit_doc simpTrace]
|
||||
syntax (name := simpAllTrace) "simp_all?" "!"? simpAllTraceArgsRest : tactic
|
||||
@@ -646,7 +654,7 @@ syntax (name := simpAllTrace) "simp_all?" "!"? simpAllTraceArgsRest : tactic
|
||||
macro tk:"simp_all?!" rest:simpAllTraceArgsRest : tactic => `(tactic| simp_all?%$tk ! $rest)
|
||||
|
||||
/-- The common arguments of `dsimp?` and `dsimp?!`. -/
|
||||
syntax dsimpTraceArgsRest := (config)? (&" only")? (dsimpArgs)? (ppSpace location)?
|
||||
syntax dsimpTraceArgsRest := optConfig (&" only")? (dsimpArgs)? (ppSpace location)?
|
||||
|
||||
@[inherit_doc simpTrace]
|
||||
syntax (name := dsimpTrace) "dsimp?" "!"? dsimpTraceArgsRest : tactic
|
||||
@@ -655,7 +663,7 @@ syntax (name := dsimpTrace) "dsimp?" "!"? dsimpTraceArgsRest : tactic
|
||||
macro tk:"dsimp?!" rest:dsimpTraceArgsRest : tactic => `(tactic| dsimp?%$tk ! $rest)
|
||||
|
||||
/-- The arguments to the `simpa` family tactics. -/
|
||||
syntax simpaArgsRest := (config)? (discharger)? &" only "? (simpArgs)? (" using " term)?
|
||||
syntax simpaArgsRest := optConfig (discharger)? &" only "? (simpArgs)? (" using " term)?
|
||||
|
||||
/--
|
||||
This is a "finishing" tactic modification of `simp`. It has two forms.
|
||||
@@ -1168,8 +1176,7 @@ a natural subtraction appearing in a hypothesis, and try again.
|
||||
|
||||
The options
|
||||
```
|
||||
omega (config :=
|
||||
{ splitDisjunctions := true, splitNatSub := true, splitNatAbs := true, splitMinMax := true })
|
||||
omega +splitDisjunctions +splitNatSub +splitNatAbs +splitMinMax
|
||||
```
|
||||
can be used to:
|
||||
* `splitDisjunctions`: split any disjunctions found in the context,
|
||||
@@ -1179,7 +1186,7 @@ can be used to:
|
||||
* `splitMinMax`: for each occurrence of `min a b`, split on `min a b = a ∨ min a b = b`
|
||||
Currently, all of these are on by default.
|
||||
-/
|
||||
syntax (name := omega) "omega" (config)? : tactic
|
||||
syntax (name := omega) "omega" optConfig : tactic
|
||||
|
||||
/--
|
||||
`bv_omega` is `omega` with an additional preprocessor that turns statements about `BitVec` into statements about `Nat`.
|
||||
@@ -1292,7 +1299,7 @@ example (a b : Nat)
|
||||
|
||||
See also `norm_cast`.
|
||||
-/
|
||||
syntax (name := pushCast) "push_cast" (config)? (discharger)? (&" only")?
|
||||
syntax (name := pushCast) "push_cast" optConfig (discharger)? (&" only")?
|
||||
(" [" (simpStar <|> simpErase <|> simpLemma),* "]")? (location)? : tactic
|
||||
|
||||
/--
|
||||
@@ -1368,7 +1375,7 @@ See also the doc-comment for `Lean.Meta.Tactic.Backtrack.BacktrackConfig` for th
|
||||
Both `apply_assumption` and `apply_rules` are implemented via these hooks.
|
||||
-/
|
||||
syntax (name := solveByElim)
|
||||
"solve_by_elim" "*"? (config)? (&" only")? (args)? (using_)? : tactic
|
||||
"solve_by_elim" "*"? optConfig (&" only")? (args)? (using_)? : tactic
|
||||
|
||||
/--
|
||||
`apply_assumption` looks for an assumption of the form `... → ∀ _, ... → head`
|
||||
@@ -1391,7 +1398,7 @@ You can pass a further configuration via the syntax `apply_rules (config := {...
|
||||
The options supported are the same as for `solve_by_elim` (and include all the options for `apply`).
|
||||
-/
|
||||
syntax (name := applyAssumption)
|
||||
"apply_assumption" (config)? (&" only")? (args)? (using_)? : tactic
|
||||
"apply_assumption" optConfig (&" only")? (args)? (using_)? : tactic
|
||||
|
||||
/--
|
||||
`apply_rules [l₁, l₂, ...]` tries to solve the main goal by iteratively
|
||||
@@ -1416,7 +1423,7 @@ You can bound the iteration depth using the syntax `apply_rules (config := {maxD
|
||||
Unlike `solve_by_elim`, `apply_rules` does not perform backtracking, and greedily applies
|
||||
a lemma from the list until it gets stuck.
|
||||
-/
|
||||
syntax (name := applyRules) "apply_rules" (config)? (&" only")? (args)? (using_)? : tactic
|
||||
syntax (name := applyRules) "apply_rules" optConfig (&" only")? (args)? (using_)? : tactic
|
||||
end SolveByElim
|
||||
|
||||
/--
|
||||
@@ -1615,7 +1622,7 @@ where `i < arr.size` is in the context) and `simp_arith` and `omega`
|
||||
syntax "get_elem_tactic_trivial" : tactic
|
||||
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| omega)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| simp (config := { arith := true }); done)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| simp +arith; done)
|
||||
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| trivial)
|
||||
|
||||
/--
|
||||
|
||||
@@ -70,11 +70,11 @@ macro_rules
|
||||
/--
|
||||
Rewrites with the given rules, normalizing casts prior to each step.
|
||||
-/
|
||||
syntax "rw_mod_cast" (config)? rwRuleSeq (location)? : tactic
|
||||
syntax "rw_mod_cast" optConfig rwRuleSeq (location)? : tactic
|
||||
macro_rules
|
||||
| `(tactic| rw_mod_cast $[$config]? [$rules,*] $[$loc]?) => do
|
||||
| `(tactic| rw_mod_cast $cfg:optConfig [$rules,*] $[$loc]?) => do
|
||||
let tacs ← rules.getElems.mapM fun rule =>
|
||||
`(tactic| (norm_cast at *; rw $[$config]? [$rule] $[$loc]?))
|
||||
`(tactic| (norm_cast at *; rw $cfg [$rule] $[$loc]?))
|
||||
`(tactic| ($[$tacs]*))
|
||||
|
||||
/--
|
||||
|
||||
@@ -16,15 +16,14 @@ user, and this tactic should no longer be necessary. Calls to `simp_wf` can be r
|
||||
by plain calls to `simp`.
|
||||
-/
|
||||
macro "simp_wf" : tactic =>
|
||||
`(tactic| try simp (config := { unfoldPartialApp := true, zetaDelta := true }) [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel, WellFoundedRelation.rel])
|
||||
`(tactic| try simp +unfoldPartialApp +zetaDelta [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel, WellFoundedRelation.rel])
|
||||
|
||||
/--
|
||||
This tactic is used internally by lean before presenting the proof obligations from a well-founded
|
||||
definition to the user via `decreasing_by`. It is not necessary to use this tactic manually.
|
||||
-/
|
||||
macro "clean_wf" : tactic =>
|
||||
`(tactic| simp
|
||||
(config := { unfoldPartialApp := true, zetaDelta := true, failIfUnchanged := false })
|
||||
`(tactic| simp +unfoldPartialApp +zetaDelta -failIfUnchanged
|
||||
only [invImage, InvImage, Prod.lex, sizeOfWFRel, measure, Nat.lt_wfRel,
|
||||
WellFoundedRelation.rel, sizeOf_nat, reduceCtorEq])
|
||||
|
||||
@@ -37,7 +36,7 @@ macro_rules | `(tactic| decreasing_trivial) => `(tactic| linarith)
|
||||
-/
|
||||
syntax "decreasing_trivial" : tactic
|
||||
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| (simp (config := { arith := true, failIfUnchanged := false })) <;> done)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| (simp +arith -failIfUnchanged) <;> done)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| omega)
|
||||
macro_rules | `(tactic| decreasing_trivial) => `(tactic| assumption)
|
||||
|
||||
|
||||
@@ -298,9 +298,14 @@ instance : ForIn m (RBMap α β cmp) (α × β) where
|
||||
| ⟨leaf, _⟩ => true
|
||||
| _ => false
|
||||
|
||||
/-- Returns a `List` of the key/value pairs in order. -/
|
||||
@[specialize] def toList : RBMap α β cmp → List (α × β)
|
||||
| ⟨t, _⟩ => t.revFold (fun ps k v => (k, v)::ps) []
|
||||
|
||||
/-- Returns an `Array` of the key/value pairs in order. -/
|
||||
@[specialize] def toArray : RBMap α β cmp → Array (α × β)
|
||||
| ⟨t, _⟩ => t.fold (fun ps k v => ps.push (k, v)) #[]
|
||||
|
||||
/-- Returns the kv pair `(a,b)` such that `a ≤ k` for all keys in the RBMap. -/
|
||||
@[inline] protected def min : RBMap α β cmp → Option (α × β)
|
||||
| ⟨t, _⟩ =>
|
||||
|
||||
@@ -595,6 +595,22 @@ mutual
|
||||
elabAndAddNewArg argName arg
|
||||
main
|
||||
| _ =>
|
||||
if (← read).ellipsis && (← readThe Term.Context).inPattern then
|
||||
/-
|
||||
In patterns, ellipsis should always be an implicit argument, even if it is an optparam or autoparam.
|
||||
This prevents examples such as the one in #4555 from failing:
|
||||
```lean
|
||||
match e with
|
||||
| .internal .. => sorry
|
||||
| .error .. => sorry
|
||||
```
|
||||
The `internal` has an optparam (`| internal (id : InternalExceptionId) (extra : KVMap := {})`).
|
||||
|
||||
We may consider having ellipsis suppress optparams and autoparams in general.
|
||||
We avoid doing so for now since it's possible to opt-out of them (for example with `.internal (extra := _) ..`)
|
||||
but it's not possible to opt-in.
|
||||
-/
|
||||
return ← addImplicitArg argName
|
||||
let argType ← getArgExpectedType
|
||||
match (← read).explicit, argType.getOptParamDefault?, argType.getAutoParamTactic? with
|
||||
| false, some defVal, _ => addNewArg argName defVal; main
|
||||
|
||||
@@ -137,7 +137,7 @@ private def mkFormat (e : Expr) : MetaM Expr := do
|
||||
if let .const name _ := (← whnf (← inferType e)).getAppFn then
|
||||
try
|
||||
trace[Elab.eval] "Attempting to derive a 'Repr' instance for '{.ofConstName name}'"
|
||||
liftCommandElabM do applyDerivingHandlers ``Repr #[name] none
|
||||
liftCommandElabM do applyDerivingHandlers ``Repr #[name]
|
||||
resetSynthInstanceCache
|
||||
return ← mkRepr e
|
||||
catch ex =>
|
||||
|
||||
@@ -63,7 +63,10 @@ def processDefDeriving (className : Name) (declName : Name) : TermElabM Bool :=
|
||||
|
||||
end Term
|
||||
|
||||
def DerivingHandler := (typeNames : Array Name) → (args? : Option (TSyntax ``Parser.Term.structInst)) → CommandElabM Bool
|
||||
def DerivingHandler := (typeNames : Array Name) → CommandElabM Bool
|
||||
|
||||
/-- Deprecated - `DerivingHandler` no longer assumes arguments -/
|
||||
@[deprecated DerivingHandler (since := "2024-09-09")]
|
||||
def DerivingHandlerNoArgs := (typeNames : Array Name) → CommandElabM Bool
|
||||
|
||||
builtin_initialize derivingHandlersRef : IO.Ref (NameMap (List DerivingHandler)) ← IO.mkRef {}
|
||||
@@ -73,25 +76,21 @@ as well as the syntax of a `with` argument, if present.
|
||||
|
||||
For example, `deriving instance Foo with fooArgs for Bar, Baz` invokes
|
||||
``fooHandler #[`Bar, `Baz] `(fooArgs)``. -/
|
||||
def registerDerivingHandlerWithArgs (className : Name) (handler : DerivingHandler) : IO Unit := do
|
||||
def registerDerivingHandler (className : Name) (handler : DerivingHandler) : IO Unit := do
|
||||
unless (← initializing) do
|
||||
throw (IO.userError "failed to register deriving handler, it can only be registered during initialization")
|
||||
derivingHandlersRef.modify fun m => match m.find? className with
|
||||
| some handlers => m.insert className (handler :: handlers)
|
||||
| none => m.insert className [handler]
|
||||
|
||||
/-- Like `registerBuiltinDerivingHandlerWithArgs` but ignoring any `with` argument. -/
|
||||
def registerDerivingHandler (className : Name) (handler : DerivingHandlerNoArgs) : IO Unit := do
|
||||
registerDerivingHandlerWithArgs className fun typeNames _ => handler typeNames
|
||||
|
||||
def defaultHandler (className : Name) (typeNames : Array Name) : CommandElabM Unit := do
|
||||
throwError "default handlers have not been implemented yet, class: '{className}' types: {typeNames}"
|
||||
|
||||
def applyDerivingHandlers (className : Name) (typeNames : Array Name) (args? : Option (TSyntax ``Parser.Term.structInst)) : CommandElabM Unit := do
|
||||
def applyDerivingHandlers (className : Name) (typeNames : Array Name) : CommandElabM Unit := do
|
||||
match (← derivingHandlersRef.get).find? className with
|
||||
| some handlers =>
|
||||
for handler in handlers do
|
||||
if (← handler typeNames args?) then
|
||||
if (← handler typeNames) then
|
||||
return ()
|
||||
defaultHandler className typeNames
|
||||
| none => defaultHandler className typeNames
|
||||
@@ -101,16 +100,16 @@ private def tryApplyDefHandler (className : Name) (declName : Name) : CommandEla
|
||||
Term.processDefDeriving className declName
|
||||
|
||||
@[builtin_command_elab «deriving»] def elabDeriving : CommandElab
|
||||
| `(deriving instance $[$classes $[with $argss?]?],* for $[$declNames],*) => do
|
||||
| `(deriving instance $[$classes],* for $[$declNames],*) => do
|
||||
let declNames ← liftCoreM <| declNames.mapM realizeGlobalConstNoOverloadWithInfo
|
||||
for cls in classes, args? in argss? do
|
||||
for cls in classes do
|
||||
try
|
||||
let className ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo cls
|
||||
withRef cls do
|
||||
if declNames.size == 1 && args?.isNone then
|
||||
if declNames.size == 1 then
|
||||
if (← tryApplyDefHandler className declNames[0]!) then
|
||||
return ()
|
||||
applyDerivingHandlers className declNames args?
|
||||
applyDerivingHandlers className declNames
|
||||
catch ex =>
|
||||
logException ex
|
||||
| _ => throwUnsupportedSyntax
|
||||
@@ -118,20 +117,19 @@ private def tryApplyDefHandler (className : Name) (declName : Name) : CommandEla
|
||||
structure DerivingClassView where
|
||||
ref : Syntax
|
||||
className : Name
|
||||
args? : Option (TSyntax ``Parser.Term.structInst)
|
||||
|
||||
def getOptDerivingClasses (optDeriving : Syntax) : CoreM (Array DerivingClassView) := do
|
||||
match optDeriving with
|
||||
| `(Parser.Command.optDeriving| deriving $[$classes $[with $argss?]?],*) =>
|
||||
| `(Parser.Command.optDeriving| deriving $[$classes],*) =>
|
||||
let mut ret := #[]
|
||||
for cls in classes, args? in argss? do
|
||||
for cls in classes do
|
||||
let className ← realizeGlobalConstNoOverloadWithInfo cls
|
||||
ret := ret.push { ref := cls, className := className, args? }
|
||||
ret := ret.push { ref := cls, className := className }
|
||||
return ret
|
||||
| _ => return #[]
|
||||
|
||||
def DerivingClassView.applyHandlers (view : DerivingClassView) (declNames : Array Name) : CommandElabM Unit :=
|
||||
withRef view.ref do applyDerivingHandlers view.className declNames view.args?
|
||||
withRef view.ref do applyDerivingHandlers view.className declNames
|
||||
|
||||
builtin_initialize
|
||||
registerTraceClass `Elab.Deriving
|
||||
|
||||
@@ -35,9 +35,13 @@ Reconstruct bit by bit which value expression must have had which `BitVec` value
|
||||
expression - pair values.
|
||||
-/
|
||||
def reconstructCounterExample (var2Cnf : Std.HashMap BVBit Nat) (assignment : Array (Bool × Nat))
|
||||
(aigSize : Nat) (atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
|
||||
(aigSize : Nat) (atomsAssignment : Std.HashMap Nat (Nat × Expr × Bool)) :
|
||||
Array (Expr × BVExpr.PackedBitVec) := Id.run do
|
||||
let mut sparseMap : Std.HashMap Nat (RBMap Nat Bool Ord.compare) := {}
|
||||
let filter bvBit _ :=
|
||||
let (_, _, synthetic) := atomsAssignment.get! bvBit.var
|
||||
!synthetic
|
||||
let var2Cnf := var2Cnf.filter filter
|
||||
for (bitVar, cnfVar) in var2Cnf.toArray do
|
||||
/-
|
||||
The setup of the variables in CNF is as follows:
|
||||
@@ -70,7 +74,7 @@ def reconstructCounterExample (var2Cnf : Std.HashMap BVBit Nat) (assignment : Ar
|
||||
if bitValue then
|
||||
value := value ||| (1 <<< currentBit)
|
||||
currentBit := currentBit + 1
|
||||
let atomExpr := atomsAssignment.get! bitVecVar |>.snd
|
||||
let (_, atomExpr, _) := atomsAssignment.get! bitVecVar
|
||||
finalMap := finalMap.push (atomExpr, ⟨BitVec.ofNat currentBit value⟩)
|
||||
return finalMap
|
||||
|
||||
@@ -101,7 +105,7 @@ structure UnsatProver.Result where
|
||||
proof : Expr
|
||||
lratCert : LratCert
|
||||
|
||||
abbrev UnsatProver := MVarId → ReflectionResult → Std.HashMap Nat (Nat × Expr) →
|
||||
abbrev UnsatProver := MVarId → ReflectionResult → Std.HashMap Nat (Nat × Expr × Bool) →
|
||||
MetaM (Except CounterExample UnsatProver.Result)
|
||||
|
||||
/--
|
||||
@@ -183,7 +187,7 @@ def explainCounterExampleQuality (counterExample : CounterExample) : MetaM Messa
|
||||
return err
|
||||
|
||||
def lratBitblaster (goal : MVarId) (cfg : TacticContext) (reflectionResult : ReflectionResult)
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
|
||||
(atomsAssignment : Std.HashMap Nat (Nat × Expr × Bool)) :
|
||||
MetaM (Except CounterExample UnsatProver.Result) := do
|
||||
let bvExpr := reflectionResult.bvExpr
|
||||
let entry ←
|
||||
@@ -253,7 +257,8 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
|
||||
reflectBV g
|
||||
trace[Meta.Tactic.bv] "Reflected bv logical expression: {reflectionResult.bvExpr}"
|
||||
|
||||
let atomsPairs := (← getThe State).atoms.toList.map (fun (expr, ⟨width, ident⟩) => (ident, (width, expr)))
|
||||
let flipper := (fun (expr, {width, atomNumber, synthetic}) => (atomNumber, (width, expr, synthetic)))
|
||||
let atomsPairs := (← getThe State).atoms.toList.map flipper
|
||||
let atomsAssignment := Std.HashMap.ofList atomsPairs
|
||||
match ← unsatProver g reflectionResult atomsAssignment with
|
||||
| .ok ⟨bvExprUnsat, cert⟩ =>
|
||||
|
||||
@@ -107,6 +107,25 @@ where
|
||||
|
||||
open Lean.Meta
|
||||
|
||||
/--
|
||||
A `BitVec` atom.
|
||||
-/
|
||||
structure Atom where
|
||||
/--
|
||||
The width of the `BitVec` that is being abstracted.
|
||||
-/
|
||||
width : Nat
|
||||
/--
|
||||
A unique numeric identifier for the atom.
|
||||
-/
|
||||
atomNumber : Nat
|
||||
/--
|
||||
Whether the atom is synthetic. The effect of this is that values for this atom are not considered
|
||||
for the counter example deriviation. This is for example useful when we introduce an atom over
|
||||
an expression, together with additional lemmas that fully describe the behavior of the atom.
|
||||
-/
|
||||
synthetic : Bool
|
||||
|
||||
/--
|
||||
The state of the reflection monad
|
||||
-/
|
||||
@@ -115,7 +134,7 @@ structure State where
|
||||
The atoms encountered so far. Saved as a map from `BitVec` expressions to a (width, atomNumber)
|
||||
pair.
|
||||
-/
|
||||
atoms : Std.HashMap Expr (Nat × Nat) := {}
|
||||
atoms : Std.HashMap Expr Atom := {}
|
||||
/--
|
||||
A cache for `atomsAssignment`.
|
||||
-/
|
||||
@@ -208,8 +227,8 @@ def run (m : M α) : MetaM α :=
|
||||
Retrieve the atoms as pairs of their width and expression.
|
||||
-/
|
||||
def atoms : M (List (Nat × Expr)) := do
|
||||
let sortedAtoms := (← getThe State).atoms.toArray.qsort (·.2.2 < ·.2.2)
|
||||
return sortedAtoms.map (fun (expr, width, _) => (width, expr)) |>.toList
|
||||
let sortedAtoms := (← getThe State).atoms.toArray.qsort (·.2.atomNumber < ·.2.atomNumber)
|
||||
return sortedAtoms.map (fun (expr, {width, ..}) => (width, expr)) |>.toList
|
||||
|
||||
/--
|
||||
Retrieve a `BitVec.Assignment` representing the atoms we found so far.
|
||||
@@ -220,16 +239,17 @@ def atomsAssignment : M Expr := do
|
||||
/--
|
||||
Look up an expression in the atoms, recording it if it has not previously appeared.
|
||||
-/
|
||||
def lookup (e : Expr) (width : Nat) : M Nat := do
|
||||
def lookup (e : Expr) (width : Nat) (synthetic : Bool) : M Nat := do
|
||||
match (← getThe State).atoms[e]? with
|
||||
| some (width', ident) =>
|
||||
if width != width' then
|
||||
| some atom =>
|
||||
if width != atom.width then
|
||||
panic! "The same atom occurs with different widths, this is a bug"
|
||||
return ident
|
||||
return atom.atomNumber
|
||||
| none =>
|
||||
trace[Meta.Tactic.bv] "New atom of width {width}: {e}"
|
||||
trace[Meta.Tactic.bv] "New atom of width {width}, synthetic? {synthetic}: {e}"
|
||||
let ident ← modifyGetThe State fun s =>
|
||||
(s.atoms.size, { s with atoms := s.atoms.insert e (width, s.atoms.size) })
|
||||
let newAtom := { width, synthetic, atomNumber := s.atoms.size}
|
||||
(s.atoms.size, { s with atoms := s.atoms.insert e newAtom })
|
||||
updateAtomsAssignment
|
||||
return ident
|
||||
where
|
||||
|
||||
@@ -32,10 +32,10 @@ def mkBVRefl (w : Nat) (expr : Expr) : Expr :=
|
||||
expr
|
||||
|
||||
/--
|
||||
Register `e` as an atom of width `width`.
|
||||
Register `e` as an atom of `width` that might potentially be `synthetic`.
|
||||
-/
|
||||
def mkAtom (e : Expr) (width : Nat) : M ReifiedBVExpr := do
|
||||
let ident ← M.lookup e width
|
||||
def mkAtom (e : Expr) (width : Nat) (synthetic : Bool) : M ReifiedBVExpr := do
|
||||
let ident ← M.lookup e width synthetic
|
||||
let expr := mkApp2 (mkConst ``BVExpr.var) (toExpr width) (toExpr ident)
|
||||
let proof := do
|
||||
let evalExpr ← mkEvalExpr width expr
|
||||
@@ -55,13 +55,13 @@ def getNatOrBvValue? (ty : Expr) (expr : Expr) : M (Option Nat) := do
|
||||
| _ => return none
|
||||
|
||||
/--
|
||||
Construct an uninterpreted `BitVec` atom from `x`.
|
||||
Construct an uninterpreted `BitVec` atom from `x`, potentially `synthetic`.
|
||||
-/
|
||||
def bitVecAtom (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
def bitVecAtom (x : Expr) (synthetic : Bool) : M (Option ReifiedBVExpr) := do
|
||||
let t ← instantiateMVars (← whnfR (← inferType x))
|
||||
let_expr BitVec widthExpr := t | return none
|
||||
let some width ← getNatValue? widthExpr | return none
|
||||
let atom ← mkAtom x width
|
||||
let atom ← mkAtom x width synthetic
|
||||
return some atom
|
||||
|
||||
/--
|
||||
|
||||
@@ -31,7 +31,7 @@ def boolAtom (t : Expr) : M (Option ReifiedBVPred) := do
|
||||
-/
|
||||
let ty ← inferType t
|
||||
let_expr Bool := ty | return none
|
||||
let atom ← ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1
|
||||
let atom ← ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1 false
|
||||
let bvExpr : BVPred := .getLsbD atom.bvExpr 0
|
||||
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr 1) atom.expr (toExpr 0)
|
||||
let proof := do
|
||||
|
||||
@@ -209,7 +209,7 @@ where
|
||||
let_expr Eq α discrExpr val := discrExpr | return none
|
||||
let_expr Bool := α | return none
|
||||
let_expr Bool.true := val | return none
|
||||
let some atom ← ReifiedBVExpr.bitVecAtom x | return none
|
||||
let some atom ← ReifiedBVExpr.bitVecAtom x true | return none
|
||||
let some discr ← ReifiedBVLogical.of discrExpr | return none
|
||||
let some lhs ← goOrAtom lhsExpr | return none
|
||||
let some rhs ← goOrAtom rhsExpr | return none
|
||||
@@ -226,7 +226,7 @@ where
|
||||
let res ← go x
|
||||
match res with
|
||||
| some exp => return some exp
|
||||
| none => ReifiedBVExpr.bitVecAtom x
|
||||
| none => ReifiedBVExpr.bitVecAtom x false
|
||||
|
||||
shiftConstLikeReflection (distance : Nat) (innerExpr : Expr) (shiftOp : Nat → BVUnOp)
|
||||
(shiftOpName : Name) (congrThm : Name) :
|
||||
@@ -316,7 +316,7 @@ where
|
||||
return mkApp4 congrProof (toExpr inner.width) innerExpr innerEval innerProof
|
||||
|
||||
goBvLit (x : Expr) : M (Option ReifiedBVExpr) := do
|
||||
let some ⟨_, bvVal⟩ ← getBitVecValue? x | return ← ReifiedBVExpr.bitVecAtom x
|
||||
let some ⟨_, bvVal⟩ ← getBitVecValue? x | return ← ReifiedBVExpr.bitVecAtom x false
|
||||
ReifiedBVExpr.mkBVConst bvVal
|
||||
|
||||
/--
|
||||
|
||||
@@ -248,8 +248,8 @@ def evalBVNormalize : Tactic := fun
|
||||
| `(tactic| bv_normalize) => do
|
||||
let g ← getMainGoal
|
||||
match ← bvNormalize g with
|
||||
| some newGoal => setGoals [newGoal]
|
||||
| none => setGoals []
|
||||
| some newGoal => replaceMainGoal [newGoal]
|
||||
| none => replaceMainGoal []
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Frontend.Normalize
|
||||
|
||||
@@ -263,19 +263,26 @@ private def getOptRotation (stx : Syntax) : Nat :=
|
||||
@[builtin_tactic Parser.Tactic.allGoals] def evalAllGoals : Tactic := fun stx => do
|
||||
let mvarIds ← getGoals
|
||||
let mut mvarIdsNew := #[]
|
||||
let mut abort := false
|
||||
let mut mctxSaved ← getMCtx
|
||||
for mvarId in mvarIds do
|
||||
unless (← mvarId.isAssigned) do
|
||||
setGoals [mvarId]
|
||||
mvarIdsNew ← Tactic.tryCatch
|
||||
abort ← Tactic.tryCatch
|
||||
(do
|
||||
evalTactic stx[1]
|
||||
return mvarIdsNew ++ (← getUnsolvedGoals))
|
||||
pure abort)
|
||||
(fun ex => do
|
||||
if (← read).recover then
|
||||
logException ex
|
||||
return mvarIdsNew.push mvarId
|
||||
pure true
|
||||
else
|
||||
throw ex)
|
||||
mvarIdsNew := mvarIdsNew ++ (← getUnsolvedGoals)
|
||||
if abort then
|
||||
setMCtx mctxSaved
|
||||
mvarIds.forM fun mvarId => unless (← mvarId.isAssigned) do admitGoal mvarId
|
||||
throwAbortTactic
|
||||
setGoals mvarIdsNew.toList
|
||||
|
||||
@[builtin_tactic Parser.Tactic.anyGoals] def evalAnyGoals : Tactic := fun stx => do
|
||||
|
||||
@@ -12,27 +12,6 @@ import Lean.Linter.MissingDocs
|
||||
namespace Lean.Elab.Tactic
|
||||
open Meta Parser.Tactic Command
|
||||
|
||||
/--
|
||||
Extracts the items from a tactic configuration,
|
||||
either a `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`, or these wrapped in null nodes.
|
||||
-/
|
||||
private partial def getConfigItems (c : Syntax) : TSyntaxArray ``configItem :=
|
||||
if c.isOfKind nullKind then
|
||||
c.getArgs.flatMap getConfigItems
|
||||
else
|
||||
match c with
|
||||
| `(optConfig| $items:configItem*) => items
|
||||
| `(config| (config := $val)) => #[Unhygienic.run <| withRef c `(configItem| (config := $val))]
|
||||
| _ => #[]
|
||||
|
||||
/--
|
||||
Appends two tactic configurations.
|
||||
The configurations can be `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`,
|
||||
or these wrapped in null nodes (for example because the syntax is `(config)?`).
|
||||
-/
|
||||
def appendConfig (cfg cfg' : Syntax) : TSyntax ``optConfig :=
|
||||
Unhygienic.run `(optConfig| $(getConfigItems cfg)* $(getConfigItems cfg')*)
|
||||
|
||||
private structure ConfigItemView where
|
||||
ref : Syntax
|
||||
option : Ident
|
||||
@@ -47,6 +26,7 @@ private def mkConfigItemViews (c : TSyntaxArray ``configItem) : Array ConfigItem
|
||||
| `(configItem| ($option:ident := $value)) => { ref := item, option, value }
|
||||
| `(configItem| +$option) => { ref := item, option, bool := true, value := mkCIdentFrom item ``true }
|
||||
| `(configItem| -$option) => { ref := item, option, bool := true, value := mkCIdentFrom item ``false }
|
||||
| `(config| (config%$tk := $value)) => { ref := item, option := mkCIdentFrom tk `config, value := value }
|
||||
| _ => { ref := item, option := ⟨Syntax.missing⟩, value := ⟨Syntax.missing⟩ }
|
||||
|
||||
/--
|
||||
@@ -83,14 +63,27 @@ private partial def expandField (structName : Name) (field : Name) : MetaM (Name
|
||||
/-- Elaborates a tactic configuration. -/
|
||||
private def elabConfig (recover : Bool) (structName : Name) (items : Array ConfigItemView) : TermElabM Expr :=
|
||||
withoutModifyingStateWithInfoAndMessages <| withLCtx {} {} <| withSaveInfoContext do
|
||||
let mut base? : Option Term := none
|
||||
let mkStructInst (source? : Option Term) (fields : TSyntaxArray ``Parser.Term.structInstField) : TermElabM Term :=
|
||||
match source? with
|
||||
| some source => `({$source with $fields* : $(mkCIdent structName)})
|
||||
| none => `({$fields* : $(mkCIdent structName)})
|
||||
let mut source? : Option Term := none
|
||||
let mut seenFields : NameSet := {}
|
||||
let mut fields : TSyntaxArray ``Parser.Term.structInstField := #[]
|
||||
for item in items do
|
||||
try
|
||||
let option := item.option.getId.eraseMacroScopes
|
||||
if option == `config then
|
||||
base? ← withRef item.value `(($item.value : $(mkCIdent structName)))
|
||||
fields := #[]
|
||||
unless fields.isEmpty do
|
||||
-- Flush fields. Even though these values will not be used, we still want to elaborate them.
|
||||
source? ← mkStructInst source? fields
|
||||
seenFields := {}
|
||||
fields := #[]
|
||||
let valSrc ← withRef item.value `(($item.value : $(mkCIdent structName)))
|
||||
if let some source := source? then
|
||||
source? ← withRef item.value `({$valSrc, $source with : $(mkCIdent structName)})
|
||||
else
|
||||
source? := valSrc
|
||||
else
|
||||
addCompletionInfo <| CompletionInfo.fieldId item.option option {} structName
|
||||
let (path, projFn) ← withRef item.option <| expandField structName option
|
||||
@@ -104,14 +97,20 @@ private def elabConfig (recover : Bool) (structName : Name) (items : Array Confi
|
||||
-- Special case: `(opt := by tacs)` uses the `tacs` syntax itself
|
||||
withRef item.value <| `(Unhygienic.run `(tacticSeq| $seq))
|
||||
| value => pure value
|
||||
if seenFields.contains path then
|
||||
-- Flush fields. There is a duplicate, but we still want to elaborate both.
|
||||
source? ← mkStructInst source? fields
|
||||
seenFields := {}
|
||||
fields := #[]
|
||||
fields := fields.push <| ← `(Parser.Term.structInstField|
|
||||
$(mkCIdentFrom item.option path (canonical := true)):ident := $value)
|
||||
seenFields := seenFields.insert path
|
||||
catch ex =>
|
||||
if recover then
|
||||
logException ex
|
||||
else
|
||||
throw ex
|
||||
let stx : Term ← `({$[$base? with]? $fields*})
|
||||
let stx : Term ← mkStructInst source? fields
|
||||
let e ← Term.withSynthesize <| Term.elabTermEnsuringType stx (mkConst structName)
|
||||
instantiateMVars e
|
||||
|
||||
|
||||
@@ -11,6 +11,8 @@ import Lean.Elab.Tactic.Conv.Basic
|
||||
namespace Lean.Elab.Tactic.Conv
|
||||
open Meta
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.skip] def evalSkip : Tactic := fun _ => pure ()
|
||||
|
||||
private def congrImplies (mvarId : MVarId) : MetaM (List MVarId) := do
|
||||
let [mvarId₁, mvarId₂, _, _] ← mvarId.apply (← mkConstWithFreshMVarLevels ``implies_congr) | throwError "'apply implies_congr' unexpected result"
|
||||
let mvarId₁ ← markAsConvGoal mvarId₁
|
||||
@@ -72,6 +74,14 @@ private partial def mkCongrThm (origTag : Name) (f : Expr) (args : Array Expr) (
|
||||
mvarIdsNewInsts := mvarIdsNewInsts ++ mvarIdsNewInsts'
|
||||
return (proof, mvarIdsNew, mvarIdsNewInsts)
|
||||
|
||||
private def resolveRhs (tacticName : String) (rhs rhs' : Expr) : MetaM Unit := do
|
||||
unless (← isDefEqGuarded rhs rhs') do
|
||||
throwError "invalid '{tacticName}' conv tactic, failed to resolve{indentExpr rhs}\n=?={indentExpr rhs'}"
|
||||
|
||||
private def resolveRhsFromProof (tacticName : String) (rhs proof : Expr) : MetaM Unit := do
|
||||
let some (_, _, rhs') := (← whnf (← inferType proof)).eq? | throwError "'{tacticName}' conv tactic failed, equality expected"
|
||||
resolveRhs tacticName rhs rhs'
|
||||
|
||||
def congr (mvarId : MVarId) (addImplicitArgs := false) (nameSubgoals := true) :
|
||||
MetaM (List (Option MVarId)) := mvarId.withContext do
|
||||
let origTag ← mvarId.getTag
|
||||
@@ -82,9 +92,7 @@ def congr (mvarId : MVarId) (addImplicitArgs := false) (nameSubgoals := true) :
|
||||
else if lhs.isApp then
|
||||
let (proof, mvarIdsNew, mvarIdsNewInsts) ←
|
||||
mkCongrThm origTag lhs.getAppFn lhs.getAppArgs addImplicitArgs nameSubgoals
|
||||
let some (_, _, rhs') := (← whnf (← inferType proof)).eq? | throwError "'congr' conv tactic failed, equality expected"
|
||||
unless (← isDefEqGuarded rhs rhs') do
|
||||
throwError "invalid 'congr' conv tactic, failed to resolve{indentExpr rhs}\n=?={indentExpr rhs'}"
|
||||
resolveRhsFromProof "congr" rhs proof
|
||||
mvarId.assign proof
|
||||
return mvarIdsNew.toList ++ mvarIdsNewInsts.toList
|
||||
else
|
||||
@@ -93,42 +101,7 @@ def congr (mvarId : MVarId) (addImplicitArgs := false) (nameSubgoals := true) :
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.congr] def evalCongr : Tactic := fun _ => do
|
||||
replaceMainGoal <| List.filterMap id (← congr (← getMainGoal))
|
||||
|
||||
-- mvarIds is the list of goals produced by congr. We only want to change the one at position `i`
|
||||
-- so this closes all other equality goals with `rfl.`. There are non-equality goals produced
|
||||
-- by `congr` (e.g. dependent instances), these are kept as goals.
|
||||
private def selectIdx (tacticName : String) (mvarIds : List (Option MVarId)) (i : Int) :
|
||||
TacticM Unit := do
|
||||
if i >= 0 then
|
||||
let i := i.toNat
|
||||
if h : i < mvarIds.length then
|
||||
let mut otherGoals := #[]
|
||||
for mvarId? in mvarIds, j in [:mvarIds.length] do
|
||||
match mvarId? with
|
||||
| none => pure ()
|
||||
| some mvarId =>
|
||||
if i != j then
|
||||
if (← mvarId.getType').isEq then
|
||||
mvarId.refl
|
||||
else
|
||||
-- If its not an equality, it's likely a class constraint, to be left open
|
||||
otherGoals := otherGoals.push mvarId
|
||||
match mvarIds[i] with
|
||||
| none => throwError "cannot select argument"
|
||||
| some mvarId => replaceMainGoal (mvarId :: otherGoals.toList)
|
||||
return ()
|
||||
throwError "invalid '{tacticName}' conv tactic, application has only {mvarIds.length} (nondependent) argument(s)"
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.skip] def evalSkip : Tactic := fun _ => pure ()
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.lhs] def evalLhs : Tactic := fun _ => do
|
||||
let mvarIds ← congr (← getMainGoal) (nameSubgoals := false)
|
||||
selectIdx "lhs" mvarIds ((mvarIds.length : Int) - 2)
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.rhs] def evalRhs : Tactic := fun _ => do
|
||||
let mvarIds ← congr (← getMainGoal) (nameSubgoals := false)
|
||||
selectIdx "rhs" mvarIds ((mvarIds.length : Int) - 1)
|
||||
|
||||
/-- Implementation of `arg 0` -/
|
||||
/-- Implementation of `arg 0`. -/
|
||||
def congrFunN (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
|
||||
let (lhs, rhs) ← getLhsRhsCore mvarId
|
||||
let lhs := (← instantiateMVars lhs).cleanupAnnotations
|
||||
@@ -136,24 +109,137 @@ def congrFunN (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
|
||||
throwError "invalid 'arg 0' conv tactic, application expected{indentExpr lhs}"
|
||||
lhs.withApp fun f xs => do
|
||||
let (g, mvarNew) ← mkConvGoalFor f
|
||||
mvarId.assign (← xs.foldlM (fun mvar a => Meta.mkCongrFun mvar a) mvarNew)
|
||||
let rhs' := mkAppN g xs
|
||||
unless ← isDefEqGuarded rhs rhs' do
|
||||
throwError "invalid 'arg 0' conv tactic, failed to resolve{indentExpr rhs}\n=?={indentExpr rhs'}"
|
||||
mvarId.assign (← xs.foldlM (init := mvarNew) Meta.mkCongrFun)
|
||||
resolveRhs "arg 0" rhs (mkAppN g xs)
|
||||
return mvarNew.mvarId!
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.arg] def evalArg : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(conv| arg $[@%$tk?]? $i:num) =>
|
||||
let i := i.getNat
|
||||
if i == 0 then
|
||||
replaceMainGoal [← congrFunN (← getMainGoal)]
|
||||
private partial def mkCongrArgZeroThm (tacticName : String) (origTag : Name) (f : Expr) (args : Array Expr) :
|
||||
MetaM (Expr × MVarId × Array MVarId) := do
|
||||
let funInfo ← getFunInfoNArgs f args.size
|
||||
let some congrThm ← mkCongrSimpCore? f funInfo (← getCongrSimpKindsForArgZero funInfo) (subsingletonInstImplicitRhs := false)
|
||||
| throwError "'{tacticName}' conv tactic failed to create congruence theorem"
|
||||
unless congrThm.argKinds[0]! matches .eq do
|
||||
throwError "'{tacticName}' conv tactic failed, cannot select argument"
|
||||
let mut eNew := f
|
||||
let mut proof := congrThm.proof
|
||||
let mut mvarIdNew? := none
|
||||
let mut mvarIdsNewInsts := #[]
|
||||
for h : i in [:congrThm.argKinds.size] do
|
||||
let arg := args[i]!
|
||||
let argInfo := funInfo.paramInfo[i]!
|
||||
match congrThm.argKinds[i] with
|
||||
| .fixed | .cast =>
|
||||
eNew := mkApp eNew arg
|
||||
proof := mkApp proof arg
|
||||
| .eq =>
|
||||
let (rhs, mvarNew) ← mkConvGoalFor arg origTag
|
||||
eNew := mkApp eNew rhs
|
||||
proof := mkApp3 proof arg rhs mvarNew
|
||||
if mvarIdNew?.isSome then throwError "'{tacticName}' conv tactic failed, cannot select argument"
|
||||
mvarIdNew? := some mvarNew.mvarId!
|
||||
| .subsingletonInst =>
|
||||
proof := mkApp proof arg
|
||||
let rhs ← mkFreshExprMVar (← whnf (← inferType proof)).bindingDomain!
|
||||
eNew := mkApp eNew rhs
|
||||
proof := mkApp proof rhs
|
||||
mvarIdsNewInsts := mvarIdsNewInsts.push rhs.mvarId!
|
||||
| .heq | .fixedNoParam => unreachable!
|
||||
let proof' ← args[congrThm.argKinds.size:].foldlM (init := proof) mkCongrFun
|
||||
return (proof', mvarIdNew?.get!, mvarIdsNewInsts)
|
||||
|
||||
/--
|
||||
Implements `arg` for foralls. If `domain` is true, accesses the domain, otherwise accesses the codomain.
|
||||
-/
|
||||
def congrArgForall (tacticName : String) (domain : Bool) (mvarId : MVarId) (lhs rhs : Expr) : MetaM (List MVarId) := do
|
||||
let .forallE n t b bi := lhs | unreachable!
|
||||
if domain then
|
||||
if !b.hasLooseBVars then
|
||||
let (t', g) ← mkConvGoalFor t (← mvarId.getTag)
|
||||
mvarId.assign <| ← mkAppM ``implies_congr #[g, ← mkEqRefl b]
|
||||
resolveRhs tacticName rhs (.forallE n t' b bi)
|
||||
return [g.mvarId!]
|
||||
else if ← isProp b <&&> isProp lhs then
|
||||
let (_rhs, g) ← mkConvGoalFor t (← mvarId.getTag)
|
||||
let proof ← mkAppM ``forall_prop_congr_dom #[g, .lam n t b .default]
|
||||
resolveRhsFromProof tacticName rhs proof
|
||||
mvarId.assign proof
|
||||
return [g.mvarId!]
|
||||
else
|
||||
let i := i - 1
|
||||
let mvarIds ← congr (← getMainGoal) (addImplicitArgs := tk?.isSome) (nameSubgoals := false)
|
||||
selectIdx "arg" mvarIds i
|
||||
throwError m!"'{tacticName}' conv tactic failed, cannot select domain"
|
||||
else
|
||||
withLocalDeclD (← mkFreshUserName n) t fun arg => do
|
||||
let u ← getLevel t
|
||||
let q := b.instantiate1 arg
|
||||
let (q', g) ← mkConvGoalFor q (← mvarId.getTag)
|
||||
let v ← getLevel q
|
||||
let proof := mkAppN (.const ``pi_congr [u, v])
|
||||
#[t, .lam n t b .default, ← mkLambdaFVars #[arg] q', ← mkLambdaFVars #[arg] g]
|
||||
resolveRhsFromProof tacticName rhs proof
|
||||
mvarId.assign proof
|
||||
return [g.mvarId!]
|
||||
|
||||
/-- Implementation of `arg i`. -/
|
||||
def congrArgN (tacticName : String) (mvarId : MVarId) (i : Int) (explicit : Bool) : MetaM (List MVarId) := mvarId.withContext do
|
||||
let (lhs, rhs) ← getLhsRhsCore mvarId
|
||||
let lhs := (← instantiateMVars lhs).cleanupAnnotations
|
||||
if lhs.isForall then
|
||||
if i < -2 || i == 0 || i > 2 then throwError "invalid '{tacticName}' conv tactic, index is out of bounds for pi type"
|
||||
let domain := i == 1 || i == -2
|
||||
return ← congrArgForall tacticName domain mvarId lhs rhs
|
||||
else if lhs.isApp then
|
||||
lhs.withApp fun f xs => do
|
||||
let (f, xs) ← applyArgs f xs i
|
||||
let (proof, mvarIdNew, mvarIdsNewInsts) ← mkCongrArgZeroThm tacticName (← mvarId.getTag) f xs
|
||||
resolveRhsFromProof tacticName rhs proof
|
||||
mvarId.assign proof
|
||||
return mvarIdNew :: mvarIdsNewInsts.toList
|
||||
else
|
||||
throwError "invalid '{tacticName}' conv tactic, application or implication expected{indentExpr lhs}"
|
||||
where
|
||||
applyArgs (f : Expr) (xs : Array Expr) (i : Int) : MetaM (Expr × Array Expr) := do
|
||||
if explicit then
|
||||
let i := if i > 0 then i - 1 else i + xs.size
|
||||
if i < 0 || i ≥ xs.size then
|
||||
throwError "invalid '{tacticName}' tactic, application has {xs.size} arguments but the index is out of bounds"
|
||||
let idx := i.natAbs
|
||||
return (mkAppN f xs[0:idx], xs[idx:])
|
||||
else
|
||||
let mut fType ← inferType f
|
||||
let mut j := 0
|
||||
let mut explicitIdxs := #[]
|
||||
for k in [0:xs.size] do
|
||||
unless fType.isForall do
|
||||
fType ← withTransparency .all <| whnf (fType.instantiateRevRange j k xs)
|
||||
j := k
|
||||
let .forallE _ _ b bi := fType | failure
|
||||
fType := b
|
||||
if bi.isExplicit then
|
||||
explicitIdxs := explicitIdxs.push k
|
||||
let i := if i > 0 then i - 1 else i + explicitIdxs.size
|
||||
if i < 0 || i ≥ explicitIdxs.size then
|
||||
throwError "invalid '{tacticName}' tactic, application has {xs.size} explicit argument(s) but the index is out of bounds"
|
||||
let idx := explicitIdxs[i.natAbs]!
|
||||
return (mkAppN f xs[0:idx], xs[idx:])
|
||||
|
||||
def evalArg (tacticName : String) (i : Int) (explicit : Bool) : TacticM Unit := do
|
||||
if i == 0 then
|
||||
replaceMainGoal [← congrFunN (← getMainGoal)]
|
||||
else
|
||||
replaceMainGoal (← congrArgN tacticName (← getMainGoal) i explicit)
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.arg] def elabArg : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(conv| arg $[@%$tk?]? $[-%$neg?]? $i:num) =>
|
||||
let i : Int := if neg?.isSome then -i.getNat else i.getNat
|
||||
evalArg "arg" i (explicit := tk?.isSome)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.lhs] def evalLhs : Tactic := fun _ => do
|
||||
evalArg "lhs" (-2) false
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.rhs] def evalRhs : Tactic := fun _ => do
|
||||
evalArg "rhs" (-1) false
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.«fun»] def evalFun : Tactic := fun _ => do
|
||||
let mvarId ← getMainGoal
|
||||
mvarId.withContext do
|
||||
@@ -163,9 +249,7 @@ def congrFunN (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
|
||||
| throwError "invalid 'fun' conv tactic, application expected{indentExpr lhs}"
|
||||
let (g, mvarNew) ← mkConvGoalFor f
|
||||
mvarId.assign (← Meta.mkCongrFun mvarNew a)
|
||||
let rhs' := .app g a
|
||||
unless ← isDefEqGuarded rhs rhs' do
|
||||
throwError "invalid 'fun' conv tactic, failed to resolve{indentExpr rhs}\n=?={indentExpr rhs'}"
|
||||
resolveRhs "fun" rhs (.app g a)
|
||||
replaceMainGoal [mvarNew.mvarId!]
|
||||
|
||||
def extLetBodyCongr? (mvarId : MVarId) (lhs rhs : Expr) : MetaM (Option MVarId) := do
|
||||
@@ -209,9 +293,7 @@ private def extCore (mvarId : MVarId) (userName? : Option Name) : MetaM MVarId :
|
||||
let (qa, mvarNew) ← mkConvGoalFor pa
|
||||
let q ← mkLambdaFVars #[a] qa
|
||||
let h ← mkLambdaFVars #[a] mvarNew
|
||||
let rhs' ← mkForallFVars #[a] qa
|
||||
unless (← isDefEqGuarded rhs rhs') do
|
||||
throwError "invalid 'ext' conv tactic, failed to resolve{indentExpr rhs}\n=?={indentExpr rhs'}"
|
||||
resolveRhs "ext" rhs (← mkForallFVars #[a] qa)
|
||||
return (q, h, mvarNew)
|
||||
let proof := mkApp4 (mkConst ``forall_congr [u]) d p q h
|
||||
mvarId.assign proof
|
||||
@@ -238,4 +320,22 @@ private def ext (userName? : Option Name) : TacticM Unit := do
|
||||
for id in ids do
|
||||
withRef id <| ext id.getId
|
||||
|
||||
-- syntax (name := enter) "enter" " [" enterArg,+ "]" : conv
|
||||
@[builtin_tactic Lean.Parser.Tactic.Conv.enter] def evalEnter : Tactic := fun stx => do
|
||||
let token := stx[0]
|
||||
let lbrak := stx[1]
|
||||
let enterArgsAndSeps := stx[2].getArgs
|
||||
-- show initial state up to (incl.) `[`
|
||||
withTacticInfoContext (mkNullNode #[token, lbrak]) (pure ())
|
||||
let numEnterArgs := (enterArgsAndSeps.size + 1) / 2
|
||||
for i in [:numEnterArgs] do
|
||||
let enterArg := enterArgsAndSeps[2 * i]!
|
||||
let sep := enterArgsAndSeps.getD (2 * i + 1) .missing
|
||||
-- show state up to (incl.) next `,` and show errors on `enterArg`
|
||||
withTacticInfoContext (mkNullNode #[enterArg, sep]) <| withRef enterArg do
|
||||
match enterArg with
|
||||
| `(Parser.Tactic.Conv.enterArg| $arg:argArg) => evalTactic (← `(conv| arg $arg))
|
||||
| `(Parser.Tactic.Conv.enterArg| $id:ident) => evalTactic (← `(conv| ext $id))
|
||||
| _ => pure ()
|
||||
|
||||
end Lean.Elab.Tactic.Conv
|
||||
|
||||
@@ -208,15 +208,28 @@ private def getAltNumFields (elimInfo : ElimInfo) (altName : Name) : TermElabM N
|
||||
private def isWildcard (altStx : Syntax) : Bool :=
|
||||
getAltName altStx == `_
|
||||
|
||||
private def checkAltNames (alts : Array Alt) (altsSyntax : Array Syntax) : TacticM Unit :=
|
||||
private def checkAltNames (alts : Array Alt) (altsSyntax : Array Syntax) : TacticM Unit := do
|
||||
let mut seenNames : Array Name := #[]
|
||||
for h : i in [:altsSyntax.size] do
|
||||
let altStx := altsSyntax[i]
|
||||
if getAltName altStx == `_ && i != altsSyntax.size - 1 then
|
||||
withRef altStx <| throwError "invalid occurrence of wildcard alternative, it must be the last alternative"
|
||||
let altName := getAltName altStx
|
||||
if altName != `_ then
|
||||
if seenNames.contains altName then
|
||||
throwErrorAt altStx s!"duplicate alternative name '{altName}'"
|
||||
seenNames := seenNames.push altName
|
||||
unless alts.any (·.name == altName) do
|
||||
throwErrorAt altStx "invalid alternative name '{altName}'"
|
||||
let unhandledAlts := alts.filter fun alt => !seenNames.contains alt.name
|
||||
let msg :=
|
||||
if unhandledAlts.isEmpty then
|
||||
m!"invalid alternative name '{altName}', no unhandled alternatives"
|
||||
else
|
||||
let unhandledAltsMessages := unhandledAlts.map (m!"{·.name}")
|
||||
let unhandledAlts := MessageData.orList unhandledAltsMessages.toList
|
||||
m!"invalid alternative name '{altName}', expected {unhandledAlts}"
|
||||
throwErrorAt altStx msg
|
||||
|
||||
|
||||
/-- Given the goal `altMVarId` for a given alternative that introduces `numFields` new variables,
|
||||
return the number of explicit variables. Recall that when the `@` is not used, only the explicit variables can
|
||||
|
||||
@@ -696,9 +696,9 @@ the tactic call `aesop (add 50% tactic Lean.Omega.omegaDefault)`. -/
|
||||
def omegaDefault : TacticM Unit := omegaTactic {}
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.omega]
|
||||
def evalOmega : Tactic := fun
|
||||
| `(tactic| omega $[$cfg]?) => do
|
||||
let cfg ← elabOmegaConfig (mkOptionalNode cfg)
|
||||
def evalOmega : Tactic
|
||||
| `(tactic| omega $cfg:optConfig) => do
|
||||
let cfg ← elabOmegaConfig cfg
|
||||
omegaTactic cfg
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
|
||||
@@ -437,7 +437,7 @@ def withSimpDiagnostics (x : TacticM Simp.Diagnostics) : TacticM Unit := do
|
||||
Simp.reportDiag stats
|
||||
|
||||
/-
|
||||
"simp" (config)? (discharger)? (" only")? (" [" ((simpStar <|> simpErase <|> simpLemma),*,?) "]")?
|
||||
"simp" optConfig (discharger)? (" only")? (" [" ((simpStar <|> simpErase <|> simpLemma),*,?) "]")?
|
||||
(location)?
|
||||
-/
|
||||
@[builtin_tactic Lean.Parser.Tactic.simp] def evalSimp : Tactic := fun stx => withMainContext do withSimpDiagnostics do
|
||||
|
||||
@@ -25,11 +25,11 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
|
||||
@[builtin_tactic simpTrace] def evalSimpTrace : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic|
|
||||
simp?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => withMainContext do withSimpDiagnostics do
|
||||
simp?%$tk $[!%$bang]? $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?) => withMainContext do withSimpDiagnostics do
|
||||
let stx ← if bang.isSome then
|
||||
`(tactic| simp!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
`(tactic| simp!%$tk $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
else
|
||||
`(tactic| simp%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
`(tactic| simp%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
let { ctx, simprocs, dischargeWrapper } ← mkSimpContext stx (eraseLocal := false)
|
||||
let stats ← dischargeWrapper.with fun discharge? =>
|
||||
simpLocation ctx (simprocs := simprocs) discharge? <|
|
||||
@@ -41,11 +41,11 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
|
||||
|
||||
@[builtin_tactic simpAllTrace] def evalSimpAllTrace : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| simp_all?%$tk $[!%$bang]? $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?) => withSimpDiagnostics do
|
||||
| `(tactic| simp_all?%$tk $[!%$bang]? $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]?) => withSimpDiagnostics do
|
||||
let stx ← if bang.isSome then
|
||||
`(tactic| simp_all!%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?)
|
||||
`(tactic| simp_all!%$tk $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]?)
|
||||
else
|
||||
`(tactic| simp_all%$tk $(config)? $(discharger)? $[only%$o]? $[[$args,*]]?)
|
||||
`(tactic| simp_all%$tk $cfg:optConfig $(discharger)? $[only%$o]? $[[$args,*]]?)
|
||||
let { ctx, .. } ← mkSimpContext stx (eraseLocal := true)
|
||||
(kind := .simpAll) (ignoreStarArg := true)
|
||||
let (result?, stats) ← simpAll (← getMainGoal) ctx
|
||||
@@ -81,11 +81,11 @@ where
|
||||
|
||||
@[builtin_tactic dsimpTrace] def evalDSimpTrace : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| dsimp?%$tk $[!%$bang]? $(config)? $[only%$o]? $[[$args,*]]? $(loc)?) => withSimpDiagnostics do
|
||||
| `(tactic| dsimp?%$tk $[!%$bang]? $cfg:optConfig $[only%$o]? $[[$args,*]]? $(loc)?) => withSimpDiagnostics do
|
||||
let stx ← if bang.isSome then
|
||||
`(tactic| dsimp!%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
`(tactic| dsimp!%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
else
|
||||
`(tactic| dsimp%$tk $(config)? $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
`(tactic| dsimp%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]? $(loc)?)
|
||||
let { ctx, simprocs, .. } ←
|
||||
withMainContext <| mkSimpContext stx (eraseLocal := false) (kind := .dsimp)
|
||||
let stats ← dsimpLocation' ctx simprocs <| (loc.map expandLocation).getD (.targets #[] true)
|
||||
|
||||
@@ -31,9 +31,9 @@ deriving instance Repr for UseImplicitLambdaResult
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.simpa] def evalSimpa : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| simpa%$tk $[?%$squeeze]? $[!%$unfold]? $(cfg)? $(disch)? $[only%$only]?
|
||||
| `(tactic| simpa%$tk $[?%$squeeze]? $[!%$unfold]? $cfg:optConfig $(disch)? $[only%$only]?
|
||||
$[[$args,*]]? $[using $usingArg]?) => Elab.Tactic.focus do withSimpDiagnostics do
|
||||
let stx ← `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?)
|
||||
let stx ← `(tactic| simp $cfg:optConfig $(disch)? $[only%$only]? $[[$args,*]]?)
|
||||
let { ctx, simprocs, dischargeWrapper } ←
|
||||
withMainContext <| mkSimpContext stx (eraseLocal := false)
|
||||
let ctx := if unfold.isSome then { ctx with config.autoUnfold := true } else ctx
|
||||
@@ -96,11 +96,11 @@ deriving instance Repr for UseImplicitLambdaResult
|
||||
g.assumption; pure stats
|
||||
if tactic.simp.trace.get (← getOptions) || squeeze.isSome then
|
||||
let stx ← match ← mkSimpOnly stx stats.usedTheorems with
|
||||
| `(tactic| simp $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]?) =>
|
||||
| `(tactic| simp $cfg:optConfig $(disch)? $[only%$only]? $[[$args,*]]?) =>
|
||||
if unfold.isSome then
|
||||
`(tactic| simpa! $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?)
|
||||
`(tactic| simpa! $cfg:optConfig $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?)
|
||||
else
|
||||
`(tactic| simpa $(cfg)? $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?)
|
||||
`(tactic| simpa $cfg:optConfig $(disch)? $[only%$only]? $[[$args,*]]? $[using $usingArg]?)
|
||||
| _ => unreachable!
|
||||
TryThis.addSuggestion tk stx (origSpan? := ← getRef)
|
||||
return stats.diag
|
||||
|
||||
@@ -68,7 +68,7 @@ def processSyntax (cfg : SolveByElimConfig := {}) (only star : Bool) (add remove
|
||||
@[builtin_tactic Lean.Parser.Tactic.applyAssumption]
|
||||
def evalApplyAssumption : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| apply_assumption $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
| `(tactic| apply_assumption $cfg:optConfig $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
let (star, add, remove) := parseArgs t
|
||||
let use := parseUsing use
|
||||
let cfg ← elabConfig (mkOptionalNode cfg)
|
||||
@@ -86,7 +86,7 @@ See `Lean.MVarId.applyRules` for a `MetaM` level analogue of this tactic.
|
||||
@[builtin_tactic Lean.Parser.Tactic.applyRules]
|
||||
def evalApplyRules : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| apply_rules $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
| `(tactic| apply_rules $cfg:optConfig $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
let (star, add, remove) := parseArgs t
|
||||
let use := parseUsing use
|
||||
let cfg ← elabApplyRulesConfig (mkOptionalNode cfg)
|
||||
@@ -95,16 +95,15 @@ def evalApplyRules : Tactic := fun stx =>
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.solveByElim]
|
||||
def evalSolveByElim : Tactic := fun stx =>
|
||||
match stx with
|
||||
| `(tactic| solve_by_elim $[*%$s]? $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
def evalSolveByElim : Tactic
|
||||
| `(tactic| solve_by_elim $[*%$s]? $cfg:optConfig $[only%$o]? $[$t:args]? $[$use:using_]?) => do
|
||||
let (star, add, remove) := parseArgs t
|
||||
let use := parseUsing use
|
||||
let goals ← if s.isSome then
|
||||
getGoals
|
||||
else
|
||||
pure [← getMainGoal]
|
||||
let cfg ← elabConfig (mkOptionalNode cfg)
|
||||
let cfg ← elabConfig cfg
|
||||
let [] ← processSyntax cfg o.isSome star add remove use goals |
|
||||
throwError "solve_by_elim unexpectedly returned subgoals"
|
||||
pure ()
|
||||
|
||||
@@ -638,20 +638,21 @@ end TagDeclarationExtension
|
||||
/-- Environment extension for mapping declarations to values.
|
||||
Declarations must only be inserted into the mapping in the module where they were declared. -/
|
||||
|
||||
def MapDeclarationExtension (α : Type) := SimplePersistentEnvExtension (Name × α) (NameMap α)
|
||||
def MapDeclarationExtension (α : Type) := PersistentEnvExtension (Name × α) (Name × α) (NameMap α)
|
||||
|
||||
def mkMapDeclarationExtension (name : Name := by exact decl_name%) : IO (MapDeclarationExtension α) :=
|
||||
registerSimplePersistentEnvExtension {
|
||||
name := name,
|
||||
addImportedFn := fun _ => {},
|
||||
addEntryFn := fun s n => s.insert n.1 n.2 ,
|
||||
toArrayFn := fun es => es.toArray.qsort (fun a b => Name.quickLt a.1 b.1)
|
||||
registerPersistentEnvExtension {
|
||||
name := name,
|
||||
mkInitial := pure {}
|
||||
addImportedFn := fun _ => pure {}
|
||||
addEntryFn := fun s (n, v) => s.insert n v
|
||||
exportEntriesFn := fun s => s.toArray
|
||||
}
|
||||
|
||||
namespace MapDeclarationExtension
|
||||
|
||||
instance : Inhabited (MapDeclarationExtension α) :=
|
||||
inferInstanceAs (Inhabited (SimplePersistentEnvExtension ..))
|
||||
inferInstanceAs (Inhabited (PersistentEnvExtension ..))
|
||||
|
||||
def insert (ext : MapDeclarationExtension α) (env : Environment) (declName : Name) (val : α) : Environment :=
|
||||
have : Inhabited Environment := ⟨env⟩
|
||||
|
||||
@@ -1836,6 +1836,27 @@ The delaborator uses `pp` options.
|
||||
def setPPUniverses (e : Expr) (flag : Bool) :=
|
||||
e.setOption `pp.universes flag
|
||||
|
||||
/--
|
||||
Annotate `e` with `pp.piBinderTypes := flag`
|
||||
The delaborator uses `pp` options.
|
||||
-/
|
||||
def setPPPiBinderTypes (e : Expr) (flag : Bool) :=
|
||||
e.setOption `pp.piBinderTypes flag
|
||||
|
||||
/--
|
||||
Annotate `e` with `pp.funBinderTypes := flag`
|
||||
The delaborator uses `pp` options.
|
||||
-/
|
||||
def setPPFunBinderTypes (e : Expr) (flag : Bool) :=
|
||||
e.setOption `pp.funBinderTypes flag
|
||||
|
||||
/--
|
||||
Annotate `e` with `pp.explicit := flag`
|
||||
The delaborator uses `pp` options.
|
||||
-/
|
||||
def setPPNumericTypes (e : Expr) (flag : Bool) :=
|
||||
e.setOption `pp.numericTypes flag
|
||||
|
||||
/--
|
||||
If `e` is an application `f a_1 ... a_n` annotate `f`, `a_1` ... `a_n` with `pp.explicit := false`,
|
||||
and annotate `e` with `pp.explicit := true`.
|
||||
|
||||
@@ -279,6 +279,14 @@ def ofList : List MessageData → MessageData
|
||||
def ofArray (msgs : Array MessageData) : MessageData :=
|
||||
ofList msgs.toList
|
||||
|
||||
/-- Puts `MessageData` into a comma-separated list with `"or"` at the back (no Oxford comma).
|
||||
Best used on non-empty lists; returns `"– none –"` for an empty list. -/
|
||||
def orList (xs : List MessageData) : MessageData :=
|
||||
match xs with
|
||||
| [] => "– none –"
|
||||
| [x] => "'" ++ x ++ "'"
|
||||
| _ => joinSep (xs.dropLast.map (fun x => "'" ++ x ++ "'")) ", " ++ " or '" ++ xs.getLast! ++ "'"
|
||||
|
||||
/-- Puts `MessageData` into a comma-separated list with `"and"` at the back (no Oxford comma).
|
||||
Best used on non-empty lists; returns `"– none –"` for an empty list. -/
|
||||
def andList (xs : List MessageData) : MessageData :=
|
||||
|
||||
@@ -37,8 +37,9 @@ private def getFunctionDomain (f : Expr) : MetaM (Expr × BinderInfo) := do
|
||||
| _ => throwFunctionExpected f
|
||||
|
||||
/--
|
||||
Given two expressions `a` and `b`, this method tries to annotate terms with `pp.explicit := true` to
|
||||
expose "implicit" differences. For example, suppose `a` and `b` are of the form
|
||||
Given two expressions `a` and `b`, this method tries to annotate terms with `pp.explicit := true`
|
||||
and other `pp` options to expose "implicit" differences.
|
||||
For example, suppose `a` and `b` are of the form
|
||||
```lean
|
||||
@HashMap Nat Nat eqInst hasInst1
|
||||
@HashMap Nat Nat eqInst hasInst2
|
||||
@@ -67,7 +68,8 @@ has type
|
||||
but is expected to have type
|
||||
@HashMap Nat Nat eqInst hasInst2
|
||||
```
|
||||
Remark: this method implements a simple heuristic, we should extend it as we find other counterintuitive
|
||||
|
||||
Remark: this method implements simple heuristics; we should extend it as we find other counterintuitive
|
||||
error messages.
|
||||
-/
|
||||
partial def addPPExplicitToExposeDiff (a b : Expr) : MetaM (Expr × Expr) := do
|
||||
@@ -123,6 +125,15 @@ where
|
||||
firstExplicitDiff? := firstExplicitDiff? <|> some i
|
||||
else
|
||||
firstImplicitDiff? := firstImplicitDiff? <|> some i
|
||||
-- Some special cases
|
||||
let fn? : Option Name :=
|
||||
match a.getAppFn, b.getAppFn with
|
||||
| .const ca .., .const cb .. => if ca == cb then ca else none
|
||||
| _, _ => none
|
||||
if fn? == ``OfNat.ofNat && as.size ≥ 3 && firstImplicitDiff? == some 0 then
|
||||
-- Even if there is an explicit diff, it is better to see that the type is different.
|
||||
return (a.setPPNumericTypes true, b.setPPNumericTypes true)
|
||||
-- General case
|
||||
if let some i := firstExplicitDiff? <|> firstImplicitDiff? then
|
||||
let (ai, bi) ← visit as[i]! bs[i]!
|
||||
as := as.set! i ai
|
||||
@@ -133,6 +144,28 @@ where
|
||||
return (a, b)
|
||||
else
|
||||
return (a.setPPExplicit true, b.setPPExplicit true)
|
||||
| .forallE na ta ba bia, .forallE nb tb bb bib =>
|
||||
if !(← isDefEq ta tb) then
|
||||
let (ta, tb) ← visit ta tb
|
||||
let a := Expr.forallE na ta ba bia
|
||||
let b := Expr.forallE nb tb bb bib
|
||||
return (a.setPPPiBinderTypes true, b.setPPPiBinderTypes true)
|
||||
else
|
||||
-- Then bodies must not be defeq.
|
||||
withLocalDeclD na ta fun arg => do
|
||||
let (ba', bb') ← visit (ba.instantiate1 arg) (bb.instantiate1 arg)
|
||||
return (Expr.forallE na ta (ba'.abstract #[arg]) bia, Expr.forallE nb tb (bb'.abstract #[arg]) bib)
|
||||
| .lam na ta ba bia, .lam nb tb bb bib =>
|
||||
if !(← isDefEq ta tb) then
|
||||
let (ta, tb) ← visit ta tb
|
||||
let a := Expr.lam na ta ba bia
|
||||
let b := Expr.lam nb tb bb bib
|
||||
return (a.setPPFunBinderTypes true, b.setPPFunBinderTypes true)
|
||||
else
|
||||
-- Then bodies must not be defeq.
|
||||
withLocalDeclD na ta fun arg => do
|
||||
let (ba', bb') ← visit (ba.instantiate1 arg) (bb.instantiate1 arg)
|
||||
return (Expr.lam na ta (ba'.abstract #[arg]) bia, Expr.lam nb tb (bb'.abstract #[arg]) bib)
|
||||
| _, _ => return (a, b)
|
||||
catch _ =>
|
||||
return (a, b)
|
||||
|
||||
@@ -231,6 +231,29 @@ def getCongrSimpKinds (f : Expr) (info : FunInfo) : MetaM (Array CongrArgKind) :
|
||||
result := result.push .eq
|
||||
return fixKindsForDependencies info result
|
||||
|
||||
/--
|
||||
Variant of `getCongrSimpKinds` for rewriting just argument 0.
|
||||
If it is possible to rewrite, the 0th `CongrArgKind` is `CongrArgKind.eq`,
|
||||
and otherwise it is `CongrArgKind.fixed`. This is used for the `arg` conv tactic.
|
||||
-/
|
||||
def getCongrSimpKindsForArgZero (info : FunInfo) : MetaM (Array CongrArgKind) := do
|
||||
let mut result := #[]
|
||||
for h : i in [:info.paramInfo.size] do
|
||||
if info.resultDeps.contains i then
|
||||
result := result.push .fixed
|
||||
else if i == 0 then
|
||||
result := result.push .eq
|
||||
else if info.paramInfo[i].isProp then
|
||||
result := result.push .cast
|
||||
else if info.paramInfo[i].isInstImplicit then
|
||||
if shouldUseSubsingletonInst info result i then
|
||||
result := result.push .subsingletonInst
|
||||
else
|
||||
result := result.push .fixed
|
||||
else
|
||||
result := result.push .fixed
|
||||
return fixKindsForDependencies info result
|
||||
|
||||
/--
|
||||
Create a congruence theorem that is useful for the simplifier and `congr` tactic.
|
||||
-/
|
||||
|
||||
@@ -173,7 +173,7 @@ def «example» := leading_parser
|
||||
def ctor := leading_parser
|
||||
atomic (optional docComment >> "\n| ") >>
|
||||
ppGroup (declModifiers true >> rawIdent >> optDeclSig)
|
||||
def derivingClasses := sepBy1 (group (ident >> optional (" with " >> ppIndent Term.structInst))) ", "
|
||||
def derivingClasses := sepBy1 ident ", "
|
||||
def optDeriving := leading_parser
|
||||
optional (ppLine >> atomic ("deriving " >> notSymbol "instance") >> derivingClasses)
|
||||
def computedField := leading_parser
|
||||
|
||||
@@ -1021,8 +1021,10 @@ Delaborates an `OfNat.ofNat` literal.
|
||||
`@OfNat.ofNat _ n _` ~> `n`.
|
||||
-/
|
||||
@[builtin_delab app.OfNat.ofNat]
|
||||
def delabOfNat : Delab := whenNotPPOption getPPExplicit <| whenPPOption getPPCoercions <| withOverApp 3 do
|
||||
delabOfNatCore (showType := (← getPPOption getPPNumericTypes))
|
||||
def delabOfNat : Delab := do
|
||||
let showType ← getPPOption getPPNumericTypes
|
||||
whenNotPPOption getPPExplicit <| whenPPOption getPPCoercions <| withOverApp 3 do
|
||||
delabOfNatCore (showType := ← pure showType <||> getPPOption getPPNumericTypes)
|
||||
|
||||
/--
|
||||
Delaborates the negative of an `OfNat.ofNat` literal.
|
||||
|
||||
@@ -72,7 +72,7 @@ def mkOrCached (aig : AIG α) (input : BinaryInput aig) : Entrypoint α :=
|
||||
rhs := {
|
||||
ref := auxRef.cast <| by
|
||||
intros
|
||||
simp (config := { zetaDelta := true }) only
|
||||
simp +zetaDelta only
|
||||
apply LawfulOperator.le_size_of_le_aig_size (f := mkConstCached)
|
||||
omega
|
||||
inv := true
|
||||
@@ -100,7 +100,7 @@ def mkXorCached (aig : AIG α) (input : BinaryInput aig) : Entrypoint α :=
|
||||
aig.mkGateCached {
|
||||
lhs := {
|
||||
ref := aux1Ref.cast <| by
|
||||
simp (config := { zetaDelta := true }) only
|
||||
simp +zetaDelta only
|
||||
apply LawfulOperator.le_size_of_le_aig_size (f := mkGateCached)
|
||||
omega
|
||||
inv := true
|
||||
@@ -132,7 +132,7 @@ def mkBEqCached (aig : AIG α) (input : BinaryInput aig) : Entrypoint α :=
|
||||
aig.mkGateCached {
|
||||
lhs := {
|
||||
ref := aux1Ref.cast <| by
|
||||
simp (config := { zetaDelta := true }) only
|
||||
simp +zetaDelta only
|
||||
apply LawfulOperator.le_size_of_le_aig_size (f := mkGateCached)
|
||||
omega
|
||||
inv := true
|
||||
@@ -163,7 +163,7 @@ def mkImpCached (aig : AIG α) (input : BinaryInput aig) : Entrypoint α :=
|
||||
rhs := {
|
||||
ref := auxRef.cast <| by
|
||||
intros
|
||||
simp (config := { zetaDelta := true }) only
|
||||
simp +zetaDelta only
|
||||
apply LawfulOperator.le_size_of_le_aig_size (f := mkConstCached)
|
||||
omega
|
||||
inv := true
|
||||
|
||||
@@ -155,7 +155,7 @@ def mkFullAdder (aig : AIG α) (input : FullAdderInput aig) : FullAdderOutput ai
|
||||
have haig2 := AIG.LawfulOperator.le_size (f := mkFullAdderCarry) ..
|
||||
let outRef := outRef.cast haig2
|
||||
have hle := by
|
||||
simp (config := { zetaDelta := true }) only
|
||||
simp +zetaDelta only
|
||||
apply AIG.LawfulOperator.le_size_of_le_aig_size (f := mkFullAdderCarry)
|
||||
apply AIG.LawfulOperator.le_size (f := mkFullAdderOut)
|
||||
⟨aig, outRef, carryRef, hle⟩
|
||||
|
||||
@@ -177,7 +177,7 @@ theorem unassigned_of_has_neither (assignment : Assignment) (lacks_pos : ¬(hasP
|
||||
(lacks_neg : ¬(hasNegAssignment assignment)) :
|
||||
assignment = unassigned := by
|
||||
simp only [hasPosAssignment, Bool.not_eq_true] at lacks_pos
|
||||
split at lacks_pos <;> simp_all (config := { decide := true })
|
||||
split at lacks_pos <;> simp_all +decide
|
||||
|
||||
theorem hasPos_addNeg (assignment : Assignment) :
|
||||
hasPosAssignment (addNegAssignment assignment) = hasPosAssignment assignment := by
|
||||
|
||||
@@ -65,10 +65,10 @@ theorem nodup_insertRatUnits {n : Nat} (f : DefaultFormula n)
|
||||
· next i_eq_k =>
|
||||
have j_ne_k : j ≠ k := by rw [← i_eq_k]; exact i_ne_j.symm
|
||||
specialize h4 j j_ne_k
|
||||
simp (config := { decide := true }) only [hj] at h4
|
||||
simp +decide only [hj] at h4
|
||||
· next i_ne_k =>
|
||||
specialize h4 i i_ne_k
|
||||
simp (config := { decide := true }) only [hi] at h4
|
||||
simp +decide only [hi] at h4
|
||||
· by_cases bi
|
||||
· next bi_eq_true =>
|
||||
by_cases i = k1
|
||||
@@ -80,7 +80,7 @@ theorem nodup_insertRatUnits {n : Nat} (f : DefaultFormula n)
|
||||
simp at h2
|
||||
· next j_ne_k2 =>
|
||||
specialize h5 j j_ne_k1 j_ne_k2
|
||||
simp (config := { decide := true }) only [hj] at h5
|
||||
simp +decide only [hj] at h5
|
||||
· next i_ne_k1 =>
|
||||
by_cases i = k2
|
||||
· next i_eq_k2 =>
|
||||
@@ -100,7 +100,7 @@ theorem nodup_insertRatUnits {n : Nat} (f : DefaultFormula n)
|
||||
simp at h1
|
||||
· next j_ne_k1 =>
|
||||
specialize h5 j j_ne_k1 j_ne_k2
|
||||
simp (config := { decide := true }) only [hj] at h5
|
||||
simp +decide only [hj] at h5
|
||||
· next i_ne_k2 =>
|
||||
by_cases i = k1
|
||||
· next i_eq_k1 =>
|
||||
@@ -108,7 +108,7 @@ theorem nodup_insertRatUnits {n : Nat} (f : DefaultFormula n)
|
||||
simp at h1
|
||||
· next i_ne_k1 =>
|
||||
specialize h5 i i_ne_k1 i_ne_k2
|
||||
simp (config := { decide := true }) only [hi] at h5
|
||||
simp +decide only [hi] at h5
|
||||
|
||||
theorem clear_insertRat_base_case {n : Nat} (f : DefaultFormula n)
|
||||
(hf : f.ratUnits = #[] ∧ f.assignments.size = n) (units : CNF.Clause (PosFin n)) :
|
||||
|
||||
@@ -303,7 +303,7 @@ theorem sat_of_insertRat {n : Nat} (f : DefaultFormula n)
|
||||
· simp at h2
|
||||
· next heq =>
|
||||
have hasNegAssignment_fi : hasAssignment false (f.assignments[i.1]'i_in_bounds) := by
|
||||
simp (config := { decide := true }) only [hasAssignment, hasPosAssignment, heq]
|
||||
simp +decide only [hasAssignment, hasPosAssignment, heq]
|
||||
have p_entails_i := hf.2.2 i false hasNegAssignment_fi p pf
|
||||
simp only [(· ⊨ ·)] at p_entails_i
|
||||
simp only [p_entails_i, decide_True]
|
||||
|
||||
@@ -203,12 +203,12 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
|
||||
· constructor
|
||||
· match h : assignments0[i.val]'_ with
|
||||
| unassigned => rfl
|
||||
| pos => simp (config := {decide := true}) [h] at h3
|
||||
| pos => simp +decide [h] at h3
|
||||
| neg =>
|
||||
simp only [addAssignment, addPosAssignment, h, ite_true] at h2
|
||||
simp only [i_eq_l] at h2
|
||||
simp [hasAssignment, hl, getElem!, l_in_bounds, h2, hasNegAssignment, decidableGetElem?] at h5
|
||||
| both => simp (config := {decide := true}) only [h] at h3
|
||||
| both => simp +decide only [h] at h3
|
||||
· intro k k_ne_j k_ne_l
|
||||
rw [Array.getElem_push]
|
||||
by_cases h : k.1 < units.size
|
||||
@@ -244,8 +244,8 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
|
||||
simp only [addAssignment, h, ite_false, addNegAssignment, reduceCtorEq] at h2
|
||||
simp only [i_eq_l] at h2
|
||||
simp [hasAssignment, hl, getElem!, l_in_bounds, h2, hasPosAssignment, decidableGetElem?] at h5
|
||||
| neg => simp (config := {decide := true}) only [h] at h3
|
||||
| both => simp (config := {decide := true}) only [h] at h3
|
||||
| neg => simp +decide only [h] at h3
|
||||
| both => simp +decide only [h] at h3
|
||||
· intro k k_ne_l k_ne_j
|
||||
rw [Array.getElem_push]
|
||||
by_cases h : k.1 < units.size
|
||||
@@ -418,7 +418,7 @@ theorem nodup_insertRupUnits {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd
|
||||
have j_ne_k : j ≠ k := by rw [← i_eq_k]; exact i_ne_j.symm
|
||||
specialize h4 j j_ne_k
|
||||
rw [hj, li_eq_lj] at h4
|
||||
simp (config := { decide := true}) only at h4
|
||||
simp +decide only at h4
|
||||
· next i_ne_k =>
|
||||
specialize h4 i i_ne_k
|
||||
rw [hi] at h4
|
||||
@@ -435,7 +435,7 @@ theorem nodup_insertRupUnits {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd
|
||||
· next j_ne_k2 =>
|
||||
specialize h5 j j_ne_k1 j_ne_k2
|
||||
rw [hj, li_eq_lj] at h5
|
||||
simp (config := { decide := true}) only at h5
|
||||
simp +decide only at h5
|
||||
· next i_ne_k1 =>
|
||||
by_cases i = k2
|
||||
· next i_eq_k2 =>
|
||||
@@ -457,7 +457,7 @@ theorem nodup_insertRupUnits {n : Nat} (f : DefaultFormula n) (f_readyForRupAdd
|
||||
· next j_ne_k1 =>
|
||||
specialize h5 j j_ne_k1 j_ne_k2
|
||||
rw [hj, li_eq_lj] at h5
|
||||
simp (config := { decide := true}) only at h5
|
||||
simp +decide only at h5
|
||||
· next i_ne_k2 =>
|
||||
by_cases i = k1
|
||||
· next i_eq_k1 =>
|
||||
@@ -993,7 +993,7 @@ theorem confirmRupHint_preserves_invariant_helper {n : Nat} (f : DefaultFormula
|
||||
simp only [hasAssignment, Bool.not_eq_true] at h
|
||||
split at h
|
||||
all_goals
|
||||
simp (config := {decide := true}) [getElem!, l_eq_i, i_in_bounds, h1, decidableGetElem?] at h
|
||||
simp +decide [getElem!, l_eq_i, i_in_bounds, h1, decidableGetElem?] at h
|
||||
constructor
|
||||
· rw [Array.getElem_modify_of_ne l_ne_i]
|
||||
exact h1
|
||||
@@ -1137,7 +1137,7 @@ theorem nodup_derivedLits {n : Nat} (f : DefaultFormula n)
|
||||
· next k_ne_i =>
|
||||
have i_ne_k : ⟨i.1, i_in_bounds⟩ ≠ k := by intro i_eq_k; simp only [← i_eq_k, not_true] at k_ne_i
|
||||
specialize h3 ⟨i.1, i_in_bounds⟩ i_ne_k
|
||||
simp (config := { decide := true }) [Fin.getElem_fin, derivedLits_arr_def, ne_eq,
|
||||
simp +decide [Fin.getElem_fin, derivedLits_arr_def, ne_eq,
|
||||
Array.getElem_eq_getElem_toList, li] at h3
|
||||
· by_cases li.2 = true
|
||||
· next li_eq_true =>
|
||||
@@ -1164,7 +1164,7 @@ theorem nodup_derivedLits {n : Nat} (f : DefaultFormula n)
|
||||
· next i_ne_k1 =>
|
||||
specialize h3 ⟨i.1, i_in_bounds⟩ i_ne_k1 i_ne_k2
|
||||
apply h3
|
||||
simp (config := { decide := true }) only [Fin.getElem_fin, Array.getElem_eq_getElem_toList,
|
||||
simp +decide only [Fin.getElem_fin, Array.getElem_eq_getElem_toList,
|
||||
ne_eq, derivedLits_arr_def, li]
|
||||
rfl
|
||||
· next li_eq_false =>
|
||||
@@ -1191,7 +1191,7 @@ theorem nodup_derivedLits {n : Nat} (f : DefaultFormula n)
|
||||
simp [li, li_eq_lj, derivedLits_arr_def, Array.getElem_eq_getElem_toList] at h3
|
||||
· next i_ne_k2 =>
|
||||
specialize h3 ⟨i.1, i_in_bounds⟩ i_ne_k1 i_ne_k2
|
||||
simp (config := { decide := true }) [Array.getElem_eq_getElem_toList, derivedLits_arr_def, li] at h3
|
||||
simp +decide [Array.getElem_eq_getElem_toList, derivedLits_arr_def, li] at h3
|
||||
|
||||
theorem restoreAssignments_performRupCheck_base_case {n : Nat} (f : DefaultFormula n)
|
||||
(f_assignments_size : f.assignments.size = n)
|
||||
|
||||
@@ -55,12 +55,12 @@ theorem contradiction_of_insertUnit_success {n : Nat} (assignments : Array Assig
|
||||
simp only [l_eq_true]
|
||||
simp only [hasAssignment, l_eq_true, hasPosAssignment, getElem!, l_in_bounds, dite_true, ite_true,
|
||||
Bool.not_eq_true, decidableGetElem?] at hl
|
||||
split at hl <;> simp_all (config := { decide := true })
|
||||
split at hl <;> simp_all +decide
|
||||
· next l_eq_false =>
|
||||
simp only [Bool.not_eq_true] at l_eq_false
|
||||
simp only [l_eq_false]
|
||||
simp [hasAssignment, l_eq_false, hasNegAssignment, getElem!, l_in_bounds, decidableGetElem?] at hl
|
||||
split at hl <;> simp_all (config := { decide := true })
|
||||
split at hl <;> simp_all +decide
|
||||
|
||||
theorem contradiction_of_insertUnit_fold_success {n : Nat} (assignments : Array Assignment) (assignments_size : assignments.size = n)
|
||||
(units : Array (Literal (PosFin n))) (foundContradiction : Bool) (l : CNF.Clause (PosFin n)) :
|
||||
@@ -424,7 +424,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
· simp only [(· ⊨ ·), i_eq_idx, c_arr_idx_eq_false] at p_entails_c_arr_i
|
||||
simp only [(· ⊨ ·), Bool.not_eq_true] at p_entails_assignment
|
||||
specialize p_entails_assignment c_arr[idx.1].1
|
||||
simp (config := { decide := true }) only [p_entails_c_arr_i, decide_True, heq] at p_entails_assignment
|
||||
simp +decide only [p_entails_c_arr_i, decide_True, heq] at p_entails_assignment
|
||||
· next h =>
|
||||
exact Or.inr h
|
||||
· exact Or.inr ih1
|
||||
@@ -443,7 +443,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
· simp only [(· ⊨ ·), i_eq_idx, c_arr_idx_eq_false] at p_entails_c_arr_i
|
||||
simp only [(· ⊨ ·), Bool.not_eq_true] at p_entails_assignment
|
||||
specialize p_entails_assignment c_arr[idx.1].1
|
||||
simp (config := { decide := true }) only [p_entails_c_arr_i, decide_True, heq] at p_entails_assignment
|
||||
simp +decide only [p_entails_c_arr_i, decide_True, heq] at p_entails_assignment
|
||||
· next h =>
|
||||
exact Or.inr h
|
||||
· exact Or.inr ih1
|
||||
@@ -475,7 +475,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
simp only [(· ⊨ ·), c_arr_idx_eq_true, p_c_arr_idx_eq_true]
|
||||
· next p_c_arr_idx_eq_false =>
|
||||
simp only [h, Bool.not_eq_true] at p_c_arr_idx_eq_false
|
||||
simp (config := { decide := true }) only [h, p_c_arr_idx_eq_false] at hp
|
||||
simp +decide only [h, p_c_arr_idx_eq_false] at hp
|
||||
· simp at h
|
||||
· next heq =>
|
||||
split at h
|
||||
@@ -488,7 +488,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
by_cases p c_arr[idx.val].1
|
||||
· next p_c_arr_idx_eq_true =>
|
||||
simp only [h, Bool.not_eq_true] at p_c_arr_idx_eq_true
|
||||
simp (config := { decide := true }) only [h, p_c_arr_idx_eq_true] at hp
|
||||
simp +decide only [h, p_c_arr_idx_eq_true] at hp
|
||||
· next p_c_arr_idx_eq_false =>
|
||||
simp only [h] at p_c_arr_idx_eq_false
|
||||
simp only [(· ⊨ ·), c_arr_idx_eq_true, p_c_arr_idx_eq_false]
|
||||
@@ -519,7 +519,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
· simp only [j_eq_idx, (· ⊨ ·), c_arr_idx_eq_false] at p_entails_c_arr_j
|
||||
simp only [(· ⊨ ·), Bool.not_eq_true] at hp
|
||||
specialize hp c_arr[idx.1].1
|
||||
simp (config := { decide := true }) only [p_entails_c_arr_j, decide_True, heq] at hp
|
||||
simp +decide only [p_entails_c_arr_j, decide_True, heq] at hp
|
||||
· next heq =>
|
||||
split at h
|
||||
· simp at h
|
||||
@@ -534,7 +534,7 @@ theorem reduce_fold_fn_preserves_induction_motive {c_arr : Array (Literal (PosFi
|
||||
· simp only [j_eq_idx, (· ⊨ ·), c_arr_idx_eq_true] at p_entails_c_arr_j
|
||||
simp only [(· ⊨ ·), Bool.not_eq_true] at hp
|
||||
specialize hp c_arr[idx.1].1
|
||||
simp (config := { decide := true }) only [p_entails_c_arr_j, decide_True, heq] at hp
|
||||
simp +decide only [p_entails_c_arr_j, decide_True, heq] at hp
|
||||
· simp at h
|
||||
· simp at h
|
||||
· simp at h
|
||||
|
||||
@@ -1651,7 +1651,7 @@ static inline uint8_t lean_uint8_dec_lt(uint8_t a1, uint8_t a2) { return a1 < a2
|
||||
static inline uint8_t lean_uint8_dec_le(uint8_t a1, uint8_t a2) { return a1 <= a2; }
|
||||
|
||||
|
||||
/* Unit8 -> other */
|
||||
/* UInt8 -> other */
|
||||
static inline uint16_t lean_uint8_to_uint16(uint8_t a) { return ((uint16_t)a); }
|
||||
static inline uint32_t lean_uint8_to_uint32(uint8_t a) { return ((uint32_t)a); }
|
||||
static inline uint64_t lean_uint8_to_uint64(uint8_t a) { return ((uint64_t)a); }
|
||||
@@ -1686,7 +1686,7 @@ static inline uint8_t lean_uint16_dec_eq(uint16_t a1, uint16_t a2) { return a1 =
|
||||
static inline uint8_t lean_uint16_dec_lt(uint16_t a1, uint16_t a2) { return a1 < a2; }
|
||||
static inline uint8_t lean_uint16_dec_le(uint16_t a1, uint16_t a2) { return a1 <= a2; }
|
||||
|
||||
/*uint16 -> other */
|
||||
/* UInt16 -> other */
|
||||
static inline uint8_t lean_uint16_to_uint8(uint16_t a) { return ((uint8_t)a); }
|
||||
static inline uint32_t lean_uint16_to_uint32(uint16_t a) { return ((uint32_t)a); }
|
||||
static inline uint64_t lean_uint16_to_uint64(uint16_t a) { return ((uint64_t)a); }
|
||||
@@ -1721,7 +1721,7 @@ static inline uint8_t lean_uint32_dec_eq(uint32_t a1, uint32_t a2) { return a1 =
|
||||
static inline uint8_t lean_uint32_dec_lt(uint32_t a1, uint32_t a2) { return a1 < a2; }
|
||||
static inline uint8_t lean_uint32_dec_le(uint32_t a1, uint32_t a2) { return a1 <= a2; }
|
||||
|
||||
/* uint32 -> other */
|
||||
/* UInt32 -> other */
|
||||
static inline uint8_t lean_uint32_to_uint8(uint32_t a) { return ((uint8_t)a); }
|
||||
static inline uint16_t lean_uint32_to_uint16(uint32_t a) { return ((uint16_t)a); }
|
||||
static inline uint64_t lean_uint32_to_uint64(uint32_t a) { return ((uint64_t)a); }
|
||||
@@ -1759,7 +1759,7 @@ static inline uint8_t lean_uint64_dec_le(uint64_t a1, uint64_t a2) { return a1 <
|
||||
LEAN_EXPORT uint64_t lean_uint64_mix_hash(uint64_t a1, uint64_t a2);
|
||||
|
||||
|
||||
/* uint64 -> other */
|
||||
/* UInt64 -> other */
|
||||
static inline uint8_t lean_uint64_to_uint8(uint64_t a) { return ((uint8_t)a); }
|
||||
static inline uint16_t lean_uint64_to_uint16(uint64_t a) { return ((uint16_t)a); }
|
||||
static inline uint32_t lean_uint64_to_uint32(uint64_t a) { return ((uint32_t)a); }
|
||||
@@ -1826,6 +1826,18 @@ static inline uint8_t lean_int8_of_int(b_lean_obj_arg a) {
|
||||
return (uint8_t)res;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_of_nat(b_lean_obj_arg a) {
|
||||
int8_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int8_t)lean_unbox(a);
|
||||
} else {
|
||||
res = lean_int8_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint8_t)res;
|
||||
}
|
||||
|
||||
static inline lean_obj_res lean_int8_to_int(uint8_t a) {
|
||||
int8_t arg = (int8_t)a;
|
||||
return lean_int64_to_int((int64_t)arg);
|
||||
@@ -1838,73 +1850,73 @@ static inline uint8_t lean_int8_neg(uint8_t a) {
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_add(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs + rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_sub(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs - rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_mul(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs * rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_div(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(rhs == 0 ? 0 : lhs / rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_mod(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(rhs == 0 ? 0 : lhs % rhs);
|
||||
return (uint8_t)(rhs == 0 ? lhs : lhs % rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_land(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs & rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_lor(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs | rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_xor(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return (uint8_t)(lhs ^ rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_shift_right(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (((int8_t)a2 % 8) + 8) % 8; // this is smod 8
|
||||
|
||||
return (uint8_t)(lhs >> (rhs % 8));
|
||||
return (uint8_t)(lhs >> rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_shift_left(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (((int8_t)a2 % 8) + 8) % 8; // this is smod 8
|
||||
|
||||
return (uint8_t)(lhs << (rhs % 8));
|
||||
return (uint8_t)(lhs << rhs);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_complement(uint8_t a) {
|
||||
@@ -1914,26 +1926,449 @@ static inline uint8_t lean_int8_complement(uint8_t a) {
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_dec_eq(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return lhs == rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_dec_lt(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return lhs < rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int8_dec_le(uint8_t a1, uint8_t a2) {
|
||||
int8_t lhs = (int8_t) a1;
|
||||
int8_t rhs = (int8_t) a2;
|
||||
int8_t lhs = (int8_t)a1;
|
||||
int8_t rhs = (int8_t)a2;
|
||||
|
||||
return lhs <= rhs;
|
||||
}
|
||||
|
||||
/* Int8 -> other */
|
||||
static inline uint16_t lean_int8_to_int16(uint8_t a) { return (uint16_t)(int16_t)(int8_t)a; }
|
||||
static inline uint32_t lean_int8_to_int32(uint8_t a) { return (uint32_t)(int32_t)(int8_t)a; }
|
||||
static inline uint64_t lean_int8_to_int64(uint8_t a) { return (uint64_t)(int64_t)(int8_t)a; }
|
||||
|
||||
|
||||
/* Int16 */
|
||||
LEAN_EXPORT int16_t lean_int16_of_big_int(b_lean_obj_arg a);
|
||||
static inline uint16_t lean_int16_of_int(b_lean_obj_arg a) {
|
||||
int16_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int16_t)lean_scalar_to_int64(a);
|
||||
} else {
|
||||
res = lean_int16_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint16_t)res;
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_of_nat(b_lean_obj_arg a) {
|
||||
int16_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int16_t)lean_unbox(a);
|
||||
} else {
|
||||
res = lean_int16_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint16_t)res;
|
||||
}
|
||||
|
||||
static inline lean_obj_res lean_int16_to_int(uint16_t a) {
|
||||
int16_t arg = (int16_t)a;
|
||||
return lean_int64_to_int((int64_t)arg);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_neg(uint16_t a) {
|
||||
int16_t arg = (int16_t)a;
|
||||
|
||||
return (uint16_t)(-arg);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_add(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs + rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_sub(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs - rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_mul(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs * rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_div(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(rhs == 0 ? 0 : lhs / rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_mod(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(rhs == 0 ? lhs : lhs % rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_land(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs & rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_lor(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs | rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_xor(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return (uint16_t)(lhs ^ rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_shift_right(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (((int16_t)a2 % 16) + 16) % 16; // this is smod 16
|
||||
|
||||
return (uint16_t)(lhs >> rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_shift_left(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (((int16_t)a2 % 16) + 16) % 16; // this is smod 16
|
||||
|
||||
return (uint16_t)(lhs << rhs);
|
||||
}
|
||||
|
||||
static inline uint16_t lean_int16_complement(uint16_t a) {
|
||||
int16_t arg = (int16_t)a;
|
||||
|
||||
return (uint16_t)(~arg);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int16_dec_eq(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return lhs == rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int16_dec_lt(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return lhs < rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int16_dec_le(uint16_t a1, uint16_t a2) {
|
||||
int16_t lhs = (int16_t)a1;
|
||||
int16_t rhs = (int16_t)a2;
|
||||
|
||||
return lhs <= rhs;
|
||||
}
|
||||
|
||||
/* Int16 -> other */
|
||||
static inline uint8_t lean_int16_to_int8(uint16_t a) { return (uint8_t)(int8_t)(int16_t)a; }
|
||||
static inline uint32_t lean_int16_to_int32(uint16_t a) { return (uint32_t)(int32_t)(int16_t)a; }
|
||||
static inline uint64_t lean_int16_to_int64(uint16_t a) { return (uint64_t)(int64_t)(int16_t)a; }
|
||||
|
||||
/* Int32 */
|
||||
LEAN_EXPORT int32_t lean_int32_of_big_int(b_lean_obj_arg a);
|
||||
static inline uint32_t lean_int32_of_int(b_lean_obj_arg a) {
|
||||
int32_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int32_t)lean_scalar_to_int64(a);
|
||||
} else {
|
||||
res = lean_int32_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint32_t)res;
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_of_nat(b_lean_obj_arg a) {
|
||||
int32_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int32_t)lean_unbox(a);
|
||||
} else {
|
||||
res = lean_int32_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint32_t)res;
|
||||
}
|
||||
|
||||
static inline lean_obj_res lean_int32_to_int(uint32_t a) {
|
||||
int32_t arg = (int32_t)a;
|
||||
return lean_int64_to_int((int64_t)arg);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_neg(uint32_t a) {
|
||||
int32_t arg = (int32_t)a;
|
||||
|
||||
return (uint32_t)(-arg);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_add(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs + rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_sub(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs - rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_mul(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs * rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_div(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(rhs == 0 ? 0 : lhs / rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_mod(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(rhs == 0 ? lhs : lhs % rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_land(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs & rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_lor(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs | rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_xor(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return (uint32_t)(lhs ^ rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_shift_right(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (((int32_t)a2 % 32) + 32) % 32; // this is smod 32
|
||||
|
||||
return (uint32_t)(lhs >> rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_shift_left(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (((int32_t)a2 % 32) + 32) % 32; // this is smod 32
|
||||
|
||||
return (uint32_t)(lhs << rhs);
|
||||
}
|
||||
|
||||
static inline uint32_t lean_int32_complement(uint32_t a) {
|
||||
int32_t arg = (int32_t)a;
|
||||
|
||||
return (uint32_t)(~arg);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int32_dec_eq(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return lhs == rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int32_dec_lt(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return lhs < rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int32_dec_le(uint32_t a1, uint32_t a2) {
|
||||
int32_t lhs = (int32_t)a1;
|
||||
int32_t rhs = (int32_t)a2;
|
||||
|
||||
return lhs <= rhs;
|
||||
}
|
||||
|
||||
/* Int32 -> other */
|
||||
static inline uint8_t lean_int32_to_int8(uint32_t a) { return (uint8_t)(int8_t)(int32_t)a; }
|
||||
static inline uint16_t lean_int32_to_int16(uint32_t a) { return (uint16_t)(int16_t)(int32_t)a; }
|
||||
static inline uint64_t lean_int32_to_int64(uint32_t a) { return (uint64_t)(int64_t)(int32_t)a; }
|
||||
|
||||
/* Int64 */
|
||||
LEAN_EXPORT int64_t lean_int64_of_big_int(b_lean_obj_arg a);
|
||||
static inline uint64_t lean_int64_of_int(b_lean_obj_arg a) {
|
||||
int64_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = lean_scalar_to_int64(a);
|
||||
} else {
|
||||
res = lean_int64_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint64_t)res;
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_of_nat(b_lean_obj_arg a) {
|
||||
int64_t res;
|
||||
|
||||
if (lean_is_scalar(a)) {
|
||||
res = (int64_t)lean_unbox(a);
|
||||
} else {
|
||||
res = lean_int64_of_big_int(a);
|
||||
}
|
||||
|
||||
return (uint64_t)res;
|
||||
}
|
||||
|
||||
static inline lean_obj_res lean_int64_to_int_sint(uint64_t a) {
|
||||
int64_t arg = (int64_t)a;
|
||||
return lean_int64_to_int(arg);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_neg(uint64_t a) {
|
||||
int64_t arg = (int64_t)a;
|
||||
|
||||
return (uint64_t)(-arg);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_add(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs + rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_sub(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs - rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_mul(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs * rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_div(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(rhs == 0 ? 0 : lhs / rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_mod(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(rhs == 0 ? lhs : lhs % rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_land(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs & rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_lor(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs | rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_xor(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return (uint64_t)(lhs ^ rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_shift_right(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (((int64_t)a2 % 64) + 64) % 64; // this is smod 64
|
||||
|
||||
return (uint64_t)(lhs >> rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_shift_left(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (((int64_t)a2 % 64) + 64) % 64; // this is smod 64
|
||||
|
||||
return (uint64_t)(lhs << rhs);
|
||||
}
|
||||
|
||||
static inline uint64_t lean_int64_complement(uint64_t a) {
|
||||
int64_t arg = (int64_t)a;
|
||||
|
||||
return (uint64_t)(~arg);
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int64_dec_eq(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return lhs == rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int64_dec_lt(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return lhs < rhs;
|
||||
}
|
||||
|
||||
static inline uint8_t lean_int64_dec_le(uint64_t a1, uint64_t a2) {
|
||||
int64_t lhs = (int64_t)a1;
|
||||
int64_t rhs = (int64_t)a2;
|
||||
|
||||
return lhs <= rhs;
|
||||
}
|
||||
|
||||
/* Int64 -> other */
|
||||
static inline uint8_t lean_int64_to_int8(uint64_t a) { return (uint8_t)(int8_t)(int64_t)a; }
|
||||
static inline uint16_t lean_int64_to_int16(uint64_t a) { return (uint16_t)(int16_t)(int64_t)a; }
|
||||
static inline uint32_t lean_int64_to_int32(uint64_t a) { return (uint32_t)(int32_t)(int64_t)a; }
|
||||
|
||||
/* Float */
|
||||
|
||||
LEAN_EXPORT lean_obj_res lean_float_to_string(double a);
|
||||
|
||||
@@ -161,15 +161,17 @@ def clearFileHash (file : FilePath) : IO Unit := do
|
||||
|
||||
/--
|
||||
Fetches the hash of a file that may already be cached in a `.hash` file.
|
||||
If the `.hash` file does not exist or hash files are not trusted
|
||||
(e.g., with `--rehash`), creates it with a newly computed hash.
|
||||
If hash files are not trusted (e.g., with `--rehash`) or the `.hash` file does
|
||||
not exist, it will be created with a newly computed hash.
|
||||
|
||||
If `text := true`, `file` is hashed as a text file rather than a binary file.
|
||||
-/
|
||||
def fetchFileHash (file : FilePath) : JobM Hash := do
|
||||
def fetchFileHash (file : FilePath) (text := false) : JobM Hash := do
|
||||
let hashFile := FilePath.mk <| file.toString ++ ".hash"
|
||||
if (← getTrustHash) then
|
||||
if let some hash ← Hash.load? hashFile then
|
||||
return hash
|
||||
let hash ← computeHash file
|
||||
let hash ← computeFileHash file text
|
||||
createParentDirs hashFile
|
||||
IO.FS.writeFile hashFile hash.toString
|
||||
return hash
|
||||
@@ -177,9 +179,11 @@ def fetchFileHash (file : FilePath) : JobM Hash := do
|
||||
/--
|
||||
Fetches the trace of a file that may have already have its hash cached
|
||||
in a `.hash` file. If no such `.hash` file exists, recomputes and creates it.
|
||||
|
||||
If `text := true`, `file` is hashed as text file rather than a binary file.
|
||||
-/
|
||||
def fetchFileTrace (file : FilePath) : JobM BuildTrace := do
|
||||
return .mk (← fetchFileHash file) (← getMTime file)
|
||||
def fetchFileTrace (file : FilePath) (text := false) : JobM BuildTrace := do
|
||||
return .mk (← fetchFileHash file text) (← getMTime file)
|
||||
|
||||
/--
|
||||
Builds `file` using `build` unless it already exists and `depTrace` matches
|
||||
@@ -191,66 +195,83 @@ a `.log.json` file and replayed from there if the build is skipped.
|
||||
For example, given `file := "foo.c"`, compares `depTrace` with that in
|
||||
`foo.c.trace` with the hash cached in `foo.c.hash` and the log cached in
|
||||
`foo.c.trace`.
|
||||
|
||||
If `text := true`, `file` is hashed as a text file rather than a binary file.
|
||||
-/
|
||||
def buildFileUnlessUpToDate
|
||||
(file : FilePath) (depTrace : BuildTrace) (build : JobM PUnit)
|
||||
(file : FilePath) (depTrace : BuildTrace) (build : JobM PUnit) (text := false)
|
||||
: JobM BuildTrace := do
|
||||
let traceFile := FilePath.mk <| file.toString ++ ".trace"
|
||||
buildUnlessUpToDate file depTrace traceFile do
|
||||
build
|
||||
clearFileHash file
|
||||
fetchFileTrace file
|
||||
fetchFileTrace file text
|
||||
|
||||
/--
|
||||
Build `file` using `build` after `dep` completes if the dependency's
|
||||
trace (and/or `extraDepTrace`) has changed.
|
||||
|
||||
If `text := true`, `file` is handled as a text file rather than a binary file.
|
||||
-/
|
||||
@[inline] def buildFileAfterDep
|
||||
(file : FilePath) (dep : BuildJob α) (build : α → JobM PUnit)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil) (text := false)
|
||||
: SpawnM (BuildJob FilePath) :=
|
||||
dep.bindSync fun depInfo depTrace => do
|
||||
let depTrace := depTrace.mix (← extraDepTrace)
|
||||
let trace ← buildFileUnlessUpToDate file depTrace <| build depInfo
|
||||
let trace ← buildFileUnlessUpToDate file depTrace (build depInfo) text
|
||||
return (file, trace)
|
||||
|
||||
/-- Build `file` using `build` after `deps` have built if any of their traces change. -/
|
||||
/--
|
||||
Build `file` using `build` after `deps` have built if any of their traces change.
|
||||
|
||||
If `text := true`, `file` is handled as a text file rather than a binary file.
|
||||
-/
|
||||
@[inline] def buildFileAfterDepList
|
||||
(file : FilePath) (deps : List (BuildJob α)) (build : List α → JobM PUnit)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil) (text := false)
|
||||
: SpawnM (BuildJob FilePath) := do
|
||||
buildFileAfterDep file (← BuildJob.collectList deps) build extraDepTrace
|
||||
buildFileAfterDep file (.collectList deps) build extraDepTrace text
|
||||
|
||||
/-- Build `file` using `build` after `deps` have built if any of their traces change. -/
|
||||
/--
|
||||
Build `file` using `build` after `deps` have built if any of their traces change.
|
||||
|
||||
If `text := true`, `file` is handled as a text file rather than a binary file.
|
||||
-/
|
||||
@[inline] def buildFileAfterDepArray
|
||||
(file : FilePath) (deps : Array (BuildJob α)) (build : Array α → JobM PUnit)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil)
|
||||
(extraDepTrace : JobM _ := pure BuildTrace.nil) (text := false)
|
||||
: SpawnM (BuildJob FilePath) := do
|
||||
buildFileAfterDep file (← BuildJob.collectArray deps) build extraDepTrace
|
||||
buildFileAfterDep file (.collectArray deps) build extraDepTrace text
|
||||
|
||||
/-! ## Common Builds -/
|
||||
|
||||
/--
|
||||
A build job for binary file that is expected to already exist (e.g., a data blob).
|
||||
Any byte difference in the file will trigger a rebuild of dependents.
|
||||
|
||||
Any byte difference in a binary file will trigger a rebuild of its dependents.
|
||||
-/
|
||||
def inputBinFile (path : FilePath) : SpawnM (BuildJob FilePath) :=
|
||||
Job.async <| (path, ·) <$> computeTrace path
|
||||
|
||||
/--
|
||||
A build job for text file that is expected to already exist (e.g., a source file).
|
||||
Normalizes line endings (converts CRLF to LF) to produce platform-independent traces.
|
||||
|
||||
Text file traces have normalized line endings to avoid unnecessary rebuilds across platforms.
|
||||
-/
|
||||
def inputTextFile (path : FilePath) : SpawnM (BuildJob FilePath) :=
|
||||
Job.async <| (path, ·) <$> computeTrace (TextFilePath.mk path)
|
||||
|
||||
/--
|
||||
A build job for file that is expected to already exist.
|
||||
A build job for file that is expected to already exist (e.g., a data blob or source file).
|
||||
|
||||
**Deprecated:** Use either `inputTextFile` or `inputBinFile`.
|
||||
`inputTextFile` normalizes line endings to produce platform-independent traces.
|
||||
If `text := true`, the file is handled as a text file rather than a binary file.
|
||||
Any byte difference in a binary file will trigger a rebuild of its dependents.
|
||||
In contrast, text file traces have normalized line endings to avoid unnecessary
|
||||
rebuilds across platforms.
|
||||
-/
|
||||
@[deprecated (since := "2024-06-08")] abbrev inputFile := @inputBinFile
|
||||
@[inline] def inputFile (path : FilePath) (text : Bool) : SpawnM (BuildJob FilePath) :=
|
||||
if text then inputTextFile path else inputBinFile path
|
||||
|
||||
/--
|
||||
Build an object file from a source file job using `compiler`. The invocation is:
|
||||
|
||||
@@ -298,11 +298,11 @@ instance : Functor BuildJob where
|
||||
@[inline] protected def wait? (self : BuildJob α) : BaseIO (Option α) :=
|
||||
(·.map (·.1)) <$> self.toJob.wait?
|
||||
|
||||
def add (t1 : BuildJob α) (t2 : BuildJob β) : BuildJob α :=
|
||||
mk <| t1.toJob.zipWith (fun a _ => a) t2.toJob
|
||||
def add (self : BuildJob α) (other : BuildJob β) : BuildJob α :=
|
||||
mk <| self.toJob.zipWith (fun a _ => a) other.toJob
|
||||
|
||||
def mix (t1 : BuildJob α) (t2 : BuildJob β) : BuildJob Unit :=
|
||||
mk <| t1.toJob.zipWith (fun (_,t) (_,t') => ((), mixTrace t t')) t2.toJob
|
||||
def mix (self : BuildJob α) (other : BuildJob β) : BuildJob Unit :=
|
||||
mk <| self.toJob.zipWith (fun (_,t) (_,t') => ((), mixTrace t t')) other.toJob
|
||||
|
||||
def mixList (jobs : List (BuildJob α)) : Id (BuildJob Unit) := ofJob $
|
||||
jobs.foldr (·.toJob.zipWith (fun (_,t') t => mixTrace t t') ·) (pure nilTrace)
|
||||
@@ -311,12 +311,12 @@ def mixArray (jobs : Array (BuildJob α)) : Id (BuildJob Unit) := ofJob $
|
||||
jobs.foldl (·.zipWith (fun t (_,t') => mixTrace t t') ·.toJob) (pure nilTrace)
|
||||
|
||||
def zipWith
|
||||
(f : α → β → γ) (t1 : BuildJob α) (t2 : BuildJob β)
|
||||
(f : α → β → γ) (self : BuildJob α) (other : BuildJob β)
|
||||
: BuildJob γ :=
|
||||
mk <| t1.toJob.zipWith (fun (a,t) (b,t') => (f a b, mixTrace t t')) t2.toJob
|
||||
mk <| self.toJob.zipWith (fun (a,t) (b,t') => (f a b, mixTrace t t')) other.toJob
|
||||
|
||||
def collectList (jobs : List (BuildJob α)) : Id (BuildJob (List α)) :=
|
||||
return jobs.foldr (zipWith List.cons) (pure [])
|
||||
|
||||
def collectArray (jobs : Array (BuildJob α)) : Id (BuildJob (Array α)) :=
|
||||
return jobs.foldl (zipWith Array.push) (pure #[])
|
||||
return jobs.foldl (zipWith Array.push) (pure (Array.mkEmpty jobs.size))
|
||||
|
||||
@@ -19,7 +19,10 @@ open Lean (Name)
|
||||
|
||||
/-- Compute a topological ordering of the package's transitive dependencies. -/
|
||||
def Package.recComputeDeps (self : Package) : FetchM (Array Package) := do
|
||||
(·.toArray) <$> self.deps.foldlM (init := OrdPackageSet.empty) fun deps dep => do
|
||||
(·.toArray) <$> self.depConfigs.foldlM (init := OrdPackageSet.empty) fun deps cfg => do
|
||||
let some dep ← findPackage? cfg.name
|
||||
| error s!"{self.name}: package not found for dependency '{cfg.name}' \
|
||||
(this is likely a bug in Lake)"
|
||||
return (← fetch <| dep.facet `deps).foldl (·.insert ·) deps |>.insert dep
|
||||
|
||||
/-- The `PackageFacetConfig` for the builtin `depsFacet`. -/
|
||||
|
||||
@@ -36,6 +36,10 @@ fetch functions, but not all fetch functions need build something.
|
||||
abbrev DFetchFn (α : Type u) (β : α → Type v) (m : Type v → Type w) :=
|
||||
(a : α) → m (β a)
|
||||
|
||||
/-- A `DFetchFn` that is not dependently typed. -/
|
||||
abbrev FetchFn (α : Type u) (β : Type v) (m : Type v → Type w) :=
|
||||
α → m β
|
||||
|
||||
/-!
|
||||
In order to nest builds / fetches within one another,
|
||||
we equip the monad `m` with a fetch function of its own.
|
||||
|
||||
@@ -6,12 +6,20 @@ Authors: Mac Malone
|
||||
import Lake.Util.IO
|
||||
import Lean.Data.Json
|
||||
|
||||
/-! # Lake Traces
|
||||
|
||||
This module defines Lake traces and associated utilities.
|
||||
Traces are used to determine whether a Lake build artifact is *dirty*
|
||||
(needs to be rebuilt) or is already *up-to-date*.
|
||||
The primary type is `Lake.BuildTrace`.
|
||||
-/
|
||||
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Utilities -/
|
||||
/-! ## Utilities -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class CheckExists.{u} (i : Type u) where
|
||||
@@ -24,60 +32,63 @@ instance : CheckExists FilePath where
|
||||
checkExists := FilePath.pathExists
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Trace Abstraction -/
|
||||
/-! ## Trace Abstraction -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class ComputeTrace.{u,v,w} (i : Type u) (m : outParam $ Type v → Type w) (t : Type v) where
|
||||
/-- Compute the trace of some target info using information from the monadic context. -/
|
||||
computeTrace : i → m t
|
||||
class ComputeTrace (α : Type u) (m : outParam $ Type v → Type w) (τ : Type v) where
|
||||
/-- Compute the trace of an object in its preferred monad. -/
|
||||
computeTrace : α → m τ
|
||||
|
||||
@[inline] def computeTrace [ComputeTrace i m t] [MonadLiftT m n] (info : i) : n t :=
|
||||
liftM <| ComputeTrace.computeTrace info
|
||||
/-- Compute the trace of an object in a supporting monad. -/
|
||||
@[inline] def computeTrace [ComputeTrace α m τ] [MonadLiftT m n] (a : α) : n τ :=
|
||||
liftM <| ComputeTrace.computeTrace a
|
||||
|
||||
class NilTrace.{u} (t : Type u) where
|
||||
class NilTrace.{u} (α : Type u) where
|
||||
/-- The nil trace. Should not unduly clash with a proper trace. -/
|
||||
nilTrace : t
|
||||
nilTrace : α
|
||||
|
||||
export NilTrace (nilTrace)
|
||||
|
||||
instance inhabitedOfNilTrace [NilTrace t] : Inhabited t := ⟨nilTrace⟩
|
||||
instance inhabitedOfNilTrace [NilTrace α] : Inhabited α := ⟨nilTrace⟩
|
||||
|
||||
class MixTrace.{u} (t : Type u) where
|
||||
class MixTrace.{u} (α : Type u) where
|
||||
/-- Combine two traces. The result should be dirty if either of the inputs is dirty. -/
|
||||
mixTrace : t → t → t
|
||||
mixTrace : α → α → α
|
||||
|
||||
export MixTrace (mixTrace)
|
||||
|
||||
section
|
||||
variable [MixTrace t] [NilTrace t]
|
||||
variable [MixTrace τ] [NilTrace τ]
|
||||
|
||||
def mixTraceList (traces : List t) : t :=
|
||||
/- Combine a `List` of traces (left-to-right). -/
|
||||
def mixTraceList (traces : List τ) : τ :=
|
||||
traces.foldl mixTrace nilTrace
|
||||
|
||||
def mixTraceArray (traces : Array t) : t :=
|
||||
/- Combine an `Array` of traces (left-to-right). -/
|
||||
def mixTraceArray (traces : Array τ) : τ :=
|
||||
traces.foldl mixTrace nilTrace
|
||||
|
||||
variable [ComputeTrace i m t]
|
||||
variable [ComputeTrace α m τ]
|
||||
|
||||
@[specialize] def computeListTrace [MonadLiftT m n] [Monad n] (artifacts : List i) : n t :=
|
||||
artifacts.foldlM (fun ts t => return mixTrace ts (← computeTrace t)) nilTrace
|
||||
/- Compute the trace of each element of a `List` and combine them (left-to-right). -/
|
||||
@[inline] def computeListTrace [MonadLiftT m n] [Monad n] (as : List α) : n τ :=
|
||||
as.foldlM (fun ts t => return mixTrace ts (← computeTrace t)) nilTrace
|
||||
|
||||
instance [Monad m] : ComputeTrace (List i) m t := ⟨computeListTrace⟩
|
||||
instance [Monad m] : ComputeTrace (List α) m τ := ⟨computeListTrace⟩
|
||||
|
||||
@[specialize] def computeArrayTrace [MonadLiftT m n] [Monad n] (artifacts : Array i) : n t :=
|
||||
artifacts.foldlM (fun ts t => return mixTrace ts (← computeTrace t)) nilTrace
|
||||
/- Compute the trace of each element of an `Array` and combine them (left-to-right). -/
|
||||
@[inline] def computeArrayTrace [MonadLiftT m n] [Monad n] (as : Array α) : n τ :=
|
||||
as.foldlM (fun ts t => return mixTrace ts (← computeTrace t)) nilTrace
|
||||
|
||||
instance [Monad m] : ComputeTrace (Array i) m t := ⟨computeArrayTrace⟩
|
||||
instance [Monad m] : ComputeTrace (Array α) m τ := ⟨computeArrayTrace⟩
|
||||
end
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Hash Trace -/
|
||||
/-! ## Hash Trace -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/--
|
||||
A content hash.
|
||||
TODO: Use a secure hash rather than the builtin Lean hash function.
|
||||
-/
|
||||
/-- A content hash. -/
|
||||
-- TODO: Use a secure hash rather than the builtin Lean hash function.
|
||||
structure Hash where
|
||||
val : UInt64
|
||||
deriving BEq, DecidableEq, Repr
|
||||
@@ -127,51 +138,66 @@ instance : FromJson Hash := ⟨Hash.fromJson?⟩
|
||||
end Hash
|
||||
|
||||
class ComputeHash (α : Type u) (m : outParam $ Type → Type v) where
|
||||
/-- Compute the hash of an object in its preferred monad. -/
|
||||
computeHash : α → m Hash
|
||||
|
||||
instance [ComputeHash α m] : ComputeTrace α m Hash := ⟨ComputeHash.computeHash⟩
|
||||
|
||||
/-- Compute the hash of object `a` in a pure context. -/
|
||||
@[inline] def pureHash [ComputeHash α Id] (a : α) : Hash :=
|
||||
ComputeHash.computeHash a
|
||||
|
||||
/-- Compute the hash an object in an supporting monad. -/
|
||||
@[inline] def computeHash [ComputeHash α m] [MonadLiftT m n] (a : α) : n Hash :=
|
||||
liftM <| ComputeHash.computeHash a
|
||||
|
||||
instance : ComputeHash String Id := ⟨Hash.ofString⟩
|
||||
|
||||
def computeFileHash (file : FilePath) : IO Hash :=
|
||||
/--
|
||||
Compute the hash of a binary file.
|
||||
Binary files are equivalent only if they are byte identical.
|
||||
-/
|
||||
def computeBinFileHash (file : FilePath) : IO Hash :=
|
||||
Hash.ofByteArray <$> IO.FS.readBinFile file
|
||||
|
||||
instance : ComputeHash FilePath IO := ⟨computeFileHash⟩
|
||||
instance : ComputeHash FilePath IO := ⟨computeBinFileHash⟩
|
||||
|
||||
/--
|
||||
Compute the hash of a text file.
|
||||
Normalizes `\r\n` sequences to `\n` for cross-platform compatibility.
|
||||
-/
|
||||
def computeTextFileHash (file : FilePath) : IO Hash := do
|
||||
let text ← IO.FS.readFile file
|
||||
let text := text.crlfToLf
|
||||
return Hash.ofString text
|
||||
|
||||
/--
|
||||
A wrapper around `FilePath` that adjusts its `ComputeHash` implementation
|
||||
to normalize `\r\n` sequences to `\n` for cross-platform compatibility. -/
|
||||
A wrapper around `FilePath` that adjusts its `ComputeHash` implementation
|
||||
to normalize `\r\n` sequences to `\n` for cross-platform compatibility.
|
||||
-/
|
||||
structure TextFilePath where
|
||||
path : FilePath
|
||||
|
||||
instance : Coe TextFilePath FilePath := ⟨(·.path)⟩
|
||||
instance : ComputeHash TextFilePath IO := ⟨(computeTextFileHash ·)⟩
|
||||
|
||||
instance : ComputeHash TextFilePath IO where
|
||||
computeHash file := computeTextFileHash file
|
||||
/-- Compute the hash of a file. If `text := true`, normalize line endings. -/
|
||||
@[inline] def computeFileHash (file : FilePath) (text := false) : IO Hash :=
|
||||
if text then computeTextFileHash file else computeBinFileHash file
|
||||
|
||||
@[specialize] def computeArrayHash [ComputeHash α m] [Monad m] (xs : Array α) : m Hash :=
|
||||
xs.foldlM (fun h a => return h.mix (← computeHash a)) .nil
|
||||
/-- Compute the hash of each element of an array and combine them (left-to-right). -/
|
||||
@[inline] def computeArrayHash [ComputeHash α m] [Monad m] (as : Array α) : m Hash :=
|
||||
computeArrayTrace as
|
||||
|
||||
instance [ComputeHash α m] [Monad m] : ComputeHash (Array α) m := ⟨computeArrayHash⟩
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Modification Time (MTime) Trace -/
|
||||
/-! ## Modification Time (MTime) Trace -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
open IO.FS (SystemTime)
|
||||
|
||||
/-- A modification time. -/
|
||||
/-- A modification time (e.g., of a file). -/
|
||||
def MTime := SystemTime
|
||||
|
||||
namespace MTime
|
||||
@@ -192,12 +218,14 @@ instance : MixTrace MTime := ⟨max⟩
|
||||
|
||||
end MTime
|
||||
|
||||
class GetMTime (α) where
|
||||
class GetMTime (α : Type u) where
|
||||
/-- Return the modification time of an object. -/
|
||||
getMTime : α → IO MTime
|
||||
|
||||
export GetMTime (getMTime)
|
||||
instance [GetMTime α] : ComputeTrace α IO MTime := ⟨getMTime⟩
|
||||
|
||||
/-- Return the modification time of a file recorded by the OS. -/
|
||||
@[inline] def getFileMTime (file : FilePath) : IO MTime :=
|
||||
return (← file.metadata).modified
|
||||
|
||||
@@ -216,7 +244,7 @@ That is, check if the info is newer than `self`.
|
||||
| .error _ => return false
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
/-! # Lake Build Trace (Hash + MTIme) -/
|
||||
/-! ## Lake Build Trace -/
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
/-- Trace used for common Lake targets. Combines `Hash` and `MTime`. -/
|
||||
@@ -242,10 +270,10 @@ def nil : BuildTrace :=
|
||||
|
||||
instance : NilTrace BuildTrace := ⟨nil⟩
|
||||
|
||||
@[specialize] def compute [ComputeHash i m] [MonadLiftT m IO] [GetMTime i] (info : i) : IO BuildTrace :=
|
||||
@[specialize] def compute [ComputeHash α m] [MonadLiftT m IO] [GetMTime α] (info : α) : IO BuildTrace :=
|
||||
return mk (← computeHash info) (← getMTime info)
|
||||
|
||||
instance [ComputeHash i m] [MonadLiftT m IO] [GetMTime i] : ComputeTrace i IO BuildTrace := ⟨compute⟩
|
||||
instance [ComputeHash α m] [MonadLiftT m IO] [GetMTime α] : ComputeTrace α IO BuildTrace := ⟨compute⟩
|
||||
|
||||
def mix (t1 t2 : BuildTrace) : BuildTrace :=
|
||||
mk (Hash.mix t1.hash t2.hash) (max t1.mtime t2.mtime)
|
||||
|
||||
@@ -41,12 +41,12 @@ BASIC OPTIONS:
|
||||
--help, -h print help of the program or a command and exit
|
||||
--dir, -d=file use the package configuration in a specific directory
|
||||
--file, -f=file use a specific file for the package configuration
|
||||
--lean=cmd specify the `lean` command used by Lake
|
||||
-K key[=value] set the configuration file option named key
|
||||
--old only rebuild modified modules (ignore transitive deps)
|
||||
--rehash, -H hash all files for traces (do not trust `.hash` files)
|
||||
--update, -U update manifest before building
|
||||
--update, -U update dependencies on load (e.g., before a build)
|
||||
--reconfigure, -R elaborate configuration files instead of using OLeans
|
||||
--keep-toolchain do not update toolchain on workspace update
|
||||
--no-build exit immediately if a build target is not up-to-date
|
||||
--no-cache build packages locally; do not download build caches
|
||||
--try-cache attempt to download build caches for supported packages
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
|
||||
-/
|
||||
import Lake.Util.Git
|
||||
import Lake.Util.Sugar
|
||||
import Lake.Util.Version
|
||||
import Lake.Config.Lang
|
||||
import Lake.Config.Package
|
||||
import Lake.Config.Workspace
|
||||
@@ -18,9 +19,6 @@ open Lean (Name)
|
||||
/-- The default module of an executable in `std` package. -/
|
||||
def defaultExeRoot : Name := `Main
|
||||
|
||||
/-- `elan` toolchain file name -/
|
||||
def toolchainFileName : FilePath := "lean-toolchain"
|
||||
|
||||
def gitignoreContents :=
|
||||
s!"/{defaultLakeDir}
|
||||
"
|
||||
|
||||
@@ -26,6 +26,7 @@ namespace Lake
|
||||
/-! ## General options for top-level `lake` -/
|
||||
|
||||
structure LakeOptions where
|
||||
args : List String := []
|
||||
rootDir : FilePath := "."
|
||||
configFile : FilePath := defaultConfigFile
|
||||
elanInstall? : Option ElanInstall := none
|
||||
@@ -36,6 +37,7 @@ structure LakeOptions where
|
||||
wantsHelp : Bool := false
|
||||
verbosity : Verbosity := .normal
|
||||
updateDeps : Bool := false
|
||||
updateToolchain : Bool := true
|
||||
reconfigure : Bool := false
|
||||
oldMode : Bool := false
|
||||
trustHash : Bool := true
|
||||
@@ -72,12 +74,15 @@ def LakeOptions.computeEnv (opts : LakeOptions) : EIO CliError Lake.Env := do
|
||||
/-- Make a `LoadConfig` from a `LakeOptions`. -/
|
||||
def LakeOptions.mkLoadConfig (opts : LakeOptions) : EIO CliError LoadConfig :=
|
||||
return {
|
||||
lakeArgs? := opts.args.toArray
|
||||
lakeEnv := ← opts.computeEnv
|
||||
wsDir := opts.rootDir
|
||||
relConfigFile := opts.configFile
|
||||
lakeOpts := opts.configOpts
|
||||
leanOpts := Lean.Options.empty
|
||||
reconfigure := opts.reconfigure
|
||||
updateDeps := opts.updateDeps
|
||||
updateToolchain := opts.updateToolchain
|
||||
}
|
||||
|
||||
/-- Make a `BuildConfig` from a `LakeOptions`. -/
|
||||
@@ -101,7 +106,7 @@ abbrev CliM := ArgsT CliStateM
|
||||
|
||||
def CliM.run (self : CliM α) (args : List String) : BaseIO ExitCode := do
|
||||
let (elanInstall?, leanInstall?, lakeInstall?) ← findInstall?
|
||||
let main := self.run' args |>.run' {elanInstall?, leanInstall?, lakeInstall?}
|
||||
let main := self.run' args |>.run' {args, elanInstall?, leanInstall?, lakeInstall?}
|
||||
let main := main.run >>= fun | .ok a => pure a | .error e => error e.toString
|
||||
main.run
|
||||
|
||||
@@ -111,6 +116,12 @@ def CliM.run (self : CliM α) (args : List String) : BaseIO ExitCode := do
|
||||
|
||||
instance (priority := low) : MonadLift LogIO CliStateM := ⟨CliStateM.runLogIO⟩
|
||||
|
||||
@[inline] def CliStateM.runLoggerIO (x : LoggerIO α) : CliStateM α := do
|
||||
let opts ← get
|
||||
MainM.runLoggerIO x opts.outLv opts.ansiMode
|
||||
|
||||
instance (priority := low) : MonadLift LoggerIO CliStateM := ⟨CliStateM.runLoggerIO⟩
|
||||
|
||||
/-! ## Argument Parsing -/
|
||||
|
||||
def takeArg (arg : String) : CliM String := do
|
||||
@@ -141,10 +152,6 @@ def noArgsRem (act : CliStateM α) : CliM α := do
|
||||
def getWantsHelp : CliStateM Bool :=
|
||||
(·.wantsHelp) <$> get
|
||||
|
||||
def setLean (lean : String) : CliStateM PUnit := do
|
||||
let leanInstall? ← findLeanCmdInstall? lean
|
||||
modify ({· with leanInstall?})
|
||||
|
||||
def setConfigOpt (kvPair : String) : CliM PUnit :=
|
||||
let pos := kvPair.posOf '='
|
||||
let (key, val) :=
|
||||
@@ -171,6 +178,7 @@ def lakeLongOption : (opt : String) → CliM PUnit
|
||||
| "--quiet" => modifyThe LakeOptions ({· with verbosity := .quiet})
|
||||
| "--verbose" => modifyThe LakeOptions ({· with verbosity := .verbose})
|
||||
| "--update" => modifyThe LakeOptions ({· with updateDeps := true})
|
||||
| "--keep-toolchain" => modifyThe LakeOptions ({· with updateToolchain := false})
|
||||
| "--reconfigure" => modifyThe LakeOptions ({· with reconfigure := true})
|
||||
| "--old" => modifyThe LakeOptions ({· with oldMode := true})
|
||||
| "--no-build" => modifyThe LakeOptions ({· with noBuild := true})
|
||||
@@ -193,7 +201,6 @@ def lakeLongOption : (opt : String) → CliM PUnit
|
||||
| "--file" => do
|
||||
let configFile ← takeOptArg "--file" "path"
|
||||
modifyThe LakeOptions ({· with configFile})
|
||||
| "--lean" => do setLean <| ← takeOptArg "--lean" "path or command"
|
||||
| "--help" => modifyThe LakeOptions ({· with wantsHelp := true})
|
||||
| "--" => do
|
||||
let subArgs ← takeArgs
|
||||
@@ -331,7 +338,7 @@ protected def build : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
let ws ← loadWorkspace config opts.updateDeps
|
||||
let ws ← loadWorkspace config
|
||||
let targetSpecs ← takeArgs
|
||||
let specs ← parseTargetSpecs ws targetSpecs
|
||||
let buildConfig := mkBuildConfig opts (out := .stdout)
|
||||
@@ -350,7 +357,7 @@ protected def resolveDeps : CliM PUnit := do
|
||||
let opts ← getThe LakeOptions
|
||||
let config ← mkLoadConfig opts
|
||||
noArgsRem do
|
||||
discard <| loadWorkspace config opts.updateDeps
|
||||
discard <| loadWorkspace config
|
||||
|
||||
protected def update : CliM PUnit := do
|
||||
processOptions lakeOption
|
||||
|
||||
@@ -38,7 +38,7 @@ def setupFile
|
||||
IO.eprintln s!"Invalid Lake configuration. Please restart the server after fixing the Lake configuration file."
|
||||
exit 1
|
||||
let outLv := buildConfig.verbosity.minLogLv
|
||||
let ws ← MainM.runLogIO (minLv := outLv) (ansiMode := .noAnsi) do
|
||||
let ws ← MainM.runLoggerIO (minLv := outLv) (ansiMode := .noAnsi) do
|
||||
loadWorkspace loadConfig
|
||||
let imports := imports.foldl (init := #[]) fun imps imp =>
|
||||
if let some mod := ws.findModule? imp.toName then imps.push mod else imps
|
||||
@@ -71,7 +71,7 @@ with the given additional `args`.
|
||||
-/
|
||||
def serve (config : LoadConfig) (args : Array String) : IO UInt32 := do
|
||||
let (extraEnv, moreServerArgs) ← do
|
||||
let (ws?, log) ← (loadWorkspace config).run?
|
||||
let (ws?, log) ← (loadWorkspace config).captureLog
|
||||
log.replay (logger := MonadLog.stderr)
|
||||
if let some ws := ws? then
|
||||
let ctx := mkLakeContext ws
|
||||
|
||||
@@ -63,7 +63,7 @@ def compute
|
||||
lake, lean, elan?,
|
||||
pkgUrlMap := ← computePkgUrlMap
|
||||
reservoirApiUrl := ← getUrlD "RESERVOIR_API_URL" s!"{reservoirBaseUrl}/v1"
|
||||
noCache := (noCache <|> (← IO.getEnv "LAKE_NO_CACHE").bind toBool?).getD false
|
||||
noCache := (noCache <|> (← IO.getEnv "LAKE_NO_CACHE").bind envToBool?).getD false
|
||||
githashOverride := (← IO.getEnv "LEAN_GITHASH").getD ""
|
||||
initToolchain := (← IO.getEnv "ELAN_TOOLCHAIN").getD ""
|
||||
initLeanPath := ← getSearchPath "LEAN_PATH",
|
||||
@@ -72,10 +72,6 @@ def compute
|
||||
initPath := ← getSearchPath "PATH"
|
||||
}
|
||||
where
|
||||
toBool? (o : String) : Option Bool :=
|
||||
if ["y", "yes", "t", "true", "on", "1"].contains o.toLower then true
|
||||
else if ["n", "no", "f", "false", "off", "0"].contains o.toLower then false
|
||||
else none
|
||||
computePkgUrlMap := do
|
||||
let some urlMapStr ← IO.getEnv "LAKE_PKG_URL_MAP" | return {}
|
||||
match Json.parse urlMapStr |>.bind fromJson? with
|
||||
@@ -144,14 +140,29 @@ Combines the initial path of the environment with that of the Lean installation.
|
||||
def sharedLibPath (env : Env) : SearchPath :=
|
||||
env.lean.sharedLibPath ++ env.initSharedLibPath
|
||||
|
||||
/-- Unset toolchain-specific environment variables. -/
|
||||
def noToolchainVars : Array (String × Option String) :=
|
||||
#[
|
||||
("ELAN_TOOLCHAIN", none),
|
||||
("LAKE", none),
|
||||
("LAKE_OVERRIDE_LEAN", none),
|
||||
("LAKE_HOME", none),
|
||||
("LEAN", none),
|
||||
("LEAN_GITHASH", none),
|
||||
("LEAN_SYSROOT", none),
|
||||
("LEAN_AR", none)
|
||||
]
|
||||
|
||||
/-- Environment variable settings that are not augmented by a Lake workspace. -/
|
||||
def baseVars (env : Env) : Array (String × Option String) :=
|
||||
#[
|
||||
("ELAN", env.elan?.map (·.elan.toString)),
|
||||
("ELAN_HOME", env.elan?.map (·.home.toString)),
|
||||
("ELAN_TOOLCHAIN", if env.toolchain.isEmpty then none else env.toolchain),
|
||||
("LAKE", env.lake.lake.toString),
|
||||
("LAKE_HOME", env.lake.home.toString),
|
||||
("LAKE_PKG_URL_MAP", toJson env.pkgUrlMap |>.compress),
|
||||
("LEAN", env.lean.lean.toString),
|
||||
("LEAN_GITHASH", env.leanGithash),
|
||||
("LEAN_SYSROOT", env.lean.sysroot.toString),
|
||||
("LEAN_AR", env.lean.ar.toString),
|
||||
|
||||
@@ -9,16 +9,18 @@ import Lake.Config.Defaults
|
||||
open System
|
||||
namespace Lake
|
||||
|
||||
/-! ## Data Structures -/
|
||||
/-- Convert the string value of an environment variable to a boolean. -/
|
||||
def envToBool? (o : String) : Option Bool :=
|
||||
if ["y", "yes", "t", "true", "on", "1"].contains o.toLower then true
|
||||
else if ["n", "no", "f", "false", "off", "0"].contains o.toLower then false
|
||||
else none
|
||||
|
||||
/-- Standard path of `elan` in a Elan installation. -/
|
||||
def elanExe (home : FilePath) :=
|
||||
home / "bin" / "elan" |>.addExtension FilePath.exeExtension
|
||||
/-! ## Data Structures -/
|
||||
|
||||
/-- Information about the local Elan setup. -/
|
||||
structure ElanInstall where
|
||||
home : FilePath
|
||||
elan := elanExe home
|
||||
elan : FilePath
|
||||
binDir := home / "bin"
|
||||
toolchainsDir := home / "toolchains"
|
||||
deriving Inhabited, Repr
|
||||
@@ -57,7 +59,7 @@ def initSharedLib : FilePath :=
|
||||
/-- Path information about the local Lean installation. -/
|
||||
structure LeanInstall where
|
||||
sysroot : FilePath
|
||||
githash : String
|
||||
githash : String := ""
|
||||
srcDir := sysroot / "src" / "lean"
|
||||
leanLibDir := sysroot / "lib" / "lean"
|
||||
includeDir := sysroot / "include"
|
||||
@@ -67,9 +69,9 @@ structure LeanInstall where
|
||||
leanc := leancExe sysroot
|
||||
sharedLib := leanSharedLibDir sysroot / leanSharedLib
|
||||
initSharedLib := leanSharedLibDir sysroot / initSharedLib
|
||||
ar : FilePath
|
||||
cc : FilePath
|
||||
customCc : Bool
|
||||
ar : FilePath := "ar"
|
||||
cc : FilePath := "cc"
|
||||
customCc : Bool := false
|
||||
deriving Inhabited, Repr
|
||||
|
||||
/--
|
||||
@@ -110,12 +112,16 @@ def LakeInstall.ofLean (lean : LeanInstall) : LakeInstall where
|
||||
/-! ## Detection Functions -/
|
||||
|
||||
/--
|
||||
Attempt to detect a Elan installation by checking the `ELAN_HOME`
|
||||
environment variable for a installation location.
|
||||
Attempt to detect an Elan installation by checking the `ELAN` and `ELAN_HOME`
|
||||
environment variables. If `ELAN` is set but empty, Elan is considered disabled.
|
||||
-/
|
||||
def findElanInstall? : BaseIO (Option ElanInstall) := do
|
||||
if let some home ← IO.getEnv "ELAN_HOME" then
|
||||
return some {home}
|
||||
let elan := (← IO.getEnv "ELAN").getD "elan"
|
||||
if elan.trim.isEmpty then
|
||||
return none
|
||||
else
|
||||
return some {elan, home}
|
||||
return none
|
||||
|
||||
/--
|
||||
@@ -149,9 +155,9 @@ set to the empty string.
|
||||
|
||||
For (2), if `LEAN_AR` or `LEAN_CC` are defined, it uses those paths.
|
||||
Otherwise, if Lean is packaged with an `llvm-ar` and/or `clang`, use them.
|
||||
If not, use the `ar` and/or `cc` in the system's `PATH`. This last step is
|
||||
needed because internal builds of Lean do not bundle these tools
|
||||
(unlike user-facing releases).
|
||||
If not, use the `ar` and/or `cc` from the `AR` / `CC` environment variables
|
||||
or the system's `PATH`. This last step is needed because internal builds of
|
||||
Lean do not bundle these tools (unlike user-facing releases).
|
||||
|
||||
We also track whether `LEAN_CC` was set to determine whether it should
|
||||
be set in the future for `lake env`. This is because if `LEAN_CC` was not set,
|
||||
@@ -187,18 +193,29 @@ where
|
||||
return FilePath.mk ar
|
||||
else
|
||||
let ar := leanArExe sysroot
|
||||
if (← ar.pathExists) then pure ar else pure "ar"
|
||||
if (← ar.pathExists) then
|
||||
return ar
|
||||
else if let some ar ← IO.getEnv "AR" then
|
||||
return ar
|
||||
else
|
||||
return "ar"
|
||||
findCc := do
|
||||
if let some cc ← IO.getEnv "LEAN_CC" then
|
||||
return (FilePath.mk cc, true)
|
||||
else
|
||||
let cc := leanCcExe sysroot
|
||||
let cc := if (← cc.pathExists) then cc else "cc"
|
||||
let cc ←
|
||||
if (← cc.pathExists) then
|
||||
pure cc
|
||||
else if let some cc ← IO.getEnv "CC" then
|
||||
pure cc
|
||||
else
|
||||
pure "cc"
|
||||
return (cc, false)
|
||||
|
||||
/--
|
||||
Attempt to detect the installation of the given `lean` command
|
||||
by calling `findLeanCmdHome?`. See `LeanInstall.get` for how it assumes the
|
||||
by calling `findLeanSysroot?`. See `LeanInstall.get` for how it assumes the
|
||||
Lean install is organized.
|
||||
-/
|
||||
def findLeanCmdInstall? (lean := "lean") : BaseIO (Option LeanInstall) :=
|
||||
@@ -235,14 +252,28 @@ def getLakeInstall? (lake : FilePath) : BaseIO (Option LakeInstall) := do
|
||||
return none
|
||||
|
||||
/--
|
||||
Attempt to detect Lean's installation by first checking the
|
||||
`LEAN_SYSROOT` environment variable and then by trying `findLeanCmdHome?`.
|
||||
Attempt to detect Lean's installation by using the `LEAN` and `LEAN_SYSROOT`
|
||||
environment variables.
|
||||
|
||||
If `LEAN_SYSROOT` is set, use it. Otherwise, check `LEAN` for the `lean`
|
||||
executable. If `LEAN` is set but empty, Lean will be considered disabled.
|
||||
Otherwise, Lean's location will be determined by trying `findLeanSysroot?`
|
||||
using value of `LEAN` or, if unset, the `lean` in `PATH`.
|
||||
|
||||
See `LeanInstall.get` for how it assumes the Lean install is organized.
|
||||
-/
|
||||
def findLeanInstall? : BaseIO (Option LeanInstall) := do
|
||||
if let some sysroot ← IO.getEnv "LEAN_SYSROOT" then
|
||||
return some <| ← LeanInstall.get sysroot
|
||||
if let some sysroot ← findLeanSysroot? then
|
||||
let lean ← do
|
||||
if let some lean ← IO.getEnv "LEAN" then
|
||||
if lean.trim.isEmpty then
|
||||
return none
|
||||
else
|
||||
pure lean
|
||||
else
|
||||
pure "lean"
|
||||
if let some sysroot ← findLeanSysroot? lean then
|
||||
return some <| ← LeanInstall.get sysroot
|
||||
return none
|
||||
|
||||
@@ -271,7 +302,8 @@ Then it attempts to detect if Lake and Lean are part of a single installation
|
||||
where the `lake` executable is co-located with the `lean` executable (i.e., they
|
||||
are in the same directory). If Lean and Lake are not co-located, Lake will
|
||||
attempt to find the their installations separately by calling
|
||||
`findLeanInstall?` and `findLakeInstall?`.
|
||||
`findLeanInstall?` and `findLakeInstall?`. Setting `LAKE_OVERRIDE_LEAN` to true
|
||||
will force Lake to use `findLeanInstall?` even if co-located.
|
||||
|
||||
When co-located, Lake will assume that Lean and Lake's binaries are located in
|
||||
`<sysroot>/bin`, their Lean libraries in `<sysroot>/lib/lean`, Lean's source files
|
||||
@@ -280,9 +312,13 @@ following the pattern of a regular Lean toolchain.
|
||||
-/
|
||||
def findInstall? : BaseIO (Option ElanInstall × Option LeanInstall × Option LakeInstall) := do
|
||||
let elan? ← findElanInstall?
|
||||
if let some home ← findLakeLeanJointHome? then
|
||||
let lean ← LeanInstall.get home (collocated := true)
|
||||
let lake := LakeInstall.ofLean lean
|
||||
return (elan?, lean, lake)
|
||||
if let some sysroot ← findLakeLeanJointHome? then
|
||||
if (← IO.getEnv "LAKE_OVERRIDE_LEAN").bind envToBool? |>.getD false then
|
||||
let lake := LakeInstall.ofLean {sysroot}
|
||||
return (elan?, ← findLeanInstall?, lake)
|
||||
else
|
||||
let lean ← LeanInstall.get sysroot (collocated := true)
|
||||
let lake := LakeInstall.ofLean lean
|
||||
return (elan?, lean, lake)
|
||||
else
|
||||
return (elan?, ← findLeanInstall?, ← findLakeInstall?)
|
||||
|
||||
@@ -45,6 +45,10 @@ abbrev MonadLake (m : Type → Type u) :=
|
||||
@[inline] def mkLakeContext (ws : Workspace) : Lake.Context where
|
||||
opaqueWs := ws
|
||||
|
||||
/-- Run a `LakeT` monad in the context of this workspace. -/
|
||||
@[inline] def Workspace.runLakeT (ws : Workspace) (x : LakeT m α) : m α :=
|
||||
x.run (mkLakeContext ws)
|
||||
|
||||
instance [MonadWorkspace m] [Functor m] : MonadLake m where
|
||||
read := (mkLakeContext ·) <$> getWorkspace
|
||||
|
||||
|
||||
@@ -8,9 +8,6 @@ import Lake.Util.Opaque
|
||||
|
||||
namespace Lake
|
||||
|
||||
/-- Opaque reference to a `Package` used for forward declaration. -/
|
||||
declare_opaque_type OpaquePackage
|
||||
|
||||
/-- Opaque reference to a `Workspace` used for forward declaration. -/
|
||||
declare_opaque_type OpaqueWorkspace
|
||||
|
||||
|
||||
@@ -380,11 +380,9 @@ structure Package where
|
||||
/-- The path to the package's JSON manifest of remote dependencies (relative to `dir`). -/
|
||||
relManifestFile : FilePath := config.manifestFile.getD defaultManifestFile
|
||||
/-- The package's scope (e.g., in Reservoir). -/
|
||||
scope : String := ""
|
||||
scope : String
|
||||
/-- The URL to this package's Git remote. -/
|
||||
remoteUrl : String := ""
|
||||
/-- (Opaque references to) the package's direct dependencies. -/
|
||||
opaqueDeps : Array OpaquePackage := #[]
|
||||
remoteUrl : String
|
||||
/-- Dependency configurations for the package. -/
|
||||
depConfigs : Array Dependency := #[]
|
||||
/-- Lean library configurations for the package. -/
|
||||
@@ -419,8 +417,6 @@ instance : Nonempty Package :=
|
||||
have : Inhabited Environment := Classical.inhabited_of_nonempty inferInstance
|
||||
⟨by constructor <;> exact default⟩
|
||||
|
||||
hydrate_opaque_type OpaquePackage Package
|
||||
|
||||
instance : Hashable Package where hash pkg := hash pkg.config.name
|
||||
instance : BEq Package where beq p1 p2 := p1.config.name == p2.config.name
|
||||
|
||||
@@ -508,10 +504,6 @@ namespace Package
|
||||
@[inline] def readmeFile (self : Package) : FilePath :=
|
||||
self.dir / self.config.readmeFile
|
||||
|
||||
/-- The package's direct dependencies. -/
|
||||
@[inline] def deps (self : Package) : Array Package :=
|
||||
self.opaqueDeps.map (·.get)
|
||||
|
||||
/-- The path to the package's Lake directory relative to `dir` (e.g., `.lake`). -/
|
||||
@[inline] def relLakeDir (_ : Package) : FilePath :=
|
||||
defaultLakeDir
|
||||
|
||||
@@ -18,8 +18,14 @@ open Lean (Name)
|
||||
structure Workspace : Type where
|
||||
/-- The root package of the workspace. -/
|
||||
root : Package
|
||||
/-- The detect `Lake.Env` of the workspace. -/
|
||||
/-- The detected `Lake.Env` of the workspace. -/
|
||||
lakeEnv : Lake.Env
|
||||
/--
|
||||
The CLI arguments Lake was run with.
|
||||
Used by `lake update` to perform a restart of Lake on a toolchain update.
|
||||
A value of `none` means that Lake is not restartable via the CLI.
|
||||
-/
|
||||
lakeArgs? : Option (Array String) := none
|
||||
/-- The packages within the workspace (in `require` declaration order). -/
|
||||
packages : Array Package := {}
|
||||
/-- Name-package map of packages within the workspace. -/
|
||||
@@ -77,7 +83,7 @@ def addPackage (pkg : Package) (self : Workspace) : Workspace :=
|
||||
|
||||
/-- Try to find a script in the workspace with the given name. -/
|
||||
protected def findScript? (script : Name) (self : Workspace) : Option Script :=
|
||||
self.packages.findSomeRev? (·.scripts.find? script)
|
||||
self.packages.findSome? (·.scripts.find? script)
|
||||
|
||||
/-- Check if the module is local to any package in the workspace. -/
|
||||
def isLocalModule (mod : Name) (self : Workspace) : Bool :=
|
||||
@@ -89,27 +95,27 @@ def isBuildableModule (mod : Name) (self : Workspace) : Bool :=
|
||||
|
||||
/-- Locate the named, buildable, importable, local module in the workspace. -/
|
||||
protected def findModule? (mod : Name) (self : Workspace) : Option Module :=
|
||||
self.packages.findSomeRev? (·.findModule? mod)
|
||||
self.packages.findSome? (·.findModule? mod)
|
||||
|
||||
/-- Locate the named, buildable, but not necessarily importable, module in the workspace. -/
|
||||
def findTargetModule? (mod : Name) (self : Workspace) : Option Module :=
|
||||
self.packages.findSomeRev? (·.findTargetModule? mod)
|
||||
self.packages.findSome? (·.findTargetModule? mod)
|
||||
|
||||
/-- Try to find a Lean library in the workspace with the given name. -/
|
||||
protected def findLeanLib? (name : Name) (self : Workspace) : Option LeanLib :=
|
||||
self.packages.findSomeRev? fun pkg => pkg.findLeanLib? name
|
||||
self.packages.findSome? fun pkg => pkg.findLeanLib? name
|
||||
|
||||
/-- Try to find a Lean executable in the workspace with the given name. -/
|
||||
protected def findLeanExe? (name : Name) (self : Workspace) : Option LeanExe :=
|
||||
self.packages.findSomeRev? fun pkg => pkg.findLeanExe? name
|
||||
self.packages.findSome? fun pkg => pkg.findLeanExe? name
|
||||
|
||||
/-- Try to find an external library in the workspace with the given name. -/
|
||||
protected def findExternLib? (name : Name) (self : Workspace) : Option ExternLib :=
|
||||
self.packages.findSomeRev? fun pkg => pkg.findExternLib? name
|
||||
self.packages.findSome? fun pkg => pkg.findExternLib? name
|
||||
|
||||
/-- Try to find a target configuration in the workspace with the given name. -/
|
||||
def findTargetConfig? (name : Name) (self : Workspace) : Option ((pkg : Package) × TargetConfig pkg.name name) :=
|
||||
self.packages.findSomeRev? fun pkg => pkg.findTargetConfig? name <&> (⟨pkg, ·⟩)
|
||||
self.packages.findSome? fun pkg => pkg.findTargetConfig? name <&> (⟨pkg, ·⟩)
|
||||
|
||||
/-- Add a module facet to the workspace. -/
|
||||
def addModuleFacetConfig (cfg : ModuleFacetConfig name) (self : Workspace) : Workspace :=
|
||||
@@ -137,15 +143,15 @@ def findLibraryFacetConfig? (name : Name) (self : Workspace) : Option (LibraryFa
|
||||
|
||||
/-- The workspace's binary directories (which are added to `Path`). -/
|
||||
def binPath (self : Workspace) : SearchPath :=
|
||||
self.packages.foldr (fun pkg dirs => pkg.binDir :: dirs) []
|
||||
self.packages.foldl (fun dirs pkg => pkg.binDir :: dirs) []
|
||||
|
||||
/-- The workspace's Lean library directories (which are added to `LEAN_PATH`). -/
|
||||
def leanPath (self : Workspace) : SearchPath :=
|
||||
self.packages.foldr (fun pkg dirs => pkg.leanLibDir :: dirs) []
|
||||
self.packages.foldl (fun dirs pkg => pkg.leanLibDir :: dirs) []
|
||||
|
||||
/-- The workspace's source directories (which are added to `LEAN_SRC_PATH`). -/
|
||||
def leanSrcPath (self : Workspace) : SearchPath :=
|
||||
self.packages.foldr (init := {}) fun pkg dirs =>
|
||||
self.packages.foldl (init := {}) fun dirs pkg =>
|
||||
pkg.leanLibConfigs.foldr (init := dirs) fun cfg dirs =>
|
||||
pkg.srcDir / cfg.srcDir :: dirs
|
||||
|
||||
|
||||
@@ -8,6 +8,7 @@ import Lean.Data.Options
|
||||
import Lake.Config.Defaults
|
||||
import Lake.Config.Env
|
||||
import Lake.Util.Log
|
||||
import Lake.Util.Version
|
||||
|
||||
namespace Lake
|
||||
open System Lean
|
||||
@@ -16,6 +17,12 @@ open System Lean
|
||||
structure LoadConfig where
|
||||
/-- The Lake environment of the load process. -/
|
||||
lakeEnv : Lake.Env
|
||||
/--
|
||||
The CLI arguments Lake was run with.
|
||||
Used to perform a restart of Lake on a toolchain update.
|
||||
A value of `none` means that Lake is not restartable via the CLI.
|
||||
-/
|
||||
lakeArgs? : Option (Array String) := none
|
||||
/-- The root directory of the Lake workspace. -/
|
||||
wsDir : FilePath
|
||||
/-- The directory of the loaded package (relative to the root). -/
|
||||
@@ -26,8 +33,15 @@ structure LoadConfig where
|
||||
lakeOpts : NameMap String := {}
|
||||
/-- The Lean options with which to elaborate the configuration file. -/
|
||||
leanOpts : Options := {}
|
||||
/-- If `true`, Lake will elaborate configuration files instead of using OLeans. -/
|
||||
/-- Whether Lake should re-elaborate configuration files instead of using cached OLeans. -/
|
||||
reconfigure : Bool := false
|
||||
/-- Whether to update dependencies when loading the workspace. -/
|
||||
updateDeps : Bool := false
|
||||
/--
|
||||
Whether to update the workspace's `lean-toolchain` when dependencies are updated.
|
||||
If `true` and a toolchain update occurs, Lake will need to be restarted.
|
||||
-/
|
||||
updateToolchain : Bool := true
|
||||
/-- The package's scope (e.g., in Reservoir). -/
|
||||
scope : String := ""
|
||||
/-- The URL to this package's Git remote (if any). -/
|
||||
|
||||
@@ -20,31 +20,36 @@ or resolve a local path dependency.
|
||||
namespace Lake
|
||||
|
||||
/-- Update the Git package in `repo` to `rev` if not already at it. -/
|
||||
def updateGitPkg (name : String) (repo : GitRepo) (rev? : Option String) : LogIO PUnit := do
|
||||
def updateGitPkg
|
||||
(name : String) (repo : GitRepo) (rev? : Option String)
|
||||
: LogIO PUnit := do
|
||||
let rev ← repo.findRemoteRevision rev?
|
||||
if (← repo.getHeadRevision) = rev then
|
||||
if (← repo.hasDiff) then
|
||||
logWarning s!"{name}: repository '{repo.dir}' has local changes"
|
||||
else
|
||||
logInfo s!"{name}: updating repository '{repo.dir}' to revision '{rev}'"
|
||||
logInfo s!"{name}: checking out revision '{rev}'"
|
||||
repo.checkoutDetach rev
|
||||
|
||||
/-- Clone the Git package as `repo`. -/
|
||||
def cloneGitPkg (name : String) (repo : GitRepo)
|
||||
(url : String) (rev? : Option String) : LogIO PUnit := do
|
||||
logInfo s!"{name}: cloning {url} to '{repo.dir}'"
|
||||
def cloneGitPkg
|
||||
(name : String) (repo : GitRepo) (url : String) (rev? : Option String)
|
||||
: LogIO PUnit := do
|
||||
logInfo s!"{name}: cloning {url}"
|
||||
repo.clone url
|
||||
if let some rev := rev? then
|
||||
let hash ← repo.resolveRemoteRevision rev
|
||||
repo.checkoutDetach hash
|
||||
let rev ← repo.resolveRemoteRevision rev
|
||||
logInfo s!"{name}: checking out revision '{rev}'"
|
||||
repo.checkoutDetach rev
|
||||
|
||||
/--
|
||||
Update the Git repository from `url` in `repo` to `rev?`.
|
||||
If `repo` is already from `url`, just checkout the new revision.
|
||||
Otherwise, delete the local repository and clone a fresh copy from `url`.
|
||||
-/
|
||||
def updateGitRepo (name : String) (repo : GitRepo)
|
||||
(url : String) (rev? : Option String) : LogIO Unit := do
|
||||
def updateGitRepo
|
||||
(name : String) (repo : GitRepo) (url : String) (rev? : Option String)
|
||||
: LogIO Unit := do
|
||||
let sameUrl ← EIO.catchExceptions (h := fun _ => pure false) <| show IO Bool from do
|
||||
let some remoteUrl ← repo.getRemoteUrl? | return false
|
||||
if remoteUrl = url then return true
|
||||
@@ -65,8 +70,9 @@ def updateGitRepo (name : String) (repo : GitRepo)
|
||||
Materialize the Git repository from `url` into `repo` at `rev?`.
|
||||
Clone it if no local copy exists, otherwise update it.
|
||||
-/
|
||||
def materializeGitRepo (name : String) (repo : GitRepo)
|
||||
(url : String) (rev? : Option String) : LogIO Unit := do
|
||||
def materializeGitRepo
|
||||
(name : String) (repo : GitRepo) (url : String) (rev? : Option String)
|
||||
: LogIO Unit := do
|
||||
if (← repo.dirExists) then
|
||||
updateGitRepo name repo url rev?
|
||||
else
|
||||
@@ -110,11 +116,7 @@ def Dependency.materialize
|
||||
match src with
|
||||
| .path dir =>
|
||||
let relPkgDir := relParentDir / dir
|
||||
return {
|
||||
relPkgDir
|
||||
remoteUrl := ""
|
||||
manifestEntry := mkEntry <| .path relPkgDir
|
||||
}
|
||||
return mkDep relPkgDir "" (.path relPkgDir)
|
||||
| .git url inputRev? subDir? => do
|
||||
let sname := dep.name.toString (escape := false)
|
||||
let repoUrl := Git.filterUrl? url |>.getD ""
|
||||
@@ -127,7 +129,7 @@ def Dependency.materialize
|
||||
if ver.startsWith "git#" then
|
||||
return ver.drop 4
|
||||
else
|
||||
error s!"{dep.name} unsupported dependency version format '{ver}' (should be \"git#>rev>\")"
|
||||
error s!"{dep.name}: unsupported dependency version format '{ver}' (should be \"git#>rev>\")"
|
||||
let depName := dep.name.toString (escape := false)
|
||||
let some pkg ← Reservoir.fetchPkg? lakeEnv dep.scope depName
|
||||
| error s!"{dep.scope}/{depName}: could not materialize package: \
|
||||
@@ -139,18 +141,17 @@ def Dependency.materialize
|
||||
(githubUrl?.getD "") (verRev? <|> defaultBranch?) subDir?
|
||||
| _ => error s!"{pkg.fullName}: Git source not found on Reservoir"
|
||||
where
|
||||
mkEntry src : PackageEntry :=
|
||||
{name := dep.name, scope := dep.scope, inherited, src}
|
||||
materializeGit name relPkgDir gitUrl remoteUrl inputRev? subDir? : LogIO MaterializedDep := do
|
||||
let repo := GitRepo.mk (wsDir / relPkgDir)
|
||||
let gitUrl := lakeEnv.pkgUrlMap.find? dep.name |>.getD gitUrl
|
||||
materializeGitRepo name repo gitUrl inputRev?
|
||||
let rev ← repo.getHeadRevision
|
||||
let relPkgDir := if let some subDir := subDir? then relPkgDir / subDir else relPkgDir
|
||||
return {
|
||||
relPkgDir, remoteUrl
|
||||
manifestEntry := mkEntry <| .git gitUrl rev inputRev? subDir?
|
||||
}
|
||||
return mkDep relPkgDir remoteUrl <| .git gitUrl rev inputRev? subDir?
|
||||
@[inline] mkDep relPkgDir remoteUrl src : MaterializedDep := {
|
||||
relPkgDir, remoteUrl,
|
||||
manifestEntry := {name := dep.name, scope := dep.scope, inherited, src}
|
||||
}
|
||||
|
||||
/--
|
||||
Materializes a manifest package entry, cloning and/or checking it out as necessary.
|
||||
@@ -161,11 +162,7 @@ def PackageEntry.materialize
|
||||
: LogIO MaterializedDep :=
|
||||
match manifestEntry.src with
|
||||
| .path (dir := relPkgDir) .. =>
|
||||
return {
|
||||
relPkgDir
|
||||
remoteUrl := ""
|
||||
manifestEntry
|
||||
}
|
||||
return mkDep relPkgDir ""
|
||||
| .git (url := url) (rev := rev) (subDir? := subDir?) .. => do
|
||||
let sname := manifestEntry.name.toString (escape := false)
|
||||
let relGitDir := relPkgsDir / sname
|
||||
@@ -188,8 +185,7 @@ def PackageEntry.materialize
|
||||
let url := lakeEnv.pkgUrlMap.find? manifestEntry.name |>.getD url
|
||||
cloneGitPkg sname repo url rev
|
||||
let relPkgDir := match subDir? with | .some subDir => relGitDir / subDir | .none => relGitDir
|
||||
return {
|
||||
relPkgDir
|
||||
remoteUrl := Git.filterUrl? url |>.getD ""
|
||||
manifestEntry
|
||||
}
|
||||
return mkDep relPkgDir (Git.filterUrl? url |>.getD "")
|
||||
where
|
||||
@[inline] mkDep relPkgDir remoteUrl : MaterializedDep :=
|
||||
{relPkgDir, remoteUrl, manifestEntry}
|
||||
|
||||
@@ -18,6 +18,21 @@ This module contains definitions for resolving the dependencies of a package.
|
||||
|
||||
namespace Lake
|
||||
|
||||
def stdMismatchError (newName : String) (rev : String) :=
|
||||
s!"the 'std' package has been renamed to '{newName}' and moved to the
|
||||
'leanprover-community' organization; downstream packages which wish to
|
||||
update to the new std should replace
|
||||
|
||||
require std from
|
||||
git \"https://github.com/leanprover/std4\"{rev}
|
||||
|
||||
in their Lake configuration file with
|
||||
|
||||
require {newName} from
|
||||
git \"https://github.com/leanprover-community/{newName}\"{rev}
|
||||
|
||||
"
|
||||
|
||||
/--
|
||||
Loads the package configuration of a materialized dependency.
|
||||
Adds the facets defined in the package to the `Workspace`.
|
||||
@@ -43,100 +58,82 @@ def loadDepPackage
|
||||
else
|
||||
return (pkg, ws)
|
||||
|
||||
/-- The monad of the dependency resolver. -/
|
||||
abbrev ResolveT m := CallStackT Name <| StateT Workspace m
|
||||
/--
|
||||
The resolver's call stack of dependencies.
|
||||
That is, the dependency currently being resolved plus its parents.
|
||||
-/
|
||||
abbrev DepStack := CallStack Name
|
||||
|
||||
@[inline] nonrec def ResolveT.run (ws : Workspace) (x : ResolveT m α) (stack : CallStack Name := {}) : m (α × Workspace) :=
|
||||
x.run stack |>.run ws
|
||||
/--
|
||||
A monad transformer for recursive dependency resolution.
|
||||
It equips the monad with the stack of dependencies currently being resolved.
|
||||
-/
|
||||
abbrev DepStackT m := CallStackT Name m
|
||||
|
||||
@[inline] nonrec def DepStackT.run
|
||||
(x : DepStackT m α) (stack : DepStack := {})
|
||||
: m α :=
|
||||
x.run stack
|
||||
|
||||
/-- Log dependency cycle and error. -/
|
||||
@[specialize] def depCycleError [MonadError m] (cycle : Cycle Name) : m α :=
|
||||
error s!"dependency cycle detected:\n{"\n".intercalate <| cycle.map (s!" {·}")}"
|
||||
|
||||
instance [Monad m] [MonadError m] : MonadCycleOf Name (ResolveT m) where
|
||||
instance [Monad m] [MonadError m] : MonadCycleOf Name (DepStackT m) where
|
||||
throwCycle := depCycleError
|
||||
|
||||
/--
|
||||
Recursively visits the workspace dependency graph, starting from `root`.
|
||||
At each package, loops through each direct dependency performing just `breath`.
|
||||
Them, loops again through the results applying `depth`, recursing, and adding
|
||||
the package to workspace's package set. Errors if a cycle is encountered.
|
||||
/-- The monad of the dependency resolver. -/
|
||||
abbrev ResolveT m := DepStackT <| StateT Workspace m
|
||||
|
||||
**Traversal Order**
|
||||
@[inline] nonrec def ResolveT.run
|
||||
(ws : Workspace) (x : ResolveT m α) (stack : DepStack := {})
|
||||
: m (α × Workspace) :=
|
||||
x.run stack |>.run ws
|
||||
|
||||
All dependencies of a package are visited in order before recursing to the
|
||||
dependencies' dependencies. For example, given the dependency graph:
|
||||
|
||||
```
|
||||
R
|
||||
|- A
|
||||
|- B
|
||||
|- X
|
||||
|- Y
|
||||
|- C
|
||||
```
|
||||
|
||||
Lake follows the order `R`, `A`, `B`, `C`, `X`, `Y`.
|
||||
|
||||
The logic behind this design is that users would expect the dependencies
|
||||
they write in a package configuration to be resolved accordingly and would be
|
||||
surprised if they are overridden by nested dependencies referring to the same
|
||||
package.
|
||||
|
||||
For example, were Lake to use a pure depth-first traversal, Lake would follow
|
||||
the order `R`, `A`, `B`, `X`, `Y`, `C`. If `X` and `C` are both the package
|
||||
`foo`, Lake would use the configuration of `foo` found in `B` rather than in
|
||||
the root `R`, which would likely confuse the user.
|
||||
-/
|
||||
@[specialize] def Workspace.resolveDeps
|
||||
/-- Recursively run a `ResolveT` monad starting from the workspace's root. -/
|
||||
@[specialize] private def Workspace.runResolveT
|
||||
[Monad m] [MonadError m] (ws : Workspace)
|
||||
(breadth : Package → Dependency → ResolveT m Package)
|
||||
(depth : Package → m PUnit := fun _ => pure ())
|
||||
(go : RecFetchFn Package PUnit (ResolveT m))
|
||||
(root := ws.root) (stack : DepStack := {})
|
||||
: m Workspace := do
|
||||
let (root, ws) ← ResolveT.run ws <| StateT.run' (s := {}) <|
|
||||
inline <| recFetchAcyclic (·.name) go ws.root
|
||||
return {ws with root}
|
||||
let (_, ws) ← ResolveT.run ws (stack := stack) do
|
||||
inline <| recFetchAcyclic (·.name) go root
|
||||
return ws
|
||||
|
||||
/-
|
||||
Recursively visits each node in a package's dependency graph, starting from
|
||||
the workspace package `root`. Each dependency missing from the workspace is
|
||||
resolved using the `resolve` function and added into the workspace.
|
||||
|
||||
Recursion occurs breadth-first. Each direct dependency of a package is
|
||||
resolved in reverse order before recursing to the dependencies' dependencies.
|
||||
|
||||
See `Workspace.updateAndMaterializeCore` for more details.
|
||||
-/
|
||||
@[inline] private def Workspace.resolveDepsCore
|
||||
[Monad m] [MonadError m] (ws : Workspace)
|
||||
(load : Package → Dependency → StateT Workspace m Package)
|
||||
(root : Package := ws.root) (stack : DepStack := {})
|
||||
: m Workspace := do
|
||||
ws.runResolveT go root stack
|
||||
where
|
||||
@[specialize] go pkg resolve : StateT (NameMap Package) (ResolveT m) Package := do
|
||||
pkg.depConfigs.forM fun dep => do
|
||||
if (← getThe (NameMap Package)).contains dep.name then
|
||||
return
|
||||
if (← getThe Workspace).packageMap.contains dep.name then
|
||||
return -- already resolved in another branch
|
||||
@[specialize] go pkg recurse : ResolveT m Unit := do
|
||||
let start := (← getWorkspace).packages.size
|
||||
-- Materialize and load the missing direct dependencies of `pkg`
|
||||
pkg.depConfigs.forRevM fun dep => do
|
||||
let ws ← getWorkspace
|
||||
if ws.packageMap.contains dep.name then
|
||||
return -- already handled in another branch
|
||||
if pkg.name = dep.name then
|
||||
error s!"{pkg.name}: package requires itself (or a package with the same name)"
|
||||
let pre ← breadth pkg dep -- package w/o dependencies
|
||||
store dep.name pre
|
||||
let deps ← pkg.depConfigs.mapM fun dep => do
|
||||
if let some pre ← fetch? dep.name then
|
||||
modifyThe (NameMap Package) (·.erase dep.name) -- for `dep` linearity
|
||||
depth pre
|
||||
return OpaquePackage.mk (← resolve pre)
|
||||
if let some dep ← findPackage? dep.name then
|
||||
return OpaquePackage.mk dep -- already resolved in another branch
|
||||
error s!"{dep.name}: impossible resolution state reached"
|
||||
let pkg := {pkg with opaqueDeps := deps}
|
||||
modifyThe Workspace (·.addPackage pkg)
|
||||
return pkg
|
||||
|
||||
def stdMismatchError (newName : String) (rev : String) :=
|
||||
s!"the 'std' package has been renamed to '{newName}' and moved to the
|
||||
'leanprover-community' organization; downstream packages which wish to
|
||||
update to the new std should replace
|
||||
|
||||
require std from
|
||||
git \"https://github.com/leanprover/std4\"{rev}
|
||||
|
||||
in their Lake configuration file with
|
||||
|
||||
require {newName} from
|
||||
git \"https://github.com/leanprover-community/{newName}\"{rev}
|
||||
|
||||
"
|
||||
let depPkg ← load pkg dep
|
||||
modifyThe Workspace (·.addPackage depPkg)
|
||||
-- Recursively load the dependencies' dependencies
|
||||
(← getWorkspace).packages.forM recurse start
|
||||
|
||||
/--
|
||||
The monad of the manifest updater.
|
||||
It is equipped with and entry map entries for the updated manifest.
|
||||
Adds monad state used to update the manifest.
|
||||
It equips the monad with a map of locked dependencies.
|
||||
-/
|
||||
abbrev UpdateT := StateT (NameMap PackageEntry)
|
||||
|
||||
@@ -147,7 +144,9 @@ abbrev UpdateT := StateT (NameMap PackageEntry)
|
||||
Reuse manifest versions of root packages that should not be updated.
|
||||
Also, move the packages directory if its location has changed.
|
||||
-/
|
||||
def reuseManifest (ws : Workspace) (toUpdate : NameSet) : UpdateT LogIO PUnit := do
|
||||
private def reuseManifest
|
||||
(ws : Workspace) (toUpdate : NameSet)
|
||||
: UpdateT LogIO PUnit := do
|
||||
let rootName := ws.root.name.toString (escape := false)
|
||||
match (← Manifest.load ws.manifestFile |>.toBaseIO) with
|
||||
| .ok manifest =>
|
||||
@@ -175,7 +174,7 @@ def reuseManifest (ws : Workspace) (toUpdate : NameSet) : UpdateT LogIO PUnit :=
|
||||
logWarning s!"{rootName}: ignoring previous manifest because it failed to load: {e}"
|
||||
|
||||
/-- Add a package dependency's manifest entries to the update state. -/
|
||||
def addDependencyEntries (pkg : Package) : UpdateT LogIO PUnit := do
|
||||
private def addDependencyEntries (pkg : Package) : UpdateT LogIO PUnit := do
|
||||
match (← Manifest.load pkg.manifestFile |>.toBaseIO) with
|
||||
| .ok manifest =>
|
||||
manifest.packages.forM fun entry => do
|
||||
@@ -187,22 +186,31 @@ def addDependencyEntries (pkg : Package) : UpdateT LogIO PUnit := do
|
||||
| .error e =>
|
||||
logWarning s!"{pkg.name}: ignoring manifest because it failed to load: {e}"
|
||||
|
||||
/-- Update a single dependency. -/
|
||||
def updateDep
|
||||
(pkg : Package) (dep : Dependency) (leanOpts : Options := {})
|
||||
: ResolveT (UpdateT LogIO) Package := do
|
||||
let ws ← getThe Workspace
|
||||
let inherited := pkg.name != ws.root.name
|
||||
-- Materialize the dependency
|
||||
let matDep ← id do
|
||||
if let some entry ← fetch? dep.name then
|
||||
entry.materialize ws.lakeEnv ws.dir ws.relPkgsDir
|
||||
else
|
||||
let matDep ← dep.materialize inherited ws.lakeEnv ws.dir ws.relPkgsDir pkg.relDir
|
||||
store matDep.name matDep.manifestEntry
|
||||
return matDep
|
||||
-- Load the package
|
||||
let depPkg ← loadDepPackage matDep dep.opts leanOpts true
|
||||
/-- Materialize a single dependency, updating it if desired. -/
|
||||
private def updateAndMaterializeDep
|
||||
(ws : Workspace) (pkg : Package) (dep : Dependency)
|
||||
: UpdateT LogIO MaterializedDep := do
|
||||
if let some entry ← fetch? dep.name then
|
||||
entry.materialize ws.lakeEnv ws.dir ws.relPkgsDir
|
||||
else
|
||||
let inherited := pkg.name ≠ ws.root.name
|
||||
/-
|
||||
NOTE: A path dependency inherited from another dependency's manifest
|
||||
will always be of the form a `./<relPath>` (i.e., be relative to its
|
||||
workspace). Thus, when relativized to this workspace, it will have the
|
||||
path `<relPkgDir>/./<relPath>`. However, if defining dependency lacks
|
||||
a manifest, it will instead be locked as `<relPkgDir>/<relPath>`.
|
||||
Adding a `.` here eliminates this difference.
|
||||
-/
|
||||
let relPkgDir := if pkg.relDir == "." then pkg.relDir else pkg.relDir / "."
|
||||
let matDep ← dep.materialize inherited ws.lakeEnv ws.dir ws.relPkgsDir relPkgDir
|
||||
store matDep.name matDep.manifestEntry
|
||||
return matDep
|
||||
|
||||
/-- Verify that a dependency was loaded with the correct name. -/
|
||||
private def validateDep
|
||||
(pkg : Package) (dep : Dependency) (matDep : MaterializedDep) (depPkg : Package)
|
||||
: LogIO PUnit := do
|
||||
if depPkg.name ≠ dep.name then
|
||||
if dep.name = .mkSimple "std" then
|
||||
let rev :=
|
||||
@@ -216,24 +224,144 @@ def updateDep
|
||||
logError s!"'{dep.name}' was downloaded incorrectly; \
|
||||
you will need to manually delete '{depPkg.dir}': {e}"
|
||||
error s!"{pkg.name}: package '{depPkg.name}' was required as '{dep.name}'"
|
||||
return depPkg
|
||||
|
||||
/--
|
||||
Rebuild the workspace's Lake manifest and materialize missing dependencies.
|
||||
|
||||
Packages are updated to latest specific revision matching that in `require`
|
||||
(e.g., if the `require` is `@master`, update to latest commit on master) or
|
||||
removed if the `require` is removed. If `tuUpdate` is empty, update/remove all
|
||||
root dependencies. Otherwise, only update the root dependencies specified.
|
||||
|
||||
Package are always reconfigured when updated.
|
||||
Exit code returned if Lake needs a manual restart.
|
||||
Used, for instance, if the toolchain is updated and no Elan is detected.
|
||||
-/
|
||||
def Workspace.updateAndMaterialize
|
||||
(ws : Workspace) (toUpdate : NameSet := {}) (leanOpts : Options := {})
|
||||
: LogIO Workspace := do
|
||||
let (ws, entries) ← UpdateT.run do
|
||||
reuseManifest ws toUpdate
|
||||
ws.resolveDeps (updateDep · · leanOpts) (addDependencyEntries ·)
|
||||
def restartCode : ExitCode := 4
|
||||
|
||||
/--
|
||||
Update the workspace's `lean-toolchain` if necessary.
|
||||
|
||||
Compares the root's toolchain with that of its direct dependencies to find the
|
||||
best match. If none can be found, issue warning and return normally. If an
|
||||
update is found
|
||||
-/
|
||||
def Workspace.updateToolchain
|
||||
(ws : Workspace) (rootDeps : Array MaterializedDep)
|
||||
: LoggerIO PUnit := do
|
||||
let rootToolchainFile := ws.root.dir / toolchainFileName
|
||||
let rootTc? ← ToolchainVer.ofDir? ws.dir
|
||||
let (src, tc?, tcs) ← rootDeps.foldlM (init := (ws.root.name, rootTc?, #[])) fun s dep => do
|
||||
let depTc? ← ToolchainVer.ofDir? (ws.dir / dep.relPkgDir)
|
||||
let some depTc := depTc?
|
||||
| return s
|
||||
let (src, tc?, tcs) := s
|
||||
let some tc := tc?
|
||||
| return (dep.name, depTc?, tcs)
|
||||
if depTc ≤ tc then
|
||||
return (src, tc, tcs)
|
||||
else if tc < depTc then
|
||||
return (dep.name, depTc, tcs)
|
||||
else
|
||||
return (src, tc, tcs.push (dep.name, depTc))
|
||||
if 0 < tcs.size then
|
||||
let s := "toolchain not updated; multiple toolchain candidates:"
|
||||
let s := if let some tc := tc? then s!"{s}\n {tc}\n from {src}" else s
|
||||
let s := tcs.foldl (init := s) fun s (d, tc) => s!"{s}\n {tc}\n from {d}"
|
||||
logWarning s
|
||||
else if let some tc := tc? then
|
||||
if rootTc?.any (· == tc) then
|
||||
logInfo "toolchain not updated; already up-to-date"
|
||||
return
|
||||
logInfo s!"updating toolchain to '{tc}'"
|
||||
IO.FS.writeFile rootToolchainFile tc.toString
|
||||
let some lakeArgs := ws.lakeArgs?
|
||||
| logInfo s!"cannot auto-restart; you will need to manually restart Lake"
|
||||
IO.Process.exit restartCode.toUInt8
|
||||
let some elanInstall := ws.lakeEnv.elan?
|
||||
| logInfo s!"no Elan detected; you will need to manually restart Lake"
|
||||
IO.Process.exit restartCode.toUInt8
|
||||
logInfo s!"restarting Lake via Elan"
|
||||
let child ← IO.Process.spawn {
|
||||
cmd := elanInstall.elan.toString
|
||||
args := #["run", "--install", tc.toString, "lake"] ++ lakeArgs
|
||||
env := Env.noToolchainVars
|
||||
}
|
||||
IO.Process.exit (← child.wait).toUInt8
|
||||
else
|
||||
logInfo s!"toolchain not updated; no toolchain information found"
|
||||
|
||||
/--
|
||||
Updates the workspace, materializing and reconfiguring dependencies.
|
||||
|
||||
Dependencies are updated to latest specific revision matching that in `require`
|
||||
(e.g., if the `require` is `@master`, update to latest commit on master) or
|
||||
removed if the `require` is removed.
|
||||
If `tuUpdate` is empty, all direct dependencies of the workspace's root will be
|
||||
updated and/or remove. Otherwise, only those specified will be updated.
|
||||
|
||||
If `updateToolchain := true`, the workspace's toolchain is also updated to the
|
||||
latest toolchain compatible with the root and its direct dependencies.
|
||||
If there are multiple incomparable toolchain versions across them,
|
||||
a warning will be issued and no update performed.
|
||||
If an update is performed, Lake will automatically restart the update on the new
|
||||
toolchain (via `elan`). If `elan` is missing, it will instead request a manual
|
||||
restart from the user and exit immediately with `restartCode`.
|
||||
|
||||
**Dependency Traversal Order**
|
||||
|
||||
All dependencies of a package are visited in reverse order before recursing
|
||||
to the dependencies' dependencies. For example, given the dependency graph:
|
||||
|
||||
```
|
||||
R
|
||||
|- A
|
||||
|- B
|
||||
|- X
|
||||
|- Y
|
||||
|- C
|
||||
```
|
||||
|
||||
Lake follows the order `R`, `C`, `A`, `B`, `Y`, `X`.
|
||||
|
||||
The reason for this is two-fold:
|
||||
1. Like targets, later requires should shadow earlier definitions.
|
||||
2. Requires written by a user should take priority over those inherited
|
||||
from dependencies.
|
||||
|
||||
Were Lake to use a depth-first traversal, for example, Lake would follow
|
||||
the order `R`, `A`, `B`, `X`, `Y`, `C`. If `X` and `C` are both the package
|
||||
`foo`, Lake would use the configuration of `foo` found in `B` rather than in
|
||||
the root `R`, which would likely confuse the user.
|
||||
-/
|
||||
def Workspace.updateAndMaterializeCore
|
||||
(ws : Workspace)
|
||||
(toUpdate : NameSet := {}) (leanOpts : Options := {})
|
||||
(updateToolchain := true)
|
||||
: LoggerIO (Workspace × NameMap PackageEntry) := UpdateT.run do
|
||||
reuseManifest ws toUpdate
|
||||
let ws := ws.addPackage ws.root
|
||||
if updateToolchain then
|
||||
let deps := ws.root.depConfigs.reverse
|
||||
let matDeps ← deps.mapM fun dep => do
|
||||
logVerbose s!"{ws.root.name}: updating '{dep.name}' with {toJson dep.opts}"
|
||||
updateAndMaterializeDep ws ws.root dep
|
||||
ws.updateToolchain matDeps
|
||||
let start := ws.packages.size
|
||||
let ws ← (deps.zip matDeps).foldlM (init := ws) fun ws (dep, matDep) => do
|
||||
let (depPkg, ws) ← loadUpdatedDep ws.root dep matDep ws
|
||||
let ws := ws.addPackage depPkg
|
||||
return ws
|
||||
ws.packages.foldlM (init := ws) (start := start) fun ws pkg =>
|
||||
ws.resolveDepsCore (stack := [ws.root.name]) updateAndLoadDep pkg
|
||||
else
|
||||
ws.resolveDepsCore updateAndLoadDep
|
||||
where
|
||||
@[inline] updateAndLoadDep pkg dep := do
|
||||
let matDep ← updateAndMaterializeDep (← getWorkspace) pkg dep
|
||||
loadUpdatedDep pkg dep matDep
|
||||
@[inline] loadUpdatedDep pkg dep matDep : StateT Workspace (UpdateT LogIO) Package := do
|
||||
let depPkg ← loadDepPackage matDep dep.opts leanOpts true
|
||||
validateDep pkg dep matDep depPkg
|
||||
addDependencyEntries depPkg
|
||||
return depPkg
|
||||
|
||||
/-- Write package entries to the workspace manifest. -/
|
||||
def Workspace.writeManifest
|
||||
(ws : Workspace) (entries : NameMap PackageEntry)
|
||||
: LogIO PUnit := do
|
||||
let manifestEntries := ws.packages.foldl (init := #[]) fun arr pkg =>
|
||||
match entries.find? pkg.name with
|
||||
| some entry => arr.push <|
|
||||
@@ -246,10 +374,28 @@ def Workspace.updateAndMaterialize
|
||||
packages := manifestEntries
|
||||
}
|
||||
manifest.saveToFile ws.manifestFile
|
||||
LakeT.run ⟨ws⟩ <| ws.packages.forM fun pkg => do
|
||||
unless pkg.postUpdateHooks.isEmpty do
|
||||
logInfo s!"{pkg.name}: running post-update hooks"
|
||||
pkg.postUpdateHooks.forM fun hook => hook.get.fn pkg
|
||||
|
||||
/-- Run a package's `post_update` hooks. -/
|
||||
def Package.runPostUpdateHooks (pkg : Package) : LakeT LogIO PUnit := do
|
||||
unless pkg.postUpdateHooks.isEmpty do
|
||||
logInfo s!"{pkg.name}: running post-update hooks"
|
||||
pkg.postUpdateHooks.forM fun hook => hook.get.fn pkg
|
||||
|
||||
/--
|
||||
Updates the workspace, writes the new Lake manifest, and runs package
|
||||
post-update hooks.
|
||||
|
||||
See `Workspace.updateAndMaterializeCore` for details on the update process.
|
||||
-/
|
||||
def Workspace.updateAndMaterialize
|
||||
(ws : Workspace)
|
||||
(toUpdate : NameSet := {}) (leanOpts : Options := {})
|
||||
(updateToolchain := true)
|
||||
: LoggerIO Workspace := do
|
||||
let (ws, entries) ←
|
||||
ws.updateAndMaterializeCore toUpdate leanOpts updateToolchain
|
||||
ws.writeManifest entries
|
||||
ws.runLakeT do ws.packages.forM (·.runPostUpdateHooks)
|
||||
return ws
|
||||
|
||||
/--
|
||||
@@ -293,8 +439,9 @@ def Workspace.materializeDeps
|
||||
let pkgEntries : NameMap PackageEntry := manifest.packages.foldl (init := {})
|
||||
fun map entry => map.insert entry.name entry
|
||||
validateManifest pkgEntries ws.root.depConfigs
|
||||
ws.resolveDeps fun pkg dep => do
|
||||
let ws ← getThe Workspace
|
||||
let ws := ws.addPackage ws.root
|
||||
ws.resolveDepsCore fun pkg dep => do
|
||||
let ws ← getWorkspace
|
||||
if let some entry := pkgEntries.find? dep.name then
|
||||
let result ← entry.materialize ws.lakeEnv ws.dir relPkgsDir
|
||||
loadDepPackage result dep.opts leanOpts reconfigure
|
||||
|
||||
@@ -25,7 +25,9 @@ def loadWorkspaceRoot (config : LoadConfig) : LogIO Workspace := do
|
||||
Lean.searchPathRef.set config.lakeEnv.leanSearchPath
|
||||
let (root, env?) ← loadPackageCore "[root]" config
|
||||
let ws : Workspace := {
|
||||
root, lakeEnv := config.lakeEnv
|
||||
root
|
||||
lakeEnv := config.lakeEnv
|
||||
lakeArgs? := config.lakeArgs?
|
||||
moduleFacetConfigs := initModuleFacetConfigs
|
||||
packageFacetConfigs := initPackageFacetConfigs
|
||||
libraryFacetConfigs := initLibraryFacetConfigs
|
||||
@@ -40,19 +42,19 @@ Load a `Workspace` for a Lake package by
|
||||
elaborating its configuration file and resolving its dependencies.
|
||||
If `updateDeps` is true, updates the manifest before resolving dependencies.
|
||||
-/
|
||||
def loadWorkspace (config : LoadConfig) (updateDeps := false) : LogIO Workspace := do
|
||||
let rc := config.reconfigure
|
||||
let leanOpts := config.leanOpts
|
||||
def loadWorkspace (config : LoadConfig) : LoggerIO Workspace := do
|
||||
let {reconfigure, leanOpts, updateDeps, updateToolchain, ..} := config
|
||||
let ws ← loadWorkspaceRoot config
|
||||
if updateDeps then
|
||||
ws.updateAndMaterialize {} leanOpts
|
||||
ws.updateAndMaterialize {} leanOpts updateToolchain
|
||||
else if let some manifest ← Manifest.load? ws.manifestFile then
|
||||
ws.materializeDeps manifest leanOpts rc
|
||||
ws.materializeDeps manifest leanOpts reconfigure
|
||||
else
|
||||
ws.updateAndMaterialize {} leanOpts
|
||||
ws.updateAndMaterialize {} leanOpts updateToolchain
|
||||
|
||||
/-- Updates the manifest for the loaded Lake workspace (see `updateAndMaterialize`). -/
|
||||
def updateManifest (config : LoadConfig) (toUpdate : NameSet := {}) : LogIO Unit := do
|
||||
let leanOpts := config.leanOpts
|
||||
def updateManifest (config : LoadConfig) (toUpdate : NameSet := {})
|
||||
: LoggerIO Unit := do
|
||||
let {leanOpts, updateToolchain, ..} := config
|
||||
let ws ← loadWorkspaceRoot config
|
||||
discard <| ws.updateAndMaterialize toUpdate leanOpts
|
||||
discard <| ws.updateAndMaterialize toUpdate leanOpts updateToolchain
|
||||
|
||||
@@ -3,6 +3,7 @@ Copyright (c) 2024 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Date
|
||||
|
||||
/-!
|
||||
# TOML Date-Time
|
||||
@@ -22,62 +23,10 @@ optionally left out, creating four distinct variants.
|
||||
|
||||
namespace Lake.Toml
|
||||
|
||||
def lpad (s : String) (c : Char) (len : Nat) : String :=
|
||||
"".pushn c (len - s.length) ++ s
|
||||
|
||||
def rpad (s : String) (c : Char) (len : Nat) : String :=
|
||||
s.pushn c (len - s.length)
|
||||
|
||||
def zpad (n : Nat) (len : Nat) : String :=
|
||||
lpad (toString n) '0' len
|
||||
|
||||
/-- A TOML date (year-month-day). -/
|
||||
structure Date where
|
||||
year : Nat
|
||||
month : Nat
|
||||
day : Nat
|
||||
deriving Inhabited, DecidableEq, Ord
|
||||
|
||||
namespace Date
|
||||
|
||||
abbrev IsLeapYear (y : Nat) : Prop :=
|
||||
y % 4 = 0 ∧ (y % 100 ≠ 0 ∨ y % 400 = 0)
|
||||
|
||||
abbrev IsValidMonth (m : Nat) : Prop :=
|
||||
m ≥ 1 ∧ m ≤ 12
|
||||
|
||||
def maxDay (y m : Nat) : Nat :=
|
||||
if m = 2 then
|
||||
if IsLeapYear y then 29 else 28
|
||||
else if m ≤ 7 then
|
||||
30 + (m % 2)
|
||||
else
|
||||
31 - (m % 2)
|
||||
|
||||
abbrev IsValidDay (y m d : Nat) : Prop :=
|
||||
d ≥ 1 ∧ d ≤ maxDay y m
|
||||
|
||||
def ofValid? (year month day : Nat) : Option Date := do
|
||||
guard (IsValidMonth month ∧ IsValidDay year month day)
|
||||
return {year, month, day}
|
||||
|
||||
def ofString? (t : String) : Option Date := do
|
||||
match t.split (· == '-') with
|
||||
| [y,m,d] =>
|
||||
ofValid? (← y.toNat?) (← m.toNat?) (← d.toNat?)
|
||||
| _ => none
|
||||
|
||||
protected def toString (d : Date) : String :=
|
||||
s!"{zpad d.year 4}-{zpad d.month 2}-{zpad d.day 2}"
|
||||
|
||||
instance : ToString Date := ⟨Date.toString⟩
|
||||
|
||||
end Date
|
||||
|
||||
/--
|
||||
A TOML time (hour:minute:second.fraction).
|
||||
|
||||
We do not represent whole time as seconds to due to the possibility
|
||||
We do not represent the whole time as seconds to due to the possibility
|
||||
of leap seconds in RFC 3339 times.
|
||||
-/
|
||||
structure Time where
|
||||
|
||||
69
src/lake/Lake/Util/Date.lean
Normal file
69
src/lake/Lake/Util/Date.lean
Normal file
@@ -0,0 +1,69 @@
|
||||
/-
|
||||
Copyright (c) 2024 Mac Malone. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
|
||||
/-!
|
||||
# Date
|
||||
|
||||
A year-mont-day date. Used by Lake's TOML parser and its toolchain version
|
||||
parser (for nightlies).
|
||||
-/
|
||||
|
||||
namespace Lake
|
||||
|
||||
def lpad (s : String) (c : Char) (len : Nat) : String :=
|
||||
"".pushn c (len - s.length) ++ s
|
||||
|
||||
def rpad (s : String) (c : Char) (len : Nat) : String :=
|
||||
s.pushn c (len - s.length)
|
||||
|
||||
def zpad (n : Nat) (len : Nat) : String :=
|
||||
lpad (toString n) '0' len
|
||||
|
||||
/-- A date (year-month-day). -/
|
||||
structure Date where
|
||||
year : Nat
|
||||
month : Nat
|
||||
day : Nat
|
||||
deriving Inhabited, DecidableEq, Ord, Repr
|
||||
|
||||
namespace Date
|
||||
|
||||
instance : LT Date := ltOfOrd
|
||||
instance : LE Date := leOfOrd
|
||||
instance : Min Date := minOfLe
|
||||
instance : Max Date := maxOfLe
|
||||
|
||||
abbrev IsLeapYear (y : Nat) : Prop :=
|
||||
y % 4 = 0 ∧ (y % 100 ≠ 0 ∨ y % 400 = 0)
|
||||
|
||||
abbrev IsValidMonth (m : Nat) : Prop :=
|
||||
m ≥ 1 ∧ m ≤ 12
|
||||
|
||||
def maxDay (y m : Nat) : Nat :=
|
||||
if m = 2 then
|
||||
if IsLeapYear y then 29 else 28
|
||||
else if m ≤ 7 then
|
||||
30 + (m % 2)
|
||||
else
|
||||
31 - (m % 2)
|
||||
|
||||
abbrev IsValidDay (y m d : Nat) : Prop :=
|
||||
d ≥ 1 ∧ d ≤ maxDay y m
|
||||
|
||||
def ofValid? (year month day : Nat) : Option Date := do
|
||||
guard (IsValidMonth month ∧ IsValidDay year month day)
|
||||
return {year, month, day}
|
||||
|
||||
def ofString? (t : String) : Option Date := do
|
||||
match t.split (· == '-') with
|
||||
| [y,m,d] =>
|
||||
ofValid? (← y.toNat?) (← m.toNat?) (← d.toNat?)
|
||||
| _ => none
|
||||
|
||||
protected def toString (d : Date) : String :=
|
||||
s!"{zpad d.year 4}-{zpad d.month 2}-{zpad d.day 2}"
|
||||
|
||||
instance : ToString Date := ⟨Date.toString⟩
|
||||
@@ -5,33 +5,39 @@ Authors: Mac Malone
|
||||
-/
|
||||
namespace Lake
|
||||
|
||||
instance (priority := low) [Monad m] [MonadExceptOf PUnit m] : Alternative m where
|
||||
failure := throw ()
|
||||
orElse := tryCatch
|
||||
|
||||
/-- Ensure direct lifts are preferred over indirect ones. -/
|
||||
instance (priority := high) [MonadLift α β] : MonadLiftT α β := ⟨MonadLift.monadLift⟩
|
||||
|
||||
instance [Pure m] : MonadLiftT Id m where
|
||||
instance (priority := low) [Pure m] : MonadLiftT Id m where
|
||||
monadLift act := pure act.run
|
||||
|
||||
instance [Alternative m] : MonadLiftT Option m where
|
||||
instance (priority := low) [Alternative m] : MonadLiftT Option m where
|
||||
monadLift
|
||||
| some a => pure a
|
||||
| none => failure
|
||||
|
||||
instance [Pure m] [MonadExceptOf ε m] : MonadLiftT (Except ε) m where
|
||||
instance (priority := low) [Pure m] [MonadExceptOf ε m] : MonadLiftT (Except ε) m where
|
||||
monadLift
|
||||
| .ok a => pure a
|
||||
| .error e => throw e
|
||||
|
||||
instance [Bind m] [MonadReaderOf ρ m] [MonadLiftT n m] : MonadLiftT (ReaderT ρ n) m where
|
||||
-- Remark: not necessarily optimal; uses context non-linearly
|
||||
instance (priority := low) [Bind m] [MonadReaderOf ρ m] [MonadLiftT n m] : MonadLiftT (ReaderT ρ n) m where
|
||||
monadLift act := do act (← read)
|
||||
|
||||
instance [Monad m] [MonadStateOf σ m] [MonadLiftT n m] : MonadLiftT (StateT σ n) m where
|
||||
-- Remark: not necessarily optimal; uses state non-linearly
|
||||
instance (priority := low) [Monad m] [MonadStateOf σ m] [MonadLiftT n m] : MonadLiftT (StateT σ n) m where
|
||||
monadLift act := do let (a, s) ← act (← get); set s; pure a
|
||||
|
||||
instance [Monad m] [Alternative m] [MonadLiftT n m] : MonadLiftT (OptionT n) m where
|
||||
instance (priority := low) [Monad m] [Alternative m] [MonadLiftT n m] : MonadLiftT (OptionT n) m where
|
||||
monadLift act := act.run >>= liftM
|
||||
|
||||
instance [Monad m] [MonadExceptOf ε m] [MonadLiftT n m] : MonadLiftT (ExceptT ε n) m where
|
||||
instance (priority := low) [Monad m] [MonadExceptOf ε m] [MonadLiftT n m] : MonadLiftT (ExceptT ε n) m where
|
||||
monadLift act := act.run >>= liftM
|
||||
|
||||
instance [Monad m] [MonadExceptOf ε m] [MonadLiftT BaseIO m] : MonadLiftT (EIO ε) m where
|
||||
instance (priority := low) [Monad m] [MonadExceptOf ε m] [MonadLiftT BaseIO m] : MonadLiftT (EIO ε) m where
|
||||
monadLift act := act.toBaseIO >>= liftM
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Util.Error
|
||||
import Lake.Util.EStateT
|
||||
import Lake.Util.Lift
|
||||
import Lean.Data.Json
|
||||
import Lean.Message
|
||||
|
||||
@@ -195,6 +196,9 @@ abbrev stream [MonadLiftT BaseIO m]
|
||||
(out : IO.FS.Stream) (minLv := LogLevel.info) (useAnsi := false)
|
||||
: MonadLog m where logEntry e := logToStream e out minLv useAnsi
|
||||
|
||||
@[inline] def error [Alternative m] [MonadLog m] (msg : String) : m α :=
|
||||
logError msg *> failure
|
||||
|
||||
end MonadLog
|
||||
|
||||
def OutStream.logEntry
|
||||
@@ -404,7 +408,7 @@ from an `ELogT` (e.g., `LogIO`).
|
||||
(msg : String)
|
||||
: m α := errorWithLog (logError msg)
|
||||
|
||||
/-- `Alternative` instance for monads with `Log` state and `Log.Pos` errors. -/
|
||||
/-- `MonadError` instance for monads with `Log` state and `Log.Pos` errors. -/
|
||||
abbrev ELog.monadError
|
||||
[Monad m] [MonadLog m] [MonadStateOf Log m] [MonadExceptOf Log.Pos m]
|
||||
: MonadError m := ⟨ELog.error⟩
|
||||
@@ -505,7 +509,7 @@ abbrev run?' [Functor m] (self : ELogT m α) (log : Log := {}) : m (Option α) :
|
||||
Run `self` with the log taken from the state of the monad `n`,
|
||||
|
||||
**Warning:** If lifting `self` from `m` to `n` fails, the log will be lost.
|
||||
Thus, this is best used when the lift cannot fail. Note excludes the
|
||||
Thus, this is best used when the lift cannot fail. This excludes the
|
||||
native log position failure of `ELogT`, which are lifted safely.
|
||||
-/
|
||||
@[inline] def takeAndRun
|
||||
@@ -545,8 +549,6 @@ instance : MonadLift IO LogIO := ⟨MonadError.runIO⟩
|
||||
|
||||
namespace LogIO
|
||||
|
||||
@[deprecated ELogT.run? (since := "2024-05-18")] abbrev captureLog := @ELogT.run?
|
||||
|
||||
/--
|
||||
Runs a `LogIO` action in `BaseIO`.
|
||||
Prints log entries of at least `minLv` to `out`.
|
||||
@@ -563,4 +565,46 @@ where
|
||||
replay (log : Log) (logger : MonadLog BaseIO) : BaseIO Unit :=
|
||||
log.replay (logger := logger)
|
||||
|
||||
-- deprecated 2024-05-18, reversed 2024-10-18
|
||||
abbrev captureLog := @ELogT.run?
|
||||
|
||||
end LogIO
|
||||
|
||||
/--
|
||||
A monad equipped with a log function and the ability to perform I/O.
|
||||
Unlike `LogIO`, log entries are not retained by the monad but instead eagerly
|
||||
passed to the log function.
|
||||
-/
|
||||
abbrev LoggerIO := MonadLogT BaseIO (EIO PUnit)
|
||||
|
||||
instance : MonadError LoggerIO := ⟨MonadLog.error⟩
|
||||
instance : MonadLift IO LoggerIO := ⟨MonadError.runIO⟩
|
||||
instance : MonadLift LogIO LoggerIO := ⟨ELogT.replayLog⟩
|
||||
|
||||
namespace LoggerIO
|
||||
|
||||
/--
|
||||
Runs a `LoggerIO` action in `BaseIO`.
|
||||
Prints log entries of at least `minLv` to `out`.
|
||||
-/
|
||||
@[inline] def toBaseIO
|
||||
(self : LoggerIO α)
|
||||
(minLv := LogLevel.info) (ansiMode := AnsiMode.auto) (out := OutStream.stderr)
|
||||
: BaseIO (Option α) := do
|
||||
(·.toOption) <$> (self.run (← out.getLogger minLv ansiMode)).toBaseIO
|
||||
|
||||
def captureLog (self : LoggerIO α) : BaseIO (Option α × Log) := do
|
||||
let ref ← IO.mkRef ({} : Log)
|
||||
let e ← self.run ⟨fun e => ref.modify (·.push e)⟩ |>.toBaseIO
|
||||
return (e.toOption, ← ref.get)
|
||||
|
||||
-- For parity with `LogIO.run?`
|
||||
abbrev run? := @captureLog
|
||||
|
||||
-- For parity with `LogIO.run?'`
|
||||
@[inline] def run?'
|
||||
(self : LoggerIO α) (logger : LogEntry → BaseIO PUnit := fun _ => pure ())
|
||||
: BaseIO (Option α) := do
|
||||
(·.toOption) <$> (self.run ⟨logger⟩).toBaseIO
|
||||
|
||||
end LoggerIO
|
||||
|
||||
@@ -88,3 +88,12 @@ where
|
||||
log.replay (logger := logger)
|
||||
|
||||
instance (priority := low) : MonadLift LogIO MainM := ⟨runLogIO⟩
|
||||
|
||||
@[inline] def runLoggerIO (x : LoggerIO α)
|
||||
(minLv := LogLevel.info) (ansiMode := AnsiMode.auto) (out := OutStream.stderr)
|
||||
: MainM α := do
|
||||
let some a ← x.run (← out.getLogger minLv ansiMode) |>.toBaseIO
|
||||
| exit 1
|
||||
return a
|
||||
|
||||
instance (priority := low) : MonadLift LoggerIO MainM := ⟨runLoggerIO⟩
|
||||
|
||||
@@ -52,7 +52,7 @@ namespace Name
|
||||
open Lean.Name
|
||||
|
||||
@[simp] protected theorem beq_false (m n : Name) : (m == n) = false ↔ ¬ (m = n) := by
|
||||
rw [← beq_iff_eq (a := m) (b := n)]; cases m == n <;> simp (config := { decide := true })
|
||||
rw [← beq_iff_eq (a := m) (b := n)]; cases m == n <;> simp +decide
|
||||
|
||||
@[simp] theorem isPrefixOf_self {n : Name} : n.isPrefixOf n := by
|
||||
cases n <;> simp [isPrefixOf]
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mac Malone
|
||||
-/
|
||||
import Lean.Elab.Eval
|
||||
import Lake.Util.Date
|
||||
|
||||
/-! # Version
|
||||
|
||||
@@ -11,7 +12,7 @@ This module contains useful definitions for manipulating versions.
|
||||
It also defines a `v!"<ver>"` syntax for version literals.
|
||||
-/
|
||||
|
||||
open Lean
|
||||
open System Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
@@ -117,6 +118,112 @@ instance : ToExpr StdVer where
|
||||
#[toExpr ver.toSemVerCore, toExpr ver.specialDescr]
|
||||
toTypeExpr := mkConst ``StdVer
|
||||
|
||||
/-- A Lean toolchain version. -/
|
||||
inductive ToolchainVer
|
||||
| release (ver : LeanVer)
|
||||
| nightly (date : Date)
|
||||
| pr (no : Nat)
|
||||
| other (name : String)
|
||||
deriving Repr, DecidableEq
|
||||
|
||||
instance : Coe LeanVer ToolchainVer := ⟨ToolchainVer.release⟩
|
||||
|
||||
def ToolchainVer.defaultOrigin := "leanprover/lean4"
|
||||
def ToolchainVer.prOrigin := "leanprover/lean4-pr-releases"
|
||||
|
||||
def ToolchainVer.ofString (ver : String) : ToolchainVer := Id.run do
|
||||
let colonPos := ver.posOf ':'
|
||||
let (origin, tag) :=
|
||||
if h : colonPos < ver.endPos then
|
||||
let pos := ver.next' colonPos (by simp_all [h, String.endPos, String.atEnd])
|
||||
(ver.extract 0 colonPos, ver.extract pos ver.endPos)
|
||||
else
|
||||
("", ver)
|
||||
if tag.startsWith "v" then
|
||||
if let .ok ver := StdVer.parse (tag.drop 1) then
|
||||
if origin.isEmpty || origin == defaultOrigin then
|
||||
return .release ver
|
||||
return .other ver
|
||||
else if tag.startsWith "nightly-" then
|
||||
if let some date := Date.ofString? (tag.drop "nightly-".length) then
|
||||
if origin.isEmpty || origin == defaultOrigin then
|
||||
return .nightly date
|
||||
else if tag.startsWith "pr-release-" then
|
||||
if let some n := (tag.drop "pr-release-".length).toNat? then
|
||||
if origin.isEmpty || origin == prOrigin then
|
||||
return .pr n
|
||||
else
|
||||
if let .ok ver := StdVer.parse ver then
|
||||
if origin.isEmpty || origin == defaultOrigin then
|
||||
return .release ver
|
||||
return .other ver
|
||||
|
||||
/-- Parse a toolchain from a `lean-toolchain` file. -/
|
||||
def ToolchainVer.ofFile? (toolchainFile : FilePath) : IO (Option ToolchainVer) := do
|
||||
try
|
||||
let toolchainString ← IO.FS.readFile toolchainFile
|
||||
return some <| ToolchainVer.ofString toolchainString.trim
|
||||
catch
|
||||
| .noFileOrDirectory .. =>
|
||||
return none
|
||||
| e => throw e
|
||||
|
||||
/-- The `elan` toolchain file name (i.e., `lean-toolchain`). -/
|
||||
def toolchainFileName : FilePath := "lean-toolchain"
|
||||
|
||||
/-- Parse a toolchain from the `lean-toolchain` file of the directory `dir`. -/
|
||||
@[inline] def ToolchainVer.ofDir? (dir : FilePath) : IO (Option ToolchainVer) :=
|
||||
ToolchainVer.ofFile? (dir / toolchainFileName)
|
||||
|
||||
protected def ToolchainVer.toString (ver : ToolchainVer) : String :=
|
||||
match ver with
|
||||
| .release ver => s!"{defaultOrigin}:v{ver}"
|
||||
| .nightly date => s!"{defaultOrigin}:nightly-{date}"
|
||||
| .pr n => s!"{prOrigin}:pr-release-{n}"
|
||||
| .other s => s
|
||||
|
||||
instance : ToString ToolchainVer := ⟨ToolchainVer.toString⟩
|
||||
instance : ToJson ToolchainVer := ⟨(·.toString)⟩
|
||||
instance : FromJson ToolchainVer := ⟨(ToolchainVer.ofString <$> fromJson? ·)⟩
|
||||
|
||||
protected def ToolchainVer.lt (a b : ToolchainVer) : Prop :=
|
||||
match a, b with
|
||||
| .release v1, .release v2 => v1 < v2
|
||||
| .nightly d1, .nightly d2 => d1 < d2
|
||||
| _, _ => False
|
||||
|
||||
instance : LT ToolchainVer := ⟨ToolchainVer.lt⟩
|
||||
|
||||
instance ToolchainVer.decLt (a b : ToolchainVer) : Decidable (a < b) :=
|
||||
match a, b with
|
||||
| .release v1, .release v2 => inferInstanceAs (Decidable (v1 < v2))
|
||||
| .nightly d1, .nightly d2 => inferInstanceAs (Decidable (d1 < d2))
|
||||
| .release _, .pr _ | .release _, .nightly _ | .release _, .other _
|
||||
| .nightly _, .release _ | .nightly _, .pr _ | .nightly _, .other _
|
||||
| .pr _, _ | .other _, _ => .isFalse (by simp [LT.lt, ToolchainVer.lt])
|
||||
|
||||
protected def ToolchainVer.le (a b : ToolchainVer) : Prop :=
|
||||
match a, b with
|
||||
| .release v1, .release v2 => v1 ≤ v2
|
||||
| .nightly d1, .nightly d2 => d1 ≤ d2
|
||||
| .pr n1, .pr n2 => n1 = n2
|
||||
| .other v1, .other v2 => v1 = v2
|
||||
| _, _ => False
|
||||
|
||||
instance : LE ToolchainVer := ⟨ToolchainVer.le⟩
|
||||
|
||||
instance ToolchainVer.decLe (a b : ToolchainVer) : Decidable (a ≤ b) :=
|
||||
match a, b with
|
||||
| .release v1, .release v2 => inferInstanceAs (Decidable (v1 ≤ v2))
|
||||
| .nightly d1, .nightly d2 => inferInstanceAs (Decidable (d1 ≤ d2))
|
||||
| .pr n1, .pr n2 => inferInstanceAs (Decidable (n1 = n2))
|
||||
| .other v1, .other v2 => inferInstanceAs (Decidable (v1 = v2))
|
||||
| .release _, .pr _ | .release _, .nightly _ | .release _, .other _
|
||||
| .nightly _, .release _ | .nightly _, .pr _ | .nightly _, other _
|
||||
| .pr _, .release _ | .pr _, .nightly _ | .pr _, .other _
|
||||
| .other _, .release _ | .other _, .nightly _ | .other _, .pr _ =>
|
||||
.isFalse (by simp [LE.le, ToolchainVer.le])
|
||||
|
||||
/-! ## Version Literals
|
||||
|
||||
Defines the `v!"<ver>"` syntax for version literals.
|
||||
@@ -134,6 +241,7 @@ export DecodeVersion (decodeVersion)
|
||||
|
||||
instance : DecodeVersion SemVerCore := ⟨SemVerCore.parse⟩
|
||||
@[default_instance] instance : DecodeVersion StdVer := ⟨StdVer.parse⟩
|
||||
instance : DecodeVersion ToolchainVer := ⟨(pure <| ToolchainVer.ofString ·)⟩
|
||||
|
||||
private def toResultExpr [ToExpr α] (x : Except String α) : Except String Expr :=
|
||||
Functor.map toExpr x
|
||||
|
||||
@@ -3,31 +3,31 @@
|
||||
"packages":
|
||||
[{"type": "path",
|
||||
"scope": "",
|
||||
"name": "root",
|
||||
"name": "foo",
|
||||
"manifestFile": "lake-manifest.json",
|
||||
"inherited": true,
|
||||
"dir": "./../foo/../a/../root",
|
||||
"configFile": "lakefile.lean"},
|
||||
{"type": "path",
|
||||
"scope": "",
|
||||
"name": "a",
|
||||
"manifestFile": "lake-manifest.json",
|
||||
"inherited": true,
|
||||
"dir": "./../foo/../a",
|
||||
"inherited": false,
|
||||
"dir": "./../foo",
|
||||
"configFile": "lakefile.lean"},
|
||||
{"type": "path",
|
||||
"scope": "",
|
||||
"name": "b",
|
||||
"manifestFile": "lake-manifest.json",
|
||||
"inherited": true,
|
||||
"dir": "./../foo/../b",
|
||||
"dir": "./../foo/./../b",
|
||||
"configFile": "lakefile.lean"},
|
||||
{"type": "path",
|
||||
"scope": "",
|
||||
"name": "foo",
|
||||
"name": "a",
|
||||
"manifestFile": "lake-manifest.json",
|
||||
"inherited": false,
|
||||
"dir": "./../foo",
|
||||
"inherited": true,
|
||||
"dir": "./../foo/./../a",
|
||||
"configFile": "lakefile.lean"},
|
||||
{"type": "path",
|
||||
"scope": "",
|
||||
"name": "root",
|
||||
"manifestFile": "lake-manifest.json",
|
||||
"inherited": true,
|
||||
"dir": "./../foo/./../b/./../root",
|
||||
"configFile": "lakefile.lean"}],
|
||||
"name": "bar",
|
||||
"lakeDir": ".lake"}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
dep/hello
|
||||
scripts/say-goodbye
|
||||
scripts/greet
|
||||
dep/hello
|
||||
Hello, world!
|
||||
Hello, me!
|
||||
Hello, --me!
|
||||
@@ -16,8 +16,8 @@ Hello from Dep!
|
||||
Goodbye!
|
||||
error: unknown script nonexistent
|
||||
error: unknown script nonexistent
|
||||
dep/hello
|
||||
scripts/say-goodbye
|
||||
scripts/greet
|
||||
dep/hello
|
||||
Hello, world!
|
||||
Goodbye!
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user