Compare commits

..

90 Commits

Author SHA1 Message Date
Kim Morrison
703b963b09 chore: make some extCore and customEliminators public for Batteries 2025-10-16 09:51:34 +11:00
Leonardo de Moura
2f93363752 feat: intro and assertAll as actions (#10798)
This PR implements the `grind` actions `intro`, `intros`, `assertNext`,
`assertAll`.
2025-10-15 19:47:48 +00:00
Marc Huisinga
4329eae8d4 fix: unknown identifier minimization (#10797)
This PR fixes a bug in the unknown identifier code actions where the
identifiers wouldn't be correctly minimized in nested namespaces. It
also fixes a bug where identifiers would sometimes be minimized to
`[anonymous]`.

The first bug was introduced in #10619.
2025-10-15 19:25:27 +00:00
Leonardo de Moura
114f7e42f1 feat: lazy message with grind state (#10791)
This PR adds a silent info message with the `grind` state in its
interactive mode. The message is shown only when there is exactly one
goal in the grind interactive mode. The condition is a workaround for
current limitations of our `InfoTree`.
2025-10-15 15:03:07 +00:00
Sebastian Ullrich
419982bd42 chore: even more module system fixes and refinements from Mathlib porting (#10726) 2025-10-15 14:59:09 +00:00
Joachim Breitner
8431088c93 fix: preserve error locations when expanding match arms (#10783)
This PR ensures that error messages such as “redundant alternative” have
the right error location even if the arms share their RHS. Fixes #10781.
2025-10-15 13:31:42 +00:00
Sebastian Ullrich
803ec8ff9d chore: CI: re-enable mistakenly deactivated tests for Linux Lake (#10788) 2025-10-15 13:20:26 +00:00
Sebastian Ullrich
c4747752fe fix: detect private references in inferred type of public def (#10762)
This PR fixes an inconsistency in the module system around defs with
elided types.
2025-10-15 12:51:54 +00:00
Joachim Breitner
ed4d453346 refactor: processLeaf: Only look at first alt (#10774)
This PR lets match compilation look only at the first remaining
alternative in `processLeaf`. At this point we have no further variables
we can split on, so if the first one isn’t applicable, match compilation
should fail.
2025-10-15 10:10:52 +00:00
David Thrane Christiansen
45df6fcd37 fix: hovers and docstrings for (co)inductive types (#10738)
This PR fixes a regression introduced by #10307, where hovering the name
of an inductive type or constructor in its own declaration didn't show
the docstring. In the process, a bug in docstring handling for
coinductive types was discovered and also fixed. Tests are added to
prevent the regression from repeating in the future.
2025-10-15 09:32:11 +00:00
Sebastian Graf
4077bf2c05 feat: implement mvcgen?, expanding to mvcgen invariants? (#10782)
This PR implements a hint tactic `mvcgen?`, expanding to `mvcgen
invariants?`

Example:
```
/--
info: Try this:
  [apply] mvcgen invariants?
---
info: Try this:
  [apply] mvcgen [mySum] invariants?
---
info: Try this:
  [apply] mvcgen +elimLets invariants?
---
info: Try this:
  [apply] mvcgen +elimLets [mySum] invariants?
-/
#guard_msgs (info) in
theorem mySum_suggest_invariant_short (l : List Nat) : mySum l = l.sum := by
  generalize h : mySum l = r
  apply Id.of_wp_run_eq h
  mvcgen?
  mvcgen? [mySum]
  mvcgen? +elimLets
  mvcgen? +elimLets [mySum]
  all_goals admit
```
2025-10-15 08:22:09 +00:00
Joachim Breitner
54a3fbf88f fix: improve error message when decide +kernel fails (#10780)
This PR improves the error message when `decide +kernel` fails in the
kernel, but not the elaborator. Fixes #10766.
2025-10-15 07:11:27 +00:00
Leonardo de Moura
746206c5e6 feat: hover information for grind anchors (#10779)
This PR implements hover information for `grind` anchors. Anchors are
stable hash codes for referencing terms in the grind state. The anchors
will be used when auto generating tactic scripts. The hover display the
following information:

1- In the `instantiate` tactic, it displays the type of the theorem
being instantiated.
<img width="952" height="125" alt="image"
src="https://github.com/user-attachments/assets/be949b87-cf9b-4f75-abe0-17751295de93"
/>

2- In the `cases` tactic, the hover information depends on the kind of
case-split.
  a) Proposition
<img width="1019" height="125" alt="image"
src="https://github.com/user-attachments/assets/253e2927-f18e-49ab-a8fc-2144657406d8"
/>

b) A hypotheses. In this case, you can opt to replace the anchor with
the hypothesis' name if it is accessible.
<img width="1019" height="178" alt="image"
src="https://github.com/user-attachments/assets/858b3751-4ef9-492d-a42f-c0743753a7de"
/>

c) A term. The hover displays just the type, by `grind` logs a silent
information with additional information
  
<img width="1376" height="148" alt="image"
src="https://github.com/user-attachments/assets/30078ca4-a886-49d9-912e-866f3567b0da"
/>
2025-10-15 02:43:11 +00:00
Leonardo de Moura
88141a0a49 feat: hygiene for grind interactive mode (#10778)
This PR ensures that `grind` interactive mode is hygienic. It also adds
tactics for renaming inaccessible names: `rename_i h_1 ... h_n` and
`next h_1 ... h_n => ..`, and `expose_names` for automatically generated
tactic scripts. The PR also adds helper functions for implementing
case-split actions.
2025-10-15 01:27:51 +00:00
Kim Morrison
b17afe0f06 feat: improvements to release automation (#10777)
This PR improves the scripts assisting with cutting Lean releases (by
reporting CI status of open PRs, and adding documentation), and adds a
`.claude/commands/release.md` prompt file so Claude can assist.
2025-10-15 00:28:26 +00:00
Paul Reichert
7632cefa87 feat: hash map iterators (#10761)
This PR provides iterators on hash maps.
2025-10-14 15:10:01 +00:00
Paul Reichert
7a47bfa208 feat: flatMap iterator combinator (#10728)
This PR introduces the `flatMap` iterator combinator. It also adds
lemmas relating `flatMap` to `toList` and `toArray`.
2025-10-14 12:50:54 +00:00
Sebastian Ullrich
ae6335f115 chore: demote Intel macOS to Tier 2 platform (#10770) 2025-10-14 12:10:06 +00:00
Paul Reichert
f58999a7a6 refactor: use Shrink stub in the iterator framework (#10725)
This PR introduces a no-op version of `Shrink`, a type that should allow
shrinking small types into smaller universes given a proof that the type
is small enough, and uses it in the iterator library. Because this type
would require special compiler support, the current version is just a
wrapper around the inner type so that the wrapper is equivalent, but not
definitionally equivalent.

While `Shrink` is unable to shrink universes right now, but introducing
it now will allow us to generalize the universes in the iterator library
with fewer breaking changes as soon as an actual `Shrink` is possible.
2025-10-14 10:22:14 +00:00
Lean stage0 autoupdater
888b59bf95 chore: update stage0 2025-10-14 08:04:41 +00:00
Markus Himmel
1dae353575 chore: duplicate some String functions ahead of deprecation (#10768)
This PR is split off from #10735 for boring bootstrapping reasons.
2025-10-14 07:36:05 +00:00
Leonardo de Moura
a4b788c332 feat: add Grind/Action.lean (#10767)
This PR implements the new control interface for implementing `grind`
search strategies. It will replace the `SearchM` framework.
2025-10-14 03:21:51 +00:00
Sebastian Ullrich
5865c41a76 chore: lean.code-workspace: always open terminal in root folder (#10745) 2025-10-13 14:12:35 +00:00
Marc Huisinga
4b0e8d88ce fix: don't display CSS color picker in Lean files in VS Code (#10757)
This PR fixes a bug in combination with VS Code where Lean code that
looks like CSS color codes would display a color picker decoration.

VS Code displays this decoration by default for all languages, not just
CSS. Due to https://github.com/microsoft/vscode/issues/91533, this
setting cannot be disabled in the client on a per-language basis.
However, we can override the default behavior by providing a color
provider of our own. This PR implements an empty color provider to
override the VS Code one.
2025-10-13 13:39:16 +00:00
Marc Huisinga
9d427fdfcf feat: "try this" messages with support for interactivity (#10524)
This PR adds support for interactivity to the combined "try this"
messages that were introduced in #9966. In doing so, it moves the link
to apply a suggestion to a separate `[apply]` button in front of the
suggestion. Hints with diffs remain unchanged, as they did not
previously support interacting with terms in the diff, either.

<img width="379" height="256" alt="Suggestion with interactive message"
src="https://github.com/user-attachments/assets/7838ebf6-0613-46e7-bc88-468a05acbf51"
/>
2025-10-13 13:39:03 +00:00
Kim Morrison
fe1e7d56f4 chore: restore #8656 (#10758)
This PR restores the change in #8656, which removed `autoImplicit =
false` from the default lake template (per previous discussions linked
there). This was accidentally reverted in #8866.
2025-10-13 10:34:01 +00:00
Markus Himmel
fbe98d76b2 fix: turn meta import into import in Init.Data.ToString (#10754)
This PR makes sure that we always properly import
`Init.Data.ToString.Name` when importing `Init`.
2025-10-13 09:20:48 +00:00
Joachim Breitner
9a5e425990 refactor: no public section in Elab.Induction (#10699)
This PR removes `public section` in `Elab.Induction`.
2025-10-13 09:02:36 +00:00
Leonardo de Moura
14ff08db6f feat: repeat tactical for grind interactive mode (#10748)
This PR implements the `repeat` tactical for the `grind` interactive
mode.
2025-10-12 22:05:58 +00:00
Sebastian Ullrich
316859e871 perf: reset InfoState.lazyAssignment before each command (#10744)
This PR fixes a performance regression introduced in #10518. More
generally, it ensures both message log and info state are per-command,
which has been the case in practice ever since the asynchronous language
driver was introduced.
2025-10-12 09:27:14 +00:00
Leonardo de Moura
47dbcd4b93 feat: finish? and grind? infrastructure (#10747)
This PR implements infrastructure for `finish?` and `grind?` tactics.
2025-10-12 02:48:16 +00:00
Leonardo de Moura
4f7d3bb692 feat: instantiate tactic parameters (#10746)
This PR implements parameters for the `instantiate` tactic in the
`grind` interactive mode. Users can now select both global and local
theorems. Local theorems are selected using anchors. It also adds the
`show_thms` tactic for displaying local theorems. Example:

```lean
example (as bs cs : Array α) (v₁ v₂ : α)
        (i₁ i₂ j : Nat)
        (h₁ : i₁ < as.size)
        (h₂ : bs = as.set i₁ v₁)
        (h₃ : i₂ < bs.size)
        (h₃ : cs = bs.set i₂ v₂)
        (h₄ : i₁ ≠ j ∧ i₂ ≠ j)
        (h₅ : j < cs.size)
        (h₆ : j < as.size)
        : cs[j] = as[j] := by
  grind =>
    instantiate = Array.getElem_set
    instantiate Array.getElem_set
```
2025-10-11 21:35:21 +00:00
Lean stage0 autoupdater
0dc862e3ed chore: update stage0 2025-10-11 05:57:21 +00:00
Mac Malone
d9ee24bf36 fix: lake: local cache w/ --old (#10741)
This PR fixes a bug where partially up-to-date files built with `--old`
could be stored in the cache as fully up-to-date. Such files are no
longer cached. In addition, builds without traces now only perform an
modification time check with `--old`. Otherwise, they are considered
out-of-date.
2025-10-11 02:20:31 +00:00
Mac Malone
0639d49a4c feat: scope output cache by platform & toolchain (#10730)
This PR changes the Lake's remote cache interface to scope cache outputs
by toolchain and/or platform were useful.

Packages that set `platformIndependent = true` will not be scoped by
platform and the core build (i.e., `bootstrap = true`) will not be
scoped by toolchain. Lake's detected platform and toolchain can be
overridden with the new `--platform` and `--toolchain` options to `cache
get` and `cache put`.

Lake no longer accepts the `--scope` option when using `cache get` with
Reservoir.. The `--repo` option must be used instead.
2025-10-11 02:17:39 +00:00
Lean stage0 autoupdater
3a26eb7281 chore: update stage0 2025-10-10 22:22:55 +00:00
Joachim Breitner
830be29422 feat: generate equational theorems uniformly (#10734)
This PR follows upon #10606 and creates equational theorems uniformly
from the unfold theorem, there is only one handler registered in
`registerGetEqnsFn`.

For now we keep `registerGetEqnsFn`, because it’s used by mathlib’s
`irreducible_def`, but I’d like to get rid of it in the long term,
relying only on `registerGetUnfoldEqnFn` for constructions that should
unfold differently.
2025-10-10 21:35:09 +00:00
Leonardo de Moura
2a8c03109a feat: improve ac, linarith, lia, and ring in grind interactive mode (#10740)
This PR improves the tactics `ac`, `linarith`, `lia`, `ring` tactics in
`grind` interactive mode. They now fail if no progress has been made.
They also generate an info message with counterexample/basis if the goal
was not closed.
2025-10-10 21:04:26 +00:00
Leonardo de Moura
07f8ab533c feat: add tactics to grind interactive mode (#10737)
This PR adds the tactics `linarith`, `ac`, `fail`, `first`, `try`,
`fail_if_success`, and `admit` to `grind` interactive mode.
2025-10-10 20:24:07 +00:00
Paul Reichert
a73ebe8a77 feat: any/all predicates for iterators (#10686)
This PR introduces `any`, `anyM`, `all` and `allM` for pure and monadic
iterators. It also provides lemmas about them.
2025-10-10 19:24:10 +00:00
Paul Reichert
3931a72573 feat: SInt ranges (#10633)
This PR provides range support for the signed finite number types
`Int{8,16,32,64}` and `ISize`. The proof obligations are handled by
reducing all of them to proofs about an internal `UpwardEnumerable`
instance for `BitVec` interpreted as signed numbers.
2025-10-10 17:07:20 +00:00
Wojciech Różowski
bf809b5298 chore: change the location of error message for coinductive predicates (#10722)
This PR changes where errors are displayed when trying to use
`coinductive` keyword when targeting things that do not live in `Prop`.
Instead of displaying the error above the first element of the mutual
block, it is displayed above the erroneous definition.

---------

Co-authored-by: Rob23oba <152706811+Rob23oba@users.noreply.github.com>
2025-10-10 16:06:18 +00:00
Joachim Breitner
4b6f07060d feat: remove support for reducible well-founded recursion (#10714)
This PR removes support for reducible well-founded recursion, a Breaking
Change. Using `@[semireducible]` on a definition by well-founded
recursion prints a warning that this is no longer effective.

With the upcoming module system, proofs are often not available. With
this change, we remove a fringe use case hat may require proofs, and
that would not be supported under the module system anyways.

At least for now, direct use of `WellFounded.fix` is not affected.

This fixes: #5192
2025-10-10 15:48:28 +00:00
David Thrane Christiansen
09092549d0 fix: Verso docstring semantic highlighting fixes (#10662)
This PR re-enables semantic tokens for Verso docstrings, after a prior
change accidentally disabled them. It also adds a test to prevent this
from happening again.

In the process, it became clear that there was a bug. The highlighting
strategy led to overlapping but not identical tokens, but the code had
previously assumed that this couldn't happen at the delta-encoding step.
So this PR additionally replaces the removal of duplicate tokens with
priority-based handling of overlapping tokens.

---------

Co-authored-by: Marc Huisinga <mhuisi@protonmail.com>
2025-10-10 11:57:02 +00:00
Joachim Breitner
1b4360c32a fix: unfold more auxillary theorems in termination checking (#10733)
This PR unfolds auxillary theorems more aggressively during termination
checking. This fixes #10721.
2025-10-10 11:09:28 +00:00
Cameron Zwarich
705dac4f77 chore: make @hargoniX code owner of the compiler (#10732) 2025-10-10 04:43:38 +00:00
Leonardo de Moura
3bab621364 feat: add grind interactive mode tactics (#10731)
This PR adds the following tactics to the `grind` interactive mode:
- `focus <grind_tac_seq>`
- `next => <grind_tac_seq>`
- `any_goals <grind_tac_seq>`
- `all_goals <grind_tac_seq>`
- `grind_tac <;> grind_tac`
- `cases <anchor>`
- `tactic => <tac_seq>`

Example:
```lean
def g (as : List Nat) :=
  match as with
  | []      => 1
  | [_]     => 2
  | _::_::_ => 3

example : g bs = 1 → g as ≠ 0 := by
  grind [g.eq_def] =>
    instantiate
    cases #ec88
    next => instantiate
    next => finish
    tactic =>
      rw [h_2] at h_1
      simp [g] at h_1
```
2025-10-10 01:17:37 +00:00
Sebastian Ullrich
526ab9caff feat: Verso and Shake (#10657)
This PR ensures Shake does not remove any imports required by Verso
docstrings
2025-10-09 16:40:29 +00:00
Rob23oba
71ddf227d2 doc: add a recommended spelling for HEq (#10717)
This PR adds a recommended spelling for heterogenous equality (`HEq`,
`≍`).
2025-10-09 10:10:23 +00:00
Markus Himmel
dca8d6d188 refactor: discipline around arithmetic of String.Pos.Raw (#10713)
This PR enforces rules around arithmetic of `String.Pos.Raw`.

Specifically, it adopts the following conventions:

- Byte indices ("ordinals") in strings should be represented using
`String.Pos.Raw`
- Amounts of bytes ("cardinals") in strings should be represented using
`Nat`.

For example, `String.Slice.utf8ByteSize` now returns `Nat` instead of
`String.Pos.Raw`, and there is a new function `String.Slice.rawEndPos`.

Finally, the `HAdd` and `HSub` instances for `String.Pos.Raw` are
reorganized. This is a **breaking change**.

The `HAdd/HSub String.Pos.Raw String.Pos.Raw String.Pos.Raw` instances
have been removed. For the use case of tracking positions relative to
some other position, we instead provide `offsetBy` and `unoffsetBy`
functions. For the use case of advancing/unadvancing a position by an
arbitrary number of bytes, we instead provide `increaseBy` and
`decreaseBy` functions. For
offsetting/unoffsetting/advancing/unadvancing a position `p` by the size
of a string `s` (resp. character `c`), use `s + p`/`p - s`/`p + s`/`p -
s` (resp. `c + p`/`p - c`/`p + c`/`p - c`).
2025-10-09 07:47:45 +00:00
Rob23oba
6f1e932542 fix: make IO.sleep opaque (#10718)
This PR makes the function `IO.sleep` opaque. Previously, the definition
of `IO.sleep` made it definitionally equivalent to `pure ()`.
2025-10-09 07:37:11 +00:00
Sebastian Graf
c32a57e580 feat: revert "feat: disable "experimental" warning for mvcgen (#10638)" (#10720)
This PR re-enables the "experimental" warning for `mvcgen` by changing
its default. The official release has been postponed to justify small
breaking changes in the semantic foundations in the near future.
2025-10-09 06:31:18 +00:00
Lean stage0 autoupdater
aa86d95c08 chore: update stage0 2025-10-08 22:00:53 +00:00
Leonardo de Moura
f9e140838e feat: hexnum parser (#10716)
This PR adds a new helper parser for implementing parsers that contain
hexadecimal numbers. We are going to use it to implement anchors in the
`grind` interactive mode.
2025-10-08 21:12:03 +00:00
Leonardo de Moura
98a6fa1ac7 feat: improve grind anchors computation (#10715)
This PR improves anchor stability (aka stable hash codes) used to
reference terms in a `grind` goal.
2025-10-08 17:44:55 +00:00
Sebastian Ullrich
11be7e8f4a chore: use lld if available for building core (#10694) 2025-10-08 16:47:30 +00:00
Lean stage0 autoupdater
a89463bf9e chore: update stage0 2025-10-08 16:51:08 +00:00
Sofia Rodrigues
7600d41c90 fix: add cancel function to the Timer API to make it behave correctly with finalizers and selectables (#10630)
This PR aims to fix the Timer API selector to make it finish as soon as
possible when unregistered. This change makes the `Selectable.one`
function drop the `selectables` array as soon as possible, so when
combined with finalizers that have some effects like the TCP socket
finalizer, it runs it as soon as possible.
2025-10-08 16:14:39 +00:00
Marc Huisinga
80b8e44072 test: fix test flakiness (#10680)
This PR fixes several causes of test flakiness and re-enables the tests
that were disabled in #10665, #10669 and #10673.

Specifically, it fixes:
- A race condition in the file worker that caused it to report an
incomplete snapshot prefix in the inlay hint request (confirmed to be
the cause of #10665)
- A bug in the test runner where it didn't correctly account for
non-deterministic message ordering inducing different RPC pointer
numbering (confirmed to be the cause of #10673)
- A race condition in the watchdog that would sometimes cause the module
hierarchy to be empty (likely the cause of #10669, but not confirmed as
this issue only reproduced again once in tens of thousands of test runs
on various machines, including CI)
- An unrelated bug in the module hierarchy implementation that would
cause it to report an empty module hierarchy when the file was changed

It also replaces some calls to `Task.get` in the language server with
`IO.wait` to protect the code against unfortunate compiler re-ordering.
2025-10-08 13:33:56 +00:00
Sebastian Ullrich
1d989523d4 fix: simp should not pick up inaccessible definitional equations (#10696)
Fixes #10671
2025-10-08 12:48:35 +00:00
Sebastian Ullrich
3b061a0996 chore: more module system fixes and improvements from Mathlib porting (#10655) 2025-10-08 11:30:09 +00:00
Marc Huisinga
1b1c802362 feat: auto-completion for end names (#10660)
This PR adds auto-completion for identifiers after `end`. It also fixes
a bug where completion in the whitespace after `set_option` would not
yield the full option list.

Closes #3885.

### Breaking changes

The `«end»` syntax is adjusted to take an `identWithPartialTrailingDot`
instead of an `ident`.
2025-10-08 11:12:05 +00:00
Joachim Breitner
50c19f704b fix: Let MVarId.cleanup chase local declarations (#10712)
This PR lets `MVarId.cleanup` chase local declarations (a bit as if they
were equalities). Fixes #10710.
2025-10-08 10:49:14 +00:00
Mac Malone
bbc194b733 feat: USE_LAKE_CACHE CMake option (#10708)
This PR adds the `USE_LAKE_CACHE` option to the core CMake build
(defaults to `OFF`). When enabled, the Lake artifact cache will be
enabled (via `enableArtifactCache`) for stage 1 builds (which includes
interactive use).
2025-10-08 08:56:53 +00:00
Leonardo de Moura
4e7a2b2371 feat: anchors for referencing terms in the grind state (#10709)
This PR implements *anchors* (also known as stable hash codes) for
referencing terms occurring in a `grind` goal. It also introduces the
commands `show_splits` and `show_state`. The former displays the anchors
for candidate case splits in the current `grind` goal.
2025-10-08 02:51:21 +00:00
Mac Malone
215bc30296 feat: lake: allowImportAll configuration option (#9855)
This PR adds a new `allowImportAll` configuration option for packages
and libraries. When enabled by an upstream package or library,
downstream packages will be able to `import all` modules of that package
or library. This enables package authors to selectively choose which
`private` elements, if any, downstream packages may have access to.
2025-10-08 02:47:35 +00:00
Leonardo de Moura
b00d1f933f feat: make finish fail when the goal is not closed (#10707)
This PR ensures the `finish` tactic in `grind` interactive mode fails
and reports diagnostics when goal is not closed.
2025-10-07 20:34:19 +00:00
Leonardo de Moura
5ba0f8b885 feat: have tactic for grind interactive mode (#10706)
This PR adds the `have` tactic for the `grind` interactive mode.
Example:
```lean
example {a b c d e : Nat}
    : a > 0 → b > 0 → 2*c + e <= 2 → e = d + 1 → a*b + 2 > 2*c + d := by
  grind =>
    have : a*b > 0 := Nat.mul_pos h h_1
    lia
```
2025-10-07 20:06:16 +00:00
François G. Dorais
43da17aa7f feat: add forall_fin_zero and exists_fin_zero (#10627)
This PR adds lemmas `forall_fin_zero` and `exists_fin_zero`. It also
marks lemmas `forall_fin_zero`, `forall_fin_one`, `forall_fin_two`,
`exists_fin_zero`, `exists_fin_one`, `exists_fin_two` with `simp`
attribute.

Closes #10629
2025-10-07 18:50:23 +00:00
Wojciech Różowski
0195fdf9aa feat: add coinductive command to specify coinductive predicates (#10333)
This PR introduces a `coinductive` keyword, that can be used to define
coinductive predicates via a syntax identical to the one for `inductive`
keyword. The machinery relies on the implementation of elaboration of
inductive types and extracts an endomap on the appropriate space of the
predicates from the definition that is then fed to the
`PartialFixpoint`. Upon elaborating definitions, all the constructors
are declared through automatically generated lemmas.

For example, infinite sequence of transitions in a relation, can be
given by the following:
```lean4
section
variable (α : Type)
coinductive infSeq (r : α → α → Prop) : α → Prop where
  | step : r a b → infSeq r b → infSeq r a
  
/--
info: infSeq.coinduct (α : Type) (r : α → α → Prop) (pred : α → Prop) (hyp : ∀ (x : α), pred x → ∃ b, r x b ∧ pred b)
  (x✝ : α) : pred x✝ → infSeq α r x✝
-/
#guard_msgs in
#check infSeq.coinduct

/--
info: infSeq.step (α : Type) (r : α → α → Prop) {a b : α} : r a b → infSeq α r b → infSeq α r a
-/
#guard_msgs in
#check infSeq.step
end
```
The machinery also supports `mutual` blocks, as well as mixing inductive
and coinductive predicate definitions:
```lean4
mutual
  coinductive tick : Prop where
  | mk : ¬tock → tick

  inductive tock : Prop where
  | mk : ¬tick → tock
end

/--
info: tick.mutual_induct (pred_1 pred_2 : Prop) (hyp_1 : pred_1 → pred_2 → False) (hyp_2 : (pred_1 → False) → pred_2) :
  (pred_1 → tick) ∧ (tock → pred_2)
-/
#guard_msgs in
#check tick.mutual_induct
```

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2025-10-07 18:04:51 +00:00
Joachim Breitner
5a751d4688 fix: induction: do not allow generalizing variables occurring in the using clause (#10697)
This PR lets `induction` print a warning if a variable occurring in the
`using` clause is generalized. Fixes #10683.
2025-10-07 15:38:34 +00:00
Lean stage0 autoupdater
486d93c5fd chore: update stage0 2025-10-07 13:47:20 +00:00
François G. Dorais
8cebe691a2 fix: Nat.and_distrib_right -> Nat.and_or_distrib_right (#10649)
This PR renames `Nat.and_distrib_right` to `Nat.and_or_distrib_right`.
This is to make the name consistent with other theorems in the same file
(e.g. `Nat.and_or_distrib_left`).
2025-10-07 12:57:46 +00:00
Joachim Breitner
8655f7706f refactor: structural recursion: prove .eq_def directly (#10606)
This PR changes how Lean proves the equational theorems for structural
recursion. The core idea is to let-bind the `f` argument to `brecOn` and
rewriting `.brecOn` with an unfolding theorem. This means no extra case
split for the `.rec` in `.brecOn` is needed, and `simp` doesn't change
the `f` argument which can break the definitional equality with the
defined function. With this, we can prove the unfolding theorem first,
and derive the equational theorems from that, like for all other ways of
defining recursive functions.

Backs out the changes from #10415, the old strategy works well with the
new goals.

Fixes #5667
Fixes #10431
Fixes #10195
Fixes #2962
2025-10-07 12:53:09 +00:00
Yuri de Wit
5c92ffc64d doc: fix url to profile.ts source (#10628)
This PR fixes a broken link to the firefox profile definitions in one of
the comments.

The `profile.js` file was renamed to `profile.ts` while the rest of the
url remained the same.
2025-10-07 12:41:04 +00:00
Sebastian Ullrich
ca7e7c4279 fix: do not discard mutual members on macro use (#10695)
This PR fixes an issue where non-`macro` members of a `mutual` block
were discarded if there was at least one macro present.

Fixes #10687
2025-10-07 12:04:04 +00:00
dependabot[bot]
13c38f64a5 chore: CI: bump softprops/action-gh-release from 2.3.2 to 2.3.3 (#10646)
Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2025-10-07 11:42:02 +00:00
dependabot[bot]
b59959ddab chore: CI: bump actions/stale from 9 to 10 (#10647)
Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2025-10-07 11:41:31 +00:00
dependabot[bot]
8f9c27cc06 chore: CI: bump actions/github-script from 7 to 8 (#10648)
Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
2025-10-07 11:41:04 +00:00
Sebastian Ullrich
715c53d92e chore: Modulize: put section below first module doc (#10693) 2025-10-07 09:10:42 +00:00
Sebastian Graf
7a9d769444 chore: fix the docstring of PredTrans.conjunctive (#10691) 2025-10-07 08:56:13 +00:00
Sebastian Ullrich
15636a347f fix: induction incrementality on removal of extraneous case (#10679)
This PR fixes an issue where "Invalid alternative name" errors from
`induction` stick around after removing the offending alternative.
2025-10-07 08:24:41 +00:00
Sebastian Ullrich
1ecdf8ddfa chore: simplify and extend Modulize.lean (#10692)
Take explicit list of files instead of asking Lake, take `--meta` flag
instead of guessing based on module name.
2025-10-07 08:22:52 +00:00
Chris Henson
54c6efea95 doc: typo in docstring of Std.Time.DateTime.now (#10668)
This PR fixes a duplicated docstring for `Std.Time.DateTime.now`.
2025-10-07 04:55:31 +00:00
Leonardo de Moura
b13f7e25ec feat: add show_* and instantiate grind tactics (#10690)
This PR adds the `instantiate`, `show_true`, `show_false`,
`show_asserted`, and `show_eqcs` tactics for the `grind` interactive
mode. The `show` tactic take an optional "filter" and are used to probe
the `grind` state. Example:
```lean
example (as bs cs : Array α) (v₁ v₂ : α)
        (i₁ i₂ j : Nat)
        (h₁ : i₁ < as.size)
        (h₂ : bs = as.set i₁ v₁)
        (h₃ : i₂ < bs.size)
        (h₃ : cs = bs.set i₂ v₂)
        (h₄ : i₁ ≠ j ∧ i₂ ≠ j)
        (h₅ : j < cs.size)
        (h₆ : j < as.size)
        : cs[j] = as[j] := by
  grind =>
    instantiate
    -- Display asserted facts with `generation > 0`
    show_asserted gen > 0
    -- Display propositions known to be `True`, containing `j`, and `generation > 0`
    show_true j && gen > 0
    -- Display equivalence classes with terms that contain `as` or `bs`
    show_eqcs as || bs
    instantiate
```

This PR also fixes a bug in the `grind` interactive mode initialization
procedure.
2025-10-07 03:36:22 +00:00
Sofia Rodrigues
6964a15b5d feat: add Std.CancellationToken type (#10510)
This PR adds a `Std.CancellationToken` type
2025-10-07 03:21:45 +00:00
Sofia Rodrigues
ad701b577b feat: add StreamMap (#10400)
This PR adds the StreamMap type that enables multiplexing in
asynchronous streams.

This PR depends on: #10366, #10367 and #10370.

---------

Co-authored-by: Markus Himmel <markus@lean-fro.org>
2025-10-06 23:39:44 +00:00
Henrik Böving
1f7374a5d6 fix: RC dec insertion for unused variables (#10689)
This PR fixes an oversight in the RC insertion phase in the code
generator.

If the code generator encounters a `let` that is unused (which is
perfectly reasonable as at this
phase we are in an impure IR and as such allow for side effects to
happen so we cannot remove all
unused `let`) it didn't insert a `dec` instruction for this variable.
This has previously gone
unnoticed because at this point in the compiler basically all unused
lets are removed already
anyways. However with the `IO`/`ST` token erasure coming up they will be
very frequent.
2025-10-06 22:05:17 +00:00
Mac Malone
aa3d409eb6 refactor: lake: mv tests/examples to top-level tests dir (#10688)
This PR moves Lake's test infrastructure from `src/lake` to
`tests/lake`.
2025-10-06 21:47:57 +00:00
Paul Reichert
7771b8079c refactor: improve naming in the range API (#10537)
This PR renames some declarations in the range API for better
consistency and readability. For example,
`UpwardEnumerable.succMany?_succ?` is now called `succMany?_add_one`, in
order to (a) correct the erroneous use of `succ?` instead of `succ`
(=`Nat.succ`) and (b) distinguish the successor of natural numbers
(`add_one`) from the successor of the upward-enumerable type (`succ?` or
`succ`).
2025-10-06 20:51:09 +00:00
2032 changed files with 16278 additions and 3760 deletions

View File

@@ -0,0 +1,57 @@
# Release Management Command
Execute the release process for a given version by running the release checklist and following its instructions.
## Before Starting
**IMPORTANT**: Before beginning the release process, read the in-file documentation:
- Read `script/release_checklist.py` for what the checklist script does
- Read `script/release_steps.py` for what the release steps script does
These comments explain the scripts' behavior, which repositories get special handling, and how errors are handled.
## Arguments
- `version`: The version to release (e.g., v4.24.0)
## Process
1. Run `script/release_checklist.py {version}` to check the current status
2. Create a todo list tracking all repositories that need updates
3. For each repository that needs updating:
- Run `script/release_steps.py {version} {repo_name}` to create the PR
- Mark it complete when the PR is created
4. After creating PRs, notify the user which PRs need review and merging
5. Continuously rerun `script/release_checklist.py {version}` to check progress
6. As PRs are merged, dependent repositories will become ready - create PRs for those as well
7. Continue until all repositories are updated and the release is complete
## Important Notes
- The `release_steps.py` script is idempotent - it's safe to rerun
- The `release_checklist.py` script is idempotent - it's safe to rerun
- Some repositories depend on others (e.g., mathlib4 depends on batteries, aesop, etc.)
- Wait for user to merge PRs before dependent repos can be updated
- Alert user if anything unusual or scary happens
- Use appropriate timeouts for long-running builds (verso can take 10+ minutes)
- ProofWidgets4 uses semantic versioning (v0.0.X) - it's okay to create and push the next sequential tag yourself when needed for a release
## PR Status Reporting
Every time you run `release_checklist.py`, you MUST:
1. Parse the output to identify ALL open PRs mentioned (lines with "✅ PR with title ... exists")
2. Provide a summary to the user listing ALL open PRs that need review
3. Group them by status:
- PRs for repositories that are blocked by dependencies (show these but note they're blocked)
- PRs for repositories that are ready to merge (highlight these)
4. Format the summary clearly with PR numbers and URLs
This summary should be provided EVERY time you run the checklist, not just after creating new PRs.
The user needs to see the complete picture of what's waiting for review.
## Error Handling
**CRITICAL**: If something goes wrong or a command fails:
- **DO NOT** try to manually reproduce the failing steps yourself
- **DO NOT** try to fix things by running git commands or other manual operations
- Both scripts are idempotent and designed to handle partial completion gracefully
- If a script continues to fail after retrying, report the error to the user and wait for instructions

View File

@@ -12,7 +12,7 @@ jobs:
- name: Check awaiting-manual label
id: check-awaiting-manual-label
if: github.event_name == 'pull_request'
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const { labels, number: prNumber } = context.payload.pull_request;

View File

@@ -12,7 +12,7 @@ jobs:
- name: Check awaiting-mathlib label
id: check-awaiting-mathlib-label
if: github.event_name == 'pull_request'
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const { labels, number: prNumber } = context.payload.pull_request;

View File

@@ -31,7 +31,7 @@ jobs:
- if: github.event_name == 'pull_request'
name: Set label
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const { owner, repo, number: issue_number } = context.issue;

View File

@@ -137,7 +137,7 @@ jobs:
- name: Configure build matrix
id: set-matrix
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const level = ${{ steps.set-level.outputs.check-level }};
@@ -187,9 +187,10 @@ jobs:
"name": "Linux Lake",
"os": large ? "nscloud-ubuntu-22.04-amd64-8x16-with-cache" : "ubuntu-latest",
"check-level": 0,
"test": true,
"check-rebootstrap": level >= 1,
"check-stage3": level >= 2,
// only check-level >= 1 opts into tests implicitly. TODO: Clean up this logic.
"test": true,
// NOTE: `test-speedcenter` currently seems to be broken on `ubuntu-latest`
"test-speedcenter": large && level >= 2,
// made explicit until it can be assumed to have propagated to PRs
@@ -215,6 +216,7 @@ jobs:
"name": "macOS",
"os": "macos-15-intel",
"release": true,
"test": false, // Tier 2 platform
"check-level": 2,
"shell": "bash -euxo pipefail {0}",
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/19.1.2/lean-llvm-x86_64-apple-darwin.tar.zst",
@@ -350,7 +352,7 @@ jobs:
content: |
A build of `${{ github.ref_name }}`, triggered by event `${{ github.event_name }}`, [failed](https://github.com/${{ github.repository }}/actions/runs/${{ github.run_id }}).
- if: contains(needs.*.result, 'failure')
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
core.setFailed('Some jobs failed')
@@ -367,7 +369,7 @@ jobs:
with:
path: artifacts
- name: Release
uses: softprops/action-gh-release@72f2c25fcb47643c292f7107632f7a47c1df5cd8
uses: softprops/action-gh-release@6cbd405e2c4e67a21c47fa9e383d020e4e28b836
with:
files: artifacts/*/*
fail_on_unmatched_files: true
@@ -411,7 +413,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@72f2c25fcb47643c292f7107632f7a47c1df5cd8
uses: softprops/action-gh-release@6cbd405e2c4e67a21c47fa9e383d020e4e28b836
with:
body_path: diff.md
prerelease: true

View File

@@ -110,7 +110,7 @@ jobs:
# material.
- id: deploy-alias
if: ${{ steps.should-run.outputs.should-run == 'true' }}
uses: actions/github-script@v7
uses: actions/github-script@v8
name: Compute Alias
with:
result-encoding: string

View File

@@ -17,7 +17,7 @@ jobs:
steps:
- name: Add label based on comment
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
github-token: ${{ secrets.GITHUB_TOKEN }}
script: |

View File

@@ -11,7 +11,7 @@ jobs:
steps:
- name: Check PR body
if: github.event_name == 'pull_request'
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const { title, body, labels, draft } = context.payload.pull_request;

View File

@@ -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@72f2c25fcb47643c292f7107632f7a47c1df5cd8
uses: softprops/action-gh-release@6cbd405e2c4e67a21c47fa9e383d020e4e28b836
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@72f2c25fcb47643c292f7107632f7a47c1df5cd8
uses: softprops/action-gh-release@6cbd405e2c4e67a21c47fa9e383d020e4e28b836
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.
@@ -101,7 +101,7 @@ jobs:
- name: Report release status (short format)
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
await github.rest.repos.createCommitStatus({
@@ -115,7 +115,7 @@ jobs:
- name: Report release status (SHA-suffixed format)
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
await github.rest.repos.createCommitStatus({
@@ -129,7 +129,7 @@ jobs:
- name: Add label
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
await github.rest.issues.addLabels({
@@ -368,7 +368,7 @@ jobs:
- name: Report mathlib base
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true' }}
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const description =

View File

@@ -10,7 +10,7 @@ jobs:
runs-on: ubuntu-latest
steps:
- name: Check PR title
uses: actions/github-script@v7
uses: actions/github-script@v8
with:
script: |
const msg = context.payload.pull_request? context.payload.pull_request.title : context.payload.merge_group.head_commit.message;

View File

@@ -11,7 +11,7 @@ jobs:
stale:
runs-on: ubuntu-latest
steps:
- uses: actions/stale@v9
- uses: actions/stale@v10
with:
days-before-stale: -1
days-before-pr-stale: 30

View File

@@ -7,9 +7,9 @@
/.github/ @kim-em
/RELEASES.md @kim-em
/src/kernel/ @leodemoura
/src/library/compiler/ @zwarich
/src/library/compiler/ @hargoniX
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura @zwarich
/src/Lean/Compiler/ @leodemoura @hargoniX
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @kim-em
/src/Lean/Elab/Tactic/ @kim-em

View File

@@ -25,6 +25,7 @@
} ({
buildInputs = with pkgs; [
cmake gmp libuv ccache pkg-config
llvmPackages.bintools # wrapped lld
llvmPackages.llvm # llvm-symbolizer for asan/lsan
gdb
tree # for CI

View File

@@ -14,6 +14,8 @@
}
],
"settings": {
// Open terminal at root, not current workspace folder
"terminal.integrated.cwd": "${workspaceFolder:.}",
"files.insertFinalNewline": true,
"files.trimTrailingWhitespace": true,
"cmake.buildDirectory": "${workspaceFolder}/build/release",

View File

@@ -1,53 +1,30 @@
import Lake.CLI.Main
/-!
A simple script that inserts `module` and `@[expose] public section` into un-modulized files and
Usage: `lean --run script/Modulize.lean [--meta] file1.lean file2.lean ...`
A simple script that inserts `module` and `public section` into un-modulized files and
bumps their imports to `public`.
When `--meta` is passed, `public meta section` and `public meta import` is used instead.
-/
open Lean Parser.Module
def main (args : List String) : IO Unit := do
initSearchPath ( findSysroot)
-- the list of root modules
let mut mods := args.toArray.map (·.toName)
if mods.isEmpty then
-- Determine default module(s) to run modulize on
mods try
let (elanInstall?, leanInstall?, lakeInstall?) Lake.findInstall?
let config Lake.MonadError.runEIO <| Lake.mkLoadConfig { elanInstall?, leanInstall?, lakeInstall? }
let some workspace Lake.loadWorkspace config |>.toBaseIO
| throw <| IO.userError "failed to load Lake workspace"
let defaultTargetModules := workspace.root.defaultTargets.flatMap fun target =>
if let some lib := workspace.root.findLeanLib? target then
lib.roots
else if let some exe := workspace.root.findLeanExe? target then
#[exe.config.root]
else
#[]
pure defaultTargetModules
catch _ =>
pure #[]
-- Only submodules of `pkg` will be edited or have info reported on them
let pkg := mods[0]!.components.head!
-- Load all the modules
let imps := mods.map ({ module := · })
let env importModules imps {}
let srcSearchPath getSrcSearchPath
for mod in env.header.moduleNames do
if !pkg.isPrefixOf mod then
continue
let mut args := args
let mut doMeta := false
while !args.isEmpty && args[0]!.startsWith "-" do
match args[0]! with
| "--meta" => doMeta := true
| arg => throw <| .userError s!"unknown flag '{arg}'"
args := args.tail
for path in args do
-- Parse the input file
let some path srcSearchPath.findModuleWithExt "lean" mod
| throw <| .userError "error: failed to find source file for {mod}"
let mut text IO.FS.readFile path
let inputCtx := Parser.mkInputContext text path.toString
let inputCtx := Parser.mkInputContext text path
let (header, parserState, msgs) Parser.parseHeader inputCtx
if !msgs.toList.isEmpty then -- skip this file if there are parse errors
msgs.forM fun msg => msg.toString >>= IO.println
@@ -57,28 +34,35 @@ def main (args : List String) : IO Unit := do
if moduleTk?.isSome then
continue
let looksMeta := mod.components.any (· [`Tactic, `Linter])
-- initial whitespace if empty header
let startPos := header.raw.getPos? |>.getD parserState.pos
-- insert section if any trailing text
if header.raw.getTrailingTailPos?.all (· < text.endPos) then
let insertPos := header.raw.getTailPos? |>.getD startPos -- empty header
let mut sec := if looksMeta then
let dummyEnv mkEmptyEnvironment
let (initCmd, parserState', _) :=
Parser.parseCommand inputCtx { env := dummyEnv, options := {} } parserState msgs
-- insert section if any trailing command
if !initCmd.isOfKind ``Parser.Command.eoi then
let insertPos? :=
-- put below initial module docstring if any
guard (initCmd.isOfKind ``Parser.Command.moduleDoc) *> initCmd.getTailPos? <|>
-- else below header
header.raw.getTailPos?
let insertPos := insertPos?.getD startPos -- empty header
let mut sec := if doMeta then
"public meta section"
else
"@[expose] public section"
if !imps.isEmpty then
sec := "\n\n" ++ sec
if header.raw.getTailPos?.isNone then
if insertPos?.isNone then
sec := sec ++ "\n\n"
text := text.extract 0 insertPos ++ sec ++ text.extract insertPos text.endPos
-- prepend each import with `public `
for imp in imps.reverse do
let insertPos := imp.raw.getPos?.get!
let prfx := if looksMeta then "public meta " else "public "
let prfx := if doMeta then "public meta " else "public "
text := text.extract 0 insertPos ++ prfx ++ text.extract insertPos text.endPos
-- insert `module` header

View File

@@ -1,5 +1,51 @@
#!/usr/bin/env python3
"""
Release Checklist for Lean4 and Downstream Repositories
This script validates the status of a Lean4 release across all dependent repositories.
It checks whether repositories are ready for release and identifies missing steps.
IMPORTANT: Keep this documentation up-to-date when modifying the script's behavior!
What this script does:
1. Validates preliminary Lean4 release infrastructure:
- Checks that the release branch (releases/vX.Y.0) exists
- Verifies CMake version settings are correct
- Confirms the release tag exists
- Validates the release page exists on GitHub
- Checks the release notes page on lean-lang.org
2. For each downstream repository (batteries, mathlib4, etc.):
- Checks if dependencies are ready (e.g., mathlib4 depends on batteries)
- Verifies the main branch is on the target toolchain (or newer)
- Checks if a PR exists to bump the toolchain (if not yet updated)
- Validates tags exist for the release version
- Ensures tags are merged into stable branches (for non-RC releases)
- Verifies bump branches exist and are configured correctly
- Special handling for ProofWidgets4 release tags
3. Optionally automates missing steps (when not in --dry-run mode):
- Creates missing release tags using push_repo_release_tag.py
- Merges tags into stable branches using merge_remote.py
Usage:
./release_checklist.py v4.24.0 # Check release status
./release_checklist.py v4.24.0 --verbose # Show detailed debug info
./release_checklist.py v4.24.0 --dry-run # Check only, don't execute fixes
For automated release management with Claude Code:
/release v4.24.0 # Run full release process with Claude
The script reads repository configurations from release_repos.yml and reports:
- ✅ for completed requirements
- ❌ for missing requirements (with instructions to fix)
- 🟡 for repositories waiting on dependencies
- ⮕ for automated actions being taken
This script is idempotent and safe to rerun multiple times.
"""
import argparse
import yaml
import requests
@@ -286,6 +332,68 @@ def check_bump_branch_toolchain(url, bump_branch, github_token):
print(f" ✅ Bump branch correctly uses toolchain: {content}")
return True
def get_pr_ci_status(repo_url, pr_number, github_token):
"""Get the CI status for a pull request."""
api_base = repo_url.replace("https://github.com/", "https://api.github.com/repos/")
headers = {'Authorization': f'token {github_token}'} if github_token else {}
# Get PR details to find the head SHA
pr_response = requests.get(f"{api_base}/pulls/{pr_number}", headers=headers)
if pr_response.status_code != 200:
return "unknown", "Could not fetch PR details"
pr_data = pr_response.json()
head_sha = pr_data['head']['sha']
# Get check runs for the commit
check_runs_response = requests.get(
f"{api_base}/commits/{head_sha}/check-runs",
headers=headers
)
if check_runs_response.status_code != 200:
return "unknown", "Could not fetch check runs"
check_runs_data = check_runs_response.json()
check_runs = check_runs_data.get('check_runs', [])
if not check_runs:
# No check runs, check for status checks (legacy)
status_response = requests.get(
f"{api_base}/commits/{head_sha}/status",
headers=headers
)
if status_response.status_code == 200:
status_data = status_response.json()
state = status_data.get('state', 'unknown')
if state == 'success':
return "success", "All status checks passed"
elif state == 'failure':
return "failure", "Some status checks failed"
elif state == 'pending':
return "pending", "Status checks in progress"
return "unknown", "No CI checks found"
# Analyze check runs
conclusions = [run['conclusion'] for run in check_runs if run.get('status') == 'completed']
in_progress = [run for run in check_runs if run.get('status') in ['queued', 'in_progress']]
if in_progress:
return "pending", f"{len(in_progress)} check(s) in progress"
if not conclusions:
return "pending", "Checks queued"
if all(c == 'success' for c in conclusions):
return "success", f"All {len(conclusions)} checks passed"
failed = sum(1 for c in conclusions if c in ['failure', 'timed_out', 'action_required'])
if failed > 0:
return "failure", f"{failed} check(s) failed"
# Some checks are cancelled, skipped, or neutral
return "warning", f"Some checks did not complete normally"
def pr_exists_with_title(repo_url, title, github_token):
api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + "/pulls"
headers = {'Authorization': f'token {github_token}'} if github_token else {}
@@ -471,6 +579,19 @@ def main():
if pr_info:
pr_number, pr_url = pr_info
print(f" ✅ PR with title '{pr_title}' exists: #{pr_number} ({pr_url})")
# Check CI status
ci_status, ci_message = get_pr_ci_status(url, pr_number, github_token)
if ci_status == "success":
print(f" ✅ CI: {ci_message}")
elif ci_status == "failure":
print(f" ❌ CI: {ci_message}")
elif ci_status == "pending":
print(f" 🔄 CI: {ci_message}")
elif ci_status == "warning":
print(f" ⚠️ CI: {ci_message}")
else:
print(f" ❓ CI: {ci_message}")
else:
print(f" ❌ PR with title '{pr_title}' does not exist")
print(f" Run `script/release_steps.py {toolchain} {name}` to create it")

View File

@@ -1,30 +1,53 @@
#!/usr/bin/env python3
"""
Execute release steps for Lean4 repositories.
Execute Release Steps for Lean4 Downstream Repositories
This script helps automate the release process for Lean4 and its dependent repositories
by actually executing the step-by-step instructions for updating toolchains, creating tags,
and managing branches.
This script automates the process of updating a downstream repository to a new Lean4 release.
It handles creating branches, updating toolchains, merging changes, building, testing, and
creating pull requests.
IMPORTANT: Keep this documentation up-to-date when modifying the script's behavior!
What this script does:
1. Sets up the downstream_releases/ directory for cloning repositories
2. Clones or updates the target repository
3. Creates a branch named bump_to_{version} for the changes
4. Updates the lean-toolchain file to the target version
5. Handles repository-specific variations:
- Different dependency update mechanisms
- Special merging strategies for repositories with nightly-testing branches
- Safety checks for repositories using bump branches
- Custom build and test procedures
6. Commits the changes with message "chore: bump toolchain to {version}"
7. Builds the project (with a clean .lake cache)
8. Runs tests if available
9. Pushes the branch to GitHub
10. Creates a pull request (or reports if one already exists)
Usage:
python3 release_steps.py <version> <repo>
./release_steps.py v4.24.0 batteries # Update batteries to v4.24.0
./release_steps.py v4.24.0-rc1 mathlib4 # Update mathlib4 to v4.24.0-rc1
Arguments:
version: The version to set in the lean-toolchain file (e.g., v4.6.0)
repo: The repository name as specified in release_repos.yml
The script reads repository configurations from release_repos.yml.
Each repository has specific handling for merging, dependencies, and testing.
Example:
python3 release_steps.py v4.6.0 mathlib4
python3 release_steps.py v4.6.0 batteries
This script is idempotent - it's safe to rerun if it fails partway through.
Existing branches, commits, and PRs will be reused rather than duplicated.
The script reads repository configurations from release_repos.yml in the same directory.
Each repository may have specific requirements for:
- Branch management
- Toolchain updates
- Dependency updates
- Tagging conventions
- Stable branch handling
Error handling:
- If build or tests fail, the script continues to create the PR anyway
- Manual conflicts must be resolved by the user
- Network issues during push/PR creation are reported with manual instructions
"""
import argparse

View File

@@ -34,7 +34,14 @@ if (NOT LEAN_PLATFORM_TARGET)
OUTPUT_VARIABLE LEAN_PLATFORM_TARGET OUTPUT_STRIP_TRAILING_WHITESPACE)
endif()
set(LEAN_EXTRA_LINKER_FLAGS "" CACHE STRING "Additional flags used by the linker")
set(LEAN_EXTRA_LINKER_FLAGS_DEFAULT "")
# Use lld by default, if available
find_program(LLD_PATH lld)
if(LLD_PATH)
string(APPEND LEAN_EXTRA_LINKER_FLAGS_DEFAULT " -fuse-ld=lld")
endif()
set(LEAN_EXTRA_LINKER_FLAGS ${LEAN_EXTRA_LINKER_FLAGS_DEFAULT} CACHE STRING "Additional flags used by the linker")
set(LEAN_EXTRA_CXX_FLAGS "" CACHE STRING "Additional flags used by the C++ compiler")
set(LEAN_TEST_VARS "LEAN_CC=${CMAKE_C_COMPILER}" CACHE STRING "Additional environment variables used when running tests")
@@ -82,6 +89,7 @@ option(USE_MIMALLOC "use mimalloc" ON)
# development-specific options
option(CHECK_OLEAN_VERSION "Only load .olean files compiled with the current version of Lean" OFF)
option(USE_LAKE "Use Lake instead of lean.mk for building core libs from language server" ON)
option(USE_LAKE_CACHE "Use the Lake artifact cache for stage 1 builds (requires USE_LAKE)" OFF)
set(LEAN_EXTRA_MAKE_OPTS "" CACHE STRING "extra options to lean --make")
set(LEANC_CC ${CMAKE_C_COMPILER} CACHE STRING "C compiler to use in `leanc`")
@@ -826,10 +834,13 @@ if(LEAN_INSTALL_PREFIX)
set(CMAKE_INSTALL_PREFIX "${LEAN_INSTALL_PREFIX}/lean-${LEAN_VERSION_STRING}${LEAN_INSTALL_SUFFIX}")
endif()
if (STAGE GREATER 1)
if (USE_LAKE_CACHE AND STAGE EQUAL 1)
set(LAKE_ARTIFACT_CACHE_TOML "true")
else()
# The build of stage2+ may depend on local changes made to src/ that are not reflected by the
# commit hash in stage1/bin/lean, so we make sure to disable the global cache
string(APPEND LEAN_EXTRA_LAKEFILE_TOML "\n\nenableArtifactCache = false")
set(LAKE_ARTIFACT_CACHE_TOML "false")
endif()
# Escape for `make`. Yes, twice.

View File

@@ -252,6 +252,7 @@ instance : LawfulMonad Id := by
@[simp] theorem run_map (x : Id α) (f : α β) : (f <$> x).run = f x.run := rfl
@[simp] theorem run_bind (x : Id α) (f : α Id β) : (x >>= f).run = (f x.run).run := rfl
@[simp] theorem run_pure (a : α) : (pure a : Id α).run = a := rfl
@[simp] theorem pure_run (a : Id α) : pure a.run = a := rfl
@[simp] theorem run_seqRight (x y : Id α) : (x *> y).run = y.run := rfl
@[simp] theorem run_seqLeft (x y : Id α) : (x <* y).run = x.run := rfl
@[simp] theorem run_seq (f : Id (α β)) (x : Id α) : (f <*> x).run = f.run x.run := rfl

View File

@@ -752,8 +752,7 @@ of results.
def mapM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m β) (as : Array α) : m (Array β) :=
-- Note: we cannot use `foldlM` here for the reference implementation because this calls
-- `bind` and `pure` too many times. (We are not assuming `m` is a `LawfulMonad`)
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
map (i : Nat) (bs : Array β) : m (Array β) := do
let rec map (i : Nat) (bs : Array β) : m (Array β) := do
if hlt : i < as.size then
map (i+1) (bs.push ( f as[i]))
else
@@ -913,8 +912,7 @@ entire array is checked.
@[implemented_by anyMUnsafe, expose]
def anyM {α : Type u} {m : Type Type w} [Monad m] (p : α m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
let any (stop : Nat) (h : stop as.size) :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) : m Bool := do
let rec loop (j : Nat) : m Bool := do
if hlt : j < stop then
have : j < as.size := Nat.lt_of_lt_of_le hlt h
if ( p as[j]) then
@@ -1252,8 +1250,7 @@ Examples:
-/
@[inline, expose]
def findIdx? {α : Type u} (p : α Bool) (as : Array α) : Option Nat :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) :=
let rec loop (j : Nat) :=
if h : j < as.size then
if p as[j] then some j else loop (j + 1)
else none
@@ -1270,8 +1267,7 @@ Examples:
-/
@[inline]
def findFinIdx? {α : Type u} (p : α Bool) (as : Array α) : Option (Fin as.size) :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) :=
let rec loop (j : Nat) :=
if h : j < as.size then
if p as[j] then some j, h else loop (j + 1)
else none
@@ -1307,7 +1303,6 @@ Examples:
@[inline, expose]
def findIdx (p : α Bool) (as : Array α) : Nat := (as.findIdx? p).getD as.size
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def idxOfAux [BEq α] (xs : Array α) (v : α) (i : Nat) : Option (Fin xs.size) :=
if h : i < xs.size then
if xs[i] == v then some i, h
@@ -1717,7 +1712,6 @@ Examples:
* `#[3, 2, 3, 4].popWhile (· > 2) = #[3, 2]`
* `(#[] : Array Nat).popWhile (· > 2) = #[]`
-/
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def popWhile (p : α Bool) (as : Array α) : Array α :=
if h : as.size > 0 then
if p (as[as.size - 1]'(Nat.sub_lt h (by decide))) then
@@ -1742,8 +1736,7 @@ Examples:
* `#[0, 1, 2, 3, 2, 1].takeWhile (· < 0) = #[]`
-/
def takeWhile (p : α Bool) (as : Array α) : Array α :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
go (i : Nat) (acc : Array α) : Array α :=
let rec go (i : Nat) (acc : Array α) : Array α :=
if h : i < as.size then
let a := as[i]
if p a then
@@ -1766,7 +1759,6 @@ Examples:
* `#["apple", "pear", "orange"].eraseIdx 1 = #["apple", "orange"]`
* `#["apple", "pear", "orange"].eraseIdx 2 = #["apple", "pear"]`
-/
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def eraseIdx (xs : Array α) (i : Nat) (h : i < xs.size := by get_elem_tactic) : Array α :=
if h' : i + 1 < xs.size then
let xs' := xs.swap (i + 1) i
@@ -1861,8 +1853,7 @@ Examples:
* `#["tues", "thur", "sat"].insertIdx 3 "wed" = #["tues", "thur", "sat", "wed"]`
-/
@[inline] def insertIdx (as : Array α) (i : Nat) (a : α) (_ : i as.size := by get_elem_tactic) : Array α :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (as : Array α) (j : Fin as.size) :=
let rec loop (as : Array α) (j : Fin as.size) :=
if i < j then
let j' : Fin as.size := j-1, Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
let as := as.swap j' j
@@ -1916,7 +1907,6 @@ def insertIdxIfInBounds (as : Array α) (i : Nat) (a : α) : Array α :=
else
as
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size bs.size) (i : Nat) : Bool :=
if h : i < as.size then
let a := as[i]
@@ -1945,7 +1935,7 @@ def isPrefixOf [BEq α] (as bs : Array α) : Bool :=
else
false
@[semireducible, specialize] -- This is otherwise irreducible because it uses well-founded recursion.
@[specialize]
def zipWithMAux {m : Type v Type w} [Monad m] (as : Array α) (bs : Array β) (f : α β m γ) (i : Nat) (cs : Array γ) : m (Array γ) := do
if h : i < as.size then
let a := as[i]
@@ -2108,7 +2098,6 @@ private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat),
have : i < as.size := Nat.lt_trans (Nat.lt_succ_self _) h;
a != as[i] && allDiffAuxAux as a i this
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
if h : i < as.size then
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)

View File

@@ -3753,6 +3753,9 @@ theorem neg_add {x y : BitVec w} : - (x + y) = - x - y := by
apply eq_of_toInt_eq
simp [toInt_neg, toInt_add, Int.neg_add, Int.add_neg_eq_sub]
theorem sub_sub (a b c : BitVec n) : a - b - c = a - (b + c) := by
simp [BitVec.sub_eq_add_neg, BitVec.add_assoc, BitVec.neg_add]
theorem add_neg_eq_sub {x y : BitVec w} : x + - y = (x - y) := by
apply eq_of_toInt_eq
simp [toInt_neg, Int.sub_eq_add_neg]

View File

@@ -9,6 +9,7 @@ prelude
public import Init.Data.Rat.Lemmas
import Init.Data.Int.Bitwise.Lemmas
import Init.Data.Int.DivMod.Lemmas
import Init.Hints
/-!
# The dyadic rationals

View File

@@ -23,7 +23,7 @@ Example:
-/
@[inline] def foldl (n) (f : α Fin n α) (init : α) : α := loop init 0 where
/-- Inner loop for `Fin.foldl`. `Fin.foldl.loop n f x i = f (f (f x i) ...) (n-1)` -/
@[semireducible, specialize] loop (x : α) (i : Nat) : α :=
@[specialize] loop (x : α) (i : Nat) : α :=
if h : i < n then loop (f x i, h) (i+1) else x
termination_by n - i
@@ -34,7 +34,7 @@ and nesting to the right.
Example:
* `Fin.foldr 3 (·.val + ·) (0 : Nat) = (0 : Fin 3).val + ((1 : Fin 3).val + ((2 : Fin 3).val + 0))`
-/
@[inline] def foldr (n) (f : Fin n α α) (init : α) : α := loop n (Nat.le_refl n) init where
@[inline, expose] def foldr (n) (f : Fin n α α) (init : α) : α := loop n (Nat.le_refl n) init where
/-- Inner loop for `Fin.foldr`. `Fin.foldr.loop n f i x = f 0 (f ... (f (i-1) x))` -/
@[specialize] loop : (i : _) i n α α
| 0, _, x => x
@@ -65,7 +65,7 @@ Fin.foldlM n f x₀ = do
pure xₙ
```
-/
@[semireducible, specialize] loop (x : α) (i : Nat) : m α := do
@[specialize] loop (x : α) (i : Nat) : m α := do
if h : i < n then f x i, h >>= (loop · (i+1)) else pure x
termination_by n - i
decreasing_by decreasing_trivial_pre_omega
@@ -96,7 +96,7 @@ Fin.foldrM n f xₙ = do
pure x₀
```
-/
@[semireducible, specialize] loop : {i // i n} α m α
@[specialize] loop : {i // i n} α m α
| 0, _, x => pure x
| i+1, h, x => f i, h x >>= loop i, Nat.le_of_lt h

View File

@@ -14,7 +14,7 @@ public import Init.Omega
public import Init.Data.Order.Factories
import Init.Data.Order.Lemmas
public section
@[expose] public section
open Std
@@ -915,16 +915,21 @@ theorem exists_fin_succ {P : Fin (n + 1) → Prop} : (∃ i, P i) ↔ P 0
fun i, h => Fin.cases Or.inl (fun i hi => Or.inr i, hi) i h, fun h =>
(h.elim fun h => 0, h) fun i, hi => i.succ, hi
theorem forall_fin_one {p : Fin 1 Prop} : ( i, p i) p 0 :=
@[simp] theorem forall_fin_zero {p : Fin 0 Prop} : ( i, p i) True :=
fun _ => trivial, fun _ _, h => False.elim <| Nat.not_lt_zero _ h
@[simp] theorem exists_fin_zero {p : Fin 0 Prop} : ( i, p i) False := by simp
@[simp] theorem forall_fin_one {p : Fin 1 Prop} : ( i, p i) p 0 :=
fun h => h _, fun h i => Subsingleton.elim i 0 h
theorem exists_fin_one {p : Fin 1 Prop} : ( i, p i) p 0 :=
@[simp] theorem exists_fin_one {p : Fin 1 Prop} : ( i, p i) p 0 :=
fun i, h => Subsingleton.elim i 0 h, fun h => _, h
theorem forall_fin_two {p : Fin 2 Prop} : ( i, p i) p 0 p 1 :=
@[simp] theorem forall_fin_two {p : Fin 2 Prop} : ( i, p i) p 0 p 1 :=
forall_fin_succ.trans <| and_congr_right fun _ => forall_fin_one
theorem exists_fin_two {p : Fin 2 Prop} : ( i, p i) p 0 p 1 :=
@[simp] theorem exists_fin_two {p : Fin 2 Prop} : ( i, p i) p 0 p 1 :=
exists_fin_succ.trans <| or_congr_right exists_fin_one
theorem fin_two_eq_of_eq_zero_iff : {a b : Fin 2}, (a = 0 b = 0) a = b := by

View File

@@ -605,6 +605,9 @@ theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a :=
match a, eq_ofNat_of_zero_le H with
| _, _, rfl => rfl
theorem ofNat_natAbs_of_nonneg {a : Int} (h : 0 a) : (natAbs a : Int) = a :=
natAbs_of_nonneg h
theorem ofNat_natAbs_of_nonpos {a : Int} (H : a 0) : (natAbs a : Int) = -a := by
rw [ natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)]

View File

@@ -12,18 +12,80 @@ public import Init.Ext
public import Init.NotationExtra
public import Init.TacticsExtra
set_option doc.verso true
public section
/-!
### Definition of iterators
# Definition of iterators
This module defines iterators and what it means for an iterator to be finite and productive.
-/
namespace Std
private opaque Internal.idOpaque {α} : { f : α α // f = id } := id, rfl
/--
Currently, {lean}`Shrink α` is just a wrapper around {lean}`α`.
In the future, {name}`Shrink` should allow shrinking {lean}`α` into a potentially smaller universe,
given a proof that {name}`α` is actually small, just like Mathlib's {lit}`Shrink`, except that
the latter's conversion functions are noncomputable. Until then, {lean}`Shrink α` is always in the
same universe as {name}`α`.
This no-op type exists so that fewer breaking changes will be needed when the
real {lit}`Shrink` type is available and the iterators will be made more flexible with regard to
universes.
The conversion functions {name (scope := "Init.Data.Iterators.Basic")}`Shrink.deflate` and
{name (scope := "Init.Data.Iterators.Basic")}`Shrink.inflate` form an equivalence between
{name}`α` and {lean}`Shrink α`, but this equivalence is intentionally not definitional.
-/
public def Shrink (α : Type u) : Type u := Internal.idOpaque.1 α
/-- Converts elements of {name}`α` into elements of {lean}`Shrink α`. -/
@[always_inline]
public def Shrink.deflate {α} (x : α) : Shrink α :=
cast (by simp [Shrink, Internal.idOpaque.property]) x
/-- Converts elements of {lean}`Shrink α` into elements of {name}`α`. -/
@[always_inline]
public def Shrink.inflate {α} (x : Shrink α) : α :=
cast (by simp [Shrink, Internal.idOpaque.property]) x
@[simp, grind =]
public theorem Shrink.deflate_inflate {α} {x : Shrink α} :
Shrink.deflate x.inflate = x := by
simp [deflate, inflate]
@[simp, grind =]
public theorem Shrink.inflate_deflate {α} {x : α} :
(Shrink.deflate x).inflate = x := by
simp [deflate, inflate]
public theorem Shrink.inflate_inj {α} {x y : Shrink α} :
x.inflate = y.inflate x = y := by
apply Iff.intro
· intro h
simpa using congrArg Shrink.deflate h
· rintro rfl
rfl
public theorem Shrink.deflate_inj {α} {x y : α} :
Shrink.deflate x = Shrink.deflate y x = y := by
apply Iff.intro
· intro h
simpa using congrArg Shrink.inflate h
· rintro rfl
rfl
namespace Iterators
-- It is not fruitful to move the following docstrings to verso right now because there are lots of
-- forward references that cannot be realized nicely.
set_option doc.verso false
/--
An iterator that sequentially emits values of type `β` in the monad `m`. It may be finite
or infinite.
@@ -284,7 +346,7 @@ step object is bundled with a proof that it is a "plausible" step for the given
-/
class Iterator (α : Type w) (m : Type w Type w') (β : outParam (Type w)) where
IsPlausibleStep : IterM (α := α) m β IterStep (IterM (α := α) m β) β Prop
step : (it : IterM (α := α) m β) m (PlausibleIterStep <| IsPlausibleStep it)
step : (it : IterM (α := α) m β) m (Shrink <| PlausibleIterStep <| IsPlausibleStep it)
section Monadic
@@ -358,7 +420,7 @@ the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
-/
@[always_inline, inline, expose]
def IterM.step {α : Type w} {m : Type w Type w'} {β : Type w} [Iterator α m β]
(it : IterM (α := α) m β) : m it.Step :=
(it : IterM (α := α) m β) : m (Shrink it.Step) :=
Iterator.step it
end Monadic
@@ -582,7 +644,7 @@ the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
-/
@[always_inline, inline, expose]
def Iter.step {α β : Type w} [Iterator α Id β] (it : Iter (α := α) β) : it.Step :=
it.toIterM.step.run.toPure
it.toIterM.step.run.inflate.toPure
end Pure

View File

@@ -8,4 +8,5 @@ module
prelude
public import Init.Data.Iterators.Combinators.Monadic
public import Init.Data.Iterators.Combinators.FilterMap
public import Init.Data.Iterators.Combinators.FlatMap
public import Init.Data.Iterators.Combinators.ULift

View File

@@ -0,0 +1,53 @@
/-
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.Combinators.FilterMap
public import Init.Data.Iterators.Combinators.Monadic.FlatMap
set_option doc.verso true
/-!
# {lit}`flatMap` combinator
This file provides the {lit}`flatMap` iterator combinator and variants of it.
If {lit}`it` is any iterator, {lit}`it.flatMap f` maps each output of {lit}`it` to an iterator using
{lit}`f`.
{lit}`it.flatMap f` first emits all outputs of the first obtained iterator, then of the second,
and so on. In other words, {lit}`it` flattens the iterator of iterators obtained by mapping with
{lit}`f`.
-/
namespace Std.Iterators
@[always_inline, inherit_doc IterM.flatMapAfterM]
public def Iter.flatMapAfterM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α Id β] [Iterator α₂ m γ]
(f : β m (IterM (α := α₂) m γ)) (it₁ : Iter (α := α) β) (it₂ : Option (IterM (α := α₂) m γ)) :=
((it₁.mapM pure).flatMapAfterM f it₂ : IterM m γ)
@[always_inline, expose, inherit_doc IterM.flatMapM]
public def Iter.flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α Id β] [Iterator α₂ m γ]
(f : β m (IterM (α := α₂) m γ)) (it : Iter (α := α) β) :=
(it.flatMapAfterM f none : IterM m γ)
@[always_inline, inherit_doc IterM.flatMapAfter]
public def Iter.flatMapAfter {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
(f : β Iter (α := α₂) γ) (it₁ : Iter (α := α) β) (it₂ : Option (Iter (α := α₂) γ)) :=
((it₁.toIterM.flatMapAfter (fun b => (f b).toIterM) (Iter.toIterM <$> it₂)).toIter : Iter γ)
@[always_inline, expose, inherit_doc IterM.flatMap]
public def Iter.flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
(f : β Iter (α := α₂) γ) (it : Iter (α := α) β) :=
(it.flatMapAfter f none : Iter γ)
end Std.Iterators

View File

@@ -7,4 +7,5 @@ module
prelude
public import Init.Data.Iterators.Combinators.Monadic.FilterMap
public import Init.Data.Iterators.Combinators.Monadic.FlatMap
public import Init.Data.Iterators.Combinators.Monadic.ULift

View File

@@ -43,7 +43,8 @@ instance Attach.instIterator {α β : Type w} {m : Type w → Type w'} [Monad m]
[Iterator α m β] {P : β Prop} :
Iterator (Attach α m P) m { out : β // P out } where
IsPlausibleStep it step := step', Monadic.modifyStep it step' = step
step it := (fun step => Monadic.modifyStep it step, step, rfl) <$> it.internalState.inner.step
step it := (fun step => .deflate Monadic.modifyStep it step.inflate, step.inflate, rfl) <$>
it.internalState.inner.step
def Attach.instFinitenessRelation {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [Finite α m] {P : β Prop} :

View File

@@ -149,13 +149,13 @@ instance FilterMap.instIterator {α β γ : Type w} {m : Type w → Type w'} {n
step it :=
letI : MonadLift m n := lift (α := _)
do
match it.internalState.inner.step with
match ( it.internalState.inner.step).inflate with
| .yield it' out h => do
match (f out).operation with
| none, h' => pure <| .skip (it'.filterMapWithPostcondition f) (by exact .yieldNone h h')
| some out', h' => pure <| .yield (it'.filterMapWithPostcondition f) out' (by exact .yieldSome h h')
| .skip it' h => pure <| .skip (it'.filterMapWithPostcondition f) (by exact .skip h)
| .done h => pure <| .done (.done h)
| none, h' => pure <| .deflate <| .skip (it'.filterMapWithPostcondition f) (by exact .yieldNone h h')
| some out', h' => pure <| .deflate <| .yield (it'.filterMapWithPostcondition f) out' (by exact .yieldSome h h')
| .skip it' h => pure <| .deflate <| .skip (it'.filterMapWithPostcondition f) (by exact .skip h)
| .done h => pure <| .deflate <| .done (.done h)
instance {α β γ : Type w} {m : Type w Type w'} {n : Type w Type w''} [Monad n] [Iterator α m β]
{lift : α : Type w m α n α}
@@ -463,7 +463,7 @@ For each value emitted by the base iterator `it`, this combinator calls `f`.
@[inline, expose]
def IterM.mapM {α β γ : Type w} {m : Type w Type w'} {n : Type w Type w''} [Iterator α m β]
[Monad n] [MonadLiftT m n] (f : β n γ) (it : IterM (α := α) m β) :=
(it.filterMapWithPostcondition (fun b => some <$> PostconditionT.lift (f b)) : IterM n γ)
(it.mapWithPostcondition (fun b => PostconditionT.lift (f b)) : IterM n γ)
/--
If `it` is an iterator, then `it.filterM f` is another iterator that applies a monadic

View File

@@ -0,0 +1,385 @@
/-
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.Combinators.Monadic.FilterMap
public import Init.Data.Option.Lemmas
/-!
# Monadic `flatMap` combinator
This file provides the `flatMap` iterator combinator and variants of it.
If `it` is any iterator, `it.flatMap f` maps each output of `it` to an iterator using
`f`.
`it.flatMap f` first emits all outputs of the first obtained iterator, then of the second,
and so on. In other words, `it` flattens the iterator of iterators obtained by mapping with
`f`.
-/
namespace Std.Iterators
/-- Internal implementation detail of the `flatMap` combinator -/
@[ext, unbox]
public structure Flatten (α α₂ β : Type w) (m) where
it₁ : IterM (α := α) m (IterM (α := α₂) m β)
it₂ : Option (IterM (α := α₂) m β)
/--
Internal iterator combinator that is used to implement all `flatMap` variants
-/
@[always_inline]
def IterM.flattenAfter {α α₂ β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
(it₁ : IterM (α := α) m (IterM (α := α₂) m β)) (it₂ : Option (IterM (α := α₂) m β)) :=
(toIterM (α := Flatten α α₂ β m) it₁, it₂ m β : IterM m β)
/--
Let `it₁` and `it₂` be iterators and `f` a monadic function mapping `it₁`'s outputs to iterators
of the same type as `it₂`. Then `it₁.flatMapAfterM f it₂` first goes over `it₂` and then over
`it₁.flatMap f it₂`, emitting all their values.
The main purpose of this combinator is to represent the intermediate state of a `flatMap` iterator
that is currently iterating over one of the inner iterators.
**Marble diagram (without monadic effects):**
```text
it₁ --b c --d -
it₂ a1-a2⊥
f b b1-b2⊥
f c c1-c2⊥
f d ⊥
it.flatMapAfterM f it₂ a1-a2----b1-b2--c1-c2----
```
**Termination properties:**
* `Finite` instance: only if `it₁`, `it₂` and the inner iterators are finite
* `Productive` instance: only if `it₁` is finite and `it₂` and the inner iterators are productive
For certain functions `f`, the resulting iterator will be finite (or productive) even though
no `Finite` (or `Productive`) instance is provided out of the box. For example, if the outer
iterator is productive and the inner
iterators are productive *and provably never empty*, then the resulting iterator is also productive.
**Performance:**
This combinator incurs an additional O(1) cost with each output of `it₁`, `it₂` or an internal
iterator.
For each value emitted by the outer iterator `it₁`, this combinator calls `f`.
-/
@[always_inline]
public def IterM.flatMapAfterM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α m β] [Iterator α₂ m γ]
(f : β m (IterM (α := α₂) m γ)) (it₁ : IterM (α := α) m β) (it₂ : Option (IterM (α := α₂) m γ)) :=
((it₁.mapM f).flattenAfter it₂ : IterM m γ)
/--
Let `it` be an iterator and `f` a monadic function mapping `it`'s outputs to iterators.
Then `it.flatMapM f` is an iterator that goes over `it` and for each output, it applies `f` and
iterates over the resulting iterator. `it.flatMapM f` emits all values obtained from the inner
iterators -- first, all of the first inner iterator, then all of the second one, and so on.
**Marble diagram (without monadic effects):**
```text
it ---a --b c --d -
f a a1-a2⊥
f b b1-b2⊥
f c c1-c2⊥
f d ⊥
it.flatMapM ----a1-a2----b1-b2--c1-c2----
```
**Termination properties:**
* `Finite` instance: only if `it` and the inner iterators are finite
* `Productive` instance: only if `it` is finite and the inner iterators are productive
For certain functions `f`, the resulting iterator will be finite (or productive) even though
no `Finite` (or `Productive`) instance is provided out of the box. For example, if the outer
iterator is productive and the inner
iterators are productive *and provably never empty*, then the resulting iterator is also productive.
**Performance:**
This combinator incurs an additional O(1) cost with each output of `it` or an internal iterator.
For each value emitted by the outer iterator `it`, this combinator calls `f`.
-/
@[always_inline, expose]
public def IterM.flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α m β] [Iterator α₂ m γ]
(f : β m (IterM (α := α₂) m γ)) (it : IterM (α := α) m β) :=
(it.flatMapAfterM f none : IterM m γ)
/--
Let `it₁` and `it₂` be iterators and `f` a function mapping `it₁`'s outputs to iterators
of the same type as `it₂`. Then `it₁.flatMapAfter f it₂` first goes over `it₂` and then over
`it₁.flatMap f it₂`, emitting all their values.
The main purpose of this combinator is to represent the intermediate state of a `flatMap` iterator
that is currently iterating over one of the inner iterators.
**Marble diagram:**
```text
it₁ --b c --d -
it₂ a1-a2⊥
f b b1-b2⊥
f c c1-c2⊥
f d ⊥
it.flatMapAfter f it₂ a1-a2----b1-b2--c1-c2----
```
**Termination properties:**
* `Finite` instance: only if `it₁`, `it₂` and the inner iterators are finite
* `Productive` instance: only if `it₁` is finite and `it₂` and the inner iterators are productive
For certain functions `f`, the resulting iterator will be finite (or productive) even though
no `Finite` (or `Productive`) instance is provided out of the box. For example, if the outer
iterator is productive and the inner
iterators are productive *and provably never empty*, then the resulting iterator is also productive.
**Performance:**
This combinator incurs an additional O(1) cost with each output of `it₁`, `it₂` or an internal
iterator.
For each value emitted by the outer iterator `it₁`, this combinator calls `f`.
-/
@[always_inline]
public def IterM.flatMapAfter {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α m β] [Iterator α₂ m γ]
(f : β IterM (α := α₂) m γ) (it₁ : IterM (α := α) m β) (it₂ : Option (IterM (α := α₂) m γ)) :=
((it₁.map f).flattenAfter it₂ : IterM m γ)
/--
Let `it` be an iterator and `f` a function mapping `it`'s outputs to iterators.
Then `it.flatMap f` is an iterator that goes over `it` and for each output, it applies `f` and
iterates over the resulting iterator. `it.flatMap f` emits all values obtained from the inner
iterators -- first, all of the first inner iterator, then all of the second one, and so on.
**Marble diagram:**
```text
it ---a --b c --d -
f a a1-a2⊥
f b b1-b2⊥
f c c1-c2⊥
f d ⊥
it.flatMap ----a1-a2----b1-b2--c1-c2----
```
**Termination properties:**
* `Finite` instance: only if `it` and the inner iterators are finite
* `Productive` instance: only if `it` is finite and the inner iterators are productive
For certain functions `f`, the resulting iterator will be finite (or productive) even though
no `Finite` (or `Productive`) instance is provided out of the box. For example, if the outer
iterator is productive and the inner
iterators are productive *and provably never empty*, then the resulting iterator is also productive.
**Performance:**
This combinator incurs an additional O(1) cost with each output of `it` or an internal iterator.
For each value emitted by the outer iterator `it`, this combinator calls `f`.
-/
@[always_inline, expose]
public def IterM.flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [Iterator α m β] [Iterator α₂ m γ]
(f : β IterM (α := α₂) m γ) (it : IterM (α := α) m β) :=
(it.flatMapAfter f none : IterM m γ)
variable {α α₂ β : Type w} {m : Type w Type w'}
/-- The plausible-step predicate for `Flatten` iterators -/
public inductive Flatten.IsPlausibleStep [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] :
(it : IterM (α := Flatten α α₂ β m) m β) (step : IterStep (IterM (α := Flatten α α₂ β m) m β) β) Prop where
| outerYield : {it₁ it₁' it₂'}, it₁.IsPlausibleStep (.yield it₁' it₂')
IsPlausibleStep (toIterM it₁, none m β) (.skip (toIterM it₁', some it₂' m β))
| outerSkip : {it₁ it₁'}, it₁.IsPlausibleStep (.skip it₁')
IsPlausibleStep (toIterM it₁, none m β) (.skip (toIterM it₁', none m β))
| outerDone : {it₁}, it₁.IsPlausibleStep .done
IsPlausibleStep (toIterM it₁, none m β) .done
| innerYield : {it₁ it₂ it₂' b}, it₂.IsPlausibleStep (.yield it₂' b)
IsPlausibleStep (toIterM it₁, some it₂ m β) (.yield (toIterM it₁, some it₂' m β) b)
| innerSkip : {it₁ it₂ it₂'}, it₂.IsPlausibleStep (.skip it₂')
IsPlausibleStep (toIterM it₁, some it₂ m β) (.skip (toIterM it₁, some it₂' m β))
| innerDone : {it₁ it₂}, it₂.IsPlausibleStep .done
IsPlausibleStep (toIterM it₁, some it₂ m β) (.skip (toIterM it₁, none m β))
public instance Flatten.instIterator [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] :
Iterator (Flatten α α₂ β m) m β where
IsPlausibleStep := IsPlausibleStep
step it :=
match it with
| it₁, none => do
match ( it₁.step).inflate with
| .yield it₁' it₂' h =>
pure <| .deflate <| .skip it₁', some it₂' (.outerYield h)
| .skip it₁' h =>
pure <| .deflate <| .skip it₁', none (.outerSkip h)
| .done h =>
pure <| .deflate <| .done (.outerDone h)
| it₁, some it₂ => do
match ( it₂.step).inflate with
| .yield it₂' c h =>
pure <| .deflate <| .yield it₁, some it₂' c (.innerYield h)
| .skip it₂' h =>
pure <| .deflate <| .skip it₁, some it₂' (.innerSkip h)
| .done h =>
pure <| .deflate <| .skip it₁, none (.innerDone h)
section Finite
variable {α : Type w} {α₂ : Type w} {β : Type w} {m : Type w Type w'}
variable (α m β) in
def Rel [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] [Finite α m] [Finite α₂ m] :
IterM (α := Flatten α α₂ β m) m β IterM (α := Flatten α α₂ β m) m β Prop :=
InvImage
(Prod.Lex
(InvImage IterM.TerminationMeasures.Finite.Rel IterM.finitelyManySteps)
(Option.lt (InvImage IterM.TerminationMeasures.Finite.Rel IterM.finitelyManySteps)))
(fun it => (it.internalState.it₁, it.internalState.it₂))
theorem Flatten.rel_of_left [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Finite α₂ m] {it it'}
(h : it'.internalState.it₁.finitelyManySteps.Rel it.internalState.it₁.finitelyManySteps) :
Rel α β m it' it :=
Prod.Lex.left _ _ h
theorem Flatten.rel_of_right₁ [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Finite α₂ m] {it₁ it₂ it₂'}
(h : (InvImage IterM.TerminationMeasures.Finite.Rel IterM.finitelyManySteps) it₂' it₂) :
Rel α β m it₁, some it₂' it₁, some it₂ := by
refine Prod.Lex.right _ h
theorem Flatten.rel_of_right₂ [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Finite α₂ m] {it₁ it₂} :
Rel α β m it₁, none it₁, some it₂ :=
Prod.Lex.right _ True.intro
instance [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Finite α₂ m] :
FinitenessRelation (Flatten α α₂ β m) m where
rel := Rel α β m
wf := by
apply InvImage.wf
refine fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b
· exact InvImage.wf _ WellFoundedRelation.wf
· exact Option.wellFounded_lt <| InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
obtain step, h, h' := h
cases h' <;> cases h
case outerYield =>
apply Flatten.rel_of_left
exact IterM.TerminationMeasures.Finite.rel_of_yield _
case outerSkip =>
apply Flatten.rel_of_left
exact IterM.TerminationMeasures.Finite.rel_of_skip _
case innerYield =>
apply Flatten.rel_of_right₁
exact IterM.TerminationMeasures.Finite.rel_of_yield _
case innerSkip =>
apply Flatten.rel_of_right₁
exact IterM.TerminationMeasures.Finite.rel_of_skip _
case innerDone =>
apply Flatten.rel_of_right₂
@[no_expose]
public instance [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Finite α₂ m] : Finite (Flatten α α₂ β m) m :=
.of_finitenessRelation instFinitenessRelationFlattenOfIterMOfFinite
end Finite
section Productive
variable {α : Type w} {α₂ : Type w} {β : Type w} {m : Type w Type w'}
variable (α m β) in
def ProductiveRel [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] [Finite α m]
[Productive α₂ m] :
IterM (α := Flatten α α₂ β m) m β IterM (α := Flatten α α₂ β m) m β Prop :=
InvImage
(Prod.Lex
(InvImage IterM.TerminationMeasures.Finite.Rel IterM.finitelyManySteps)
(Option.lt (InvImage IterM.TerminationMeasures.Productive.Rel IterM.finitelyManySkips)))
(fun it => (it.internalState.it₁, it.internalState.it₂))
theorem Flatten.productiveRel_of_left [Monad m] [Iterator α m (IterM (α := α₂) m β)]
[Iterator α₂ m β] [Finite α m] [Productive α₂ m] {it it'}
(h : it'.internalState.it₁.finitelyManySteps.Rel it.internalState.it₁.finitelyManySteps) :
ProductiveRel α β m it' it :=
Prod.Lex.left _ _ h
theorem Flatten.productiveRel_of_right₁ [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Productive α₂ m] {it₁ it₂ it₂'}
(h : (InvImage IterM.TerminationMeasures.Productive.Rel IterM.finitelyManySkips) it₂' it₂) :
ProductiveRel α β m it₁, some it₂' it₁, some it₂ := by
refine Prod.Lex.right _ h
theorem Flatten.productiveRel_of_right₂ [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Productive α₂ m] {it₁ it₂} :
ProductiveRel α β m it₁, none it₁, some it₂ :=
Prod.Lex.right _ True.intro
instance [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Productive α₂ m] :
ProductivenessRelation (Flatten α α₂ β m) m where
rel := ProductiveRel α β m
wf := by
apply InvImage.wf
refine fun (a, b) => Prod.lexAccessible (WellFounded.apply ?_ a) (WellFounded.apply ?_) b
· exact InvImage.wf _ WellFoundedRelation.wf
· exact Option.wellFounded_lt <| InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
cases h
case outerYield =>
apply Flatten.productiveRel_of_left
exact IterM.TerminationMeasures.Finite.rel_of_yield _
case outerSkip =>
apply Flatten.productiveRel_of_left
exact IterM.TerminationMeasures.Finite.rel_of_skip _
case innerSkip =>
apply Flatten.productiveRel_of_right₁
exact IterM.TerminationMeasures.Productive.rel_of_skip _
case innerDone =>
apply Flatten.productiveRel_of_right₂
@[no_expose]
public instance [Monad m] [Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
[Finite α m] [Productive α₂ m] : Productive (Flatten α α₂ β m) m :=
.of_productivenessRelation instProductivenessRelationFlattenOfFiniteIterMOfProductive
end Productive
public instance Flatten.instIteratorCollect [Monad m] [Monad n] [Iterator α m (IterM (α := α₂) m β)]
[Iterator α₂ m β] : IteratorCollect (Flatten α α₂ β m) m n :=
.defaultImplementation
public instance Flatten.instIteratorCollectPartial [Monad m] [Monad n] [Iterator α m (IterM (α := α₂) m β)]
[Iterator α₂ m β] : IteratorCollectPartial (Flatten α α₂ β m) m n :=
.defaultImplementation
public instance Flatten.instIteratorLoop [Monad m] [Monad n] [Iterator α m (IterM (α := α₂) m β)]
[Iterator α₂ m β] : IteratorLoop (Flatten α α₂ β m) m n :=
.defaultImplementation
public instance Flatten.instIteratorLoopPartial [Monad m] [Monad n] [Iterator α m (IterM (α := α₂) m β)]
[Iterator α₂ m β] : IteratorLoopPartial (Flatten α α₂ β m) m n :=
.defaultImplementation
end Std.Iterators

View File

@@ -90,9 +90,9 @@ instance Types.ULiftIterator.instIterator [Iterator α m β] [Monad n] :
step = ULiftIterator.Monadic.modifyStep step'
step it := do
let step := ( (lift it.internalState.inner.step).run).down
return Monadic.modifyStep step.val, ?hp
return .deflate Monadic.modifyStep step.inflate.val, ?hp
where finally
case hp => exact step.val, step.property, rfl
case hp => exact step.inflate.val, step.inflate.property, rfl
def Types.ULiftIterator.instFinitenessRelation [Iterator α m β] [Finite α m] [Monad n] :
FinitenessRelation (ULiftIterator α m n β lift) n where

View File

@@ -139,6 +139,70 @@ def Iter.Partial.fold {α : Type w} {β : Type w} {γ : Type x} [Iterator α Id
(init : γ) (it : Iter.Partial (α := α) β) : γ :=
ForIn.forIn (m := Id) it init (fun x acc => ForInStep.yield (f acc x))
set_option doc.verso true in
/--
Returns {lean}`true` if the monadic predicate {name}`p` returns {lean}`true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
-/
@[specialize]
def Iter.anyM {α β : Type w} {m : Type Type w'} [Monad m]
[Iterator α Id β] [IteratorLoop α Id m] [Finite α Id]
(p : β m Bool) (it : Iter (α := α) β) : m Bool :=
ForIn.forIn it false (fun x _ => do
if p x then
return .done true
else
return .yield false)
set_option doc.verso true in
/--
Returns {lean}`true` if the pure predicate {name}`p` returns {lean}`true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
-/
@[inline]
def Iter.any {α β : Type w}
[Iterator α Id β] [IteratorLoop α Id Id] [Finite α Id]
(p : β Bool) (it : Iter (α := α) β) : Bool :=
(it.anyM (fun x => pure (f := Id) (p x))).run
set_option doc.verso true in
/--
Returns {lean}`true` if the monadic predicate {name}`p` returns {lean}`true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
-/
@[specialize]
def Iter.allM {α β : Type w} {m : Type Type w'} [Monad m]
[Iterator α Id β] [IteratorLoop α Id m] [Finite α Id]
(p : β m Bool) (it : Iter (α := α) β) : m Bool :=
ForIn.forIn it true (fun x _ => do
if p x then
return .yield true
else
return .done false)
set_option doc.verso true in
/--
Returns {lean}`true` if the pure predicate {name}`p` returns {lean}`true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
-/
@[inline]
def Iter.all {α β : Type w}
[Iterator α Id β] [IteratorLoop α Id Id] [Finite α Id]
(p : β Bool) (it : Iter (α := α) β) : Bool :=
(it.allM (fun x => pure (f := Id) (p x))).run
@[always_inline, inline, expose, inherit_doc IterM.size]
def Iter.size {α : Type w} {β : Type w} [Iterator α Id β] [IteratorSize α Id]
(it : Iter (α := α) β) : Nat :=

View File

@@ -91,7 +91,7 @@ def IterM.DefaultConsumers.toArrayMapped {α β : Type w} {m : Type w → Type w
where
@[specialize]
go [Monad n] [Finite α m] (it : IterM (α := α) m β) a := letI : MonadLift m n := lift (α := _); do
match it.step with
match ( it.step).inflate with
| .yield it' b _ => go it' (a.push ( f b))
| .skip it' _ => go it' a
| .done _ => return a
@@ -150,7 +150,7 @@ partial def IterM.DefaultConsumers.toArrayMappedPartial {α β : Type w} {m : Ty
where
@[specialize]
go [Monad n] (it : IterM (α := α) m β) a := letI : MonadLift m n := lift; do
match it.step with
match ( it.step).inflate with
| .yield it' b _ => go it' (a.push ( f b))
| .skip it' _ => go it' a
| .done _ => return a
@@ -209,7 +209,7 @@ def IterM.toListRev {α : Type w} {m : Type w → Type w'} [Monad m] {β : Type
go it []
where
go [Finite α m] it bs := do
match it.step with
match ( it.step).inflate with
| .yield it' b _ => go it' (b :: bs)
| .skip it' _ => go it' bs
| .done _ => return bs
@@ -229,7 +229,7 @@ partial def IterM.Partial.toListRev {α : Type w} {m : Type w → Type w'} [Mona
where
@[specialize]
go it bs := do
match it.step with
match ( it.step).inflate with
| .yield it' b _ => go it' (b :: bs)
| .skip it' _ => go it' bs
| .done _ => return bs

View File

@@ -142,7 +142,8 @@ def IterM.DefaultConsumers.forIn' {m : Type w → Type w'} {α : Type w} {β : T
(P : β Prop) (hP : b, it.IsPlausibleIndirectOutput b P b)
(f : (b : β) P b (c : γ) n (Subtype (plausible_forInStep b c))) : n γ :=
haveI : WellFounded _ := wf
(lift _ _ · it.step) fun
(lift _ _ · it.step) fun s =>
match s.inflate with
| .yield it' out h => do
match f out (hP _ <| .direct _, h) init with
| .yield c, _ =>
@@ -220,7 +221,8 @@ partial def IterM.DefaultConsumers.forInPartial {m : Type w → Type w'} {α : T
(lift : γ δ, (γ n δ) m γ n δ) (γ : Type x)
(it : IterM (α := α) m β) (init : γ)
(f : (b : β) it.IsPlausibleIndirectOutput b (c : γ) n (ForInStep γ)) : n γ :=
(lift _ _ · it.step) fun
(lift _ _ · it.step) fun s =>
match s.inflate with
| .yield it' out h => do
match f out (.direct _, h) init with
| .yield c =>
@@ -416,6 +418,169 @@ def IterM.Partial.drain {α : Type w} {m : Type w → Type w'} [Monad m] {β : T
m PUnit :=
it.fold (γ := PUnit) (fun _ _ => .unit) .unit
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the monadic predicate {name}`p` returns {lean}`ULift.up true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
This function requires a {name}`Finite` instance proving that the iterator will finish after a
finite number of steps. If the iterator is not finite or such an instance is not available,
consider using {lit}`it.allowNontermination.anyM` instead of {lean}`it.anyM`. However, it is not
possible to formally verify the behavior of the partial variant.
-/
@[specialize]
def IterM.anyM {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoop α m m] [Finite α m]
(p : β m (ULift Bool)) (it : IterM (α := α) m β) : m (ULift Bool) :=
ForIn.forIn it (ULift.up false) (fun x _ => do
if ( p x).down then
return .done (.up true)
else
return .yield (.up false))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the monadic predicate {name}`p` returns {lean}`ULift.up true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
This is a partial, potentially nonterminating, function. It is not possible to formally verify
its behavior. If the iterator has a {name}`Finite` instance, consider using {name}`IterM.anyM`
instead.
-/
@[specialize]
def IterM.Partial.anyM {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoopPartial α m m]
(p : β m (ULift Bool)) (it : IterM.Partial (α := α) m β) : m (ULift Bool) :=
ForIn.forIn it (ULift.up false) (fun x _ => do
if ( p x).down then
return .done (.up true)
else
return .yield (.up false))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the pure predicate {name}`p` returns {lean}`true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
This function requires a {name}`Finite` instance proving that the iterator will finish after a
finite number of steps. If the iterator is not finite or such an instance is not available,
consider using {lit}`it.allowNontermination.any` instead of {lean}`it.any`. However, it is not
possible to formally verify the behavior of the partial variant.
-/
@[inline]
def IterM.any {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoop α m m] [Finite α m]
(p : β Bool) (it : IterM (α := α) m β) : m (ULift Bool) := do
it.anyM (fun x => pure (.up (p x)))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the pure predicate {name}`p` returns {lean}`true` for
any element emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first match. The elements in {name}`it` are
examined in order of iteration.
This is a partial, potentially nonterminating, function. It is not possible to formally verify
its behavior. If the iterator has a {name}`Finite` instance, consider using {name}`IterM.any`
instead.
-/
@[inline]
def IterM.Partial.any {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoopPartial α m m]
(p : β Bool) (it : IterM.Partial (α := α) m β) : m (ULift Bool) := do
it.anyM (fun x => pure (.up (p x)))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the monadic predicate {name}`p` returns {lean}`ULift.up true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
This function requires a {name}`Finite` instance proving that the iterator will finish after a
finite number of steps. If the iterator is not finite or such an instance is not available,
consider using {lit}`it.allowNontermination.allM` instead of {lean}`it.allM`. However, it is not
possible to formally verify the behavior of the partial variant.
-/
@[specialize]
def IterM.allM {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoop α m m] [Finite α m]
(p : β m (ULift Bool)) (it : IterM (α := α) m β) : m (ULift Bool) := do
ForIn.forIn it (ULift.up true) (fun x _ => do
if ( p x).down then
return .yield (.up true)
else
return .done (.up false))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the monadic predicate {name}`p` returns {lean}`ULift.up true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
This is a partial, potentially nonterminating, function. It is not possible to formally verify
its behavior. If the iterator has a {name}`Finite` instance, consider using {name}`IterM.allM`
instead.
-/
@[specialize]
def IterM.Partial.allM {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoopPartial α m m]
(p : β m (ULift Bool)) (it : IterM.Partial (α := α) m β) : m (ULift Bool) := do
ForIn.forIn it (ULift.up true) (fun x _ => do
if ( p x).down then
return .yield (.up true)
else
return .done (.up false))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the pure predicate {name}`p` returns {lean}`true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
This function requires a {name}`Finite` instance proving that the iterator will finish after a
finite number of steps. If the iterator is not finite or such an instance is not available,
consider using {lit}`it.allowNontermination.all` instead of {lean}`it.all`. However, it is not
possible to formally verify the behavior of the partial variant.
-/
@[inline]
def IterM.all {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoop α m m] [Finite α m]
(p : β Bool) (it : IterM (α := α) m β) : m (ULift Bool) := do
it.allM (fun x => pure (.up (p x)))
set_option doc.verso true in
/--
Returns {lean}`ULift.up true` if the pure predicate {name}`p` returns {lean}`true` for
all elements emitted by the iterator {name}`it`.
{lit}`O(|xs|)`. Short-circuits upon encountering the first mismatch. The elements in {name}`it` are
examined in order of iteration.
This is a partial, potentially nonterminating, function. It is not possible to formally verify
its behavior. If the iterator has a {name}`Finite` instance, consider using {name}`IterM.all`
instead.
-/
@[inline]
def IterM.Partial.all {α β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m β] [IteratorLoopPartial α m m]
(p : β Bool) (it : IterM.Partial (α := α) m β) : m (ULift Bool) := do
it.allM (fun x => pure (.up (p x)))
section Size
/--

View File

@@ -9,4 +9,5 @@ prelude
public import Init.Data.Iterators.Lemmas.Combinators.Attach
public import Init.Data.Iterators.Lemmas.Combinators.Monadic
public import Init.Data.Iterators.Lemmas.Combinators.FilterMap
public import Init.Data.Iterators.Lemmas.Combinators.FlatMap
public import Init.Data.Iterators.Lemmas.Combinators.ULift

View File

@@ -62,18 +62,18 @@ theorem Iter.step_filterMapWithPostcondition {f : β → PostconditionT n (Optio
| .yield it' out h => do
match (f out).operation with
| none, h' =>
pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone (out := out) h h')
pure <| .deflate <| .skip (it'.filterMapWithPostcondition f) (.yieldNone (out := out) h h')
| some out', h' =>
pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome (out := out) h h')
pure <| .deflate <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome (out := out) h h')
| .skip it' h =>
pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
pure <| .deflate <| .skip (it'.filterMapWithPostcondition f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [filterMapWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM, IterM.step_filterMapWithPostcondition,
step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
apply bind_congr
intro step
@@ -88,17 +88,17 @@ theorem Iter.step_filterWithPostcondition {f : β → PostconditionT n (ULift Bo
| .yield it' out h => do
match (f out).operation with
| .up false, h' =>
pure <| .skip (it'.filterWithPostcondition f) (.yieldNone (out := out) h _, h', rfl)
pure <| .deflate <| .skip (it'.filterWithPostcondition f) (.yieldNone (out := out) h _, h', rfl)
| .up true, h' =>
pure <| .yield (it'.filterWithPostcondition f) out (.yieldSome (out := out) h _, h', rfl)
pure <| .deflate <| .yield (it'.filterWithPostcondition f) out (.yieldSome (out := out) h _, h', rfl)
| .skip it' h =>
pure <| .skip (it'.filterWithPostcondition f) (.skip h)
pure <| .deflate <| .skip (it'.filterWithPostcondition f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [filterWithPostcondition_eq_toIter_filterMapWithPostcondition_toIterM, IterM.step_filterWithPostcondition, step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
apply bind_congr
intro step
@@ -112,15 +112,15 @@ theorem Iter.step_mapWithPostcondition {f : β → PostconditionT n γ}
match it.step with
| .yield it' out h => do
let out' (f out).operation
pure <| .yield (it'.mapWithPostcondition f) out'.1 (.yieldSome h out', rfl)
pure <| .deflate <| .yield (it'.mapWithPostcondition f) out'.1 (.yieldSome h out', rfl)
| .skip it' h =>
pure <| .skip (it'.mapWithPostcondition f) (.skip h)
pure <| .deflate <| .skip (it'.mapWithPostcondition f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [mapWithPostcondition_eq_toIter_mapWithPostcondition_toIterM, IterM.step_mapWithPostcondition, step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
simp only [bind_pure_comp]
rfl
@@ -134,17 +134,17 @@ theorem Iter.step_filterMapM {β' : Type w} {f : β → n (Option β')}
| .yield it' out h => do
match f out with
| none =>
pure <| .skip (it'.filterMapM f) (.yieldNone (out := out) h .intro)
pure <| .deflate <| .skip (it'.filterMapM f) (.yieldNone (out := out) h .intro)
| some out' =>
pure <| .yield (it'.filterMapM f) out' (.yieldSome (out := out) h .intro)
pure <| .deflate <| .yield (it'.filterMapM f) out' (.yieldSome (out := out) h .intro)
| .skip it' h =>
pure <| .skip (it'.filterMapM f) (.skip h)
pure <| .deflate <| .skip (it'.filterMapM f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [filterMapM_eq_toIter_filterMapM_toIterM, IterM.step_filterMapM, step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
apply bind_congr
intro step
@@ -159,17 +159,17 @@ theorem Iter.step_filterM {f : β → n (ULift Bool)}
| .yield it' out h => do
match f out with
| .up false =>
pure <| .skip (it'.filterM f) (.yieldNone (out := out) h .up false, .intro, rfl)
pure <| .deflate <| .skip (it'.filterM f) (.yieldNone (out := out) h .up false, .intro, rfl)
| .up true =>
pure <| .yield (it'.filterM f) out (.yieldSome (out := out) h .up true, .intro, rfl)
pure <| .deflate <| .yield (it'.filterM f) out (.yieldSome (out := out) h .up true, .intro, rfl)
| .skip it' h =>
pure <| .skip (it'.filterM f) (.skip h)
pure <| .deflate <| .skip (it'.filterM f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [filterM_eq_toIter_filterM_toIterM, IterM.step_filterM, step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
simp [PostconditionT.lift]
apply bind_congr
@@ -179,23 +179,22 @@ theorem Iter.step_filterM {f : β → n (ULift Bool)}
| .done h => rfl
theorem Iter.step_mapM {f : β n γ}
[Monad n] [LawfulMonad n] [MonadLiftT m n] :
[Monad n] [LawfulMonad n] :
(it.mapM f).step = (do
match it.step with
| .yield it' out h => do
let out' f out
pure <| .yield (it'.mapM f) out' (.yieldSome h out', True.intro, rfl)
pure <| .deflate <| .yield (it'.mapM f) out' (.yieldSome h out', True.intro, rfl)
| .skip it' h =>
pure <| .skip (it'.mapM f) (.skip h)
pure <| .deflate <| .skip (it'.mapM f) (.skip h)
| .done h =>
pure <| .done (.done h)) := by
pure <| .deflate <| .done (.done h)) := by
simp only [mapM_eq_toIter_mapM_toIterM, IterM.step_mapM, step]
simp only [liftM, monadLift, pure_bind]
generalize it.toIterM.step = step
match step with
match step.inflate with
| .yield it' out h =>
simp only [bind_pure_comp]
simp only [Functor.map]
rfl
| .skip it' h => rfl
| .done h => rfl
@@ -211,14 +210,32 @@ theorem Iter.step_filterMap {f : β → Option γ} :
simp only [filterMap_eq_toIter_filterMap_toIterM, toIterM_toIter, IterM.step_filterMap, step]
simp only [monadLift, Id.run_bind]
generalize it.toIterM.step.run = step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· simp only [IterM.Step.toPure_yield, toIter_toIterM, toIterM_toIter]
split <;> split <;> (try exfalso; simp_all; done)
· rfl
· simp
· rename_i h₁ _ h₂
rw [h₁] at h₂
cases h₂
rfl
simp
· simp
· simp
/--
a weaker version of `step_filterMap` that does not use dependent `match`
-/
theorem Iter.val_step_filterMap {f : β Option γ} :
(it.filterMap f).step.val = match it.step.val with
| .yield it' out =>
match f out with
| none => .skip (it'.filterMap f)
| some out' => .yield (it'.filterMap f) out'
| .skip it' => .skip (it'.filterMap f)
| .done => .done := by
simp [step_filterMap]
cases it.step using PlausibleIterStep.casesOn
· simp only
split <;> simp_all
· simp
· simp
@@ -232,7 +249,7 @@ theorem Iter.step_map {f : β → γ} :
.done (.done h) := by
simp only [map_eq_toIter_map_toIterM, step, toIterM_toIter, IterM.step_map, Id.run_bind]
generalize it.toIterM.step.run = step
cases step using PlausibleIterStep.casesOn <;> simp
cases step.inflate using PlausibleIterStep.casesOn <;> simp
def Iter.step_filter {f : β Bool} :
(it.filter f).step = match it.step with
@@ -247,7 +264,26 @@ def Iter.step_filter {f : β → Bool} :
.done (.done h) := by
simp only [filter_eq_toIter_filter_toIterM, step, toIterM_toIter, IterM.step_filter, Id.run_bind]
generalize it.toIterM.step.run = step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· simp only
split <;> simp [*]
· simp
· simp
def Iter.val_step_filter {f : β Bool} :
(it.filter f).step.val = match it.step.val with
| .yield it' out =>
if f out = true then
.yield (it'.filter f) out
else
.skip (it'.filter f)
| .skip it' =>
.skip (it'.filter f)
| .done =>
.done := by
simp only [filter_eq_toIter_filter_toIterM, step, toIterM_toIter, IterM.step_filter, Id.run_bind]
generalize it.toIterM.step.run = step
cases step.inflate using PlausibleIterStep.casesOn
· simp only
split <;> simp [*]
· simp
@@ -431,4 +467,317 @@ theorem Iter.fold_map {α β γ : Type w} {δ : Type x}
end Fold
theorem Iter.anyM_filterMapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m (Option β')} {p : β' m (ULift Bool)} :
(it.filterMapM f).anyM p = (it.mapM (pure (f := m))).anyM (fun x => do
match f x with
| some fx => p fx
| none => return .up false) := by
simp only [filterMapM_eq_toIter_filterMapM_toIterM, IterM.anyM_filterMapM]
rfl
-- There is hope to generalize the following theorem as soon there is a `Shrink` type.
/--
This lemma expresses `Iter.anyM` in terms of `IterM.anyM`.
It requires all involved types to live in `Type 0`.
-/
theorem Iter.anyM_eq_anyM_mapM_pure {α β : Type} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.anyM p = ULift.down <$> (it.mapM (α := α) (pure (f := m))).anyM (fun x => ULift.up <$> p x) := by
rw [anyM_eq_forIn, IterM.anyM_eq_forIn, map_eq_pure_bind]
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [forIn_eq_match_step, IterM.forIn_eq_match_step, bind_assoc, step_mapM]
cases it.step using PlausibleIterStep.casesOn
· simp only [bind_assoc, liftM_pure, pure_bind, map_eq_pure_bind, Shrink.inflate_deflate]
apply bind_congr; intro px
split
· simp
· simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.anyM_mapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m β'} {p : β' m (ULift Bool)} :
(it.mapM f).anyM p = (it.mapM (pure (f := m))).anyM (fun x => do p ( f x)) := by
rw [mapM_eq_toIter_mapM_toIterM, IterM.anyM_mapM, mapM_eq_toIter_mapM_toIterM]
theorem Iter.anyM_filterM {α β : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m (ULift Bool)} {p : β m (ULift Bool)} :
(it.filterM f).anyM p = (it.mapM (pure (f := m))).anyM (fun x => do
if ( f x).down then
p x
else
return .up false) := by
rw [filterM_eq_toIter_filterM_toIterM, IterM.anyM_filterM, mapM_eq_toIter_mapM_toIterM]
theorem Iter.anyM_filterMap {α β β' : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β Option β'} {p : β' m Bool} :
(it.filterMap f).anyM p = it.anyM (fun x => do
match f x with
| some fx => p fx
| none => return false) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [anyM_eq_match_step, anyM_eq_match_step, val_step_filterMap]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out
· simp [ihy _]
· apply bind_congr; intro px
split <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.anyM_map {α β β' : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β β'} {p : β' m Bool} :
(it.map f).anyM p = it.anyM (fun x => p (f x)) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [anyM_eq_match_step, anyM_eq_match_step, step_map]
cases it.step using PlausibleIterStep.casesOn
· simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.anyM_filter {α β : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m][IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β Bool} {p : β m Bool} :
(it.filter f).anyM p = it.anyM (fun x => do
if f x then
p x
else
return false) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [anyM_eq_match_step, anyM_eq_match_step, val_step_filter]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.any_filterMapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m (Option β')} {p : β' Bool} :
(it.filterMapM f).any p = (it.mapM (pure (f := m))).anyM (fun x => do
match f x with
| some fx => return .up (p fx)
| none => return .up false) := by
simp [IterM.any_eq_anyM, anyM_filterMapM]
theorem Iter.any_mapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m β'} {p : β' Bool} :
(it.mapM f).any p = (it.mapM pure).anyM (fun x => (.up <| p ·) <$> (f x)) := by
simp [IterM.any_eq_anyM, anyM_mapM]
theorem Iter.any_filterM {α β : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m (ULift Bool)} {p : β Bool} :
(it.filterM f).any p = (it.mapM (pure (f := m))).anyM (fun x => do
if ( f x).down then
return .up (p x)
else
return .up false) := by
simp [IterM.any_eq_anyM, anyM_filterM]
theorem Iter.any_filterMap {α β β' : Type w}
[Iterator α Id β] [Finite α Id][IteratorLoop α Id Id]
[LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {f : β Option β'} {p : β' Bool} :
(it.filterMap f).any p = it.any (fun x =>
match f x with
| some fx => (p fx)
| none => false) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [any_eq_match_step, any_eq_match_step, val_step_filterMap]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out
· simp [*, ihy _]
· simp only
split <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.any_map {α β β' : Type w}
[Iterator α Id β] [Finite α Id] [IteratorLoop α Id Id]
[LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {f : β β'} {p : β' Bool} :
(it.map f).any p = it.any (fun x => p (f x)) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [any_eq_match_step, any_eq_match_step, step_map]
cases it.step using PlausibleIterStep.casesOn
· simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.allM_filterMapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m (Option β')} {p : β' m (ULift Bool)} :
(it.filterMapM f).allM p = (it.mapM (pure (f := m))).allM (fun x => do
match f x with
| some fx => p fx
| none => return .up true) := by
simp only [filterMapM_eq_toIter_filterMapM_toIterM, IterM.allM_filterMapM]
rfl
/--
This lemma expresses `Iter.allM` in terms of `IterM.allM`.
It requires all involved types to live in `Type 0`.
-/
theorem Iter.allM_eq_allM_mapM_pure {α β : Type} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.allM p = ULift.down <$> (it.mapM (α := α) (pure (f := m))).allM (fun x => ULift.up <$> p x) := by
rw [allM_eq_forIn, IterM.allM_eq_forIn, map_eq_pure_bind]
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [forIn_eq_match_step, IterM.forIn_eq_match_step, bind_assoc, step_mapM]
cases it.step using PlausibleIterStep.casesOn
· simp only [bind_assoc, liftM_pure, pure_bind, map_eq_pure_bind, Shrink.inflate_deflate]
apply bind_congr; intro px
split
· simp [ihy _]
· simp
· simp [ihs _]
· simp
theorem Iter.allM_mapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m β'} {p : β' m (ULift Bool)} :
(it.mapM f).allM p = (it.mapM (pure (f := m))).allM (fun x => do p ( f x)) := by
rw [mapM_eq_toIter_mapM_toIterM, IterM.allM_mapM, mapM_eq_toIter_mapM_toIterM]
theorem Iter.allM_filterM {α β : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [LawfulMonad m]
{it : Iter (α := α) β} {f : β m (ULift Bool)} {p : β m (ULift Bool)} :
(it.filterM f).allM p = (it.mapM (pure (f := m))).allM (fun x => do
if ( f x).down then
p x
else
return .up true) := by
rw [filterM_eq_toIter_filterM_toIterM, IterM.allM_filterM, mapM_eq_toIter_mapM_toIterM]
theorem Iter.allM_filterMap {α β β' : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β Option β'} {p : β' m Bool} :
(it.filterMap f).allM p = it.allM (fun x => do
match f x with
| some fx => p fx
| none => return true) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [allM_eq_match_step, allM_eq_match_step, val_step_filterMap]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out
· simp [ihy _]
· apply bind_congr; intro px
split <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.allM_map {α β β' : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β β'} {p : β' m Bool} :
(it.map f).allM p = it.allM (fun x => p (f x)) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [allM_eq_match_step, allM_eq_match_step, step_map]
cases it.step using PlausibleIterStep.casesOn
· simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.allM_filter {α β : Type w} {m : Type Type w'}
[Iterator α Id β] [Finite α Id] [Monad m][IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β Bool} {p : β m Bool} :
(it.filter f).allM p = it.allM (fun x => do
if f x then
p x
else
return true) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [allM_eq_match_step, allM_eq_match_step, val_step_filter]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.all_filterMapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m (Option β')} {p : β' Bool} :
(it.filterMapM f).all p = (it.mapM (pure (f := m))).allM (fun x => do
match f x with
| some fx => return .up (p fx)
| none => return .up true) := by
simp [IterM.all_eq_allM, allM_filterMapM]
theorem Iter.all_mapM {α β β' : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m β'} {p : β' Bool} :
(it.mapM f).all p = (it.mapM pure).allM (fun x => (.up <| p ·) <$> (f x)) := by
simp [IterM.all_eq_allM, allM_mapM]
theorem Iter.all_filterM {α β : Type w} {m : Type w Type w'}
[Iterator α Id β] [Finite α Id] [Monad m] [IteratorLoop α Id m]
[LawfulMonad m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {f : β m (ULift Bool)} {p : β Bool} :
(it.filterM f).all p = (it.mapM (pure (f := m))).allM (fun x => do
if ( f x).down then
return .up (p x)
else
return .up true) := by
simp [IterM.all_eq_allM, allM_filterM]
theorem Iter.all_filterMap {α β β' : Type w}
[Iterator α Id β] [Finite α Id][IteratorLoop α Id Id]
[LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {f : β Option β'} {p : β' Bool} :
(it.filterMap f).all p = it.all (fun x =>
match f x with
| some fx => (p fx)
| none => true) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [all_eq_match_step, all_eq_match_step, val_step_filterMap]
cases it.step using PlausibleIterStep.casesOn
· rename_i out _
simp only
cases f out
· simp [*, ihy _]
· simp only
split <;> simp [ihy _]
· simp [ihs _]
· simp
theorem Iter.all_map {α β β' : Type w}
[Iterator α Id β] [Finite α Id] [IteratorLoop α Id Id]
[LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {f : β β'} {p : β' Bool} :
(it.map f).all p = it.all (fun x => p (f x)) := by
induction it using Iter.inductSteps with | step it ihy ihs
rw [all_eq_match_step, all_eq_match_step, step_map]
cases it.step using PlausibleIterStep.casesOn
· simp [ihy _]
· simp [ihs _]
· simp
end Std.Iterators

View File

@@ -0,0 +1,266 @@
/-
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
import Init.Data.Iterators.Lemmas.Combinators.FilterMap
public import Init.Data.Iterators.Combinators.FlatMap
import all Init.Data.Iterators.Combinators.FlatMap
public import Init.Data.Iterators.Lemmas.Combinators.Monadic.FlatMap
namespace Std.Iterators
open Std.Internal
public theorem Flatten.IsPlausibleStep.outerYield_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ it₁' : Iter (α := α) β} {it₂' b}
(h : it₁.IsPlausibleStep (.yield it₁' b)) :
(it₁.flatMapAfterM f none).IsPlausibleStep (.skip (it₁'.flatMapAfterM f (some it₂'))) := by
apply outerYield_flatMapM
exact .yieldSome h (out' := b) (by simp [PostconditionT.lift, PostconditionT.bind])
public theorem Flatten.IsPlausibleStep.outerSkip_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ it₁' : Iter (α := α) β}
(h : it₁.IsPlausibleStep (.skip it₁')) :
(it₁.flatMapAfterM f none).IsPlausibleStep (.skip (it₁'.flatMapAfterM f none)) :=
outerSkip_flatMapM (.skip h)
public theorem Flatten.IsPlausibleStep.outerDone_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β}
(h : it₁.IsPlausibleStep .done) :
(it₁.flatMapAfterM f none).IsPlausibleStep .done :=
outerDone_flatMapM (.done h)
public theorem Flatten.IsPlausibleStep.innerYield_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β} {it₂ it₂' b}
(h : it₂.IsPlausibleStep (.yield it₂' b)) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.yield (it₁.flatMapAfterM f (some it₂')) b) :=
innerYield_flatMapM h
public theorem Flatten.IsPlausibleStep.innerSkip_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β} {it₂ it₂'}
(h : it₂.IsPlausibleStep (.skip it₂')) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfterM f (some it₂'))) :=
innerSkip_flatMapM h
public theorem Flatten.IsPlausibleStep.innerDone_flatMapM_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β} {it₂}
(h : it₂.IsPlausibleStep .done) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfterM f none)) :=
innerDone_flatMapM h
public theorem Flatten.IsPlausibleStep.outerYield_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ it₁' : Iter (α := α) β} {b}
(h : it₁.IsPlausibleStep (.yield it₁' b)) :
(it₁.flatMapAfter f none).IsPlausibleStep (.skip (it₁'.flatMapAfter f (some (f b)))) :=
outerYield_flatMap h
public theorem Flatten.IsPlausibleStep.outerSkip_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ it₁' : Iter (α := α) β}
(h : it₁.IsPlausibleStep (.skip it₁')) :
(it₁.flatMapAfter f none).IsPlausibleStep (.skip (it₁'.flatMapAfter f none)) :=
outerSkip_flatMap h
public theorem Flatten.IsPlausibleStep.outerDone_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β}
(h : it₁.IsPlausibleStep .done) :
(it₁.flatMapAfter f none).IsPlausibleStep .done :=
outerDone_flatMap h
public theorem Flatten.IsPlausibleStep.innerYield_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂ it₂' b}
(h : it₂.IsPlausibleStep (.yield it₂' b)) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.yield (it₁.flatMapAfter f (some it₂')) b) :=
innerYield_flatMap h
public theorem Flatten.IsPlausibleStep.innerSkip_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂ it₂'}
(h : it₂.IsPlausibleStep (.skip it₂')) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfter f (some it₂'))) :=
innerSkip_flatMap h
public theorem Flatten.IsPlausibleStep.innerDone_flatMap_pure {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂}
(h : it₂.IsPlausibleStep .done) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfter f none)) :=
innerDone_flatMap h
public theorem Iter.step_flatMapAfterM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).step = (do
match it₂ with
| none =>
match it₁.step with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfterM f (some ( f b))) (.outerYield_flatMapM_pure h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfterM f none) (.outerSkip_flatMapM_pure h))
| .done h => return .deflate (.done (.outerDone_flatMapM_pure h))
| some it₂ =>
match ( it₂.step).inflate with
| .yield it₂' out h =>
return .deflate (.yield (it₁.flatMapAfterM f (some it₂')) out (.innerYield_flatMapM_pure h))
| .skip it₂' h =>
return .deflate (.skip (it₁.flatMapAfterM f (some it₂')) (.innerSkip_flatMapM_pure h))
| .done h =>
return .deflate (.skip (it₁.flatMapAfterM f none) (.innerDone_flatMapM_pure h))) := by
simp only [flatMapAfterM, IterM.step_flatMapAfterM, Iter.step_mapM]
split
· split <;> simp [*]
· rfl
public theorem Iter.step_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : Iter (α := α) β} :
(it₁.flatMapM f).step = (do
match it₁.step with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfterM f (some ( f b))) (.outerYield_flatMapM_pure h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfterM f none) (.outerSkip_flatMapM_pure h))
| .done h => return .deflate (.done (.outerDone_flatMapM_pure h))) := by
simp [flatMapM, step_flatMapAfterM]
public theorem Iter.step_flatMapAfter {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂ : Option (Iter (α := α₂) γ)} :
(it₁.flatMapAfter f it₂).step = (match it₂ with
| none =>
match it₁.step with
| .yield it₁' b h =>
.skip (it₁'.flatMapAfter f (some (f b))) (.outerYield_flatMap_pure h)
| .skip it₁' h => .skip (it₁'.flatMapAfter f none) (.outerSkip_flatMap_pure h)
| .done h => .done (.outerDone_flatMap_pure h)
| some it₂ =>
match it₂.step with
| .yield it₂' out h => .yield (it₁.flatMapAfter f (some it₂')) out (.innerYield_flatMap_pure h)
| .skip it₂' h => .skip (it₁.flatMapAfter f (some it₂')) (.innerSkip_flatMap_pure h)
| .done h => .skip (it₁.flatMapAfter f none) (.innerDone_flatMap_pure h)) := by
simp only [flatMapAfter, step, toIterM_toIter, IterM.step_flatMapAfter]
cases it₂
· simp only [Option.map_eq_map, Option.map_none, Id.run_bind, Option.map_some]
cases it₁.toIterM.step.run.inflate using PlausibleIterStep.casesOn <;> simp
· rename_i it₂
simp only [Option.map_eq_map, Option.map_some, Id.run_bind, Option.map_none]
cases it₂.toIterM.step.run.inflate using PlausibleIterStep.casesOn <;> simp
public theorem Iter.step_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} :
(it₁.flatMap f).step = (match it₁.step with
| .yield it₁' b h =>
.skip (it₁'.flatMapAfter f (some (f b))) (.outerYield_flatMap_pure h)
| .skip it₁' h => .skip (it₁'.flatMapAfter f none) (.outerSkip_flatMap_pure h)
| .done h => .done (.outerDone_flatMap_pure h)) := by
simp [flatMap, step_flatMapAfter]
public theorem Iter.toList_flatMapAfterM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ] [Finite α Id] [Finite α₂ m]
[IteratorCollect α Id m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α Id m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : Iter (α := α) β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).toList = do
match it₂ with
| none => List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList
| some it₂ => return ( it₂.toList) ++
( List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList) := by
simp only [flatMapAfterM, IterM.toList_flatMapAfterM]
split
· simp only [mapM, IterM.toList_mapM_mapM, monadLift_self]
congr <;> simp
· apply bind_congr; intro step
simp only [mapM, IterM.toList_mapM_mapM, monadLift_self, bind_pure_comp, Functor.map_map]
congr <;> simp
public theorem Iter.toArray_flatMapAfterM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ] [Finite α Id] [Finite α₂ m]
[IteratorCollect α Id m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α Id m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : Iter (α := α) β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).toArray = do
match it₂ with
| none => Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray
| some it₂ => return ( it₂.toArray) ++
( Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray) := by
simp only [flatMapAfterM, IterM.toArray_flatMapAfterM]
split
· simp only [mapM, IterM.toArray_mapM_mapM, monadLift_self]
congr <;> simp
· apply bind_congr; intro step
simp only [mapM, IterM.toArray_mapM_mapM, monadLift_self, bind_pure_comp, Functor.map_map]
congr <;> simp
public theorem Iter.toList_flatMapM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ] [Finite α Id] [Finite α₂ m]
[IteratorCollect α Id m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α Id m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : Iter (α := α) β} :
(it₁.flatMapM f).toList = List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList := by
simp [flatMapM, toList_flatMapAfterM]
public theorem Iter.toArray_flatMapM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α Id β] [Iterator α₂ m γ] [Finite α Id] [Finite α₂ m]
[IteratorCollect α Id m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α Id m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : Iter (α := α) β} :
(it₁.flatMapM f).toArray = Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray := by
simp [flatMapM, toArray_flatMapAfterM]
public theorem Iter.toList_flatMapAfter {α α₂ β γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
[Finite α Id] [Finite α₂ Id] [IteratorCollect α Id Id] [IteratorCollect α₂ Id Id]
[LawfulIteratorCollect α Id Id] [LawfulIteratorCollect α₂ Id Id]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂ : Option (Iter (α := α₂) γ)} :
(it₁.flatMapAfter f it₂).toList = match it₂ with
| none => (it₁.map fun b => (f b).toList).toList.flatten
| some it₂ => it₂.toList ++
(it₁.map fun b => (f b).toList).toList.flatten := by
simp only [flatMapAfter, Iter.toList, toIterM_toIter, IterM.toList_flatMapAfter]
cases it₂ <;> simp [map, IterM.toList_map_eq_toList_mapM]
public theorem Iter.toArray_flatMapAfter {α α₂ β γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
[Finite α Id] [Finite α₂ Id] [IteratorCollect α Id Id] [IteratorCollect α₂ Id Id]
[LawfulIteratorCollect α Id Id] [LawfulIteratorCollect α₂ Id Id]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} {it₂ : Option (Iter (α := α₂) γ)} :
(it₁.flatMapAfter f it₂).toArray = match it₂ with
| none => (it₁.map fun b => (f b).toArray).toArray.flatten
| some it₂ => it₂.toArray ++
(it₁.map fun b => (f b).toArray).toArray.flatten := by
simp only [flatMapAfter, Iter.toArray, toIterM_toIter, IterM.toArray_flatMapAfter]
cases it₂ <;> simp [map, IterM.toArray_map_eq_toArray_mapM]
public theorem Iter.toList_flatMap {α α₂ β γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
[Finite α Id] [Finite α₂ Id]
[Iterator α Id β] [Iterator α₂ Id γ] [Finite α Id] [Finite α₂ Id]
[IteratorCollect α Id Id] [IteratorCollect α₂ Id Id]
[LawfulIteratorCollect α Id Id] [LawfulIteratorCollect α₂ Id Id]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} :
(it₁.flatMap f).toList = (it₁.map fun b => (f b).toList).toList.flatten := by
simp [flatMap, toList_flatMapAfter]
public theorem Iter.toArray_flatMap {α α₂ β γ : Type w} [Iterator α Id β] [Iterator α₂ Id γ]
[Finite α Id] [Finite α₂ Id]
[Iterator α Id β] [Iterator α₂ Id γ] [Finite α Id] [Finite α₂ Id]
[IteratorCollect α Id Id] [IteratorCollect α₂ Id Id]
[LawfulIteratorCollect α Id Id] [LawfulIteratorCollect α₂ Id Id]
{f : β Iter (α := α₂) γ} {it₁ : Iter (α := α) β} :
(it₁.flatMap f).toArray = (it₁.map fun b => (f b).toArray).toArray.flatten := by
simp [flatMap, toArray_flatMapAfter]
end Std.Iterators

View File

@@ -8,4 +8,5 @@ module
prelude
public import Init.Data.Iterators.Lemmas.Combinators.Monadic.Attach
public import Init.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
public import Init.Data.Iterators.Lemmas.Combinators.Monadic.FlatMap
public import Init.Data.Iterators.Lemmas.Combinators.Monadic.ULift

View File

@@ -18,7 +18,7 @@ variable {α : Type w} {m : Type w → Type w'} {β : Type w} {P : β → Prop}
theorem IterM.step_attachWith [Iterator α m β] [Monad m] {it : IterM (α := α) m β} {hP} :
(it.attachWith P hP).step =
(fun s => Types.Attach.Monadic.modifyStep (it.attachWith P hP) s, s, rfl) <$> it.step :=
(fun s => .deflate Types.Attach.Monadic.modifyStep (it.attachWith P hP) s.inflate, s.inflate, rfl) <$> it.step :=
rfl
@[simp]
@@ -32,7 +32,7 @@ theorem IterM.map_unattach_toList_attachWith [Iterator α m β] [Monad m]
simp only [bind_pure_comp, bind_map_left, map_bind]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· rename_i it' out hp
simp only [IterM.attachWith] at ihy
simp [Types.Attach.Monadic.modifyStep,

View File

@@ -0,0 +1,344 @@
/-
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
import Init.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
public import Init.Data.Iterators.Combinators.Monadic.FlatMap
import all Init.Data.Iterators.Combinators.Monadic.FlatMap
namespace Std.Iterators
open Std.Internal
theorem IterM.step_flattenAfter {α α₂ β : Type w} {m : Type w Type w'} [Monad m]
[Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β]
{it₁ : IterM (α := α) m (IterM (α := α₂) m β)} {it₂ : Option (IterM (α := α₂) m β)} :
(it₁.flattenAfter it₂).step = (do
match it₂ with
| none =>
match ( it₁.step).inflate with
| .yield it₁' it₂' h => return .deflate (.skip (it₁'.flattenAfter (some it₂')) (.outerYield h))
| .skip it₁' h => return .deflate (.skip (it₁'.flattenAfter none) (.outerSkip h))
| .done h => return .deflate (.done (.outerDone h))
| some it₂ =>
match ( it₂.step).inflate with
| .yield it₂' out h => return .deflate (.yield (it₁.flattenAfter (some it₂')) out (.innerYield h))
| .skip it₂' h => return .deflate (.skip (it₁.flattenAfter (some it₂')) (.innerSkip h))
| .done h => return .deflate (.skip (it₁.flattenAfter none) (.innerDone h))) := by
cases it₂
all_goals
· apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn <;> simp [IterM.flattenAfter, toIterM]
public theorem Flatten.IsPlausibleStep.outerYield_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ it₁' : IterM (α := α) m β} {it₂' b}
(h : it₁.IsPlausibleStep (.yield it₁' b)) :
(it₁.flatMapAfterM f none).IsPlausibleStep (.skip (it₁'.flatMapAfterM f (some it₂'))) :=
.outerYield (.yieldSome h _, trivial, rfl)
public theorem Flatten.IsPlausibleStep.outerSkip_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ it₁' : IterM (α := α) m β}
(h : it₁.IsPlausibleStep (.skip it₁')) :
(it₁.flatMapAfterM f none).IsPlausibleStep (.skip (it₁'.flatMapAfterM f none)) :=
.outerSkip (.skip h)
public theorem Flatten.IsPlausibleStep.outerDone_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β}
(h : it₁.IsPlausibleStep .done) :
(it₁.flatMapAfterM f none).IsPlausibleStep .done :=
.outerDone (.done h)
public theorem Flatten.IsPlausibleStep.innerYield_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β} {it₂ it₂' b}
(h : it₂.IsPlausibleStep (.yield it₂' b)) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.yield (it₁.flatMapAfterM f (some it₂')) b) :=
.innerYield h
public theorem Flatten.IsPlausibleStep.innerSkip_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β} {it₂ it₂'}
(h : it₂.IsPlausibleStep (.skip it₂')) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfterM f (some it₂'))) :=
.innerSkip h
public theorem Flatten.IsPlausibleStep.innerDone_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β} {it₂}
(h : it₂.IsPlausibleStep .done) :
(it₁.flatMapAfterM f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfterM f none)) :=
.innerDone h
public theorem Flatten.IsPlausibleStep.outerYield_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ it₁' : IterM (α := α) m β} {b}
(h : it₁.IsPlausibleStep (.yield it₁' b)) :
(it₁.flatMapAfter f none).IsPlausibleStep (.skip (it₁'.flatMapAfter f (some (f b)))) :=
.outerYield (.yieldSome h _, rfl, rfl)
public theorem Flatten.IsPlausibleStep.outerSkip_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ it₁' : IterM (α := α) m β}
(h : it₁.IsPlausibleStep (.skip it₁')) :
(it₁.flatMapAfter f none).IsPlausibleStep (.skip (it₁'.flatMapAfter f none)) :=
.outerSkip (.skip h)
public theorem Flatten.IsPlausibleStep.outerDone_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β}
(h : it₁.IsPlausibleStep .done) :
(it₁.flatMapAfter f none).IsPlausibleStep .done :=
.outerDone (.done h)
public theorem Flatten.IsPlausibleStep.innerYield_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β} {it₂ it₂' b}
(h : it₂.IsPlausibleStep (.yield it₂' b)) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.yield (it₁.flatMapAfter f (some it₂')) b) :=
.innerYield h
public theorem Flatten.IsPlausibleStep.innerSkip_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β} {it₂ it₂'}
(h : it₂.IsPlausibleStep (.skip it₂')) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfter f (some it₂'))) :=
.innerSkip h
public theorem Flatten.IsPlausibleStep.innerDone_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β} {it₂}
(h : it₂.IsPlausibleStep .done) :
(it₁.flatMapAfter f (some it₂)).IsPlausibleStep (.skip (it₁.flatMapAfter f none)) :=
.innerDone h
public theorem IterM.step_flatMapAfterM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).step = (do
match it₂ with
| none =>
match ( it₁.step).inflate with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfterM f (some ( f b))) (.outerYield_flatMapM h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfterM f none) (.outerSkip_flatMapM h))
| .done h => return .deflate (.done (.outerDone_flatMapM h))
| some it₂ =>
match ( it₂.step).inflate with
| .yield it₂' out h => return .deflate (.yield (it₁.flatMapAfterM f (some it₂')) out (.innerYield_flatMapM h))
| .skip it₂' h => return .deflate (.skip (it₁.flatMapAfterM f (some it₂')) (.innerSkip_flatMapM h))
| .done h => return .deflate (.skip (it₁.flatMapAfterM f none) (.innerDone_flatMapM h))) := by
simp only [flatMapAfterM, step_flattenAfter, IterM.step_mapM]
split
· simp only [bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn <;> simp
· rfl
public theorem IterM.step_flatMapM {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β m (IterM (α := α₂) m γ)} {it₁ : IterM (α := α) m β} :
(it₁.flatMapM f).step = (do
match ( it₁.step).inflate with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfterM f (some ( f b)))
(.outerYield_flatMapM h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfterM f none) (.outerSkip_flatMapM h))
| .done h => return .deflate (.done (.outerDone_flatMapM h))) := by
simp [flatMapM, step_flatMapAfterM]
public theorem IterM.step_flatMapAfter {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfter f it₂).step = (do
match it₂ with
| none =>
match ( it₁.step).inflate with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfter f (some (f b))) (.outerYield_flatMap h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfter f none) (.outerSkip_flatMap h))
| .done h => return .deflate (.done (.outerDone_flatMap h))
| some it₂ =>
match ( it₂.step).inflate with
| .yield it₂' out h => return .deflate (.yield (it₁.flatMapAfter f (some it₂')) out (.innerYield_flatMap h))
| .skip it₂' h => return .deflate (.skip (it₁.flatMapAfter f (some it₂')) (.innerSkip_flatMap h))
| .done h => return .deflate (.skip (it₁.flatMapAfter f none) (.innerDone_flatMap h))) := by
simp only [flatMapAfter, step_flattenAfter, IterM.step_map]
split
· simp only [bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn <;> simp
· rfl
public theorem IterM.step_flatMap {α : Type w} {β : Type w} {α₂ : Type w}
{γ : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ]
{f : β IterM (α := α₂) m γ} {it₁ : IterM (α := α) m β} :
(it₁.flatMap f).step = (do
match ( it₁.step).inflate with
| .yield it₁' b h =>
return .deflate (.skip (it₁'.flatMapAfter f (some (f b))) (.outerYield_flatMap h))
| .skip it₁' h => return .deflate (.skip (it₁'.flatMapAfter f none) (.outerSkip_flatMap h))
| .done h => return .deflate (.done (.outerDone_flatMap h))) := by
simp [flatMap, step_flatMapAfter]
theorem IterM.toList_flattenAfter {α α₂ β : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m]
[Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{it₁ : IterM (α := α) m (IterM (α := α₂) m β)} {it₂ : Option (IterM (α := α₂) m β)} :
(it₁.flattenAfter it₂).toList = do
match it₂ with
| none => List.flatten <$> (it₁.mapM fun it₂ => it₂.toList).toList
| some it₂ => return ( it₂.toList) ++ ( List.flatten <$> (it₁.mapM fun it₂ => it₂.toList).toList) := by
induction it₁ using IterM.inductSteps generalizing it₂ with | step it₁ ihy₁ ihs₁ =>
have hn : (it₁.flattenAfter none).toList =
List.flatten <$> (it₁.mapM fun it₂ => it₂.toList).toList := by
rw [toList_eq_match_step, toList_eq_match_step, step_flattenAfter, step_mapM]
simp only [bind_assoc, map_eq_pure_bind]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp [ihy₁ _]
· simp [ihs₁ _]
· simp
cases it₂
· exact hn
· rename_i ih₂
induction ih₂ using IterM.inductSteps with | step it₂ ihy₂ ihs₂ =>
rw [toList_eq_match_step, step_flattenAfter, bind_assoc]
simp only
rw [toList_eq_match_step, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp [ihy₂ _]
· simp [ihs₂ _]
· simp [hn]
theorem IterM.toArray_flattenAfter {α α₂ β : Type w} {m : Type w Type w'} [Monad m] [LawfulMonad m]
[Iterator α m (IterM (α := α₂) m β)] [Iterator α₂ m β] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{it₁ : IterM (α := α) m (IterM (α := α₂) m β)} {it₂ : Option (IterM (α := α₂) m β)} :
(it₁.flattenAfter it₂).toArray = do
match it₂ with
| none => Array.flatten <$> (it₁.mapM fun it₂ => it₂.toArray).toArray
| some it₂ => return ( it₂.toArray) ++ ( Array.flatten <$> (it₁.mapM fun it₂ => it₂.toArray).toArray) := by
induction it₁ using IterM.inductSteps generalizing it₂ with | step it₁ ihy₁ ihs₁ =>
have hn : (it₁.flattenAfter none).toArray =
Array.flatten <$> (it₁.mapM fun it₂ => it₂.toArray).toArray := by
rw [toArray_eq_match_step, toArray_eq_match_step, step_flattenAfter, step_mapM]
simp only [bind_assoc, map_eq_pure_bind]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp [ihy₁ _]
· simp [ihs₁ _]
· simp
cases it₂
· exact hn
· rename_i ih₂
induction ih₂ using IterM.inductSteps with | step it₂ ihy₂ ihs₂ =>
rw [toArray_eq_match_step, step_flattenAfter, bind_assoc]
simp only
rw [toArray_eq_match_step, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp [ihy₂ _]
· simp [ihs₂ _]
· simp [hn]
public theorem IterM.toList_flatMapAfterM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).toList = do
match it₂ with
| none => List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList
| some it₂ => return ( it₂.toList) ++
( List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList) := by
simp [flatMapAfterM, toList_flattenAfter]; rfl
public theorem IterM.toArray_flatMapAfterM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfterM f it₂).toArray = do
match it₂ with
| none => Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray
| some it₂ => return ( it₂.toArray) ++
( Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray) := by
simp [flatMapAfterM, toArray_flattenAfter]; rfl
public theorem IterM.toList_flatMapM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : IterM (α := α) m β} :
(it₁.flatMapM f).toList = List.flatten <$> (it₁.mapM fun b => do ( f b).toList).toList := by
simp [flatMapM, toList_flatMapAfterM]
public theorem IterM.toArray_flatMapM {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β m (IterM (α := α₂) m γ)}
{it₁ : IterM (α := α) m β} :
(it₁.flatMapM f).toArray = Array.flatten <$> (it₁.mapM fun b => do ( f b).toArray).toArray := by
simp [flatMapM, toArray_flatMapAfterM]
public theorem IterM.toList_flatMapAfter {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β IterM (α := α₂) m γ}
{it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfter f it₂).toList = do
match it₂ with
| none => List.flatten <$> (it₁.mapM fun b => (f b).toList).toList
| some it₂ => return ( it₂.toList) ++
( List.flatten <$> (it₁.mapM fun b => (f b).toList).toList) := by
simp [flatMapAfter, toList_flattenAfter]; rfl
public theorem IterM.toArray_flatMapAfter {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β IterM (α := α₂) m γ}
{it₁ : IterM (α := α) m β} {it₂ : Option (IterM (α := α₂) m γ)} :
(it₁.flatMapAfter f it₂).toArray = do
match it₂ with
| none => Array.flatten <$> (it₁.mapM fun b => (f b).toArray).toArray
| some it₂ => return ( it₂.toArray) ++
( Array.flatten <$> (it₁.mapM fun b => (f b).toArray).toArray) := by
simp [flatMapAfter, toArray_flattenAfter]; rfl
public theorem IterM.toList_flatMap {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β IterM (α := α₂) m γ}
{it₁ : IterM (α := α) m β} :
(it₁.flatMap f).toList = List.flatten <$> (it₁.mapM fun b => (f b).toList).toList := by
simp [flatMap, toList_flatMapAfter]
public theorem IterM.toArray_flatMap {α α₂ β γ : Type w} {m : Type w Type w'} [Monad m]
[LawfulMonad m] [Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[Iterator α m β] [Iterator α₂ m γ] [Finite α m] [Finite α₂ m]
[IteratorCollect α m m] [IteratorCollect α₂ m m]
[LawfulIteratorCollect α m m] [LawfulIteratorCollect α₂ m m]
{f : β IterM (α := α₂) m γ}
{it₁ : IterM (α := α) m β} :
(it₁.flatMap f).toArray = Array.flatten <$> (it₁.mapM fun b => (f b).toArray).toArray := by
simp [flatMap, toArray_flatMapAfter]
end Std.Iterators

View File

@@ -21,7 +21,7 @@ theorem IterM.step_uLift [Iterator α m β] [Monad n] {it : IterM (α := α) m
[MonadLiftT m (ULiftT n)] :
(it.uLift n).step = (do
let step := ( (monadLift it.step : ULiftT n _).run).down
return Types.ULiftIterator.Monadic.modifyStep step.val, step.val, step.property, rfl) :=
return .deflate Types.ULiftIterator.Monadic.modifyStep step.inflate.val, step.inflate.val, step.inflate.property, rfl) :=
rfl
@[simp]
@@ -37,7 +37,7 @@ theorem IterM.toList_uLift [Iterator α m β] [Monad m] [Monad n] {it : IterM (
apply bind_congr
intro step
simp [Types.ULiftIterator.Monadic.modifyStep]
cases step.down using PlausibleIterStep.casesOn
cases step.down.inflate using PlausibleIterStep.casesOn
· simp only [uLift] at ihy
simp [ihy _]
· exact ihs _

View File

@@ -77,7 +77,7 @@ theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [I
simp only [Iter.toArray_eq_toArray_toIterM, Iter.step]
rw [IterM.toArray_eq_match_step, Id.run_bind]
generalize it.toIterM.step.run = step
cases step using PlausibleIterStep.casesOn <;> simp
cases step.inflate using PlausibleIterStep.casesOn <;> simp
theorem Iter.toList_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
[LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
@@ -95,7 +95,7 @@ theorem Iter.toListRev_eq_match_step {α β} [Iterator α Id β] [Finite α Id]
| .done => [] := by
rw [Iter.toListRev_eq_toListRev_toIterM, IterM.toListRev_eq_match_step, Iter.step, Id.run_bind]
generalize it.toIterM.step.run = step
cases step using PlausibleIterStep.casesOn <;> simp
cases step.inflate using PlausibleIterStep.casesOn <;> simp
theorem Iter.getElem?_toList_eq_atIdxSlow? {α β}
[Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]

View File

@@ -112,7 +112,7 @@ theorem Iter.forIn'_eq_match_step {α β : Type w} [Iterator α Id β]
simp only [forIn'_eq]
rw [IterM.DefaultConsumers.forIn'_eq_match_step]
simp only [bind_map_left, Iter.step]
cases it.toIterM.step.run using PlausibleIterStep.casesOn
cases it.toIterM.step.run.inflate using PlausibleIterStep.casesOn
· simp only [IterM.Step.toPure_yield, PlausibleIterStep.yield, toIter_toIterM, toIterM_toIter]
apply bind_congr
intro forInStep
@@ -497,4 +497,236 @@ theorem Iter.length_toListRev_eq_size {α β : Type w} [Iterator α Id β] [Fini
it.toListRev.length = it.size := by
rw [toListRev_eq, List.length_reverse, length_toList_eq_size]
theorem Iter.anyM_eq_forIn {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.anyM p = (ForIn.forIn it false (fun x _ => do
if p x then
return .done true
else
return .yield false)) := by
rfl
theorem Iter.anyM_eq_match_step {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.anyM p = (do
match it.step.val with
| .yield it' x =>
if ( p x) then
return true
else
it'.anyM p
| .skip it' => it'.anyM p
| .done => return false) := by
rw [anyM_eq_forIn, forIn_eq_match_step]
simp only [bind_assoc]
cases it.step using PlausibleIterStep.casesOn
· apply bind_congr; intro px
split
· simp
· simp [anyM_eq_forIn]
· simp [anyM_eq_forIn]
· simp
theorem Iter.anyM_toList {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β m Bool} :
it.toList.anyM p = it.anyM p := by
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [it.toList_eq_match_step, anyM_eq_match_step]
cases it.step using PlausibleIterStep.casesOn
· simp only [List.anyM_cons, ihy _]
· simp only [ihs _]
· simp only [List.anyM_nil]
theorem Iter.anyM_toArray {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β m Bool} :
it.toArray.anyM p = it.anyM p := by
simp only [ Iter.toArray_toList, List.anyM_toArray, anyM_toList]
theorem Iter.any_eq_anyM {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.any p = (it.anyM (fun x => pure (f := Id) (p x))).run := by
rfl
theorem Iter.anyM_pure {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.anyM (fun x => pure (f := Id) (p x)) = pure (it.any (fun x => p x)) := by
simp [any_eq_anyM]
theorem Iter.any_eq_match_step {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.any p = (match it.step.val with
| .yield it' x =>
if p x then
true
else
it'.any p
| .skip it' => it'.any p
| .done => false) := by
rw [any_eq_anyM, anyM_eq_match_step]
split
· simp only [pure_bind, Bool.if_true_left, Bool.decide_eq_true, any_eq_anyM]
split <;> simp [*]
· simp [any_eq_anyM]
· simp
theorem Iter.any_eq_forIn {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.any p = (ForIn.forIn (m := Id) it false (fun x _ => do
if p x then
return .done true
else
return .yield false)).run := by
simp [any_eq_anyM, anyM_eq_forIn]
theorem Iter.any_toList {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.toList.any p = it.any p := by
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [it.toList_eq_match_step, any_eq_match_step]
cases it.step using PlausibleIterStep.casesOn
· simp only [List.any_cons, ihy _]
split <;> simp [*]
· simp only [ihs _]
· simp only [List.any_nil]
theorem Iter.any_toArray {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.toArray.any p = it.any p := by
simp only [ Iter.toArray_toList, List.any_toArray, any_toList]
theorem Iter.allM_eq_forIn {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.allM p = (ForIn.forIn it true (fun x _ => do
if p x then
return .yield true
else
return .done false)) := by
rfl
theorem Iter.allM_eq_match_step {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.allM p = (do
match it.step.val with
| .yield it' x =>
if ( p x) then
it'.allM p
else
return false
| .skip it' => it'.allM p
| .done => return true) := by
rw [allM_eq_forIn, forIn_eq_match_step]
simp only [bind_assoc]
cases it.step using PlausibleIterStep.casesOn
· apply bind_congr; intro px
split
· simp [allM_eq_forIn]
· simp
· simp [allM_eq_forIn]
· simp
theorem Iter.all_eq_allM {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.all p = (it.allM (fun x => pure (f := Id) (p x))).run := by
rfl
theorem Iter.allM_pure {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.allM (fun x => pure (f := Id) (p x)) = pure (it.all (fun x => p x)) := by
simp [all_eq_allM]
theorem Iter.all_eq_match_step {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.all p = (match it.step.val with
| .yield it' x =>
if p x then
it'.all p
else
false
| .skip it' => it'.all p
| .done => true) := by
rw [all_eq_allM, allM_eq_match_step]
split
· simp only [pure_bind, all_eq_allM, Bool.if_false_right, Bool.decide_eq_true]
split <;> simp [*]
· simp [all_eq_allM]
· simp
theorem Iter.all_eq_forIn {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.all p = (ForIn.forIn (m := Id) it true (fun x _ => do
if p x then
return .yield true
else
return .done false)).run := by
simp [all_eq_allM, allM_eq_forIn]
theorem Iter.all_toList {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.toList.all p = it.all p := by
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [it.toList_eq_match_step, all_eq_match_step]
cases it.step using PlausibleIterStep.casesOn
· simp only [List.all_cons, ihy _]
split <;> simp [*]
· simp only [ihs _]
· simp only [List.all_nil]
theorem Iter.all_toArray {α β : Type w} [Iterator α Id β]
[Finite α Id] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
[IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.toArray.all p = it.all p := by
simp only [ Iter.toArray_toList, List.all_toArray, all_toList]
theorem Iter.allM_eq_not_anyM_not {α β : Type w} {m : Type Type w'} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
{it : Iter (α := α) β} {p : β m Bool} :
it.allM p = (! ·) <$> it.anyM ((! ·) <$> p ·) := by
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [allM_eq_match_step, anyM_eq_match_step, map_eq_pure_bind]
cases it.step using PlausibleIterStep.casesOn
· simp only [map_eq_pure_bind, bind_assoc, pure_bind]
apply bind_congr; intro px
split
· simp [*, ihy _]
· simp [*]
· simp [ihs _]
· simp
theorem Iter.all_eq_not_any_not {α β : Type w} [Iterator α Id β]
[Finite α Id] [Monad m] [LawfulMonad m] [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
{it : Iter (α := α) β} {p : β Bool} :
it.all p = ! it.any (! p ·) := by
induction it using Iter.inductSteps with | step it ihy ihs =>
rw [all_eq_match_step, any_eq_match_step]
cases it.step using PlausibleIterStep.casesOn
· simp only
split
· simp [*, ihy _]
· simp [*]
· simp [ihs _]
· simp
end Std.Iterators

View File

@@ -46,7 +46,7 @@ theorem IterM.DefaultConsumers.toArrayMapped.go.aux₂ [Monad n] [LawfulMonad n]
theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad n] [LawfulMonad n]
[Iterator α m β] [Finite α m] :
IterM.DefaultConsumers.toArrayMapped lift f it (m := m) = letI : MonadLift m n := lift (δ := _); (do
match ( it.step).val with
match ( it.step).inflate.val with
| .yield it' out =>
return #[ f out] ++ ( IterM.DefaultConsumers.toArrayMapped lift f it' (m := m))
| .skip it' => IterM.DefaultConsumers.toArrayMapped lift f it' (m := m)
@@ -54,12 +54,13 @@ theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad n] [LawfulMona
rw [IterM.DefaultConsumers.toArrayMapped, IterM.DefaultConsumers.toArrayMapped.go]
apply bind_congr
intro step
split <;> simp [IterM.DefaultConsumers.toArrayMapped.go.aux₂]
cases step.inflate using PlausibleIterStep.casesOn <;>
simp [IterM.DefaultConsumers.toArrayMapped.go.aux₂]
theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
[IteratorCollect α m m] [LawfulIteratorCollect α m m] :
it.toArray = (do
match ( it.step).val with
match ( it.step).inflate.val with
| .yield it' out => return #[out] ++ ( it'.toArray)
| .skip it' => it'.toArray
| .done => return #[]) := by
@@ -82,7 +83,7 @@ theorem IterM.toArray_toList [Monad m] [LawfulMonad m] [Iterator α m β] [Finit
theorem IterM.toList_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
[IteratorCollect α m m] [LawfulIteratorCollect α m m] {it : IterM (α := α) m β} :
it.toList = (do
match ( it.step).val with
match ( it.step).inflate.val with
| .yield it' out => return out :: ( it'.toList)
| .skip it' => it'.toList
| .done => return []) := by
@@ -114,7 +115,7 @@ theorem IterM.toListRev.go.aux₂ [Monad m] [LawfulMonad m] [Iterator α m β] [
theorem IterM.toListRev_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
{it : IterM (α := α) m β} :
it.toListRev = (do
match ( it.step).val with
match ( it.step).inflate.val with
| .yield it' out => return ( it'.toListRev) ++ [out]
| .skip it' => it'.toListRev
| .done => return []) := by
@@ -122,7 +123,7 @@ theorem IterM.toListRev_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m
rw [toListRev.go]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn <;> simp [IterM.toListRev.go.aux₂]
cases step.inflate using PlausibleIterStep.casesOn <;> simp [IterM.toListRev.go.aux₂]
theorem IterM.reverse_toListRev [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
[IteratorCollect α m m] [LawfulIteratorCollect α m m]
@@ -134,7 +135,7 @@ theorem IterM.reverse_toListRev [Monad m] [LawfulMonad m] [Iterator α m β] [Fi
rw [toListRev_eq_match_step, toList_eq_match_step, map_eq_pure_bind, bind_assoc]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn <;> simp (discharger := assumption) [ihy, ihs]
cases step.inflate using PlausibleIterStep.casesOn <;> simp (discharger := assumption) [ihy, ihs]
theorem IterM.toListRev_eq [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
[IteratorCollect α m m] [LawfulIteratorCollect α m m]

View File

@@ -23,7 +23,8 @@ theorem IterM.DefaultConsumers.forIn'_eq_match_step {α β : Type w} {m : Type w
{it : IterM (α := α) m β} {init : γ}
{P hP} {f : (b : β) P b (c : γ) n (Subtype (plausible_forInStep b c))} :
IterM.DefaultConsumers.forIn' lift γ plausible_forInStep wf it init P hP f =
(lift _ _ · it.step) (fun
(lift _ _ · it.step) (fun s =>
match s.inflate with
| .yield it' out h => do
match f out (hP _ <| .direct _, h) init with
| .yield c, _ =>
@@ -36,7 +37,7 @@ theorem IterM.DefaultConsumers.forIn'_eq_match_step {α β : Type w} {m : Type w
| .done _ => return init) := by
rw [forIn']
congr; ext step
cases step using PlausibleIterStep.casesOn <;> rfl
cases step.inflate using PlausibleIterStep.casesOn <;> rfl
theorem IterM.forIn'_eq {α β : Type w} {m : Type w Type w'} [Iterator α m β] [Finite α m]
{n : Type w Type w''} [Monad m] [Monad n] [LawfulMonad n] [IteratorLoop α m n]
@@ -95,7 +96,7 @@ theorem IterM.forIn'_eq_match_step {α β : Type w} {m : Type w → Type w'} [It
{f : (out : β) _ γ n (ForInStep γ)} :
letI : ForIn' n (IterM (α := α) m β) β _ := IterM.instForIn'
ForIn'.forIn' it init f = (do
match it.step with
match ( it.step).inflate with
| .yield it' out h =>
match f out (.direct _, h) init with
| .yield c =>
@@ -109,7 +110,7 @@ theorem IterM.forIn'_eq_match_step {α β : Type w} {m : Type w → Type w'} [It
rw [IterM.forIn'_eq, DefaultConsumers.forIn'_eq_match_step]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· simp only [map_eq_pure_bind, bind_assoc]
apply bind_congr
intro forInStep
@@ -129,7 +130,7 @@ theorem IterM.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'} [Ite
[MonadLiftT m n] [LawfulMonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
{f : β γ n (ForInStep γ)} :
ForIn.forIn it init f = (do
match it.step with
match ( it.step).inflate with
| .yield it' out _ =>
match f out init with
| .yield c => ForIn.forIn it' c f
@@ -153,7 +154,7 @@ theorem IterM.forM_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iter
[MonadLiftT m n] [LawfulMonadLiftT m n] {it : IterM (α := α) m β}
{f : β n PUnit} :
ForM.forM it f = (do
match it.step with
match ( it.step).inflate with
| .yield it' out _ =>
f out
ForM.forM it' f
@@ -162,7 +163,7 @@ theorem IterM.forM_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iter
rw [forM_eq_forIn, forIn_eq_match_step]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn <;> simp [forM_eq_forIn]
cases step.inflate using PlausibleIterStep.casesOn <;> simp [forM_eq_forIn]
theorem IterM.foldM_eq_forIn {α β γ : Type w} {m : Type w Type w'} [Iterator α m β] [Finite α m]
{n : Type w Type w''} [Monad n] [IteratorLoop α m n] [MonadLiftT m n] {f : γ β n γ}
@@ -183,14 +184,14 @@ theorem IterM.foldM_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [
[LawfulIteratorLoop α m n] [MonadLiftT m n] [LawfulMonadLiftT m n]
{f : γ β n γ} {init : γ} {it : IterM (α := α) m β} :
it.foldM (init := init) f = (do
match it.step with
match ( it.step).inflate with
| .yield it' out _ => it'.foldM (init := f init out) f
| .skip it' _ => it'.foldM (init := init) f
| .done _ => return init) := by
rw [IterM.foldM_eq_forIn, IterM.forIn_eq_match_step]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
cases step.inflate using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
theorem IterM.fold_eq_forIn {α β γ : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m]
@@ -218,7 +219,7 @@ theorem IterM.fold_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [I
[Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{f : γ β γ} {init : γ} {it : IterM (α := α) m β} :
it.fold (init := init) f = (do
match it.step with
match ( it.step).inflate with
| .yield it' out _ => it'.fold (init := f init out) f
| .skip it' _ => it'.fold (init := init) f
| .done _ => return init) := by
@@ -226,7 +227,7 @@ theorem IterM.fold_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [I
simp only [fold_eq_foldM]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn <;> simp
cases step.inflate using PlausibleIterStep.casesOn <;> simp
-- The argument `f : γ₁ → γ₂` is intentionally explicit, as it is sometimes not found by unification.
theorem IterM.fold_hom {m : Type w Type w'} [Iterator α m β] [Finite α m]
@@ -260,7 +261,7 @@ theorem IterM.toList_eq_fold {α β : Type w} {m : Type w → Type w'} [Iterator
simp only [map_eq_pure_bind, bind_assoc]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· rename_i it' out h
specialize ihy h (l' ++ [out])
simpa using ihy
@@ -296,7 +297,7 @@ theorem IterM.drain_eq_match_step {α β : Type w} {m : Type w → Type w'} [Ite
[Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} :
it.drain = (do
match it.step with
match ( it.step).inflate with
| .yield it' _ _ => it'.drain
| .skip it' _ => it'.drain
| .done _ => return .unit) := by
@@ -313,7 +314,7 @@ theorem IterM.drain_eq_map_toList {α β : Type w} {m : Type w → Type w'} [Ite
simp only [map_eq_pure_bind, bind_assoc]
apply bind_congr
intro step
cases step using PlausibleIterStep.casesOn
cases step.inflate using PlausibleIterStep.casesOn
· rename_i it' out h
simp [ihy h]
· rename_i it' h
@@ -334,4 +335,183 @@ theorem IterM.drain_eq_map_toArray {α β : Type w} {m : Type w → Type w'} [It
it.drain = (fun _ => .unit) <$> it.toList := by
simp [IterM.drain_eq_map_toList]
theorem IterM.anyM_eq_forIn {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β m (ULift Bool)} :
it.anyM p = (ForIn.forIn it (.up false) (fun x _ => do
if ( p x).down then
return .done (.up true)
else
return .yield (.up false))) := by
rfl
theorem IterM.anyM_eq_match_step {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β m (ULift Bool)} :
it.anyM p = (do
match ( it.step).inflate.val with
| .yield it' x =>
if ( p x).down then
return .up true
else
it'.anyM p
| .skip it' => it'.anyM p
| .done => return .up false) := by
rw [anyM_eq_forIn, forIn_eq_match_step]
simp only [monadLift_self, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· apply bind_congr; intro px
split
· simp
· simp [anyM_eq_forIn]
· simp [anyM_eq_forIn]
· simp
theorem IterM.any_eq_anyM {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.any p = it.anyM (fun x => pure (.up (p x))) := by
rfl
theorem IterM.anyM_pure {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β ULift Bool} :
it.anyM (fun x => pure (p x)) = it.any (fun x => (p x).down) := by
simp [any_eq_anyM]
theorem IterM.any_eq_match_step {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.any p = (do
match ( it.step).inflate.val with
| .yield it' x =>
if p x then
return .up true
else
it'.any p
| .skip it' => it'.any p
| .done => return .up false) := by
rw [any_eq_anyM, anyM_eq_match_step]
apply bind_congr; intro step
split
· simp [any_eq_anyM]
· simp [any_eq_anyM]
· simp
theorem IterM.any_eq_forIn {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.any p = (ForIn.forIn it (.up false) (fun x _ => do
if p x then
return .done (.up true)
else
return .yield (.up false))) := by
simp [any_eq_anyM, anyM_eq_forIn]
theorem IterM.allM_eq_forIn {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β m (ULift Bool)} :
it.allM p = (ForIn.forIn it (.up true) (fun x _ => do
if ( p x).down then
return .yield (.up true)
else
return .done (.up false))) := by
rfl
theorem IterM.allM_eq_match_step {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β m (ULift Bool)} :
it.allM p = (do
match ( it.step).inflate.val with
| .yield it' x =>
if ( p x).down then
it'.allM p
else
return .up false
| .skip it' => it'.allM p
| .done => return .up true) := by
rw [allM_eq_forIn, forIn_eq_match_step]
simp only [monadLift_self, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· apply bind_congr; intro px
split
· simp [allM_eq_forIn]
· simp
· simp [allM_eq_forIn]
· simp
theorem IterM.all_eq_allM {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.all p = it.allM (fun x => pure (.up (p x))) := by
rfl
theorem IterM.allM_pure {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β ULift Bool} :
it.allM (fun x => pure (p x)) = it.all (fun x => (p x).down) := by
simp [all_eq_allM]
theorem IterM.all_eq_match_step {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.all p = (do
match ( it.step).inflate.val with
| .yield it' x =>
if p x then
it'.all p
else
return .up false
| .skip it' => it'.all p
| .done => return .up true) := by
rw [all_eq_allM, allM_eq_match_step]
apply bind_congr; intro step
split
· simp [all_eq_allM]
· simp [all_eq_allM]
· simp
theorem IterM.all_eq_forIn {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.all p = (ForIn.forIn it (.up true) (fun x _ => do
if p x then
return .yield (.up true)
else
return .done (.up false))) := by
simp [all_eq_allM, allM_eq_forIn]
theorem IterM.allM_eq_not_anyM_not {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β m (ULift Bool)} :
it.allM p = (fun x => .up !x.down) <$> it.anyM ((fun x => .up !x.down) <$> p ·) := by
induction it using IterM.inductSteps with | step it ihy ihs =>
rw [allM_eq_match_step, anyM_eq_match_step, map_eq_pure_bind, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp only [map_eq_pure_bind, bind_assoc, pure_bind]
apply bind_congr; intro px
split
· simp [*, ihy _]
· simp [*]
· simp [ihs _]
· simp
theorem IterM.all_eq_not_any_not {α β : Type w} {m : Type w Type w'} [Iterator α m β]
[Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
{it : IterM (α := α) m β} {p : β Bool} :
it.all p = (fun x => .up !x.down) <$> it.any (! p ·) := by
induction it using IterM.inductSteps with | step it ihy ihs =>
rw [all_eq_match_step, any_eq_match_step, map_eq_pure_bind, bind_assoc]
apply bind_congr; intro step
cases step.inflate using PlausibleIterStep.casesOn
· simp only
split
· simp [*, ihy _]
· simp [*]
· simp [ihs _]
· simp
end Std.Iterators

View File

@@ -9,6 +9,7 @@ prelude
public import Init.Control.Lawful.Basic
public import Init.Data.Subtype.Basic
public import Init.PropLemmas
public import Init.Control.Lawful.MonadLift.Basic
public section
@@ -82,7 +83,7 @@ protected def PostconditionT.map {m : Type w → Type w'} [Functor m] {α : Type
Given a function `α → PostconditionT m β`, returns a a function
`PostconditionT m α → PostconditionT m β`, turning `PostconditionT m` into a monad.
-/
@[always_inline, inline]
@[always_inline, inline, expose]
protected def PostconditionT.bind {m : Type w Type w'} [Monad m] {α : Type w} {β : Type w}
(x : PostconditionT m α) (f : α PostconditionT m β) : PostconditionT m β :=
fun b => a, x.Property a (f a).Property b,
@@ -222,6 +223,21 @@ theorem PostconditionT.operation_map {m : Type w → Type w'} [Functor m] {α :
(fun a => _, (property_map (m := m)).mpr a.1, rfl, a.2) <$> x.operation := by
rfl
@[simp]
theorem PostconditionT.operation_bind {m : Type w Type w'} [Monad m] {α : Type w} {β : Type w}
{x : PostconditionT m α} {f : α PostconditionT m β} :
(x.bind f).operation = (do
let a x.operation
(fun fa => fa.1, by exacta.1, a.2, fa.2) <$> (f a.1).operation) := by
rfl
theorem PostconditionT.operation_bind' {m : Type w Type w'} [Monad m] {α : Type w} {β : Type w}
{x : PostconditionT m α} {f : α PostconditionT m β} :
(x >>= f).operation = (do
let a x.operation
(fun fa => fa.1, by exacta.1, a.2, fa.2) <$> (f a.1).operation) := by
rfl
@[simp]
theorem PostconditionT.property_lift {m : Type w Type w'} [Functor m] {α : Type w}
{x : m α} : (lift x : PostconditionT m α).Property = (fun _ => True) := by
@@ -233,4 +249,19 @@ theorem PostconditionT.operation_lift {m : Type w → Type w'} [Functor m] {α :
(·, property_lift (m := m) True.intro) <$> 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
instance PostconditionT.instLawfulMonadLift {m : Type w Type w'} {n : Type w Type w''}
[MonadLift m n] [Monad m] [Monad n] [LawfulMonad m] [LawfulMonad n] [LawfulMonadLift m n] :
LawfulMonadLift (PostconditionT m) (PostconditionT n) where
monadLift_pure a := by
simp [MonadLift.monadLift, monadLift, LawfulMonadLift.monadLift_pure, pure,
PostconditionT.pure]
monadLift_bind x f := by
simp only [MonadLift.monadLift, bind, monadLift, LawfulMonadLift.monadLift_bind,
PostconditionT.bind, mk.injEq, heq_eq_eq, true_and]
simp only [map_eq_pure_bind, LawfulMonadLift.monadLift_bind, LawfulMonadLift.monadLift_pure]
end Std.Iterators

View File

@@ -24,7 +24,7 @@ Examples:
* `List.finRange 0 = ([] : List (Fin 0))`
* `List.finRange 2 = ([0, 1] : List (Fin 2))`
-/
def finRange (n : Nat) : List (Fin n) := ofFn fun i => i
@[expose] def finRange (n : Nat) : List (Fin n) := ofFn fun i => i
@[simp, grind =] theorem length_finRange {n : Nat} : (List.finRange n).length = n := by
simp [List.finRange]

View File

@@ -481,10 +481,38 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] {p : α → m Bool} {as :
simp only [anyM, ih, pure_bind]
split <;> simp_all
@[simp] theorem anyM_nil [Monad m] {p : α m Bool} :
([] : List α).anyM p = pure false :=
(rfl)
@[simp] theorem anyM_cons [Monad m] {p : α m Bool} {x : α} {xs : List α} :
(x :: xs).anyM p = (do
if ( p x) then
return true
else
xs.anyM p) := by
rw [anyM]
apply bind_congr; intro px
split <;> simp
@[simp] theorem allM_pure [Monad m] [LawfulMonad m] {p : α Bool} {as : List α} :
as.allM (m := m) (pure <| p ·) = pure (as.all p) := by
simp [allM_eq_not_anyM_not, all_eq_not_any_not]
@[simp] theorem allM_nil [Monad m] {p : α m Bool} :
([] : List α).allM p = pure true :=
(rfl)
@[simp] theorem allM_cons [Monad m] {p : α m Bool} {x : α} {xs : List α} :
(x :: xs).allM p = (do
if ( p x) then
xs.allM p
else
return false) := by
rw [allM]
apply bind_congr; intro px
split <;> simp
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--

View File

@@ -27,7 +27,7 @@ Examples:
* `List.ofFn (n := 3) toString = ["0", "1", "2"]`
* `List.ofFn (fun i => #["red", "green", "blue"].get i.val i.isLt) = ["red", "green", "blue"]`
-/
def ofFn {n} (f : Fin n α) : List α := Fin.foldr n (f · :: ·) []
@[expose] def ofFn {n} (f : Fin n α) : List α := Fin.foldr n (f · :: ·) []
/--
Creates a list wrapped in a monad by applying the monadic function `f : Fin n → m α`

View File

@@ -591,10 +591,13 @@ theorem and_or_distrib_left (x y z : Nat) : x &&& (y ||| z) = (x &&& y) ||| (x &
simp [Bool.and_or_distrib_left]
@[grind =]
theorem and_distrib_right (x y z : Nat) : (x ||| y) &&& z = (x &&& z) ||| (y &&& z) := by
theorem and_or_distrib_right (x y z : Nat) : (x ||| y) &&& z = (x &&& z) ||| (y &&& z) := by
apply Nat.eq_of_testBit_eq
simp [Bool.and_or_distrib_right]
@[deprecated and_or_distrib_right (since := "2025-10-02")]
abbrev and_distrib_right := and_or_distrib_right
theorem or_and_distrib_left (x y z : Nat) : x ||| (y &&& z) = (x ||| y) &&& (x ||| z) := by
apply Nat.eq_of_testBit_eq
simp [Bool.or_and_distrib_left]

View File

@@ -10,10 +10,13 @@ public import Init.Data.Range.Polymorphic.Basic
public import Init.Data.Range.Polymorphic.Iterators
public import Init.Data.Range.Polymorphic.Stream
public import Init.Data.Range.Polymorphic.Lemmas
public import Init.Data.Range.Polymorphic.Nat
public import Init.Data.Range.Polymorphic.Int
public import Init.Data.Range.Polymorphic.BitVec
public import Init.Data.Range.Polymorphic.UInt
public import Init.Data.Range.Polymorphic.SInt
public import Init.Data.Range.Polymorphic.NatLemmas
public import Init.Data.Range.Polymorphic.GetElemTactic

View File

@@ -11,12 +11,12 @@ public import Init.Data.Order.Lemmas
public import Init.Data.UInt
import Init.Omega
public section
open Std Std.PRange
namespace BitVec
public section
variable {n : Nat}
instance : UpwardEnumerable (BitVec n) where
@@ -59,7 +59,7 @@ instance : LawfulUpwardEnumerable (BitVec n) where
simp +contextual [UpwardEnumerable.LT, BitVec.toNat_inj, succMany?] at
omega
succMany?_zero := by simp [UpwardEnumerable.succMany?, BitVec.toNat_lt_twoPow_of_le]
succMany?_succ? a b := by
succMany?_add_one a b := by
simp +contextual [ BitVec.toNat_inj, succMany?, succ?]
split <;> split
· rename_i h
@@ -81,12 +81,11 @@ instance : LawfulUpwardEnumerableLE (BitVec n) where
simp [BitVec.ofNatLT]
instance : LawfulUpwardEnumerableLT (BitVec n) := inferInstance
instance : LawfulUpwardEnumerableLT (BitVec n) := inferInstance
instance : Rxc.HasSize (BitVec n) where
instance instRxcHasSize : Rxc.HasSize (BitVec n) where
size lo hi := hi.toNat + 1 - lo.toNat
instance : Rxc.LawfulHasSize (BitVec n) where
instance instRxcLawfulHasSize : Rxc.LawfulHasSize (BitVec n) where
size_eq_zero_of_not_le bound x := by
simp only [BitVec.not_le, Rxc.HasSize.size, BitVec.lt_def]
omega
@@ -98,16 +97,16 @@ instance : Rxc.LawfulHasSize (BitVec n) where
simp only [succ?_eq_some, Rxc.HasSize.size, BitVec.le_def]
omega
instance : Rxc.IsAlwaysFinite (BitVec n) := inferInstance
instance instRxcIsAlwaysFinite : Rxc.IsAlwaysFinite (BitVec n) := inferInstance
instance : Rxo.HasSize (BitVec n) := .ofClosed
instance : Rxo.LawfulHasSize (BitVec n) := inferInstance
instance : Rxo.IsAlwaysFinite (BitVec n) := inferInstance
instance instRxoHasSize : Rxo.HasSize (BitVec n) := .ofClosed
instance instRxoLawfulHasSize : Rxo.LawfulHasSize (BitVec n) := inferInstance
instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite (BitVec n) := inferInstance
instance : Rxi.HasSize (BitVec n) where
instance instRxiHasSize : Rxi.HasSize (BitVec n) where
size lo := 2 ^ n - lo.toNat
instance : Rxi.LawfulHasSize (BitVec n) where
instance instRxiLawfulHasSize : Rxi.LawfulHasSize (BitVec n) where
size_eq_one_of_succ?_eq_none x := by
simp only [succ?_eq_none, Rxi.HasSize.size]
omega
@@ -115,6 +114,7 @@ instance : Rxi.LawfulHasSize (BitVec n) where
simp only [succ?_eq_some, Rxi.HasSize.size]
omega
instance : Rxi.IsAlwaysFinite (BitVec n) := inferInstance
instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite (BitVec n) := inferInstance
end
end BitVec

View File

@@ -51,15 +51,15 @@ instance [LE α] [Total (α := α) (· ≤ ·)] [UpwardEnumerable α] [LawfulUpw
cases n
· simpa [succMany?_zero] using hn
· exfalso
rw [succMany?_succ?_eq_succ?_bind_succMany?, hab,
succMany?_succ?_eq_succ?_bind_succMany?] at hn
rw [succMany?_add_one_eq_succ?_bind_succMany?, hab,
succMany?_add_one_eq_succ?_bind_succMany?] at hn
exact UpwardEnumerable.lt_irrefl _, hn
· obtain n, hn := h
cases n
· simpa [succMany?_zero] using hn.symm
· exfalso
rw [succMany?_succ?_eq_succ?_bind_succMany?, hab.symm,
succMany?_succ?_eq_succ?_bind_succMany?] at hn
rw [succMany?_add_one_eq_succ?_bind_succMany?, hab.symm,
succMany?_add_one_eq_succ?_bind_succMany?] at hn
exact UpwardEnumerable.lt_irrefl _, hn
namespace Rxc
@@ -76,7 +76,7 @@ instance instIsAlwaysFiniteOfLawfulHasSize [LE α] [UpwardEnumerable α]
simp [succMany?_zero, hn]
| succ =>
rename_i n ih
rw [succMany?_succ?_eq_succ?_bind_succMany?]
rw [succMany?_add_one_eq_succ?_bind_succMany?]
match hs : succ? lo with
| none => simp
| some a =>
@@ -120,7 +120,7 @@ instance LawfulHasSize.of_closed [UpwardEnumerable α] [LE α] [DecidableLE α]
exfalso
simp only [UpwardEnumerable.lt_iff] at h
obtain n, hn := h
simp [succMany?_succ?_eq_succ?_bind_succMany?, h'] at hn
simp [succMany?_add_one_eq_succ?_bind_succMany?, h'] at hn
size_eq_succ_of_succ?_eq_some bound a a' h h' := by
simp only [HasSize.size, Nat.pred_eq_succ_iff]
rw [Rxc.LawfulHasSize.size_eq_succ_of_succ?_eq_some (h := le_of_lt h) (h' := h')]
@@ -130,7 +130,7 @@ instance LawfulHasSize.of_closed [UpwardEnumerable α] [LE α] [DecidableLE α]
rw [UpwardEnumerable.le_iff]
rw [UpwardEnumerable.lt_iff] at h
refine h.choose, ?_
simpa [succMany?_succ?_eq_succ?_bind_succMany?, h'] using h.choose_spec
simpa [succMany?_add_one_eq_succ?_bind_succMany?, h'] using h.choose_spec
/--
Creates a {lean}`HasSize α` from a {lean}`HasSize α` instance. If the latter is lawful
@@ -151,7 +151,7 @@ instance instIsAlwaysFiniteOfLawfulHasSize [LT α] [UpwardEnumerable α]
simp [succMany?_zero, hn]
| succ =>
rename_i n ih
rw [succMany?_succ?_eq_succ?_bind_succMany?]
rw [succMany?_add_one_eq_succ?_bind_succMany?]
match hs : succ? lo with
| none => simp
| some a =>
@@ -176,7 +176,7 @@ instance instIsAlwaysFiniteOfLawfulHasSize [LT α] [UpwardEnumerable α]
simp [Nat.ne_of_gt size_pos] at hn
| succ =>
rename_i n ih
rw [succMany?_succ?_eq_succ?_bind_succMany?]
rw [succMany?_add_one_eq_succ?_bind_succMany?]
match hs : succ? lo with
| none => simp
| some a =>

View File

@@ -24,7 +24,7 @@ instance : LawfulUpwardEnumerable Int where
simp only [UpwardEnumerable.LT, UpwardEnumerable.succMany?, Option.some.injEq]
omega
succMany?_zero := by simp [UpwardEnumerable.succMany?]
succMany?_succ? := by
succMany?_add_one := by
simp only [UpwardEnumerable.succMany?, UpwardEnumerable.succ?,
Option.bind_some, Option.some.injEq]
omega
@@ -37,7 +37,6 @@ instance : LawfulUpwardEnumerableLE Int where
simp [UpwardEnumerable.LE, UpwardEnumerable.succMany?, Int.le_def, Int.nonneg_def,
Int.sub_eq_iff_eq_add', eq_comm (a := y)]
instance : LawfulOrderLT Int := inferInstance
instance : LawfulUpwardEnumerableLT Int := inferInstance
instance : LawfulUpwardEnumerableLT Int := inferInstance

View File

@@ -0,0 +1,320 @@
/-
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.Range.Polymorphic.BitVec
/-!
# Ranges on signed bit vectors
This is an internal library implementing an alternative, signed notion of ranges
on bit vectors. It is only used internally for the construction of ranges on signed number types
(see `Init.Data.Range.Polymorphic.SInt`).
-/
open Std Std.PRange
namespace BitVec.Signed
/-
The elaborator tends to recurse too deeply when working with large numbers in `Int*`
and `BitVec`. Therefore, we define sealed versions of `BitVec.intMin` and `BitVec.intMax`.
-/
def intMinSealed n : BitVec n := (2 ^ (n - 1) : Nat)
def intMaxSealed n : BitVec n := (2 ^ (n - 1) - 1 : Nat)
theorem intMinSealed_def : intMinSealed n = (2 ^ (n - 1) : Nat) := (rfl)
theorem intMaxSealed_def : intMaxSealed n = (2 ^ (n - 1) - 1 : Nat) := (rfl)
seal intMinSealed intMaxSealed
def rotate (x : BitVec n) : BitVec n := x + intMinSealed n
theorem intMaxSealed_eq_intMinSealed_add :
intMaxSealed n = intMinSealed n + (2 ^ n - 1 : Nat) := by
match n with
| 0 => simp [eq_nil (intMaxSealed 0), eq_nil (intMinSealed 0)]
| n + 1 =>
simp only [intMaxSealed_def, Nat.add_one_sub_one, natCast_eq_ofNat, intMinSealed_def,
ofNat_add, toNat_inj, toNat_ofNat, Nat.mod_eq_mod_iff]
exact 1, 0, by omega
theorem intMinSealed_add_intMinSealed :
intMinSealed n + intMinSealed n = 0 := by
match n with
| 0 => simp [eq_nil (intMinSealed 0)]
| n + 1 =>
simp [intMinSealed_def, BitVec.ofNat_add, show 2 ^ n + 2 ^ n = 2 ^ (n + 1) by omega,
BitVec.toNat_inj]
theorem rotate_neg_eq_intMinSealed_sub {x : BitVec n} :
rotate (-x) = intMinSealed n - x := by
simp only [rotate, intMinSealed_def, natCast_eq_ofNat]
rw [eq_sub_iff_add_eq, BitVec.add_comm, BitVec.add_assoc, BitVec.add_neg_eq_sub,
BitVec.sub_self, BitVec.zero_add]
theorem rotate_add {x y : BitVec n} : rotate (x + y) = rotate x + y := by
simp [rotate, BitVec.add_assoc, BitVec.add_comm y]
theorem rotate_sub {x y : BitVec n} : rotate (x - y) = rotate x - y := by
simp [BitVec.sub_eq_add_neg, rotate_add]
theorem rotate_intMinSealed : rotate (intMinSealed n) = (0 : Nat) := by
simp [rotate, intMinSealed_add_intMinSealed]
theorem rotate_intMaxSealed : rotate (intMaxSealed n) = (2 ^ n - 1 : Nat) := by
simp [intMaxSealed_eq_intMinSealed_add, rotate_add, rotate_intMinSealed]
theorem rotate_rotate {x : BitVec n} : rotate (rotate x) = x := by
match n with
| 0 => simp [eq_nil x, rotate, intMinSealed_def]
| n + 1 =>
simp only [rotate, BitVec.add_assoc]
simp [ BitVec.toNat_inj, Nat.two_mul, intMinSealed_def, show 2 * 2 ^ n = 2 ^ (n + 1) by omega]
theorem rotate_map_eq_iff {x y : Option (BitVec n)} :
rotate <$> x = y x = rotate <$> y := by
suffices h : x y : Option (BitVec n), rotate <$> x = y x = rotate <$> y by
exact h x y, fun h' => (h y x h'.symm).symm
intro x y h
replace h := congrArg (rotate <$> ·) h
simpa [Function.comp_def, rotate_rotate] using h
scoped instance instUpwardEnumerable : UpwardEnumerable (BitVec n) where
succ? x := rotate <$> UpwardEnumerable.succ? (rotate x)
succMany? n x := rotate <$> UpwardEnumerable.succMany? n (rotate x)
theorem succ?_rotate {x : BitVec n} :
succ? (rotate x) = (haveI := BitVec.instUpwardEnumerable (n := n); rotate <$> succ? x) := by
simp [succ?, rotate_rotate]
theorem succMany?_rotate {x : BitVec n} :
succMany? m (rotate x) =
(haveI := BitVec.instUpwardEnumerable (n := n); rotate <$> succMany? m x) := by
simp [succMany?, rotate_rotate]
theorem sle_iff_rotate_le_rotate {x y : BitVec n} :
x.sle y rotate x rotate y := by
match n with
| 0 => simp [eq_nil x, eq_nil y]
| n + 1 =>
simp only [sle_iff_toInt_le, BitVec.toInt, Nat.pow_add, Nat.pow_one, Nat.mul_comm _ 2,
Nat.zero_lt_succ, Nat.mul_lt_mul_left, Int.natCast_mul, Int.cast_ofNat_Int, Int.natCast_pow,
rotate, intMinSealed_def, Nat.add_one_sub_one, natCast_eq_ofNat, le_def, toNat_add,
toNat_ofNat, Nat.add_mod_mod]
split <;> split
· simp only [Int.ofNat_le]
rw [Nat.mod_eq_of_lt (by omega), Nat.mod_eq_of_lt (by omega)]
omega
· have : (y.toNat : Int) - 2 * 2 ^ n < 0 := by
have := BitVec.toNat_lt_twoPow_of_le (x := y) (Nat.le_refl _)
simp [Nat.pow_add, Nat.mul_comm _ 2] at this
simp only [ Int.ofNat_lt, Int.natCast_mul, Int.cast_ofNat_Int, Int.natCast_pow] at this
omega
have : ¬ (x.toNat (y.toNat : Int) - 2 * 2 ^ n) := by
apply Int.not_le_of_gt
calc _ < 0 := this
_ _ := by omega
simp only [this, false_iff, Nat.not_le, gt_iff_lt]
rw [Nat.mod_eq_mod_iff (x := y.toNat + 2 ^ n) (y := y.toNat - 2 ^ n) (z := 2 * 2 ^ n) |>.mpr]
· rw [Nat.mod_eq_of_lt (by omega), Nat.mod_eq_of_lt (by omega)]
omega
· exact 0, 1, by omega
· have : (x.toNat : Int) - 2 * 2 ^ n y.toNat := by
have : x.toNat < 2 * 2 ^ n := by omega
have : (x.toNat : Int) < 2 * 2 ^ n := by simpa [ Int.ofNat_lt] using this
omega
simp only [this, true_iff, ge_iff_le]
rw [Nat.mod_eq_mod_iff (x := x.toNat + 2 ^ n) (y := x.toNat - 2 ^ n) (z := 2 * 2 ^ n) |>.mpr]
· rw [Nat.mod_eq_of_lt (by omega), Nat.mod_eq_of_lt (by omega)]
omega
· exact 0, 1, by omega
· simp only [Int.sub_le_sub_right_iff, Int.ofNat_le]
rw [Nat.mod_eq_mod_iff (x := x.toNat + 2 ^ n) (y := x.toNat - 2 ^ n) (z := 2 * 2 ^ n)
|>.mpr 0, 1, by omega,
Nat.mod_eq_mod_iff (x := y.toNat + 2 ^ n) (y := y.toNat - 2 ^ n) (z := 2 * 2 ^ n)
|>.mpr 0, 1, by omega,
Nat.mod_eq_of_lt (by omega), Nat.mod_eq_of_lt (by omega)]
omega
theorem rotate_inj {x y : BitVec n} :
rotate x = rotate y x = y := by
apply Iff.intro
all_goals
intro h
simpa [rotate_rotate] using congrArg rotate h
theorem rotate_eq_iff {x y : BitVec n} : rotate x = y x = rotate y := by
rw [ rotate_rotate (x := y), rotate_inj, rotate_rotate]
theorem toInt_eq_ofNat_toNat_rotate_sub {x : BitVec n} (h : n > 0) :
x.toInt = ((rotate x).toNat : Int) - (intMinSealed n).toNat := by
match n with
| 0 => omega
| n + 1 =>
simp only [BitVec.toInt, Int.natCast_pow, Int.cast_ofNat_Int, rotate, intMinSealed_def,
Nat.add_one_sub_one, natCast_eq_ofNat, toNat_add, toNat_ofNat, Nat.add_mod_mod,
Int.natCast_emod, Int.natCast_add]
rw [Int.emod_eq_of_lt (a := 2 ^ n)]; rotate_left
· exact Int.le_of_lt (Int.pow_pos (by omega))
· rw [Int.pow_add, Int.pow_succ, Int.pow_zero, Int.one_mul, Int.mul_comm, Int.two_mul]
exact Int.lt_add_of_pos_right _ (Int.pow_pos (by omega))
have : (2 : Int) ^ n > 0 := Int.pow_pos (by omega)
split <;> rename_i h
· rw [Nat.pow_add, Nat.pow_one, Nat.mul_comm _ 2, Nat.mul_lt_mul_left (by omega),
Int.ofNat_lt, Int.natCast_pow, Int.cast_ofNat_Int] at h
rw [Int.emod_eq_of_lt (by omega) (by omega)]
omega
· rw [Nat.pow_add, Nat.pow_one, Nat.mul_comm _ 2, Nat.mul_lt_mul_left (by omega),
Int.ofNat_lt, Int.natCast_pow, Int.cast_ofNat_Int] at h
simp only [Int.pow_add, Int.reducePow, Int.mul_comm _ 2, Int.two_mul, Int.sub_sub,
Int.sub_left_inj]
rw [eq_comm, Int.emod_eq_iff (by omega)]
refine by omega, ?_, ?_
· have := BitVec.toNat_lt_twoPow_of_le (x := x) (Nat.le_refl _)
rw [Int.ofNat_natAbs_of_nonneg (by omega)]
simp only [Nat.pow_add, Nat.pow_one, Int.ofNat_lt, Int.natCast_mul, Int.natCast_pow,
Int.cast_ofNat_Int] at this
omega
· conv => rhs; rw [ Int.sub_sub, Int.sub_sub (b := 2 ^ n), Int.add_comm, Int.sub_sub]
exact -1, by omega
theorem ofNat_eq_rotate_ofInt_sub {n k : Nat} :
BitVec.ofNat n k = rotate (BitVec.ofInt n (k - (intMinSealed n).toNat)) := by
match n with
| 0 => simp only [eq_nil (BitVec.ofNat _ _), eq_nil (rotate _)]
| n + 1 =>
simp only [intMinSealed, natCast_eq_ofNat, toNat_ofNat, Int.natCast_emod, Int.natCast_pow]
rw [Int.emod_eq_of_lt]
· simp [rotate, toInt_inj, intMinSealed, toInt_ofNat']
· exact Int.le_of_lt (Int.pow_pos (by omega))
· exact Int.pow_lt_pow_of_lt (by omega) (by omega)
scoped instance instLE : LE (BitVec n) where le x y := x.sle y
scoped instance instLT : LT (BitVec n) where lt x y := x.slt y
scoped instance instDecidableLE : DecidableLE (BitVec n) :=
fun x y => inferInstanceAs (Decidable <| x.sle y)
scoped instance instDecidableLT : DecidableLT (BitVec n) :=
fun x y => inferInstanceAs (Decidable <| x.slt y)
scoped instance : LawfulOrderLT (BitVec n) where
lt_iff x y := by
simp only [LE.le, LT.lt]
simpa [BitVec.slt_iff_toInt_lt, BitVec.sle_iff_toInt_le] using Int.le_of_lt
scoped instance : IsPartialOrder (BitVec n) where
le_refl x := by simp only [LE.le]; simp [BitVec.sle_iff_toInt_le]
le_trans := by
simp only [LE.le]
simpa [BitVec.sle_iff_toInt_le] using fun _ _ _ => Int.le_trans
le_antisymm := by
simp only [LE.le, BitVec.toInt_inj]
simpa [BitVec.sle_iff_toInt_le] using fun _ _ => Int.le_antisymm
scoped instance : LawfulUpwardEnumerableLE (BitVec n) where
le_iff x y := by
rw [ rotate_rotate (x := x), rotate_rotate (x := y)]
generalize (rotate x) = x; generalize (rotate y) = y
letI := BitVec.instUpwardEnumerable (n := n)
letI := instLEBitVec (w := n)
simp only [LE.le]
simp [sle_iff_rotate_le_rotate, UpwardEnumerable.le_iff, rotate_rotate,
UpwardEnumerable.le_iff_exists, succMany?_rotate, rotate_inj]
scoped instance :
LawfulUpwardEnumerable (BitVec n) where
ne_of_lt x y h := by
rw [ rotate_rotate (x := x), rotate_rotate (x := y)] at h
generalize rotate x = x at h
generalize rotate y = y at h
letI : UpwardEnumerable (BitVec n) := BitVec.instUpwardEnumerable
have : x y := by
apply UpwardEnumerable.ne_of_lt
obtain n, hn := h
refine n, ?_
rwa [succMany?_rotate, rotate_map_eq_iff, Option.map_eq_map, Option.map_some, rotate_rotate] at hn
apply this.imp; intro heq
simpa [rotate_rotate] using congrArg rotate heq
succMany?_zero x := by
rw [ rotate_rotate (x := x)]
generalize rotate x = x
letI : UpwardEnumerable (BitVec n) := BitVec.instUpwardEnumerable
simp [succMany?_rotate, succMany?_zero]
succMany?_add_one m x := by
rw [ rotate_rotate (x := x)]
generalize rotate x = x
letI : UpwardEnumerable (BitVec n) := BitVec.instUpwardEnumerable
simp [succMany?_rotate, succMany?_add_one, Option.bind_map, Function.comp_def, succ?_rotate]
scoped instance : LawfulUpwardEnumerableLT (BitVec n) := inferInstance
scoped instance instRxcHasSize : Rxc.HasSize (BitVec n) where
size lo hi :=
haveI := BitVec.instRxcHasSize (n := n)
Rxc.HasSize.size (rotate lo) (rotate hi)
scoped instance instRxcLawfulHasSize : Rxc.LawfulHasSize (BitVec n) where
size_eq_zero_of_not_le bound x := by
simp only [LE.le]
match n with
| 0 => simp [eq_nil x, eq_nil bound]
| n + 1 =>
simp [BitVec.sle_iff_toInt_le, Rxc.HasSize.size,
toInt_eq_ofNat_toNat_rotate_sub (show n + 1 > 0 by omega)]
omega
size_eq_one_of_succ?_eq_none lo hi := by
rw [ rotate_rotate (x := lo)]
generalize rotate lo = lo
simp only [LE.le]
match n with
| 0 => simp [eq_nil lo, eq_nil hi, succ?, rotate, Rxc.HasSize.size, intMinSealed_def]
| n + 1 =>
simp [BitVec.sle_iff_toInt_le, toInt_eq_ofNat_toNat_rotate_sub,
Rxc.HasSize.size, rotate_rotate, succ?_rotate, Option.map_eq_map, Option.map_eq_none_iff,
succ?_eq_none]
omega
size_eq_succ_of_succ?_eq_some lo hi x := by
rw [ rotate_rotate (x := lo)]
generalize rotate lo = lo
simp only [LE.le]
match n with
| 0 => simp [eq_nil lo, eq_nil hi, succ?, rotate, Rxc.HasSize.size, intMinSealed_def]
| n + 1 =>
simp only [sle_iff_toInt_le, Nat.zero_lt_succ, toInt_eq_ofNat_toNat_rotate_sub,
rotate_rotate, succ?_rotate, Option.map_eq_map, Option.map_eq_some_iff, succ?_eq_some,
Rxc.HasSize.size, forall_exists_index, and_imp]
rintro h y h' hy rfl
simp only [rotate_rotate]
omega
scoped instance instRxcIsAlwaysFinite : Rxc.IsAlwaysFinite (BitVec n) := inferInstance
scoped instance instRxoHasSize : Rxo.HasSize (BitVec n) := .ofClosed
scoped instance instRxoLawfulHasSize : Rxo.LawfulHasSize (BitVec n) := .of_closed
scoped instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite (BitVec n) := inferInstance
scoped instance instRxiHasSize : Rxi.HasSize (BitVec n) where
size lo := 2 ^ n - (rotate lo).toNat
scoped instance instRxiLawfulHasSize : Rxi.LawfulHasSize (BitVec n) where
size_eq_one_of_succ?_eq_none x := by
rw [ rotate_rotate (x := x)]
generalize rotate x = x
simp only [succ?_rotate, Option.map_eq_map, Option.map_eq_none_iff, Rxi.HasSize.size,
rotate_rotate]
letI := BitVec.instRxiHasSize (n := n)
exact Rxi.size_eq_one_of_succ?_eq_none x
size_eq_succ_of_succ?_eq_some lo lo' := by
rw [ rotate_rotate (x := lo), rotate_rotate (x := lo')]
generalize rotate lo = lo
generalize rotate lo' = lo'
simp only [succ?_rotate, Option.map_eq_map, Option.map_eq_some_iff, rotate_inj, exists_eq_right,
instRxiHasSize, rotate_rotate]
letI := BitVec.instRxiHasSize (n := n)
exact Rxi.size_eq_succ_of_succ?_eq_some lo lo'
scoped instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite (BitVec n) := inferInstance
end BitVec.Signed

View File

@@ -62,12 +62,11 @@ namespace Rcc
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a closed range {lit}`lo...=hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Rcc.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Rcc α) : Iter (α := Rxc.Iterator α) α :=
@@ -149,12 +148,11 @@ namespace Rco
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a closed range {lit}`lo...hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Rco.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Rco α) : Iter (α := Rxo.Iterator α) α :=
@@ -236,12 +234,11 @@ namespace Rci
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a closed range {lit}`lo...*`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Rcc.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Rci α) : Iter (α := Rxi.Iterator α) α :=
@@ -322,12 +319,11 @@ namespace Roc
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a left-open right-closed range {lit}`lo<...=hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Roc.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Roc α) : Iter (α := Rxc.Iterator α) α :=
@@ -380,7 +376,7 @@ theorem Internal.isPlausibleIndirectOutput_iter_iff
rw [LawfulUpwardEnumerableLT.lt_iff] at hl
obtain n, hn := hl
exact n,
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?], hu
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?], hu
@[no_expose]
instance {m} [UpwardEnumerable α]
@@ -402,12 +398,11 @@ namespace Roo
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for an open range {lit}`lo<...hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Roo.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Roo α) : Iter (α := Rxo.Iterator α) α :=
@@ -459,7 +454,7 @@ theorem Internal.isPlausibleIndirectOutput_iter_iff
rw [LawfulUpwardEnumerableLT.lt_iff] at hl
obtain n, hn := hl
exact n,
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?], hu
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?], hu
@[no_expose]
instance {m} [UpwardEnumerable α]
@@ -481,12 +476,11 @@ namespace Roi
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a closed range {lit}`lo<...*`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Roi.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] (r : Roi α) : Iter (α := Rxi.Iterator α) α :=
@@ -535,7 +529,7 @@ theorem Internal.isPlausibleIndirectOutput_iter_iff
simp only [Membership.mem, LawfulUpwardEnumerableLT.lt_iff] at hl
obtain n, hn := hl
exact n,
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?]
by simp [Internal.iter, hn, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?]
@[no_expose]
instance {m} [UpwardEnumerable α]
@@ -556,12 +550,11 @@ namespace Ric
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a left-unbounded right-closed range {lit}`*...=hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Ric.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [Least? α] (r : Ric α) : Iter (α := Rxc.Iterator α) α :=
@@ -630,12 +623,11 @@ namespace Rio
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for a left-unbounded right-open range {lit}`*...hi`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Rio.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] [Least? α] (r : Rio α) : Iter (α := Rxo.Iterator α) α :=
@@ -703,12 +695,11 @@ namespace Rii
variable {α : Type u}
-- TODO: Replace the `lit` role with a `module` role?
/--
Internal function that constructs an iterator for the full range {lean}`*...*`.
This is an internal function.
Use {name (scope := "Std.Data.Iterators.Producers.Range")}`Rio.iter` instead, which requires
importing {lit}`Std.Data.Iterators`.
importing {module -checked}`Std.Data.Iterators`.
-/
@[always_inline, inline]
def Internal.iter [UpwardEnumerable α] [Least? α] (_ : Rii α) : Iter (α := Rxi.Iterator α) α :=

View File

@@ -507,7 +507,7 @@ public theorem Rxc.Iterator.pairwise_toList_upwardEnumerableLt [LE α] [Decidabl
simp only at ha
have : UpwardEnumerable.LT a ha.choose := by
refine 0, ?_
simp only [succMany?_succ?, succMany?_zero,
simp only [succMany?_add_one, succMany?_zero,
Option.bind_some]
exact ha.choose_spec.1
exact UpwardEnumerable.lt_of_lt_of_le this ha.choose_spec.2
@@ -530,7 +530,7 @@ public theorem Rxo.Iterator.pairwise_toList_upwardEnumerableLt [LT α] [Decidabl
simp only at ha
have : UpwardEnumerable.LT a ha.choose := by
refine 0, ?_
simp only [succMany?_succ?, succMany?_zero,
simp only [succMany?_add_one, succMany?_zero,
Option.bind_some]
exact ha.choose_spec.1
exact UpwardEnumerable.lt_of_lt_of_le this ha.choose_spec.2
@@ -553,7 +553,7 @@ public theorem Rxi.Iterator.pairwise_toList_upwardEnumerableLt
simp only at ha
have : UpwardEnumerable.LT a ha.choose := by
refine 0, ?_
simp only [succMany?_succ?, succMany?_zero,
simp only [succMany?_add_one, succMany?_zero,
Option.bind_some]
exact ha.choose_spec.1
exact UpwardEnumerable.lt_of_lt_of_le this ha.choose_spec.2
@@ -1300,7 +1300,7 @@ public theorem toList_eq_nil_iff [LE α] [DecidableLE α] [LT α] [UpwardEnumera
split <;> rename_i heq <;>
simp [UpwardEnumerable.lt_iff, UpwardEnumerable.lt_iff_exists,
UpwardEnumerable.le_iff, UpwardEnumerable.le_iff_exists,
UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?, heq]
UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?, heq]
public theorem toArray_eq_empty_iff [LE α] [DecidableLE α] [LT α] [UpwardEnumerable α]
[LawfulUpwardEnumerable α] [LawfulUpwardEnumerableLE α] [LawfulUpwardEnumerableLT α]
@@ -1681,7 +1681,7 @@ public theorem isEmpty_iff_forall_not_mem [LT α] [DecidableLT α] [UpwardEnumer
· rintro h a hl, hu
simp only [UpwardEnumerable.lt_iff, UpwardEnumerable.lt_iff] at h hl hu
obtain n, hn := hl
simp only [succMany?_succ?_eq_succ?_bind_succMany?, Option.bind_eq_some_iff] at hn
simp only [succMany?_add_one_eq_succ?_bind_succMany?, Option.bind_eq_some_iff] at hn
obtain a', ha', hn := hn
exact h a' ha' (UpwardEnumerable.lt_of_le_of_lt n, hn hu)
· intro h a ha
@@ -1882,7 +1882,7 @@ public theorem isEmpty_iff_forall_not_mem [LT α] [DecidableLT α] [UpwardEnumer
UpwardEnumerable.lt_iff_exists, not_exists]
constructor
· intro h a n hs
simp [UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?, h] at hs
simp [UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?, h] at hs
· simp only [Option.eq_none_iff_forall_ne_some]
intro h a
simpa [UpwardEnumerable.succMany?_one] using h a 0
@@ -2692,7 +2692,7 @@ theorem getElem?_toList_eq [LE α] [DecidableLE α] [UpwardEnumerable α] [Lawfu
· rename_i n ih
rw [toList_eq_match]
split
· simp only [List.getElem?_cons_succ, succMany?_succ?_eq_succ?_bind_succMany?]
· simp only [List.getElem?_cons_succ, succMany?_add_one_eq_succ?_bind_succMany?]
cases hs : UpwardEnumerable.succ? r.lower
· rw [Roc.toList_eq_match]
simp [hs]
@@ -2784,10 +2784,10 @@ theorem getElem?_toList_eq [LE α] [DecidableLE α] [UpwardEnumerable α] [Lawfu
r.toList[i]? = (UpwardEnumerable.succMany? (i + 1) r.lower).filter (· r.upper) := by
match h : UpwardEnumerable.succ? r.lower with
| none =>
simp [toList_eq_match, h, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?]
simp [toList_eq_match, h, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?]
| some next =>
rw [toList_Roc_eq_toList_Rcc_of_isSome_succ? (by simp [h]), Rcc.getElem?_toList_eq]
simp [succMany?_succ?_eq_succ?_bind_succMany?, h]
simp [succMany?_add_one_eq_succ?_bind_succMany?, h]
theorem getElem?_toArray_eq [LE α] [DecidableLE α] [UpwardEnumerable α] [LawfulUpwardEnumerable α]
[LawfulUpwardEnumerableLE α] [Rxc.IsAlwaysFinite α] {i} :
@@ -2960,7 +2960,7 @@ theorem getElem?_toList_eq [LT α] [DecidableLT α] [UpwardEnumerable α]
· rename_i n ih
rw [toList_eq_if]
split
· simp only [List.getElem?_cons_succ, succMany?_succ?_eq_succ?_bind_succMany?]
· simp only [List.getElem?_cons_succ, succMany?_add_one_eq_succ?_bind_succMany?]
cases hs : UpwardEnumerable.succ? r.lower
· rw [Roo.toList_eq_match]
simp [hs]
@@ -3052,10 +3052,10 @@ theorem getElem?_toList_eq [LT α] [DecidableLT α] [UpwardEnumerable α] [Lawfu
r.toList[i]? = (UpwardEnumerable.succMany? (i + 1) r.lower).filter (· < r.upper) := by
match h : UpwardEnumerable.succ? r.lower with
| none =>
simp [toList_eq_match, h, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?]
simp [toList_eq_match, h, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?]
| some next =>
rw [toList_Roo_eq_toList_Rco_of_isSome_succ? (by simp [h]), Rco.getElem?_toList_eq]
simp [succMany?_succ?_eq_succ?_bind_succMany?, h]
simp [succMany?_add_one_eq_succ?_bind_succMany?, h]
theorem getElem?_toArray_eq [LT α] [DecidableLT α] [UpwardEnumerable α] [LawfulUpwardEnumerable α]
[LawfulUpwardEnumerableLT α] [Rxo.IsAlwaysFinite α] {i} :
@@ -3224,7 +3224,7 @@ theorem getElem?_toList_eq [UpwardEnumerable α]
· simp [toList_eq_toList_Roi, UpwardEnumerable.succMany?_zero]
· rename_i n ih
rw [toList_eq_toList_Roi]
simp only [List.getElem?_cons_succ, succMany?_succ?_eq_succ?_bind_succMany?]
simp only [List.getElem?_cons_succ, succMany?_add_one_eq_succ?_bind_succMany?]
cases hs : UpwardEnumerable.succ? r.lower
· rw [Roi.toList_eq_match]
simp [hs]
@@ -3308,10 +3308,10 @@ theorem getElem?_toList_eq [LT α] [DecidableLT α] [UpwardEnumerable α] [Lawfu
r.toList[i]? = UpwardEnumerable.succMany? (i + 1) r.lower := by
match h : UpwardEnumerable.succ? r.lower with
| none =>
simp [toList_eq_match, h, UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?]
simp [toList_eq_match, h, UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?]
| some next =>
rw [toList_Roi_eq_toList_Rci_of_isSome_succ? (by simp [h]), Rci.getElem?_toList_eq]
simp [succMany?_succ?_eq_succ?_bind_succMany?, h]
simp [succMany?_add_one_eq_succ?_bind_succMany?, h]
theorem getElem?_toArray_eq [LT α] [DecidableLT α] [UpwardEnumerable α] [LawfulUpwardEnumerable α]
[LawfulUpwardEnumerableLT α] [Rxi.IsAlwaysFinite α] {i} :

View File

@@ -43,7 +43,7 @@ instance : LawfulUpwardEnumerableLE Nat where
instance : LawfulUpwardEnumerable Nat where
succMany?_zero := by simp [UpwardEnumerable.succMany?]
succMany?_succ? := by simp [UpwardEnumerable.succMany?, UpwardEnumerable.succ?, Nat.add_assoc]
succMany?_add_one := by simp [UpwardEnumerable.succMany?, UpwardEnumerable.succ?, Nat.add_assoc]
ne_of_lt a b hlt := by
have hn := hlt.choose_spec
simp only [UpwardEnumerable.succMany?, Option.some.injEq] at hn
@@ -79,11 +79,10 @@ instance : LinearlyUpwardEnumerable Nat := inferInstance
end PRange
-- TODO: Replace the `lit` role with a `module` role?
/-!
The following instances are used for the implementation of array slices a.k.a.
{name (scope := "Init.Data.Array.Subarray")}`Subarray`.
See also {lit}`Init.Data.Slice.Array`.
See also {module -checked}`Init.Data.Slice.Array`.
-/
instance : Roo.HasRcoIntersection Nat where

View File

@@ -89,7 +89,7 @@ theorem Iterator.step_eq_monadicStep [UpwardEnumerable α] [LE α] [DecidableLE
instance [UpwardEnumerable α] [LE α] [DecidableLE α] :
Iterator (Rxc.Iterator α) Id α where
IsPlausibleStep it step := step = Iterator.Monadic.step it
step it := pure Iterator.Monadic.step it, rfl
step it := pure <| .deflate <| Iterator.Monadic.step it, rfl
theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α] [LE α] [DecidableLE α]
{it : IterM (α := Rxc.Iterator α) Id α} {step} :
@@ -98,7 +98,7 @@ theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α] [LE α] [Deci
theorem Iterator.Monadic.step_eq_step [UpwardEnumerable α] [LE α] [DecidableLE α]
{it : IterM (α := Rxc.Iterator α) Id α} :
it.step = pure Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl := by
it.step = pure (.deflate Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl) := by
simp [IterM.step, Iterators.Iterator.step]
theorem Iterator.isPlausibleStep_iff [UpwardEnumerable α] [LE α] [DecidableLE α]
@@ -265,7 +265,7 @@ private def Iterator.instFinitenessRelation [UpwardEnumerable α] [LE α] [Decid
| succ n ih =>
constructor
rintro it'
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at hn
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at hn
match hs : succ? init with
| none =>
simp only [hs]
@@ -346,7 +346,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α] [LE α] [DecidableLE
· apply IterM.IsPlausibleNthOutputStep.done
simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq']
· rename_i out
simp only [heq', Option.bind_some, succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [heq', Option.bind_some, succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out, it.internalState.upperBound
simp only [heq] at ih
by_cases heq'' : out it.internalState.upperBound
@@ -362,7 +362,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α] [LE α] [DecidableLE
rename_i out
simp only [heq', Option.bind_some] at heq
have hle : UpwardEnumerable.LE out _ := n + 1, heq
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out, it.internalState.upperBound
simp only [heq] at ih
by_cases hout : out it.internalState.upperBound
@@ -403,7 +403,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
obtain n, hn := ih
obtain a, ha, h₁, h₂, h₃ := h
refine n + 1, ?_
simp [ha, h₃, hn.2, succMany?_succ?_eq_succ?_bind_succMany?, h₂, hn]
simp [ha, h₃, hn.2, succMany?_add_one_eq_succ?_bind_succMany?, h₂, hn]
· rintro n, hn, hu
induction n generalizing it
case zero =>
@@ -416,7 +416,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
rename_i a
simp only [hn', Option.bind_some] at hn
have hle : UpwardEnumerable.LE a out := _, hn
rw [succMany?_succ?_eq_succ?_bind_succMany?] at hn
rw [succMany?_add_one_eq_succ?_bind_succMany?] at hn
cases hn' : succ? a
· simp only [hn', Option.bind_none, reduceCtorEq] at hn
rename_i a'
@@ -546,7 +546,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α] [LE α] [Decidab
(by
refine UpwardEnumerable.le_trans hl ?_
simp only [Monadic.isPlausibleIndirectOutput_iff, it',
succMany?_succ?_eq_succ?_bind_succMany?] at h
succMany?_add_one_eq_succ?_bind_succMany?] at h
exact h.choose + 1, h.choose_spec.1)
(by
simp only [Monadic.isPlausibleIndirectOutput_iff, it'] at h
@@ -562,7 +562,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α] [LE α] [Decidab
rw [IterM.DefaultConsumers.forIn']
simp only [Monadic.step_eq_step, Monadic.step, reduceIte, *,
Internal.LawfulMonadLiftBindFunction.liftBind_pure]
rw [loop_eq (lift := lift)]
rw [loop_eq (lift := lift), Shrink.inflate_deflate]
apply bind_congr
intro step
split
@@ -666,7 +666,7 @@ theorem Iterator.step_eq_monadicStep [UpwardEnumerable α] [LT α] [DecidableLT
instance [UpwardEnumerable α] [LT α] [DecidableLT α] :
Iterator (Rxo.Iterator α) Id α where
IsPlausibleStep it step := step = Iterator.Monadic.step it
step it := pure Iterator.Monadic.step it, rfl
step it := pure (.deflate Iterator.Monadic.step it, rfl)
theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α] [LT α] [DecidableLT α]
{it : IterM (α := Rxo.Iterator α) Id α} {step} :
@@ -675,7 +675,7 @@ theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α] [LT α] [Deci
theorem Iterator.Monadic.step_eq_step [UpwardEnumerable α] [LT α] [DecidableLT α]
{it : IterM (α := Rxo.Iterator α) Id α} :
it.step = pure Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl := by
it.step = pure (.deflate Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl) := by
simp [IterM.step, Iterators.Iterator.step]
theorem Iterator.isPlausibleStep_iff [UpwardEnumerable α] [LT α] [DecidableLT α]
@@ -842,7 +842,7 @@ private def Iterator.instFinitenessRelation [UpwardEnumerable α] [LT α] [Decid
| succ n ih =>
constructor
rintro it'
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at hn
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at hn
match hs : succ? init with
| none =>
simp only [hs]
@@ -923,7 +923,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α] [LT α] [DecidableLT
· apply IterM.IsPlausibleNthOutputStep.done
simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq']
· rename_i out
simp only [heq', Option.bind_some, succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [heq', Option.bind_some, succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out, it.internalState.upperBound
simp only [heq] at ih
by_cases heq'' : out < it.internalState.upperBound
@@ -939,7 +939,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α] [LT α] [DecidableLT
rename_i out
simp only [heq', Option.bind_some] at heq
have hlt : UpwardEnumerable.LT out _ := n, heq
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out, it.internalState.upperBound
simp only [heq] at ih
by_cases hout : out < it.internalState.upperBound
@@ -980,7 +980,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
obtain n, hn := ih
obtain a, ha, h₁, h₂, h₃ := h
refine n + 1, ?_
simp [ha, h₃, hn.2, succMany?_succ?_eq_succ?_bind_succMany?, h₂, hn]
simp [ha, h₃, hn.2, succMany?_add_one_eq_succ?_bind_succMany?, h₂, hn]
· rintro n, hn, hu
induction n generalizing it
case zero =>
@@ -993,7 +993,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
rename_i a
simp only [hn', Option.bind_some] at hn
have hlt : UpwardEnumerable.LT a out := _, hn
rw [succMany?_succ?_eq_succ?_bind_succMany?] at hn
rw [succMany?_add_one_eq_succ?_bind_succMany?] at hn
cases hn' : succ? a
· simp only [hn', Option.bind_none, reduceCtorEq] at hn
rename_i a'
@@ -1123,7 +1123,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α] [LT α] [Decidab
(by
refine UpwardEnumerable.le_trans hl ?_
simp only [Monadic.isPlausibleIndirectOutput_iff, it',
succMany?_succ?_eq_succ?_bind_succMany?] at h
succMany?_add_one_eq_succ?_bind_succMany?] at h
exact h.choose + 1, h.choose_spec.1)
(by
simp only [Monadic.isPlausibleIndirectOutput_iff, it'] at h
@@ -1139,7 +1139,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α] [LT α] [Decidab
rw [IterM.DefaultConsumers.forIn']
simp only [Monadic.step_eq_step, Monadic.step, reduceIte, *,
Internal.LawfulMonadLiftBindFunction.liftBind_pure]
rw [loop_eq (lift := lift)]
rw [loop_eq (lift := lift), Shrink.inflate_deflate]
apply bind_congr
intro step
split
@@ -1233,7 +1233,7 @@ theorem Iterator.step_eq_monadicStep [UpwardEnumerable α]
instance [UpwardEnumerable α] :
Iterator (Rxi.Iterator α) Id α where
IsPlausibleStep it step := step = Iterator.Monadic.step it
step it := pure Iterator.Monadic.step it, rfl
step it := pure (.deflate Iterator.Monadic.step it, rfl)
theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α]
{it : IterM (α := Rxi.Iterator α) Id α} {step} :
@@ -1242,7 +1242,7 @@ theorem Iterator.Monadic.isPlausibleStep_iff [UpwardEnumerable α]
theorem Iterator.Monadic.step_eq_step [UpwardEnumerable α]
{it : IterM (α := Rxi.Iterator α) Id α} :
it.step = pure Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl := by
it.step = pure (.deflate Iterator.Monadic.step it, isPlausibleStep_iff.mpr rfl) := by
simp [IterM.step, Iterators.Iterator.step]
theorem Iterator.isPlausibleStep_iff [UpwardEnumerable α]
@@ -1365,7 +1365,7 @@ private def Iterator.instFinitenessRelation [UpwardEnumerable α]
| succ n ih =>
constructor
rintro it'
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at hn
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at hn
match hs : succ? init with
| none =>
simp only [hs]
@@ -1433,7 +1433,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α]
· apply IterM.IsPlausibleNthOutputStep.done
simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq']
· rename_i out
simp only [heq', Option.bind_some, succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [heq', Option.bind_some, succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out
simp only [heq] at ih
· apply IterM.IsPlausibleNthOutputStep.yield
@@ -1446,7 +1446,7 @@ instance Iterator.instIteratorAccess [UpwardEnumerable α]
rename_i out
simp only [heq', Option.bind_some] at heq
have hlt : UpwardEnumerable.LT out _ := n, heq
simp only [succMany?_succ?_eq_succ?_bind_succMany?] at heq
simp only [succMany?_add_one_eq_succ?_bind_succMany?] at heq
specialize ih UpwardEnumerable.succ? out
simp only [heq] at ih
· apply IterM.IsPlausibleNthOutputStep.yield
@@ -1475,7 +1475,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
obtain n, hn := ih
obtain a, ha, h := h
refine n + 1, ?_
simp [ha, succMany?_succ?_eq_succ?_bind_succMany?, hn, h]
simp [ha, succMany?_add_one_eq_succ?_bind_succMany?, hn, h]
· rintro n, hn
induction n generalizing it
case zero =>
@@ -1488,7 +1488,7 @@ theorem Iterator.Monadic.isPlausibleIndirectOutput_iff
rename_i a
simp only [hn', Option.bind_some] at hn
have hlt : UpwardEnumerable.LT a out := _, hn
rw [succMany?_succ?_eq_succ?_bind_succMany?] at hn
rw [succMany?_add_one_eq_succ?_bind_succMany?] at hn
cases hn' : succ? a
· simp only [hn', Option.bind_none, reduceCtorEq] at hn
rename_i a'
@@ -1599,7 +1599,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α]
(by
refine UpwardEnumerable.le_trans hl ?_
simp only [Monadic.isPlausibleIndirectOutput_iff, it',
succMany?_succ?_eq_succ?_bind_succMany?] at h
succMany?_add_one_eq_succ?_bind_succMany?] at h
exact h.choose + 1, h.choose_spec)
c)
| .done c, _ => return c) := by
@@ -1615,7 +1615,7 @@ theorem Iterator.instIteratorLoop.loop_eq [UpwardEnumerable α]
rw [IterM.DefaultConsumers.forIn']
simp only [Monadic.step_eq_step, Monadic.step, *,
Internal.LawfulMonadLiftBindFunction.liftBind_pure]
rw [loop_eq (lift := lift)]
rw [loop_eq (lift := lift), Shrink.inflate_deflate]
apply bind_congr
intro step
split
@@ -1644,7 +1644,7 @@ instance Iterator.instLawfulIteratorLoop [UpwardEnumerable α]
simp only [Internal.LawfulMonadLiftBindFunction.liftBind_pure]
split
· rename_i it f next upperBound f'
rw [instIteratorLoop.loop_eq (lift := lift)]
rw [instIteratorLoop.loop_eq (lift := lift), Shrink.inflate_deflate]
apply bind_congr
intro step
split

View File

@@ -0,0 +1,681 @@
/-
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.Range.Polymorphic.Instances
public import Init.Data.Order.Lemmas
public import Init.Data.SInt
import Init.Omega
import Init.Data.Range.Polymorphic.UInt
import all Init.Data.SInt.Basic
import all Init.Data.Range.Polymorphic.Internal.SignedBitVec
open Std Std.PRange
namespace HasModel
open BitVec.Signed
variable {α : Type u} [LE α] [LT α] {β : Type v} [LE β] [LT β]
class _root_.HasModel (α : Type u) [LE α] [LT α] (β : outParam (Type v)) [LE β] [LT β]
[UpwardEnumerable β] [LawfulUpwardEnumerable β] [LawfulUpwardEnumerableLE β]
[LawfulUpwardEnumerableLT β] where
encode : α β
decode : β α
encode_decode : encode (decode x) = x
decode_encode : decode (encode x) = x
le_iff_encode_le : x y (encode x) (encode y)
lt_iff_encode_lt : x < y (encode x) < (encode y)
variable [UpwardEnumerable β] [LawfulUpwardEnumerable β] [LawfulUpwardEnumerableLE β]
[LawfulUpwardEnumerableLT β]
scoped instance instUpwardEnumerable [m : HasModel α β] :
UpwardEnumerable α where
succ? a := (succ? (m.encode a)).map m.decode
succMany? n a := (succMany? n (m.encode a)).map m.decode
theorem succ?_decode [m : HasModel α β] {x : β} :
UpwardEnumerable.succ? (m.decode x) = (UpwardEnumerable.succ? x).map m.decode := by
simp [instUpwardEnumerable, HasModel.encode_decode]
theorem succ?_encode [m : HasModel α β] {x : α} :
UpwardEnumerable.succ? (m.encode x) = (UpwardEnumerable.succ? x).map m.encode := by
simp [instUpwardEnumerable, Function.comp_def, HasModel.encode_decode]
theorem succMany?_decode [m : HasModel α β] {x : β} :
UpwardEnumerable.succMany? n' (m.decode x) = (UpwardEnumerable.succMany? n' x).map m.decode := by
simp [instUpwardEnumerable, HasModel.encode_decode]
theorem succMany?_encode [m : HasModel α β] {x : α} :
UpwardEnumerable.succMany? n' (m.encode x) = (UpwardEnumerable.succMany? n' x).map m.encode := by
simp [instUpwardEnumerable, Function.comp_def, HasModel.encode_decode]
theorem eq_of_encode_eq [m : HasModel α β] (x y : α) :
m.encode x = m.encode y x = y := by
intro h
simpa [m.decode_encode] using congrArg m.decode h
theorem encode_inj [m : HasModel α β] {x y : α} :
m.encode x = m.encode y x = y := by
exact m.eq_of_encode_eq x y, by simp +contextual
theorem le_iff [m : HasModel α β] {x y : α} :
UpwardEnumerable.LE x y UpwardEnumerable.LE (m.encode x) (m.encode y) := by
simp [UpwardEnumerable.le_iff_exists, succMany?_encode, Option.map_some,
Option.map_inj_right eq_of_encode_eq]
theorem lt_iff [m : HasModel α β] {x y : α} :
UpwardEnumerable.LT x y UpwardEnumerable.LT (m.encode x) (m.encode y) := by
simp [UpwardEnumerable.lt_iff_exists, succMany?_encode, Option.map_some,
Option.map_inj_right eq_of_encode_eq]
attribute [local instance] HasModel.instUpwardEnumerable
scoped instance instLawfulUpwardEnumerable [m : HasModel α β] :
LawfulUpwardEnumerable α where
ne_of_lt x y := by
rw [m.lt_iff, ne_eq, m.encode_inj]
apply LawfulUpwardEnumerable.ne_of_lt
succMany?_zero x := by
rw [ Option.map_inj_right eq_of_encode_eq, succMany?_encode, Option.map_some]
apply LawfulUpwardEnumerable.succMany?_zero
succMany?_add_one n x := by
rw [ Option.map_inj_right eq_of_encode_eq, succMany?_encode, Option.map_bind,
Function.comp_def]
simp only [ succ?_encode]
rw [ Function.comp_def, Option.bind_map, succMany?_encode (n' := n),
LawfulUpwardEnumerable.succMany?_add_one]
scoped instance instLawfulUpwardEnumerableLE [m : HasModel α β] :
LawfulUpwardEnumerableLE α where
le_iff x y := by
rw [m.le_iff_encode_le, m.le_iff]
apply LawfulUpwardEnumerableLE.le_iff
scoped instance instLawfulUpwardEnumerableLT [m : HasModel α β] :
LawfulUpwardEnumerableLT α where
lt_iff x y := by
rw [m.lt_iff_encode_lt, m.lt_iff]
apply LawfulUpwardEnumerableLT.lt_iff
instance : Rxc.HasSize Int8 where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
scoped instance instRxcHasSize [m : HasModel α β] [Rxc.HasSize β] :
Rxc.HasSize α where
size lo hi := Rxc.HasSize.size (m.encode lo) (m.encode hi)
scoped instance instRxcLawfulHasSize [m : HasModel α β] [Rxc.HasSize β] [Rxc.LawfulHasSize β] :
Rxc.LawfulHasSize α where
size_eq_zero_of_not_le lo hi := by
simp only [m.le_iff_encode_le, Rxc.HasSize.size]
apply Rxc.LawfulHasSize.size_eq_zero_of_not_le
size_eq_one_of_succ?_eq_none lo hi := by
simp only [m.le_iff_encode_le, Rxc.HasSize.size,
show succ? lo = none succ? (m.encode lo) = none by simp [m.succ?_encode]]
apply Rxc.LawfulHasSize.size_eq_one_of_succ?_eq_none
size_eq_succ_of_succ?_eq_some lo hi x := by
have : x, succ? lo = some x succ? (m.encode lo) = some (m.encode x) := by
simp [m.succ?_encode, Option.map_some, Option.map_inj_right m.eq_of_encode_eq]
simp only [m.le_iff_encode_le, Rxc.HasSize.size, this]
apply Rxc.LawfulHasSize.size_eq_succ_of_succ?_eq_some
scoped instance instRxiHasSize [m : HasModel α β] [Rxi.HasSize β] :
Rxi.HasSize α where
size lo := Rxi.HasSize.size (m.encode lo)
scoped instance instRxiLawfulHasSize [m : HasModel α β] [Rxi.HasSize β] [Rxi.LawfulHasSize β] :
Rxi.LawfulHasSize α where
size_eq_one_of_succ?_eq_none lo := by
have : succ? lo = none succ? (m.encode lo) = none := by simp [m.succ?_encode]
simp only [this, instRxiHasSize]
apply Rxi.LawfulHasSize.size_eq_one_of_succ?_eq_none
size_eq_succ_of_succ?_eq_some lo lo' := by
have : x, succ? lo = some x succ? (m.encode lo) = some (m.encode x) := by
simp [m.succ?_encode, Option.map_some, Option.map_inj_right m.eq_of_encode_eq]
simp only [this, instRxiHasSize]
apply Rxi.LawfulHasSize.size_eq_succ_of_succ?_eq_some
section AuxiliaryLemmas
/-!
The following lemmas are stated purely in terms of `BitVec n`. Their assumptions and statements
may seem technical, but they are exactly what is needed in the actual proofs.
-/
theorem succ?_eq_of_technicalCondition {α : Type u} [UpwardEnumerable α] [LE α] [LT α] [m : HasModel α (BitVec n)]
{x : α}
(h : y, succ? x = some y ¬ m.encode x + 1#n = BitVec.Signed.intMinSealed n m.encode x + 1#n = m.encode y) :
succ? x = (haveI := HasModel.instUpwardEnumerable (α := α); succ? x) := by
ext y
simp only [UpwardEnumerable.succ?, h]
rw [ Option.map_inj_right HasModel.eq_of_encode_eq, Option.map_map, Function.comp_def]
simp [HasModel.encode_decode, BitVec.eq_sub_iff_add_eq, rotate_eq_iff,
rotate_neg_eq_intMinSealed_sub, rotate_sub, rotate_rotate]
theorem succMany?_eq {α : Type u} [UpwardEnumerable α] [LE α] [LT α]
[m : HasModel α (BitVec n)] {x : α} {k} :
haveI := HasModel.instUpwardEnumerable (α := α)
succMany? k x = if (m.encode x).toInt + k (BitVec.Signed.intMaxSealed n).toInt then
some (m.decode (BitVec.ofInt n ((m.encode x).toInt + k)))
else
none := by
by_cases hn : n > 0; rotate_left
· cases show n = 0 by omega
simp [succMany?, BitVec.eq_nil (BitVec.Signed.rotate _), BitVec.eq_nil (.ofInt _ _),
BitVec.eq_nil (encode _), BitVec.eq_nil (BitVec.Signed.intMaxSealed _)]
have h : a b c d : Int, a - b + c d - b a + c d := by omega
simp [UpwardEnumerable.succMany?, BitVec.ofNatLT_eq_ofNat]
simp [toInt_eq_ofNat_toNat_rotate_sub hn, rotate_intMaxSealed, h]
simp only [ Int.natCast_add]
congr
· rw [Nat.lt_iff_add_one_le, Int.ofNat_le, Nat.le_sub_iff_add_le]
exact Nat.pow_pos (Nat.zero_lt_succ _)
· generalize rotate (HasModel.encode x) = x
simp only [ofNat_eq_rotate_ofInt_sub, rotate_rotate]
congr; omega
theorem toNat_toInt_add_one_sub_toInt {lo hi : BitVec n} (h : n > 0) :
(hi.toInt + 1 - lo.toInt).toNat = (rotate hi).toNat + 1 - (rotate lo).toNat := by
match n with
| 0 => omega
| n + 1 =>
simp only [toInt_eq_ofNat_toNat_rotate_sub h, rotate, BitVec.toNat_add, Int.natCast_emod,
show a b c d : Int, (a - b) + c - (d - b) = a + c - d by omega]
omega
theorem toNat_two_pow_sub_one_sub_toInt {lo : BitVec n} (h : n > 0) :
(2 ^ (n - 1) - lo.toInt).toNat = 2 ^ n - (rotate lo).toNat := by
simp only [toInt_eq_ofNat_toNat_rotate_sub h, intMinSealed_def, BitVec.natCast_eq_ofNat,
BitVec.toNat_ofNat, Int.natCast_emod, Int.natCast_pow, Int.cast_ofNat_Int]
rw [Int.emod_eq_of_lt, Int.sub_eq_add_neg, Int.neg_sub, Int.add_sub_assoc]; rotate_left
· exact Int.le_of_lt (Int.pow_pos (by omega))
· exact Int.pow_lt_pow_of_lt (by omega) (by omega)
simp [Int.toNat_sub', Int.toNat_pow_of_nonneg,
show (2 : Int) ^ (n - 1) + 2 ^ (n - 1) = 2 ^ (n - 1 + 1) by omega,
show n - 1 + 1 = n by omega]
end AuxiliaryLemmas
end HasModel
namespace Int8
open BitVec.Signed
open scoped HasModel
@[inline] def minValueSealed := Int8.minValue
@[inline] def maxValueSealed := Int8.maxValue
theorem minValueSealed_def : minValueSealed = Int8.minValue := (rfl)
theorem maxValueSealed_def : maxValueSealed = Int8.maxValue := (rfl)
seal minValueSealed maxValueSealed
theorem toBitVec_minValueSealed_eq_intMinSealed : minValueSealed.toBitVec = BitVec.Signed.intMinSealed 8 := by
simp [minValueSealed_def, BitVec.Signed.intMinSealed_def]
theorem toBitVec_maxValueSealed_eq_intMaxSealed : maxValueSealed.toBitVec = BitVec.Signed.intMaxSealed 8 := by
simp [maxValueSealed_def, BitVec.Signed.intMaxSealed_def]
@[no_expose]
public instance : UpwardEnumerable Int8 where
succ? i := if i + 1 = minValueSealed then none else some (i + 1)
succMany? n i :=
have := i.minValue_le_toInt
if h : i.toInt + n maxValueSealed.toInt then some (.ofIntLE _ (by omega) (maxValueSealed_def h)) else none
instance : Least? Int8 where
least? := some Int8.minValue
instance : LawfulUpwardEnumerableLeast? Int8 where
least?_le x := by
refine Int8.minValue, rfl, (x.toInt - Int8.minValue.toInt).toNat, ?_
simp only [succMany?, toInt_neg, Int8.reduceToInt, Int.neg_neg, Nat.reducePow, Int.reduceBmod,
Int.sub_neg, Int.ofNat_toNat, ofIntLE_eq_ofInt]
rw [Int.max_eq_left, Int.add_comm _ 128, Int.add_assoc]
· simp [maxValueSealed_def, toInt_le]
· have := le_toInt x
omega
instance : HasModel Int8 (BitVec 8) where
encode x := x.toBitVec
decode x := .ofBitVec x
encode_decode := by simp
decode_encode := by simp
le_iff_encode_le := by simp [Int8.le_iff_toBitVec_sle, BitVec.Signed.instLE]
lt_iff_encode_lt := by simp [Int8.lt_iff_toBitVec_slt, BitVec.Signed.instLT]
theorem instUpwardEnumerable_eq :
instUpwardEnumerable = HasModel.instUpwardEnumerable := by
apply UpwardEnumerable.ext
· apply funext; intro x
apply HasModel.succ?_eq_of_technicalCondition
simp [HasModel.encode, succ?, Int8.toBitVec_inj, toBitVec_minValueSealed_eq_intMinSealed]
· ext
simp [HasModel.succMany?_eq, instUpwardEnumerable, HasModel.encode, HasModel.decode,
toInt_toBitVec, toBitVec_maxValueSealed_eq_intMaxSealed, ofIntLE_eq_ofInt]
instance : LawfulUpwardEnumerable Int8 := by
simp only [instUpwardEnumerable_eq]
infer_instance
instance : LawfulUpwardEnumerableLE Int8 := by
simp only [instUpwardEnumerable_eq]
infer_instance
public instance instRxcHasSize : Rxc.HasSize Int8 where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
theorem instRxcHasSize_eq :
instRxcHasSize = HasModel.instRxcHasSize := by
simp only [instRxcHasSize, HasModel.instRxcHasSize, Rxc.HasSize.size, HasModel.encode,
toInt_toBitVec, HasModel.toNat_toInt_add_one_sub_toInt (Nat.zero_lt_succ _)]
public instance instRxcLawfulHasSize : Rxc.LawfulHasSize Int8 := by
simp only [instUpwardEnumerable_eq, instRxcHasSize_eq]
infer_instance
public instance : Rxc.IsAlwaysFinite Int8 := by exact inferInstance
public instance instRxoHasSize : Rxo.HasSize Int8 := .ofClosed
public instance instRxoLawfulHasSize : Rxo.LawfulHasSize Int8 := by exact inferInstance
public instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite Int8 := by exact inferInstance
public instance instRxiHasSize : Rxi.HasSize Int8 where
size lo := ((2 : Int) ^ 7 - lo.toInt).toNat
theorem instRxiHasSize_eq :
instRxiHasSize = HasModel.instRxiHasSize := by
simp only [instRxiHasSize, HasModel.instRxiHasSize, Rxi.HasSize.size, toInt_toBitVec,
HasModel.encode, HasModel.toNat_two_pow_sub_one_sub_toInt (show 8 > 0 by omega)]
public instance instRxiLawfulHasSize : Rxi.LawfulHasSize Int8 := by
simp only [instUpwardEnumerable_eq, instRxiHasSize_eq]
infer_instance
public instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite Int8 := by exact inferInstance
end Int8
namespace Int16
open BitVec.Signed
open scoped HasModel
@[inline] def minValueSealed := Int16.minValue
@[inline] def maxValueSealed := Int16.maxValue
theorem minValueSealed_def : minValueSealed = Int16.minValue := (rfl)
theorem maxValueSealed_def : maxValueSealed = Int16.maxValue := (rfl)
seal minValueSealed maxValueSealed
theorem toBitVec_minValueSealed_eq_intMinSealed : minValueSealed.toBitVec = BitVec.Signed.intMinSealed 16 := by
simp [minValueSealed_def, BitVec.Signed.intMinSealed_def]
theorem toBitVec_maxValueSealed_eq_intMaxSealed : maxValueSealed.toBitVec = BitVec.Signed.intMaxSealed 16 := by
simp [maxValueSealed_def, BitVec.Signed.intMaxSealed_def]
@[no_expose]
public instance : UpwardEnumerable Int16 where
succ? i := if i + 1 = minValueSealed then none else some (i + 1)
succMany? n i :=
have := i.minValue_le_toInt
if h : i.toInt + n maxValueSealed.toInt then some (.ofIntLE _ (by omega) (maxValueSealed_def h)) else none
instance : Least? Int16 where
least? := some Int16.minValue
instance : LawfulUpwardEnumerableLeast? Int16 where
least?_le x := by
refine Int16.minValue, rfl, (x.toInt - Int16.minValue.toInt).toNat, ?_
simp only [succMany?, toInt_neg, Int16.reduceToInt, Int.neg_neg, Nat.reducePow, Int.reduceBmod,
Int.sub_neg, Int.ofNat_toNat, ofIntLE_eq_ofInt]
rw [Int.max_eq_left, Int.add_comm _ 32768, Int.add_assoc]
· simp [maxValueSealed_def, toInt_le]
· have := le_toInt x
omega
instance : HasModel Int16 (BitVec 16) where
encode x := x.toBitVec
decode x := .ofBitVec x
encode_decode := by simp
decode_encode := by simp
le_iff_encode_le := by simp [Int16.le_iff_toBitVec_sle, BitVec.Signed.instLE]
lt_iff_encode_lt := by simp [Int16.lt_iff_toBitVec_slt, BitVec.Signed.instLT]
theorem instUpwardEnumerable_eq :
instUpwardEnumerable = HasModel.instUpwardEnumerable := by
apply UpwardEnumerable.ext
· apply funext; intro x
apply HasModel.succ?_eq_of_technicalCondition
simp [HasModel.encode, succ?, Int16.toBitVec_inj, toBitVec_minValueSealed_eq_intMinSealed]
· ext
simp [HasModel.succMany?_eq, instUpwardEnumerable, HasModel.encode, HasModel.decode,
toInt_toBitVec, toBitVec_maxValueSealed_eq_intMaxSealed, ofIntLE_eq_ofInt]
instance : LawfulUpwardEnumerable Int16 := by
simp only [instUpwardEnumerable_eq]
infer_instance
instance : LawfulUpwardEnumerableLE Int16 := by
simp only [instUpwardEnumerable_eq]
infer_instance
public instance instRxcHasSize : Rxc.HasSize Int16 where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
theorem instRxcHasSize_eq :
instRxcHasSize = HasModel.instRxcHasSize := by
simp only [instRxcHasSize, HasModel.instRxcHasSize, Rxc.HasSize.size, HasModel.encode,
toInt_toBitVec, HasModel.toNat_toInt_add_one_sub_toInt (Nat.zero_lt_succ _)]
public instance instRxcLawfulHasSize : Rxc.LawfulHasSize Int16 := by
simp only [instUpwardEnumerable_eq, instRxcHasSize_eq]
infer_instance
public instance : Rxc.IsAlwaysFinite Int16 := by exact inferInstance
public instance instRxoHasSize : Rxo.HasSize Int16 := .ofClosed
public instance instRxoLawfulHasSize : Rxo.LawfulHasSize Int16 := by exact inferInstance
public instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite Int16 := by exact inferInstance
public instance instRxiHasSize : Rxi.HasSize Int16 where
size lo := ((2 : Int) ^ 15 - lo.toInt).toNat
theorem instRxiHasSize_eq :
instRxiHasSize = HasModel.instRxiHasSize := by
simp only [instRxiHasSize, HasModel.instRxiHasSize, Rxi.HasSize.size, toInt_toBitVec,
HasModel.encode, HasModel.toNat_two_pow_sub_one_sub_toInt (show 16 > 0 by omega)]
public instance instRxiLawfulHasSize : Rxi.LawfulHasSize Int16 := by
simp only [instUpwardEnumerable_eq, instRxiHasSize_eq]
infer_instance
public instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite Int16 := by exact inferInstance
end Int16
namespace Int32
open BitVec.Signed
open scoped HasModel
@[inline] def minValueSealed := Int32.minValue
@[inline] def maxValueSealed := Int32.maxValue
theorem minValueSealed_def : minValueSealed = Int32.minValue := (rfl)
theorem maxValueSealed_def : maxValueSealed = Int32.maxValue := (rfl)
seal minValueSealed maxValueSealed
theorem toBitVec_minValueSealed_eq_intMinSealed : minValueSealed.toBitVec = BitVec.Signed.intMinSealed 32 := by
simp [minValueSealed_def, BitVec.Signed.intMinSealed_def]
theorem toBitVec_maxValueSealed_eq_intMaxSealed : maxValueSealed.toBitVec = BitVec.Signed.intMaxSealed 32 := by
simp [maxValueSealed_def, BitVec.Signed.intMaxSealed_def]
@[no_expose]
public instance : UpwardEnumerable Int32 where
succ? i := if i + 1 = minValueSealed then none else some (i + 1)
succMany? n i :=
have := i.minValue_le_toInt
if h : i.toInt + n maxValueSealed.toInt then some (.ofIntLE _ (by omega) (maxValueSealed_def h)) else none
instance : Least? Int32 where
least? := some Int32.minValue
instance : LawfulUpwardEnumerableLeast? Int32 where
least?_le x := by
refine Int32.minValue, rfl, (x.toInt - Int32.minValue.toInt).toNat, ?_
simp only [succMany?, toInt_neg, Int32.reduceToInt, Int.neg_neg, Nat.reducePow, Int.reduceBmod,
Int.sub_neg, Int.ofNat_toNat, ofIntLE_eq_ofInt]
rw [Int.max_eq_left, Int.add_comm _ (OfNat.ofNat _), Int.add_assoc]
· simp [maxValueSealed_def, toInt_le]
· have := le_toInt x
omega
instance : HasModel Int32 (BitVec 32) where
encode x := x.toBitVec
decode x := .ofBitVec x
encode_decode := by simp
decode_encode := by simp
le_iff_encode_le := by simp [Int32.le_iff_toBitVec_sle, BitVec.Signed.instLE]
lt_iff_encode_lt := by simp [Int32.lt_iff_toBitVec_slt, BitVec.Signed.instLT]
theorem instUpwardEnumerable_eq :
instUpwardEnumerable = HasModel.instUpwardEnumerable := by
apply UpwardEnumerable.ext
· apply funext; intro x
apply HasModel.succ?_eq_of_technicalCondition
simp [HasModel.encode, succ?, Int32.toBitVec_inj, toBitVec_minValueSealed_eq_intMinSealed]
· ext
simp [HasModel.succMany?_eq, instUpwardEnumerable, HasModel.encode, HasModel.decode,
toInt_toBitVec, toBitVec_maxValueSealed_eq_intMaxSealed, ofIntLE_eq_ofInt]
instance : LawfulUpwardEnumerable Int32 := by
simp only [instUpwardEnumerable_eq]
infer_instance
instance : LawfulUpwardEnumerableLE Int32 := by
simp only [instUpwardEnumerable_eq]
infer_instance
public instance instRxcHasSize : Rxc.HasSize Int32 where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
theorem instRxcHasSize_eq :
instRxcHasSize = HasModel.instRxcHasSize := by
simp only [instRxcHasSize, HasModel.instRxcHasSize, Rxc.HasSize.size, HasModel.encode,
toInt_toBitVec, HasModel.toNat_toInt_add_one_sub_toInt (Nat.zero_lt_succ _)]
public instance instRxcLawfulHasSize : Rxc.LawfulHasSize Int32 := by
simp only [instUpwardEnumerable_eq, instRxcHasSize_eq]
infer_instance
public instance : Rxc.IsAlwaysFinite Int32 := by exact inferInstance
public instance instRxoHasSize : Rxo.HasSize Int32 := .ofClosed
public instance instRxoLawfulHasSize : Rxo.LawfulHasSize Int32 := by exact inferInstance
public instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite Int32 := by exact inferInstance
public instance instRxiHasSize : Rxi.HasSize Int32 where
size lo := ((2 : Int) ^ 31 - lo.toInt).toNat
theorem instRxiHasSize_eq :
instRxiHasSize = HasModel.instRxiHasSize := by
simp only [instRxiHasSize, HasModel.instRxiHasSize, Rxi.HasSize.size, toInt_toBitVec,
HasModel.encode, HasModel.toNat_two_pow_sub_one_sub_toInt (show 32 > 0 by omega)]
public instance instRxiLawfulHasSize : Rxi.LawfulHasSize Int32 := by
simp only [instUpwardEnumerable_eq, instRxiHasSize_eq]
infer_instance
public instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite Int32 := by exact inferInstance
end Int32
namespace Int64
open BitVec.Signed
open scoped HasModel
@[inline] def minValueSealed := Int64.minValue
@[inline] def maxValueSealed := Int64.maxValue
theorem minValueSealed_def : minValueSealed = Int64.minValue := (rfl)
theorem maxValueSealed_def : maxValueSealed = Int64.maxValue := (rfl)
seal minValueSealed maxValueSealed
theorem toBitVec_minValueSealed_eq_intMinSealed : minValueSealed.toBitVec = BitVec.Signed.intMinSealed 64 := by
simp [minValueSealed_def, BitVec.Signed.intMinSealed_def]
theorem toBitVec_maxValueSealed_eq_intMaxSealed : maxValueSealed.toBitVec = BitVec.Signed.intMaxSealed 64 := by
simp [maxValueSealed_def, BitVec.Signed.intMaxSealed_def]
@[no_expose]
public instance : UpwardEnumerable Int64 where
succ? i := if i + 1 = minValueSealed then none else some (i + 1)
succMany? n i :=
have := i.minValue_le_toInt
if h : i.toInt + n maxValueSealed.toInt then some (.ofIntLE _ (by omega) (maxValueSealed_def h)) else none
instance : Least? Int64 where
least? := some Int64.minValue
instance : LawfulUpwardEnumerableLeast? Int64 where
least?_le x := by
refine Int64.minValue, rfl, (x.toInt - Int64.minValue.toInt).toNat, ?_
simp only [succMany?, toInt_neg, Int64.reduceToInt, Int.neg_neg, Nat.reducePow, Int.reduceBmod,
Int.sub_neg, Int.ofNat_toNat, ofIntLE_eq_ofInt]
rw [Int.max_eq_left, Int.add_comm _ (OfNat.ofNat _), Int.add_assoc]
· simp [maxValueSealed_def, toInt_le]
· have := le_toInt x
omega
instance : HasModel Int64 (BitVec 64) where
encode x := x.toBitVec
decode x := .ofBitVec x
encode_decode := by simp
decode_encode := by simp
le_iff_encode_le := by simp [Int64.le_iff_toBitVec_sle, BitVec.Signed.instLE]
lt_iff_encode_lt := by simp [Int64.lt_iff_toBitVec_slt, BitVec.Signed.instLT]
theorem instUpwardEnumerable_eq :
instUpwardEnumerable = HasModel.instUpwardEnumerable := by
apply UpwardEnumerable.ext
· apply funext; intro x
apply HasModel.succ?_eq_of_technicalCondition
simp [HasModel.encode, succ?, Int64.toBitVec_inj, toBitVec_minValueSealed_eq_intMinSealed]
· ext
simp [HasModel.succMany?_eq, instUpwardEnumerable, HasModel.encode, HasModel.decode,
toInt_toBitVec, toBitVec_maxValueSealed_eq_intMaxSealed, ofIntLE_eq_ofInt]
instance : LawfulUpwardEnumerable Int64 := by
simp only [instUpwardEnumerable_eq]
infer_instance
instance : LawfulUpwardEnumerableLE Int64 := by
simp only [instUpwardEnumerable_eq]
infer_instance
public instance instRxcHasSize : Rxc.HasSize Int64 where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
theorem instRxcHasSize_eq :
instRxcHasSize = HasModel.instRxcHasSize := by
simp only [instRxcHasSize, HasModel.instRxcHasSize, Rxc.HasSize.size, HasModel.encode,
toInt_toBitVec, HasModel.toNat_toInt_add_one_sub_toInt (Nat.zero_lt_succ _)]
public instance instRxcLawfulHasSize : Rxc.LawfulHasSize Int64 := by
simp only [instUpwardEnumerable_eq, instRxcHasSize_eq]
infer_instance
public instance : Rxc.IsAlwaysFinite Int64 := by exact inferInstance
public instance instRxoHasSize : Rxo.HasSize Int64 := .ofClosed
public instance instRxoLawfulHasSize : Rxo.LawfulHasSize Int64 := by exact inferInstance
public instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite Int64 := by exact inferInstance
public instance instRxiHasSize : Rxi.HasSize Int64 where
size lo := ((2 : Int) ^ 63 - lo.toInt).toNat
theorem instRxiHasSize_eq :
instRxiHasSize = HasModel.instRxiHasSize := by
simp only [instRxiHasSize, HasModel.instRxiHasSize, Rxi.HasSize.size, toInt_toBitVec,
HasModel.encode, HasModel.toNat_two_pow_sub_one_sub_toInt (show 64 > 0 by omega)]
public instance instRxiLawfulHasSize : Rxi.LawfulHasSize Int64 := by
simp only [instUpwardEnumerable_eq, instRxiHasSize_eq]
infer_instance
public instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite Int64 := by exact inferInstance
end Int64
namespace ISize
open BitVec.Signed
open scoped HasModel
@[inline] def minValueSealed := ISize.minValue
@[inline] def maxValueSealed := ISize.maxValue
theorem minValueSealed_def : minValueSealed = ISize.minValue := (rfl)
theorem maxValueSealed_def : maxValueSealed = ISize.maxValue := (rfl)
seal minValueSealed maxValueSealed
private theorem toBitVec_minValueSealed_eq_intMinSealed :
minValueSealed.toBitVec = BitVec.Signed.intMinSealed System.Platform.numBits := by
rw [minValueSealed_def, BitVec.Signed.intMinSealed_def, toBitVec_minValue]
have := System.Platform.numBits_eq; generalize System.Platform.numBits = a at this
rcases this with rfl | rfl <;> rfl
private theorem toBitVec_maxValueSealed_eq_intMaxSealed :
maxValueSealed.toBitVec = BitVec.Signed.intMaxSealed System.Platform.numBits := by
rw [maxValueSealed_def, BitVec.Signed.intMaxSealed_def, toBitVec_maxValue]
have := System.Platform.numBits_eq; generalize System.Platform.numBits = a at this
rcases this with rfl | rfl <;> rfl
@[no_expose]
public instance : UpwardEnumerable ISize where
succ? i := if i + 1 = minValueSealed then none else some (i + 1)
succMany? n i :=
have := i.minValue_le_toInt
if h : i.toInt + n maxValueSealed.toInt then some (.ofIntLE _ (by omega) (maxValueSealed_def h)) else none
instance : Least? ISize where
least? := some ISize.minValue
instance : LawfulUpwardEnumerableLeast? ISize where
least?_le x := by
refine ISize.minValue, rfl, (x.toInt - ISize.minValue.toInt).toNat, ?_
simp only [succMany?, Int.ofNat_toNat, ofIntLE_eq_ofInt, maxValueSealed]
rw [Int.max_eq_left, Int.sub_eq_add_neg, Int.add_comm _ (-minValue.toInt), Int.add_assoc,
Int.sub_eq_add_neg, Int.sub_self, Int.zero_add, dif_pos (toInt_le x), ofInt_toInt]
have := minValue_le_toInt x
omega
instance : HasModel ISize (BitVec System.Platform.numBits) where
encode x := x.toBitVec
decode x := .ofBitVec x
encode_decode := by simp
decode_encode := by simp
le_iff_encode_le := by simp [ISize.le_iff_toBitVec_sle, BitVec.Signed.instLE]
lt_iff_encode_lt := by simp [ISize.lt_iff_toBitVec_slt, BitVec.Signed.instLT]
theorem instUpwardEnumerable_eq :
instUpwardEnumerable = HasModel.instUpwardEnumerable := by
apply UpwardEnumerable.ext
· apply funext; intro x
apply HasModel.succ?_eq_of_technicalCondition
simp [HasModel.encode, succ?, ISize.toBitVec_inj, toBitVec_minValueSealed_eq_intMinSealed]
· ext
simp [HasModel.succMany?_eq, instUpwardEnumerable, HasModel.encode, HasModel.decode,
toInt_toBitVec, toBitVec_maxValueSealed_eq_intMaxSealed, ofIntLE_eq_ofInt]
instance : LawfulUpwardEnumerable ISize := by
simp only [instUpwardEnumerable_eq]
infer_instance
instance : LawfulUpwardEnumerableLE ISize := by
simp only [instUpwardEnumerable_eq]
infer_instance
public instance instRxcHasSize : Rxc.HasSize ISize where
size lo hi := (hi.toInt + 1 - lo.toInt).toNat
theorem instRxcHasSize_eq :
instRxcHasSize = HasModel.instRxcHasSize := by
simp only [instRxcHasSize, HasModel.instRxcHasSize, Rxc.HasSize.size, HasModel.encode,
toInt_toBitVec, HasModel.toNat_toInt_add_one_sub_toInt System.Platform.numBits_pos]
public instance instRxcLawfulHasSize : Rxc.LawfulHasSize ISize := by
simp only [instUpwardEnumerable_eq, instRxcHasSize_eq]
infer_instance
public instance : Rxc.IsAlwaysFinite ISize := by exact inferInstance
public instance instRxoHasSize : Rxo.HasSize ISize := .ofClosed
public instance instRxoLawfulHasSize : Rxo.LawfulHasSize ISize := by exact inferInstance
public instance instRxoIsAlwaysFinite : Rxo.IsAlwaysFinite ISize := by exact inferInstance
public instance instRxiHasSize : Rxi.HasSize ISize where
size lo := ((2 : Int) ^ (System.Platform.numBits - 1) - lo.toInt).toNat
theorem instRxiHasSize_eq :
instRxiHasSize = HasModel.instRxiHasSize := by
simp only [instRxiHasSize, HasModel.instRxiHasSize, Rxi.HasSize.size, toInt_toBitVec,
HasModel.encode, HasModel.toNat_two_pow_sub_one_sub_toInt System.Platform.numBits_pos]
public instance instRxiLawfulHasSize : Rxi.LawfulHasSize ISize := by
simp only [instUpwardEnumerable_eq, instRxiHasSize_eq]
infer_instance
public instance instRxiIsAlwaysFinite : Rxi.IsAlwaysFinite ISize := by exact inferInstance
end ISize

View File

@@ -22,6 +22,12 @@ instance : UpwardEnumerable UInt8 where
succ? i := if i + 1 = 0 then none else some (i + 1)
succMany? n i := if h : i.toNat + n < UInt8.size then some (.ofNatLT _ h) else none
instance : Least? UInt8 where
least? := some 0
instance : LawfulUpwardEnumerableLeast? UInt8 where
least?_le a := 0, rfl, a.toNat, by simpa [succMany?] using UInt8.toNat_lt a
theorem succ?_ofBitVec {x : BitVec 8} :
UpwardEnumerable.succ? (UInt8.ofBitVec x) = UInt8.ofBitVec <$> UpwardEnumerable.succ? x := by
simp only [succ?, BitVec.ofNat_eq_ofNat, Option.map_eq_map, UInt8.toBitVec_inj]
@@ -46,9 +52,9 @@ instance : LawfulUpwardEnumerable UInt8 where
succMany?_zero x := by
cases x
simpa [succMany?_ofBitVec] using succMany?_zero
succMany?_succ? n x := by
succMany?_add_one n x := by
cases x
simp [succMany?_ofBitVec, succMany?_succ?, Option.bind_map, Function.comp_def,
simp [succMany?_ofBitVec, succMany?_add_one, Option.bind_map, Function.comp_def,
succ?_ofBitVec]
instance : LawfulUpwardEnumerableLE UInt8 where
@@ -112,6 +118,12 @@ instance : UpwardEnumerable UInt16 where
succ? i := if i + 1 = 0 then none else some (i + 1)
succMany? n i := if h : i.toNat + n < UInt16.size then some (.ofNatLT _ h) else none
instance : Least? UInt16 where
least? := some 0
instance : LawfulUpwardEnumerableLeast? UInt16 where
least?_le a := 0, rfl, a.toNat, by simpa [succMany?] using UInt16.toNat_lt a
theorem succ?_ofBitVec {x : BitVec 16} :
UpwardEnumerable.succ? (UInt16.ofBitVec x) = UInt16.ofBitVec <$> UpwardEnumerable.succ? x := by
simp only [succ?, BitVec.ofNat_eq_ofNat, Option.map_eq_map, UInt16.toBitVec_inj]
@@ -136,9 +148,9 @@ instance : LawfulUpwardEnumerable UInt16 where
succMany?_zero x := by
cases x
simpa [succMany?_ofBitVec] using succMany?_zero
succMany?_succ? n x := by
succMany?_add_one n x := by
cases x
simp [succMany?_ofBitVec, succMany?_succ?, Option.bind_map, Function.comp_def,
simp [succMany?_ofBitVec, succMany?_add_one, Option.bind_map, Function.comp_def,
succ?_ofBitVec]
instance : LawfulUpwardEnumerableLE UInt16 where
@@ -202,6 +214,12 @@ instance : UpwardEnumerable UInt32 where
succ? i := if i + 1 = 0 then none else some (i + 1)
succMany? n i := if h : i.toNat + n < UInt32.size then some (.ofNatLT _ h) else none
instance : Least? UInt32 where
least? := some 0
instance : LawfulUpwardEnumerableLeast? UInt32 where
least?_le a := 0, rfl, a.toNat, by simpa [succMany?] using UInt32.toNat_lt a
theorem succ?_ofBitVec {x : BitVec 32} :
UpwardEnumerable.succ? (UInt32.ofBitVec x) = UInt32.ofBitVec <$> UpwardEnumerable.succ? x := by
simp only [succ?, BitVec.ofNat_eq_ofNat, Option.map_eq_map, UInt32.toBitVec_inj]
@@ -226,9 +244,9 @@ instance : LawfulUpwardEnumerable UInt32 where
succMany?_zero x := by
cases x
simpa [succMany?_ofBitVec] using succMany?_zero
succMany?_succ? n x := by
succMany?_add_one n x := by
cases x
simp [succMany?_ofBitVec, succMany?_succ?, Option.bind_map, Function.comp_def,
simp [succMany?_ofBitVec, succMany?_add_one, Option.bind_map, Function.comp_def,
succ?_ofBitVec]
instance : LawfulUpwardEnumerableLE UInt32 where
@@ -292,6 +310,12 @@ instance : UpwardEnumerable UInt64 where
succ? i := if i + 1 = 0 then none else some (i + 1)
succMany? n i := if h : i.toNat + n < UInt64.size then some (.ofNatLT _ h) else none
instance : Least? UInt64 where
least? := some 0
instance : LawfulUpwardEnumerableLeast? UInt64 where
least?_le a := 0, rfl, a.toNat, by simpa [succMany?] using UInt64.toNat_lt a
theorem succ?_ofBitVec {x : BitVec 64} :
UpwardEnumerable.succ? (UInt64.ofBitVec x) = UInt64.ofBitVec <$> UpwardEnumerable.succ? x := by
simp only [succ?, BitVec.ofNat_eq_ofNat, Option.map_eq_map, UInt64.toBitVec_inj]
@@ -316,9 +340,9 @@ instance : LawfulUpwardEnumerable UInt64 where
succMany?_zero x := by
cases x
simpa [succMany?_ofBitVec] using succMany?_zero
succMany?_succ? n x := by
succMany?_add_one n x := by
cases x
simp [succMany?_ofBitVec, succMany?_succ?, Option.bind_map, Function.comp_def,
simp [succMany?_ofBitVec, succMany?_add_one, Option.bind_map, Function.comp_def,
succ?_ofBitVec]
instance : LawfulUpwardEnumerableLE UInt64 where
@@ -382,6 +406,12 @@ instance : UpwardEnumerable USize where
succ? i := if i + 1 = 0 then none else some (i + 1)
succMany? n i := if h : i.toNat + n < USize.size then some (.ofNatLT _ h) else none
instance : Least? USize where
least? := some 0
instance : LawfulUpwardEnumerableLeast? USize where
least?_le a := 0, rfl, a.toNat, by simpa [succMany?] using USize.toNat_lt_size a
theorem succ?_ofBitVec {x : BitVec System.Platform.numBits} :
UpwardEnumerable.succ? (USize.ofBitVec x) = USize.ofBitVec <$> UpwardEnumerable.succ? x := by
simp only [succ?, BitVec.ofNat_eq_ofNat, Option.map_eq_map, USize.toBitVec_inj]
@@ -406,9 +436,9 @@ instance : LawfulUpwardEnumerable USize where
succMany?_zero x := by
cases x
simpa [succMany?_ofBitVec] using succMany?_zero
succMany?_succ? n x := by
succMany?_add_one n x := by
cases x
simp [succMany?_ofBitVec, succMany?_succ?, Option.bind_map, Function.comp_def,
simp [succMany?_ofBitVec, succMany?_add_one, Option.bind_map, Function.comp_def,
succ?_ofBitVec]
instance : LawfulUpwardEnumerableLE USize where

View File

@@ -27,6 +27,7 @@ These properties and the compatibility of `succ?` with `succMany?` are encoded i
`LawfulUpwardEnumerable`, `LawfulUpwardEnumerableLE` and `LawfulUpwardEnumerableLT`.
-/
@[ext]
class UpwardEnumerable (α : Type u) where
/-- Maps elements of `α` to their successor, or none if no successor exists. -/
succ? : α Option α
@@ -51,7 +52,7 @@ successor of `a`.
protected def UpwardEnumerable.LE {α : Type u} [UpwardEnumerable α] (a b : α) : Prop :=
n, succMany? n a = some b
protected theorem UpwardEnumerable.le_iff_exists {α : Type u} [UpwardEnumerable α] {a b : α} :
protected theorem UpwardEnumerable.le_iff_exists {α : Type u} {_ : UpwardEnumerable α} {a b : α} :
UpwardEnumerable.LE a b n, succMany? n a = some b :=
Iff.rfl
@@ -102,27 +103,33 @@ class LawfulUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
The `n + 1`-th successor of `a` is the successor of the `n`-th successor, given that said
successors actually exist.
-/
succMany?_succ? (n : Nat) (a : α) :
succMany?_add_one (n : Nat) (a : α) :
succMany? (n + 1) a = (succMany? n a).bind succ?
theorem UpwardEnumerable.succMany?_zero [UpwardEnumerable α] [LawfulUpwardEnumerable α] {a : α} :
succMany? 0 a = some a :=
LawfulUpwardEnumerable.succMany?_zero a
theorem UpwardEnumerable.succMany?_add_one [UpwardEnumerable α] [LawfulUpwardEnumerable α]
{n : Nat} {a : α} :
succMany? (n + 1) a = (succMany? n a).bind succ? :=
LawfulUpwardEnumerable.succMany?_add_one n a
@[deprecated succMany?_add_one (since := "2025-09-03")]
theorem UpwardEnumerable.succMany?_succ? [UpwardEnumerable α] [LawfulUpwardEnumerable α]
{n : Nat} {a : α} :
succMany? (n + 1) a = (succMany? n a).bind succ? :=
LawfulUpwardEnumerable.succMany?_succ? n a
succMany?_add_one
@[deprecated succMany?_succ? (since := "2025-09-03")]
@[deprecated succMany?_add_one (since := "2025-09-03")]
theorem UpwardEnumerable.succMany?_succ [UpwardEnumerable α] [LawfulUpwardEnumerable α]
{n : Nat} {a : α} :
succMany? (n + 1) a = (succMany? n a).bind succ? :=
succMany?_succ?
succMany?_add_one
theorem UpwardEnumerable.succMany?_one [UpwardEnumerable α] [LawfulUpwardEnumerable α] {a : α} :
succMany? 1 a = succ? a := by
simp [succMany?_succ?, succMany?_zero]
simp [succMany?_add_one, succMany?_zero]
theorem UpwardEnumerable.succMany?_add [UpwardEnumerable α] [LawfulUpwardEnumerable α]
{m n : Nat} {a : α} :
@@ -130,25 +137,33 @@ theorem UpwardEnumerable.succMany?_add [UpwardEnumerable α] [LawfulUpwardEnumer
induction n
case zero => simp [succMany?_zero]
case succ n ih =>
rw [ Nat.add_assoc, succMany?_succ?, ih, Option.bind_assoc]
simp [succMany?_succ?]
rw [ Nat.add_assoc, succMany?_add_one, ih, Option.bind_assoc]
simp [succMany?_add_one]
theorem UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?
theorem UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?
[UpwardEnumerable α] [LawfulUpwardEnumerable α]
{n : Nat} {a : α} :
succMany? (n + 1) a = (succ? a).bind (succMany? n ·) := by
rw [Nat.add_comm]
simp [succMany?_add, succMany?_succ?, succMany?_zero]
simp [succMany?_add, succMany?_add_one, succMany?_zero]
@[deprecated UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany? (since := "2025-09-03")]
@[deprecated UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany? (since := "2025-09-03")]
theorem UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?
[UpwardEnumerable α] [LawfulUpwardEnumerable α]
(n : Nat) (a : α) :
succMany? (n + 1) a = (succ? a).bind (succMany? n ·) :=
UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?
@[deprecated UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany? (since := "2025-09-03")]
theorem LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?
[UpwardEnumerable α] [LawfulUpwardEnumerable α]
(n : Nat) (a : α) :
succMany? (n + 1) a = (succ? a).bind (succMany? n ·) :=
UpwardEnumerable.succMany?_succ?_eq_succ?_bind_succMany?
UpwardEnumerable.succMany?_add_one_eq_succ?_bind_succMany?
export UpwardEnumerable (succMany?_zero succMany?_succ? succMany?_one succMany?_add
succMany?_succ?_eq_succ?_bind_succMany?)
export UpwardEnumerable (succMany?_zero succMany?_succ? succMany?_add_one succMany?_one
succMany?_add succMany?_succ?_eq_succ?_bind_succMany?
succMany?_add_one_eq_succ?_bind_succMany?)
protected theorem UpwardEnumerable.le_refl {α : Type u} [UpwardEnumerable α]
[LawfulUpwardEnumerable α] (a : α) : UpwardEnumerable.LE a a :=
@@ -293,7 +308,7 @@ theorem UpwardEnumerable.isSome_succMany? {α : Type u} [UpwardEnumerable α]
induction n
· simp [succMany?_zero]
· rename_i ih
simp only [succMany?_succ?]
simp only [succMany?_add_one]
rw [ Option.some_get ih, Option.bind_some]
apply InfinitelyUpwardEnumerable.isSome_succ?
@@ -340,12 +355,12 @@ theorem UpwardEnumerable.succMany_one {α : Type u} [UpwardEnumerable α]
theorem UpwardEnumerable.succMany_succ {α : Type u} [UpwardEnumerable α]
[LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a : α} :
succMany (n + 1) a = succ (succMany n a) := by
simp [succMany_eq_get, succMany?_succ?]
simp [succMany_eq_get, succMany?_add_one]
theorem UpwardEnumerable.succMany_add_one_eq_succMany_succ {α : Type u} [UpwardEnumerable α]
[LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a : α} :
succMany (n + 1) a = (succMany n (succ a)) := by
simp [succMany_eq_get, succMany?_succ?_eq_succ?_bind_succMany?]
simp [succMany_eq_get, succMany?_add_one_eq_succ?_bind_succMany?]
theorem UpwardEnumerable.succMany_succ_eq_succ_succMany {α : Type u} [UpwardEnumerable α]
[LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a : α} :

View File

@@ -89,7 +89,7 @@ abbrev Int8.size : Nat := 256
/--
Obtain the `BitVec` that contains the 2's complement representation of the `Int8`.
-/
@[inline] def Int8.toBitVec (x : Int8) : BitVec 8 := x.toUInt8.toBitVec
@[inline] def Int8.toBitVec (x : Int8) : BitVec 8 := x.toUInt8.toBitVec --
theorem Int8.toBitVec.inj : {x y : Int8} x.toBitVec = y.toBitVec x = y
| _, _, rfl => rfl

View File

@@ -36,6 +36,12 @@ macro "declare_int_theorems" typeName:ident _bits:term:arg : command => do
theorem toBitVec_inj {a b : $typeName} : a.toBitVec = b.toBitVec a = b :=
toBitVec.inj, (· rfl)
theorem ofBitVec_inj {a b : BitVec $_bits} : ofBitVec a = ofBitVec b a = b := by
apply Iff.intro <;> (rintro h; cases h; rfl)
theorem eq_iff_ofBitVec_eq {a b : BitVec $_bits} : a = b ofBitVec a = ofBitVec b :=
ofBitVec_inj.symm
theorem ne_iff_ofBitVec_ne {a b : BitVec $_bits} : a b ofBitVec a ofBitVec b := by
simp [ofBitVec_inj]
@[int_toBitVec] theorem eq_iff_toBitVec_eq {a b : $typeName} : a = b a.toBitVec = b.toBitVec :=
toBitVec_inj.symm
@[int_toBitVec] theorem ne_iff_toBitVec_ne {a b : $typeName} : a b a.toBitVec b.toBitVec :=
@@ -1296,6 +1302,13 @@ theorem Int64.toISize_ofIntTruncate {n : Int} (h₁ : -2 ^ 63 ≤ n) (h₂ : n <
BitVec.eq_of_toInt_eq (by rw [toInt_toBitVec, toInt_minValue,
BitVec.toInt_intMin_of_pos (by cases System.Platform.numBits_eq <;> simp_all)])
@[simp, int_toBitVec] theorem Int8.toBitVec_maxValue : maxValue.toBitVec = BitVec.intMax _ := (rfl)
@[simp, int_toBitVec] theorem Int16.toBitVec_maxValue : maxValue.toBitVec = BitVec.intMax _ := (rfl)
@[simp, int_toBitVec] theorem Int32.toBitVec_maxValue : maxValue.toBitVec = BitVec.intMax _ := (rfl)
@[simp, int_toBitVec] theorem Int64.toBitVec_maxValue : maxValue.toBitVec = BitVec.intMax _ := (rfl)
@[simp, int_toBitVec] theorem ISize.toBitVec_maxValue : maxValue.toBitVec = BitVec.intMax _ :=
BitVec.eq_of_toInt_eq (by rw [toInt_toBitVec, toInt_maxValue, BitVec.toInt_intMax])
@[simp] theorem Int16.toInt8_neg (x : Int16) : (-x).toInt8 = -x.toInt8 := Int8.toBitVec.inj (by simp)
@[simp] theorem Int32.toInt8_neg (x : Int32) : (-x).toInt8 = -x.toInt8 := Int8.toBitVec.inj (by simp)
@[simp] theorem Int64.toInt8_neg (x : Int64) : (-x).toInt8 = -x.toInt8 := Int8.toBitVec.inj (by simp)
@@ -2504,6 +2517,17 @@ protected theorem ISize.neg_add {a b : ISize} : - (a + b) = -a - b := ISize.toBi
@[simp] protected theorem ISize.neg_sub {a b : ISize} : -(a - b) = b - a := by
rw [ISize.sub_eq_add_neg, ISize.neg_add, ISize.sub_neg, ISize.add_comm, ISize.sub_eq_add_neg]
protected theorem Int8.sub_sub (a b c : Int8) : a - b - c = a - (b + c) := by
simp [Int8.sub_eq_add_neg, Int8.add_assoc, Int8.neg_add]
protected theorem Int16.sub_sub (a b c : Int16) : a - b - c = a - (b + c) := by
simp [Int16.sub_eq_add_neg, Int16.add_assoc, Int16.neg_add]
protected theorem Int32.sub_sub (a b c : Int32) : a - b - c = a - (b + c) := by
simp [Int32.sub_eq_add_neg, Int32.add_assoc, Int32.neg_add]
protected theorem Int64.sub_sub (a b c : Int64) : a - b - c = a - (b + c) := by
simp [Int64.sub_eq_add_neg, Int64.add_assoc, Int64.neg_add]
protected theorem ISize.sub_sub (a b c : ISize) : a - b - c = a - (b + c) := by
simp [ISize.sub_eq_add_neg, ISize.add_assoc, ISize.neg_add]
@[simp] protected theorem Int8.add_left_inj {a b : Int8} (c : Int8) : (a + c = b + c) a = b := by
simp [ Int8.toBitVec_inj]
@[simp] protected theorem Int16.add_left_inj {a b : Int16} (c : Int16) : (a + c = b + c) a = b := by

File diff suppressed because it is too large Load Diff

View File

@@ -1424,22 +1424,22 @@ public theorem isUTF8FirstByte_getElem_zero_utf8EncodeChar {c : Char} :
simp
@[expose]
public def utf8ByteSize (c : UInt8) (_h : c.IsUTF8FirstByte) : String.Pos.Raw :=
public def utf8ByteSize (c : UInt8) (_h : c.IsUTF8FirstByte) : Nat :=
if c &&& 0x80 = 0 then
1
1
else if c &&& 0xe0 = 0xc0 then
2
2
else if c &&& 0xf0 = 0xe0 then
3
3
else
4
4
def _root_.ByteArray.utf8DecodeChar?.FirstByte.utf8ByteSize : FirstByte String.Pos.Raw
| .invalid => 0
| .done => 1
| .oneMore => 2
| .twoMore => 3
| .threeMore => 4
def _root_.ByteArray.utf8DecodeChar?.FirstByte.utf8ByteSize : FirstByte Nat
| .invalid => 0
| .done => 1
| .oneMore => 2
| .twoMore => 3
| .threeMore => 4
theorem utf8ByteSize_eq_utf8ByteSize_parseFirstByte {c : UInt8} {h : c.IsUTF8FirstByte} :
c.utf8ByteSize h = (parseFirstByte c).utf8ByteSize := by
@@ -1477,9 +1477,9 @@ public theorem ByteArray.isUTF8FirstByte_of_validateUTF8At {b : ByteArray} {i :
simp only [validateUTF8At_eq_isSome_utf8DecodeChar?]
exact isUTF8FirstByte_of_isSome_utf8DecodeChar?
theorem Char.byteIdx_utf8ByteSize_getElem_utf8EncodeChar {c : Char} :
(((String.utf8EncodeChar c)[0]'(by simp [c.utf8Size_pos])).utf8ByteSize
UInt8.isUTF8FirstByte_getElem_zero_utf8EncodeChar).byteIdx = c.utf8Size := by
theorem Char.utf8ByteSize_getElem_utf8EncodeChar {c : Char} :
((String.utf8EncodeChar c)[0]'(by simp [c.utf8Size_pos])).utf8ByteSize
UInt8.isUTF8FirstByte_getElem_zero_utf8EncodeChar = c.utf8Size := by
rw [UInt8.utf8ByteSize_eq_utf8ByteSize_parseFirstByte]
obtain (hc|hc|hc|hc) := c.utf8Size_eq
· rw [parseFirstByte_utf8EncodeChar_eq_done hc, FirstByte.utf8ByteSize, hc]
@@ -1489,7 +1489,7 @@ theorem Char.byteIdx_utf8ByteSize_getElem_utf8EncodeChar {c : Char} :
public theorem ByteArray.utf8Size_utf8DecodeChar {b : ByteArray} {i} {h} :
(utf8DecodeChar b i h).utf8Size =
((b[i]'(lt_size_of_isSome_utf8DecodeChar? h)).utf8ByteSize (isUTF8FirstByte_of_isSome_utf8DecodeChar? h)).byteIdx := by
rw [ Char.byteIdx_utf8ByteSize_getElem_utf8EncodeChar]
(b[i]'(lt_size_of_isSome_utf8DecodeChar? h)).utf8ByteSize (isUTF8FirstByte_of_isSome_utf8DecodeChar? h) := by
rw [ Char.utf8ByteSize_getElem_utf8EncodeChar]
simp only [List.getElem_eq_getElem_toByteArray, utf8EncodeChar_utf8DecodeChar]
simp [ByteArray.getElem_extract]

View File

@@ -76,8 +76,8 @@ namespace Internal
@[extern "lean_slice_memcmp"]
def memcmp (lhs rhs : @& Slice) (lstart : @& String.Pos.Raw) (rstart : @& String.Pos.Raw)
(len : @& String.Pos.Raw) (h1 : lstart + len lhs.utf8ByteSize)
(h2 : rstart + len rhs.utf8ByteSize) : Bool :=
(len : @& String.Pos.Raw) (h1 : len.offsetBy lstart lhs.rawEndPos)
(h2 : len.offsetBy rstart rhs.rawEndPos) : Bool :=
go 0
where
go (curr : String.Pos.Raw) : Bool :=
@@ -88,7 +88,7 @@ where
have hr := by
simp [Pos.Raw.le_iff] at h h2
omega
if lhs.getUTF8Byte (lstart + curr) hl == rhs.getUTF8Byte (rstart + curr) hr then
if lhs.getUTF8Byte (curr.offsetBy lstart) hl == rhs.getUTF8Byte (curr.offsetBy rstart) hr then
go curr.inc
else
false

View File

@@ -50,18 +50,18 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardCharSearcher s) Id (Search
| .done => it.internalState.currPos = s.endPos
step := fun currPos, needle =>
if h1 : currPos = s.endPos then
pure .done, by simp [h1]
pure (.deflate .done, by simp [h1])
else
let nextPos := currPos.next h1
let nextIt := nextPos, needle
if h2 : currPos.get h1 = needle then
pure .yield nextIt (.matched currPos nextPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.matched currPos nextPos), by simp [h1, h2, nextIt, nextPos])
else
pure .yield nextIt (.rejected currPos nextPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.rejected currPos nextPos), by simp [h1, h2, nextIt, nextPos])
def finitenessRelation : Std.Iterators.FinitenessRelation (ForwardCharSearcher s) Id where
rel := InvImage WellFoundedRelation.rel
(fun it => s.utf8ByteSize.byteIdx - it.internalState.currPos.offset.byteIdx)
(fun it => s.utf8ByteSize - it.internalState.currPos.offset.byteIdx)
wf := InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
simp_wf
@@ -119,14 +119,14 @@ instance (s : Slice) : Std.Iterators.Iterator (BackwardCharSearcher s) Id (Searc
| .done => it.internalState.currPos = s.startPos
step := fun currPos, needle =>
if h1 : currPos = s.startPos then
pure .done, by simp [h1]
pure (.deflate .done, by simp [h1])
else
let nextPos := currPos.prev h1
let nextIt := nextPos, needle
if h2 : nextPos.get Pos.prev_ne_endPos = needle then
pure .yield nextIt (.matched nextPos currPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.matched nextPos currPos), by simp [h1, h2, nextIt, nextPos])
else
pure .yield nextIt (.rejected nextPos currPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.rejected nextPos currPos), by simp [h1, h2, nextIt, nextPos])
def finitenessRelation : Std.Iterators.FinitenessRelation (BackwardCharSearcher s) Id where
rel := InvImage WellFoundedRelation.rel

View File

@@ -51,19 +51,19 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardCharPredSearcher s) Id (Se
| .done => it.internalState.currPos = s.endPos
step := fun currPos, needle =>
if h1 : currPos = s.endPos then
pure .done, by simp [h1]
pure (.deflate .done, by simp [h1])
else
let nextPos := currPos.next h1
let nextIt := nextPos, needle
if h2 : needle <| currPos.get h1 then
pure .yield nextIt (.matched currPos nextPos), by simp [h1, h2, nextPos, nextIt]
pure (.deflate .yield nextIt (.matched currPos nextPos), by simp [h1, h2, nextPos, nextIt])
else
pure .yield nextIt (.rejected currPos nextPos), by simp [h1, h2, nextPos, nextIt]
pure (.deflate .yield nextIt (.rejected currPos nextPos), by simp [h1, h2, nextPos, nextIt])
def finitenessRelation : Std.Iterators.FinitenessRelation (ForwardCharPredSearcher s) Id where
rel := InvImage WellFoundedRelation.rel
(fun it => s.utf8ByteSize.byteIdx - it.internalState.currPos.offset.byteIdx)
(fun it => s.utf8ByteSize - it.internalState.currPos.offset.byteIdx)
wf := InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
simp_wf
@@ -121,14 +121,14 @@ instance (s : Slice) : Std.Iterators.Iterator (BackwardCharPredSearcher s) Id (S
| .done => it.internalState.currPos = s.startPos
step := fun currPos, needle =>
if h1 : currPos = s.startPos then
pure .done, by simp [h1]
pure (.deflate .done, by simp [h1])
else
let nextPos := currPos.prev h1
let nextIt := nextPos, needle
if h2 : needle <| nextPos.get Pos.prev_ne_endPos then
pure .yield nextIt (.matched nextPos currPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.matched nextPos currPos), by simp [h1, h2, nextIt, nextPos])
else
pure .yield nextIt (.rejected nextPos currPos), by simp [h1, h2, nextIt, nextPos]
pure (.deflate .yield nextIt (.rejected nextPos currPos), by simp [h1, h2, nextIt, nextPos])
def finitenessRelation : Std.Iterators.FinitenessRelation (BackwardCharPredSearcher s) Id where
rel := InvImage WellFoundedRelation.rel

View File

@@ -33,12 +33,12 @@ partial def buildTable (pat : Slice) : Array String.Pos.Raw :=
if pat.utf8ByteSize == 0 then
#[]
else
let arr := Array.emptyWithCapacity pat.utf8ByteSize.byteIdx
let arr := Array.emptyWithCapacity pat.utf8ByteSize
let arr := arr.push 0
go 1 arr
where
go (pos : String.Pos.Raw) (table : Array String.Pos.Raw) :=
if h : pos < pat.utf8ByteSize then
if h : pos < pat.rawEndPos then
let patByte := pat.getUTF8Byte pos h
let distance := computeDistance table[table.size - 1]! patByte table
let distance := if patByte = pat.getUTF8Byte! distance then distance.inc else distance
@@ -77,7 +77,7 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardSliceSearcher s) Id (Searc
| .proper needle table stackPos needlePos =>
( newStackPos newNeedlePos,
stackPos < newStackPos
newStackPos s.utf8ByteSize
newStackPos s.rawEndPos
it'.internalState = .proper needle table newStackPos newNeedlePos)
it'.internalState = .atEnd
| .atEnd => False
@@ -88,13 +88,13 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardSliceSearcher s) Id (Searc
| .empty pos =>
let res := .matched pos pos
if h : pos s.endPos then
pure .yield .empty (pos.next h) res, by simp
pure (.deflate .yield .empty (pos.next h) res, by simp)
else
pure .yield .atEnd res, by simp
pure (.deflate .yield .atEnd res, by simp)
| .proper needle table stackPos needlePos =>
let rec findNext (startPos : String.Pos.Raw)
(currStackPos : String.Pos.Raw) (needlePos : String.Pos.Raw) (h : stackPos currStackPos) :=
if h1 : currStackPos < s.utf8ByteSize then
if h1 : currStackPos < s.rawEndPos then
let stackByte := s.getUTF8Byte currStackPos h1
let needlePos := backtrackIfNecessary needle table stackByte needlePos
let patByte := needle.getUTF8Byte! needlePos
@@ -112,10 +112,10 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardSliceSearcher s) Id (Searc
omega
· apply Pos.Raw.IsValidForSlice.le_utf8ByteSize
apply Pos.isValidForSlice
.yield .proper needle table nextStackPos needlePos res, hiter
.deflate .yield .proper needle table nextStackPos needlePos res, hiter
else
let needlePos := needlePos.inc
if needlePos == needle.utf8ByteSize then
if needlePos == needle.rawEndPos then
let nextStackPos := currStackPos.inc
let res := .matched (s.pos! startPos) (s.pos! nextStackPos)
have hiter := by
@@ -128,29 +128,29 @@ instance (s : Slice) : Std.Iterators.Iterator (ForwardSliceSearcher s) Id (Searc
omega
· simp [String.Pos.Raw.le_iff] at h1
omega
.yield .proper needle table nextStackPos 0 res, hiter
.deflate .yield .proper needle table nextStackPos 0 res, hiter
else
have hinv := by
simp [String.Pos.Raw.le_iff] at h
omega
findNext startPos currStackPos.inc needlePos hinv
else
if startPos != s.utf8ByteSize then
if startPos != s.rawEndPos then
let res := .rejected (s.pos! startPos) (s.pos! currStackPos)
.yield .atEnd res, by simp
.deflate .yield .atEnd res, by simp
else
.done, by simp
termination_by s.utf8ByteSize.byteIdx - currStackPos.byteIdx
.deflate .done, by simp
termination_by s.utf8ByteSize - currStackPos.byteIdx
decreasing_by
simp at h1
omega
findNext stackPos stackPos needlePos (by simp)
| .atEnd => pure .done, by simp
| .atEnd => pure (.deflate .done, by simp)
private def toPair : ForwardSliceSearcher s (Nat × Nat)
| .empty pos => (1, s.utf8ByteSize.byteIdx - pos.offset.byteIdx)
| .proper _ _ sp _ => (1, s.utf8ByteSize.byteIdx - sp.byteIdx)
| .empty pos => (1, s.utf8ByteSize - pos.offset.byteIdx)
| .proper _ _ sp _ => (1, s.utf8ByteSize - sp.byteIdx)
| .atEnd => (0, 0)
private instance : WellFoundedRelation (ForwardSliceSearcher s) where
@@ -213,14 +213,14 @@ def startsWith (s : Slice) (pat : Slice) : Bool :=
omega
have hp := by
simp [Pos.Raw.le_iff]
Internal.memcmp s pat s.startPos.offset pat.startPos.offset pat.utf8ByteSize hs hp
Internal.memcmp s pat s.startPos.offset pat.startPos.offset pat.rawEndPos hs hp
else
false
@[inline]
def dropPrefix? (s : Slice) (pat : Slice) : Option Slice :=
if startsWith s pat then
some <| s.replaceStart <| s.pos! <| s.startPos.offset + pat.utf8ByteSize
some <| s.replaceStart <| s.pos! <| pat.rawEndPos.offsetBy s.startPos.offset
else
none
@@ -242,21 +242,21 @@ namespace BackwardSliceSearcher
@[inline]
def endsWith (s : Slice) (pat : Slice) : Bool :=
if h : pat.utf8ByteSize s.utf8ByteSize then
let sStart := s.endPos.offset - pat.utf8ByteSize
let sStart := s.endPos.offset.unoffsetBy pat.rawEndPos
let patStart := pat.startPos.offset
have hs := by
simp [sStart, Pos.Raw.le_iff] at h
omega
have hp := by
simp [patStart, Pos.Raw.le_iff] at h
Internal.memcmp s pat sStart patStart pat.utf8ByteSize hs hp
Internal.memcmp s pat sStart patStart pat.rawEndPos hs hp
else
false
@[inline]
def dropSuffix? (s : Slice) (pat : Slice) : Option Slice :=
if endsWith s pat then
some <| s.replaceEnd <| s.pos! <| s.endPos.offset - pat.utf8ByteSize
some <| s.replaceEnd <| s.pos! <| s.endPos.offset.unoffsetBy pat.rawEndPos
else
none

View File

@@ -61,7 +61,7 @@ def beq (s1 s2 : Slice) : Bool :=
if h : s1.utf8ByteSize = s2.utf8ByteSize then
have h1 := by simp [h, String.Pos.Raw.le_iff]
have h2 := by simp [h, String.Pos.Raw.le_iff]
Internal.memcmp s1 s2 s1.startPos.offset s2.startPos.offset s1.utf8ByteSize h1 h2
Internal.memcmp s1 s2 s1.startPos.offset s2.startPos.offset s1.rawEndPos h1 h2
else
false
@@ -131,11 +131,11 @@ instance [Pure m] : Std.Iterators.Iterator (SplitIterator ρ) m Slice where
| some (searcher, startPos, endPos) =>
let slice := s.replaceStartEnd! currPos startPos
let nextIt := .operating s endPos searcher
pure .yield nextIt slice, by simp
pure (.deflate .yield nextIt slice, by simp)
| none =>
let slice := s.replaceStart currPos
pure .yield .atEnd slice, by simp
| .atEnd => pure .done, by simp
pure (.deflate .yield .atEnd slice, by simp)
| .atEnd => pure (.deflate .done, by simp)
-- TODO: Finiteness after we have a notion of lawful searcher
@@ -190,14 +190,14 @@ instance [Pure m] : Std.Iterators.Iterator (SplitInclusiveIterator ρ) m Slice w
| some (searcher, _, endPos) =>
let slice := s.replaceStartEnd! currPos endPos
let nextIt := .operating s endPos searcher
pure .yield nextIt slice, by simp
pure (.deflate .yield nextIt slice, by simp)
| none =>
if currPos != s.endPos then
let slice := s.replaceStart currPos
pure .yield .atEnd slice, by simp
pure (.deflate .yield .atEnd slice, by simp)
else
pure .done, by simp
| .atEnd => pure .done, by simp
pure (.deflate .done, by simp)
| .atEnd => pure (.deflate .done, by simp)
-- TODO: Finiteness after we have a notion of lawful searcher
@@ -464,14 +464,14 @@ instance [Pure m] : Std.Iterators.Iterator (RevSplitIterator ρ) m Slice where
| some (searcher, startPos, endPos) =>
let slice := s.replaceStartEnd! endPos currPos
let nextIt := .operating s startPos searcher
pure .yield nextIt slice, by simp
pure (.deflate .yield nextIt slice, by simp)
| none =>
if currPos s.startPos then
let slice := s.replaceEnd currPos
pure .yield .atEnd slice, by simp
pure (.deflate .yield .atEnd slice, by simp)
else
pure .done, by simp
| .atEnd => pure .done, by simp
pure (.deflate .done, by simp)
| .atEnd => pure (.deflate .done, by simp)
-- TODO: Finiteness after we have a notion of lawful searcher
@@ -687,7 +687,7 @@ def eqIgnoreAsciiCase (s1 s2 : Slice) : Bool :=
s1.utf8ByteSize == s2.utf8ByteSize && go s1 s1.startPos.offset s2 s2.startPos.offset
where
go (s1 : Slice) (s1Curr : String.Pos.Raw) (s2 : Slice) (s2Curr : String.Pos.Raw) : Bool :=
if h : s1Curr < s1.utf8ByteSize s2Curr < s2.utf8ByteSize then
if h : s1Curr < s1.rawEndPos s2Curr < s2.rawEndPos then
let c1 := (s1.getUTF8Byte s1Curr h.left).toAsciiLower
let c2 := (s2.getUTF8Byte s2Curr h.right).toAsciiLower
if c1 == c2 then
@@ -695,7 +695,7 @@ where
else
false
else
s1Curr == s1.utf8ByteSize && s2Curr == s2.utf8ByteSize
s1Curr == s1.rawEndPos && s2Curr == s2.rawEndPos
termination_by s1.endPos.offset.byteIdx - s1Curr.byteIdx
decreasing_by
simp at h
@@ -733,14 +733,14 @@ instance [Pure m] :
| .done => it.internalState.currPos = s.endPos
step := fun currPos =>
if h : currPos = s.endPos then
pure .done, by simp [h]
pure (.deflate .done, by simp [h])
else
pure .yield currPos.next h currPos, h, by simp [h]
pure (.deflate .yield currPos.next h currPos, h, by simp [h])
private def finitenessRelation [Pure m] :
Std.Iterators.FinitenessRelation (PosIterator s) m where
rel := InvImage WellFoundedRelation.rel
(fun it => s.utf8ByteSize.byteIdx - it.internalState.currPos.offset.byteIdx)
(fun it => s.utf8ByteSize - it.internalState.currPos.offset.byteIdx)
wf := InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
simp_wf
@@ -819,10 +819,10 @@ instance [Pure m] :
| .done => it.internalState.currPos = s.startPos
step := fun currPos =>
if h : currPos = s.startPos then
pure .done, by simp [h]
pure (.deflate .done, by simp [h])
else
let prevPos := currPos.prev h
pure .yield prevPos prevPos, Pos.prev_ne_endPos, by simp [h, prevPos]
pure (.deflate .yield prevPos prevPos, Pos.prev_ne_endPos, by simp [h, prevPos])
private def finitenessRelation [Pure m] :
Std.Iterators.FinitenessRelation (RevPosIterator s) m where
@@ -897,22 +897,22 @@ namespace ByteIterator
instance [Pure m] : Std.Iterators.Iterator ByteIterator m UInt8 where
IsPlausibleStep it
| .yield it' out =>
h1 : it.internalState.offset < it.internalState.s.utf8ByteSize,
h1 : it.internalState.offset < it.internalState.s.rawEndPos,
it.internalState.s = it'.internalState.s
it'.internalState.offset = it.internalState.offset.inc
it.internalState.s.getUTF8Byte it.internalState.offset h1 = out
| .skip _ => False
| .done => ¬ it.internalState.offset < it.internalState.s.utf8ByteSize
| .done => ¬ it.internalState.offset < it.internalState.s.rawEndPos
step := fun s, offset =>
if h : offset < s.utf8ByteSize then
pure .yield s, offset.inc (s.getUTF8Byte offset h), by simp [h]
if h : offset < s.rawEndPos then
pure (.deflate .yield s, offset.inc (s.getUTF8Byte offset h), by simp [h])
else
pure .done, by simp [h]
pure (.deflate .done, by simp [h])
private def finitenessRelation [Pure m] :
Std.Iterators.FinitenessRelation (ByteIterator) m where
rel := InvImage WellFoundedRelation.rel
(fun it => it.internalState.s.utf8ByteSize.byteIdx - it.internalState.offset.byteIdx)
(fun it => it.internalState.s.utf8ByteSize - it.internalState.offset.byteIdx)
wf := InvImage.wf _ WellFoundedRelation.wf
subrelation {it it'} h := by
simp_wf
@@ -951,7 +951,7 @@ end ByteIterator
structure RevByteIterator where
s : Slice
offset : String.Pos.Raw
hinv : offset s.utf8ByteSize
hinv : offset s.rawEndPos
set_option doc.verso false
/--
@@ -977,7 +977,7 @@ namespace RevByteIterator
instance [Pure m] : Std.Iterators.Iterator RevByteIterator m UInt8 where
IsPlausibleStep it
| .yield it' out =>
h1 : it.internalState.offset.dec < it.internalState.s.utf8ByteSize,
h1 : it.internalState.offset.dec < it.internalState.s.rawEndPos,
it.internalState.s = it'.internalState.s
it.internalState.offset 0
it'.internalState.offset = it.internalState.offset.dec
@@ -994,9 +994,9 @@ instance [Pure m] : Std.Iterators.Iterator RevByteIterator m UInt8 where
simp [String.Pos.Raw.le_iff, nextOffset] at hinv
omega
have hiter := by simp [nextOffset, hbound, h]
pure .yield s, nextOffset, hinv (s.getUTF8Byte nextOffset hbound), hiter
pure (.deflate .yield s, nextOffset, hinv (s.getUTF8Byte nextOffset hbound), hiter)
else
pure .done, by simpa using h
pure (.deflate .done, by simpa using h)
private def finitenessRelation [Pure m] :
Std.Iterators.FinitenessRelation (RevByteIterator) m where

View File

@@ -8,4 +8,4 @@ module
prelude
public import Init.Data.ToString.Basic
public import Init.Data.ToString.Macro
public meta import Init.Data.ToString.Name
public import Init.Data.ToString.Name

View File

@@ -6,8 +6,18 @@ Authors: Leonardo de Moura
module
prelude
public import Init.Tactics
public import Init.Grind.Attr
public section
namespace Lean.Parser.Tactic.Grind
namespace Lean.Parser.Tactic
syntax grindLemma := ppGroup((Attr.grindMod ppSpace)? ident)
/--
The `!` modifier instructs `grind` to consider only minimal indexable subexpressions
when selecting patterns.
-/
syntax grindLemmaMin := ppGroup("!" (Attr.grindMod ppSpace)? ident)
namespace Grind
/-- `grind` is the syntax category for a "grind interactive tactic".
A `grind` tactic is a program which receives a `grind` goal. -/
@@ -27,6 +37,61 @@ syntax (name := skip) "skip" : grind
syntax (name := lia) "lia" : grind
/-- `ring` (commutative) rings and fields. -/
syntax (name := ring) "ring" : grind
/-- `ac` associativity and commutativity procedure. -/
syntax (name := ac) "ac" : grind
/-- `linarith` linear arithmetic. -/
syntax (name := linarith) "linarith" : grind
/-- The `sorry` tactic is a temporary placeholder for an incomplete tactic proof. -/
syntax (name := «sorry») "sorry" : grind
syntax anchor := "#" noWs hexnum
syntax thm := anchor <|> grindLemma <|> grindLemmaMin
/-- Instantiates theorems using E-matching. -/
syntax (name := instantiate) "instantiate" (colGt thm),* : grind
declare_syntax_cat show_filter (behavior := both)
syntax:max ident : show_filter
syntax:max &"gen" " < " num : show_filter
syntax:max &"gen" " = " num : show_filter
syntax:max &"gen" " != " num : show_filter
syntax:max &"gen" "" num : show_filter
syntax:max &"gen" " <= " num : show_filter
syntax:max &"gen" " > " num : show_filter
syntax:max &"gen" "" num : show_filter
syntax:max &"gen" " >= " num : show_filter
syntax:max "(" show_filter ")" : show_filter
syntax:35 show_filter:35 " && " show_filter:36 : show_filter
syntax:35 show_filter:35 " || " show_filter:36 : show_filter
syntax:max "!" show_filter:40 : show_filter
syntax showFilter := (colGt show_filter)?
-- **Note**: Should we rename the following tactics to `trace_`?
/-- Shows asserted facts. -/
syntax (name := showAsserted) "show_asserted" ppSpace showFilter : grind
/-- Shows propositions known to be `True`. -/
syntax (name := showTrue) "show_true" ppSpace showFilter : grind
/-- Shows propositions known to be `False`. -/
syntax (name := showFalse) "show_false" ppSpace showFilter : grind
/-- Shows equivalence classes of terms. -/
syntax (name := showEqcs) "show_eqcs" ppSpace showFilter : grind
/-- Show case-split candidates. -/
syntax (name := showSplits) "show_splits" ppSpace showFilter : grind
/-- Show `grind` state. -/
syntax (name := «showState») "show_state" ppSpace showFilter : grind
/-- Show active local theorems and their anchors for heuristic instantiation. -/
syntax (name := showThms) "show_thms" : grind
declare_syntax_cat grind_ref (behavior := both)
syntax:max anchor : grind_ref
syntax term : grind_ref
syntax (name := cases) "cases " grind_ref (" with " (colGt ident)+)? : grind
/-- `done` succeeds iff there are no remaining goals. -/
syntax (name := done) "done" : grind
@@ -38,4 +103,82 @@ syntax (name := «have») "have" letDecl : grind
/-- Executes the given tactic block to close the current goal. -/
syntax (name := nestedTacticCore) "tactic" " => " tacticSeq : grind
end Lean.Parser.Tactic.Grind
/--
`all_goals tac` runs `tac` on each goal, concatenating the resulting goals.
If the tactic fails on any goal, the entire `all_goals` tactic fails.
-/
syntax (name := allGoals) "all_goals " grindSeq : grind
/--
`focus tac` focuses on the main goal, suppressing all other goals, and runs `tac` on it.
Usually `· tac`, which enforces that the goal is closed by `tac`, should be preferred.
-/
syntax (name := focus) "focus " grindSeq : grind
syntax (name := next) "next " binderIdent* " => " grindSeq : grind
/--
`any_goals tac` applies the tactic `tac` to every goal,
concatenating the resulting goals for successful tactic applications.
If the tactic fails on all of the goals, the entire `any_goals` tactic fails.
This tactic is like `all_goals try tac` except that it fails if none of the applications of `tac` succeeds.
-/
syntax (name := anyGoals) "any_goals " grindSeq : grind
/--
`with_annotate_state stx t` annotates the lexical range of `stx : Syntax` with
the initial and final state of running tactic `t`.
-/
scoped syntax (name := withAnnotateState)
"with_annotate_state " rawStx ppSpace grind : grind
/--
`tac <;> tac'` runs `tac` on the main goal and `tac'` on each produced goal,
concatenating all goals produced by `tac'`.
-/
macro:1 x:grind tk:" <;> " y:grind:2 : grind => `(grind|
focus
$x:grind
with_annotate_state $tk skip
all_goals $y:grind)
/-- `first | tac | ...` runs each `tac` until one succeeds, or else fails. -/
syntax (name := first) "first " withPosition((ppDedent(ppLine) colGe "| " grindSeq)+) : grind
/-- `try tac` runs `tac` and succeeds even if `tac` failed. -/
macro "try " t:grindSeq : grind => `(grind| first | $t | skip)
/-- `fail_if_success t` fails if the tactic `t` succeeds. -/
syntax (name := failIfSuccess) "fail_if_success " grindSeq : grind
/-- `admit` is a synonym for `sorry`. -/
macro "admit" : grind => `(grind| sorry)
/-- `fail msg` is a tactic that always fails, and produces an error using the given message. -/
syntax (name := fail) "fail" (ppSpace str)? : grind
/--
`repeat tac` repeatedly applies `tac` so long as it succeeds.
The tactic `tac` may be a tactic sequence, and if `tac` fails at any point in its execution,
`repeat` will revert any partial changes that `tac` made to the tactic state.
The tactic `tac` should eventually fail, otherwise `repeat tac` will run indefinitely.
-/
syntax "repeat " grindSeq : grind
macro_rules
| `(grind| repeat $seq) => `(grind| first | ($seq); repeat $seq | skip)
/-- `rename_i x_1 ... x_n` renames the last `n` inaccessible names using the given names. -/
syntax (name := renameI) "rename_i" (ppSpace colGt binderIdent)+ : grind
/--
`expose_names` renames all inaccessible variables with accessible names, making them available
for reference in generated tactics. However, this renaming introduces machine-generated names
that are not fully under user control. `expose_names` is primarily intended as a preamble for
generated `grind` tactic scripts.
-/
syntax (name := exposeNames) "expose_names" : grind
end Grind
end Lean.Parser.Tactic

View File

@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
module
prelude
public import Init.Core
public import Init.Grind.Attr
public import Init.Grind.Interactive
public section
namespace Lean.Grind
@@ -156,6 +155,13 @@ structure Config where
offset := true
deriving Inhabited, BEq
/--
Configuration for interactive mode.
We disable `clean := false`.
-/
structure ConfigInteractive extends Config where
clean := false
/--
A minimal configuration, with ematching and splitting disabled, and all solver modules turned off.
`grind` will not do anything in this configuration,
@@ -209,14 +215,11 @@ namespace Lean.Parser.Tactic
/-!
`grind` tactic and related tactics.
-/
syntax grindErase := "-" ident
syntax grindLemma := ppGroup((Attr.grindMod ppSpace)? ident)
/--
The `!` modifier instructs `grind` to consider only minimal indexable subexpressions
when selecting patterns.
-/
syntax grindLemmaMin := ppGroup("!" (Attr.grindMod ppSpace)? ident)
syntax grindParam := grindErase <|> grindLemma <|> grindLemmaMin
open Parser.Tactic.Grind

View File

@@ -6,14 +6,11 @@ Authors: Leonardo de Moura and Sebastian Ullrich
Additional goodies for writing macros
-/
module
prelude
public import Init.Meta.Defs
public meta import Init.Meta.Defs
public import Init.Tactics
public section
namespace Lean
macro_rules

View File

@@ -443,6 +443,10 @@ abbrev NumLit := TSyntax numLitKind
Syntax that represents macro hygiene info.
-/
abbrev HygieneInfo := TSyntax hygieneInfoKind
/--
Syntax that represent a hexadecimal number without the `0x` prefix.
-/
abbrev HexNum := TSyntax hexnumKind
end Syntax
@@ -1196,6 +1200,21 @@ Returns `0` if the syntax is malformed.
def getNat (s : NumLit) : Nat :=
s.raw.isNatLit?.getD 0
private def isHexNum? (stx : Syntax) : Option Nat :=
match Syntax.isLit? hexnumKind stx with
| some val => Syntax.decodeHexLitAux val 0 0
| _ => none
/-- Returns the value of the hexadecimal numeral as a natural number. -/
def getHexNumVal (s : Syntax.HexNum) : Nat :=
isHexNum? s.raw |>.getD 0
/-- Returns the number of hexadecimal digits. -/
def getHexNumSize (s : Syntax.HexNum) : Nat :=
match Syntax.isLit? hexnumKind s.raw with
| some val => val.utf8ByteSize
| _ => 0
/--
Extracts the parsed name from the syntax of an identifier.

View File

@@ -402,6 +402,7 @@ recommended_spelling "ge" for "≥" in [GE.ge, «term_≥_»]
recommended_spelling "ge" for ">=" in [GE.ge, «term_>=_»]
recommended_spelling "eq" for "=" in [Eq, «term_=_»]
recommended_spelling "beq" for "==" in [BEq.beq, «term_==_»]
recommended_spelling "heq" for "" in [HEq, «term__»]
@[inherit_doc] infixr:35 " /\\ " => And
@[inherit_doc] infixr:35 "" => And

View File

@@ -4969,9 +4969,17 @@ abbrev strLitKind : SyntaxNodeKind := `str
/-- `` `char `` is the node kind of character literals like `'A'`. -/
abbrev charLitKind : SyntaxNodeKind := `char
/-- `` `num `` is the node kind of number literals like `42`. -/
/-- `` `num `` is the node kind of number literals like `42` and `0xa1` -/
abbrev numLitKind : SyntaxNodeKind := `num
/--
`` `hexnum `` is the node kind of hexadecimal numbers like `ea10`
without the `0x` prefix. Recall that `hexnum` is not a token and must be prefixed.
For hexadecimal number literals, you should use `num` instead.
Example: `syntax anchor := "#" noWs hexnum`.
-/
abbrev hexnumKind : SyntaxNodeKind := `hexnum
/-- `` `scientific `` is the node kind of floating point literals like `1.23e-3`. -/
abbrev scientificLitKind : SyntaxNodeKind := `scientific

View File

@@ -110,13 +110,13 @@ end Attr
macro_rules
| `($[$doc?:docComment]? simproc_decl $n:ident ($pattern:term) := $body) => do
let simprocType := `Lean.Meta.Simp.Simproc
`($[$doc?:docComment]? def $n:ident : $(mkIdent simprocType) := $body
`($[$doc?:docComment]? meta def $n:ident : $(mkIdent simprocType) := $body
simproc_pattern% $pattern => $n)
macro_rules
| `($[$doc?:docComment]? dsimproc_decl $n:ident ($pattern:term) := $body) => do
let simprocType := `Lean.Meta.Simp.DSimproc
`($[$doc?:docComment]? def $n:ident : $(mkIdent simprocType) := $body
`($[$doc?:docComment]? meta def $n:ident : $(mkIdent simprocType) := $body
simproc_pattern% $pattern => $n)
macro_rules

View File

@@ -398,7 +398,7 @@ If `nBytes` is `0`, returns immediately with an empty buffer.
/--
Pauses execution for the specified number of milliseconds.
-/
def sleep (ms : UInt32) : BaseIO Unit :=
opaque sleep (ms : UInt32) : BaseIO Unit :=
-- TODO: add a proper primitive for IO.sleep
fun s => dbgSleep ms fun _ => EStateM.Result.ok () s

View File

@@ -53,7 +53,13 @@ instance : ToString AttributeKind where
| .scoped => "scoped"
structure AttributeImpl extends AttributeImplCore where
/-- This is run when the attribute is applied to a declaration `decl`. `stx` is the syntax of the attribute including arguments. -/
/--
This is run when the attribute is applied to a declaration `decl`. `stx` is the syntax of the
attribute including arguments.
The handler will be run under `withExporting` iff the declaration is public, i.e. using the same
visibility scope as elaboration of the rest of the declaration signature.
-/
add (decl : Name) (stx : Syntax) (kind : AttributeKind) : AttrM Unit
erase (decl : Name) : AttrM Unit := throwError "Attribute `[{name}]` cannot be erased"
deriving Inhabited
@@ -240,26 +246,31 @@ structure ParametricAttribute (α : Type) where
structure ParametricAttributeImpl (α : Type) extends AttributeImplCore where
getParam : Name Syntax AttrM α
afterSet : Name α AttrM Unit := fun _ _ _ => pure ()
afterImport : Array (Array (Name × α)) ImportM Unit := fun _ => pure ()
/--
If set, entries are not resorted on export and `getParam?` will fall back to a linear instead of
binary search insde an imported module's entries.
-/
preserveOrder : Bool := false
/--
Predicate run on each declaration-param pair to check whether it should be exported. By default,
only params on public declarations are exported.
-/
filterExport : Environment Name α Bool := fun env n _ =>
env.contains (skipRealize := false) n
def registerParametricAttribute (impl : ParametricAttributeImpl α) : IO (ParametricAttribute α) := do
let ext : PersistentEnvExtension (Name × α) (Name × α) (List Name × NameMap α) registerPersistentEnvExtension {
name := impl.ref
mkInitial := pure ([], {})
addImportedFn := fun s => impl.afterImport s *> pure ([], {})
addImportedFn := fun _ => pure ([], {})
addEntryFn := fun (decls, m) (p : Name × α) => (p.1 :: decls, m.insert p.1 p.2)
exportEntriesFnEx := fun env (decls, m) _ =>
let r := if impl.preserveOrder then
exportEntriesFnEx := fun env (decls, m) lvl => Id.run do
let mut r := if impl.preserveOrder then
decls.toArray.reverse.filterMap (fun n => return (n, m.find? n))
else
m.foldl (fun a n p => a.push (n, p)) #[]
-- Do not export info for private defs
let r := r.filter (env.contains (skipRealize := false) ·.1)
if lvl != .private then
r := r.filter (fun n, a => impl.filterExport env n a)
r.qsort (fun a b => Name.quickLt a.1 b.1)
statsFn := fun (_, m) => "parametric attribute" ++ Format.line ++ "number of local entries: " ++ format m.size
}

View File

@@ -13,6 +13,7 @@ public import Lean.Compiler.IR.Format
public import Lean.Compiler.MetaAttr
public import Lean.Compiler.ExportAttr
public import Lean.Compiler.LCNF.PhaseExt
import Lean.Compiler.InitAttr
public section
@@ -148,10 +149,19 @@ builtin_initialize declMapExt : SimplePersistentEnvExtension Decl DeclMap ←
@[export lean_ir_export_entries]
private def exportIREntries (env : Environment) : Array (Name × Array EnvExtensionEntry) :=
let decls := declMapExt.getEntries env |>.foldl (init := #[]) fun decls decl => decls.push decl
let irDecls := declMapExt.getEntries env |>.foldl (init := #[]) fun decls decl => decls.push decl
-- safety: cast to erased type
let entries : Array EnvExtensionEntry := unsafe unsafeCast <| sortDecls decls
#[(``declMapExt, entries)]
let irEntries : Array EnvExtensionEntry := unsafe unsafeCast <| sortDecls irDecls
-- see `regularInitAttr.filterExport`
let initDecls : Array (Name × Name) := regularInitAttr.ext.getState env
|>.2.foldl (fun a n p => a.push (n, p)) #[]
|>.qsort (fun a b => Name.quickLt a.1 b.1)
-- safety: cast to erased type
let initDecls : Array EnvExtensionEntry := unsafe unsafeCast initDecls
#[(declMapExt.name, irEntries),
(Lean.regularInitAttr.ext.name, initDecls)]
@[export lean_ir_find_env_decl]
def findEnvDecl (env : Environment) (declName : Name) : Option Decl :=

View File

@@ -349,6 +349,10 @@ private def addDecIfNeeded (ctx : Context) (x : VarId) (b : FnBody) (bLiveVars :
else b
private def processVDecl (ctx : Context) (z : VarId) (t : IRType) (v : Expr) (b : FnBody) (bLiveVars : LiveVars) : FnBody × LiveVars :=
-- `z` can be unused in `b` so we might have to drop it. Note that we do not remove the let
-- because we are in the impure phase of the compiler so `v` can have side effects that we don't
-- want to loose.
let b := addDecIfNeeded ctx z b bLiveVars
let b := match v with
| .ctor _ ys | .reuse _ _ _ ys | .pap _ ys =>
addIncBeforeConsumeAll ctx ys (.vdecl z t v b) bLiveVars

View File

@@ -9,6 +9,7 @@ prelude
public import Lean.AddDecl
public import Lean.MonadEnv
public import Lean.Elab.InfoTree.Main
import Init.Data.Range.Polymorphic.Stream
public section
@@ -62,36 +63,14 @@ unsafe def registerInitAttrUnsafe (attrName : Name) (runAfterImport : Bool) (ref
| none =>
if isIOUnit decl.type then pure Name.anonymous
else throwError "initialization function must have type `IO Unit`"
afterImport := fun entries => do
let ctx read
if runAfterImport && ( isInitializerExecutionEnabled) then
for mod in ctx.env.header.moduleNames,
modEntries in entries do
-- any native Lean code reachable by the interpreter (i.e. from shared
-- libraries with their corresponding module in the Environment) must
-- first be initialized
if ( runModInit mod) then
continue
-- If no native code for the module is available, run `[init]` decls manually.
-- All other constants (nullary functions) are lazily initialized by the interpreter.
if modEntries.isEmpty then
-- If there are no `[init]` decls, don't bother walking through all module decls.
-- We do this after trying `runModInit` as that one may also efficiently initialize
-- nullary functions.
continue
-- As `[init]` decls can have global side effects, ensure we run them at most once,
-- just like the compiled code does.
if ( interpretedModInits.get).contains mod then
continue
interpretedModInits.modify (·.insert mod)
for (decl, initDecl) in modEntries do
if getIRPhases ctx.env decl == .runtime then
continue
if initDecl.isAnonymous then
let initFn IO.ofExcept <| ctx.env.evalConst (IO Unit) ctx.opts decl
initFn
else
runInit ctx.env ctx.opts decl initDecl
-- Save `meta initialize` in .olean; `initialize`s of any kind will be stored in .ir by
-- `exportIREntries` analogously to `Lean.IR.declMapExt` so we can run them when meta-imported,
-- even without the .olean file.
filterExport := fun env declName _ =>
-- TODO: The interpreter currently depends on `[builtin_init]` to be exported for
-- `prefer_native` handling but this is incorrect with private imports anyway and should be
-- replaced by consulting a builtin list.
!runAfterImport || isMeta env declName
}
@[implemented_by registerInitAttrUnsafe]
@@ -162,12 +141,44 @@ def hasInitAttr (env : Environment) (fn : Name) : Bool :=
def setBuiltinInitAttr (env : Environment) (declName : Name) (initFnName : Name := Name.anonymous) : Except String Environment :=
builtinInitAttr.setParam env declName initFnName
def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit := do
let name mkAuxDeclName (kind := `_regBuiltin ++ forDecl)
let type := mkApp (mkConst `IO) (mkConst `Unit)
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
safety := DefinitionSafety.safe }
addAndCompile decl
IO.ofExcept (setBuiltinInitAttr ( getEnv) name) >>= setEnv
def declareBuiltin (forDecl : Name) (value : Expr) : CoreM Unit :=
-- can always be private, not referenced directly except through emitted C code
withoutExporting do
-- TODO: needs an update-stage0 + prefer_native=true for breaking symbol name
withExporting do
let name mkAuxDeclName (kind := `_regBuiltin ++ forDecl)
let type := mkApp (mkConst `IO) (mkConst `Unit)
let decl := Declaration.defnDecl { name, levelParams := [], type, value, hints := ReducibilityHints.opaque,
safety := DefinitionSafety.safe }
addAndCompile decl
IO.ofExcept (setBuiltinInitAttr ( getEnv) name) >>= setEnv
@[export lean_run_init_attrs]
private unsafe def runInitAttrs (env : Environment) (opts : Options) : IO Unit := do
if ( isInitializerExecutionEnabled) then
for mod in env.header.moduleNames, modIdx in 0...* do
-- any native Lean code reachable by the interpreter (i.e. from shared
-- libraries with their corresponding module in the Environment) must
-- first be initialized
if ( runModInit mod) then
continue
-- As `[init]` decls can have global side effects, ensure we run them at most once,
-- just like the compiled code does.
if ( interpretedModInits.get).contains mod then
continue
interpretedModInits.modify (·.insert mod)
let modEntries := regularInitAttr.ext.getModuleEntries env modIdx
-- `getModuleIREntries` is identical to `getModuleEntries` if we loaded only one of .olean/.ir
-- so deduplicate (these lists should be very short)
let modEntries := modEntries ++ (regularInitAttr.ext.getModuleIREntries env modIdx).filter (!modEntries.contains ·)
for (decl, initDecl) in modEntries do
-- Skip initializers we do not have IR for; they should not be reachable by interpretation.
if !Elab.inServer.get opts && getIRPhases env decl == .runtime then
continue
if initDecl.isAnonymous then
let initFn IO.ofExcept <| env.evalConst (IO Unit) opts decl
initFn
else
runInit env opts decl initDecl
end Lean

View File

@@ -72,14 +72,14 @@ builtin_initialize inlineAttrs : EnumAttributes InlineAttributeKind ←
(`macro_inline, "mark definition to always be inlined before ANF conversion", .macroInline),
(`always_inline, "mark definition to be always inlined", .alwaysInline)]
fun declName kind => do
ofExcept <| (checkIsDefinition ( getEnv) declName).mapError fun e =>
s!"Cannot add attribute `[{kind.toAttrString}]`: {e}"
if kind matches .macroInline then
if !(checkIsDefinition ( getEnv) declName |>.isOk) then
throwError "invalid `[macro_inline]` attribute, `{.ofConstName declName}` must be an exposed definition"
unless ( isValidMacroInline declName) do
throwError "Cannot add `[macro_inline]` attribute to `{.ofConstName declName}`: This attribute does not support this kind of declaration; only non-recursive definitions are supported"
withExporting (isExporting := !isPrivateName declName) do
if !( getConstInfo declName).isDefinition then
throwError "invalid `[macro_inline]` attribute, `{.ofConstName declName}` must be an exposed definition"
else
ofExcept <| (checkIsDefinition ( withoutExporting <| getEnv) declName).mapError fun e =>
s!"Cannot add attribute `[{kind.toAttrString}]`: {e}"
def setInlineAttribute (env : Environment) (declName : Name) (kind : InlineAttributeKind) : Except String Environment :=
inlineAttrs.setValue env declName kind

View File

@@ -109,10 +109,6 @@ def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRe
if !(isValidMainType info.type) then
throwError "`main` function must have type `(List String →)? IO (UInt32 | Unit | PUnit)`"
let decls declNames.mapM toDecl
-- Check meta accesses now before optimizations may obscure references. This check should stay in
-- `lean` if some compilation is moved out.
for decl in decls do
checkMeta decl
let decls := markRecDecls decls
let manager getPassManager
let isCheckEnabled := compiler.check.get ( getOptions)

View File

@@ -40,6 +40,13 @@ def init : Pass where
phase := .base
shouldAlwaysRunCheck := true
def checkMeta : Pass where
name := `checkMeta
run := fun decls => do
decls.forM LCNF.checkMeta
return decls
phase := .base
-- Helper pass used for debugging purposes
def trace (phase := Phase.base) : Pass where
name := `trace
@@ -71,6 +78,9 @@ open Pass
def builtinPassManager : PassManager := {
basePasses := #[
init,
-- Check meta accesses now before optimizations may obscure references. This check should stay in
-- `lean` if some compilation is moved out.
Pass.checkMeta,
pullInstances,
cse (shouldElimFunDecls := false),
simp,

View File

@@ -59,6 +59,7 @@ private def escapeAux (acc : String) (c : Char) : String :=
let d4 := Nat.digitChar (n % 16)
acc ++ "\\u" |>.push d1 |>.push d2 |>.push d3 |>.push d4
set_option maxRecDepth 10240 in
private def needEscape (s : String) : Bool :=
go s 0
where

View File

@@ -111,6 +111,7 @@ structure ServerCapabilities where
codeActionProvider? : Option CodeActionOptions := none
inlayHintProvider? : Option InlayHintOptions := none
signatureHelpProvider? : Option SignatureHelpOptions := none
colorProvider? : Option DocumentColorOptions := none
experimental? : Option LeanServerCapabilities := none
deriving ToJson, FromJson

View File

@@ -705,5 +705,24 @@ structure SignatureHelpOptions extends WorkDoneProgressOptions where
retriggerCharacters? : Option (Array String) := none
deriving FromJson, ToJson
structure DocumentColorParams extends WorkDoneProgressParams, PartialResultParams where
textDocument : TextDocumentIdentifier
deriving FromJson, ToJson
structure Color where
red : Float
green : Float
blue : Float
alpha : Float
deriving FromJson, ToJson
structure ColorInformation where
range : Range
color : Color
deriving FromJson, ToJson
structure DocumentColorOptions extends WorkDoneProgressOptions where
deriving FromJson, ToJson
end Lsp
end Lean

View File

@@ -140,8 +140,8 @@ protected def register [KVMap.Value α] (name : Name) (decl : Lean.Option.Decl
macro (name := registerBuiltinOption) doc?:(docComment)? vis?:(visibility)? "register_builtin_option" name:ident " : " type:term " := " decl:term : command =>
`($[$doc?]? $[$vis?:visibility]? builtin_initialize $name : Lean.Option $type Lean.Option.register $(quote name.getId) $decl)
macro (name := registerOption) doc?:(docComment)? vis?:(visibility)? "register_option" name:ident " : " type:term " := " decl:term : command =>
`($[$doc?]? $[$vis?:visibility]? initialize $name : Lean.Option $type Lean.Option.register $(quote name.getId) $decl)
macro (name := registerOption) mods:declModifiers "register_option" name:ident " : " type:term " := " decl:term : command =>
`($mods:declModifiers initialize $name : Lean.Option $type Lean.Option.register $(quote name.getId) $decl)
end Option

View File

@@ -95,7 +95,7 @@ partial def toPosition (fmap : FileMap) (pos : String.Pos.Raw) : Position :=
-- Some systems like the delaborator use synthetic positions without an input file,
-- which would violate `toPositionAux`'s invariant.
-- Can also happen with EOF errors, which are not strictly inside the file.
fmap.getLastLine, (pos - ps.back!).byteIdx
fmap.getLastLine, ps.back!.byteDistance pos
/-- Convert a `Lean.Position` to a `String.Pos`. -/
def ofPosition (text : FileMap) (pos : Position) : String.Pos.Raw :=

View File

@@ -45,7 +45,7 @@ def validateDocComment
for (start, stop, err) in errs do
-- Report errors at their actual location if possible
if let some pos := pos? then
let urlStx : Syntax := .atom (.synthetic (pos + start) (pos + stop)) (str.extract start stop)
let urlStx : Syntax := .atom (.synthetic (start.offsetBy pos) (stop.offsetBy pos)) (str.extract start stop)
logErrorAt urlStx err
else
logError err

View File

@@ -215,11 +215,11 @@ def getModuleDoc? (env : Environment) (moduleName : Name) : Option (Array Module
def getDocStringText [Monad m] [MonadError m] (stx : TSyntax `Lean.Parser.Command.docComment) : m String :=
match stx.raw[1] with
| Syntax.atom _ val =>
return val.extract 0 (val.endPos - 2)
return val.extract 0 (val.endPos.unoffsetBy 2)
| Syntax.node _ `Lean.Parser.Command.versoCommentBody _ =>
match stx.raw[1][0] with
| Syntax.atom _ val =>
return val.extract 0 (val.endPos - 2)
return val.extract 0 (val.endPos.unoffsetBy 2)
| _ =>
throwErrorAt stx "unexpected doc string{indentD stx}"
| _ =>

View File

@@ -689,11 +689,11 @@ mutual
let info : SourceInfo :=
match info with
| .none => .none
| .synthetic start stop c => .synthetic (start + 1) (stop - 1) c
| .synthetic start stop c => .synthetic (start.offsetBy 1) (stop.unoffsetBy 1) c
| .original leading start trailing stop =>
.original
{leading with stopPos := leading.stopPos + 1} (start + 1)
{trailing with startPos := trailing.startPos - 1} (stop - 1)
{leading with stopPos := leading.stopPos.offsetBy 1} (start.offsetBy 1)
{trailing with startPos := trailing.startPos.unoffsetBy 1} (stop.unoffsetBy 1)
return s.popSyntax.pushSyntax (.atom info str)
return s

View File

@@ -44,17 +44,18 @@ def getMatchAltsNumPatterns (matchAlts : Syntax) : Nat :=
let pats := alt0[1][0].getSepArgs
pats.size
open TSyntax.Compat in
/--
Expand a match alternative such as `| 0 | 1 => rhs` to an array containing `| 0 => rhs` and `| 1 => rhs`.
-/
def expandMatchAlt (stx : TSyntax ``matchAlt) : MacroM (Array (TSyntax ``matchAlt)) :=
match stx with
| `(matchAltExpr| | $[$patss,*]|* => $rhs) =>
if patss.size 1 then
return #[stx]
else
patss.mapM fun pats => `(matchAltExpr| | $pats,* => $rhs)
| _ => return #[stx]
def expandMatchAlt (stx : TSyntax ``matchAlt) : Array (TSyntax ``matchAlt) :=
-- Not using syntax quotations here to keep source location
-- of the pattern sequence (`$term,*`) intact
let patss := stx.raw[1].getSepArgs
if patss.size 1 then
#[stx]
else
patss.map fun pats => stx.raw.setArg 1 (mkNullNode #[pats])
def shouldExpandMatchAlt : TSyntax ``matchAlt Bool
| `(matchAltExpr| | $[$patss,*]|* => $_) => patss.size > 1
@@ -64,7 +65,7 @@ def expandMatchAlts? (stx : Syntax) : MacroM (Option Syntax) := do
match stx with
| `(match $[$gen]? $[$motive]? $discrs,* with $alts:matchAlt*) =>
if alts.any shouldExpandMatchAlt then
let alts alts.foldlM (init := #[]) fun alts alt => return alts ++ ( expandMatchAlt alt)
let alts alts.foldlM (init := #[]) fun alts alt => return alts ++ (expandMatchAlt alt)
`(match $[$gen]? $[$motive]? $discrs,* with $alts:matchAlt*)
else
return none

View File

@@ -29,7 +29,7 @@ namespace Lean.Elab.Command
match stx[1] with
| Syntax.atom _ val =>
if getVersoModuleDocs ( getEnv) |>.isEmpty then
let doc := val.extract 0 (val.endPos - 2)
let doc := val.extract 0 (val.endPos.unoffsetBy 2)
modifyEnv fun env => addMainModuleDoc env doc, range
else
throwError m!"Can't add Markdown-format module docs because there is already Verso-format content present."
@@ -233,7 +233,10 @@ private def throwUnnecessaryScopeName (header : Name) : CommandElabM Unit := do
throwError m!"Unexpected name `{header}` after `end`: The current section is unnamed" ++ hint
@[builtin_command_elab «end»] def elabEnd : CommandElab := fun stx => do
let header? := (stx.getArg 1).getOptionalIdent?
let `(end $[$header? $[.%$trailingDotTk?$_]?]?) := stx
| throwUnsupportedSyntax
let header? := header?.map (·.getId)
let danglingDot := trailingDotTk?.join.isSome
let endSize : Nat := match header? with
| none => 1
| some n => n.getNumParts
@@ -243,12 +246,14 @@ private def throwUnnecessaryScopeName (header : Name) : CommandElabM Unit := do
throwNoScope
match header? with
| none =>
addCompletionInfo <| .endSection stx none false <| scopes.map (·.header)
if let some name := innermostScopeName? scopes then
throwMissingName name
| some header =>
if endSize >= numScopes then
throwTooManyScopeComponents header scopes
else
addCompletionInfo <| .endSection stx header danglingDot <| scopes.map (·.header)
let scopesName := nameOfScopes scopes endSize
if scopesName != header then
if scopesName == .anonymous then

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