mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-22 12:54:06 +00:00
Compare commits
90 Commits
sofia/asyn
...
extCore_pu
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
703b963b09 | ||
|
|
2f93363752 | ||
|
|
4329eae8d4 | ||
|
|
114f7e42f1 | ||
|
|
419982bd42 | ||
|
|
8431088c93 | ||
|
|
803ec8ff9d | ||
|
|
c4747752fe | ||
|
|
ed4d453346 | ||
|
|
45df6fcd37 | ||
|
|
4077bf2c05 | ||
|
|
54a3fbf88f | ||
|
|
746206c5e6 | ||
|
|
88141a0a49 | ||
|
|
b17afe0f06 | ||
|
|
7632cefa87 | ||
|
|
7a47bfa208 | ||
|
|
ae6335f115 | ||
|
|
f58999a7a6 | ||
|
|
888b59bf95 | ||
|
|
1dae353575 | ||
|
|
a4b788c332 | ||
|
|
5865c41a76 | ||
|
|
4b0e8d88ce | ||
|
|
9d427fdfcf | ||
|
|
fe1e7d56f4 | ||
|
|
fbe98d76b2 | ||
|
|
9a5e425990 | ||
|
|
14ff08db6f | ||
|
|
316859e871 | ||
|
|
47dbcd4b93 | ||
|
|
4f7d3bb692 | ||
|
|
0dc862e3ed | ||
|
|
d9ee24bf36 | ||
|
|
0639d49a4c | ||
|
|
3a26eb7281 | ||
|
|
830be29422 | ||
|
|
2a8c03109a | ||
|
|
07f8ab533c | ||
|
|
a73ebe8a77 | ||
|
|
3931a72573 | ||
|
|
bf809b5298 | ||
|
|
4b6f07060d | ||
|
|
09092549d0 | ||
|
|
1b4360c32a | ||
|
|
705dac4f77 | ||
|
|
3bab621364 | ||
|
|
526ab9caff | ||
|
|
71ddf227d2 | ||
|
|
dca8d6d188 | ||
|
|
6f1e932542 | ||
|
|
c32a57e580 | ||
|
|
aa86d95c08 | ||
|
|
f9e140838e | ||
|
|
98a6fa1ac7 | ||
|
|
11be7e8f4a | ||
|
|
a89463bf9e | ||
|
|
7600d41c90 | ||
|
|
80b8e44072 | ||
|
|
1d989523d4 | ||
|
|
3b061a0996 | ||
|
|
1b1c802362 | ||
|
|
50c19f704b | ||
|
|
bbc194b733 | ||
|
|
4e7a2b2371 | ||
|
|
215bc30296 | ||
|
|
b00d1f933f | ||
|
|
5ba0f8b885 | ||
|
|
43da17aa7f | ||
|
|
0195fdf9aa | ||
|
|
5a751d4688 | ||
|
|
486d93c5fd | ||
|
|
8cebe691a2 | ||
|
|
8655f7706f | ||
|
|
5c92ffc64d | ||
|
|
ca7e7c4279 | ||
|
|
13c38f64a5 | ||
|
|
b59959ddab | ||
|
|
8f9c27cc06 | ||
|
|
715c53d92e | ||
|
|
7a9d769444 | ||
|
|
15636a347f | ||
|
|
1ecdf8ddfa | ||
|
|
54c6efea95 | ||
|
|
b13f7e25ec | ||
|
|
6964a15b5d | ||
|
|
ad701b577b | ||
|
|
1f7374a5d6 | ||
|
|
aa3d409eb6 | ||
|
|
7771b8079c |
57
.claude/commands/release.md
Normal file
57
.claude/commands/release.md
Normal 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
|
||||
2
.github/workflows/awaiting-manual.yml
vendored
2
.github/workflows/awaiting-manual.yml
vendored
@@ -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;
|
||||
|
||||
2
.github/workflows/awaiting-mathlib.yml
vendored
2
.github/workflows/awaiting-mathlib.yml
vendored
@@ -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;
|
||||
|
||||
2
.github/workflows/check-stage0.yml
vendored
2
.github/workflows/check-stage0.yml
vendored
@@ -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;
|
||||
|
||||
12
.github/workflows/ci.yml
vendored
12
.github/workflows/ci.yml
vendored
@@ -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
|
||||
|
||||
2
.github/workflows/grove.yml
vendored
2
.github/workflows/grove.yml
vendored
@@ -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
|
||||
|
||||
2
.github/workflows/labels-from-comments.yml
vendored
2
.github/workflows/labels-from-comments.yml
vendored
@@ -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: |
|
||||
|
||||
2
.github/workflows/pr-body.yml
vendored
2
.github/workflows/pr-body.yml
vendored
@@ -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;
|
||||
|
||||
12
.github/workflows/pr-release.yml
vendored
12
.github/workflows/pr-release.yml
vendored
@@ -71,7 +71,7 @@ jobs:
|
||||
GH_TOKEN: ${{ secrets.PR_RELEASES_TOKEN }}
|
||||
- name: Release (short format)
|
||||
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
|
||||
uses: softprops/action-gh-release@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 =
|
||||
|
||||
2
.github/workflows/pr-title.yml
vendored
2
.github/workflows/pr-title.yml
vendored
@@ -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;
|
||||
|
||||
2
.github/workflows/stale.yml
vendored
2
.github/workflows/stale.yml
vendored
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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",
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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⟩
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)]
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
53
src/Init/Data/Iterators/Combinators/FlatMap.lean
Normal file
53
src/Init/Data/Iterators/Combinators/FlatMap.lean
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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} :
|
||||
|
||||
@@ -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
|
||||
|
||||
385
src/Init/Data/Iterators/Combinators/Monadic/FlatMap.lean
Normal file
385
src/Init/Data/Iterators/Combinators/Monadic/FlatMap.lean
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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 :=
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
/--
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
266
src/Init/Data/Iterators/Lemmas/Combinators/FlatMap.lean
Normal file
266
src/Init/Data/Iterators/Lemmas/Combinators/FlatMap.lean
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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,
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
344
src/Init/Data/Iterators/Lemmas/Combinators/Monadic/FlatMap.lean
Normal file
344
src/Init/Data/Iterators/Lemmas/Combinators/Monadic/FlatMap.lean
Normal 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
|
||||
@@ -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 ‹_›
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 exact⟨a.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 exact⟨a.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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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. -/
|
||||
|
||||
/--
|
||||
|
||||
@@ -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 α`
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =>
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
320
src/Init/Data/Range/Polymorphic/Internal/SignedBitVec.lean
Normal file
320
src/Init/Data/Range/Polymorphic/Internal/SignedBitVec.lean
Normal 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
|
||||
@@ -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 α) α :=
|
||||
|
||||
@@ -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} :
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
681
src/Init/Data/Range/Polymorphic/SInt.lean
Normal file
681
src/Init/Data/Range/Polymorphic/SInt.lean
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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 : α} :
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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 :=
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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 :=
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}"
|
||||
| _ =>
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
Reference in New Issue
Block a user