Compare commits

..

1 Commits

Author SHA1 Message Date
Kim Morrison
1739bcaa38 chore: cleanup of Array docstrings after refactor 2024-09-25 08:59:55 +10:00
1146 changed files with 2860 additions and 13243 deletions

View File

@@ -257,7 +257,7 @@ jobs:
"cross": true,
"shell": "bash -euxo pipefail {0}",
// Just a few selected tests because wasm is slow
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
"CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_libuv\\.lean\""
}
];
console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
@@ -452,7 +452,7 @@ jobs:
run: ccache -s
# This job collects results from all the matrix jobs
# This can be made the "required" job, instead of listing each
# This can be made the required job, instead of listing each
# matrix job separately
all-done:
name: Build matrix complete

View File

@@ -164,10 +164,10 @@ jobs:
# Use GitHub API to check if a comment already exists
existing_comment="$(curl --retry 3 --location --silent \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments" \
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-bot"))')"
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-mathlib4-bot"))')"
existing_comment_id="$(echo "$existing_comment" | jq -r .id)"
existing_comment_body="$(echo "$existing_comment" | jq -r .body)"
@@ -177,14 +177,14 @@ jobs:
echo "Posting message to the comments: $MESSAGE"
# Append new result to the existing comment or post a new comment
# It's essential we use the MATHLIB4_COMMENT_BOT token here, so that Mathlib CI can subsequently edit the comment.
# It's essential we use the MATHLIB4_BOT token here, so that Mathlib CI can subsequently edit the comment.
if [ -z "$existing_comment_id" ]; then
INTRO="Mathlib CI status ([docs](https://leanprover-community.github.io/contribute/tags_and_branches.html)):"
# Post new comment with a bullet point
echo "Posting as new comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X POST \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg intro "$INTRO" --arg val "$MESSAGE" '{"body":($intro + "\n" + $val)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
@@ -193,7 +193,7 @@ jobs:
echo "Appending to existing comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X PATCH \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg existing "$existing_comment_body" --arg message "$MESSAGE" '{"body":($existing + "\n" + $message)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/comments/$existing_comment_id"
@@ -340,7 +340,6 @@ jobs:
# (This should no longer be possible once `nightly-testing-YYYY-MM-DD` is a tag, but it is still safe to merge.)
git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories
lake update batteries
git add lake-manifest.json
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi

View File

