mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-24 05:44:15 +00:00
Compare commits
84 Commits
sym_apply
...
sofia/asyn
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
6313f22b1e | ||
|
|
5bb7f37645 | ||
|
|
15a719cb36 | ||
|
|
0f1eb1d0e5 | ||
|
|
e766839345 | ||
|
|
22bef1c45a | ||
|
|
b771d12072 | ||
|
|
214abb7eb2 | ||
|
|
76a734c907 | ||
|
|
f65fe51630 | ||
|
|
e6d021967e | ||
|
|
4c360d50fa | ||
|
|
821218aabd | ||
|
|
7b1fb7ac9e | ||
|
|
cd632b033d | ||
|
|
d92cdae8e9 | ||
|
|
7d5a96941e | ||
|
|
b4cf6b02b9 | ||
|
|
ea7c740ad4 | ||
|
|
aa8fa47321 | ||
|
|
7e6365567f | ||
|
|
1361d733a6 | ||
|
|
0ad15fe982 | ||
|
|
531dbf0e1b | ||
|
|
2e649e16f0 | ||
|
|
0e4794a1a9 | ||
|
|
975a81cdb8 | ||
|
|
f7de0c408f | ||
|
|
60cdda3c1e | ||
|
|
8484dbad5d | ||
|
|
b0ebfaa812 | ||
|
|
c3cc61cdb4 | ||
|
|
ff87bcb8e5 | ||
|
|
a6ed0d640d | ||
|
|
8154453bb5 | ||
|
|
11e4e44be0 | ||
|
|
c871f66cfa | ||
|
|
0f866236c7 | ||
|
|
f6c8b8d974 | ||
|
|
175661b6c3 | ||
|
|
fd88637948 | ||
|
|
7376772cbd | ||
|
|
c358b0c734 | ||
|
|
8207919728 | ||
|
|
06b7b022b3 | ||
|
|
460b3c3e43 | ||
|
|
b46688d683 | ||
|
|
82f60a7ff3 | ||
|
|
6bf2486e13 | ||
|
|
f1c903ca65 | ||
|
|
35d8925c50 | ||
|
|
9f404d8fbe | ||
|
|
81c93aeae8 | ||
|
|
cf36ac986d | ||
|
|
609d99e860 | ||
|
|
78c9a01bb2 | ||
|
|
a2cf78ac4a | ||
|
|
bc72487aed | ||
|
|
b40dabdecd | ||
|
|
19df2c41b3 | ||
|
|
ce8fdb1aa7 | ||
|
|
fab1897f28 | ||
|
|
3804a1df8d | ||
|
|
514a5fddc6 | ||
|
|
d8f0507d2a | ||
|
|
4eb5b5776d | ||
|
|
6642061623 | ||
|
|
4e8b5cfc46 | ||
|
|
c07ee77d33 | ||
|
|
b82f969e5b | ||
|
|
97c23abf8e | ||
|
|
ef9777ec0d | ||
|
|
b7360969ed | ||
|
|
9b1b932242 | ||
|
|
d4563a818f | ||
|
|
e8781f12c0 | ||
|
|
1ca4faae18 | ||
|
|
3a5887276c | ||
|
|
e086b9b5c6 | ||
|
|
16ae74e98e | ||
|
|
2a28cd98fc | ||
|
|
bba35e4532 | ||
|
|
17581a2628 | ||
|
|
05664b15a3 |
2
.github/workflows/actionlint.yml
vendored
2
.github/workflows/actionlint.yml
vendored
@@ -15,7 +15,7 @@ jobs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
- name: actionlint
|
||||
uses: raven-actions/actionlint@v2
|
||||
with:
|
||||
|
||||
4
.github/workflows/build-template.yml
vendored
4
.github/workflows/build-template.yml
vendored
@@ -67,13 +67,13 @@ jobs:
|
||||
if: runner.os == 'macOS'
|
||||
- name: Checkout
|
||||
if: (!endsWith(matrix.os, '-with-cache'))
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
# the default is to use a virtual merge commit between the PR and master: just use the PR
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
- name: Namespace Checkout
|
||||
if: endsWith(matrix.os, '-with-cache')
|
||||
uses: namespacelabs/nscloud-checkout-action@v7
|
||||
uses: namespacelabs/nscloud-checkout-action@v8
|
||||
with:
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
- name: Open Nix shell once
|
||||
|
||||
2
.github/workflows/check-prelude.yml
vendored
2
.github/workflows/check-prelude.yml
vendored
@@ -7,7 +7,7 @@ jobs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
# the default is to use a virtual merge commit between the PR and master: just use the PR
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
|
||||
2
.github/workflows/check-stage0.yml
vendored
2
.github/workflows/check-stage0.yml
vendored
@@ -8,7 +8,7 @@ jobs:
|
||||
check-stage0-on-queue:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
- uses: actions/checkout@v6
|
||||
with:
|
||||
ref: ${{ github.event.pull_request.head.sha }}
|
||||
fetch-depth: 0
|
||||
|
||||
8
.github/workflows/ci.yml
vendored
8
.github/workflows/ci.yml
vendored
@@ -50,7 +50,7 @@ jobs:
|
||||
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
# don't schedule nightlies on forks
|
||||
if: github.event_name == 'schedule' && github.repository == 'leanprover/lean4' || inputs.action == 'release nightly' || (startsWith(github.ref, 'refs/tags/') && github.repository == 'leanprover/lean4')
|
||||
- name: Set Nightly
|
||||
@@ -434,7 +434,7 @@ jobs:
|
||||
with:
|
||||
path: artifacts
|
||||
- name: Release
|
||||
uses: softprops/action-gh-release@6da8fa9354ddfdc4aeace5fc48d7f679b5214090
|
||||
uses: softprops/action-gh-release@a06a81a03ee405af7f2048a818ed3f03bbf83c7b
|
||||
with:
|
||||
files: artifacts/*/*
|
||||
fail_on_unmatched_files: true
|
||||
@@ -455,7 +455,7 @@ jobs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
# needed for tagging
|
||||
fetch-depth: 0
|
||||
@@ -480,7 +480,7 @@ jobs:
|
||||
echo -e "\n*Full commit log*\n" >> diff.md
|
||||
git log --oneline "$last_tag"..HEAD | sed 's/^/* /' >> diff.md
|
||||
- name: Release Nightly
|
||||
uses: softprops/action-gh-release@6da8fa9354ddfdc4aeace5fc48d7f679b5214090
|
||||
uses: softprops/action-gh-release@a06a81a03ee405af7f2048a818ed3f03bbf83c7b
|
||||
with:
|
||||
body_path: diff.md
|
||||
prerelease: true
|
||||
|
||||
2
.github/workflows/copyright-header.yml
vendored
2
.github/workflows/copyright-header.yml
vendored
@@ -6,7 +6,7 @@ jobs:
|
||||
check-lean-files:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
- uses: actions/checkout@v6
|
||||
|
||||
- name: Verify .lean files start with a copyright header.
|
||||
run: |
|
||||
|
||||
10
.github/workflows/pr-release.yml
vendored
10
.github/workflows/pr-release.yml
vendored
@@ -71,7 +71,7 @@ jobs:
|
||||
GH_TOKEN: ${{ secrets.PR_RELEASES_TOKEN }}
|
||||
- name: Release (short format)
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
uses: softprops/action-gh-release@6da8fa9354ddfdc4aeace5fc48d7f679b5214090
|
||||
uses: softprops/action-gh-release@a06a81a03ee405af7f2048a818ed3f03bbf83c7b
|
||||
with:
|
||||
name: Release for PR ${{ steps.workflow-info.outputs.pullRequestNumber }}
|
||||
# There are coredumps files here as well, but all in deeper subdirectories.
|
||||
@@ -86,7 +86,7 @@ jobs:
|
||||
|
||||
- name: Release (SHA-suffixed format)
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
uses: softprops/action-gh-release@6da8fa9354ddfdc4aeace5fc48d7f679b5214090
|
||||
uses: softprops/action-gh-release@a06a81a03ee405af7f2048a818ed3f03bbf83c7b
|
||||
with:
|
||||
name: Release for PR ${{ steps.workflow-info.outputs.pullRequestNumber }} (${{ steps.workflow-info.outputs.sourceHeadSha }})
|
||||
# There are coredumps files here as well, but all in deeper subdirectories.
|
||||
@@ -387,7 +387,7 @@ jobs:
|
||||
# Checkout the Batteries repository with all branches
|
||||
- name: Checkout Batteries repository
|
||||
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
repository: leanprover-community/batteries
|
||||
token: ${{ secrets.MATHLIB4_BOT }}
|
||||
@@ -447,7 +447,7 @@ jobs:
|
||||
# Checkout the mathlib4 repository with all branches
|
||||
- name: Checkout mathlib4 repository
|
||||
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
repository: leanprover-community/mathlib4-nightly-testing
|
||||
token: ${{ secrets.MATHLIB4_BOT }}
|
||||
@@ -530,7 +530,7 @@ jobs:
|
||||
# Checkout the reference manual repository with all branches
|
||||
- name: Checkout mathlib4 repository
|
||||
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.reference-manual-ready.outputs.manual_ready == 'true'
|
||||
uses: actions/checkout@v5
|
||||
uses: actions/checkout@v6
|
||||
with:
|
||||
repository: leanprover/reference-manual
|
||||
token: ${{ secrets.MANUAL_PR_BOT }}
|
||||
|
||||
2
.github/workflows/update-stage0.yml
vendored
2
.github/workflows/update-stage0.yml
vendored
@@ -27,7 +27,7 @@ jobs:
|
||||
# This action should push to an otherwise protected branch, so it
|
||||
# uses a deploy key with write permissions, as suggested at
|
||||
# https://stackoverflow.com/a/76135647/946226
|
||||
- uses: actions/checkout@v5
|
||||
- uses: actions/checkout@v6
|
||||
with:
|
||||
ssh-key: ${{secrets.STAGE0_SSH_KEY}}
|
||||
- run: echo "should_update_stage0=yes" >> "$GITHUB_ENV"
|
||||
|
||||
106
doc/style.md
106
doc/style.md
@@ -810,7 +810,7 @@ Docstrings for constants should have the following structure:
|
||||
|
||||
The **short summary** should be 1–3 sentences (ideally 1) and provide
|
||||
enough information for most readers to quickly decide whether the
|
||||
docstring is relevant to their task. The first (or only) sentence of
|
||||
constant is relevant to their task. The first (or only) sentence of
|
||||
the short summary should be a *sentence fragment* in which the subject
|
||||
is implied to be the documented item, written in present tense
|
||||
indicative, or a *noun phrase* that characterizes the documented
|
||||
@@ -1123,6 +1123,110 @@ infix:50 " ⇔ " => Bijection
|
||||
recommended_spelling "bij" for "⇔" in [Bijection, «term_⇔_»]
|
||||
```
|
||||
|
||||
#### Tactics
|
||||
|
||||
Docstrings for tactics should have the following structure:
|
||||
|
||||
* Short summary
|
||||
* Details
|
||||
* Variants
|
||||
* Examples
|
||||
|
||||
Sometimes more than one declaration is needed to implement what the user
|
||||
sees as a single tactic. In that case, only one declaration should have
|
||||
the associated docstring, and the others should have the `tactic_alt`
|
||||
attribute to mark them as an implementation detail.
|
||||
|
||||
The **short summary** should be 1–3 sentences (ideally 1) and provide
|
||||
enough information for most readers to quickly decide whether the
|
||||
tactic is relevant to their task. The first (or only) sentence of
|
||||
the short summary should be a full sentence in which the subject
|
||||
is an example invocation of the tactic, written in present tense
|
||||
indicative. If the example tactic invocation names parameters, then the
|
||||
short summary may refer to them. For the example invocation, prefer the
|
||||
simplest or most typical example. Explain more complicated forms in the
|
||||
variants section. If needed, abbreviate the invocation by naming part of
|
||||
the syntax and expanding it in the next sentence. The summary should be
|
||||
written as a single paragraph.
|
||||
|
||||
**Details**, if needed, may be 1-3 paragraphs that describe further
|
||||
relevant information. They may insert links as needed. This section
|
||||
should fully explain the scope of the tactic: its syntax format,
|
||||
on which goals it works and what the resulting goal(s) look like. It
|
||||
should be clear whether the tactic fails if it does not close the main
|
||||
goal and whether it creates any side goals. The details may include
|
||||
explanatory examples that can’t necessarily be machine checked and
|
||||
don’t fit the format.
|
||||
|
||||
If the tactic is extensible using `macro_rules`, mention this in the
|
||||
details, with a link to `lean-manual://section/tactic-macro-extension`
|
||||
and give a one-line example. If the tactic provides an attribute or a
|
||||
command that allows the user to extend its behavior, the documentation
|
||||
on how to extend the tactic belongs to that attribute or command. In the
|
||||
tactic docstring, use a single sentence to refer the reader to this
|
||||
further documentation.
|
||||
|
||||
**Variants**, if needed, should be a bulleted list describing different
|
||||
options and forms of the same tactic. The reader should be able to parse
|
||||
and understand the parts of a tactic invocation they are hovering over,
|
||||
using this list. Each list item should describe an individual variant
|
||||
and take one of two formats: the **short summary** as above, or a
|
||||
**named list item**. A named list item consists of a title in bold
|
||||
followed by an indented short paragraph.
|
||||
|
||||
Variants should be explained from the perspective of the tactic's users, not
|
||||
their implementers. A tactic that is implemented as a single Lean parser may
|
||||
have multiple variants from the perspective of users, while a tactic that is
|
||||
implemented as multiple parsers may have no variants, but merely an optional
|
||||
part of the syntax.
|
||||
|
||||
**Examples** should start with the line `Examples:` (or `Example:` if
|
||||
there’s exactly one). The section should consist of a sequence of code
|
||||
blocks, each showing a Lean declaration (usually with the `example`
|
||||
keyword) that invokes the tactic. When the effect of the tactic is not
|
||||
clear from the code, you can use code comments to describe this. Do
|
||||
not include text between examples, because it can be unclear whether
|
||||
the text refers to the code before or after the example.
|
||||
|
||||
##### Example
|
||||
|
||||
````
|
||||
`rw [e]` uses the expression `e` as a rewrite rule on the main goal,
|
||||
then tries to close the goal by "cheap" (reducible) `rfl`.
|
||||
|
||||
If `e` is a defined constant, then the equational theorems associated with `e`
|
||||
are used. This provides a convenient way to unfold `e`. If `e` has parameters,
|
||||
the tactic will try to fill these in by unification with the matching part of
|
||||
the target. Parameters are only filled in once per rule, restricting which
|
||||
later rewrites can be found. Parameters that are not filled in after
|
||||
unification will create side goals. If the `rfl` fails to close the main goal,
|
||||
no error is raised.
|
||||
|
||||
`rw` may fail to rewrite terms "under binders", such as `∀ x, ...` or `∃ x,
|
||||
...`. `rw` can also fail with a "motive is type incorrect" error in the context
|
||||
of dependent types. In these cases, consider using `simp only`.
|
||||
|
||||
* `rw [e₁, ... eₙ]` applies the given rules sequentially.
|
||||
* `rw [← e]` or `rw [<- e]` applies the rewrite in the reverse direction.
|
||||
* `rw [e] at l` rewrites with `e` at location(s) `l`.
|
||||
* `rw (occs := .pos L) [e]`, where `L` is a literal list of natural numbers,
|
||||
only rewrites the given occurrences in the target. Occurrences count from 1.
|
||||
* `rw (occs := .neg L) [e]`, where `L` is a literal list of natural numbers,
|
||||
skips rewriting the given occurrences in the target. Occurrences count from 1.
|
||||
|
||||
Examples:
|
||||
|
||||
```lean
|
||||
example {a b : Nat} (h : a + a = b) : (a + a) + (a + a) = b + b := by rw [h]
|
||||
```
|
||||
|
||||
```lean
|
||||
example {f : Nat -> Nat} (h : ∀ x, f x = 1) (a b : Nat) : f a = f b := by
|
||||
rw [h] -- `rw` instantiates `h` only once, so this is equivalent to: `rw [h a]`
|
||||
-- goal: ⊢ 1 = f b
|
||||
rw [h] -- equivalent to: `rw [h b]`
|
||||
```
|
||||
````
|
||||
|
||||
|
||||
## Dictionary
|
||||
|
||||
@@ -338,12 +338,14 @@ where
|
||||
deps := deps.union k {indMod}
|
||||
return deps
|
||||
|
||||
abbrev Explanations := Std.HashMap (ModuleIdx × NeedsKind) (Option (Name × Name))
|
||||
|
||||
/--
|
||||
Calculates the same as `calcNeeds` but tracing each module to a use-def declaration pair or
|
||||
`none` if merely a recorded extra use.
|
||||
-/
|
||||
def getExplanations (env : Environment) (i : ModuleIdx) :
|
||||
Std.HashMap (ModuleIdx × NeedsKind) (Option (Name × Name)) := Id.run do
|
||||
def getExplanations (s : State) (i : ModuleIdx) : Explanations := Id.run do
|
||||
let env := s.env
|
||||
let mut deps := default
|
||||
for ci in env.header.moduleData[i]!.constants do
|
||||
-- Added guard for cases like `structure` that are still exported even if private
|
||||
@@ -364,18 +366,25 @@ def getExplanations (env : Environment) (i : ModuleIdx) :
|
||||
where
|
||||
/-- Accumulate the results from expression `e` into `deps`. -/
|
||||
visitExpr (k : NeedsKind) name e deps :=
|
||||
let env := s.env
|
||||
Lean.Expr.foldConsts e deps fun c deps => Id.run do
|
||||
let mut deps := deps
|
||||
if let some c := getDepConstName? env c then
|
||||
if let some j := env.getModuleIdxFor? c then
|
||||
let k := { k with isMeta := k.isMeta && !isDeclMeta' env c }
|
||||
if
|
||||
if let some (some (name', _)) := deps[(j, k)]? then
|
||||
decide (name.toString.length < name'.toString.length)
|
||||
else true
|
||||
then
|
||||
deps := deps.insert (j, k) (name, c)
|
||||
deps := addExplanation j k name c deps
|
||||
for indMod in (indirectModUseExt.getState env)[c]?.getD #[] do
|
||||
if s.transDeps[i]!.has k indMod then
|
||||
deps := addExplanation indMod k name (`_indirect ++ c) deps
|
||||
return deps
|
||||
addExplanation (j : ModuleIdx) (k : NeedsKind) (use def_ : Name) (deps : Explanations) : Explanations :=
|
||||
if
|
||||
if let some (some (name', _)) := deps[(j, k)]? then
|
||||
decide (use.toString.length < name'.toString.length)
|
||||
else true
|
||||
then
|
||||
deps.insert (j, k) (use, def_)
|
||||
else deps
|
||||
|
||||
partial def initStateFromEnv (env : Environment) : State := Id.run do
|
||||
let mut s := { env }
|
||||
@@ -542,7 +551,7 @@ def visitModule (pkg : Name) (srcSearchPath : SearchPath)
|
||||
let mut imp : Import := { k with module := s.modNames[j]! }
|
||||
let mut j := j
|
||||
if args.trace then
|
||||
IO.eprintln s!"`{imp}` is needed"
|
||||
IO.eprintln s!"`{imp}` is needed{if needs.has k j then " (calculated)" else ""}"
|
||||
if args.addPublic && !k.isExported &&
|
||||
-- also add as public if previously `public meta`, which could be from automatic porting
|
||||
(s.transDepsOrig[i]!.has { k with isExported := true } j || s.transDepsOrig[i]!.has { k with isExported := true, isMeta := true } j) then
|
||||
@@ -660,7 +669,7 @@ def visitModule (pkg : Name) (srcSearchPath : SearchPath)
|
||||
modify fun s => { s with transDeps := s.transDeps.set! i newTransDepsI }
|
||||
|
||||
if args.explain then
|
||||
let explanation := getExplanations s.env i
|
||||
let explanation := getExplanations s i
|
||||
let sanitize n := if n.hasMacroScopes then (sanitizeName n).run' { options := {} } else n
|
||||
let run (imp : Import) := do
|
||||
let j := s.env.getModuleIdx? imp.module |>.get!
|
||||
|
||||
@@ -142,3 +142,15 @@ repositories:
|
||||
branch: master
|
||||
dependencies:
|
||||
- verso-web-components
|
||||
|
||||
- name: comparator
|
||||
url: https://github.com/leanprover/comparator
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: master
|
||||
|
||||
- name: lean4export
|
||||
url: https://github.com/leanprover/lean4export
|
||||
toolchain-tag: true
|
||||
stable-branch: false
|
||||
branch: master
|
||||
|
||||
@@ -695,7 +695,7 @@ endif()
|
||||
|
||||
set(STDLIBS Init Std Lean Leanc)
|
||||
if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
list(APPEND STDLIBS Lake)
|
||||
list(APPEND STDLIBS Lake LeanChecker)
|
||||
endif()
|
||||
|
||||
add_custom_target(make_stdlib ALL
|
||||
@@ -758,6 +758,12 @@ if(NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
|
||||
DEPENDS lake_shared
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make lake
|
||||
VERBATIM)
|
||||
|
||||
add_custom_target(leanchecker ALL
|
||||
WORKING_DIRECTORY ${LEAN_SOURCE_DIR}
|
||||
DEPENDS lake_shared
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanchecker
|
||||
VERBATIM)
|
||||
endif()
|
||||
|
||||
if(PREV_STAGE)
|
||||
|
||||
@@ -102,7 +102,7 @@ noncomputable def strongIndefiniteDescription {α : Sort u} (p : α → Prop) (h
|
||||
⟨xp.val, fun _ => xp.property⟩)
|
||||
(fun hp => ⟨choice h, fun h => absurd h hp⟩)
|
||||
|
||||
/-- the Hilbert epsilon Function -/
|
||||
/-- The Hilbert epsilon function. -/
|
||||
noncomputable def epsilon {α : Sort u} [h : Nonempty α] (p : α → Prop) : α :=
|
||||
(strongIndefiniteDescription p h).val
|
||||
|
||||
|
||||
@@ -144,7 +144,7 @@ instance : ToBool Bool where
|
||||
Converts the result of the monadic action `x` to a `Bool`. If it is `true`, returns it and ignores
|
||||
`y`; otherwise, runs `y` and returns its result.
|
||||
|
||||
This a monadic counterpart to the short-circuiting `||` operator, usually accessed via the `<||>`
|
||||
This is a monadic counterpart to the short-circuiting `||` operator, usually accessed via the `<||>`
|
||||
operator.
|
||||
-/
|
||||
@[macro_inline] def orM {m : Type u → Type v} {β : Type u} [Monad m] [ToBool β] (x y : m β) : m β := do
|
||||
@@ -161,7 +161,7 @@ recommended_spelling "orM" for "<||>" in [orM, «term_<||>_»]
|
||||
Converts the result of the monadic action `x` to a `Bool`. If it is `true`, returns `y`; otherwise,
|
||||
returns the original result of `x`.
|
||||
|
||||
This a monadic counterpart to the short-circuiting `&&` operator, usually accessed via the `<&&>`
|
||||
This is a monadic counterpart to the short-circuiting `&&` operator, usually accessed via the `<&&>`
|
||||
operator.
|
||||
-/
|
||||
@[macro_inline] def andM {m : Type u → Type v} {β : Type u} [Monad m] [ToBool β] (x y : m β) : m β := do
|
||||
|
||||
@@ -337,7 +337,7 @@ inductive Exists {α : Sort u} (p : α → Prop) : Prop where
|
||||
An indication of whether a loop's body terminated early that's used to compile the `for x in xs`
|
||||
notation.
|
||||
|
||||
A collection's `ForIn` or `ForIn'` instance describe's how to iterate over its elements. The monadic
|
||||
A collection's `ForIn` or `ForIn'` instance describes how to iterate over its elements. The monadic
|
||||
action that represents the body of the loop returns a `ForInStep α`, where `α` is the local state
|
||||
used to implement features such as `let mut`.
|
||||
-/
|
||||
@@ -510,12 +510,12 @@ abbrev SSuperset [HasSSubset α] (a b : α) := SSubset b a
|
||||
|
||||
/-- Notation type class for the union operation `∪`. -/
|
||||
class Union (α : Type u) where
|
||||
/-- `a ∪ b` is the union of`a` and `b`. -/
|
||||
/-- `a ∪ b` is the union of `a` and `b`. -/
|
||||
union : α → α → α
|
||||
|
||||
/-- Notation type class for the intersection operation `∩`. -/
|
||||
class Inter (α : Type u) where
|
||||
/-- `a ∩ b` is the intersection of`a` and `b`. -/
|
||||
/-- `a ∩ b` is the intersection of `a` and `b`. -/
|
||||
inter : α → α → α
|
||||
|
||||
/-- Notation type class for the set difference `\`. -/
|
||||
@@ -538,10 +538,10 @@ infix:50 " ⊇ " => Superset
|
||||
/-- Strict superset relation: `a ⊃ b` -/
|
||||
infix:50 " ⊃ " => SSuperset
|
||||
|
||||
/-- `a ∪ b` is the union of`a` and `b`. -/
|
||||
/-- `a ∪ b` is the union of `a` and `b`. -/
|
||||
infixl:65 " ∪ " => Union.union
|
||||
|
||||
/-- `a ∩ b` is the intersection of`a` and `b`. -/
|
||||
/-- `a ∩ b` is the intersection of `a` and `b`. -/
|
||||
infixl:70 " ∩ " => Inter.inter
|
||||
|
||||
/--
|
||||
|
||||
@@ -125,6 +125,22 @@ instance instDecidableEmpEq (ys : Array α) : Decidable (#[] = ys) :=
|
||||
| ⟨[]⟩ => isTrue rfl
|
||||
| ⟨_ :: _⟩ => isFalse (fun h => Array.noConfusion rfl (heq_of_eq h) (fun h => List.noConfusion rfl h))
|
||||
|
||||
@[inline]
|
||||
def instDecidableEqEmpImpl (xs : Array α) : Decidable (xs = #[]) :=
|
||||
decidable_of_iff xs.isEmpty <| by rcases xs with ⟨⟨⟩⟩ <;> simp [Array.isEmpty]
|
||||
|
||||
@[inline]
|
||||
def instDecidableEmpEqImpl (xs : Array α) : Decidable (#[] = xs) :=
|
||||
decidable_of_iff xs.isEmpty <| by rcases xs with ⟨⟨⟩⟩ <;> simp [Array.isEmpty]
|
||||
|
||||
@[csimp]
|
||||
theorem instDecidableEqEmp_csimp : @instDecidableEqEmp = @instDecidableEqEmpImpl :=
|
||||
Subsingleton.allEq _ _
|
||||
|
||||
@[csimp]
|
||||
theorem instDecidableEmpEq_csimp : @instDecidableEmpEq = @instDecidableEmpEqImpl :=
|
||||
Subsingleton.allEq _ _
|
||||
|
||||
theorem beq_eq_decide [BEq α] (xs ys : Array α) :
|
||||
(xs == ys) = if h : xs.size = ys.size then
|
||||
decide (∀ (i : Nat) (h' : i < xs.size), xs[i] == ys[i]'(h ▸ h')) else false := by
|
||||
|
||||
@@ -115,7 +115,8 @@ theorem none_eq_getElem?_iff {xs : Array α} {i : Nat} : none = xs[i]? ↔ xs.si
|
||||
theorem getElem?_eq_none {xs : Array α} (h : xs.size ≤ i) : xs[i]? = none := by
|
||||
simp [h]
|
||||
|
||||
grind_pattern Array.getElem?_eq_none => xs.size, xs[i]?
|
||||
grind_pattern Array.getElem?_eq_none => xs.size, xs[i]? where
|
||||
guard xs.size ≤ i
|
||||
|
||||
@[simp] theorem getElem?_eq_getElem {xs : Array α} {i : Nat} (h : i < xs.size) : xs[i]? = some xs[i] :=
|
||||
getElem?_pos ..
|
||||
|
||||
@@ -67,6 +67,9 @@ theorem none_eq_getElem?_iff {l : BitVec w} : none = l[n]? ↔ w ≤ n := by
|
||||
@[simp]
|
||||
theorem getElem?_eq_none {l : BitVec w} (h : w ≤ n) : l[n]? = none := getElem?_eq_none_iff.mpr h
|
||||
|
||||
grind_pattern BitVec.getElem?_eq_none => l[n]? where
|
||||
guard w ≤ n
|
||||
|
||||
theorem getElem?_eq (l : BitVec w) (i : Nat) :
|
||||
l[i]? = if h : i < w then some l[i] else none := by
|
||||
split <;> simp_all
|
||||
|
||||
@@ -113,6 +113,8 @@ theorem gcd_eq_right_iff_dvd (hb : 0 ≤ b) : gcd a b = b ↔ b ∣ a := by
|
||||
|
||||
theorem gcd_assoc (a b c : Int) : gcd (gcd a b) c = gcd a (gcd b c) := Nat.gcd_assoc ..
|
||||
|
||||
theorem gcd_left_comm (a b c : Int) : gcd a (gcd b c) = gcd b (gcd a c) := Nat.gcd_left_comm ..
|
||||
|
||||
theorem gcd_mul_left (m n k : Int) : gcd (m * n) (m * k) = m.natAbs * gcd n k := by
|
||||
simp [gcd_eq_natAbs_gcd_natAbs, Nat.gcd_mul_left, natAbs_mul]
|
||||
|
||||
|
||||
@@ -10,6 +10,7 @@ public import Init.Classical
|
||||
public import Init.Ext
|
||||
|
||||
set_option doc.verso true
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
@@ -349,14 +350,24 @@ abbrev PlausibleIterStep.casesOn {IsPlausibleStep : IterStep α β → Prop}
|
||||
end IterStep
|
||||
|
||||
/--
|
||||
The typeclass providing the step function of an iterator in `Iter (α := α) β` or
|
||||
`IterM (α := α) m β`.
|
||||
The step function of an iterator in `Iter (α := α) β` or `IterM (α := α) m β`.
|
||||
|
||||
In order to allow intrinsic termination proofs when iterating with the `step` function, the
|
||||
step object is bundled with a proof that it is a "plausible" step for the given current iterator.
|
||||
-/
|
||||
class Iterator (α : Type w) (m : Type w → Type w') (β : outParam (Type w)) where
|
||||
/--
|
||||
A relation that governs the allowed steps from a given iterator.
|
||||
|
||||
The "plausible" steps are those which make sense for a given state; plausibility can ensure
|
||||
properties such as the successor iterator being drawn from the same collection, that an iterator
|
||||
resulting from a skip will return the same next value, or that the next item yielded is next one
|
||||
in the original collection.
|
||||
-/
|
||||
IsPlausibleStep : IterM (α := α) m β → IterStep (IterM (α := α) m β) β → Prop
|
||||
/--
|
||||
Carries out a step of iteration.
|
||||
-/
|
||||
step : (it : IterM (α := α) m β) → m (Shrink <| PlausibleIterStep <| IsPlausibleStep it)
|
||||
|
||||
section Monadic
|
||||
@@ -369,7 +380,7 @@ def IterM.mk {α : Type w} (it : α) (m : Type w → Type w') (β : Type w) :
|
||||
IterM (α := α) m β :=
|
||||
⟨it⟩
|
||||
|
||||
@[deprecated IterM.mk (since := "2025-12-01"), inline, expose]
|
||||
@[deprecated IterM.mk (since := "2025-12-01"), inline, expose, inherit_doc IterM.mk]
|
||||
def Iterators.toIterM := @IterM.mk
|
||||
|
||||
@[simp]
|
||||
@@ -377,6 +388,7 @@ theorem IterM.mk_internalState {α m β} (it : IterM (α := α) m β) :
|
||||
.mk it.internalState m β = it :=
|
||||
rfl
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
@[deprecated IterM.mk_internalState (since := "2025-12-01")]
|
||||
def Iterators.toIterM_internalState := @IterM.mk_internalState
|
||||
|
||||
@@ -459,8 +471,10 @@ number of steps.
|
||||
-/
|
||||
inductive IterM.IsPlausibleIndirectOutput {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
|
||||
: IterM (α := α) m β → β → Prop where
|
||||
/-- The output value could plausibly be emitted in the next step. -/
|
||||
| direct {it : IterM (α := α) m β} {out : β} : it.IsPlausibleOutput out →
|
||||
it.IsPlausibleIndirectOutput out
|
||||
/-- The output value could plausibly be emitted in a step after the next step. -/
|
||||
| indirect {it it' : IterM (α := α) m β} {out : β} : it'.IsPlausibleSuccessorOf it →
|
||||
it'.IsPlausibleIndirectOutput out → it.IsPlausibleIndirectOutput out
|
||||
|
||||
@@ -470,7 +484,9 @@ finitely many steps. This relation is reflexive.
|
||||
-/
|
||||
inductive IterM.IsPlausibleIndirectSuccessorOf {α β : Type w} {m : Type w → Type w'}
|
||||
[Iterator α m β] : IterM (α := α) m β → IterM (α := α) m β → Prop where
|
||||
/-- Every iterator is a plausible indirect successor of itself. -/
|
||||
| refl (it : IterM (α := α) m β) : it.IsPlausibleIndirectSuccessorOf it
|
||||
/-- The iterator is a plausible successor of one of the current iterator's successors. -/
|
||||
| cons_right {it'' it' it : IterM (α := α) m β} (h' : it''.IsPlausibleIndirectSuccessorOf it')
|
||||
(h : it'.IsPlausibleSuccessorOf it) : it''.IsPlausibleIndirectSuccessorOf it
|
||||
|
||||
@@ -595,8 +611,10 @@ number of steps.
|
||||
-/
|
||||
inductive Iter.IsPlausibleIndirectOutput {α β : Type w} [Iterator α Id β] :
|
||||
Iter (α := α) β → β → Prop where
|
||||
/-- The output value could plausibly be emitted in the next step. -/
|
||||
| direct {it : Iter (α := α) β} {out : β} : it.IsPlausibleOutput out →
|
||||
it.IsPlausibleIndirectOutput out
|
||||
/-- The output value could plausibly be emitted in a step after the next step. -/
|
||||
| indirect {it it' : Iter (α := α) β} {out : β} : it'.IsPlausibleSuccessorOf it →
|
||||
it'.IsPlausibleIndirectOutput out → it.IsPlausibleIndirectOutput out
|
||||
|
||||
@@ -627,7 +645,9 @@ finitely many steps. This relation is reflexive.
|
||||
-/
|
||||
inductive Iter.IsPlausibleIndirectSuccessorOf {α : Type w} {β : Type w} [Iterator α Id β] :
|
||||
Iter (α := α) β → Iter (α := α) β → Prop where
|
||||
/-- Every iterator is a plausible indirect successor of itself. -/
|
||||
| refl (it : Iter (α := α) β) : IsPlausibleIndirectSuccessorOf it it
|
||||
/-- The iterator is a plausible indirect successor of one of the current iterator's successors. -/
|
||||
| cons_right {it'' it' it : Iter (α := α) β} (h' : it''.IsPlausibleIndirectSuccessorOf it')
|
||||
(h : it'.IsPlausibleSuccessorOf it) : it''.IsPlausibleIndirectSuccessorOf it
|
||||
|
||||
@@ -701,6 +721,11 @@ recursion over finite iterators. See also `IterM.finitelyManySteps` and `Iter.fi
|
||||
-/
|
||||
structure IterM.TerminationMeasures.Finite
|
||||
(α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
|
||||
/--
|
||||
The wrapped iterator.
|
||||
|
||||
In the wrapper, its finiteness is used as a termination measure.
|
||||
-/
|
||||
it : IterM (α := α) m β
|
||||
|
||||
/--
|
||||
@@ -827,6 +852,11 @@ recursion over productive iterators. See also `IterM.finitelyManySkips` and `Ite
|
||||
-/
|
||||
structure IterM.TerminationMeasures.Productive
|
||||
(α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
|
||||
/--
|
||||
The wrapped iterator.
|
||||
|
||||
In the wrapper, its productivity is used as a termination measure.
|
||||
-/
|
||||
it : IterM (α := α) m β
|
||||
|
||||
/--
|
||||
@@ -930,6 +960,9 @@ library.
|
||||
-/
|
||||
class LawfulDeterministicIterator (α : Type w) (m : Type w → Type w') [Iterator α m β]
|
||||
where
|
||||
/--
|
||||
Every iterator with state `α` in monad `m` has exactly one plausible step.
|
||||
-/
|
||||
isPlausibleStep_eq_eq : ∀ it : IterM (α := α) m β, ∃ step, it.IsPlausibleStep = (· = step)
|
||||
|
||||
namespace Iterators
|
||||
@@ -940,14 +973,13 @@ This structure provides a more convenient way to define `Finite α m` instances
|
||||
-/
|
||||
structure FinitenessRelation (α : Type w) (m : Type w → Type w') {β : Type w}
|
||||
[Iterator α m β] where
|
||||
/-
|
||||
A well-founded relation such that if `it'` is a successor iterator of `it`, then
|
||||
`Rel it' it`.
|
||||
/--
|
||||
A well-founded relation such that if `it'` is a successor iterator of `it`, then `Rel it' it`.
|
||||
-/
|
||||
Rel (it' it : IterM (α := α) m β) : Prop
|
||||
/- A proof that `Rel` is well-founded. -/
|
||||
/-- `Rel` is well-founded. -/
|
||||
wf : WellFounded Rel
|
||||
/- A proof that if `it'` is a successor iterator of `it`, then `Rel it' it`. -/
|
||||
/-- If `it'` is a successor iterator of `it`, then `Rel it' it`. -/
|
||||
subrelation : ∀ {it it'}, it'.IsPlausibleSuccessorOf it → Rel it' it
|
||||
|
||||
theorem Finite.of_finitenessRelation
|
||||
@@ -967,14 +999,13 @@ This structure provides a more convenient way to define `Productive α m` instan
|
||||
-/
|
||||
structure ProductivenessRelation (α : Type w) (m : Type w → Type w') {β : Type w}
|
||||
[Iterator α m β] where
|
||||
/-
|
||||
A well-founded relation such that if `it'` is obtained from `it` by skipping, then
|
||||
`Rel it' it`.
|
||||
/--
|
||||
A well-founded relation such that if `it'` is obtained from `it` by skipping, then `Rel it' it`.
|
||||
-/
|
||||
Rel : (IterM (α := α) m β) → (IterM (α := α) m β) → Prop
|
||||
/- A proof that `Rel` is well-founded. -/
|
||||
/-- `Rel` is well-founded. -/
|
||||
wf : WellFounded Rel
|
||||
/- A proof that if `it'` is obtained from `it` by skipping, then `Rel it' it`. -/
|
||||
/-- If `it'` is obtained from `it` by skipping, then `Rel it' it`. -/
|
||||
subrelation : ∀ {it it'}, it'.IsPlausibleSkipSuccessorOf it → Rel it' it
|
||||
|
||||
theorem Productive.of_productivenessRelation
|
||||
|
||||
@@ -9,6 +9,8 @@ prelude
|
||||
public import Init.Data.Iterators.Consumers.Loop
|
||||
public import Init.Data.Iterators.Consumers.Monadic.Access
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
@[expose] public section
|
||||
|
||||
namespace Std
|
||||
|
||||
@@ -8,6 +8,8 @@ module
|
||||
prelude
|
||||
public import Init.Data.Iterators.Basic
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
@@ -57,8 +59,8 @@ theorem IterM.not_isPlausibleNthOutputStep_yield {α β : Type w} {m : Type w
|
||||
|
||||
/--
|
||||
`IteratorAccess α m` provides efficient implementations for random access or iterators that support
|
||||
it. `it.nextAtIdx? n` either returns the step in which the `n`-th value of `it` is emitted
|
||||
(necessarily of the form `.yield _ _`) or `.done` if `it` terminates before emitting the `n`-th
|
||||
it. `it.nextAtIdx? n` either returns the step in which the `n`th value of `it` is emitted
|
||||
(necessarily of the form `.yield _ _`) or `.done` if `it` terminates before emitting the `n`th
|
||||
value.
|
||||
|
||||
For monadic iterators, the monadic effects of this operation may differ from manually iterating
|
||||
@@ -68,6 +70,11 @@ is guaranteed to plausible in the sense of `IterM.IsPlausibleNthOutputStep`.
|
||||
This class is experimental and users of the iterator API should not explicitly depend on it.
|
||||
-/
|
||||
class IteratorAccess (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
|
||||
/--
|
||||
`nextAtIdx? it n` either returns the step in which the `n`th value of `it` is emitted
|
||||
(necessarily of the form `.yield _ _`) or `.done` if `it` terminates before emitting the `n`th
|
||||
value.
|
||||
-/
|
||||
nextAtIdx? (it : IterM (α := α) m β) (n : Nat) :
|
||||
m (PlausibleIterStep (it.IsPlausibleNthOutputStep n))
|
||||
|
||||
|
||||
@@ -11,6 +11,8 @@ public import Init.Data.Iterators.Consumers.Monadic.Total
|
||||
public import Init.Data.Iterators.Internal.LawfulMonadLiftFunction
|
||||
public import Init.WFExtrinsicFix
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
@[expose] public section
|
||||
|
||||
/-!
|
||||
|
||||
@@ -11,6 +11,8 @@ public import Init.Data.Iterators.Internal.LawfulMonadLiftFunction
|
||||
public import Init.WFExtrinsicFix
|
||||
public import Init.Data.Iterators.Consumers.Monadic.Total
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
@@ -70,6 +72,9 @@ provided by the standard library.
|
||||
@[ext]
|
||||
class IteratorLoop (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β]
|
||||
(n : Type x → Type x') where
|
||||
/--
|
||||
Iteration over the iterator `it` in the manner expected by `for` loops.
|
||||
-/
|
||||
forIn : ∀ (_liftBind : (γ : Type w) → (δ : Type x) → (γ → n δ) → m γ → n δ) (γ : Type x),
|
||||
(plausible_forInStep : β → γ → ForInStep γ → Prop) →
|
||||
(it : IterM (α := α) m β) → γ →
|
||||
@@ -82,7 +87,9 @@ end Typeclasses
|
||||
structure IteratorLoop.WithWF (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β]
|
||||
{γ : Type x} (PlausibleForInStep : β → γ → ForInStep γ → Prop)
|
||||
(hwf : IteratorLoop.WellFounded α m PlausibleForInStep) where
|
||||
/-- Internal implementation detail of the iterator library. -/
|
||||
it : IterM (α := α) m β
|
||||
/-- Internal implementation detail of the iterator library. -/
|
||||
acc : γ
|
||||
|
||||
instance IteratorLoop.WithWF.instWellFoundedRelation
|
||||
@@ -163,6 +170,7 @@ Asserts that a given `IteratorLoop` instance is equal to `IteratorLoop.defaultIm
|
||||
-/
|
||||
class LawfulIteratorLoop (α : Type w) (m : Type w → Type w') (n : Type x → Type x')
|
||||
[Monad m] [Monad n] [Iterator α m β] [i : IteratorLoop α m n] where
|
||||
/-- The implementation of `IteratorLoop.forIn` in `i` is equal to the default implementation. -/
|
||||
lawful lift [LawfulMonadLiftBindFunction lift] γ it init
|
||||
(Pl : β → γ → ForInStep γ → Prop) (wf : IteratorLoop.WellFounded α m Pl)
|
||||
(f : (b : β) → it.IsPlausibleIndirectOutput b → (c : γ) → n (Subtype (Pl b c))) :
|
||||
@@ -219,6 +227,7 @@ instance IterM.instForInOfIteratorLoop {m : Type w → Type w'} {n : Type w →
|
||||
haveI : ForIn' n (IterM (α := α) m β) β _ := IterM.instForIn'
|
||||
instForInOfForIn'
|
||||
|
||||
/-- Internal implementation detail of the iterator library. -/
|
||||
@[always_inline, inline]
|
||||
def IterM.Partial.instForIn' {m : Type w → Type w'} {n : Type w → Type w''}
|
||||
{α : Type w} {β : Type w} [Iterator α m β] [IteratorLoop α m n] [MonadLiftT m n] [Monad n] :
|
||||
@@ -226,6 +235,7 @@ def IterM.Partial.instForIn' {m : Type w → Type w'} {n : Type w → Type w''}
|
||||
forIn' it init f :=
|
||||
haveI := @IterM.instForIn'; forIn' it.it init f
|
||||
|
||||
/-- Internal implementation detail of the iterator library. -/
|
||||
@[always_inline, inline]
|
||||
def IterM.Total.instForIn' {m : Type w → Type w'} {n : Type w → Type w''}
|
||||
{α : Type w} {β : Type w} [Iterator α m β] [IteratorLoop α m n] [MonadLiftT m n] [Monad n]
|
||||
|
||||
@@ -8,6 +8,8 @@ module
|
||||
prelude
|
||||
public import Init.Data.Iterators.Basic
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
@@ -16,6 +18,9 @@ namespace Std
|
||||
A wrapper around an iterator that provides partial consumers. See `IterM.allowNontermination`.
|
||||
-/
|
||||
structure IterM.Partial {α : Type w} (m : Type w → Type w') (β : Type w) where
|
||||
/--
|
||||
The wrapped iterator, which was wrapped by `IterM.allowNontermination`.
|
||||
-/
|
||||
it : IterM (α := α) m β
|
||||
|
||||
/--
|
||||
|
||||
@@ -9,12 +9,19 @@ prelude
|
||||
public import Init.Data.Iterators.Basic
|
||||
|
||||
set_option doc.verso true
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
|
||||
/--
|
||||
A wrapper around an iterator that provides total consumers. See `IterM.ensureTermination`.
|
||||
-/
|
||||
structure IterM.Total {α : Type w} (m : Type w → Type w') (β : Type w) where
|
||||
/--
|
||||
The wrapped iterator, which was wrapped by `IterM.ensureTermination`.
|
||||
-/
|
||||
it : IterM (α := α) m β
|
||||
|
||||
/--
|
||||
|
||||
@@ -8,6 +8,8 @@ module
|
||||
prelude
|
||||
public import Init.Data.Iterators.Basic
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
@@ -16,6 +18,9 @@ namespace Std
|
||||
A wrapper around an iterator that provides partial consumers. See `Iter.allowNontermination`.
|
||||
-/
|
||||
structure Iter.Partial {α : Type w} (β : Type w) where
|
||||
/--
|
||||
The wrapped iterator, which was wrapped by `Iter.allowNontermination`.
|
||||
-/
|
||||
it : Iter (α := α) β
|
||||
|
||||
/--
|
||||
|
||||
@@ -9,6 +9,8 @@ prelude
|
||||
public import Init.Data.Stream
|
||||
public import Init.Data.Iterators.Consumers.Access
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
|
||||
@@ -9,12 +9,19 @@ prelude
|
||||
public import Init.Data.Iterators.Basic
|
||||
|
||||
set_option doc.verso true
|
||||
set_option linter.missingDocs true
|
||||
|
||||
public section
|
||||
|
||||
namespace Std
|
||||
|
||||
/--
|
||||
A wrapper around an iterator that provides total consumers. See `Iter.ensureTermination`.
|
||||
-/
|
||||
structure Iter.Total {α : Type w} (β : Type w) where
|
||||
/--
|
||||
The wrapped iterator, which was wrapped by `Iter.ensureTermination`.
|
||||
-/
|
||||
it : Iter (α := α) β
|
||||
|
||||
/--
|
||||
|
||||
@@ -9,3 +9,4 @@ prelude
|
||||
public import Init.Data.Iterators.Lemmas.Consumers.Monadic
|
||||
public import Init.Data.Iterators.Lemmas.Consumers.Collect
|
||||
public import Init.Data.Iterators.Lemmas.Consumers.Loop
|
||||
public import Init.Data.Iterators.Lemmas.Consumers.Access
|
||||
|
||||
26
src/Init/Data/Iterators/Lemmas/Consumers/Access.lean
Normal file
26
src/Init/Data/Iterators/Lemmas/Consumers/Access.lean
Normal file
@@ -0,0 +1,26 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Paul Reichert
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.Iterators.Consumers.Access
|
||||
|
||||
namespace Std.Iter
|
||||
open Std.Iterators
|
||||
|
||||
public theorem atIdxSlow?_eq_match [Iterator α Id β] [Productive α Id]
|
||||
{n : Nat} {it : Iter (α := α) β} :
|
||||
it.atIdxSlow? n =
|
||||
(match it.step.val with
|
||||
| .yield it' out =>
|
||||
match n with
|
||||
| 0 => some out
|
||||
| n + 1 => it'.atIdxSlow? n
|
||||
| .skip it' => it'.atIdxSlow? n
|
||||
| .done => none) := by
|
||||
fun_induction it.atIdxSlow? n <;> simp_all
|
||||
|
||||
end Std.Iter
|
||||
@@ -72,7 +72,7 @@ def PostconditionT.liftWithProperty {α : Type w} {m : Type w → Type w'} {P :
|
||||
⟨P, x⟩
|
||||
|
||||
/--
|
||||
Given a function `f : α → β`, returns a a function `PostconditionT m α → PostconditionT m β`,
|
||||
Given a function `f : α → β`, returns a function `PostconditionT m α → PostconditionT m β`,
|
||||
turning `PostconditionT m` into a functor.
|
||||
|
||||
The postcondition of the `x.map f` states that the return value is the image under `f` of some
|
||||
@@ -85,7 +85,7 @@ protected def PostconditionT.map {m : Type w → Type w'} [Functor m] {α : Type
|
||||
(fun a => ⟨f a.val, _, rfl⟩) <$> x.operation⟩
|
||||
|
||||
/--
|
||||
Given a function `α → PostconditionT m β`, returns a a function
|
||||
Given a function `α → PostconditionT m β`, returns a function
|
||||
`PostconditionT m α → PostconditionT m β`, turning `PostconditionT m` into a monad.
|
||||
-/
|
||||
@[always_inline, inline, expose]
|
||||
@@ -287,6 +287,12 @@ theorem PostconditionT.run_attachLift {m : Type w → Type w'} [Monad m] [MonadA
|
||||
{x : m α} : (attachLift x).run = x := by
|
||||
simp [attachLift, run_eq_map, WeaklyLawfulMonadAttach.map_attach]
|
||||
|
||||
@[simp]
|
||||
theorem PostconditionT.operation_attachLift {m : Type w → Type w'} [Monad m] [MonadAttach m]
|
||||
{α : Type w} {x : m α} : (attachLift x : PostconditionT m α).operation =
|
||||
MonadAttach.attach x := by
|
||||
rfl
|
||||
|
||||
instance {m : Type w → Type w'} {n : Type w → Type w''} [MonadLift m n] :
|
||||
MonadLift (PostconditionT m) (PostconditionT n) where
|
||||
monadLift x := ⟨_, monadLift x.operation⟩
|
||||
|
||||
@@ -11,7 +11,7 @@ public import Init.Core
|
||||
public section
|
||||
|
||||
/--
|
||||
The `BEq α` and `Hashable α` instances on `α` are compatible. This means that that `a == b` implies
|
||||
The `BEq α` and `Hashable α` instances on `α` are compatible. This means that `a == b` implies
|
||||
`hash a = hash b`.
|
||||
|
||||
This is automatic if the `BEq` instance is lawful.
|
||||
|
||||
@@ -169,10 +169,10 @@ Examples:
|
||||
| a::as, b::bs, eqv => eqv a b && isEqv as bs eqv
|
||||
| _, _, _ => false
|
||||
|
||||
@[simp] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl
|
||||
@[simp] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl
|
||||
@[simp] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl
|
||||
theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl
|
||||
@[simp, grind =] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl
|
||||
@[simp, grind =] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl
|
||||
@[simp, grind =] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl
|
||||
@[grind =] theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl
|
||||
|
||||
|
||||
/-! ## Lexicographic ordering -/
|
||||
@@ -717,6 +717,7 @@ Examples:
|
||||
* `["red", "green", "blue"].leftpad 3 "blank" = ["red", "green", "blue"]`
|
||||
* `["red", "green", "blue"].leftpad 1 "blank" = ["red", "green", "blue"]`
|
||||
-/
|
||||
@[simp, grind =]
|
||||
def leftpad (n : Nat) (a : α) (l : List α) : List α := replicate (n - length l) a ++ l
|
||||
|
||||
|
||||
@@ -730,6 +731,7 @@ Examples:
|
||||
* `["red", "green", "blue"].rightpad 3 "blank" = ["red", "green", "blue"]`
|
||||
* `["red", "green", "blue"].rightpad 1 "blank" = ["red", "green", "blue"]`
|
||||
-/
|
||||
@[simp, grind =]
|
||||
def rightpad (n : Nat) (a : α) (l : List α) : List α := l ++ replicate (n - length l) a
|
||||
|
||||
/-! ### reduceOption -/
|
||||
|
||||
@@ -50,7 +50,7 @@ Users that want to use `mapM` with `Applicative` should use `mapA` instead.
|
||||
Applies the monadic action `f` to every element in the list, left-to-right, and returns the list of
|
||||
results.
|
||||
|
||||
This implementation is tail recursive. `List.mapM'` is a a non-tail-recursive variant that may be
|
||||
This implementation is tail recursive. `List.mapM'` is a non-tail-recursive variant that may be
|
||||
more convenient to reason about. `List.forM` is the variant that discards the results and
|
||||
`List.mapA` is the variant that works with `Applicative`.
|
||||
-/
|
||||
@@ -107,7 +107,7 @@ Applies the monadic action `f` to the corresponding elements of two lists, left-
|
||||
at the end of the shorter list. `zipWithM f as bs` is equivalent to `mapM id (zipWith f as bs)`
|
||||
for lawful `Monad` instances.
|
||||
|
||||
This implementation is tail recursive. `List.zipWithM'` is a a non-tail-recursive variant that may
|
||||
This implementation is tail recursive. `List.zipWithM'` is a non-tail-recursive variant that may
|
||||
be more convenient to reason about.
|
||||
-/
|
||||
@[inline, expose]
|
||||
|
||||
@@ -2941,9 +2941,6 @@ theorem getLast?_replicate {a : α} {n : Nat} : (replicate n a).getLast? = if n
|
||||
|
||||
/-! ### leftpad -/
|
||||
|
||||
-- We unfold `leftpad` and `rightpad` for verification purposes.
|
||||
attribute [simp, grind =] leftpad rightpad
|
||||
|
||||
-- `length_leftpad` and `length_rightpad` are in `Init.Data.List.Nat.Basic`.
|
||||
|
||||
theorem leftpad_prefix {n : Nat} {a : α} {l : List α} :
|
||||
|
||||
@@ -223,6 +223,16 @@ theorem testBit_lt_two_pow {x i : Nat} (lt : x < 2^i) : x.testBit i = false := b
|
||||
exfalso
|
||||
exact Nat.not_le_of_gt lt (ge_two_pow_of_testBit p)
|
||||
|
||||
theorem testBit_of_two_pow_le_and_two_pow_add_one_gt {n i : Nat}
|
||||
(hle : 2^i ≤ n) (hgt : n < 2^(i + 1)) : n.testBit i = true := by
|
||||
rcases exists_ge_and_testBit_of_ge_two_pow hle with ⟨i', ⟨_, _⟩⟩
|
||||
have : i = i' := by
|
||||
false_or_by_contra
|
||||
have : 2 ^ (i + 1) ≤ 2 ^ i' := Nat.pow_le_pow_of_le (by decide) (by omega)
|
||||
have : n.testBit i' = false := testBit_lt_two_pow (by omega)
|
||||
simp_all only [Bool.false_eq_true]
|
||||
rwa [this]
|
||||
|
||||
theorem lt_pow_two_of_testBit (x : Nat) (p : ∀i, i ≥ n → testBit x i = false) : x < 2^n := by
|
||||
apply Decidable.by_contra
|
||||
intro not_lt
|
||||
@@ -231,6 +241,10 @@ theorem lt_pow_two_of_testBit (x : Nat) (p : ∀i, i ≥ n → testBit x i = fal
|
||||
have test_false := p _ i_ge_n
|
||||
simp [test_true] at test_false
|
||||
|
||||
theorem testBit_log2 {n : Nat} (h : n ≠ 0) : n.testBit n.log2 = true := by
|
||||
have := log2_eq_iff (n := n) (k := n.log2) (by omega)
|
||||
apply testBit_of_two_pow_le_and_two_pow_add_one_gt <;> omega
|
||||
|
||||
private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by
|
||||
induction x with
|
||||
| zero =>
|
||||
|
||||
@@ -129,6 +129,9 @@ theorem gcd_assoc (m n k : Nat) : gcd (gcd m n) k = gcd m (gcd n k) :=
|
||||
(Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))
|
||||
instance : Std.Associative gcd := ⟨gcd_assoc⟩
|
||||
|
||||
theorem gcd_left_comm (m n k : Nat) : gcd m (gcd n k) = gcd n (gcd m k) := by
|
||||
rw [← gcd_assoc, ← gcd_assoc, gcd_comm m n]
|
||||
|
||||
@[simp] theorem gcd_one_right (n : Nat) : gcd n 1 = 1 := (gcd_comm n 1).trans (gcd_one_left n)
|
||||
|
||||
theorem gcd_mul_left (m n k : Nat) : gcd (m * n) (m * k) = m * gcd n k := by
|
||||
|
||||
@@ -10,7 +10,7 @@ import all Init.Data.Nat.Bitwise.Basic
|
||||
public import Init.Data.Nat.MinMax
|
||||
public import Init.Data.Nat.Log2
|
||||
import all Init.Data.Nat.Log2
|
||||
public import Init.Data.Nat.Power2
|
||||
public import Init.Data.Nat.Power2.Basic
|
||||
public import Init.Data.Nat.Mod
|
||||
import Init.TacticsExtra
|
||||
import Init.BinderPredicates
|
||||
|
||||
@@ -6,66 +6,5 @@ Authors: Leonardo de Moura
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.Nat.Linear
|
||||
|
||||
public section
|
||||
|
||||
namespace Nat
|
||||
|
||||
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
|
||||
have : power * 2 = power + power := by simp +arith
|
||||
rw [this, Nat.sub_add_eq]
|
||||
exact Nat.sub_lt (Nat.zero_lt_sub_of_lt h₂) h₁
|
||||
|
||||
/--
|
||||
Returns the least power of two that's greater than or equal to `n`.
|
||||
|
||||
Examples:
|
||||
* `Nat.nextPowerOfTwo 0 = 1`
|
||||
* `Nat.nextPowerOfTwo 1 = 1`
|
||||
* `Nat.nextPowerOfTwo 2 = 2`
|
||||
* `Nat.nextPowerOfTwo 3 = 4`
|
||||
* `Nat.nextPowerOfTwo 5 = 8`
|
||||
-/
|
||||
def nextPowerOfTwo (n : Nat) : Nat :=
|
||||
go 1 (by decide)
|
||||
where
|
||||
go (power : Nat) (h : power > 0) : Nat :=
|
||||
if power < n then
|
||||
go (power * 2) (Nat.mul_pos h (by decide))
|
||||
else
|
||||
power
|
||||
termination_by n - power
|
||||
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
|
||||
|
||||
/--
|
||||
A natural number `n` is a power of two if there exists some `k : Nat` such that `n = 2 ^ k`.
|
||||
-/
|
||||
def isPowerOfTwo (n : Nat) := ∃ k, n = 2 ^ k
|
||||
|
||||
theorem isPowerOfTwo_one : isPowerOfTwo 1 :=
|
||||
⟨0, by decide⟩
|
||||
|
||||
theorem isPowerOfTwo_mul_two_of_isPowerOfTwo (h : isPowerOfTwo n) : isPowerOfTwo (n * 2) :=
|
||||
have ⟨k, h⟩ := h
|
||||
⟨k+1, by simp [h, Nat.pow_succ]⟩
|
||||
|
||||
theorem pos_of_isPowerOfTwo (h : isPowerOfTwo n) : n > 0 := by
|
||||
have ⟨k, h⟩ := h
|
||||
rw [h]
|
||||
apply Nat.pow_pos
|
||||
decide
|
||||
|
||||
theorem isPowerOfTwo_nextPowerOfTwo (n : Nat) : n.nextPowerOfTwo.isPowerOfTwo := by
|
||||
apply isPowerOfTwo_go
|
||||
apply isPowerOfTwo_one
|
||||
where
|
||||
isPowerOfTwo_go (power : Nat) (h₁ : power > 0) (h₂ : power.isPowerOfTwo) : (nextPowerOfTwo.go n power h₁).isPowerOfTwo := by
|
||||
unfold nextPowerOfTwo.go
|
||||
split
|
||||
. exact isPowerOfTwo_go (power*2) (Nat.mul_pos h₁ (by decide)) (Nat.isPowerOfTwo_mul_two_of_isPowerOfTwo h₂)
|
||||
. assumption
|
||||
termination_by n - power
|
||||
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
|
||||
|
||||
end Nat
|
||||
public import Init.Data.Nat.Power2.Basic
|
||||
public import Init.Data.Nat.Power2.Lemmas
|
||||
|
||||
71
src/Init/Data/Nat/Power2/Basic.lean
Normal file
71
src/Init/Data/Nat/Power2/Basic.lean
Normal file
@@ -0,0 +1,71 @@
|
||||
/-
|
||||
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.Nat.Linear
|
||||
|
||||
public section
|
||||
|
||||
namespace Nat
|
||||
|
||||
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
|
||||
have : power * 2 = power + power := by simp +arith
|
||||
rw [this, Nat.sub_add_eq]
|
||||
exact Nat.sub_lt (Nat.zero_lt_sub_of_lt h₂) h₁
|
||||
|
||||
/--
|
||||
Returns the least power of two that's greater than or equal to `n`.
|
||||
|
||||
Examples:
|
||||
* `Nat.nextPowerOfTwo 0 = 1`
|
||||
* `Nat.nextPowerOfTwo 1 = 1`
|
||||
* `Nat.nextPowerOfTwo 2 = 2`
|
||||
* `Nat.nextPowerOfTwo 3 = 4`
|
||||
* `Nat.nextPowerOfTwo 5 = 8`
|
||||
-/
|
||||
def nextPowerOfTwo (n : Nat) : Nat :=
|
||||
go 1 (by decide)
|
||||
where
|
||||
go (power : Nat) (h : power > 0) : Nat :=
|
||||
if power < n then
|
||||
go (power * 2) (Nat.mul_pos h (by decide))
|
||||
else
|
||||
power
|
||||
termination_by n - power
|
||||
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
|
||||
|
||||
/--
|
||||
A natural number `n` is a power of two if there exists some `k : Nat` such that `n = 2 ^ k`.
|
||||
-/
|
||||
def isPowerOfTwo (n : Nat) := ∃ k, n = 2 ^ k
|
||||
|
||||
theorem isPowerOfTwo_one : isPowerOfTwo 1 :=
|
||||
⟨0, by decide⟩
|
||||
|
||||
theorem isPowerOfTwo_mul_two_of_isPowerOfTwo (h : isPowerOfTwo n) : isPowerOfTwo (n * 2) :=
|
||||
have ⟨k, h⟩ := h
|
||||
⟨k+1, by simp [h, Nat.pow_succ]⟩
|
||||
|
||||
theorem pos_of_isPowerOfTwo (h : isPowerOfTwo n) : n > 0 := by
|
||||
have ⟨k, h⟩ := h
|
||||
rw [h]
|
||||
apply Nat.pow_pos
|
||||
decide
|
||||
|
||||
theorem isPowerOfTwo_nextPowerOfTwo (n : Nat) : n.nextPowerOfTwo.isPowerOfTwo := by
|
||||
apply isPowerOfTwo_go
|
||||
apply isPowerOfTwo_one
|
||||
where
|
||||
isPowerOfTwo_go (power : Nat) (h₁ : power > 0) (h₂ : power.isPowerOfTwo) : (nextPowerOfTwo.go n power h₁).isPowerOfTwo := by
|
||||
unfold nextPowerOfTwo.go
|
||||
split
|
||||
. exact isPowerOfTwo_go (power*2) (Nat.mul_pos h₁ (by decide)) (Nat.isPowerOfTwo_mul_two_of_isPowerOfTwo h₂)
|
||||
. assumption
|
||||
termination_by n - power
|
||||
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
|
||||
|
||||
end Nat
|
||||
62
src/Init/Data/Nat/Power2/Lemmas.lean
Normal file
62
src/Init/Data/Nat/Power2/Lemmas.lean
Normal file
@@ -0,0 +1,62 @@
|
||||
/-
|
||||
Copyright (c) George Rennie. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: George Rennie
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
import all Init.Data.Nat.Power2.Basic
|
||||
public import Init.Data.Nat.Bitwise.Lemmas
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Further lemmas about `Nat.isPowerOfTwo`, with the convenience of having bitwise lemmas available.
|
||||
-/
|
||||
|
||||
namespace Nat
|
||||
|
||||
theorem not_isPowerOfTwo_zero : ¬isPowerOfTwo 0 := by
|
||||
rw [isPowerOfTwo, not_exists]
|
||||
intro x
|
||||
have := one_le_pow x 2 (by decide)
|
||||
omega
|
||||
|
||||
theorem and_sub_one_testBit_log2 {n : Nat} (h : n ≠ 0) (hpow2 : ¬n.isPowerOfTwo) :
|
||||
(n &&& (n - 1)).testBit n.log2 := by
|
||||
rw [testBit_and, Bool.and_eq_true]
|
||||
constructor
|
||||
· exact testBit_log2 (by omega)
|
||||
· by_cases n = 2^n.log2
|
||||
· rw [isPowerOfTwo, not_exists] at hpow2
|
||||
have := hpow2 n.log2
|
||||
trivial
|
||||
· have := log2_eq_iff (n := n) (k := n.log2) (by omega)
|
||||
have : (n - 1).log2 = n.log2 := by rw [log2_eq_iff] <;> omega
|
||||
rw [←this]
|
||||
exact testBit_log2 (by omega)
|
||||
|
||||
theorem and_sub_one_eq_zero_iff_isPowerOfTwo {n : Nat} (h : n ≠ 0) :
|
||||
(n &&& (n - 1)) = 0 ↔ n.isPowerOfTwo := by
|
||||
constructor
|
||||
· intro hbitwise
|
||||
false_or_by_contra
|
||||
rename_i hpow2
|
||||
have := and_sub_one_testBit_log2 h hpow2
|
||||
rwa [hbitwise, zero_testBit n.log2, Bool.false_eq_true] at this
|
||||
· intro hpow2
|
||||
rcases hpow2 with ⟨_, hpow2⟩
|
||||
rw [hpow2, and_two_pow_sub_one_eq_mod, mod_self]
|
||||
|
||||
theorem ne_zero_and_sub_one_eq_zero_iff_isPowerOfTwo {n : Nat} :
|
||||
((n ≠ 0) ∧ (n &&& (n - 1)) = 0) ↔ n.isPowerOfTwo := by
|
||||
match h : n with
|
||||
| 0 => simp [not_isPowerOfTwo_zero]
|
||||
| n + 1 => simp; exact and_sub_one_eq_zero_iff_isPowerOfTwo (by omega)
|
||||
|
||||
@[inline]
|
||||
instance {n : Nat} : Decidable n.isPowerOfTwo :=
|
||||
decidable_of_iff _ ne_zero_and_sub_one_eq_zero_iff_isPowerOfTwo
|
||||
|
||||
end Nat
|
||||
@@ -46,7 +46,7 @@ theorem ne_of_cmp_ne_eq {α : Type u} {cmp : α → α → Ordering} [Std.ReflCm
|
||||
|
||||
end ReflCmp
|
||||
|
||||
/-- A typeclasses for ordered types for which `compare a a = .eq` for all `a`. -/
|
||||
/-- A typeclass for ordered types for which `compare a a = .eq` for all `a`. -/
|
||||
abbrev ReflOrd (α : Type u) [Ord α] := ReflCmp (compare : α → α → Ordering)
|
||||
|
||||
@[simp]
|
||||
|
||||
@@ -246,8 +246,12 @@ class InfinitelyUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
|
||||
This propositional typeclass ensures that `UpwardEnumerable.succ?` is injective.
|
||||
-/
|
||||
class LinearlyUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
|
||||
/-- The implementation of `UpwardEnumerable.succ?` for `α` is injective. -/
|
||||
eq_of_succ?_eq : ∀ a b : α, UpwardEnumerable.succ? a = UpwardEnumerable.succ? b → a = b
|
||||
|
||||
/--
|
||||
If a type is infinitely upwardly enumerable, then every element has a successor.
|
||||
-/
|
||||
theorem UpwardEnumerable.isSome_succ? {α : Type u} [UpwardEnumerable α]
|
||||
[InfinitelyUpwardEnumerable α] {a : α} : (succ? a).isSome :=
|
||||
InfinitelyUpwardEnumerable.isSome_succ? a
|
||||
|
||||
@@ -40,7 +40,7 @@ class Rcc.Sliceable (α : Type u) (β : outParam (Type v)) (γ : outParam (Type
|
||||
This typeclass indicates how to obtain slices of elements of {lit}`α` over ranges in the index type
|
||||
{lit}`β`, the ranges being left-closed right-open.
|
||||
|
||||
The type of resulting the slices is {lit}`γ`.
|
||||
The type of the resulting slices is {lit}`γ`.
|
||||
-/
|
||||
class Rco.Sliceable (α : Type u) (β : outParam (Type v)) (γ : outParam (Type w)) where
|
||||
/--
|
||||
|
||||
@@ -1396,6 +1396,7 @@ scalar value.
|
||||
public def IsUTF8FirstByte (c : UInt8) : Prop :=
|
||||
c &&& 0x80 = 0 ∨ c &&& 0xe0 = 0xc0 ∨ c &&& 0xf0 = 0xe0 ∨ c &&& 0xf8 = 0xf0
|
||||
|
||||
@[inline]
|
||||
public instance {c : UInt8} : Decidable c.IsUTF8FirstByte :=
|
||||
inferInstanceAs <| Decidable (c &&& 0x80 = 0 ∨ c &&& 0xe0 = 0xc0 ∨ c &&& 0xf0 = 0xe0 ∨ c &&& 0xf8 = 0xf0)
|
||||
|
||||
|
||||
@@ -119,7 +119,7 @@ instance (s : Slice) : Std.Iterator (ForwardSliceSearcher s) Id (SearchStep s) w
|
||||
-- **Invariant 1:** we have already covered everything up until `stackPos - needlePos` (exclusive),
|
||||
-- with matches and rejections.
|
||||
-- **Invariant 2:** `stackPos - needlePos` is a valid position
|
||||
-- **Invariant 3:** the range from from `stackPos - needlePos` to `stackPos` (exclusive) is a
|
||||
-- **Invariant 3:** the range from `stackPos - needlePos` to `stackPos` (exclusive) is a
|
||||
-- prefix of the pattern.
|
||||
if h₁ : stackPos < s.rawEndPos then
|
||||
let stackByte := s.getUTF8Byte stackPos h₁
|
||||
|
||||
@@ -20,7 +20,7 @@ functionality for searching for various kinds of pattern matches in slices to it
|
||||
provide subslices according to matches etc. The key design principles behind this module are:
|
||||
- Instead of providing one function per kind of pattern the API is generic over various kinds of
|
||||
patterns. Thus it only provides e.g. one kind of function for looking for the position of the
|
||||
first occurence of a pattern. Currently the supported patterns are:
|
||||
first occurrence of a pattern. Currently the supported patterns are:
|
||||
- {name}`Char`
|
||||
- {lean}`Char → Bool`
|
||||
- {name}`String` and {name}`String.Slice` (partially: doing non trivial searches backwards is not
|
||||
|
||||
@@ -796,7 +796,8 @@ theorem getElem?_eq_none {xs : Vector α n} (h : n ≤ i) : xs[i]? = none := by
|
||||
|
||||
-- This is a more aggressive pattern than for `List/Array.getElem?_eq_none`, because
|
||||
-- `length/size` won't appear.
|
||||
grind_pattern Vector.getElem?_eq_none => xs[i]?
|
||||
grind_pattern Vector.getElem?_eq_none => xs[i]? where
|
||||
guard n ≤ i
|
||||
|
||||
@[simp] theorem getElem?_eq_getElem {xs : Vector α n} {i : Nat} (h : i < n) : xs[i]? = some xs[i] :=
|
||||
getElem?_pos ..
|
||||
|
||||
@@ -366,9 +366,11 @@ instance : GetElem? (List α) Nat α fun as i => i < as.length where
|
||||
theorem none_eq_getElem?_iff {l : List α} {i : Nat} : none = l[i]? ↔ length l ≤ i := by
|
||||
simp [eq_comm (a := none)]
|
||||
|
||||
@[grind =]
|
||||
theorem getElem?_eq_none (h : length l ≤ i) : l[i]? = none := getElem?_eq_none_iff.mpr h
|
||||
|
||||
grind_pattern getElem?_eq_none => l.length, l[i]? where
|
||||
guard l.length ≤ i
|
||||
|
||||
instance : LawfulGetElem (List α) Nat α fun as i => i < as.length where
|
||||
getElem?_def as i h := by
|
||||
split <;> simp_all
|
||||
|
||||
@@ -21,6 +21,8 @@ structure Config where
|
||||
/-- If `suggestions` is `true`, `grind` will invoke the currently configured library suggestion engine on the current goal,
|
||||
and add attempt to use the resulting suggestions as additional parameters to the `grind` tactic. -/
|
||||
suggestions : Bool := false
|
||||
/-- If `locals` is `true`, `grind` will add all definitions from the current file. -/
|
||||
locals : Bool := false
|
||||
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
|
||||
splits : Nat := 9
|
||||
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
|
||||
|
||||
@@ -766,7 +766,7 @@ def Poly.cancelVar (c : Int) (x : Var) (p : Poly) : Poly :=
|
||||
(fun _ _ _ _ => a.toPoly_k.pow k)
|
||||
(fun _ _ _ _ => a.toPoly_k.pow k)
|
||||
(fun _ _ _ => a.toPoly_k.pow k)
|
||||
a) = match (generalizing := false) a with
|
||||
a) = match a with
|
||||
| num n => Poly.num (n ^ k)
|
||||
| .intCast n => .num (n^k)
|
||||
| .natCast n => .num (n^k)
|
||||
|
||||
@@ -132,6 +132,11 @@ structure Config where
|
||||
Unused `have`s are still removed if `zeta` or `zetaUnused` are true.
|
||||
-/
|
||||
zetaHave : Bool := true
|
||||
/--
|
||||
If `locals` is `true`, `dsimp` will unfold all definitions from the current file.
|
||||
For local theorems, use `+suggestions` instead.
|
||||
-/
|
||||
locals : Bool := false
|
||||
deriving Inhabited, BEq
|
||||
|
||||
end DSimp
|
||||
@@ -297,6 +302,11 @@ structure Config where
|
||||
and attempt to use the resulting suggestions as parameters to the `simp` tactic.
|
||||
-/
|
||||
suggestions : Bool := false
|
||||
/--
|
||||
If `locals` is `true`, `simp` will unfold all definitions from the current file.
|
||||
For local theorems, use `+suggestions` instead.
|
||||
-/
|
||||
locals : Bool := false
|
||||
deriving Inhabited, BEq
|
||||
|
||||
-- Configuration object for `simp_all`
|
||||
|
||||
@@ -523,7 +523,7 @@ macro_rules
|
||||
| `(bif $c then $t else $e) => `(cond $c $t $e)
|
||||
|
||||
/--
|
||||
Haskell-like pipe operator `<|`. `f <| x` means the same as the same as `f x`,
|
||||
Haskell-like pipe operator `<|`. `f <| x` means the same as `f x`,
|
||||
except that it parses `x` with lower precedence, which means that `f <| g <| x`
|
||||
is interpreted as `f (g x)` rather than `(f g) x`.
|
||||
-/
|
||||
@@ -557,7 +557,7 @@ macro_rules
|
||||
| `($a |> $f) => `($f $a)
|
||||
|
||||
/--
|
||||
Alternative syntax for `<|`. `f $ x` means the same as the same as `f x`,
|
||||
Alternative syntax for `<|`. `f $ x` means the same as `f x`,
|
||||
except that it parses `x` with lower precedence, which means that `f $ g $ x`
|
||||
is interpreted as `f (g x)` rather than `(f g) x`.
|
||||
-/
|
||||
@@ -782,9 +782,16 @@ Position reporting for `#guard_msgs`:
|
||||
-/
|
||||
syntax guardMsgsPositions := &"positions" " := " guardMsgsPositionsArg
|
||||
|
||||
/--
|
||||
Substring matching for `#guard_msgs`:
|
||||
- `substring := true` checks that the docstring appears as a substring of the output.
|
||||
- `substring := false` (the default) requires exact matching (modulo whitespace normalization).
|
||||
-/
|
||||
syntax guardMsgsSubstring := &"substring" " := " (&"true" <|> &"false")
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
syntax guardMsgsSpecElt :=
|
||||
guardMsgsFilter <|> guardMsgsWhitespace <|> guardMsgsOrdering <|> guardMsgsPositions
|
||||
guardMsgsFilter <|> guardMsgsWhitespace <|> guardMsgsOrdering <|> guardMsgsPositions <|> guardMsgsSubstring
|
||||
|
||||
set_option linter.missingDocs false in
|
||||
syntax guardMsgsSpec := "(" guardMsgsSpecElt,* ")"
|
||||
@@ -860,6 +867,11 @@ Position reporting:
|
||||
`#guard_msgs` appears.
|
||||
- `positions := false` does not report position info.
|
||||
|
||||
Substring matching:
|
||||
- `substring := true` checks that the docstring appears as a substring of the output
|
||||
(after whitespace normalization). This is useful when you only care about part of the message.
|
||||
- `substring := false` (the default) requires exact matching (modulo whitespace normalization).
|
||||
|
||||
For example, `#guard_msgs (error, drop all) in cmd` means to check errors and drop
|
||||
everything else.
|
||||
|
||||
@@ -873,6 +885,13 @@ The top-level command elaborator only runs the linters if `#guard_msgs` is not p
|
||||
syntax (name := guardMsgsCmd)
|
||||
(plainDocComment)? "#guard_msgs" (ppSpace guardMsgsSpec)? " in" ppLine command : command
|
||||
|
||||
/--
|
||||
`#guard_panic in cmd` runs `cmd` and succeeds if the command produces a panic message.
|
||||
This is useful for testing that a command panics without matching the exact (volatile) panic text.
|
||||
-/
|
||||
syntax (name := guardPanicCmd)
|
||||
"#guard_panic" " in" ppLine command : command
|
||||
|
||||
/--
|
||||
Format and print the info trees for a given command.
|
||||
This is mostly useful for debugging info trees.
|
||||
|
||||
@@ -67,7 +67,7 @@ syntax unifConstraint := term patternIgnore(" =?= " <|> " ≟ ") term
|
||||
syntax unifConstraintElem := colGe unifConstraint ", "?
|
||||
|
||||
syntax (docComment)? attrKind "unif_hint" (ppSpace ident)? (ppSpace bracketedBinder)*
|
||||
" where " withPosition(unifConstraintElem*) patternIgnore(atomic("|" noWs "-") <|> "⊢") unifConstraint : command
|
||||
" where " withPosition(unifConstraintElem*) patternIgnore(atomic("|" noWs "-") <|> "⊢") ppSpace unifConstraint : command
|
||||
|
||||
macro_rules
|
||||
| `($[$doc?:docComment]? $kind:attrKind unif_hint $(n)? $bs* where $[$cs₁ ≟ $cs₂]* |- $t₁ ≟ $t₂) => do
|
||||
@@ -120,7 +120,7 @@ calc
|
||||
_ = z := pyz
|
||||
```
|
||||
It is also possible to write the *first* relation as `<lhs>\n _ = <rhs> :=
|
||||
<proof>`. This is useful for aligning relation symbols, especially on longer:
|
||||
<proof>`. This is useful for aligning relation symbols, especially on longer
|
||||
identifiers:
|
||||
```
|
||||
calc abc
|
||||
|
||||
@@ -375,6 +375,10 @@ theorem congr {α : Sort u} {β : Sort v} {f₁ f₂ : α → β} {a₁ a₂ :
|
||||
theorem congrFun {α : Sort u} {β : α → Sort v} {f g : (x : α) → β x} (h : Eq f g) (a : α) : Eq (f a) (g a) :=
|
||||
h ▸ rfl
|
||||
|
||||
/-- Similar to `congrFun` but `β` does not depend on `α`. -/
|
||||
theorem congrFun' {α : Sort u} {β : Sort v} {f g : α → β} (h : Eq f g) (a : α) : Eq (f a) (g a) :=
|
||||
h ▸ rfl
|
||||
|
||||
/-!
|
||||
Initialize the Quotient Module, which effectively adds the following definitions:
|
||||
```
|
||||
@@ -903,7 +907,7 @@ instance [Inhabited α] : Inhabited (ULift α) where
|
||||
Lifts a type or proposition to a higher universe level.
|
||||
|
||||
`PULift α` wraps a value of type `α`. It is a generalization of
|
||||
`PLift` that allows lifting values who's type may live in `Sort s`.
|
||||
`PLift` that allows lifting values whose type may live in `Sort s`.
|
||||
It also subsumes `PLift`.
|
||||
-/
|
||||
-- The universe variable `r` is written first so that `ULift.{r} α` can be used
|
||||
@@ -3521,7 +3525,7 @@ instance : DecidableEq String.Pos.Raw :=
|
||||
/--
|
||||
A region or slice of some underlying string.
|
||||
|
||||
A substring contains an string together with the start and end byte positions of a region of
|
||||
A substring contains a string together with the start and end byte positions of a region of
|
||||
interest. Actually extracting a substring requires copying and memory allocation, while many
|
||||
substrings of the same underlying string may exist with very little overhead, and they are more
|
||||
convenient than tracking the bounds by hand.
|
||||
|
||||
@@ -38,6 +38,12 @@ theorem eq_false_of_decide {p : Prop} {_ : Decidable p} (h : decide p = false) :
|
||||
theorem implies_congr {p₁ p₂ : Sort u} {q₁ q₂ : Sort v} (h₁ : p₁ = p₂) (h₂ : q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
|
||||
h₁ ▸ h₂ ▸ rfl
|
||||
|
||||
theorem implies_congr_left {p₁ p₂ : Sort u} {q : Sort v} (h : p₁ = p₂) : (p₁ → q) = (p₂ → q) :=
|
||||
h ▸ rfl
|
||||
|
||||
theorem implies_congr_right {p : Sort u} {q₁ q₂ : Sort v} (h : q₁ = q₂) : (p → q₁) = (p → q₂) :=
|
||||
h ▸ rfl
|
||||
|
||||
theorem iff_congr {p₁ p₂ q₁ q₂ : Prop} (h₁ : p₁ ↔ p₂) (h₂ : q₁ ↔ q₂) : (p₁ ↔ q₁) ↔ (p₂ ↔ q₂) :=
|
||||
Iff.of_eq (propext h₁ ▸ propext h₂ ▸ rfl)
|
||||
|
||||
|
||||
@@ -150,7 +150,7 @@ def parent (p : FilePath) : Option FilePath :=
|
||||
/--
|
||||
Extracts the last element of a path if it is a file or directory name.
|
||||
|
||||
Returns `none ` if the last entry is a special name (such as `.` or `..`) or if the path is the root
|
||||
Returns `none` if the last entry is a special name (such as `.` or `..`) or if the path is the root
|
||||
directory.
|
||||
-/
|
||||
def fileName (p : FilePath) : Option String :=
|
||||
|
||||
@@ -561,7 +561,7 @@ Waits for the task to finish, then returns its result.
|
||||
return t.get
|
||||
|
||||
/--
|
||||
Waits until any of the tasks in the list has finished, then return its result.
|
||||
Waits until any of the tasks in the list has finished, then returns its result.
|
||||
-/
|
||||
@[extern "lean_io_wait_any"] opaque waitAny (tasks : @& List (Task α))
|
||||
(h : tasks.length > 0 := by exact Nat.zero_lt_succ _) : BaseIO α :=
|
||||
@@ -679,7 +679,7 @@ File handles wrap the underlying operating system's file descriptors. There is n
|
||||
to close a file: when the last reference to a file handle is dropped, the file is closed
|
||||
automatically.
|
||||
|
||||
Handles have an associated read/write cursor that determines the where reads and writes occur in the
|
||||
Handles have an associated read/write cursor that determines where reads and writes occur in the
|
||||
file.
|
||||
-/
|
||||
opaque FS.Handle : Type := Unit
|
||||
@@ -790,7 +790,7 @@ An exception is thrown if the file cannot be opened.
|
||||
/--
|
||||
Acquires an exclusive or shared lock on the handle. Blocks to wait for the lock if necessary.
|
||||
|
||||
Acquiring a exclusive lock while already possessing a shared lock will **not** reliably succeed: it
|
||||
Acquiring an exclusive lock while already possessing a shared lock will **not** reliably succeed: it
|
||||
works on Unix-like systems but not on Windows.
|
||||
-/
|
||||
@[extern "lean_io_prim_handle_lock"] opaque lock (h : @& Handle) (exclusive := true) : IO Unit
|
||||
@@ -798,7 +798,7 @@ works on Unix-like systems but not on Windows.
|
||||
Tries to acquire an exclusive or shared lock on the handle and returns `true` if successful. Will
|
||||
not block if the lock cannot be acquired, but instead returns `false`.
|
||||
|
||||
Acquiring a exclusive lock while already possessing a shared lock will **not** reliably succeed: it
|
||||
Acquiring an exclusive lock while already possessing a shared lock will **not** reliably succeed: it
|
||||
works on Unix-like systems but not on Windows.
|
||||
-/
|
||||
@[extern "lean_io_prim_handle_try_lock"] opaque tryLock (h : @& Handle) (exclusive := true) : IO Bool
|
||||
@@ -1350,7 +1350,7 @@ def withTempFile [Monad m] [MonadFinally m] [MonadLiftT IO m] (f : Handle → Fi
|
||||
removeFile path
|
||||
|
||||
/--
|
||||
Creates a temporary directory in the most secure manner possible, providing a its path to an `IO`
|
||||
Creates a temporary directory in the most secure manner possible, providing its path to an `IO`
|
||||
action. Afterwards, all files in the temporary directory are recursively deleted, regardless of how
|
||||
or when they were created.
|
||||
|
||||
@@ -1480,7 +1480,7 @@ possible to close the child's standard input before the process terminates, whic
|
||||
@[extern "lean_io_process_spawn"] opaque spawn (args : SpawnArgs) : IO (Child args.toStdioConfig)
|
||||
|
||||
/--
|
||||
Blocks until the child process has exited and return its exit code.
|
||||
Blocks until the child process has exited and returns its exit code.
|
||||
-/
|
||||
@[extern "lean_io_process_child_wait"] opaque Child.wait {cfg : @& StdioConfig} : @& Child cfg → IO UInt32
|
||||
|
||||
@@ -1586,7 +1586,7 @@ end Process
|
||||
/--
|
||||
POSIX-style file permissions.
|
||||
|
||||
The `FileRight` structure describes these permissions for a file's owner, members of it's designated
|
||||
The `FileRight` structure describes these permissions for a file's owner, members of its designated
|
||||
group, and all others.
|
||||
-/
|
||||
structure AccessRight where
|
||||
@@ -1863,7 +1863,7 @@ unsafe def Runtime.markPersistent (a : α) : BaseIO α := return a
|
||||
|
||||
set_option linter.unusedVariables false in
|
||||
/--
|
||||
Discards the passed owned reference. This leads to `a` any any object reachable from it never being
|
||||
Discards the passed owned reference. This leads to `a` and any object reachable from it never being
|
||||
freed. This can be a useful optimization for eliding deallocation time of big object graphs that are
|
||||
kept alive close to the end of the process anyway (in which case calling `Runtime.markPersistent`
|
||||
would be similarly costly to deallocation). It is still considered a safe operation as it cannot
|
||||
|
||||
@@ -369,6 +369,12 @@ In this setting all definitions that are not opaque are unfolded.
|
||||
-/
|
||||
syntax (name := withUnfoldingAll) "with_unfolding_all " tacticSeq : tactic
|
||||
|
||||
/--
|
||||
`with_unfolding_none tacs` executes `tacs` using the `.none` transparency setting.
|
||||
In this setting no definitions are unfolded.
|
||||
-/
|
||||
syntax (name := withUnfoldingNone) "with_unfolding_none " tacticSeq : tactic
|
||||
|
||||
/-- `first | tac | ...` runs each `tac` until one succeeds, or else fails. -/
|
||||
syntax (name := first) "first " withPosition((ppDedent(ppLine) colGe "| " tacticSeq)+) : tactic
|
||||
|
||||
|
||||
@@ -58,6 +58,9 @@ syntax (name := attemptAll) "attempt_all " withPosition((ppDedent(ppLine) colGe
|
||||
/-- Helper internal tactic for implementing the tactic `try?` with parallel execution. -/
|
||||
syntax (name := attemptAllPar) "attempt_all_par " withPosition((ppDedent(ppLine) colGe "| " tacticSeq)+) : tactic
|
||||
|
||||
/-- Helper internal tactic for implementing the tactic `try?` with parallel execution, returning first success. -/
|
||||
syntax (name := firstPar) "first_par " withPosition((ppDedent(ppLine) colGe "| " tacticSeq)+) : tactic
|
||||
|
||||
/-- Helper internal tactic used to implement `evalSuggest` in `try?` -/
|
||||
syntax (name := tryResult) "try_suggestions " tactic* : tactic
|
||||
|
||||
|
||||
@@ -463,7 +463,7 @@ variable {motive : α → Sort v}
|
||||
variable (h : α → Nat)
|
||||
variable (F : (x : α) → ((y : α) → InvImage (· < ·) h y x → motive y) → motive x)
|
||||
|
||||
/-- Helper gadget that prevents reduction of `Nat.eager n` unless `n` evalutes to a ground term. -/
|
||||
/-- Helper gadget that prevents reduction of `Nat.eager n` unless `n` evaluates to a ground term. -/
|
||||
def Nat.eager (n : Nat) : Nat :=
|
||||
if Nat.beq n n = true then n else n
|
||||
|
||||
@@ -474,8 +474,8 @@ A well-founded fixpoint operator specialized for `Nat`-valued measures. Given a
|
||||
its higher order function argument `F` to invoke its argument only on values `y` that are smaller
|
||||
than `x` with regard to `h`.
|
||||
|
||||
In contrast to to `WellFounded.fix`, this fixpoint operator reduces on closed terms. (More precisely:
|
||||
when `h x` evalutes to a ground value)
|
||||
In contrast to `WellFounded.fix`, this fixpoint operator reduces on closed terms. (More precisely:
|
||||
when `h x` evaluates to a ground value)
|
||||
|
||||
-/
|
||||
def Nat.fix : (x : α) → motive x :=
|
||||
|
||||
@@ -147,18 +147,11 @@ inductive Alt where
|
||||
| alt (ctorName : Name) (params : Array Param) (code : Code)
|
||||
| default (code : Code)
|
||||
|
||||
structure FunDecl where
|
||||
fvarId : FVarId
|
||||
binderName : Name
|
||||
params : Array Param
|
||||
type : Expr
|
||||
value : Code
|
||||
inductive FunDecl where
|
||||
| mk (fvarId : FVarId) (binderName : Name) (params : Array Param) (type : Expr) (value : Code)
|
||||
|
||||
structure Cases where
|
||||
typeName : Name
|
||||
resultType : Expr
|
||||
discr : FVarId
|
||||
alts : Array Alt
|
||||
inductive Cases where
|
||||
| mk (typeName : Name) (resultType : Expr) (discr : FVarId) (alts : Array Alt)
|
||||
deriving Inhabited
|
||||
|
||||
inductive Code where
|
||||
@@ -173,6 +166,57 @@ inductive Code where
|
||||
|
||||
end
|
||||
|
||||
@[inline]
|
||||
def FunDecl.fvarId : FunDecl → FVarId
|
||||
| .mk (fvarId := fvarId) .. => fvarId
|
||||
|
||||
@[inline]
|
||||
def FunDecl.binderName : FunDecl → Name
|
||||
| .mk (binderName := binderName) .. => binderName
|
||||
|
||||
@[inline]
|
||||
def FunDecl.params : FunDecl → Array Param
|
||||
| .mk (params := params) .. => params
|
||||
|
||||
@[inline]
|
||||
def FunDecl.type : FunDecl → Expr
|
||||
| .mk (type := type) .. => type
|
||||
|
||||
@[inline]
|
||||
def FunDecl.value : FunDecl → Code
|
||||
| .mk (value := value) .. => value
|
||||
|
||||
@[inline]
|
||||
def FunDecl.updateBinderName : FunDecl → Name → FunDecl
|
||||
| .mk fvarId _ params type value, new =>
|
||||
.mk fvarId new params type value
|
||||
|
||||
@[inline]
|
||||
def FunDecl.toParam (decl : FunDecl) (borrow : Bool) : Param :=
|
||||
match decl with
|
||||
| .mk fvarId binderName _ type .. => ⟨fvarId, binderName, type, borrow⟩
|
||||
|
||||
@[inline]
|
||||
def Cases.typeName : Cases → Name
|
||||
| .mk (typeName := typeName) .. => typeName
|
||||
|
||||
@[inline]
|
||||
def Cases.resultType : Cases → Expr
|
||||
| .mk (resultType := resultType) .. => resultType
|
||||
|
||||
@[inline]
|
||||
def Cases.discr : Cases → FVarId
|
||||
| .mk (discr := discr) .. => discr
|
||||
|
||||
@[inline]
|
||||
def Cases.alts : Cases → Array Alt
|
||||
| .mk (alts := alts) .. => alts
|
||||
|
||||
@[inline]
|
||||
def Cases.updateAlts : Cases → Array Alt → Cases
|
||||
| .mk typeName resultType discr _, new =>
|
||||
.mk typeName resultType discr new
|
||||
|
||||
deriving instance Inhabited for Alt
|
||||
deriving instance Inhabited for FunDecl
|
||||
|
||||
@@ -281,14 +325,18 @@ private unsafe def updateAltImp (alt : Alt) (ps' : Array Param) (k' : Code) : Al
|
||||
|
||||
@[inline] private unsafe def updateAltsImp (c : Code) (alts : Array Alt) : Code :=
|
||||
match c with
|
||||
| .cases cs => if ptrEq cs.alts alts then c else .cases { cs with alts }
|
||||
| .cases cs => if ptrEq cs.alts alts then c else .cases <| cs.updateAlts alts
|
||||
| _ => unreachable!
|
||||
|
||||
@[implemented_by updateAltsImp] opaque Code.updateAlts! (c : Code) (alts : Array Alt) : Code
|
||||
|
||||
@[inline] private unsafe def updateCasesImp (c : Code) (resultType : Expr) (discr : FVarId) (alts : Array Alt) : Code :=
|
||||
match c with
|
||||
| .cases cs => if ptrEq cs.alts alts && ptrEq cs.resultType resultType && cs.discr == discr then c else .cases { cs with discr, resultType, alts }
|
||||
| .cases cs =>
|
||||
if ptrEq cs.alts alts && ptrEq cs.resultType resultType && cs.discr == discr then
|
||||
c
|
||||
else
|
||||
.cases <| ⟨cs.typeName, resultType, discr, alts⟩
|
||||
| _ => unreachable!
|
||||
|
||||
@[implemented_by updateCasesImp] opaque Code.updateCases! (c : Code) (resultType : Expr) (discr : FVarId) (alts : Array Alt) : Code
|
||||
@@ -368,7 +416,7 @@ private unsafe def updateFunDeclCoreImp (decl: FunDecl) (type : Expr) (params :
|
||||
if ptrEq type decl.type && ptrEq params decl.params && ptrEq value decl.value then
|
||||
decl
|
||||
else
|
||||
{ decl with type, params, value }
|
||||
⟨decl.fvarId, decl.binderName, params, type, value⟩
|
||||
|
||||
/--
|
||||
Low-level update `FunDecl` function. It does not update the local context.
|
||||
@@ -378,7 +426,7 @@ to be updated.
|
||||
@[implemented_by updateFunDeclCoreImp] opaque FunDecl.updateCore (decl : FunDecl) (type : Expr) (params : Array Param) (value : Code) : FunDecl
|
||||
|
||||
def Cases.extractAlt! (cases : Cases) (ctorName : Name) : Alt × Cases :=
|
||||
let found i := (cases.alts[i], { cases with alts := cases.alts.eraseIdx i })
|
||||
let found i := (cases.alts[i]!, cases.updateAlts (cases.alts.eraseIdx! i))
|
||||
if let some i := cases.alts.findFinIdx? fun | .alt ctorName' .. => ctorName == ctorName' | _ => false then
|
||||
found i
|
||||
else if let some i := cases.alts.findFinIdx? fun | .default _ => true | _ => false then
|
||||
|
||||
@@ -48,7 +48,7 @@ where
|
||||
if alts.isEmpty then
|
||||
throwError "`Code.bind` failed, empty `cases` found"
|
||||
let resultType ← mkCasesResultType alts
|
||||
return .cases { c with alts, resultType }
|
||||
return .cases ⟨c.typeName, resultType, c.discr, alts⟩
|
||||
| .return fvarId => f fvarId
|
||||
| .jmp fvarId .. =>
|
||||
unless (← read).contains fvarId do
|
||||
|
||||
@@ -137,7 +137,7 @@ mutual
|
||||
/- We only collect the variables in the scope of the function application being specialized. -/
|
||||
if let some funDecl ← findFunDecl? fvarId then
|
||||
if ctx.abstract funDecl.fvarId then
|
||||
modify fun s => { s with params := s.params.push <| { funDecl with borrow := false } }
|
||||
modify fun s => { s with params := s.params.push <| funDecl.toParam false }
|
||||
else
|
||||
collectFunDecl funDecl
|
||||
modify fun s => { s with decls := s.decls.push <| .fun funDecl }
|
||||
|
||||
@@ -359,7 +359,7 @@ def mkLetDecl (binderName : Name) (type : Expr) (value : LetValue) : CompilerM L
|
||||
def mkFunDecl (binderName : Name) (type : Expr) (params : Array Param) (value : Code) : CompilerM FunDecl := do
|
||||
let fvarId ← mkFreshFVarId
|
||||
let binderName ← ensureNotAnonymous binderName `_f
|
||||
let funDecl := { fvarId, binderName, type, params, value }
|
||||
let funDecl := ⟨fvarId, binderName, params, type, value⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl funDecl
|
||||
return funDecl
|
||||
|
||||
@@ -397,7 +397,7 @@ private unsafe def updateFunDeclImp (decl : FunDecl) (type : Expr) (params : Arr
|
||||
if ptrEq type decl.type && ptrEq params decl.params && ptrEq value decl.value then
|
||||
return decl
|
||||
else
|
||||
let decl := { decl with type, params, value }
|
||||
let decl := ⟨decl.fvarId, decl.binderName, params, type, value⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl decl
|
||||
return decl
|
||||
|
||||
|
||||
@@ -119,7 +119,7 @@ partial def internalizeFunDecl (decl : FunDecl) : InternalizeM FunDecl := do
|
||||
let params ← decl.params.mapM internalizeParam
|
||||
let value ← internalizeCode decl.value
|
||||
let fvarId ← mkNewFVarId decl.fvarId
|
||||
let decl := { decl with binderName, fvarId, params, type, value }
|
||||
let decl := ⟨fvarId, binderName, params, type, value⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl decl
|
||||
return decl
|
||||
|
||||
@@ -139,7 +139,7 @@ partial def internalizeCode (code : Code) : InternalizeM Code := do
|
||||
let alts ← c.alts.mapM fun
|
||||
| .alt ctorName params k => return .alt ctorName (← params.mapM internalizeParam) (← internalizeAltCode k)
|
||||
| .default k => return .default (← internalizeAltCode k)
|
||||
return .cases { c with discr, alts, resultType }
|
||||
return .cases ⟨c.typeName, resultType, discr, alts⟩
|
||||
|
||||
end
|
||||
|
||||
|
||||
@@ -229,10 +229,8 @@ where
|
||||
| _, _ => return Code.updateLet! code decl (← go k)
|
||||
| .fun decl k =>
|
||||
if let some replacement := (← read)[decl.fvarId]? then
|
||||
let newDecl := { decl with
|
||||
binderName := replacement,
|
||||
value := (← go decl.value)
|
||||
}
|
||||
let newValue ← go decl.value
|
||||
let newDecl := ⟨decl.fvarId, replacement, decl.params, decl.type, newValue⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl newDecl
|
||||
return .jp newDecl (← go k)
|
||||
else
|
||||
|
||||
@@ -4,16 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Compiler.Options
|
||||
public import Lean.Compiler.IR
|
||||
public import Lean.Compiler.LCNF.Passes
|
||||
public import Lean.Compiler.LCNF.ToDecl
|
||||
public import Lean.Compiler.LCNF.Check
|
||||
|
||||
import Lean.Meta.Match.MatcherInfo
|
||||
public section
|
||||
|
||||
namespace Lean.Compiler.LCNF
|
||||
/--
|
||||
We do not generate code for `declName` if
|
||||
|
||||
@@ -35,7 +35,7 @@ def LetDecl.applyRenaming (decl : LetDecl) (r : Renaming) : CompilerM LetDecl :=
|
||||
mutual
|
||||
partial def FunDecl.applyRenaming (decl : FunDecl) (r : Renaming) : CompilerM FunDecl := do
|
||||
if let some binderName := r.get? decl.fvarId then
|
||||
let decl := { decl with binderName }
|
||||
let decl := decl.updateBinderName binderName
|
||||
modifyLCtx fun lctx => lctx.addFunDecl decl
|
||||
decl.updateValue (← decl.value.applyRenaming r)
|
||||
else
|
||||
|
||||
@@ -268,7 +268,7 @@ where
|
||||
else
|
||||
altsNew := altsNew.push (alt.updateCode k)
|
||||
modify fun s => s.insert decl.fvarId jpAltMap
|
||||
let value := LCNF.attachCodeDecls decls (.cases { cases with alts := altsNew })
|
||||
let value := LCNF.attachCodeDecls decls (.cases <| cases.updateAlts altsNew)
|
||||
let decl ← decl.updateValue value
|
||||
let code := .jp decl (← visit k)
|
||||
return LCNF.attachCodeDecls jpAltDecls code
|
||||
|
||||
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Compiler.LCNF.SpecInfo
|
||||
public import Lean.Compiler.LCNF.MonadScope
|
||||
@@ -13,7 +12,7 @@ import Lean.Compiler.LCNF.Simp
|
||||
import Lean.Compiler.LCNF.ToExpr
|
||||
import Lean.Compiler.LCNF.Level
|
||||
import Lean.Compiler.LCNF.Closure
|
||||
|
||||
import Lean.Meta.Transform
|
||||
namespace Lean.Compiler.LCNF
|
||||
namespace Specialize
|
||||
|
||||
@@ -116,7 +115,7 @@ def isGround [TraverseFVar α] (e : α) : SpecializeM Bool := do
|
||||
match ← findFunDecl? fnFVarId with
|
||||
-- This ascription to `Bool` is required to avoid this being inferred as `Prop`,
|
||||
-- even with a type specified on the `let` binding.
|
||||
| some { params, .. } => pure ((args.size < params.size) : Bool)
|
||||
| some (.mk (params := params) ..) => pure ((args.size < params.size) : Bool)
|
||||
| none => pure false
|
||||
| _ => pure false
|
||||
let fvarId := decl.fvarId
|
||||
|
||||
@@ -72,7 +72,7 @@ partial def visitCode (code : Code) : M Code := do
|
||||
modify fun s => { s with projMap := s.projMap.erase base }
|
||||
let resultType ← toMonoType (← k.inferType)
|
||||
let alts := #[.alt ctorInfo.name params k]
|
||||
return .cases { typeName, resultType, discr := base, alts }
|
||||
return .cases ⟨typeName, resultType, base, alts⟩
|
||||
| _ => return code.updateLet! (← decl.updateValue (← visitLetValue decl.value)) (← visitCode k)
|
||||
| .fun decl k =>
|
||||
let decl ← decl.updateValue (← visitCode decl.value)
|
||||
|
||||
@@ -4,13 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Compiler.InitAttr
|
||||
public import Lean.Compiler.LCNF.ToLCNF
|
||||
|
||||
import Lean.Meta.Transform
|
||||
import Lean.Meta.Match.MatcherInfo
|
||||
public section
|
||||
|
||||
namespace Lean.Compiler.LCNF
|
||||
/--
|
||||
Inline constants tagged with the `[macro_inline]` attribute occurring in `e`.
|
||||
|
||||
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Meta.AppBuilder
|
||||
public import Lean.Compiler.CSimpAttr
|
||||
@@ -12,9 +11,8 @@ public import Lean.Compiler.ImplementedByAttr
|
||||
public import Lean.Compiler.LCNF.Bind
|
||||
public import Lean.Compiler.NeverExtractAttr
|
||||
import Lean.Meta.CasesInfo
|
||||
|
||||
import Lean.Meta.WHNF
|
||||
public section
|
||||
|
||||
namespace Lean.Compiler.LCNF
|
||||
namespace ToLCNF
|
||||
|
||||
@@ -65,7 +63,7 @@ That is, our goal is to try to promote the pre join points `_alt.<idx>` into a p
|
||||
partial def bindCases (jpDecl : FunDecl) (cases : Cases) : CompilerM Code := do
|
||||
let (alts, s) ← visitAlts cases.alts |>.run {}
|
||||
let resultType ← mkCasesResultType alts
|
||||
let result := .cases { cases with alts, resultType }
|
||||
let result := .cases ⟨cases.typeName, resultType, cases.discr, alts⟩
|
||||
let result := s.foldl (init := result) fun result _ altJp => .jp altJp result
|
||||
return .jp jpDecl result
|
||||
where
|
||||
@@ -149,7 +147,7 @@ where
|
||||
if alts.isEmpty then
|
||||
throwError "`Code.bind` failed, empty `cases` found"
|
||||
let resultType ← mkCasesResultType alts
|
||||
return .cases { c with alts, resultType }
|
||||
return .cases ⟨c.typeName, resultType, c.discr, alts⟩
|
||||
| .return fvarId => return .jmp jpDecl.fvarId #[.fvar fvarId]
|
||||
| .jmp .. | .unreach .. => return code
|
||||
|
||||
@@ -185,7 +183,7 @@ where
|
||||
result instead of a join point that takes a closure.
|
||||
-/
|
||||
eraseParam auxParam
|
||||
let auxFunDecl := { auxParam with params := #[], value := .cases cases : FunDecl }
|
||||
let auxFunDecl := ⟨auxParam.fvarId, auxParam.binderName, #[], auxParam.type, .cases cases⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl auxFunDecl
|
||||
let auxFunDecl ← auxFunDecl.etaExpand
|
||||
go seq (i - 1) (.fun auxFunDecl c)
|
||||
@@ -599,7 +597,7 @@ where
|
||||
let (altType, alt) ← visitAlt numParams args[i]!
|
||||
resultType := joinTypes altType resultType
|
||||
alts := alts.push alt
|
||||
let cases : Cases := { typeName, discr := discrFVarId, resultType, alts }
|
||||
let cases := ⟨typeName, resultType, discrFVarId, alts⟩
|
||||
let auxDecl ← mkAuxParam resultType
|
||||
pushElement (.cases auxDecl cases)
|
||||
let result := .fvar auxDecl.fvarId
|
||||
|
||||
@@ -205,7 +205,7 @@ partial def decToMono (c : Cases) (_ : c.typeName == ``Decidable) : ToMonoM Code
|
||||
eraseParams ps
|
||||
let ctorName := if ctorName == ``Decidable.isTrue then ``Bool.true else ``Bool.false
|
||||
return .alt ctorName #[] (← k.toMono)
|
||||
return .cases { c with resultType, alts, typeName := ``Bool }
|
||||
return .cases ⟨``Bool, resultType, c.discr, alts⟩
|
||||
|
||||
/-- Eliminate `cases` for `Nat`. -/
|
||||
partial def casesNatToMono (c: Cases) (_ : c.typeName == ``Nat) : ToMonoM Code := do
|
||||
@@ -226,7 +226,7 @@ partial def casesNatToMono (c: Cases) (_ : c.typeName == ``Nat) : ToMonoM Code :
|
||||
return .alt ``Bool.false #[] (.let oneDecl (.let subOneDecl (← k.toMono)))
|
||||
else
|
||||
return .alt ``Bool.true #[] (← k.toMono)
|
||||
return .let zeroDecl (.let isZeroDecl (.cases { discr := isZeroDecl.fvarId, resultType, alts, typeName := ``Bool }))
|
||||
return .let zeroDecl (.let isZeroDecl (.cases ⟨``Bool, resultType, isZeroDecl.fvarId, alts⟩))
|
||||
|
||||
/-- Eliminate `cases` for `Int`. -/
|
||||
partial def casesIntToMono (c: Cases) (_ : c.typeName == ``Int) : ToMonoM Code := do
|
||||
@@ -251,7 +251,7 @@ partial def casesIntToMono (c: Cases) (_ : c.typeName == ``Int) : ToMonoM Code :
|
||||
let absDecl := { fvarId := p.fvarId, binderName := p.binderName, type := natType, value := .const ``Int.natAbs [] #[.fvar c.discr] }
|
||||
modifyLCtx fun lctx => lctx.addLetDecl absDecl
|
||||
return .alt ``Bool.false #[] (.let absDecl (← k.toMono))
|
||||
return .let zeroNatDecl (.let zeroIntDecl (.let isNegDecl (.cases { discr := isNegDecl.fvarId, resultType, alts, typeName := ``Bool })))
|
||||
return .let zeroNatDecl (.let zeroIntDecl (.let isNegDecl (.cases ⟨``Bool, resultType, isNegDecl.fvarId, alts⟩)))
|
||||
|
||||
/-- Eliminate `cases` for `UInt` types. -/
|
||||
partial def casesUIntToMono (c : Cases) (uintName : Name) (_ : c.typeName == uintName) : ToMonoM Code := do
|
||||
@@ -317,13 +317,13 @@ partial def casesThunkToMono (c : Cases) (_ : c.typeName == ``Thunk) : ToMonoM C
|
||||
let letValue := .const ``Thunk.get [] #[.erased, .fvar c.discr]
|
||||
let letDecl ← mkLetDecl (← mkFreshBinderName `_x) anyExpr letValue
|
||||
let paramType := .const `PUnit []
|
||||
let decl := {
|
||||
fvarId := p.fvarId
|
||||
binderName := p.binderName
|
||||
type := (← mkArrow paramType anyExpr)
|
||||
params := #[← mkAuxParam paramType]
|
||||
value := .let letDecl (.return letDecl.fvarId)
|
||||
}
|
||||
let decl := ⟨
|
||||
p.fvarId,
|
||||
p.binderName,
|
||||
#[← mkAuxParam paramType],
|
||||
(← mkArrow paramType anyExpr),
|
||||
.let letDecl (.return letDecl.fvarId)
|
||||
⟩
|
||||
modifyLCtx fun lctx => lctx.addFunDecl decl
|
||||
let k ← k.toMono
|
||||
return .fun decl k
|
||||
@@ -418,7 +418,7 @@ partial def Code.toMono (code : Code) : ToMonoM Code := do
|
||||
let ps ← mkFieldParamsForComputedFields ctorInfo.type ctorInfo.numParams numNewFields ps
|
||||
let k ← k.toMono
|
||||
return .alt implCtorName ps k
|
||||
return .cases { discr := c.discr, resultType, typeName, alts }
|
||||
return .cases ⟨typeName, resultType, c.discr, alts⟩
|
||||
else
|
||||
let alts ← c.alts.mapM fun alt =>
|
||||
match alt with
|
||||
|
||||
@@ -193,6 +193,28 @@ partial def findEntryAux [BEq α] : Node α β → USize → α → Option (α
|
||||
def findEntry? {_ : BEq α} {_ : Hashable α} : PersistentHashMap α β → α → Option (α × β)
|
||||
| { root }, k => findEntryAux root (hash k |>.toUSize) k
|
||||
|
||||
partial def findKeyDAtAux [BEq α] (keys : Array α) (vals : Array β) (heq : keys.size = vals.size) (i : Nat) (k : α) (k₀ : α) : α :=
|
||||
if h : i < keys.size then
|
||||
let k' := keys[i]
|
||||
if k == k' then k'
|
||||
else findKeyDAtAux keys vals heq (i+1) k k₀
|
||||
else k₀
|
||||
|
||||
partial def findKeyDAux [BEq α] : Node α β → USize → α → α → α
|
||||
| .entries entries, h, k, k₀ =>
|
||||
let j := (mod2Shift h shift).toNat
|
||||
match entries[j]! with
|
||||
| .null => k₀
|
||||
| .ref node => findKeyDAux node (div2Shift h shift) k k₀
|
||||
| .entry k' _ => if k == k' then k' else k₀
|
||||
| .collision keys vals heq, _, k, k₀ => findKeyDAtAux keys vals heq 0 k k₀
|
||||
|
||||
/--
|
||||
A more efficient `m.findEntry? a |>.map (·.1) |>.getD a₀`
|
||||
-/
|
||||
@[inline] def findKeyD {_ : BEq α} {_ : Hashable α} (m : PersistentHashMap α β) (a : α) (a₀ : α) : α :=
|
||||
findKeyDAux m.root (hash a |>.toUSize) a a₀
|
||||
|
||||
partial def containsAtAux [BEq α] (keys : Array α) (vals : Array β) (heq : keys.size = vals.size) (i : Nat) (k : α) : Bool :=
|
||||
if h : i < keys.size then
|
||||
let k' := keys[i]
|
||||
|
||||
@@ -45,6 +45,9 @@ variable {_ : BEq α} {_ : Hashable α}
|
||||
| some (a, _) => some a
|
||||
| none => none
|
||||
|
||||
@[inline] def findD (s : PersistentHashSet α) (a : α) (a₀ : α) : α :=
|
||||
s.set.findKeyD a a₀
|
||||
|
||||
@[inline] def contains (s : PersistentHashSet α) (a : α) : Bool :=
|
||||
s.set.contains a
|
||||
|
||||
|
||||
@@ -45,26 +45,29 @@ def toAttributeKind (attrKindStx : Syntax) : MacroM AttributeKind := do
|
||||
def mkAttrKindGlobal : Syntax :=
|
||||
mkNode ``Lean.Parser.Term.attrKind #[mkNullNode]
|
||||
|
||||
def elabAttr [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLiftT IO m] (attrInstance : Syntax) : m Attribute := do
|
||||
/- attrInstance := ppGroup $ leading_parser attrKind >> attrParser -/
|
||||
let attrKind ← liftMacroM <| toAttributeKind attrInstance[0]
|
||||
let attr := attrInstance[1]
|
||||
let attr ← liftMacroM <| expandMacros attr
|
||||
let attrName ← if attr.getKind == ``Parser.Attr.simple then
|
||||
pure attr[0].getId.eraseMacroScopes
|
||||
else match attr.getKind with
|
||||
| .str _ s => pure <| Name.mkSimple s
|
||||
| _ => throwErrorAt attr "Unknown attribute"
|
||||
let .ok _impl := getAttributeImpl (← getEnv) attrName
|
||||
| throwError "Unknown attribute `[{attrName}]`"
|
||||
if let .ok impl := getAttributeImpl (← getEnv) attrName then
|
||||
if regularInitAttr.getParam? (← getEnv) impl.ref |>.isSome then -- skip `builtin_initialize` attributes
|
||||
recordExtraModUseFromDecl (isMeta := true) impl.ref
|
||||
/- The `AttrM` does not have sufficient information for expanding macros in `args`.
|
||||
So, we expand them before here before we invoke the attributer handlers implemented using `AttrM`. -/
|
||||
return { kind := attrKind, name := attrName, stx := attr }
|
||||
def elabAttr [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLiftT IO m] [MonadFinally m] (attrInstance : Syntax) : m Attribute := do
|
||||
-- Resolving the attribute itself can be done in the private scope; running the attribute handler
|
||||
-- will later be done in a scope determined by `applyAttributesCore`.
|
||||
withoutExporting do
|
||||
/- attrInstance := ppGroup $ leading_parser attrKind >> attrParser -/
|
||||
let attrKind ← liftMacroM <| toAttributeKind attrInstance[0]
|
||||
let attr := attrInstance[1]
|
||||
let attr ← liftMacroM <| expandMacros attr
|
||||
let attrName ← if attr.getKind == ``Parser.Attr.simple then
|
||||
pure attr[0].getId.eraseMacroScopes
|
||||
else match attr.getKind with
|
||||
| .str _ s => pure <| Name.mkSimple s
|
||||
| _ => throwErrorAt attr "Unknown attribute"
|
||||
let .ok _impl := getAttributeImpl (← getEnv) attrName
|
||||
| throwError "Unknown attribute `[{attrName}]`"
|
||||
if let .ok impl := getAttributeImpl (← getEnv) attrName then
|
||||
if regularInitAttr.getParam? (← getEnv) impl.ref |>.isSome then -- skip `builtin_initialize` attributes
|
||||
recordExtraModUseFromDecl (isMeta := true) impl.ref
|
||||
/- The `AttrM` does not have sufficient information for expanding macros in `args`.
|
||||
So, we expand them before here before we invoke the attributer handlers implemented using `AttrM`. -/
|
||||
return { kind := attrKind, name := attrName, stx := attr }
|
||||
|
||||
def elabAttrs [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadLiftT IO m] (attrInstances : Array Syntax) : m (Array Attribute) := do
|
||||
def elabAttrs [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadLiftT IO m] [MonadFinally m] (attrInstances : Array Syntax) : m (Array Attribute) := do
|
||||
let mut attrs := #[]
|
||||
for attr in attrInstances do
|
||||
try
|
||||
@@ -74,7 +77,7 @@ def elabAttrs [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadM
|
||||
return attrs
|
||||
|
||||
-- leading_parser "@[" >> sepBy1 attrInstance ", " >> "]"
|
||||
def elabDeclAttrs [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadLiftT IO m] (stx : Syntax) : m (Array Attribute) :=
|
||||
def elabDeclAttrs [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadLiftT IO m] [MonadFinally m] (stx : Syntax) : m (Array Attribute) :=
|
||||
elabAttrs stx[1].getSepArgs
|
||||
|
||||
end Lean.Elab
|
||||
|
||||
@@ -573,11 +573,16 @@ def elabDefaultOrNonempty : TermElab := fun stx expectedType? => do
|
||||
| some expectedType =>
|
||||
try
|
||||
mkDefault expectedType
|
||||
catch ex => try
|
||||
catch _ => try
|
||||
mkOfNonempty expectedType
|
||||
catch _ =>
|
||||
if stx[1].isNone then
|
||||
throw ex
|
||||
throwError "\
|
||||
failed to synthesize '{.ofConstName ``Inhabited}' or '{.ofConstName ``Nonempty}' instance for\
|
||||
{indentExpr expectedType}\n\
|
||||
\n\
|
||||
If this type is defined using the 'structure' or 'inductive' command, \
|
||||
you can try adding a 'deriving Nonempty' clause to it."
|
||||
else
|
||||
-- It is in the context of an `unsafe` constant. We can use sorry instead.
|
||||
-- Another option is to make a recursive application since it is unsafe.
|
||||
|
||||
@@ -11,10 +11,13 @@ public import Lean.Server.CodeActions.Attr
|
||||
|
||||
public section
|
||||
|
||||
/-! `#guard_msgs` command for testing commands
|
||||
/-! `#guard_msgs` and `#guard_panic` commands for testing commands
|
||||
|
||||
This module defines a command to test that another command produces the expected messages.
|
||||
See the docstring on the `#guard_msgs` command.
|
||||
This module defines commands to test that other commands produce expected messages:
|
||||
- `#guard_msgs`: tests that a command produces exactly the expected messages
|
||||
- `#guard_panic`: tests that a command produces a panic message (without checking the exact text)
|
||||
|
||||
See the docstrings on the individual commands.
|
||||
-/
|
||||
|
||||
open Lean Parser.Tactic Elab Command
|
||||
@@ -88,6 +91,8 @@ structure GuardMsgsSpec where
|
||||
ordering : MessageOrdering := .exact
|
||||
/-- Whether to report position information. -/
|
||||
reportPositions : Bool := false
|
||||
/-- Whether to check for substring containment instead of exact match. -/
|
||||
substring : Bool := false
|
||||
|
||||
def parseGuardMsgsFilterAction (action? : Option (TSyntax ``guardMsgsFilterAction)) :
|
||||
CommandElabM FilterSpec := do
|
||||
@@ -118,7 +123,7 @@ def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : CommandElabM
|
||||
| `(guardMsgsSpec| ($[$elts:guardMsgsSpecElt],*)) => pure elts
|
||||
| _ => throwUnsupportedSyntax
|
||||
let defaultFilterFn := cfg.filterFn
|
||||
let mut { whitespace, ordering, reportPositions .. } := cfg
|
||||
let mut { whitespace, ordering, reportPositions, substring .. } := cfg
|
||||
let mut p? : Option (Message → FilterSpec) := none
|
||||
let pushP (action : FilterSpec) (msgP : Message → Bool) (p? : Option (Message → FilterSpec))
|
||||
(msg : Message) : FilterSpec :=
|
||||
@@ -136,9 +141,11 @@ def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) : CommandElabM
|
||||
| `(guardMsgsSpecElt| ordering := sorted) => ordering := .sorted
|
||||
| `(guardMsgsSpecElt| positions := true) => reportPositions := true
|
||||
| `(guardMsgsSpecElt| positions := false) => reportPositions := false
|
||||
| `(guardMsgsSpecElt| substring := true) => substring := true
|
||||
| `(guardMsgsSpecElt| substring := false) => substring := false
|
||||
| _ => throwUnsupportedSyntax
|
||||
let filterFn := p?.getD defaultFilterFn
|
||||
return { filterFn, whitespace, ordering, reportPositions }
|
||||
return { filterFn, whitespace, ordering, reportPositions, substring }
|
||||
|
||||
/-- An info tree node corresponding to a failed `#guard_msgs` invocation,
|
||||
used for code action support. -/
|
||||
@@ -176,22 +183,31 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
|
||||
| .exact => msgs
|
||||
| .sorted => msgs |>.toArray.qsort (· < ·) |>.toList
|
||||
|
||||
/--
|
||||
Runs a command and collects all messages (sync and async) it produces.
|
||||
Clears the snapshot tasks after collection.
|
||||
Returns the collected messages.
|
||||
-/
|
||||
def runAndCollectMessages (cmd : Syntax) : CommandElabM MessageLog := do
|
||||
-- do not forward snapshot as we don't want messages assigned to it to leak outside
|
||||
withReader ({ · with snap? := none }) do
|
||||
-- The `#guard_msgs` command is special-cased in `elabCommandTopLevel` to ensure linters only run once.
|
||||
elabCommandTopLevel cmd
|
||||
-- collect sync and async messages
|
||||
let msgs := (← get).messages ++
|
||||
(← get).snapshotTasks.foldl (· ++ ·.get.getAll.foldl (· ++ ·.diagnostics.msgLog) .empty) .empty
|
||||
-- clear async messages as we don't want them to leak outside
|
||||
modify ({ · with snapshotTasks := #[] })
|
||||
return msgs
|
||||
|
||||
@[builtin_command_elab Lean.guardMsgsCmd] def elabGuardMsgs : CommandElab
|
||||
| `(command| $[$dc?:docComment]? #guard_msgs%$tk $(spec?)? in $cmd) => do
|
||||
let expected : String := (← dc?.mapM (getDocStringText ·)).getD ""
|
||||
|>.trimAscii |>.copy |> removeTrailingWhitespaceMarker
|
||||
let { whitespace, ordering, filterFn, reportPositions } ← parseGuardMsgsSpec spec?
|
||||
-- do not forward snapshot as we don't want messages assigned to it to leak outside
|
||||
withReader ({ · with snap? := none }) do
|
||||
-- The `#guard_msgs` command is special-cased in `elabCommandTopLevel` to ensure linters only run once.
|
||||
elabCommandTopLevel cmd
|
||||
-- collect sync and async messages
|
||||
let msgs := (← get).messages ++
|
||||
(← get).snapshotTasks.foldl (· ++ ·.get.getAll.foldl (· ++ ·.diagnostics.msgLog) {}) {}
|
||||
-- clear async messages as we don't want them to leak outside
|
||||
modify ({ · with snapshotTasks := #[] })
|
||||
let mut toCheck : MessageLog := .empty
|
||||
let mut toPassthrough : MessageLog := .empty
|
||||
let { whitespace, ordering, filterFn, reportPositions, substring } ← parseGuardMsgsSpec spec?
|
||||
let msgs ← runAndCollectMessages cmd
|
||||
let mut toCheck : MessageLog := MessageLog.empty
|
||||
let mut toPassthrough : MessageLog := MessageLog.empty
|
||||
for msg in msgs.toList do
|
||||
if msg.isSilent then
|
||||
continue
|
||||
@@ -207,7 +223,13 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
|
||||
let strings ← toCheck.toList.mapM (messageToString · reportPos?)
|
||||
let strings := ordering.apply strings
|
||||
let res := "---\n".intercalate strings |>.trimAscii |>.copy
|
||||
if whitespace.apply expected == whitespace.apply res then
|
||||
let passed := if substring then
|
||||
-- Substring mode: check that expected appears within res (after whitespace normalization)
|
||||
(whitespace.apply res).contains (whitespace.apply expected)
|
||||
else
|
||||
-- Exact mode: check equality (after whitespace normalization)
|
||||
whitespace.apply expected == whitespace.apply res
|
||||
if passed then
|
||||
-- Passed. Only put toPassthrough messages back on the message log
|
||||
modify fun st => { st with messages := toPassthrough }
|
||||
else
|
||||
@@ -257,4 +279,24 @@ def guardMsgsCodeAction : CommandCodeAction := fun _ _ _ node => do
|
||||
}
|
||||
}]
|
||||
|
||||
@[builtin_command_elab Lean.guardPanicCmd] def elabGuardPanic : CommandElab
|
||||
| `(command| #guard_panic in $cmd) => do
|
||||
let msgs ← runAndCollectMessages cmd
|
||||
-- Check if any message contains "PANIC"
|
||||
let mut foundPanic := false
|
||||
for msg in msgs.toList do
|
||||
if msg.isSilent then continue
|
||||
let msgStr ← msg.data.toString
|
||||
if msgStr.contains "PANIC" then
|
||||
foundPanic := true
|
||||
break
|
||||
if foundPanic then
|
||||
-- Success - clear the messages so they don't appear
|
||||
modify fun st => { st with messages := MessageLog.empty }
|
||||
else
|
||||
-- Failed - put the messages back and add our error
|
||||
modify fun st => { st with messages := msgs }
|
||||
logError "Expected a PANIC but none was found"
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic.GuardMsgs
|
||||
|
||||
@@ -29,72 +29,76 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) (isCoi
|
||||
let (binders, type?) := expandOptDeclSig decl[2]
|
||||
let declId := decl[1]
|
||||
let ⟨name, declName, levelNames, docString?⟩ ← Term.expandDeclId (← getCurrNamespace) (← Term.getLevelNames) declId modifiers
|
||||
if modifiers.isMeta then
|
||||
modifyEnv (markMeta · declName)
|
||||
addDeclarationRangesForBuiltin declName modifiers.stx decl
|
||||
/-
|
||||
Relates to issue
|
||||
https://github.com/leanprover/lean4/issues/10503
|
||||
-/
|
||||
if declName.hasMacroScopes && isCoinductive then
|
||||
throwError "Coinductive predicates are not allowed inside of macro scopes"
|
||||
let ctors ← decl[4].getArgs.mapM fun ctor => withRef ctor do
|
||||
/-
|
||||
```
|
||||
def ctor := leading_parser optional docComment >> "\n| " >> declModifiers >> rawIdent >> optDeclSig
|
||||
```
|
||||
-/
|
||||
let modifiersStx := ctor[2]
|
||||
let mut ctorModifiers ← elabModifiers ⟨modifiersStx⟩
|
||||
if let some leadingDocComment := ctor[0].getOptional? then
|
||||
if ctorModifiers.docString?.isSome then
|
||||
logErrorAt leadingDocComment "Duplicate doc string"
|
||||
ctorModifiers := { ctorModifiers with
|
||||
docString? := some (⟨leadingDocComment⟩, doc.verso.get (← getOptions)) }
|
||||
if ctorModifiers.isPrivate && modifiers.isPrivate then
|
||||
let hint ← do
|
||||
let .original .. := modifiersStx.getHeadInfo | pure .nil
|
||||
let some range := modifiersStx[2].getRangeWithTrailing? | pure .nil
|
||||
-- Drop the doc comment from both the `declModifiers` and outer `ctor`, as well as
|
||||
-- everything after the constructor name (yielding invalid syntax with the desired range)
|
||||
let previewSpan? := ctor.modifyArgs (·[2...4].toArray.modify 0 (·.modifyArgs (·[1...*])))
|
||||
MessageData.hint "Remove `private` modifier from constructor" #[{
|
||||
suggestion := ""
|
||||
span? := Syntax.ofRange range
|
||||
previewSpan?
|
||||
toCodeActionTitle? := some fun _ => "Delete `private` modifier"
|
||||
}]
|
||||
throwError m!"Constructor cannot be marked `private` because it is already in a `private` inductive datatype" ++ hint
|
||||
if ctorModifiers.isProtected && modifiers.isPrivate then
|
||||
throwError "Constructor cannot be `protected` because it is in a `private` inductive datatype"
|
||||
checkValidCtorModifier ctorModifiers
|
||||
let ctorName := ctor.getIdAt 3
|
||||
let ctorName := declName ++ ctorName
|
||||
let ctorName ← withRef ctor[3] <| applyVisibility ctorModifiers ctorName
|
||||
let (binders, type?) := expandOptDeclSig ctor[4]
|
||||
addDeclarationRangesFromSyntax ctorName ctor ctor[3]
|
||||
-- In the case of mutual inductives, this is the earliests point where we can establish the
|
||||
-- correct scope for each individual inductive declaration (used e.g. to infer ctor visibility
|
||||
-- below), so let's do that now.
|
||||
withExporting (isExporting := !isPrivateName declName) do
|
||||
if modifiers.isMeta then
|
||||
modifyEnv (markMeta · ctorName)
|
||||
return { ref := ctor, declId := ctor[3], modifiers := ctorModifiers, declName := ctorName, binders := binders, type? := type? : CtorView }
|
||||
let computedFields ← (decl[5].getOptional?.map (·[1].getArgs) |>.getD #[]).mapM fun cf => withRef cf do
|
||||
return { ref := cf, modifiers := cf[0], fieldId := cf[1].getId, type := ⟨cf[3]⟩, matchAlts := ⟨cf[4]⟩ }
|
||||
let classes ← getOptDerivingClasses decl[6]
|
||||
if decl[3][0].isToken ":=" then
|
||||
-- https://github.com/leanprover/lean4/issues/5236
|
||||
withRef decl[0] <| Linter.logLintIf Linter.linter.deprecated decl[3]
|
||||
"`inductive ... :=` has been deprecated in favor of `inductive ... where`"
|
||||
return {
|
||||
ref := decl
|
||||
shortDeclName := name
|
||||
derivingClasses := classes
|
||||
allowIndices := true
|
||||
allowSortPolymorphism := true
|
||||
declId, modifiers, isClass, declName, levelNames
|
||||
binders, type?, ctors
|
||||
computedFields
|
||||
docString?
|
||||
isCoinductive := isCoinductive
|
||||
}
|
||||
modifyEnv (markMeta · declName)
|
||||
addDeclarationRangesForBuiltin declName modifiers.stx decl
|
||||
/-
|
||||
Relates to issue
|
||||
https://github.com/leanprover/lean4/issues/10503
|
||||
-/
|
||||
if declName.hasMacroScopes && isCoinductive then
|
||||
throwError "Coinductive predicates are not allowed inside of macro scopes"
|
||||
let ctors ← decl[4].getArgs.mapM fun ctor => withRef ctor do
|
||||
/-
|
||||
```
|
||||
def ctor := leading_parser optional docComment >> "\n| " >> declModifiers >> rawIdent >> optDeclSig
|
||||
```
|
||||
-/
|
||||
let modifiersStx := ctor[2]
|
||||
let mut ctorModifiers ← elabModifiers ⟨modifiersStx⟩
|
||||
if let some leadingDocComment := ctor[0].getOptional? then
|
||||
if ctorModifiers.docString?.isSome then
|
||||
logErrorAt leadingDocComment "Duplicate doc string"
|
||||
ctorModifiers := { ctorModifiers with
|
||||
docString? := some (⟨leadingDocComment⟩, doc.verso.get (← getOptions)) }
|
||||
if ctorModifiers.isPrivate && modifiers.isPrivate then
|
||||
let hint ← do
|
||||
let .original .. := modifiersStx.getHeadInfo | pure .nil
|
||||
let some range := modifiersStx[2].getRangeWithTrailing? | pure .nil
|
||||
-- Drop the doc comment from both the `declModifiers` and outer `ctor`, as well as
|
||||
-- everything after the constructor name (yielding invalid syntax with the desired range)
|
||||
let previewSpan? := ctor.modifyArgs (·[2...4].toArray.modify 0 (·.modifyArgs (·[1...*])))
|
||||
MessageData.hint "Remove `private` modifier from constructor" #[{
|
||||
suggestion := ""
|
||||
span? := Syntax.ofRange range
|
||||
previewSpan?
|
||||
toCodeActionTitle? := some fun _ => "Delete `private` modifier"
|
||||
}]
|
||||
throwError m!"Constructor cannot be marked `private` because it is already in a `private` inductive datatype" ++ hint
|
||||
if ctorModifiers.isProtected && modifiers.isPrivate then
|
||||
throwError "Constructor cannot be `protected` because it is in a `private` inductive datatype"
|
||||
checkValidCtorModifier ctorModifiers
|
||||
let ctorName := ctor.getIdAt 3
|
||||
let ctorName := declName ++ ctorName
|
||||
let ctorName ← withRef ctor[3] <| applyVisibility ctorModifiers ctorName
|
||||
let (binders, type?) := expandOptDeclSig ctor[4]
|
||||
addDeclarationRangesFromSyntax ctorName ctor ctor[3]
|
||||
if modifiers.isMeta then
|
||||
modifyEnv (markMeta · ctorName)
|
||||
return { ref := ctor, declId := ctor[3], modifiers := ctorModifiers, declName := ctorName, binders := binders, type? := type? : CtorView }
|
||||
let computedFields ← (decl[5].getOptional?.map (·[1].getArgs) |>.getD #[]).mapM fun cf => withRef cf do
|
||||
return { ref := cf, modifiers := cf[0], fieldId := cf[1].getId, type := ⟨cf[3]⟩, matchAlts := ⟨cf[4]⟩ }
|
||||
let classes ← getOptDerivingClasses decl[6]
|
||||
if decl[3][0].isToken ":=" then
|
||||
-- https://github.com/leanprover/lean4/issues/5236
|
||||
withRef decl[0] <| Linter.logLintIf Linter.linter.deprecated decl[3]
|
||||
"`inductive ... :=` has been deprecated in favor of `inductive ... where`"
|
||||
return {
|
||||
ref := decl
|
||||
shortDeclName := name
|
||||
derivingClasses := classes
|
||||
allowIndices := true
|
||||
allowSortPolymorphism := true
|
||||
declId, modifiers, isClass, declName, levelNames
|
||||
binders, type?, ctors
|
||||
computedFields
|
||||
docString?
|
||||
isCoinductive := isCoinductive
|
||||
}
|
||||
|
||||
private def isInductiveFamily (numParams : Nat) (indFVar : Expr) : TermElabM Bool := do
|
||||
let indFVarType ← inferType indFVar
|
||||
|
||||
@@ -886,7 +886,7 @@ private def generalize (discrs : Array Discr) (matchType : Expr) (altViews : Arr
|
||||
let matchType' ← forallBoundedTelescope matchType discrs.size fun ds type => do
|
||||
let type ← mkForallFVars ys type
|
||||
let (discrs', ds') := Array.unzip <| Array.zip discrExprs ds |>.filter fun (di, _) => di.isFVar
|
||||
let type ← type.replaceFVarsM discrs' ds'
|
||||
let type := type.replaceFVars discrs' ds'
|
||||
mkForallFVars ds type
|
||||
if (← isTypeCorrect matchType') then
|
||||
let discrs := discrs ++ ys.map fun y => { expr := y : Discr }
|
||||
@@ -1119,11 +1119,11 @@ private def elabMatchAux (generalizing? : Option Bool) (discrStxs : Array Syntax
|
||||
withRef altLHS.ref do
|
||||
for d in altLHS.fvarDecls do
|
||||
if d.hasExprMVar then
|
||||
-- This code path is a vestige prior to fixing #8099, but it is still appears to be
|
||||
-- important for testcase 1300.lean.
|
||||
tryPostpone
|
||||
withExistingLocalDecls altLHS.fvarDecls do
|
||||
runPendingTacticsAt d.type
|
||||
if (← instantiateMVars d.type).hasExprMVar then
|
||||
throwMVarError m!"Invalid match expression: The type of pattern variable '{d.toExpr}' contains metavariables:{indentExpr d.type}"
|
||||
for p in altLHS.patterns do
|
||||
if (← Match.instantiatePatternMVars p).hasExprMVar then
|
||||
tryPostpone
|
||||
|
||||
@@ -8,6 +8,7 @@ module
|
||||
prelude
|
||||
public import Std.Tactic.BVDecide.LRAT.Parser
|
||||
public import Lean.CoreM
|
||||
public import Std.Tactic.BVDecide.Syntax
|
||||
|
||||
public section
|
||||
|
||||
@@ -146,7 +147,7 @@ solvers the solver is run with `timeout` in seconds as a maximum time limit to s
|
||||
Note: This function currently assume that the solver has the same CLI as CaDiCal.
|
||||
-/
|
||||
def satQuery (solverPath : System.FilePath) (problemPath : System.FilePath) (proofOutput : System.FilePath)
|
||||
(timeout : Nat) (binaryProofs : Bool) :
|
||||
(timeout : Nat) (binaryProofs : Bool) (mode : Frontend.SolverMode) :
|
||||
CoreM SolverResult := do
|
||||
let cmd := solverPath.toString
|
||||
let mut args := #[
|
||||
@@ -156,17 +157,12 @@ def satQuery (solverPath : System.FilePath) (problemPath : System.FilePath) (pro
|
||||
s!"--binary={binaryProofs}",
|
||||
"--quiet",
|
||||
/-
|
||||
This sets the magic parameters of cadical to optimize for UNSAT search.
|
||||
Given the fact that we are mostly interested in proving things and expect user goals to be
|
||||
provable this is a fine value to set
|
||||
-/
|
||||
"--unsat",
|
||||
/-
|
||||
Bitwuzla sets this option and it does improve performance practically:
|
||||
https://github.com/bitwuzla/bitwuzla/blob/0e81e616af4d4421729884f01928b194c3536c76/src/sat/cadical.cpp#L34
|
||||
-/
|
||||
"--shrink=0"
|
||||
]
|
||||
args := args ++ solverModeFlags mode
|
||||
|
||||
-- We implement timeouting ourselves because cadicals -t option is not available on Windows.
|
||||
let out? ← runInterruptible timeout { cmd, args, stdin := .piped, stdout := .piped, stderr := .null }
|
||||
@@ -190,6 +186,12 @@ def satQuery (solverPath : System.FilePath) (problemPath : System.FilePath) (pro
|
||||
throwError s!"Error {err} while parsing:\n{stdout}"
|
||||
else
|
||||
throwError s!"The external prover produced unexpected output, stdout:\n{stdout}stderr:\n{stderr}"
|
||||
where
|
||||
solverModeFlags (mode : Frontend.SolverMode) : Array String :=
|
||||
match mode with
|
||||
| .proof => #["--unsat"]
|
||||
| .counterexample => #["--sat"]
|
||||
| .default => #["--default"]
|
||||
|
||||
end External
|
||||
|
||||
|
||||
@@ -344,7 +344,14 @@ def lratBitblaster (goal : MVarId) (ctx : TacticContext) (reflectionResult : Ref
|
||||
|
||||
let res ←
|
||||
withTraceNode `Meta.Tactic.sat (fun _ => return "Obtaining external proof certificate") do
|
||||
runExternal cnf ctx.solver ctx.lratPath ctx.config.trimProofs ctx.config.timeout ctx.config.binaryProofs
|
||||
runExternal
|
||||
cnf
|
||||
ctx.solver
|
||||
ctx.lratPath
|
||||
ctx.config.trimProofs
|
||||
ctx.config.timeout
|
||||
ctx.config.binaryProofs
|
||||
ctx.config.solverMode
|
||||
|
||||
match res with
|
||||
| .ok cert =>
|
||||
|
||||
@@ -4,13 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Elab.Tactic.BVDecide.Frontend.BVDecide.Reflect
|
||||
public import Std.Tactic.BVDecide.Reflect
|
||||
|
||||
import Lean.Meta.LitValues
|
||||
public section
|
||||
|
||||
/-!
|
||||
Provides the logic for reifying `BitVec` expressions.
|
||||
-/
|
||||
|
||||
@@ -4,10 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Henrik Böving
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Elab.Tactic.BVDecide.Frontend.BVDecide.ReifiedLemmas
|
||||
|
||||
import Lean.Meta.LitValues
|
||||
public section
|
||||
|
||||
/-!
|
||||
|
||||
@@ -131,7 +131,7 @@ Run an external SAT solver on the `CNF` to obtain an LRAT proof.
|
||||
This will obtain an `LratCert` if the formula is UNSAT and throw errors otherwise.
|
||||
-/
|
||||
def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.FilePath)
|
||||
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool) :
|
||||
(trimProofs : Bool) (timeout : Nat) (binaryProofs : Bool) (solverMode : Frontend.SolverMode) :
|
||||
CoreM (Except (Array (Bool × Nat)) LratCert) := do
|
||||
IO.FS.withTempFile fun cnfHandle cnfPath => do
|
||||
withTraceNode `Meta.Tactic.sat (fun _ => return "Serializing SAT problem to DIMACS file") do
|
||||
@@ -141,7 +141,7 @@ def runExternal (cnf : CNF Nat) (solver : System.FilePath) (lratPath : System.Fi
|
||||
|
||||
let res ←
|
||||
withTraceNode `Meta.Tactic.sat (fun _ => return "Running SAT solver") do
|
||||
External.satQuery solver cnfPath lratPath timeout binaryProofs
|
||||
External.satQuery solver cnfPath lratPath timeout binaryProofs solverMode
|
||||
if let .sat assignment := res then
|
||||
return .error assignment
|
||||
|
||||
|
||||
@@ -195,16 +195,16 @@ where
|
||||
return false
|
||||
|
||||
let ctorTyp := (← getConstInfoCtor constInfo.ctors.head!).type
|
||||
let analyzer state arg := do return state || (← typeCasesRelevant (← arg.fvarId!.getType))
|
||||
let interesting ← forallTelescope ctorTyp fun args _ => args.foldlM (init := false) analyzer
|
||||
let interesting ← forallTelescope ctorTyp fun args _ =>
|
||||
-- Note: Important not to short circuit here so that we collect information about all
|
||||
-- arguments in case we want to split recursively.
|
||||
args.foldlM (init := false) fun state arg => do
|
||||
return state || (← typeCasesRelevant (← arg.fvarId!.getType))
|
||||
return interesting
|
||||
|
||||
typeCasesRelevant (expr : Expr) : PreProcessM Bool := do
|
||||
match_expr expr with
|
||||
| BitVec n => return (← getNatValue? n).isSome
|
||||
| _ =>
|
||||
let some const := expr.getAppFn.constName? | return false
|
||||
analyzeConst const
|
||||
let some const := expr.getAppFn.constName? | return false
|
||||
analyzeConst const
|
||||
|
||||
end Frontend.Normalize
|
||||
end Lean.Elab.Tactic.BVDecide
|
||||
|
||||
@@ -369,6 +369,33 @@ def withoutRecover (x : TacticM α) : TacticM α :=
|
||||
def withRecover (recover : Bool) (x : TacticM α) : TacticM α :=
|
||||
withReader (fun ctx => { ctx with recover }) x
|
||||
|
||||
/-! ## Message log utilities -/
|
||||
|
||||
/-- Execute an action while suppressing any new messages it generates.
|
||||
Restores the original message log after the action completes.
|
||||
Useful for trying tactics without polluting the message log with errors from failed attempts. -/
|
||||
def withSuppressedMessages (action : TacticM α) : TacticM α := do
|
||||
let initialLog ← Core.getMessageLog
|
||||
try
|
||||
action
|
||||
finally
|
||||
Core.setMessageLog initialLog
|
||||
|
||||
/-- Execute an action and return any new messages it generates.
|
||||
Restores the original message log afterward.
|
||||
Useful for inspecting messages produced by a tactic without committing them. -/
|
||||
def withCapturedMessages (action : TacticM α) : TacticM (α × List Message) := do
|
||||
let initialLog ← Core.getMessageLog
|
||||
let initialMsgCount := initialLog.toList.length
|
||||
let result ← action
|
||||
let newMsgs := (← Core.getMessageLog).toList.drop initialMsgCount
|
||||
Core.setMessageLog initialLog
|
||||
return (result, newMsgs)
|
||||
|
||||
/-- Check if any messages in the list are errors. -/
|
||||
def hasErrorMessages (msgs : List Message) : Bool :=
|
||||
msgs.any (·.severity == .error)
|
||||
|
||||
/--
|
||||
Like `throwErrorAt`, but, if recovery is enabled, logs the error instead.
|
||||
-/
|
||||
|
||||
@@ -193,7 +193,7 @@ def mkSpecTheoremFromStx (ref : Syntax) (proof : Expr) (prio : Nat := eval_prio
|
||||
mkSpecTheorem type (.stx (← mkFreshId) ref proof) prio
|
||||
|
||||
def addSpecTheoremEntry (d : SpecTheorems) (e : SpecTheorem) : SpecTheorems :=
|
||||
{ d with specs := d.specs.insertCore e.keys e }
|
||||
{ d with specs := d.specs.insertKeyValue e.keys e }
|
||||
|
||||
def addSpecTheorem (ext : SpecExtension) (declName : Name) (prio : Nat) (attrKind : AttributeKind) : MetaM Unit := do
|
||||
let thm ← mkSpecTheoremFromConst declName prio
|
||||
|
||||
@@ -436,7 +436,7 @@ where
|
||||
let some tactic := tactic | return vcs
|
||||
let mut newVCs := #[]
|
||||
for vc in vcs do
|
||||
let vcs ← try evalTacticAt tactic vc catch _ => pure [vc]
|
||||
let vcs ← evalTacticAt tactic vc
|
||||
newVCs := newVCs ++ vcs
|
||||
return newVCs
|
||||
|
||||
|
||||
@@ -320,6 +320,9 @@ def evalApplyLikeTactic (tac : MVarId → Expr → MetaM (List MVarId)) (e : Syn
|
||||
@[builtin_tactic Lean.Parser.Tactic.withUnfoldingAll] def evalWithUnfoldingAll : Tactic := fun stx =>
|
||||
withTransparency TransparencyMode.all <| evalTactic stx[1]
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.withUnfoldingNone] def evalWithUnfoldingNone : Tactic := fun stx =>
|
||||
withTransparency TransparencyMode.none <| evalTactic stx[1]
|
||||
|
||||
/--
|
||||
Elaborate `stx`. If it is a free variable, return it. Otherwise, assert it, and return the free variable.
|
||||
Note that, the main goal is updated when `Meta.assert` is used in the second case. -/
|
||||
|
||||
@@ -22,8 +22,9 @@ structure Context extends Tactic.Context where
|
||||
open Meta.Grind (Goal)
|
||||
|
||||
structure State where
|
||||
state : Meta.Grind.State
|
||||
goals : List Goal
|
||||
symState : Meta.Sym.State
|
||||
grindState : Meta.Grind.State
|
||||
goals : List Goal
|
||||
|
||||
structure SavedState where
|
||||
term : Term.SavedState
|
||||
@@ -288,8 +289,8 @@ open Grind
|
||||
def liftGrindM (k : GrindM α) : GrindTacticM α := do
|
||||
let ctx ← read
|
||||
let s ← get
|
||||
let (a, state) ← liftMetaM <| (Grind.withGTransparency k) ctx.methods.toMethodsRef ctx.ctx |>.run s.state
|
||||
modify fun s => { s with state }
|
||||
let ((a, grindState), symState) ← liftMetaM <| StateRefT'.run ((Grind.withGTransparency k) ctx.methods.toMethodsRef ctx.ctx |>.run s.grindState) s.symState
|
||||
modify fun s => { s with grindState, symState }
|
||||
return a
|
||||
|
||||
def replaceMainGoal (goals : List Goal) : GrindTacticM Unit := do
|
||||
@@ -358,15 +359,17 @@ def mkEvalTactic' (elaborator : Name) (params : Params) : TermElabM (Goal → TS
|
||||
let methods ← getMethods
|
||||
let grindCtx ← readThe Meta.Grind.Context
|
||||
let grindState ← get
|
||||
let symState ← getThe Sym.State
|
||||
-- **Note**: we discard changes to `Term.State`
|
||||
let (subgoals, grindState') ← Term.TermElabM.run' (ctx := termCtx) (s := termState) do
|
||||
let (subgoals, grindState', symState') ← Term.TermElabM.run' (ctx := termCtx) (s := termState) do
|
||||
let (_, s) ← GrindTacticM.run
|
||||
(ctx := { recover := false, methods, ctx := grindCtx, params, elaborator })
|
||||
(s := { state := grindState, goals := [goal] }) do
|
||||
(s := { grindState, symState, goals := [goal] }) do
|
||||
evalGrindTactic stx.raw
|
||||
pruneSolvedGoals
|
||||
return (s.goals, s.state)
|
||||
return (s.goals, s.grindState, s.symState)
|
||||
set grindState'
|
||||
set symState'
|
||||
return subgoals
|
||||
return eval
|
||||
|
||||
@@ -389,8 +392,9 @@ def GrindTacticM.runAtGoal (mvarId : MVarId) (params : Params) (k : GrindTacticM
|
||||
let ctx ← readThe Meta.Grind.Context
|
||||
/- Restore original config -/
|
||||
let ctx := { ctx with config := params.config }
|
||||
let state ← get
|
||||
pure (methods, ctx, { state, goals })
|
||||
let grindState ← get
|
||||
let symState ← getThe Sym.State
|
||||
return (methods, ctx, { grindState, symState, goals })
|
||||
let tctx ← read
|
||||
k { tctx with methods, ctx, params } |>.run state
|
||||
|
||||
|
||||
@@ -15,6 +15,7 @@ import Lean.Elab.Tactic.Grind.Lint
|
||||
#grind_lint skip List.replicate_sublist_iff
|
||||
#grind_lint skip List.Sublist.append
|
||||
#grind_lint skip List.Sublist.middle
|
||||
#grind_lint skip List.getLast?_pmap
|
||||
#grind_lint skip Array.count_singleton
|
||||
#grind_lint skip Array.foldl_empty
|
||||
#grind_lint skip Array.foldr_empty
|
||||
|
||||
@@ -182,6 +182,7 @@ open LibrarySuggestions in
|
||||
def elabGrindSuggestions
|
||||
(params : Grind.Params) (suggestions : Array Suggestion := #[]) : MetaM Grind.Params := do
|
||||
let mut params := params
|
||||
let mut added : Array Name := #[]
|
||||
for p in suggestions do
|
||||
let attr ← match p.flag with
|
||||
| some flag => parseModifier flag
|
||||
@@ -190,6 +191,7 @@ def elabGrindSuggestions
|
||||
| .ematch kind =>
|
||||
try
|
||||
params ← addEMatchTheorem params (mkIdent p.name) p.name kind false (warn := false)
|
||||
added := added.push p.name
|
||||
catch _ => pure () -- Don't worry if library suggestions gave bad theorems.
|
||||
| _ =>
|
||||
-- We could actually support arbitrary grind modifiers,
|
||||
@@ -197,26 +199,40 @@ def elabGrindSuggestions
|
||||
-- but this would require a larger refactor.
|
||||
-- Let's only do this if there is a prospect of a library suggestion engine supporting this.
|
||||
throwError "unexpected modifier {p.flag}"
|
||||
unless added.isEmpty do
|
||||
trace[grind.debug.suggestions] "{added}"
|
||||
return params
|
||||
|
||||
open LibrarySuggestions in
|
||||
def elabGrindParamsAndSuggestions
|
||||
(params : Grind.Params)
|
||||
(ps : TSyntaxArray ``Parser.Tactic.grindParam)
|
||||
(suggestions : Array Suggestion := #[])
|
||||
(only : Bool) (lax : Bool := false) : TermElabM Grind.Params := do
|
||||
let params ← elabGrindParams params ps (lax := lax) (only := only)
|
||||
elabGrindSuggestions params suggestions
|
||||
/-- Add all definitions from the current file. -/
|
||||
def elabGrindLocals (params : Grind.Params) : MetaM Grind.Params := do
|
||||
let env ← getEnv
|
||||
let mut params := params
|
||||
let mut added : Array Name := #[]
|
||||
for (name, ci) in env.constants.map₂.toList do
|
||||
-- Filter similar to LibrarySuggestions.isDeniedPremise (but inlined to avoid dependency)
|
||||
-- Skip internal details, but allow private names (which are accessible from current module)
|
||||
if name.isInternalDetail && !isPrivateName name then continue
|
||||
if (← Meta.isInstance name) then continue
|
||||
match ci with
|
||||
| .defnInfo _ =>
|
||||
try
|
||||
params ← addEMatchTheorem params (mkIdent name) name (.default false) false (warn := false)
|
||||
added := added.push name
|
||||
catch _ => pure ()
|
||||
| _ => continue
|
||||
unless added.isEmpty do
|
||||
trace[grind.debug.locals] "{added}"
|
||||
return params
|
||||
|
||||
def mkGrindParams
|
||||
(config : Grind.Config) (only : Bool) (ps : TSyntaxArray ``Parser.Tactic.grindParam) (mvarId : MVarId) :
|
||||
TermElabM Grind.Params := do
|
||||
let params ← if only then Grind.mkOnlyParams config else Grind.mkDefaultParams config
|
||||
let suggestions ← if config.suggestions then
|
||||
LibrarySuggestions.select mvarId { caller := some "grind" }
|
||||
else
|
||||
pure #[]
|
||||
let mut params ← elabGrindParamsAndSuggestions params ps suggestions (only := only) (lax := config.lax)
|
||||
let mut params ← elabGrindParams params ps (lax := config.lax) (only := only)
|
||||
if config.suggestions then
|
||||
params ← elabGrindSuggestions params (← LibrarySuggestions.select mvarId { caller := some "grind" })
|
||||
if config.locals then
|
||||
params ← elabGrindLocals params
|
||||
trace[grind.debug.inj] "{params.extensions[0]!.inj.getOrigins.map (·.pp)}"
|
||||
if params.anchorRefs?.isSome then
|
||||
/-
|
||||
@@ -289,21 +305,24 @@ def setGrindParams (stx : TSyntax `tactic) (params : Array Syntax) : TSyntax `ta
|
||||
def getGrindParams (stx : TSyntax `tactic) : Array Syntax :=
|
||||
stx.raw[grindParamsPos][1].getSepArgs
|
||||
|
||||
/-- Filter out `+suggestions` from the config syntax -/
|
||||
def filterSuggestionsFromGrindConfig (config : TSyntax ``Lean.Parser.Tactic.optConfig) :
|
||||
/-- Filter out `+suggestions` and `+locals` from the config syntax -/
|
||||
def filterSuggestionsAndLocalsFromGrindConfig (config : TSyntax ``Lean.Parser.Tactic.optConfig) :
|
||||
TSyntax ``Lean.Parser.Tactic.optConfig :=
|
||||
let configItems := config.raw.getArgs
|
||||
let filteredItems := configItems.filter fun item =>
|
||||
-- Keep all items except +suggestions
|
||||
-- Structure: null node -> configItem -> posConfigItem -> ["+", ident]
|
||||
match item[0]? with
|
||||
| some configItem => match configItem[0]? with
|
||||
| some posConfigItem => match posConfigItem[1]? with
|
||||
| some ident => !(posConfigItem.getKind == ``Lean.Parser.Tactic.posConfigItem && ident.getId == `suggestions)
|
||||
| none => true
|
||||
-- optConfig structure: (Tactic.optConfig [configItem1, configItem2, ...])
|
||||
-- config.raw.getArgs returns #[null_node], so we need to filter the null node's children
|
||||
let nullNode := config.raw[0]!
|
||||
let configItems := nullNode.getArgs
|
||||
let filteredItems := configItems.filter fun configItem =>
|
||||
-- Keep all items except +suggestions and +locals
|
||||
-- Structure: configItem -> posConfigItem -> ["+", ident]
|
||||
match configItem[0]? with
|
||||
| some posConfigItem => match posConfigItem[1]? with
|
||||
| some ident =>
|
||||
let id := ident.getId.eraseMacroScopes
|
||||
!(posConfigItem.getKind == ``Lean.Parser.Tactic.posConfigItem && (id == `suggestions || id == `locals))
|
||||
| none => true
|
||||
| none => true
|
||||
⟨config.raw.setArgs filteredItems⟩
|
||||
⟨config.raw.setArg 0 (nullNode.setArgs filteredItems)⟩
|
||||
|
||||
private def elabGrindConfig' (config : TSyntax ``Lean.Parser.Tactic.optConfig) (interactive : Bool) : TacticM Grind.Config := do
|
||||
if interactive then
|
||||
@@ -345,7 +364,7 @@ def evalGrindTraceCore (stx : Syntax) (trace := true) (verbose := true) (useSorr
|
||||
let finish ← Grind.Action.mkFinish
|
||||
let goal :: _ ← Grind.getGoals
|
||||
| -- Goal was closed during initialization
|
||||
let configStx' := filterSuggestionsFromGrindConfig configStx
|
||||
let configStx' := filterSuggestionsAndLocalsFromGrindConfig configStx
|
||||
if termParamStxs.isEmpty then
|
||||
let tac ← `(tactic| grind $configStx':optConfig only)
|
||||
return #[tac]
|
||||
@@ -357,7 +376,7 @@ def evalGrindTraceCore (stx : Syntax) (trace := true) (verbose := true) (useSorr
|
||||
-- let saved ← saveState
|
||||
match (← finish.run goal) with
|
||||
| .closed seq =>
|
||||
let configStx' := filterSuggestionsFromGrindConfig configStx
|
||||
let configStx' := filterSuggestionsAndLocalsFromGrindConfig configStx
|
||||
let tacs ← Grind.mkGrindOnlyTactics configStx' seq termParamStxs
|
||||
let seq := Grind.Action.mkGrindSeq seq
|
||||
let tac ← `(tactic| grind $configStx':optConfig => $seq:grindSeq)
|
||||
|
||||
@@ -4,12 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Meta.Tactic.Injection
|
||||
public import Lean.Meta.Tactic.Assumption
|
||||
public import Lean.Elab.Tactic.ElabTerm
|
||||
|
||||
public section
|
||||
namespace Lean.Elab.Tactic
|
||||
|
||||
|
||||
@@ -29,7 +29,7 @@ partial def headBetaUnderLambda (f : Expr) : Expr := Id.run do
|
||||
builtin_initialize monotoneExt :
|
||||
SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←
|
||||
registerSimpleScopedEnvExtension {
|
||||
addEntry := fun dt (n, ks) => dt.insertCore ks n
|
||||
addEntry := fun dt (n, ks) => dt.insertKeyValue ks n
|
||||
initial := {}
|
||||
}
|
||||
|
||||
|
||||
@@ -416,6 +416,28 @@ structure MkSimpContextResult where
|
||||
/-- The elaborated simp arguments with syntax -/
|
||||
simpArgs : Array (Syntax × ElabSimpArgResult) := #[]
|
||||
|
||||
/-- Add all definitions from the current file to unfold. -/
|
||||
def elabSimpLocals (thms : SimpTheorems) (kind : SimpKind) : MetaM SimpTheorems := do
|
||||
let env ← getEnv
|
||||
let mut thms := thms
|
||||
for (name, ci) in env.constants.map₂.toList do
|
||||
-- Skip internal details, but allow private names (which are accessible from current module)
|
||||
if name.isInternalDetail && !isPrivateName name then continue
|
||||
if (← Meta.isInstance name) then continue
|
||||
match ci with
|
||||
| .defnInfo _ =>
|
||||
-- Definitions are added to unfold
|
||||
try
|
||||
if kind == .dsimp then
|
||||
thms := thms.addDeclToUnfoldCore name
|
||||
else
|
||||
let entries ← mkSimpEntryOfDeclToUnfold name
|
||||
for entry in entries do
|
||||
thms := thms.addSimpEntry entry
|
||||
catch _ => pure () -- Skip definitions that can't be added
|
||||
| _ => continue
|
||||
return thms
|
||||
|
||||
/--
|
||||
Create the `Simp.Context` for the `simp`, `dsimp`, and `simp_all` tactics.
|
||||
If `kind != SimpKind.simp`, the `discharge` option must be `none`
|
||||
@@ -437,14 +459,18 @@ def mkSimpContext (stx : Syntax) (eraseLocal : Bool) (kind := SimpKind.simp)
|
||||
throwError "Tactic `dsimp` does not support the `discharger' option"
|
||||
let dischargeWrapper ← mkDischargeWrapper stx[2]
|
||||
let simpOnly := !stx[simpOnlyPos].isNone
|
||||
let simpTheorems ← if simpOnly then
|
||||
let mut simpTheorems ← if simpOnly then
|
||||
simpOnlyBuiltins.foldlM (·.addConst ·) ({} : SimpTheorems)
|
||||
else
|
||||
simpTheorems
|
||||
let simprocs ← if simpOnly then pure {} else Simp.getSimprocs
|
||||
let congrTheorems ← getSimpCongrTheorems
|
||||
let config ← elabSimpConfig stx[1] (kind := kind)
|
||||
-- Add local definitions if +locals is enabled
|
||||
if config.locals then
|
||||
simpTheorems ← elabSimpLocals simpTheorems kind
|
||||
let ctx ← Simp.mkContext
|
||||
(config := (← elabSimpConfig stx[1] (kind := kind)))
|
||||
(config := config)
|
||||
(simpTheorems := #[simpTheorems])
|
||||
congrTheorems
|
||||
let r ← elabSimpArgs stx[4] (eraseLocal := eraseLocal) (kind := kind) (simprocs := #[simprocs]) (ignoreStarArg := ignoreStarArg) ctx
|
||||
|
||||
@@ -21,19 +21,21 @@ The `simp?` tactic is a simple wrapper around the simp with trace behavior.
|
||||
namespace Lean.Elab.Tactic
|
||||
open Lean Elab Parser Tactic Meta Simp Tactic.TryThis
|
||||
|
||||
/-- Filter out `+suggestions` from the config syntax -/
|
||||
def filterSuggestionsFromSimpConfig (cfg : TSyntax ``Lean.Parser.Tactic.optConfig) :
|
||||
/-- Filter out `+suggestions` and `+locals` from the config syntax -/
|
||||
def filterSuggestionsAndLocalsFromSimpConfig (cfg : TSyntax ``Lean.Parser.Tactic.optConfig) :
|
||||
MetaM (TSyntax ``Lean.Parser.Tactic.optConfig) := do
|
||||
-- The config has one arg: a null node containing configItem nodes
|
||||
let nullNode := cfg.raw.getArg 0
|
||||
let configItems := nullNode.getArgs
|
||||
|
||||
-- Filter out configItem nodes that contain +suggestions
|
||||
-- Filter out configItem nodes that contain +suggestions or +locals
|
||||
let filteredItems := configItems.filter fun item =>
|
||||
match item[0]?, item.getKind with
|
||||
| some posConfigItem, ``Lean.Parser.Tactic.configItem =>
|
||||
match posConfigItem[1]?, posConfigItem.getKind with
|
||||
| some ident, ``Lean.Parser.Tactic.posConfigItem => ident.getId != `suggestions
|
||||
| some ident, ``Lean.Parser.Tactic.posConfigItem =>
|
||||
let id := ident.getId.eraseMacroScopes
|
||||
id != `suggestions && id != `locals
|
||||
| _, _ => true
|
||||
| _, _ => true
|
||||
|
||||
@@ -72,7 +74,7 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
|
||||
else
|
||||
`(tactic| simp%$tk $cfg:optConfig $[$discharger]? $[only%$o]? [$argsArray,*] $[$loc]?)
|
||||
-- Build syntax for suggestion (without +suggestions config)
|
||||
let filteredCfg ← filterSuggestionsFromSimpConfig cfg
|
||||
let filteredCfg ← filterSuggestionsAndLocalsFromSimpConfig cfg
|
||||
let stxForSuggestion ← if bang.isSome then
|
||||
`(tactic| simp!%$tk $filteredCfg:optConfig $[$discharger]? $[only%$o]? [$argsArray,*] $[$loc]?)
|
||||
else
|
||||
@@ -118,7 +120,7 @@ def mkSimpCallStx (stx : Syntax) (usedSimps : UsedSimps) : MetaM (TSyntax `tacti
|
||||
else
|
||||
`(tactic| simp_all%$tk $cfg:optConfig $[$discharger]? $[only%$o]? [$argsArray,*])
|
||||
-- Build syntax for suggestion (without +suggestions config)
|
||||
let filteredCfg ← filterSuggestionsFromSimpConfig cfg
|
||||
let filteredCfg ← filterSuggestionsAndLocalsFromSimpConfig cfg
|
||||
let stxForSuggestion ←
|
||||
if argsArray.isEmpty then
|
||||
if bang.isSome then
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user