test:

This PR introduces a local artifact cache for Lake. When enabled, Lake
will shared build artifacts (built files) across different instances of
the same package using an input- and content-addressed cache.

To enable support for the local cache, packages must set
`enableArtifactCache := true` in their package configuration. The reason
for this is twofold. This feature is new and experimental, so it should
be opt-in. Also, some packages may need to disable it as the cache
entails that artifacts are no longer necessarily available within the
build directory, which can break custom build scripts.

The cache location is determined by the system configuration. Lake's
first preference is to store it under the Lean toolchain in a
`lake/cache` directory. If Elan is not available, Lake will store it in
common system location (e.g., `$XDG_CACHE_HOME/lake`, or
`~/.cache/lake`). On an exotic system where neither of these exist, the
cache will be disabled. Users can override this location through the
`LAKE_CACHE_DIR` environment variable. If set to empty, caching will be
disabled.

The cache is both input and content-addressed. Mappings from input hash
to output content hash(es) are stored in a per-package JSON Lines file
(e.g., `<cache-dir>/inputs/<pkg-name>.jsonl`). Thus, mappings are shared
across different instances of a package, but not between packages. The
output content hashes are also now stored in trace files in a new
`outputs` field. The value of this field can be either a single hash or
an object of multiple content hashes for targets which produce multiple
artifacts (e.g., Lean module builds). Separately, artifacts are stored
in a single flat content-addressed cache (e.g.,
`<cache-dir>/artifacts/<hash>.art`. Artifacts are therefore shared
across all cache-enabled packages.

Module `*.olean` and and `*.ilean` artifacts are cached. However, each
package will still copy the files to their build directory, as Lean and
the server currently expect them to be at a specific path. This will be
changed for `*.olean` files when the performance issues with
pre-resolving modules in Lake for `lean --setup` are solved.

.github/workflows/ci.yml

@@ -145,6 +145,7 @@ jobs:
             // use large runners where available (original repo)
             let large = ${{ github.repository == 'leanprover/lean4' }};
             const isPr = "${{ github.event_name }}" == "pull_request";
+            const isPushToMaster = "${{ github.event_name }}" == "push" && "${{ github.ref_name }}" == "master";
             let matrix = [
               /* TODO: to be updated to new LLVM
               {
@@ -167,11 +168,13 @@ jobs:
                 "os": large && level < 2 ? "nscloud-ubuntu-22.04-amd64-4x16" : "ubuntu-latest",
                 "release": true,
                 // Special handling for release jobs. We want:
-                // 1. To run it in PRs so developrs get PR toolchains (so secondary is sufficient)
+                // 1. To run it in PRs so developers get PR toolchains (so secondary is sufficient)
                 // 2. To skip it in merge queues as it takes longer than the
                 //    Linux lake build and adds little value in the merge queue
                 // 3. To run it in release (obviously)
-                "check-level": isPr ? 0 : 2,
+                // 4. To run it for pushes to master so that pushes to master have a Linux toolchain
+                //    available as an artifact for Grove to use.
+                "check-level": (isPr || isPushToMaster) ? 0 : 2,
                 "secondary": isPr,
                 "shell": "nix develop .#oldGlibc -c bash -euxo pipefail {0}",
                 "llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/19.1.2/lean-llvm-x86_64-linux-gnu.tar.zst",

.github/workflows/grove.yml

@@ -0,0 +1,161 @@
+name: Grove
+
+on:
+  workflow_run: # https://docs.github.com/en/actions/using-workflows/events-that-trigger-workflows#workflow_run
+    workflows: [CI]
+    types: [completed]
+
+permissions:
+  pull-requests: write
+
+jobs:
+  grove-build:
+    runs-on: ubuntu-latest
+    if: github.event.workflow_run.conclusion == 'success' && github.repository == 'leanprover/lean4'
+
+    steps:
+      - name: Retrieve information about the original workflow
+        uses: potiuk/get-workflow-origin@v1_1 # https://github.com/marketplace/actions/get-workflow-origin
+        # This action is deprecated and archived, but it seems hard to find a
+        # better solution for getting the PR number
+        # see https://github.com/orgs/community/discussions/25220 for some discussion
+        id: workflow-info
+        with:
+          token: ${{ secrets.GITHUB_TOKEN }}
+          sourceRunId: ${{ github.event.workflow_run.id }}
+
+      - name: Check if should run
+        id: should-run
+        run: |
+          # Check if it's a push to master (no PR number and target branch is master)
+          if [ -z "${{ steps.workflow-info.outputs.pullRequestNumber }}" ]; then
+            if [ "${{ github.event.workflow_run.head_branch }}" = "master" ]; then
+              echo "Push to master detected. Skipping for now, to be enabled later."
+              echo "should-run=false" >> "$GITHUB_OUTPUT"
+            else
+              echo "Push to non-master branch, skipping"
+              echo "should-run=false" >> "$GITHUB_OUTPUT"
+            fi
+          else
+            # Check if it's a PR with grove label
+            PR_LABELS='${{ steps.workflow-info.outputs.pullRequestLabels }}'
+            if echo "$PR_LABELS" | grep -q '"grove"'; then
+              echo "PR with grove label detected"
+              echo "should-run=true" >> "$GITHUB_OUTPUT"
+            else
+              echo "PR without grove label, skipping"
+              echo "should-run=false" >> "$GITHUB_OUTPUT"
+            fi
+          fi
+
+      - name: Fetch upstream invalidated facts
+        if: ${{ steps.should-run.outputs.should-run == 'true' && steps.workflow-info.outputs.pullRequestNumber != '' }}
+        id: fetch-upstream
+        uses: TwoFx/grove-action/fetch-upstream@v0.3
+        with:
+          artifact-name: grove-invalidated-facts
+          base-ref: master
+
+      - name: Download toolchain for this commit
+        if: ${{ steps.should-run.outputs.should-run == 'true' }}
+        id: download-toolchain
+        uses: dawidd6/action-download-artifact@v11
+        with:
+          commit: ${{ steps.workflow-info.outputs.sourceHeadSha }}
+          workflow: ci.yml
+          path: artifacts
+          name: build-Linux.*
+          name_is_regexp: true
+
+      - name: Unpack toolchain
+        if: ${{ steps.should-run.outputs.should-run == 'true' }}
+        id: unpack-toolchain
+        run: |
+          cd artifacts
+          # Find the tar.zst file
+          TAR_FILE=$(find . -name "lean-*.tar.zst" -type f | head -1)
+          if [ -z "$TAR_FILE" ]; then
+            echo "Error: No lean-*.tar.zst file found"
+            exit 1
+          fi
+          echo "Found archive: $TAR_FILE"
+
+          # Extract the archive
+          tar --zstd -xf "$TAR_FILE"
+
+          # Find the extracted directory name
+          LEAN_DIR=$(find . -maxdepth 1 -name "lean-*" -type d | head -1)
+          if [ -z "$LEAN_DIR" ]; then
+            echo "Error: No lean-* directory found after extraction"
+            exit 1
+          fi
+          echo "Extracted directory: $LEAN_DIR"
+          echo "lean-dir=$LEAN_DIR" >> "$GITHUB_OUTPUT"
+
+      - name: Build
+        if: ${{ steps.should-run.outputs.should-run == 'true' }}
+        id: build
+        uses: TwoFx/grove-action/build@v0.3
+        with:
+          project-path: doc/std/grove
+          script-name: grove-stdlib
+          invalidated-facts-artifact-name: grove-invalidated-facts
+          comment-artifact-name: grove-comment
+          toolchain-id: lean4
+          toolchain-path: artifacts/${{ steps.unpack-toolchain.outputs.lean-dir }}
+          project-ref: ${{ steps.workflow-info.outputs.sourceHeadSha }}
+
+      # deploy-alias computes a URL component for the PR preview. This
+      # is so we can have a stable name to use for feedback on draft
+      # material.
+      - id: deploy-alias
+        if: ${{ steps.should-run.outputs.should-run == 'true' }}
+        uses: actions/github-script@v7
+        name: Compute Alias
+        with:
+          result-encoding: string
+          script: |
+            if (process.env.PR) {
+                return `pr-${process.env.PR}`
+            } else {
+                return 'deploy-preview-main';
+            }
+        env:
+          PR: ${{ steps.workflow-info.outputs.pullRequestNumber }}
+
+      - name: Deploy to Netlify
+        if: ${{ steps.should-run.outputs.should-run == 'true' }}
+        id: deploy-draft
+        uses: nwtgck/actions-netlify@v3.0
+        with:
+          publish-dir: ${{ steps.build.outputs.out-path }}
+          production-deploy: false
+          github-token: ${{ secrets.GITHUB_TOKEN }}
+          alias: ${{ steps.deploy-alias.outputs.result }}
+          enable-commit-comment: false
+          enable-pull-request-comment: false
+          fails-without-credentials: true
+          enable-github-deployment: false
+          enable-commit-status: false
+        env:
+          NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }}
+          NETLIFY_SITE_ID: "1cacfa39-a11c-467c-99e7-2e01d7b4089e"
+
+      # actions-netlify cannot add deploy links to a PR because it assumes a
+      # pull_request context, not a workflow_run context, see
+      # https://github.com/nwtgck/actions-netlify/issues/545
+      # We work around by using a comment to post the latest link
+      - name: "Comment on PR with preview links"
+        uses: marocchino/sticky-pull-request-comment@v2
+        if: ${{ steps.should-run.outputs.should-run == 'true' && steps.workflow-info.outputs.pullRequestNumber != '' }}
+        with:
+          number: ${{ env.PR_NUMBER }}
+          header: preview-comment
+          recreate: true
+          message: |
+            [Grove](${{ steps.deploy-draft.outputs.deploy-url }}) for revision ${{ steps.workflow-info.outputs.sourceHeadSha }}.
+
+            ${{ steps.build.outputs.comment-text }}
+        env:
+          PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }}
+          PR_HEADSHA: ${{ steps.workflow-info.outputs.sourceHeadSha }}

doc/std/grove/.gitignore

@@ -0,0 +1,4 @@
+/.lake
+!lake-manifest.json
+metadata.json
+invalidated.json

doc/std/grove/GroveStdlib/Generated.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Generated
+
+def restoreState : RestoreStateM Unit := do
+  return ()

doc/std/grove/GroveStdlib/Std.lean

@@ -0,0 +1,31 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import GroveStdlib.Std.CoreTypesAndOperations
+import GroveStdlib.Std.LanguageConstructs
+import GroveStdlib.Std.Libraries
+import GroveStdlib.Std.OperatingSystemAbstractions
+
+open Grove.Framework Widget
+
+namespace GroveStdlib
+
+namespace Std
+
+def introduction : Node :=
+  .text "Welcome to the interactive Lean standard library outline!"
+
+end Std
+
+def std : Node :=
+  .section "stdlib" "The Lean standard library" #[
+    Std.introduction,
+    Std.coreTypesAndOperations,
+    Std.languageConstructs,
+    Std.libraries,
+    Std.operatingSystemAbstractions
+  ]
+
+end GroveStdlib

doc/std/grove/GroveStdlib/Std/CoreTypesAndOperations.lean

@@ -0,0 +1,28 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+import GroveStdlib.Std.CoreTypesAndOperations.BasicTypes
+import GroveStdlib.Std.CoreTypesAndOperations.Containers
+import GroveStdlib.Std.CoreTypesAndOperations.Numbers
+import GroveStdlib.Std.CoreTypesAndOperations.StringsAndFormatting
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std
+
+namespace CoreTypesAndOperations
+
+end CoreTypesAndOperations
+
+def coreTypesAndOperations : Node :=
+  .section "core-types-and-operations" "Core types and operations" #[
+    CoreTypesAndOperations.basicTypes,
+    CoreTypesAndOperations.containers,
+    CoreTypesAndOperations.numbers,
+    CoreTypesAndOperations.stringsAndFormatting
+  ]
+
+end GroveStdlib.Std

doc/std/grove/GroveStdlib/Std/CoreTypesAndOperations/BasicTypes.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.CoreTypesAndOperations
+
+namespace BasicTypes
+
+end BasicTypes
+
+def basicTypes : Node :=
+  .section "basic-types" "Basic types" #[]
+
+end GroveStdlib.Std.CoreTypesAndOperations

doc/std/grove/GroveStdlib/Std/CoreTypesAndOperations/Containers.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.CoreTypesAndOperations
+
+namespace Containers
+
+end Containers
+
+def containers : Node :=
+  .section "containers" "Containers" #[]
+
+end GroveStdlib.Std.CoreTypesAndOperations

doc/std/grove/GroveStdlib/Std/CoreTypesAndOperations/Numbers.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.CoreTypesAndOperations
+
+namespace Numbers
+
+end Numbers
+
+def numbers : Node :=
+  .section "numbers" "Numbers" #[]
+
+end GroveStdlib.Std.CoreTypesAndOperations

doc/std/grove/GroveStdlib/Std/CoreTypesAndOperations/StringsAndFormatting.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.CoreTypesAndOperations
+
+namespace StringsAndFormatting
+
+end StringsAndFormatting
+
+def stringsAndFormatting : Node :=
+  .section "strings-and-formatting" "Strings and formatting" #[]
+
+end GroveStdlib.Std.CoreTypesAndOperations

doc/std/grove/GroveStdlib/Std/LanguageConstructs.lean

@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+import GroveStdlib.Std.LanguageConstructs.ComparisonOrderingHashing
+import GroveStdlib.Std.LanguageConstructs.Monads
+import GroveStdlib.Std.LanguageConstructs.RangesAndIterators
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std
+
+namespace LanguageConstructs
+
+end LanguageConstructs
+
+def languageConstructs : Node :=
+  .section "language-constructs" "Language constructs" #[
+    LanguageConstructs.comparisonOrderingHashing,
+    LanguageConstructs.monads,
+    LanguageConstructs.rangesAndIterators
+  ]
+
+end GroveStdlib.Std

doc/std/grove/GroveStdlib/Std/LanguageConstructs/ComparisonOrderingHashing.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.LanguageConstructs
+
+namespace ComparisonOrderingHashing
+
+end ComparisonOrderingHashing
+
+def comparisonOrderingHashing : Node :=
+  .section "comparison-ordering-hashing" "Comparison, ordering, hashing" #[]
+
+end GroveStdlib.Std.LanguageConstructs

doc/std/grove/GroveStdlib/Std/LanguageConstructs/Monads.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.LanguageConstructs
+
+namespace Monads
+
+end Monads
+
+def monads : Node :=
+  .section "monads" "Monads" #[]
+
+end GroveStdlib.Std.LanguageConstructs

doc/std/grove/GroveStdlib/Std/LanguageConstructs/RangesAndIterators.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.LanguageConstructs
+
+namespace RangesAndIterators
+
+end RangesAndIterators
+
+def rangesAndIterators : Node :=
+  .section "ranges-and-iterators" "Ranges and iterators" #[]
+
+end GroveStdlib.Std.LanguageConstructs

doc/std/grove/GroveStdlib/Std/Libraries.lean

@@ -0,0 +1,24 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+import GroveStdlib.Std.Libraries.DateAndTime
+import GroveStdlib.Std.Libraries.RandomNumbers
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std
+
+namespace Libraries
+
+end Libraries
+
+def libraries : Node :=
+  .section "libraries" "Libraries" #[
+    Libraries.dateAndTime,
+    Libraries.randomNumbers
+  ]
+
+end GroveStdlib.Std

doc/std/grove/GroveStdlib/Std/Libraries/DateAndTime.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.Libraries
+
+namespace DateAndTime
+
+end DateAndTime
+
+def dateAndTime : Node :=
+  .section "date-and-time" "Date and time" #[]
+
+end GroveStdlib.Std.Libraries

doc/std/grove/GroveStdlib/Std/Libraries/RandomNumbers.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.Libraries
+
+namespace RandomNumbers
+
+end RandomNumbers
+
+def randomNumbers : Node :=
+  .section "random-numbers" "Random numbers" #[]
+
+end GroveStdlib.Std.Libraries

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions.lean

@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+import GroveStdlib.Std.OperatingSystemAbstractions.AsynchronousIO
+import GroveStdlib.Std.OperatingSystemAbstractions.BasicIO
+import GroveStdlib.Std.OperatingSystemAbstractions.ConcurrencyAndParallelism
+import GroveStdlib.Std.OperatingSystemAbstractions.EnvironmentFileSystemProcesses
+import GroveStdlib.Std.OperatingSystemAbstractions.Locales
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std
+
+namespace OperatingSystemAbstractions
+
+end OperatingSystemAbstractions
+
+def operatingSystemAbstractions : Node :=
+  .section "operating-system-abstractions" "Operating system abstractions" #[
+    OperatingSystemAbstractions.asynchronousIO,
+    OperatingSystemAbstractions.basicIO,
+    OperatingSystemAbstractions.concurrencyAndParallelism,
+    OperatingSystemAbstractions.environmentFileSystemProcesses,
+    OperatingSystemAbstractions.locales
+  ]
+
+end GroveStdlib.Std

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions/AsynchronousIO.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.OperatingSystemAbstractions
+
+namespace AsynchronousIO
+
+end AsynchronousIO
+
+def asynchronousIO : Node :=
+  .section "asynchronous-io" "Asynchronous I/O" #[]
+
+end GroveStdlib.Std.OperatingSystemAbstractions

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions/BasicIO.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.OperatingSystemAbstractions
+
+namespace BasicIO
+
+end BasicIO
+
+def basicIO : Node :=
+  .section "basic-io" "Basic I/O" #[]
+
+end GroveStdlib.Std.OperatingSystemAbstractions

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions/ConcurrencyAndParallelism.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.OperatingSystemAbstractions
+
+namespace ConcurrencyAndParallelism
+
+end ConcurrencyAndParallelism
+
+def concurrencyAndParallelism : Node :=
+  .section "concurrency-and-parallelism" "Concurrency and parallelism" #[]
+
+end GroveStdlib.Std.OperatingSystemAbstractions

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions/EnvironmentFileSystemProcesses.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.OperatingSystemAbstractions
+
+namespace EnvironmentFileSystemProcesses
+
+end EnvironmentFileSystemProcesses
+
+def environmentFileSystemProcesses : Node :=
+  .section "environment-filesystem-processes" "Environment, file system, processes" #[]
+
+end GroveStdlib.Std.OperatingSystemAbstractions

doc/std/grove/GroveStdlib/Std/OperatingSystemAbstractions/Locales.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import Grove.Framework
+
+open Grove.Framework Widget
+
+namespace GroveStdlib.Std.OperatingSystemAbstractions
+
+namespace Locales
+
+end Locales
+
+def locales : Node :=
+  .section "locales" "Locales" #[]
+
+end GroveStdlib.Std.OperatingSystemAbstractions

doc/std/grove/Main.lean

@@ -0,0 +1,18 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+import GroveStdlib.Std
+import GroveStdlib.Generated
+
+def config : Grove.Framework.Project.Configuration where
+  projectNamespace := `GroveStdlib
+
+def project : Grove.Framework.Project where
+  config := config
+  rootNode := GroveStdlib.std
+  restoreState := GroveStdlib.Generated.restoreState
+
+def main (args : List String) : IO UInt32 :=
+  Grove.Framework.main project #[`Init, `Std, `Lean] args

doc/std/grove/README.md

@@ -0,0 +1,3 @@
+# Standard library QA
+
+This directory contains the [Grove](github.com/TwoFX/grove) data files for the standard library.

doc/std/grove/grove-local.sh

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+lake exe grove-stdlib --full metadata.json
+cd .lake/packages/grove/frontend
+npm install
+if [ -f "../../../../invalidated.json" ]; then
+    GROVE_DATA_LOCATION=../../../../metadata.json GROVE_UPSTREAM_INVALIDATED_FACTS_LOCATION=../../../../invalidated.json npm run dev
+else
+    GROVE_DATA_LOCATION=../../../../metadata.json npm run dev
+fi

doc/std/grove/lake-manifest.json

@@ -0,0 +1,25 @@
+{"version": "1.1.0",
+ "packagesDir": ".lake/packages",
+ "packages":
+ [{"url": "https://github.com/TwoFx/grove.git",
+   "type": "git",
+   "subDir": "backend",
+   "scope": "",
+   "rev": "78110476d9c76abd4103d91a0ae3f89405558065",
+   "name": "grove",
+   "manifestFile": "lake-manifest.json",
+   "inputRev": "master",
+   "inherited": false,
+   "configFile": "lakefile.toml"},
+  {"url": "https://github.com/leanprover/lean4-cli",
+   "type": "git",
+   "subDir": null,
+   "scope": "leanprover",
+   "rev": "1604206fcd0462da9a241beeac0e2df471647435",
+   "name": "Cli",
+   "manifestFile": "lake-manifest.json",
+   "inputRev": "main",
+   "inherited": true,
+   "configFile": "lakefile.toml"}],
+ "name": "grovestdlib",
+ "lakeDir": ".lake"}

doc/std/grove/lakefile.toml

@@ -0,0 +1,18 @@
+name = "grovestdlib"
+version = "0.1.0"
+defaultTargets = ["grove-stdlib"]
+
+[[require]]
+name = "grove"
+git = "https://github.com/TwoFx/grove.git"
+rev = "master"
+subDir = "backend"
+
+[[lean_lib]]
+name = "GroveStdlib"
+root = "GroveStdlib"
+
+[[lean_exe]]
+name = "grove-stdlib"
+supportInterpreter = true
+root = "Main"

doc/std/grove/lean-toolchain

@@ -0,0 +1 @@
+lean4

doc/std/grove/update_invalidated.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+lake exe grove-stdlib --invalidated invalidated.json

src/Init/Control/Id.lean

@@ -62,4 +62,7 @@ protected def run (x : Id α) : α := x
 instance [OfNat α n] : OfNat (Id α) n :=
   inferInstanceAs (OfNat α n)
 
+instance {m : Type u → Type v} [Pure m] : MonadLiftT Id m where
+  monadLift x := pure x.run
+
 end Id

src/Init/Control/Lawful/MonadLift/Instances.lean

@@ -11,6 +11,7 @@ import all Init.Control.Except
 import all Init.Control.ExceptCps
 import all Init.Control.StateRef
 import all Init.Control.StateCps
+import all Init.Control.Id
 import Init.Control.Lawful.MonadLift.Lemmas
 import Init.Control.Lawful.Instances
 
@@ -135,3 +136,11 @@ instance {ε : Type u} [Monad m] [LawfulMonad m] : LawfulMonadLift m (ExceptCpsT
     simp only [bind_assoc]
 
 end ExceptCpsT
+
+namespace Id
+
+instance [Monad m] [LawfulMonad m] : LawfulMonadLiftT Id m where
+  monadLift_pure a := by simp [monadLift]
+  monadLift_bind a f := by simp [monadLift]
+
+end Id

src/Init/Data.lean

@@ -47,3 +47,5 @@ import Init.Data.Function
 import Init.Data.RArray
 import Init.Data.Vector
 import Init.Data.Iterators
+import Init.Data.Range.Polymorphic
+import Init.Data.Slice

src/Init/Data/Array/Subarray.lean

@@ -7,6 +7,7 @@ module
 
 prelude
 import Init.Data.Array.Basic
+import Init.Data.Slice.Basic
 
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 set_option linter.missingDocs true
@@ -14,14 +15,9 @@ set_option linter.missingDocs true
 universe u v w
 
 /--
-A region of some underlying array.
-
-A subarray contains an array together with the start and end indices of a region of interest.
-Subarrays can be used to avoid copying or allocating space, while being more convenient than
-tracking the bounds by hand. The region of interest consists of every index that is both greater
-than or equal to `start` and strictly less than `stop`.
+Internal representation of `Subarray`, which is an abbreviation for `Slice SubarrayData`.
 -/
-structure Subarray (α : Type u) where
+structure Std.Slice.Internal.SubarrayData (α : Type u) where
   /-- The underlying array. -/
   array : Array α
   /-- The starting index of the region of interest (inclusive). -/
@@ -42,6 +38,40 @@ structure Subarray (α : Type u) where
   -/
   stop_le_array_size : stop ≤ array.size
 
+open Std.Slice
+
+/--
+A region of some underlying array.
+
+A subarray contains an array together with the start and end indices of a region of interest.
+Subarrays can be used to avoid copying or allocating space, while being more convenient than
+tracking the bounds by hand. The region of interest consists of every index that is both greater
+than or equal to `start` and strictly less than `stop`.
+-/
+abbrev Subarray (α : Type u) := Std.Slice (Internal.SubarrayData α)
+
+instance {α : Type u} : Self (Std.Slice (Internal.SubarrayData α)) (Subarray α) where
+
+@[always_inline, inline, expose, inherit_doc Internal.SubarrayData.array]
+def Subarray.array (xs : Subarray α) : Array α :=
+  xs.internalRepresentation.array
+
+@[always_inline, inline, expose, inherit_doc Internal.SubarrayData.start]
+def Subarray.start (xs : Subarray α) : Nat :=
+  xs.internalRepresentation.start
+
+@[always_inline, inline, expose, inherit_doc Internal.SubarrayData.stop]
+def Subarray.stop (xs : Subarray α) : Nat :=
+  xs.internalRepresentation.stop
+
+@[always_inline, inline, expose, inherit_doc Internal.SubarrayData.start_le_stop]
+def Subarray.start_le_stop (xs : Subarray α) : xs.start ≤ xs.stop :=
+  xs.internalRepresentation.start_le_stop
+
+@[always_inline, inline, expose, inherit_doc Internal.SubarrayData.stop_le_array_size]
+def Subarray.stop_le_array_size (xs : Subarray α) : xs.stop ≤ xs.array.size :=
+  xs.internalRepresentation.stop_le_array_size
+
 namespace Subarray
 
 /--
@@ -51,7 +81,7 @@ def size (s : Subarray α) : Nat :=
   s.stop - s.start
 
 theorem size_le_array_size {s : Subarray α} : s.size ≤ s.array.size := by
-  let {array, start, stop, start_le_stop, stop_le_array_size} := s
+  let ⟨{array, start, stop, start_le_stop, stop_le_array_size}⟩ := s
   simp [size]
   apply Nat.le_trans (Nat.sub_le stop start)
   assumption
@@ -102,7 +132,9 @@ Examples:
 -/
 def popFront (s : Subarray α) : Subarray α :=
   if h : s.start < s.stop then
-    { s with start := s.start + 1, start_le_stop := Nat.le_of_lt_succ (Nat.add_lt_add_right h 1) }
+    ⟨{ s.internalRepresentation with
+        start := s.start + 1,
+        start_le_stop := Nat.le_of_lt_succ (Nat.add_lt_add_right h 1) }⟩
   else
     s
 
@@ -111,12 +143,13 @@ The empty subarray.
 
 This empty subarray is backed by an empty array.
 -/
-protected def empty : Subarray α where
-  array := #[]
-  start := 0
-  stop := 0
-  start_le_stop := Nat.le_refl 0
-  stop_le_array_size := Nat.le_refl 0
+protected def empty : Subarray α := ⟨{
+    array := #[]
+    start := 0
+    stop := 0
+    start_le_stop := Nat.le_refl 0
+    stop_le_array_size := Nat.le_refl 0
+  }⟩
 
 instance : EmptyCollection (Subarray α) :=
   ⟨Subarray.empty⟩
@@ -410,24 +443,24 @@ Additionally, the starting index is clamped to the ending index.
 def toSubarray (as : Array α) (start : Nat := 0) (stop : Nat := as.size) : Subarray α :=
   if h₂ : stop ≤ as.size then
     if h₁ : start ≤ stop then
-      { array := as, start := start, stop := stop,
-        start_le_stop := h₁, stop_le_array_size := h₂ }
+      ⟨{ array := as, start := start, stop := stop,
+         start_le_stop := h₁, stop_le_array_size := h₂ }⟩
     else
-      { array := as, start := stop, stop := stop,
-        start_le_stop := Nat.le_refl _, stop_le_array_size := h₂ }
+      ⟨{ array := as, start := stop, stop := stop,
+         start_le_stop := Nat.le_refl _, stop_le_array_size := h₂ }⟩
   else
     if h₁ : start ≤ as.size then
-      { array := as,
-        start := start,
-        stop := as.size,
-        start_le_stop := h₁,
-        stop_le_array_size := Nat.le_refl _ }
+      ⟨{ array := as,
+         start := start,
+         stop := as.size,
+         start_le_stop := h₁,
+         stop_le_array_size := Nat.le_refl _ }⟩
     else
-      { array := as,
-        start := as.size,
-        stop := as.size,
-        start_le_stop := Nat.le_refl _,
-        stop_le_array_size := Nat.le_refl _ }
+      ⟨{ array := as,
+         start := as.size,
+         stop := as.size,
+         start_le_stop := Nat.le_refl _,
+         stop_le_array_size := Nat.le_refl _ }⟩
 
 /--
 Allocates a new array that contains the contents of the subarray.

src/Init/Data/Array/Subarray/Split.lean

@@ -21,44 +21,24 @@ set_option linter.listVariables true -- Enforce naming conventions for `List`/`A
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
 namespace Subarray
-/--
-Splits a subarray into two parts, the first of which contains the first `i` elements and the second
-of which contains the remainder.
--/
-def split (s : Subarray α) (i : Fin s.size.succ) : (Subarray α × Subarray α) :=
-  let ⟨i', isLt⟩ := i
-  have := s.start_le_stop
-  have := s.stop_le_array_size
-  have : s.start + i' ≤ s.stop := by
-    simp only [size] at isLt
-    omega
-  let pre := {s with
-    stop := s.start + i',
-    start_le_stop := by omega,
-    stop_le_array_size := by omega
-  }
-  let post := {s with
-    start := s.start + i'
-    start_le_stop := by assumption
-  }
-  (pre, post)
 
 /--
 Removes the first `i` elements of the subarray. If there are `i` or fewer elements, the resulting
 subarray is empty.
 -/
-def drop (arr : Subarray α) (i : Nat) : Subarray α where
+def drop (arr : Subarray α) (i : Nat) : Subarray α := ⟨{
   array := arr.array
   start := min (arr.start + i) arr.stop
   stop := arr.stop
   start_le_stop := by omega
   stop_le_array_size := arr.stop_le_array_size
+}⟩
 
 /--
 Keeps only the first `i` elements of the subarray. If there are `i` or fewer elements, the resulting
 subarray is empty.
 -/
-def take (arr : Subarray α) (i : Nat) : Subarray α where
+def take (arr : Subarray α) (i : Nat) : Subarray α := ⟨{
   array := arr.array
   start := arr.start
   stop := min (arr.start + i) arr.stop
@@ -68,3 +48,11 @@ def take (arr : Subarray α) (i : Nat) : Subarray α where
   stop_le_array_size := by
     have := arr.stop_le_array_size
     omega
+}⟩
+
+/--
+Splits a subarray into two parts, the first of which contains the first `i` elements and the second
+of which contains the remainder.
+-/
+def split (s : Subarray α) (i : Fin s.size.succ) : (Subarray α × Subarray α) :=
+  (s.take i, s.drop i)

src/Init/Data/BitVec/Basic.lean

@@ -37,7 +37,7 @@ instance natCastInst : NatCast (BitVec w) := ⟨BitVec.ofNat w⟩
 
 /-- Theorem for normalizing the bitvector literal representation. -/
 -- TODO: This needs more usage data to assess which direction the simp should go.
-@[simp, bitvec_to_nat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
+@[simp, bitvec_to_nat, grind =] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl
 
 -- Note. Mathlib would like this to go the other direction.
 @[simp] theorem natCast_eq_ofNat (w x : Nat) : @Nat.cast (BitVec w) _ x = .ofNat w x := rfl
@@ -115,17 +115,18 @@ instance : GetElem (BitVec w) Nat Bool fun _ i => i < w where
   getElem xs i h := xs.getLsb ⟨i, h⟩
 
 /-- We prefer `x[i]` as the simp normal form for `getLsb'` -/
-@[simp] theorem getLsb_eq_getElem (x : BitVec w) (i : Fin w) :
+@[simp, grind =] theorem getLsb_eq_getElem (x : BitVec w) (i : Fin w) :
     x.getLsb i = x[i] := rfl
 
 /-- We prefer `x[i]?` as the simp normal form for `getLsb?` -/
-@[simp] theorem getLsb?_eq_getElem? (x : BitVec w) (i : Nat) :
+@[simp, grind =] theorem getLsb?_eq_getElem? (x : BitVec w) (i : Nat) :
     x.getLsb? i = x[i]? := rfl
 
+@[grind =_] -- Activate when we see `x.toNat.testBit i`.
 theorem getElem_eq_testBit_toNat (x : BitVec w) (i : Nat) (h : i < w) :
   x[i] = x.toNat.testBit i := rfl
 
-@[simp]
+@[simp, grind =]
 theorem getLsbD_eq_getElem {x : BitVec w} {i : Nat} (h : i < w) :
     x.getLsbD i = x[i] := rfl
 
@@ -356,8 +357,8 @@ section bool
 @[expose]
 def ofBool (b : Bool) : BitVec 1 := cond b 1 0
 
-@[simp] theorem ofBool_false : ofBool false = 0 := by trivial
-@[simp] theorem ofBool_true  : ofBool true  = 1 := by trivial
+@[simp, grind =] theorem ofBool_false : ofBool false = 0 := by trivial
+@[simp, grind =] theorem ofBool_true  : ofBool true  = 1 := by trivial
 
 /-- Fills a bitvector with `w` copies of the bit `b`. -/
 def fill (w : Nat) (b : Bool) : BitVec w := bif b then -1 else 0
@@ -415,15 +416,15 @@ that can more consistently simplify `BitVec.cast` away.
 -/
 @[inline, expose] protected def cast (eq : n = m) (x : BitVec n) : BitVec m := .ofNatLT x.toNat (eq ▸ x.isLt)
 
-@[simp] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) :
+@[simp, grind =] theorem cast_ofNat {n m : Nat} (h : n = m) (x : Nat) :
     (BitVec.ofNat n x).cast h = BitVec.ofNat m x := by
   subst h; rfl
 
-@[simp] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) :
+@[simp, grind =] theorem cast_cast {n m k : Nat} (h₁ : n = m) (h₂ : m = k) (x : BitVec n) :
     (x.cast h₁).cast h₂ = x.cast (h₁ ▸ h₂) :=
   rfl
 
-@[simp] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : x.cast h = x := rfl
+@[simp, grind =] theorem cast_eq {n : Nat} (h : n = n) (x : BitVec n) : x.cast h = x := rfl
 
 /--
 Extracts the bits `start` to `start + len - 1` from a bitvector of size `n` to yield a
@@ -707,10 +708,12 @@ The new bit is the most significant bit.
 def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) :=
   ((ofBool msb) ++ lsbs).cast (Nat.add_comm ..)
 
+@[grind =]
 theorem append_ofBool (msbs : BitVec w) (lsb : Bool) :
     msbs ++ ofBool lsb = concat msbs lsb :=
   rfl
 
+@[grind =]
 theorem ofBool_append (msb : Bool) (lsbs : BitVec w) :
     ofBool msb ++ lsbs = (cons msb lsbs).cast (Nat.add_comm ..) :=
   rfl
@@ -745,20 +748,20 @@ instance : Hashable (BitVec n) where
 
 section normalization_eqs
 /-! We add simp-lemmas that rewrite bitvector operations into the equivalent notation -/
-@[simp] theorem append_eq (x : BitVec w) (y : BitVec v)   : BitVec.append x y = x ++ y        := rfl
-@[simp] theorem shiftLeft_eq (x : BitVec w) (n : Nat)     : BitVec.shiftLeft x n = x <<< n    := rfl
-@[simp] theorem ushiftRight_eq (x : BitVec w) (n : Nat)   : BitVec.ushiftRight x n = x >>> n  := rfl
-@[simp] theorem not_eq (x : BitVec w)                     : BitVec.not x = ~~~x               := rfl
-@[simp] theorem and_eq (x y : BitVec w)                   : BitVec.and x y = x &&& y          := rfl
-@[simp] theorem or_eq (x y : BitVec w)                    : BitVec.or x y = x ||| y           := rfl
-@[simp] theorem xor_eq (x y : BitVec w)                   : BitVec.xor x y = x ^^^ y          := rfl
-@[simp] theorem neg_eq (x : BitVec w)                     : BitVec.neg x = -x                 := rfl
-@[simp] theorem add_eq (x y : BitVec w)                   : BitVec.add x y = x + y            := rfl
-@[simp] theorem sub_eq (x y : BitVec w)                   : BitVec.sub x y = x - y            := rfl
-@[simp] theorem mul_eq (x y : BitVec w)                   : BitVec.mul x y = x * y            := rfl
-@[simp] theorem udiv_eq (x y : BitVec w)                  : BitVec.udiv x y = x / y           := rfl
-@[simp] theorem umod_eq (x y : BitVec w)                  : BitVec.umod x y = x % y           := rfl
-@[simp] theorem zero_eq                                   : BitVec.zero n = 0#n               := rfl
+@[simp, grind =] theorem append_eq (x : BitVec w) (y : BitVec v) : BitVec.append x y = x ++ y        := rfl
+@[simp, grind =] theorem shiftLeft_eq (x : BitVec w) (n : Nat)     : BitVec.shiftLeft x n = x <<< n    := rfl
+@[simp, grind =] theorem ushiftRight_eq (x : BitVec w) (n : Nat)   : BitVec.ushiftRight x n = x >>> n  := rfl
+@[simp, grind =] theorem not_eq (x : BitVec w)                     : BitVec.not x = ~~~x               := rfl
+@[simp, grind =] theorem and_eq (x y : BitVec w)                   : BitVec.and x y = x &&& y          := rfl
+@[simp, grind =] theorem or_eq (x y : BitVec w)                    : BitVec.or x y = x ||| y           := rfl
+@[simp, grind =] theorem xor_eq (x y : BitVec w)                   : BitVec.xor x y = x ^^^ y          := rfl
+@[simp, grind =] theorem neg_eq (x : BitVec w)                     : BitVec.neg x = -x                 := rfl
+@[simp, grind =] theorem add_eq (x y : BitVec w)                   : BitVec.add x y = x + y            := rfl
+@[simp, grind =] theorem sub_eq (x y : BitVec w)                   : BitVec.sub x y = x - y            := rfl
+@[simp, grind =] theorem mul_eq (x y : BitVec w)                   : BitVec.mul x y = x * y            := rfl
+@[simp, grind =] theorem udiv_eq (x y : BitVec w)                  : BitVec.udiv x y = x / y           := rfl
+@[simp, grind =] theorem umod_eq (x y : BitVec w)                  : BitVec.umod x y = x % y           := rfl
+@[simp, grind =] theorem zero_eq                                   : BitVec.zero n = 0#n               := rfl
 end normalization_eqs
 
 /-- Converts a list of `Bool`s into a big-endian `BitVec`. -/

src/Init/Data/BitVec/BasicAux.lean

@@ -31,6 +31,8 @@ instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
 /-- Return the bound in terms of toNat. -/
 theorem isLt (x : BitVec w) : x.toNat < 2^w := x.toFin.isLt
 
+grind_pattern isLt => x.toNat, 2^w
+
 end Nat
 
 section arithmetic

src/Init/Data/BitVec/Bitblast.lean

@@ -1930,6 +1930,44 @@ theorem toInt_sub_neg_umod {x y : BitVec w} (hxmsb : x.msb = true) (hymsb : y.ms
         Int.dvd_neg] at hdvd
       simp only [hdvd, ↓reduceIte, Int.natAbs_cast]
 
+theorem srem_zero_of_dvd {x y : BitVec w} (h : y.toInt ∣ x.toInt) :
+    x.srem y = 0#w := by
+  have := toInt_dvd_toInt_iff (x := x) (y := y)
+  by_cases hx : x.msb <;> by_cases hy : y.msb
+  <;> simp only [h, hx, reduceIte, hy, false_eq_true, true_iff] at this
+  <;> simp [srem, hx, hy, this]
+
+/--
+The remainder for `srem`, i.e. division with rounding to zero is negative
+iff `x` is negative and `y` does not divide `x`.
+
+We can eventually build fast circuits for the divisibility test `x.srem y = 0`.
+-/ 
+theorem msb_srem {x y : BitVec w} : (x.srem y).msb =
+    (x.msb && decide (x.srem y ≠ 0)) := by
+  rw [msb_eq_toInt]
+  by_cases hx : x.msb
+  · by_cases hsrem : x.srem y = 0#w
+    · simp [hsrem]
+    · have := toInt_neg_of_msb_true hx
+      by_cases hdvd : y.toInt ∣ x.toInt
+      · simp [BitVec.srem_zero_of_dvd hdvd] at hsrem
+      · simp only [toInt_srem, Int.tmod_eq_emod, show ¬0 ≤ x.toInt by omega, hdvd, _root_.or_self,
+          reduceIte, hx, ofNat_eq_ofNat, ne_eq, hsrem, not_false_eq_true, decide_true, Bool.and_self,
+          decide_eq_true_eq, gt_iff_lt]
+        have hlt := Int.emod_lt (a := x.toInt) (b := y.toInt)
+        by_cases hy0 : y = 0#w
+        · simp only [hy0, toInt_zero, Int.emod_zero, Int.natAbs_zero, Int.cast_ofNat_Int,
+            Int.sub_zero, gt_iff_lt]
+          exact toInt_neg_of_msb_true hx
+        · simp only [← toInt_inj, toInt_zero] at hy0
+          simp only [ne_eq, hy0, not_false_eq_true, forall_const] at hlt
+          have := Int.le_natAbs (a := y.toInt)
+          omega
+  · simp only [toInt_srem, hx, ofNat_eq_ofNat, ne_eq, decide_not, Bool.false_and,
+      decide_eq_false_iff_not, Int.not_lt]
+    apply Int.tmod_nonneg y.toInt (by exact toInt_nonneg_of_msb_false (by simp at hx; exact hx))
+
 theorem toInt_smod {x y : BitVec w} :
     (x.smod y).toInt = x.toInt.fmod y.toInt := by
   rcases w with _|w
@@ -1998,6 +2036,30 @@ theorem getMsbD_smod {x y : BitVec w} :
   by_cases hx : x.msb <;> by_cases hy : y.msb
   <;> simp [hx, hy]
 
+theorem msb_smod {x y : BitVec w} :
+    (x.smod y).msb = (x.msb && y = 0) || (y.msb && (x.smod y) ≠ 0) := by
+  rw [msb_eq_toInt]
+  by_cases hx : x.msb <;> by_cases hy : y.msb
+  · by_cases hsmod : x.smod y = 0#w <;> simp [hx, hy, hsmod]
+  · simp only [hx, ofNat_eq_ofNat, Bool.true_and, decide_eq_decide, decide_iff_dist, hy, ne_eq,
+      decide_not, Bool.false_and, Bool.or_false, beq_iff_eq]
+    constructor
+    · intro h
+      apply Classical.byContradiction
+      intro hcontra
+      rw [toInt_smod] at h
+      have := toInt_nonneg_of_msb_false (by simp at hy; exact hy)
+      have := Int.fmod_nonneg_of_pos (a := x.toInt) (b := y.toInt) (by simp [← toInt_inj] at hcontra; omega)
+      omega
+    · intro h
+      simp only [h, smod_zero]
+      exact toInt_neg_of_msb_true hx
+  · by_cases hsmod : x.smod y = 0#w <;> simp [hx, hy, hsmod]
+  · simp only [toInt_smod, hx, ofNat_eq_ofNat, Bool.false_and, decide_eq_false_iff_not, Int.not_lt,
+      hy, ne_eq, decide_not, Bool.or_false, decide_eq_true_eq]
+    simp only [not_eq_true] at hx hy
+    apply Int.fmod_nonneg (by exact toInt_nonneg_of_msb_false hx) (by exact toInt_nonneg_of_msb_false hy)
+
 /-! ### Lemmas that use bit blasting circuits -/
 
 theorem add_sub_comm {x y : BitVec w} : x + y - z = x - z + y := by

src/Init/Data/BitVec/Bootstrap.lean

@@ -12,10 +12,10 @@ namespace BitVec
 
 theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsbD i := rfl
 
-@[simp] theorem getLsbD_ofFin (x : Fin (2^n)) (i : Nat) :
+@[simp, grind =] theorem getLsbD_ofFin (x : Fin (2^n)) (i : Nat) :
     getLsbD (BitVec.ofFin x) i = x.val.testBit i := rfl
 
-@[simp] theorem getLsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getLsbD x i = false := by
+@[simp, grind] theorem getLsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getLsbD x i = false := by
   let ⟨x, x_lt⟩ := x
   simp only [getLsbD_ofFin]
   apply Nat.testBit_lt_two_pow
@@ -37,31 +37,35 @@ theorem eq_of_getLsbD_eq {x y : BitVec w}
     have p : i ≥ w := Nat.le_of_not_gt i_lt
     simp [testBit_toNat, getLsbD_of_ge _ _ p]
 
-@[simp, bitvec_to_nat] theorem toNat_ofNat (x w : Nat) : (BitVec.ofNat w x).toNat = x % 2^w := by
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_ofNat (x w : Nat) : (BitVec.ofNat w x).toNat = x % 2^w := by
   simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat]
 
-@[ext] theorem eq_of_getElem_eq {x y : BitVec n} :
+@[ext, grind ext] theorem eq_of_getElem_eq {x y : BitVec n} :
         (∀ i (hi : i < n), x[i] = y[i]) → x = y :=
   fun h => BitVec.eq_of_getLsbD_eq (h ↑·)
 
-@[simp] theorem toNat_append (x : BitVec m) (y : BitVec n) :
+@[simp, grind =] theorem toNat_append (x : BitVec m) (y : BitVec n) :
     (x ++ y).toNat = x.toNat <<< n ||| y.toNat :=
   rfl
 
-@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
+@[simp, grind =] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
   cases b <;> rfl
 
-@[simp, bitvec_to_nat] theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
 
-@[simp, bitvec_to_nat] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
 
-@[simp] theorem toNat_ofNatLT (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
+@[simp, grind =] theorem toNat_ofNatLT (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
 
-@[simp] theorem toNat_cons (b : Bool) (x : BitVec w) :
+@[simp, grind =] theorem toNat_cons (b : Bool) (x : BitVec w) :
     (cons b x).toNat = (b.toNat <<< w) ||| x.toNat := by
   let ⟨x, _⟩ := x
   simp only [cons, toNat_cast, toNat_append, toNat_ofBool, toNat_ofFin]
 
+@[grind =]
 theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
     (cons b x)[i] = if h : i = n then b else x[i] := by
   simp only [getElem_eq_testBit_toNat, toNat_cons, Nat.testBit_or]
@@ -80,12 +84,14 @@ theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
 private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m ≤ n) : x < 2 ^ n :=
   Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_right (by trivial : 0 < 2) le)
 
-@[simp, bitvec_to_nat] theorem toNat_setWidth' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_setWidth' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
     (setWidth' p x).toNat = x.toNat := by
   simp only [setWidth', toNat_ofNatLT]
 
-@[simp, bitvec_to_nat] theorem toNat_setWidth (i : Nat) (x : BitVec n) :
-    BitVec.toNat (setWidth i x) = x.toNat % 2^i := by
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_setWidth (i : Nat) (x : BitVec n) :
+    (setWidth i x).toNat = x.toNat % 2^i := by
   let ⟨x, lt_n⟩ := x
   simp only [setWidth]
   if n_le_i : n ≤ i then
@@ -94,15 +100,17 @@ private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m ≤ n) :
   else
     simp [n_le_i, toNat_ofNat]
 
-@[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : BitVec.ofNat m x.toNat = setWidth m x := by
+@[simp, grind =]
+theorem ofNat_toNat (m : Nat) (x : BitVec n) : BitVec.ofNat m x.toNat = setWidth m x := by
   apply eq_of_toNat_eq
   simp only [toNat_ofNat, toNat_setWidth]
 
+@[grind =]
 theorem getElem_setWidth' (x : BitVec w) (i : Nat) (h : w ≤ v) (hi : i < v) :
     (setWidth' h x)[i] = x.getLsbD i := by
   rw [getElem_eq_testBit_toNat, toNat_setWidth', getLsbD]
 
-@[simp]
+@[simp, grind =]
 theorem getElem_setWidth (m : Nat) (x : BitVec n) (i : Nat) (h : i < m) :
     (setWidth m x)[i] = x.getLsbD i := by
   rw [setWidth]
@@ -112,6 +120,7 @@ theorem getElem_setWidth (m : Nat) (x : BitVec n) (i : Nat) (h : i < m) :
       getLsbD, Bool.and_eq_right_iff_imp, decide_eq_true_eq]
     omega
 
+-- Later this is provable by `grind`, so doesn't need an annotation.
 @[simp] theorem cons_msb_setWidth (x : BitVec (w+1)) : (cons x.msb (x.setWidth w)) = x := by
   ext i
   simp only [getElem_cons]
@@ -121,10 +130,12 @@ theorem getElem_setWidth (m : Nat) (x : BitVec n) (i : Nat) (h : i < m) :
     · simp_all only [getElem_setWidth, getLsbD_eq_getElem]
     · omega
 
-@[simp, bitvec_to_nat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
+@[simp, bitvec_to_nat, grind =]
+theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
   simp [Neg.neg, BitVec.neg]
 
-@[simp] theorem setWidth_neg_of_le {x : BitVec v} (h : w ≤ v) : BitVec.setWidth w (-x) = -BitVec.setWidth w x := by
+@[simp, grind =]
+theorem setWidth_neg_of_le {x : BitVec v} (h : w ≤ v) : BitVec.setWidth w (-x) = -BitVec.setWidth w x := by
   apply BitVec.eq_of_toNat_eq
   simp only [toNat_setWidth, toNat_neg]
   rw [Nat.mod_mod_of_dvd _ (Nat.pow_dvd_pow 2 h)]

src/Init/Data/Fin/Lemmas.lean

@@ -63,7 +63,7 @@ theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
     0 = (⟨a, ha⟩ : Fin n) ↔ a = 0 := by
   simp [eq_comm]
 
-@[simp] theorem val_ofNat (n : Nat) [NeZero n] (a : Nat) :
+@[simp, grind =] theorem val_ofNat (n : Nat) [NeZero n] (a : Nat) :
   (Fin.ofNat n a).val = a % n := rfl
 
 @[deprecated val_ofNat (since := "2025-05-28")] abbrev val_ofNat' := @val_ofNat
@@ -249,7 +249,7 @@ protected theorem le_antisymm_iff {x y : Fin n} : x = y ↔ x ≤ y ∧ y ≤ x
 protected theorem le_antisymm {x y : Fin n} (h1 : x ≤ y) (h2 : y ≤ x) : x = y :=
   Fin.le_antisymm_iff.2 ⟨h1, h2⟩
 
-@[simp] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl
+@[simp, grind =] theorem val_rev (i : Fin n) : rev i = n - (i + 1) := rfl
 
 @[simp] theorem rev_rev (i : Fin n) : rev (rev i) = i := Fin.ext <| by
   rw [val_rev, val_rev, ← Nat.sub_sub, Nat.sub_sub_self (by exact i.2), Nat.add_sub_cancel]
@@ -445,7 +445,7 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
 @[simp] theorem castLT_mk (i n m : Nat) (hn : i < n) (hm : i < m) : castLT ⟨i, hn⟩ hm = ⟨i, hm⟩ :=
   rfl
 
-@[simp] theorem coe_castLE (h : n ≤ m) (i : Fin n) : (castLE h i : Nat) = i := rfl
+@[simp, grind =] theorem coe_castLE (h : n ≤ m) (i : Fin n) : (castLE h i : Nat) = i := rfl
 
 @[simp] theorem castLE_mk (i n m : Nat) (hn : i < n) (h : n ≤ m) :
     castLE h ⟨i, hn⟩ = ⟨i, Nat.lt_of_lt_of_le hn h⟩ := rfl

src/Init/Data/Format/Basic.lean

@@ -12,8 +12,9 @@ import Init.Data.String.Basic
 
 namespace Std
 
-/-- Determines how groups should have linebreaks inserted when the
-text would overfill its remaining space.
+/--
+Determines how groups should have linebreaks inserted when the text would overfill its remaining
+space.
 
 - `allOrNone` will make a linebreak on every `Format.line` in the group or none of them.
   ```
@@ -28,60 +29,83 @@ text would overfill its remaining space.
   ```
 -/
 inductive Format.FlattenBehavior where
+  /--
+  Either all `Format.line`s in the group will be newlines, or all of them will be spaces.
+  -/
   | allOrNone
+  /--
+  As few `Format.line`s in the group as possible will be newlines.
+  -/
   | fill
   deriving Inhabited, BEq
 
 open Format in
-/-- A string with pretty-printing information for rendering in a column-width-aware way.
+/--
+A representation of a set of strings, in which the placement of newlines and indentation differ.
+
+Given a specific line width, specified in columns, the string that uses the fewest lines can be
+selected.
 
 The pretty-printing algorithm is based on Wadler's paper
-[_A Prettier Printer_](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf). -/
+[_A Prettier Printer_](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf).
+-/
 inductive Format where
   /-- The empty format. -/
   | nil                 : Format
-  /-- A position where a newline may be inserted
-  if the current group does not fit within the allotted column width. -/
+  /--
+  A position where a newline may be inserted if the current group does not fit within the allotted
+  column width.
+  -/
   | line                : Format
-  /-- `align` tells the formatter to pad with spaces to the current indent,
-  or else add a newline if we are already at or past the indent. For example:
-  ```
-  nest 2 <| "." ++ align ++ "a" ++ line ++ "b"
-  ```
-  results in:
+  /--
+  `align` tells the formatter to pad with spaces to the current indentation level, or else add a
+  newline if we are already at or past the indent.
+
+  If `force` is true, then it will pad to the indent even if it is in a flattened group.
+
+  Example:
+  ```lean example
+  open Std Format in
+  #eval IO.println (nest 2 <| "." ++ align ++ "a" ++ line ++ "b")
   ```
+  ```lean output
   . a
     b
   ```
-  If `force` is true, then it will pad to the indent even if it is in a flattened group.
   -/
   | align (force : Bool) : Format
-  /-- A node containing a plain string. -/
-  | text                : String → Format
-  /-- `nest n f` tells the formatter that `f` is nested inside something with length `n`
-  so that it is pretty-printed with the correct indentation on a line break.
-  For example, we can define a formatter for list `l : List Format` as:
+  /--
+  A node containing a plain string.
 
-  ```
-  let f := join <| l.intersperse <| ", " ++ Format.line
-  group (nest 1 <| "[" ++ f ++ "]")
-  ```
-
-  This will be written all on one line, but if the text is too large,
-  the formatter will put in linebreaks after the commas and indent later lines by 1.
+  If the string contains newlines, the formatter emits them and then indents to the current level.
   -/
-  | nest (indent : Int) : Format → Format
-  /-- Concatenation of two Formats. -/
-  | append              : Format → Format → Format
-  /-- Creates a new flattening group for the given inner format.  -/
-  | group               : Format → (behavior : FlattenBehavior := FlattenBehavior.allOrNone) → Format
+  | text                : String → Format
+  /--
+  `nest indent f` increases the current indentation level by `indent` while rendering `f`.
+
+  Example:
+  ```lean example
+  open Std Format in
+  def fmtList (l : List Format) : Format :=
+    let f := joinSep l  (", " ++ Format.line)
+    group (nest 1 <| "[" ++ f ++ "]")
+  ```
+
+  This will be written all on one line, but if the text is too large, the formatter will put in
+  linebreaks after the commas and indent later lines by 1.
+  -/
+  | nest (indent : Int) (f : Format) : Format
+  /-- Concatenation of two `Format`s. -/
+  | append : Format → Format → Format
+  /-- Creates a new flattening group for the given inner `Format`.  -/
+  | group : Format → (behavior : FlattenBehavior := FlattenBehavior.allOrNone) → Format
   /-- Used for associating auxiliary information (e.g. `Expr`s) with `Format` objects. -/
-  | tag                 : Nat → Format → Format
+  | tag : Nat → Format → Format
   deriving Inhabited
 
 namespace Format
 
-/-- Check whether the given format contains no characters. -/
+/-- Checks whether the given format contains no characters. -/
 def isEmpty : Format → Bool
   | nil          => true
   | line         => false
@@ -92,16 +116,29 @@ def isEmpty : Format → Bool
   | group f _    => f.isEmpty
   | tag _ f      => f.isEmpty
 
-/-- Alias for a group with `FlattenBehavior` set to `fill`. -/
+/--
+Creates a group in which as few `Format.line`s as possible are rendered as newlines.
+
+This is an alias for `Format.group`, with `FlattenBehavior` set to `fill`.
+-/
 def fill (f : Format) : Format :=
   group f (behavior := FlattenBehavior.fill)
 
 instance : Append Format     := ⟨Format.append⟩
 instance : Coe String Format := ⟨text⟩
 
+/--
+Concatenates a list of `Format`s with `++`.
+-/
 def join (xs : List Format) : Format :=
   xs.foldl (·++·) ""
 
+/--
+Checks whether a `Format` is the constructor `Format.nil`.
+
+This does not check whether the resulting rendered strings are always empty. To do that, use
+`Format.isEmpty`.
+-/
 def isNil : Format → Bool
   | nil => true
   | _   => false
@@ -174,15 +211,30 @@ private partial def spaceUptoLine' : List WorkGroup → Nat → Nat → SpaceRes
       (spaceUptoLine i.f g.fla.shouldFlatten (w + col - i.indent) w)
       (spaceUptoLine' ({ g with items := is }::gs) col)
 
-/-- A monad in which we can pretty-print `Format` objects. -/
+/--
+A monad that can be used to incrementally render `Format` objects.
+-/
 class MonadPrettyFormat (m : Type → Type) where
-  pushOutput (s : String)    : m Unit
+  /--
+  Emits the string `s`.
+  -/
+  pushOutput (s : String) : m Unit
+  /--
+  Emits a newline followed by `indent` columns of indentation.
+  -/
   pushNewline (indent : Nat) : m Unit
-  currColumn                 : m Nat
-  /-- Start a scope tagged with `n`. -/
-  startTag                   : Nat → m Unit
-  /-- Exit the scope of `n`-many opened tags. -/
-  endTags                    : Nat → m Unit
+  /--
+  Gets the current column at which the next string will be emitted.
+  -/
+  currColumn : m Nat
+  /--
+  Starts a region tagged with `tag`.
+  -/
+  startTag (tag : Nat) : m Unit
+  /--
+  Exits the scope of `count` opened tags.
+  -/
+  endTags (count : Nat) : m Unit
 open MonadPrettyFormat
 
 private def pushGroup (flb : FlattenBehavior) (items : List WorkItem) (gs : List WorkGroup) (w : Nat) [Monad m] [MonadPrettyFormat m] : m (List WorkGroup) := do
@@ -276,35 +328,59 @@ private partial def be (w : Nat) [Monad m] [MonadPrettyFormat m] : List WorkGrou
       else
         pushGroup flb [{ i with f }] (gs' is) w >>= be w
 
-/-- Render the given `f : Format` with a line width of `w`.
+/- Render the given `f : Format` with a line width of `w`.
 `indent` is the starting amount to indent each line by. -/
+/--
+Renders a `Format` using effects in the monad `m`, using the methods of `MonadPrettyFormat`.
+
+Each line is emitted as soon as it is rendered, rather than waiting for the entire document to be
+rendered.
+* `w`: the total width
+* `indent`: the initial indentation to use for wrapped lines (subsequent wrapping may increase the
+  indentation)
+-/
 def prettyM (f : Format) (w : Nat) (indent : Nat := 0) [Monad m] [MonadPrettyFormat m] : m Unit :=
   be w [{ flb := FlattenBehavior.allOrNone, fla := .disallow, items := [{ f := f, indent, activeTags := 0 }]}]
 
-/-- Create a format `l ++ f ++ r` with a flatten group.
-FlattenBehaviour is `allOrNone`; for `fill` use `bracketFill`. -/
+/--
+Creates a format `l ++ f ++ r` with a flattening group, nesting the contents by the length of `l`.
+
+The group's `FlattenBehavior` is `allOrNone`; for `fill` use `Std.Format.bracketFill`.
+-/
 @[inline] def bracket (l : String) (f : Format) (r : String) : Format :=
   group (nest l.length $ l ++ f ++ r)
 
-/-- Creates the format `"(" ++ f ++ ")"` with a flattening group.-/
+/--
+Creates the format `"(" ++ f ++ ")"` with a flattening group, nesting by one space.
+-/
 @[inline] def paren (f : Format) : Format :=
   bracket "(" f ")"
 
-/-- Creates the format `"[" ++ f ++ "]"` with a flattening group.-/
+/--
+Creates the format `"[" ++ f ++ "]"` with a flattening group, nesting by one space.
+
+`sbracket` is short for “square bracket”.
+-/
 @[inline] def sbracket (f : Format) : Format :=
   bracket "[" f "]"
 
-/-- Same as `bracket` except uses the `fill` flattening behaviour. -/
+/--
+Creates a format `l ++ f ++ r` with a flattening group, nesting the contents by the length of `l`.
+
+The group's `FlattenBehavior` is `fill`; for `allOrNone` use `Std.Format.bracketFill`.
+-/
 @[inline] def bracketFill (l : String) (f : Format) (r : String) : Format :=
   fill (nest l.length $ l ++ f ++ r)
 
-/-- Default indentation. -/
+/-- The default indentation level, which is two spaces. -/
 def defIndent  := 2
 def defUnicode := true
-/-- Default width of the targeted output pane. -/
+/-- The default width of the targeted output, which is 120 columns. -/
 def defWidth   := 120
 
-/-- Nest with the default indentation amount.-/
+/--
+Increases the indentation level by the default amount.
+-/
 def nestD (f : Format) : Format :=
   nest defIndent f
 
@@ -340,8 +416,12 @@ def pretty (f : Format) (width : Nat := defWidth) (indent : Nat := 0) (column :=
 
 end Format
 
-/-- Class for converting a given type α to a `Format` object for pretty-printing.
-See also `Repr`, which also outputs a `Format` object. -/
+/--
+Specifies a “user-facing” way to convert from the type `α` to a `Format` object. There is no
+expectation that the resulting string is valid code.
+
+The `Repr` class is similar, but the expectation is that instances produce valid Lean code.
+-/
 class ToFormat (α : Type u) where
   format : α → Format
 
@@ -354,18 +434,31 @@ instance : ToFormat Format where
 instance : ToFormat String where
   format s := Format.text s
 
-/-- Intersperse the given list (each item printed with `format`) with the given `sep` format. -/
+/--
+Intercalates the given list with the given `sep` format.
+
+The list items are formatting using `ToFormat.format`.
+-/
 def Format.joinSep {α : Type u} [ToFormat α] : List α → Format → Format
   | [],    _   => nil
   | [a],   _   => format a
   | a::as, sep => as.foldl (· ++ sep ++ format ·) (format a)
 
-/-- Format each item in `items` and prepend prefix `pre`. -/
+/--
+Concatenates the given list after prepending `pre` to each element.
+
+The list items are formatting using `ToFormat.format`.
+-/
 def Format.prefixJoin {α : Type u} [ToFormat α] (pre : Format) : List α → Format
   | []    => nil
   | a::as => as.foldl (· ++ pre ++ format ·) (pre ++ format a)
 
-/-- Format each item in `items` and append `suffix`. -/
+/--
+Concatenates the given list after appending the given suffix to each element.
+
+The list items are formatting using `ToFormat.format`.
+-/
+
 def Format.joinSuffix {α : Type u} [ToFormat α] : List α → Format → Format
   | [],    _      => nil
   | a::as, suffix => as.foldl (· ++ format · ++ suffix) (format a ++ suffix)

src/Init/Data/Iterators.lean

@@ -9,7 +9,9 @@ prelude
 import Init.Data.Iterators.Basic
 import Init.Data.Iterators.PostconditionMonad
 import Init.Data.Iterators.Consumers
+import Init.Data.Iterators.Combinators
 import Init.Data.Iterators.Lemmas
+import Init.Data.Iterators.ToIterator
 import Init.Data.Iterators.Internal
 
 /-!

src/Init/Data/Iterators/Basic.lean

@@ -354,7 +354,7 @@ Makes a single step with the given iterator `it`, potentially emitting a value a
 succeeding iterator. If this function is used recursively, termination can sometimes be proved with
 the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def IterM.step {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     (it : IterM (α := α) m β) : m it.Step :=
   Iterator.step it
@@ -383,6 +383,38 @@ inductive IterM.IsPlausibleIndirectOutput {α β : Type w} {m : Type w → Type
   | indirect {it it' : IterM (α := α) m β} {out : β} : it'.IsPlausibleSuccessorOf it →
       it'.IsPlausibleIndirectOutput out → it.IsPlausibleIndirectOutput out
 
+/--
+Asserts that an iterator `it'` could plausibly produce `it'` as a successor iterator after
+finitely many steps. This relation is reflexive.
+-/
+inductive IterM.IsPlausibleIndirectSuccessorOf {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β] : IterM (α := α) m β → IterM (α := α) m β → Prop where
+  | refl (it : IterM (α := α) m β) : it.IsPlausibleIndirectSuccessorOf it
+  | cons_right {it'' it' it : IterM (α := α) m β} (h' : it''.IsPlausibleIndirectSuccessorOf it')
+      (h : it'.IsPlausibleSuccessorOf it) : it''.IsPlausibleIndirectSuccessorOf it
+
+theorem IterM.IsPlausibleIndirectSuccessorOf.trans {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β] {it'' it' it : IterM (α := α) m β}
+    (h' : it''.IsPlausibleIndirectSuccessorOf it') (h : it'.IsPlausibleIndirectSuccessorOf it) :
+    it''.IsPlausibleIndirectSuccessorOf it := by
+  induction h
+  case refl => exact h'
+  case cons_right ih => exact IsPlausibleIndirectSuccessorOf.cons_right ih ‹_›
+
+theorem IterM.IsPlausibleIndirectSuccessorOf.single {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β] {it' it : IterM (α := α) m β}
+    (h : it'.IsPlausibleSuccessorOf it) :
+    it'.IsPlausibleIndirectSuccessorOf it :=
+  .cons_right (.refl _) h
+
+theorem IterM.IsPlausibleIndirectOutput.trans {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β]
+    {it' it : IterM (α := α) m β} {out : β} (h : it'.IsPlausibleIndirectSuccessorOf it)
+    (h' : it'.IsPlausibleIndirectOutput out) : it.IsPlausibleIndirectOutput out := by
+  induction h
+  case refl => exact h'
+  case cons_right ih => exact IsPlausibleIndirectOutput.indirect ‹_› ih
+
 /--
 The type of the step object returned by `Iter.step`, containing an `IterStep`
 and a proof that this is a plausible step for the given iterator.
@@ -431,6 +463,16 @@ def Iter.IsPlausibleOutput {α : Type w} {β : Type w} [Iterator α Id β]
     (it : Iter (α := α) β) (out : β) : Prop :=
   it.toIterM.IsPlausibleOutput out
 
+theorem Iter.isPlausibleOutput_iff_exists {α : Type w} {β : Type w} [Iterator α Id β]
+    {it : Iter (α := α) β} {out : β} :
+    it.IsPlausibleOutput out ↔ ∃ it', it.IsPlausibleStep (.yield it' out) := by
+  simp only [IsPlausibleOutput, IterM.IsPlausibleOutput]
+  constructor
+  · rintro ⟨it', h⟩
+    exact ⟨it'.toIter, h⟩
+  · rintro ⟨it', h⟩
+    exact ⟨it'.toIterM, h⟩
+
 /--
 Asserts that a certain iterator `it'` could plausibly be the directly succeeding iterator of another
 given iterator `it`.
@@ -440,6 +482,18 @@ def Iter.IsPlausibleSuccessorOf {α : Type w} {β : Type w} [Iterator α Id β]
     (it' it : Iter (α := α) β) : Prop :=
   it'.toIterM.IsPlausibleSuccessorOf it.toIterM
 
+theorem Iter.isPlausibleSuccessorOf_iff_exists {α : Type w} {β : Type w} [Iterator α Id β]
+    {it' it : Iter (α := α) β} :
+    it'.IsPlausibleSuccessorOf it ↔ ∃ step, step.successor = some it' ∧ it.IsPlausibleStep step := by
+  simp only [IsPlausibleSuccessorOf, IterM.IsPlausibleSuccessorOf]
+  constructor
+  · rintro ⟨step, h₁, h₂⟩
+    exact ⟨step.mapIterator IterM.toIter,
+      by cases step <;> simp_all [IterStep.successor, Iter.IsPlausibleStep]⟩
+  · rintro ⟨step, h₁, h₂⟩
+    exact ⟨step.mapIterator Iter.toIterM,
+      by cases step <;> simp_all [IterStep.successor, Iter.IsPlausibleStep]⟩
+
 /--
 Asserts that a certain iterator `it` could plausibly yield the value `out` after an arbitrary
 number of steps.
@@ -472,6 +526,45 @@ theorem Iter.isPlausibleIndirectOutput_iff_isPlausibleIndirectOutput_toIterM {α
       replace h : it'.toIter.IsPlausibleSuccessorOf it.toIter := h
       exact .indirect (α := α) h ih
 
+/--
+Asserts that an iterator `it'` could plausibly produce `it'` as a successor iterator after
+finitely many steps. This relation is reflexive.
+-/
+inductive Iter.IsPlausibleIndirectSuccessorOf {α : Type w} {β : Type w} [Iterator α Id β] :
+    Iter (α := α) β → Iter (α := α) β → Prop where
+  | refl (it : Iter (α := α) β) : IsPlausibleIndirectSuccessorOf it it
+  | cons_right {it'' it' it : Iter (α := α) β} (h' : it''.IsPlausibleIndirectSuccessorOf it')
+      (h : it'.IsPlausibleSuccessorOf it) : it''.IsPlausibleIndirectSuccessorOf it
+
+theorem Iter.isPlausibleIndirectSuccessor_iff_isPlausibleIndirectSuccessor_toIterM {α β : Type w}
+    [Iterator α Id β] {it' it : Iter (α := α) β} :
+    it'.IsPlausibleIndirectSuccessorOf it ↔ it'.toIterM.IsPlausibleIndirectSuccessorOf it.toIterM := by
+  constructor
+  · intro h
+    induction h with
+    | refl => exact .refl _
+    | cons_right _ h ih => exact .cons_right ih h
+  · intro h
+    rw [← Iter.toIter_toIterM (it := it), ← Iter.toIter_toIterM (it := it')]
+    generalize it.toIterM = it at ⊢ h
+    induction h with
+    | refl => exact .refl _
+    | cons_right _ h ih => exact .cons_right ih h
+
+theorem Iter.IsPlausibleIndirectSuccessorOf.trans {α : Type w} {β : Type w} [Iterator α Id β]
+    {it'' it' it : Iter (α := α) β} (h' : it''.IsPlausibleIndirectSuccessorOf it')
+    (h : it'.IsPlausibleIndirectSuccessorOf it) : it''.IsPlausibleIndirectSuccessorOf it := by
+  induction h
+  case refl => exact h'
+  case cons_right ih => exact IsPlausibleIndirectSuccessorOf.cons_right ih ‹_›
+
+theorem Iter.IsPlausibleIndirectOutput.trans {α : Type w} {β : Type w} [Iterator α Id β]
+    {it' it : Iter (α := α) β} {out : β} (h : it'.IsPlausibleIndirectSuccessorOf it)
+    (h' : it'.IsPlausibleIndirectOutput out) : it.IsPlausibleIndirectOutput out := by
+  induction h
+  case refl => exact h'
+  case cons_right ih => exact IsPlausibleIndirectOutput.indirect ‹_› ih
+
 /--
 Asserts that a certain iterator `it'` could plausibly be the directly succeeding iterator of another
 given iterator `it` while no value is emitted (see `IterStep.skip`).
@@ -687,6 +780,21 @@ instance [Iterator α m β] [Finite α m] : Productive α m where
 
 end Productive
 
+/--
+This typeclass characterizes iterators that have deterministic return values. This typeclass does
+*not* guarantee that there are no monadic side effects such as exceptions.
+
+General monadic iterators can be nondeterministic, so that `it.IsPlausibleStep step` will be true
+for no or more than one choice of `step`. This typeclass ensures that there is exactly one such
+choice.
+
+This is an experimental instance and it should not be explicitly used downstream of the standard
+library.
+-/
+class LawfulDeterministicIterator (α : Type w) (m : Type w → Type w') [Iterator α m β]
+    where
+  isPlausibleStep_eq_eq : ∀ it : IterM (α := α) m β, ∃ step, it.IsPlausibleStep = (· = step)
+
 end Iterators
 
 export Iterators (Iter IterM)

src/Init/Data/Iterators/Combinators.lean

@@ -0,0 +1,10 @@
+/-
+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.Combinators.Monadic
+import Init.Data.Iterators.Combinators.FilterMap

src/Init/Data/Iterators/Combinators/Attach.lean

@@ -0,0 +1,25 @@
+/-
+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.Combinators.Monadic.Attach
+import Init.Data.Iterators.Combinators.FilterMap
+
+namespace Std.Iterators
+
+@[always_inline, inline, inherit_doc IterM.attachWith]
+def Iter.attachWith {α β : Type w}
+    [Iterator α Id β]
+    (it : Iter (α := α) β) (P : β → Prop) (h : ∀ out, it.IsPlausibleIndirectOutput out → P out) :
+  Iter (α := Types.Attach α Id P) { out : β // P out } :=
+  (it.toIterM.attachWith P ?h).toIter
+where finally
+  case h =>
+    simp only [← isPlausibleIndirectOutput_iff_isPlausibleIndirectOutput_toIterM]
+    exact h
+
+end Std.Iterators

src/Init/Data/Iterators/Combinators/FilterMap.lean

@@ -3,8 +3,10 @@ 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 Std.Data.Iterators.Combinators.Monadic.FilterMap
+import Init.Data.Iterators.Combinators.Monadic.FilterMap
 
 /-!
 
@@ -75,7 +77,7 @@ postcondition is `fun x => x.isSome`; if `f` always fails, a suitable postcondit
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned `Option` value.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.filterMapWithPostcondition {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → PostconditionT m (Option γ)) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapWithPostcondition f : IterM m γ)
@@ -120,7 +122,7 @@ be `fun _ => False`.
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.filterWithPostcondition {α β : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → PostconditionT m (ULift Bool)) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterWithPostcondition f : IterM m β)
@@ -164,7 +166,7 @@ be `fun _ => False`.
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.mapWithPostcondition {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → PostconditionT m γ) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapWithPostcondition f : IterM m γ)
@@ -205,7 +207,7 @@ possible to manually prove `Finite` and `Productive` instances depending on the
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned `Option` value.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.filterMapM {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → m (Option γ)) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterMapM f : IterM m γ)
@@ -242,7 +244,7 @@ manually prove `Finite` and `Productive` instances depending on the concrete cho
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.filterM {α β : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → m (ULift Bool)) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.filterM f : IterM m β)
@@ -281,22 +283,22 @@ manually prove `Finite` and `Productive` instances depending on the concrete cho
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.mapM {α β γ : Type w} [Iterator α Id β] {m : Type w → Type w'}
     [Monad m] (f : β → m γ) (it : Iter (α := α) β) :=
   (letI : MonadLift Id m := ⟨pure⟩; it.toIterM.mapM f : IterM m γ)
 
-@[always_inline, inline, inherit_doc IterM.filterMap]
+@[always_inline, inline, inherit_doc IterM.filterMap, expose]
 def Iter.filterMap {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β]
     (f : β → Option γ) (it : Iter (α := α) β) :=
   ((it.toIterM.filterMap f).toIter : Iter γ)
 
-@[always_inline, inline, inherit_doc IterM.filter]
+@[always_inline, inline, inherit_doc IterM.filter, expose]
 def Iter.filter {α : Type w} {β : Type w} [Iterator α Id β]
     (f : β → Bool) (it : Iter (α := α) β) :=
   ((it.toIterM.filter f).toIter : Iter β)
 
-@[always_inline, inline, inherit_doc IterM.map]
+@[always_inline, inline, inherit_doc IterM.map, expose]
 def Iter.map {α : Type w} {β : Type w} {γ : Type w} [Iterator α Id β]
     (f : β → γ) (it : Iter (α := α) β) :=
   ((it.toIterM.map f).toIter : Iter γ)

src/Init/Data/Iterators/Combinators/Monadic.lean

@@ -0,0 +1,9 @@
+/-
+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.Combinators.Monadic.FilterMap

src/Init/Data/Iterators/Combinators/Monadic/Attach.lean

@@ -0,0 +1,136 @@
+/-
+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.Basic
+import Init.Data.Iterators.Internal.Termination
+import Init.Data.Iterators.Consumers.Collect
+import Init.Data.Iterators.Consumers.Loop
+
+namespace Std.Iterators.Types
+
+/--
+Internal state of the `attachWith` combinator. Do not depend on its internals.
+-/
+@[unbox]
+structure Attach (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β]
+    (P : β → Prop) where
+  inner : IterM (α := α) m β
+  invariant : ∀ out, inner.IsPlausibleIndirectOutput out → P out
+
+@[always_inline, inline]
+def Attach.modifyStep {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
+    {P : β → Prop}
+    (it : IterM (α := Attach α m P) m { out : β // P out })
+    (step : it.internalState.inner.Step (α := α) (m := m)) :
+    IterStep (IterM (α := Attach α m P) m { out : β // P out })
+        { out : β // P out } :=
+  match step with
+  | .yield it' out h =>
+    .yield ⟨it', fun out ho => it.internalState.invariant out (.indirect ⟨_, rfl, h⟩ ho)⟩
+      ⟨out, it.internalState.invariant out (.direct ⟨_, h⟩)⟩
+  | .skip it' h =>
+    .skip ⟨it', fun out ho => it.internalState.invariant out (.indirect ⟨_, rfl, h⟩ ho)⟩
+  | .done _ => .done
+
+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', modifyStep it step' = step
+  step it := (fun step => ⟨modifyStep it step, step, rfl⟩) <$> it.internalState.inner.step
+
+def Attach.instFinitenessRelation {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] [Finite α m] {P : β → Prop} :
+    FinitenessRelation (Attach α m P) m where
+  rel := InvImage WellFoundedRelation.rel fun it => it.internalState.inner.finitelyManySteps
+  wf := InvImage.wf _ WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    apply Relation.TransGen.single
+    obtain ⟨_, hs, step, h', rfl⟩ := h
+    cases step using PlausibleIterStep.casesOn
+    · simp only [IterStep.successor, modifyStep, Option.some.injEq] at hs
+      simp only [← hs]
+      exact ⟨_, rfl, ‹_›⟩
+    · simp only [IterStep.successor, modifyStep, Option.some.injEq] at hs
+      simp only [← hs]
+      exact ⟨_, rfl, ‹_›⟩
+    · simp [IterStep.successor, modifyStep, reduceCtorEq] at hs
+
+instance Attach.instFinite {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] [Finite α m] {P : β → Prop} : Finite (Attach α m P) m :=
+  .of_finitenessRelation instFinitenessRelation
+
+def Attach.instProductivenessRelation {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] [Productive α m] {P : β → Prop} :
+    ProductivenessRelation (Attach α m P) m where
+  rel := InvImage WellFoundedRelation.rel fun it => it.internalState.inner.finitelyManySkips
+  wf := InvImage.wf _ WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    apply Relation.TransGen.single
+    simp_wf
+    obtain ⟨step, hs⟩ := h
+    cases step using PlausibleIterStep.casesOn
+    · simp [modifyStep] at hs
+    · simp only [modifyStep, IterStep.skip.injEq] at hs
+      simp only [← hs]
+      assumption
+    · simp [modifyStep] at hs
+
+instance Attach.instProductive {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] [Productive α m] {P : β → Prop} :
+    Productive (Attach α m P) m :=
+  .of_productivenessRelation instProductivenessRelation
+
+instance Attach.instIteratorCollect {α β : Type w} {m : Type w → Type w'} [Monad m] [Monad n]
+    {P : β → Prop} [Iterator α m β] :
+    IteratorCollect (Attach α m P) m n :=
+  .defaultImplementation
+
+instance Attach.instIteratorCollectPartial {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Monad n] {P : β → Prop} [Iterator α m β] :
+    IteratorCollectPartial (Attach α m P) m n :=
+  .defaultImplementation
+
+instance Attach.instIteratorLoop {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Monad n] {P : β → Prop} [Iterator α m β] [MonadLiftT m n] :
+    IteratorLoop (Attach α m P) m n :=
+  .defaultImplementation
+
+instance Attach.instIteratorLoopPartial {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Monad n] {P : β → Prop} [Iterator α m β] [MonadLiftT m n] :
+    IteratorLoopPartial (Attach α m P) m n :=
+  .defaultImplementation
+
+instance {α β : Type w} {m : Type w → Type w'} [Monad m]
+    {P : β → Prop} [Iterator α m β] [IteratorSize α m] :
+    IteratorSize (Attach α m P) m where
+  size it := IteratorSize.size it.internalState.inner
+
+instance {α β : Type w} {m : Type w → Type w'} [Monad m]
+    {P : β → Prop} [Iterator α m β] [IteratorSizePartial α m] :
+    IteratorSizePartial (Attach α m P) m where
+  size it := IteratorSizePartial.size it.internalState.inner
+
+end Types
+
+/--
+“Attaches” individual proofs to an iterator of values that satisfy a predicate `P`, returning an
+iterator with values in the corresponding subtype `{ x // P x }`.
+
+**Termination properties:**
+
+* `Finite` instance: only if the base iterator is finite
+* `Productive` instance: only if the base iterator is productive
+-/
+@[always_inline, inline]
+def IterM.attachWith {α β : Type w} {m : Type w → Type w'} [Monad m]
+    [Iterator α m β] (it : IterM (α := α) m β) (P : β → Prop)
+    (h : ∀ out, it.IsPlausibleIndirectOutput out → P out) :
+    IterM (α := Types.Attach α m P) m { out : β // P out } :=
+  ⟨⟨it, h⟩⟩
+
+end Std.Iterators

src/Init/Data/Iterators/Combinators/Monadic/FilterMap.lean

@@ -3,6 +3,8 @@ 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.Basic
 import Init.Data.Iterators.Consumers.Collect
@@ -45,19 +47,20 @@ structure FilterMap (α : Type w) {β γ : Type w}
 /--
 Internal state of the `map` combinator. Do not depend on its internals.
 -/
+@[expose]
 def Map (α : Type w) {β γ : Type w} (m : Type w → Type w') (n : Type w → Type w'')
     (lift : ⦃α : Type w⦄ → m α → n α) [Functor n]
     (f : β → PostconditionT n γ) :=
   FilterMap α m n lift (fun b => PostconditionT.map some (f b))
 
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def IterM.InternalCombinators.filterMap {α β γ : Type w} {m : Type w → Type w'}
     {n : Type w → Type w''} (lift : ⦃α : Type w⦄ → m α → n α)
     [Iterator α m β] (f : β → PostconditionT n (Option γ))
     (it : IterM (α := α) m β) : IterM (α := FilterMap α m n lift f) n γ :=
   toIterM ⟨it⟩ n γ
 
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def IterM.InternalCombinators.map {α β γ : Type w} {m : Type w → Type w'}
     {n : Type w → Type w''} [Monad n] (lift : ⦃α : Type w⦄ → m α → n α)
     [Iterator α m β] (f : β → PostconditionT n γ)
@@ -110,7 +113,7 @@ postcondition is `fun x => x.isSome`; if `f` always fails, a suitable postcondit
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned `Option` value.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filterMapWithPostcondition {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
     [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n (Option γ))
     (it : IterM (α := α) m β) : IterM (α := FilterMap α m n (fun ⦃_⦄ => monadLift) f) n γ :=
@@ -147,9 +150,9 @@ instance FilterMap.instIterator {α β γ : Type w} {m : Type w → Type w'} {n
       match ← it.internalState.inner.step with
       | .yield it' out h => do
         match ← (f out).operation with
-        | ⟨none, h'⟩ => pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone h h')
-        | ⟨some out', h'⟩ => pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome h h')
-      | .skip it' h => pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
+        | ⟨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)
 
 instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Monad n] [Iterator α m β]
@@ -179,11 +182,13 @@ private def FilterMap.instFinitenessRelation {α β γ : Type w} {m : Type w →
     case done h' =>
       cases h
 
+@[no_expose]
 instance FilterMap.instFinite {α β γ : Type w} {m : Type w → Type w'}
     {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
     {f : β → PostconditionT n (Option γ)} [Finite α m] : Finite (FilterMap α m n lift f) n :=
   Finite.of_finitenessRelation FilterMap.instFinitenessRelation
 
+@[no_expose]
 instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Monad n] [Iterator α m β]
     {lift : ⦃α : Type w⦄ → m α → n α} {f : β → PostconditionT n γ} [Finite α m] :
     Finite (Map α m n lift f) n :=
@@ -202,6 +207,7 @@ private def Map.instProductivenessRelation {α β γ : Type w} {m : Type w → T
     case skip it' h =>
       exact h
 
+@[no_expose]
 instance Map.instProductive {α β γ : Type w} {m : Type w → Type w'}
     {n : Type w → Type w''} [Monad n] [Iterator α m β] {lift : ⦃α : Type w⦄ → m α → n α}
     {f : β → PostconditionT n γ} [Productive α m] :
@@ -253,6 +259,7 @@ instance Map.instIteratorCollect {α β γ : Type w} {m : Type w → Type w'}
       (fun x => do g (← (f x).operation))
       it.internalState.inner (m := m)
 
+@[no_expose]
 instance Map.instIteratorCollectPartial {α β γ : Type w} {m : Type w → Type w'}
     {n : Type w → Type w''} {o : Type w → Type x} [Monad n] [Monad o] [Iterator α m β]
     {lift₁ : ⦃α : Type w⦄ → m α → n α}
@@ -318,7 +325,7 @@ be `fun _ => False`.
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[inline]
+@[inline, expose]
 def IterM.mapWithPostcondition {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
     [Monad n] [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n γ)
     (it : IterM (α := α) m β) : IterM (α := Map α m n (fun ⦃_⦄ => monadLift) f) n γ :=
@@ -365,7 +372,7 @@ be `fun _ => False`.
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filterWithPostcondition {α β : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
     [Monad n] [MonadLiftT m n] [Iterator α m β] (f : β → PostconditionT n (ULift Bool))
     (it : IterM (α := α) m β) :=
@@ -411,7 +418,7 @@ possible to manually prove `Finite` and `Productive` instances depending on the
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned `Option` value.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filterMapM {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
     [Iterator α m β] [Monad n] [MonadLiftT m n]
     (f : β → n (Option γ)) (it : IterM (α := α) m β) :=
@@ -451,7 +458,7 @@ manually prove `Finite` and `Productive` instances depending on the concrete cho
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[inline]
+@[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 γ)
@@ -491,7 +498,7 @@ manually prove `Finite` and `Productive` instances depending on the concrete cho
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filterM {α β : Type w} {m : Type w → Type w'} {n : Type w → Type w''} [Iterator α m β]
     [Monad n] [MonadLiftT m n] (f : β → n (ULift Bool)) (it : IterM (α := α) m β) :=
   (it.filterMapWithPostcondition
@@ -528,7 +535,7 @@ be proved manually.
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned `Option` value.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filterMap {α β γ : Type w} {m : Type w → Type w'}
     [Iterator α m β] [Monad m] (f : β → Option γ) (it : IterM (α := α) m β) :=
   (it.filterMapWithPostcondition (fun b => pure (f b)) : IterM m γ)
@@ -557,7 +564,7 @@ it.map     ---a'--b'--c'--d'-e'----⊥
 
 For each value emitted by the base iterator `it`, this combinator calls `f`.
 -/
-@[inline]
+@[inline, expose]
 def IterM.map {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Monad m] (f : β → γ)
     (it : IterM (α := α) m β) :=
   (it.mapWithPostcondition (fun b => pure (f b)) : IterM m γ)
@@ -592,7 +599,7 @@ be proved manually.
 For each value emitted by the base iterator `it`, this combinator calls `f` and matches on the
 returned value.
 -/
-@[inline]
+@[inline, expose]
 def IterM.filter {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Monad m]
     (f : β → Bool) (it : IterM (α := α) m β) :=
   (it.filterMap (fun b => if f b then some b else none) : IterM m β)
@@ -609,4 +616,18 @@ instance {α β γ : Type w} {m : Type w → Type w'}
     IteratorSizePartial (FilterMap α m n lift f) n :=
   .defaultImplementation
 
+instance {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [IteratorSize α m] :
+    IteratorSize (Map α m n lift f) n where
+  size it := lift (IteratorSize.size it.internalState.inner)
+
+instance {α β γ : Type w} {m : Type w → Type w'}
+    {n : Type w → Type w''} [Monad n] [Iterator α m β]
+    {lift : ⦃α : Type w⦄ → m α → n α}
+    {f : β → PostconditionT n γ} [IteratorSizePartial α m] :
+    IteratorSizePartial (Map α m n lift f) n where
+  size it := lift (IteratorSizePartial.size it.internalState.inner)
+
 end Std.Iterators

src/Init/Data/Iterators/Consumers/Access.lean

@@ -7,6 +7,8 @@ module
 
 prelude
 import Init.Data.Iterators.Consumers.Partial
+import Init.Data.Iterators.Consumers.Loop
+import Init.Data.Iterators.Consumers.Monadic.Access
 
 namespace Std.Iterators
 
@@ -51,4 +53,12 @@ partial def Iter.Partial.atIdxSlow? {α β} [Iterator α Id β] [Monad Id]
   | .skip it' _ => (⟨it'⟩ : Iter.Partial (α := α) β).atIdxSlow? n
   | .done _ => none
 
+@[always_inline, inline, inherit_doc IterM.atIdx?]
+def Iter.atIdx? {α β} [Iterator α Id β] [Productive α Id] [IteratorAccess α Id]
+    (n : Nat) (it : Iter (α := α) β) : Option β :=
+  match (IteratorAccess.nextAtIdx? it.toIterM n).run.val with
+  | .yield _ out => some out
+  | .skip _ => none
+  | .done => none
+
 end Std.Iterators

src/Init/Data/Iterators/Consumers/Collect.lean

@@ -56,18 +56,4 @@ def Iter.Partial.toList {α : Type w} {β : Type w}
     [Iterator α Id β] [IteratorCollectPartial α Id Id] (it : Iter.Partial (α := α) β) : List β :=
   it.it.toIterM.allowNontermination.toList.run
 
-/--
-This class charaterizes how the plausibility behavior (`IsPlausibleStep`) and the actual iteration
-behavior (`it.step`) should relate to each other for pure iterators. Intuitively, a step should
-only be plausible if it is possible. For simplicity's sake, the actual definition is weaker but
-presupposes that the iterator is finite.
-
-This is an experimental instance and it should not be explicitly used downstream of the standard
-library.
--/
-class LawfulPureIterator (α : Type w) [Iterator α Id β]
-    [Finite α Id] [IteratorCollect α Id Id] where
-  mem_toList_iff_isPlausibleIndirectOutput {it : Iter (α := α) β} {out : β} :
-    out ∈ it.toList ↔ it.IsPlausibleIndirectOutput out
-
 end Std.Iterators

src/Init/Data/Iterators/Consumers/Loop.lean

@@ -6,6 +6,7 @@ Authors: Paul Reichert
 module
 
 prelude
+import Init.Data.Iterators.Consumers.Collect
 import Init.Data.Iterators.Consumers.Monadic.Loop
 import Init.Data.Iterators.Consumers.Partial
 
@@ -29,6 +30,7 @@ A `ForIn'` instance for iterators. Its generic membership relation is not easy t
 so this is not marked as `instance`. This way, more convenient instances can be built on top of it
 or future library improvements will make it more comfortable.
 -/
+@[always_inline, inline]
 def Iter.instForIn' {α : Type w} {β : Type w} {n : Type w → Type w'} [Monad n]
     [Iterator α Id β] [Finite α Id] [IteratorLoop α Id n] :
     ForIn' n (Iter (α := α) β) β ⟨fun it out => it.IsPlausibleIndirectOutput out⟩ where
@@ -47,7 +49,6 @@ instance (α : Type w) (β : Type w) (n : Type w → Type w') [Monad n]
     [Iterator α Id β] [IteratorLoopPartial α Id n] :
     ForIn n (Iter.Partial (α := α) β) β where
   forIn it init f :=
-    letI : MonadLift Id n := ⟨pure⟩
     ForIn.forIn it.it.toIterM.allowNontermination init f
 
 instance {m : Type w → Type w'}
@@ -136,4 +137,18 @@ def Iter.Partial.size {α : Type w} {β : Type w} [Iterator α Id β] [IteratorS
     (it : Iter (α := α) β) : Nat :=
   (IteratorSizePartial.size it.toIterM).run.down
 
+/--
+`LawfulIteratorSize α m` ensures that the `size` function of an iterator behaves as if it
+iterated over the whole iterator, counting its elements and causing all the monadic side effects
+of the iterations. This is a fairly strong condition for monadic iterators and it will be false
+for many efficient implementations of `size` that compute the size without actually iterating.
+
+This class is experimental and users of the iterator API should not explicitly depend on it.
+-/
+class LawfulIteratorSize (α : Type w) {β : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorSize α Id] where
+    size_eq_size_toArray {it : Iter (α := α) β} : it.size =
+      haveI : IteratorCollect α Id Id := .defaultImplementation
+      it.toArray.size
+
 end Std.Iterators

src/Init/Data/Iterators/Consumers/Monadic.lean

@@ -6,6 +6,7 @@ Authors: Paul Reichert
 module
 
 prelude
+import Init.Data.Iterators.Consumers.Monadic.Access
 import Init.Data.Iterators.Consumers.Monadic.Collect
 import Init.Data.Iterators.Consumers.Monadic.Loop
 import Init.Data.Iterators.Consumers.Monadic.Partial

src/Init/Data/Iterators/Consumers/Monadic/Access.lean

@@ -0,0 +1,95 @@
+/-
+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.Basic
+
+namespace Std.Iterators
+
+/--
+`it.IsPlausibleNthOutputStep n step` is the proposition that according to the
+`IsPlausibleStep` relation, it is plausible that `step` returns the step in which the `n`-th value
+of `it` is emitted, or `.done` if `it` can plausibly terminate before emitting `n` values.
+-/
+inductive IterM.IsPlausibleNthOutputStep {α β : Type w} {m : Type w → Type w'} [Iterator α m β] :
+    Nat → IterM (α := α) m β → IterStep (IterM (α := α) m β) β → Prop where
+  /-- If `it` plausibly yields in its immediate next step, this step is a plausible `0`-th output step. -/
+  | zero_yield {it : IterM (α := α) m β} : it.IsPlausibleStep (.yield it' out) →
+      it.IsPlausibleNthOutputStep 0 (.yield it' out)
+  /--
+  If `it` plausibly terminates in its immediate next step (`.done`), then `.done` is a plausible
+  `n`-th output step for arbitrary `n`.
+  -/
+  | done {it : IterM (α := α) m β} : it.IsPlausibleStep .done →
+      it.IsPlausibleNthOutputStep n .done
+  /--
+  If `it` plausibly yields in its immediate next step, the successor iterator being `it'`, and
+  if `step` is a plausible `n`-th output step of `it'`, then `step` is a plausible `n + 1`-th
+  output step of `it`.
+  -/
+  | yield {it it' : IterM (α := α) m β} {out step} : it.IsPlausibleStep (.yield it' out) →
+      it'.IsPlausibleNthOutputStep n step → it.IsPlausibleNthOutputStep (n + 1) step
+  /--
+  If `it` plausibly skips in its immediate next step, the successor iterator being `it'`, and
+  if `step` is a plausible `n`-th output step of `it'`, then `step` is also a plausible `n`-th
+  output step of `it`.
+  -/
+  | skip {it it' : IterM (α := α) m β} {step} : it.IsPlausibleStep (.skip it') →
+      it'.IsPlausibleNthOutputStep n step → it.IsPlausibleNthOutputStep n step
+
+/--
+`IteratorAccess α m` provides efficient implementations for random access or iterators that support
+it. `it.nextAtIdx? n` either returns the step in which the `n`-th value of `it` is emitted
+(necessarily of the form `.yield _ _`) or `.done` if `it` terminates before emitting the `n`-th
+value.
+
+For monadic iterators, the monadic effects of this operation may differ from manually iterating
+to the `n`-th value because `nextAtIdx?` can take shortcuts. By the signature, the return value
+is guaranteed to plausible in the sense of `IterM.IsPlausibleNthOutputStep`.
+
+This class is experimental and users of the iterator API should not explicitly depend on it.
+-/
+class IteratorAccess (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β] where
+  nextAtIdx? (it : IterM (α := α) m β) (n : Nat) :
+    m (PlausibleIterStep (it.IsPlausibleNthOutputStep n))
+
+/--
+Returns the step in which `it` yields its `n`-th element, or `.done` if it terminates earlier.
+In contrast to `step`, this function will always return either `.yield` or `.done` but never a
+`.skip` step.
+
+For monadic iterators, the monadic effects of this operation may differ from manually iterating
+to the `n`-th value because `nextAtIdx?` can take shortcuts. By the signature, the return value
+is guaranteed to plausible in the sense of `IterM.IsPlausibleNthOutputStep`.
+
+This function is only available for iterators that explicitly support it by implementing
+the `IteratorAccess` typeclass.
+-/
+@[always_inline, inline]
+def IterM.nextAtIdx? [Iterator α m β] [IteratorAccess α m] (it : IterM (α := α) m β)
+    (n : Nat) : m (PlausibleIterStep (it.IsPlausibleNthOutputStep n)) :=
+  IteratorAccess.nextAtIdx? it n
+
+/--
+Returns the `n`-th value emitted by `it`, or `none` if `it` terminates earlier.
+
+For monadic iterators, the monadic effects of this operation may differ from manually iterating
+to the `n`-th value because `atIdx?` can take shortcuts. By the signature, the return value
+is guaranteed to plausible in the sense of `IterM.IsPlausibleNthOutputStep`.
+
+This function is only available for iterators that explicitly support it by implementing
+the `IteratorAccess` typeclass.
+-/
+@[always_inline, inline]
+def IterM.atIdx? [Iterator α m β] [IteratorAccess α m] [Monad m] (it : IterM (α := α) m β)
+    (n : Nat) : m (Option β) := do
+  match (← IteratorAccess.nextAtIdx? it n).val with
+  | .yield _ out => return some out
+  | .skip _ => return none
+  | .done => return none
+
+end Std.Iterators

src/Init/Data/Iterators/Consumers/Monadic/Loop.lean

@@ -105,12 +105,14 @@ class IteratorSizePartial (α : Type w) (m : Type w → Type w') {β : Type w} [
 
 end Typeclasses
 
-private def IteratorLoop.WFRel {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
+/-- Internal implementation detail of the iterator library. -/
+def IteratorLoop.WFRel {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     {γ : Type x} {plausible_forInStep : β → γ → ForInStep γ → Prop}
     (_wf : WellFounded α m plausible_forInStep) :=
   IterM (α := α) m β × γ
 
-private def IteratorLoop.WFRel.mk {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
+/-- Internal implementation detail of the iterator library. -/
+def IteratorLoop.WFRel.mk {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     {γ : Type x} {plausible_forInStep : β → γ → ForInStep γ → Prop}
     (wf : WellFounded α m plausible_forInStep) (it : IterM (α := α) m β) (c : γ) :
     IteratorLoop.WFRel wf :=
@@ -134,20 +136,21 @@ def IterM.DefaultConsumers.forIn' {m : Type w → Type w'} {α : Type w} {β : T
     (plausible_forInStep : β → γ → ForInStep γ → Prop)
     (wf : IteratorLoop.WellFounded α m plausible_forInStep)
     (it : IterM (α := α) m β) (init : γ)
-    (f : (b : β) → it.IsPlausibleIndirectOutput b → (c : γ) → n (Subtype (plausible_forInStep b c))) : n γ :=
+    (P : β → Prop) (hP : ∀ b, it.IsPlausibleIndirectOutput b → P b)
+    (f : (b : β) → P b → (c : γ) → n (Subtype (plausible_forInStep b c))) : n γ :=
   haveI : WellFounded _ := wf
   letI : MonadLift m n := ⟨fun {γ} => lift γ⟩
   do
     match ← it.step with
     | .yield it' out h =>
-      match ← f out (.direct ⟨_, h⟩) init with
+      match ← f out (hP _ <| .direct ⟨_, h⟩) init with
       | ⟨.yield c, _⟩ =>
-        IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' c
-          (fun out h' acc => f out (.indirect ⟨_, rfl, h⟩ h') acc)
+        IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' c P
+          (fun _ h' => hP _ <| .indirect ⟨_, rfl, h⟩ h') f
       | ⟨.done c, _⟩ => return c
     | .skip it' h =>
-      IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' init
-        (fun out h' acc => f out (.indirect ⟨_, rfl, h⟩ h') acc)
+      IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' init P
+          (fun _ h' => hP _ <| .indirect ⟨_, rfl, h⟩ h') f
     | .done _ => return init
 termination_by IteratorLoop.WFRel.mk wf it init
 decreasing_by
@@ -163,7 +166,7 @@ implementations are possible and should be used instead.
 def IteratorLoop.defaultImplementation {α : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
     [Monad n] [Iterator α m β] :
     IteratorLoop α m n where
-  forIn lift := IterM.DefaultConsumers.forIn' lift
+  forIn lift γ Pl wf it init := IterM.DefaultConsumers.forIn' lift γ Pl wf it init _ (fun _ => id)
 
 /--
 Asserts that a given `IteratorLoop` instance is equal to `IteratorLoop.defaultImplementation`.
@@ -246,6 +249,7 @@ A `ForIn'` instance for iterators. Its generic membership relation is not easy t
 so this is not marked as `instance`. This way, more convenient instances can be built on top of it
 or future library improvements will make it more comfortable.
 -/
+@[always_inline, inline]
 def IterM.instForIn' {m : Type w → Type w'} {n : Type w → Type w''}
     {α : Type w} {β : Type w} [Iterator α m β] [Finite α m] [IteratorLoop α m n]
     [MonadLiftT m n] :

src/Init/Data/Iterators/Lemmas.lean

@@ -7,3 +7,4 @@ module
 
 prelude
 import Init.Data.Iterators.Lemmas.Consumers
+import Init.Data.Iterators.Lemmas.Combinators

src/Init/Data/Iterators/Lemmas/Combinators.lean

@@ -0,0 +1,10 @@
+/-
+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
+import Init.Data.Iterators.Lemmas.Combinators.FilterMap

src/Init/Data/Iterators/Lemmas/Combinators/FilterMap.lean

@@ -3,10 +3,12 @@ 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.Consumers
-import Std.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
-import Std.Data.Iterators.Combinators.FilterMap
+import Init.Data.Iterators.Lemmas.Combinators.Monadic.FilterMap
+import Init.Data.Iterators.Combinators.FilterMap
 
 namespace Std.Iterators
 
@@ -142,7 +144,6 @@ theorem Iter.step_filterMapM {β' : Type w} {f : β → n (Option β')}
   generalize it.toIterM.step = step
   match step with
   | .yield it' out h =>
-    simp only
     apply bind_congr
     intro step
     rcases step with _ | _ <;> rfl

src/Init/Data/Iterators/Lemmas/Combinators/Monadic.lean

@@ -0,0 +1,9 @@
+/-
+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

src/Init/Data/Iterators/Lemmas/Combinators/Monadic/FilterMap.lean

@@ -0,0 +1,414 @@
+/-
+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.Internal.LawfulMonadLiftFunction
+import Init.Data.Iterators.Combinators.Monadic.FilterMap
+import Init.Data.Iterators.Lemmas.Consumers.Monadic
+import all Init.Data.Iterators.Consumers.Monadic.Collect
+
+namespace Std.Iterators
+open Std.Internal
+
+section Step
+
+variable {α β β' : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+  [Iterator α m β] {it : IterM (α := α) m β}
+
+theorem IterM.step_filterMapWithPostcondition {f : β → PostconditionT n (Option β')}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapWithPostcondition f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨none, h'⟩ =>
+        pure <| .skip (it'.filterMapWithPostcondition f) (.yieldNone (out := out) h h')
+      | ⟨some out', h'⟩ =>
+        pure <| .yield (it'.filterMapWithPostcondition f) out' (.yieldSome (out := out) h h')
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (by exact .done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PlausibleIterStep.skip, PlausibleIterStep.yield]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterWithPostcondition {f : β → PostconditionT n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterWithPostcondition f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← (f out).operation with
+      | ⟨.up false, h'⟩ =>
+        pure <| .skip (it'.filterWithPostcondition f) (.yieldNone (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+      | ⟨.up true, h'⟩ =>
+        pure <| .yield (it'.filterWithPostcondition f) out (by exact .yieldSome (out := out) h ⟨⟨_, h'⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterWithPostcondition f) (by exact .skip h)
+    | .done h =>
+      pure <| .done (by exact .done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, PlausibleIterStep.skip, PlausibleIterStep.yield,
+      bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_mapWithPostcondition {γ : Type w} {f : β → PostconditionT n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.mapWithPostcondition f).step = (do
+    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⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapWithPostcondition f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.operation_map, bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterMapM {f : β → n (Option β')}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterMapM f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | none =>
+        pure <| .skip (it'.filterMapM f) (.yieldNone (out := out) h .intro)
+      | some out' =>
+        pure <| .yield (it'.filterMapM f) out' (.yieldSome (out := out) h .intro)
+    | .skip it' h =>
+      pure <| .skip (it'.filterMapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.lift, bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterM {f : β → n (ULift Bool)}
+    [Monad n] [LawfulMonad n] [MonadLiftT m n] :
+  (it.filterM f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match ← f out with
+      | .up false =>
+        pure <| .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⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.filterM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [PostconditionT.lift, PostconditionT.operation_map, Functor.map_map,
+      PlausibleIterStep.skip, PlausibleIterStep.yield, bind_map_left]
+    apply bind_congr
+    intro step
+    rcases step with _ | _ <;> rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_mapM {γ : Type w} {f : β → n γ}
+    [Monad n] [LawfulMonad n] [MonadLiftT m 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⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.mapM f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  apply bind_congr
+  intro step
+  match step with
+  | .yield it' out h =>
+    simp only [bind_pure_comp]
+    simp only [PostconditionT.lift, Functor.map]
+    simp only [PostconditionT.operation_map, Functor.map_map, PlausibleIterStep.skip,
+      PlausibleIterStep.yield, bind_map_left, bind_pure_comp]
+    rfl
+  | .skip it' h => rfl
+  | .done h => rfl
+
+theorem IterM.step_filterMap [Monad m] [LawfulMonad m] {f : β → Option β'} :
+  (it.filterMap f).step = (do
+    match ← it.step with
+    | .yield it' out h => do
+      match h' : f out with
+      | none =>
+        pure <| .skip (it'.filterMap f) (.yieldNone h h')
+      | some out' =>
+        pure <| .yield (it'.filterMap f) out' (.yieldSome h h')
+    | .skip it' h =>
+      pure <| .skip (it'.filterMap f) (.skip h)
+    | .done h =>
+      pure <| .done (.done h)) := by
+  simp only [IterM.filterMap, step_filterMapWithPostcondition, pure]
+  apply bind_congr
+  intro step
+  split
+  · simp only [PostconditionT.pure, PlausibleIterStep.skip, PlausibleIterStep.yield, pure_bind]
+    split <;> split <;> simp_all
+  · simp
+  · simp
+
+theorem IterM.step_map [Monad m] [LawfulMonad m] {f : β → β'} :
+  (it.map f).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      let out' := f out
+      pure <| .yield (it'.map f) out' (.yieldSome h ⟨⟨out', rfl⟩, rfl⟩)
+    | .skip it' h =>
+      pure <| .skip (it'.map f) (.skip h)
+    | .done h => pure <| .done (.done h)) := by
+  simp only [map, IterM.step_mapWithPostcondition]
+  apply bind_congr
+  intro step
+  split
+  · simp
+  · rfl
+  · rfl
+
+theorem IterM.step_filter [Monad m] [LawfulMonad m] {f : β → Bool} :
+  (it.filter f).step = (do
+    match ← it.step with
+    | .yield it' out h =>
+      if h' : f out = true then
+        pure <| .yield (it'.filter f) out (.yieldSome h (by simp [h']))
+      else
+        pure <| .skip (it'.filter f) (.yieldNone h (by simp [h']))
+    | .skip it' h =>
+      pure <| .skip (it'.filter f) (.skip h)
+    | .done h => pure <| .done (.done h)) := by
+  simp only [filter, IterM.step_filterMap]
+  apply bind_congr
+  intro step
+  split
+  · split
+    · split
+      · exfalso; simp_all
+      · rfl
+    · split
+      · congr; simp_all
+      · exfalso; simp_all
+  · rfl
+  · rfl
+
+end Step
+
+section Lawful
+
+@[no_expose]
+instance {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''} {o : Type w → Type x}
+    [Monad m] [Monad n] [Monad o] [LawfulMonad n] [LawfulMonad o] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m o] [LawfulIteratorCollect α m o]
+    {lift : ⦃δ : Type w⦄ -> m δ → n δ} {f : β → PostconditionT n γ} [LawfulMonadLiftFunction lift] :
+    LawfulIteratorCollect (Map α m n lift f) n o where
+  lawful_toArrayMapped := by
+    intro δ lift' _ _
+    letI : MonadLift m n := ⟨lift (δ := _)⟩
+    letI : MonadLift n o := ⟨lift' (α := _)⟩
+    ext g it
+    have : it = IterM.mapWithPostcondition _ it.internalState.inner := by rfl
+    generalize it.internalState.inner = it at *
+    cases this
+    simp only [LawfulIteratorCollect.toArrayMapped_eq]
+    simp only [IteratorCollect.toArrayMapped]
+    rw [LawfulIteratorCollect.toArrayMapped_eq]
+    induction it using IterM.inductSteps with | step it ih_yield ih_skip =>
+    rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
+    rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
+    simp only [bind_assoc]
+    rw [IterM.step_mapWithPostcondition]
+    simp only [liftM_bind (m := n) (n := o), bind_assoc]
+    apply bind_congr
+    intro step
+    cases step using PlausibleIterStep.casesOn
+    · simp only [bind_pure_comp]
+      simp only [liftM_map, bind_map_left]
+      apply bind_congr
+      intro out'
+      simp only [← ih_yield ‹_›]
+      rfl
+    · simp only [bind_pure_comp, pure_bind, liftM_pure, pure_bind, ← ih_skip ‹_›]
+      simp only [IterM.mapWithPostcondition, IterM.InternalCombinators.map, internalState_toIterM]
+    · simp
+
+end Lawful
+
+section ToList
+
+theorem IterM.InternalConsumers.toList_filterMap {α β γ: Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toList = (fun x => x.filterMap f) <$> it.toList := by
+  induction it using IterM.inductSteps
+  rename_i it ihy ihs
+  rw [IterM.toList_eq_match_step, IterM.toList_eq_match_step]
+  simp only [bind_pure_comp, map_bind]
+  rw [step_filterMap]
+  simp only [bind_assoc, IterM.step, map_eq_pure_bind]
+  apply bind_congr
+  intro step
+  split
+  · simp only [List.filterMap_cons, bind_assoc, pure_bind]
+    split
+    · split
+      · simp only [bind_pure_comp, pure_bind]
+        exact ihy ‹_›
+      · simp_all
+    · split
+      · simp_all
+      · simp_all [ihy ‹_›]
+  · simp only [bind_pure_comp, pure_bind]
+    apply ihs
+    assumption
+  · simp
+
+theorem IterM.toList_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toList = (fun x => x.filterMap f) <$> it.toList := by
+  induction it using IterM.inductSteps
+  rename_i it ihy ihs
+  rw [IterM.toList_eq_match_step, IterM.toList_eq_match_step]
+  simp only [bind_pure_comp, map_bind]
+  rw [step_filterMap]
+  simp only [bind_assoc, IterM.step, map_eq_pure_bind]
+  apply bind_congr
+  intro step
+  split
+  · simp only [List.filterMap_cons, bind_assoc, pure_bind]
+    split
+    · split
+      · simp only [bind_pure_comp, pure_bind]
+        exact ihy ‹_›
+      · simp_all
+    · split
+      · simp_all
+      · simp_all [ihy ‹_›]
+  · simp only [bind_pure_comp, pure_bind]
+    apply ihs
+    assumption
+  · simp
+
+theorem IterM.toList_map {α β β' : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → β'}
+    (it : IterM (α := α) m β) :
+    (it.map f).toList = (fun x => x.map f) <$> it.toList := by
+  rw [LawfulIteratorCollect.toList_eq, ← List.filterMap_eq_map, ← toList_filterMap]
+  let t := type_of% (it.map f)
+  let t' := type_of% (it.filterMap (some ∘ f))
+  congr
+  · simp [Map]
+  · simp [instIteratorMap, inferInstanceAs]
+    congr
+    simp
+  · refine heq_of_eqRec_eq ?_ rfl
+    congr
+    simp only [Map, PostconditionT.map_pure, Function.comp_apply]
+    simp only [instIteratorMap, inferInstanceAs, Function.comp_apply]
+    congr
+    simp
+  · simp [Map]
+  · simp only [instIteratorMap, inferInstanceAs, Function.comp_apply]
+    congr
+    simp
+  · simp only [map, mapWithPostcondition, InternalCombinators.map, Function.comp_apply, filterMap,
+    filterMapWithPostcondition, InternalCombinators.filterMap]
+    congr
+    · simp [Map]
+    · simp
+
+theorem IterM.toList_filter {α : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    {β : Type w} [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toList = List.filter f <$> it.toList := by
+  simp only [filter, toList_filterMap, ← List.filterMap_eq_filter]
+  rfl
+
+end ToList
+
+section ToListRev
+
+theorem IterM.toListRev_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toListRev = (fun x => x.filterMap f) <$> it.toListRev := by
+  simp [toListRev_eq, toList_filterMap]
+
+theorem IterM.toListRev_map {α β γ : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → γ}
+    (it : IterM (α := α) m β) :
+    (it.map f).toListRev = (fun x => x.map f) <$> it.toListRev := by
+  simp [toListRev_eq, toList_map]
+
+theorem IterM.toListRev_filter {α β : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toListRev = List.filter f <$> it.toListRev := by
+  simp [toListRev_eq, toList_filter]
+
+end ToListRev
+
+section ToArray
+
+theorem IterM.toArray_filterMap {α β γ : Type w} {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m]
+    {f : β → Option γ} (it : IterM (α := α) m β) :
+    (it.filterMap f).toArray = (fun x => x.filterMap f) <$> it.toArray := by
+  simp [← toArray_toList, toList_filterMap]
+
+theorem IterM.toArray_map {α β γ : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    [Iterator α m β] [IteratorCollect α m m] [LawfulIteratorCollect α m m] [Finite α m] {f : β → γ}
+    (it : IterM (α := α) m β) :
+    (it.map f).toArray = (fun x => x.map f) <$> it.toArray := by
+  simp [← toArray_toList, toList_map]
+
+theorem IterM.toArray_filter {α : Type w} {m : Type w → Type w'} [Monad m] [LawfulMonad m]
+    {β : Type w} [Iterator α m β] [Finite α m] [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {f : β → Bool} {it : IterM (α := α) m β} :
+    (it.filter f).toArray = Array.filter f <$> it.toArray := by
+  simp [← toArray_toList, toList_filter]
+
+end ToArray
+
+end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Collect.lean

@@ -64,10 +64,10 @@ theorem Iter.toListRev_eq {α β} [Iterator α Id β] [Finite α Id] [IteratorCo
 
 theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
     [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
-    it.toArray = match it.step with
-      | .yield it' out _ => #[out] ++ it'.toArray
-      | .skip it' _ => it'.toArray
-      | .done _ => #[] := by
+    it.toArray = match it.step.val with
+      | .yield it' out => #[out] ++ it'.toArray
+      | .skip it' => it'.toArray
+      | .done => #[] := by
   simp only [Iter.toArray_eq_toArray_toIterM, Iter.step]
   rw [IterM.toArray_eq_match_step, Id.run_bind]
   generalize it.toIterM.step.run = step
@@ -75,18 +75,18 @@ theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [I
 
 theorem Iter.toList_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
     [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
-    it.toList = match it.step with
-      | .yield it' out _ => out :: it'.toList
-      | .skip it' _ => it'.toList
-      | .done _ => [] := by
+    it.toList = match it.step.val with
+      | .yield it' out => out :: it'.toList
+      | .skip it' => it'.toList
+      | .done => [] := by
   rw [← Iter.toList_toArray, Iter.toArray_eq_match_step]
   split <;> simp [Iter.toList_toArray]
 
 theorem Iter.toListRev_eq_match_step {α β} [Iterator α Id β] [Finite α Id] {it : Iter (α := α) β} :
-    it.toListRev = match it.step with
-      | .yield it' out _ => it'.toListRev ++ [out]
-      | .skip it' _ => it'.toListRev
-      | .done _ => [] := by
+    it.toListRev = match it.step.val with
+      | .yield it' out => it'.toListRev ++ [out]
+      | .skip it' => it'.toListRev
+      | .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
@@ -111,4 +111,27 @@ theorem Iter.toList_eq_of_atIdxSlow?_eq {α₁ α₂ β}
     it₁.toList = it₂.toList := by
   ext; simp [getElem?_toList_eq_atIdxSlow?, h]
 
+theorem Iter.isPlausibleIndirectOutput_of_mem_toList
+    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} {b : β} :
+    b ∈ it.toList → it.IsPlausibleIndirectOutput b := by
+  induction it using Iter.inductSteps with | step it ihy ihs =>
+  rw [toList_eq_match_step]
+  cases it.step using PlausibleIterStep.casesOn
+  case yield it' out h =>
+    simp only [List.mem_cons]
+    rintro h'
+    cases h' <;> rename_i h'
+    · cases h'
+      exact .direct ⟨_, h⟩
+    · specialize ihy h h'
+      exact IsPlausibleIndirectOutput.indirect ⟨_, rfl, h⟩ ihy
+  case skip it' h =>
+    simp only
+    intro h'
+    specialize ihs h h'
+    exact IsPlausibleIndirectOutput.indirect ⟨_, rfl, h⟩ ihs
+  case done h =>
+    simp
+
 end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Loop.lean

@@ -9,6 +9,7 @@ prelude
 import Init.Data.Iterators.Lemmas.Consumers.Collect
 import all Init.Data.Iterators.Lemmas.Consumers.Monadic.Loop
 import all Init.Data.Iterators.Consumers.Loop
+import all Init.Data.Iterators.Consumers.Monadic.Collect
 
 namespace Std.Iterators
 
@@ -19,7 +20,7 @@ theorem Iter.forIn'_eq {α β : Type w} [Iterator α Id β] [Finite α Id]
     letI : ForIn' m (Iter (α := α) β) β _ := Iter.instForIn'
     ForIn'.forIn' it init f =
       IterM.DefaultConsumers.forIn' (fun _ c => pure c.run) γ (fun _ _ _ => True)
-        IteratorLoop.wellFounded_of_finite it.toIterM init
+        IteratorLoop.wellFounded_of_finite it.toIterM init _ (fun _ => id)
           (fun out h acc => (⟨·, .intro⟩) <$>
             f out (Iter.isPlausibleIndirectOutput_iff_isPlausibleIndirectOutput_toIterM.mpr h) acc) := by
   cases hl.lawful; rfl
@@ -30,7 +31,7 @@ theorem Iter.forIn_eq {α β : Type w} [Iterator α Id β] [Finite α Id]
     {f : (b : β) → γ → m (ForInStep γ)} :
     ForIn.forIn it init f =
       IterM.DefaultConsumers.forIn' (fun _ c => pure c.run) γ (fun _ _ _ => True)
-        IteratorLoop.wellFounded_of_finite it.toIterM init
+        IteratorLoop.wellFounded_of_finite it.toIterM init _ (fun _ => id)
           (fun out _ acc => (⟨·, .intro⟩) <$>
             f out acc) := by
   cases hl.lawful; rfl
@@ -42,7 +43,6 @@ theorem Iter.forIn'_eq_forIn'_toIterM {α β : Type w} [Iterator α Id β]
     {f : (out : β) → _ → γ → m (ForInStep γ)} :
     letI : ForIn' m (Iter (α := α) β) β _ := Iter.instForIn'
     ForIn'.forIn' it init f =
-      letI : MonadLift Id m := ⟨Std.Internal.idToMonad (α := _)⟩
       letI : ForIn' m (IterM (α := α) Id β) β _ := IterM.instForIn'
       ForIn'.forIn' it.toIterM init
         (fun out h acc => f out (isPlausibleIndirectOutput_iff_isPlausibleIndirectOutput_toIterM.mpr h) acc) := by
@@ -54,7 +54,6 @@ theorem Iter.forIn_eq_forIn_toIterM {α β : Type w} [Iterator α Id β]
     {γ : Type w} {it : Iter (α := α) β} {init : γ}
     {f : β → γ → m (ForInStep γ)} :
     ForIn.forIn it init f =
-      letI : MonadLift Id m := ⟨Std.Internal.idToMonad (α := _)⟩
       ForIn.forIn it.toIterM init f := by
   rfl
 
@@ -115,15 +114,83 @@ private theorem Iter.forIn'_toList.aux {ρ : Type u} {α : Type v} {γ : Type w}
     forIn' r init f = forIn' s init (fun a h' acc => f a (h ▸ h') acc) := by
   cases h; rfl
 
+
+theorem Iter.isPlausibleStep_iff_step_eq {α β} [Iterator α Id β]
+    [IteratorCollect α Id Id] [Finite α Id]
+    [LawfulIteratorCollect α Id Id] [LawfulDeterministicIterator α Id]
+    {it : Iter (α := α) β} {step} :
+    it.IsPlausibleStep step ↔ it.step.val = step := by
+  obtain ⟨step', hs'⟩ := LawfulDeterministicIterator.isPlausibleStep_eq_eq (it := it.toIterM)
+  have hs := it.step.property
+  simp only [Iter.IsPlausibleStep, hs'] at hs
+  cases hs
+  simp only [IsPlausibleStep, hs', Iter.step, IterM.Step.toPure, toIter_toIterM,
+    IterStep.mapIterator_mapIterator, toIterM_comp_toIter, IterStep.mapIterator_id]
+  simp only [Eq.comm (b := step)]
+  constructor
+  · intro h
+    replace h := congrArg (IterStep.mapIterator IterM.toIter) h
+    simpa using h
+  · intro h
+    replace h := congrArg (IterStep.mapIterator Iter.toIterM) h
+    simpa using h
+
+theorem Iter.mem_toList_iff_isPlausibleIndirectOutput {α β} [Iterator α Id β]
+    [IteratorCollect α Id Id] [Finite α Id]
+    [LawfulIteratorCollect α Id Id] [LawfulDeterministicIterator α Id]
+    {it : Iter (α := α) β} {out : β} :
+    out ∈ it.toList ↔ it.IsPlausibleIndirectOutput out := by
+  induction it using Iter.inductSteps with | step it ihy ihs =>
+  rw [toList_eq_match_step]
+  constructor
+  · intro h
+    cases heq : it.step using PlausibleIterStep.casesOn <;> simp only [heq] at h
+    · rename_i it' out hp
+      cases List.mem_cons.mp h <;> rename_i hmem
+      · cases hmem
+        simp only [Iter.IsPlausibleStep, IterStep.mapIterator_yield] at hp
+        exact Iter.IsPlausibleIndirectOutput.direct ⟨_, hp⟩
+      · apply Iter.IsPlausibleIndirectOutput.indirect
+        · exact ⟨_, rfl, ‹_›⟩
+        · exact (ihy ‹_›).mp hmem
+    · apply Iter.IsPlausibleIndirectOutput.indirect
+      · exact ⟨_, rfl, ‹_›⟩
+      · exact (ihs ‹_›).mp h
+    · cases h
+  · intro hp
+    cases hp
+    · rename_i hp
+      simp only [Iter.isPlausibleOutput_iff_exists, Iter.isPlausibleStep_iff_step_eq] at hp
+      obtain ⟨it', hp⟩ := hp
+      split <;> simp_all
+    · rename_i it' h₁ h₂
+      cases heq : it.step using PlausibleIterStep.casesOn <;> simp only
+      · apply List.mem_cons_of_mem
+        simp only [Iter.isPlausibleSuccessorOf_iff_exists, Iter.isPlausibleStep_iff_step_eq] at h₁
+        obtain ⟨step, h₁, rfl⟩ := h₁
+        simp only [heq, IterStep.successor, Option.some.injEq] at h₁
+        cases h₁
+        simp only [ihy ‹_›]
+        exact h₂
+      · simp only [Iter.isPlausibleSuccessorOf_iff_exists, Iter.isPlausibleStep_iff_step_eq] at h₁
+        obtain ⟨step, h₁, rfl⟩ := h₁
+        simp only [heq, IterStep.successor, Option.some.injEq] at h₁
+        cases h₁
+        rw [ihs ‹_›]
+        exact h₂
+      · simp only [Iter.isPlausibleSuccessorOf_iff_exists, Iter.isPlausibleStep_iff_step_eq] at h₁
+        obtain ⟨step, h₁, rfl⟩ := h₁
+        simp [heq, IterStep.successor] at h₁
+
 theorem Iter.forIn'_toList {α β : Type w} [Iterator α Id β]
     [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
     [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
     [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
-    [LawfulPureIterator α]
+    [LawfulDeterministicIterator α Id]
     {γ : Type w} {it : Iter (α := α) β} {init : γ}
     {f : (out : β) → _ → γ → m (ForInStep γ)} :
     letI : ForIn' m (Iter (α := α) β) β _ := Iter.instForIn'
-    ForIn'.forIn' it.toList init f = ForIn'.forIn' it init (fun out h acc => f out (LawfulPureIterator.mem_toList_iff_isPlausibleIndirectOutput.mpr h) acc) := by
+    ForIn'.forIn' it.toList init f = ForIn'.forIn' it init (fun out h acc => f out (Iter.mem_toList_iff_isPlausibleIndirectOutput.mpr h) acc) := by
   induction it using Iter.inductSteps generalizing init with case step it ihy ihs =>
   have := it.toList_eq_match_step
   generalize hs : it.step = step at this
@@ -153,11 +220,11 @@ theorem Iter.forIn'_eq_forIn'_toList {α β : Type w} [Iterator α Id β]
     [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
     [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
     [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
-    [LawfulPureIterator α]
+    [LawfulDeterministicIterator α Id]
     {γ : Type w} {it : Iter (α := α) β} {init : γ}
     {f : (out : β) → _ → γ → m (ForInStep γ)} :
     letI : ForIn' m (Iter (α := α) β) β _ := Iter.instForIn'
-    ForIn'.forIn' it init f = ForIn'.forIn' it.toList init (fun out h acc => f out (LawfulPureIterator.mem_toList_iff_isPlausibleIndirectOutput.mp h) acc) := by
+    ForIn'.forIn' it init f = ForIn'.forIn' it.toList init (fun out h acc => f out (Iter.mem_toList_iff_isPlausibleIndirectOutput.mp h) acc) := by
   simp only [forIn'_toList]
   congr
 
@@ -197,7 +264,7 @@ theorem Iter.foldM_eq_foldM_toIterM {α β : Type w} [Iterator α Id β]
     [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
     [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
     {γ : Type w} {it : Iter (α := α) β} {init : γ} {f : γ → β → m γ} :
-    it.foldM (init := init) f = letI : MonadLift Id m := ⟨pure⟩; it.toIterM.foldM (init := init) f :=
+    it.foldM (init := init) f = it.toIterM.foldM (init := init) f :=
   (rfl)
 
 theorem Iter.forIn_yield_eq_foldM {α β γ δ : Type w} [Iterator α Id β]
@@ -282,4 +349,26 @@ theorem Iter.foldl_toList {α β γ : Type w} [Iterator α Id β] [Finite α Id]
     it.toList.foldl (init := init) f = it.fold (init := init) f := by
   rw [fold_eq_foldM, List.foldl_eq_foldlM, ← Iter.foldlM_toList]
 
+theorem Iter.size_toArray_eq_size {α β : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    [IteratorSize α Id] [LawfulIteratorSize α]
+    {it : Iter (α := α) β} :
+    it.toArray.size = it.size := by
+  simp only [toArray_eq_toArray_toIterM, LawfulIteratorCollect.toArray_eq]
+  simp [← toArray_eq_toArray_toIterM, LawfulIteratorSize.size_eq_size_toArray]
+
+theorem Iter.length_toList_eq_size {α β : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    [IteratorSize α Id] [LawfulIteratorSize α]
+    {it : Iter (α := α) β} :
+    it.toList.length = it.size := by
+  rw [← toList_toArray, Array.length_toList, size_toArray_eq_size]
+
+theorem Iter.length_toListRev_eq_size {α β : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    [IteratorSize α Id] [LawfulIteratorSize α]
+    {it : Iter (α := α) β} :
+    it.toListRev.length = it.size := by
+  rw [toListRev_eq, List.length_reverse, length_toList_eq_size]
+
 end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Monadic/Collect.lean

@@ -44,11 +44,11 @@ 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 with
-      | .yield it' out _ =>
+      match (← it.step).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)
-      | .done _ => return #[]) := by
+      | .skip it' => IterM.DefaultConsumers.toArrayMapped lift f it' (m := m)
+      | .done => return #[]) := by
   rw [IterM.DefaultConsumers.toArrayMapped, IterM.DefaultConsumers.toArrayMapped.go]
   apply bind_congr
   intro step
@@ -57,10 +57,10 @@ theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad n] [LawfulMona
 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 with
-      | .yield it' out _ => return #[out] ++ (← it'.toArray)
-      | .skip it' _ => it'.toArray
-      | .done _ => return #[]) := by
+      match (← it.step).val with
+      | .yield it' out => return #[out] ++ (← it'.toArray)
+      | .skip it' => it'.toArray
+      | .done => return #[]) := by
   simp only [IterM.toArray, LawfulIteratorCollect.toArrayMapped_eq]
   rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
   simp [bind_pure_comp, pure_bind]
@@ -78,10 +78,10 @@ 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 with
-      | .yield it' out _ => return out :: (← it'.toList)
-      | .skip it' _ => it'.toList
-      | .done _ => return []) := by
+      match (← it.step).val with
+      | .yield it' out => return out :: (← it'.toList)
+      | .skip it' => it'.toList
+      | .done => return []) := by
   simp [← IterM.toList_toArray]
   rw [IterM.toArray_eq_match_step, map_eq_pure_bind, bind_assoc]
   apply bind_congr
@@ -111,10 +111,10 @@ 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 with
-      | .yield it' out _ => return (← it'.toListRev) ++ [out]
-      | .skip it' _ => it'.toListRev
-      | .done _ => return []) := by
+      match (← it.step).val with
+      | .yield it' out => return (← it'.toListRev) ++ [out]
+      | .skip it' => it'.toListRev
+      | .done => return []) := by
   simp [IterM.toListRev]
   rw [toListRev.go]
   apply bind_congr
@@ -131,7 +131,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
-  split <;> simp (discharger := assumption) [ihy, ihs]
+  cases step 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]

src/Init/Data/Iterators/Lemmas/Consumers/Monadic/Loop.lean

@@ -18,18 +18,19 @@ theorem IterM.DefaultConsumers.forIn'_eq_match_step {α β : Type w} {m : Type w
     {plausible_forInStep : β → γ → ForInStep γ → Prop}
     {wf : IteratorLoop.WellFounded α m plausible_forInStep}
     {it : IterM (α := α) m β} {init : γ}
-    {f : (b : β) → it.IsPlausibleIndirectOutput b → (c : γ) → n (Subtype (plausible_forInStep b c))} :
-    IterM.DefaultConsumers.forIn' lift γ plausible_forInStep wf it init f = (do
+    {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 = (do
       match ← lift _ it.step with
       | .yield it' out h =>
-        match ← f out (.direct ⟨_, h⟩) init with
+        match ← f out (hP _ <| .direct ⟨_, h⟩) init with
         | ⟨.yield c, _⟩ =>
-          IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' c
-            fun out h'' acc => f out (.indirect ⟨_, rfl, h⟩ h'') acc
+          IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' c P
+            (fun _ h' => hP _ <| .indirect ⟨_, rfl, h⟩ h') f
         | ⟨.done c, _⟩ => return c
       | .skip it' h =>
-        IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' init
-          fun out h' acc => f out (.indirect ⟨_, rfl, h⟩ h') acc
+        IterM.DefaultConsumers.forIn' lift _ plausible_forInStep wf it' init P
+          (fun _ h' => hP _ <| .indirect ⟨_, rfl, h⟩ h') f
       | .done _ => return init) := by
   rw [forIn']
   apply bind_congr
@@ -42,7 +43,7 @@ theorem IterM.forIn'_eq {α β : Type w} {m : Type w → Type w'} [Iterator α m
     {f : (b : β) → it.IsPlausibleIndirectOutput b → γ → n (ForInStep γ)} :
     letI : ForIn' n (IterM (α := α) m β) β _ := IterM.instForIn'
     ForIn'.forIn' it init f = IterM.DefaultConsumers.forIn' (fun _ => monadLift) γ (fun _ _ _ => True)
-        IteratorLoop.wellFounded_of_finite it init ((⟨·, .intro⟩) <$> f · · ·) := by
+        IteratorLoop.wellFounded_of_finite it init _ (fun _ => id) ((⟨·, .intro⟩) <$> f · · ·) := by
   cases hl.lawful; rfl
 
 theorem IterM.forIn_eq {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
@@ -50,9 +51,42 @@ theorem IterM.forIn_eq {α β : Type w} {m : Type w → Type w'} [Iterator α m
     [MonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
     {f : β → γ → n (ForInStep γ)} :
     ForIn.forIn it init f = IterM.DefaultConsumers.forIn' (fun _ => monadLift) γ (fun _ _ _ => True)
-        IteratorLoop.wellFounded_of_finite it init (fun out _ acc => (⟨·, .intro⟩) <$> f out acc) := by
+        IteratorLoop.wellFounded_of_finite it init _ (fun _ => id) (fun out _ acc => (⟨·, .intro⟩) <$> f out acc) := by
   cases hl.lawful; rfl
 
+theorem IterM.DefaultConsumers.forIn'_eq_forIn' {m : Type w → Type w'} {α : Type w} {β : Type w}
+    [Iterator α m β]
+    {n : Type w → Type w''} [Monad n]
+    {lift : ∀ γ, m γ → n γ} {γ : Type w}
+    {Pl : β → γ → ForInStep γ → Prop}
+    {wf : IteratorLoop.WellFounded α m Pl}
+    {it : IterM (α := α) m β} {init : γ}
+    {P : β → Prop} {hP : ∀ b, it.IsPlausibleIndirectOutput b → P b}
+    {Q : β → Prop} {hQ : ∀ b, it.IsPlausibleIndirectOutput b → Q b}
+    {f : (b : β) → P b → (c : γ) → n (Subtype (Pl b c))}
+    {g : (b : β) → Q b → (c : γ) → n (Subtype (Pl b c))}
+    (hfg : ∀ b c, (hPb : P b) → (hQb : Q b) → f b hPb c = g b hQb c) :
+    IterM.DefaultConsumers.forIn' lift γ Pl wf it init P hP f =
+      IterM.DefaultConsumers.forIn' lift γ Pl wf it init Q hQ g := by
+  rw [forIn', forIn']
+  apply bind_congr
+  intro step
+  split
+  · congr
+    · apply hfg
+    · ext
+      split
+      · apply IterM.DefaultConsumers.forIn'_eq_forIn'
+        assumption
+      · rfl
+  · apply IterM.DefaultConsumers.forIn'_eq_forIn'
+    assumption
+  · rfl
+termination_by IteratorLoop.WFRel.mk wf it init
+decreasing_by
+  · exact Or.inl ⟨_, ‹_›, ‹_›⟩
+  · exact Or.inr ⟨‹_›, rfl⟩
+
 theorem IterM.forIn'_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
     [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
     [IteratorLoop α m n] [LawfulIteratorLoop α m n]
@@ -78,8 +112,14 @@ theorem IterM.forIn'_eq_match_step {α β : Type w} {m : Type w → Type w'} [It
   · simp only [map_eq_pure_bind, bind_assoc]
     apply bind_congr
     intro forInStep
-    cases forInStep <;> simp [IterM.forIn'_eq]
-  · simp [IterM.forIn'_eq]
+    cases forInStep
+    · simp
+    · simp only [bind_pure_comp, pure_bind, forIn'_eq]
+      apply DefaultConsumers.forIn'_eq_forIn'
+      intros; congr
+  · simp only [forIn'_eq]
+    apply DefaultConsumers.forIn'_eq_forIn'
+    intros; congr
   · simp
 
 theorem IterM.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
@@ -95,16 +135,9 @@ theorem IterM.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'} [Ite
         | .done c => return c
       | .skip it' _ => ForIn.forIn it' init f
       | .done _ => return init) := by
-  rw [IterM.forIn_eq, DefaultConsumers.forIn'_eq_match_step]
-  apply bind_congr
-  intro step
-  cases step using PlausibleIterStep.casesOn
-  · simp only [map_eq_pure_bind, bind_assoc]
-    apply bind_congr
-    intro forInStep
-    cases forInStep <;> simp [IterM.forIn_eq]
-  · simp [IterM.forIn_eq]
-  · simp
+  simp only [forIn]
+  rw [forIn'_eq_match_step]
+  rfl
 
 theorem IterM.forM_eq_forIn {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
     [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]

src/Init/Data/Iterators/PostconditionMonad.lean

@@ -45,12 +45,12 @@ Caution: `lift` is not a lawful lift function.
 For example, `pure a : PostconditionT m α` is not the same as
 `PostconditionT.lift (pure a : m α)`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def PostconditionT.lift {α : Type w} {m : Type w → Type w'} [Functor m] (x : m α) :
     PostconditionT m α :=
   ⟨fun _ => True, (⟨·, .intro⟩) <$> x⟩
 
-@[always_inline, inline]
+@[always_inline, inline, expose]
 protected def PostconditionT.pure {m : Type w → Type w'} [Pure m] {α : Type w}
     (a : α) : PostconditionT m α :=
   ⟨fun y => a = y, pure <| ⟨a, rfl⟩⟩
@@ -70,7 +70,7 @@ turning `PostconditionT m` into a functor.
 The postcondition of the `x.map f` states that the return value is the image under `f` of some
 `a : α` satisfying the `x.Property`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 protected def PostconditionT.map {m : Type w → Type w'} [Functor m] {α : Type w} {β : Type w}
     (f : α → β) (x : PostconditionT m α) : PostconditionT m β :=
   ⟨fun b => ∃ a : Subtype x.Property, f a.1 = b,

src/Init/Data/Iterators/ToIterator.lean

@@ -0,0 +1,110 @@
+/-
+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.Consumers
+
+/-!
+This module provides the typeclass `ToIterator`, which is implemented by types that can be
+converted into iterators.
+-/
+
+open Std.Iterators
+
+namespace Std.Iterators
+
+/--
+This typeclass provides an iterator for the given element `x : γ`. Usually, instances are provided
+for all elements of a type `γ`.
+-/
+class ToIterator {γ : Type u} (x : γ) (m : Type w → Type w') (β : outParam (Type w)) where
+  State : Type w
+  iterMInternal : IterM (α := State) m β
+
+/-- Converts `x` into a monadic iterator. -/
+@[always_inline, inline, expose]
+def ToIterator.iterM (x : γ) [ToIterator x m β] : IterM (α := ToIterator.State x m) m β :=
+  ToIterator.iterMInternal (x := x)
+
+/-- Converts `x` into a pure iterator. -/
+@[always_inline, inline, expose]
+def ToIterator.iter (x : γ) [ToIterator x Id β] : Iter (α := ToIterator.State x Id) β :=
+  ToIterator.iterM x |>.toIter
+
+/-- Creates a monadic `ToIterator` instance. -/
+@[always_inline, inline, expose]
+def ToIterator.ofM {x : γ} (State : Type w)
+    (iterM : IterM (α := State) m β) :
+    ToIterator x m β where
+  State := State
+  iterMInternal := iterM
+
+/-- Creates a pure `ToIterator` instance. -/
+@[always_inline, inline, expose]
+def ToIterator.of {x : γ} (State : Type w)
+    (iter : Iter (α := State) β) :
+    ToIterator x Id β where
+  State := State
+  iterMInternal := iter.toIterM
+
+/-!
+## Instance forwarding
+
+If the type defined as `ToIterator.State` implements an iterator typeclass, then this typeclass
+should also be available when the type is syntactically visible as `ToIteratorState`. The following
+instances are responsible for this forwarding.
+-/
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator State m β] :
+    letI i : ToIterator x m β := .ofM State iter
+    Iterator (α := i.State) m β :=
+  inferInstanceAs <| Iterator State m β
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [Finite State m] :
+    letI i : ToIterator x m β := .ofM State iter
+    Finite (α := i.State) m :=
+  inferInstanceAs <| Finite (α := State) m
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorCollect State m n] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorCollect (α := i.State) m n :=
+  inferInstanceAs <| IteratorCollect (α := State) m n
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorCollectPartial State m n] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorCollectPartial (α := i.State) m n :=
+  inferInstanceAs <| IteratorCollectPartial (α := State) m n
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorLoop State m n] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorLoop (α := i.State) m n :=
+  inferInstanceAs <| IteratorLoop (α := State) m n
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorLoopPartial State m n] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorLoopPartial (α := i.State) m n :=
+  inferInstanceAs <| IteratorLoopPartial (α := State) m n
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorSize State m] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorSize (α := i.State) m :=
+  inferInstanceAs <| IteratorSize (α := State) m
+
+instance {x : γ} {State : Type w} {iter}
+    [Iterator (α := State) m β] [IteratorSizePartial State m] :
+    letI i : ToIterator x m β := .ofM State iter
+    IteratorSizePartial (α := i.State) m :=
+  inferInstanceAs <| IteratorSizePartial (α := State) m
+
+end Std.Iterators

src/Init/Data/Range/Polymorphic.lean

@@ -0,0 +1,28 @@
+/-
+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.Range.Polymorphic.Basic
+import Init.Data.Range.Polymorphic.Lemmas
+import Init.Data.Range.Polymorphic.Nat
+import Init.Data.Range.Polymorphic.NatLemmas
+
+/-!
+# Polymorphic ranges
+
+Any type that provides certain typeclasses supports range notation: For example, `2...<5`
+stands for the numbers at least `2` and smaller than `5`. Such ranges support iteration with
+`for .. in` and can be converted into a list with `PRange.toList`. After importing
+`Std.Data.Iterators`, there will also be `PRange.iter`, which provides an iterator over the
+elements of the range.
+
+In order to support ranges of a certain type `α`, multiple instances need to be implemented.
+An example of how this plays out can be found in `Init.Data.Range.Polymorphic.Nat`.
+
+The typeclass system is experimental and will change soon, so at this point it is not recommended
+to provide custom ranges outside of the standard library.
+-/

src/Init/Data/Range/Polymorphic/Basic.lean

@@ -0,0 +1,225 @@
+/-
+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.Range.Polymorphic.RangeIterator
+import Init.Data.Iterators.Combinators.Attach
+
+open Std.Iterators
+
+namespace Std.PRange
+
+/--
+Internal function that constructs an iterator for a `PRange`. This is an internal function.
+Use `PRange.iter` instead, which requires importing `Std.Data.Iterators`.
+-/
+@[always_inline, inline]
+def Internal.iter {sl su α} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    (r : PRange ⟨sl, su⟩ α) : Iter (α := RangeIterator su α) α :=
+  ⟨⟨BoundedUpwardEnumerable.init? r.lower, r.upper⟩⟩
+
+/--
+Returns the elements of the given range as a list in ascending order, given that ranges of the given
+type and shape support this function and the range is finite.
+-/
+@[always_inline, inline]
+def toList {sl su α} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsUpperBound su α]
+    (r : PRange ⟨sl, su⟩ α)
+    [Iterator (RangeIterator su α) Id α] [Finite (RangeIterator su α) Id]
+    [IteratorCollect (RangeIterator su α) Id Id] : List α :=
+  PRange.Internal.iter r |>.toList
+
+/--
+This typeclass provides support for the `PRange.size` function.
+
+The returned size should be equal to the number of elements returned by `toList`. This condition
+is captured by the typeclass `LawfulRangeSize`.
+-/
+class RangeSize (shape : BoundShape) (α : Type u) where
+  /-- Returns the number of elements starting from `init` that satisfy the given upper bound. -/
+  size : (upperBound : Bound shape α) → (init : α) → Nat
+
+/--
+This typeclass ensures that a `RangeSize` instance returns the correct size for all ranges.
+-/
+class LawfulRangeSize (su : BoundShape) (α : Type u) [UpwardEnumerable α]
+    [SupportsUpperBound su α] [RangeSize su α]
+    [LawfulUpwardEnumerable α] [HasFiniteRanges su α] where
+  /-- If the smallest value in the range is beyond the upper bound, the size is zero. -/
+  size_eq_zero_of_not_satisfied (upperBound : Bound su α) (init : α)
+      (h : ¬ SupportsUpperBound.IsSatisfied upperBound init) :
+      RangeSize.size upperBound init = 0
+  /--
+  If the smallest value in the range satisfies the upper bound and has no successor, the size is
+  one.
+  -/
+  size_eq_one_of_succ?_eq_none (upperBound : Bound su α) (init : α)
+      (h : SupportsUpperBound.IsSatisfied upperBound init)
+      (h' : UpwardEnumerable.succ? init = none) :
+      RangeSize.size upperBound init = 1
+  /--
+  If the smallest value in the range satisfies the upper bound and has a successor, the size is
+  one larger than the size of the range starting at the successor. -/
+  size_eq_succ_of_succ?_eq_some (upperBound : Bound su α) (init : α)
+      (h : SupportsUpperBound.IsSatisfied upperBound init)
+      (h' : UpwardEnumerable.succ? init = some a) :
+      RangeSize.size upperBound init = RangeSize.size upperBound a + 1
+
+/--
+Iterators for ranges implementing `RangeSize` support the `size` function.
+-/
+instance [RangeSize su α] [UpwardEnumerable α] [SupportsUpperBound su α] :
+    IteratorSize (RangeIterator su α) Id where
+  size it := match it.internalState.next with
+    | none => pure (.up 0)
+    | some next => pure (.up (RangeSize.size it.internalState.upperBound next))
+
+/--
+Returns the number of elements contained in the given range, given that ranges of the given
+type and shape support this function.
+-/
+@[always_inline, inline]
+def size {sl su α} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsUpperBound su α] (r : PRange ⟨sl, su⟩ α)
+    [IteratorSize (RangeIterator su α) Id] : Nat :=
+  PRange.Internal.iter r |>.size
+
+/--
+Checks whether the range contains any value.
+
+This function returns a meaningful value for all range types defined by the standard library
+and for all range types that satisfy the properties encoded in the `LawfulUpwardEnumerable`,
+`LawfulUpwardEnumerableLowerBound` and `LawfulUpwardEnumerableUpperBound` typeclasses.
+-/
+@[always_inline, inline]
+def isEmpty {sl su α} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsUpperBound su α] (r : PRange ⟨sl, su⟩ α) : Bool :=
+  (BoundedUpwardEnumerable.init? r.lower).all (! SupportsUpperBound.IsSatisfied r.upper ·)
+
+section Iterator
+
+theorem RangeIterator.isPlausibleIndirectOutput_iff {su α}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α] [LawfulUpwardEnumerableUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} {out : α} :
+    it.IsPlausibleIndirectOutput out ↔
+      ∃ n, it.internalState.next.bind (UpwardEnumerable.succMany? n ·) = some out ∧
+        SupportsUpperBound.IsSatisfied it.internalState.upperBound out := by
+  constructor
+  · intro h
+    induction h
+    case direct h =>
+      rw [RangeIterator.isPlausibleOutput_iff] at h
+      refine ⟨0, by simp [h, LawfulUpwardEnumerable.succMany?_zero]⟩
+    case indirect h _ ih =>
+      rw [RangeIterator.isPlausibleSuccessorOf_iff] at h
+      obtain ⟨n, hn⟩ := ih
+      obtain ⟨a, ha, h₁, h₂, h₃⟩ := h
+      refine ⟨n + 1, ?_⟩
+      simp [ha, ← h₃, hn.2, LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?, h₂, hn]
+  · rintro ⟨n, hn, hu⟩
+    induction n generalizing it
+    case zero =>
+      apply Iter.IsPlausibleIndirectOutput.direct
+      rw [RangeIterator.isPlausibleOutput_iff]
+      exact ⟨by simpa [LawfulUpwardEnumerable.succMany?_zero] using hn, hu⟩
+    case succ ih =>
+      cases hn' : it.internalState.next
+      · simp [hn'] at hn
+      rename_i a
+      simp only [hn', Option.bind_some] at hn
+      have hle : UpwardEnumerable.LE a out := ⟨_, hn⟩
+      rw [LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?] at hn
+      cases hn' : UpwardEnumerable.succ? a
+      · simp only [hn', Option.bind_none, reduceCtorEq] at hn
+      rename_i a'
+      simp only [hn', Option.bind_some] at hn
+      specialize ih (it := ⟨some a', it.internalState.upperBound⟩) hn hu
+      refine Iter.IsPlausibleIndirectOutput.indirect ?_ ih
+      rw [RangeIterator.isPlausibleSuccessorOf_iff]
+      refine ⟨a, ‹_›, ?_, hn', rfl⟩
+      apply LawfulUpwardEnumerableUpperBound.isSatisfied_of_le _ a out
+      · exact hu
+      · exact hle
+
+theorem Internal.isPlausibleIndirectOutput_iter_iff {sl su α}
+    [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsLowerBound sl α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableUpperBound su α] [LawfulUpwardEnumerableLowerBound sl α]
+    {r : PRange ⟨sl, su⟩ α} {a : α} :
+    (PRange.Internal.iter r).IsPlausibleIndirectOutput a ↔ a ∈ r := by
+  rw [RangeIterator.isPlausibleIndirectOutput_iff]
+  constructor
+  · rintro ⟨n, hn, hu⟩
+    refine ⟨?_, hu⟩
+    rw [LawfulUpwardEnumerableLowerBound.isSatisfied_iff]
+    cases hr : (PRange.Internal.iter r).internalState.next
+    · simp [hr] at hn
+    · rw [hr, Option.bind_some] at hn
+      exact ⟨_, hr, n, hn⟩
+  · rintro ⟨hl, hu⟩
+    rw [LawfulUpwardEnumerableLowerBound.isSatisfied_iff] at hl
+    obtain ⟨_, hr, n, hn⟩ := hl
+    exact ⟨n, by simp [PRange.Internal.iter, hr, hn], hu⟩
+
+theorem RangeIterator.upwardEnumerableLe_of_isPlausibleIndirectOutput {su α}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α] [LawfulUpwardEnumerableUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} {out : α}
+    (hout : it.IsPlausibleIndirectOutput out) :
+    ∃ a, it.internalState.next = some a ∧ UpwardEnumerable.LE a out := by
+  have ⟨a, ha⟩ := Option.isSome_iff_exists.mp <|
+    RangeIterator.isSome_next_of_isPlausibleIndirectOutput hout
+  refine ⟨a, ha, ?_⟩
+  simp only [isPlausibleIndirectOutput_iff, ha, Option.bind_some, exists_and_right] at hout
+  exact hout.1
+
+@[no_expose]
+instance {sl su α m} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsLowerBound sl α] [SupportsUpperBound su α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    [Monad m] [Finite (RangeIterator su α) Id] :
+    ForIn' m (PRange ⟨sl, su⟩ α) α inferInstance where
+  forIn' r init f := by
+    haveI : MonadLift Id m := ⟨Std.Internal.idToMonad (α := _)⟩
+    haveI := Iter.instForIn' (α := RangeIterator su α) (β := α) (n := m)
+    refine ForIn'.forIn' (α := α) (PRange.Internal.iter r) init (fun a ha acc => f a ?_ acc)
+    simp only [Membership.mem] at ha
+    rwa [PRange.Internal.isPlausibleIndirectOutput_iter_iff] at ha
+
+end Iterator
+
+theorem le_upper_of_mem {sl α} [LE α] [DecidableLE α] [SupportsLowerBound sl α]
+    {a : α} {r : PRange ⟨sl, .closed⟩ α} (h : a ∈ r) : a ≤ r.upper :=
+  h.2
+
+theorem lt_upper_of_mem {sl α} [LT α] [DecidableLT α] [SupportsLowerBound sl α]
+    {a : α} {r : PRange ⟨sl, .open⟩ α} (h : a ∈ r) : a < r.upper :=
+  h.2
+
+theorem lower_le_of_mem {su α} [LE α] [DecidableLE α] [SupportsUpperBound su α]
+    {a : α} {r : PRange ⟨.closed, su⟩ α} (h : a ∈ r) : r.lower ≤ a :=
+  h.1
+
+theorem lower_lt_of_mem {su α} [LT α] [DecidableLT α] [SupportsUpperBound su α]
+    {a : α} {r : PRange ⟨.open, su⟩ α} (h : a ∈ r) : r.lower < a :=
+  h.1
+
+theorem Internal.get_elem_helper_upper_open {sl α} [SupportsLowerBound sl α] [LT α] [DecidableLT α]
+    {a n : α} {r : PRange ⟨sl, .open⟩ α} (h₁ : a ∈ r) (h₂ : r.upper = n) :
+    a < n := h₂ ▸ r.lt_upper_of_mem h₁
+
+macro_rules
+  | `(tactic| get_elem_tactic_extensible) =>
+    `(tactic|
+      first
+        | apply Std.PRange.Internal.get_elem_helper_upper_open ‹_› (by trivial)
+        | done)
+
+end Std.PRange

src/Init/Data/Range/Polymorphic/Lemmas.lean

@@ -0,0 +1,421 @@
+/-
+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
+import Init.Data.Iterators.Lemmas.Consumers.Collect
+import all Init.Data.Range.Polymorphic.PRange
+import all Init.Data.Range.Polymorphic.RangeIterator
+import all Init.Data.Range.Polymorphic.Basic
+import all Init.Data.Iterators.Consumers.Loop
+
+/-!
+# Lemmas about ranges
+
+This file provides lemmas about `Std.PRange`.
+-/
+
+namespace Std.PRange
+open Std.Iterators
+
+variable {shape : RangeShape} {α : Type u}
+
+private theorem Internal.iter_open_eq_iter_closed_of_isSome_succ? {su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [HasFiniteRanges su α]
+    [LawfulUpwardEnumerable α]
+    {lo : Bound .open α} {hi} (h : (UpwardEnumerable.succ? lo).isSome) :
+    Internal.iter (PRange.mk (shape := ⟨.open, su⟩) lo hi) =
+      Internal.iter (PRange.mk (shape := ⟨.closed, su⟩) (UpwardEnumerable.succ? lo |>.get h) hi) := by
+  simp [Internal.iter, BoundedUpwardEnumerable.init?]
+
+private theorem Internal.toList_eq_toList_iter {sl su} [UpwardEnumerable α]
+    [BoundedUpwardEnumerable sl α] [SupportsUpperBound su α] [HasFiniteRanges su α]
+    [LawfulUpwardEnumerable α] {r : PRange ⟨sl, su⟩ α} :
+    r.toList = (Internal.iter r).toList := by
+  rfl
+
+theorem RangeIterator.toList_eq_match {su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [HasFiniteRanges su α]
+    [LawfulUpwardEnumerable α]
+    {it : Iter (α := RangeIterator su α) α} :
+    it.toList =  match it.internalState.next with
+      | none => []
+      | some a => if SupportsUpperBound.IsSatisfied it.internalState.upperBound a then
+          a :: (⟨⟨UpwardEnumerable.succ? a, it.internalState.upperBound⟩⟩ : Iter (α := RangeIterator su α) α).toList
+        else
+          [] := by
+  apply Eq.symm
+  rw [Iter.toList_eq_match_step, RangeIterator.step_eq_step]
+  simp only [RangeIterator.step]
+  split <;> rename_i heq
+  · simp [*]
+  · split <;> rename_i heq' <;> simp [*]
+
+theorem toList_eq_match {sl su} [UpwardEnumerable α] [BoundedUpwardEnumerable sl α]
+    [SupportsUpperBound su α] [HasFiniteRanges su α]
+    [LawfulUpwardEnumerable α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList = match BoundedUpwardEnumerable.init? r.lower with
+      | none => []
+      | some a => if SupportsUpperBound.IsSatisfied r.upper a then
+        a :: (PRange.mk (shape := ⟨.open, su⟩) a r.upper).toList
+      else
+        [] := by
+  rw [Internal.toList_eq_toList_iter, RangeIterator.toList_eq_match]; rfl
+
+theorem toList_open_eq_toList_closed_of_isSome_succ? {su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [HasFiniteRanges su α]
+    [LawfulUpwardEnumerable α]
+    {lo : Bound .open α} {hi} (h : (UpwardEnumerable.succ? lo).isSome) :
+    (PRange.mk (shape := ⟨.open, su⟩) lo hi).toList =
+      (PRange.mk (shape := ⟨.closed, su⟩) (UpwardEnumerable.succ? lo |>.get h) hi).toList := by
+  simp [Internal.toList_eq_toList_iter, Internal.iter_open_eq_iter_closed_of_isSome_succ?, h]
+
+theorem toList_eq_nil_iff {sl su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [HasFiniteRanges su α] [BoundedUpwardEnumerable sl α]
+    [LawfulUpwardEnumerable α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList = [] ↔
+      ¬ (∃ a, BoundedUpwardEnumerable.init? r.lower = some a ∧ SupportsUpperBound.IsSatisfied r.upper a) := by
+  rw [Internal.toList_eq_toList_iter]
+  rw [RangeIterator.toList_eq_match, Internal.iter]
+  simp only
+  split <;> rename_i heq <;> simp [heq]
+
+theorem mem_toList_iff_mem {sl su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α}
+    {a : α} : a ∈ r.toList ↔ a ∈ r := by
+  rw [Internal.toList_eq_toList_iter, Iter.mem_toList_iff_isPlausibleIndirectOutput,
+    Internal.isPlausibleIndirectOutput_iter_iff]
+
+theorem BoundedUpwardEnumerable.Closed.init?_succ [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] {lower lower' : Bound .closed α}
+    (h : UpwardEnumerable.succ? lower = some lower') :
+    BoundedUpwardEnumerable.init? lower' = (BoundedUpwardEnumerable.init? lower).bind UpwardEnumerable.succ? := by
+  cases h : init? lower <;> rename_i ilower <;> cases h' : init? lower' <;> rename_i ilower'
+  · simp
+  · simp [init?] at h
+  · simp [init?] at h'
+  · simp_all [init?]
+
+theorem pairwise_toList_upwardEnumerableLt {sl su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList.Pairwise (fun a b => UpwardEnumerable.LT a b) := by
+  rw [Internal.toList_eq_toList_iter]
+  generalize Internal.iter r = it
+  induction it using Iter.inductSteps with | step it ihy ihs =>
+  rw [RangeIterator.toList_eq_match]
+  repeat' split <;> (try exact .nil; done)
+  rename_i a _ _
+  apply List.Pairwise.cons
+  · intro a' ha
+    rw [Iter.mem_toList_iff_isPlausibleIndirectOutput] at ha
+    replace ha := RangeIterator.upwardEnumerableLe_of_isPlausibleIndirectOutput ha
+    simp only at ha
+    have : UpwardEnumerable.LT a ha.choose := by
+      refine ⟨0, ?_⟩
+      simp only [UpwardEnumerable.succMany?_succ, UpwardEnumerable.succMany?_zero,
+        Option.bind_some]
+      exact ha.choose_spec.1
+    exact UpwardEnumerable.lt_of_lt_of_le this ha.choose_spec.2
+  · apply ihy (out := a)
+    simp_all [RangeIterator.isPlausibleStep_iff, RangeIterator.step]
+
+theorem pairwise_toList_ne {sl su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList.Pairwise (fun a b => a ≠ b) :=
+  List.Pairwise.imp (fun hlt => UpwardEnumerable.ne_of_lt hlt) pairwise_toList_upwardEnumerableLt
+
+theorem pairwise_toList_lt {sl su} [LT α] [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α] [LawfulUpwardEnumerableLT α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList.Pairwise (fun a b => a < b) :=
+  List.Pairwise.imp
+    (fun hlt => (LawfulUpwardEnumerableLT.lt_iff ..).mpr hlt) pairwise_toList_upwardEnumerableLt
+
+theorem pairwise_toList_le {sl su} [LE α] [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α] [LawfulUpwardEnumerableLE α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.toList.Pairwise (fun a b => a ≤ b) :=
+  pairwise_toList_upwardEnumerableLt
+    |> List.Pairwise.imp UpwardEnumerable.le_of_lt
+    |> List.Pairwise.imp (fun hle => (LawfulUpwardEnumerableLE.le_iff ..).mpr hle)
+
+theorem ClosedOpen.mem_succ_iff [UpwardEnumerable α]
+    [LinearlyUpwardEnumerable α] [InfinitelyUpwardEnumerable α] [SupportsUpperBound .open α]
+    [SupportsLowerBound .closed α] [LawfulUpwardEnumerableLowerBound .closed α]
+    [HasFiniteRanges .open α] [LawfulUpwardEnumerable α] [LawfulOpenUpperBound α]
+    {lower : Bound .closed α} {upper : Bound .open α} {a : α} :
+    a ∈ PRange.mk (shape := ⟨.closed, .open⟩) (UpwardEnumerable.succ lower) (UpwardEnumerable.succ upper) ↔
+      ∃ a', a = UpwardEnumerable.succ a' ∧ a' ∈ PRange.mk (shape := ⟨.closed, .open⟩) lower upper := by
+  simp [Membership.mem, LawfulUpwardEnumerableLowerBound.isSatisfied_iff,
+    BoundedUpwardEnumerable.init?, LawfulOpenUpperBound.isSatisfied_iff_le]
+  rw [← Option.some_get (InfinitelyUpwardEnumerable.isSome_succ? _)]
+  simp only [Option.some.injEq, ← UpwardEnumerable.succ.eq_def]
+  simp
+  constructor
+  · rintro ⟨⟨n, hn⟩, h⟩
+    rw [UpwardEnumerable.succMany?_eq_some_iff_succMany, ← UpwardEnumerable.succMany_one,
+      ← UpwardEnumerable.succMany_add, Nat.add_comm, UpwardEnumerable.succMany_add,
+      UpwardEnumerable.succMany_one] at hn
+    rw [← hn]
+    refine ⟨UpwardEnumerable.succMany n lower, rfl, ?_, ?_⟩
+    · exact ⟨n, by simp [UpwardEnumerable.succMany_eq_get]⟩
+    · obtain ⟨m, hm⟩ := h
+      refine ⟨m, ?_⟩
+      rw [UpwardEnumerable.succMany?_eq_some_iff_succMany] at hm ⊢
+      rwa [← hn, ← UpwardEnumerable.succMany_one, ← UpwardEnumerable.succMany_add, Nat.add_comm,
+        UpwardEnumerable.succMany_add, UpwardEnumerable.succMany_one,
+        UpwardEnumerable.succ_eq_succ_iff] at hm
+  · rintro ⟨a', rfl, hl, hu⟩
+    simp [UpwardEnumerable.succ_le_succ_iff, UpwardEnumerable.succ_lt_succ_iff]
+    exact ⟨hl, hu⟩
+
+private theorem eq_of_pairwise_lt_of_mem_iff_mem {lt : α → α → Prop} [asymm : Asymm lt]
+    {l l' : List α} (hl : l.Pairwise lt) (hl' : l'.Pairwise lt)
+    (h : ∀ a, a ∈ l ↔ a ∈ l') : l = l' := by
+  induction l generalizing l'
+  · cases l'
+    · rfl
+    · rename_i x xs
+      specialize h x
+      simp at h
+  · rename_i x xs ih
+    cases l'
+    · specialize h x
+      simp at h
+    · have hx := (h x).mp (List.mem_cons_self)
+      cases List.mem_cons.mp hx
+      · rename_i y ys heq
+        cases heq
+        simp only [List.cons.injEq, true_and]
+        apply ih hl.tail hl'.tail
+        intro a
+        specialize h a
+        constructor
+        · intro haxs
+          replace h := h.mp (List.mem_cons_of_mem _ haxs)
+          cases List.mem_cons.mp h
+          · rename_i heq
+            cases heq
+            simp only [List.pairwise_cons] at hl
+            have := hl.1 x haxs
+            cases Asymm.asymm _ _ this this
+          · simp [*]
+        · intro hays
+          replace h := h.mpr (List.mem_cons_of_mem _ hays)
+          cases List.mem_cons.mp h
+          · rename_i heq
+            cases heq
+            simp only [List.pairwise_cons] at hl'
+            have := hl'.1 x hays
+            cases Asymm.asymm _ _ this this
+          · simp [*]
+      · rename_i y ys hx
+        simp only [List.pairwise_cons] at hl'
+        have hlt := hl'.1 _ hx
+        have hmem : y ∈ x :: xs := (h y).mpr List.mem_cons_self
+        cases List.mem_cons.mp hmem
+        · rename_i heq
+          cases heq
+          cases Asymm.asymm _ _ hlt hlt
+        · simp only [List.pairwise_cons] at hl
+          have hgt := hl.1 y ‹_›
+          cases Asymm.asymm _ _ hlt hgt
+
+theorem ClosedOpen.toList_succ_succ_eq_map [UpwardEnumerable α] [SupportsLowerBound .closed α]
+    [LinearlyUpwardEnumerable α] [InfinitelyUpwardEnumerable α] [SupportsUpperBound .open α]
+    [HasFiniteRanges .open α] [LawfulUpwardEnumerable α] [LawfulOpenUpperBound α]
+    [LawfulUpwardEnumerableLowerBound .closed α] [LawfulUpwardEnumerableUpperBound .open α]
+    {lower : Bound .closed α} {upper : Bound .open α} :
+    (PRange.mk (shape := ⟨.closed, .open⟩) (UpwardEnumerable.succ lower) (UpwardEnumerable.succ upper)).toList =
+      (PRange.mk (shape := ⟨.closed, .open⟩) lower upper).toList.map UpwardEnumerable.succ := by
+  apply eq_of_pairwise_lt_of_mem_iff_mem (lt := UpwardEnumerable.LT) (asymm := ?_)
+  · apply pairwise_toList_upwardEnumerableLt
+  · apply List.Pairwise.map (R := UpwardEnumerable.LT) (S := UpwardEnumerable.LT)
+    · intro a b
+      exact UpwardEnumerable.succ_lt_succ_iff.mpr
+    · apply pairwise_toList_upwardEnumerableLt
+  · simp only [List.mem_map, mem_toList_iff_mem]
+    intro a
+    rw [mem_succ_iff]
+    constructor
+    · rintro ⟨a, rfl, h⟩
+      exact ⟨a, h, rfl⟩
+    · rintro ⟨a, h, h'⟩
+      exact ⟨_, h'.symm, h⟩
+  · exact ⟨fun _ _ => UpwardEnumerable.not_gt_of_lt⟩
+
+private theorem Internal.forIn'_eq_forIn'_iter [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α}
+    {γ : Type u} {init : γ} {m : Type u → Type w} [Monad m] {f : (a : α) → a ∈ r → γ → m (ForInStep γ)} :
+    haveI := Iter.instForIn' (α := RangeIterator su α) (β := α) (n := m)
+    ForIn'.forIn' r init f =
+      ForIn'.forIn' (Internal.iter r) init (fun a ha acc => f a (Internal.isPlausibleIndirectOutput_iter_iff.mp ha) acc) := by
+  rfl
+
+theorem forIn'_eq_forIn'_toList [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α}
+    {γ : Type u} {init : γ} {m : Type u → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → a ∈ r → γ → m (ForInStep γ)} :
+    ForIn'.forIn' r init f =
+      ForIn'.forIn' r.toList init (fun a ha acc => f a (mem_toList_iff_mem.mp ha) acc) := by
+  simp [Internal.forIn'_eq_forIn'_iter, Internal.toList_eq_toList_iter,
+    Iter.forIn'_eq_forIn'_toList]
+
+theorem forIn'_toList_eq_forIn' [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α}
+    {γ : Type u} {init : γ} {m : Type u → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → _ → γ → m (ForInStep γ)} :
+    ForIn'.forIn' r.toList init f =
+      ForIn'.forIn' r init (fun a ha acc => f a (mem_toList_iff_mem.mpr ha) acc) := by
+  simp [forIn'_eq_forIn'_toList]
+
+theorem mem_of_mem_open [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    [SupportsLowerBound .open α] [LawfulUpwardEnumerableLowerBound .open α]
+    {r : PRange ⟨sl, su⟩ α} {a b : α}
+    (hrb : SupportsLowerBound.IsSatisfied r.lower b)
+    (hmem : a ∈ PRange.mk (shape := ⟨.open, su⟩) b r.upper) :
+    a ∈ r := by
+  refine ⟨?_, hmem.2⟩
+  have := hmem.1
+  simp only [LawfulUpwardEnumerableLowerBound.isSatisfied_iff,
+    BoundedUpwardEnumerable.init?] at this hrb ⊢
+  obtain ⟨init, hi⟩ := hrb
+  obtain ⟨b', hb'⟩ := this
+  refine ⟨init, hi.1, UpwardEnumerable.le_trans hi.2 (UpwardEnumerable.le_trans ?_ hb'.2)⟩
+  exact UpwardEnumerable.le_of_succ?_eq hb'.1
+
+theorem SupportsLowerBound.isSatisfied_init? {sl} [UpwardEnumerable α]
+    [SupportsLowerBound sl α] [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α]
+    {bound : Bound sl α} {a : α} (h : BoundedUpwardEnumerable.init? bound = some a) :
+    SupportsLowerBound.IsSatisfied bound a := by
+  simp only [LawfulUpwardEnumerableLowerBound.isSatisfied_iff]
+  exact ⟨a, h, UpwardEnumerable.le_refl _⟩
+
+theorem forIn'_eq_match {sl su} [UpwardEnumerable α]
+    [SupportsUpperBound su α] [SupportsLowerBound sl α] [HasFiniteRanges su α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerable α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    [SupportsLowerBound .open α] [LawfulUpwardEnumerableLowerBound .open α]
+    {r : PRange ⟨sl, su⟩ α}
+    {γ : Type u} {init : γ} {m : Type u → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → _ → γ → m (ForInStep γ)} :
+    ForIn'.forIn' r init f = match hi : BoundedUpwardEnumerable.init? r.lower with
+      | none => pure init
+      | some a => if hu : SupportsUpperBound.IsSatisfied r.upper a then do
+        match ← f a ⟨SupportsLowerBound.isSatisfied_init? hi, hu⟩ init with
+        | .yield c =>
+          ForIn'.forIn' (α := α) (β := γ) (PRange.mk (shape := ⟨.open, su⟩) a r.upper) c
+            (fun a ha acc => f a (mem_of_mem_open (SupportsLowerBound.isSatisfied_init? hi) ha) acc)
+        | .done c => return c
+      else
+        return init := by
+  rw [Internal.forIn'_eq_forIn'_iter, Iter.forIn'_eq_match_step]
+  simp only [RangeIterator.step_eq_step, RangeIterator.step, Internal.iter]
+  apply Eq.symm
+  split <;> rename_i heq
+  · simp [heq]
+  · simp only [heq]
+    split
+    · simp only
+      apply bind_congr
+      intro step
+      split
+      · simp [Internal.forIn'_eq_forIn'_iter, Internal.iter, BoundedUpwardEnumerable.init?]
+      · simp
+    · simp
+
+instance {su} [UpwardEnumerable α] [SupportsUpperBound su α] [RangeSize su α]
+    [LawfulUpwardEnumerable α] [HasFiniteRanges su α] [LawfulRangeSize su α] :
+    LawfulIteratorSize (RangeIterator su α) where
+  size_eq_size_toArray {it} := by
+    simp only [Iter.size, IteratorSize.size, Iter.toIterM]
+    split <;> rename_i heq
+    · rw [Iter.toArray_eq_match_step, RangeIterator.step_eq_step]
+      simp [RangeIterator.step, heq]
+    · rename_i next
+      simp only [Id.run_pure]
+      induction h : RangeSize.size it.internalState.upperBound _ generalizing it next
+      · rw [Iter.toArray_eq_match_step, RangeIterator.step_eq_step]
+        simp only [RangeIterator.step, heq]
+        by_cases h : SupportsUpperBound.IsSatisfied it.internalState.upperBound next
+        · exfalso
+          cases hn : UpwardEnumerable.succ? next
+          · have := LawfulRangeSize.size_eq_one_of_succ?_eq_none _ _ h hn
+            simp [*] at this
+          · have := LawfulRangeSize.size_eq_succ_of_succ?_eq_some _ _ h hn
+            simp [*] at this
+        · simp [h]
+      · rename_i ih
+        by_cases h' : SupportsUpperBound.IsSatisfied it.internalState.upperBound next
+        · rw [Iter.toArray_eq_match_step, RangeIterator.step_eq_step]
+          simp only [RangeIterator.step, heq, h', ↓reduceIte, Array.size_append, List.size_toArray,
+            List.length_cons, List.length_nil, Nat.zero_add]
+          cases hn : UpwardEnumerable.succ? next
+          · rw [Iter.toArray_eq_match_step, RangeIterator.step_eq_step]
+            simp only [RangeIterator.step, Array.size_empty]
+            simp_all [LawfulRangeSize.size_eq_one_of_succ?_eq_none _ _ h' hn]
+          · rename_i next'
+            have := LawfulRangeSize.size_eq_succ_of_succ?_eq_some _ _ h' hn
+            simp only [this, Nat.add_right_cancel_iff] at h
+            specialize ih (it := ⟨⟨some next', it.internalState.upperBound⟩⟩) next' rfl h
+            rw [ih, Nat.add_comm]
+        · have := LawfulRangeSize.size_eq_zero_of_not_satisfied _ _ h'
+          simp [*] at this
+
+theorem isEmpty_iff_forall_not_mem {sl su} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    [BoundedUpwardEnumerable sl α] [SupportsLowerBound sl α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerableLowerBound sl α] [LawfulUpwardEnumerableUpperBound su α]
+    {r : PRange ⟨sl, su⟩ α} :
+    r.isEmpty ↔ ∀ a, ¬ a ∈ r := by
+  simp only [PRange.isEmpty, Option.all_eq_true_iff_get]
+  constructor
+  · intro h a hmem
+    have hl := hmem.1
+    have hu := hmem.2
+    simp only [LawfulUpwardEnumerableLowerBound.isSatisfied_iff] at hl
+    obtain ⟨init, hi, hl⟩ := hl
+    have : SupportsUpperBound.IsSatisfied r.upper init :=
+      LawfulUpwardEnumerableUpperBound.isSatisfied_of_le r.upper _ a hu hl
+    simp only [Option.eq_some_iff_get_eq] at hi
+    specialize h hi.choose
+    simp [hi.choose_spec, this] at h
+  · intro h hi
+    simp only [Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not]
+    intro hu
+    have hl := SupportsLowerBound.isSatisfied_init? (bound := r.lower)
+      (Option.some_get hi).symm
+    exact h ((BoundedUpwardEnumerable.init? r.lower).get hi) ⟨hl, hu⟩
+
+end Std.PRange

src/Init/Data/Range/Polymorphic/Nat.lean

@@ -0,0 +1,230 @@
+/-
+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.Nat.Lemmas
+import Init.Data.Range.Polymorphic.Basic
+
+namespace Std.PRange
+
+instance : UpwardEnumerable Nat where
+  succ? n := some (n + 1)
+  succMany? k n := some (n + k)
+
+instance : Least? Nat where
+  least? := some 0
+
+instance : LawfulUpwardEnumerableLE Nat where
+  le_iff a b := by
+    constructor
+    · intro h
+      exact ⟨b - a, by simp [UpwardEnumerable.succMany?, Nat.add_sub_cancel' h]⟩
+    · rintro ⟨n, hn⟩
+      simp only [UpwardEnumerable.succMany?, Option.some.injEq] at hn
+      rw [← hn]
+      exact Nat.le_add_right _ _
+
+instance : LawfulUpwardEnumerableLT Nat where
+  lt_iff a b := by
+    constructor
+    · intro h
+      refine ⟨b - a - 1, ?_⟩
+      simp [UpwardEnumerable.succMany?]
+      rw [Nat.sub_add_cancel, Nat.add_sub_cancel']
+      · exact Nat.le_of_lt h
+      · rwa [Nat.lt_iff_add_one_le, ← Nat.le_sub_iff_add_le'] at h
+        exact Nat.le_trans (Nat.le_succ _) h
+    · rintro ⟨n, hn⟩
+      simp only [UpwardEnumerable.succMany?, Option.some.injEq] at hn
+      rw [← hn]
+      apply Nat.lt_add_of_pos_right
+      apply Nat.zero_lt_succ
+
+instance : LawfulUpwardEnumerable Nat where
+  succMany?_zero := by simp [UpwardEnumerable.succMany?]
+  succMany?_succ := by simp [UpwardEnumerable.succMany?, UpwardEnumerable.succ?, Nat.add_assoc]
+  ne_of_lt a b hlt := by
+    rw [← LawfulUpwardEnumerableLT.lt_iff] at hlt
+    exact Nat.ne_of_lt hlt
+
+instance : LawfulUpwardEnumerableLowerBound .closed Nat where
+  isSatisfied_iff a l := by
+    simp [← LawfulUpwardEnumerableLE.le_iff, BoundedUpwardEnumerable.init?,
+      SupportsLowerBound.IsSatisfied]
+
+instance : LawfulUpwardEnumerableUpperBound .closed Nat where
+  isSatisfied_of_le u a b hub hab := by
+    rw [← LawfulUpwardEnumerableLE.le_iff] at hab
+    exact Nat.le_trans hab hub
+
+instance : LawfulUpwardEnumerableLowerBound .open Nat where
+  isSatisfied_iff a l := by
+    simp [← LawfulUpwardEnumerableLE.le_iff, BoundedUpwardEnumerable.init?,
+      SupportsLowerBound.IsSatisfied, UpwardEnumerable.succ?, Nat.lt_iff_add_one_le]
+
+instance : LawfulUpwardEnumerableUpperBound .open Nat where
+  isSatisfied_of_le u a b hub hab := by
+    rw [← LawfulUpwardEnumerableLE.le_iff] at hab
+    exact Nat.lt_of_le_of_lt hab hub
+
+instance : LawfulUpwardEnumerableLowerBound .unbounded Nat where
+  isSatisfied_iff a l := by
+    simp [← LawfulUpwardEnumerableLE.le_iff, BoundedUpwardEnumerable.init?,
+      SupportsLowerBound.IsSatisfied, Least?.least?]
+
+instance : LawfulUpwardEnumerableUpperBound .unbounded Nat where
+  isSatisfied_of_le _ _ _ _ _ := .intro
+
+instance : LinearlyUpwardEnumerable Nat where
+  eq_of_succ?_eq a b := by simp [UpwardEnumerable.succ?]
+
+instance : InfinitelyUpwardEnumerable Nat where
+  isSome_succ? a := by simp [UpwardEnumerable.succ?]
+
+private def rangeRev (k : Nat) :=
+  match k with
+  | 0 => []
+  | k + 1 => k :: rangeRev k
+
+private theorem mem_rangeRev {k l : Nat} (h : l < k) : l ∈ rangeRev k := by
+  induction k
+  case zero => cases h
+  case succ k ih =>
+    rw [rangeRev]
+    by_cases hl : l = k
+    · simp [hl]
+    · apply List.mem_cons_of_mem
+      exact ih (Nat.lt_of_le_of_ne (Nat.le_of_lt_succ h) hl)
+
+@[no_expose]
+instance : HasFiniteRanges .closed Nat where
+  mem_of_satisfiesUpperBound upperBound := by
+    refine ⟨rangeRev (upperBound + 1), fun a h => ?_⟩
+    simp only [SupportsUpperBound.IsSatisfied] at h
+    exact mem_rangeRev (Nat.lt_succ_of_le h)
+
+@[no_expose]
+instance : HasFiniteRanges .open Nat where
+  mem_of_satisfiesUpperBound upperBound := by
+    refine ⟨rangeRev (upperBound + 1), fun a h => ?_⟩
+    simp only [SupportsUpperBound.IsSatisfied] at h
+    apply mem_rangeRev
+    exact Nat.lt_succ_of_lt h
+
+instance : RangeSize .closed Nat where
+  size bound a := bound + 1 - a
+
+instance : RangeSize .open Nat where
+  size bound a := bound - a
+
+instance : LawfulRangeSize .closed Nat where
+  size_eq_zero_of_not_satisfied upperBound init hu := by
+    simp only [SupportsUpperBound.IsSatisfied, RangeSize.size] at hu ⊢
+    omega
+  size_eq_one_of_succ?_eq_none upperBound init hu h := by
+    simp only [UpwardEnumerable.succ?] at h
+    cases h
+  size_eq_succ_of_succ?_eq_some upperBound init hu h := by
+    simp only [SupportsUpperBound.IsSatisfied, RangeSize.size, UpwardEnumerable.succ?,
+      Option.some.injEq] at hu h ⊢
+    omega
+
+instance : LawfulRangeSize .open Nat where
+  size_eq_zero_of_not_satisfied upperBound init hu := by
+    simp only [SupportsUpperBound.IsSatisfied, RangeSize.size] at hu ⊢
+    omega
+  size_eq_one_of_succ?_eq_none upperBound init hu h := by
+    simp only [UpwardEnumerable.succ?] at h
+    cases h
+  size_eq_succ_of_succ?_eq_some upperBound init hu h := by
+    simp only [SupportsUpperBound.IsSatisfied, RangeSize.size, UpwardEnumerable.succ?,
+      Option.some.injEq] at hu h ⊢
+    omega
+
+instance : ClosedOpenIntersection ⟨.open, .open⟩ Nat where
+  intersection r s := PRange.mk (max (r.lower + 1) s.lower) (min r.upper s.upper)
+
+example (h : b + 1 ≤ a) : b < a := by omega
+
+instance : LawfulClosedOpenIntersection ⟨.open, .open⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [ClosedOpenIntersection.intersection, Membership.mem, SupportsLowerBound.IsSatisfied,
+      SupportsUpperBound.IsSatisfied, Nat.max_le, Nat.lt_min, Bound]
+    omega
+
+instance : ClosedOpenIntersection ⟨.open, .closed⟩ Nat where
+  intersection r s := PRange.mk (max (r.lower + 1) s.lower) (min (r.upper + 1) s.upper)
+
+instance : LawfulClosedOpenIntersection ⟨.open, .closed⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [ClosedOpenIntersection.intersection, Membership.mem, SupportsLowerBound.IsSatisfied,
+      SupportsUpperBound.IsSatisfied, Nat.max_le, Nat.lt_min, Bound]
+    omega
+
+instance : ClosedOpenIntersection ⟨.open, .unbounded⟩ Nat where
+  intersection r s := PRange.mk (max (r.lower + 1) s.lower) s.upper
+
+instance : LawfulClosedOpenIntersection ⟨.open, .unbounded⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [Membership.mem, SupportsLowerBound.IsSatisfied, Bound,
+      ClosedOpenIntersection.intersection, Nat.max_le, SupportsUpperBound.IsSatisfied, and_true]
+    omega
+
+instance : ClosedOpenIntersection ⟨.closed, .open⟩ Nat where
+  intersection r s := PRange.mk (max r.lower s.lower) (min r.upper s.upper)
+
+instance : LawfulClosedOpenIntersection ⟨.closed, .open⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [ClosedOpenIntersection.intersection, Membership.mem, SupportsLowerBound.IsSatisfied,
+      SupportsUpperBound.IsSatisfied, Nat.max_le, Nat.lt_min, Bound]
+    omega
+
+instance : ClosedOpenIntersection ⟨.closed, .closed⟩ Nat where
+  intersection r s := PRange.mk (max r.lower s.lower) (min (r.upper + 1) s.upper)
+
+instance : LawfulClosedOpenIntersection ⟨.closed, .closed⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [ClosedOpenIntersection.intersection, Membership.mem, SupportsLowerBound.IsSatisfied,
+      SupportsUpperBound.IsSatisfied, Nat.max_le, Nat.lt_min, Bound]
+    omega
+
+instance : ClosedOpenIntersection ⟨.closed, .unbounded⟩ Nat where
+  intersection r s := PRange.mk (max r.lower s.lower) s.upper
+
+instance : LawfulClosedOpenIntersection ⟨.closed, .unbounded⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [Membership.mem, SupportsLowerBound.IsSatisfied, Bound,
+      ClosedOpenIntersection.intersection, Nat.max_le, SupportsUpperBound.IsSatisfied, and_true]
+    omega
+
+instance : ClosedOpenIntersection ⟨.unbounded, .open⟩ Nat where
+  intersection r s := PRange.mk s.lower (min r.upper s.upper)
+
+instance : LawfulClosedOpenIntersection ⟨.unbounded, .open⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [Membership.mem, SupportsLowerBound.IsSatisfied, Bound,
+      ClosedOpenIntersection.intersection, SupportsUpperBound.IsSatisfied, true_and]
+    omega
+
+instance : ClosedOpenIntersection ⟨.unbounded, .closed⟩ Nat where
+  intersection r s := PRange.mk s.lower (min (r.upper + 1) s.upper)
+
+instance : LawfulClosedOpenIntersection ⟨.unbounded, .closed⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp only [Membership.mem, SupportsLowerBound.IsSatisfied, Bound,
+      ClosedOpenIntersection.intersection, SupportsUpperBound.IsSatisfied, true_and]
+    omega
+
+instance : ClosedOpenIntersection ⟨.unbounded, .unbounded⟩ Nat where
+  intersection _ s := s
+
+instance : LawfulClosedOpenIntersection ⟨.unbounded, .unbounded⟩ Nat where
+  mem_intersection_iff {a r s} := by
+    simp [Membership.mem, SupportsLowerBound.IsSatisfied, Bound,
+      ClosedOpenIntersection.intersection, SupportsUpperBound.IsSatisfied]
+
+end Std.PRange

src/Init/Data/Range/Polymorphic/NatLemmas.lean

@@ -0,0 +1,23 @@
+/-
+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.Range.Polymorphic.Nat
+import Init.Data.Range.Polymorphic.Lemmas
+
+namespace Std.PRange.Nat
+
+theorem succ_eq {n : Nat} : UpwardEnumerable.succ n = n + 1 :=
+  rfl
+
+theorem ClosedOpen.toList_succ_succ  {m n : Nat} :
+    (PRange.mk (shape := ⟨.closed, .open⟩) (m+1) (n+1)).toList =
+      (PRange.mk (shape := ⟨.closed, .open⟩) m n).toList.map (· + 1) := by
+  simp only [← succ_eq]
+  rw [Std.PRange.ClosedOpen.toList_succ_succ_eq_map]
+
+end Std.PRange.Nat

src/Init/Data/Range/Polymorphic/PRange.lean

@@ -0,0 +1,324 @@
+/-
+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.Core
+import Init.Data.Range.Polymorphic.UpwardEnumerable
+
+namespace Std.PRange
+
+/--
+The shape of a range's upper or lower bound: `open`, `closed` or `unbounded`.
+-/
+inductive BoundShape where
+  /--
+  An open upper (or lower) bound of this shape requires elements of a range to be less than
+  (or greater than) the bound, excluding the bound itself.
+  -/
+  | «open» : BoundShape
+  /--
+  A closed upper (or lower) bound of this shape requires elements of a range to be less than or equal
+  (or greater than or equal) to the bound.
+  -/
+  | closed : BoundShape
+  /--
+  This bound shape signifies the absence of a range bound, so that the range is unbounded in at
+  least one direction.
+  -/
+  | unbounded : BoundShape
+
+/-- The shape of a range, consisting of the shape of its upper and lower bounds. -/
+structure RangeShape where
+  /-- The shape of the range's lower bound. -/
+  lower : BoundShape
+  /-- The shape of the range's upper bound. -/
+  upper : BoundShape
+
+/--
+An upper or lower bound in `α` of the given shape.
+-/
+abbrev Bound (shape : BoundShape) (α : Type u) : Type u :=
+  match shape with
+  | .open | .closed => α
+  | .unbounded => PUnit
+
+/--
+A range of elements of some type `α`. It is characterized by its upper and lower bounds, which
+may be inclusive, exclusive or absent.
+
+* `a...=b` is the range of elements greater than or equal to `a` and less than or equal to `b`.
+* `a<...=b` is the range of elements greater than `a` and less than or equal to `b`.
+* `a...b` or `a...<b` is the range of elements greater than or equal to `a` and less than `b`.
+* `a<...b` or `a<...<b` is the range of elements greater than `a` and less than `b`.
+* `*...=b` is the range of elements less than or equal to `b`.
+* `*...b` or `*...<b` is the range of elements less than `b`.
+* `a...*` is the range of elements greater than or equal to `a`.
+* `a<...*` is the range of elements greater than `a`.
+* `*...*` contains all elements of `α`.
+-/
+structure _root_.Std.PRange (shape : RangeShape) (α : Type u) where
+  /-- The lower bound of the range. -/
+  lower : Bound shape.lower α
+  /-- The upper bound of the range. -/
+  upper : Bound shape.upper α
+
+/-- `a...*` is the range of elements greater than or equal to `a`. See also `Std.PRange`. -/
+syntax:max (term "...*") : term
+/-- `*...*` is the range that is unbounded in both directions. See also `Std.PRange`. -/
+syntax:max ("*...*") : term
+/-- `a<...*` is the range of elements greater than `a`. See also `Std.PRange`. -/
+syntax:max (term "<...*") : term
+/--
+`a...<b` is the range of elements greater than or equal to `a` and less than `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "...<" term) : term
+/--
+`a...b` is the range of elements greater than or equal to `a` and less than `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "..." term) : term
+/-- `*...<b` is the range of elements less than `b`. See also `Std.PRange`. -/
+syntax:max ("*...<" term) : term
+/-- `*...b` is the range of elements less than `b`. See also `Std.PRange`. -/
+syntax:max ("*..." term) : term
+/--
+`a<...<b` is the range of elements greater than `a` and less than `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "<...<" term) : term
+/--
+`a<...b` is the range of elements greater than `a` and less than `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "<..." term) : term
+/--
+`a...=b` is the range of elements greater than or equal to `a` and less than or equal to `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "...=" term) : term
+/-- `*...=b` is the range of elements less than or equal to `b`. See also `Std.PRange`. -/
+syntax:max ("*...=" term) : term
+/--
+`a<...=b` is the range of elements greater than `a` and less than or equal to `b`.
+See also `Std.PRange`.
+-/
+syntax:max (term "<...=" term) : term
+
+macro_rules
+  | `($a...=$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.closed BoundShape.closed) $a $b)
+  | `(*...=$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.unbounded BoundShape.closed) PUnit.unit $b)
+  | `($a...*) => ``(PRange.mk (shape := RangeShape.mk BoundShape.closed BoundShape.unbounded) $a PUnit.unit)
+  | `(*...*) => ``(PRange.mk (shape := RangeShape.mk BoundShape.unbounded BoundShape.unbounded) PUnit.unit PUnit.unit)
+  | `($a<...=$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.open BoundShape.closed) $a $b)
+  | `($a<...*) => ``(PRange.mk (shape := RangeShape.mk BoundShape.open BoundShape.unbounded) $a PUnit.unit)
+  | `($a...<$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.closed BoundShape.open) $a $b)
+  | `($a...$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.closed BoundShape.open) $a $b)
+  | `(*...<$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.unbounded BoundShape.open) PUnit.unit $b)
+  | `(*...$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.unbounded BoundShape.open) PUnit.unit $b)
+  | `($a<...<$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.open BoundShape.open) $a $b)
+  | `($a<...$b) => ``(PRange.mk (shape := RangeShape.mk BoundShape.open BoundShape.open) $a $b)
+
+/--
+This typeclass provides decidable lower bound checks of the given shape.
+
+Instances are automatically provided in the following cases:
+
+* `shape` is `open` and there is an `LT α` instance
+* `shape` is `closed` and there is an `LE α` instance
+* `shape` is `.unbounded`
+-/
+class SupportsLowerBound (shape : BoundShape) (α : Type u) where
+  IsSatisfied : Bound shape α → α → Prop
+  decidableSatisfiesLowerBound : DecidableRel IsSatisfied := by infer_instance
+
+instance : SupportsLowerBound .unbounded α where
+  IsSatisfied _ _ := True
+
+/--
+This typeclass provides decidable upper bound checks of the given shape.
+
+Instances are automatically provided in the following cases:
+
+* `shape` is `open` and there is an `LT α` instance
+* `shape` is `closed` and there is an `LE α` instance
+* `shape` is `.unbounded`
+-/
+class SupportsUpperBound (shape : BoundShape) (α : Type u) where
+  IsSatisfied : Bound shape α → α → Prop
+  decidableSatisfiesUpperBound : DecidableRel IsSatisfied := by infer_instance
+
+instance {α} : SupportsUpperBound .unbounded α where
+  IsSatisfied _ _ := True
+
+instance {shape α} [i : SupportsLowerBound shape α] : DecidableRel i.IsSatisfied :=
+  i.decidableSatisfiesLowerBound
+
+instance {shape α} [i : SupportsUpperBound shape α] : DecidableRel i.IsSatisfied :=
+  i.decidableSatisfiesUpperBound
+
+instance {sl su α} [SupportsLowerBound sl α] [SupportsUpperBound su α] :
+    Membership α (PRange ⟨sl, su⟩ α) where
+  mem r a := SupportsLowerBound.IsSatisfied r.lower a ∧ SupportsUpperBound.IsSatisfied r.upper a
+
+instance {sl su α a} [SupportsLowerBound sl α] [SupportsUpperBound su α] (r : PRange ⟨sl, su⟩ α) :
+    Decidable (a ∈ r) :=
+  inferInstanceAs <| Decidable (_ ∧ _)
+
+/--
+This typeclass ensures that ranges with the given shape of upper bounds are always finite.
+This is a prerequisite for many functions and instances, such as `PRange.toList` or `ForIn'`.
+-/
+class HasFiniteRanges (shape α) [SupportsUpperBound shape α] : Prop where
+  mem_of_satisfiesUpperBound (u : Bound shape α) :
+    ∃ enumeration : List α, (a : α) → SupportsUpperBound.IsSatisfied u a → a ∈ enumeration
+
+/--
+This typeclass will usually be used together with `UpwardEnumerable α`. It provides the starting
+point from which to enumerate all the values above the given lower bound.
+
+Instances are automatically generated in the following cases:
+
+* `lowerBoundShape` is `.closed`
+* `lowerBoundShape` is `.open` and there is an `UpwardEnumerable α` instance
+* `lowerBoundShape` is `.unbounded` and there is a `Least? α` instance
+-/
+class BoundedUpwardEnumerable (lowerBoundShape : BoundShape) (α : Type u) where
+  init? : Bound lowerBoundShape α → Option α
+
+/--
+This typeclass ensures that the lower bound predicate from `SupportsLowerBound sl α`
+can be characterized in terms of `UpwardEnumerable α` and `BoundedUpwardEnumerable sl α`.
+-/
+class LawfulUpwardEnumerableLowerBound (sl α) [UpwardEnumerable α]
+    [SupportsLowerBound sl α] [BoundedUpwardEnumerable sl α] where
+  /--
+  An element `a` satisfies the lower bound `l` if and only if it is
+  `BoundedUpwardEnumerable.init? l` or one of its transitive successors.
+  -/
+  isSatisfied_iff (a : α) (l : Bound sl α) :
+    SupportsLowerBound.IsSatisfied l a ↔
+      ∃ init, BoundedUpwardEnumerable.init? l = some init ∧ UpwardEnumerable.LE init a
+
+/--
+This typeclass ensures that if `b` is a transitive successor of `a` and `b` satisfies an upper bound
+of the given shape, then `a` also satisfies the upper bound.
+-/
+class LawfulUpwardEnumerableUpperBound (su α) [UpwardEnumerable α] [SupportsUpperBound su α] where
+  /--
+  If `b` is a transitive successor of `a` and `b` satisfies a certain upper bound, then
+  `a` also satisfies the upper bound.
+  -/
+  isSatisfied_of_le (u : Bound su α) (a b : α) :
+    SupportsUpperBound.IsSatisfied u b → UpwardEnumerable.LE a b → SupportsUpperBound.IsSatisfied u a
+
+theorem LawfulUpwardEnumerableLowerBound.isSatisfied_of_le [SupportsLowerBound sl α]
+    [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    [BoundedUpwardEnumerable sl α] [LawfulUpwardEnumerableLowerBound sl α]
+    (l : Bound sl α) (a b : α)
+    (ha : SupportsLowerBound.IsSatisfied l a) (hle : UpwardEnumerable.LE a b) :
+    SupportsLowerBound.IsSatisfied l b := by
+  rw [LawfulUpwardEnumerableLowerBound.isSatisfied_iff] at ⊢ ha
+  obtain ⟨init, hi, ha⟩ := ha
+  exact ⟨init, hi, UpwardEnumerable.le_trans ha hle⟩
+
+/--
+This typeclass ensures that `SupportsUpperBound .closed α` and `UpwardEnumerable α` instances
+are compatible.
+-/
+class LawfulClosedUpperBound (α : Type w) [SupportsUpperBound .closed α]
+    [UpwardEnumerable α] where
+  /--
+  A closed upper bound is satisfied for `a` if and only if it is greater than or equal to `a`
+  according to `UpwardEnumerable.LE`.
+  -/
+  isSatisfied_iff_le (u : Bound .closed α) (a : α) :
+    SupportsUpperBound.IsSatisfied u a ↔ UpwardEnumerable.LE a u
+
+/--
+This typeclass ensures that `SupportsUpperBound .open α` and `UpwardEnumerable α` instances
+are compatible.
+-/
+class LawfulOpenUpperBound (α : Type w) [SupportsUpperBound .open α]
+    [UpwardEnumerable α] where
+  /--
+  An open upper bound is satisfied for `a` if and only if it is greater than to `a`
+  according to `UpwardEnumerable.LT`.
+  -/
+  isSatisfied_iff_le (u : Bound .open α) (a : α) :
+    SupportsUpperBound.IsSatisfied u a ↔ UpwardEnumerable.LT a u
+
+/--
+This typeclass ensures that according to `SupportsUpperBound .unbounded α`, every element is
+in bounds.
+-/
+class LawfulUnboundedUpperBound (α : Type w) [SupportsUpperBound .unbounded α] where
+  /--
+  An unbounded upper bound is satisfied for every element.
+  -/
+  isSatisfied (u : Bound .unbounded α) (a : α) :
+    SupportsUpperBound.IsSatisfied u a
+
+instance {α} [LT α] [DecidableLT α] : SupportsLowerBound .open α where
+  IsSatisfied bound a := bound < a
+
+instance {α} [LT α] [DecidableLT α] : SupportsUpperBound .open α where
+  IsSatisfied bound a := a < bound
+
+instance {α} [LE α] [DecidableLE α] : SupportsLowerBound .closed α where
+  IsSatisfied bound a := bound ≤ a
+
+instance {α} [LE α] [DecidableLE α] : SupportsUpperBound .closed α where
+  IsSatisfied bound a := a ≤ bound
+
+instance {α} [Least? α] : BoundedUpwardEnumerable .unbounded α where
+  init? _ := Least?.least?
+
+instance {α} [UpwardEnumerable α] : BoundedUpwardEnumerable .open α where
+  init? lower := UpwardEnumerable.succ? lower
+
+instance {α} : BoundedUpwardEnumerable .closed α where
+  init? lower := some lower
+
+instance {α} [LE α] [DecidableLE α] [UpwardEnumerable α] [LawfulUpwardEnumerableLE α] :
+    LawfulClosedUpperBound α where
+  isSatisfied_iff_le u a := by simp [SupportsUpperBound.IsSatisfied, LawfulUpwardEnumerableLE.le_iff]
+
+instance {α} [LT α] [DecidableLT α] [UpwardEnumerable α] [LawfulUpwardEnumerableLT α] :
+    LawfulOpenUpperBound α where
+  isSatisfied_iff_le u a := by simp [SupportsUpperBound.IsSatisfied, LawfulUpwardEnumerableLT.lt_iff]
+
+instance {α} [UpwardEnumerable α] : LawfulUnboundedUpperBound α where
+  isSatisfied u a := by simp [SupportsUpperBound.IsSatisfied]
+
+/--
+This typeclass allows taking the intersection of ranges of the given shape and half-open ranges.
+
+An element should be contained in the intersection if and only if it is contained in both ranges.
+This is encoded in `LawfulClosedOpenIntersection`.
+-/
+class ClosedOpenIntersection (shape : RangeShape) (α : Type w) where
+  intersection : PRange shape α → PRange ⟨.closed, .open⟩ α → PRange ⟨.closed, .open⟩ α
+
+/--
+This typeclass ensures that the intersection according to `ClosedOpenIntersection shape α`
+of two ranges contains exactly those elements that are contained in both ranges.
+-/
+class LawfulClosedOpenIntersection (shape : RangeShape) (α : Type w)
+    [ClosedOpenIntersection shape α]
+    [SupportsLowerBound shape.lower α] [SupportsUpperBound shape.upper α]
+    [SupportsLowerBound .closed α]
+    [SupportsUpperBound .open α] where
+  /--
+  The intersection according to `ClosedOpenIntersection shapee α` of two ranges contains exactly
+  those elements that are contained in both ranges.
+  -/
+  mem_intersection_iff {a : α} {r : PRange ⟨shape.lower, shape.upper⟩ α}
+      {s : PRange ⟨.closed, .open⟩ α} :
+    a ∈ ClosedOpenIntersection.intersection r s ↔ a ∈ r ∧ a ∈ s
+
+end Std.PRange

src/Init/Data/Range/Polymorphic/RangeIterator.lean

@@ -0,0 +1,350 @@
+/-
+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.Internal.Termination
+import Init.Data.Iterators.Consumers.Access
+import Init.Data.Iterators.Consumers.Loop
+import Init.Data.Iterators.Consumers.Collect
+import Init.Data.Range.Polymorphic.PRange
+import Init.Data.List.Sublist
+
+/-!
+# Range iterator
+
+This module implements an iterator for ranges (`Std.PRange`).
+
+This iterator is publicly available via `PRange.iter` after importing
+`Std.Data.Iterators` and it internally powers many functions on ranges such as
+`PRange.toList`.
+-/
+
+open Std.Iterators
+
+namespace Std.PRange
+
+/-- Internal state of the range iterators. Do not depend on its internals. -/
+@[unbox]
+structure RangeIterator (shape : BoundShape) (α : Type u) where
+  next : Option α
+  upperBound : Bound shape α
+
+variable {α : Type u}
+
+/--
+The pure function mapping a range iterator of type `IterM` to the next step of the iterator.
+
+This function is prefixed with `Monadic` in order to disambiguate it from the version for iterators
+of type `Iter`.
+-/
+@[always_inline, inline]
+def RangeIterator.Monadic.step {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    (it : IterM (α := RangeIterator su α) Id α) :
+    IterStep (IterM (α := RangeIterator su α) Id α) α :=
+  match it.internalState.next with
+  | none => .done
+  | some a => if SupportsUpperBound.IsSatisfied it.internalState.upperBound a then
+      .yield ⟨⟨UpwardEnumerable.succ? a, it.internalState.upperBound⟩⟩ a
+    else
+      .done
+
+/--
+The pure function mapping a range iterator of type `Iter` to the next step of the iterator.
+-/
+@[always_inline, inline]
+def RangeIterator.step {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    (it : Iter (α := RangeIterator su α) α) :
+    IterStep (Iter (α := RangeIterator su α) α) α :=
+  match it.internalState.next with
+  | none => .done
+  | some a => if SupportsUpperBound.IsSatisfied it.internalState.upperBound a then
+      .yield ⟨⟨UpwardEnumerable.succ? a, it.internalState.upperBound⟩⟩ a
+    else
+      .done
+
+theorem RangeIterator.step_eq_monadicStep {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} :
+    RangeIterator.step it = (RangeIterator.Monadic.step it.toIterM).mapIterator IterM.toIter := by
+  simp only [step, Monadic.step, Iter.toIterM]
+  split
+  · rfl
+  · split <;> rfl
+
+@[always_inline, inline]
+instance {su} [UpwardEnumerable α] [SupportsUpperBound su α] :
+    Iterator (RangeIterator su α) Id α where
+  IsPlausibleStep it step := step = RangeIterator.Monadic.step it
+  step it := pure ⟨RangeIterator.Monadic.step it, rfl⟩
+
+theorem RangeIterator.Monadic.isPlausibleStep_iff {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : IterM (α := RangeIterator su α) Id α} {step} :
+    it.IsPlausibleStep step ↔ step = RangeIterator.Monadic.step it := by
+  exact Iff.rfl
+
+theorem RangeIterator.Monadic.step_eq_step {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : IterM (α := RangeIterator su α) Id α} :
+    it.step = pure ⟨RangeIterator.Monadic.step it, isPlausibleStep_iff.mpr rfl⟩ := by
+  simp [IterM.step, Iterator.step]
+
+theorem RangeIterator.isPlausibleStep_iff {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} {step} :
+    it.IsPlausibleStep step ↔ step = RangeIterator.step it := by
+  simp only [Iter.IsPlausibleStep, Monadic.isPlausibleStep_iff, step_eq_monadicStep]
+  constructor
+  · intro h
+    generalize hs : (step.mapIterator Iter.toIterM) = stepM at h
+    cases h
+    replace hs := congrArg (IterStep.mapIterator IterM.toIter) hs
+    simpa using hs
+  · rintro rfl
+    simp only [IterStep.mapIterator_mapIterator, Iter.toIterM_comp_toIter, IterStep.mapIterator_id]
+
+theorem RangeIterator.step_eq_step {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} :
+    it.step = ⟨RangeIterator.step it, isPlausibleStep_iff.mpr rfl⟩ := by
+  simp [Iter.step, step_eq_monadicStep, Monadic.step_eq_step, IterM.Step.toPure]
+
+@[always_inline, inline]
+instance RepeatIterator.instIteratorLoop {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {n : Type u → Type w} [Monad n] :
+    IteratorLoop (RangeIterator su α) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorLoopPartial {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {n : Type u → Type w} [Monad n] : IteratorLoopPartial (RangeIterator su α) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorCollect {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {n : Type u → Type w} [Monad n] : IteratorCollect (RangeIterator su α) Id n :=
+  .defaultImplementation
+
+instance RepeatIterator.instIteratorCollectPartial {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    {n : Type u → Type w} [Monad n] : IteratorCollectPartial (RangeIterator su α) Id n :=
+  .defaultImplementation
+
+theorem RangeIterator.Monadic.isPlausibleOutput_next {su a}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : IterM (α := RangeIterator su α) Id α} (h : it.internalState.next = some a)
+    (hP : SupportsUpperBound.IsSatisfied it.internalState.upperBound a) :
+    it.IsPlausibleOutput a := by
+  simp [IterM.IsPlausibleOutput, Monadic.isPlausibleStep_iff, RangeIterator.Monadic.step, h, hP]
+
+theorem RangeIterator.Monadic.isPlausibleOutput_iff {su a}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : IterM (α := RangeIterator su α) Id α} :
+    it.IsPlausibleOutput a ↔
+      it.internalState.next = some a ∧
+        SupportsUpperBound.IsSatisfied it.internalState.upperBound a := by
+  simp [IterM.IsPlausibleOutput, isPlausibleStep_iff, RangeIterator.Monadic.step]
+  split
+  · simp [*]
+  · constructor
+    · rintro ⟨it', hit'⟩
+      split at hit' <;> simp_all
+    · rename_i heq
+      rintro ⟨heq', h'⟩
+      simp only [heq', Option.some.injEq] at heq
+      simp_all
+
+theorem RangeIterator.isPlausibleOutput_next {su a}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} (h : it.internalState.next = some a)
+    (hP : SupportsUpperBound.IsSatisfied it.internalState.upperBound a) :
+    it.IsPlausibleOutput a := by
+  simp [Iter.IsPlausibleOutput, Monadic.isPlausibleOutput_iff, Iter.toIterM, h, hP]
+
+theorem RangeIterator.isPlausibleOutput_iff {su a}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} :
+    it.IsPlausibleOutput a ↔
+      it.internalState.next = some a ∧
+        SupportsUpperBound.IsSatisfied it.internalState.upperBound a := by
+  simp [Iter.IsPlausibleOutput, Monadic.isPlausibleOutput_iff, Iter.toIterM]
+
+theorem RangeIterator.Monadic.isPlausibleSuccessorOf_iff {su}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it' it : IterM (α := RangeIterator su α) Id α} :
+    it'.IsPlausibleSuccessorOf it ↔
+      ∃ a, it.internalState.next = some a ∧
+        SupportsUpperBound.IsSatisfied it.internalState.upperBound a ∧
+        UpwardEnumerable.succ? a = it'.internalState.next ∧
+        it'.internalState.upperBound = it.internalState.upperBound := by
+  simp only [IterM.IsPlausibleSuccessorOf]
+  constructor
+  · rintro ⟨step, h, h'⟩
+    cases h'
+    simp only [RangeIterator.Monadic.step] at h
+    split at h
+    · cases h
+    · split at h
+      · simp only [IterStep.successor, Option.some.injEq] at h
+        cases h
+        exact ⟨_, ‹_›, ‹_›, rfl, rfl⟩
+      · cases h
+  · rintro ⟨a, h, hP, h'⟩
+    refine ⟨.yield it' a, rfl, ?_⟩
+    simp only [IterM.IsPlausibleStep, Iterator.IsPlausibleStep, step, h, hP, ↓reduceIte,
+      IterStep.yield.injEq, and_true]
+    simp [h'.1, ← h'.2]
+
+theorem RangeIterator.isPlausibleSuccessorOf_iff {su}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it' it : Iter (α := RangeIterator su α) α} :
+    it'.IsPlausibleSuccessorOf it ↔
+      ∃ a, it.internalState.next = some a ∧
+        SupportsUpperBound.IsSatisfied it.internalState.upperBound a ∧
+        UpwardEnumerable.succ? a = it'.internalState.next ∧
+        it'.internalState.upperBound = it.internalState.upperBound := by
+  simp [Iter.IsPlausibleSuccessorOf, Monadic.isPlausibleSuccessorOf_iff, Iter.toIterM]
+
+theorem RangeIterator.isSome_next_of_isPlausibleIndirectOutput {su}
+    [UpwardEnumerable α] [SupportsUpperBound su α]
+    {it : Iter (α := RangeIterator su α) α} {out : α}
+    (h : it.IsPlausibleIndirectOutput out) :
+    it.internalState.next.isSome := by
+  cases h
+  case direct h =>
+    rw [isPlausibleOutput_iff] at h
+    simp [h]
+  case indirect h _ =>
+    rw [isPlausibleSuccessorOf_iff] at h
+    obtain ⟨a, ha, _⟩ := h
+    simp [ha]
+
+private def List.Sublist.filter_mono {l : List α} {P Q : α → Bool} (h : ∀ a, P a → Q a) :
+    List.Sublist (l.filter P) (l.filter Q) := by
+  apply List.Sublist.trans (l₂ := (l.filter Q).filter P)
+  · simp [Bool.and_eq_left_iff_imp.mpr (h _)]
+  · apply List.filter_sublist
+
+private def List.length_filter_strict_mono {l : List α} {P Q : α → Bool} {a : α}
+    (h : ∀ a, P a → Q a) (ha : a ∈ l) (hPa : ¬ P a) (hQa : Q a) :
+    (l.filter P).length < (l.filter Q).length := by
+  have hsl : List.Sublist (l.filter P) (l.filter Q) := by
+    apply List.Sublist.filter_mono
+    exact h
+  apply Nat.lt_of_le_of_ne
+  · apply List.Sublist.length_le
+    exact hsl
+  · intro h
+    apply hPa
+    have heq := List.Sublist.eq_of_length hsl h
+    have : a ∈ List.filter Q l := List.mem_filter.mpr ⟨ha, hQa⟩
+    rw [← heq, List.mem_filter] at this
+    exact this.2
+
+private def RangeIterator.instFinitenessRelation [UpwardEnumerable α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α] [HasFiniteRanges su α] :
+    FinitenessRelation (RangeIterator su α) Id where
+  rel :=
+    open Classical in
+    InvImage WellFoundedRelation.rel
+      (fun it => (HasFiniteRanges.mem_of_satisfiesUpperBound it.internalState.upperBound).choose
+        |>.filter (∃ a, it.internalState.next = some a ∧ UpwardEnumerable.LE a ·)
+        |>.length)
+  wf := InvImage.wf _ WellFoundedRelation.wf
+  subrelation {it it'} h := by
+    simp_wf
+    rw [Monadic.isPlausibleSuccessorOf_iff] at h
+    obtain ⟨a, hn, hu, hn', hu'⟩ := h
+    rw [hu']
+    apply List.length_filter_strict_mono (a := a)
+    · intro u h
+      simp only [decide_eq_true_eq] at ⊢ h
+      obtain ⟨a', ha', hle⟩ := h
+      refine ⟨a, hn, UpwardEnumerable.le_trans ⟨1, ?_⟩ hle⟩
+      rw [ha'] at hn'
+      rw [UpwardEnumerable.succMany?_succ, LawfulUpwardEnumerable.succMany?_zero,
+        Option.bind_some, hn']
+    · exact (HasFiniteRanges.mem_of_satisfiesUpperBound _).choose_spec _ hu
+    · intro h
+      simp only [decide_eq_true_eq] at h
+      obtain ⟨x, hx, h⟩ := h
+      rw [hx] at hn'
+      have hlt : UpwardEnumerable.LT a x :=
+        ⟨0, by simp [UpwardEnumerable.succMany?_succ, UpwardEnumerable.succMany?_zero, hn']⟩
+      exact UpwardEnumerable.not_gt_of_le h hlt
+    · simp only [decide_eq_true_eq]
+      exact ⟨a, hn, UpwardEnumerable.le_refl _⟩
+
+@[no_expose]
+instance RangeIterator.instFinite {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α] [HasFiniteRanges su α] :
+    Finite (RangeIterator su α) Id :=
+  .of_finitenessRelation instFinitenessRelation
+
+instance RangeIterator.instIteratorAccess {su} [UpwardEnumerable α] [SupportsUpperBound su α]
+    [LawfulUpwardEnumerable α] [LawfulUpwardEnumerableUpperBound su α] :
+    IteratorAccess (RangeIterator su α) Id where
+  nextAtIdx? it n := ⟨match it.internalState.next.bind (UpwardEnumerable.succMany? n) with
+    | none => .done
+    | some next => if SupportsUpperBound.IsSatisfied it.internalState.upperBound next then
+        .yield ⟨⟨UpwardEnumerable.succ? next, it.internalState.upperBound⟩⟩ next
+      else
+        .done, (by
+      induction n generalizing it
+      · split <;> rename_i heq
+        · apply IterM.IsPlausibleNthOutputStep.done
+          simp only [Monadic.isPlausibleStep_iff, Monadic.step]
+          simp only [Option.bind_eq_none_iff, UpwardEnumerable.succMany?_zero, reduceCtorEq,
+            imp_false] at heq
+          cases heq' : it.internalState.next
+          · simp
+          · rw [heq'] at heq
+            exfalso
+            exact heq _ rfl
+        · cases heq' : it.internalState.next
+          · simp [heq'] at heq
+          simp only [heq', Option.bind_some, UpwardEnumerable.succMany?_zero, Option.some.injEq] at heq
+          cases heq
+          split <;> rename_i heq''
+          · apply IterM.IsPlausibleNthOutputStep.zero_yield
+            simp [Monadic.isPlausibleStep_iff, Monadic.step, heq', heq'']
+          · apply IterM.IsPlausibleNthOutputStep.done
+            simp [Monadic.isPlausibleStep_iff, Monadic.step, heq', heq'']
+      · rename_i n ih
+        split <;> rename_i heq
+        · cases heq' : it.internalState.next
+          · apply IterM.IsPlausibleNthOutputStep.done
+            simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq']
+          · rename_i out
+            simp only [heq', Option.bind_some, LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?] at heq
+            specialize ih ⟨⟨UpwardEnumerable.succ? out, it.internalState.upperBound⟩⟩
+            simp only [heq] at ih
+            by_cases heq'' : SupportsUpperBound.IsSatisfied it.internalState.upperBound out
+            · apply IterM.IsPlausibleNthOutputStep.yield
+              · simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq', heq'', ↓reduceIte,
+                IterStep.yield.injEq]
+                exact ⟨rfl, rfl⟩
+              · exact ih
+            · apply IterM.IsPlausibleNthOutputStep.done
+              simp [Monadic.isPlausibleStep_iff, Monadic.step, heq', heq'']
+        · cases heq' : it.internalState.next
+          · simp [heq'] at heq
+          rename_i out
+          simp only [heq', Option.bind_some] at heq
+          have hle : UpwardEnumerable.LE out _ := ⟨n + 1, heq⟩
+          simp only [LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?] at heq
+          specialize ih ⟨⟨UpwardEnumerable.succ? out, it.internalState.upperBound⟩⟩
+          simp only [heq] at ih
+          by_cases hout : SupportsUpperBound.IsSatisfied it.internalState.upperBound out
+          · apply IterM.IsPlausibleNthOutputStep.yield
+            · simp only [Monadic.isPlausibleStep_iff, Monadic.step, heq', hout, ↓reduceIte,
+              IterStep.yield.injEq]
+              exact ⟨rfl, rfl⟩
+            · apply ih
+          · have := hout.imp (fun h => LawfulUpwardEnumerableUpperBound.isSatisfied_of_le _ _ _ h hle)
+            simp only [this, ↓reduceIte]
+            simp only [this, ↓reduceIte] at ih
+            apply IterM.IsPlausibleNthOutputStep.done
+            simp [Monadic.isPlausibleStep_iff, Monadic.step, heq', hout])⟩
+
+instance RangeIterator.instLawfulDeterministicIterator {su} [UpwardEnumerable α] [SupportsUpperBound su α] :
+    LawfulDeterministicIterator (RangeIterator su α) Id where
+  isPlausibleStep_eq_eq it := ⟨Monadic.step it, rfl⟩
+
+end Std.PRange

src/Init/Data/Range/Polymorphic/UpwardEnumerable.lean

@@ -0,0 +1,324 @@
+/-
+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.Classical
+import Init.Core
+import Init.Data.Nat.Basic
+import Init.Data.Option.Lemmas
+
+namespace Std.PRange
+
+/--
+This typeclass provides the function `succ? : α → Option α` that computes the successor of
+elements of `α`, or none if no successor exists.
+It also provides the function `succMany?`, which computes `n`-th successors.
+
+`succ?` is expected to be acyclic: No element is its own transitive successor.
+If `α` is ordered, then every element larger than `a : α` should be a transitive successor of `a`.
+These properties and the compatibility of `succ?` with `succMany?` are encoded in the typeclasses
+`LawfulUpwardEnumerable`, `LawfulUpwardEnumerableLE` and `LawfulUpwardEnumerableLT`.
+
+-/
+class UpwardEnumerable (α : Type u) where
+  /-- Maps elements of `α` to their successor, or none if no successor exists. -/
+  succ? : α → Option α
+  /--
+  Maps elements of `α` to their `n`-th successor, or none if no successor exists.
+  This should semantically behave like repeatedly applying `succ?`, but it might be more efficient.
+
+  `LawfulUpwardEnumerable` ensures the compatibility with `succ?`.
+
+  If no other implementation is provided in `UpwardEnumerable` instance, `succMany?` repeatedly
+  applies `succ?`.
+  -/
+  succMany? (n : Nat) (a : α) : Option α := Nat.repeat (· >>= succ?) n (some a)
+
+/--
+According to `UpwardEnumerable.LE`, `a` is less than or equal to `b` if `b` is `a` or a transitive
+successor of `a`.
+-/
+@[expose]
+def UpwardEnumerable.LE {α : Type u} [UpwardEnumerable α] (a b : α) : Prop :=
+  ∃ n, UpwardEnumerable.succMany? n a = some b
+
+/--
+According to `UpwardEnumerable.LT`, `a` is less than `b` if `b` is a proper transitive successor of
+`a`. 'Proper' means that `b` is the `n`-th successor of `a`, where `n > 0`.
+
+Given `LawfulUpwardEnumerable α`, no element of `α` is less than itself.
+-/
+@[expose]
+def UpwardEnumerable.LT {α : Type u} [UpwardEnumerable α] (a b : α) : Prop :=
+  ∃ n, UpwardEnumerable.succMany? (n + 1) a = some b
+
+theorem UpwardEnumerable.le_of_lt {α : Type u} [UpwardEnumerable α] {a b : α}
+    (h : UpwardEnumerable.LT a b) : UpwardEnumerable.LE a b :=
+  ⟨h.choose + 1, h.choose_spec⟩
+
+/--
+The typeclass `Least? α` optionally provides a smallest element of `α`, `least? : Option α`.
+
+The main use case of this typeclass is to use it in combination with `UpwardEnumerable` to
+obtain a (possibly infinite) ascending enumeration of all elements of `α`.
+-/
+class Least? (α : Type u) where
+  /--
+  Returns the smallest element of `α`, or none if `α` is empty.
+
+  Only empty types are allowed to define `least? := none`. If `α` is ordered and nonempty, then
+  the value of `least?` should be the smallest element according to the order on `α`.
+  -/
+  least? : Option α
+
+/--
+This typeclass ensures that an `UpwardEnumerable α` instance is well-behaved.
+-/
+class LawfulUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
+  /-- There is no cyclic chain of successors. -/
+  ne_of_lt (a b : α) : UpwardEnumerable.LT a b → a ≠ b
+  /-- The `0`-th successor of `a` is `a` itself. -/
+  succMany?_zero (a : α) : UpwardEnumerable.succMany? 0 a = some a
+  /--
+  The `n + 1`-th successor of `a` is the successor of the `n`-th successor, given that said
+  successors actualy exist.
+  -/
+  succMany?_succ (n : Nat) (a : α) :
+    UpwardEnumerable.succMany? (n + 1) a = (UpwardEnumerable.succMany? n a).bind UpwardEnumerable.succ?
+
+theorem UpwardEnumerable.succMany?_zero [UpwardEnumerable α] [LawfulUpwardEnumerable α] {a : α} :
+    UpwardEnumerable.succMany? 0 a = some a :=
+  LawfulUpwardEnumerable.succMany?_zero a
+
+theorem UpwardEnumerable.succMany?_succ [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {n : Nat} {a : α} :
+    UpwardEnumerable.succMany? (n + 1) a =
+      (UpwardEnumerable.succMany? n a).bind UpwardEnumerable.succ? :=
+  LawfulUpwardEnumerable.succMany?_succ n a
+
+theorem UpwardEnumerable.succMany?_one [UpwardEnumerable α] [LawfulUpwardEnumerable α] {a : α} :
+    UpwardEnumerable.succMany? 1 a = UpwardEnumerable.succ? a := by
+  simp [UpwardEnumerable.succMany?_succ, UpwardEnumerable.succMany?_zero]
+
+theorem UpwardEnumerable.succMany?_add [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    (m n : Nat) (a : α) :
+    UpwardEnumerable.succMany? (m + n) a =
+      (UpwardEnumerable.succMany? m a).bind (UpwardEnumerable.succMany? n ·) := by
+  induction n
+  case zero => simp [LawfulUpwardEnumerable.succMany?_zero]
+  case succ n ih =>
+    rw [← Nat.add_assoc, LawfulUpwardEnumerable.succMany?_succ, ih, Option.bind_assoc]
+    simp only [LawfulUpwardEnumerable.succMany?_succ]
+
+theorem LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?
+    [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    (n : Nat) (a : α) :
+    UpwardEnumerable.succMany? (n + 1) a =
+      (UpwardEnumerable.succ? a).bind (UpwardEnumerable.succMany? n ·) := by
+  rw [Nat.add_comm]
+  simp [UpwardEnumerable.succMany?_add, LawfulUpwardEnumerable.succMany?_succ,
+    LawfulUpwardEnumerable.succMany?_zero]
+
+theorem UpwardEnumerable.le_refl {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    (a : α) : UpwardEnumerable.LE a a :=
+  ⟨0, LawfulUpwardEnumerable.succMany?_zero a⟩
+
+theorem UpwardEnumerable.le_trans {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b c : α} (hab : UpwardEnumerable.LE a b) (hbc : UpwardEnumerable.LE b c) :
+    UpwardEnumerable.LE a c := by
+  refine ⟨hab.choose + hbc.choose, ?_⟩
+  simp [succMany?_add, hab.choose_spec, hbc.choose_spec]
+
+theorem UpwardEnumerable.le_of_succ?_eq {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b : α} (hab : UpwardEnumerable.succ? a = some b) : UpwardEnumerable.LE a b :=
+  ⟨1, by simp [UpwardEnumerable.succMany?_one, hab]⟩
+
+theorem UpwardEnumerable.lt_of_lt_of_le {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b c : α} (hab : UpwardEnumerable.LT a b) (hbc : UpwardEnumerable.LE b c) :
+    UpwardEnumerable.LT a c := by
+  refine ⟨hab.choose + hbc.choose, ?_⟩
+  rw [Nat.add_right_comm, succMany?_add, hab.choose_spec, Option.bind_some, hbc.choose_spec]
+
+theorem UpwardEnumerable.not_gt_of_le {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b : α} :
+    UpwardEnumerable.LE a b → ¬ UpwardEnumerable.LT b a := by
+  rintro ⟨n, hle⟩ ⟨m, hgt⟩
+  have : UpwardEnumerable.LT a a := by
+    refine ⟨n + m, ?_⟩
+    rw [Nat.add_assoc, UpwardEnumerable.succMany?_add, hle, Option.bind_some, hgt]
+  exact LawfulUpwardEnumerable.ne_of_lt _ _ this rfl
+
+theorem UpwardEnumerable.not_gt_of_lt {α : Type u} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b : α} (h : UpwardEnumerable.LT a b) : ¬ UpwardEnumerable.LT b a :=
+  not_gt_of_le (le_of_lt h)
+
+theorem UpwardEnumerable.ne_of_lt {α : Type w} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    {a b : α} :
+    UpwardEnumerable.LT a b → a ≠ b :=
+  LawfulUpwardEnumerable.ne_of_lt a b
+
+/--
+This propositional typeclass ensures that `UpwardEnumerable.succ?` will never return `none`.
+In other words, it ensures that there will always be a successor.
+-/
+class InfinitelyUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
+  isSome_succ? : ∀ a : α, (UpwardEnumerable.succ? a).isSome
+
+/--
+This propositional typeclass ensures that `UpwardEnumerable.succ?` is injective.
+-/
+class LinearlyUpwardEnumerable (α : Type u) [UpwardEnumerable α] where
+  eq_of_succ?_eq : ∀ a b : α, UpwardEnumerable.succ? a = UpwardEnumerable.succ? b → a = b
+
+theorem UpwardEnumerable.isSome_succ? {α : Type u} [UpwardEnumerable α]
+    [InfinitelyUpwardEnumerable α] {a : α} :
+    (succ? a).isSome :=
+  InfinitelyUpwardEnumerable.isSome_succ? a
+
+theorem UpwardEnumerable.eq_of_succ?_eq {α : Type u} [UpwardEnumerable α]
+    [LinearlyUpwardEnumerable α] {a b : α} (h : succ? a = succ? b) :
+    a = b :=
+  LinearlyUpwardEnumerable.eq_of_succ?_eq a b h
+
+@[always_inline, inline]
+abbrev UpwardEnumerable.succ {α : Type u} [UpwardEnumerable α] [InfinitelyUpwardEnumerable α]
+    (a : α) : α :=
+  (succ? a).get isSome_succ?
+
+theorem UpwardEnumerable.succ_eq_get {α : Type u} [UpwardEnumerable α]
+    [InfinitelyUpwardEnumerable α] {a : α} :
+    succ a = (succ? a).get isSome_succ? :=
+  (rfl)
+
+theorem UpwardEnumerable.succ?_eq_some {α : Type u} [UpwardEnumerable α]
+    [InfinitelyUpwardEnumerable α] {a : α} :
+    succ? a = some (succ a) := by
+  simp
+
+theorem UpwardEnumerable.eq_of_succ_eq {α : Type u} [UpwardEnumerable α]
+    [InfinitelyUpwardEnumerable α] [LinearlyUpwardEnumerable α] {a b : α}
+    (h : succ a = succ b) : a = b := by
+  rw [succ, succ, ← Option.some.injEq, Option.some_get, Option.some_get] at h
+  exact eq_of_succ?_eq h
+
+theorem UpwardEnumerable.succ_eq_succ_iff {α : Type u} [UpwardEnumerable α]
+    [InfinitelyUpwardEnumerable α] [LinearlyUpwardEnumerable α] {a b : α} :
+    succ a = succ b ↔ a = b := by
+  constructor
+  · apply eq_of_succ_eq
+  · exact congrArg succ
+
+theorem UpwardEnumerable.isSome_succMany? {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {n : Nat} {a : α} :
+    (succMany? n a).isSome := by
+  induction n
+  · simp [succMany?_zero]
+  · rename_i ih
+    simp only [succMany?_succ]
+    rw [← Option.some_get ih, Option.bind_some]
+    apply InfinitelyUpwardEnumerable.isSome_succ?
+
+@[always_inline, inline]
+def UpwardEnumerable.succMany {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α]
+    (n : Nat) (a : α) :=
+  (succMany? n a).get isSome_succMany?
+
+theorem UpwardEnumerable.succMany_eq_get {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {n : Nat} {a : α} :
+    succMany n a = (succMany? n a).get isSome_succMany? :=
+  (rfl)
+
+theorem UpwardEnumerable.succMany?_eq_some {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {n : Nat} {a : α} :
+    succMany? n a = some (succMany n a) := by
+  simp [succMany]
+
+theorem UpwardEnumerable.succMany?_eq_some_iff_succMany {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {n : Nat} {a b : α} :
+    succMany? n a = some b ↔ succMany n a = b := by
+  simp [succMany?_eq_some]
+
+theorem UpwardEnumerable.succMany_one {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a : α} :
+    succMany 1 a = succ a := by
+  simp [succMany, succ, succMany?_one]
+
+theorem UpwardEnumerable.succMany_add {α : Type u} [UpwardEnumerable α]
+    [LawfulUpwardEnumerable α] [InfinitelyUpwardEnumerable α]
+    {m n : Nat} {a : α} : succMany (m + n) a = succMany n (succMany m a) := by
+  simp [succMany, succMany?_add]
+
+theorem UpwardEnumerable.succ_le_succ_iff {α : Type w} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    [LinearlyUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a b : α} :
+    UpwardEnumerable.LE (UpwardEnumerable.succ a) (UpwardEnumerable.succ b) ↔
+      UpwardEnumerable.LE a b := by
+  constructor
+  · rintro ⟨n, hn⟩
+    simp only [succ] at hn
+    refine ⟨n, ?_⟩
+    simp [succMany?_eq_some]
+    apply eq_of_succ?_eq
+    rw [← Option.bind_some (f := succMany? n), Option.some_get,
+      ← LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?, Option.some_get] at hn
+    rw [← Option.bind_some (f := succ?), ← succMany?_eq_some, ← succMany?_succ, hn]
+  · rintro ⟨n, hn⟩
+    refine ⟨n, ?_⟩
+    rw [succ_eq_get, succ_eq_get, ← Option.bind_some (f := succMany? n), Option.some_get,
+      Option.some_get, ← LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?,
+      succMany?_succ, hn, Option.bind_some]
+
+theorem UpwardEnumerable.succ_lt_succ_iff {α : Type w} [UpwardEnumerable α] [LawfulUpwardEnumerable α]
+    [LinearlyUpwardEnumerable α] [InfinitelyUpwardEnumerable α] {a b : α} :
+    UpwardEnumerable.LT (UpwardEnumerable.succ a) (UpwardEnumerable.succ b) ↔
+      UpwardEnumerable.LT a b := by
+  constructor
+  · rintro ⟨n, hn⟩
+    simp only [succ] at hn
+    refine ⟨n, ?_⟩
+    rw [succMany?_eq_some_iff_succMany]
+    apply eq_of_succ?_eq
+    rw [← Option.bind_some (f := succMany? _), Option.some_get,
+      ← LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?, Option.some_get] at hn
+    rw [← Option.bind_some (f := succ?), ← succMany?_eq_some, ← succMany?_succ, hn]
+  · rintro ⟨n, hn⟩
+    refine ⟨n, ?_⟩
+    rw [succ_eq_get, succ_eq_get, ← Option.bind_some (f := succMany? _), Option.some_get,
+      Option.some_get, ← LawfulUpwardEnumerable.succMany?_succ_eq_succ?_bind_succMany?,
+      succMany?_succ, hn, Option.bind_some]
+
+/--
+This typeclass ensures that an `UpwardEnumerable α` instance is compatible with `≤`.
+In this case, `UpwardEnumerable α` fully characterizes the `LE α` instance.
+-/
+class LawfulUpwardEnumerableLE (α : Type u) [UpwardEnumerable α] [LE α] where
+  /--
+  `a` is less than or equal to `b` if and only if `b` is either `a` or a transitive successor
+  of `a`.
+  -/
+  le_iff (a b : α) : a ≤ b ↔ UpwardEnumerable.LE a b
+
+/--
+This typeclass ensures that an `UpwardEnumerable α` instance is compatible with `<`.
+In this case, `UpwardEnumerable α` fully characterizes the `LT α` instance.
+-/
+class LawfulUpwardEnumerableLT (α : Type u) [UpwardEnumerable α] [LT α] where
+  /--
+  `a` is less than `b` if and only if `b` is a proper transitive successor of `a`.
+  -/
+  lt_iff (a b : α) : a < b ↔ UpwardEnumerable.LT a b
+
+/--
+This typeclass ensures that an `UpwardEnumerable α` instance is compatible with a `Least? α`
+instance. For nonempty `α`, it ensures that `least?` has a value and that every other value is
+a transitive successor of it.
+-/
+class LawfulUpwardEnumerableLeast? (α : Type u) [UpwardEnumerable α] [Least? α] where
+  /-- For nonempty `α`, `least?` has a value and every other value is a transitive successor of it. -/
+  eq_succMany?_least? (a : α) : ∃ init, Least?.least? = some init ∧ UpwardEnumerable.LE init a
+
+end Std.PRange

src/Init/Data/Repr.lean

@@ -12,14 +12,14 @@ open Sum Subtype Nat
 open Std
 
 /--
-A typeclass that specifies the standard way of turning values of some type into `Format`.
+The standard way of turning values of some type into `Format`.
 
 When rendered this `Format` should be as close as possible to something that can be parsed as the
 input value.
 -/
 class Repr (α : Type u) where
   /--
-  Turn a value of type `α` into `Format` at a given precedence. The precedence value can be used
+  Turn a value of type `α` into a `Format` at a given precedence. The precedence value can be used
   to avoid parentheses if they are not necessary.
   -/
   reprPrec : α → Nat → Format
@@ -27,14 +27,27 @@ class Repr (α : Type u) where
 export Repr (reprPrec)
 
 /--
-Turn `a` into `Format` using its `Repr` instance. The precedence level is initially set to 0.
+Turns `a` into a `Format` using its `Repr` instance. The precedence level is initially set to 0.
 -/
 abbrev repr [Repr α] (a : α) : Format :=
   reprPrec a 0
 
+/--
+Turns `a` into a `String` using its `Repr` instance, rendering the `Format` at the default width of
+120 columns.
+
+The precedence level is initially set to 0.
+-/
 abbrev reprStr [Repr α] (a : α) : String :=
   reprPrec a 0 |>.pretty
 
+/--
+Turns `a` into a `Format` using its `Repr` instance, with the precedence level set to that of
+function application.
+
+Together with `Repr.addAppParen`, this can be used to correctly parenthesize function application
+syntax.
+-/
 abbrev reprArg [Repr α] (a : α) : Format :=
   reprPrec a max_prec
 
@@ -62,6 +75,13 @@ protected def Bool.repr : Bool → Nat → Format
 instance : Repr Bool where
   reprPrec := Bool.repr
 
+/--
+Adds parentheses to `f` if the precedence `prec` from the context is at least that of function
+application.
+
+Together with `reprArg`, this can be used to correctly parenthesize function application
+syntax.
+-/
 def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
   if prec >= max_prec then
     Format.paren f

src/Init/Data/SInt/Lemmas.lean

@@ -128,6 +128,28 @@ theorem ISize.toNat_toBitVec_ofNat_of_lt {n : Nat} (h : n < 2^32) :
 theorem ISize.toInt_ofInt {n : Int} : toInt (ofInt n) = n.bmod ISize.size := by
   rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt]
 
+@[simp] theorem Int8.toInt_ofNat' {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int8.size := by
+  rw [toInt, toBitVec_ofNat', BitVec.toInt_ofNat']
+@[simp] theorem Int16.toInt_ofNat' {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int16.size := by
+  rw [toInt, toBitVec_ofNat', BitVec.toInt_ofNat']
+@[simp] theorem Int32.toInt_ofNat' {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int32.size := by
+  rw [toInt, toBitVec_ofNat', BitVec.toInt_ofNat']
+@[simp] theorem Int64.toInt_ofNat' {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int64.size := by
+  rw [toInt, toBitVec_ofNat', BitVec.toInt_ofNat']
+@[simp] theorem ISize.toInt_ofNat' {n : Nat} : toInt (ofNat n) = (n : Int).bmod ISize.size := by
+  rw [toInt, toBitVec_ofNat', BitVec.toInt_ofNat']
+
+theorem Int8.toInt_ofNat {n : Nat} : toInt (no_index (OfNat.ofNat n)) = (n : Int).bmod Int8.size := by
+  rw [toInt, toBitVec_ofNat, BitVec.toInt_ofNat]
+theorem Int16.toInt_ofNat {n : Nat} : toInt (no_index (OfNat.ofNat n)) = (n : Int).bmod Int16.size := by
+  rw [toInt, toBitVec_ofNat, BitVec.toInt_ofNat]
+theorem Int32.toInt_ofNat {n : Nat} : toInt (no_index (OfNat.ofNat n)) = (n : Int).bmod Int32.size := by
+  rw [toInt, toBitVec_ofNat, BitVec.toInt_ofNat]
+theorem Int64.toInt_ofNat {n : Nat} : toInt (no_index (OfNat.ofNat n)) = (n : Int).bmod Int64.size := by
+  rw [toInt, toBitVec_ofNat, BitVec.toInt_ofNat]
+theorem ISize.toInt_ofNat {n : Nat} : toInt (no_index (OfNat.ofNat n)) = (n : Int).bmod ISize.size := by
+  rw [toInt, toBitVec_ofNat, BitVec.toInt_ofNat]
+
 theorem Int8.toInt_ofInt_of_le {n : Int} (hn : -2^7 ≤ n) (hn' : n < 2^7) : toInt (ofInt n) = n := by
   rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self (by decide) hn hn']
 theorem Int16.toInt_ofInt_of_le {n : Int} (hn : -2^15 ≤ n) (hn' : n < 2^15) : toInt (ofInt n) = n := by
@@ -166,17 +188,6 @@ theorem Int32.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by s
 theorem Int64.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
 theorem ISize.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
 
-@[simp] theorem Int8.toInt_ofNat {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int8.size := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt]
-@[simp] theorem Int16.toInt_ofNat {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int16.size := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt]
-@[simp] theorem Int32.toInt_ofNat {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int32.size := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt]
-@[simp] theorem Int64.toInt_ofNat {n : Nat} : toInt (ofNat n) = (n : Int).bmod Int64.size := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt]
-@[simp] theorem ISize.toInt_ofNat {n : Nat} : toInt (ofNat n) = (n : Int).bmod ISize.size := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt]
-
 theorem Int8.neg_ofNat {n : Nat} : -ofNat n = ofInt (-n) := by
   rw [← neg_ofInt, ofInt_eq_ofNat]
 theorem Int16.neg_ofNat {n : Nat} : -ofNat n = ofInt (-n) := by

src/Init/Data/Slice.lean

@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Slice.Basic
+import Init.Data.Slice.Notation
+import Init.Data.Slice.Operations
+import Init.Data.Slice.Array
+
+/-!
+# Polymorphic slices
+
+This module provides slices -- views on a subset of all elements of an array or other collection,
+demarcated by a range of indices.
+
+* `Init.Data.Slice.Basic` defines the `Slice` structure. All slices are of this type.
+* `Init.Data.Slice.Operations` provides functions on `Slice` via dot notation. Many of them are
+  implemented using iterators under the hood.
+* `Init.Data.Slice.Notation` provides slice notation based on ranges, relying on the `Sliceable`
+  typeclass.
+* `Init.Data.Slice.Array` provides the `Sliceable` instance for array slices.
+-/

src/Init/Data/Slice/Array.lean

@@ -0,0 +1,41 @@
+/-
+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.Core
+import Init.Data.Array.Subarray
+import Init.Data.Iterators.Combinators.Attach
+import Init.Data.Iterators.Combinators.FilterMap
+import all Init.Data.Range.Polymorphic.Basic
+import Init.Data.Range.Polymorphic.Nat
+import Init.Data.Slice.Operations
+
+/-!
+This module provides slice notation for array slices (a.k.a. `Subarray`) and implements an iterator
+for those slices.
+-/
+
+open Std Slice PRange Iterators
+
+instance {shape} {α : Type u} [ClosedOpenIntersection shape Nat] :
+    Sliceable shape (Array α) Nat (Subarray α) where
+  mkSlice xs range :=
+    let halfOpenRange := ClosedOpenIntersection.intersection range (0)...<xs.size
+    (xs.toSubarray halfOpenRange.lower halfOpenRange.upper)
+
+instance {s : Subarray α} : ToIterator s Id α :=
+  .of _
+    (PRange.Internal.iter (s.internalRepresentation.start...<s.internalRepresentation.stop)
+      |>.attachWith (· < s.internalRepresentation.array.size) ?h
+      |>.map fun i => s.internalRepresentation.array[i.1])
+where finally
+  case h =>
+    simp only [Internal.isPlausibleIndirectOutput_iter_iff, Membership.mem,
+      SupportsUpperBound.IsSatisfied, and_imp]
+    intro out _ h
+    have := s.internalRepresentation.stop_le_array_size
+    omega

src/Init/Data/Slice/Basic.lean

@@ -0,0 +1,35 @@
+/-
+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.Core
+
+namespace Std.Slice
+
+/--
+Wrapper structure for slice types that makes generic slice functions available via dot notation.
+The implementation of the functions depends on the type `γ` of the internal representation.
+
+Usually, if `γ` is the internal representation of a slice of some type `α`, then `Slice γ` can be
+used directly, but one usually creates an abbreviation `AlphaSlice := Slice γ` and provides
+`Self (Slice γ) AlphaSlice` and `Sliceable shape α AlphaSlice` instances. Then `AlphaSlice` can
+be worked with without ever thinking of `Slice` and it is possible to extend the API with
+`α`/`γ`-specific functions.
+-/
+structure _root_.Std.Slice (γ : Type u) where
+  internalRepresentation : γ
+
+/--
+This typeclass determines that some type `α` is equal to `β` and that `β` should be used in APIs
+instead of `α`.
+
+`Self` is used in the polymorphic slice library.
+-/
+class Self (α : Type u) (β : outParam (Type u)) where
+  eq : α = β := by rfl
+
+end Std.Slice

src/Init/Data/Slice/Notation.lean

@@ -0,0 +1,44 @@
+/-
+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.Range.Polymorphic.PRange
+
+/-!
+# Slice notation
+
+This module provides the means to obtain a slice from a collection and a range of indices via
+slice notation.
+-/
+
+open Std PRange
+
+namespace Std.Slice
+
+/--
+This typeclass indicates how to obtain slices of `α` of type `γ`, given ranges of shape `shape` in
+the index type `β`.
+-/
+class Sliceable (shape : RangeShape) (α : Type u) (β : outParam (Type v))
+    (γ : outParam (Type w)) where
+  mkSlice (carrier : α) (range : PRange shape β) : γ
+
+macro_rules
+  | `($c[*...*]) => `(Sliceable.mkSlice $c *...*)
+  | `($c[$a...*]) => `(Sliceable.mkSlice $c $a...*)
+  | `($c[$a<...*]) => `(Sliceable.mkSlice $c $a<...*)
+  | `($c[*...<$b]) => `(Sliceable.mkSlice $c *...<$b)
+  | `($c[$a...<$b]) => `(Sliceable.mkSlice $c $a...<$b)
+  | `($c[$a<...<$b]) => `(Sliceable.mkSlice $c $a<...<$b)
+  | `($c[*...$b]) => `(Sliceable.mkSlice $c *...<$b)
+  | `($c[$a...$b]) => `(Sliceable.mkSlice $c $a...<$b)
+  | `($c[$a<...$b]) => `(Sliceable.mkSlice $c $a<...<$b)
+  | `($c[*...=$b]) => `(Sliceable.mkSlice $c *...=$b)
+  | `($c[$a...=$b]) => `(Sliceable.mkSlice $c $a...=$b)
+  | `($c[$a<...=$b]) => `(Sliceable.mkSlice $c $a<...=$b)
+
+end Std.Slice

src/Init/Data/Slice/Operations.lean

@@ -0,0 +1,57 @@
+/-
+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.Slice.Basic
+import Init.Data.Slice.Notation
+import Init.Data.Iterators
+
+open Std.Iterators
+
+namespace Std.Slice
+
+instance {x : γ} [ToIterator x m β] : ToIterator (Slice.mk x) m β where
+  State := ToIterator.State x m
+  iterMInternal := ToIterator.iterMInternal
+
+/--
+Internal function to obtain an iterator from a slice. Users should import `Std.Data.Iterators`
+and use `Std.Slice.iter` instead.
+-/
+@[always_inline, inline]
+def Internal.iter (s : Slice γ) [ToIterator s Id β] :=
+  ToIterator.iter s
+
+/--
+Returns the number of elements with distinct indices in the given slice.
+
+Example: `#[1, 1, 1][0...2].size = 2`.
+-/
+@[always_inline, inline]
+def size (s : Slice g) [ToIterator s Id β] [Iterator (ToIterator.State s Id) Id β]
+    [IteratorSize (ToIterator.State s Id) Id] :=
+  Internal.iter s |>.size
+
+/-- Allocates a new array that contains the elements of the slice. -/
+@[always_inline, inline]
+def toArray (s : Slice g) [ToIterator s Id β] [Iterator (ToIterator.State s Id) Id β]
+    [IteratorCollect (ToIterator.State s Id) Id Id] [Finite (ToIterator.State s Id) Id] : Array β :=
+  Internal.iter s |>.toArray
+
+/-- Allocates a new list that contains the elements of the slice. -/
+@[always_inline, inline]
+def toList (s : Slice g) [ToIterator s Id β] [Iterator (ToIterator.State s Id) Id β]
+    [IteratorCollect (ToIterator.State s Id) Id Id] [Finite (ToIterator.State s Id) Id] : List β :=
+  Internal.iter s |>.toList
+
+/-- Allocates a new list that contains the elements of the slice in reverse order. -/
+@[always_inline, inline]
+def toListRev (s : Slice g) [ToIterator s Id β] [Iterator (ToIterator.State s Id) Id β]
+    [IteratorCollect (ToIterator.State s Id) Id Id] [Finite (ToIterator.State s Id) Id] : List β :=
+  Internal.iter s |>.toListRev
+
+end Std.Slice

src/Init/Data/Stream.lean

@@ -97,7 +97,7 @@ instance : Stream (Subarray α) α where
     if h : s.start < s.stop then
       have : s.start + 1 ≤ s.stop := Nat.succ_le_of_lt h
       some (s.array[s.start]'(Nat.lt_of_lt_of_le h s.stop_le_array_size),
-        { s with start := s.start + 1, start_le_stop := this })
+        ⟨{ s.internalRepresentation with start := s.start + 1, start_le_stop := this }⟩)
     else
       none
 

src/Init/Grind.lean

@@ -19,4 +19,5 @@ import Init.Grind.Module
 import Init.Grind.Ordered
 import Init.Grind.Ext
 import Init.Grind.ToInt
+import Init.Grind.ToIntLemmas
 import Init.Data.Int.OfNat -- This may not have otherwise been imported, breaking `grind` proofs.

src/Init/Grind/Module/Basic.lean

@@ -7,11 +7,15 @@ module
 
 prelude
 import Init.Data.Int.Order
-import Init.Grind.ToInt
+import all Init.Grind.ToInt
 
 namespace Lean.Grind
 
+/--
+A type where addition is right-cancellative, i.e. `a + c = b + c` implies `a = b`.
+-/
 class AddRightCancel (M : Type u) [Add M] where
+  /-- Addition is right-cancellative. -/
   add_right_cancel : ∀ a b c : M, a + c = b + c → a = b
 
 /--
@@ -204,8 +208,14 @@ end IntModule
 /--
 We say a module has no natural number zero divisors if
 `k ≠ 0` and `k * a = k * b` implies `a = b` (here `k` is a natural number and `a` and `b` are element of the module).
+
+For a module over the integers this is equivalent to
+`k ≠ 0` and `k * a = 0` implies `a = 0`.
+(See the alternative constructor `NoNatZeroDivisors.mk'`,
+and the theorem `eq_zero_of_mul_eq_zero`.)
 -/
 class NoNatZeroDivisors (α : Type u) [HMul Nat α α] where
+  /-- If `k * a ≠ k * b` then `k ≠ 0` or `a ≠ b`.-/
   no_nat_zero_divisors : ∀ (k : Nat) (a b : α), k ≠ 0 → k * a = k * b → a = b
 
 export NoNatZeroDivisors (no_nat_zero_divisors)
@@ -227,17 +237,17 @@ theorem eq_zero_of_mul_eq_zero {α : Type u} [NatModule α] [NoNatZeroDivisors
 
 end NoNatZeroDivisors
 
-instance [ToInt α (some lo) (some hi)] [IntModule α] [ToInt.Zero α (some lo) (some hi)] [ToInt.Add α (some lo) (some hi)] : ToInt.Neg α (some lo) (some hi) where
+instance [ToInt α (IntInterval.co lo hi)] [IntModule α] [ToInt.Zero α (IntInterval.co lo hi)] [ToInt.Add α (IntInterval.co lo hi)] : ToInt.Neg α (IntInterval.co lo hi) where
   toInt_neg x := by
     have := (ToInt.Add.toInt_add (-x) x).symm
-    rw [IntModule.neg_add_cancel, ToInt.Zero.toInt_zero] at this
-    rw [ToInt.wrap_eq_wrap_iff] at this
+    rw [IntModule.neg_add_cancel, ToInt.Zero.toInt_zero, ← ToInt.Zero.wrap_zero (α := α)] at this
+    rw [IntInterval.wrap_eq_wrap_iff] at this
     simp at this
     rw [← ToInt.wrap_toInt]
-    rw [ToInt.wrap_eq_wrap_iff]
+    rw [IntInterval.wrap_eq_wrap_iff]
     simpa
 
-instance [ToInt α (some lo) (some hi)] [IntModule α] [ToInt.Add α (some lo) (some hi)] [ToInt.Neg α (some lo) (some hi)] : ToInt.Sub α (some lo) (some hi) :=
-  ToInt.Sub.of_sub_eq_add_neg IntModule.sub_eq_add_neg
+instance [ToInt α (IntInterval.co lo hi)] [IntModule α] [ToInt.Add α (IntInterval.co lo hi)] [ToInt.Neg α (IntInterval.co lo hi)] : ToInt.Sub α (IntInterval.co lo hi) :=
+  ToInt.Sub.of_sub_eq_add_neg IntModule.sub_eq_add_neg (by simp)
 
 end Lean.Grind

src/Init/Grind/Ring.lean

@@ -11,3 +11,4 @@ import Init.Grind.Ring.Poly
 import Init.Grind.Ring.Field
 import Init.Grind.Ring.Envelope
 import Init.Grind.Ring.OfSemiring
+import Init.Grind.Ring.ToInt

src/Init/Grind/Ring/Field.lean

@@ -10,10 +10,17 @@ import Init.Grind.Ring.Basic
 
 namespace Lean.Grind
 
+/--
+A field is a commutative ring with inverses for all non-zero elements.
+-/
 class Field (α : Type u) extends CommRing α, Inv α, Div α where
+  /-- Division is multiplication by the inverse. -/
   div_eq_mul_inv : ∀ a b : α, a / b = a * b⁻¹
+  /-- Zero is not equal to one: fields are non trivial.-/
   zero_ne_one : (0 : α) ≠ 1
+  /-- The inverse of zero is zero. This is a "junk value" convention. -/
   inv_zero : (0 : α)⁻¹ = 0
+  /-- The inverse of a non-zero element is a right inverse. -/
   mul_inv_cancel : ∀ {a : α}, a ≠ 0 → a * a⁻¹ = 1
 
 attribute [instance 100] Field.toInv Field.toDiv

src/Init/Grind/Ring/ToInt.lean

@@ -0,0 +1,27 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+
+prelude
+import Init.Grind.Ring.Basic
+import Init.Grind.ToInt
+
+namespace Lean.Grind
+
+/-- A `ToInt` instance on a semiring preserves powers if it preserves numerals and multiplication. -/
+def ToInt.pow_of_semiring [Semiring α] [ToInt α I] [ToInt.OfNat α I] [ToInt.Mul α I]
+    (h₁ : I.isFinite) : ToInt.Pow α I where
+  toInt_pow x n := by
+    induction n with
+    | zero =>
+      rw [Semiring.pow_zero, ToInt.OfNat.toInt_ofNat, Int.pow_zero]
+      rfl
+    | succ n ih =>
+      rw [Semiring.pow_succ, ToInt.Mul.toInt_mul]
+      conv => lhs; rw [← ToInt.wrap_toInt I x]
+      rw [ih, ← I.wrap_mul h₁, Int.pow_succ]
+
+end Lean.Grind

src/Init/Grind/ToInt.lean

@@ -25,72 +25,169 @@ These typeclasses are used solely in the `grind` tactic to lift linear inequalit
 
 namespace Lean.Grind
 
-class ToInt (α : Type u) (lo? hi? : outParam (Option Int)) where
-  toInt : α → Int
-  toInt_inj : ∀ x y, toInt x = toInt y → x = y
-  le_toInt : lo? = some lo → lo ≤ toInt x
-  toInt_lt : hi? = some hi → toInt x < hi
+/-- An interval in the integers (either finite, half-infinite, or infinite). -/
+inductive IntInterval : Type where
+  | /-- The finite interval `[lo, hi)`. -/
+    co (lo hi : Int)
+  | /-- The half-infinite interval `[lo, ∞)`. -/
+    ci (lo : Int)
+  | /-- The half-infinite interval `(-∞, hi)`. -/
+    io (hi : Int)
+  | /-- The infinite interval `(-∞, ∞)`. -/
+    ii
+  deriving BEq, DecidableEq
+
+instance : LawfulBEq IntInterval where
+   rfl := by intro a; cases a <;> simp_all! [BEq.beq]
+   eq_of_beq := by intro a b; cases a <;> cases b <;> simp_all! [BEq.beq]
+
+namespace IntInterval
+
+/-- The interval `[0, 2^n)`. -/
+abbrev uint (n : Nat) := IntInterval.co 0 (2 ^ n)
+/-- The interval `[-2^(n-1), 2^(n-1))`. -/
+abbrev sint (n : Nat) := IntInterval.co (-(2 ^ (n - 1))) (2 ^ (n - 1))
+
+/-- The lower bound of the interval, if finite. -/
+def lo? (i : IntInterval) : Option Int :=
+  match i with
+  | co lo _ => some lo
+  | ci lo => some lo
+  | io _ => none
+  | ii => none
+
+/-- The upper bound of the interval, if finite. -/
+def hi? (i : IntInterval) : Option Int :=
+  match i with
+  | co _ hi => some hi
+  | ci _ => none
+  | io hi => some hi
+  | ii => none
 
 @[simp]
-def ToInt.wrap (lo? hi? : Option Int) (x : Int) : Int :=
-  match lo?, hi? with
-  | some lo, some hi => (x - lo) % (hi - lo) + lo
-  | _, _ => x
+def nonEmpty (i : IntInterval) : Bool :=
+  match i with
+  | co lo hi => lo < hi
+  | ci _ => true
+  | io _ => true
+  | ii => true
 
-class ToInt.Zero (α : Type u) [Zero α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  toInt_zero : toInt (0 : α) = wrap lo? hi? 0
+@[simp]
+def isFinite (i : IntInterval) : Bool :=
+  match i with
+  | co _ _ => true
+  | ci _
+  | io _
+  | ii => false
 
-class ToInt.Add (α : Type u) [Add α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  toInt_add : ∀ x y : α, toInt (x + y) = wrap lo? hi? (toInt x + toInt y)
+def mem (i : IntInterval) (x : Int) : Prop :=
+  match i with
+  | co lo hi => lo ≤ x ∧ x < hi
+  | ci lo => lo ≤ x
+  | io hi => x < hi
+  | ii => True
 
-class ToInt.Neg (α : Type u) [Neg α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  toInt_neg : ∀ x : α, toInt (-x) = wrap lo? hi? (-toInt x)
+instance : Membership Int IntInterval where
+  mem := mem
 
-class ToInt.Sub (α : Type u) [Sub α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  toInt_sub : ∀ x y : α, toInt (x - y) = wrap lo? hi? (toInt x - toInt y)
+@[simp] theorem mem_co (lo hi : Int) (x : Int) : x ∈ IntInterval.co lo hi ↔ lo ≤ x ∧ x < hi := by rfl
+@[simp] theorem mem_ci (lo : Int) (x : Int) : x ∈ IntInterval.ci lo ↔ lo ≤ x := by rfl
+@[simp] theorem mem_io (hi : Int) (x : Int) : x ∈ IntInterval.io hi ↔ x < hi := by rfl
+@[simp] theorem mem_ii (x : Int) : x ∈ IntInterval.ii ↔ True := by rfl
 
-class ToInt.Mod (α : Type u) [Mod α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  /-- One might expect a `wrap` on the right hand side,
-  but in practice this stronger statement is usually true. -/
-  toInt_mod : ∀ x y : α, toInt (x % y) = toInt x % toInt y
+theorem nonEmpty_of_mem {x : Int} {i : IntInterval} (h : x ∈ i) : i.nonEmpty := by
+  cases i <;> simp_all <;> omega
 
-class ToInt.LE (α : Type u) [LE α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  le_iff : ∀ x y : α, x ≤ y ↔ toInt x ≤ toInt y
+@[simp]
+def wrap (i : IntInterval) (x : Int) : Int :=
+  match i with
+  | co lo hi => (x - lo) % (hi - lo) + lo
+  | ci lo => max x lo
+  | io hi => min x (hi - 1)
+  | ii => x
 
-class ToInt.LT (α : Type u) [LT α] (lo? hi? : outParam (Option Int)) [ToInt α lo? hi?] where
-  lt_iff : ∀ x y : α, x < y ↔ toInt x < toInt y
+theorem wrap_wrap (i : IntInterval) (x : Int) :
+    wrap i (wrap i x) = wrap i x := by
+  cases i <;> simp [wrap] <;> omega
 
-/-! ## Helper theorems -/
+theorem wrap_mem (i : IntInterval) (h : i.nonEmpty) (x : Int) :
+    i.wrap x ∈ i := by
+  match i with
+  | co lo hi =>
+    simp [wrap]
+    simp at h
+    constructor
+    · apply Int.le_add_of_nonneg_left
+      apply Int.emod_nonneg
+      omega
+    · have := Int.emod_lt (x - lo) (b := hi - lo) (by omega)
+      omega
+  | ci lo =>
+    simp [wrap]
+    omega
+  | io hi =>
+    simp [wrap]
+    omega
+  | ii =>
+    simp [wrap]
 
-theorem ToInt.wrap_add (lo? hi? : Option Int) (x y : Int) :
-    ToInt.wrap lo? hi? (x + y) = ToInt.wrap lo? hi? (ToInt.wrap lo? hi? x + ToInt.wrap lo? hi? y) := by
-  simp only [wrap]
-  split <;> rename_i lo hi
-  · dsimp
-    rw [Int.add_left_inj, Int.emod_eq_emod_iff_emod_sub_eq_zero, Int.emod_def (x - lo), Int.emod_def (y - lo)]
-    have : (x + y - lo -
-        (x - lo - (hi - lo) * ((x - lo) / (hi - lo)) + lo +
-          (y - lo - (hi - lo) * ((y - lo) / (hi - lo)) + lo) - lo)) =
-        (hi - lo) * ((x - lo) / (hi - lo) + (y - lo) / (hi - lo)) := by
+theorem wrap_eq_self_iff (i : IntInterval) (h : i.nonEmpty) (x : Int) :
+    i.wrap x = x ↔ x ∈ i := by
+  match i with
+  | co lo hi =>
+    simp [wrap]
+    simp at h
+    constructor
+    · have := Int.emod_lt (x - lo) (b := hi - lo) (by omega)
+      have := Int.emod_nonneg (x - lo) (b := hi - lo) (by omega)
+      omega
+    · intro w
+      rw [Int.emod_eq_of_lt] <;> omega
+  | ci lo =>
+    simp [wrap]
+    omega
+  | io hi =>
+    simp [wrap]
+    omega
+  | ii =>
+    simp [wrap]
+
+theorem wrap_add {i : IntInterval} (h : i.isFinite) (x y : Int) :
+    i.wrap (x + y) = i.wrap (i.wrap x + i.wrap y) := by
+  match i with
+  | co lo hi =>
+    simp [wrap]
+    rw [Int.emod_eq_emod_iff_emod_sub_eq_zero, Int.emod_def (x - lo), Int.emod_def (y - lo)]
+    have : (x + y - lo - (x - lo - (hi - lo) * ((x - lo) / (hi - lo)) + lo + (y - lo - (hi - lo) * ((y - lo) / (hi - lo)) + lo) - lo)) =
+      (hi - lo) * ((x - lo) / (hi - lo) + (y - lo) / (hi - lo)) := by
       simp only [Int.mul_add]
       omega
     rw [this]
     exact Int.mul_emod_right ..
-  · simp
 
-@[simp]
-theorem ToInt.wrap_toInt (lo? hi? : Option Int) [ToInt α lo? hi?] (x : α) :
-    ToInt.wrap lo? hi? (ToInt.toInt x) = ToInt.toInt x := by
-  simp only [wrap]
-  split
-  · have := ToInt.le_toInt (x := x) rfl
-    have := ToInt.toInt_lt (x := x) rfl
-    rw [Int.emod_eq_of_lt (by omega) (by omega)]
-    omega
-  · rfl
+theorem wrap_mul {i : IntInterval} (h : i.isFinite) (x y : Int) :
+    i.wrap (x * y) = i.wrap (i.wrap x * i.wrap y) := by
+  match i with
+  | co lo hi =>
+    dsimp [wrap]
+    rw [Int.add_left_inj, Int.emod_eq_emod_iff_emod_sub_eq_zero, Int.emod_def (x - lo), Int.emod_def (y - lo)]
+    have : x - lo - (hi - lo) * ((x - lo) / (hi - lo)) + lo = x - (hi - lo) * ((x - lo) / (hi - lo)) := by omega
+    rw [this]; clear this
+    have : y - lo - (hi - lo) * ((y - lo) / (hi - lo)) + lo = y - (hi - lo) * ((y - lo) / (hi - lo)) := by omega
+    rw [this]; clear this
+    have : x * y - lo - ((x - (hi - lo) * ((x - lo) / (hi - lo))) * (y - (hi - lo) * ((y - lo) / (hi - lo))) - lo) =
+      x * y - (x - (hi - lo) * ((x - lo) / (hi - lo))) * (y - (hi - lo) * ((y - lo) / (hi - lo))) := by omega
+    rw [this]; clear this
+    have : (x - (hi - lo) * ((x - lo) / (hi - lo))) * (y - (hi - lo) * ((y - lo) / (hi - lo))) =
+        x * y - (hi - lo) * (x * ((y - lo) / (hi - lo)) + (x - lo) / (hi - lo) * (y - (hi - lo) * ((y - lo) / (hi - lo)))) := by
+      conv => lhs; rw [Int.sub_mul, Int.mul_sub, Int.mul_left_comm, Int.sub_sub, Int.mul_assoc, ← Int.mul_add]
+    rw [this]; clear this
+    rw [Int.sub_sub_self]
+    apply Int.mul_emod_right
 
-theorem ToInt.wrap_eq_bmod {i : Int} (h : 0 ≤ i) :
-    ToInt.wrap (some (-i)) (some i) x = x.bmod ((2 * i).toNat) := by
+theorem wrap_eq_bmod {i : Int} (h : 0 ≤ i) :
+    (IntInterval.co (-i) i).wrap  x = x.bmod ((2 * i).toNat) := by
+  dsimp only [wrap]
   match i, h with
   | (i : Nat), _ =>
     have : (2 * (i : Int)).toNat = 2 * i := by omega
@@ -127,21 +224,138 @@ theorem ToInt.wrap_eq_bmod {i : Int} (h : 0 ≤ i) :
         rw [this]
         exact Int.dvd_mul_right ..
 
-theorem ToInt.wrap_eq_wrap_iff :
-    ToInt.wrap (some lo) (some hi) x = ToInt.wrap (some lo) (some hi) y ↔ (x - y) % (hi - lo) = 0 := by
+theorem wrap_eq_wrap_iff :
+    (IntInterval.co lo hi).wrap x = (IntInterval.co lo hi).wrap y ↔ (x - y) % (hi - lo) = 0 := by
   simp only [wrap]
   rw [Int.add_left_inj]
   rw [Int.emod_eq_emod_iff_emod_sub_eq_zero]
-  have : x - lo - (y - lo)  = x - y := by omega
+  have : x - lo - (y - lo) = x - y := by omega
   rw [this]
 
+end IntInterval
+
+/--
+`ToInt α I` asserts that `α` can be embedded faithfully into an interval `I` in the integers.
+-/
+class ToInt (α : Type u) (range : outParam IntInterval) where
+  /-- The embedding function. -/
+  toInt : α → Int
+  /-- The embedding function is injective. -/
+  toInt_inj : ∀ x y, toInt x = toInt y → x = y
+  /-- The embedding function lands in the interval. -/
+  toInt_mem : ∀ x, toInt x ∈ range
+
+/--
+The embedding into the integers takes `0` to `0`.
+-/
+class ToInt.Zero (α : Type u) [Zero α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes `0` to `0`. -/
+  toInt_zero : toInt (0 : α) = 0
+
+/--
+The embedding into the integers takes numerals in the range interval to themselves.
+-/
+class ToInt.OfNat (α : Type u) [∀ n, OfNat α n] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes `OfNat` to `OfNat`. -/
+  toInt_ofNat : ∀ n : Nat, toInt (OfNat.ofNat n : α) = I.wrap n
+
+/--
+The embedding into the integers takes addition to addition, wrapped into the range interval.
+-/
+class ToInt.Add (α : Type u) [Add α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes addition to addition, wrapped into the range interval. -/
+  toInt_add : ∀ x y : α, toInt (x + y) = I.wrap (toInt x + toInt y)
+
+/--
+The embedding into the integers takes negation to negation, wrapped into the range interval.
+-/
+class ToInt.Neg (α : Type u) [Neg α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes negation to negation, wrapped into the range interval. -/
+  toInt_neg : ∀ x : α, toInt (-x) = I.wrap (-toInt x)
+
+/--
+The embedding into the integers takes subtraction to subtraction, wrapped into the range interval.
+-/
+class ToInt.Sub (α : Type u) [Sub α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes subtraction to subtraction, wrapped into the range interval. -/
+  toInt_sub : ∀ x y : α, toInt (x - y) = I.wrap (toInt x - toInt y)
+
+/--
+The embedding into the integers takes multiplication to multiplication, wrapped into the range interval.
+-/
+class ToInt.Mul (α : Type u) [Mul α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes multiplication to multiplication, wrapped into the range interval. -/
+  toInt_mul : ∀ x y : α, toInt (x * y) = I.wrap (toInt x * toInt y)
+
+/--
+The embedding into the integers takes exponentiation to exponentiation, wrapped into the range interval.
+-/
+class ToInt.Pow (α : Type u) [HPow α Nat α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding takes exponentiation to exponentiation, wrapped into the range interval. -/
+  toInt_pow : ∀ x : α, ∀ n : Nat, toInt (x ^ n) = I.wrap (toInt x ^ n)
+
+/--
+The embedding into the integers takes modulo to modulo (without needing to wrap into the range interval).
+-/
+class ToInt.Mod (α : Type u) [Mod α] (I : outParam IntInterval) [ToInt α I] where
+  /--
+  The embedding takes modulo to modulo (without needing to wrap into the range interval).
+  One might expect a `wrap` on the right hand side,
+  but in practice this stronger statement is usually true.
+  -/
+  toInt_mod : ∀ x y : α, toInt (x % y) = toInt x % toInt y
+
+/--
+The embedding into the integers takes division to division, wrapped into the range interval.
+-/
+class ToInt.Div (α : Type u) [Div α] (I : outParam IntInterval) [ToInt α I] where
+  /--
+  The embedding takes division to division (without needing to wrap into the range interval).
+  One might expect a `wrap` on the right hand side,
+  but in practice this stronger statement is usually true.
+  -/
+  toInt_div : ∀ x y : α, toInt (x / y) = toInt x / toInt y
+
+/--
+The embedding into the integers is monotone.
+-/
+class ToInt.LE (α : Type u) [LE α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding is monotone with respect to `≤`. -/
+  le_iff : ∀ x y : α, x ≤ y ↔ toInt x ≤ toInt y
+
+/--
+The embedding into the integers is strictly monotone.
+-/
+class ToInt.LT (α : Type u) [LT α] (I : outParam IntInterval) [ToInt α I] where
+  /-- The embedding is strictly monotone with respect to `<`. -/
+  lt_iff : ∀ x y : α, x < y ↔ toInt x < toInt y
+
+open IntInterval
+namespace ToInt
+
+/-! ## Helper theorems -/
+
+theorem Zero.wrap_zero (I : IntInterval) [_root_.Zero α] [ToInt α I] [ToInt.Zero α I] :
+    I.wrap 0 = 0 := by
+  have := toInt_mem (0 : α)
+  rw [I.wrap_eq_self_iff (I.nonEmpty_of_mem this)]
+  rwa [ToInt.Zero.toInt_zero] at this
+
+@[simp]
+theorem wrap_toInt (I : IntInterval) [ToInt α I] (x : α) :
+    I.wrap (toInt x) = toInt x := by
+  rw [I.wrap_eq_self_iff (I.nonEmpty_of_mem (toInt_mem x))]
+  exact ToInt.toInt_mem x
+
 /-- Construct a `ToInt.Sub` instance from a `ToInt.Add` and `ToInt.Neg` instance and
 a `sub_eq_add_neg` assumption. -/
-def ToInt.Sub.of_sub_eq_add_neg {α : Type u} [_root_.Add α] [_root_.Neg α] [_root_.Sub α]
+def Sub.of_sub_eq_add_neg {α : Type u} [_root_.Add α] [_root_.Neg α] [_root_.Sub α]
     (sub_eq_add_neg : ∀ x y : α, x - y = x + -y)
-    {lo? hi? : Option Int} [ToInt α lo? hi?] [Add α lo? hi?] [Neg α lo? hi?] : ToInt.Sub α lo? hi? where
+    {I : IntInterval} (h : I.isFinite) [ToInt α I] [Add α I] [Neg α I] : ToInt.Sub α I where
   toInt_sub x y := by
     rw [sub_eq_add_neg, ToInt.Add.toInt_add, ToInt.Neg.toInt_neg, Int.sub_eq_add_neg]
-    conv => rhs; rw [ToInt.wrap_add, ToInt.wrap_toInt]
+    conv => rhs; rw [wrap_add h, ToInt.wrap_toInt]
+
+end ToInt
 
 end Lean.Grind

src/Init/Grind/ToIntLemmas.lean

@@ -0,0 +1,133 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+module
+
+prelude
+import all Init.Grind.ToInt
+
+namespace Lean.Grind.ToInt
+
+/-! Wrap -/
+
+theorem of_eq_wrap_co_0 (i : IntInterval) (hi : Int) (h : i == .co 0 hi) {a b : Int} : a = i.wrap b → a = b % hi := by
+  revert h
+  cases i <;> simp
+  intro h₁ h₂; subst h₁ h₂; simp
+
+/-! Asserted propositions -/
+
+theorem of_eq {α i} [ToInt α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : a = b → a' = b' := by
+  intro h; replace h := congrArg toInt h
+  rw [h₁, h₂] at h; assumption
+
+theorem of_diseq {α i} [ToInt α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : a ≠ b → a' ≠ b' := by
+  intro hne h; rw [← h₁, ← h₂] at h
+  replace h := ToInt.toInt_inj _ _ h; contradiction
+
+theorem of_le {α i} [ToInt α i] [_root_.LE α] [ToInt.LE α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : a ≤ b → a' ≤ b' := by
+  intro h; replace h := ToInt.LE.le_iff _ _ |>.mp h
+  rw [h₁, h₂] at h; assumption
+
+theorem of_not_le {α i} [ToInt α i] [_root_.LE α] [ToInt.LE α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : ¬ (a ≤ b) → b' + 1 ≤ a' := by
+  intro h; have h' := ToInt.LE.le_iff a b
+  simp [h, h₁, h₂] at h'; exact h'
+
+theorem of_lt {α i} [ToInt α i] [_root_.LT α] [ToInt.LT α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : a < b → a' + 1 ≤ b' := by
+  intro h; replace h := ToInt.LT.lt_iff _ _ |>.mp h
+  rw [h₁, h₂] at h; assumption
+
+theorem of_not_lt {α i} [ToInt α i] [_root_.LT α] [ToInt.LT α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : ¬ (a < b) → b' ≤ a' := by
+  intro h; have h' := ToInt.LT.lt_iff a b
+  simp [h, h₁, h₂] at h'; assumption
+
+/-! Addition -/
+
+theorem add_congr {α i} [ToInt α i] [_root_.Add α] [ToInt.Add α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : toInt (a + b) = i.wrap (a' + b') := by
+  rw [ToInt.Add.toInt_add, h₁, h₂]
+
+theorem add_congr.ww {α i} [ToInt α i] [_root_.Add α] [ToInt.Add α i] (h : i.isFinite) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = i.wrap a') (h₂ : toInt b = i.wrap b') : toInt (a + b) = i.wrap (a' + b') := by
+  rw [add_congr h₁ h₂, ← i.wrap_add h]
+
+theorem add_congr.wr {α i} [ToInt α i] [_root_.Add α] [ToInt.Add α i] (h : i.isFinite) (h' : i.nonEmpty) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = i.wrap b') : toInt (a + b) = i.wrap (a' + b') := by
+  have := i.wrap_eq_self_iff h' _ |>.mpr (ToInt.toInt_mem a)
+  rw [h₁] at this; rw [← this] at h₁; apply add_congr.ww h h₁ h₂
+
+theorem add_congr.wl {α i} [ToInt α i] [_root_.Add α] [ToInt.Add α i] (h : i.isFinite) (h' : i.nonEmpty) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = i.wrap a') (h₂ : toInt b = b') : toInt (a + b) = i.wrap (a' + b') := by
+  have := i.wrap_eq_self_iff h' _ |>.mpr (ToInt.toInt_mem b)
+  rw [h₂] at this; rw [← this] at h₂; apply add_congr.ww h h₁ h₂
+
+/-! Multiplication -/
+
+theorem mul_congr {α i} [ToInt α i] [_root_.Mul α] [ToInt.Mul α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : toInt (a * b) = i.wrap (a' * b') := by
+  rw [ToInt.Mul.toInt_mul, h₁, h₂]
+
+theorem mul_congr.ww {α i} [ToInt α i] [_root_.Mul α] [ToInt.Mul α i] (h : i.isFinite) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = i.wrap a') (h₂ : toInt b = i.wrap b') : toInt (a * b) = i.wrap (a' * b') := by
+  rw [ToInt.Mul.toInt_mul, h₁, h₂, ← i.wrap_mul]; apply h
+
+theorem mul_congr.wr {α i} [ToInt α i] [_root_.Mul α] [ToInt.Mul α i] (h : i.isFinite) (h' : i.nonEmpty) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = i.wrap b') : toInt (a * b) = i.wrap (a' * b') := by
+  have := i.wrap_eq_self_iff h' _ |>.mpr (ToInt.toInt_mem a)
+  rw [h₁] at this; rw [← this] at h₁; apply mul_congr.ww h h₁ h₂
+
+theorem mul_congr.wl {α i} [ToInt α i] [_root_.Mul α] [ToInt.Mul α i] (h : i.isFinite) (h' : i.nonEmpty) {a b : α} {a' b' : Int}
+    (h₁ : toInt a = i.wrap a') (h₂ : toInt b = b') : toInt (a * b) = i.wrap (a' * b') := by
+  have := i.wrap_eq_self_iff h' _ |>.mpr (ToInt.toInt_mem b)
+  rw [h₂] at this; rw [← this] at h₂; apply mul_congr.ww h h₁ h₂
+
+/-! Subtraction -/
+
+theorem sub_congr {α i} [ToInt α i] [_root_.Sub α] [ToInt.Sub α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : toInt (a - b) = i.wrap (a' - b') := by
+  rw [ToInt.Sub.toInt_sub, h₁, h₂]
+
+/-! Negation -/
+
+theorem neg_congr {α i} [ToInt α i] [_root_.Neg α] [ToInt.Neg α i] {a : α} {a' : Int}
+    (h₁ : toInt a = a') : toInt (- a) = i.wrap (- a') := by
+  rw [ToInt.Neg.toInt_neg, h₁]
+
+/-! Power -/
+
+theorem pow_congr {α i} [ToInt α i] [HPow α Nat α] [ToInt.Pow α i] {a : α} (k : Nat) (a' : Int)
+    (h₁ : toInt a = a') : toInt (a ^ k) = i.wrap (a' ^ k) := by
+  rw [ToInt.Pow.toInt_pow, h₁]
+
+/-! Division -/
+
+theorem div_congr {α i} [ToInt α i] [_root_.Div α] [ToInt.Div α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : toInt (a / b) = a' / b' := by
+  rw [ToInt.Div.toInt_div, h₁, h₂]
+
+/-! Modulo -/
+
+theorem mod_congr {α i} [ToInt α i] [_root_.Mod α] [ToInt.Mod α i] {a b : α} {a' b' : Int}
+    (h₁ : toInt a = a') (h₂ : toInt b = b') : toInt (a % b) = a' % b' := by
+  rw [ToInt.Mod.toInt_mod, h₁, h₂]
+
+/-! OfNat -/
+
+theorem ofNat_eq {α i} [ToInt α i] [∀ n, _root_.OfNat α n] [ToInt.OfNat α i] (n : Nat)
+    : toInt (OfNat.ofNat (α := α) n) = i.wrap n := by
+  apply ToInt.OfNat.toInt_ofNat
+
+/-! Zero -/
+
+theorem zero_eq {α i} [ToInt α i] [_root_.Zero α] [ToInt.Zero α i] : toInt (0 : α) = 0 := by
+  apply ToInt.Zero.toInt_zero
+
+end Lean.Grind.ToInt

src/Init/GrindInstances/Ring/BitVec.lean

@@ -9,6 +9,7 @@ prelude
 import Init.Grind.Ring.Basic
 import Init.GrindInstances.ToInt
 import all Init.Data.BitVec.Basic
+import all Init.Grind.ToInt
 
 namespace Lean.Grind
 
@@ -35,8 +36,11 @@ instance : IsCharP (BitVec w) (2 ^ w) := IsCharP.mk' _ _
   (ofNat_eq_zero_iff := fun x => by simp [BitVec.toNat_eq])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add (BitVec w) (some 0) (some (2^w)) := inferInstance
-example : ToInt.Neg (BitVec w) (some 0) (some (2^w)) := inferInstance
-example : ToInt.Sub (BitVec w) (some 0) (some (2^w)) := inferInstance
+example : ToInt.Add (BitVec w) (.uint w) := inferInstance
+example : ToInt.Neg (BitVec w) (.uint w) := inferInstance
+example : ToInt.Sub (BitVec w) (.uint w) := inferInstance
+
+instance : ToInt.Pow (BitVec w) (.uint w) :=
+  ToInt.pow_of_semiring (by simp)
 
 end Lean.Grind

src/Init/GrindInstances/Ring/Fin.lean

@@ -8,7 +8,7 @@ module
 prelude
 import all Init.Data.Zero
 import Init.Grind.Ring.Basic
-import Init.GrindInstances.ToInt
+import all Init.GrindInstances.ToInt
 import Init.Data.Fin.Lemmas
 
 namespace Lean.Grind
@@ -23,6 +23,9 @@ def npow [NeZero n] (x : Fin n) (y : Nat) : Fin n := npowRec y x
 instance [NeZero n] : HPow (Fin n) Nat (Fin n) where
   hPow := Fin.npow
 
+instance [NeZero n] : Pow (Fin n) Nat where
+  pow := Fin.npow
+
 @[simp] theorem pow_zero [NeZero n] (a : Fin n) : a ^ 0 = 1 := rfl
 @[simp] theorem pow_succ [NeZero n] (a : Fin n) (n : Nat) : a ^ (n+1) = a ^ n * a := rfl
 
@@ -101,8 +104,21 @@ instance (n : Nat) [NeZero n] : IsCharP (Fin n) n := IsCharP.mk' _ _
     simp only [Nat.zero_mod]
     simp only [Fin.mk.injEq])
 
-example [NeZero n] : ToInt.Neg (Fin n) (some 0) (some n) := inferInstance
-example [NeZero n] : ToInt.Sub (Fin n) (some 0) (some n) := inferInstance
+example [NeZero n] : ToInt.Neg (Fin n) (.co 0 n) := inferInstance
+example [NeZero n] : ToInt.Sub (Fin n) (.co 0 n) := inferInstance
+
+instance [i : NeZero n] : ToInt.Pow (Fin n) (.co 0 n) where
+  toInt_pow x k := by
+    induction k with
+    | zero =>
+      match n, i with
+      | 1, _ => rfl
+      | (n + 2), _ =>
+        simp [IntInterval.wrap, Int.sub_zero, Int.add_zero]
+        rw [Int.emod_eq_of_lt] <;> omega
+    | succ k ih =>
+      rw [pow_succ, ToInt.Mul.toInt_mul, ih, ← ToInt.wrap_toInt,
+        ← IntInterval.wrap_mul (by simp), Int.pow_succ, ToInt.wrap_toInt]
 
 end Fin
 

src/Init/GrindInstances/Ring/SInt.lean

@@ -7,6 +7,7 @@ module
 
 prelude
 import Init.Grind.Ring.Basic
+import all Init.Grind.ToInt
 import Init.GrindInstances.ToInt
 import all Init.Data.BitVec.Basic
 import all Init.Data.SInt.Basic
@@ -47,9 +48,11 @@ instance : IsCharP Int8 (2 ^ 8) := IsCharP.mk' _ _
       ← Int.dvd_iff_bmod_eq_zero, ← Nat.dvd_iff_mod_eq_zero, Int.ofNat_dvd_right])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add Int8 (some (-(2^7))) (some (2^7)) := inferInstance
-example : ToInt.Neg Int8 (some (-(2^7))) (some (2^7)) := inferInstance
-example : ToInt.Sub Int8 (some (-(2^7))) (some (2^7)) := inferInstance
+example : ToInt.Add Int8 (.sint 8) := inferInstance
+example : ToInt.Neg Int8 (.sint 8) := inferInstance
+example : ToInt.Sub Int8 (.sint 8) := inferInstance
+
+instance : ToInt.Pow Int8 (.sint 8) := ToInt.pow_of_semiring (by simp)
 
 instance : NatCast Int16 where
   natCast x := Int16.ofNat x
@@ -84,9 +87,11 @@ instance : IsCharP Int16 (2 ^ 16) := IsCharP.mk' _ _
       ← Int.dvd_iff_bmod_eq_zero, ← Nat.dvd_iff_mod_eq_zero, Int.ofNat_dvd_right])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add Int16 (some (-(2^15))) (some (2^15)) := inferInstance
-example : ToInt.Neg Int16 (some (-(2^15))) (some (2^15)) := inferInstance
-example : ToInt.Sub Int16 (some (-(2^15))) (some (2^15)) := inferInstance
+example : ToInt.Add Int16 (.sint 16) := inferInstance
+example : ToInt.Neg Int16 (.sint 16) := inferInstance
+example : ToInt.Sub Int16 (.sint 16) := inferInstance
+
+instance : ToInt.Pow Int16 (.sint 16) := ToInt.pow_of_semiring (by simp)
 
 instance : NatCast Int32 where
   natCast x := Int32.ofNat x
@@ -121,9 +126,11 @@ instance : IsCharP Int32 (2 ^ 32) := IsCharP.mk' _ _
       ← Int.dvd_iff_bmod_eq_zero, ← Nat.dvd_iff_mod_eq_zero, Int.ofNat_dvd_right])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add Int32 (some (-(2^31))) (some (2^31)) := inferInstance
-example : ToInt.Neg Int32 (some (-(2^31))) (some (2^31)) := inferInstance
-example : ToInt.Sub Int32 (some (-(2^31))) (some (2^31)) := inferInstance
+example : ToInt.Add Int32 (.sint 32) := inferInstance
+example : ToInt.Neg Int32 (.sint 32) := inferInstance
+example : ToInt.Sub Int32 (.sint 32) := inferInstance
+
+instance : ToInt.Pow Int32 (.sint 32) := ToInt.pow_of_semiring (by simp)
 
 instance : NatCast Int64 where
   natCast x := Int64.ofNat x
@@ -158,9 +165,11 @@ instance : IsCharP Int64 (2 ^ 64) := IsCharP.mk' _ _
       ← Int.dvd_iff_bmod_eq_zero, ← Nat.dvd_iff_mod_eq_zero, Int.ofNat_dvd_right])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add Int64 (some (-(2^63))) (some (2^63)) := inferInstance
-example : ToInt.Neg Int64 (some (-(2^63))) (some (2^63)) := inferInstance
-example : ToInt.Sub Int64 (some (-(2^63))) (some (2^63)) := inferInstance
+example : ToInt.Add Int64 (.sint 64) := inferInstance
+example : ToInt.Neg Int64 (.sint 64) := inferInstance
+example : ToInt.Sub Int64 (.sint 64) := inferInstance
+
+instance : ToInt.Pow Int64 (.sint 64) := ToInt.pow_of_semiring (by simp)
 
 instance : NatCast ISize where
   natCast x := ISize.ofNat x
@@ -196,8 +205,11 @@ instance : IsCharP ISize (2 ^ numBits) := IsCharP.mk' _ _
       ← Int.dvd_iff_bmod_eq_zero, ← Nat.dvd_iff_mod_eq_zero, Int.ofNat_dvd_right])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add ISize (some (-(2^(numBits-1)))) (some (2^(numBits-1))) := inferInstance
-example : ToInt.Neg ISize (some (-(2^(numBits-1)))) (some (2^(numBits-1))) := inferInstance
-example : ToInt.Sub ISize (some (-(2^(numBits-1)))) (some (2^(numBits-1))) := inferInstance
+example : ToInt.Add ISize (.sint numBits) := inferInstance
+example : ToInt.Neg ISize (.sint numBits) := inferInstance
+example : ToInt.Sub ISize (.sint numBits) := inferInstance
+
+instance : ToInt.Pow ISize (.sint numBits) :=
+  ToInt.pow_of_semiring (by simp)
 
 end Lean.Grind

src/Init/GrindInstances/Ring/UInt.lean

@@ -7,7 +7,7 @@ module
 
 prelude
 import Init.Grind.Ring.Basic
-import Init.GrindInstances.ToInt
+import all Init.GrindInstances.ToInt
 import all Init.Data.UInt.Basic
 import Init.Data.UInt.Lemmas
 
@@ -151,9 +151,11 @@ instance : IsCharP UInt8 256 := IsCharP.mk' _ _
     simp [this, UInt8.ofNat_eq_iff_mod_eq_toNat])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add UInt8 (some 0) (some (2^8)) := inferInstance
-example : ToInt.Neg UInt8 (some 0) (some (2^8)) := inferInstance
-example : ToInt.Sub UInt8 (some 0) (some (2^8)) := inferInstance
+example : ToInt.Add UInt8 (.uint 8) := inferInstance
+example : ToInt.Neg UInt8 (.uint 8) := inferInstance
+example : ToInt.Sub UInt8 (.uint 8) := inferInstance
+
+instance : ToInt.Pow UInt8 (.uint 8) := ToInt.pow_of_semiring (by simp)
 
 instance : CommRing UInt16 where
   add_assoc := UInt16.add_assoc
@@ -181,9 +183,11 @@ instance : IsCharP UInt16 65536 := IsCharP.mk' _ _
     simp [this, UInt16.ofNat_eq_iff_mod_eq_toNat])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add UInt16 (some 0) (some (2^16)) := inferInstance
-example : ToInt.Neg UInt16 (some 0) (some (2^16)) := inferInstance
-example : ToInt.Sub UInt16 (some 0) (some (2^16)) := inferInstance
+example : ToInt.Add UInt16 (.uint 16) := inferInstance
+example : ToInt.Neg UInt16 (.uint 16) := inferInstance
+example : ToInt.Sub UInt16 (.uint 16) := inferInstance
+
+instance : ToInt.Pow UInt16 (.uint 16) := ToInt.pow_of_semiring (by simp)
 
 instance : CommRing UInt32 where
   add_assoc := UInt32.add_assoc
@@ -211,9 +215,11 @@ instance : IsCharP UInt32 4294967296 := IsCharP.mk' _ _
     simp [this, UInt32.ofNat_eq_iff_mod_eq_toNat])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add UInt32 (some 0) (some (2^32)) := inferInstance
-example : ToInt.Neg UInt32 (some 0) (some (2^32)) := inferInstance
-example : ToInt.Sub UInt32 (some 0) (some (2^32)) := inferInstance
+example : ToInt.Add UInt32 (.uint 32) := inferInstance
+example : ToInt.Neg UInt32 (.uint 32) := inferInstance
+example : ToInt.Sub UInt32 (.uint 32) := inferInstance
+
+instance : ToInt.Pow UInt32 (.uint 32) := ToInt.pow_of_semiring (by simp)
 
 instance : CommRing UInt64 where
   add_assoc := UInt64.add_assoc
@@ -241,9 +247,11 @@ instance : IsCharP UInt64 18446744073709551616 := IsCharP.mk' _ _
     simp [this, UInt64.ofNat_eq_iff_mod_eq_toNat])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add UInt64 (some 0) (some (2^64)) := inferInstance
-example : ToInt.Neg UInt64 (some 0) (some (2^64)) := inferInstance
-example : ToInt.Sub UInt64 (some 0) (some (2^64)) := inferInstance
+example : ToInt.Add UInt64 (.uint 64) := inferInstance
+example : ToInt.Neg UInt64 (.uint 64) := inferInstance
+example : ToInt.Sub UInt64 (.uint 64) := inferInstance
+
+instance : ToInt.Pow UInt64 (.uint 64) := ToInt.pow_of_semiring (by simp)
 
 instance : CommRing USize where
   add_assoc := USize.add_assoc
@@ -273,8 +281,11 @@ instance : IsCharP USize (2 ^ numBits) := IsCharP.mk' _ _
     simp [this, USize.ofNat_eq_iff_mod_eq_toNat])
 
 -- Verify we can derive the instances showing how `toInt` interacts with operations:
-example : ToInt.Add USize (some 0) (some (2^numBits)) := inferInstance
-example : ToInt.Neg USize (some 0) (some (2^numBits)) := inferInstance
-example : ToInt.Sub USize (some 0) (some (2^numBits)) := inferInstance
+example : ToInt.Add USize (.uint numBits) := inferInstance
+example : ToInt.Neg USize (.uint numBits) := inferInstance
+example : ToInt.Sub USize (.uint numBits) := inferInstance
+
+instance : ToInt.Pow USize (.uint numBits) :=
+  ToInt.pow_of_semiring (by simp)
 
 end Lean.Grind

src/Init/GrindInstances/ToInt.lean

@@ -7,6 +7,8 @@ module
 
 prelude
 import all Init.Grind.ToInt
+import Init.Grind.Module.Basic
+import Init.Grind.Ring.ToInt
 import Init.Data.Int.DivMod.Basic
 import Init.Data.Int.Lemmas
 import Init.Data.Int.Order
@@ -18,343 +20,518 @@ namespace Lean.Grind
 
 /-! ## Instances for concrete types-/
 
-instance : ToInt Int none none where
+instance : ToInt Int .ii where
   toInt := id
   toInt_inj := by simp
-  le_toInt := by simp
-  toInt_lt := by simp
+  toInt_mem := by simp
 
 @[simp] theorem toInt_int (x : Int) : ToInt.toInt x = x := rfl
 
-instance : ToInt.Add Int none none where
+instance : ToInt.Zero Int .ii where
+  toInt_zero := by simp
+
+instance : ToInt.OfNat Int .ii where
+  toInt_ofNat _ := by simp; rfl
+
+instance : ToInt.Add Int .ii where
   toInt_add := by simp
 
-instance : ToInt.Neg Int none none where
+instance : ToInt.Neg Int .ii where
   toInt_neg x := by simp
 
-instance : ToInt.Sub Int none none where
+instance : ToInt.Sub Int .ii where
   toInt_sub x y := by simp
 
-instance : ToInt.Mod Int none none where
+instance : ToInt.Mul Int .ii where
+  toInt_mul x y := by simp
+
+instance : ToInt.Pow Int .ii where
+  toInt_pow x n := by simp
+
+instance : ToInt.Mod Int .ii where
   toInt_mod x y := by simp
 
-instance : ToInt.LE Int none none where
+instance : ToInt.Div Int .ii where
+  toInt_div x y := by simp
+
+instance : ToInt.LE Int .ii where
   le_iff x y := by simp
 
-instance : ToInt.LT Int none none where
+instance : ToInt.LT Int .ii where
   lt_iff x y := by simp
 
-instance : ToInt Nat (some 0) none where
+instance : ToInt Nat (.ci 0) where
   toInt := Nat.cast
   toInt_inj x y := Int.ofNat_inj.mp
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x
-  toInt_lt := by simp
+  toInt_mem := by simp
 
 @[simp] theorem toInt_nat (x : Nat) : ToInt.toInt x = (x : Int) := rfl
 
-instance : ToInt.Add Nat (some 0) none where
-  toInt_add := by simp
+instance : ToInt.Zero Nat (.ci 0) where
+  toInt_zero := by simp
 
-instance : ToInt.Mod Nat (some 0) none where
+instance : ToInt.OfNat Nat (.ci 0) where
+  toInt_ofNat _ := by simp; rfl
+
+instance : ToInt.Add Nat (.ci 0) where
+  toInt_add := by simp <;> omega
+
+instance : ToInt.Mul Nat (.ci 0) where
+  toInt_mul x y := by
+    dsimp only [IntInterval.wrap]
+    rw [Int.max_eq_left]
+    simp only [toInt_nat, Int.natCast_mul]
+    simp [toInt_nat, ← Int.natCast_mul]
+
+instance : ToInt.Pow Nat (.ci 0) where
+  toInt_pow x n := by
+    dsimp only [IntInterval.wrap]
+    rw [Int.max_eq_left]
+    simp only [toInt_nat, Int.natCast_pow]
+    simp [toInt_nat, ← Int.natCast_pow]
+
+instance : ToInt.Sub Nat (.ci 0) where
+  toInt_sub x y := by simp; omega
+
+instance : ToInt.Mod Nat (.ci 0) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE Nat (some 0) none where
+instance : ToInt.Div Nat (.ci 0) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE Nat (.ci 0) where
   le_iff x y := by simp
 
-instance : ToInt.LT Nat (some 0) none where
+instance : ToInt.LT Nat (.ci 0) where
   lt_iff x y := by simp
 
 -- Mathlib will add a `ToInt ℕ+ (some 1) none` instance.
 
-instance : ToInt (Fin n) (some 0) (some n) where
+instance : ToInt (Fin n) (.co 0 n) where
   toInt x := x.val
   toInt_inj x y w := Fin.eq_of_val_eq (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.natCast_nonneg x
-  toInt_lt {hi x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.ofNat_lt.mpr x.isLt
+  toInt_mem := by simp
 
 @[simp] theorem toInt_fin (x : Fin n) : ToInt.toInt x = (x.val : Int) := rfl
 
-instance : ToInt.Add (Fin n) (some 0) (some n) where
+instance [NeZero n] : ToInt.Zero (Fin n) (.co 0 n) where
+  toInt_zero := rfl
+
+instance [NeZero n] : ToInt.OfNat (Fin n) (.co 0 n) where
+  toInt_ofNat x := by simp; rfl
+
+instance : ToInt.Add (Fin n) (.co 0 n) where
   toInt_add x y := by rfl
 
-instance [NeZero n] : ToInt.Zero (Fin n) (some 0) (some n) where
-  toInt_zero := by rfl
-
 -- The `ToInt.Neg` and `ToInt.Sub` instances are generated automatically from the `IntModule (Fin n)` instance.
+-- See `Init.GrindInstances.Ring.Fin`.
 
-instance : ToInt.Mod (Fin n) (some 0) (some n) where
-  toInt_mod x y := by
-    simp only [toInt_fin, Fin.mod_val, Int.natCast_emod]
+instance : ToInt.Mul (Fin n) (.co 0 n) where
+  toInt_mul x y := by rfl
 
-instance : ToInt.LE (Fin n) (some 0) (some n) where
+-- The `IoInt.Pow` instance is defined in `Init.GrindInstances.Ring.Fin`,
+-- since the power operation is only defined there.
+
+instance : ToInt.Mod (Fin n) (.co 0 n) where
+  toInt_mod _ _ := rfl
+
+instance : ToInt.Div (Fin n) (.co 0 n) where
+  toInt_div _ _ := rfl
+
+instance : ToInt.LE (Fin n) (.co 0 n) where
   le_iff x y := by simpa using Fin.le_def
 
-instance : ToInt.LT (Fin n) (some 0) (some n) where
+instance : ToInt.LT (Fin n) (.co 0 n) where
   lt_iff x y := by simpa using Fin.lt_def
 
-instance : ToInt UInt8 (some 0) (some (2^8)) where
+instance : ToInt UInt8 (.uint 8) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w := UInt8.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt8.toNat_lt x)
+  toInt_mem x := by simpa using Int.lt_toNat.mp (UInt8.toNat_lt x)
 
 @[simp] theorem toInt_uint8 (x : UInt8) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add UInt8 (some 0) (some (2^8)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt8 (some 0) (some (2^8)) where
+instance : ToInt.Zero UInt8 (.uint 8) where
   toInt_zero := by simp
 
-instance : ToInt.Mod UInt8 (some 0) (some (2^8)) where
+instance : ToInt.OfNat UInt8 (.uint 8) where
+  toInt_ofNat x := by simp; rfl
+
+instance : ToInt.Add UInt8 (.uint 8) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul UInt8 (.uint 8) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.UInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod UInt8 (.uint 8) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE UInt8 (some 0) (some (2^8)) where
+instance : ToInt.Div UInt8 (.uint 8) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE UInt8 (.uint 8) where
   le_iff x y := by simpa using UInt8.le_iff_toBitVec_le
 
-instance : ToInt.LT UInt8 (some 0) (some (2^8)) where
+instance : ToInt.LT UInt8 (.uint 8) where
   lt_iff x y := by simpa using UInt8.lt_iff_toBitVec_lt
 
-instance : ToInt UInt16 (some 0) (some (2^16)) where
+instance : ToInt UInt16 (.uint 16) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w := UInt16.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt16.toNat_lt x)
+  toInt_mem x := by simpa using Int.lt_toNat.mp (UInt16.toNat_lt x)
 
 @[simp] theorem toInt_uint16 (x : UInt16) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add UInt16 (some 0) (some (2^16)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt16 (some 0) (some (2^16)) where
+instance : ToInt.Zero UInt16 (.uint 16) where
   toInt_zero := by simp
 
-instance : ToInt.Mod UInt16 (some 0) (some (2^16)) where
+instance : ToInt.OfNat UInt16 (.uint 16) where
+  toInt_ofNat x := by simp; rfl
+
+instance : ToInt.Add UInt16 (.uint 16) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul UInt16 (.uint 16) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.UInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod UInt16 (.uint 16) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE UInt16 (some 0) (some (2^16)) where
+instance : ToInt.Div UInt16 (.uint 16) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE UInt16 (.uint 16) where
   le_iff x y := by simpa using UInt16.le_iff_toBitVec_le
 
-instance : ToInt.LT UInt16 (some 0) (some (2^16)) where
+instance : ToInt.LT UInt16 (.uint 16) where
   lt_iff x y := by simpa using UInt16.lt_iff_toBitVec_lt
 
-instance : ToInt UInt32 (some 0) (some (2^32)) where
+instance : ToInt UInt32 (.uint 32) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w := UInt32.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt32.toNat_lt x)
+  toInt_mem x := by simpa using Int.lt_toNat.mp (UInt32.toNat_lt x)
 
 @[simp] theorem toInt_uint32 (x : UInt32) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add UInt32 (some 0) (some (2^32)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt32 (some 0) (some (2^32)) where
+instance : ToInt.Zero UInt32 (.uint 32) where
   toInt_zero := by simp
 
-instance : ToInt.Mod UInt32 (some 0) (some (2^32)) where
+instance : ToInt.OfNat UInt32 (.uint 32) where
+  toInt_ofNat x := by simp; rfl
+
+instance : ToInt.Add UInt32 (.uint 32) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul UInt32 (.uint 32) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.UInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod UInt32 (.uint 32) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE UInt32 (some 0) (some (2^32)) where
+instance : ToInt.Div UInt32 (.uint 32) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE UInt32 (.uint 32) where
   le_iff x y := by simpa using UInt32.le_iff_toBitVec_le
 
-instance : ToInt.LT UInt32 (some 0) (some (2^32)) where
+instance : ToInt.LT UInt32 (.uint 32) where
   lt_iff x y := by simpa using UInt32.lt_iff_toBitVec_lt
 
-instance : ToInt UInt64 (some 0) (some (2^64)) where
+instance : ToInt UInt64 (.uint 64) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w := UInt64.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt64.toNat_lt x)
+  toInt_mem x := by simpa using Int.lt_toNat.mp (UInt64.toNat_lt x)
 
 @[simp] theorem toInt_uint64 (x : UInt64) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add UInt64 (some 0) (some (2^64)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt64 (some 0) (some (2^64)) where
+instance : ToInt.Zero UInt64 (.uint 64) where
   toInt_zero := by simp
 
-instance : ToInt.Mod UInt64 (some 0) (some (2^64)) where
+instance : ToInt.OfNat UInt64 (.uint 64) where
+  toInt_ofNat x := by simp; rfl
+
+instance : ToInt.Add UInt64 (.uint 64) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul UInt64 (.uint 64) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.UInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod UInt64 (.uint 64) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE UInt64 (some 0) (some (2^64)) where
+instance : ToInt.Div UInt64 (.uint 64) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE UInt64 (.uint 64) where
   le_iff x y := by simpa using UInt64.le_iff_toBitVec_le
 
-instance : ToInt.LT UInt64 (some 0) (some (2^64)) where
+instance : ToInt.LT UInt64 (.uint 64) where
   lt_iff x y := by simpa using UInt64.lt_iff_toBitVec_lt
 
-instance : ToInt USize (some 0) (some (2^System.Platform.numBits)) where
+instance : ToInt USize (.uint System.Platform.numBits) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w := USize.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by
-    simp at w; subst w
+  toInt_mem x := by
+    simp only [IntInterval.mem_co, Int.ofNat_zero_le, true_and]
     rw [show (2 : Int) ^ System.Platform.numBits = (2 ^ System.Platform.numBits : Nat) by simp,
       Int.ofNat_lt]
     exact USize.toNat_lt_two_pow_numBits x
 
 @[simp] theorem toInt_usize (x : USize) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add USize (some 0) (some (2^System.Platform.numBits)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero USize (some 0) (some (2^System.Platform.numBits)) where
+instance : ToInt.Zero USize (.uint System.Platform.numBits) where
   toInt_zero := by simp
 
-instance : ToInt.Mod USize (some 0) (some (2^System.Platform.numBits)) where
+instance : ToInt.OfNat USize (.uint System.Platform.numBits) where
+  toInt_ofNat x := by
+    change ((x % 2^System.Platform.numBits : Nat) : Int) = _
+    simp
+
+instance : ToInt.Add USize (.uint System.Platform.numBits) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul USize (.uint System.Platform.numBits) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.UInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod USize (.uint System.Platform.numBits) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE USize (some 0) (some (2^System.Platform.numBits)) where
+instance : ToInt.Div USize (.uint System.Platform.numBits) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE USize (.uint System.Platform.numBits) where
   le_iff x y := by simpa using USize.le_iff_toBitVec_le
 
-instance : ToInt.LT USize (some 0) (some (2^System.Platform.numBits)) where
+instance : ToInt.LT USize (.uint System.Platform.numBits) where
   lt_iff x y := by simpa using USize.lt_iff_toBitVec_lt
 
-instance : ToInt Int8 (some (-2^7)) (some (2^7)) where
+instance : ToInt Int8 (.sint 8) where
   toInt x := x.toInt
   toInt_inj x y w := Int8.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int8.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int8.toInt_lt x
+  toInt_mem x := by simp; exact ⟨Int8.le_toInt x, Int8.toInt_lt x⟩
 
 @[simp] theorem toInt_int8 (x : Int8) : ToInt.toInt x = (x.toInt : Int) := rfl
 
-instance : ToInt.Add Int8 (some (-2^7)) (some (2^7)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int8 (some (-2^7)) (some (2^7)) where
+instance : ToInt.Zero Int8 (.sint 8) where
   toInt_zero := by
     --  simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
     change (0 : Int8).toInt = _
     rw [Int8.toInt_zero]
-    decide
+
+instance : ToInt.OfNat Int8 (.sint 8) where
+  toInt_ofNat x := by
+    rw [toInt_int8, Int8.toInt_ofNat, Int8.size, Int.bmod_eq_emod, IntInterval.wrap]
+    simp
+    split <;> omega
+
+instance : ToInt.Add Int8 (.sint 8) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.Mul Int8 (.sint 8) where
+  toInt_mul x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.SInt`,
+-- as it is convenient to use the ring structure.
 
 -- Note that we can not define `ToInt.Mod` instances for `Int8`,
 -- because the condition does not hold unless `0 ≤ x.toInt ∨ y.toInt ∣ x.toInt ∨ y = 0`.
 
-instance : ToInt.LE Int8 (some (-2^7)) (some (2^7)) where
+instance : ToInt.LE Int8 (.sint 8) where
   le_iff x y := by simpa using Int8.le_iff_toInt_le
 
-instance : ToInt.LT Int8 (some (-2^7)) (some (2^7)) where
+instance : ToInt.LT Int8 (.sint 8) where
   lt_iff x y := by simpa using Int8.lt_iff_toInt_lt
 
-instance : ToInt Int16 (some (-2^15)) (some (2^15)) where
+instance : ToInt Int16 (.sint 16) where
   toInt x := x.toInt
   toInt_inj x y w := Int16.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int16.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int16.toInt_lt x
+  toInt_mem x := by simp; exact ⟨Int16.le_toInt x, Int16.toInt_lt x⟩
 
 @[simp] theorem toInt_int16 (x : Int16) : ToInt.toInt x = (x.toInt : Int) := rfl
 
-instance : ToInt.Add Int16 (some (-2^15)) (some (2^15)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int16 (some (-2^15)) (some (2^15)) where
+instance : ToInt.Zero Int16 (.sint 16) where
   toInt_zero := by
     -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
     change (0 : Int16).toInt = _
     rw [Int16.toInt_zero]
-    decide
 
-instance : ToInt.LE Int16 (some (-2^15)) (some (2^15)) where
-  le_iff x y := by simpa using Int16.le_iff_toInt_le
+instance : ToInt.OfNat Int16 (.sint 16) where
+  toInt_ofNat x := by
+    rw [toInt_int16, Int16.toInt_ofNat, Int16.size, Int.bmod_eq_emod, IntInterval.wrap]
+    simp
+    split <;> omega
 
-instance : ToInt.LT Int16 (some (-2^15)) (some (2^15)) where
-  lt_iff x y := by simpa using Int16.lt_iff_toInt_lt
-
-instance : ToInt Int32 (some (-2^31)) (some (2^31)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int32.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int32.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int32.toInt_lt x
-
-@[simp] theorem toInt_int32 (x : Int32) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int32 (some (-2^31)) (some (2^31)) where
+instance : ToInt.Add Int16 (.sint 16) where
   toInt_add x y := by
     simp [Int.bmod_eq_emod]
     split <;> · simp; omega
 
-instance : ToInt.Zero Int32 (some (-2^31)) (some (2^31)) where
+instance : ToInt.Mul Int16 (.sint 16) where
+  toInt_mul x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.SInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.LE Int16 (.sint 16) where
+  le_iff x y := by simpa using Int16.le_iff_toInt_le
+
+instance : ToInt.LT Int16 (.sint 16) where
+  lt_iff x y := by simpa using Int16.lt_iff_toInt_lt
+
+instance : ToInt Int32 (.sint 32) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int32.toInt_inj.mp w
+  toInt_mem x := by simp; exact ⟨Int32.le_toInt x, Int32.toInt_lt x⟩
+
+@[simp] theorem toInt_int32 (x : Int32) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Zero Int32 (.sint 32) where
   toInt_zero := by
     -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
     change (0 : Int32).toInt = _
     rw [Int32.toInt_zero]
-    decide
 
-instance : ToInt.LE Int32 (some (-2^31)) (some (2^31)) where
-  le_iff x y := by simpa using Int32.le_iff_toInt_le
+instance : ToInt.OfNat Int32 (.sint 32) where
+  toInt_ofNat x := by
+    rw [toInt_int32, Int32.toInt_ofNat, Int32.size, Int.bmod_eq_emod, IntInterval.wrap]
+    simp
+    split <;> omega
 
-instance : ToInt.LT Int32 (some (-2^31)) (some (2^31)) where
-  lt_iff x y := by simpa using Int32.lt_iff_toInt_lt
-
-instance : ToInt Int64 (some (-2^63)) (some (2^63)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int64.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int64.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int64.toInt_lt x
-
-@[simp] theorem toInt_int64 (x : Int64) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int64 (some (-2^63)) (some (2^63)) where
+instance : ToInt.Add Int32 (.sint 32) where
   toInt_add x y := by
     simp [Int.bmod_eq_emod]
     split <;> · simp; omega
 
-instance : ToInt.Zero Int64 (some (-2^63)) (some (2^63)) where
+instance : ToInt.Mul Int32 (.sint 32) where
+  toInt_mul x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.SInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.LE Int32 (.sint 32) where
+  le_iff x y := by simpa using Int32.le_iff_toInt_le
+
+instance : ToInt.LT Int32 (.sint 32) where
+  lt_iff x y := by simpa using Int32.lt_iff_toInt_lt
+
+instance : ToInt Int64 (.sint 64) where
+  toInt x := x.toInt
+  toInt_inj x y w := Int64.toInt_inj.mp w
+  toInt_mem x := by simp; exact ⟨Int64.le_toInt x, Int64.toInt_lt x⟩
+
+@[simp] theorem toInt_int64 (x : Int64) : ToInt.toInt x = (x.toInt : Int) := rfl
+
+instance : ToInt.Zero Int64 (.sint 64) where
   toInt_zero := by
     -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
     change (0 : Int64).toInt = _
     rw [Int64.toInt_zero]
-    decide
 
-instance : ToInt.LE Int64 (some (-2^63)) (some (2^63)) where
+instance : ToInt.OfNat Int64 (.sint 64) where
+  toInt_ofNat x := by
+    rw [toInt_int64, Int64.toInt_ofNat, Int64.size, Int.bmod_eq_emod, IntInterval.wrap]
+    simp
+    split <;> omega
+
+instance : ToInt.Add Int64 (.sint 64) where
+  toInt_add x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+instance : ToInt.Mul Int64 (.sint 64) where
+  toInt_mul x y := by
+    simp [Int.bmod_eq_emod]
+    split <;> · simp; omega
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.SInt`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.LE Int64 (.sint 64) where
   le_iff x y := by simpa using Int64.le_iff_toInt_le
 
-instance : ToInt.LT Int64 (some (-2^63)) (some (2^63)) where
+instance : ToInt.LT Int64 (.sint 64) where
   lt_iff x y := by simpa using Int64.lt_iff_toInt_lt
 
-instance : ToInt (BitVec v) (some 0) (some (2^v)) where
+instance : ToInt (BitVec v) (.uint v) where
   toInt x := (x.toNat : Int)
   toInt_inj x y w :=
     BitVec.eq_of_toNat_eq (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by
-    simp at w; subst w;
-    simpa using Int.ofNat_lt.mpr (BitVec.isLt x)
+  toInt_mem x := by simpa using Int.ofNat_lt.mpr (BitVec.isLt x)
 
 @[simp] theorem toInt_bitVec (x : BitVec v) : ToInt.toInt x = (x.toNat : Int) := rfl
 
-instance : ToInt.Add (BitVec v) (some 0) (some (2^v)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero (BitVec v) (some 0) (some (2^v)) where
+instance : ToInt.Zero (BitVec v) (.uint v) where
   toInt_zero := by simp
 
-instance : ToInt.Mod (BitVec v) (some 0) (some (2^v)) where
+instance : ToInt.OfNat (BitVec v) (.uint v) where
+  toInt_ofNat x := by simp
+
+instance : ToInt.Add (BitVec v) (.uint v) where
+  toInt_add x y := by simp
+
+instance : ToInt.Mul (BitVec v) (.uint v) where
+  toInt_mul x y := by simp
+
+-- The `ToInt.Pow` instance is defined in `Init.GrindInstances.Ring.BitVec`,
+-- as it is convenient to use the ring structure.
+
+instance : ToInt.Mod (BitVec v) (.uint v) where
   toInt_mod x y := by simp
 
-instance : ToInt.LE (BitVec v) (some 0) (some (2^v)) where
+instance : ToInt.Div (BitVec v) (.uint v) where
+  toInt_div x y := by simp
+
+instance : ToInt.LE (BitVec v) (.uint v) where
   le_iff x y := by simpa using BitVec.le_def
 
-instance : ToInt.LT (BitVec v) (some 0) (some (2^v)) where
+instance : ToInt.LT (BitVec v) (.uint v) where
   lt_iff x y := by simpa using BitVec.lt_def
 
-instance : ToInt ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+instance : ToInt ISize (.sint System.Platform.numBits) where
   toInt x := x.toInt
   toInt_inj x y w := ISize.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact ISize.two_pow_numBits_le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact ISize.toInt_lt_two_pow_numBits x
+  toInt_mem x := by simp; exact ⟨ISize.two_pow_numBits_le_toInt x, ISize.toInt_lt_two_pow_numBits x⟩
 
 @[simp] theorem toInt_isize (x : ISize) : ToInt.toInt x = x.toInt := rfl
 
-instance : ToInt.Add ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+instance : ToInt.Zero ISize (.sint System.Platform.numBits) where
+  toInt_zero := by
+    rw [toInt_isize, ISize.toInt_zero]
+
+instance : ToInt.OfNat ISize (.sint System.Platform.numBits) where
+  toInt_ofNat x := by
+    rw [toInt_isize]
+    simp only [ISize.toInt_ofNat, ISize.size, IntInterval.wrap, Int.sub_neg]
+    rcases System.Platform.numBits_eq with h | h <;>
+    · simp [h, Int.bmod_eq_emod]
+      split <;> omega
+
+instance : ToInt.Add ISize (.sint System.Platform.numBits) where
   toInt_add x y := by
-    rw [toInt_isize, ISize.toInt_add, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
+    rw [toInt_isize, ISize.toInt_add, IntInterval.wrap_eq_bmod (Int.pow_nonneg (by decide))]
     have p₁ : (2 : Int) * 2 ^ (System.Platform.numBits - 1) = 2 ^ System.Platform.numBits := by
       have := System.Platform.numBits_pos
       have : System.Platform.numBits - 1 + 1 = System.Platform.numBits := by omega
@@ -364,16 +541,22 @@ instance : ToInt.Add ISize (some (-2^(System.Platform.numBits-1))) (some (2^(Sys
       simp
     simp [p₁, p₂]
 
-instance : ToInt.Zero ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  toInt_zero := by
-    rw [toInt_isize]
-    rw [ISize.toInt_zero, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
-    simp
+instance : ToInt.Mul ISize (.sint System.Platform.numBits) where
+  toInt_mul x y := by
+    rw [toInt_isize, ISize.toInt_mul, IntInterval.wrap_eq_bmod (Int.pow_nonneg (by decide))]
+    have p₁ : (2 : Int) * 2 ^ (System.Platform.numBits - 1) = 2 ^ System.Platform.numBits := by
+      have := System.Platform.numBits_pos
+      have : System.Platform.numBits - 1 + 1 = System.Platform.numBits := by omega
+      simp [← Int.pow_succ', this]
+    have p₂ : ((2 : Int) ^ System.Platform.numBits).toNat = 2 ^ System.Platform.numBits := by
+      rw [Int.toNat_pow_of_nonneg (by decide)]
+      simp
+    simp [p₁, p₂]
 
-instance instToIntLEISize : ToInt.LE ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+instance : ToInt.LE ISize (.sint System.Platform.numBits) where
   le_iff x y := by simpa using ISize.le_iff_toInt_le
 
-instance instToIntLTISize : ToInt.LT ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
+instance : ToInt.LT ISize (.sint System.Platform.numBits) where
   lt_iff x y := by simpa using ISize.lt_iff_toInt_lt
 
 end Lean.Grind

src/Init/Meta.lean

@@ -1430,7 +1430,7 @@ def expandInterpolatedStrChunks (chunks : Array Syntax) (mkAppend : Syntax → S
   let mut i := 0
   let mut result := Syntax.missing
   for elem in chunks do
-    let elem ← match elem.isInterpolatedStrLit? with
+    let elem ← withRef elem <| match elem.isInterpolatedStrLit? with
       | none     => mkElem elem
       | some str => mkElem (Syntax.mkStrLit str)
     if i == 0 then

src/Init/MetaTypes.lean

@@ -123,7 +123,6 @@ structure Config where
   -/
   zetaUnused : Bool := true
   /--
-  (Unimplemented)
   When `false` (default: `true`), then disables zeta reduction of `have` expressions.
   If `zeta` is `false`, then this option has no effect.
   Unused `have`s are still removed if `zeta` or `zetaUnused` are true.
@@ -253,6 +252,7 @@ structure Config where
   /--
   When `true` (default : `true`), then `simp` will remove unused `let` and `have` expressions:
   `let x := v; e` simplifies to `e` when `x` does not occur in `e`.
+  This option takes precedence over `zeta` and `zetaHave`.
   -/
   zetaUnused : Bool := true
   /--
@@ -261,14 +261,12 @@ structure Config where
   -/
   catchRuntime : Bool := true
   /--
-  (Unimplemented)
   When `false` (default: `true`), then disables zeta reduction of `have` expressions.
   If `zeta` is `false`, then this option has no effect.
   Unused `have`s are still removed if `zeta` or `zetaUnused` are true.
   -/
   zetaHave : Bool := true
   /--
-  (Unimplemented)
   When `true` (default : `true`), then `simp` will attempt to transform `let`s into `have`s
   if they are non-dependent. This only applies when `zeta := false`.
   -/

src/Init/SimpLemmas.lean

@@ -74,6 +74,22 @@ theorem let_body_congr {α : Sort u} {β : α → Sort v} {b b' : (a : α) →
     (a : α) (h : ∀ x, b x = b' x) : (let x := a; b x) = (let x := a; b' x) :=
   (funext h : b = b') ▸ rfl
 
+/-!
+Congruence lemmas for `have` have kernel performance issues when stated using `have` directly.
+Illustration of the problem: the kernel infers that the type of
+`have_congr (fun x => b) (fun x => b') h₁ h₂`
+is
+`(have x := a; (fun x => b) x) = (have x := a'; (fun x => b') x)`
+rather than
+`(have x := a; b x) = (have x := a'; b' x)`
+That means the kernel will do `whnf_core` at every step of checking a sequence of these lemmas.
+Thus, we get quadratically many zeta reductions.
+
+For reference, we have the `have` versions of the theorems in the following comment,
+and then after that we have the versions that `simpHaveTelescope` actually uses,
+which avoid this issue.
+-/
+/-
 theorem have_unused {α : Sort u} {β : Sort v} (a : α) {b b' : β}
     (h : b = b') : (have _ := a; b) = b' := h
 
@@ -95,6 +111,29 @@ theorem have_body_congr_dep {α : Sort u} {β : α → Sort v} (a : α) {f f' :
 theorem have_body_congr {α : Sort u} {β : Sort v} (a : α) {f f' : α → β}
     (h : ∀ x, f x = f' x) : (have x := a; f x) = (have x := a; f' x) :=
   h a
+-/
+
+theorem have_unused' {α : Sort u} {β : Sort v} (a : α) {b b' : β}
+    (h : b = b') : (fun _ => b) a = b' := h
+
+theorem have_unused_dep' {α : Sort u} {β : Sort v} (a : α) {b : α → β} {b' : β}
+    (h : ∀ x, b x = b') : b a = b' := h a
+
+theorem have_congr' {α : Sort u} {β : Sort v} {a a' : α} {f f' : α → β}
+    (h₁ : a = a') (h₂ : ∀ x, f x = f' x) : f a = f' a' :=
+  @congr α β f f' a a' (funext h₂) h₁
+
+theorem have_val_congr' {α : Sort u} {β : Sort v} {a a' : α} {f : α → β}
+    (h : a = a') : f a = f a' :=
+  @congrArg α β a a' f h
+
+theorem have_body_congr_dep' {α : Sort u} {β : α → Sort v} (a : α) {f f' : (x : α) → β x}
+    (h : ∀ x, f x = f' x) : f a = f' a :=
+  h a
+
+theorem have_body_congr' {α : Sort u} {β : Sort v} (a : α) {f f' : α → β}
+    (h : ∀ x, f x = f' x) : f a = f' a :=
+  h a
 
 theorem letFun_unused {α : Sort u} {β : Sort v} (a : α) {b b' : β} (h : b = b') : @letFun α (fun _ => β) a (fun _ => b) = b' :=
   h

src/Init/Tactics.lean

@@ -1799,6 +1799,369 @@ macro (name := bvNormalizeMacro) (priority:=low) "bv_normalize" optConfig : tact
   Macro.throwError "to use `bv_normalize`, please include `import Std.Tactic.BVDecide`"
 
 
+/--
+`massumption` is like `assumption`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : Q ⊢ₛ P → Q := by
+  mintro _ _
+  massumption
+```
+-/
+macro (name := massumptionMacro) (priority:=low) "massumption" : tactic =>
+  Macro.throwError "to use `massumption`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mclear` is like `clear`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ Q → Q := by
+  mintro HP
+  mintro HQ
+  mclear HP
+  mexact HQ
+```
+-/
+macro (name := mclearMacro) (priority:=low) "mclear" : tactic =>
+  Macro.throwError "to use `mclear`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mconstructor` is like `constructor`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (Q : SPred σs) : Q ⊢ₛ Q ∧ Q := by
+  mintro HQ
+  mconstructor <;> mexact HQ
+```
+-/
+macro (name := mconstructorMacro) (priority:=low) "mconstructor" : tactic =>
+  Macro.throwError "to use `mconstructor`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexact` is like `exact`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (Q : SPred σs) : Q ⊢ₛ Q := by
+  mstart
+  mintro HQ
+  mexact HQ
+```
+-/
+macro (name := mexactMacro) (priority:=low) "mexact" : tactic =>
+  Macro.throwError "to use `mexact`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexfalso` is like `exfalso`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P : SPred σs) : ⌜False⌝ ⊢ₛ P := by
+  mintro HP
+  mexfalso
+  mexact HP
+```
+-/
+macro (name := mexfalsoMacro) (priority:=low) "mexfalso" : tactic =>
+  Macro.throwError "to use `mexfalso`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mexists` is like `exists`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (ψ : Nat → SPred σs) : ψ 42 ⊢ₛ ∃ x, ψ x := by
+  mintro H
+  mexists 42
+```
+-/
+macro (name := mexistsMacro) (priority:=low) "mexists" : tactic =>
+  Macro.throwError "to use `mexists`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mframe` infers which hypotheses from the stateful context can be moved into the pure context.
+This is useful because pure hypotheses "survive" the next application of modus ponens
+(`Std.Do.SPred.mp`) and transitivity (`Std.Do.SPred.entails.trans`).
+
+It is used as part of the `mspec` tactic.
+
+```lean
+example (P Q : SPred σs) : ⊢ₛ ⌜p⌝ ∧ Q ∧ ⌜q⌝ ∧ ⌜r⌝ ∧ P ∧ ⌜s⌝ ∧ ⌜t⌝ → Q := by
+  mintro _
+  mframe
+  /- `h : p ∧ q ∧ r ∧ s ∧ t` in the pure context -/
+  mcases h with hP
+  mexact h
+```
+-/
+macro (name := mframeMacro) (priority:=low) "mframe" : tactic =>
+  Macro.throwError "to use `mframe`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mhave` is like `have`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mhave HQ : Q := by mspecialize HPQ HP; mexact HPQ
+  mexact HQ
+```
+-/
+macro (name := mhaveMacro) (priority:=low) "mhave" : tactic =>
+  Macro.throwError "to use `mhave`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mreplace` is like `replace`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mreplace HPQ : Q := by mspecialize HPQ HP; mexact HPQ
+  mexact HPQ
+```
+-/
+macro (name := mreplaceMacro) (priority:=low) "mreplace" : tactic =>
+  Macro.throwError "to use `mreplace`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mleft` is like `left`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ P ∨ Q := by
+  mintro HP
+  mleft
+  mexact HP
+```
+-/
+macro (name := mleftMacro) (priority:=low) "mleft" : tactic =>
+  Macro.throwError "to use `mleft`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mright` is like `right`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ Q ∨ P := by
+  mintro HP
+  mright
+  mexact HP
+```
+-/
+macro (name := mrightMacro) (priority:=low) "mright" : tactic =>
+  Macro.throwError "to use `mright`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mpure` moves a pure hypothesis from the stateful context into the pure context.
+```lean
+example (Q : SPred σs) (ψ : φ → ⊢ₛ Q): ⌜φ⌝ ⊢ₛ Q := by
+  mintro Hφ
+  mpure Hφ
+  mexact (ψ Hφ)
+```
+-/
+macro (name := mpureMacro) (priority:=low) "mpure" : tactic =>
+  Macro.throwError "to use `mpure`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mpure_intro` operates on a stateful `Std.Do.SPred` goal of the form `P ⊢ₛ ⌜φ⌝`.
+It leaves the stateful proof mode (thereby discarding `P`), leaving the regular goal `φ`.
+```lean
+theorem simple : ⊢ₛ (⌜True⌝ : SPred σs) := by
+  mpure_intro
+  exact True.intro
+```
+-/
+macro (name := mpureIntroMacro) (priority:=low) "mpure_intro" : tactic =>
+  Macro.throwError "to use `mpure_intro`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mrevert` is like `revert`, but operating on a stateful `Std.Do.SPred` goal.
+```lean
+example (P Q R : SPred σs) : P ∧ Q ∧ R ⊢ₛ P → R := by
+  mintro ⟨HP, HQ, HR⟩
+  mrevert HR
+  mrevert HP
+  mintro HP'
+  mintro HR'
+  mexact HR'
+```
+-/
+macro (name := mrevertMacro) (priority:=low) "mrevert" : tactic =>
+  Macro.throwError "to use `mrevert`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mspecialize` is like `specialize`, but operating on a stateful `Std.Do.SPred` goal.
+It specializes a hypothesis from the stateful context with hypotheses from either the pure
+or stateful context or pure terms.
+```lean
+example (P Q : SPred σs) : P ⊢ₛ (P → Q) → Q := by
+  mintro HP HPQ
+  mspecialize HPQ HP
+  mexact HPQ
+
+example (y : Nat) (P Q : SPred σs) (Ψ : Nat → SPred σs) (hP : ⊢ₛ P) : ⊢ₛ Q → (∀ x, P → Q → Ψ x) → Ψ (y + 1) := by
+  mintro HQ HΨ
+  mspecialize HΨ (y + 1) hP HQ
+  mexact HΨ
+```
+-/
+macro (name := mspecializeMacro) (priority:=low) "mspecialize" : tactic =>
+  Macro.throwError "to use `mspecialize`, please include `import Std.Tactic.Do`"
+
+
+/--
+`mspecialize_pure` is like `mspecialize`, but it specializes a hypothesis from the
+*pure* context with hypotheses from either the pure or stateful context or pure terms.
+```lean
+example (y : Nat) (P Q : SPred σs) (Ψ : Nat → SPred σs) (hP : ⊢ₛ P) (hΨ : ∀ x, ⊢ₛ P → Q → Ψ x) : ⊢ₛ Q → Ψ (y + 1) := by
+  mintro HQ
+  mspecialize_pure (hΨ (y + 1)) hP HQ => HΨ
+  mexact HΨ
+```
+-/
+macro (name := mspecializePureMacro) (priority:=low) "mspecialize_pure" : tactic =>
+  Macro.throwError "to use `mspecialize_pure`, please include `import Std.Tactic.Do`"
+
+
+/--
+Start the stateful proof mode of `Std.Do.SPred`.
+This will transform a stateful goal of the form `H ⊢ₛ T` into `⊢ₛ H → T`
+upon which `mintro` can be used to re-introduce `H` and give it a name.
+It is often more convenient to use `mintro` directly, which will
+try `mstart` automatically if necessary.
+-/
+macro (name := mstartMacro) (priority:=low) "mstart" : tactic =>
+  Macro.throwError "to use `mstart`, please include `import Std.Tactic.Do`"
+
+
+/--
+Stops the stateful proof mode of `Std.Do.SPred`.
+This will simply forget all the names given to stateful hypotheses and pretty-print
+a bit differently.
+-/
+macro (name := mstopMacro) (priority:=low) "mstop" : tactic =>
+  Macro.throwError "to use `mstop`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `rcases`, but operating on stateful `Std.Do.SPred` goals.
+Example: Given a goal `h : (P ∧ (Q ∨ R) ∧ (Q → R)) ⊢ₛ R`,
+`mcases h with ⟨-, ⟨hq | hr⟩, hqr⟩` will yield two goals:
+`(hq : Q, hqr : Q → R) ⊢ₛ R` and `(hr : R) ⊢ₛ R`.
+
+That is, `mcases h with pat` has the following semantics, based on `pat`:
+* `pat=□h'` renames `h` to `h'` in the stateful context, regardless of whether `h` is pure
+* `pat=⌜h'⌝` introduces `h' : φ`  to the pure local context if `h : ⌜φ⌝`
+  (c.f. `Lean.Elab.Tactic.Do.ProofMode.IsPure`)
+* `pat=h'` is like `pat=⌜h'⌝` if `h` is pure
+  (c.f. `Lean.Elab.Tactic.Do.ProofMode.IsPure`), otherwise it is like `pat=□h'`.
+* `pat=_` renames `h` to an inaccessible name
+* `pat=-` discards `h`
+* `⟨pat₁, pat₂⟩` matches on conjunctions and existential quantifiers and recurses via
+  `pat₁` and `pat₂`.
+* `⟨pat₁ | pat₂⟩` matches on disjunctions, matching the left alternative via `pat₁` and the right
+  alternative via `pat₂`.
+-/
+macro (name := mcasesMacro) (priority:=low) "mcases" : tactic =>
+  Macro.throwError "to use `mcases`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `refine`, but operating on stateful `Std.Do.SPred` goals.
+```lean
+example (P Q R : SPred σs) : (P ∧ Q ∧ R) ⊢ₛ P ∧ R := by
+  mintro ⟨HP, HQ, HR⟩
+  mrefine ⟨HP, HR⟩
+
+example (ψ : Nat → SPred σs) : ψ 42 ⊢ₛ ∃ x, ψ x := by
+  mintro H
+  mrefine ⟨⌜42⌝, H⟩
+```
+-/
+macro (name := mrefineMacro) (priority:=low) "mrefine" : tactic =>
+  Macro.throwError "to use `mrefine`, please include `import Std.Tactic.Do`"
+
+
+/--
+Like `intro`, but introducing stateful hypotheses into the stateful context of the `Std.Do.SPred`
+proof mode.
+That is, given a stateful goal `(hᵢ : Hᵢ)* ⊢ₛ P → T`, `mintro h` transforms
+into `(hᵢ : Hᵢ)*, (h : P) ⊢ₛ T`.
+
+Furthermore, `mintro ∀s` is like `intro s`, but preserves the stateful goal.
+That is, `mintro ∀s` brings the topmost state variable `s:σ` in scope and transforms
+`(hᵢ : Hᵢ)* ⊢ₛ T` (where the entailment is in `Std.Do.SPred (σ::σs)`) into
+`(hᵢ : Hᵢ s)* ⊢ₛ T s` (where the entailment is in `Std.Do.SPred σs`).
+
+Beyond that, `mintro` supports the full syntax of `mcases` patterns
+(`mintro pat = (mintro h; mcases h with pat`), and can perform multiple
+introductions in sequence.
+-/
+macro (name := mintroMacro) (priority:=low) "mintro" : tactic =>
+  Macro.throwError "to use `mintro`, please include `import Std.Tactic.Do`"
+
+/--
+`mspec` is an `apply`-like tactic that applies a Hoare triple specification to the target of the
+stateful goal.
+
+Given a stateful goal `H ⊢ₛ wp⟦prog⟧.apply Q'`, `mspec foo_spec` will instantiate
+`foo_spec : ... → ⦃P⦄ foo ⦃Q⦄`, match `foo` against `prog` and produce subgoals for
+the verification conditions `?pre : H ⊢ₛ P` and `?post : Q ⊢ₚ Q'`.
+
+* If `prog = x >>= f`, then `mspec Specs.bind` is tried first so that `foo` is matched against `x`
+  instead. Tactic `mspec_no_bind` does not attempt to do this decomposition.
+* If `?pre` or `?post` follow by `.rfl`, then they are discharged automatically.
+* `?post` is automatically simplified into constituent `⊢ₛ` entailments on
+  success and failure continuations.
+* `?pre` and `?post.*` goals introduce their stateful hypothesis as `h`.
+* Any uninstantiated MVar arising from instantiation of `foo_spec` becomes a new subgoal.
+* If the goal looks like `fun s => _ ⊢ₛ _` then `mspec` will first `mintro ∀s`.
+* If `P` has schematic variables that can be instantiated by doing `mintro ∀s`, for example
+  `foo_spec : ∀(n:Nat), ⦃⌜n = ‹Nat›ₛ⌝⦄ foo ⦃Q⦄`, then `mspec` will do `mintro ∀s` first to
+  instantiate `n = s`.
+* Right before applying the spec, the `mframe` tactic is used, which has the following effect:
+  Any hypothesis `Hᵢ` in the goal `h₁:H₁, h₂:H₂, ..., hₙ:Hₙ ⊢ₛ T` that is
+  pure (i.e., equivalent to some `⌜φᵢ⌝`) will be moved into the pure context as `hᵢ:φᵢ`.
+
+Additionally, `mspec` can be used without arguments or with a term argument:
+
+* `mspec` without argument will try and look up a spec for `x` registered with `@[spec]`.
+* `mspec (foo_spec blah ?bleh)` will elaborate its argument as a term with expected type
+  `⦃?P⦄ x ⦃?Q⦄` and introduce `?bleh` as a subgoal.
+  This is useful to pass an invariant to e.g., `Specs.forIn_list` and leave the inductive step
+  as a hole.
+-/
+macro (name := mspecMacro) (priority:=low) "mspec" : tactic =>
+  Macro.throwError "to use `mspec`, please include `import Std.Tactic.Do`"
+
+/--
+`mvcgen` will break down a Hoare triple proof goal like `⦃P⦄ prog ⦃Q⦄` into verification conditions,
+provided that all functions used in `prog` have specifications registered with `@[spec]`.
+
+A verification condition is an entailment in the stateful logic of `Std.Do.SPred`
+in which the original program `prog` no longer occurs.
+Verification conditions are introduced by the `mspec` tactic; see the `mspec` tactic for what they
+look like.
+When there's no applicable `mspec` spec, `mvcgen` will try and rewrite an application
+`prog = f a b c` with the simp set registered via `@[spec]`.
+
+When used like `mvcgen +noLetElim [foo_spec, bar_def, instBEqFloat]`, `mvcgen` will additionally
+
+* add a Hoare triple specification `foo_spec : ... → ⦃P⦄ foo ... ⦃Q⦄` to `spec` set for a
+  function `foo` occurring in `prog`,
+* unfold a definition `def bar_def ... := ...` in `prog`,
+* unfold any method of the `instBEqFloat : BEq Float` instance in `prog`.
+* it will no longer substitute away `let`-expressions that occur at most once in `P`, `Q` or `prog`.
+
+Furthermore, `mvcgen` tries to close trivial verification conditions by `SPred.entails.rfl` or
+the tactic sequence `try (mpure_intro; trivial)`. The variant `mvcgen_no_trivial` does not do this.
+
+For debugging purposes there is also `mvcgen_step 42` which will do at most 42 VC generation
+steps. This is useful for bisecting issues with the generated VCs.
+-/
+macro (name := mvcgenMacro) (priority:=low) "mvcgen" : tactic =>
+  Macro.throwError "to use `mvcgen`, please include `import Std.Tactic.Do`"
+
 end Tactic
 
 namespace Attr

src/Lean/Compiler/LCNF/Basic.lean

@@ -89,7 +89,6 @@ inductive LetValue where
   | proj (typeName : Name) (idx : Nat) (struct : FVarId)
   | const (declName : Name) (us : List Level) (args : Array Arg)
   | fvar (fvarId : FVarId) (args : Array Arg)
-  -- TODO: add constructors for mono and impure phases
   deriving Inhabited, BEq, Hashable
 
 def Arg.toLetValue (arg : Arg) : LetValue :=