@@ -10,317 +10,7 @@ of each version.
v4.12.0
----------
### Language features, tactics, and metaprograms
* `bv_decide` tactic. This release introduces a new tactic for proving goals involving `BitVec` and `Bool`. It reduces the goal to a SAT instance that is refuted by an external solver, and the resulting LRAT proof is checked in Lean. This is used to synthesize a proof of the goal by reflection. As this process uses verified algorithms, proofs generated by this tactic use `Lean.ofReduceBool`, so this tactic includes the Lean compiler as part of the trusted code base. The external solver CaDiCaL is included with Lean and does not need to be installed separately to make use of `bv_decide`.
For example, we can use `bv_decide` to verify that a bit twiddling formula leaves at most one bit set:
```lean
def popcount (x : BitVec 64) : BitVec 64 :=
let rec go (x pop : BitVec 64) : Nat → BitVec 64
| 0 => pop
| n + 1 => go (x >>> 2) (pop + (x &&& 1)) n
go x 0 64
example (x : BitVec 64) : popcount ((x &&& (x - 1)) ^^^ x) ≤ 1 := by
simp only [popcount, popcount.go]
bv_decide
```
When the external solver fails to refute the SAT instance generated by `bv_decide`, it can report a counterexample:
```lean
/--
error: The prover found a counterexample, consider the following assignment:
x = 0xffffffffffffffff#64
-/
#guard_msgs in
example (x : BitVec 64) : x < x + 1 := by
bv_decide
```
See `Lean.Elab.Tactic.BVDecide` for a more detailed overview, and look in `tests/lean/run/bv_*` for examples.
[#5013](https://github.com/leanprover/lean4/pull/5013), [#5074](https://github.com/leanprover/lean4/pull/5074), [#5100](https://github.com/leanprover/lean4/pull/5100), [#5113](https://github.com/leanprover/lean4/pull/5113), [#5137](https://github.com/leanprover/lean4/pull/5137), [#5203](https://github.com/leanprover/lean4/pull/5203), [#5212](https://github.com/leanprover/lean4/pull/5212), [#5220](https://github.com/leanprover/lean4/pull/5220).
* `simp` tactic
* [#4988](https://github.com/leanprover/lean4/pull/4988) fixes a panic in the `reducePow` simproc.
* [#5071](https://github.com/leanprover/lean4/pull/5071) exposes the `index` option to the `dsimp` tactic, introduced to `simp` in [#4202](https://github.com/leanprover/lean4/pull/4202).
* [#5159](https://github.com/leanprover/lean4/pull/5159) fixes a panic at `Fin.isValue` simproc.
* [#5167](https://github.com/leanprover/lean4/pull/5167) and [#5175](https://github.com/leanprover/lean4/pull/5175) rename the `simpCtorEq` simproc to `reduceCtorEq` and makes it optional. (See breaking changes.)
* [#5187](https://github.com/leanprover/lean4/pull/5187) ensures `reduceCtorEq` is enabled in the `norm_cast` tactic.
* [#5073](https://github.com/leanprover/lean4/pull/5073) modifies the simp debug trace messages to tag with "dpre" and "dpost" instead of "pre" and "post" when in definitional rewrite mode. [#5054](https://github.com/leanprover/lean4/pull/5054) explains the `reduce` steps for `trace.Debug.Meta.Tactic.simp` trace messages.
* `ext` tactic
* [#4996](https://github.com/leanprover/lean4/pull/4996) reduces default maximum iteration depth from 1000000 to 100.
* `induction` tactic
* [#5117](https://github.com/leanprover/lean4/pull/5117) fixes a bug where `let` bindings in minor premises wouldn't be counted correctly.
* `omega` tactic
* [#5157](https://github.com/leanprover/lean4/pull/5157) fixes a panic.
* `conv` tactic
* [#5149](https://github.com/leanprover/lean4/pull/5149) improves `arg n` to handle subsingleton instance arguments.
* [#5044](https://github.com/leanprover/lean4/pull/5044) upstreams the `#time` command.
* [#5079](https://github.com/leanprover/lean4/pull/5079) makes `#check` and `#reduce` typecheck the elaborated terms.
* **Incrementality**
* [#4974](https://github.com/leanprover/lean4/pull/4974) fixes regression where we would not interrupt elaboration of previous document versions.
* [#5004](https://github.com/leanprover/lean4/pull/5004) fixes a performance regression.
* [#5001](https://github.com/leanprover/lean4/pull/5001) disables incremental body elaboration in presence of `where` clauses in declarations.
* [#5018](https://github.com/leanprover/lean4/pull/5018) enables infotrees on the command line for ilean generation.
* [#5040](https://github.com/leanprover/lean4/pull/5040) and [#5056](https://github.com/leanprover/lean4/pull/5056) improve performance of info trees.
* [#5090](https://github.com/leanprover/lean4/pull/5090) disables incrementality in the `case .. | ..` tactic.
* [#5312](https://github.com/leanprover/lean4/pull/5312) fixes a bug where changing whitespace after the module header could break subsequent commands.
* **Definitions**
* [#5016](https://github.com/leanprover/lean4/pull/5016) and [#5066](https://github.com/leanprover/lean4/pull/5066) add `clean_wf` tactic to clean up tactic state in `decreasing_by`. This can be disabled with `set_option debug.rawDecreasingByGoal false`.
* [#5055](https://github.com/leanprover/lean4/pull/5055) unifies equational theorems between structural and well-founded recursion.
* [#5041](https://github.com/leanprover/lean4/pull/5041) allows mutually recursive functions to use different parameter names among the “fixed parameter prefix”
* [#4154](https://github.com/leanprover/lean4/pull/4154) and [#5109](https://github.com/leanprover/lean4/pull/5109) add fine-grained equational lemmas for non-recursive functions. See breaking changes.
* [#5129](https://github.com/leanprover/lean4/pull/5129) unifies equation lemmas for recursive and non-recursive definitions. The `backward.eqns.deepRecursiveSplit` option can be set to `false` to get the old behavior. See breaking changes.
* [#5141](https://github.com/leanprover/lean4/pull/5141) adds `f.eq_unfold` lemmas. Now Lean produces the following zoo of rewrite rules:
```
Option.map.eq_1 : Option.map f none = none
Option.map.eq_2 : Option.map f (some x) = some (f x)
Option.map.eq_def : Option.map f p = match o with | none => none | (some x) => some (f x)
Option.map.eq_unfold : Option.map = fun f p => match o with | none => none | (some x) => some (f x)
```
The `f.eq_unfold` variant is especially useful to rewrite with `rw` under binders.
* [#5136](https://github.com/leanprover/lean4/pull/5136) fixes bugs in recursion over predicates.
* **Variable inclusion**
* [#5206](https://github.com/leanprover/lean4/pull/5206) documents that `include` currently only applies to theorems.
* **Elaboration**
* [#4926](https://github.com/leanprover/lean4/pull/4926) fixes a bug where autoparam errors were associated to an incorrect source position.
* [#4833](https://github.com/leanprover/lean4/pull/4833) fixes an issue where cdot anonymous functions (e.g. `(· + ·)`) would not handle ambiguous notation correctly. Numbers the parameters, making this example expand as `fun x1 x2 => x1 + x2` rather than `fun x x_1 => x + x_1`.
* [#5037](https://github.com/leanprover/lean4/pull/5037) improves strength of the tactic that proves array indexing is in bounds.
* [#5119](https://github.com/leanprover/lean4/pull/5119) fixes a bug in the tactic that proves indexing is in bounds where it could loop in the presence of mvars.
* [#5072](https://github.com/leanprover/lean4/pull/5072) makes the structure type clickable in "not a field of structure" errors for structure instance notation.
* [#4717](https://github.com/leanprover/lean4/pull/4717) fixes a bug where mutual `inductive` commands could create terms that the kernel rejects.
* [#5142](https://github.com/leanprover/lean4/pull/5142) fixes a bug where `variable` could fail when mixing binder updates and declarations.
* **Other fixes or improvements**
* [#5118](https://github.com/leanprover/lean4/pull/5118) changes the definition of the `syntheticHole` parser so that hovering over `_` in `?_` gives the docstring for synthetic holes.
* [#5173](https://github.com/leanprover/lean4/pull/5173) uses the emoji variant selector for ✅️,❌️,💥️ in messages, improving fonts selection.
* [#5183](https://github.com/leanprover/lean4/pull/5183) fixes a bug in `rename_i` where implementation detail hypotheses could be renamed.
### Language server, widgets, and IDE extensions
* [#4821](https://github.com/leanprover/lean4/pull/4821) resolves two language server bugs that especially affect Windows users. (1) Editing the header could result in the watchdog not correctly restarting the file worker, which would lead to the file seemingly being processed forever. (2) On an especially slow Windows machine, we found that starting the language server would sometimes not succeed at all. This PR also resolves an issue where we would not correctly emit messages that we received while the file worker is being restarted to the corresponding file worker after the restart.
* [#5006](https://github.com/leanprover/lean4/pull/5006) updates the user widget manual.
* [#5193](https://github.com/leanprover/lean4/pull/5193) updates the quickstart guide with the new display name for the Lean 4 extension ("Lean 4").
* [#5185](https://github.com/leanprover/lean4/pull/5185) fixes a bug where over time "import out of date" messages would accumulate.
* [#4900](https://github.com/leanprover/lean4/pull/4900) improves ilean loading performance by about a factor of two. Optimizes the JSON parser and the conversion from JSON to Lean data structures; see PR description for details.
* **Other fixes or improvements**
* [#5031](https://github.com/leanprover/lean4/pull/5031) localizes an instance in `Lsp.Diagnostics`.
### Pretty printing
* [#4976](https://github.com/leanprover/lean4/pull/4976) introduces `@[app_delab]`, a macro for creating delaborators for particular constants. The `@[app_delab ident]` syntax resolves `ident` to its constant name `name` and then expands to `@[delab app.name]`.
* [#4982](https://github.com/leanprover/lean4/pull/4982) fixes a bug where the pretty printer assumed structure projections were type correct (such terms can appear in type mismatch errors). Improves hoverability of `#print` output for structures.
* [#5218](https://github.com/leanprover/lean4/pull/5218) and [#5239](https://github.com/leanprover/lean4/pull/5239) add `pp.exprSizes` debugging option. When true, each pretty printed expression is prefixed with `[size a/b/c]`, where `a` is the size without sharing, `b` is the actual size, and `c` is the size with the maximum possible sharing.
### Library
* [#5020](https://github.com/leanprover/lean4/pull/5020) swaps the parameters to `Membership.mem`. A purpose of this change is to make set-like `CoeSort` coercions to refer to the eta-expanded function `fun x => Membership.mem s x`, which can reduce in many computations. Another is that having the `s` argument first leads to better discrimination tree keys. (See breaking changes.)
* `Array`
* [#4970](https://github.com/leanprover/lean4/pull/4970) adds `@[ext]` attribute to `Array.ext`.
* [#4957](https://github.com/leanprover/lean4/pull/4957) deprecates `Array.get_modify`.
* `List`
* [#4995](https://github.com/leanprover/lean4/pull/4995) upstreams `List.findIdx` lemmas.
* [#5029](https://github.com/leanprover/lean4/pull/5029), [#5048](https://github.com/leanprover/lean4/pull/5048) and [#5132](https://github.com/leanprover/lean4/pull/5132) add `List.Sublist` lemmas, some upstreamed. [#5077](https://github.com/leanprover/lean4/pull/5077) fixes implicitness in refl/rfl lemma binders. add `List.Sublist` theorems.
* [#5047](https://github.com/leanprover/lean4/pull/5047) upstreams `List.Pairwise` lemmas.
* [#5053](https://github.com/leanprover/lean4/pull/5053), [#5124](https://github.com/leanprover/lean4/pull/5124), and [#5161](https://github.com/leanprover/lean4/pull/5161) add `List.find?/findSome?/findIdx?` theorems.
* [#5039](https://github.com/leanprover/lean4/pull/5039) adds `List.foldlRecOn` and `List.foldrRecOn` recursion principles to prove things about `List.foldl` and `List.foldr`.
* [#5069](https://github.com/leanprover/lean4/pull/5069) upstreams `List.Perm`.
* [#5092](https://github.com/leanprover/lean4/pull/5092) and [#5107](https://github.com/leanprover/lean4/pull/5107) add `List.mergeSort` and a fast `@[csimp]` implementation.
* [#5103](https://github.com/leanprover/lean4/pull/5103) makes the simp lemmas for `List.subset` more aggressive.
* [#5106](https://github.com/leanprover/lean4/pull/5106) changes the statement of `List.getLast?_cons`.
* [#5123](https://github.com/leanprover/lean4/pull/5123) and [#5158](https://github.com/leanprover/lean4/pull/5158) add `List.range` and `List.iota` lemmas.
* [#5130](https://github.com/leanprover/lean4/pull/5130) adds `List.join` lemmas.
* [#5131](https://github.com/leanprover/lean4/pull/5131) adds `List.append` lemmas.
* [#5152](https://github.com/leanprover/lean4/pull/5152) adds `List.erase(|P|Idx)` lemmas.
* [#5127](https://github.com/leanprover/lean4/pull/5127) makes miscellaneous lemma updates.
* [#5153](https://github.com/leanprover/lean4/pull/5153) and [#5160](https://github.com/leanprover/lean4/pull/5160) add lemmas about `List.attach` and `List.pmap`.
* [#5164](https://github.com/leanprover/lean4/pull/5164), [#5177](https://github.com/leanprover/lean4/pull/5177), and [#5215](https://github.com/leanprover/lean4/pull/5215) add `List.find?` and `List.range'/range/iota` lemmas.
* [#5196](https://github.com/leanprover/lean4/pull/5196) adds `List.Pairwise_erase` and related lemmas.
* [#5151](https://github.com/leanprover/lean4/pull/5151) and [#5163](https://github.com/leanprover/lean4/pull/5163) improve confluence of `List` simp lemmas. [#5105](https://github.com/leanprover/lean4/pull/5105) and [#5102](https://github.com/leanprover/lean4/pull/5102) adjust `List` simp lemmas.
* [#5178](https://github.com/leanprover/lean4/pull/5178) removes `List.getLast_eq_iff_getLast_eq_some` as a simp lemma.
* [#5210](https://github.com/leanprover/lean4/pull/5210) reverses the meaning of `List.getElem_drop` and `List.getElem_drop'`.
* [#5214](https://github.com/leanprover/lean4/pull/5214) moves `@[csimp]` lemmas earlier where possible.
* `Nat` and `Int`
* [#5104](https://github.com/leanprover/lean4/pull/5104) adds `Nat.add_left_eq_self` and relatives.
* [#5146](https://github.com/leanprover/lean4/pull/5146) adds missing `Nat.and_xor_distrib_(left|right)`.
* [#5148](https://github.com/leanprover/lean4/pull/5148) and [#5190](https://github.com/leanprover/lean4/pull/5190) improve `Nat` and `Int` simp lemma confluence.
* [#5165](https://github.com/leanprover/lean4/pull/5165) adjusts `Int` simp lemmas.
* [#5166](https://github.com/leanprover/lean4/pull/5166) adds `Int` lemmas relating `neg` and `emod`/`mod`.
* [#5208](https://github.com/leanprover/lean4/pull/5208) reverses the direction of the `Int.toNat_sub` simp lemma.
* [#5209](https://github.com/leanprover/lean4/pull/5209) adds `Nat.bitwise` lemmas.
* [#5230](https://github.com/leanprover/lean4/pull/5230) corrects the docstrings for integer division and modulus.
* `Option`
* [#5128](https://github.com/leanprover/lean4/pull/5128) and [#5154](https://github.com/leanprover/lean4/pull/5154) add `Option` lemmas.
* `BitVec`
* [#4889](https://github.com/leanprover/lean4/pull/4889) adds `sshiftRight` bitblasting.
* [#4981](https://github.com/leanprover/lean4/pull/4981) adds `Std.Associative` and `Std.Commutative` instances for `BitVec.[and|or|xor]`.
* [#4913](https://github.com/leanprover/lean4/pull/4913) enables `missingDocs` error for `BitVec` modules.
* [#4930](https://github.com/leanprover/lean4/pull/4930) makes parameter names for `BitVec` more consistent.
* [#5098](https://github.com/leanprover/lean4/pull/5098) adds `BitVec.intMin`. Introduces `boolToPropSimps` simp set for converting from boolean to propositional expressions.
* [#5200](https://github.com/leanprover/lean4/pull/5200) and [#5217](https://github.com/leanprover/lean4/pull/5217) rename `BitVec.getLsb` to `BitVec.getLsbD`, etc., to bring naming in line with `List`/`Array`/etc.
* **Theorems:** [#4977](https://github.com/leanprover/lean4/pull/4977), [#4951](https://github.com/leanprover/lean4/pull/4951), [#4667](https://github.com/leanprover/lean4/pull/4667), [#5007](https://github.com/leanprover/lean4/pull/5007), [#4997](https://github.com/leanprover/lean4/pull/4997), [#5083](https://github.com/leanprover/lean4/pull/5083), [#5081](https://github.com/leanprover/lean4/pull/5081), [#4392](https://github.com/leanprover/lean4/pull/4392)
* `UInt`
* [#4514](https://github.com/leanprover/lean4/pull/4514) fixes naming convention for `UInt` lemmas.
* `Std.HashMap` and `Std.HashSet`
* [#4943](https://github.com/leanprover/lean4/pull/4943) deprecates variants of hash map query methods. (See breaking changes.)
* [#4917](https://github.com/leanprover/lean4/pull/4917) switches the library and Lean to `Std.HashMap` and `Std.HashSet` almost everywhere.
* [#4954](https://github.com/leanprover/lean4/pull/4954) deprecates `Lean.HashMap` and `Lean.HashSet`.
* [#5023](https://github.com/leanprover/lean4/pull/5023) cleans up lemma parameters.
* `Std.Sat` (for `bv_decide`)
* [#4933](https://github.com/leanprover/lean4/pull/4933) adds definitions of SAT and CNF.
* [#4953](https://github.com/leanprover/lean4/pull/4953) defines "and-inverter graphs" (AIGs) as described in section 3 of [Davis-Swords 2013](https://arxiv.org/pdf/1304.7861.pdf).
* **Parsec**
* [#4774](https://github.com/leanprover/lean4/pull/4774) generalizes the `Parsec` library, allowing parsing of iterable data beyond `String` such as `ByteArray`. (See breaking changes.)
* [#5115](https://github.com/leanprover/lean4/pull/5115) moves `Lean.Data.Parsec` to `Std.Internal.Parsec` for bootstrappng reasons.
* `Thunk`
* [#4969](https://github.com/leanprover/lean4/pull/4969) upstreams `Thunk.ext`.
* **IO**
* [#4973](https://github.com/leanprover/lean4/pull/4973) modifies `IO.FS.lines` to handle `\r\n` on all operating systems instead of just on Windows.
* [#5125](https://github.com/leanprover/lean4/pull/5125) adds `createTempFile` and `withTempFile` for creating temporary files that can only be read and written by the current user.
* **Other fixes or improvements**
* [#4945](https://github.com/leanprover/lean4/pull/4945) adds `Array`, `Bool` and `Prod` utilities from LeanSAT.
* [#4960](https://github.com/leanprover/lean4/pull/4960) adds `Relation.TransGen.trans`.
* [#5012](https://github.com/leanprover/lean4/pull/5012) states `WellFoundedRelation Nat` using `<`, not `Nat.lt`.
* [#5011](https://github.com/leanprover/lean4/pull/5011) uses `` instead of `Not (Eq ...)` in `Fin.ne_of_val_ne`.
* [#5197](https://github.com/leanprover/lean4/pull/5197) upstreams `Fin.le_antisymm`.
* [#5042](https://github.com/leanprover/lean4/pull/5042) reduces usage of `refine'`.
* [#5101](https://github.com/leanprover/lean4/pull/5101) adds about `if-then-else` and `Option`.
* [#5112](https://github.com/leanprover/lean4/pull/5112) adds basic instances for `ULift` and `PLift`.
* [#5133](https://github.com/leanprover/lean4/pull/5133) and [#5168](https://github.com/leanprover/lean4/pull/5168) make fixes from running the simpNF linter over Lean.
* [#5156](https://github.com/leanprover/lean4/pull/5156) removes a bad simp lemma in `omega` theory.
* [#5155](https://github.com/leanprover/lean4/pull/5155) improves confluence of `Bool` simp lemmas.
* [#5162](https://github.com/leanprover/lean4/pull/5162) improves confluence of `Function.comp` simp lemmas.
* [#5191](https://github.com/leanprover/lean4/pull/5191) improves confluence of `if-then-else` simp lemmas.
* [#5147](https://github.com/leanprover/lean4/pull/5147) adds `@[elab_as_elim]` to `Quot.rec`, `Nat.strongInductionOn` and `Nat.casesStrongInductionOn`, and also renames the latter two to `Nat.strongRecOn` and `Nat.casesStrongRecOn` (deprecated in [#5179](https://github.com/leanprover/lean4/pull/5179)).
* [#5180](https://github.com/leanprover/lean4/pull/5180) disables some simp lemmas with bad discrimination tree keys.
* [#5189](https://github.com/leanprover/lean4/pull/5189) cleans up internal simp lemmas that had leaked.
* [#5198](https://github.com/leanprover/lean4/pull/5198) cleans up `allowUnsafeReducibility`.
* [#5229](https://github.com/leanprover/lean4/pull/5229) removes unused lemmas from some `simp` tactics.
* [#5199](https://github.com/leanprover/lean4/pull/5199) removes >6 month deprecations.
### Lean internals
* **Performance**
* Some core algorithms have been rewritten in C++ for performance.
* [#4910](https://github.com/leanprover/lean4/pull/4910) and [#4912](https://github.com/leanprover/lean4/pull/4912) reimplement `instantiateLevelMVars`.
* [#4915](https://github.com/leanprover/lean4/pull/4915), [#4922](https://github.com/leanprover/lean4/pull/4922), and [#4931](https://github.com/leanprover/lean4/pull/4931) reimplement `instantiateExprMVars`, 30% faster on a benchmark.
* [#4934](https://github.com/leanprover/lean4/pull/4934) has optimizations for the kernel's `Expr` equality test.
* [#4990](https://github.com/leanprover/lean4/pull/4990) fixes bug in hashing for the kernel's `Expr` equality test.
* [#4935](https://github.com/leanprover/lean4/pull/4935) and [#4936](https://github.com/leanprover/lean4/pull/4936) skip some `PreDefinition` transformations if they are not needed.
* [#5225](https://github.com/leanprover/lean4/pull/5225) adds caching for visited exprs at `CheckAssignmentQuick` in `ExprDefEq`.
* [#5226](https://github.com/leanprover/lean4/pull/5226) maximizes term sharing at `instantiateMVarDeclMVars`, used by `runTactic`.
* **Diagnostics and profiling**
* [#4923](https://github.com/leanprover/lean4/pull/4923) adds profiling for `instantiateMVars` in `Lean.Elab.MutualDef`, which can be a bottleneck there.
* [#4924](https://github.com/leanprover/lean4/pull/4924) adds diagnostics for large theorems, controlled by the `diagnostics.threshold.proofSize` option.
* [#4897](https://github.com/leanprover/lean4/pull/4897) improves display of diagnostic results.
* **Other fixes or improvements**
* [#4921](https://github.com/leanprover/lean4/pull/4921) cleans up `Expr.betaRev`.
* [#4940](https://github.com/leanprover/lean4/pull/4940) fixes tests by not writing directly to stdout, which is unreliable now that elaboration and reporting are executed in separate threads.
* [#4955](https://github.com/leanprover/lean4/pull/4955) documents that `stderrAsMessages` is now the default on the command line as well.
* [#4647](https://github.com/leanprover/lean4/pull/4647) adjusts documentation for building on macOS.
* [#4987](https://github.com/leanprover/lean4/pull/4987) makes regular mvar assignments take precedence over delayed ones in `instantiateMVars`. Normally delayed assignment metavariables are never directly assigned, but on errors Lean assigns `sorry` to unassigned metavariables.
* [#4967](https://github.com/leanprover/lean4/pull/4967) adds linter name to errors when a linter crashes.
* [#5043](https://github.com/leanprover/lean4/pull/5043) cleans up command line snapshots logic.
* [#5067](https://github.com/leanprover/lean4/pull/5067) minimizes some imports.
* [#5068](https://github.com/leanprover/lean4/pull/5068) generalizes the monad for `addMatcherInfo`.
* [f71a1f](https://github.com/leanprover/lean4/commit/f71a1fb4ae958fccb3ad4d48786a8f47ced05c15) adds missing test for [#5126](https://github.com/leanprover/lean4/issues/5126).
* [#5201](https://github.com/leanprover/lean4/pull/5201) restores a test.
* [#3698](https://github.com/leanprover/lean4/pull/3698) fixes a bug where label attributes did not pass on the attribute kind.
* Typos: [#5080](https://github.com/leanprover/lean4/pull/5080), [#5150](https://github.com/leanprover/lean4/pull/5150), [#5202](https://github.com/leanprover/lean4/pull/5202)
### Compiler, runtime, and FFI
* [#3106](https://github.com/leanprover/lean4/pull/3106) moves frontend to new snapshot architecture. Note that `Frontend.processCommand` and `FrontendM` are no longer used by Lean core, but they will be preserved.
* [#4919](https://github.com/leanprover/lean4/pull/4919) adds missing include in runtime for `AUTO_THREAD_FINALIZATION` feature on Windows.
* [#4941](https://github.com/leanprover/lean4/pull/4941) adds more `LEAN_EXPORT`s for Windows.
* [#4911](https://github.com/leanprover/lean4/pull/4911) improves formatting of CLI help text for the frontend.
* [#4950](https://github.com/leanprover/lean4/pull/4950) improves file reading and writing.
* `readBinFile` and `readFile` now only require two system calls (`stat` + `read`) instead of one `read` per 1024 byte chunk.
* `Handle.getLine` and `Handle.putStr` no longer get tripped up by NUL characters.
* [#4971](https://github.com/leanprover/lean4/pull/4971) handles the SIGBUS signal when detecting stack overflows.
* [#5062](https://github.com/leanprover/lean4/pull/5062) avoids overwriting existing signal handlers, like in [rust-lang/rust#69685](https://github.com/rust-lang/rust/pull/69685).
* [#4860](https://github.com/leanprover/lean4/pull/4860) improves workarounds for building on Windows. Splits `libleanshared` on Windows to avoid symbol limit, removes the `LEAN_EXPORT` denylist workaround, adds missing `LEAN_EXPORT`s.
* [#4952](https://github.com/leanprover/lean4/pull/4952) output panics into Lean's redirected stderr, ensuring panics ARE visible as regular messages in the language server and properly ordered in relation to other messages on the command line.
* [#4963](https://github.com/leanprover/lean4/pull/4963) links LibUV.
### Lake
* [#5030](https://github.com/leanprover/lean4/pull/5030) removes dead code.
* [#4770](https://github.com/leanprover/lean4/pull/4770) adds additional fields to the package configuration which will be used by Reservoir. See the PR description for details.
### DevOps/CI
* [#4914](https://github.com/leanprover/lean4/pull/4914) and [#4937](https://github.com/leanprover/lean4/pull/4937) improve the release checklist.
* [#4925](https://github.com/leanprover/lean4/pull/4925) ignores stale leanpkg tests.
* [#5003](https://github.com/leanprover/lean4/pull/5003) upgrades `actions/cache` in CI.
* [#5010](https://github.com/leanprover/lean4/pull/5010) sets `save-always` in cache actions in CI.
* [#5008](https://github.com/leanprover/lean4/pull/5008) adds more libuv search patterns for the speedcenter.
* [#5009](https://github.com/leanprover/lean4/pull/5009) reduce number of runs in the speedcenter for "fast" benchmarks from 10 to 3.
* [#5014](https://github.com/leanprover/lean4/pull/5014) adjusts lakefile editing to use new `git` syntax in `pr-release` workflow.
* [#5025](https://github.com/leanprover/lean4/pull/5025) has `pr-release` workflow pass `--retry` to `curl`.
* [#5022](https://github.com/leanprover/lean4/pull/5022) builds MacOS Aarch64 release for PRs by default.
* [#5045](https://github.com/leanprover/lean4/pull/5045) adds libuv to the required packages heading in macos docs.
* [#5034](https://github.com/leanprover/lean4/pull/5034) fixes the install name of `libleanshared_1` on macOS.
* [#5051](https://github.com/leanprover/lean4/pull/5051) fixes Windows stage 0.
* [#5052](https://github.com/leanprover/lean4/pull/5052) fixes 32bit stage 0 builds in CI.
* [#5057](https://github.com/leanprover/lean4/pull/5057) avoids rebuilding `leanmanifest` in each build.
* [#5099](https://github.com/leanprover/lean4/pull/5099) makes `restart-on-label` workflow also filter by commit SHA.
* [#4325](https://github.com/leanprover/lean4/pull/4325) adds CaDiCaL.
### Breaking changes
* [LibUV](https://libuv.org/) is now required to build Lean. This change only affects developers who compile Lean themselves instead of obtaining toolchains via `elan`. We have updated the official build instructions with information on how to obtain LibUV on our supported platforms. ([#4963](https://github.com/leanprover/lean4/pull/4963))
* Recursive definitions with a `decreasing_by` clause that begins with `simp_wf` may break. Try removing `simp_wf` or replacing it with `simp`. ([#5016](https://github.com/leanprover/lean4/pull/5016))
* The behavior of `rw [f]` where `f` is a non-recursive function defined by pattern matching changed.
For example, preciously, `rw [Option.map]` would rewrite `Option.map f o` to `match o with … `. Now this rewrite fails because it will use the equational lemmas, and these require constructors just like for `List.map`.
Remedies:
* Split on `o` before rewriting.
* Use `rw [Option.map.eq_def]`, which rewrites any (saturated) application of `Option.map`.
* Use `set_option backward.eqns.nonrecursive false` when *defining* the function in question.
([#4154](https://github.com/leanprover/lean4/pull/4154))
* The unified handling of equation lemmas for recursive and non-recursive functions can break existing code, as there now can be extra equational lemmas:
* Explicit uses of `f.eq_2` might have to be adjusted if the numbering changed.
* Uses of `rw [f]` or `simp [f]` may no longer apply if they previously matched (and introduced a `match` statement), when the equational lemmas got more fine-grained.
In this case either case analysis on the parameters before rewriting helps, or setting the option `backward.eqns.deepRecursiveSplit false` while *defining* the function.
([#5129](https://github.com/leanprover/lean4/pull/5129), [#5207](https://github.com/leanprover/lean4/pull/5207))
* The `reduceCtorEq` simproc is now optional, and it might need to be included in lists of simp lemmas, like `simp only [reduceCtorEq]`. This simproc is responsible for reducing equalities of constructors. ([#5167](https://github.com/leanprover/lean4/pull/5167))
* `Nat.strongInductionOn` is now `Nat.strongRecOn` and `Nat.caseStrongInductionOn` to `Nat.caseStrongRecOn`. ([#5147](https://github.com/leanprover/lean4/pull/5147))
* The parameters to `Membership.mem` have been swapped, which affects all `Membership` instances. ([#5020](https://github.com/leanprover/lean4/pull/5020))
* The meanings of `List.getElem_drop` and `List.getElem_drop'` have been reversed and the first is now a simp lemma. ([#5210](https://github.com/leanprover/lean4/pull/5210))
* The `Parsec` library has moved from `Lean.Data.Parsec` to `Std.Internal.Parsec`. The `Parsec` type is now more general with a parameter for an iterable. Users parsing strings can migrate to `Parser` in the `Std.Internal.Parsec.String` namespace, which also includes string-focused parsing combinators. ([#4774](https://github.com/leanprover/lean4/pull/4774))
* The `Lean` module has switched from `Lean.HashMap` and `Lean.HashSet` to `Std.HashMap` and `Std.HashSet` ([#4943](https://github.com/leanprover/lean4/pull/4943)). `Lean.HashMap` and `Lean.HashSet` are now deprecated ([#4954](https://github.com/leanprover/lean4/pull/4954)) and will be removed in a future release. Users of `Lean` APIs that interact with hash maps, for example `Lean.Environment.const2ModIdx`, might encounter minor breakage due to the following changes from `Lean.HashMap` to `Std.HashMap`:
* query functions use the term `get` instead of `find`, ([#4943](https://github.com/leanprover/lean4/pull/4943))
* the notation `map[key]` no longer returns an optional value but instead expects a proof that the key is present in the map. The previous behavior is available via the `map[key]?` notation.
Development in progress.
v4.11.0
----------
@@ -331,7 +21,7 @@ v4.11.0
See breaking changes below.
PRs: [#4883](https://github.com/leanprover/lean4/pull/4883), [#4814](https://github.com/leanprover/lean4/pull/4814), [#5000](https://github.com/leanprover/lean4/pull/5000), [#5036](https://github.com/leanprover/lean4/pull/5036), [#5138](https://github.com/leanprover/lean4/pull/5138), [0edf1b](https://github.com/leanprover/lean4/commit/0edf1bac392f7e2fe0266b28b51c498306363a84).
PRs: [#4883](https://github.com/leanprover/lean4/pull/4883), [1242ff](https://github.com/leanprover/lean4/commit/1242ffbfb5a79296041683682268e770fc3cf820), [#5000](https://github.com/leanprover/lean4/pull/5000), [#5036](https://github.com/leanprover/lean4/pull/5036), [#5138](https://github.com/leanprover/lean4/pull/5138), [0edf1b](https://github.com/leanprover/lean4/commit/0edf1bac392f7e2fe0266b28b51c498306363a84).
* **Recursive definitions**
* Structural recursion can now be explicitly requested using

View File

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

View File

@@ -39,19 +39,7 @@
CTEST_OUTPUT_ON_FAILURE = 1;
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
GMP = pkgsDist.gmp.override { withStatic = true; };
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: {
configureFlags = ["--enable-static"];
hardeningDisable = [ "stackprotector" ];
# Sync version with CMakeLists.txt
version = "1.48.0";
src = pkgs.fetchFromGitHub {
owner = "libuv";
repo = "libuv";
rev = "v1.48.0";
sha256 = "100nj16fg8922qg4m2hdjh62zv4p32wyrllsvqr659hdhjc03bsk";
};
doCheck = false;
});
LIBUV = pkgsDist.libuv.overrideAttrs (attrs: { configureFlags = ["--enable-static"]; });
GLIBC = pkgsDist.glibc;
GLIBC_DEV = pkgsDist.glibc.dev;
GCC_LIB = pkgsDist.gcc.cc.lib;

View File

@@ -0,0 +1,3 @@
* The `Lean` module has switched from `Lean.HashMap` and `Lean.HashSet` to `Std.HashMap` and `Std.HashSet`. `Lean.HashMap` and `Lean.HashSet` are now deprecated and will be removed in a future release. Users of `Lean` APIs that interact with hash maps, for example `Lean.Environment.const2ModIdx`, might encounter minor breakage due to the following breaking changes from `Lean.HashMap` to `Std.HashMap`:
* query functions use the term `get` instead of `find`,
* the notation `map[key]` no longer returns an optional value but expects a proof that the key is present in the map instead. The previous behavior is available via the `map[key]?` notation.

1
releases_drafts/libuv.md Normal file
View File

@@ -0,0 +1 @@
* #4963 [LibUV](https://libuv.org/) is now required to build Lean. This change only affects developers who compile Lean themselves instead of obtaining toolchains via `elan`. We have updated the official build instructions with information on how to obtain LibUV on our supported platforms.

View File

@@ -48,8 +48,6 @@ $CP llvm-host/lib/*/lib{c++,c++abi,unwind}.* llvm-host/lib/
$CP -r llvm/include/*-*-* llvm-host/include/
# glibc: use for linking (so Lean programs don't embed newer symbol versions), but not for running (because libc.so, librt.so, and ld.so must be compatible)!
$CP $GLIBC/lib/libc_nonshared.a stage1/lib/glibc
# libpthread_nonshared.a must be linked in order to be able to use `pthread_atfork(3)`. LibUV uses this function.
$CP $GLIBC/lib/libpthread_nonshared.a stage1/lib/glibc
for f in $GLIBC/lib/lib{c,dl,m,rt,pthread}-*; do b=$(basename $f); cp $f stage1/lib/glibc/${b%-*}.so; done
OPTIONS=()
echo -n " -DLEAN_STANDALONE=ON"
@@ -64,8 +62,8 @@ fi
# use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
# but do not change sysroot so users can still link against system libs
echo -n " -DLEANC_INTERNAL_FLAGS='-nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -lpthread -ldl -lrt -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -Wl,--no-as-needed'"
# do not set `LEAN_CC` for tests
echo -n " -DLEAN_TEST_VARS=''"

View File

@@ -31,15 +31,15 @@ cp /clang64/lib/{crtbegin,crtend,crt2,dllcrt2}.o stage1/lib/
# runtime
(cd llvm; cp --parents lib/clang/*/lib/*/libclang_rt.builtins* ../stage1)
# further dependencies
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase,psapi,iphlpapi,userenv,ws2_32,dbghelp,ole32}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
echo -n " -DLEAN_STANDALONE=ON"
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=1 -DCMAKE_CXX_COMPILER=$PWD/llvm/bin/clang++.exe -DCMAKE_CXX_COMPILER_WORKS=1 -DLEAN_CXX_STDLIB='-lc++ -lc++abi'"
echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='-L ROOT/lib -static-libgcc -Wl,-Bstatic -lgmp -luv -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
# when not using the above flags, link GMP dynamically/as usual
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv -lucrtbase'"
# do not set `LEAN_CC` for tests
echo -n " -DAUTO_THREAD_FINALIZATION=OFF -DSTAGE0_AUTO_THREAD_FINALIZATION=OFF"
echo -n " -DLEAN_TEST_VARS=''"

View File

@@ -243,56 +243,11 @@ if("${USE_GMP}" MATCHES "ON")
endif()
endif()
# LibUV
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
# Only on WebAssembly we compile LibUV ourselves
set(LIBUV_EMSCRIPTEN_FLAGS "${EMSCRIPTEN_SETTINGS}")
# LibUV does not compile on WebAssembly without modifications because
# building LibUV on a platform requires including stub implementations
# for features not present on the target platform. This patch includes
# the minimum amount of stub implementations needed for successfully
# running Lean on WebAssembly and using LibUV's temporary file support.
# It still leaves several symbols completely undefined: uv__fs_event_close,
# uv__hrtime, uv__io_check_fd, uv__io_fork, uv__io_poll, uv__platform_invalidate_fd
# uv__platform_loop_delete, uv__platform_loop_init. Making additional
# LibUV features available on WebAssembly might require adapting the
# patch to include additional LibUV source files.
set(LIBUV_PATCH_IN "
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 5e8e0166..f3b29134 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -317,6 +317,11 @@ if(CMAKE_SYSTEM_NAME STREQUAL \"GNU\")
src/unix/hurd.c)
endif()
+if(CMAKE_SYSTEM_NAME STREQUAL \"Emscripten\")
+ list(APPEND uv_sources
+ src/unix/no-proctitle.c)
+endif()
+
if(CMAKE_SYSTEM_NAME STREQUAL \"Linux\")
list(APPEND uv_defines _GNU_SOURCE _POSIX_C_SOURCE=200112)
list(APPEND uv_libraries dl rt)
")
string(REPLACE "\n" "\\n" LIBUV_PATCH ${LIBUV_PATCH_IN})
ExternalProject_add(libuv
PREFIX libuv
GIT_REPOSITORY https://github.com/libuv/libuv
# Sync version with flake.nix
GIT_TAG v1.48.0
CMAKE_ARGS -DCMAKE_BUILD_TYPE=Release -DLIBUV_BUILD_TESTS=OFF -DLIBUV_BUILD_SHARED=OFF -DCMAKE_AR=${CMAKE_AR} -DCMAKE_TOOLCHAIN_FILE=${CMAKE_TOOLCHAIN_FILE} -DCMAKE_POSITION_INDEPENDENT_CODE=ON -DCMAKE_C_FLAGS=${LIBUV_EMSCRIPTEN_FLAGS}
PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
BUILD_IN_SOURCE ON
INSTALL_COMMAND "")
set(LIBUV_INCLUDE_DIR "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
set(LIBUV_LIBRARIES "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
else()
if(NOT "${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
# LibUV
find_package(LibUV 1.0.0 REQUIRED)
include_directories(${LIBUV_INCLUDE_DIR})
endif()
include_directories(${LIBUV_INCLUDE_DIR})
if(NOT LEAN_STANDALONE)
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LIBRARIES}")
endif()
@@ -567,10 +522,6 @@ if(${STAGE} GREATER 1)
endif()
else()
add_subdirectory(runtime)
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
add_dependencies(leanrt libuv)
add_dependencies(leanrt_initial-exec libuv)
endif()
add_subdirectory(util)
set(LEAN_OBJS ${LEAN_OBJS} $<TARGET_OBJECTS:util>)
@@ -611,10 +562,7 @@ if (${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
# simple. (And we are not interested in `Lake` anyway.) To use dynamic
# linking, we would probably have to set MAIN_MODULE=2 on `leanshared`,
# SIDE_MODULE=2 on `lean`, and set CMAKE_SHARED_LIBRARY_SUFFIX to ".js".
# We set `ERROR_ON_UNDEFINED_SYMBOLS=0` because our build of LibUV does not
# define all symbols, see the comment about LibUV on WebAssembly further up
# in this file.
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1 -s ERROR_ON_UNDEFINED_SYMBOLS=0")
string(APPEND LEAN_EXE_LINKER_FLAGS " ${LIB}/temp/libleanshell.a ${TOOLCHAIN_STATIC_LINKER_FLAGS} ${EMSCRIPTEN_SETTINGS} -lnodefs.js -s EXIT_RUNTIME=1 -s MAIN_MODULE=1 -s LINKABLE=1 -s EXPORT_ALL=1")
endif()
# Build the compiler using the bootstrapped C sources for stage0, and use

View File

@@ -80,8 +80,6 @@ noncomputable scoped instance (priority := low) propDecidable (a : Prop) : Decid
noncomputable def decidableInhabited (a : Prop) : Inhabited (Decidable a) where
default := inferInstance
instance (a : Prop) : Nonempty (Decidable a) := propDecidable a
noncomputable def typeDecidableEq (α : Sort u) : DecidableEq α :=
fun _ _ => inferInstance

View File

@@ -33,10 +33,6 @@ attribute [simp] id_map
@[simp] theorem id_map' [Functor m] [LawfulFunctor m] (x : m α) : (fun a => a) <$> x = x :=
id_map x
@[simp] theorem Functor.map_map [Functor f] [LawfulFunctor f] (m : α β) (g : β γ) (x : f α) :
g <$> m <$> x = (fun a => g (m a)) <$> x :=
(comp_map _ _ _).symm
/--
The `Applicative` typeclass only contains the operations of an applicative functor.
`LawfulApplicative` further asserts that these operations satisfy the laws of an applicative functor:
@@ -87,16 +83,12 @@ class LawfulMonad (m : Type u → Type v) [Monad m] extends LawfulApplicative m
seq_assoc x g h := (by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind])
export LawfulMonad (bind_pure_comp bind_map pure_bind bind_assoc)
attribute [simp] pure_bind bind_assoc bind_pure_comp
attribute [simp] pure_bind bind_assoc
@[simp] theorem bind_pure [Monad m] [LawfulMonad m] (x : m α) : x >>= pure = x := by
show x >>= (fun a => pure (id a)) = x
rw [bind_pure_comp, id_map]
/--
Use `simp [← bind_pure_comp]` rather than `simp [map_eq_pure_bind]`,
as `bind_pure_comp` is in the default simp set, so also using `map_eq_pure_bind` would cause a loop.
-/
theorem map_eq_pure_bind [Monad m] [LawfulMonad m] (f : α β) (x : m α) : f <$> x = x >>= fun a => pure (f a) := by
rw [ bind_pure_comp]
@@ -117,24 +109,10 @@ theorem seq_eq_bind {α β : Type u} [Monad m] [LawfulMonad m] (mf : m (α
theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *> y = x >>= fun _ => y := by
rw [seqRight_eq]
simp only [map_eq_pure_bind, const, seq_eq_bind_map, bind_assoc, pure_bind, id_eq, bind_pure]
simp [map_eq_pure_bind, seq_eq_bind_map, const]
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]
simp only [map_eq_pure_bind, seq_eq_bind_map, bind_assoc, pure_bind, const_apply]
@[simp] theorem map_bind [Monad m] [LawfulMonad m] (f : β γ) (x : m α) (g : α m β) :
f <$> (x >>= g) = x >>= fun a => f <$> g a := by
rw [ bind_pure_comp, LawfulMonad.bind_assoc]
simp [bind_pure_comp]
@[simp] theorem bind_map_left [Monad m] [LawfulMonad m] (f : α β) (x : m α) (g : β m γ) :
((f <$> x) >>= fun b => g b) = (x >>= fun a => g (f a)) := by
rw [ bind_pure_comp]
simp only [bind_assoc, pure_bind]
@[simp] theorem Functor.map_unit [Monad m] [LawfulMonad m] {a : m PUnit} : (fun _ => PUnit.unit) <$> a = a := by
simp [map]
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
/--
An alternative constructor for `LawfulMonad` which has more
@@ -183,9 +161,9 @@ end Id
instance : LawfulMonad Option := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun x _ _ => by cases x <;> rfl)
(bind_pure_comp := fun _ x => by cases x <;> rfl)
(pure_bind := fun x f => rfl)
(bind_assoc := fun x f g => by cases x <;> rfl)
(bind_pure_comp := fun f x => by cases x <;> rfl)
instance : LawfulApplicative Option := inferInstance
instance : LawfulFunctor Option := inferInstance

View File

@@ -25,7 +25,7 @@ theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
simp [ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont]
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
@[simp] theorem bind_throw [Monad m] [LawfulMonad m] (f : α ExceptT ε m β) : (throw e >>= f) = throw e := by
simp [throw, throwThe, MonadExceptOf.throw, bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
@@ -43,7 +43,7 @@ theorem run_bind [Monad m] (x : ExceptT ε m α)
@[simp] theorem run_map [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α)
: (f <$> x).run = Except.map f <$> x.run := by
simp [Functor.map, ExceptT.map, bind_pure_comp]
simp [Functor.map, ExceptT.map, map_eq_pure_bind]
apply bind_congr
intro a; cases a <;> simp [Except.map]
@@ -62,7 +62,7 @@ protected theorem seqLeft_eq {α β ε : Type u} {m : Type u → Type v} [Monad
intro
| Except.error _ => simp
| Except.ok _ =>
simp [bind_pure_comp]; apply bind_congr; intro b;
simp [map_eq_pure_bind]; apply bind_congr; intro b;
cases b <;> simp [comp, Except.map, const]
protected theorem seqRight_eq [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x *> y = const α id <$> x <*> y := by
@@ -84,19 +84,14 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
pure_bind := by intros; apply ext; simp [run_bind]
bind_assoc := by intros; apply ext; simp [run_bind]; apply bind_congr; intro a; cases a <;> simp
@[simp] theorem map_throw [Monad m] [LawfulMonad m] {α β : Type _} (f : α β) (e : ε) :
f <$> (throw e : ExceptT ε m α) = (throw e : ExceptT ε m β) := by
simp only [ExceptT.instMonad, ExceptT.map, ExceptT.mk, throw, throwThe, MonadExceptOf.throw,
pure_bind]
end ExceptT
/-! # Except -/
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun a _ _ => by cases a <;> rfl)
(pure_bind := fun a f => rfl)
(bind_assoc := fun a f g => by cases a <;> rfl)
instance : LawfulApplicative (Except ε) := inferInstance
instance : LawfulFunctor (Except ε) := inferInstance
@@ -180,7 +175,7 @@ theorem ext {x y : StateT σ m α} (h : ∀ s, x.run s = y.run s) : x = y :=
simp [bind, StateT.bind, run]
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
simp [Functor.map, StateT.map, run, bind_pure_comp]
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
@@ -215,13 +210,13 @@ theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f :
theorem seqRight_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x *> y = const α id <$> x <*> y := by
apply ext; intro s
simp [bind_pure_comp, const]
simp [map_eq_pure_bind, const]
apply bind_congr; intro p; cases p
simp [Prod.eta]
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
apply ext; intro s
simp [bind_pure_comp]
simp [map_eq_pure_bind]
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
id_map := by intros; apply ext; intros; simp[Prod.eta]
@@ -229,7 +224,7 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
seqLeft_eq := seqLeft_eq
seqRight_eq := seqRight_eq
pure_seq := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp; apply LawfulMonad.bind_pure_comp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp

View File

@@ -823,7 +823,6 @@ theorem iff_iff_implies_and_implies {a b : Prop} : (a ↔ b) ↔ (a → b) ∧ (
protected theorem Iff.rfl {a : Prop} : a a :=
Iff.refl a
-- And, also for backward compatibility, we try `Iff.rfl.` using `exact` (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
theorem Iff.of_eq (h : a = b) : a b := h Iff.rfl
@@ -838,9 +837,6 @@ instance : Trans Iff Iff Iff where
theorem Eq.comm {a b : α} : a = b b = a := Iff.intro Eq.symm Eq.symm
theorem eq_comm {a b : α} : a = b b = a := Eq.comm
theorem HEq.comm {a : α} {b : β} : HEq a b HEq b a := Iff.intro HEq.symm HEq.symm
theorem heq_comm {a : α} {b : β} : HEq a b HEq b a := HEq.comm
@[symm] theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.comm: (a b) (b a) := Iff.intro Iff.symm Iff.symm
theorem iff_comm : (a b) (b a) := Iff.comm
@@ -1864,8 +1860,7 @@ section
variable {α : Type u}
variable (r : α α Prop)
instance Quotient.decidableEq {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)]
: DecidableEq (Quotient s) :=
instance {α : Sort u} {s : Setoid α} [d : (a b : α), Decidable (a b)] : DecidableEq (Quotient s) :=
fun (q₁ q₂ : Quotient s) =>
Quotient.recOnSubsingleton₂ q₁ q₂
fun a₁ a₂ =>

View File

@@ -40,4 +40,3 @@ import Init.Data.ULift
import Init.Data.PLift
import Init.Data.Zero
import Init.Data.NeZero
import Init.Data.Function

View File

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

View File

@@ -11,7 +11,6 @@ import Init.Data.UInt.Basic
import Init.Data.Repr
import Init.Data.ToString.Basic
import Init.GetElem
import Init.Data.List.ToArray
universe u v w
/-! ### Array literal syntax -/
@@ -216,7 +215,7 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
if h : i < a.size then
swapAt a i, h v
else
have : Inhabited (α × Array α) := (v, a)
have : Inhabited α := v
panic! ("index " ++ toString i ++ " out of bounds")
def shrink (a : Array α) (n : Nat) : Array α :=
@@ -618,7 +617,7 @@ def concatMap (f : α → Array β) (as : Array α) : Array β :=
`flatten #[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` = `#[a₁, a₂, ⋯, b₁, b₂, ⋯]`
-/
@[inline] def flatten (as : Array (Array α)) : Array α :=
def flatten (as : Array (Array α)) : Array α :=
as.foldl (init := empty) fun r a => r ++ a
@[inline]
@@ -721,7 +720,7 @@ termination_by a.size - i.val
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ i.isLt
-- This is required in `Lean.Data.PersistentHashMap`.
@[simp] theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
induction a, i using Array.feraseIdx.induct with
| @case1 a i h a' _ ih =>
unfold feraseIdx
@@ -811,27 +810,11 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
as.foldl (init := (#[], #[])) fun (as, bs) a =>
if p a then (as.push a, bs) else (as, bs.push a)
/-! ## Auxiliary functions used in metaprogramming.
/-! ### Auxiliary functions used in metaprogramming.
We do not intend to provide verification theorems for these functions.
-/
/-! ### eraseReps -/
/--
`O(|l|)`. Erase repeated adjacent elements. Keeps the first occurrence of each run.
* `eraseReps #[1, 3, 2, 2, 2, 3, 5] = #[1, 3, 2, 3, 5]`
-/
def eraseReps {α} [BEq α] (as : Array α) : Array α :=
if h : 0 < as.size then
let last, r := as.foldl (init := (as[0], #[])) fun last, r a =>
if a == last then last, r else a, r.push last
r.push last
else
#[]
/-! ### allDiff -/
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size Bool
| 0, _ => true
| i+1, h =>
@@ -849,8 +832,6 @@ decreasing_by simp_wf; decreasing_trivial_pre_omega
def allDiff [BEq α] (as : Array α) : Bool :=
allDiffAux as 0
/-! ### getEvenElems -/
@[inline] def getEvenElems (as : Array α) : Array α :=
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
if even then

View File

@@ -73,7 +73,7 @@ theorem foldr_eq_foldr_toList (f : α → β → β) (init : β) (arr : Array α
@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl
@[simp] theorem toList_append (arr arr' : Array α) :
@[simp] theorem append_toList (arr arr' : Array α) :
(arr ++ arr').toList = arr.toList ++ arr'.toList := by
rw [ append_eq_append]; unfold Array.append
rw [foldl_eq_foldl_toList]
@@ -111,8 +111,8 @@ abbrev toList_eq := @toListImpl_eq
@[deprecated pop_toList (since := "2024-09-09")]
abbrev pop_data := @pop_toList
@[deprecated toList_append (since := "2024-09-09")]
abbrev append_data := @toList_append
@[deprecated append_toList (since := "2024-09-09")]
abbrev append_data := @append_toList
@[deprecated appendList_toList (since := "2024-09-09")]
abbrev appendList_data := @appendList_toList

File diff suppressed because it is too large Load Diff

View File

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.Ord
namespace Array
-- TODO: remove the [Inhabited α] parameters as soon as we have the tactic framework for automating proof generation and using Array.fget
@@ -45,11 +44,4 @@ def qpartition (as : Array α) (lt : αα → Bool) (lo hi : Nat) : Nat ×
else as
sort as low high
set_option linter.unusedVariables.funArgs false in
/--
Sort an array using `compare` to compare elements.
-/
def qsortOrd [ord : Ord α] (xs : Array α) : Array α :=
xs.qsort fun x y => compare x y |>.isLT
end Array

View File

@@ -59,22 +59,6 @@ def popFront (s : Subarray α) : Subarray α :=
else
s
/--
The empty subarray.
-/
protected def empty : Subarray α where
array := #[]
start := 0
stop := 0
start_le_stop := Nat.le_refl 0
stop_le_array_size := Nat.le_refl 0
instance : EmptyCollection (Subarray α) :=
Subarray.empty
instance : Inhabited (Subarray α) :=
{}
@[inline] unsafe def forInUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (s : Subarray α) (b : β) (f : α β m (ForInStep β)) : m β :=
let sz := USize.ofNat s.stop
let rec @[specialize] loop (i : USize) (b : β) : m β := do

View File

@@ -12,7 +12,7 @@ namespace Array
theorem exists_of_uset (self : Array α) (i d h) :
l₁ l₂, self.toList = l₁ ++ self[i] :: l₂ List.length l₁ = i.toNat
(self.uset i d h).toList = l₁ ++ d :: l₂ := by
simpa only [ugetElem_eq_getElem, getElem_eq_getElem_toList, uset, toList_set] using
simpa only [ugetElem_eq_getElem, getElem_eq_toList_getElem, uset, toList_set] using
List.exists_of_set _
end Array

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed, Siddharth Bhat
Authors: Joe Hendrix, Wojciech Nawrocki, Leonardo de Moura, Mario Carneiro, Alex Keizer, Harun Khan, Abdalrhman M Mohamed
-/
prelude
import Init.Data.Fin.Basic
@@ -269,8 +269,8 @@ Return the absolute value of a signed bitvector.
protected def abs (x : BitVec n) : BitVec n := if x.msb then .neg x else x
/--
Multiplication for bit vectors. This can be interpreted as either signed or unsigned
multiplication modulo `2^n`.
Multiplication for bit vectors. This can be interpreted as either signed or unsigned negation
modulo `2^n`.
SMT-Lib name: `bvmul`.
-/
@@ -676,13 +676,6 @@ result of appending a single bit to the front in the naive implementation).
That is, the new bit is the least significant bit. -/
def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool lsb)
/--
`x.shiftConcat b` shifts all bits of `x` to the left by `1` and sets the least significant bit to `b`.
It is a non-dependent version of `concat` that does not change the total bitwidth.
-/
def shiftConcat (x : BitVec n) (b : Bool) : BitVec n :=
(x.concat b).truncate n
/-- Prepend a single bit to the front of a bitvector, using big endian order (see `append`).
That is, the new bit is the most significant bit. -/
def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) :=
@@ -718,8 +711,6 @@ section normalization_eqs
@[simp] theorem add_eq (x y : BitVec w) : BitVec.add x y = x + y := rfl
@[simp] theorem sub_eq (x y : BitVec w) : BitVec.sub x y = x - y := rfl
@[simp] theorem mul_eq (x y : BitVec w) : BitVec.mul x y = x * y := rfl
@[simp] theorem udiv_eq (x y : BitVec w) : BitVec.udiv x y = x / y := rfl
@[simp] theorem umod_eq (x y : BitVec w) : BitVec.umod x y = x % y := rfl
@[simp] theorem zero_eq : BitVec.zero n = 0#n := rfl
end normalization_eqs

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix, Siddharth Bhat
Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix
-/
prelude
import Init.Data.BitVec.Folds
@@ -18,80 +18,6 @@ as vectors of bits into proofs about Lean `BitVec` values.
The module is named for the bit-blasting operation in an SMT solver that converts bitvector
expressions into expressions about individual bits in each vector.
### Example: How bitblasting works for multiplication
We explain how the lemmas here are used for bitblasting,
by using multiplication as a prototypical example.
Other bitblasters for other operations follow the same pattern.
To bitblast a multiplication of the form `x * y`,
we must unfold the above into a form that the SAT solver understands.
We assume that the solver already knows how to bitblast addition.
This is known to `bv_decide`, by exploiting the lemma `add_eq_adc`,
which says that `x + y : BitVec w` equals `(adc x y false).2`,
where `adc` builds an add-carry circuit in terms of the primitive operations
(bitwise and, bitwise or, bitwise xor) that bv_decide already understands.
In this way, we layer bitblasters on top of each other,
by reducing the multiplication bitblaster to an addition operation.
The core lemma is given by `getLsbD_mul`:
```lean
x y : BitVec w ⊢ (x * y).getLsbD i = (mulRec x y w).getLsbD i
```
Which says that the `i`th bit of `x * y` can be obtained by
evaluating the `i`th bit of `(mulRec x y w)`.
Once again, we assume that `bv_decide` knows how to implement `getLsbD`,
given that `mulRec` can be understood by `bv_decide`.
We write two lemmas to enable `bv_decide` to unfold `(mulRec x y w)`
into a complete circuit, **when `w` is a known constant**`.
This is given by two recurrence lemmas, `mulRec_zero_eq` and `mulRec_succ_eq`,
which are applied repeatedly when the width is `0` and when the width is `w' + 1`:
```lean
mulRec_zero_eq :
mulRec x y 0 =
if y.getLsbD 0 then x else 0
mulRec_succ_eq
mulRec x y (s + 1) =
mulRec x y s +
if y.getLsbD (s + 1) then (x <<< (s + 1)) else 0 := rfl
```
By repeatedly applying the lemmas `mulRec_zero_eq` and `mulRec_succ_eq`,
one obtains a circuit for multiplication.
Note that this circuit uses `BitVec.add`, `BitVec.getLsbD`, `BitVec.shiftLeft`.
Here, `BitVec.add` and `BitVec.shiftLeft` are (recursively) bitblasted by `bv_decide`,
using the lemmas `add_eq_adc` and `shiftLeft_eq_shiftLeftRec`,
and `BitVec.getLsbD` is a primitive that `bv_decide` knows how to reduce to SAT.
The two lemmas, `mulRec_zero_eq`, and `mulRec_succ_eq`,
are used in `Std.Tactic.BVDecide.BVExpr.bitblast.blastMul`
to prove the correctness of the circuit that is built by `bv_decide`.
```lean
def blastMul (aig : AIG BVBit) (input : AIG.BinaryRefVec aig w) : AIG.RefVecEntry BVBit w
theorem denote_blastMul (aig : AIG BVBit) (lhs rhs : BitVec w) (assign : Assignment) :
...
⟦(blastMul aig input).aig, (blastMul aig input).vec.get idx hidx, assign.toAIGAssignment⟧
=
(lhs * rhs).getLsbD idx
```
The definition and theorem above are internal to `bv_decide`,
and use `mulRec_{zero,succ}_eq` to prove that the circuit built by `bv_decide`
computes the correct value for multiplication.
To zoom out, therefore, we follow two steps:
First, we prove bitvector lemmas to unfold a high-level operation (such as multiplication)
into already bitblastable operations (such as addition and left shift).
We then use these lemmas to prove the correctness of the circuit that `bv_decide` builds.
We use this workflow to implement bitblasting for all SMT-LIB2 operations.
## Main results
* `x + y : BitVec w` is `(adc x y false).2`.
@@ -238,17 +164,6 @@ theorem getLsbD_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y false)) := by
simpa using getLsbD_add_add_bool i_lt x y false
theorem getElem_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
(x + y + setWidth w (ofBool c))[i] =
(x[i] ^^ (y[i] ^^ carry i x y c)) := by
simp only [ getLsbD_eq_getElem]
rw [getLsbD_add_add_bool]
omega
theorem getElem_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
(x + y)[i] = (x[i] ^^ (y[i] ^^ carry i x y false)) := by
simpa using getElem_add_add_bool i_lt x y false
theorem adc_spec (x y : BitVec w) (c : Bool) :
adc x y c = (carry w x y c, x + y + setWidth w (ofBool c)) := by
simp only [adc]
@@ -453,10 +368,6 @@ theorem getLsbD_mul (x y : BitVec w) (i : Nat) :
· simp
· omega
theorem getElem_mul {x y : BitVec w} {i : Nat} (h : i < w) :
(x * y)[i] = (mulRec x y w)[i] := by
simp [mulRec_eq_mul_signExtend_setWidth]
/-! ## shiftLeft recurrence for bitblasting -/
/--
@@ -527,385 +438,6 @@ theorem shiftLeft_eq_shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) :
· simp [of_length_zero]
· simp [shiftLeftRec_eq]
/-! # udiv/urem recurrence for bitblasting
In order to prove the correctness of the division algorithm on the integers,
one shows that `n.div d = q` and `n.mod d = r` iff `n = d * q + r` and `0 ≤ r < d`.
Mnemonic: `n` is the numerator, `d` is the denominator, `q` is the quotient, and `r` the remainder.
This *uniqueness of decomposition* is not true for bitvectors.
For `n = 0, d = 3, w = 3`, we can write:
- `0 = 0 * 3 + 0` (`q = 0`, `r = 0 < 3`.)
- `0 = 2 * 3 + 2 = 6 + 2 ≃ 0 (mod 8)` (`q = 2`, `r = 2 < 3`).
Such examples can be created by choosing different `(q, r)` for a fixed `(d, n)`
such that `(d * q + r)` overflows and wraps around to equal `n`.
This tells us that the division algorithm must have more restrictions than just the ones
we have for integers. These restrictions are captured in `DivModState.Lawful`.
The key idea is to state the relationship in terms of the toNat values of {n, d, q, r}.
If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q` and `n.umod d = r`.
Following this, we implement the division algorithm by repeated shift-subtract.
References:
- Fast 32-bit Division on the DSP56800E: Minimized nonrestoring division algorithm by David Baca
- Bitwuzla sources for bitblasting.h
-/
private theorem Nat.div_add_eq_left_of_lt {x y z : Nat} (hx : z x) (hy : y < z) (hz : 0 < z) :
(x + y) / z = x / z := by
refine Nat.div_eq_of_lt_le ?lo ?hi
· apply Nat.le_trans
· exact div_mul_le_self x z
· omega
· simp only [succ_eq_add_one, Nat.add_mul, Nat.one_mul]
apply Nat.add_lt_add_of_le_of_lt
· apply Nat.le_of_eq
exact (Nat.div_eq_iff_eq_mul_left hz hx).mp rfl
· exact hy
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q`. -/
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
(hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n / d = q := by
apply BitVec.eq_of_toNat_eq
rw [toNat_udiv]
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
simp [hdqnr]
rw [Nat.div_add_eq_left_of_lt] at hdqnr
· rw [ hdqnr]
exact mul_div_right q.toNat hd
· exact Nat.dvd_mul_right d.toNat q.toNat
· exact hrd
· exact hd
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.umod d = r`. -/
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n % d = r := by
apply BitVec.eq_of_toNat_eq
rw [toNat_umod]
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
simp [hdqnr]
rw [Nat.add_mod, Nat.mul_mod_right] at hdqnr
simp only [Nat.zero_add, mod_mod] at hdqnr
replace hrd : r.toNat < d.toNat := by
simpa [BitVec.lt_def] using hrd
rw [Nat.mod_eq_of_lt hrd] at hdqnr
simp [hdqnr]
/-! ### DivModState -/
/-- `DivModState` is a structure that maintains the state of recursive `divrem` calls. -/
structure DivModState (w : Nat) : Type where
/-- The number of bits in the numerator that are not yet processed -/
wn : Nat
/-- The number of bits in the remainder (and quotient) -/
wr : Nat
/-- The current quotient. -/
q : BitVec w
/-- The current remainder. -/
r : BitVec w
/-- `DivModArgs` contains the arguments to a `divrem` call which remain constant throughout
execution. -/
structure DivModArgs (w : Nat) where
/-- the numerator (aka, dividend) -/
n : BitVec w
/-- the denumerator (aka, divisor)-/
d : BitVec w
/-- A `DivModState` is lawful if the remainder width `wr` plus the numerator width `wn` equals `w`,
and the bitvectors `r` and `n` have values in the bounds given by bitwidths `wr`, resp. `wn`.
This is a proof engineering choice: an alternative world could have been
`r : BitVec wr` and `n : BitVec wn`, but this required much more dependent typing coercions.
Instead, we choose to declare all involved bitvectors as length `w`, and then prove that
the values are within their respective bounds.
We start with `wn = w` and `wr = 0`, and then in each step, we decrement `wn` and increment `wr`.
In this way, we grow a legal remainder in each loop iteration.
-/
structure DivModState.Lawful {w : Nat} (args : DivModArgs w) (qr : DivModState w) : Prop where
/-- The sum of widths of the dividend and remainder is `w`. -/
hwrn : qr.wr + qr.wn = w
/-- The denominator is positive. -/
hdPos : 0 < args.d
/-- The remainder is strictly less than the denominator. -/
hrLtDivisor : qr.r.toNat < args.d.toNat
/-- The remainder is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hrWidth : qr.r.toNat < 2^qr.wr
/-- The quotient is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hqWidth : qr.q.toNat < 2^qr.wr
/-- The low `(w - wn)` bits of `n` obey the invariant for division. -/
hdiv : args.n.toNat >>> qr.wn = args.d.toNat * qr.q.toNat + qr.r.toNat
/-- A lawful DivModState implies `w > 0`. -/
def DivModState.Lawful.hw {args : DivModArgs w} {qr : DivModState w}
{h : DivModState.Lawful args qr} : 0 < w := by
have hd := h.hdPos
rcases w with rfl | w
· have hcontra : args.d = 0#0 := by apply Subsingleton.elim
rw [hcontra] at hd
simp at hd
· omega
/-- An initial value with both `q, r = 0`. -/
def DivModState.init (w : Nat) : DivModState w := {
wn := w
wr := 0
q := 0#w
r := 0#w
}
/-- The initial state is lawful. -/
def DivModState.lawful_init {w : Nat} (args : DivModArgs w) (hd : 0#w < args.d) :
DivModState.Lawful args (DivModState.init w) := by
simp only [BitVec.DivModState.init]
exact {
hwrn := by simp only; omega,
hdPos := by assumption
hrLtDivisor := by simp [BitVec.lt_def] at hd ; assumption
hrWidth := by simp [DivModState.init],
hqWidth := by simp [DivModState.init],
hdiv := by
simp only [DivModState.init, toNat_ofNat, zero_mod, Nat.mul_zero, Nat.add_zero];
rw [Nat.shiftRight_eq_div_pow]
apply Nat.div_eq_of_lt args.n.isLt
}
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
quotient has been correctly computed.
-/
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
(h_lawful : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n / d = qr.q := by
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
have hdiv := h_lawful.hdiv
simp only [h_final] at *
omega
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
remainder has been correctly computed.
-/
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
(h : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n % d = qr.r := by
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
have hdiv := h.hdiv
simp only [shiftRight_zero] at hdiv
simp only [h_final] at *
exact hdiv.symm
/-! ### DivModState.Poised -/
/--
A `Poised` DivModState is a state which is `Lawful` and furthermore, has at least
one numerator bit left to process `(0 < wn)`
The input to the shift subtractor is a legal input to `divrem`, and we also need to have an
input bit to perform shift subtraction on, and thus we need `0 < wn`.
-/
structure DivModState.Poised {w : Nat} (args : DivModArgs w) (qr : DivModState w)
extends DivModState.Lawful args qr : Type where
/-- Only perform a round of shift-subtract if we have dividend bits. -/
hwn_lt : 0 < qr.wn
/--
In the shift subtract input, the dividend is at least one bit long (`wn > 0`), so
the remainder has bits to be computed (`wr < w`).
-/
def DivModState.wr_lt_w {qr : DivModState w} (h : qr.Poised args) : qr.wr < w := by
have hwrn := h.hwrn
have hwn_lt := h.hwn_lt
omega
/-! ### Division shift subtractor -/
/--
One round of the division algorithm, that tries to perform a subtract shift.
Note that this should only be called when `r.msb = false`, so we will not overflow.
-/
def divSubtractShift (args : DivModArgs w) (qr : DivModState w) : DivModState w :=
let {n, d} := args
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (n.getLsbD wn)
if r' < d then {
q := qr.q.shiftConcat false, -- If `r' < d`, then we do not have a quotient bit.
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true, -- Otherwise, `r' ≥ d`, and we have a quotient bit.
r := r' - d -- we subtract to maintain the invariant that `r < d`.
wn, wr
}
/-- The value of shifting right by `wn - 1` equals shifting by `wn` and grabbing the lsb at `(wn - 1)`. -/
theorem DivModState.toNat_shiftRight_sub_one_eq
{args : DivModArgs w} {qr : DivModState w} (h : qr.Poised args) :
args.n.toNat >>> (qr.wn - 1)
= (args.n.toNat >>> qr.wn) * 2 + (args.n.getLsbD (qr.wn - 1)).toNat := by
show BitVec.toNat (args.n >>> (qr.wn - 1)) = _
have {..} := h -- break the structure down for `omega`
rw [shiftRight_sub_one_eq_shiftConcat args.n h.hwn_lt]
rw [toNat_shiftConcat_eq_of_lt (k := w - qr.wn)]
· simp
· omega
· apply BitVec.toNat_ushiftRight_lt
omega
/--
This is used when proving the correctness of the division algorithm,
where we know that `r < d`.
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
In arithmetic, this is the same as showing that
`r * 2 + 1 - d < d`, which this theorem establishes.
-/
private theorem two_mul_add_sub_lt_of_lt_of_lt_two (h : a < x) (hy : y < 2) :
2 * a + y - x < x := by omega
/-- We show that the output of `divSubtractShift` is lawful, which tells us that it
obeys the division equation. -/
theorem lawful_divSubtractShift (qr : DivModState w) (h : qr.Poised args) :
DivModState.Lawful args (divSubtractShift args qr) := by
rcases args with n, d
simp only [divSubtractShift, decide_eq_true_eq]
-- We add these hypotheses for `omega` to find them later.
have hrwn, hd, hrd, hr, hn, hrnd, hwn_lt := h
have : d.toNat * (qr.q.toNat * 2) = d.toNat * qr.q.toNat * 2 := by rw [Nat.mul_assoc]
by_cases rltd : shiftConcat qr.r (n.getLsbD (qr.wn - 1)) < d
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case pos.hrWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hqWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hdiv =>
simp [qr.toNat_shiftRight_sub_one_eq h, h.hdiv, this,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth]
omega
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case neg.hrLtDivisor =>
simp only [lt_def, Nat.not_lt] at rltd
rw [BitVec.toNat_sub_of_le rltd,
toNat_shiftConcat_eq_of_lt (hk := qr.wr_lt_w h) (hx := h.hrWidth),
Nat.mul_comm]
apply two_mul_add_sub_lt_of_lt_of_lt_two <;> bv_omega
case neg.hrWidth =>
simp only
have hdr' : d (qr.r.shiftConcat (n.getLsbD (qr.wn - 1))) :=
BitVec.not_lt_iff_le.mp rltd
have hr' : ((qr.r.shiftConcat (n.getLsbD (qr.wn - 1)))).toNat < 2 ^ (qr.wr + 1) := by
apply toNat_shiftConcat_lt_of_lt <;> bv_omega
rw [BitVec.toNat_sub_of_le hdr']
omega
case neg.hqWidth =>
apply toNat_shiftConcat_lt_of_lt <;> omega
case neg.hdiv =>
have rltd' := (BitVec.not_lt_iff_le.mp rltd)
simp only [qr.toNat_shiftRight_sub_one_eq h,
BitVec.toNat_sub_of_le rltd',
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth]
simp only [BitVec.le_def,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth] at rltd'
simp only [toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth, h.hdiv, Nat.mul_add]
bv_omega
/-! ### Core division algorithm circuit -/
/-- A recursive definition of division for bitblasting, in terms of a shift-subtraction circuit. -/
def divRec {w : Nat} (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
DivModState w :=
match m with
| 0 => qr
| m + 1 => divRec m args <| divSubtractShift args qr
@[simp]
theorem divRec_zero (qr : DivModState w) :
divRec 0 args qr = qr := rfl
@[simp]
theorem divRec_succ (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m + 1) args qr =
divRec m args (divSubtractShift args qr) := rfl
/-- The output of `divRec` is a lawful state -/
theorem lawful_divRec {args : DivModArgs w} {qr : DivModState w}
(h : DivModState.Lawful args qr) :
DivModState.Lawful args (divRec qr.wn args qr) := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
exact h
case succ wn' ih =>
simp only [divRec_succ]
apply ih
· apply lawful_divSubtractShift
constructor
· assumption
· omega
· simp only [divSubtractShift, hm]
split <;> rfl
/-- The output of `divRec` has no more bits left to process (i.e., `wn = 0`) -/
@[simp]
theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
(divRec qr.wn args qr).wn = 0 := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
assumption
case succ wn' ih =>
apply ih
simp only [divSubtractShift, hm]
split <;> rfl
/-- The result of `udiv` agrees with the result of the division recurrence. -/
theorem udiv_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n / d = out.q := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
/-- The result of `umod` agrees with the result of the division recurrence. -/
theorem umod_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n % d = out.r := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
theorem divRec_succ' (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m+1) args qr =
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (args.n.getLsbD wn)
let input : DivModState _ :=
if r' < args.d then {
q := qr.q.shiftConcat false,
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true,
r := r' - args.d
wn, wr
}
divRec m args input := by
simp [divRec_succ, divSubtractShift]
/- ### Arithmetic shift right (sshiftRight) recurrence -/
/--

File diff suppressed because it is too large Load Diff

View File

@@ -368,14 +368,13 @@ theorem and_or_inj_left_iff :
/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/
def toNat (b : Bool) : Nat := cond b 1 0
@[simp, bv_toNat] theorem toNat_false : false.toNat = 0 := rfl
@[simp] theorem toNat_false : false.toNat = 0 := rfl
@[simp, bv_toNat] theorem toNat_true : true.toNat = 1 := rfl
@[simp] theorem toNat_true : true.toNat = 1 := rfl
theorem toNat_le (c : Bool) : c.toNat 1 := by
cases c <;> trivial
@[bv_toNat]
theorem toNat_lt (b : Bool) : b.toNat < 2 :=
Nat.lt_succ_of_le (toNat_le _)

View File

@@ -245,7 +245,7 @@ On an invalid position, returns `(default : UInt8)`. -/
@[inline]
def curr : Iterator UInt8
| arr, i =>
if h : i < arr.size then
if h:i < arr.size then
arr[i]'h
else
default

View File

@@ -244,13 +244,9 @@ theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.siz
theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl
@[simp] protected theorem zero_add [NeZero n] (k : Fin n) : (0 : Fin n) + k = k := by
@[simp] protected theorem zero_add {n : Nat} [NeZero n] (i : Fin n) : (0 : Fin n) + i = i := by
ext
simp [Fin.add_def, Nat.mod_eq_of_lt k.2]
@[simp] protected theorem add_zero [NeZero n] (k : Fin n) : k + 0 = k := by
ext
simp [add_def, Nat.mod_eq_of_lt k.2]
simp [Fin.add_def, Nat.mod_eq_of_lt i.2]
theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by
match n with
@@ -586,8 +582,8 @@ theorem rev_succ (k : Fin n) : rev (succ k) = castSucc (rev k) := k.rev_addNat 1
@[simp] theorem coe_pred (j : Fin (n + 1)) (h : j 0) : (j.pred h : Nat) = j - 1 := rfl
@[simp] theorem succ_pred : (i : Fin (n + 1)) (h : i 0), (i.pred h).succ = i
| 0, _, hi => by simp only [mk_zero, ne_eq, not_true] at hi
| _ + 1, _, _ => rfl
| 0, h, hi => by simp only [mk_zero, ne_eq, not_true] at hi
| n + 1, h, hi => rfl
@[simp]
theorem pred_succ (i : Fin n) {h : i.succ 0} : i.succ.pred h = i := by

View File

@@ -72,35 +72,21 @@ instance floatDecLt (a b : Float) : Decidable (a < b) := Float.decLt a b
instance floatDecLe (a b : Float) : Decidable (a b) := Float.decLe a b
@[extern "lean_float_to_string"] opaque Float.toString : Float String
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt8` (including Inf), returns the maximum value of `UInt8`
(i.e. `UInt8.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt8, returns 0. -/
@[extern "lean_float_to_uint8"] opaque Float.toUInt8 : Float UInt8
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt16` (including Inf), returns the maximum value of `UInt16`
(i.e. `UInt16.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt16, returns 0. -/
@[extern "lean_float_to_uint16"] opaque Float.toUInt16 : Float UInt16
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt32` (including Inf), returns the maximum value of `UInt32`
(i.e. `UInt32.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt32, returns 0. -/
@[extern "lean_float_to_uint32"] opaque Float.toUInt32 : Float UInt32
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `UInt64` (including Inf), returns the maximum value of `UInt64`
(i.e. `UInt64.size - 1`).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for UInt64, returns 0. -/
@[extern "lean_float_to_uint64"] opaque Float.toUInt64 : Float UInt64
/-- If the given float is non-negative, truncates the value to the nearest non-negative integer.
If negative or NaN, returns `0`.
If larger than the maximum value for `USize` (including Inf), returns the maximum value of `USize`
(i.e. `USize.size - 1`). This value is platform dependent).
-/
/-- If the given float is positive, truncates the value to the nearest positive integer.
If negative or larger than the maximum value for USize, returns 0. -/
@[extern "lean_float_to_usize"] opaque Float.toUSize : Float USize
@[extern "lean_float_isnan"] opaque Float.isNaN : Float Bool

View File

@@ -1,35 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Core
namespace Function
@[inline]
def curry : (α × β φ) α β φ := fun f a b => f (a, b)
/-- Interpret a function with two arguments as a function on `α × β` -/
@[inline]
def uncurry : (α β φ) α × β φ := fun f a => f a.1 a.2
@[simp]
theorem curry_uncurry (f : α β φ) : curry (uncurry f) = f :=
rfl
@[simp]
theorem uncurry_curry (f : α × β φ) : uncurry (curry f) = f :=
funext fun _a, _b => rfl
@[simp]
theorem uncurry_apply_pair {α β γ} (f : α β γ) (x : α) (y : β) : uncurry f (x, y) = f x y :=
rfl
@[simp]
theorem curry_apply {α β γ} (f : α × β γ) (x : α) (y : β) : curry f x y = f (x, y) :=
rfl
end Function

View File

@@ -253,7 +253,7 @@ theorem tmod_def (a b : Int) : tmod a b = a - b * a.tdiv b := by
theorem fmod_add_fdiv : a b : Int, a.fmod b + b * a.fdiv b = a
| 0, ofNat _ | 0, -[_+1] => congrArg ofNat <| by simp
| succ _, ofNat _ => congrArg ofNat <| Nat.mod_add_div ..
| succ m, ofNat n => congrArg ofNat <| Nat.mod_add_div ..
| succ m, -[n+1] => by
show subNatNat (m % succ n) n + ((succ n * (m / succ n)) + n + 1) = (m + 1)
rw [Int.add_comm _ n, Int.add_assoc, Int.add_assoc,
@@ -289,8 +289,8 @@ theorem fmod_eq_tmod {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fmod a b = tmod
@[simp] protected theorem ediv_neg : a b : Int, a / (-b) = -(a / b)
| ofNat m, 0 => show ofNat (m / 0) = -(m / 0) by rw [Nat.div_zero]; rfl
| ofNat _, -[_+1] => (Int.neg_neg _).symm
| ofNat _, succ _ | -[_+1], 0 | -[_+1], succ _ | -[_+1], -[_+1] => rfl
| ofNat m, -[n+1] => (Int.neg_neg _).symm
| ofNat m, succ n | -[m+1], 0 | -[m+1], succ n | -[m+1], -[n+1] => rfl
theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 :=
match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with
@@ -339,7 +339,7 @@ theorem add_mul_ediv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c) / c
| _, k, rfl, -[n+1] => show (a - n.succ * k.succ).ediv k.succ = a.ediv k.succ - n.succ by
rw [ Int.add_sub_cancel (ediv ..), this, Int.sub_add_cancel]
fun {k n} => @fun
| ofNat _ => congrArg ofNat <| Nat.add_mul_div_right _ _ k.succ_pos
| ofNat m => congrArg ofNat <| Nat.add_mul_div_right _ _ k.succ_pos
| -[m+1] => by
show ((n * k.succ : Nat) - m.succ : Int).ediv k.succ = n - (m / k.succ + 1 : Nat)
by_cases h : m < n * k.succ
@@ -396,7 +396,7 @@ theorem add_mul_ediv_left (a : Int) {b : Int}
rw [Int.mul_neg, Int.ediv_neg, Int.ediv_neg]; apply congrArg Neg.neg; apply this
fun m k b =>
match b, k with
| ofNat _, _ => congrArg ofNat (Nat.mul_div_mul_left _ _ m.succ_pos)
| ofNat n, k => congrArg ofNat (Nat.mul_div_mul_left _ _ m.succ_pos)
| -[n+1], 0 => by
rw [Int.ofNat_zero, Int.mul_zero, Int.ediv_zero, Int.ediv_zero]
| -[n+1], succ k => congrArg negSucc <|
@@ -822,14 +822,14 @@ theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int}
unseal Nat.div in
@[simp] protected theorem tdiv_neg : a b : Int, a.tdiv (-b) = -(a.tdiv b)
| ofNat m, 0 => show ofNat (m / 0) = -(m / 0) by rw [Nat.div_zero]; rfl
| ofNat _, -[_+1] | -[_+1], succ _ => (Int.neg_neg _).symm
| ofNat _, succ _ | -[_+1], 0 | -[_+1], -[_+1] => rfl
| ofNat m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm
| ofNat m, succ n | -[m+1], 0 | -[m+1], -[n+1] => rfl
unseal Nat.div in
@[simp] protected theorem neg_tdiv : a b : Int, (-a).tdiv b = -(a.tdiv b)
| 0, n => by simp [Int.neg_zero]
| succ _, (n:Nat) | -[_+1], 0 | -[_+1], -[_+1] => rfl
| succ _, -[_+1] | -[_+1], succ _ => (Int.neg_neg _).symm
| succ m, (n:Nat) | -[m+1], 0 | -[m+1], -[n+1] => rfl
| succ m, -[n+1] | -[m+1], succ n => (Int.neg_neg _).symm
protected theorem neg_tdiv_neg (a b : Int) : (-a).tdiv (-b) = a.tdiv b := by
simp [Int.tdiv_neg, Int.neg_tdiv, Int.neg_neg]

View File

@@ -181,12 +181,12 @@ theorem subNatNat_add_negSucc (m n k : Nat) :
Nat.add_comm]
protected theorem add_assoc : a b c : Int, a + b + c = a + (b + c)
| (m:Nat), (n:Nat), _ => aux1 ..
| (m:Nat), (n:Nat), c => aux1 ..
| Nat.cast m, b, Nat.cast k => by
rw [Int.add_comm, aux1, Int.add_comm k, aux1, Int.add_comm b]
| a, (n:Nat), (k:Nat) => by
rw [Int.add_comm, Int.add_comm a, aux1, Int.add_comm a, Int.add_comm k]
| -[_+1], -[_+1], (k:Nat) => aux2 ..
| -[m+1], -[n+1], (k:Nat) => aux2 ..
| -[m+1], (n:Nat), -[k+1] => by
rw [Int.add_comm, aux2, Int.add_comm n, aux2, Int.add_comm -[m+1]]
| (m:Nat), -[n+1], -[k+1] => by

View File

@@ -512,8 +512,8 @@ theorem toNat_add_nat {a : Int} (ha : 0 ≤ a) (n : Nat) : (a + n).toNat = a.toN
@[simp] theorem pred_toNat : i : Int, (i - 1).toNat = i.toNat - 1
| 0 => rfl
| (_+1:Nat) => by simp [ofNat_add]
| -[_+1] => rfl
| (n+1:Nat) => by simp [ofNat_add]
| -[n+1] => rfl
theorem toNat_sub_toNat_neg : n : Int, n.toNat - (-n).toNat = n
| 0 => rfl

View File

@@ -5,7 +5,6 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.Int.Lemmas
import Init.Data.Nat.Lemmas
namespace Int
@@ -36,24 +35,10 @@ theorem pow_le_pow_of_le_right {n : Nat} (hx : n > 0) {i : Nat} : ∀ {j}, i ≤
theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
pow_le_pow_of_le_right h (Nat.zero_le _)
@[norm_cast]
theorem natCast_pow (b n : Nat) : ((b^n : Nat) : Int) = (b : Int) ^ n := by
match n with
| 0 => rfl
| n + 1 =>
simp only [Nat.pow_succ, Int.pow_succ, natCast_mul, natCast_pow _ n]
@[simp]
protected theorem two_pow_pred_sub_two_pow {w : Nat} (h : 0 < w) :
((2 ^ (w - 1) : Nat) - (2 ^ w : Nat) : Int) = - ((2 ^ (w - 1) : Nat) : Int) := by
rw [ Nat.two_pow_pred_add_two_pow_pred h]
omega
@[simp]
protected theorem two_pow_pred_sub_two_pow' {w : Nat} (h : 0 < w) :
(2 : Int) ^ (w - 1) - (2 : Int) ^ w = - (2 : Int) ^ (w - 1) := by
norm_cast
rw [ Nat.two_pow_pred_add_two_pow_pred h]
simp [h]
end Int

View File

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

View File

@@ -73,7 +73,7 @@ theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (l H)
· simp only [*, pmap, map]
theorem pmap_map {p : β Prop} (g : b, p b γ) (f : α β) (l H) :
pmap g (map f l) H = pmap (fun a h => g (f a) h) l fun _ h => H _ (mem_map_of_mem _ h) := by
pmap g (map f l) H = pmap (fun a h => g (f a) h) l fun a h => H _ (mem_map_of_mem _ h) := by
induction l
· rfl
· simp only [*, pmap, map]
@@ -84,7 +84,7 @@ theorem attach_congr {l₁ l₂ : List α} (h : l₁ = l₂) :
simp
theorem attachWith_congr {l₁ l₂ : List α} (w : l₁ = l₂) {P : α Prop} {H : x l₁, P x} :
l₁.attachWith P H = l₂.attachWith P fun _ h => H _ (w h) := by
l₁.attachWith P H = l₂.attachWith P fun x h => H _ (w h) := by
subst w
simp
@@ -353,7 +353,7 @@ theorem attach_map {l : List α} (f : α → β) :
induction l <;> simp [*]
theorem attachWith_map {l : List α} (f : α β) {P : β Prop} {H : (b : β), b l.map f P b} :
(l.map f).attachWith P H = (l.attachWith (P f) (fun _ h => H _ (mem_map_of_mem f h))).map
(l.map f).attachWith P H = (l.attachWith (P f) (fun a h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
induction l <;> simp [*]
@@ -548,133 +548,4 @@ theorem count_attachWith [DecidableEq α] {p : α → Prop} (l : List α) (H :
(l.attachWith p H).count a = l.count a :=
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attachWith _ _ _
/-! ## unattach
`List.unattach` is the (one-sided) inverse of `List.attach`. It is a synonym for `List.map Subtype.val`.
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
functions applied to `l : List { x // p x }` which only depend on the value, not the predicate, and rewrite these
in terms of a simpler function applied to `l.unattach`.
Further, we provide simp lemmas that push `unattach` inwards.
-/
/--
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
It is introduced as an intermediate step by lemmas such as `map_subtype`,
and is ideally subsequently simplified away by `unattach_attach`.
If not, usually the right approach is `simp [List.unattach, -List.map_subtype]` to unfold.
-/
def unattach {α : Type _} {p : α Prop} (l : List { x // p x }) := l.map (·.val)
@[simp] theorem unattach_nil {p : α Prop} : ([] : List { x // p x }).unattach = [] := rfl
@[simp] theorem unattach_cons {p : α Prop} {a : { x // p x }} {l : List { x // p x }} :
(a :: l).unattach = a.val :: l.unattach := rfl
@[simp] theorem length_unattach {p : α Prop} {l : List { x // p x }} :
l.unattach.length = l.length := by
unfold unattach
simp
@[simp] theorem unattach_attach {l : List α} : l.attach.unattach = l := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, Function.comp_def]
@[simp] theorem unattach_attachWith {p : α Prop} {l : List α}
{H : a l, p a} :
(l.attachWith p H).unattach = l := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, Function.comp_def]
/-! ### Recognizing higher order functions on subtypes using a function that only depends on the value. -/
/--
This lemma identifies folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldl_subtype {p : α Prop} {l : List { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
l.foldl f x = l.unattach.foldl g x := by
unfold unattach
induction l generalizing x with
| nil => simp
| cons a l ih => simp [ih, hf]
/--
This lemma identifies folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldr_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
l.foldr f x = l.unattach.foldr g x := by
unfold unattach
induction l generalizing x with
| nil => simp
| cons a l ih => simp [ih, hf]
/--
This lemma identifies maps over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
l.map f = l.unattach.map g := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, hf]
@[simp] theorem filterMap_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
l.filterMap f = l.unattach.filterMap g := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, hf, filterMap_cons]
@[simp] theorem bind_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } List β} {g : α List β} {hf : x h, f x, h = g x} :
(l.bind f) = l.unattach.bind g := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, hf]
@[simp] theorem unattach_filter {p : α Prop} {l : List { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(l.filter f).unattach = l.unattach.filter g := by
induction l with
| nil => simp
| cons a l ih =>
simp only [filter_cons, hf, unattach_cons]
split <;> simp [ih]
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem unattach_reverse {p : α Prop} {l : List { x // p x }} :
l.reverse.unattach = l.unattach.reverse := by
simp [unattach, -map_subtype]
@[simp] theorem unattach_append {p : α Prop} {l₁ l₂ : List { x // p x }} :
(l₁ ++ l₂).unattach = l₁.unattach ++ l₂.unattach := by
simp [unattach, -map_subtype]
@[simp] theorem unattach_flatten {p : α Prop} {l : List (List { x // p x })} :
l.flatten.unattach = (l.map unattach).flatten := by
unfold unattach
induction l <;> simp_all
@[deprecated unattach_flatten (since := "2024-10-14")] abbrev unattach_join := @unattach_flatten
@[simp] theorem unattach_replicate {p : α Prop} {n : Nat} {x : { x // p x }} :
(List.replicate n x).unattach = List.replicate n x.1 := by
simp [unattach, -map_subtype]
end List

View File

@@ -29,10 +29,9 @@ The operations are organized as follow:
* Lexicographic ordering: `lt`, `le`, and instances.
* Head and tail operators: `head`, `head?`, `headD?`, `tail`, `tail?`, `tailD`.
* Basic operations:
`map`, `filter`, `filterMap`, `foldr`, `append`, `flatten`, `pure`, `bind`, `replicate`, and
`map`, `filter`, `filterMap`, `foldr`, `append`, `join`, `pure`, `bind`, `replicate`, and
`reverse`.
* Additional functions defined in terms of these: `leftpad`, `rightPad`, and `reduceOption`.
* Operations using indexes: `mapIdx`.
* List membership: `isEmpty`, `elem`, `contains`, `mem` (and the `∈` notation),
and decidability for predicates quantifying over membership in a `List`.
* Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
@@ -44,7 +43,7 @@ The operations are organized as follow:
* Logic: `any`, `all`, `or`, and `and`.
* Zippers: `zipWith`, `zip`, `zipWithAll`, and `unzip`.
* Ranges and enumeration: `range`, `iota`, `enumFrom`, and `enum`.
* Minima and maxima: `min?` and `max?`.
* Minima and maxima: `minimum?` and `maximum?`.
* Other functions: `intersperse`, `intercalate`, `eraseDups`, `eraseReps`, `span`, `groupBy`,
`removeAll`
(currently these functions are mostly only used in meta code,
@@ -219,8 +218,8 @@ def get? : (as : List α) → (i : Nat) → Option α
theorem ext_get? : {l₁ l₂ : List α}, ( n, l₁.get? n = l₂.get? n) l₁ = l₂
| [], [], _ => rfl
| _ :: _, [], h => nomatch h 0
| [], _ :: _, h => nomatch h 0
| a :: l₁, [], h => nomatch h 0
| [], a' :: l₂, h => nomatch h 0
| a :: l₁, a' :: l₂, h => by
have h0 : some a = some a' := h 0
injection h0 with aa; simp only [aa, ext_get? fun n => h (n+1)]
@@ -369,7 +368,7 @@ def tailD (list fallback : List α) : List α :=
/-! ## Basic `List` operations.
We define the basic functional programming operations on `List`:
`map`, `filter`, `filterMap`, `foldr`, `append`, `flatten`, `pure`, `bind`, `replicate`, and `reverse`.
`map`, `filter`, `filterMap`, `foldr`, `append`, `join`, `pure`, `bind`, `replicate`, and `reverse`.
-/
/-! ### map -/
@@ -543,20 +542,18 @@ theorem reverseAux_eq_append (as bs : List α) : reverseAux as bs = reverseAux a
simp [reverse, reverseAux]
rw [ reverseAux_eq_append]
/-! ### flatten -/
/-! ### join -/
/--
`O(|flatten L|)`. `join L` concatenates all the lists in `L` into one list.
* `flatten [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
`O(|join L|)`. `join L` concatenates all the lists in `L` into one list.
* `join [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
-/
def flatten : List (List α) List α
def join : List (List α) List α
| [] => []
| a :: as => a ++ flatten as
| a :: as => a ++ join as
@[simp] theorem flatten_nil : List.flatten ([] : List (List α)) = [] := rfl
@[simp] theorem flatten_cons : (l :: ls).flatten = l ++ ls.flatten := rfl
@[deprecated flatten (since := "2024-10-14"), inherit_doc flatten] abbrev join := @flatten
@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl
@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl
/-! ### pure -/
@@ -570,11 +567,11 @@ def flatten : List (List α) → List α
to get a list of lists, and then concatenates them all together.
* `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
-/
@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α List β) : List β := flatten (map b a)
@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α List β) : List β := join (map b a)
@[simp] theorem bind_nil (f : α List β) : List.bind [] f = [] := by simp [flatten, List.bind]
@[simp] theorem bind_nil (f : α List β) : List.bind [] f = [] := by simp [join, List.bind]
@[simp] theorem bind_cons x xs (f : α List β) :
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [flatten, List.bind]
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind]
set_option linter.missingDocs false in
@[deprecated bind_nil (since := "2024-06-15")] abbrev nil_bind := @bind_nil
@@ -1398,17 +1395,8 @@ def unzip : List (α × β) → List α × List β
/-! ## Ranges and enumeration -/
/-- Sum of a list.
`List.sum [a, b, c] = a + (b + (c + 0))` -/
def sum {α} [Add α] [Zero α] : List α α :=
foldr (· + ·) 0
@[simp] theorem sum_nil [Add α] [Zero α] : ([] : List α).sum = 0 := rfl
@[simp] theorem sum_cons [Add α] [Zero α] {a : α} {l : List α} : (a::l).sum = a + l.sum := rfl
/-- Sum of a list of natural numbers. -/
-- We intend to subsequently deprecate this in favor of `List.sum`.
-- This is not in the `List` namespace as later `List.sum` will be defined polymorphically.
protected def _root_.Nat.sum (l : List Nat) : Nat := l.foldr (·+·) 0
@[simp] theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
@@ -1476,34 +1464,30 @@ def enum : List α → List (Nat × α) := enumFrom 0
/-! ## Minima and maxima -/
/-! ### min? -/
/-! ### minimum? -/
/--
Returns the smallest element of the list, if it is not empty.
* `[].min? = none`
* `[4].min? = some 4`
* `[1, 4, 2, 10, 6].min? = some 1`
* `[].minimum? = none`
* `[4].minimum? = some 4`
* `[1, 4, 2, 10, 6].minimum? = some 1`
-/
def min? [Min α] : List α Option α
def minimum? [Min α] : List α Option α
| [] => none
| a::as => some <| as.foldl min a
@[inherit_doc min?, deprecated min? (since := "2024-09-29")] abbrev minimum? := @min?
/-! ### max? -/
/-! ### maximum? -/
/--
Returns the largest element of the list, if it is not empty.
* `[].max? = none`
* `[4].max? = some 4`
* `[1, 4, 2, 10, 6].max? = some 10`
* `[].maximum? = none`
* `[4].maximum? = some 4`
* `[1, 4, 2, 10, 6].maximum? = some 10`
-/
def max? [Max α] : List α Option α
def maximum? [Max α] : List α Option α
| [] => none
| a::as => some <| as.foldl max a
@[inherit_doc max?, deprecated max? (since := "2024-09-29")] abbrev maximum? := @max?
/-! ## Other list operations
The functions are currently mostly used in meta code,
@@ -1539,7 +1523,7 @@ def intersperse (sep : α) : List α → List α
* `intercalate sep [a, b, c] = a ++ sep ++ b ++ sep ++ c`
-/
def intercalate (sep : List α) (xs : List (List α)) : List α :=
(intersperse sep xs).flatten
join (intersperse sep xs)
/-! ### eraseDups -/

View File

@@ -235,8 +235,8 @@ theorem sizeOf_get [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.g
theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : α α Prop)] {as bs : List α} (h₁ : as bs) (h₂ : bs as) : as = bs :=
match as, bs with
| [], [] => rfl
| [], _::_ => False.elim <| h₂ (List.lt.nil ..)
| _::_, [] => False.elim <| h₁ (List.lt.nil ..)
| [], b::bs => False.elim <| h₂ (List.lt.nil ..)
| a::as, [] => False.elim <| h₁ (List.lt.nil ..)
| a::as, b::bs => by
by_cases hab : a < b
· exact False.elim <| h₂ (List.lt.head _ _ hab)

View File

@@ -153,15 +153,13 @@ 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 (config := { contextual := true }) [Option.getD_eq_iff]
@[simp] theorem countP_flatten (l : List (List α)) :
countP p l.flatten = (l.map (countP p)).sum := by
simp only [countP_eq_length_filter, filter_flatten]
@[simp] theorem countP_join (l : List (List α)) :
countP p l.join = Nat.sum (l.map (countP p)) := by
simp only [countP_eq_length_filter, filter_join]
simp [countP_eq_length_filter']
@[deprecated countP_flatten (since := "2024-10-14")] abbrev countP_join := @countP_flatten
@[simp] theorem countP_reverse (l : List α) : countP p l.reverse = countP p l := by
simp [countP_eq_length_filter, filter_reverse]
@@ -232,10 +230,8 @@ theorem count_singleton (a b : α) : count a [b] = if b == a then 1 else 0 := by
@[simp] theorem count_append (a : α) : l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
countP_append _
theorem count_flatten (a : α) (l : List (List α)) : count a l.flatten = (l.map (count a)).sum := by
simp only [count_eq_countP, countP_flatten, count_eq_countP']
@[deprecated count_flatten (since := "2024-10-14")] abbrev count_join := @count_flatten
theorem count_join (a : α) (l : List (List α)) : count a l.join = Nat.sum (l.map (count a)) := by
simp only [count_eq_countP, countP_join, count_eq_countP']
@[simp] theorem count_reverse (a : α) (l : List α) : count a l.reverse = count a l := by
simp only [count_eq_countP, countP_eq_length_filter, filter_reverse, length_reverse]

View File

@@ -52,9 +52,9 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
theorem eraseP_ne_nil {xs : List α} {p : α Bool} : xs.eraseP p [] xs [] x, p x xs [x] := by
simp
theorem exists_of_eraseP : {l : List α} {a} (_ : a l) (_ : p a),
theorem exists_of_eraseP : {l : List α} {a} (al : a l) (pa : p a),
a l₁ l₂, ( b l₁, ¬p b) p a l = l₁ ++ a :: l₂ l.eraseP p = l₁ ++ l₂
| b :: l, _, al, pa =>
| b :: l, a, al, pa =>
if pb : p b then
b, [], l, forall_mem_nil _, pb, by simp [pb]
else
@@ -168,8 +168,8 @@ theorem eraseP_append_left {a : α} (pa : p a) :
theorem eraseP_append_right :
{l₁ : List α} l₂, ( b l₁, ¬p b) eraseP p (l₁++l₂) = l₁ ++ l₂.eraseP p
| [], _, _ => rfl
| _ :: _, _, h => by
| [], l₂, _ => rfl
| x :: xs, l₂, h => by
simp [(forall_mem_cons.1 h).1, eraseP_append_right _ (forall_mem_cons.1 h).2]
theorem eraseP_append (l₁ l₂ : List α) :

View File

@@ -132,14 +132,14 @@ theorem findSome?_append {l₁ l₂ : List α} : (l₁ ++ l₂).findSome? f = (l
simp only [cons_append, findSome?]
split <;> simp_all
theorem head_flatten {L : List (List α)} (h : l, l L l []) :
(flatten L).head (by simpa using h) = (L.findSome? fun l => l.head?).get (by simpa using h) := by
simp [head_eq_iff_head?_eq_some, head?_flatten]
theorem head_join {L : List (List α)} (h : l, l L l []) :
(join L).head (by simpa using h) = (L.findSome? fun l => l.head?).get (by simpa using h) := by
simp [head_eq_iff_head?_eq_some, head?_join]
theorem getLast_flatten {L : List (List α)} (h : l, l L l []) :
(flatten L).getLast (by simpa using h) =
theorem getLast_join {L : List (List α)} (h : l, l L l []) :
(join L).getLast (by simpa using h) =
(L.reverse.findSome? fun l => l.getLast?).get (by simpa using h) := by
simp [getLast_eq_iff_getLast_eq_some, getLast?_flatten]
simp [getLast_eq_iff_getLast_eq_some, getLast?_join]
theorem findSome?_replicate : findSome? f (replicate n a) = if n = 0 then none else f a := by
cases n with
@@ -326,35 +326,35 @@ theorem get_find?_mem (xs : List α) (p : α → Bool) (h) : (xs.find? p).get h
simp only [cons_append, find?]
by_cases h : p x <;> simp [h, ih]
@[simp] theorem find?_flatten (xs : List (List α)) (p : α Bool) :
xs.flatten.find? p = xs.findSome? (·.find? p) := by
@[simp] theorem find?_join (xs : List (List α)) (p : α Bool) :
xs.join.find? p = xs.findSome? (·.find? p) := by
induction xs with
| nil => simp
| cons x xs ih =>
simp only [flatten_cons, find?_append, findSome?_cons, ih]
simp only [join_cons, find?_append, findSome?_cons, ih]
split <;> simp [*]
theorem find?_flatten_eq_none {xs : List (List α)} {p : α Bool} :
xs.flatten.find? p = none ys xs, x ys, !p x := by
theorem find?_join_eq_none {xs : List (List α)} {p : α Bool} :
xs.join.find? p = none ys xs, x ys, !p x := by
simp
/--
If `find? p` returns `some a` from `xs.flatten`, then `p a` holds, and
If `find? p` returns `some a` from `xs.join`, then `p a` holds, and
some list in `xs` contains `a`, and no earlier element of that list satisfies `p`.
Moreover, no earlier list in `xs` has an element satisfying `p`.
-/
theorem find?_flatten_eq_some {xs : List (List α)} {p : α Bool} {a : α} :
xs.flatten.find? p = some a
theorem find?_join_eq_some {xs : List (List α)} {p : α Bool} {a : α} :
xs.join.find? p = some a
p a as ys zs bs, xs = as ++ (ys ++ a :: zs) :: bs
( a as, x a, !p x) ( x ys, !p x) := by
rw [find?_eq_some]
constructor
· rintro h, ys, zs, h₁, h₂
refine h, ?_
rw [flatten_eq_append_iff] at h₁
rw [join_eq_append_iff] at h₁
obtain (as, bs, rfl, rfl, h₁ | as, bs, c, cs, ds, rfl, rfl, h₁) := h₁
· replace h₁ := h₁.symm
rw [flatten_eq_cons_iff] at h₁
rw [join_eq_cons_iff] at h₁
obtain bs, cs, ds, rfl, h₁, rfl := h₁
refine as ++ bs, [], cs, ds, by simp, ?_
simp
@@ -371,7 +371,7 @@ theorem find?_flatten_eq_some {xs : List (List α)} {p : α → Bool} {a : α} :
· intro x m
simpa using h₂ x (by simpa using .inr m)
· rintro h, as, ys, zs, bs, rfl, h₁, h₂
refine h, as.flatten ++ ys, zs ++ bs.flatten, by simp, ?_
refine h, as.join ++ ys, zs ++ bs.join, by simp, ?_
intro a m
simp at m
obtain l, ml, m | m := m
@@ -786,15 +786,15 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
induction xs with simp
| cons _ _ _ => split <;> simp_all [Option.map_or', Option.map_map]; rfl
theorem findIdx?_flatten {l : List (List α)} {p : α Bool} :
l.flatten.findIdx? p =
theorem findIdx?_join {l : List (List α)} {p : α Bool} :
l.join.findIdx? p =
(l.findIdx? (·.any p)).map
fun i => ((l.take i).map List.length).sum +
fun i => Nat.sum ((l.take i).map List.length) +
(l[i]?.map fun xs => xs.findIdx p).getD 0 := by
induction l with
| nil => simp
| cons xs l ih =>
simp only [flatten, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
simp only [join, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
findIdx?_succ]
split
· simp only [Option.map_some', take_zero, sum_nil, length_cons, zero_lt_succ,
@@ -976,13 +976,4 @@ theorem IsInfix.lookup_eq_none {l₁ l₂ : List (α × β)} (h : l₁ <:+: l₂
end lookup
/-! ### Deprecations -/
@[deprecated head_flatten (since := "2024-10-14")] abbrev head_join := @head_flatten
@[deprecated getLast_flatten (since := "2024-10-14")] abbrev getLast_join := @getLast_flatten
@[deprecated find?_flatten (since := "2024-10-14")] abbrev find?_join := @find?_flatten
@[deprecated find?_flatten_eq_none (since := "2024-10-14")] abbrev find?_join_eq_none := @find?_flatten_eq_none
@[deprecated find?_flatten_eq_some (since := "2024-10-14")] abbrev find?_join_eq_some := @find?_flatten_eq_some
@[deprecated findIdx?_flatten (since := "2024-10-14")] abbrev findIdx?_join := @findIdx?_flatten
end List

View File

@@ -31,7 +31,7 @@ The following operations are still missing `@[csimp]` replacements:
The following operations are not recursive to begin with
(or are defined in terms of recursive primitives):
`isEmpty`, `isSuffixOf`, `isSuffixOf?`, `rotateLeft`, `rotateRight`, `insert`, `zip`, `enum`,
`min?`, `max?`, and `removeAll`.
`minimum?`, `maximum?`, and `removeAll`.
The following operations were already given `@[csimp]` replacements in `Init/Data/List/Basic.lean`:
`length`, `map`, `filter`, `replicate`, `leftPad`, `unzip`, `range'`, `iota`, `intersperse`.
@@ -109,12 +109,12 @@ The following operations are given `@[csimp]` replacements below:
| x::xs, acc => by simp [bindTR.go, bind, go xs]
exact (go as #[]).symm
/-! ### flatten -/
/-! ### join -/
/-- Tail recursive version of `List.flatten`. -/
@[inline] def flattenTR (l : List (List α)) : List α := bindTR l id
/-- Tail recursive version of `List.join`. -/
@[inline] def joinTR (l : List (List α)) : List α := bindTR l id
@[csimp] theorem flatten_eq_flattenTR : @flatten = @flattenTR := by
@[csimp] theorem join_eq_joinTR : @join = @joinTR := by
funext α l; rw [ List.bind_id, List.bind_eq_bindTR]; rfl
/-! ## Sublists -/
@@ -322,7 +322,7 @@ where
| [_] => simp
| x::y::xs =>
let rec go {acc x} : xs,
intercalateTR.go sep.toArray x xs acc = acc.toList ++ flatten (intersperse sep (x::xs))
intercalateTR.go sep.toArray x xs acc = acc.toList ++ join (intersperse sep (x::xs))
| [] => by simp [intercalateTR.go]
| _::_ => by simp [intercalateTR.go, go]
simp [intersperse, go]

View File

@@ -55,7 +55,7 @@ See also
* `Init.Data.List.Erase` for lemmas about `List.eraseP` and `List.erase`.
* `Init.Data.List.Find` for lemmas about `List.find?`, `List.findSome?`, `List.findIdx`,
`List.findIdx?`, and `List.indexOf`
* `Init.Data.List.MinMax` for lemmas about `List.min?` and `List.max?`.
* `Init.Data.List.MinMax` for lemmas about `List.minimum?` and `List.maximum?`.
* `Init.Data.List.Pairwise` for lemmas about `List.Pairwise` and `List.Nodup`.
* `Init.Data.List.Sublist` for lemmas about `List.Subset`, `List.Sublist`, `List.IsPrefix`,
`List.IsSuffix`, and `List.IsInfix`.
@@ -191,7 +191,7 @@ theorem get?_eq_some : l.get? n = some a ↔ ∃ h, get l ⟨n, h⟩ = a :=
fun e =>
have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn e
this, by rwa [get?_eq_get this, Option.some.injEq] at e,
fun _, e => e get?_eq_get _
fun h, e => e get?_eq_get _
theorem get?_eq_none : l.get? n = none length l n :=
fun e => Nat.ge_of_not_lt (fun h' => by cases e get?_eq_some.2 h', rfl), get?_len_le
@@ -203,9 +203,6 @@ theorem get?_eq_none : l.get? n = none ↔ length l ≤ n :=
@[simp] theorem get_eq_getElem (l : List α) (i : Fin l.length) : l.get i = l[i.1]'i.2 := rfl
theorem getElem?_eq_some {l : List α} : l[i]? = some a h : i < l.length, l[i]'h = a := by
simpa using get?_eq_some
/--
If one has `l.get i` in an expression (with `i : Fin l.length`) and `h : l = l'`,
`rw [h]` will give a "motive it not type correct" error, as it cannot rewrite the
@@ -492,7 +489,7 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n : Nat, l[n]? = s
theorem get?_of_mem {a} {l : List α} (h : a l) : n, l.get? n = some a :=
let n, _, e := get_of_mem h; n, e get?_eq_get _
@[simp] theorem getElem_mem : {l : List α} {n} (h : n < l.length), l[n]'h l
theorem getElem_mem : {l : List α} {n} (h : n < l.length), l[n]'h l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (getElem_mem (l := l) ..)
@@ -718,9 +715,9 @@ theorem set_eq_of_length_le {l : List α} {n : Nat} (h : l.length ≤ n) {a : α
theorem set_comm (a b : α) : {n m : Nat} (l : List α), n m
(l.set n a).set m b = (l.set m b).set n a
| _, _, [], _ => by simp
| _+1, 0, _ :: _, _ => by simp [set]
| 0, _+1, _ :: _, _ => by simp [set]
| _+1, _+1, _ :: t, h =>
| n+1, 0, _ :: _, _ => by simp [set]
| 0, m+1, _ :: _, _ => by simp [set]
| n+1, m+1, x :: t, h =>
congrArg _ <| set_comm a b t fun h' => h <| Nat.succ_inj'.mpr h'
@[simp]
@@ -881,20 +878,6 @@ theorem foldr_map' {α β : Type u} (g : α → β) (f : ααα) (f' :
· simp
· simp [*, h]
theorem foldl_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldl op (op a₁ a₂) = op a₁ (l.foldl op a₂)
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldl_cons, ha.assoc]
rw [foldl_assoc]
theorem foldr_assoc {op : α α α} [ha : Std.Associative op] :
{l : List α} {a₁ a₂}, l.foldr op (op a₁ a₂) = op (l.foldr op a₁) a₂
| [], a₁, a₂ => rfl
| a :: l, a₁, a₂ => by
simp only [foldr_cons, ha.assoc]
rw [foldr_assoc]
theorem foldl_hom (f : α₁ α₂) (g₁ : α₁ β α₁) (g₂ : α₂ β α₂) (l : List β) (init : α₁)
(H : x y, g₂ (f x) y = f (g₁ x y)) : l.foldl g₂ (f init) = f (l.foldl g₁ init) := by
induction l generalizing init <;> simp [*, H]
@@ -994,8 +977,8 @@ theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
match l with
| [] => contradiction
| a :: l => exact Nat.le_refl _)
| [_], _ => rfl
| _ :: _ :: _, _ => by
| [a], h => rfl
| a :: b :: l, h => by
simp [getLast, get, Nat.succ_sub_succ, getLast_eq_getElem]
@[deprecated getLast_eq_getElem (since := "2024-07-15")]
@@ -1021,14 +1004,14 @@ theorem getLast_eq_getLastD (a l h) : @getLast α (a::l) h = getLastD l a := by
theorem getLast!_cons [Inhabited α] : @getLast! α _ (a::l) = getLastD l a := by
simp [getLast!, getLast_eq_getLastD]
@[simp] theorem getLast_mem : {l : List α} (h : l []), getLast l h l
theorem getLast_mem : {l : List α} (h : l []), getLast l h l
| [], h => absurd rfl h
| [_], _ => .head ..
| _::a::l, _ => .tail _ <| getLast_mem (cons_ne_nil a l)
theorem getLast_mem_getLast? : {l : List α} (h : l []), getLast l h getLast? l
| [], h => by contradiction
| _ :: _, _ => rfl
| a :: l, _ => rfl
theorem getLastD_mem_cons : (l : List α) (a : α), getLastD l a a::l
| [], _ => .head ..
@@ -1119,7 +1102,7 @@ theorem head?_eq_some_iff {xs : List α} {a : α} : xs.head? = some a ↔ ∃ ys
@[simp] theorem head?_isSome : l.head?.isSome l [] := by
cases l <;> simp
@[simp] theorem head_mem : {l : List α} (h : l []), head l h l
theorem head_mem : {l : List α} (h : l []), head l h l
| [], h => absurd rfl h
| _::_, _ => .head ..
@@ -1134,7 +1117,7 @@ theorem mem_of_mem_head? : ∀ {l : List α} {a : α}, a ∈ l.head? → a ∈ l
theorem head_mem_head? : {l : List α} (h : l []), head l h head? l
| [], h => by contradiction
| _ :: _, _ => rfl
| a :: l, _ => rfl
theorem head?_concat {a : α} : (l ++ [a]).head? = l.head?.getD a := by
cases l <;> simp
@@ -1343,12 +1326,12 @@ theorem set_map {f : α → β} {l : List α} {n : Nat} {a : α} :
simp
@[simp] theorem head_map (f : α β) (l : List α) (w) :
(map f l).head w = f (l.head (by simpa using w)) := by
head (map f l) w = f (head l (by simpa using w)) := by
cases l
· simp at w
· simp_all
@[simp] theorem head?_map (f : α β) (l : List α) : (map f l).head? = l.head?.map f := by
@[simp] theorem head?_map (f : α β) (l : List α) : head? (map f l) = (head? l).map f := by
cases l <;> rfl
@[simp] theorem map_tail? (f : α β) (l : List α) : (tail? l).map (map f) = tail? (map f l) := by
@@ -1466,7 +1449,7 @@ theorem map_filter_eq_foldr (f : α → β) (p : α → Bool) (as : List α) :
@[simp] theorem filter_append {p : α Bool} :
(l₁ l₂ : List α), filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂
| [], _ => rfl
| [], l₂ => rfl
| a :: l₁, l₂ => by simp [filter]; split <;> simp [filter_append l₁]
theorem filter_eq_cons_iff {l} {a} {as} :
@@ -1671,11 +1654,6 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
/-! ### append -/
@[simp] theorem nil_append_fun : (([] : List α) ++ ·) = id := rfl
@[simp] theorem cons_append_fun (a : α) (as : List α) :
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
theorem getElem_append {l₁ l₂ : List α} (n : Nat) (h) :
(l₁ ++ l₂)[n] = if h' : n < l₁.length then l₁[n] else l₂[n - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
split <;> rename_i h'
@@ -1690,7 +1668,7 @@ theorem getElem?_append_left {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.leng
theorem getElem?_append_right : {l₁ l₂ : List α} {n : Nat}, l₁.length n
(l₁ ++ l₂)[n]? = l₂[n - l₁.length]?
| [], _, _, _ => rfl
| [], _, n, _ => rfl
| a :: l, _, n+1, h₁ => by
rw [cons_append]
simp [Nat.succ_sub_succ_eq_sub, getElem?_append_right (Nat.lt_succ.1 h₁)]
@@ -1755,8 +1733,8 @@ theorem append_of_mem {a : α} {l : List α} : a ∈ l → ∃ s t : List α, l
theorem append_inj :
{s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ length s₁ = length s₂ s₁ = s₂ t₁ = t₂
| [], [], _, _, h, _ => rfl, h
| _ :: _, _ :: _, _, _, h, hl => by
| [], [], t₁, t₂, h, _ => rfl, h
| a :: s₁, b :: s₂, t₁, t₂, h, hl => by
simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ; exact h
theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ :=
@@ -2068,97 +2046,106 @@ theorem eq_nil_or_concat : ∀ l : List α, l = [] ∃ L b, l = concat L b
| _, .inl rfl => .inr [], a, rfl
| _, .inr L, b, rfl => .inr a::L, b, rfl
/-! ### flatten -/
/-! ### join -/
@[simp] theorem length_flatten (L : List (List α)) : (flatten L).length = (L.map length).sum := by
@[simp] theorem length_join (L : List (List α)) : (join L).length = Nat.sum (L.map length) := by
induction L with
| nil => rfl
| cons =>
simp [flatten, length_append, *]
simp [join, length_append, *]
theorem flatten_singleton (l : List α) : [l].flatten = l := by simp
theorem join_singleton (l : List α) : [l].join = l := by simp
@[simp] theorem mem_flatten : {L : List (List α)}, a L.flatten l, l L a l
@[simp] theorem mem_join : {L : List (List α)}, a L.join l, l L a l
| [] => by simp
| b :: l => by simp [mem_flatten, or_and_right, exists_or]
| b :: l => by simp [mem_join, or_and_right, exists_or]
@[simp] theorem flatten_eq_nil_iff {L : List (List α)} : L.flatten = [] l L, l = [] := by
@[simp] theorem join_eq_nil_iff {L : List (List α)} : L.join = [] l L, l = [] := by
induction L <;> simp_all
theorem flatten_ne_nil_iff {xs : List (List α)} : xs.flatten [] x, x xs x [] := by
@[deprecated join_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @join_eq_nil_iff
theorem join_ne_nil_iff {xs : List (List α)} : xs.join [] x, x xs x [] := by
simp
theorem exists_of_mem_flatten : a flatten L l, l L a l := mem_flatten.1
@[deprecated join_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @join_ne_nil_iff
theorem mem_flatten_of_mem (lL : l L) (al : a l) : a flatten L := mem_flatten.2 l, lL, al
theorem exists_of_mem_join : a join L l, l L a l := mem_join.1
theorem forall_mem_flatten {p : α Prop} {L : List (List α)} :
( (x) (_ : x flatten L), p x) (l) (_ : l L) (x) (_ : x l), p x := by
simp only [mem_flatten, forall_exists_index, and_imp]
theorem mem_join_of_mem (lL : l L) (al : a l) : a join L := mem_join.2 l, lL, al
theorem forall_mem_join {p : α Prop} {L : List (List α)} :
( (x) (_ : x join L), p x) (l) (_ : l L) (x) (_ : x l), p x := by
simp only [mem_join, forall_exists_index, and_imp]
constructor <;> (intros; solve_by_elim)
theorem flatten_eq_bind {L : List (List α)} : flatten L = L.bind id := by
theorem join_eq_bind {L : List (List α)} : join L = L.bind id := by
induction L <;> simp [List.bind]
theorem head?_flatten {L : List (List α)} : (flatten L).head? = L.findSome? fun l => l.head? := by
theorem head?_join {L : List (List α)} : (join L).head? = L.findSome? fun l => l.head? := by
induction L with
| nil => rfl
| cons =>
simp only [findSome?_cons]
split <;> simp_all
-- `getLast?_flatten` is proved later, after the `reverse` section.
-- `head_flatten` and `getLast_flatten` are proved in `Init.Data.List.Find`.
-- `getLast?_join` is proved later, after the `reverse` section.
-- `head_join` and `getLast_join` are proved in `Init.Data.List.Find`.
theorem foldl_flatten (f : β α β) (b : β) (L : List (List α)) :
(flatten L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
theorem foldl_join (f : β α β) (b : β) (L : List (List α)) :
(join L).foldl f b = L.foldl (fun b l => l.foldl f b) b := by
induction L generalizing b <;> simp_all
theorem foldr_flatten (f : α β β) (b : β) (L : List (List α)) :
(flatten L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
theorem foldr_join (f : α β β) (b : β) (L : List (List α)) :
(join L).foldr f b = L.foldr (fun l b => l.foldr f b) b := by
induction L <;> simp_all
@[simp] theorem map_flatten (f : α β) (L : List (List α)) : map f (flatten L) = flatten (map (map f) L) := by
@[simp] theorem map_join (f : α β) (L : List (List α)) : map f (join L) = join (map (map f) L) := by
induction L <;> simp_all
@[simp] theorem filterMap_flatten (f : α Option β) (L : List (List α)) :
filterMap f (flatten L) = flatten (map (filterMap f) L) := by
@[simp] theorem filterMap_join (f : α Option β) (L : List (List α)) :
filterMap f (join L) = join (map (filterMap f) L) := by
induction L <;> simp [*, filterMap_append]
@[simp] theorem filter_flatten (p : α Bool) (L : List (List α)) :
filter p (flatten L) = flatten (map (filter p) L) := by
@[simp] theorem filter_join (p : α Bool) (L : List (List α)) :
filter p (join L) = join (map (filter p) L) := by
induction L <;> simp [*, filter_append]
theorem flatten_filter_not_isEmpty :
{L : List (List α)}, flatten (L.filter fun l => !l.isEmpty) = L.flatten
theorem join_filter_not_isEmpty :
{L : List (List α)}, join (L.filter fun l => !l.isEmpty) = L.join
| [] => rfl
| [] :: L
| (a :: l) :: L => by
simp [flatten_filter_not_isEmpty (L := L)]
simp [join_filter_not_isEmpty (L := L)]
theorem flatten_filter_ne_nil [DecidablePred fun l : List α => l []] {L : List (List α)} :
flatten (L.filter fun l => l []) = L.flatten := by
theorem join_filter_ne_nil [DecidablePred fun l : List α => l []] {L : List (List α)} :
join (L.filter fun l => l []) = L.join := by
simp only [ne_eq, isEmpty_iff, Bool.not_eq_true, Bool.decide_eq_false,
flatten_filter_not_isEmpty]
join_filter_not_isEmpty]
@[simp] theorem flatten_append (L₁ L₂ : List (List α)) : flatten (L₁ ++ L₂) = flatten L₁ ++ flatten L₂ := by
@[deprecated filter_join (since := "2024-08-26")]
theorem join_map_filter (p : α Bool) (l : List (List α)) :
(l.map (filter p)).join = (l.join).filter p := by
rw [filter_join]
@[simp] theorem join_append (L₁ L₂ : List (List α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ := by
induction L₁ <;> simp_all
theorem flatten_concat (L : List (List α)) (l : List α) : flatten (L ++ [l]) = flatten L ++ l := by
theorem join_concat (L : List (List α)) (l : List α) : join (L ++ [l]) = join L ++ l := by
simp
theorem flatten_flatten {L : List (List (List α))} : flatten (flatten L) = flatten (map flatten L) := by
theorem join_join {L : List (List (List α))} : join (join L) = join (map join L) := by
induction L <;> simp_all
theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
xs.flatten = y :: ys
as bs cs, xs = as ++ (y :: bs) :: cs ( l, l as l = []) ys = bs ++ cs.flatten := by
theorem join_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
xs.join = y :: ys
as bs cs, xs = as ++ (y :: bs) :: cs ( l, l as l = []) ys = bs ++ cs.join := by
constructor
· induction xs with
| nil => simp
| cons x xs ih =>
intro h
simp only [flatten_cons] at h
simp only [join_cons] at h
replace h := h.symm
rw [cons_eq_append_iff] at h
obtain (rfl, h | z) := h
@@ -2169,23 +2156,23 @@ theorem flatten_eq_cons_iff {xs : List (List α)} {y : α} {ys : List α} :
refine [], a', xs, ?_
simp
· rintro as, bs, cs, rfl, h₁, rfl
simp [flatten_eq_nil_iff.mpr h₁]
simp [join_eq_nil_iff.mpr h₁]
theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
xs.flatten = ys ++ zs
( as bs, xs = as ++ bs ys = as.flatten zs = bs.flatten)
as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ys = as.flatten ++ bs
zs = c :: cs ++ ds.flatten := by
theorem join_eq_append_iff {xs : List (List α)} {ys zs : List α} :
xs.join = ys ++ zs
( as bs, xs = as ++ bs ys = as.join zs = bs.join)
as bs c cs ds, xs = as ++ (bs ++ c :: cs) :: ds ys = as.join ++ bs
zs = c :: cs ++ ds.join := by
constructor
· induction xs generalizing ys with
| nil =>
simp only [flatten_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
simp only [join_nil, nil_eq, append_eq_nil, and_false, cons_append, false_and, exists_const,
exists_false, or_false, and_imp, List.cons_ne_nil]
rintro rfl rfl
exact [], [], by simp
| cons x xs ih =>
intro h
simp only [flatten_cons] at h
simp only [join_cons] at h
rw [append_eq_append_iff] at h
obtain (ys, rfl, h | c', rfl, h) := h
· obtain (as, bs, rfl, rfl, rfl | as, bs, c, cs, ds, rfl, rfl, rfl) := ih h
@@ -2199,15 +2186,18 @@ theorem flatten_eq_append_iff {xs : List (List α)} {ys zs : List α} :
· simp
· simp
/-- Two lists of sublists are equal iff their flattens coincide, as well as the lengths of the
@[deprecated join_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @join_eq_cons_iff
@[deprecated join_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @join_eq_append_iff
/-- Two lists of sublists are equal iff their joins coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_flatten_eq : {L L' : List (List α)},
L = L' L.flatten = L'.flatten map length L = map length L'
theorem eq_iff_join_eq : {L L' : List (List α)},
L = L' L.join = L'.join map length L = map length L'
| _, [] => by simp_all
| [], x' :: L' => by simp_all
| x :: L, x' :: L' => by
simp
rw [eq_iff_flatten_eq]
rw [eq_iff_join_eq]
constructor
· rintro rfl, h₁, h₂
simp_all
@@ -2217,12 +2207,12 @@ theorem eq_iff_flatten_eq : ∀ {L L' : List (List α)},
/-! ### bind -/
theorem bind_def (l : List α) (f : α List β) : l.bind f = flatten (map f l) := by rfl
theorem bind_def (l : List α) (f : α List β) : l.bind f = join (map f l) := by rfl
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.flatten := by simp [bind_def]
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [bind_def]
@[simp] theorem mem_bind {f : α List β} {b} {l : List α} : b l.bind f a, a l b f a := by
simp [bind_def, mem_flatten]
simp [bind_def, mem_join]
exact fun _, a, h₁, rfl, h₂ => a, h₁, h₂, fun a, h₁, h₂ => _, a, h₁, rfl, h₂
theorem exists_of_mem_bind {b : β} {l : List α} {f : α List β} :
@@ -2233,7 +2223,7 @@ theorem mem_bind_of_mem {b : β} {l : List α} {f : α → List β} {a} (al : a
@[simp]
theorem bind_eq_nil_iff {l : List α} {f : α List β} : List.bind l f = [] x l, f x = [] :=
flatten_eq_nil_iff.trans <| by
join_eq_nil_iff.trans <| by
simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
@[deprecated bind_eq_nil_iff (since := "2024-09-05")] abbrev bind_eq_nil := @bind_eq_nil_iff
@@ -2397,21 +2387,11 @@ theorem map_eq_replicate_iff {l : List α} {f : α → β} {b : β} :
@[simp] theorem map_const (l : List α) (b : β) : map (Function.const α b) l = replicate l.length b :=
map_eq_replicate_iff.mpr fun _ _ => rfl
@[simp] theorem map_const_fun (x : β) : map (Function.const α x) = (replicate ·.length x) := by
funext l
simp
/-- Variant of `map_const` using a lambda rather than `Function.const`. -/
-- This can not be a `@[simp]` lemma because it would fire on every `List.map`.
theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.length b :=
map_const l b
@[simp] theorem set_replicate_self : (replicate n a).set i a = replicate n a := by
apply ext_getElem
· simp
· intro i h₁ h₂
simp [getElem_set]
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
rw [eq_replicate_iff]
constructor
@@ -2471,23 +2451,23 @@ theorem filterMap_replicate_of_some {f : α → Option β} (h : f a = some b) :
(replicate n a).filterMap f = [] := by
simp [filterMap_replicate, h]
@[simp] theorem flatten_replicate_nil : (replicate n ([] : List α)).flatten = [] := by
@[simp] theorem join_replicate_nil : (replicate n ([] : List α)).join = [] := by
induction n <;> simp_all [replicate_succ]
@[simp] theorem flatten_replicate_singleton : (replicate n [a]).flatten = replicate n a := by
@[simp] theorem join_replicate_singleton : (replicate n [a]).join = replicate n a := by
induction n <;> simp_all [replicate_succ]
@[simp] theorem flatten_replicate_replicate : (replicate n (replicate m a)).flatten = replicate (n * m) a := by
@[simp] theorem join_replicate_replicate : (replicate n (replicate m a)).join = replicate (n * m) a := by
induction n with
| zero => simp
| succ n ih =>
simp only [replicate_succ, flatten_cons, ih, append_replicate_replicate, replicate_inj, or_true,
simp only [replicate_succ, join_cons, ih, append_replicate_replicate, replicate_inj, or_true,
and_true, add_one_mul, Nat.add_comm]
theorem bind_replicate {β} (f : α List β) : (replicate n a).bind f = (replicate n (f a)).flatten := by
theorem bind_replicate {β} (f : α List β) : (replicate n a).bind f = (replicate n (f a)).join := by
induction n with
| zero => simp
| succ n ih => simp only [replicate_succ, bind_cons, ih, flatten_cons]
| succ n ih => simp only [replicate_succ, bind_cons, ih, join_cons]
@[simp] theorem isEmpty_replicate : (replicate n a).isEmpty = decide (n = 0) := by
cases n <;> simp [replicate_succ]
@@ -2662,14 +2642,14 @@ theorem reverse_eq_concat {xs ys : List α} {a : α} :
xs.reverse = ys ++ [a] xs = a :: ys.reverse := by
rw [reverse_eq_iff, reverse_concat]
/-- Reversing a flatten is the same as reversing the order of parts and reversing all parts. -/
theorem reverse_flatten (L : List (List α)) :
L.flatten.reverse = (L.map reverse).reverse.flatten := by
/-- Reversing a join is the same as reversing the order of parts and reversing all parts. -/
theorem reverse_join (L : List (List α)) :
L.join.reverse = (L.map reverse).reverse.join := by
induction L <;> simp_all
/-- Flattening a reverse is the same as reversing all parts and reversing the flattened result. -/
theorem flatten_reverse (L : List (List α)) :
L.reverse.flatten = (L.map reverse).flatten.reverse := by
/-- Joining a reverse is the same as reversing all parts and reversing the joined result. -/
theorem join_reverse (L : List (List α)) :
L.reverse.join = (L.map reverse).join.reverse := by
induction L <;> simp_all
theorem reverse_bind {β} (l : List α) (f : α List β) : (l.bind f).reverse = l.reverse.bind (reverse f) := by
@@ -2695,7 +2675,7 @@ theorem bind_reverse {β} (l : List α) (f : α → List β) : (l.reverse.bind f
@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a :=
eq_replicate_iff.2
by rw [length_reverse, length_replicate],
fun _ h => eq_of_mem_replicate (mem_reverse.1 h)
fun b h => eq_of_mem_replicate (mem_reverse.1 h)
/-! #### Further results about `getLast` and `getLast?` -/
@@ -2789,8 +2769,8 @@ theorem getLast?_bind {L : List α} {f : α → List β} :
rw [head?_bind]
rfl
theorem getLast?_flatten {L : List (List α)} :
(flatten L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
theorem getLast?_join {L : List (List α)} :
(join L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
simp [ bind_id, getLast?_bind]
theorem getLast?_replicate (a : α) (n : Nat) : (replicate n a).getLast? = if n = 0 then none else some a := by
@@ -2900,7 +2880,7 @@ theorem head?_dropLast (xs : List α) : xs.dropLast.head? = if 1 < xs.length the
theorem getLast_dropLast {xs : List α} (h) :
xs.dropLast.getLast h =
xs[xs.length - 2]'(match xs, h with | (_ :: _ :: _), _ => Nat.lt_trans (Nat.lt_add_one _) (Nat.lt_add_one _)) := by
xs[xs.length - 2]'(match xs, h with | (a :: b :: xs), _ => Nat.lt_trans (Nat.lt_add_one _) (Nat.lt_add_one _)) := by
rw [getLast_eq_getElem, getElem_dropLast]
congr 1
simp; rfl
@@ -2924,8 +2904,8 @@ theorem dropLast_cons_of_ne_nil {α : Type u} {x : α}
theorem dropLast_concat_getLast : {l : List α} (h : l []), dropLast l ++ [getLast l h] = l
| [], h => absurd rfl h
| [_], _ => rfl
| _ :: b :: l, _ => by
| [a], h => rfl
| a :: b :: l, h => by
rw [dropLast_cons₂, cons_append, getLast_cons (cons_ne_nil _ _)]
congr
exact dropLast_concat_getLast (cons_ne_nil b l)
@@ -3290,16 +3270,12 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
| nil => rfl
| cons h t ih => simp_all [Bool.and_assoc]
@[simp] theorem any_flatten {l : List (List α)} : l.flatten.any f = l.any (any · f) := by
@[simp] theorem any_join {l : List (List α)} : l.join.any f = l.any (any · f) := by
induction l <;> simp_all
@[deprecated any_flatten (since := "2024-10-14")] abbrev any_join := @any_flatten
@[simp] theorem all_flatten {l : List (List α)} : l.flatten.all f = l.all (all · f) := by
@[simp] theorem all_join {l : List (List α)} : l.join.all f = l.all (all · f) := by
induction l <;> simp_all
@[deprecated all_flatten (since := "2024-10-14")] abbrev all_join := @all_flatten
@[simp] theorem any_bind {l : List α} {f : α List β} :
(l.bind f).any p = l.any fun a => (f a).any p := by
induction l <;> simp_all
@@ -3330,47 +3306,4 @@ theorem all_eq_not_any_not (l : List α) (p : α → Bool) : l.all p = !l.any (!
(l.insert a).all f = (f a && l.all f) := by
simp [all_eq]
/-! ### Deprecations -/
@[deprecated flatten_nil (since := "2024-10-14")] abbrev join_nil := @flatten_nil
@[deprecated flatten_cons (since := "2024-10-14")] abbrev join_cons := @flatten_cons
@[deprecated length_flatten (since := "2024-10-14")] abbrev length_join := @length_flatten
@[deprecated flatten_singleton (since := "2024-10-14")] abbrev join_singleton := @flatten_singleton
@[deprecated mem_flatten (since := "2024-10-14")] abbrev mem_join := @mem_flatten
@[deprecated flatten_eq_nil_iff (since := "2024-09-05")] abbrev join_eq_nil := @flatten_eq_nil_iff
@[deprecated flatten_eq_nil_iff (since := "2024-10-14")] abbrev join_eq_nil_iff := @flatten_eq_nil_iff
@[deprecated flatten_ne_nil_iff (since := "2024-09-05")] abbrev join_ne_nil := @flatten_ne_nil_iff
@[deprecated flatten_ne_nil_iff (since := "2024-10-14")] abbrev join_ne_nil_iff := @flatten_ne_nil_iff
@[deprecated exists_of_mem_flatten (since := "2024-10-14")] abbrev exists_of_mem_join := @exists_of_mem_flatten
@[deprecated mem_flatten_of_mem (since := "2024-10-14")] abbrev mem_join_of_mem := @mem_flatten_of_mem
@[deprecated forall_mem_flatten (since := "2024-10-14")] abbrev forall_mem_join := @forall_mem_flatten
@[deprecated flatten_eq_bind (since := "2024-10-14")] abbrev join_eq_bind := @flatten_eq_bind
@[deprecated head?_flatten (since := "2024-10-14")] abbrev head?_join := @head?_flatten
@[deprecated foldl_flatten (since := "2024-10-14")] abbrev foldl_join := @foldl_flatten
@[deprecated foldr_flatten (since := "2024-10-14")] abbrev foldr_join := @foldr_flatten
@[deprecated map_flatten (since := "2024-10-14")] abbrev map_join := @map_flatten
@[deprecated filterMap_flatten (since := "2024-10-14")] abbrev filterMap_join := @filterMap_flatten
@[deprecated filter_flatten (since := "2024-10-14")] abbrev filter_join := @filter_flatten
@[deprecated flatten_filter_not_isEmpty (since := "2024-10-14")] abbrev join_filter_not_isEmpty := @flatten_filter_not_isEmpty
@[deprecated flatten_filter_ne_nil (since := "2024-10-14")] abbrev join_filter_ne_nil := @flatten_filter_ne_nil
@[deprecated filter_flatten (since := "2024-08-26")]
theorem join_map_filter (p : α Bool) (l : List (List α)) :
(l.map (filter p)).flatten = (l.flatten).filter p := by
rw [filter_flatten]
@[deprecated flatten_append (since := "2024-10-14")] abbrev join_append := @flatten_append
@[deprecated flatten_concat (since := "2024-10-14")] abbrev join_concat := @flatten_concat
@[deprecated flatten_flatten (since := "2024-10-14")] abbrev join_join := @flatten_flatten
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons_iff := @flatten_eq_cons_iff
@[deprecated flatten_eq_cons_iff (since := "2024-09-05")] abbrev join_eq_cons := @flatten_eq_cons_iff
@[deprecated flatten_eq_append_iff (since := "2024-09-05")] abbrev join_eq_append := @flatten_eq_append_iff
@[deprecated flatten_eq_append_iff (since := "2024-10-14")] abbrev join_eq_append_iff := @flatten_eq_append_iff
@[deprecated eq_iff_flatten_eq (since := "2024-10-14")] abbrev eq_iff_join_eq := @eq_iff_flatten_eq
@[deprecated flatten_replicate_nil (since := "2024-10-14")] abbrev join_replicate_nil := @flatten_replicate_nil
@[deprecated flatten_replicate_singleton (since := "2024-10-14")] abbrev join_replicate_singleton := @flatten_replicate_singleton
@[deprecated flatten_replicate_replicate (since := "2024-10-14")] abbrev join_replicate_replicate := @flatten_replicate_replicate
@[deprecated reverse_flatten (since := "2024-10-14")] abbrev reverse_join := @reverse_flatten
@[deprecated flatten_reverse (since := "2024-10-14")] abbrev join_reverse := @flatten_reverse
@[deprecated getLast?_flatten (since := "2024-10-14")] abbrev getLast?_join := @getLast?_flatten
end List

View File

@@ -1,248 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison, Mario Carneiro
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.Nat.Range
namespace List
/-! ## Operations using indexes -/
/-! ### mapIdx -/
/--
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
/-- Auxiliary for `mapIdx`:
`mapIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/
@[specialize] go : List α Array β List β
| [], acc => acc.toList
| a :: as, acc => go as (acc.push (f acc.size a))
@[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
| nil => simp only [mapIdx.go, length_nil, Nat.zero_add]
| 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]
| a :: l, _ => by
simp only [mapIdx.go, length_cons]
rw [length_mapIdx_go]
simp
omega
@[simp] theorem length_mapIdx {l : List α} : (l.mapIdx f).length = l.length := by
simp [mapIdx, length_mapIdx_go]
theorem getElem?_mapIdx_go : {l : List α} {arr : Array β} {i : Nat},
(mapIdx.go f l arr)[i]? =
if h : i < arr.size then some arr[i] else Option.map (f i) l[i - arr.size]?
| [], arr, i => by
simp only [mapIdx.go, Array.toListImpl_eq, getElem?_eq, Array.length_toList,
Array.getElem_eq_getElem_toList, length_nil, Nat.not_lt_zero, reduceDIte, Option.map_none']
| a :: l, arr, i => by
rw [mapIdx.go, getElem?_mapIdx_go]
simp only [Array.size_push]
split <;> split
· simp only [Option.some.injEq]
rw [Array.getElem_eq_getElem_toList]
simp only [Array.push_toList]
rw [getElem_append_left, Array.getElem_eq_getElem_toList]
· have : i = arr.size := by omega
simp_all
· omega
· have : i - arr.size = i - (arr.size + 1) + 1 := by omega
simp_all
@[simp] theorem getElem?_mapIdx {l : List α} {i : Nat} :
(l.mapIdx f)[i]? = Option.map (f i) l[i]? := by
simp [mapIdx, getElem?_mapIdx_go]
@[simp] theorem getElem_mapIdx {l : List α} {f : Nat α β} {i : Nat} {h : i < (l.mapIdx f).length} :
(l.mapIdx f)[i] = f i (l[i]'(by simpa using h)) := by
apply Option.some_inj.mp
rw [ getElem?_eq_getElem, getElem?_mapIdx, getElem?_eq_getElem (by simpa using h)]
simp
theorem mapIdx_eq_enum_map {l : List α} :
l.mapIdx f = l.enum.map (Function.uncurry f) := by
ext1 i
simp only [getElem?_mapIdx, Option.map, getElem?_map, getElem?_enum]
split <;> simp
@[simp]
theorem mapIdx_cons {l : List α} {a : α} :
mapIdx f (a :: l) = f 0 a :: mapIdx (fun i => f (i + 1)) l := by
simp [mapIdx_eq_enum_map, enum_eq_zip_range, map_uncurry_zip_eq_zipWith,
range_succ_eq_map, zipWith_map_left]
theorem mapIdx_append {K L : List α} :
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.length) := by
induction K generalizing f with
| nil => rfl
| cons _ _ ih => simp [ih (f := fun i => f (i + 1)), Nat.add_assoc]
@[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]
theorem mapIdx_ne_nil_iff {l : List α} :
List.mapIdx f l [] l [] := by
simp
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
@[simp] theorem mem_mapIdx {b : β} {l : List α} :
b mapIdx f l (i : Nat) (h : i < l.length), f i l[i] = b := by
constructor
· intro h
exact exists_of_mem_mapIdx h
· rintro i, h, rfl
rw [mem_iff_getElem]
exact i, by simpa using h, by simp
theorem mapIdx_eq_cons_iff {l : List α} {b : β} :
mapIdx f l = b :: l₂
(a : α) (l₁ : List α), l = a :: l₁ f 0 a = b mapIdx (fun i => f (i + 1)) l₁ = l₂ := by
cases l <;> simp [and_assoc]
theorem mapIdx_eq_cons_iff' {l : List α} {b : β} :
mapIdx f l = b :: l₂
l.head?.map (f 0) = some b l.tail?.map (mapIdx fun i => f (i + 1)) = some l₂ := by
cases l <;> simp
theorem mapIdx_eq_iff {l : List α} : mapIdx f l = l' i : Nat, l'[i]? = l[i]?.map (f i) := by
constructor
· intro w i
simpa using congrArg (fun l => l[i]?) w.symm
· intro w
ext1 i
simp [w]
theorem mapIdx_eq_mapIdx_iff {l : List α} :
mapIdx f l = mapIdx g l i : Nat, (h : i < l.length) f i l[i] = g i l[i] := by
constructor
· intro w i h
simpa [h] using congrArg (fun l => l[i]?) w
· intro w
apply ext_getElem
· simp
· intro i h₁ h₂
simp [w]
@[simp] theorem mapIdx_set {l : List α} {i : Nat} {a : α} :
(l.set i a).mapIdx f = (l.mapIdx f).set i (f i a) := by
simp only [mapIdx_eq_iff, getElem?_set, length_mapIdx, getElem?_mapIdx]
intro i
split
· split <;> simp_all
· rfl
@[simp] theorem head_mapIdx {l : List α} {f : Nat α β} {w : mapIdx f l []} :
(mapIdx f l).head w = f 0 (l.head (by simpa using w)) := by
cases l with
| nil => simp at w
| cons _ _ => simp
@[simp] theorem head?_mapIdx {l : List α} {f : Nat α β} : (mapIdx f l).head? = l.head?.map (f 0) := by
cases l <;> simp
@[simp] theorem getLast_mapIdx {l : List α} {f : Nat α β} {h} :
(mapIdx f l).getLast h = f (l.length - 1) (l.getLast (by simpa using h)) := by
cases l with
| nil => simp at h
| cons _ _ =>
simp only [ getElem_cons_length _ _ _ rfl]
simp only [mapIdx_cons]
simp only [ getElem_cons_length _ _ _ rfl]
simp only [ mapIdx_cons, getElem_mapIdx]
simp
@[simp] theorem getLast?_mapIdx {l : List α} {f : Nat α β} :
(mapIdx f l).getLast? = (getLast? l).map (f (l.length - 1)) := by
cases l
· simp
· rw [getLast?_eq_getLast, getLast?_eq_getLast, getLast_mapIdx] <;> simp
@[simp] theorem mapIdx_mapIdx {l : List α} {f : Nat α β} {g : Nat β γ} :
(l.mapIdx f).mapIdx g = l.mapIdx (fun i => g i f i) := by
simp [mapIdx_eq_iff]
theorem mapIdx_eq_replicate_iff {l : List α} {f : Nat α β} {b : β} :
mapIdx f l = replicate l.length b (i : Nat) (h : i < l.length), f i l[i] = b := by
simp only [eq_replicate_iff, length_mapIdx, mem_mapIdx, forall_exists_index, true_and]
constructor
· intro w i h
apply w _ _ _ rfl
· rintro w _ i h rfl
exact w i h
@[simp] theorem mapIdx_reverse {l : List α} {f : Nat α β} :
l.reverse.mapIdx f = (mapIdx (fun i => f (l.length - 1 - i)) l).reverse := by
simp [mapIdx_eq_iff]
intro i
by_cases h : i < l.length
· simp [getElem?_reverse, h]
congr
omega
· simp at h
rw [getElem?_eq_none (by simp [h]), getElem?_eq_none (by simp [h])]
simp
end List

View File

@@ -7,7 +7,7 @@ prelude
import Init.Data.List.Lemmas
/-!
# Lemmas about `List.min?` and `List.max?.
# Lemmas about `List.minimum?` and `List.maximum?.
-/
namespace List
@@ -16,32 +16,24 @@ open Nat
/-! ## Minima and maxima -/
/-! ### min? -/
/-! ### minimum? -/
@[simp] theorem min?_nil [Min α] : ([] : List α).min? = none := rfl
@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl
-- We don't put `@[simp]` on `min?_cons'`,
-- We don't put `@[simp]` on `minimum?_cons`,
-- because the definition in terms of `foldl` is not useful for proofs.
theorem min?_cons' [Min α] {xs : List α} : (x :: xs).min? = foldl min x xs := rfl
theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl
@[simp] theorem min?_cons [Min α] [Std.Associative (min : α α α)] {xs : List α} :
(x :: xs).min? = some (xs.min?.elim x (min x)) := by
cases xs <;> simp [min?_cons', foldl_assoc]
@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none xs = [] := by
cases xs <;> simp [minimum?]
@[simp] theorem min?_eq_none_iff {xs : List α} [Min α] : xs.min? = none xs = [] := by
cases xs <;> simp [min?]
theorem isSome_min?_of_mem {l : List α} [Min α] {a : α} (h : a l) :
l.min?.isSome := by
cases l <;> simp_all [List.min?_cons']
theorem min?_mem [Min α] (min_eq_or : a b : α, min a b = a min a b = b) :
{xs : List α} xs.min? = some a a xs := by
theorem minimum?_mem [Min α] (min_eq_or : a b : α, min a b = a min a b = b) :
{xs : List α} xs.minimum? = some a a xs := by
intro xs
match xs with
| nil => simp
| x :: xs =>
simp only [min?_cons', Option.some.injEq, List.mem_cons]
simp only [minimum?_cons, Option.some.injEq, List.mem_cons]
intro eq
induction xs generalizing x with
| nil =>
@@ -57,12 +49,12 @@ theorem min?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a min a b = b
-- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
theorem le_min?_iff [Min α] [LE α]
theorem le_minimum?_iff [Min α] [LE α]
(le_min_iff : a b c : α, a min b c a b a c) :
{xs : List α} xs.min? = some a {x}, x a b, b xs x b
{xs : List α} xs.minimum? = some a {x}, x a b, b xs x b
| nil => by simp
| cons x xs => by
rw [min?]
rw [minimum?]
intro eq y
simp only [Option.some.injEq] at eq
induction xs generalizing x with
@@ -75,58 +67,46 @@ theorem le_min?_iff [Min α] [LE α]
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
-- and `le_min_iff`.
theorem min?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ·)]
theorem minimum?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ·)]
(le_refl : a : α, a a)
(min_eq_or : a b : α, min a b = a min a b = b)
(le_min_iff : a b c : α, a min b c a b a c) {xs : List α} :
xs.min? = some a a xs b, b xs a b := by
refine fun h => min?_mem min_eq_or h, (le_min?_iff le_min_iff h).1 (le_refl _), ?_
xs.minimum? = some a a xs b, b xs a b := by
refine fun h => minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h).1 (le_refl _), ?_
intro h₁, h₂
cases xs with
| nil => simp at h₁
| cons x xs =>
exact congrArg some <| anti.1
((le_min?_iff le_min_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
(h₂ _ (min?_mem min_eq_or (xs := x::xs) rfl))
((le_minimum?_iff le_min_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
(h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl))
theorem min?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
(replicate n a).min? = if n = 0 then none else some a := by
theorem minimum?_replicate [Min α] {n : Nat} {a : α} (w : min a a = a) :
(replicate n a).minimum? = if n = 0 then none else some a := by
induction n with
| zero => rfl
| succ n ih => cases n <;> simp_all [replicate_succ, min?_cons']
| succ n ih => cases n <;> simp_all [replicate_succ, minimum?_cons]
@[simp] theorem min?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
(replicate n a).min? = some a := by
simp [min?_replicate, Nat.ne_of_gt h, w]
@[simp] theorem minimum?_replicate_of_pos [Min α] {n : Nat} {a : α} (w : min a a = a) (h : 0 < n) :
(replicate n a).minimum? = some a := by
simp [minimum?_replicate, Nat.ne_of_gt h, w]
theorem foldl_min [Min α] [Std.IdempotentOp (min : α α α)] [Std.Associative (min : α α α)]
{l : List α} {a : α} : l.foldl (init := a) min = min a (l.min?.getD a) := by
cases l <;> simp [min?, foldl_assoc, Std.IdempotentOp.idempotent]
/-! ### maximum? -/
/-! ### max? -/
@[simp] theorem maximum?_nil [Max α] : ([] : List α).maximum? = none := rfl
@[simp] theorem max?_nil [Max α] : ([] : List α).max? = none := rfl
-- We don't put `@[simp]` on `max?_cons'`,
-- We don't put `@[simp]` on `maximum?_cons`,
-- because the definition in terms of `foldl` is not useful for proofs.
theorem max?_cons' [Max α] {xs : List α} : (x :: xs).max? = foldl max x xs := rfl
theorem maximum?_cons [Max α] {xs : List α} : (x :: xs).maximum? = foldl max x xs := rfl
@[simp] theorem max?_cons [Max α] [Std.Associative (max : α α α)] {xs : List α} :
(x :: xs).max? = some (xs.max?.elim x (max x)) := by
cases xs <;> simp [max?_cons', foldl_assoc]
@[simp] theorem maximum?_eq_none_iff {xs : List α} [Max α] : xs.maximum? = none xs = [] := by
cases xs <;> simp [maximum?]
@[simp] theorem max?_eq_none_iff {xs : List α} [Max α] : xs.max? = none xs = [] := by
cases xs <;> simp [max?]
theorem isSome_max?_of_mem {l : List α} [Max α] {a : α} (h : a l) :
l.max?.isSome := by
cases l <;> simp_all [List.max?_cons']
theorem max?_mem [Max α] (min_eq_or : a b : α, max a b = a max a b = b) :
{xs : List α} xs.max? = some a a xs
theorem maximum?_mem [Max α] (min_eq_or : a b : α, max a b = a max a b = b) :
{xs : List α} xs.maximum? = some a a xs
| nil => by simp
| cons x xs => by
rw [max?]; rintro
rw [maximum?]; rintro
induction xs generalizing x with simp at *
| cons y xs ih =>
rcases ih (max x y) with h | h <;> simp [h]
@@ -134,61 +114,40 @@ theorem max?_mem [Max α] (min_eq_or : ∀ a b : α, max a b = a max a b = b
-- See also `Init.Data.List.Nat.Basic` for specialisations of the next two results to `Nat`.
theorem max?_le_iff [Max α] [LE α]
theorem maximum?_le_iff [Max α] [LE α]
(max_le_iff : a b c : α, max b c a b a c a) :
{xs : List α} xs.max? = some a {x}, a x b xs, b x
{xs : List α} xs.maximum? = some a {x}, a x b xs, b x
| nil => by simp
| cons x xs => by
rw [max?]; rintro y
rw [maximum?]; rintro y
induction xs generalizing x with
| nil => simp
| cons y xs ih => simp [ih, max_le_iff, and_assoc]
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `max_eq_or`,
-- and `le_min_iff`.
theorem max?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ·)]
theorem maximum?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ·)]
(le_refl : a : α, a a)
(max_eq_or : a b : α, max a b = a max a b = b)
(max_le_iff : a b c : α, max b c a b a c a) {xs : List α} :
xs.max? = some a a xs b xs, b a := by
refine fun h => max?_mem max_eq_or h, (max?_le_iff max_le_iff h).1 (le_refl _), ?_
xs.maximum? = some a a xs b xs, b a := by
refine fun h => maximum?_mem max_eq_or h, (maximum?_le_iff max_le_iff h).1 (le_refl _), ?_
intro h₁, h₂
cases xs with
| nil => simp at h₁
| cons x xs =>
exact congrArg some <| anti.1
(h₂ _ (max?_mem max_eq_or (xs := x::xs) rfl))
((max?_le_iff max_le_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
(h₂ _ (maximum?_mem max_eq_or (xs := x::xs) rfl))
((maximum?_le_iff max_le_iff (xs := x::xs) rfl).1 (le_refl _) _ h₁)
theorem max?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
(replicate n a).max? = if n = 0 then none else some a := by
theorem maximum?_replicate [Max α] {n : Nat} {a : α} (w : max a a = a) :
(replicate n a).maximum? = if n = 0 then none else some a := by
induction n with
| zero => rfl
| succ n ih => cases n <;> simp_all [replicate_succ, max?_cons']
| succ n ih => cases n <;> simp_all [replicate_succ, maximum?_cons]
@[simp] theorem max?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
(replicate n a).max? = some a := by
simp [max?_replicate, Nat.ne_of_gt h, w]
theorem foldl_max [Max α] [Std.IdempotentOp (max : α α α)] [Std.Associative (max : α α α)]
{l : List α} {a : α} : l.foldl (init := a) max = max a (l.max?.getD a) := by
cases l <;> simp [max?, foldl_assoc, Std.IdempotentOp.idempotent]
@[deprecated min?_nil (since := "2024-09-29")] abbrev minimum?_nil := @min?_nil
@[deprecated min?_cons (since := "2024-09-29")] abbrev minimum?_cons := @min?_cons
@[deprecated min?_eq_none_iff (since := "2024-09-29")] abbrev mininmum?_eq_none_iff := @min?_eq_none_iff
@[deprecated min?_mem (since := "2024-09-29")] abbrev minimum?_mem := @min?_mem
@[deprecated le_min?_iff (since := "2024-09-29")] abbrev le_minimum?_iff := @le_min?_iff
@[deprecated min?_eq_some_iff (since := "2024-09-29")] abbrev minimum?_eq_some_iff := @min?_eq_some_iff
@[deprecated min?_replicate (since := "2024-09-29")] abbrev minimum?_replicate := @min?_replicate
@[deprecated min?_replicate_of_pos (since := "2024-09-29")] abbrev minimum?_replicate_of_pos := @min?_replicate_of_pos
@[deprecated max?_nil (since := "2024-09-29")] abbrev maximum?_nil := @max?_nil
@[deprecated max?_cons (since := "2024-09-29")] abbrev maximum?_cons := @max?_cons
@[deprecated max?_eq_none_iff (since := "2024-09-29")] abbrev maximum?_eq_none_iff := @max?_eq_none_iff
@[deprecated max?_mem (since := "2024-09-29")] abbrev maximum?_mem := @max?_mem
@[deprecated max?_le_iff (since := "2024-09-29")] abbrev maximum?_le_iff := @max?_le_iff
@[deprecated max?_eq_some_iff (since := "2024-09-29")] abbrev maximum?_eq_some_iff := @max?_eq_some_iff
@[deprecated max?_replicate (since := "2024-09-29")] abbrev maximum?_replicate := @max?_replicate
@[deprecated max?_replicate_of_pos (since := "2024-09-29")] abbrev maximum?_replicate_of_pos := @max?_replicate_of_pos
@[simp] theorem maximum?_replicate_of_pos [Max α] {n : Nat} {a : α} (w : max a a = a) (h : 0 < n) :
(replicate n a).maximum? = some a := by
simp [maximum?_replicate, Nat.ne_of_gt h, w]
end List

View File

@@ -51,27 +51,6 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α m β) {l₁ l₂ : List α} :
(l₁ ++ l₂).mapM f = (return ( l₁.mapM f) ++ ( l₂.mapM f)) := by induction l₁ <;> simp [*]
/-- Auxiliary lemma for `mapM_eq_reverse_foldlM_cons`. -/
theorem foldlM_cons_eq_append [Monad m] [LawfulMonad m] (f : α m β) (as : List α) (b : β) (bs : List β) :
(as.foldlM (init := b :: bs) fun acc a => return (( f a) :: acc)) =
(· ++ b :: bs) <$> as.foldlM (init := []) fun acc a => return (( f a) :: acc) := by
induction as generalizing b bs with
| nil => simp
| cons a as ih =>
simp only [bind_pure_comp] at ih
simp [ih, _root_.map_bind, Functor.map_map, Function.comp_def]
theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α m β) (l : List α) :
mapM f l = reverse <$> (l.foldlM (fun acc a => return (( f a) :: acc)) []) := by
rw [ mapM'_eq_mapM]
induction l with
| nil => simp
| cons a as ih =>
simp only [mapM'_cons, ih, bind_map_left, foldlM_cons, LawfulMonad.bind_assoc, pure_bind,
foldlM_cons_eq_append, _root_.map_bind, Functor.map_map, Function.comp_def, reverse_append,
reverse_cons, reverse_nil, nil_append, singleton_append]
simp [bind_pure_comp]
/-! ### forM -/
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
@@ -87,16 +66,4 @@ theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α → m β)
(l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
induction l₁ <;> simp [*]
/-! ### allM -/
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α m Bool) (as : List α) :
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
induction as with
| nil => simp
| cons a as ih =>
simp only [allM, anyM, bind_map_left, _root_.map_bind]
congr
funext b
split <;> simp_all
end List

View File

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

View File

@@ -10,7 +10,7 @@ import Init.Data.List.Erase
namespace List
theorem getElem?_eraseIdx (l : List α) (i : Nat) (j : Nat) :
(l.eraseIdx i)[j]? = if j < i then l[j]? else l[j + 1]? := by
(l.eraseIdx i)[j]? = if h : j < i then l[j]? else l[j + 1]? := by
rw [eraseIdx_eq_take_drop_succ, getElem?_append]
split <;> rename_i h
· rw [getElem?_take]

View File

@@ -154,7 +154,7 @@ theorem erase_range' :
/-! ### range -/
theorem reverse_range' : s n : Nat, reverse (range' s n) = map (s + n - 1 - ·) (range n)
| _, 0 => rfl
| s, 0 => rfl
| s, n + 1 => by
rw [range'_1_concat, reverse_append, range_succ_eq_map,
show s + (n + 1) - 1 = s + n from rfl, map, map_map]
@@ -500,13 +500,4 @@ theorem enum_eq_zip_range (l : List α) : l.enum = (range l.length).zip l :=
theorem unzip_enum_eq_prod (l : List α) : l.enum.unzip = (range l.length, l) := by
simp only [enum_eq_zip_range, unzip_zip, length_range]
theorem enum_eq_cons_iff {l : List α} :
l.enum = x :: l' a as, l = a :: as x = (0, a) l' = enumFrom 1 as := by
rw [enum, enumFrom_eq_cons_iff]
theorem enum_eq_append_iff {l : List α} :
l.enum = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = l₁'.enum l₂ = l₂'.enumFrom l₁'.length := by
simp [enum, enumFrom_eq_append_iff]
end List

View File

@@ -42,7 +42,7 @@ theorem getElem_take' (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j)
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
@[simp] theorem getElem_take (L : List α) {j i : Nat} {h : i < (L.take j).length} :
theorem getElem_take (L : List α) {j i : Nat} {h : i < (L.take j).length} :
(L.take j)[i] =
L[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
rw [length_take, Nat.lt_min] at h; rw [getElem_take' L _ h.1]
@@ -52,7 +52,7 @@ length `> i`. Version designed to rewrite from the big list to the small list. -
@[deprecated getElem_take' (since := "2024-06-12")]
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
get L i, hi = get (L.take j) i, length_take .. Nat.lt_min.mpr hj, hi := by
simp
simp [getElem_take' _ hi hj]
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/

View File

@@ -160,23 +160,21 @@ theorem pairwise_middle {R : αα → Prop} (s : ∀ {x y}, R x y → R y x
rw [ append_assoc, pairwise_append, @pairwise_append _ _ ([a] ++ l₁), pairwise_append_comm s]
simp only [mem_append, or_comm]
theorem pairwise_flatten {L : List (List α)} :
Pairwise R (flatten L)
theorem pairwise_join {L : List (List α)} :
Pairwise R (join L)
( l L, Pairwise R l) Pairwise (fun l₁ l₂ => x l₁, y l₂, R x y) L := by
induction L with
| nil => simp
| cons l L IH =>
simp only [flatten, pairwise_append, IH, mem_flatten, exists_imp, and_imp, forall_mem_cons,
simp only [join, pairwise_append, IH, mem_join, exists_imp, and_imp, forall_mem_cons,
pairwise_cons, and_assoc, and_congr_right_iff]
rw [and_comm, and_congr_left_iff]
intros; exact fun h a b c d e => h c d e a b, fun h c d e a b => h a b c d e
@[deprecated pairwise_flatten (since := "2024-10-14")] abbrev pairwise_join := @pairwise_flatten
theorem pairwise_bind {R : β β Prop} {l : List α} {f : α List β} :
List.Pairwise R (l.bind f)
( a l, Pairwise R (f a)) Pairwise (fun a₁ a₂ => x f a₁, y f a₂, R x y) l := by
simp [List.bind, pairwise_flatten, pairwise_map]
simp [List.bind, pairwise_join, pairwise_map]
theorem pairwise_reverse {l : List α} :
l.reverse.Pairwise R l.Pairwise (fun a b => R b a) := by

View File

@@ -98,8 +98,8 @@ theorem Perm.append_cons (a : α) {h₁ h₂ t₁ t₂ : List α} (p₁ : h₁ ~
perm_middle.trans <| by rw [append_nil]
theorem perm_append_comm : {l₁ l₂ : List α}, l₁ ++ l₂ ~ l₂ ++ l₁
| [], _ => by simp
| _ :: _, _ => (perm_append_comm.cons _).trans perm_middle.symm
| [], l₂ => by simp
| a :: t, l₂ => (perm_append_comm.cons _).trans perm_middle.symm
theorem perm_append_comm_assoc (l₁ l₂ l₃ : List α) :
Perm (l₁ ++ (l₂ ++ l₃)) (l₂ ++ (l₁ ++ l₃)) := by
@@ -248,10 +248,6 @@ theorem countP_eq_countP_filter_add (l : List α) (p q : α → Bool) :
theorem Perm.count_eq [DecidableEq α] {l₁ l₂ : List α} (p : l₁ ~ l₂) (a) :
count a l₁ = count a l₂ := p.countP_eq _
/-
This theorem is a variant of `Perm.foldl_eq` defined in Mathlib which uses typeclasses rather
than the explicit `comm` argument.
-/
theorem Perm.foldl_eq' {f : β α β} {l₁ l₂ : List α} (p : l₁ ~ l₂)
(comm : x l₁, y l₁, (z), f (f z x) y = f (f z y) x)
(init) : foldl f init l₁ = foldl f init l₂ := by
@@ -268,28 +264,6 @@ theorem Perm.foldl_eq' {f : β → α → β} {l₁ l₂ : List α} (p : l₁ ~
refine (IH₁ comm init).trans (IH₂ ?_ _)
intros; apply comm <;> apply p₁.symm.subset <;> assumption
/-
This theorem is a variant of `Perm.foldr_eq` defined in Mathlib which uses typeclasses rather
than the explicit `comm` argument.
-/
theorem Perm.foldr_eq' {f : α β β} {l₁ l₂ : List α} (p : l₁ ~ l₂)
(comm : x l₁, y l₁, (z), f y (f x z) = f x (f y z))
(init) : foldr f init l₁ = foldr f init l₂ := by
induction p using recOnSwap' generalizing init with
| nil => simp
| cons x _p IH =>
simp only [foldr]
congr 1
apply IH; intros; apply comm <;> exact .tail _ _
| swap' x y _p IH =>
simp only [foldr]
rw [comm x (.tail _ <| .head _) y (.head _)]
congr 2
apply IH; intros; apply comm <;> exact .tail _ (.tail _ _)
| trans p₁ _p₂ IH₁ IH₂ =>
refine (IH₁ comm init).trans (IH₂ ?_ _)
intros; apply comm <;> apply p₁.symm.subset <;> assumption
theorem Perm.rec_heq {β : List α Sort _} {f : a l, β l β (a :: l)} {b : β []} {l l' : List α}
(hl : l ~ l') (f_congr : {a l l' b b'}, l ~ l' HEq b b' HEq (f a l b) (f a l' b'))
(f_swap : {a a' l b}, HEq (f a (a' :: l) (f a' l b)) (f a' (a :: l) (f a l b))) :
@@ -461,17 +435,15 @@ theorem Perm.nodup {l l' : List α} (hl : l ~ l') (hR : l.Nodup) : l'.Nodup := h
theorem Perm.nodup_iff {l₁ l₂ : List α} : l₁ ~ l₂ (Nodup l₁ Nodup l₂) :=
Perm.pairwise_iff <| @Ne.symm α
theorem Perm.flatten {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.flatten ~ l₂.flatten := by
theorem Perm.join {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.join ~ l₂.join := by
induction h with
| nil => rfl
| cons _ _ ih => simp only [flatten_cons, perm_append_left_iff, ih]
| swap => simp only [flatten_cons, append_assoc, perm_append_right_iff]; exact perm_append_comm ..
| cons _ _ ih => simp only [join_cons, perm_append_left_iff, ih]
| swap => simp only [join_cons, append_assoc, perm_append_right_iff]; exact perm_append_comm ..
| trans _ _ ih₁ ih₂ => exact trans ih₁ ih₂
@[deprecated Perm.flatten (since := "2024-10-14")] abbrev Perm.join := @Perm.flatten
theorem Perm.bind_right {l₁ l₂ : List α} (f : α List β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f :=
(p.map _).flatten
(p.map _).join
theorem Perm.eraseP (f : α Bool) {l₁ l₂ : List α}
(H : Pairwise (fun a b => f a f b False) l₁) (p : l₁ ~ l₂) : eraseP f l₁ ~ eraseP f l₂ := by

View File

@@ -20,6 +20,7 @@ open Nat
/-! ## Ranges and enumeration -/
/-! ### range' -/
theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step) n step := by
@@ -91,7 +92,7 @@ theorem map_add_range' (a) : ∀ s n step, map (a + ·) (range' s n step) = rang
theorem range'_append : s m n step : Nat,
range' s m step ++ range' (s + step * m) n step = range' s (n + m) step
| _, 0, _, _ => rfl
| s, 0, n, step => rfl
| s, m + 1, n, step => by
simpa [range', Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
using range'_append (s + step) m n step
@@ -130,7 +131,7 @@ theorem range'_eq_cons_iff : range' s n = a :: xs ↔ s = a ∧ 0 < n ∧ xs = r
/-! ### range -/
theorem range_loop_range' : s n : Nat, range.loop s (range' s n) = range' 0 (n + s)
| 0, _ => rfl
| 0, n => rfl
| s + 1, n => by rw [ Nat.add_assoc, Nat.add_right_comm n s 1]; exact range_loop_range' s (n + 1)
theorem range_eq_range' (n : Nat) : range n = range' 0 n :=
@@ -213,9 +214,9 @@ theorem enumFrom_eq_nil {n : Nat} {l : List α} : List.enumFrom n l = [] ↔ l =
@[simp]
theorem getElem?_enumFrom :
n (l : List α) m, (enumFrom n l)[m]? = l[m]?.map fun a => (n + m, a)
| _, [], _ => rfl
| _, _ :: _, 0 => by simp
| n, _ :: l, m + 1 => by
| n, [], m => rfl
| n, a :: l, 0 => by simp
| n, a :: l, m + 1 => by
simp only [enumFrom_cons, getElem?_cons_succ]
exact (getElem?_enumFrom (n + 1) l m).trans <| by rw [Nat.add_right_comm]; rfl

View File

@@ -102,7 +102,7 @@ def mergeSortTR (l : List α) (le : αα → Bool := by exact fun a b => a
where run : {n : Nat} { l : List α // l.length = n } List α
| 0, [], _ => []
| 1, [a], _ => [a]
| _+2, xs =>
| n+2, xs =>
let (l, r) := splitInTwo xs
mergeTR (run l) (run r) le
@@ -136,13 +136,13 @@ where
run : {n : Nat} { l : List α // l.length = n } List α
| 0, [], _ => []
| 1, [a], _ => [a]
| _+2, xs =>
| n+2, xs =>
let (l, r) := splitRevInTwo xs
mergeTR (run' l) (run r) le
run' : {n : Nat} { l : List α // l.length = n } List α
| 0, [], _ => []
| 1, [a], _ => [a]
| _+2, xs =>
| n+2, xs =>
let (l, r) := splitRevInTwo' xs
mergeTR (run' r) (run l) le

View File

@@ -483,30 +483,30 @@ theorem sublist_replicate_iff : l <+ replicate m a ↔ ∃ n, n ≤ m ∧ l = re
rw [w]
exact (replicate_sublist_replicate a).2 le
theorem sublist_flatten_of_mem {L : List (List α)} {l} (h : l L) : l <+ L.flatten := by
theorem sublist_join_of_mem {L : List (List α)} {l} (h : l L) : l <+ L.join := by
induction L with
| nil => cases h
| cons l' L ih =>
rcases mem_cons.1 h with (rfl | h)
· simp [h]
· simp [ih h, flatten_cons, sublist_append_of_sublist_right]
· simp [ih h, join_cons, sublist_append_of_sublist_right]
theorem sublist_flatten_iff {L : List (List α)} {l} :
l <+ L.flatten
L' : List (List α), l = L'.flatten i (_ : i < L'.length), L'[i] <+ L[i]?.getD [] := by
theorem sublist_join_iff {L : List (List α)} {l} :
l <+ L.join
L' : List (List α), l = L'.join i (_ : i < L'.length), L'[i] <+ L[i]?.getD [] := by
induction L generalizing l with
| nil =>
constructor
· intro w
simp only [flatten_nil, sublist_nil] at w
simp only [join_nil, sublist_nil] at w
subst w
exact [], by simp, fun i x => by cases x
· rintro L', rfl, h
simp only [flatten_nil, sublist_nil, flatten_eq_nil_iff]
simp only [join_nil, sublist_nil, join_eq_nil_iff]
simp only [getElem?_nil, Option.getD_none, sublist_nil] at h
exact (forall_getElem (p := (· = []))).1 h
| cons l' L ih =>
simp only [flatten_cons, sublist_append_iff, ih]
simp only [join_cons, sublist_append_iff, ih]
constructor
· rintro l₁, l₂, rfl, s, L', rfl, h
refine l₁ :: L', by simp, ?_
@@ -517,21 +517,21 @@ theorem sublist_flatten_iff {L : List (List α)} {l} :
| nil =>
exact [], [], by simp, by simp, [], by simp, fun i x => by cases x
| cons l₁ L' =>
exact l₁, L'.flatten, by simp, by simpa using h 0 (by simp), L', rfl,
exact l₁, L'.join, by simp, by simpa using h 0 (by simp), L', rfl,
fun i lt => by simpa using h (i+1) (Nat.add_lt_add_right lt 1)
theorem flatten_sublist_iff {L : List (List α)} {l} :
L.flatten <+ l
L' : List (List α), l = L'.flatten i (_ : i < L.length), L[i] <+ L'[i]?.getD [] := by
theorem join_sublist_iff {L : List (List α)} {l} :
L.join <+ l
L' : List (List α), l = L'.join i (_ : i < L.length), L[i] <+ L'[i]?.getD [] := by
induction L generalizing l with
| nil =>
constructor
· intro _
exact [l], by simp, fun i x => by cases x
· rintro L', rfl, _
simp only [flatten_nil, nil_sublist]
simp only [join_nil, nil_sublist]
| cons l' L ih =>
simp only [flatten_cons, append_sublist_iff, ih]
simp only [join_cons, append_sublist_iff, ih]
constructor
· rintro l₁, l₂, rfl, s, L', rfl, h
refine l₁ :: L', by simp, ?_
@@ -543,7 +543,7 @@ theorem flatten_sublist_iff {L : List (List α)} {l} :
exact [], [], by simp, by simpa using h 0 (by simp), [], by simp,
fun i x => by simpa using h (i+1) (Nat.add_lt_add_right x 1)
| cons l₁ L' =>
exact l₁, L'.flatten, by simp, by simpa using h 0 (by simp), L', rfl,
exact l₁, L'.join, by simp, by simpa using h 0 (by simp), L', rfl,
fun i lt => by simpa using h (i+1) (Nat.add_lt_add_right lt 1)
@[simp] theorem isSublist_iff_sublist [BEq α] [LawfulBEq α] {l₁ l₂ : List α} :
@@ -725,25 +725,16 @@ theorem infix_iff_suffix_prefix {l₁ l₂ : List α} : l₁ <:+: l₂ ↔ ∃ t
theorem IsInfix.eq_of_length (h : l₁ <:+: l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsInfix.eq_of_length_le (h : l₁ <:+: l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem IsPrefix.eq_of_length (h : l₁ <+: l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsPrefix.eq_of_length_le (h : l₁ <+: l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem IsSuffix.eq_of_length (h : l₁ <:+ l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsSuffix.eq_of_length_le (h : l₁ <:+ l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem prefix_of_prefix_length_le :
{l₁ l₂ l₃ : List α}, l₁ <+: l₃ l₂ <+: l₃ length l₁ length l₂ l₁ <+: l₂
| [], _, _, _, _, _ => nil_prefix
| _ :: _, b :: _, _, _, rfl, _, e, ll => by
| [], l₂, _, _, _, _ => nil_prefix
| a :: l₁, b :: l₂, _, r₁, rfl, r₂, e, ll => by
injection e with _ e'; subst b
rcases prefix_of_prefix_length_le _, rfl _, e' (le_of_succ_le_succ ll) with r₃, rfl
exact r₃, rfl
@@ -838,24 +829,6 @@ theorem isPrefix_iff : l₁ <+: l₂ ↔ ∀ i (h : i < l₁.length), l₂[i]? =
rw (config := {occs := .pos [2]}) [ Nat.and_forall_add_one]
simp [Nat.succ_lt_succ_iff, eq_comm]
theorem isPrefix_iff_getElem {l₁ l₂ : List α} :
l₁ <+: l₂ (h : l₁.length l₂.length), x (hx : x < l₁.length),
l₁[x] = l₂[x]'(Nat.lt_of_lt_of_le hx h) where
mp h := h.length_le, fun _ _ h.getElem _
mpr h := by
obtain hl, h := h
induction l₂ generalizing l₁ with
| nil =>
simpa using hl
| cons _ _ tail_ih =>
cases l₁ with
| nil =>
exact nil_prefix
| cons _ _ =>
simp only [length_cons, Nat.add_le_add_iff_right, Fin.getElem_fin] at hl h
simp only [cons_prefix_cons]
exact h 0 (zero_lt_succ _), tail_ih hl fun a ha h a.succ (succ_lt_succ ha)
-- See `Init.Data.List.Nat.Sublist` for `isSuffix_iff` and `ifInfix_iff`.
theorem isPrefix_filterMap_iff {β} {f : α Option β} {l₁ : List α} {l₂ : List β} :
@@ -938,14 +911,14 @@ theorem isInfix_replicate_iff {n} {a : α} {l : List α} :
· simpa using Nat.sub_add_cancel h
· simpa using w
theorem infix_of_mem_flatten : {L : List (List α)}, l L l <:+: flatten L
theorem infix_of_mem_join : {L : List (List α)}, l L l <:+: join L
| l' :: _, h =>
match h with
| List.Mem.head .. => infix_append [] _ _
| List.Mem.tail _ hlMemL =>
IsInfix.trans (infix_of_mem_flatten hlMemL) <| (suffix_append _ _).isInfix
IsInfix.trans (infix_of_mem_join hlMemL) <| (suffix_append _ _).isInfix
@[simp] theorem prefix_append_right_inj (l) : l ++ l₁ <+: l ++ l₂ l₁ <+: l₂ :=
theorem prefix_append_right_inj (l) : l ++ l₁ <+: l ++ l₂ l₁ <+: l₂ :=
exists_congr fun r => by rw [append_assoc, append_right_inj]
theorem prefix_cons_inj (a) : a :: l₁ <+: a :: l₂ l₁ <+: l₂ :=
@@ -976,7 +949,7 @@ theorem mem_of_mem_drop {n} {l : List α} (h : a ∈ l.drop n) : a ∈ l :=
drop_subset _ _ h
theorem drop_suffix_drop_left (l : List α) {m n : Nat} (h : m n) : drop n l <:+ drop m l := by
rw [ Nat.sub_add_cancel h, Nat.add_comm, drop_drop]
rw [ Nat.sub_add_cancel h, drop_drop]
apply drop_suffix
-- See `Init.Data.List.Nat.TakeDrop` for `take_prefix_take_left`.
@@ -1087,11 +1060,4 @@ theorem prefix_iff_eq_take : l₁ <+: l₂ ↔ l₁ = take (length l₁) l₂ :=
-- See `Init.Data.List.Nat.Sublist` for `suffix_iff_eq_append`, `prefix_take_iff`, and `suffix_iff_eq_drop`.
/-! ### Deprecations -/
@[deprecated sublist_flatten_of_mem (since := "2024-10-14")] abbrev sublist_join_of_mem := @sublist_flatten_of_mem
@[deprecated sublist_flatten_iff (since := "2024-10-14")] abbrev sublist_join_iff := @sublist_flatten_iff
@[deprecated flatten_sublist_iff (since := "2024-10-14")] abbrev flatten_join_iff := @flatten_sublist_iff
@[deprecated infix_of_mem_flatten (since := "2024-10-14")] abbrev infix_of_mem_join := @infix_of_mem_flatten
end List

View File

@@ -97,14 +97,14 @@ theorem get?_take {l : List α} {n m : Nat} (h : m < n) : (l.take n).get? m = l.
theorem getElem?_take_of_succ {l : List α} {n : Nat} : (l.take (n + 1))[n]? = l[n]? := by simp
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (m + n) l
@[simp] theorem drop_drop (n : Nat) : (m) (l : List α), drop n (drop m l) = drop (n + m) l
| m, [] => by simp
| 0, l => by simp
| m + 1, a :: l =>
calc
drop n (drop (m + 1) (a :: l)) = drop n (drop m l) := rfl
_ = drop (m + n) l := drop_drop n m l
_ = drop ((m + 1) + n) (a :: l) := by rw [Nat.add_right_comm]; rfl
_ = drop (n + m) l := drop_drop n m l
_ = drop (n + (m + 1)) (a :: l) := rfl
theorem take_drop : (m n : Nat) (l : List α), take n (drop m l) = drop m (take (m + n) l)
| 0, _, _ => by simp
@@ -112,7 +112,7 @@ theorem take_drop : ∀ (m n : Nat) (l : List α), take n (drop m l) = drop m (t
| _+1, _, _ :: _ => by simpa [Nat.succ_add, take_succ_cons, drop_succ_cons] using take_drop ..
@[deprecated drop_drop (since := "2024-06-15")]
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop n (drop m l) := by
theorem drop_add (m n) (l : List α) : drop (m + n) l = drop m (drop n l) := by
simp [drop_drop]
@[simp]
@@ -126,7 +126,7 @@ theorem tail_drop (l : List α) (n : Nat) : (l.drop n).tail = l.drop (n + 1) :=
@[simp]
theorem drop_tail (l : List α) (n : Nat) : l.tail.drop n = l.drop (n + 1) := by
rw [Nat.add_comm, drop_drop, drop_one]
rw [ drop_drop, drop_one]
@[simp]
theorem drop_eq_nil_iff {l : List α} {k : Nat} : l.drop k = [] l.length k := by

View File

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

View File

@@ -5,7 +5,6 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
-/
prelude
import Init.Data.List.TakeDrop
import Init.Data.Function
/-!
# Lemmas about `List.zip`, `List.zipWith`, `List.zipWithAll`, and `List.unzip`.
@@ -239,14 +238,6 @@ theorem zipWith_eq_append_iff {f : α → β → γ} {l₁ : List α} {l₂ : Li
| zero => rfl
| succ n ih => simp [replicate_succ, ih]
theorem map_uncurry_zip_eq_zipWith (f : α β γ) (l : List α) (l' : List β) :
map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
rw [zip]
induction l generalizing l' with
| nil => simp
| cons hl tl ih =>
cases l' <;> simp [ih]
/-! ### zip -/
theorem zip_eq_zipWith : (l₁ : List α) (l₂ : List β), zip l₁ l₂ = zipWith Prod.mk l₁ l₂
@@ -256,9 +247,9 @@ theorem zip_eq_zipWith : ∀ (l₁ : List α) (l₂ : List β), zip l₁ l₂ =
theorem zip_map (f : α γ) (g : β δ) :
(l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
| [], _ => rfl
| _, [] => by simp only [map, zip_nil_right]
| _ :: _, _ :: _ => by
| [], l₂ => rfl
| l₁, [] => by simp only [map, zip_nil_right]
| a :: l₁, b :: l₂ => by
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
theorem zip_map_left (f : α γ) (l₁ : List α) (l₂ : List β) :
@@ -296,12 +287,12 @@ theorem of_mem_zip {a b} : ∀ {l₁ : List α} {l₂ : List β}, (a, b) ∈ zip
theorem map_fst_zip :
(l₁ : List α) (l₂ : List β), l₁.length l₂.length map Prod.fst (zip l₁ l₂) = l₁
| [], _, _ => rfl
| [], bs, _ => rfl
| _ :: as, _ :: bs, h => by
simp [Nat.succ_le_succ_iff] at h
show _ :: map Prod.fst (zip as bs) = _ :: as
rw [map_fst_zip as bs h]
| _ :: _, [], h => by simp at h
| a :: as, [], h => by simp at h
theorem map_snd_zip :
(l₁ : List α) (l₂ : List β), l₂.length l₁.length map Prod.snd (zip l₁ l₂) = l₂
@@ -439,9 +430,9 @@ theorem zip_unzip : ∀ l : List (α × β), zip (unzip l).1 (unzip l).2 = l
theorem unzip_zip_left :
{l₁ : List α} {l₂ : List β}, length l₁ length l₂ (unzip (zip l₁ l₂)).1 = l₁
| [], _, _ => rfl
| _, [], h => by rw [eq_nil_of_length_eq_zero (Nat.eq_zero_of_le_zero h)]; rfl
| _ :: _, _ :: _, h => by
| [], l₂, _ => rfl
| l₁, [], h => by rw [eq_nil_of_length_eq_zero (Nat.eq_zero_of_le_zero h)]; rfl
| a :: l₁, b :: l₂, h => by
simp only [zip_cons_cons, unzip_cons, unzip_zip_left (le_of_succ_le_succ h)]
theorem unzip_zip_right :

View File

@@ -248,7 +248,7 @@ protected theorem add_mul (n m k : Nat) : (n + m) * k = n * k + m * k :=
Nat.right_distrib n m k
protected theorem mul_assoc : (n m k : Nat), (n * m) * k = n * (m * k)
| _, _, 0 => rfl
| n, m, 0 => rfl
| n, m, succ k => by simp [mul_succ, Nat.mul_assoc n m k, Nat.left_distrib]
instance : Std.Associative (α := Nat) (· * ·) := Nat.mul_assoc
@@ -634,8 +634,6 @@ theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h
theorem lt_add_one_of_lt (h : a < b) : a < b + 1 := le_succ_of_le h
@[simp] theorem lt_one_iff : n < 1 n = 0 := Nat.lt_succ_iff.trans <| by rw [le_zero_eq]
theorem succ_pred_eq_of_ne_zero : {n}, n 0 succ (pred n) = n
| _+1, _ => rfl

View File

@@ -269,7 +269,7 @@ protected theorem div_div_eq_div_mul (m n k : Nat) : m / n / k = m / (n * k) :=
theorem div_mul_le_self : (m n : Nat), m / n * n m
| m, 0 => by simp
| _, _+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _)
| m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _)
theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y x < y * k := by
rw [ Nat.not_le, Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk)

View File

@@ -605,9 +605,6 @@ theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by
| zero => simp_all
| succ k => omega
@[simp] theorem mod_mul_mod {a b c : Nat} : (a % c * b) % c = a * b % c := by
rw [mul_mod, mod_mod, mul_mod]
/-! ### pow -/
theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by
@@ -770,16 +767,6 @@ protected theorem two_pow_pred_mod_two_pow (h : 0 < w) :
rw [mod_eq_of_lt]
apply Nat.pow_pred_lt_pow (by omega) h
protected theorem pow_lt_pow_iff_pow_mul_le_pow {a n m : Nat} (h : 1 < a) :
a ^ n < a ^ m a ^ n * a a ^ m := by
rw [Nat.pow_add_one, Nat.pow_le_pow_iff_right (by omega), Nat.pow_lt_pow_iff_right (by omega)]
omega
@[simp]
theorem two_pow_pred_mul_two (h : 0 < w) :
2 ^ (w - 1) * 2 = 2 ^ w := by
simp [ Nat.pow_succ, Nat.sub_add_cancel h]
/-! ### log2 -/
@[simp]
@@ -874,15 +861,15 @@ theorem shiftLeft_succ_inside (m n : Nat) : m <<< (n+1) = (2*m) <<< n := rfl
/-- Shiftleft on successor with multiple moved to outside. -/
theorem shiftLeft_succ : (m n), m <<< (n + 1) = 2 * (m <<< n)
| _, 0 => rfl
| _, k + 1 => by
| m, 0 => rfl
| m, k + 1 => by
rw [shiftLeft_succ_inside _ (k+1)]
rw [shiftLeft_succ _ k, shiftLeft_succ_inside]
/-- Shiftright on successor with division moved inside. -/
theorem shiftRight_succ_inside : m n, m >>> (n+1) = (m/2) >>> n
| _, 0 => rfl
| _, k + 1 => by
| m, 0 => rfl
| m, k + 1 => by
rw [shiftRight_succ _ (k+1)]
rw [shiftRight_succ_inside _ k, shiftRight_succ]

View File

@@ -35,4 +35,4 @@ theorem neZero_iff {n : R} : NeZero n ↔ n ≠ 0 :=
fun h h.out, NeZero.mk
@[simp] theorem neZero_zero_iff_false {α : Type _} [Zero α] : NeZero (0 : α) False :=
fun _ NeZero.ne (0 : α) rfl, fun h h.elim
fun h h.ne rfl, fun h h.elim

View File

@@ -8,5 +8,3 @@ import Init.Data.Option.Basic
import Init.Data.Option.BasicAux
import Init.Data.Option.Instances
import Init.Data.Option.Lemmas
import Init.Data.Option.Attach
import Init.Data.Option.List

View File

@@ -1,242 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Option.Basic
import Init.Data.Option.List
import Init.Data.List.Attach
import Init.BinderPredicates
namespace Option
/--
Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
`Option {x // P x}` is the same as the input `Option α`.
-/
@[inline] private unsafe def attachWithImpl
(o : Option α) (P : α Prop) (_ : x o, P x) : Option {x // P x} := unsafeCast o
/-- "Attach" a proof `P x` that holds for the element of `o`, if present,
to produce a new option with the same element but in the type `{x // P x}`. -/
@[implemented_by attachWithImpl] def attachWith
(xs : Option α) (P : α Prop) (H : x xs, P x) : Option {x // P x} :=
match xs with
| none => none
| some x => some x, H x (mem_some_self x)
/-- "Attach" the proof that the element of `xs`, if present, is in `xs`
to produce a new option with the same elements but in the type `{x // x ∈ xs}`. -/
@[inline] def attach (xs : Option α) : Option {x // x xs} := xs.attachWith _ fun _ => id
@[simp] theorem attach_none : (none : Option α).attach = none := rfl
@[simp] theorem attachWith_none : (none : Option α).attachWith P H = none := rfl
@[simp] theorem attach_some {x : α} :
(some x).attach = some x, rfl := rfl
@[simp] theorem attachWith_some {x : α} {P : α Prop} (h : (b : α), b some x P b) :
(some x).attachWith P h = some x, by simpa using h := rfl
theorem attach_congr {o₁ o₂ : Option α} (h : o₁ = o₂) :
o₁.attach = o₂.attach.map (fun x => x.1, h x.2) := by
subst h
simp
theorem attachWith_congr {o₁ o₂ : Option α} (w : o₁ = o₂) {P : α Prop} {H : x o₁, P x} :
o₁.attachWith P H = o₂.attachWith P fun x h => H _ (w h) := by
subst w
simp
theorem attach_map_coe (o : Option α) (f : α β) :
(o.attach.map fun (i : {i // i o}) => f i) = o.map f := by
cases o <;> simp
theorem attach_map_val (o : Option α) (f : α β) :
(o.attach.map fun i => f i.val) = o.map f :=
attach_map_coe _ _
@[simp]
theorem attach_map_subtype_val (o : Option α) :
o.attach.map Subtype.val = o :=
(attach_map_coe _ _).trans (congrFun Option.map_id _)
theorem attachWith_map_coe {p : α Prop} (f : α β) (o : Option α) (H : a o, p a) :
((o.attachWith p H).map fun (i : { i // p i}) => f i.val) = o.map f := by
cases o <;> simp [H]
theorem attachWith_map_val {p : α Prop} (f : α β) (o : Option α) (H : a o, p a) :
((o.attachWith p H).map fun i => f i.val) = o.map f :=
attachWith_map_coe _ _ _
@[simp]
theorem attachWith_map_subtype_val {p : α Prop} (o : Option α) (H : a o, p a) :
(o.attachWith p H).map Subtype.val = o :=
(attachWith_map_coe _ _ _).trans (congrFun Option.map_id _)
@[simp] theorem mem_attach : (o : Option α) (x : {x // x o}), x o.attach
| none, x, h => by simp at h
| some a, x, h => by simpa using h
@[simp] theorem isNone_attach (o : Option α) : o.attach.isNone = o.isNone := by
cases o <;> simp
@[simp] theorem isNone_attachWith {p : α Prop} (o : Option α) (H : a o, p a) :
(o.attachWith p H).isNone = o.isNone := by
cases o <;> simp
@[simp] theorem isSome_attach (o : Option α) : o.attach.isSome = o.isSome := by
cases o <;> simp
@[simp] theorem isSome_attachWith {p : α Prop} (o : Option α) (H : a o, p a) :
(o.attachWith p H).isSome = o.isSome := by
cases o <;> simp
@[simp] theorem attach_eq_none_iff (o : Option α) : o.attach = none o = none := by
cases o <;> simp
@[simp] theorem attach_eq_some_iff {o : Option α} {x : {x // x o}} :
o.attach = some x o = some x.val := by
cases o <;> cases x <;> simp
@[simp] theorem attachWith_eq_none_iff {p : α Prop} (o : Option α) (H : a o, p a) :
o.attachWith p H = none o = none := by
cases o <;> simp
@[simp] theorem attachWith_eq_some_iff {p : α Prop} {o : Option α} (H : a o, p a) {x : {x // p x}} :
o.attachWith p H = some x o = some x.val := by
cases o <;> cases x <;> simp
@[simp] theorem get_attach {o : Option α} (h : o.attach.isSome = true) :
o.attach.get h = o.get (by simpa using h), by simp := by
cases o
· simp at h
· simp [get_some]
@[simp] theorem get_attachWith {p : α Prop} {o : Option α} (H : a o, p a) (h : (o.attachWith p H).isSome) :
(o.attachWith p H).get h = o.get (by simpa using h), H _ (by simp) := by
cases o
· simp at h
· simp [get_some]
@[simp] theorem toList_attach (o : Option α) :
o.attach.toList = o.toList.attach.map fun x, h => x, by simpa using h := by
cases o <;> simp
theorem attach_map {o : Option α} (f : α β) :
(o.map f).attach = o.attach.map (fun x, h => f x, mem_map_of_mem f h) := by
cases o <;> simp
theorem attachWith_map {o : Option α} (f : α β) {P : β Prop} {H : (b : β), b o.map f P b} :
(o.map f).attachWith P H = (o.attachWith (P f) (fun a h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
cases o <;> simp
theorem map_attach {o : Option α} (f : { x // x o } β) :
o.attach.map f = o.pmap (fun a (h : a o) => f a, h) (fun a h => h) := by
cases o <;> simp
theorem map_attachWith {o : Option α} {P : α Prop} {H : (a : α), a o P a}
(f : { x // P x } β) :
(o.attachWith P H).map f =
o.pmap (fun a (h : a o P a) => f a, h.2) (fun a h => h, H a h) := by
cases o <;> simp
theorem attach_bind {o : Option α} {f : α Option β} :
(o.bind f).attach =
o.attach.bind fun x, h => (f x).attach.map fun y, h' => y, mem_bind_iff.mpr x, h, h' := by
cases o <;> simp
theorem bind_attach {o : Option α} {f : {x // x o} Option β} :
o.attach.bind f = o.pbind fun a h => f a, h := by
cases o <;> simp
theorem pbind_eq_bind_attach {o : Option α} {f : (a : α) a o Option β} :
o.pbind f = o.attach.bind fun x, h => f x h := by
cases o <;> simp
theorem attach_filter {o : Option α} {p : α Bool} :
(o.filter p).attach =
o.attach.bind fun x, h => if h' : p x then some x, by simp_all else none := by
cases o with
| none => simp
| some a =>
simp only [filter_some, attach_some]
ext
simp only [mem_def, attach_eq_some_iff, ite_none_right_eq_some, some.injEq, some_bind,
dite_none_right_eq_some]
constructor
· rintro h, w
refine h, by ext; simpa using w
· rintro h, rfl
simp [h]
theorem filter_attach {o : Option α} {p : {x // x o} Bool} :
o.attach.filter p = o.pbind fun a h => if p a, h then some a, h else none := by
cases o <;> simp [filter_some]
/-! ## unattach
`Option.unattach` is the (one-sided) inverse of `Option.attach`. It is a synonym for `Option.map Subtype.val`.
We use it by providing a simp lemma `l.attach.unattach = l`, and simp lemmas which recognize higher order
functions applied to `l : Option { x // p x }` which only depend on the value, not the predicate, and rewrite these
in terms of a simpler function applied to `l.unattach`.
Further, we provide simp lemmas that push `unattach` inwards.
-/
/--
A synonym for `l.map (·.val)`. Mostly this should not be needed by users.
It is introduced as an intermediate step by lemmas such as `map_subtype`,
and is ideally subsequently simplified away by `unattach_attach`.
If not, usually the right approach is `simp [Option.unattach, -Option.map_subtype]` to unfold.
-/
def unattach {α : Type _} {p : α Prop} (o : Option { x // p x }) := o.map (·.val)
@[simp] theorem unattach_none {p : α Prop} : (none : Option { x // p x }).unattach = none := rfl
@[simp] theorem unattach_some {p : α Prop} {a : { x // p x }} :
(some a).unattach = a.val := rfl
@[simp] theorem isSome_unattach {p : α Prop} {o : Option { x // p x }} :
o.unattach.isSome = o.isSome := by
simp [unattach]
@[simp] theorem isNone_unattach {p : α Prop} {o : Option { x // p x }} :
o.unattach.isNone = o.isNone := by
simp [unattach]
@[simp] theorem unattach_attach (o : Option α) : o.attach.unattach = o := by
cases o <;> simp
@[simp] theorem unattach_attachWith {p : α Prop} {o : Option α}
{H : a o, p a} :
(o.attachWith p H).unattach = o := by
cases o <;> simp
/-! ### Recognizing higher order functions on subtypes using a function that only depends on the value. -/
/--
This lemma identifies maps over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
o.map f = o.unattach.map g := by
cases o <;> simp [hf]
@[simp] theorem bind_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
(o.bind f) = o.unattach.bind g := by
cases o <;> simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(o.filter f).unattach = o.unattach.filter g := by
cases o
· simp
· simp only [filter_some, hf, unattach_some]
split <;> simp
end Option

View File

@@ -202,7 +202,7 @@ result.
instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where
rfl {x} :=
match x with
| some _ => LawfulBEq.rfl (α := α)
| some x => LawfulBEq.rfl (α := α)
| none => rfl
eq_of_beq {x y h} := by
match x, y with

View File

@@ -79,7 +79,7 @@ theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o :=
theorem isSome_iff_exists : isSome x a, x = some a := by cases x <;> simp [isSome]
theorem isSome_eq_isSome : (isSome x = isSome y) (x = none y = none) := by
@[simp] theorem isSome_eq_isSome : (isSome x = isSome y) (x = none y = none) := by
cases x <;> cases y <;> simp
@[simp] theorem isNone_none : @isNone α none = true := rfl
@@ -138,10 +138,6 @@ theorem bind_eq_none' {o : Option α} {f : α → Option β} :
o.bind f = none b a, a o b f a := by
simp only [eq_none_iff_forall_not_mem, not_exists, not_and, mem_def, bind_eq_some]
theorem mem_bind_iff {o : Option α} {f : α Option β} :
b o.bind f a, a o b f a := by
cases o <;> simp
theorem bind_comm {f : α β Option γ} (a : Option α) (b : Option β) :
(a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
cases a <;> cases b <;> rfl
@@ -236,27 +232,9 @@ theorem isSome_filter_of_isSome (p : α → Bool) (o : Option α) (h : (o.filter
cases o <;> simp at h
@[simp] theorem filter_eq_none {p : α Bool} :
o.filter p = none o = none a, a o ¬ p a := by
Option.filter p o = none o = none a, a o ¬ p a := by
cases o <;> simp [filter_some]
@[simp] theorem filter_eq_some {o : Option α} {p : α Bool} :
o.filter p = some a a o p a := by
cases o with
| none => simp
| some a =>
simp [filter_some]
split <;> rename_i h
· simp only [some.injEq, iff_self_and]
rintro rfl
exact h
· simp only [reduceCtorEq, false_iff, not_and, Bool.not_eq_true]
rintro rfl
simpa using h
theorem mem_filter_iff {p : α Bool} {a : α} {o : Option α} :
a o.filter p a o p a := by
simp
@[simp] theorem all_guard (p : α Prop) [DecidablePred p] (a : α) :
Option.all q (guard p a) = (!p a || q a) := by
simp only [guard]
@@ -330,8 +308,8 @@ theorem guard_comp {p : α → Prop} [DecidablePred p] {f : β → α} :
theorem liftOrGet_eq_or_eq {f : α α α} (h : a b, f a b = a f a b = b) :
o₁ o₂, liftOrGet f o₁ o₂ = o₁ liftOrGet f o₁ o₂ = o₂
| none, none => .inl rfl
| some _, none => .inl rfl
| none, some _ => .inr rfl
| some a, none => .inl rfl
| none, some b => .inr rfl
| some a, some b => by have := h a b; simp [liftOrGet] at this ; exact this
@[simp] theorem liftOrGet_none_left {f} {b : Option α} : liftOrGet f none b = b := by
@@ -372,8 +350,6 @@ end choice
@[simp] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
-- See `Init.Data.Option.List` for lemmas about `toList`.
@[simp] theorem or_some : (some a).or o = some a := rfl
@[simp] theorem none_or : none.or o = o := rfl

View File

@@ -1,14 +0,0 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Lemmas
namespace Option
@[simp] theorem mem_toList {a : α} {o : Option α} : a o.toList a o := by
cases o <;> simp [eq_comm]
end Option

View File

@@ -317,15 +317,12 @@ theorem _root_.Char.utf8Size_le_four (c : Char) : c.utf8Size ≤ 4 := by
@[simp] theorem pos_add_char (p : Pos) (c : Char) : (p + c).byteIdx = p.byteIdx + c.utf8Size := rfl
protected theorem Pos.ne_zero_of_lt : {a b : Pos} a < b b 0
| _, _, hlt, rfl => Nat.not_lt_zero _ hlt
theorem lt_next (s : String) (i : Pos) : i.1 < (s.next i).1 :=
Nat.add_lt_add_left (Char.utf8Size_pos _) _
theorem utf8PrevAux_lt_of_pos : (cs : List Char) (i p : Pos), p 0
(utf8PrevAux cs i p).1 < p.1
| [], _, _, h =>
| [], i, p, h =>
Nat.lt_of_le_of_lt (Nat.zero_le _)
(Nat.zero_lt_of_ne_zero (mt (congrArg Pos.mk) h))
| c::cs, i, p, h => by
@@ -1024,66 +1021,6 @@ instance hasBeq : BEq Substring := ⟨beq⟩
def sameAs (ss1 ss2 : Substring) : Bool :=
ss1.startPos == ss2.startPos && ss1 == ss2
/--
Returns the longest common prefix of two substrings.
The returned substring will use the same underlying string as `s`.
-/
def commonPrefix (s t : Substring) : Substring :=
{ s with stopPos := loop s.startPos t.startPos }
where
/-- Returns the ending position of the common prefix, working up from `spos, tpos`. -/
loop spos tpos :=
if h : spos < s.stopPos tpos < t.stopPos then
if s.str.get spos == t.str.get tpos then
have := Nat.sub_lt_sub_left h.1 (s.str.lt_next spos)
loop (s.str.next spos) (t.str.next tpos)
else
spos
else
spos
termination_by s.stopPos.byteIdx - spos.byteIdx
/--
Returns the longest common suffix of two substrings.
The returned substring will use the same underlying string as `s`.
-/
def commonSuffix (s t : Substring) : Substring :=
{ s with startPos := loop s.stopPos t.stopPos }
where
/-- Returns the starting position of the common prefix, working down from `spos, tpos`. -/
loop spos tpos :=
if h : s.startPos < spos t.startPos < tpos then
let spos' := s.str.prev spos
let tpos' := t.str.prev tpos
if s.str.get spos' == t.str.get tpos' then
have : spos' < spos := s.str.prev_lt_of_pos spos (String.Pos.ne_zero_of_lt h.1)
loop spos' tpos'
else
spos
else
spos
termination_by spos.byteIdx
/--
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
-/
def dropPrefix? (s : Substring) (pre : Substring) : Option Substring :=
let t := s.commonPrefix pre
if t.bsize = pre.bsize then
some { s with startPos := t.stopPos }
else
none
/--
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
-/
def dropSuffix? (s : Substring) (suff : Substring) : Option Substring :=
let t := s.commonSuffix suff
if t.bsize = suff.bsize then
some { s with stopPos := t.startPos }
else
none
end Substring
namespace String
@@ -1145,28 +1082,6 @@ namespace String
@[inline] def decapitalize (s : String) :=
s.set 0 <| s.get 0 |>.toLower
/--
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
-/
def dropPrefix? (s : String) (pre : Substring) : Option Substring :=
s.toSubstring.dropPrefix? pre
/--
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
-/
def dropSuffix? (s : String) (suff : Substring) : Option Substring :=
s.toSubstring.dropSuffix? suff
/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there,
or otherwise return `s`. -/
def stripPrefix (s : String) (pre : Substring) : String :=
s.dropPrefix? pre |>.map Substring.toString |>.getD s
/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there,
or otherwise return `s`. -/
def stripSuffix (s : String) (suff : Substring) : String :=
s.dropSuffix? suff |>.map Substring.toString |>.getD s
end String
namespace Char

View File

@@ -121,7 +121,7 @@ def toUTF8 (a : @& String) : ByteArray :=
@[simp] theorem size_toUTF8 (s : String) : s.toUTF8.size = s.utf8ByteSize := by
simp [toUTF8, ByteArray.size, Array.size, utf8ByteSize, List.bind]
induction s.data <;> simp [List.map, List.flatten, utf8ByteSize.go, Nat.add_comm, *]
induction s.data <;> simp [List.map, List.join, utf8ByteSize.go, Nat.add_comm, *]
/-- Accesses a byte in the UTF-8 encoding of the `String`. O(1) -/
@[extern "lean_string_get_byte_fast"]

View File

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

View File

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

View File

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

View File

@@ -352,10 +352,10 @@ theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x,
@[simp] theorem exists_or_eq_left' (y : α) (p : α Prop) : x : α, y = x p x := y, .inl rfl
@[simp] theorem exists_or_eq_right' (y : α) (p : α Prop) : x : α, p x y = x := y, .inr rfl
theorem exists_prop' {p : Prop} : ( _ : α, p) Nonempty α p :=
@[simp] theorem exists_prop' {p : Prop} : ( _ : α, p) Nonempty α p :=
fun a, h => a, h, fun a, h => a, h
@[simp] theorem exists_prop : ( _h : a, b) a b :=
theorem exists_prop : ( _h : a, b) a b :=
fun hp, hq => hp, hq, fun hp, hq => hp, hq
@[simp] theorem exists_apply_eq_apply (f : α β) (a' : α) : a, f a = f a' := a', rfl
@@ -458,7 +458,7 @@ theorem Decidable.imp_iff_not_or [Decidable a] : (a → b) ↔ (¬a b) :=
theorem Decidable.imp_iff_or_not [Decidable b] : b a a ¬b :=
Decidable.imp_iff_not_or.trans or_comm
theorem Decidable.imp_or [Decidable a] : (a b c) (a b) (a c) :=
theorem Decidable.imp_or [h : Decidable a] : (a b c) (a b) (a c) :=
if h : a then by
rw [imp_iff_right h, imp_iff_right h, imp_iff_right h]
else by

View File

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

View File

@@ -149,27 +149,26 @@ syntax (name := assumption) "assumption" : tactic
/--
`contradiction` closes the main goal if its hypotheses are "trivially contradictory".
- Inductive type/family with no applicable constructors
```lean
example (h : False) : p := by contradiction
```
```lean
example (h : False) : p := by contradiction
```
- Injectivity of constructors
```lean
example (h : none = some true) : p := by contradiction --
```
```lean
example (h : none = some true) : p := by contradiction --
```
- Decidable false proposition
```lean
example (h : 2 + 2 = 3) : p := by contradiction
```
```lean
example (h : 2 + 2 = 3) : p := by contradiction
```
- Contradictory hypotheses
```lean
example (h : p) (h' : ¬ p) : q := by contradiction
```
```lean
example (h : p) (h' : ¬ p) : q := by contradiction
```
- Other simple contradictions such as
```lean
example (x : Nat) (h : x ≠ x) : p := by contradiction
```
```lean
example (x : Nat) (h : x ≠ x) : p := by contradiction
```
-/
syntax (name := contradiction) "contradiction" : tactic
@@ -364,24 +363,31 @@ syntax (name := fail) "fail" (ppSpace str)? : tactic
syntax (name := eqRefl) "eq_refl" : tactic
/--
This tactic applies to a goal whose target has the form `x ~ x`,
where `~` is equality, heterogeneous equality or any relation that
has a reflexivity lemma tagged with the attribute @[refl].
`rfl` tries to close the current goal using reflexivity.
This is supposed to be an extensible tactic and users can add their own support
for new reflexive relations.
Remark: `rfl` is an extensible tactic. We later add `macro_rules` to try different
reflexivity theorems (e.g., `Iff.rfl`).
-/
syntax "rfl" : tactic
macro "rfl" : tactic => `(tactic| case' _ => fail "The rfl tactic failed. Possible reasons:
- The goal is not a reflexive relation (neither `=` nor a relation with a @[refl] lemma).
- The arguments of the relation are not equal.
Try using the reflexivity lemma for your relation explicitly, e.g. `exact Eq.refl _` or
`exact HEq.rfl` etc.")
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
/--
The same as `rfl`, but without trying `eq_refl` at the end.
This tactic applies to a goal whose target has the form `x ~ x`,
where `~` is a reflexive relation other than `=`,
that is, a relation which has a reflexive lemma tagged with the attribute @[refl].
-/
syntax (name := applyRfl) "apply_rfl" : tactic
-- We try `apply_rfl` first, because it produces a nice error message
macro_rules | `(tactic| rfl) => `(tactic| apply_rfl)
-- But, mostly for backward compatibility, we try `eq_refl` too (reduces more aggressively)
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
-- Also for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
/--
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
theorems included (relevant for declarations defined by well-founded recursion).
@@ -788,7 +794,7 @@ syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
After `with`, there is an optional tactic that runs on all branches, and
then a list of alternatives.
-/
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
syntax inductionAlts := " with" (ppSpace tactic)? withPosition((colGe inductionAlt)+)
/--
Assuming `x` is a variable in the local context with an inductive type,
@@ -1159,9 +1165,6 @@ Currently the preprocessor is implemented as `try simp only [bv_toNat] at *`.
-/
macro "bv_omega" : tactic => `(tactic| (try simp only [bv_toNat] at *) <;> omega)
/-- Implementation of `ac_nf` (the full `ac_nf` calls `trivial` afterwards). -/
syntax (name := acNf0) "ac_nf0" (location)? : tactic
/-- Implementation of `norm_cast` (the full `norm_cast` calls `trivial` afterwards). -/
syntax (name := normCast0) "norm_cast0" (location)? : tactic
@@ -1212,24 +1215,6 @@ See also `push_cast`, which moves casts inwards rather than lifting them outward
macro "norm_cast" loc:(location)? : tactic =>
`(tactic| norm_cast0 $[$loc]? <;> try trivial)
/--
`ac_nf` normalizes equalities up to application of an associative and commutative operator.
- `ac_nf` normalizes all hypotheses and the goal target of the goal.
- `ac_nf at l` normalizes at location(s) `l`, where `l` is either `*` or a
list of hypotheses in the local context. In the latter case, a turnstile `⊢` or `|-`
can also be used, to signify the target of the goal.
```
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by
ac_nf
-- goal: a + (b + (c + d)) = a + (b + (c + d))
```
-/
macro "ac_nf" loc:(location)? : tactic =>
`(tactic| ac_nf0 $[$loc]? <;> try trivial)
/--
`push_cast` rewrites the goal to move certain coercions (*casts*) inward, toward the leaf nodes.
This uses `norm_cast` lemmas in the forward direction.

View File

@@ -249,8 +249,8 @@ theorem lex_def {r : αα → Prop} {s : β → β → Prop} {p q : α ×
Prod.Lex r s p q r p.1 q.1 p.1 = q.1 s p.2 q.2 :=
fun h => by cases h <;> simp [*], fun h =>
match p, q, h with
| _, _, Or.inl h => Lex.left _ _ h
| (_, _), (_, _), Or.inr e, h => by subst e; exact Lex.right _ h
| (a, b), (c, d), Or.inl h => Lex.left _ _ h
| (a, b), (c, d), Or.inr e, h => by subst e; exact Lex.right _ h
namespace Lex

View File

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

View File

@@ -305,16 +305,15 @@ def registerAttributeImplBuilder (builderId : Name) (builder : AttributeImplBuil
if table.contains builderId then throw (IO.userError ("attribute implementation builder '" ++ toString builderId ++ "' has already been declared"))
attributeImplBuilderTableRef.modify fun table => table.insert builderId builder
structure AttributeExtensionOLeanEntry where
builderId : Name
ref : Name
args : List DataValue
def mkAttributeImplOfEntry (e : AttributeExtensionOLeanEntry) : IO AttributeImpl := do
def mkAttributeImplOfBuilder (builderId ref : Name) (args : List DataValue) : IO AttributeImpl := do
let table attributeImplBuilderTableRef.get
match table[e.builderId]? with
| none => throw (IO.userError ("unknown attribute implementation builder '" ++ toString e.builderId ++ "'"))
| some builder => IO.ofExcept <| builder e.ref e.args
match table[builderId]? with
| none => throw (IO.userError ("unknown attribute implementation builder '" ++ toString builderId ++ "'"))
| some builder => IO.ofExcept <| builder ref args
inductive AttributeExtensionOLeanEntry where
| decl (declName : Name) -- `declName` has type `AttributeImpl`
| builder (builderId ref : Name) (args : List DataValue)
structure AttributeExtensionState where
newEntries : List AttributeExtensionOLeanEntry := []
@@ -338,13 +337,19 @@ unsafe def mkAttributeImplOfConstantUnsafe (env : Environment) (opts : Options)
@[implemented_by mkAttributeImplOfConstantUnsafe]
opaque mkAttributeImplOfConstant (env : Environment) (opts : Options) (declName : Name) : Except String AttributeImpl
def mkAttributeImplOfEntry (env : Environment) (opts : Options) (e : AttributeExtensionOLeanEntry) : IO AttributeImpl :=
match e with
| .decl declName => IO.ofExcept <| mkAttributeImplOfConstant env opts declName
| .builder builderId ref args => mkAttributeImplOfBuilder builderId ref args
private def AttributeExtension.addImported (es : Array (Array AttributeExtensionOLeanEntry)) : ImportM AttributeExtensionState := do
let ctx read
let map attributeMapRef.get
let map es.foldlM
(fun map entries =>
entries.foldlM
(fun (map : Std.HashMap Name AttributeImpl) entry => do
let attrImpl mkAttributeImplOfEntry entry
let attrImpl mkAttributeImplOfEntry ctx.env ctx.opts entry
return map.insert attrImpl.name attrImpl)
map)
map
@@ -395,13 +400,19 @@ def getAttributeImpl (env : Environment) (attrName : Name) : Except String Attri
| some attr => pure attr
| none => throw ("unknown attribute '" ++ toString attrName ++ "'")
def registerAttributeOfDecl (env : Environment) (opts : Options) (attrDeclName : Name) : Except String Environment := do
let attrImpl mkAttributeImplOfConstant env opts attrDeclName
if isAttribute env attrImpl.name then
throw ("invalid builtin attribute declaration, '" ++ toString attrImpl.name ++ "' has already been used")
else
return attributeExtension.addEntry env (.decl attrDeclName, attrImpl)
def registerAttributeOfBuilder (env : Environment) (builderId ref : Name) (args : List DataValue) : IO Environment := do
let entry := {builderId, ref, args}
let attrImpl mkAttributeImplOfEntry entry
let attrImpl mkAttributeImplOfBuilder builderId ref args
if isAttribute env attrImpl.name then
throw (IO.userError ("invalid builtin attribute declaration, '" ++ toString attrImpl.name ++ "' has already been used"))
else
return attributeExtension.addEntry env (entry, attrImpl)
return attributeExtension.addEntry env (.builder builderId ref args, attrImpl)
def Attribute.add (declName : Name) (attrName : Name) (stx : Syntax) (kind := AttributeKind.global) : AttrM Unit := do
let attr ofExcept <| getAttributeImpl ( getEnv) attrName

View File

@@ -20,18 +20,18 @@ def ensureHasDefault (alts : Array Alt) : Array Alt :=
private def getOccsOf (alts : Array Alt) (i : Nat) : Nat := Id.run do
let aBody := (alts.get! i).body
let mut n := 1
for h : j in [i+1:alts.size] do
if alts[j].body == aBody then
for j in [i+1:alts.size] do
if alts[j]!.body == aBody then
n := n+1
return n
private def maxOccs (alts : Array Alt) : Alt × Nat := Id.run do
let mut maxAlt := alts[0]!
let mut max := getOccsOf alts 0
for h : i in [1:alts.size] do
for i in [1:alts.size] do
let curr := getOccsOf alts i
if curr > max then
maxAlt := alts[i]
maxAlt := alts[i]!
max := curr
return (maxAlt, max)

View File

@@ -110,8 +110,8 @@ def isCtorParam (f : Expr) (i : Nat) : CoreM Bool := do
def checkAppArgs (f : Expr) (args : Array Arg) : CheckM Unit := do
let mut fType inferType f
let mut j := 0
for h : i in [:args.size] do
let arg := args[i]
for i in [:args.size] do
let arg := args[i]!
if fType.isErased then
return ()
fType := fType.headBeta

View File

@@ -505,8 +505,8 @@ ones. Return whether any `Value` got updated in the process.
-/
def inferStep : InterpM Bool := do
let ctx read
for h : idx in [0:ctx.decls.size] do
let decl := ctx.decls[idx]
for idx in [0:ctx.decls.size] do
let decl := ctx.decls[idx]!
if !decl.safe then
continue

View File

@@ -48,8 +48,8 @@ def hasTrivialStructure? (declName : Name) : CoreM (Option TrivialStructureInfo)
let [ctorName] := info.ctors | return none
let mask getRelevantCtorFields ctorName
let mut result := none
for h : i in [:mask.size] do
if mask[i] then
for i in [:mask.size] do
if mask[i]! then
if result.isSome then return none
result := some { ctorName, fieldIdx := i, numParams := info.numParams }
return result
@@ -129,4 +129,4 @@ def getOtherDeclMonoType (declName : Name) : CoreM Expr := do
modifyEnv fun env => monoTypeExt.modifyState env fun s => { s with mono := s.mono.insert declName type }
return type
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -96,9 +96,9 @@ where
unless ( visited i) do
modify fun (k, visited) => (k, visited.set! i true)
let pi := ps[i]!
for h : j in [:ps.size] do
for j in [:ps.size] do
unless ( visited j) do
let pj := ps[j]
let pj := ps[j]!
if pj.used.contains pi.decl.fvarId then
visit j
modify fun (k, visited) => (pi.attach k, visited)

View File

@@ -18,10 +18,10 @@ or not.
private def getMaxOccs (alts : Array Alt) : Alt × Nat := Id.run do
let mut maxAlt := alts[0]!
let mut max := getNumOccsOf alts 0
for h : i in [1:alts.size] do
for i in [1:alts.size] do
let curr := getNumOccsOf alts i
if curr > max then
maxAlt := alts[i]
maxAlt := alts[i]!
max := curr
return (maxAlt, max)
where
@@ -34,8 +34,8 @@ where
getNumOccsOf (alts : Array Alt) (i : Nat) : Nat := Id.run do
let code := alts[i]!.getCode
let mut n := 1
for h : j in [i+1:alts.size] do
if Code.alphaEqv alts[j].getCode code then
for j in [i+1:alts.size] do
if Code.alphaEqv alts[j]!.getCode code then
n := n+1
return n

View File

@@ -121,8 +121,8 @@ where
let mut paramsNew := #[]
let singleton : FVarIdSet := ({} : FVarIdSet).insert params[targetParamIdx]!.fvarId
let dependsOnDiscr := k.dependsOn singleton || decls.any (·.dependsOn singleton)
for h : i in [:params.size] do
let param := params[i]
for i in [:params.size] do
let param := params[i]!
if targetParamIdx == i then
if dependsOnDiscr then
paramsNew := paramsNew.push ( internalizeParam param)
@@ -300,3 +300,4 @@ builtin_initialize
registerTraceClass `Compiler.simp.jpCases
end Lean.Compiler.LCNF

View File

@@ -129,9 +129,9 @@ See comment at `.fixedNeutral`.
-/
private def hasFwdDeps (decl : Decl) (paramsInfo : Array SpecParamInfo) (j : Nat) : Bool := Id.run do
let param := decl.params[j]!
for h : k in [j+1 : decl.params.size] do
for k in [j+1 : decl.params.size] do
if paramsInfo[k]! matches .user | .fixedHO | .fixedInst then
let param' := decl.params[k]
let param' := decl.params[k]!
if param'.type.containsFVar param.fvarId then
return true
return false
@@ -214,3 +214,4 @@ builtin_initialize
registerTraceClass `Compiler.specialize.info
end Lean.Compiler.LCNF

View File

@@ -50,9 +50,9 @@ partial def inlineMatchers (e : Expr) : CoreM Expr :=
let numAlts := info.numAlts
let altNumParams := info.altNumParams
let rec inlineMatcher (i : Nat) (args : Array Expr) (letFVars : Array Expr) : MetaM Expr := do
if h : i < numAlts then
if i < numAlts then
let altIdx := i + info.getFirstAltPos
let numParams := altNumParams[i]
let numParams := altNumParams[i]!
let alt normalizeAlt args[altIdx]! numParams
Meta.withLetDecl ( mkFreshUserName `_alt) ( Meta.inferType alt) alt fun altFVar =>
inlineMatcher (i+1) (args.set! altIdx altFVar) (letFVars.push altFVar)

View File

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

View File

@@ -41,18 +41,6 @@ structure InsertReplaceEdit where
replace : Range
deriving FromJson, ToJson
inductive CompletionItemTag where
| deprecated
deriving Inhabited, DecidableEq, Repr
instance : ToJson CompletionItemTag where
toJson t := toJson (t.toCtorIdx + 1)
instance : FromJson CompletionItemTag where
fromJson? v := do
let i : Nat fromJson? v
return CompletionItemTag.ofNat (i-1)
structure CompletionItem where
label : String
detail? : Option String := none
@@ -61,8 +49,8 @@ structure CompletionItem where
textEdit? : Option InsertReplaceEdit := none
sortText? : Option String := none
data? : Option Json := none
tags? : Option (Array CompletionItemTag) := none
/-
tags? : CompletionItemTag[]
deprecated? : boolean
preselect? : boolean
filterText? : string
@@ -71,8 +59,7 @@ structure CompletionItem where
insertTextMode? : InsertTextMode
additionalTextEdits? : TextEdit[]
commitCharacters? : string[]
command? : Command
-/
command? : Command -/
deriving FromJson, ToJson, Inhabited
structure CompletionList where

View File

@@ -76,7 +76,7 @@ partial def upsert (t : Trie α) (s : String) (f : Option αα) : Trie α :
let c := s.getUtf8Byte i h
if c == c'
then node1 v c' (loop (i + 1) t')
else
else
let t := insertEmpty (i + 1)
node v (.mk #[c, c']) #[t, t']
else
@@ -190,7 +190,7 @@ private partial def toStringAux {α : Type} : Trie α → List Format
| node1 _ c t =>
[ format (repr c), Format.group $ Format.nest 4 $ flip Format.joinSep Format.line $ toStringAux t ]
| node _ cs ts =>
List.flatten $ List.zipWith (fun c t =>
List.join $ List.zipWith (fun c t =>
[ format (repr c), (Format.group $ Format.nest 4 $ flip Format.joinSep Format.line $ toStringAux t) ]
) cs.toList ts.toList

View File

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

View File

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

View File

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

View File

@@ -411,23 +411,21 @@ private def finalize : M Expr := do
synthesizeAppInstMVars
return e
/--
Returns a named argument that depends on the next argument, otherwise `none`.
-/
private def findNamedArgDependsOnCurrent? : M (Option NamedArg) := do
/-- Return `true` if there is a named argument that depends on the next argument. -/
private def anyNamedArgDependsOnCurrent : M Bool := do
let s get
if s.namedArgs.isEmpty then
return none
return false
else
forallTelescopeReducing s.fType fun xs _ => do
let curr := xs[0]!
for h : i in [1:xs.size] do
let xDecl xs[i].fvarId!.getDecl
if let some arg := s.namedArgs.find? fun arg => arg.name == xDecl.userName then
for i in [1:xs.size] do
let xDecl xs[i]!.fvarId!.getDecl
if s.namedArgs.any fun arg => arg.name == xDecl.userName then
/- Remark: a default value at `optParam` does not count as a dependency -/
if ( exprDependsOn xDecl.type.cleanupAnnotations curr.fvarId!) then
return arg
return none
return true
return false
/-- Return `true` if there are regular or named arguments to be processed. -/
@@ -435,13 +433,11 @@ private def hasArgsToProcess : M Bool := do
let s get
return !s.args.isEmpty || !s.namedArgs.isEmpty
/--
Returns the argument syntax if the next argument at `args` is of the form `_`.
-/
private def nextArgHole? : M (Option Syntax) := do
/-- Return `true` if the next argument at `args` is of the form `_` -/
private def isNextArgHole : M Bool := do
match ( get).args with
| Arg.stx stx@(Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure stx
| _ => pure none
| Arg.stx (Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure true
| _ => pure false
/--
Return `true` if the next argument to be processed is the outparam of a local instance, and it the result type
@@ -516,9 +512,8 @@ where
mutual
/--
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
and then execute the main loop.
-/
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
and then execute the main loop.-/
private partial def addEtaArg (argName : Name) : M Expr := do
let n getBindingName
let type getArgExpectedType
@@ -527,9 +522,6 @@ mutual
addNewArg argName x
main
/--
Create a fresh metavariable for the implicit argument, add it to `f`, and then execute the main loop.
-/
private partial def addImplicitArg (argName : Name) : M Expr := do
let argType getArgExpectedType
let arg if ( isNextOutParamOfLocalInstanceAndResult) then
@@ -547,47 +539,35 @@ mutual
main
/--
Process a `fType` of the form `(x : A) → B x`.
This method assume `fType` is a function type.
-/
Process a `fType` of the form `(x : A) → B x`.
This method assume `fType` is a function type -/
private partial def processExplicitArg (argName : Name) : M Expr := do
match ( get).args with
| arg::args =>
-- Note: currently the following test never succeeds in explicit mode since `@x.f` notation does not exist.
if let some true := NamedArg.suppressDeps <$> ( findNamedArgDependsOnCurrent?) then
if ( anyNamedArgDependsOnCurrent) then
/-
We treat the explicit argument `argName` as implicit
if we have a named arguments that depends on it whose `suppressDeps` flag set to `true`.
The motivation for this is class projections (issue #1851).
In some cases, class projections can have explicit parameters. For example, in
We treat the explicit argument `argName` as implicit if we have named arguments that depend on it.
The idea is that this explicit argument can be inferred using the type of the named argument one.
Note that we also use this approach in the branch where there are no explicit arguments left.
This is important to make sure the system behaves in a uniform way.
Moreover, users rely on this behavior. For example, consider the example on issue #1851
```
class Approx {α : Type} (a : α) (X : Type) : Type where
val : X
```
the type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`.
Note that the parameter `a` is explicit since there is no way to infer it from the expected
type or from the types of other explicit parameters.
Being a parameter of the class, `a` is determined by the type of `self`.
Consider
```
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)]
```
Recall that `f.val` is, to first approximation, sugar for `Approx.val (self := f)`.
Without further refinement, this would expand to `fun f'' : α → β => Approx.val f'' f`,
which is a type error, since `f''` must be defeq to `f'`.
Furthermore, with projection notation, users expect all structure parameters
to be uniformly implicit; after all, they are determined by `self`.
To handle this, the `(self := f)` named argument is annotated with the `suppressDeps` flag.
This causes the `a` parameter to become implicit, and `f.val` instead expands to `Approx.val f' f`.
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)] [x : Approx x' X]
This feature previously was enabled for *all* explicit arguments, which confused users
and was frequently reported as a bug (issue #1867).
Now it is only enabled for the `self` argument in structure projections.
We used to do this only when `(← get).args` was empty,
but it created an asymmetry because `f.val` worked as expected,
yet one would have to write `f.val _ x` when there are further arguments.
#check f.val
#check f.val x.val
```
The type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`
Note that the argument `a` is explicit since there is no way to infer it from the expected
type or the type of other explicit arguments.
Recall that `f.val` is sugar for `Approx.val (self := f)`. In both `#check` commands above
the user assumed that `a` does not need to be provided since it can be inferred from the type
of `self`.
We used to that only in the branch where `(← get).args` was empty, but it created an asymmetry
because `#check f.val` worked as expected, but one would have to write `#check f.val _ x.val`
-/
return ( addImplicitArg argName)
propagateExpectedType arg
@@ -604,6 +584,7 @@ mutual
match evalSyntaxConstant env opts tacticDecl with
| Except.error err => throwError err
| Except.ok tacticSyntax =>
-- TODO(Leo): does this work correctly for tactic sequences?
let tacticBlock `(by $(tacticSyntax))
/-
We insert position information from the current ref into `stx` everywhere, simulating this being
@@ -615,32 +596,24 @@ mutual
-/
let info := ( getRef).getHeadInfo
let tacticBlock := tacticBlock.raw.rewriteBottomUp (·.setInfo info)
let mvar mkTacticMVar argType.consumeTypeAnnotations tacticBlock (.autoParam argName)
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
-- We should look into removing this since terminfo for synthetic syntax is suspect,
-- but we noted it was necessary to preserve the behavior of the unused variable linter.
addTermInfo' tacticBlock mvar
let argNew := Arg.expr mvar
let argNew := Arg.stx tacticBlock
propagateExpectedType argNew
elabAndAddNewArg argName argNew
main
| false, _, some _ =>
throwError "invalid autoParam, argument must be a constant"
| _, _, _ =>
if ( read).ellipsis then
addImplicitArg argName
else if !( get).namedArgs.isEmpty then
if let some _ findNamedArgDependsOnCurrent? then
/-
Dependencies of named arguments cannot be turned into eta arguments
since they are determined by the named arguments.
Instead we can turn them into implicit arguments.
-/
if !( get).namedArgs.isEmpty then
if ( anyNamedArgDependsOnCurrent) then
addImplicitArg argName
else if ( read).ellipsis then
addImplicitArg argName
else
addEtaArg argName
else if !( read).explicit then
if ( fTypeHasOptAutoParams) then
if ( read).ellipsis then
addImplicitArg argName
else if ( fTypeHasOptAutoParams) then
addEtaArg argName
else
finalize
@@ -668,30 +641,24 @@ mutual
finalize
/--
Process a `fType` of the form `[x : A] → B x`.
This method assume `fType` is a function type.
-/
Process a `fType` of the form `[x : A] → B x`.
This method assume `fType` is a function type -/
private partial def processInstImplicitArg (argName : Name) : M Expr := do
if ( read).explicit then
if let some stx nextArgHole? then
-- We still use typeclass resolution for `_` arguments.
-- This behavior can be suppressed with `(_)`.
let ty getArgExpectedType
let arg mkInstMVar ty
addTermInfo' stx arg ty
if ( isNextArgHole) then
/- Recall that if '@' has been used, and the argument is '_', then we still use type class resolution -/
let arg mkFreshExprMVar ( getArgExpectedType) MetavarKind.synthetic
modify fun s => { s with args := s.args.tail! }
addInstMVar arg.mvarId!
addNewArg argName arg
main
else
processExplicitArg argName
else
discard <| mkInstMVar ( getArgExpectedType)
main
where
mkInstMVar (ty : Expr) : M Expr := do
let arg mkFreshExprMVar ty MetavarKind.synthetic
let arg mkFreshExprMVar ( getArgExpectedType) MetavarKind.synthetic
addInstMVar arg.mvarId!
addNewArg argName arg
return arg
main
/-- Elaborate function application arguments. -/
partial def main : M Expr := do
@@ -722,104 +689,6 @@ end
end ElabAppArgs
/-! # Eliminator-like function application elaborator -/
/--
Information about an eliminator used by the elab-as-elim elaborator.
This is not to be confused with `Lean.Meta.ElimInfo`, which is for `induction` and `cases`.
The elab-as-elim routine is less restrictive in what counts as an eliminator, and it doesn't need
to have a strict notion of what is a "target" — all it cares about are
1. that the return type of a function is of the form `m ...` where `m` is a parameter
(unlike `induction` and `cases` eliminators, the arguments to `m`, known as "discriminants",
can be any expressions, not just parameters), and
2. which arguments should be eagerly elaborated, to make discriminants be as elaborated as
possible for the expected type generalization procedure,
and which should be postponed (since they are the "minor premises").
Note that the routine isn't doing induction/cases *on* particular expressions.
The purpose of elab-as-elim is to successfully solve the higher-order unification problem
between the return type of the function and the expected type.
-/
structure ElabElimInfo where
/-- The eliminator. -/
elimExpr : Expr
/-- The type of the eliminator. -/
elimType : Expr
/-- The position of the motive parameter. -/
motivePos : Nat
/--
Positions of "major" parameters (those that should be eagerly elaborated
because they can contribute to the motive inference procedure).
All parameters that are neither the motive nor a major parameter are "minor" parameters.
The major parameters include all of the parameters that transitively appear in the motive's arguments,
as well as "first-order" arguments that include such parameters,
since they too can help with elaborating discriminants.
For example, in the following theorem the argument `h : a = b`
should be elaborated eagerly because it contains `b`, which occurs in `motive b`.
```
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
```
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
argument `α` to be elaborated eagerly to create a type-correct motive.
```
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
```
-/
majorsPos : Array Nat := #[]
deriving Repr, Inhabited
def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
let elimType inferType elimExpr
trace[Elab.app.elab_as_elim] "eliminator {indentExpr elimExpr}\nhas type{indentExpr elimType}"
forallTelescopeReducing elimType fun xs type => do
let motive := type.getAppFn
let motiveArgs := type.getAppArgs
unless motive.isFVar && motiveArgs.size > 0 do
throwError "unexpected eliminator resulting type{indentExpr type}"
let motiveType inferType motive
forallTelescopeReducing motiveType fun motiveParams motiveResultType => do
unless motiveParams.size == motiveArgs.size do
throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
unless motiveResultType.isSort do
throwError "motive result type must be a sort{indentExpr motiveType}"
let some motivePos pure (xs.indexOf? motive) |
throwError "unexpected eliminator type{indentExpr elimType}"
/-
Compute transitive closure of fvars appearing in arguments to the motive.
These are the primary set of major parameters.
-/
let initMotiveFVars : CollectFVars.State := motiveArgs.foldl (init := {}) collectFVars
let motiveFVars xs.size.foldRevM (init := initMotiveFVars) fun i s => do
let x := xs[i]!
if s.fvarSet.contains x.fvarId! then
return collectFVars s ( inferType x)
else
return s
/- Collect the major parameter positions -/
let mut majorsPos := #[]
for h : i in [:xs.size] do
let x := xs[i]
unless motivePos == i do
let xType x.fvarId!.getType
/-
We also consider "first-order" types because we can reliably "extract" information from them.
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
-/
let isFirstOrder (e : Expr) : Bool := Option.isNone <| e.find? fun e => e.isApp && !e.getAppFn.isConst
if motiveFVars.fvarSet.contains x.fvarId!
|| (isFirstOrder xType
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
majorsPos := majorsPos.push i
trace[Elab.app.elab_as_elim] "motivePos: {motivePos}"
trace[Elab.app.elab_as_elim] "majorsPos: {majorsPos}"
return { elimExpr, elimType, motivePos, majorsPos }
def getElabElimInfo (elimName : Name) : MetaM ElabElimInfo := do
getElabElimExprInfo ( mkConstWithFreshMVarLevels elimName)
builtin_initialize elabAsElim : TagAttribute
registerTagAttribute `elab_as_elim
"instructs elaborator that the arguments of the function application should be elaborated as were an eliminator"
@@ -834,15 +703,33 @@ builtin_initialize elabAsElim : TagAttribute ←
let info getConstInfo declName
if ( hasOptAutoParams info.type) then
throwError "[elab_as_elim] attribute cannot be used in declarations containing optional and auto parameters"
discard <| getElabElimInfo declName
discard <| getElimInfo declName
go.run' {} {}
/-! # Eliminator-like function application elaborator -/
namespace ElabElim
/-- Context of the `elab_as_elim` elaboration procedure. -/
structure Context where
elimInfo : ElabElimInfo
elimInfo : ElimInfo
expectedType : Expr
/--
Position of additional arguments that should be elaborated eagerly
because they can contribute to the motive inference procedure.
For example, in the following theorem the argument `h : a = b`
should be elaborated eagerly because it contains `b` which occurs
in `motive b`.
```
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
```
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
argument `α` to be elaborated eagerly to create a type-correct motive.
```
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
```
-/
extraArgsPos : Array Nat
/-- State of the `elab_as_elim` elaboration procedure. -/
structure State where
@@ -854,6 +741,8 @@ structure State where
namedArgs : List NamedArg
/-- User-provided arguments that still have to be processed. -/
args : List Arg
/-- Discriminants (targets) processed so far. -/
discrs : Array (Option Expr)
/-- Instance implicit arguments collected so far. -/
instMVars : Array MVarId := #[]
/-- Position of the next argument to be processed. We use it to decide whether the argument is the motive or a discriminant. -/
@@ -899,7 +788,7 @@ def finalize : M Expr := do
let some motive := ( get).motive?
| throwError "failed to elaborate eliminator, insufficient number of arguments"
trace[Elab.app.elab_as_elim] "motive: {motive}"
forallTelescope ( get).fType fun xs fType => do
forallTelescope ( get).fType fun xs _ => do
trace[Elab.app.elab_as_elim] "xs: {xs}"
let mut expectedType := ( read).expectedType
trace[Elab.app.elab_as_elim] "expectedType:{indentD expectedType}"
@@ -908,7 +797,6 @@ def finalize : M Expr := do
let mut f := ( get).f
if xs.size > 0 then
-- under-application, specialize the expected type using `xs`
-- Note: if we ever wanted to support optParams and autoParams, this is where it could be.
assert! ( get).args.isEmpty
for x in xs do
let .forallE _ t b _ whnf expectedType | throwInsufficient
@@ -925,11 +813,18 @@ def finalize : M Expr := do
trace[Elab.app.elab_as_elim] "expectedType after processing:{indentD expectedType}"
let result := mkAppN f xs
trace[Elab.app.elab_as_elim] "result:{indentD result}"
unless fType.getAppFn == ( get).motive? do
throwError "Internal error, eliminator target type isn't an application of the motive"
let discrs := fType.getAppArgs
trace[Elab.app.elab_as_elim] "discrs: {discrs}"
let motiveVal mkMotive discrs expectedType
let mut discrs := ( get).discrs
let idx := ( get).idx
if discrs.any Option.isNone then
for i in [idx:idx + xs.size], x in xs do
if let some tidx := ( read).elimInfo.targetsPos.indexOf? i then
discrs := discrs.set! tidx x
if let some idx := discrs.findIdx? Option.isNone then
-- This should not happen.
trace[Elab.app.elab_as_elim] "Internal error, missing target with index {idx}"
throwError "failed to elaborate eliminator, insufficient number of arguments"
trace[Elab.app.elab_as_elim] "discrs: {discrs.map Option.get!}"
let motiveVal mkMotive (discrs.map Option.get!) expectedType
unless ( isTypeCorrect motiveVal) do
throwError "failed to elaborate eliminator, motive is not type correct:{indentD motiveVal}"
unless ( isDefEq motive motiveVal) do
@@ -963,6 +858,10 @@ def getNextArg? (binderName : Name) (binderInfo : BinderInfo) : M (LOption Arg)
def setMotive (motive : Expr) : M Unit :=
modify fun s => { s with motive? := motive }
/-- Push the given expression into the `discrs` field in the state, where `i` is which target it is for. -/
def addDiscr (i : Nat) (discr : Expr) : M Unit :=
modify fun s => { s with discrs := s.discrs.set! i discr }
/-- Elaborate the given argument with the given expected type. -/
private def elabArg (arg : Arg) (argExpectedType : Expr) : M Expr := do
match arg with
@@ -1005,13 +904,18 @@ partial def main : M Expr := do
mkImplicitArg binderType binderInfo
setMotive motive
addArgAndContinue motive
else if ( read).elimInfo.majorsPos.contains idx then
else if let some tidx := ( read).elimInfo.targetsPos.indexOf? idx then
match ( getNextArg? binderName binderInfo) with
| .some arg => let discr elabArg arg binderType; addArgAndContinue discr
| .some arg => let discr elabArg arg binderType; addDiscr tidx discr; addArgAndContinue discr
| .undef => finalize
| .none => let discr mkImplicitArg binderType binderInfo; addArgAndContinue discr
| .none => let discr mkImplicitArg binderType binderInfo; addDiscr tidx discr; addArgAndContinue discr
else match ( getNextArg? binderName binderInfo) with
| .some (.stx stx) => addArgAndContinue ( postponeElabTerm stx binderType)
| .some (.stx stx) =>
if ( read).extraArgsPos.contains idx then
let arg elabArg (.stx stx) binderType
addArgAndContinue arg
else
addArgAndContinue ( postponeElabTerm stx binderType)
| .some (.expr val) => addArgAndContinue ( ensureArgType ( get).f val binderType)
| .undef => finalize
| .none => addArgAndContinue ( mkImplicitArg binderType binderInfo)
@@ -1065,10 +969,13 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
let some expectedType := expectedType? | throwError "failed to elaborate eliminator, expected type is not available"
let expectedType instantiateMVars expectedType
if expectedType.getAppFn.isMVar then throwError "failed to elaborate eliminator, expected type is not available"
ElabElim.main.run { elimInfo, expectedType } |>.run' {
let extraArgsPos getElabAsElimExtraArgsPos elimInfo
trace[Elab.app.elab_as_elim] "extraArgsPos: {extraArgsPos}"
ElabElim.main.run { elimInfo, expectedType, extraArgsPos } |>.run' {
f, fType
args := args.toList
namedArgs := namedArgs.toList
discrs := mkArray elimInfo.targetsPos.size none
}
else
ElabAppArgs.main.run { explicit, ellipsis, resultIsOutParamSupport } |>.run' {
@@ -1079,12 +986,12 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
}
where
/-- Return `some info` if we should elaborate as an eliminator. -/
elabAsElim? : TermElabM (Option ElabElimInfo) := do
elabAsElim? : TermElabM (Option ElimInfo) := do
unless ( read).heedElabAsElim do return none
if explicit || ellipsis then return none
let .const declName _ := f | return none
unless ( shouldElabAsElim declName) do return none
let elimInfo getElabElimInfo declName
let elimInfo getElimInfo declName
forallTelescopeReducing ( inferType f) fun xs _ => do
/- Process arguments similar to `Lean.Elab.Term.ElabElim.main` to see if the motive has been
provided, in which case we use the standard app elaborator.
@@ -1115,20 +1022,47 @@ where
return none
| _, _ => return some elimInfo
/--
Collect extra argument positions that must be elaborated eagerly when using `elab_as_elim`.
The idea is that they contribute to motive inference. See comment at `ElamElim.Context.extraArgsPos`.
-/
getElabAsElimExtraArgsPos (elimInfo : ElimInfo) : MetaM (Array Nat) := do
forallTelescope elimInfo.elimType fun xs type => do
let targets := type.getAppArgs
/- Compute transitive closure of fvars appearing in the motive and the targets. -/
let initMotiveFVars : CollectFVars.State := targets.foldl (init := {}) collectFVars
let motiveFVars xs.size.foldRevM (init := initMotiveFVars) fun i s => do
let x := xs[i]!
if elimInfo.motivePos == i || elimInfo.targetsPos.contains i || s.fvarSet.contains x.fvarId! then
return collectFVars s ( inferType x)
else
return s
/- Collect the extra argument positions -/
let mut extraArgsPos := #[]
for i in [:xs.size] do
let x := xs[i]!
unless elimInfo.motivePos == i || elimInfo.targetsPos.contains i do
let xType x.fvarId!.getType
/- We only consider "first-order" types because we can reliably "extract" information from them. -/
if motiveFVars.fvarSet.contains x.fvarId!
|| (isFirstOrder xType
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
extraArgsPos := extraArgsPos.push i
return extraArgsPos
/-
Helper function for implementing `elab_as_elim`.
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
-/
isFirstOrder (e : Expr) : Bool :=
Option.isNone <| e.find? fun e =>
e.isApp && !e.getAppFn.isConst
/-- Auxiliary inductive datatype that represents the resolution of an `LVal`. -/
inductive LValResolution where
/-- When applied to `f`, effectively expands to `BaseStruct.fieldName (self := Struct.toBase f)`.
This is a special named argument where it suppresses any explicit arguments depending on it so that type parameters don't need to be supplied. -/
| projFn (baseStructName : Name) (structName : Name) (fieldName : Name)
/-- Similar to `projFn`, but for extracting field indexed by `idx`. Works for structure-like inductive types in general. -/
| projIdx (structName : Name) (idx : Nat)
/-- When applied to `f`, effectively expands to `constName ... (Struct.toBase f)`, with the argument placed in the correct
positional argument if possible, or otherwise as a named argument. The `Struct.toBase` is not present if `baseStructName == structName`,
in which case these do not need to be structures. Supports generalized field notation. -/
| const (baseStructName : Name) (structName : Name) (constName : Name)
/-- Like `const`, but with `fvar` instead of `constName`.
The `fullName` is the name of the recursive function, and `baseName` is the base name of the type to search for in the parameter list. -/
| localRec (baseName : Name) (fullName : Name) (fvar : Expr)
private def throwLValError (e : Expr) (eType : Expr) (msg : MessageData) : TermElabM α :=
@@ -1287,7 +1221,7 @@ private partial def mkBaseProjections (baseStructName : Name) (structName : Name
let mut e := e
for projFunName in path do
let projFn mkConst projFunName
e elabAppArgs projFn #[{ name := `self, val := Arg.expr e, suppressDeps := true }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
e elabAppArgs projFn #[{ name := `self, val := Arg.expr e }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
return e
private def typeMatchesBaseName (type : Expr) (baseName : Name) : MetaM Bool := do
@@ -1298,70 +1232,45 @@ private def typeMatchesBaseName (type : Expr) (baseName : Name) : MetaM Bool :=
else
return ( whnfR type).isAppOf baseName
/--
Auxiliary method for field notation. Tries to add `e` as a new argument to `args` or `namedArgs`.
This method first finds the parameter with a type of the form `(baseName ...)`.
When the parameter is found, if it an explicit one and `args` is big enough, we add `e` to `args`.
Otherwise, if there isn't another parameter with the same name, we add `e` to `namedArgs`.
/-- Auxiliary method for field notation. It tries to add `e` as a new argument to `args` or `namedArgs`.
This method first finds the parameter with a type of the form `(baseName ...)`.
When the parameter is found, if it an explicit one and `args` is big enough, we add `e` to `args`.
Otherwise, if there isn't another parameter with the same name, we add `e` to `namedArgs`.
Remark: `fullName` is the name of the resolved "field" access function. It is used for reporting errors
-/
private partial def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (f : Expr) :
MetaM (Array Arg × Array NamedArg) := do
withoutModifyingState <| go f ( inferType f) 0 namedArgs (namedArgs.map (·.name)) true
where
/--
* `argIdx` is the position into `args` for the next place an explicit argument can be inserted.
* `remainingNamedArgs` keeps track of named arguments that haven't been visited yet,
for handling the case where multiple parameters have the same name.
* `unusableNamedArgs` keeps track of names that can't be used as named arguments. This is initialized with user-provided named arguments.
* `allowNamed` is whether or not to allow using named arguments.
Disabled after using `CoeFun` since those parameter names unlikely to be meaningful,
and otherwise whether dot notation works or not could feel random.
-/
go (f fType : Expr) (argIdx : Nat) (remainingNamedArgs : Array NamedArg) (unusableNamedArgs : Array Name) (allowNamed : Bool) := withIncRecDepth do
/- Use metavariables (rather than `forallTelescope`) to prevent `coerceToFunction?` from succeeding when multiple instances could apply -/
let (xs, bInfos, fType') forallMetaTelescope fType
let mut argIdx := argIdx
let mut remainingNamedArgs := remainingNamedArgs
let mut unusableNamedArgs := unusableNamedArgs
for x in xs, bInfo in bInfos do
let xDecl x.mvarId!.getDecl
if let some idx := remainingNamedArgs.findIdx? (·.name == xDecl.userName) then
/- If there is named argument with name `xDecl.userName`, then it is accounted for and we can't make use of it. -/
Remark: `fullName` is the name of the resolved "field" access function. It is used for reporting errors -/
private def addLValArg (baseName : Name) (fullName : Name) (e : Expr) (args : Array Arg) (namedArgs : Array NamedArg) (fType : Expr)
: TermElabM (Array Arg × Array NamedArg) :=
forallTelescopeReducing fType fun xs _ => do
let mut argIdx := 0 -- position of the next explicit argument
let mut remainingNamedArgs := namedArgs
for i in [:xs.size] do
let x := xs[i]!
let xDecl x.fvarId!.getDecl
/- If there is named argument with name `xDecl.userName`, then we skip it. -/
match remainingNamedArgs.findIdx? (fun namedArg => namedArg.name == xDecl.userName) with
| some idx =>
remainingNamedArgs := remainingNamedArgs.eraseIdx idx
else
if ( typeMatchesBaseName xDecl.type baseName) then
| none =>
let type := xDecl.type
if ( typeMatchesBaseName type baseName) then
/- We found a type of the form (baseName ...).
First, we check if the current argument is an explicit one,
and if the current explicit position "fits" at `args` (i.e., it must be ≤ arg.size) -/
if argIdx args.size && bInfo.isExplicit then
/- We can insert `e` as an explicit argument -/
and the current explicit position "fits" at `args` (i.e., it must be ≤ arg.size) -/
if argIdx args.size && xDecl.binderInfo.isExplicit then
/- We insert `e` as an explicit argument -/
return (args.insertAt! argIdx (Arg.expr e), namedArgs)
else
/- If we can't add `e` to `args`, we try to add it using a named argument, but this is only possible
if there isn't an argument with the same name occurring before it. -/
if !allowNamed || unusableNamedArgs.contains xDecl.userName then
throwError "\
invalid field notation, function '{fullName}' has argument with the expected type\
{indentExpr xDecl.type}\n\
but it cannot be used"
else
return (args, namedArgs.push { name := xDecl.userName, val := Arg.expr e })
/- Advance `argIdx` and update seen named arguments. -/
if bInfo.isExplicit then
/- If we can't add `e` to `args`, we try to add it using a named argument, but this is only possible
if there isn't an argument with the same name occurring before it. -/
for j in [:i] do
let prev := xs[j]!
let prevDecl prev.fvarId!.getDecl
if prevDecl.userName == xDecl.userName then
throwError "invalid field notation, function '{fullName}' has argument with the expected type{indentExpr type}\nbut it cannot be used"
return (args, namedArgs.push { name := xDecl.userName, val := Arg.expr e })
if xDecl.binderInfo.isExplicit then
-- advance explicit argument position
argIdx := argIdx + 1
unusableNamedArgs := unusableNamedArgs.push xDecl.userName
/- If named arguments aren't allowed, then it must still be possible to pass the value as an explicit argument.
Otherwise, we can abort now. -/
if allowNamed || argIdx args.size then
if let fType'@(.forallE ..) whnf fType' then
return go (mkAppN f xs) fType' argIdx remainingNamedArgs unusableNamedArgs allowNamed
if let some f' coerceToFunction? (mkAppN f xs) then
return go f' ( inferType f') argIdx remainingNamedArgs unusableNamedArgs false
throwError "\
invalid field notation, function '{fullName}' does not have argument with type ({baseName} ...) that can be used, \
it must be explicit or implicit with a unique name"
throwError "invalid field notation, function '{fullName}' does not have argument with type ({baseName} ...) that can be used, it must be explicit or implicit with a unique name"
/-- Adds the `TermInfo` for the field of a projection. See `Lean.Parser.Term.identProjKind`. -/
private def addProjTermInfo
@@ -1396,10 +1305,10 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
let projFn mkConst info.projFn
let projFn addProjTermInfo lval.getRef projFn
if lvals.isEmpty then
let namedArgs addNamedArg namedArgs { name := `self, val := Arg.expr f, suppressDeps := true }
let namedArgs addNamedArg namedArgs { name := `self, val := Arg.expr f }
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs projFn #[{ name := `self, val := Arg.expr f, suppressDeps := true }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
let f elabAppArgs projFn #[{ name := `self, val := Arg.expr f }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
loop f lvals
else
unreachable!
@@ -1408,7 +1317,8 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
let projFn mkConst constName
let projFn addProjTermInfo lval.getRef projFn
if lvals.isEmpty then
let (args, namedArgs) addLValArg baseStructName constName f args namedArgs projFn
let projFnType inferType projFn
let (args, namedArgs) addLValArg baseStructName constName f args namedArgs projFnType
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs projFn #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)
@@ -1416,7 +1326,8 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
| LValResolution.localRec baseName fullName fvar =>
let fvar addProjTermInfo lval.getRef fvar
if lvals.isEmpty then
let (args, namedArgs) addLValArg baseName fullName f args namedArgs fvar
let fvarType inferType fvar
let (args, namedArgs) addLValArg baseName fullName f args namedArgs fvarType
elabAppArgs fvar namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs fvar #[] #[Arg.expr f] (expectedType? := none) (explicit := false) (ellipsis := false)
@@ -1425,6 +1336,8 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
private def elabAppLVals (f : Expr) (lvals : List LVal) (namedArgs : Array NamedArg) (args : Array Arg)
(expectedType? : Option Expr) (explicit ellipsis : Bool) : TermElabM Expr := do
if !lvals.isEmpty && explicit then
throwError "invalid use of field notation with `@` modifier"
elabAppLValsAux namedArgs args expectedType? explicit ellipsis f lvals
def elabExplicitUnivs (lvls : Array Syntax) : TermElabM (List Level) := do
@@ -1523,21 +1436,19 @@ private partial def elabAppFn (f : Syntax) (lvals : List LVal) (namedArgs : Arra
withReader (fun ctx => { ctx with errToSorry := false }) do
f.getArgs.foldlM (init := acc) fun acc f => elabAppFn f lvals namedArgs args expectedType? explicit ellipsis true acc
else
let elabFieldName (e field : Syntax) (explicit : Bool) := do
let elabFieldName (e field : Syntax) := do
let newLVals := field.identComponents.map fun comp =>
-- We use `none` in `suffix?` since `field` can't be part of a composite name
LVal.fieldName comp comp.getId.getString! none f
elabAppFn e (newLVals ++ lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
let elabFieldIdx (e idxStx : Syntax) (explicit : Bool) := do
let elabFieldIdx (e idxStx : Syntax) := do
let some idx := idxStx.isFieldIdx? | throwError "invalid field index"
elabAppFn e (LVal.fieldIdx idxStx idx :: lvals) namedArgs args expectedType? explicit ellipsis overloaded acc
match f with
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx explicit
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx explicit
| `($(e).$field:ident) => elabFieldName e field explicit
| `($e |>.$field:ident) => elabFieldName e field explicit
| `(@$(e).$idx:fieldIdx) => elabFieldIdx e idx (explicit := true)
| `(@$(e).$field:ident) => elabFieldName e field (explicit := true)
| `($(e).$idx:fieldIdx) => elabFieldIdx e idx
| `($e |>.$idx:fieldIdx) => elabFieldIdx e idx
| `($(e).$field:ident) => elabFieldName e field
| `($e |>.$field:ident) => elabFieldName e field
| `($_:ident@$_:term) =>
throwError "unexpected occurrence of named pattern"
| `($id:ident) => do
@@ -1694,10 +1605,8 @@ private def elabAtom : TermElab := fun stx expectedType? => do
@[builtin_term_elab explicit] def elabExplicit : TermElab := fun stx expectedType? =>
match stx with
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
| `(@$_:ident) => elabAtom stx expectedType? -- Recall that `elabApp` also has support for `@`
| `(@$_:ident.{$_us,*}) => elabAtom stx expectedType?
| `(@$(_).$_:fieldIdx) => elabAtom stx expectedType?
| `(@$(_).$_:ident) => elabAtom stx expectedType?
| `(@($t)) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
| `(@$t) => elabTerm t expectedType? (implicitLambda := false) -- `@` is being used just to disable implicit lambdas
| _ => throwUnsupportedSyntax

View File

@@ -9,22 +9,18 @@ import Lean.Elab.Term
namespace Lean.Elab.Term
/--
Auxiliary inductive datatype for combining unelaborated syntax
and already elaborated expressions. It is used to elaborate applications.
-/
Auxiliary inductive datatype for combining unelaborated syntax
and already elaborated expressions. It is used to elaborate applications. -/
inductive Arg where
| stx (val : Syntax)
| expr (val : Expr)
deriving Inhabited
/-- Named arguments created using the notation `(x := val)`. -/
/-- Named arguments created using the notation `(x := val)` -/
structure NamedArg where
ref : Syntax := Syntax.missing
name : Name
val : Arg
/-- If `true`, then make all parameters that depend on this one become implicit.
This is used for projection notation, since structure parameters might be explicit for classes. -/
suppressDeps : Bool := false
deriving Inhabited
/--

View File

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

View File

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

View File

@@ -55,8 +55,8 @@ open Meta
let cinfo getConstInfoCtor ctor
let numExplicitFields forallTelescopeReducing cinfo.type fun xs _ => do
let mut n := 0
for h : i in [cinfo.numParams:xs.size] do
if ( getFVarLocalDecl xs[i]).binderInfo.isExplicit then
for i in [cinfo.numParams:xs.size] do
if ( getFVarLocalDecl xs[i]!).binderInfo.isExplicit then
n := n + 1
return n
let args := args.getElems

View File

@@ -103,11 +103,9 @@ private def elabOptLevel (stx : Syntax) : TermElabM Level :=
@[builtin_term_elab Lean.Parser.Term.omission] def elabOmission : TermElab := fun stx expectedType? => do
logWarning m!"\
The '⋯' token is used by the pretty printer to indicate omitted terms, and it should not be used directly. \
It logs this warning and then elaborates like '_'.\
\n\n\
The presence of '⋯' in pretty printing output is controlled by the 'pp.maxSteps', 'pp.deepTerms' and 'pp.proofs' options. \
These options can be further adjusted using 'pp.deepTerms.threshold' and 'pp.proofs.threshold'. \
If this '⋯' was copied from the Infoview, the hover there for the original '⋯' explains which of these options led to the omission."
It logs this warning and then elaborates like `_`.\
\n\nThe presence of `⋯` in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
elabHole stx expectedType?
@[builtin_term_elab «letMVar»] def elabLetMVar : TermElab := fun stx expectedType? => do
@@ -152,10 +150,26 @@ private def getMVarFromUserName (ident : Syntax) : MetaM Expr := do
elabTerm b expectedType?
| _ => throwUnsupportedSyntax
private def mkTacticMVar (type : Expr) (tacticCode : Syntax) : TermElabM Expr := do
let mvar mkFreshExprMVar type MetavarKind.syntheticOpaque
let mvarId := mvar.mvarId!
let ref getRef
registerSyntheticMVar ref mvarId <| SyntheticMVarKind.tactic tacticCode ( saveContext)
return mvar
register_builtin_option debug.byAsSorry : Bool := {
defValue := false
group := "debug"
descr := "replace `by ..` blocks with `sorry` IF the expected type is a proposition"
}
@[builtin_term_elab byTactic] def elabByTactic : TermElab := fun stx expectedType? => do
match expectedType? with
| some expectedType =>
mkTacticMVar expectedType stx .term
if pure (debug.byAsSorry.get ( getOptions)) <&&> isProp expectedType then
mkSorry expectedType false
else
mkTacticMVar expectedType stx
| none =>
tryPostpone
throwError ("invalid 'by' tactic, expected type has not been provided")

View File

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

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