[ { "path": ".docker/gitpod/Dockerfile", "content": "# This is the Dockerfile for leanprover-community/batteries\n# This file is mostly copied from [mathlib4](https://github.com/leanprover-community/mathlib4/blob/master/.docker/gitpod/Dockerfile)\n\n# gitpod doesn't support multiple FROM statements, (or rather, you can't copy from one to another)\n# so we just install everything in one go\nFROM ubuntu:jammy\n\nUSER root\n\nRUN apt-get update && apt-get install sudo git curl bash-completion python3-requests gcc make -y && apt-get clean\n\nRUN useradd -l -u 33333 -G sudo -md /home/gitpod -s /bin/bash -p gitpod gitpod \\\n # passwordless sudo for users in the 'sudo' group\n && sed -i.bkp -e 's/%sudo\\s\\+ALL=(ALL\\(:ALL\\)\\?)\\s\\+ALL/%sudo ALL=NOPASSWD:ALL/g' /etc/sudoers\nUSER gitpod\nWORKDIR /home/gitpod\n\nSHELL [\"/bin/bash\", \"-c\"]\n\n# gitpod bash prompt\nRUN { echo && echo \"PS1='\\[\\033[01;32m\\]\\u\\[\\033[00m\\] \\[\\033[01;34m\\]\\w\\[\\033[00m\\]\\$(__git_ps1 \\\" (%s)\\\") $ '\" ; } >> .bashrc\n\n# install elan\nRUN curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- -y --default-toolchain none\n\n# install whichever toolchain batteries is currently using\nRUN . ~/.profile && elan toolchain install $(curl https://raw.githubusercontent.com/leanprover-community/batteries/main/lean-toolchain)\n\n# install neovim (for any lean.nvim user), via tarball since the appimage doesn't work for some reason, and jammy's version is ancient\nRUN curl -s -L https://github.com/neovim/neovim/releases/download/stable/nvim-linux64.tar.gz | tar xzf - && sudo mv nvim-linux64 /opt/nvim\n\nENV PATH=\"/home/gitpod/.local/bin:/home/gitpod/.elan/bin:/opt/nvim/bin:${PATH}\"\n\n# fix the infoview when the container is used on gitpod:\nENV VSCODE_API_VERSION=\"1.50.0\"\n\n# ssh to github once to bypass the unknown fingerprint warning\nRUN ssh -o StrictHostKeyChecking=no github.com || true\n\n# run sudo once to suppress usage info\nRUN sudo echo finished\n" }, { "path": ".github/workflows/build.yml", "content": "on:\n push:\n branches-ignore:\n # ignore tmp branches used by bors\n - 'staging.tmp*'\n - 'trying.tmp*'\n - 'staging*.tmp'\n pull_request:\n\nname: ci\n\nconcurrency:\n group: build-${{ github.sha }}\n cancel-in-progress: true\n\njobs:\n build:\n name: Build\n runs-on: ubuntu-latest\n steps:\n - uses: actions/checkout@v4\n\n - id: lean-action\n name: build, test, and lint batteries\n uses: leanprover/lean-action@v1\n with:\n build-args: '--wfail'\n\n - name: Check that all files are imported\n run: lake env lean scripts/check_imports.lean\n\n - name: Check for forbidden character ↦\n if: always()\n run: |\n if grep -r -n --include=\\*.lean -e '↦' . ; then\n echo \"Error: Found forbidden character ↦\"\n exit 1\n fi\n\n - name: Check for 'namespace Mathlib'\n if: always()\n run: |\n if grep -r -n --include=\\*.lean -e 'namespace Mathlib' . ; then\n echo \"Error: Found 'namespace Mathlib'\"\n exit 1\n fi\n\n - name: Check for long lines\n if: always()\n run: |\n ! (find Batteries -name \"*.lean\" -type f -exec grep -E -H -n '^.{101,}$' {} \\; | grep -v -E 'https?://')\n\n - name: Check for trailing whitespace\n if: always()\n run: |\n scripts/lintWhitespace.sh\n\n - name: Don't 'import Lean', use precise imports\n if: always()\n run: |\n ! (find . -name \"*.lean\" ! -path \"./BatteriesTest/import_lean.lean\" -type f -print0 | xargs -0 grep -E -n '^import Lean$')\n" }, { "path": ".github/workflows/docs-deploy.yml", "content": "name: Deploy Docs\n\non:\n workflow_dispatch:\n schedule:\n - cron: '0 10 * * *' # daily (UTC 10:00)\n\npermissions:\n contents: write\n\njobs:\n deploy-docs:\n runs-on: ubuntu-latest\n if: github.repository_owner == 'leanprover-community'\n steps:\n\n - name: Checkout\n uses: actions/checkout@v4\n\n - name: Install Lean\n uses: leanprover/lean-action@v1\n with:\n test: false\n lint: false\n use-github-cache: true\n\n - name: Build Docs\n working-directory: docs\n run: lake build --keep-toolchain -q Batteries:docs\n\n - name: Deploy Docs\n run: |\n git config user.name \"leanprover-community-batteries-bot\"\n git config user.email \"leanprover-community-batteries-bot@users.noreply.github.com\"\n git checkout -b docs\n git add docs/doc docs/doc-data\n git commit -m \"chore: generate docs\"\n git push origin docs --force\n" }, { "path": ".github/workflows/docs-release.yml", "content": "name: Release Docs\n\non:\n push:\n tags:\n - \"v[0-9]+.[0-9]+.[0-9]+\"\n - \"v[0-9]+.[0-9]+.[0-9]+-rc[0-9]+\"\n\npermissions:\n contents: write\n\njobs:\n build-docs:\n runs-on: ubuntu-latest\n if: github.repository_owner == 'leanprover-community'\n steps:\n\n - name: Checkout\n uses: actions/checkout@v4\n\n - name: Install Lean\n uses: leanprover/lean-action@v1\n with:\n test: false\n lint: false\n use-github-cache: true\n\n - name: Build Docs\n working-directory: docs\n run: lake build --keep-toolchain -q Batteries:docs\n\n - name: Compress Docs\n working-directory: docs\n env:\n TAG_NAME: ${{ github.ref_name }}\n run: |\n tar -czf docs-${TAG_NAME}.tar.gz doc doc-data\n zip -rq docs-${TAG_NAME}.zip doc doc-data\n\n - name: Release Docs\n uses: softprops/action-gh-release@v2\n with:\n prerelease: ${{ contains(github.ref, 'rc') }}\n make_latest: ${{ !contains(github.ref, 'rc') }}\n files: |\n docs/docs-${{ github.ref_name }}.tar.gz\n docs/docs-${{ github.ref_name }}.zip\n fail_on_unmatched_files: true\n" }, { "path": ".github/workflows/labels-from-comments.yml", "content": "# This workflow allows any user to add one of the `awaiting-review`, `awaiting-author`, or `WIP` labels,\n# by commenting on the PR or issue.\n# Other labels from this set are removed automatically at the same time.\n\nname: Label PR based on Comment\n\non:\n issue_comment:\n types: [created]\n\njobs:\n update-label:\n if: github.event.issue.pull_request != null && (github.event.comment.body == 'awaiting-review' || github.event.comment.body == 'awaiting-author' || github.event.comment.body == 'WIP')\n runs-on: ubuntu-latest\n\n steps:\n - name: Remove all relevant labels\n uses: actions/github-script@v6\n with:\n github-token: ${{ secrets.GITHUB_TOKEN }}\n script: |\n const { owner, repo, number: issue_number } = context.issue;\n\n // Remove the labels if they exist\n await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'awaiting-review' }).catch(() => {});\n await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'awaiting-author' }).catch(() => {});\n await github.rest.issues.removeLabel({ owner, repo, issue_number, name: 'WIP' }).catch(() => {});\n\n - name: Add label based on comment\n uses: actions/github-script@v6\n with:\n github-token: ${{ secrets.GITHUB_TOKEN }}\n script: |\n const { owner, repo, number: issue_number } = context.issue;\n const commentBody = context.payload.comment.body;\n\n if (commentBody == 'awaiting-review') {\n await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['awaiting-review'] });\n } else if (commentBody == 'awaiting-author') {\n await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['awaiting-author'] });\n } else if (commentBody == 'WIP') {\n await github.rest.issues.addLabels({ owner, repo, issue_number, labels: ['WIP'] });\n }\n\n # - name: Delete the comment\n # uses: actions/github-script@v6\n # with:\n # github-token: ${{ secrets.GITHUB_TOKEN }}\n # script: |\n # const { owner, repo } = context.repo;\n\n # await github.rest.issues.deleteComment({ owner, repo, comment_id: context.payload.comment.id });\n" }, { "path": ".github/workflows/labels-from-status.yml", "content": "# This workflow assigns `awaiting-review` or `WIP` labels to new PRs, and it removes\n# `awaiting-review`, `awaiting-author`, or `WIP` label from closed PRs.\n# It does not modify labels for open PRs that already have one of the `awaiting-review`,\n# `awaiting-author`, or `WIP` labels.\n\nname: Label PR from status change\n\npermissions:\n contents: read\n pull-requests: write\n\non:\n pull_request_target:\n types:\n - closed\n - opened\n - reopened\n - converted_to_draft\n - ready_for_review\n branches:\n - main\n\njobs:\n auto-label:\n if: github.repository_owner == 'leanprover-community'\n runs-on: ubuntu-latest\n steps:\n\n - uses: actions/checkout@v4\n with:\n fetch-depth: 0\n\n - name: Unlabel closed PR\n if: github.event.pull_request.state == 'closed'\n uses: actions-ecosystem/action-remove-labels@v1\n with:\n github_token: ${{ secrets.GITHUB_TOKEN }}\n labels: |\n WIP\n awaiting-author\n awaiting-review\n\n - name: Label unlabeled draft PR as WIP\n if: |\n github.event.pull_request.state == 'open' &&\n github.event.pull_request.draft &&\n ! contains(github.event.pull_request.labels.*.name, 'awaiting-author') &&\n ! contains(github.event.pull_request.labels.*.name, 'awaiting-review') &&\n ! contains(github.event.pull_request.labels.*.name, 'WIP')\n uses: actions-ecosystem/action-add-labels@v1\n with:\n github_token: ${{ secrets.GITHUB_TOKEN }}\n labels: WIP\n\n - name: Label unlabeled other PR as awaiting-review\n if: |\n github.event.pull_request.state == 'open' &&\n ! github.event.pull_request.draft &&\n ! contains(github.event.pull_request.labels.*.name, 'awaiting-author') &&\n ! contains(github.event.pull_request.labels.*.name, 'awaiting-review') &&\n ! contains(github.event.pull_request.labels.*.name, 'WIP')\n uses: actions-ecosystem/action-add-labels@v1\n with:\n github_token: ${{ secrets.GITHUB_TOKEN }}\n labels: awaiting-review\n" }, { "path": ".github/workflows/merge_conflicts.yml", "content": "name: Merge conflicts\n\non:\n schedule:\n - cron: '*/60 * * * *' # run every 60 minutes\n\njobs:\n main:\n if: github.repository_owner == 'leanprover-community'\n runs-on: ubuntu-latest\n steps:\n - name: Generate app token\n id: app-token\n uses: actions/create-github-app-token@29824e69f54612133e76f7eaac726eef6c875baf # v2.2.1\n with:\n app-id: ${{ secrets.MATHLIB_MERGE_CONFLICTS_APP_ID }}\n private-key: ${{ secrets.MATHLIB_MERGE_CONFLICTS_PRIVATE_KEY }}\n # The create-github-app-token README states that this token is masked and will not be logged accidentally.\n - name: check if prs are dirty\n uses: eps1lon/actions-label-merge-conflict@1df065ebe6e3310545d4f4c4e862e43bdca146f0 # v3.0.3\n with:\n dirtyLabel: \"merge-conflict\"\n repoToken: ${{ steps.app-token.outputs.token }}\n" }, { "path": ".github/workflows/nightly_bump_and_merge.yml", "content": "name: Bump toolchain and merge pr-testing branches\n\n# This workflow combines the former `nightly_bump_toolchain.yml` and `discover-lean-pr-testing.yml`\n# into a single workflow. This ensures that when the toolchain is bumped, any relevant\n# lean-pr-testing branches are merged in the same push, avoiding spurious CI failures\n# on the intermediate state (bumped toolchain without the adaptations).\n\non:\n schedule:\n - cron: '45 9/3 * * *'\n # 10:45AM CET/1:45AM PT (and then every 3 hours thereafter),\n # This should be 2 hours and 45 minutes after lean4 starts building the nightly.\n # Mathlib's `nightly-testing` branch is bumped 15 minutes later.\n workflow_dispatch:\n\njobs:\n bump-and-merge:\n runs-on: ubuntu-latest\n if: github.repository_owner == 'leanprover-community'\n steps:\n - name: Generate app token\n id: app-token\n uses: actions/create-github-app-token@29824e69f54612133e76f7eaac726eef6c875baf # v2.2.1\n with:\n app-id: ${{ secrets.MATHLIB_NIGHTLY_TESTING_APP_ID }}\n private-key: ${{ secrets.MATHLIB_NIGHTLY_TESTING_PRIVATE_KEY }}\n # The create-github-app-token README states that this token is masked and will not be logged accidentally.\n\n - name: Checkout nightly-testing branch\n uses: actions/checkout@11bd71901bbe5b1630ceea73d27597364c9af683 # v4.2.2\n with:\n ref: nightly-testing\n fetch-depth: 0 # Fetch all branches and history\n token: ${{ steps.app-token.outputs.token }}\n\n - name: Set up Git\n run: |\n git config --global user.name \"mathlib-nightly-testing[bot]\"\n git config --global user.email \"mathlib-nightly-testing[bot]@users.noreply.github.com\"\n\n - name: Configure Lean\n uses: leanprover/lean-action@f807b338d95de7813c5c50d018f1c23c9b93b4ec # 2025-04-24\n with:\n auto-config: false\n use-github-cache: false\n use-mathlib-cache: false\n\n # ============================================================================\n # Phase 1: Bump the toolchain (commit locally, don't push yet)\n # ============================================================================\n\n - name: Get old toolchain version\n id: old-toolchain\n run: |\n # Capture the current toolchain BEFORE we modify anything\n OLD=$(cut -f2 -d: lean-toolchain)\n echo \"old=$OLD\"\n echo \"old=$OLD\" >> \"$GITHUB_OUTPUT\"\n\n - name: Get latest release tag from leanprover/lean4-nightly\n id: get-latest-release\n env:\n GH_TOKEN: ${{ steps.app-token.outputs.token }}\n run: |\n RELEASE_TAG=$(gh api -X GET repos/leanprover/lean4-nightly/releases \\\n -f per_page=1 --jq '.[0].tag_name')\n if [ -z \"$RELEASE_TAG\" ] || [ \"$RELEASE_TAG\" = \"null\" ]; then\n echo \"::error::Could not determine latest lean4-nightly release\"\n exit 1\n fi\n echo \"RELEASE_TAG=$RELEASE_TAG\"\n echo \"RELEASE_TAG=$RELEASE_TAG\" >> \"$GITHUB_ENV\"\n echo \"new=$RELEASE_TAG\" >> \"$GITHUB_OUTPUT\"\n\n - name: Update lean-toolchain file\n run: |\n echo \"leanprover/lean4:${RELEASE_TAG}\" > lean-toolchain\n\n - name: Commit toolchain bump (without pushing)\n id: commit-bump\n run: |\n git add lean-toolchain\n # Don't fail if there's nothing to commit (toolchain already up to date)\n if git commit -m \"chore: bump to ${RELEASE_TAG}\"; then\n echo \"bumped=true\" >> \"$GITHUB_OUTPUT\"\n else\n echo \"bumped=false\" >> \"$GITHUB_OUTPUT\"\n echo \"Toolchain already at ${RELEASE_TAG}, no bump needed\"\n fi\n\n # ============================================================================\n # Phase 2: Find and merge pr-testing branches\n # ============================================================================\n\n - name: Clone lean4-nightly and get PRs\n id: get-prs\n if: steps.commit-bump.outputs.bumped == 'true'\n run: |\n OLD=\"${{ steps.old-toolchain.outputs.old }}\"\n NEW=\"${{ steps.get-latest-release.outputs.new }}\"\n\n echo \"Finding PRs between $OLD and $NEW\"\n\n NIGHTLY_URL=\"https://github.com/leanprover/lean4-nightly.git\"\n\n # Create a temporary directory for cloning\n cd \"$(mktemp -d)\" || exit 1\n\n # Clone the repository with a depth of 1\n git clone --depth 1 \"$NIGHTLY_URL\"\n\n # Navigate to the cloned repository\n cd lean4-nightly || exit 1\n\n # Fetch the $OLD tag\n git fetch --depth=1 origin tag \"$OLD\" --no-tags\n # Fetch the $NEW tag\n git fetch origin tag \"$NEW\" --no-tags\n\n # Get all commit SHAs between the $OLD and $NEW toolchains\n COMMIT_SHAS=$(git log --format=\"%H\" \"$OLD..$NEW\")\n\n # Initialize an empty string to collect PR numbers\n PRS=\"\"\n\n # For each commit, query the GitHub API to get associated PRs\n for commit_sha in $COMMIT_SHAS; do\n echo \"Checking commit $commit_sha for associated PRs...\"\n\n # Query GitHub API for PRs associated with this commit\n pr_numbers=$(curl -s -H \"Accept: application/vnd.github.v3+json\" \\\n \"https://api.github.com/repos/leanprover/lean4/commits/$commit_sha/pulls\" | \\\n jq -r '.[] | select(.merged_at != null) | .number | tostring' 2>/dev/null || echo \"\")\n\n # Add each PR number to our list (duplicates will be handled later)\n for pr_num in $pr_numbers; do\n if [[ \"$pr_num\" =~ ^[0-9]+$ ]]; then\n PRS=\"$PRS $pr_num\"\n echo \"Found PR #$pr_num associated with commit $commit_sha\"\n fi\n done\n done\n\n # Remove duplicates and trim whitespace\n PRS=$(echo \"$PRS\" | tr ' ' '\\n' | sort -u | tr '\\n' ' ' | xargs)\n\n # Output the PRs\n echo \"Found PRs: $PRS\"\n printf \"prs<> \"$GITHUB_OUTPUT\"\n\n - name: Find matching pr-testing branches\n id: find-branches\n if: steps.commit-bump.outputs.bumped == 'true'\n run: |\n PRS=\"${{ steps.get-prs.outputs.prs }}\"\n echo \"=== PRS =========================\"\n echo \"$PRS\"\n\n # CRITICAL: If no PRs were found, skip branch matching entirely.\n if [ -z \"$PRS\" ]; then\n echo \"No PRs found between old and new nightlies. Skipping branch discovery.\"\n echo \"branches_exist=false\" >> \"$GITHUB_ENV\"\n printf \"branches<> \"$GITHUB_OUTPUT\"\n exit 0\n fi\n\n echo \"$PRS\" | tr ' ' '\\n' > prs.txt\n echo \"=== prs.txt =====================\"\n cat prs.txt\n MATCHING_BRANCHES=$(git branch -r | grep -f prs.txt | grep \"lean-pr-testing\" || true)\n echo \"=== MATCHING_BRANCHES ===========\"\n echo \"$MATCHING_BRANCHES\"\n echo \"=================================\"\n\n # Initialize an empty variable to store branches with relevant diffs\n RELEVANT_BRANCHES=\"\"\n\n # Loop through each matching branch\n for BRANCH in $MATCHING_BRANCHES; do\n echo \" === Testing $BRANCH for relevance.\"\n # Get the diff filenames\n DIFF_FILES=$(git diff --name-only \"origin/nightly-testing...$BRANCH\")\n\n # Check if the diff contains files other than the specified ones\n # Note: Batteries uses lakefile.toml, not lakefile.lean\n if echo \"$DIFF_FILES\" | grep -v -e 'lake-manifest.json' -e 'lakefile.toml' -e 'lean-toolchain'; then\n # Extract the actual branch name\n ACTUAL_BRANCH=${BRANCH#origin/}\n\n # Append the branch details to RELEVANT_BRANCHES\n RELEVANT_BRANCHES=\"$RELEVANT_BRANCHES\"\"$ACTUAL_BRANCH\"$' '\n fi\n done\n\n # Output the relevant branches\n echo \"=== RELEVANT_BRANCHES ===========\"\n echo \"'$RELEVANT_BRANCHES'\"\n printf \"branches<> \"$GITHUB_OUTPUT\"\n\n # Check if there are relevant branches\n if [ -z \"${RELEVANT_BRANCHES}\" ]; then\n echo \"branches_exist=false\" >> \"$GITHUB_ENV\"\n else\n echo \"branches_exist=true\" >> \"$GITHUB_ENV\"\n fi\n\n - name: Execute merge script for each branch\n id: execute-merges\n if: steps.commit-bump.outputs.bumped == 'true' && env.branches_exist == 'true'\n run: |\n BRANCHES=\"${{ steps.find-branches.outputs.branches }}\"\n\n # Initialize arrays to track results\n SUCCESSFUL_MERGES=\"\"\n FAILED_MERGES=\"\"\n\n # Ensure the merge script is executable\n chmod +x scripts/merge-lean-testing-pr.sh\n\n # Process each branch\n for BRANCH in $BRANCHES; do\n # Extract PR number from branch name\n PR_NUMBER=$(echo \"$BRANCH\" | grep -oP '\\d+$')\n\n # Make sure we're on nightly-testing branch before doing fetch operations\n git checkout nightly-testing\n\n # Fetch all tags in the repository\n git fetch --tags\n\n # Fetch the PR branch\n git fetch origin \"$BRANCH\"\n\n # Find the most recent nightly-testing-YYYY-MM-DD tag that is an ancestor of the branch\n git checkout origin/\"$BRANCH\" || {\n echo \"Failed to checkout branch origin/$BRANCH, skipping\"\n continue\n }\n\n # Find tags that are ancestors of this branch with the right format\n LATEST_TAG=$(git tag --merged HEAD | grep \"nightly-testing-[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\" | sort -r | head -n 1)\n echo \"Latest tag found for $BRANCH: ${LATEST_TAG:-none}\"\n\n # Return to nightly-testing branch\n git checkout nightly-testing\n\n # Default to nightly-testing if no tag is found\n if [ -z \"$LATEST_TAG\" ]; then\n COMPARE_BASE=\"nightly-testing\"\n else\n COMPARE_BASE=\"$LATEST_TAG\"\n fi\n\n GITHUB_DIFF=\"https://github.com/leanprover-community/batteries/compare/$COMPARE_BASE...lean-pr-testing-$PR_NUMBER\"\n\n echo \"Attempting to merge branch: $BRANCH (PR #$PR_NUMBER)\"\n echo \"Using diff URL: $GITHUB_DIFF (comparing with $COMPARE_BASE)\"\n\n # Reset to a clean state before running merge script\n git reset --hard HEAD\n\n # Run the merge script and capture exit code\n # Note: The merge script does its own commit but NOT push\n if ./scripts/merge-lean-testing-pr.sh \"$PR_NUMBER\"; then\n echo \"Successfully merged $BRANCH\"\n SUCCESSFUL_MERGES=\"$SUCCESSFUL_MERGES$PR_NUMBER|$GITHUB_DIFF|$BRANCH \"\n else\n echo \"Failed to merge $BRANCH\"\n FAILED_MERGES=\"$FAILED_MERGES$PR_NUMBER|$GITHUB_DIFF|$BRANCH \"\n\n # Clean up - reset to a clean state\n git reset --hard HEAD\n git checkout nightly-testing\n fi\n done\n\n # Output the results\n echo \"successful_merges=$SUCCESSFUL_MERGES\" >> \"$GITHUB_OUTPUT\"\n echo \"failed_merges=$FAILED_MERGES\" >> \"$GITHUB_OUTPUT\"\n\n # ============================================================================\n # Phase 3: Push everything and notify\n # ============================================================================\n\n - name: Push all changes\n if: steps.commit-bump.outputs.bumped == 'true'\n run: |\n # This pushes the toolchain bump commit plus any successful merge commits\n git push origin nightly-testing\n\n - name: Prepare Zulip message\n id: zulip-message\n if: steps.commit-bump.outputs.bumped == 'true' && env.branches_exist == 'true'\n run: |\n SUCCESSFUL_MERGES=\"${{ steps.execute-merges.outputs.successful_merges }}\"\n FAILED_MERGES=\"${{ steps.execute-merges.outputs.failed_merges }}\"\n\n # Start building the message\n MESSAGE=\"\"\n\n # Report successful merges\n if [ -n \"$SUCCESSFUL_MERGES\" ]; then\n MESSAGE+=$'### Successfully merged branches into Batteries\\' \\'nightly-testing\\':\\n\\n'\n for MERGE_INFO in $SUCCESSFUL_MERGES; do\n IFS='|' read -r PR_NUMBER GITHUB_DIFF _ <<< \"$MERGE_INFO\"\n MESSAGE+=$(printf -- '- [lean-pr-testing-%s](%s) (adaptations for lean#%s)' \"$PR_NUMBER\" \"$GITHUB_DIFF\" \"$PR_NUMBER\")$'\\n\\n'\n done\n MESSAGE+=$'\\n'\n else\n MESSAGE+=$'No branches were successfully merged into Batteries\\' \\'nightly-testing\\'. \\n\\n'\n fi\n\n # Report failed merges\n if [ -n \"$FAILED_MERGES\" ]; then\n MESSAGE+=$'### Failed merges:\\n\\nThe following branches need to be merged manually into Batteries\\' \\'nightly-testing\\':\\n\\n'\n for MERGE_INFO in $FAILED_MERGES; do\n IFS='|' read -r PR_NUMBER GITHUB_DIFF _ <<< \"$MERGE_INFO\"\n MESSAGE+=$(printf '- [lean-pr-testing-%s](%s) (adaptations for lean#%s)' \"$PR_NUMBER\" \"$GITHUB_DIFF\" \"$PR_NUMBER\")$'\\n\\n'\n MESSAGE+=$'```bash\\n'\n MESSAGE+=$(printf 'scripts/merge-lean-testing-pr.sh %s' \"$PR_NUMBER\")$'\\n'\n MESSAGE+=$'```\\n\\n'\n done\n else\n MESSAGE+=$'All branches were successfully merged!\\n'\n fi\n\n # Output the message using the correct GitHub Actions syntax\n printf 'msg<> \"${GITHUB_ENV}\"\n # Check if the remote tag exists\n if git ls-remote --tags --exit-code origin \"nightly-testing-$version\" >/dev/null; then\n printf 'Tag nightly-testing-%s already exists on the remote.' \"${version}\"\n else\n # If the tag does not exist, create and push the tag to remote\n printf 'Creating tag %s from the current state of the nightly-testing branch.' \"nightly-testing-${version}\"\n git tag \"nightly-testing-${version}\"\n git push origin \"nightly-testing-${version}\"\n fi\n hash=\"$(git rev-parse \"nightly-testing-${version}\")\"\n printf 'SHA=%s\\n' \"${hash}\" >> \"${GITHUB_ENV}\"\n else\n echo \"Error: The file lean-toolchain does not contain the expected pattern.\"\n exit 1\n fi\n\n # Now post a success message to zulip, if the last message there is not a success message.\n # https://chat.openai.com/share/87656d2c-c804-4583-91aa-426d4f1537b3\n - name: Install Zulip API client\n run: pip install zulip\n\n - name: Check last message and post if necessary\n env:\n ZULIP_EMAIL: 'github-mathlib4-bot@leanprover.zulipchat.com'\n ZULIP_API_KEY: ${{ secrets.ZULIP_API_KEY }}\n ZULIP_SITE: 'https://leanprover.zulipchat.com'\n SHA: ${{ env.SHA }}\n run: |\n import os\n import zulip\n client = zulip.Client(email=os.getenv('ZULIP_EMAIL'), api_key=os.getenv('ZULIP_API_KEY'), site=os.getenv('ZULIP_SITE'))\n\n # Get the last message from the bot in the 'status updates' topic.\n # We narrow by sender to ignore human replies in between.\n bot_email = 'github-mathlib4-bot@leanprover.zulipchat.com'\n request = {\n 'anchor': 'newest',\n 'num_before': 1,\n 'num_after': 0,\n 'narrow': [\n {'operator': 'stream', 'operand': 'nightly-testing-batteries'},\n {'operator': 'topic', 'operand': 'Batteries status updates'},\n {'operator': 'sender', 'operand': bot_email}\n ],\n 'apply_markdown': False # Otherwise the content test below fails.\n }\n response = client.get_messages(request)\n messages = response['messages']\n if not messages or messages[0]['content'] != f\"✅ The latest CI for Batteries' [nightly-testing branch](https://github.com/${{ github.repository }}/tree/nightly-testing) has succeeded! ([{os.getenv('SHA')}](https://github.com/${{ github.repository }}/commit/{os.getenv('SHA')}))\":\n # Post the success message\n request = {\n 'type': 'stream',\n 'to': 'nightly-testing-batteries',\n 'topic': 'Batteries status updates',\n 'content': f\"✅ The latest CI for Batteries' [nightly-testing branch](https://github.com/${{ github.repository }}/tree/nightly-testing) has succeeded! ([{os.getenv('SHA')}](https://github.com/${{ github.repository }}/commit/{os.getenv('SHA')}))\"\n }\n result = client.send_message(request)\n print(result)\n shell: python\n\n # Next, determine if we should remind the humans to create a new PR to the `bump/v4.X.0` branch.\n\n - name: Check for matching bump/nightly-YYYY-MM-DD branch\n id: check_branch\n uses: actions/github-script@60a0d83039c74a4aee543508d2ffcb1c3799cdea # v7.0.1\n with:\n script: |\n const branchName = `bump/nightly-${process.env.NIGHTLY}`;\n console.log(`Looking for branch: ${branchName}`);\n\n // Use paginate to get all branches\n const branches = await github.paginate(github.rest.repos.listBranches, {\n owner: context.repo.owner,\n repo: context.repo.repo\n });\n\n const exists = branches.some(branch => branch.name === branchName);\n if (exists) {\n console.log(`Branch ${branchName} exists.`);\n return true;\n } else {\n console.log(`Branch ${branchName} does not exist.`);\n return false;\n }\n result-encoding: string\n\n - name: Exit if matching branch exists\n if: steps.check_branch.outputs.result == 'true'\n run: |\n echo \"Matching bump/nightly-YYYY-MM-DD branch found, no further action needed.\"\n exit 0\n\n - name: Fetch latest bump branch name\n id: latest_bump_branch\n uses: actions/github-script@60a0d83039c74a4aee543508d2ffcb1c3799cdea # v7.0.1\n with:\n result-encoding: string\n script: |\n const branches = await github.paginate(github.rest.repos.listBranches, {\n owner: context.repo.owner,\n repo: context.repo.repo\n });\n const bumpBranches = branches\n .map(branch => branch.name)\n .filter(name => name.match(/^bump\\/v4\\.\\d+\\.0$/))\n .sort((a, b) => b.localeCompare(a, undefined, {numeric: true, sensitivity: 'base'}));\n if (!bumpBranches.length) {\n throw new Exception(\"Did not find any bump/v4.x.0 branch\")\n }\n const latestBranch = bumpBranches[0];\n return latestBranch;\n\n - name: Fetch lean-toolchain from latest bump branch\n id: bump_version\n uses: actions/github-script@60a0d83039c74a4aee543508d2ffcb1c3799cdea # v7.0.1\n with:\n script: |\n try {\n const response = await github.rest.repos.getContent({\n owner: context.repo.owner,\n repo: context.repo.repo,\n path: 'lean-toolchain',\n ref: '${{ steps.latest_bump_branch.outputs.result }}'\n });\n const content = Buffer.from(response.data.content, 'base64').toString();\n const match = content.match(/leanprover\\/lean4:nightly-(\\d{4}-\\d{2}-\\d{2})/);\n if (!match) {\n core.setFailed('Toolchain pattern did not match');\n core.setOutput('toolchain_content', content);\n return null;\n }\n return match[1];\n } catch (error) {\n core.setFailed(error.message);\n return null;\n }\n\n - name: Send warning message on Zulip if pattern doesn't match\n if: failure()\n uses: zulip/github-actions-zulip/send-message@e4c8f27c732ba9bd98ac6be0583096dea82feea5 # v1.0.2\n with:\n api-key: ${{ secrets.ZULIP_API_KEY }}\n email: 'github-mathlib4-bot@leanprover.zulipchat.com'\n organization-url: 'https://leanprover.zulipchat.com'\n to: 'nightly-testing-batteries'\n type: 'stream'\n topic: 'Batteries status updates'\n content: |\n ⚠️ Warning: The lean-toolchain file in the latest bump branch does not match the expected pattern 'leanprover/lean4:nightly-YYYY-MM-DD'.\n Current content: ${{ steps.bump_version.outputs.toolchain_content }}\n This needs to be fixed for the nightly testing process to work correctly.\n\n - name: Setup for automatic PR creation\n if: steps.check_branch.outputs.result == 'false'\n env:\n BUMP_VERSION: ${{ steps.bump_version.outputs.result }}\n BUMP_BRANCH: ${{ steps.latest_bump_branch.outputs.result }}\n SHA: ${{ env.SHA }}\n run: |\n echo \"Installing zulip CLI...\"\n pip install zulip\n echo \"Configuring git identity for mathlib4-bot...\"\n git config --global user.name \"mathlib4-bot\"\n git config --global user.email \"github-mathlib4-bot@leanprover.zulipchat.com\"\n echo \"Setting up zulip credentials...\"\n {\n echo \"[api]\"\n echo \"email=github-mathlib4-bot@leanprover.zulipchat.com\"\n echo \"key=${{ secrets.ZULIP_API_KEY }}\"\n echo \"site=https://leanprover.zulipchat.com\"\n } > ~/.zuliprc\n chmod 600 ~/.zuliprc\n echo \"Setup complete\"\n\n - name: Clean workspace and checkout Batteries\n if: steps.check_branch.outputs.result == 'false'\n run: |\n sudo rm -rf -- *\n # Regenerate the app token just before use.\n # GitHub App tokens expire after 1 hour, and the preceding steps can take longer than that.\n - name: Regenerate app token for Batteries checkout\n if: steps.check_branch.outputs.result == 'false'\n id: app-token-2\n uses: actions/create-github-app-token@29824e69f54612133e76f7eaac726eef6c875baf # v2.2.1\n with:\n app-id: ${{ secrets.MATHLIB_NIGHTLY_TESTING_APP_ID }}\n private-key: ${{ secrets.MATHLIB_NIGHTLY_TESTING_PRIVATE_KEY }}\n - name: Checkout Batteries repository\n uses: actions/checkout@11bd71901bbe5b1630ceea73d27597364c9af683 # v4.2.2\n if: steps.check_branch.outputs.result == 'false'\n with:\n ref: nightly-testing # checkout nightly-testing branch (shouldn't matter which)\n fetch-depth: 0 # checkout all branches\n token: ${{ steps.app-token-2.outputs.token }}\n\n - name: Attempt automatic PR creation\n id: auto_pr\n if: steps.check_branch.outputs.result == 'false'\n continue-on-error: true\n env:\n BUMP_VERSION: ${{ steps.bump_version.outputs.result }}\n BUMP_BRANCH: ${{ steps.latest_bump_branch.outputs.result }}\n SHA: ${{ env.SHA }}\n GH_TOKEN: ${{ steps.app-token-2.outputs.token }}\n ZULIP_API_KEY: ${{ secrets.ZULIP_API_KEY }}\n run: |\n echo \"Current version: ${NIGHTLY}\"\n echo \"Target bump branch: ${BUMP_BRANCH}\"\n echo \"Using commit SHA: ${SHA}\"\n current_version=\"${NIGHTLY}\"\n bump_branch_suffix=\"${BUMP_BRANCH#bump/}\"\n echo \"Running create-adaptation-pr.sh with:\"\n echo \" bumpversion: ${bump_branch_suffix}\"\n echo \" nightlydate: ${current_version}\"\n echo \" nightlysha: ${SHA}\"\n ./scripts/create-adaptation-pr.sh --bumpversion=\"${bump_branch_suffix}\" --nightlydate=\"${current_version}\" --nightlysha=\"${SHA}\" --auto=yes\n\n - name: Fallback to manual instructions\n if: steps.auto_pr.outcome == 'failure' && steps.check_branch.outputs.result == 'false'\n env:\n BUMP_VERSION: ${{ steps.bump_version.outputs.result }}\n BUMP_BRANCH: ${{ steps.latest_bump_branch.outputs.result }}\n SHA: ${{ env.SHA }}\n ZULIP_API_KEY: ${{ secrets.ZULIP_API_KEY }}\n REPOSITORY: ${{ github.repository }}\n CURRENT_RUN_ID: ${{ github.run_id }}\n shell: python\n run: |\n import os\n import re\n import zulip\n client = zulip.Client(config_file=\"~/.zuliprc\")\n current_version = os.getenv('NIGHTLY')\n bump_version = os.getenv('BUMP_VERSION')\n bump_branch = os.getenv('BUMP_BRANCH')\n sha = os.getenv('SHA')\n repository = os.getenv('REPOSITORY')\n current_run_id = os.getenv('CURRENT_RUN_ID')\n print(f'Current version: {current_version}, Bump version: {bump_version}, SHA: {sha}')\n if current_version > bump_version:\n print('Lean toolchain in `nightly-testing` is ahead of the bump branch.')\n # Get the last message from the bot in the 'Batteries bump branch reminders' topic.\n # We narrow by sender to ignore human replies in between.\n bot_email = 'github-mathlib4-bot@leanprover.zulipchat.com'\n request = {\n 'anchor': 'newest',\n 'num_before': 1,\n 'num_after': 0,\n 'narrow': [\n {'operator': 'stream', 'operand': 'nightly-testing-batteries'},\n {'operator': 'topic', 'operand': 'Batteries bump branch reminders'},\n {'operator': 'sender', 'operand': bot_email}\n ],\n 'apply_markdown': False # Otherwise the content test below fails.\n }\n response = client.get_messages(request)\n messages = response['messages']\n last_bot_message = messages[0] if messages else None\n bump_branch_suffix = bump_branch.replace('bump/', '')\n failed_link = f\"https://github.com/{repository}/actions/runs/{current_run_id}\"\n payload = f\"🛠️: Automatic PR creation [failed]({failed_link}). Please create a new bump/nightly-{current_version} branch from nightly-testing (specifically {sha}), and then PR that to {bump_branch}. \"\n payload += \"To do so semi-automatically, run the following script from Batteries root:\\n\\n\"\n payload += f\"```bash\\n./scripts/create-adaptation-pr.sh --bumpversion={bump_branch_suffix} --nightlydate={current_version} --nightlysha={sha}\\n```\\n\"\n # Check if we already posted a message for this nightly date and bump branch.\n # We extract these fields from the last bot message rather than comparing substrings,\n # since the message also contains a run ID that differs between workflow runs.\n should_post = True\n if last_bot_message:\n last_content = last_bot_message['content']\n # Extract nightly date and bump branch from last bot message\n date_match = re.search(r'bump/nightly-(\\d{4}-\\d{2}-\\d{2})', last_content)\n branch_match = re.search(r'PR that to (bump/v[\\d.]+)', last_content)\n if date_match and branch_match:\n last_date = date_match.group(1)\n last_branch = branch_match.group(1)\n if last_date == current_version and last_branch == bump_branch:\n should_post = False\n print(f'Already posted for nightly {current_version} and {bump_branch}')\n if should_post:\n if last_bot_message:\n print(\"###### Last bot message:\")\n print(last_bot_message['content'])\n print(\"###### Current message:\")\n print(payload)\n # Post the reminder message\n request = {\n 'type': 'stream',\n 'to': 'nightly-testing-batteries',\n 'topic': 'Batteries bump branch reminders',\n 'content': payload\n }\n result = client.send_message(request)\n print(result)\n else:\n print('No action needed.')\n" }, { "path": ".github/workflows/nightly_merge_master.yml", "content": "# This job merges every commit to `main` into `nightly-testing`, resolving merge conflicts in favor of `nightly-testing`.\n\nname: Merge main to nightly\n\non:\n push:\n branches:\n - main\n\njobs:\n merge-to-nightly:\n if: github.repository_owner == 'leanprover-community'\n runs-on: ubuntu-latest\n steps:\n - name: Generate app token\n id: app-token\n uses: actions/create-github-app-token@29824e69f54612133e76f7eaac726eef6c875baf # v2.2.1\n with:\n app-id: ${{ secrets.MATHLIB_NIGHTLY_TESTING_APP_ID }}\n private-key: ${{ secrets.MATHLIB_NIGHTLY_TESTING_PRIVATE_KEY }}\n # The create-github-app-token README states that this token is masked and will not be logged accidentally.\n\n - name: Checkout repository\n uses: actions/checkout@11bd71901bbe5b1630ceea73d27597364c9af683 # v4.2.2\n with:\n fetch-depth: 0\n token: ${{ steps.app-token.outputs.token }}\n\n - name: Configure Git User\n run: |\n git config user.name \"mathlib-nightly-testing[bot]\"\n git config user.email \"mathlib-nightly-testing[bot]@users.noreply.github.com\"\n\n - name: Merge main to nightly favoring nightly changes\n run: |\n git checkout nightly-testing\n git merge main --strategy-option ours --no-commit --allow-unrelated-histories\n git commit -m \"Merge main into nightly-testing\"\n git push origin nightly-testing\n" }, { "path": ".github/workflows/test_mathlib.yml", "content": "# Test Mathlib against a Batteries PR\n\nname: Test Mathlib\n\non:\n workflow_run:\n workflows: [ci]\n types: [completed]\n\njobs:\n on-success:\n runs-on: ubuntu-latest\n if: github.event.workflow_run.conclusion == 'success' && github.event.workflow_run.event == 'pull_request' && github.repository == 'leanprover-community/batteries'\n steps:\n - name: Checkout PR\n uses: actions/checkout@11bd71901bbe5b1630ceea73d27597364c9af683 # v4.2.2\n with:\n fetch-depth: 0\n\n - name: Get PR info\n id: pr-info\n run: |\n echo \"pullRequestNumber=$(gh pr list --search $SHA --json number -q '.[0].number' || echo '')\" >> $GITHUB_OUTPUT\n echo \"targetBranch=$(gh pr list --search $SHA --json baseRefName -q '.[0].baseRefName' || echo '')\" >> $GITHUB_OUTPUT\n env:\n GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}\n SHA: ${{ github.event.workflow_run.head_sha }}\n\n - name: Generate app token\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n id: app-token\n uses: actions/create-github-app-token@29824e69f54612133e76f7eaac726eef6c875baf # v2.2.1\n with:\n app-id: ${{ secrets.MATHLIB_NIGHTLY_TESTING_APP_ID }}\n private-key: ${{ secrets.MATHLIB_NIGHTLY_TESTING_PRIVATE_KEY }}\n owner: leanprover-community\n repositories: mathlib4,mathlib4-nightly-testing\n\n - name: Checkout mathlib4 repository\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n uses: actions/checkout@11bd71901bbe5b1630ceea73d27597364c9af683 # v4.2.2\n with:\n repository: leanprover-community/mathlib4\n token: ${{ steps.app-token.outputs.token }}\n ref: master\n fetch-depth: 0\n\n - name: Add nightly-testing remote\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n run: |\n git remote add nightly-testing https://github.com/leanprover-community/mathlib4-nightly-testing.git\n git fetch nightly-testing\n\n - name: Install elan\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n run: |\n set -o pipefail\n curl -sSfL https://github.com/leanprover/elan/releases/download/v3.0.0/elan-x86_64-unknown-linux-gnu.tar.gz | tar xz\n ./elan-init -y --default-toolchain none\n echo \"$HOME/.elan/bin\" >> \"${GITHUB_PATH}\"\n\n - name: Check if branch exists\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n id: check_mathlib_tag\n env:\n PR_NUMBER: ${{ steps.pr-info.outputs.pullRequestNumber }}\n HEAD_REPO: ${{ github.event.workflow_run.head_repository.full_name }}\n HEAD_BRANCH: ${{ github.event.workflow_run.head_branch }}\n run: |\n git config user.name \"mathlib-nightly-testing[bot]\"\n git config user.email \"mathlib-nightly-testing[bot]@users.noreply.github.com\"\n\n echo \"PR info: $HEAD_REPO $HEAD_BRANCH\"\n\n BASE=master\n echo \"Using base tag: $BASE\"\n\n EXISTS=\"$(git ls-remote --heads nightly-testing batteries-pr-testing-$PR_NUMBER | wc -l)\"\n echo \"Branch exists: $EXISTS\"\n if [ \"$EXISTS\" = \"0\" ]; then\n echo \"Branch does not exist, creating it.\"\n git switch -c batteries-pr-testing-$PR_NUMBER \"$BASE\"\n\n # Modify the lakefile.lean with the fork and branch name\n sed -i \"s,require \\\"leanprover-community\\\" / \\\"batteries\\\" @ git \\\".\\+\\\",require \\\"leanprover-community\\\" / \\\"batteries\\\" from git \\\"https://github.com/$HEAD_REPO\\\" @ \\\"$HEAD_BRANCH\\\",g\" lakefile.lean\n\n lake update batteries\n git add lakefile.lean lake-manifest.json\n git commit -m \"Update Batteries branch for testing https://github.com/leanprover-community/batteries/pull/$PR_NUMBER\"\n else\n echo \"Branch already exists, merging $BASE and bumping Batteries.\"\n git switch batteries-pr-testing-$PR_NUMBER\n git merge \"$BASE\" --strategy-option ours --no-commit --allow-unrelated-histories\n lake update batteries\n git add lake-manifest.json\n git commit --allow-empty -m \"Trigger CI for https://github.com/leanprover-community/batteries/pull/$PR_NUMBER\"\n fi\n\n - name: Push changes\n if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main'\n env:\n PR_NUMBER: ${{ steps.pr-info.outputs.pullRequestNumber }}\n run: |\n git push nightly-testing batteries-pr-testing-$PR_NUMBER\n" }, { "path": ".gitignore", "content": "# Prior to v4.3.0-rc2 lake stored files in these locations.\n# We'll leave them in the `.gitignore` for a while for users switching between toolchains.\n/build/\n/lake-packages/\n/lakefile.olean\n# After v4.3.0-rc2 lake stores its files here:\n/.lake/\n" }, { "path": ".gitpod.yml", "content": "image:\n file: .docker/gitpod/Dockerfile\n\nvscode:\n extensions:\n - leanprover.lean4\n\ntasks:\n - init: |\n elan self update\n lake build\n" }, { "path": ".vscode/copyright.code-snippets", "content": "{\n\t\"Copyright header for batteries\": {\n\t\t\"scope\": \"lean4\",\n\t\t\"prefix\": \"copyright\",\n\t\t\"body\": [\n\t\t\t\"/-\",\n\t\t\t\"Copyright (c) ${CURRENT_YEAR} $1. All rights reserved.\",\n\t\t\t\"Released under Apache 2.0 license as described in the file LICENSE.\",\n\t\t\t\"Authors: $1\",\n\t\t\t\"-/\"\n\t\t]\n\t}\n}\n" }, { "path": ".vscode/settings.json", "content": "{\n \"editor.insertSpaces\": true,\n \"editor.tabSize\": 2,\n \"editor.rulers\" : [100],\n \"files.encoding\": \"utf8\",\n \"files.eol\": \"\\n\",\n \"files.insertFinalNewline\": true,\n \"files.trimFinalNewlines\": true,\n \"files.trimTrailingWhitespace\": true,\n \"search.usePCRE2\": true\n}\n" }, { "path": "Batteries/Classes/Cast.lean", "content": "/-\nCopyright (c) 2014 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Gabriel Ebner\n-/\nmodule\n\npublic import Batteries.Util.LibraryNote\n\n@[expose] public section\n\nlibrary_note «coercion into rings» /--\nCoercions such as `Nat.castCoe` that go from a concrete structure such as\n`Nat` to an arbitrary ring `R` should be set up as follows:\n```lean\ninstance : CoeTail Nat R where coe := ...\ninstance : CoeHTCT Nat R where coe := ...\n```\n\nIt needs to be `CoeTail` instead of `Coe` because otherwise type-class\ninference would loop when constructing the transitive coercion `Nat → Nat → Nat → ...`.\nSometimes we also need to declare the `CoeHTCT` instance\nif we need to shadow another coercion\n(e.g. `Nat.cast` should be used over `Int.ofNat`).\n-/\n" }, { "path": "Batteries/Classes/Deprecated.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Classes.Order\n\n@[expose] public section\n\n/-! Deprecated Batteries comparison classes\n\nExamples are to ensure that old instances have equivalent new instances.\n-/\n\nset_option linter.deprecated false\n\nnamespace Batteries\n\n/-- `OrientedCmp cmp` asserts that `cmp` is determined by the relation `cmp x y = .lt`. -/\n@[deprecated Std.OrientedCmp (since := \"2025-07-01\")]\nclass OrientedCmp (cmp : α → α → Ordering) : Prop where\n /-- The comparator operation is symmetric, in the sense that if `cmp x y` equals `.lt` then\n `cmp y x = .gt` and vice versa. -/\n symm (x y) : (cmp x y).swap = cmp y x\n\nattribute [deprecated Std.OrientedOrd.eq_swap (since := \"2025-07-01\")] OrientedCmp.symm\n\nnamespace OrientedCmp\n\n@[deprecated Std.OrientedCmp.gt_iff_lt (since := \"2025-07-01\")]\ntheorem cmp_eq_gt [OrientedCmp cmp] : cmp x y = .gt ↔ cmp y x = .lt := by\n rw [← Ordering.swap_inj, symm]; exact .rfl\n\n@[deprecated Std.OrientedCmp.le_iff_ge (since := \"2025-07-01\")]\ntheorem cmp_ne_gt [OrientedCmp cmp] : cmp x y ≠ .gt ↔ cmp y x ≠ .lt := not_congr cmp_eq_gt\n\n@[deprecated Std.OrientedCmp.eq_comm (since := \"2025-07-01\")]\ntheorem cmp_eq_eq_symm [OrientedCmp cmp] : cmp x y = .eq ↔ cmp y x = .eq := by\n rw [← Ordering.swap_inj, symm]; exact .rfl\n\n@[deprecated Std.ReflCmp.compare_self (since := \"2025-07-01\")]\ntheorem cmp_refl [OrientedCmp cmp] : cmp x x = .eq :=\n match e : cmp x x with\n | .lt => nomatch e.symm.trans (cmp_eq_gt.2 e)\n | .eq => rfl\n | .gt => nomatch (cmp_eq_gt.1 e).symm.trans e\n\n@[deprecated Std.OrientedCmp.not_lt_of_lt (since := \"2025-07-01\")]\ntheorem lt_asymm [OrientedCmp cmp] (h : cmp x y = .lt) : cmp y x ≠ .lt :=\n fun h' => nomatch h.symm.trans (cmp_eq_gt.2 h')\n\n@[deprecated Std.OrientedCmp.not_gt_of_gt (since := \"2025-07-01\")]\ntheorem gt_asymm [OrientedCmp cmp] (h : cmp x y = .gt) : cmp y x ≠ .gt :=\n mt cmp_eq_gt.1 <| lt_asymm <| cmp_eq_gt.1 h\n\nend OrientedCmp\n\n/-- `TransCmp cmp` asserts that `cmp` induces a transitive relation. -/\n@[deprecated Std.TransCmp (since := \"2025-07-01\")]\nclass TransCmp (cmp : α → α → Ordering) : Prop extends OrientedCmp cmp where\n /-- The comparator operation is transitive. -/\n le_trans : cmp x y ≠ .gt → cmp y z ≠ .gt → cmp x z ≠ .gt\n\nattribute [deprecated Std.TransCmp.le_trans (since := \"2025-07-01\")] TransCmp.le_trans\n\nnamespace TransCmp\nvariable [TransCmp cmp]\nopen OrientedCmp Decidable\n\n@[deprecated Std.TransCmp.ge_trans (since := \"2025-07-01\")]\ntheorem ge_trans (h₁ : cmp x y ≠ .lt) (h₂ : cmp y z ≠ .lt) : cmp x z ≠ .lt := by\n have := @TransCmp.le_trans _ cmp _ z y x\n simp [cmp_eq_gt] at *; exact this h₂ h₁\n\n@[deprecated Std.TransCmp.lt_of_le_of_lt (since := \"2025-07-01\")]\ntheorem le_lt_trans (h₁ : cmp x y ≠ .gt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=\n byContradiction fun h₃ => ge_trans (mt cmp_eq_gt.2 h₁) h₃ h₂\n\n@[deprecated Std.TransCmp.lt_of_lt_of_le (since := \"2025-07-01\")]\ntheorem lt_le_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z ≠ .gt) : cmp x z = .lt :=\n byContradiction fun h₃ => ge_trans h₃ (mt cmp_eq_gt.2 h₂) h₁\n\n@[deprecated Std.TransCmp.lt_trans (since := \"2025-07-01\")]\ntheorem lt_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=\n le_lt_trans (gt_asymm <| cmp_eq_gt.2 h₁) h₂\n\n@[deprecated Std.TransCmp.gt_trans (since := \"2025-07-01\")]\ntheorem gt_trans (h₁ : cmp x y = .gt) (h₂ : cmp y z = .gt) : cmp x z = .gt := by\n rw [cmp_eq_gt] at h₁ h₂ ⊢; exact lt_trans h₂ h₁\n\n@[deprecated Std.TransCmp.congr_left (since := \"2025-07-01\")]\ntheorem cmp_congr_left (xy : cmp x y = .eq) : cmp x z = cmp y z :=\n match yz : cmp y z with\n | .lt => byContradiction (ge_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)\n | .gt => byContradiction (le_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)\n | .eq => match xz : cmp x z with\n | .lt => nomatch ge_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz\n | .gt => nomatch le_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz\n | .eq => rfl\n\n@[deprecated Std.TransCmp.congr_left (since := \"2025-07-01\")]\ntheorem cmp_congr_left' (xy : cmp x y = .eq) : cmp x = cmp y :=\n funext fun _ => cmp_congr_left xy\n\n@[deprecated Std.TransCmp.congr_right (since := \"2025-07-01\")]\ntheorem cmp_congr_right (yz : cmp y z = .eq) : cmp x y = cmp x z := by\n rw [← Ordering.swap_inj, symm, symm, cmp_congr_left yz]\n\nend TransCmp\n\ninstance [inst : OrientedCmp cmp] : OrientedCmp (flip cmp) where\n symm _ _ := inst.symm ..\n\nexample [inst : Std.OrientedCmp cmp] : Std.OrientedCmp (flip cmp) := inferInstance\n\ninstance [inst : TransCmp cmp] : TransCmp (flip cmp) where\n le_trans h1 h2 := inst.le_trans h2 h1\n\nexample [inst : Std.TransCmp cmp] : Std.TransCmp (flip cmp) := inferInstance\n\n/-- `BEqCmp cmp` asserts that `cmp x y = .eq` and `x == y` coincide. -/\n@[deprecated Std.LawfulBEqCmp (since := \"2025-07-01\")]\nclass BEqCmp [BEq α] (cmp : α → α → Ordering) : Prop where\n /-- `cmp x y = .eq` holds iff `x == y` is true. -/\n cmp_iff_beq : cmp x y = .eq ↔ x == y\n\nattribute [deprecated Std.LawfulBEqCmp.compare_eq_iff_beq\n (since := \"2025-07-01\")] BEqCmp.cmp_iff_beq\n\n@[deprecated Std.LawfulEqCmp.compare_eq_iff_eq (since := \"2025-07-01\")]\ntheorem BEqCmp.cmp_iff_eq [BEq α] [LawfulBEq α] [BEqCmp (α := α) cmp] : cmp x y = .eq ↔ x = y := by\n simp [BEqCmp.cmp_iff_beq]\n\n/-- `LTCmp cmp` asserts that `cmp x y = .lt` and `x < y` coincide. -/\n@[deprecated Std.LawfulLTCmp (since := \"2025-07-01\")]\nclass LTCmp [LT α] (cmp : α → α → Ordering) : Prop extends OrientedCmp cmp where\n /-- `cmp x y = .lt` holds iff `x < y` is true. -/\n cmp_iff_lt : cmp x y = .lt ↔ x < y\n\nattribute [deprecated Std.LawfulLTCmp.eq_lt_iff_lt (since := \"2025-07-01\")] LTCmp.cmp_iff_lt\n\n@[deprecated Std.LawfulLTCmp.eq_gt_iff_gt (since := \"2025-07-01\")]\ntheorem LTCmp.cmp_iff_gt [LT α] [LTCmp (α := α) cmp] : cmp x y = .gt ↔ y < x := by\n rw [OrientedCmp.cmp_eq_gt, LTCmp.cmp_iff_lt]\n\n/-- `LECmp cmp` asserts that `cmp x y ≠ .gt` and `x ≤ y` coincide. -/\n@[deprecated Std.LawfulLECmp (since := \"2025-07-01\")]\nclass LECmp [LE α] (cmp : α → α → Ordering) : Prop extends OrientedCmp cmp where\n /-- `cmp x y ≠ .gt` holds iff `x ≤ y` is true. -/\n cmp_iff_le : cmp x y ≠ .gt ↔ x ≤ y\n\nattribute [deprecated Std.LawfulLECmp.ne_gt_iff_le (since := \"2025-07-01\")] LECmp.cmp_iff_le\n\n@[deprecated Std.LawfulLECmp.ne_lt_iff_ge (since := \"2025-07-01\")]\ntheorem LECmp.cmp_iff_ge [LE α] [LECmp (α := α) cmp] : cmp x y ≠ .lt ↔ y ≤ x := by\n rw [← OrientedCmp.cmp_ne_gt, LECmp.cmp_iff_le]\n\n/-- `LawfulCmp cmp` asserts that the `LE`, `LT`, `BEq` instances are all coherent with each other\nand with `cmp`, describing a strict weak order (a linear order except for antisymmetry). -/\n@[deprecated Std.LawfulBCmp (since := \"2025-07-01\")]\nclass LawfulCmp [LE α] [LT α] [BEq α] (cmp : α → α → Ordering) : Prop extends\n TransCmp cmp, BEqCmp cmp, LTCmp cmp, LECmp cmp\n\n/-- `OrientedOrd α` asserts that the `Ord` instance satisfies `OrientedCmp`. -/\n@[deprecated Std.OrientedOrd (since := \"2025-07-01\")]\nabbrev OrientedOrd (α) [Ord α] := OrientedCmp (α := α) compare\n\n/-- `TransOrd α` asserts that the `Ord` instance satisfies `TransCmp`. -/\n@[deprecated Std.TransOrd (since := \"2025-07-01\")]\nabbrev TransOrd (α) [Ord α] := TransCmp (α := α) compare\n\n/-- `BEqOrd α` asserts that the `Ord` and `BEq` instances are coherent via `BEqCmp`. -/\n@[deprecated Std.LawfulBEqOrd (since := \"2025-07-01\")]\nabbrev BEqOrd (α) [BEq α] [Ord α] := BEqCmp (α := α) compare\n\n/-- `LTOrd α` asserts that the `Ord` instance satisfies `LTCmp`. -/\n@[deprecated Std.LawfulLTOrd (since := \"2025-07-01\")]\nabbrev LTOrd (α) [LT α] [Ord α] := LTCmp (α := α) compare\n\n/-- `LEOrd α` asserts that the `Ord` instance satisfies `LECmp`. -/\n@[deprecated Std.LawfulLEOrd (since := \"2025-07-01\")]\nabbrev LEOrd (α) [LE α] [Ord α] := LECmp (α := α) compare\n\n/-- `LawfulOrd α` asserts that the `Ord` instance satisfies `LawfulCmp`. -/\n@[deprecated Std.LawfulBOrd (since := \"2025-07-01\")]\nabbrev LawfulOrd (α) [LE α] [LT α] [BEq α] [Ord α] := LawfulCmp (α := α) compare\n\n@[deprecated Std.TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n (since := \"2025-07-01\")]\nprotected theorem TransCmp.compareOfLessAndEq\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (lt_antisymm : ∀ {x y : α}, ¬x < y → ¬y < x → x = y) :\n TransCmp (α := α) (compareOfLessAndEq · ·) := by\n have : OrientedCmp (α := α) (compareOfLessAndEq · ·) := by\n refine { symm := fun x y => ?_ }\n simp [compareOfLessAndEq]; split <;> [rename_i xy; split <;> [subst y; rename_i xy ne]]\n · rw [if_neg, if_neg]; rfl\n · rintro rfl; exact lt_irrefl _ xy\n · exact fun yx => lt_irrefl _ (lt_trans xy yx)\n · rw [if_neg ‹_›, if_pos rfl]; rfl\n · split <;> [rfl; rename_i yx]\n cases ne (lt_antisymm xy yx)\n refine { this with le_trans := fun {x y z} yx zy => ?_ }\n rw [Ne, this.cmp_eq_gt, compareOfLessAndEq_eq_lt] at yx zy ⊢\n intro zx\n if xy : x < y then exact zy (lt_trans zx xy)\n else exact zy (lt_antisymm yx xy ▸ zx)\n\n@[deprecated Std.TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (since := \"2025-07-01\")]\ntheorem TransCmp.compareOfLessAndEq_of_le\n [LT α] [LE α] [DecidableRel (LT.lt (α := α))] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y → y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n TransCmp (α := α) (compareOfLessAndEq · ·) :=\n .compareOfLessAndEq lt_irrefl lt_trans fun xy yx => le_antisymm (not_lt yx) (not_lt xy)\n\n@[deprecated Std.LawfulBEqCmp.compareOfLessAndEq_of_lt_irrefl (since := \"2025-07-01\")]\nprotected theorem BEqCmp.compareOfLessAndEq\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α] [BEq α] [LawfulBEq α]\n (lt_irrefl : ∀ x : α, ¬x < x) :\n BEqCmp (α := α) (compareOfLessAndEq · ·) where\n cmp_iff_beq {x y} := by\n simp [compareOfLessAndEq]\n split <;> [skip; split] <;> simp [*]\n rintro rfl; exact lt_irrefl _ ‹_›\n\n@[deprecated Std.LawfulLTCmp.compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n (since := \"2025-07-01\")]\nprotected theorem LTCmp.compareOfLessAndEq\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (lt_antisymm : ∀ {x y : α}, ¬x < y → ¬y < x → x = y) :\n LTCmp (α := α) (compareOfLessAndEq · ·) :=\n { TransCmp.compareOfLessAndEq lt_irrefl lt_trans lt_antisymm with\n cmp_iff_lt := compareOfLessAndEq_eq_lt }\n\n@[deprecated Std.LawfulLTCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (since := \"2025-07-01\")]\nprotected theorem LTCmp.compareOfLessAndEq_of_le\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α] [LE α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y → y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LTCmp (α := α) (compareOfLessAndEq · ·) :=\n { TransCmp.compareOfLessAndEq_of_le lt_irrefl lt_trans not_lt le_antisymm with\n cmp_iff_lt := compareOfLessAndEq_eq_lt }\n\n@[deprecated Std.LawfulLECmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (since := \"2025-07-01\")]\nprotected theorem LECmp.compareOfLessAndEq\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α] [LE α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y ↔ y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LECmp (α := α) (compareOfLessAndEq · ·) :=\n have := TransCmp.compareOfLessAndEq_of_le lt_irrefl lt_trans not_lt.1 le_antisymm\n { this with\n cmp_iff_le := (this.cmp_ne_gt).trans <| (not_congr compareOfLessAndEq_eq_lt).trans not_lt }\n\n@[deprecated Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (since := \"2025-07-01\")]\nprotected theorem LawfulCmp.compareOfLessAndEq\n [LT α] [DecidableRel (LT.lt (α := α))] [DecidableEq α] [BEq α] [LawfulBEq α] [LE α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y ↔ y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LawfulCmp (α := α) (compareOfLessAndEq · ·) :=\n { TransCmp.compareOfLessAndEq_of_le lt_irrefl lt_trans not_lt.1 le_antisymm,\n LTCmp.compareOfLessAndEq_of_le lt_irrefl lt_trans not_lt.1 le_antisymm,\n LECmp.compareOfLessAndEq lt_irrefl lt_trans not_lt le_antisymm,\n BEqCmp.compareOfLessAndEq lt_irrefl with }\n\n@[deprecated Std.LawfulLTCmp.eq_compareOfLessAndEq (since := \"2025-07-01\")]\ntheorem LTCmp.eq_compareOfLessAndEq\n [LT α] [DecidableEq α] [BEq α] [LawfulBEq α] [BEqCmp cmp] [LTCmp cmp]\n (x y : α) [Decidable (x < y)] : cmp x y = compareOfLessAndEq x y := by\n simp [compareOfLessAndEq]\n split <;> rename_i h1 <;> [skip; split <;> rename_i h2]\n · exact LTCmp.cmp_iff_lt.2 h1\n · exact BEqCmp.cmp_iff_eq.2 h2\n · cases e : cmp x y\n · cases h1 (LTCmp.cmp_iff_lt.1 e)\n · cases h2 (BEqCmp.cmp_iff_eq.1 e)\n · rfl\n\ninstance [inst₁ : OrientedCmp cmp₁] [inst₂ : OrientedCmp cmp₂] :\n OrientedCmp (compareLex cmp₁ cmp₂) where\n symm _ _ := by simp [compareLex, Ordering.swap_then]; rw [inst₁.symm, inst₂.symm]\n\nexample [inst₁ : Std.OrientedCmp cmp₁] [inst₂ : Std.OrientedCmp cmp₂] :\n Std.OrientedCmp (compareLex cmp₁ cmp₂) := inferInstance\n\ninstance [inst₁ : TransCmp cmp₁] [inst₂ : TransCmp cmp₂] :\n TransCmp (compareLex cmp₁ cmp₂) where\n le_trans {a b c} h1 h2 := by\n simp only [compareLex, ne_eq, Ordering.then_eq_gt, not_or, not_and] at h1 h2 ⊢\n refine ⟨inst₁.le_trans h1.1 h2.1, fun e1 e2 => ?_⟩\n match ab : cmp₁ a b with\n | .gt => exact h1.1 ab\n | .eq => exact inst₂.le_trans (h1.2 ab) (h2.2 (inst₁.cmp_congr_left ab ▸ e1)) e2\n | .lt => exact h2.1 <| (inst₁.cmp_eq_gt).2 (inst₁.cmp_congr_left e1 ▸ ab)\n\nexample [inst₁ : Std.TransCmp cmp₁] [inst₂ : Std.TransCmp cmp₂] :\n Std.TransCmp (compareLex cmp₁ cmp₂) := inferInstance\n\ninstance [Ord β] [OrientedOrd β] (f : α → β) : OrientedCmp (compareOn f) where\n symm _ _ := OrientedCmp.symm (α := β) ..\n\nexample [Ord β] [Std.OrientedOrd β] (f : α → β) : Std.OrientedCmp (compareOn f) :=\n inferInstance\n\ninstance [Ord β] [TransOrd β] (f : α → β) : TransCmp (compareOn f) where\n le_trans := TransCmp.le_trans (α := β)\n\nexample [Ord β] [Std.TransOrd β] (f : α → β) : Std.TransCmp (compareOn f) :=\n inferInstance\n\nsection «non-canonical instances»\n-- Note: the following instances seem to cause lean to fail, see:\n-- https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Typeclass.20inference.20crashes/near/432836360\n\n/-- Local instance for `OrientedOrd lexOrd`. -/\n@[deprecated \"instance exists\" (since := \"2025-07-01\")]\ntheorem OrientedOrd.instLexOrd [Ord α] [Ord β]\n [OrientedOrd α] [OrientedOrd β] : @OrientedOrd (α × β) lexOrd := by\n rw [OrientedOrd, lexOrd_def]; infer_instance\n\n/-- Local instance for `TransOrd lexOrd`. -/\n@[deprecated \"instance exists\" (since := \"2025-07-01\")]\ntheorem TransOrd.instLexOrd [Ord α] [Ord β]\n [TransOrd α] [TransOrd β] : @TransOrd (α × β) lexOrd := by\n rw [TransOrd, lexOrd_def]; infer_instance\n\n/-- Local instance for `OrientedOrd ord.opposite`. -/\n@[deprecated Std.OrientedOrd.opposite (since := \"2025-07-01\")]\ntheorem OrientedOrd.instOpposite [ord : Ord α] [inst : OrientedOrd α] :\n @OrientedOrd _ ord.opposite where symm _ _ := inst.symm ..\n\n/-- Local instance for `TransOrd ord.opposite`. -/\n@[deprecated Std.TransOrd.opposite (since := \"2025-07-01\")]\ntheorem TransOrd.instOpposite [ord : Ord α] [inst : TransOrd α] : @TransOrd _ ord.opposite :=\n { OrientedOrd.instOpposite with le_trans := fun h1 h2 => inst.le_trans h2 h1 }\n\n/-- Local instance for `OrientedOrd (ord.on f)`. -/\n@[deprecated Std.OrientedOrd.instOn (since := \"2025-07-01\")]\ntheorem OrientedOrd.instOn [ord : Ord β] [OrientedOrd β] (f : α → β) : @OrientedOrd _ (ord.on f) :=\n inferInstanceAs (@OrientedCmp _ (compareOn f))\n\n/-- Local instance for `TransOrd (ord.on f)`. -/\n@[deprecated Std.TransOrd.instOn (since := \"2025-07-01\")]\ntheorem TransOrd.instOn [ord : Ord β] [TransOrd β] (f : α → β) : @TransOrd _ (ord.on f) :=\n inferInstanceAs (@TransCmp _ (compareOn f))\n\n/-- Local instance for `OrientedOrd (oα.lex oβ)`. -/\n@[deprecated \"instance exists\" (since := \"2025-07-01\")]\ntheorem OrientedOrd.instOrdLex [oα : Ord α] [oβ : Ord β] [OrientedOrd α] [OrientedOrd β] :\n @OrientedOrd _ (oα.lex oβ) := OrientedOrd.instLexOrd\n\n/-- Local instance for `TransOrd (oα.lex oβ)`. -/\n@[deprecated \"instance exists\" (since := \"2025-07-01\")]\ntheorem TransOrd.instOrdLex [oα : Ord α] [oβ : Ord β] [TransOrd α] [TransOrd β] :\n @TransOrd _ (oα.lex oβ) := TransOrd.instLexOrd\n\n/-- Local instance for `OrientedOrd (oα.lex' oβ)`. -/\n@[deprecated Std.OrientedOrd.instOrdLex' (since := \"2025-07-01\")]\ntheorem OrientedOrd.instOrdLex' (ord₁ ord₂ : Ord α) [@OrientedOrd _ ord₁] [@OrientedOrd _ ord₂] :\n @OrientedOrd _ (ord₁.lex' ord₂) :=\n inferInstanceAs (OrientedCmp (compareLex ord₁.compare ord₂.compare))\n\n/-- Local instance for `TransOrd (oα.lex' oβ)`. -/\n@[deprecated Std.TransOrd.instOrdLex' (since := \"2025-07-01\")]\ntheorem TransOrd.instOrdLex' (ord₁ ord₂ : Ord α) [@TransOrd _ ord₁] [@TransOrd _ ord₂] :\n @TransOrd _ (ord₁.lex' ord₂) :=\n inferInstanceAs (TransCmp (compareLex ord₁.compare ord₂.compare))\n\nend «non-canonical instances»\n" }, { "path": "Batteries/Classes/Order.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Basic\npublic import Batteries.Tactic.SeqFocus\n\n@[expose] public section\n\ntheorem lexOrd_def [Ord α] [Ord β] :\n (lexOrd : Ord (α × β)).compare = compareLex (compareOn (·.1)) (compareOn (·.2)) := rfl\n\n/-- Pull back a comparator by a function `f`, by applying the comparator to both arguments. -/\n@[inline] def Ordering.byKey (f : α → β) (cmp : β → β → Ordering) (a b : α) : Ordering :=\n cmp (f a) (f b)\n\nnamespace Batteries\n\n/-- `TotalBLE le` asserts that `le` has a total order, that is, `le a b ∨ le b a`. -/\nclass TotalBLE (le : α → α → Bool) : Prop where\n /-- `le` is total: either `le a b` or `le b a`. -/\n total : le a b ∨ le b a\n\ntheorem compareOfLessAndEq_eq_lt {x y : α} [LT α] [Decidable (x < y)] [DecidableEq α] :\n compareOfLessAndEq x y = .lt ↔ x < y := by\n simp [compareOfLessAndEq]\n split <;> simp\n\nend Batteries\n\n/-! Batteries features not in core Std -/\n\nnamespace Std\nopen Batteries (compareOfLessAndEq_eq_lt)\n\nnamespace OrientedCmp\nvariable {cmp : α → α → Ordering} [OrientedCmp cmp]\n\ntheorem le_iff_ge : cmp x y ≠ .gt ↔ cmp y x ≠ .lt :=\n not_congr OrientedCmp.gt_iff_lt\n\nend OrientedCmp\n\nnamespace TransCmp\nvariable {cmp : α → α → Ordering} [TransCmp cmp]\n\ntheorem le_trans : cmp x y ≠ .gt → cmp y z ≠ .gt → cmp x z ≠ .gt := by\n simp only [ne_eq, ← Ordering.isLE_iff_ne_gt]; exact isLE_trans\n\ntheorem lt_of_lt_of_le : cmp x y = .lt → cmp y z ≠ .gt → cmp x z = .lt := by\n simp only [ne_eq, ← Ordering.isLE_iff_ne_gt]; exact lt_of_lt_of_isLE\n\ntheorem lt_of_le_of_lt : cmp x y ≠ .gt → cmp y z = .lt → cmp x z = .lt := by\n simp only [ne_eq, ← Ordering.isLE_iff_ne_gt]; exact lt_of_isLE_of_lt\n\ntheorem ge_trans : cmp x y ≠ .lt → cmp y z ≠ .lt → cmp x z ≠ .lt := by\n simp only [ne_eq, ← Ordering.isGE_iff_ne_lt]; exact isGE_trans\n\ntheorem gt_of_gt_of_ge : cmp x y = .gt → cmp y z ≠ .lt → cmp x z = .gt := by\n simp only [ne_eq, ← Ordering.isGE_iff_ne_lt]; exact gt_of_gt_of_isGE\n\ntheorem gt_of_ge_of_gt : cmp x y ≠ .lt → cmp y z = .gt → cmp x z = .gt := by\n simp only [ne_eq, ← Ordering.isGE_iff_ne_lt]; exact gt_of_isGE_of_gt\n\nend TransCmp\n\n/-- `LawfulLTCmp cmp` asserts that `cmp x y = .lt` and `x < y` coincide. -/\nclass LawfulLTCmp [LT α] (cmp : α → α → Ordering) : Prop extends OrientedCmp cmp where\n /-- `cmp x y = .lt` holds iff `x < y` is true. -/\n eq_lt_iff_lt : cmp x y = .lt ↔ x < y\n\ntheorem LawfulLTCmp.eq_gt_iff_gt [LT α] [LawfulLTCmp (α := α) cmp] :\n cmp x y = .gt ↔ y < x := by rw [OrientedCmp.gt_iff_lt, eq_lt_iff_lt]\n\n/-- `LawfulLECmp cmp` asserts that `(cmp x y).isLE` and `x ≤ y` coincide. -/\nclass LawfulLECmp [LE α] (cmp : α → α → Ordering) : Prop extends OrientedCmp cmp where\n /-- `cmp x y ≠ .gt` holds iff `x ≤ y` is true. -/\n isLE_iff_le : (cmp x y).isLE ↔ x ≤ y\n\ntheorem LawfulLECmp.isGE_iff_ge [LE α] [LawfulLECmp (α := α) cmp] :\n (cmp x y).isGE ↔ y ≤ x := by rw [← Ordering.isLE_swap, ← OrientedCmp.eq_swap, isLE_iff_le]\n\ntheorem LawfulLECmp.ne_gt_iff_le [LE α] [LawfulLECmp (α := α) cmp] :\n cmp x y ≠ .gt ↔ x ≤ y := by rw [← isLE_iff_le (cmp := cmp), Ordering.isLE_iff_ne_gt]\n\ntheorem LawfulLECmp.ne_lt_iff_ge [LE α] [LawfulLECmp (α := α) cmp] :\n cmp x y ≠ .lt ↔ y ≤ x := by rw [← isGE_iff_ge (cmp := cmp), Ordering.isGE_iff_ne_lt]\n\n/-- `LawfulBCmp cmp` asserts that the `LE`, `LT`, `BEq` are all coherent with each other\nand with `cmp`, describing a strict weak order (a linear order except for antisymmetry). -/\nclass LawfulBCmp [LE α] [LT α] [BEq α] (cmp : α → α → Ordering) : Prop extends\n TransCmp cmp, LawfulBEqCmp cmp, LawfulLTCmp cmp, LawfulLECmp cmp\n\n/-- `LawfulBCmp cmp` asserts that the `LE`, `LT`, `Eq` are all coherent with each other\nand with `cmp`, describing a linear order. -/\nclass LawfulCmp [LE α] [LT α] (cmp : α → α → Ordering) : Prop extends\n TransCmp cmp, LawfulEqCmp cmp, LawfulLTCmp cmp, LawfulLECmp cmp\n\n/-- Class for types where the ordering function is compatible with the `LT`. -/\nabbrev LawfulLTOrd (α) [LT α] [Ord α] := LawfulLTCmp (α := α) compare\n\n/-- Class for types where the ordering function is compatible with the `LE`. -/\nabbrev LawfulLEOrd (α) [LE α] [Ord α] := LawfulLECmp (α := α) compare\n\n/-- Class for types where the ordering function is compatible with the `LE`, `LT` and `BEq`. -/\nabbrev LawfulBOrd (α) [LE α] [LT α] [BEq α] [Ord α] := LawfulBCmp (α := α) compare\n\n/-- Class for types where the ordering function is compatible with the `LE`, `LT` and `Eq`. -/\nabbrev LawfulOrd (α) [LE α] [LT α] [Ord α] := LawfulCmp (α := α) compare\n\ninstance [inst : Std.OrientedCmp cmp] : Std.OrientedCmp (flip cmp) where\n eq_swap := inst.eq_swap\n\ninstance [inst : Std.TransCmp cmp] : Std.TransCmp (flip cmp) where\n isLE_trans h1 h2 := inst.isLE_trans h2 h1\n\ninstance (f : α → β) (cmp : β → β → Ordering) [Std.OrientedCmp cmp] :\n Std.OrientedCmp (Ordering.byKey f cmp) where\n eq_swap {a b} := Std.OrientedCmp.eq_swap (a := f a) (b := f b)\n\ninstance (f : α → β) (cmp : β → β → Ordering) [Std.TransCmp cmp] :\n Std.TransCmp (Ordering.byKey f cmp) where\n isLE_trans h₁ h₂ := Std.TransCmp.isLE_trans (α := β) h₁ h₂\n\ninstance [inst₁ : OrientedCmp cmp₁] [inst₂ : OrientedCmp cmp₂] :\n OrientedCmp (compareLex cmp₁ cmp₂) := inferInstance\n\ninstance [inst₁ : TransCmp cmp₁] [inst₂ : TransCmp cmp₂] :\n TransCmp (compareLex cmp₁ cmp₂) := inferInstance\n\ninstance [Ord β] [OrientedOrd β] (f : α → β) : OrientedCmp (compareOn f) := inferInstance\n\ninstance [Ord β] [TransOrd β] (f : α → β) : TransCmp (compareOn f) := inferInstance\n\ntheorem OrientedOrd.instOn [ord : Ord β] [OrientedOrd β] (f : α → β) : @OrientedOrd _ (ord.on f) :=\n inferInstanceAs (@OrientedCmp _ (compareOn f))\n\ntheorem TransOrd.instOn [ord : Ord β] [TransOrd β] (f : α → β) : @TransOrd _ (ord.on f) :=\n inferInstanceAs (@TransCmp _ (compareOn f))\n\ntheorem OrientedOrd.instOrdLex' (ord₁ ord₂ : Ord α) [@OrientedOrd _ ord₁] [@OrientedOrd _ ord₂] :\n @OrientedOrd _ (ord₁.lex' ord₂) :=\n inferInstanceAs (OrientedCmp (compareLex ord₁.compare ord₂.compare))\n\ntheorem TransOrd.instOrdLex' (ord₁ ord₂ : Ord α) [@TransOrd _ ord₁] [@TransOrd _ ord₂] :\n @TransOrd _ (ord₁.lex' ord₂) :=\n inferInstanceAs (TransCmp (compareLex ord₁.compare ord₂.compare))\n\ntheorem LawfulLTCmp.eq_compareOfLessAndEq\n [LT α] [DecidableEq α] [LawfulEqCmp cmp] [LawfulLTCmp cmp]\n (x y : α) [Decidable (x < y)] : cmp x y = compareOfLessAndEq x y := by\n simp only [compareOfLessAndEq]\n split <;> rename_i h1 <;> [skip; split <;> rename_i h2]\n · exact LawfulLTCmp.eq_lt_iff_lt.2 h1\n · exact LawfulEqCmp.compare_eq_iff_eq.2 h2\n · cases e : cmp x y\n · cases h1 (LawfulLTCmp.eq_lt_iff_lt.1 e)\n · cases h2 (LawfulEqCmp.compare_eq_iff_eq.1 e)\n · rfl\n\ntheorem ReflCmp.compareOfLessAndEq_of_lt_irrefl [LT α] [DecidableLT α] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬ x < x) :\n ReflCmp (α := α) (compareOfLessAndEq · ·) where\n compare_self {x} := by simp [compareOfLessAndEq, if_neg (lt_irrefl x)]\n\ntheorem LawfulBEqCmp.compareOfLessAndEq_of_lt_irrefl\n [LT α] [DecidableLT α] [DecidableEq α] [BEq α] [LawfulBEq α]\n (lt_irrefl : ∀ x : α, ¬x < x) :\n LawfulBEqCmp (α := α) (compareOfLessAndEq · ·) where\n compare_eq_iff_beq {x y} := by\n simp [compareOfLessAndEq]\n split <;> [skip; split] <;> simp [*]\n rintro rfl; exact lt_irrefl _ ‹_›\n\n-- redundant? See `compareOfLessAndEq_of_lt_trans_of_lt_iff` in core\ntheorem TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n [LT α] [DecidableLT α] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (lt_antisymm : ∀ {x y : α}, ¬x < y → ¬y < x → x = y) :\n TransCmp (α := α) (compareOfLessAndEq · ·) :=\n TransOrd.compareOfLessAndEq_of_lt_trans_of_lt_iff lt_trans <| by\n intros\n constructor\n · intro h₁\n constructor\n · intro h₂\n apply lt_irrefl\n exact lt_trans h₁ h₂\n · intro | rfl => exact lt_irrefl _ h₁\n · intro ⟨h₁, h₂⟩\n by_contra h₃\n apply h₂\n exact lt_antisymm h₃ h₁\n\n-- redundant? See `compareOfLessAndEq_of_antisymm_of_trans_of_total_of_not_le` in core\ntheorem TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n [LT α] [LE α] [DecidableLT α] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y → y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n TransCmp (α := α) (compareOfLessAndEq · ·) :=\n .compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n lt_irrefl lt_trans fun xy yx => le_antisymm (not_lt yx) (not_lt xy)\n\n-- make redundant?\ntheorem LawfulLTCmp.compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n [LT α] [DecidableLT α] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (lt_antisymm : ∀ {x y : α}, ¬x < y → ¬y < x → x = y) :\n LawfulLTCmp (α := α) (compareOfLessAndEq · ·) :=\n { TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n lt_irrefl lt_trans lt_antisymm with\n eq_lt_iff_lt := Batteries.compareOfLessAndEq_eq_lt }\n\n-- make redundant?\ntheorem LawfulLTCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n [LT α] [DecidableLT α] [DecidableEq α] [LE α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y → y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LawfulLTCmp (α := α) (compareOfLessAndEq · ·) :=\n { TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n lt_irrefl lt_trans not_lt le_antisymm with\n eq_lt_iff_lt := Batteries.compareOfLessAndEq_eq_lt }\n\n-- make redundant?\ntheorem LawfulLECmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n [LT α] [DecidableLT α] [DecidableEq α] [LE α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y ↔ y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LawfulLECmp (α := α) (compareOfLessAndEq · ·) :=\n have := TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n lt_irrefl lt_trans not_lt.1 le_antisymm\n { this with\n isLE_iff_le := by\n intro x y\n simp only [Ordering.isLE_iff_ne_gt, ← not_lt]\n apply not_congr\n rw [this.gt_iff_lt, Batteries.compareOfLessAndEq_eq_lt] }\n\ntheorem LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n [LT α] [LE α] [DecidableLT α] [DecidableLE α] [DecidableEq α]\n (lt_irrefl : ∀ x : α, ¬x < x)\n (lt_trans : ∀ {x y z : α}, x < y → y < z → x < z)\n (not_lt : ∀ {x y : α}, ¬x < y ↔ y ≤ x)\n (le_antisymm : ∀ {x y : α}, x ≤ y → y ≤ x → x = y) :\n LawfulCmp (α := α) (compareOfLessAndEq · ·) :=\n have instT := TransCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n lt_irrefl lt_trans not_lt.1 le_antisymm\n have instLT := LawfulLTCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n lt_irrefl lt_trans not_lt.1 le_antisymm\n have instLE := LawfulLECmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n lt_irrefl lt_trans not_lt le_antisymm\n have le_refl (x : α) : x ≤ x := by rw [← not_lt]; exact lt_irrefl _\n have not_le {x y : α} : ¬x ≤ y ↔ y < x := by simp [← not_lt]\n { instT, instLT, instLE with\n eq_of_compare {_ _}:= by rw [compareOfLessAndEq_eq_eq le_refl not_le]; exact id\n }\n\ninstance : LawfulOrd Nat :=\n LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n Nat.lt_irrefl Nat.lt_trans Nat.not_lt Nat.le_antisymm\n\ninstance : LawfulOrd Int :=\n LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n Int.lt_irrefl Int.lt_trans Int.not_lt Int.le_antisymm\n\ninstance : LawfulOrd Bool := by\n apply LawfulCmp.mk <;> decide\n\ninstance : LawfulOrd (Fin n) where\n eq_swap := OrientedCmp.eq_swap (α := Nat) (cmp := compare) ..\n eq_lt_iff_lt := LawfulLTCmp.eq_lt_iff_lt (α := Nat) (cmp := compare)\n isLE_iff_le := LawfulLECmp.isLE_iff_le (α := Nat) (cmp := compare)\n isLE_trans := TransCmp.isLE_trans (α := Nat) (cmp := compare)\n\nend Std\n" }, { "path": "Batteries/Classes/RatCast.lean", "content": "/-\nCopyright (c) 2014 Robert Lewis. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro, Gabriel Ebner\n-/\nmodule\n\n@[expose] public section\n\n/-- Type class for the canonical homomorphism `Rat → K`. -/\nclass RatCast (K : Type u) where\n /-- The canonical homomorphism `Rat → K`. -/\n protected ratCast : Rat → K\n\ninstance : RatCast Rat where ratCast n := n\n\n/-- Canonical homomorphism from `Rat` to a division ring `K`.\nThis is just the bare function in order to aid in creating instances of `DivisionRing`. -/\n@[coe, reducible, match_pattern] protected def Rat.cast {K : Type u} [RatCast K] : Rat → K :=\n RatCast.ratCast\n\n-- see note [coercion into rings]\ninstance [RatCast K] : CoeTail Rat K where coe := Rat.cast\n\n-- see note [coercion into rings]\ninstance [RatCast K] : CoeHTCT Rat K where coe := Rat.cast\n" }, { "path": "Batteries/Classes/SatisfiesM.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Kim Morrison\n-/\nmodule\n\npublic import Batteries.Lean.EStateM\npublic import Batteries.Lean.Except\n\n@[expose] public section\n\n/-!\n## SatisfiesM\n\nThe `SatisfiesM` predicate works over an arbitrary (lawful) monad / applicative / functor,\nand enables Hoare-like reasoning over monadic expressions. For example, given a monadic\nfunction `f : α → m β`, to say that the return value of `f` satisfies `Q` whenever\nthe input satisfies `P`, we write `∀ a, P a → SatisfiesM Q (f a)`.\n\nFor any monad equipped with `MonadSatisfying m`\none can lift `SatisfiesM` to a monadic value in `Subtype`,\nusing `satisfying x h : m {a // p a}`, where `x : m α` and `h : SatisfiesM p x`.\nThis includes `Option`, `ReaderT`, `StateT`, and `ExceptT`, and the Lean monad stack.\n(Although it is not entirely clear one should treat the Lean monad stack as lawful,\neven though Lean accepts this.)\n\n## Notes\n\n`SatisfiesM` is not yet a satisfactory solution for verifying the behaviour of large scale monadic\nprograms. Such a solution would allow ergonomic reasoning about large `do` blocks,\nwith convenient mechanisms for introducing invariants and loop conditions as needed.\n\nIt is possible that in the future `SatiesfiesM` will become part of such a solution,\npresumably requiring more syntactic support (and smarter `do` blocks) from Lean.\nOr it may be that such a solution will look different!\nThis is an open research program, and for now one should not be overly ambitious using `SatisfiesM`.\n\nIn particular lemmas about pure operations on data structures in `Batteries` except for `HashMap`\nshould avoid `SatisfiesM` for now, so that it is easy to migrate to other approaches in future.\n-/\n\n/--\n`SatisfiesM p (x : m α)` lifts propositions over a monad. It asserts that `x` may as well\nhave the type `x : m {a // p a}`, because there exists some `m {a // p a}` whose image is `x`.\nSo `p` is the postcondition of the monadic value.\n-/\ndef SatisfiesM {m : Type u → Type v} [Functor m] (p : α → Prop) (x : m α) : Prop :=\n ∃ x' : m {a // p a}, Subtype.val <$> x' = x\n\nnamespace SatisfiesM\n\n/-- If `p` is always true, then every `x` satisfies it. -/\ntheorem of_true [Functor m] [LawfulFunctor m] {x : m α}\n (h : ∀ a, p a) : SatisfiesM p x :=\n ⟨(fun a => ⟨a, h a⟩) <$> x, by simp⟩\n\n/--\nIf `p` is always true, then every `x` satisfies it.\n(This is the strongest postcondition version of `of_true`.)\n-/\nprotected theorem trivial [Functor m] [LawfulFunctor m] {x : m α} :\n SatisfiesM (fun _ => True) x := of_true fun _ => trivial\n\n/-- The `SatisfiesM p x` predicate is monotonic in `p`. -/\ntheorem imp [Functor m] [LawfulFunctor m] {x : m α}\n (h : SatisfiesM p x) (H : ∀ {a}, p a → q a) : SatisfiesM q x :=\n let ⟨x, h⟩ := h; ⟨(fun ⟨_, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩\n\n/-- `SatisfiesM` distributes over `<$>`, general version. -/\nprotected theorem map [Functor m] [LawfulFunctor m] {x : m α}\n (hx : SatisfiesM p x) (hf : ∀ {a}, p a → q (f a)) : SatisfiesM q (f <$> x) := by\n let ⟨x', hx⟩ := hx\n refine ⟨(fun ⟨a, h⟩ => ⟨f a, hf h⟩) <$> x', ?_⟩\n rw [← hx]; simp\n\n/--\n`SatisfiesM` distributes over `<$>`, strongest postcondition version.\n(Use this for reasoning forward from assumptions.)\n-/\ntheorem map_post [Functor m] [LawfulFunctor m] {x : m α}\n (hx : SatisfiesM p x) : SatisfiesM (fun b => ∃ a, p a ∧ b = f a) (f <$> x) :=\n hx.map fun h => ⟨_, h, rfl⟩\n\n/--\n`SatisfiesM` distributes over `<$>`, weakest precondition version.\n(Use this for reasoning backward from the goal.)\n-/\ntheorem map_pre [Functor m] [LawfulFunctor m] {x : m α}\n (hx : SatisfiesM (fun a => p (f a)) x) : SatisfiesM p (f <$> x) :=\n hx.map fun h => h\n\n/-- `SatisfiesM` distributes over `mapConst`, general version. -/\nprotected theorem mapConst [Functor m] [LawfulFunctor m] {x : m α}\n (hx : SatisfiesM q x) (ha : ∀ {b}, q b → p a) : SatisfiesM p (Functor.mapConst a x) :=\n map_const (f := m) ▸ hx.map ha\n\n/-- `SatisfiesM` distributes over `pure`, general version / weakest precondition version. -/\nprotected theorem pure [Applicative m] [LawfulApplicative m]\n (h : p a) : SatisfiesM (m := m) p (pure a) := ⟨pure ⟨_, h⟩, by simp⟩\n\n/-- `SatisfiesM` distributes over `<*>`, general version. -/\nprotected theorem seq [Applicative m] [LawfulApplicative m] {x : m α}\n (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x)\n (H : ∀ {f a}, p₁ f → p₂ a → q (f a)) : SatisfiesM q (f <*> x) := by\n match f, x, hf, hx with | _, _, ⟨f, rfl⟩, ⟨x, rfl⟩ => ?_\n refine ⟨(fun ⟨a, h₁⟩ ⟨b, h₂⟩ => ⟨a b, H h₁ h₂⟩) <$> f <*> x, ?_⟩\n simp only [← pure_seq]; simp [seq_assoc]\n simp only [← pure_seq]; simp [seq_assoc, Function.comp_def]\n\n/-- `SatisfiesM` distributes over `<*>`, strongest postcondition version. -/\nprotected theorem seq_post [Applicative m] [LawfulApplicative m] {x : m α}\n (hf : SatisfiesM p₁ f) (hx : SatisfiesM p₂ x) :\n SatisfiesM (fun c => ∃ f a, p₁ f ∧ p₂ a ∧ c = f a) (f <*> x) :=\n hf.seq hx fun hf ha => ⟨_, _, hf, ha, rfl⟩\n\n/--\n`SatisfiesM` distributes over `<*>`, weakest precondition version 1.\n(Use this when `x` and the goal are known and `f` is a subgoal.)\n-/\nprotected theorem seq_pre [Applicative m] [LawfulApplicative m] {x : m α}\n (hf : SatisfiesM (fun f => ∀ {a}, p₂ a → q (f a)) f) (hx : SatisfiesM p₂ x) :\n SatisfiesM q (f <*> x) :=\n hf.seq hx fun hf ha => hf ha\n\n/--\n`SatisfiesM` distributes over `<*>`, weakest precondition version 2.\n(Use this when `f` and the goal are known and `x` is a subgoal.)\n-/\nprotected theorem seq_pre' [Applicative m] [LawfulApplicative m] {x : m α}\n (hf : SatisfiesM p₁ f) (hx : SatisfiesM (fun a => ∀ {f}, p₁ f → q (f a)) x) :\n SatisfiesM q (f <*> x) :=\n hf.seq hx fun hf ha => ha hf\n\n/-- `SatisfiesM` distributes over `<*`, general version. -/\nprotected theorem seqLeft [Applicative m] [LawfulApplicative m] {x : m α}\n (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y)\n (H : ∀ {a b}, p₁ a → p₂ b → q a) : SatisfiesM q (x <* y) :=\n seqLeft_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy\n\n/-- `SatisfiesM` distributes over `*>`, general version. -/\nprotected theorem seqRight [Applicative m] [LawfulApplicative m] {x : m α}\n (hx : SatisfiesM p₁ x) (hy : SatisfiesM p₂ y)\n (H : ∀ {a b}, p₁ a → p₂ b → q b) : SatisfiesM q (x *> y) :=\n seqRight_eq x y ▸ (hx.map fun h _ => H h).seq_pre hy\n\n/-- `SatisfiesM` distributes over `>>=`, general version. -/\nprotected theorem bind [Monad m] [LawfulMonad m] {f : α → m β}\n (hx : SatisfiesM p x) (hf : ∀ a, p a → SatisfiesM q (f a)) :\n SatisfiesM q (x >>= f) := by\n match x, hx with | _, ⟨x, rfl⟩ => ?_\n have g a ha := Classical.indefiniteDescription _ (hf a ha)\n refine ⟨x >>= fun ⟨a, h⟩ => g a h, ?_⟩\n simp [← bind_pure_comp]; congr; funext ⟨a, h⟩; simp [← (g a h).2, ← bind_pure_comp]\n\n/-- `SatisfiesM` distributes over `>>=`, weakest precondition version. -/\nprotected theorem bind_pre [Monad m] [LawfulMonad m] {f : α → m β}\n (hx : SatisfiesM (fun a => SatisfiesM q (f a)) x) :\n SatisfiesM q (x >>= f) := hx.bind fun _ h => h\n\nend SatisfiesM\n\n@[simp] theorem SatisfiesM_Id_eq : SatisfiesM (m := Id) p x ↔ p x :=\n ⟨fun ⟨y, eq⟩ => eq ▸ y.2, fun h => ⟨⟨_, h⟩, rfl⟩⟩\n\n@[simp] theorem SatisfiesM_Option_eq : SatisfiesM (m := Option) p x ↔ ∀ a, x = some a → p a :=\n ⟨by revert x; intro | some _, ⟨some ⟨_, h⟩, rfl⟩, _, rfl => exact h,\n fun h => match x with | some a => ⟨some ⟨a, h _ rfl⟩, rfl⟩ | none => ⟨none, rfl⟩⟩\n\n@[simp] theorem SatisfiesM_Except_eq : SatisfiesM (m := Except ε) p x ↔ ∀ a, x = .ok a → p a :=\n ⟨by revert x; intro | .ok _, ⟨.ok ⟨_, h⟩, rfl⟩, _, rfl => exact h,\n fun h => match x with | .ok a => ⟨.ok ⟨a, h _ rfl⟩, rfl⟩ | .error e => ⟨.error e, rfl⟩⟩\n\ntheorem SatisfiesM_EStateM_eq :\n SatisfiesM (m := EStateM ε σ) p x ↔ ∀ s a s', x.run s = .ok a s' → p a := by\n constructor\n · rintro ⟨x, rfl⟩ s a s' h\n match w : x.run s with\n | .ok a s' => simp at h; exact h.1\n | .error e s' => simp [w] at h\n · intro w\n refine ⟨?_, ?_⟩\n · intro s\n match q : x.run s with\n | .ok a s' => exact .ok ⟨a, w s a s' q⟩ s'\n | .error e s' => exact .error e s'\n · ext s\n rw [EStateM.run_map, EStateM.run]\n split <;> simp_all\n\ntheorem SatisfiesM_ReaderT_eq [Monad m] :\n SatisfiesM (m := ReaderT ρ m) p x ↔ ∀ s, SatisfiesM p (x.run s) :=\n (exists_congr fun a => by exact ⟨fun eq _ => eq ▸ rfl, funext⟩).trans Classical.skolem.symm\n\ntheorem SatisfiesM_StateRefT_eq [Monad m] :\n SatisfiesM (m := StateRefT' ω σ m) p x ↔ ∀ s, SatisfiesM p (x s) :=\n SatisfiesM_ReaderT_eq\n\ntheorem SatisfiesM_StateT_eq [Monad m] [LawfulMonad m] :\n SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x.run s) := by\n change SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x s)\n refine .trans ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, h⟩ => ?_⟩ Classical.skolem.symm\n · refine ⟨fun s => (fun ⟨⟨a, h⟩, s'⟩ => ⟨⟨a, s'⟩, h⟩) <$> f s, fun s => ?_⟩\n rw [← comp_map, map_eq_pure_bind]; rfl\n · refine ⟨fun s => (fun ⟨⟨a, s'⟩, h⟩ => ⟨⟨a, h⟩, s'⟩) <$> f s, funext fun s => ?_⟩\n show _ >>= _ = _; simp [← h]\n\ntheorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] :\n SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔\n SatisfiesM (m := m) (∀ a, · = .ok a → p a) x.run := by\n change _ ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x\n refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩\n · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f\n show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl\n · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _)\n show _ >>= _ = _; simp [← bind_pure_comp]; congr; funext ⟨a, h⟩; cases a <;> rfl\n\n/--\nIf a monad has `MonadSatisfying m`, then we can lift a `h : SatisfiesM (m := m) p x` predicate\nto monadic value `satisfying x p : m { x // p x }`.\n\nReader, state, and exception monads have `MonadSatisfying` instances if the base monad does.\n-/\nclass MonadSatisfying (m : Type u → Type v) [Functor m] [LawfulFunctor m] where\n /-- Lift a `SatisfiesM` predicate to a monadic value. -/\n satisfying {p : α → Prop} {x : m α} (h : SatisfiesM (m := m) p x) : m {a // p a}\n /-- The value of the lifted monadic value is equal to the original monadic value. -/\n val_eq {p : α → Prop} {x : m α} (h : SatisfiesM (m := m) p x) : Subtype.val <$> satisfying h = x\n\nexport MonadSatisfying (satisfying)\n\nnamespace MonadSatisfying\n\ninstance : MonadSatisfying Id where\n satisfying {α p x} h := ⟨x, by obtain ⟨⟨_, h⟩, rfl⟩ := h; exact h⟩\n val_eq {α p x} h := rfl\n\ninstance : MonadSatisfying Option where\n satisfying {α p x?} h :=\n have h' := SatisfiesM_Option_eq.mp h\n match x? with\n | none => none\n | some x => some ⟨x, h' x rfl⟩\n val_eq {α p x?} h := by cases x? <;> simp\n\ninstance : MonadSatisfying (Except ε) where\n satisfying {α p x?} h :=\n have h' := SatisfiesM_Except_eq.mp h\n match x? with\n | .ok x => .ok ⟨x, h' x rfl⟩\n | .error e => .error e\n val_eq {α p x?} h := by cases x? <;> simp\n\ninstance [Monad m] [LawfulMonad m][MonadSatisfying m] : MonadSatisfying (ReaderT ρ m) where\n satisfying {α p x} h :=\n have h' := SatisfiesM_ReaderT_eq.mp h\n fun r => satisfying (h' r)\n val_eq {α p x} h := by\n have h' := SatisfiesM_ReaderT_eq.mp h\n ext r\n rw [ReaderT.run_map, ← MonadSatisfying.val_eq (h' r)]\n rfl\n\ninstance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (StateRefT' ω σ m) :=\n inferInstanceAs <| MonadSatisfying (ReaderT (ST.Ref ω σ) m)\n\ninstance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (StateT ρ m) where\n satisfying {α p x} h :=\n have h' := SatisfiesM_StateT_eq.mp h\n fun r => (fun ⟨⟨a, r'⟩, h⟩ => ⟨⟨a, h⟩, r'⟩) <$> satisfying (h' r)\n val_eq {α p x} h := by\n have h' := SatisfiesM_StateT_eq.mp h\n ext r\n rw [← MonadSatisfying.val_eq (h' r), StateT.run_map]\n simp [StateT.run]\n\ninstance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (ExceptT ε m) where\n satisfying {α p x} h :=\n let x' := satisfying (SatisfiesM_ExceptT_eq.mp h)\n ExceptT.mk ((fun ⟨y, w⟩ => y.pmap fun a h => ⟨a, w _ h⟩) <$> x')\n val_eq {α p x} h := by\n ext\n refine Eq.trans ?_ (MonadSatisfying.val_eq (SatisfiesM_ExceptT_eq.mp h))\n simp\n\ninstance : MonadSatisfying (EStateM ε σ) where\n satisfying {α p x} h :=\n have h' := SatisfiesM_EStateM_eq.mp h\n fun s => match w : x.run s with\n | .ok a s' => .ok ⟨a, h' s a s' w⟩ s'\n | .error e s' => .error e s'\n val_eq {α p x} h := by\n ext s\n rw [EStateM.run_map, EStateM.run]\n split <;> simp_all\n\nend MonadSatisfying\n" }, { "path": "Batteries/CodeAction/Attr.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Lean.Server.CodeActions.Basic\npublic import Lean.Compiler.IR.CompilerM\n\n@[expose] public section\n\n/-!\n# Initial setup for code action attributes\n\n* `@[hole_code_action]` and `@[command_code_action]` now live in the Lean repository,\n and are builtin.\n\n* Attribute `@[tactic_code_action]` collects code actions which will be called\n on each occurrence of a tactic.\n-/\nnamespace Batteries.CodeAction\n\nopen Lean Elab Server Lsp RequestM Snapshots\n\n/-- A tactic code action extension. -/\nabbrev TacticCodeAction :=\n CodeActionParams → Snapshot →\n (ctx : ContextInfo) → (stack : Syntax.Stack) → (node : InfoTree) →\n RequestM (Array LazyCodeAction)\n\n/-- A tactic code action extension. -/\nabbrev TacticSeqCodeAction :=\n CodeActionParams → Snapshot →\n (ctx : ContextInfo) → (i : Nat) → (stack : Syntax.Stack) → (goals : List MVarId) →\n RequestM (Array LazyCodeAction)\n\n/-- Read a tactic code action from a declaration of the right type. -/\ndef mkTacticCodeAction (n : Name) : ImportM TacticCodeAction := do\n let { env, opts, .. } ← read\n IO.ofExcept <| unsafe env.evalConstCheck TacticCodeAction opts ``TacticCodeAction n\n\n/-- Read a tacticSeq code action from a declaration of the right type. -/\ndef mkTacticSeqCodeAction (n : Name) : ImportM TacticSeqCodeAction := do\n let { env, opts, .. } ← read\n IO.ofExcept <| unsafe env.evalConstCheck TacticSeqCodeAction opts ``TacticSeqCodeAction n\n\n/-- An entry in the tactic code actions extension, containing the attribute arguments. -/\nstructure TacticCodeActionEntry where\n /-- The declaration to tag -/\n declName : Name\n /-- The tactic kinds that this extension supports. If empty it is called on all tactic kinds. -/\n tacticKinds : Array Name\n deriving Inhabited\n\n/-- The state of the tactic code actions extension. -/\nstructure TacticCodeActions where\n /-- The list of tactic code actions to apply on any tactic. -/\n onAnyTactic : Array TacticCodeAction := {}\n /-- The list of tactic code actions to apply when a particular tactic kind is highlighted. -/\n onTactic : NameMap (Array TacticCodeAction) := {}\n deriving Inhabited\n\n/-- Insert a tactic code action entry into the `TacticCodeActions` structure. -/\ndef TacticCodeActions.insert (self : TacticCodeActions)\n (tacticKinds : Array Name) (action : TacticCodeAction) : TacticCodeActions :=\n if tacticKinds.isEmpty then\n { self with onAnyTactic := self.onAnyTactic.push action }\n else\n { self with onTactic := tacticKinds.foldl (init := self.onTactic) fun m a =>\n m.insert a ((m.getD a #[]).push action) }\n\n/-- An extension which collects all the tactic code actions. -/\ninitialize tacticSeqCodeActionExt :\n PersistentEnvExtension Name (Name × TacticSeqCodeAction)\n (Array Name × Array TacticSeqCodeAction) ←\n registerPersistentEnvExtension {\n mkInitial := pure (#[], #[])\n addImportedFn := fun as => return (#[], ← as.foldlM (init := #[]) fun m as =>\n as.foldlM (init := m) fun m a => return m.push (← mkTacticSeqCodeAction a))\n addEntryFn := fun (s₁, s₂) (n₁, n₂) => (s₁.push n₁, s₂.push n₂)\n exportEntriesFn := (·.1)\n }\n\n/-- An extension which collects all the tactic code actions. -/\ninitialize tacticCodeActionExt :\n PersistentEnvExtension TacticCodeActionEntry (TacticCodeActionEntry × TacticCodeAction)\n (Array TacticCodeActionEntry × TacticCodeActions) ←\n registerPersistentEnvExtension {\n mkInitial := pure (#[], {})\n addImportedFn := fun as => return (#[], ← as.foldlM (init := {}) fun m as =>\n as.foldlM (init := m) fun m ⟨name, kinds⟩ =>\n return m.insert kinds (← mkTacticCodeAction name))\n addEntryFn := fun (s₁, s₂) (e, n₂) => (s₁.push e, s₂.insert e.tacticKinds n₂)\n exportEntriesFn := (·.1)\n }\n\n/--\nThis attribute marks a code action, which is used to suggest new tactics or replace existing ones.\n\n* `@[tactic_code_action]`: This is a code action which applies to the spaces between tactics,\n to suggest a new tactic to change the goal state.\n\n* `@[tactic_code_action kind]`: This is a code action which applies to applications of the tactic\n `kind` (a tactic syntax kind), which can replace the tactic or insert things before or after it.\n\n* `@[tactic_code_action kind₁ kind₂]`: shorthand for\n `@[tactic_code_action kind₁, tactic_code_action kind₂]`.\n\n* `@[tactic_code_action *]`: This is a tactic code action that applies to all tactics.\n Use sparingly.\n-/\nsyntax (name := tactic_code_action) \"tactic_code_action\" (\"*\" <|> (ppSpace ident)*) : attr\n\ninitialize\n registerBuiltinAttribute {\n name := `tactic_code_action\n descr := \"Declare a new tactic code action, to appear in the code actions on tactics\"\n applicationTime := .afterCompilation\n add := fun decl stx kind => do\n unless kind == AttributeKind.global do\n throwError \"invalid attribute 'tactic_code_action', must be global\"\n match stx with\n | `(attr| tactic_code_action *) =>\n if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions\n modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, #[]⟩, ← mkTacticCodeAction decl))\n | `(attr| tactic_code_action $[$args]*) =>\n if args.isEmpty then\n if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions\n modifyEnv (tacticSeqCodeActionExt.addEntry · (decl, ← mkTacticSeqCodeAction decl))\n else\n let args ← args.mapM realizeGlobalConstNoOverloadWithInfo\n if (IR.getSorryDep (← getEnv) decl).isSome then return -- ignore in progress definitions\n modifyEnv (tacticCodeActionExt.addEntry · (⟨decl, args⟩, ← mkTacticCodeAction decl))\n | _ => pure ()\n }\n" }, { "path": "Batteries/CodeAction/Basic.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.BuiltinTerm\npublic meta import Lean.Elab.BuiltinNotation\npublic meta import Lean.Server.InfoUtils\npublic meta import Lean.Server.CodeActions.Provider\npublic meta import Batteries.CodeAction.Attr\n\npublic meta section\n\n/-!\n# Initial setup for code actions\n\nThis declares a code action provider that calls all `@[hole_code_action]` definitions\non each occurrence of a hole (`_`, `?_` or `sorry`).\n\n(This is in a separate file from `Batteries.CodeAction.Hole.Attr` so that the server does not\nattempt to use this code action provider when browsing the `Batteries.CodeAction.Hole.Attr` file\nitself.)\n-/\nnamespace Batteries.CodeAction\n\nopen Lean Elab Server RequestM CodeAction\n\n/-- A code action which calls `@[tactic_code_action]` code actions. -/\n@[code_action_provider] def tacticCodeActionProvider : CodeActionProvider := fun params snap => do\n let doc ← readDoc\n let startPos := doc.meta.text.lspPosToUtf8Pos params.range.start\n let endPos := doc.meta.text.lspPosToUtf8Pos params.range.end\n let pointerCol :=\n if params.range.start.line == params.range.end.line then\n max params.range.start.character params.range.end.character\n else 0\n let some result := findTactic?\n (fun pos => (doc.meta.text.utf8PosToLspPos pos).character ≤ pointerCol)\n ⟨startPos, endPos⟩ snap.stx | return #[]\n let tgtTac := match result with\n | .tactic (tac :: _)\n | .tacticSeq _ _ (_ :: tac :: _) => tac.1\n | _ => unreachable!\n let tgtRange := tgtTac.getRange?.get!\n have info := findInfoTree? tgtTac.getKind tgtRange none snap.infoTree (canonicalOnly := true)\n fun _ info => info matches .ofTacticInfo _\n let some (ctx, node@(.node (.ofTacticInfo info) _)) := info | return #[]\n let mut out := #[]\n match result with\n | .tactic stk@((tac, _) :: _) => do\n let ctx := { ctx with mctx := info.mctxBefore }\n let actions := (tacticCodeActionExt.getState snap.env).2\n if let some arr := actions.onTactic.find? tac.getKind then\n for act in arr do\n try out := out ++ (← act params snap ctx stk node) catch _ => pure ()\n for act in actions.onAnyTactic do\n try out := out ++ (← act params snap ctx stk node) catch _ => pure ()\n | .tacticSeq _ i stk@((seq, _) :: _) =>\n let (ctx, goals) ← if 2*i < seq.getNumArgs then\n let stx := seq[2*i]\n let some stxRange := stx.getRange? | return #[]\n let some (ctx, .node (.ofTacticInfo info') _) :=\n findInfoTree? stx.getKind stxRange ctx node fun _ info => (info matches .ofTacticInfo _)\n | return #[]\n pure ({ ctx with mctx := info'.mctxBefore }, info'.goalsBefore)\n else\n pure ({ ctx with mctx := info.mctxAfter }, info.goalsAfter)\n for act in (tacticSeqCodeActionExt.getState snap.env).2 do\n try out := out ++ (← act params snap ctx i stk goals) catch _ => pure ()\n | _ => unreachable!\n pure out\n" }, { "path": "Batteries/CodeAction/Deprecated.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Server.CodeActions.Provider\n\npublic meta section\n\n/-!\n# Code action for @[deprecated] replacements\n\nThis is an opt-in mechanism for making machine-applicable `@[deprecated]` definitions. When enabled\n(by setting the `machineApplicableDeprecated` tag attribute), a code action will be triggered\nwhenever the deprecation lint also fires, allowing the user to replace the usage of the deprecated\nconstant.\n-/\n\nnamespace Batteries\n\nopen Lean Elab Server Lsp RequestM CodeAction\n\n/-- An environment extension for identifying `@[deprecated]` definitions which can be auto-fixed -/\ninitialize machineApplicableDeprecated : TagDeclarationExtension ← mkTagDeclarationExtension\n\nnamespace CodeAction\n\n/-- A code action which applies replacements for `@[deprecated]` definitions. -/\n@[code_action_provider]\ndef deprecatedCodeActionProvider : CodeActionProvider := fun params snap => do\n let mut i := 0\n let doc ← readDoc\n let mut msgs := #[]\n for m in snap.msgLog.toList do\n if m.data.isDeprecationWarning then\n if h : _ then\n msgs := msgs.push (snap.cmdState.messages.toList[i]'h)\n i := i + 1\n if msgs.isEmpty then return #[]\n let start := doc.meta.text.lspPosToUtf8Pos params.range.start\n let stop := doc.meta.text.lspPosToUtf8Pos params.range.end\n for msg in msgs do\n let some endPos := msg.endPos | continue\n let pos := doc.meta.text.ofPosition msg.pos\n let endPos' := doc.meta.text.ofPosition endPos\n unless start ≤ endPos' && pos ≤ stop do continue\n let some (ctx, .node (.ofTermInfo info@{ expr := .const c .., ..}) _) :=\n findInfoTree? identKind ⟨pos, endPos'⟩ none snap.infoTree fun _ i =>\n (i matches .ofTermInfo { elaborator := .anonymous, expr := .const .., ..})\n | continue\n unless machineApplicableDeprecated.isTagged snap.cmdState.env c do continue\n let some c' := Linter.getDeprecatedNewName snap.cmdState.env c | continue\n let eager : CodeAction := {\n title := s!\"Replace {c} with {c'}\"\n kind? := \"quickfix\"\n isPreferred? := true\n }\n return #[{\n eager\n lazy? := some do\n let c' ← info.runMetaM ctx (unresolveNameGlobal c')\n let pos := doc.meta.text.leanPosToLspPos msg.pos\n let endPos' := doc.meta.text.leanPosToLspPos endPos\n pure { eager with\n edit? := some <| .ofTextEdit doc.versionedIdentifier {\n range := ⟨pos, endPos'⟩\n newText := toString c'\n }\n }\n }]\n return #[]\n" }, { "path": "Batteries/CodeAction/Match.lean", "content": "/-\nCopyright (c) 2026 Moritz Roos. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Moritz Roos\n-/\nmodule\n\npublic meta import Batteries.CodeAction.Misc\npublic meta import Batteries.Data.List.Basic\n\n@[expose] public meta section\n\nnamespace Batteries.CodeAction\n\nopen Lean Meta Elab Server RequestM CodeAction\n\n\n/-- Filter for the info-nodes to find the match-nodes. -/\ndef isMatchTerm : Info → Bool\n | .ofTermInfo i => i.stx.isOfKind ``Lean.Parser.Term.match\n | _ => false\n\n/-- Returns the String.range that encompasses `match e (with)`. -/\ndef getMatchHeaderRange? (matchStx : Syntax) : Option Lean.Syntax.Range := do\n match matchStx with\n | `(term| match\n $[(generalizing := $generalizingVal)]?\n $[(motive := $motiveVal)]?\n $[$discrs:matchDiscr],*\n with $_) => --Here the $alts would go, if they were already typed. Else $_ will match \"missing\"\n\n -- Isolate the syntax of only the \"match\" atom to get the starting position:\n let mStx ← matchStx.getArgs.find? (fun s => s.isAtom && s.getAtomVal == \"match\")\n let startPos ← mStx.getPos? -- begin of 'match' keyword\n\n -- Depending on the existence of 'with', return the correct range:\n if let some withStx := (matchStx.getArgs.find? (fun s => s.isAtom && s.getAtomVal == \"with\"))\n then return ⟨startPos, ←withStx.getTailPos?⟩\n else\n let lastMatchDiscr ← discrs.back?\n return ⟨startPos, ←lastMatchDiscr.raw.getTailPos?⟩\n | _ => none\n\n/-- Flattens an Infotree into an array of Info-nodes that fulfill p. -/\npartial def findAllInfos (p : Info → Bool) (t : InfoTree) : Array Info :=\n loop t #[]\nwhere\n /-- Inner loop for `findAllInfos`. -/\n loop (t : InfoTree) (acc : Array Info) : Array Info :=\n match t with\n | .context _ childTree => loop childTree acc\n | .node info children =>\n let acc' := if p info then acc.push info else acc\n children.foldl (fun currentAcc child => loop child currentAcc) acc'\n | .hole _ => acc\n\n/-- Computes for a constructor, if it makes sense to use `@constr` in a match, by determining\n if it has any non-parameter implicit arguments. -/\ndef hasImplicitNonparArg (ctor : Name) (env : Environment) : Bool := Id.run do\n let some (.ctorInfo ctorInfo) := env.find? ctor | panic! \"bad inductive\"\n let explicitArgs := getExplicitArgs ctorInfo.type #[]\n let allArgs := getAllArgs ctorInfo.type #[]\n let some (.inductInfo indInfo) := env.find? ctorInfo.induct | panic! \"not an inductive\"\n let numParams := indInfo.numParams\n return (allArgs.size - (explicitArgs.size + numParams) > 0)\n\n/-- From a constructor-name e.g. `Option.some` construct the corresponding match pattern, e.g.\n `.some val`. We implement special cases for `Nat` and `List`, `Option` and `Bool` to e.g.\n produce `n + 1` instead of `Nat.succ n`. -/\ndef patternFromConstructor (ctor : Name) (env : Environment) (suffix : String)\n (explicitArgsOnly : Bool) (ctor_hasImplicitNonparArg : Bool): Option String := do\n let some (.ctorInfo ctorInfo) := env.find? ctor | panic! \"bad inductive\"\n let some (.inductInfo indInfo) := env.find? ctorInfo.induct | panic! \"not an inductive\"\n let numParams := indInfo.numParams\n let ctor_short := toString (ctor.updatePrefix .anonymous)\n let explicitCtorArgs := getExplicitArgs ctorInfo.type #[]\n let allCtorArgs := getAllArgs ctorInfo.type #[]\n\n /- Special cases with nicer Notation. None of these constructors has any implicit arguments\n that aren't parameters, i.e. that aren't already determined by the match discriminant.\n So it doesn't make sense to use them with `@`. That's why we *always* nicely print them\n regardless of the setting `explicitArgsOnly`. -/\n match ctor with\n | (.str (.str .anonymous \"Nat\") \"zero\") => \"0\"\n /- At the moment this evaluates to \"n + 1\": -/\n | (.str (.str .anonymous \"Nat\") \"succ\") => s!\"{explicitCtorArgs[0]!}{suffix} + 1\" --\n | (.str (.str .anonymous \"List\") \"nil\") => \"[]\"\n /- At the moment this evaluates to \"head :: tail\": -/\n | (.str (.str .anonymous \"List\") \"cons\") =>\n s!\"{explicitCtorArgs[0]!}{suffix} :: {explicitCtorArgs[1]!}{suffix}\"\n | (.str (.str .anonymous \"Option\") \"some\") => s!\"some {explicitCtorArgs[0]!}{suffix}\"\n | (.str (.str .anonymous \"Option\") \"none\") => \"none\"\n | (.str (.str .anonymous \"Bool\") \"true\") => \"true\"\n | (.str (.str .anonymous \"Bool\") \"false\") => \"false\"\n | _ =>\n /- This is the Default case. It fills the constructor arguments with the variable names `arg`\n which were used in the inductive type specification. When using this action with multiple\n (same-type) arguments these might clash, so we fix it by appending a suffix like `_2` -\n you will probably want to rename these suffixed names yourself.\n If the the user wants the match to contain the implicit arguments as well, we\n additionally put `_` for every `parameter` (a parameter is an argument to the inductive\n type that is fixed over constructors), since these should already be determined by the\n match discriminant. One could elaborate the type of this discriminant and fill the parameters\n from there, but we don't see any value in this. -/\n if explicitArgsOnly || Bool.not ctor_hasImplicitNonparArg then\n let mut str := s!\".{ctor_short}\"\n for arg in explicitCtorArgs do\n str := str ++ if arg.hasNum || arg.isInternal then \" _\" else s!\" {arg}{suffix}\"\n return str\n else\n let mut str := s!\".{ctor_short}\"\n /- This loop skips the first `numParams` many arguments, since these are the parameters\n and are already determined by the match discriminant and thus unlikely to be\n useful for the match. -/\n for i in [numParams:allCtorArgs.size] do\n let arg := allCtorArgs[i]!\n str := str ++\n if arg.hasNum || arg.isInternal then\n \" _\"\n else\n if arg ∈ explicitCtorArgs then\n s!\" {arg}{suffix}\"\n else\n s!\" ({arg} := {arg}{suffix})\"\n return str\n\n\n/--\nInvoking tactic code action `Generate a list of alternatives for this match.` in the\nfollowing:\n```lean\ndef myfun2 (n : Nat) : Nat :=\n match n\n```\nproduces:\n```lean\ndef myfun2 (n : Nat) : Nat :=\n match n with\n | 0 => _\n | n + 1 => _\n```\nAlso has support for multiple discriminants, e.g.\n```\ndef myfun3 (o : Option Bool) (m : Nat) : Nat :=\n match o, m with\n```\ncan be expanded into\n```\ndef myfun3 (o : Option Bool) (m : Nat) : Nat :=\n match o, m with\n | none, 0 => _\n | none, n_2 + 1 => _\n | some val_1, 0 => _\n | some val_1, n_2 + 1 => _\n```\nIf it makes sense to use at least one of the constructors with `@` (i.e. iff it has an\nimplicit non-parameter argument) then we also show a codeaction that expands every such constructor\nwith implicit arguments filled in with the syntax `implicitArg := implicitArg`.\nE.g. invoking `Generate a list of equations with implicit arguments for this match.` in\nthe following\n```lean\ninductive TermWithImplicit (F : Nat → Type u) (α : Type w)\n | var (x : α) : TermWithImplicit F α\n | func {l : Nat} (f : F l) (ts : Fin l → TermWithImplicit F α) : TermWithImplicit F α\n\ndef myfun4 (t : TermWithImplicit F α) : Nat := by\n match t with\n```\nproduces\n```lean\ndef myfun4 (t : TermWithImplicit F α) : Nat := by\n match t with\n | .var x => _\n | .func (l := l) f ts => _\n```\nwhere the implicit argument `{l : Nat}` is now usable.\nNote that the arguments `F` and `α` are not filled since they are `parameters`\n(a parameter is an argument to an inductive type that is fixed over constructors), i.e.\nthey are already determined by the match discriminant `t`. This means they don't provide any\nnew information for you.\n-/\n@[command_code_action]\ndef matchExpand : CommandCodeAction := fun CodeActionParams snap ctx node => do\n /- Since `match` is a term (not a command) `@[command_code_action Parser.Term.match]` will\n not fire. So we filter `command_code_action` ourselves in Step 1 for now. -/\n\n /- 1. Find ALL ofTermInfo Info nodes that are of kind `Term.match` -/\n let allMatchInfos := findAllInfos isMatchTerm node\n\n /- 2. Filter these candidates within the `RequestM` monad based on the cursor being in the\n header lines of these matches. -/\n let doc ← readDoc\n let relevantMatchInfos ← allMatchInfos.filterM fun matchInfo => do\n let some headerRangeRaw := getMatchHeaderRange? matchInfo.stx | return false\n let headerRangeLsp := doc.meta.text.utf8RangeToLspRange headerRangeRaw\n\n let cursorRangeLsp := CodeActionParams.range\n -- check if the cursor range is contained in the header range\n return (cursorRangeLsp.start ≥ headerRangeLsp.start && cursorRangeLsp.end ≤ headerRangeLsp.end)\n\n /- 3. Pick the first (and mostly only) candidate. There might sometimes be more,\n since some things are just contained multiple times in 'node'. -/\n let some matchInfo := relevantMatchInfos[0]? | return #[]\n let some headerRangeRaw := getMatchHeaderRange? matchInfo.stx | return #[]\n\n /- Isolate the array of match-discriminants -/\n let discrs ← match matchInfo.stx with\n | `(term| match\n $[(generalizing := $generalizingVal)]?\n $[(motive := $motiveVal)]?\n $[$discrs:matchDiscr],*\n with $_) => pure discrs\n | _ => return #[]\n\n /- Reduce discrs to the array of match-discriminants-terms (i.e. \"[n1, n2]\" in \"match n2,n2\"). -/\n let some discrTerms := discrs.mapM (fun discr =>\n match discr with\n | `(matchDiscr| $t: term) => some t\n | `(matchDiscr| $_:ident : $t: term) => some t\n | _ => none\n ) | return #[]\n\n -- Get a Bool, that tells us if \"with\" is already typed in:\n let withPresent :=\n (matchInfo.stx.getArgs.find? (fun s => s.isAtom && s.getAtomVal == \"with\")).isSome\n\n /- Construct a list containing for each discriminant its list of constructor names paired with\n a Bool that determines if it makes sense to use the constructor with `@`.\n The list contains the first discriminant constructors last,\n since we are prepending in the loop. -/\n let mut constructors_rev : List (List (Name × Bool)) := []\n for discrTerm in discrTerms do\n let some (info, updatedCtx) := findTermInfoWithCtx? node discrTerm ctx | return #[]\n let ty ← info.runMetaM updatedCtx (Lean.Meta.inferType info.expr)\n let .const name _ := (← info.runMetaM updatedCtx (whnf ty)).getAppFn | return #[]\n -- Find the inductive constructors of e:\n let some (.inductInfo indInfo) := snap.env.find? name | return #[]\n let ctors := indInfo.ctors\n constructors_rev :=\n (ctors.map (fun ctor => (ctor, hasImplicitNonparArg ctor snap.env)))\n :: constructors_rev\n\n let mkAction (title : String) (explicitArgsOnly : Bool) : LazyCodeAction :=\n let eager : Lsp.CodeAction := {\n title := title\n kind? := \"quickfix\"\n }\n { --rest is lightly adapted from eqnStub:\n eager\n lazy? := some do\n let holePos := headerRangeRaw.stop --where we start inserting\n let (indent, _) := findIndentAndIsStart doc.meta.text.source headerRangeRaw.start\n let mut str := if withPresent then \"\" else \" with\"\n\n let indent := \"\\n\".pushn ' ' (indent) --use the same indent as the 'match' line.\n let constructor_combinations := constructors_rev.sections.map List.reverse\n for l in constructor_combinations do\n str := str ++ indent ++ \"| \"\n for ctor_idx in [:l.length] do\n let (ctor, existsExplicitNonparArg) := l[ctor_idx]!\n let suffix := if constructors_rev.length ≥ 2 then s!\"_{ctor_idx + 1}\" else \"\"\n let some pat :=\n patternFromConstructor ctor snap.env suffix explicitArgsOnly existsExplicitNonparArg |\n panic! \"bad inductive\"\n str := str ++ pat\n if ctor_idx < l.length - 1 then\n str := str ++ \", \"\n str := str ++ s!\" => _\"\n pure { eager with\n edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange ⟨holePos, holePos⟩-- adapted to insert-only\n newText := str\n }\n }\n }\n /- Show the code action with implicit arguments if at least one constructor has an implicit\n non-parameter argument. -/\n let showExplicitCodeAction := constructors_rev.any (fun l =>\n l.any (fun (_, ctor_hasImplicitNonparArg) => ctor_hasImplicitNonparArg))\n\n if (showExplicitCodeAction) then\n return #[mkAction \"Generate a list of equations for this match.\" True,\n mkAction \"Generate a list of equations with implicit arguments for this match.\" False]\n else\n return #[mkAction \"Generate a list of equations for this match.\" True]\n" }, { "path": "Batteries/CodeAction/Misc.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.Induction\npublic meta import Batteries.Lean.Position\npublic meta import Batteries.CodeAction.Attr\npublic meta import Lean.Server.CodeActions.Provider\n\npublic meta section\n\n/-!\n# Miscellaneous code actions\n\nThis declares some basic tactic code actions, using the `@[tactic_code_action]` API.\n-/\nnamespace Batteries.CodeAction\n\nopen Lean Meta Elab Server RequestM CodeAction\n\n/-- Return the syntax stack leading to `target` from `root`, if one exists. -/\ndef findStack? (root target : Syntax) : Option Syntax.Stack := do\n let range ← target.getRange?\n root.findStack? (·.getRange?.any (·.includes range))\n (fun s => s.getKind == target.getKind && s.getRange? == range)\n\n/-- Constructs a hole with a kind matching the provided hole elaborator. -/\ndef holeKindToHoleString : (elaborator : Name) → (synthName : String) → String\n | ``Elab.Term.elabSyntheticHole, name => \"?\" ++ name\n | ``Elab.Term.elabSorry, _ => \"sorry\"\n | _, _ => \"_\"\n\n/--\nHole code action used to fill in a structure's field when specifying an instance.\n\nIn the following:\n```lean\ninstance : Monad Id := _\n```\n\ninvoking the hole code action \"Generate a (minimal) skeleton for the structure under construction.\"\nproduces:\n```lean\ninstance : Monad Id where\n pure := _\n bind := _\n```\n\nand invoking \"Generate a (maximal) skeleton for the structure under construction.\" produces:\n```lean\ninstance : Monad Id where\n map := _\n mapConst := _\n pure := _\n seq := _\n seqLeft := _\n seqRight := _\n bind := _\n```\n-/\n@[hole_code_action] partial def instanceStub : HoleCodeAction := fun _ snap ctx info => do\n let some ty := info.expectedType? | return #[]\n let .const name _ := (← info.runMetaM ctx (whnf ty)).getAppFn | return #[]\n unless isStructure snap.env name do return #[]\n let doc ← readDoc\n let fields := collectFields snap.env name #[] []\n let only := !fields.any fun (_, auto) => auto\n let mkAutofix minimal :=\n let eager := {\n title := s!\"\\\n Generate a {if only then \"\" else if minimal then \"(minimal) \" else \"(maximal) \"}\\\n skeleton for the structure under construction.\"\n kind? := \"quickfix\"\n isPreferred? := minimal\n }\n let lazy? := some do\n let useWhere := do\n let _ :: (stx, _) :: _ ← findStack? snap.stx info.stx | none\n guard (stx.getKind == ``Parser.Command.declValSimple)\n stx[0].getPos?\n let holePos := useWhere.getD info.stx.getPos?.get!\n let (indent, isStart) := findIndentAndIsStart doc.meta.text.source holePos\n let indent := \"\\n\".pushn ' ' indent\n let mut str := if useWhere.isSome then \"where\" else \"{\"\n let mut first := useWhere.isNone && isStart\n for (field, auto) in fields do\n if minimal && auto then continue\n if first then\n str := str ++ \" \"\n first := false\n else\n str := str ++ indent ++ \" \"\n let field := toString field\n str := str ++ s!\"{field} := {holeKindToHoleString info.elaborator field}\"\n if useWhere.isNone then\n if isStart then\n str := str ++ \" }\"\n else\n str := str ++ indent ++ \"}\"\n pure { eager with\n edit? := some <| .ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange ⟨holePos, info.stx.getTailPos?.get!⟩\n newText := str\n }\n }\n { eager, lazy? }\n pure <| if only then #[mkAutofix true] else #[mkAutofix true, mkAutofix false]\nwhere\n /-- Returns true if this field is an autoParam or optParam, or if it is given an optional value\n in a child struct. -/\n isAutofillable (env : Environment) (fieldInfo : StructureFieldInfo) (stack : List Name) : Bool :=\n fieldInfo.autoParam?.isSome || env.contains (mkDefaultFnOfProjFn fieldInfo.projFn)\n || stack.any fun struct => env.contains (mkDefaultFnOfProjFn (struct ++ fieldInfo.fieldName))\n\n /-- Returns the fields of a structure, unfolding parent structures. -/\n collectFields (env : Environment) (structName : Name)\n (fields : Array (Name × Bool)) (stack : List Name) : Array (Name × Bool) :=\n (getStructureFields env structName).foldl (init := fields) fun fields field =>\n if let some fieldInfo := getFieldInfo? env structName field then\n if let some substructName := fieldInfo.subobject? then\n collectFields env substructName fields (structName :: stack)\n else\n fields.push (field, isAutofillable env fieldInfo stack)\n else fields\n\n/-- Returns the explicit arguments given a type. The second argument of this\n function is an accumulator. -/\ndef getExplicitArgs : Expr → Array Name → Array Name\n | .forallE n _ body bi, args =>\n getExplicitArgs body <| if bi.isExplicit then args.push n else args\n | _, args => args\n\n/-- Returns all of the arguments given a type. The second argument of this\n function is an accumulator. -/\ndef getAllArgs : Expr → Array Name → Array Name\n | .forallE n _ body _, args =>\n getAllArgs body <| args.push n\n | _, args => args\n\n/--\nInvoking hole code action \"Generate a list of equations for a recursive definition\" in the\nfollowing:\n```lean\ndef foo : Expr → Unit := _\n```\n\nproduces:\n\n```lean\ndef foo : Expr → Unit := fun\n | .bvar deBruijnIndex => _\n | .fvar fvarId => _\n | .mvar mvarId => _\n | .sort u => _\n | .const declName us => _\n | .app fn arg => _\n | .lam binderName binderType body binderInfo => _\n | .forallE binderName binderType body binderInfo => _\n | .letE declName type value body nonDep => _\n | .lit _ => _\n | .mdata data expr => _\n | .proj typeName idx struct => _\n```\n\n-/\n@[hole_code_action] def eqnStub : HoleCodeAction := fun _ snap ctx info => do\n let some ty := info.expectedType? | return #[]\n let .forallE _ dom .. ← info.runMetaM ctx (whnf ty) | return #[]\n let .const name _ := (← info.runMetaM ctx (whnf dom)).getAppFn | return #[]\n let some (.inductInfo val) := snap.env.find? name | return #[]\n let eager := {\n title := \"Generate a list of equations for a recursive definition.\"\n kind? := \"quickfix\"\n }\n let doc ← readDoc\n pure #[{\n eager\n lazy? := some do\n let holePos := info.stx.getPos?.get!\n let (indent, isStart) := findIndentAndIsStart doc.meta.text.source holePos\n let mut str := \"fun\"\n let indent := \"\\n\".pushn ' ' (if isStart then indent else indent + 2)\n for ctor in val.ctors do\n let some (.ctorInfo ci) := snap.env.find? ctor | panic! \"bad inductive\"\n let ctor := toString (ctor.updatePrefix .anonymous)\n str := str ++ indent ++ s!\"| .{ctor}\"\n for arg in getExplicitArgs ci.type #[] do\n str := str ++ if arg.hasNum || arg.isInternal then \" _\" else s!\" {arg}\"\n str := str ++ s!\" => {holeKindToHoleString info.elaborator ctor}\"\n pure { eager with\n edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange ⟨holePos, info.stx.getTailPos?.get!⟩\n newText := str\n }\n }\n }]\n\n/-- Invoking hole code action \"Start a tactic proof\" will fill in a hole with `by done`. -/\n@[hole_code_action] def startTacticStub : HoleCodeAction := fun _ _ _ info => do\n let holePos := info.stx.getPos?.get!\n let doc ← readDoc\n let indent := (findIndentAndIsStart doc.meta.text.source holePos).1\n pure #[{\n eager.title := \"Start a tactic proof.\"\n eager.kind? := \"quickfix\"\n eager.edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange ⟨holePos, info.stx.getTailPos?.get!⟩\n newText := \"by\\n\".pushn ' ' (indent + 2) ++ \"done\"\n }\n }]\n\n/-- The \"Remove tactics after 'no goals'\" code action deletes any tactics following a completed\nproof.\n```\nexample : True := by\n trivial\n trivial -- <- remove this, proof is already done\n rfl\n```\nis transformed to\n```\nexample : True := by\n trivial\n```\n-/\n@[tactic_code_action*]\ndef removeAfterDoneAction : TacticCodeAction := fun _ _ _ stk node => do\n let .node (.ofTacticInfo info) _ := node | return #[]\n unless info.goalsBefore.isEmpty do return #[]\n let _ :: (seq, i) :: _ := stk | return #[]\n let some stop := seq.getTailPos? | return #[]\n let some prev := (seq.setArgs seq.getArgs[:i]).getTailPos? | return #[]\n let doc ← readDoc\n let eager := {\n title := \"Remove tactics after 'no goals'\"\n kind? := \"quickfix\"\n isPreferred? := true\n edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange ⟨prev, stop⟩\n newText := \"\"\n }\n }\n pure #[{ eager }]\n\n/--\nSimilar to `getElimExprInfo`, but returns the names of binders instead of just the numbers;\nintended for code actions which need to name the binders.\n-/\ndef getElimExprNames (elimType : Expr) : MetaM (Array (Name × Array Name)) := do\n -- let inductVal ← getConstInfoInduct inductName\n -- let decl ← getConstInfo declName\n forallTelescopeReducing elimType fun xs type => do\n let motive := type.getAppFn\n let targets := type.getAppArgs\n let motiveType ← inferType motive\n let mut altsInfo := #[]\n for _h : i in [:xs.size] do\n let x := xs[i]\n if x != motive && !targets.contains x then\n let xDecl ← x.fvarId!.getDecl\n if xDecl.binderInfo.isExplicit then\n let args ← forallTelescopeReducing xDecl.type fun args _ => do\n let lctx ← getLCtx\n pure <| args.filterMap fun y =>\n let yDecl := (lctx.find? y.fvarId!).get!\n if yDecl.binderInfo.isExplicit then some yDecl.userName else none\n altsInfo := altsInfo.push (xDecl.userName, args)\n pure altsInfo\n\n/-- Finds the `TermInfo` for an elaborated term `stx`. -/\ndef findTermInfo? (node : InfoTree) (stx : Term) : Option TermInfo :=\n match node.findInfo? fun\n | .ofTermInfo i => i.stx.getKind == stx.raw.getKind && i.stx.getRange? == stx.raw.getRange?\n | _ => false\n with\n | some (.ofTermInfo info) => pure info\n | _ => none\n\n/-- `findTermInfoWithCtx?` finds the `TermInfo` for an elaborated term `stx`\n and also updates the inputted `ContextInfo` using all the\n `PartialContextInfo` on the path to the returned `TermInfo`. -/\npartial def findTermInfoWithCtx? (t : InfoTree) (stx : Term) (ctx : ContextInfo)\n : Option (TermInfo × ContextInfo) :=\n match t with\n | .context partialCtx t' =>\n -- Merge partial context with outer, fall back to outer if merge fails\n let ctx' := partialCtx.mergeIntoOuter? ctx |>.getD ctx\n findTermInfoWithCtx? t' stx ctx'\n | .node info children =>\n let optResult : Option (TermInfo × ContextInfo) :=\n match info with\n | .ofTermInfo i =>\n if i.stx.getKind == stx.raw.getKind && i.stx.getRange? == stx.raw.getRange? then\n some (i, ctx)\n else none\n | _ => none\n if let some res := optResult then\n return res\n else\n children.findSome? (findTermInfoWithCtx? · stx ctx)\n | .hole _ => none\n\n/--\nInvoking tactic code action \"Generate an explicit pattern match for 'induction'\" in the\nfollowing:\n```lean\nexample (x : Nat) : x = x := by\n induction x\n```\nproduces:\n```lean\nexample (x : Nat) : x = x := by\n induction x with\n | zero => sorry\n | succ n ih => sorry\n```\n\nIt also works for `cases`.\n-/\n@[tactic_code_action Parser.Tactic.cases Parser.Tactic.induction]\ndef casesExpand : TacticCodeAction := fun _ snap ctx _ node => do\n let .node (.ofTacticInfo info) _ := node | return #[]\n let (targets, induction, using_, alts) ← match info.stx with\n | `(tactic| cases $[$[$_ :]? $targets],* $[using $u]? $(alts)?) =>\n pure (targets, false, u, alts)\n | `(tactic| induction $[$[$_ :]? $targets],* $[using $u]? $[generalizing $_*]? $(alts)?) =>\n pure (targets, true, u, alts)\n | _ => return #[]\n let some discrInfos := targets.mapM (findTermInfo? node) | return #[]\n let some discr₀ := discrInfos[0]? | return #[]\n let mut some ctors ← discr₀.runMetaM ctx do\n let targets := discrInfos.map (·.expr)\n match using_ with\n | none =>\n if tactic.customEliminators.get (← getOptions) then\n if let some elimName ← getCustomEliminator? targets induction then\n return some (← getElimExprNames (← getConstInfo elimName).type)\n matchConstInduct (← whnf (← inferType discr₀.expr)).getAppFn\n (fun _ => failure) fun val _ => do\n let elimName := if induction then mkRecName val.name else mkCasesOnName val.name\n return some (← getElimExprNames (← getConstInfo elimName).type)\n | some u =>\n let some info := findTermInfo? node u | return none\n return some (← getElimExprNames (← inferType info.expr))\n | return #[]\n let mut fallback := none\n if let some alts := alts then\n if let `(Parser.Tactic.inductionAlts| with $(_)? $alts*) := alts then\n for alt in alts do\n match alt with\n | `(Parser.Tactic.inductionAlt| | _ $_* => $fb) => fallback := fb.raw.getRange?\n | `(Parser.Tactic.inductionAlt| | $id:ident $_* => $_) =>\n ctors := ctors.filter (fun x => x.1 != id.getId)\n | _ => pure ()\n if ctors.isEmpty then return #[]\n let tacName := info.stx.getKind.updatePrefix .anonymous\n let eager := {\n title := s!\"Generate an explicit pattern match for '{tacName}'.\"\n kind? := \"quickfix\"\n }\n let doc ← readDoc\n pure #[{\n eager\n lazy? := some do\n let tacPos := info.stx.getPos?.get!\n let endPos := doc.meta.text.utf8PosToLspPos info.stx.getTailPos?.get!\n let indent := \"\\n\".pushn ' ' (findIndentAndIsStart doc.meta.text.source tacPos).1\n let (startPos, str') := if alts.isSome then\n let stx' := if fallback.isSome then\n info.stx.modifyArg (if induction then 4 else 3)\n (·.modifyArg 0 (·.modifyArg 2 (·.modifyArgs (·.filter fun s =>\n !(s matches `(Parser.Tactic.inductionAlt| | _ $_* => $_))))))\n else info.stx\n (doc.meta.text.utf8PosToLspPos stx'.getTailPos?.get!, \"\")\n else (endPos, \" with\")\n let fallback := if let some ⟨startPos, endPos⟩ := fallback then\n String.Pos.Raw.extract doc.meta.text.source startPos endPos\n else\n \"sorry\"\n let newText := Id.run do\n let mut str := str'\n for (name, args) in ctors do\n let mut ctor := toString name\n if let some _ := (Parser.getTokenTable snap.env).find? ctor then\n ctor := s!\"{idBeginEscape}{ctor}{idEndEscape}\"\n str := str ++ indent ++ s!\"| {ctor}\"\n -- replace n_ih with just ih if there is only one\n let args := if induction &&\n args.foldl (fun c n =>\n if n.eraseMacroScopes.getString!.endsWith \"_ih\" then c+1 else c) 0 == 1\n then\n args.map (fun n => if !n.hasMacroScopes && n.getString!.endsWith \"_ih\" then `ih else n)\n else args\n for arg in args do\n str := str ++ if arg.hasNum || arg.isInternal then \" _\" else s!\" {arg}\"\n str := str ++ s!\" => \" ++ fallback\n str\n pure { eager with\n edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := ⟨startPos, endPos⟩\n newText\n }\n }\n }]\n\n/-- The \"Add subgoals\" code action puts `· done` subgoals for any goals remaining at the end of a\nproof.\n```\nexample : True ∧ True := by\n constructor\n -- <- here\n```\nis transformed to\n```\nexample : True ∧ True := by\n constructor\n · done\n · done\n```\n-/\ndef addSubgoalsActionCore (params : Lsp.CodeActionParams)\n (i : Nat) (stk : Syntax.Stack) (goals : List MVarId) : RequestM (Array LazyCodeAction) := do\n -- If there are zero goals remaining, no need to do anything\n -- If there is one goal remaining, the user can just keep typing and subgoals are not helpful\n unless goals.length > 1 do return #[]\n let seq := stk.head!.1\n let nargs := (seq.getNumArgs + 1) / 2\n unless i == nargs do -- only trigger at the end of a block\n -- or if there is only a `done` or `sorry` terminator\n unless i + 1 == nargs && [\n ``Parser.Tactic.done, ``Parser.Tactic.tacticSorry, ``Parser.Tactic.tacticAdmit\n ].contains seq[2*i].getKind do\n return #[]\n let some startPos := seq[0].getPos? true | return #[]\n let doc ← readDoc\n let eager := { title := \"Add subgoals\", kind? := \"quickfix\" }\n pure #[{\n eager\n lazy? := some do\n let indent := \"\\n\".pushn ' ' (doc.meta.text.toPosition startPos).column\n let mut (range, newText) := (default, \"\")\n if let some tac := seq.getArgs[2*i]? then\n let some range2 := tac.getRange? true | return eager\n range := range2\n else\n let trimmed := seq.modifyArgs (·[:2*i])\n let some tail := trimmed.getTailPos? true | return eager\n (range, newText) := (⟨tail, tail⟩, indent)\n let cursor := doc.meta.text.lspPosToUtf8Pos params.range.end\n if range.stop ≤ cursor && cursor.1 ≤ range.stop.1 + trimmed.getTrailingSize then\n range := { range with stop := cursor }\n newText := newText ++ \"· done\"\n for _ in goals.tail! do\n newText := newText ++ indent ++ \"· done\"\n pure { eager with\n edit? := some <|.ofTextEdit doc.versionedIdentifier {\n range := doc.meta.text.utf8RangeToLspRange range\n newText\n }\n }\n }]\n\n@[inherit_doc addSubgoalsActionCore, tactic_code_action]\ndef addSubgoalsSeqAction : TacticSeqCodeAction := fun params _ _ => addSubgoalsActionCore params\n\n-- This makes sure that the addSubgoals action also triggers\n-- when the cursor is on the final `done` of a tactic block\n@[inherit_doc addSubgoalsActionCore,\n tactic_code_action Parser.Tactic.done Parser.Tactic.tacticSorry Parser.Tactic.tacticAdmit]\ndef addSubgoalsAction : TacticCodeAction := fun params _ _ stk node => do\n let (_ :: (seq, i) :: stk@(_ :: t :: _), .node (.ofTacticInfo info) _) := (stk, node) | return #[]\n unless t.1.getKind == ``Parser.Tactic.tacticSeq do return #[]\n addSubgoalsActionCore params (i/2) ((seq, 0) :: stk) info.goalsBefore\n" }, { "path": "Batteries/CodeAction.lean", "content": "module\n\npublic import Batteries.CodeAction.Attr\npublic import Batteries.CodeAction.Basic\npublic import Batteries.CodeAction.Misc\npublic import Batteries.CodeAction.Match\n" }, { "path": "Batteries/Control/AlternativeMonad.lean", "content": "/-\nCopyright (c) 2025 Devon Tuma. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Devon Tuma\n-/\nmodule\n\npublic import Batteries.Control.Lemmas\npublic import Batteries.Control.OptionT\nimport all Init.Control.Option\nimport all Init.Control.State\nimport all Init.Control.Reader\nimport all Init.Control.StateRef\n\n@[expose] public section\n\n\n/-!\n# Laws for Monads with Failure\n\nDefinitions for monads that also have an `Alternative` instance while sharing the underlying\n`Applicative` instance, and a class `LawfulAlternative` for types where the `failure` and `orElse`\noperations behave in a natural way. More specifically they satisfy:\n\n* `f <$> failure = failure`\n* `failure <*> x = failure`\n* `x <|> failure = x`\n* `failure <|> y = y`\n* `x <|> y <|> z = (x <|> y) <|> z`\n* `f <$> (x <|> y) = (f <$> x <|> f <$> y)`\n\n`Option`/`OptionT` are the most basic examples, but transformers like `StateT` also preserve\nthe lawfulness of this on the underlying monad.\n\nThe law `x *> failure = failure` is true for monads like `Option` and `List` that don't\nhave any \"side effects\" to execution, but not for something like `OptionT` on some monads,\nso we don't include this condition.\n\nWe also define a class `LawfulAlternativeLift` similar to `LawfulMonadLift` that states that\na lifting between monads preserves `failure` and `orElse`.\n\n## Tags\n\nmonad, alternative, failure\n-/\n\n/-- `AlternativeMonad m` means that `m` has both a `Monad` and `Alternative` instance,\nwhich both share the same underlying `Applicative` instance.\nThe main example is `Option`, but many monad transformers also preserve or add this structure. -/\nclass AlternativeMonad (m : Type _ → Type _) extends Alternative m, Monad m\n\nsection LawfulAlternative\n\n/-- `LawfulAlternative m` means that the `failure` operation on `m` behaves naturally\nwith respect to `map`, `seq`, and `orElse` operators. -/\nclass LawfulAlternative (m : Type _ → Type _) [Alternative m] : Prop\n extends LawfulApplicative m where\n /-- Mapping the result of a failure is still a failure -/\n map_failure (f : α → β) : f <$> (failure : m α) = failure\n /-- Sequencing a `failure` call results in failure -/\n failure_seq (x : m α) : (failure : m (α → β)) <*> x = failure\n /-- `failure` is a right identity for `orElse`. -/\n orElse_failure (x : m α) : (x <|> failure) = x\n /-- `failure` is a left identity for `orElse`. -/\n failure_orElse (y : m α) : (failure <|> y) = y\n /-- `orElse` is associative. -/\n orElse_assoc (x y z : m α) : (x <|> y <|> z) = ((x <|> y) <|> z)\n /-- `map` commutes with `orElse`. The stronger statement with `bind` generally isn't true -/\n map_orElse (x y : m α) (f : α → β) : f <$> (x <|> y) = (f <$> x <|> f <$> y)\n\nexport LawfulAlternative (map_failure failure_seq orElse_failure failure_orElse orElse_assoc\n map_orElse)\nattribute [simp] map_failure failure_seq orElse_failure failure_orElse map_orElse\n\nsection Alternative\n\n@[simp] theorem mapConst_failure [Alternative m] [LawfulAlternative m] (y : β) :\n Functor.mapConst y (failure : m α) = failure := by\n rw [LawfulFunctor.map_const, Function.comp_apply, map_failure]\n\n@[simp] theorem mapConst_orElse [Alternative m] [LawfulAlternative m] (x x' : m α) (y : β) :\n Functor.mapConst y (x <|> x') = (Functor.mapConst y x <|> Functor.mapConst y x') := by\n simp only [map_const, Function.comp_apply, map_orElse]\n\n@[simp] theorem failure_seqLeft [Alternative m] [LawfulAlternative m] (x : m α) :\n (failure : m β) <* x = failure := by\n simp only [seqLeft_eq, map_failure, failure_seq]\n\n@[simp] theorem failure_seqRight [Alternative m] [LawfulAlternative m] (x : m α) :\n (failure : m β) *> x = failure := by\n simp only [seqRight_eq, map_failure, failure_seq]\n\nend Alternative\n\nsection AlternativeMonad\n\n@[simp] theorem failure_bind [AlternativeMonad m] [LawfulAlternative m] [LawfulMonad m]\n (x : α → m β) : failure >>= x = failure := by\n calc failure >>= x = (PEmpty.elim <$> failure) >>= x := by rw [map_failure]\n _ = failure >>= (x ∘ PEmpty.elim) := by rw [bind_map_left, Function.comp_def]\n _ = failure >>= (pure ∘ PEmpty.elim) := bind_congr fun a => a.elim\n _ = (PEmpty.elim <$> failure) >>= pure := by rw [bind_map_left, Function.comp_def]\n _ = failure := by rw [map_failure, bind_pure]\n\n@[simp] theorem seq_failure [AlternativeMonad m] [LawfulAlternative m] [LawfulMonad m]\n (x : m (α → β)) : x <*> failure = x *> failure := by\n simp only [seq_eq_bind_map, map_failure, seqRight_eq, bind_map_left]\n\nend AlternativeMonad\n\nend LawfulAlternative\n\n/-- Type-class for monad lifts that preserve the `Alternative` operations. -/\nclass LawfulAlternativeLift (m : semiOutParam (Type u → Type v)) (n : Type u → Type w)\n [Alternative m] [Alternative n] [MonadLift m n] : Prop where\n /-- Lifting preserves `failure`. -/\n monadLift_failure : monadLift (failure : m α) = (failure : n α)\n /-- Lifting preserves `orElse`. -/\n monadLift_orElse (x y : m α) : monadLift (x <|> y) = (monadLift x <|> monadLift y : n α)\n\nexport LawfulAlternativeLift (monadLift_failure monadLift_orElse)\nattribute [simp] monadLift_failure monadLift_orElse\n\nnamespace Option\n\ninstance : AlternativeMonad Option.{u} where\n\ninstance : LawfulAlternative Option.{u} where\n map_failure _ := rfl\n failure_seq _ := rfl\n orElse_failure x := by cases x <;> rfl\n failure_orElse := by simp [failure]\n orElse_assoc | some _, _, _ => rfl | none, _, _ => rfl\n map_orElse | some _ => by simp | none => by simp\n\nend Option\n\nnamespace OptionT\n\ninstance (m) [Monad m] : AlternativeMonad (OptionT m) where\n\ninstance (m) [Monad m] [LawfulMonad m] : LawfulAlternative (OptionT m) where\n map_failure _ := pure_bind _ _\n failure_seq _ := pure_bind _ _\n orElse_failure x := (bind_congr (fun | some _ => rfl | none => rfl)).trans (bind_pure x)\n failure_orElse _ := pure_bind _ _\n orElse_assoc _ _ _ := by\n simp only [OptionT.ext_iff, run_orElse, Option.elimM, bind_assoc]\n refine bind_congr fun | some _ => by simp | none => rfl\n map_orElse x y f := by\n simp only [OptionT.ext_iff, run_map, run_orElse, map_bind, bind_map_left, Option.elimM]\n refine bind_congr fun | some _ => by simp | none => rfl\n\nend OptionT\n\nnamespace StateT\n\ninstance (m) [AlternativeMonad m] : AlternativeMonad (StateT σ m) where\n\ninstance (m) [AlternativeMonad m] [LawfulAlternative m] [LawfulMonad m] :\n LawfulAlternative (StateT σ m) where\n map_failure _ := StateT.ext fun _ => by simp only [run_map, run_failure, map_failure]\n failure_seq _ := StateT.ext fun _ => by simp only [run_seq, run_failure, failure_bind]\n orElse_failure _ := StateT.ext fun _ => orElse_failure _\n failure_orElse _ := StateT.ext fun _ => failure_orElse _\n orElse_assoc _ _ _ := StateT.ext fun _ => orElse_assoc _ _ _\n map_orElse _ _ _ := StateT.ext fun _ => by simp only [run_map, run_orElse, map_orElse]\n\ninstance (m) [AlternativeMonad m] [LawfulAlternative m] [LawfulMonad m] :\n LawfulAlternativeLift m (StateT σ m) where\n monadLift_failure {α} := StateT.ext fun s => by simp\n monadLift_orElse {α} x y := StateT.ext fun s => by simp\n\nend StateT\n\nnamespace ReaderT\n\ninstance [AlternativeMonad m] : AlternativeMonad (ReaderT ρ m) where\n\ninstance [AlternativeMonad m] [LawfulAlternative m] : LawfulAlternative (ReaderT ρ m) where\n map_failure _ := ReaderT.ext fun _ => map_failure _\n failure_seq _ := ReaderT.ext fun _ => failure_seq _\n orElse_failure _ := ReaderT.ext fun _ => orElse_failure _\n failure_orElse _ := ReaderT.ext fun _ => failure_orElse _\n orElse_assoc _ _ _ := ReaderT.ext fun _ => orElse_assoc _ _ _\n map_orElse _ _ _ := ReaderT.ext fun _ => by simp only [run_map, run_orElse, map_orElse]\n\ninstance [AlternativeMonad m] : LawfulAlternativeLift m (ReaderT ρ m) where\n monadLift_failure {α} := ReaderT.ext fun s => by simp\n monadLift_orElse {α} x y := ReaderT.ext fun s => by simp\n\nend ReaderT\n\nnamespace StateRefT'\n\ninstance [AlternativeMonad m] : AlternativeMonad (StateRefT' ω σ m) where\n\ninstance [AlternativeMonad m] [LawfulAlternative m] :\n LawfulAlternative (StateRefT' ω σ m) :=\n inferInstanceAs (LawfulAlternative (ReaderT (ST.Ref ω σ) m))\n\ninstance [AlternativeMonad m] : LawfulAlternativeLift m (StateRefT' ω σ m) :=\n inferInstanceAs (LawfulAlternativeLift m (ReaderT (ST.Ref ω σ) m))\n\nend StateRefT'\n" }, { "path": "Batteries/Control/ForInStep/Basic.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\n@[expose] public section\n\n/-! # Additional definitions on `ForInStep` -/\n\n/--\nThis is similar to a monadic `bind` operator, except that the two type parameters have to be\nthe same, which prevents putting a monad instance on `ForInStepT m α := m (ForInStep α)`.\n-/\n@[inline] protected def ForInStep.bind [Monad m]\n (a : ForInStep α) (f : α → m (ForInStep α)) : m (ForInStep α) :=\n match a with\n | .done a => return .done a\n | .yield a => f a\n\n@[inherit_doc ForInStep.bind] protected abbrev ForInStep.bindM [Monad m]\n (a : m (ForInStep α)) (f : α → m (ForInStep α)) : m (ForInStep α) := a >>= (·.bind f)\n\n/--\nGet the value out of a `ForInStep`.\nThis is usually done at the end of a `forIn` loop to scope the early exit to the loop body.\n-/\n@[inline] def ForInStep.run : ForInStep α → α\n | .done a\n | .yield a => a\n\n/-- Applies function `f` to each element of a list to accumulate a `ForInStep` value. -/\ndef ForInStep.bindList [Monad m]\n (f : α → β → m (ForInStep β)) : List α → ForInStep β → m (ForInStep β)\n | [], s => pure s\n | a::l, s => s.bind fun b => f a b >>= (·.bindList f l)\n" }, { "path": "Batteries/Control/ForInStep/Lemmas.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Control.ForInStep.Basic\n\n@[expose] public section\n\n/-! # Additional theorems on `ForInStep` -/\n\n@[simp] theorem ForInStep.bind_done [Monad m] (a : α) (f : α → m (ForInStep α)) :\n (ForInStep.done a).bind (m := m) f = pure (.done a) := rfl\n@[simp] theorem ForInStep.bind_yield [Monad m] (a : α) (f : α → m (ForInStep α)) :\n (ForInStep.yield a).bind (m := m) f = f a := rfl\n\nattribute [simp] ForInStep.bindM\n\n@[simp] theorem ForInStep.run_done : (ForInStep.done a).run = a := rfl\n@[simp] theorem ForInStep.run_yield : (ForInStep.yield a).run = a := rfl\n\n@[simp] theorem ForInStep.bindList_nil [Monad m] (f : α → β → m (ForInStep β))\n (s : ForInStep β) : s.bindList f [] = pure s := rfl\n\n@[simp] theorem ForInStep.bindList_cons [Monad m]\n (f : α → β → m (ForInStep β)) (s : ForInStep β) (a l) :\n s.bindList f (a::l) = s.bind fun b => f a b >>= (·.bindList f l) := rfl\n\n@[simp] theorem ForInStep.done_bindList [Monad m]\n (f : α → β → m (ForInStep β)) (a l) :\n (ForInStep.done a).bindList f l = pure (.done a) := by cases l <;> simp\n\n@[simp] theorem ForInStep.bind_yield_bindList [Monad m]\n (f : α → β → m (ForInStep β)) (s : ForInStep β) (l) :\n (s.bind fun a => (yield a).bindList f l) = s.bindList f l := by cases s <;> simp\n\n@[simp] theorem ForInStep.bind_bindList_assoc [Monad m] [LawfulMonad m]\n (f : β → m (ForInStep β)) (g : α → β → m (ForInStep β)) (s : ForInStep β) (l) :\n s.bind f >>= (·.bindList g l) = s.bind fun b => f b >>= (·.bindList g l) := by\n cases s <;> simp\n\ntheorem ForInStep.bindList_cons' [Monad m] [LawfulMonad m]\n (f : α → β → m (ForInStep β)) (s : ForInStep β) (a l) :\n s.bindList f (a::l) = s.bind (f a) >>= (·.bindList f l) := by simp\n\n@[simp] theorem ForInStep.bindList_append [Monad m] [LawfulMonad m]\n (f : α → β → m (ForInStep β)) (s : ForInStep β) (l₁ l₂) :\n s.bindList f (l₁ ++ l₂) = s.bindList f l₁ >>= (·.bindList f l₂) := by\n induction l₁ generalizing s <;> simp [*]\n" }, { "path": "Batteries/Control/ForInStep.lean", "content": "module\n\npublic import Batteries.Control.ForInStep.Basic\npublic import Batteries.Control.ForInStep.Lemmas\n" }, { "path": "Batteries/Control/LawfulMonadState.lean", "content": "/-\nCopyright (c) 2025 Devon Tuma. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Devon Tuma, Quang Dao\n-/\nmodule\nimport all Init.Control.StateRef\n\n@[expose] public section\n\n/-!\n# Laws for Monads with State\n\nThis file defines a typeclass for `MonadStateOf` with compatible `get` and `set` operations.\n\nNote that we use `MonadStateOf` over `MonadState` as the first induces the second,\nbut we phrase things using `MonadStateOf.set` and `MonadState.get` as those are the\nversions that are available at the top level namespace.\n-/\n\n/-- The namespaced `MonadStateOf.get` is equal to the `MonadState` provided `get`. -/\n@[simp] theorem monadStateOf_get_eq_get [MonadStateOf σ m] :\n (MonadStateOf.get : m σ) = get := rfl\n\n/-- The namespaced `MonadStateOf.modifyGet` is equal to the `MonadState` provided `modifyGet`. -/\n@[simp] theorem monadStateOf_modifyGet_eq_modifyGet [MonadStateOf σ m]\n (f : σ → α × σ) : (MonadStateOf.modifyGet f : m α) = modifyGet f := rfl\n\n@[simp] theorem liftM_get {m n} [MonadStateOf σ m] [MonadLift m n] :\n (liftM (get (m := m)) : n _) = get := rfl\n\n@[simp] theorem liftM_set {m n} [MonadStateOf σ m] [MonadLift m n]\n (s : σ) : (liftM (set (m := m) s) : n _) = set s := rfl\n\n@[simp] theorem liftM_modify {m n} [MonadStateOf σ m] [MonadLift m n]\n (f : σ → σ) : (liftM (modify (m := m) f) : n _) = modify f := rfl\n\n@[simp] theorem liftM_modifyGet {m n} [MonadStateOf σ m] [MonadLift m n]\n (f : σ → α × σ) : (liftM (modifyGet (m := m) f) : n _) = modifyGet f := rfl\n\n@[simp] theorem liftM_getModify {m n} [MonadStateOf σ m] [MonadLift m n]\n (f : σ → σ) : (liftM (getModify (m := m) f) : n _) = getModify f := rfl\n\n/-- Class for well behaved state monads, extending the base `MonadState` type.\nRequires that `modifyGet` is equal to the same definition with only `get` and `set`,\nthat `get` is idempotent if the result isn't used, and that `get` after `set` returns\nexactly the value that was previously `set`. -/\nclass LawfulMonadStateOf (σ : semiOutParam (Type _)) (m : Type _ → Type _)\n [Monad m] [MonadStateOf σ m] extends LawfulMonad m where\n /-- `modifyGet f` is equal to getting the state, modifying it, and returning a result. -/\n modifyGet_eq {α} (f : σ → α × σ) :\n modifyGet (m := m) f = do let z ← f <$> get; set z.2; return z.1\n /-- Discarding the result of `get` is the same as never getting the state. -/\n get_bind_const {α} (mx : m α) : (do let _ ← get; mx) = mx\n /-- Calling `get` twice is the same as just using the first retreived state value. -/\n get_bind_get_bind {α} (mx : σ → σ → m α) :\n (do let s ← get; let s' ← get; mx s s') = (do let s ← get; mx s s)\n /-- Setting the monad state to its current value has no effect. -/\n get_bind_set_bind {α} (mx : σ → PUnit → m α) :\n (do let s ← get; let u ← set s; mx s u) = (do let s ← get; mx s PUnit.unit)\n /-- Setting and then returning the monad state is the same as returning the set value. -/\n set_bind_get (s : σ) : (do set (m := m) s; get) = (do set s; return s)\n /-- Setting the monad twice is the same as just setting to the final state. -/\n set_bind_set (s s' : σ) : (do set (m := m) s; set s') = set s'\n\nnamespace LawfulMonadStateOf\n\nvariable {σ : Type _} {m : Type _ → Type _} [Monad m]\n [MonadStateOf σ m] [LawfulMonadStateOf σ m]\n\nattribute [simp] get_bind_const get_bind_get_bind get_bind_set_bind set_bind_get set_bind_set\n\n@[simp] theorem get_seqRight (mx : m α) : get *> mx = mx := by\n rw [seqRight_eq_bind, get_bind_const]\n\n@[simp] theorem seqLeft_get (mx : m α) : mx <* get = mx := by\n simp only [seqLeft_eq_bind, get_bind_const, bind_pure]\n\n@[simp] theorem get_map_const (x : α) :\n (fun _ => x) <$> get (m := m) = pure x := by\n rw [map_eq_pure_bind, get_bind_const]\n\ntheorem get_bind_get : (do let _ ← get (m := m); get) = get := get_bind_const get\n\n@[simp] theorem get_bind_set :\n (do let s ← get (m := m); set s) = return PUnit.unit := by\n simpa only [bind_pure_comp, id_map', get_map_const] using\n get_bind_set_bind (σ := σ) (m := m) (fun _ _ => return PUnit.unit)\n\n@[simp] theorem get_bind_map_set (f : σ → PUnit → α) :\n (do let s ← get (m := m); f s <$> set s) = (do return f (← get) PUnit.unit) := by\n simp [map_eq_pure_bind, -bind_pure_comp]\n\n@[simp] theorem set_bind_get_bind (s : σ) (f : σ → m α) :\n (do set s; let s' ← get; f s') = (do set s; f s) := by\n rw [← bind_assoc, set_bind_get, bind_assoc, pure_bind]\n\n@[simp] theorem set_bind_map_get (f : σ → α) (s : σ) :\n (do set (m := m) s; f <$> get) = (do set (m := m) s; pure (f s)) := by\n simp [map_eq_pure_bind, -bind_pure_comp]\n\n@[simp] theorem set_bind_set_bind (s s' : σ) (mx : m α) :\n (do set s; set s'; mx) = (do set s'; mx) := by\n rw [← bind_assoc, set_bind_set]\n\n@[simp] theorem set_bind_map_set (s s' : σ) (f : PUnit → α) :\n (do set (m := m) s; f <$> set s') = (do f <$> set s') := by\n simp [map_eq_pure_bind, ← bind_assoc, -bind_pure_comp]\n\nsection modify\n\ntheorem modifyGetThe_eq (f : σ → α × σ) :\n modifyGetThe σ (m := m) f = do let z ← f <$> get; set z.2; return z.1 := modifyGet_eq f\n\ntheorem modify_eq (f : σ → σ) :\n modify (m := m) f = (do set (f (← get))) := by simp [modify, modifyGet_eq]\n\ntheorem modifyThe_eq (f : σ → σ) :\n modifyThe σ (m := m) f = (do set (f (← get))) := modify_eq f\n\ntheorem getModify_eq (f : σ → σ) :\n getModify (m := m) f = do let s ← get; set (f s); return s := by\n rw [getModify, modifyGet_eq, bind_map_left]\n\n/-- Version of `modifyGet_eq` that preserves an call to `modify`. -/\ntheorem modifyGet_eq' (f : σ → α × σ) :\n modifyGet (m := m) f = do let s ← get; modify (Prod.snd ∘ f); return (f s).fst := by\n simp [modify_eq, modifyGet_eq]\n\n@[simp] theorem modify_id : modify (m := m) id = pure PUnit.unit := by\n simp [modify_eq]\n\n@[simp] theorem getModify_id : getModify (m := m) id = get := by\n simp [getModify_eq]\n\n@[simp] theorem set_bind_modify (s : σ) (f : σ → σ) :\n (do set (m := m) s; modify f) = set (f s) := by simp [modify_eq]\n\n@[simp] theorem set_bind_modify_bind (s : σ) (f : σ → σ) (mx : PUnit → m α) :\n (do set s; let u ← modify f; mx u) = (do set (f s); mx PUnit.unit) := by\n simp [modify_eq, ← bind_assoc]\n\n@[simp] theorem set_bind_modifyGet (s : σ) (f : σ → α × σ) :\n (do set (m := m) s; modifyGet f) = (do set (f s).2; return (f s).1) := by simp [modifyGet_eq]\n\n@[simp] theorem set_bind_modifyGet_bind (s : σ) (f : σ → α × σ) (mx : α → m β) :\n (do set s; let x ← modifyGet f; mx x) = (do set (f s).2; mx (f s).1) := by simp [modifyGet_eq]\n\n@[simp] theorem set_bind_getModify (s : σ) (f : σ → σ) :\n (do set (m := m) s; getModify f) = (do set (f s); return s) := by simp [getModify_eq]\n\n@[simp] theorem set_bind_getModify_bind (s : σ) (f : σ → σ) (mx : σ → m α) :\n (do set s; let x ← getModify f; mx x) = (do set (f s); mx s) := by\n simp [getModify_eq, ← bind_assoc]\n\n@[simp] theorem modify_bind_modify (f g : σ → σ) :\n (do modify (m := m) f; modify g) = modify (g ∘ f) := by simp [modify_eq]\n\n@[simp] theorem modify_bind_modifyGet (f : σ → σ) (g : σ → α × σ) :\n (do modify (m := m) f; modifyGet g) = modifyGet (g ∘ f) := by\n simp [modify_eq, modifyGet_eq]\n\n@[simp] theorem getModify_bind_modify (f : σ → σ) (g : σ → σ → σ) :\n (do let s ← getModify (m := m) f; modify (g s)) =\n (do let s ← get; modify (g s ∘ f)) := by\n simp [modify_eq, getModify_eq]\n\ntheorem modify_comm_of_comp_comm {f g : σ → σ} (h : f ∘ g = g ∘ f) :\n (do modify (m := m) f; modify g) = (do modify (m := m) g; modify f) := by\n simp [modify_bind_modify, h]\n\ntheorem modify_bind_get (f : σ → σ) :\n (do modify (m := m) f; get) = (do let s ← get; modify f; return (f s)) := by\n simp [modify_eq]\n\nend modify\n\n/-- `StateT` has lawful state operations if the underlying monad is lawful.\nThis is applied for `StateM` as well due to the reducibility of that definition. -/\ninstance {m σ} [Monad m] [LawfulMonad m] : LawfulMonadStateOf σ (StateT σ m) where\n modifyGet_eq f := StateT.ext fun s => by simp\n get_bind_const mx := StateT.ext fun s => by simp\n get_bind_get_bind mx := StateT.ext fun s => by simp\n get_bind_set_bind mx := StateT.ext fun s => by simp\n set_bind_get s := StateT.ext fun s => by simp\n set_bind_set s s' := StateT.ext fun s => by simp\n\n/-- The continuation passing state monad variant `StateCpsT` always has lawful state instance. -/\ninstance {σ m} : LawfulMonadStateOf σ (StateCpsT σ m) where\n modifyGet_eq _ := rfl\n get_bind_const _ := rfl\n get_bind_get_bind _ := rfl\n get_bind_set_bind _ := rfl\n set_bind_get _ := rfl\n set_bind_set _ _ := rfl\n\n/-- The `EStateM` monad always has a lawful state instance. -/\ninstance {σ ε} : LawfulMonadStateOf σ (EStateM ε σ) where\n modifyGet_eq _ := rfl\n get_bind_const _ := rfl\n get_bind_get_bind _ := rfl\n get_bind_set_bind _ := rfl\n set_bind_get _ := rfl\n set_bind_set _ _ := rfl\n\n/-- If the underlying monad `m` has a lawful state instance, then the induced state instance on\n`ReaderT ρ m` will also be lawful. -/\ninstance {m σ ρ} [Monad m] [LawfulMonad m] [MonadStateOf σ m] [LawfulMonadStateOf σ m] :\n LawfulMonadStateOf σ (ReaderT ρ m) where\n modifyGet_eq f := ReaderT.ext fun ctx => by\n simp [← liftM_modifyGet, LawfulMonadStateOf.modifyGet_eq, ← liftM_get]\n get_bind_const mx := ReaderT.ext fun ctx => by\n simp [← liftM_get]\n get_bind_get_bind mx := ReaderT.ext fun ctx => by\n simp [← liftM_get]\n get_bind_set_bind mx := ReaderT.ext fun ctx => by\n simp [← liftM_get, ← liftM_set]\n set_bind_get s := ReaderT.ext fun ctx => by\n simp [← liftM_get, ← liftM_set]\n set_bind_set s s' := ReaderT.ext fun ctx => by\n simp [← liftM_set]\n\ninstance {m ω σ} [Monad m] [LawfulMonad m] [MonadStateOf σ m] [LawfulMonadStateOf σ m] :\n LawfulMonadStateOf σ (StateRefT' ω σ m) :=\n inferInstanceAs (LawfulMonadStateOf σ (ReaderT (ST.Ref ω σ) m))\n" }, { "path": "Batteries/Control/Lemmas.lean", "content": "/-\nCopyright (c) 2023 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais, Eric Wieser\n-/\nmodule\nimport all Init.Control.Reader\nimport all Init.Control.State\n\n@[expose] public section\n\nnamespace ReaderT\n\nattribute [ext] ReaderT.ext\n\n@[simp] theorem run_failure [Monad m] [Alternative m] (ctx : ρ) :\n (failure : ReaderT ρ m α).run ctx = failure := (rfl)\n\n@[simp] theorem run_orElse [Monad m] [Alternative m] (x y : ReaderT ρ m α) (ctx : ρ) :\n (x <|> y).run ctx = (x.run ctx <|> y.run ctx) := (rfl)\n\n@[simp] theorem run_throw [MonadExceptOf ε m] (e : ε) (ctx : ρ) :\n (throw e : ReaderT ρ m α).run ctx = throw e := rfl\n\n@[simp] theorem run_throwThe [MonadExceptOf ε m] (e : ε) (ctx : ρ) :\n (throwThe ε e : ReaderT ρ m α).run ctx = throwThe ε e := rfl\n\n@[simp] theorem run_tryCatch [MonadExceptOf ε m]\n (body : ReaderT ρ m α) (handler : ε → ReaderT ρ m α) (ctx : ρ) :\n (tryCatch body handler).run ctx = tryCatch (body.run ctx) (handler · |>.run ctx) := rfl\n\n@[simp] theorem run_tryCatchThe [MonadExceptOf ε m]\n (body : ReaderT ρ m α) (handler : ε → ReaderT ρ m α) (ctx : ρ) :\n (tryCatchThe ε body handler).run ctx = tryCatchThe ε (body.run ctx) (handler · |>.run ctx) :=\n rfl\n\nend ReaderT\n\nnamespace StateT\n\nattribute [ext] StateT.ext\n\n@[simp] theorem run_failure {α σ} [Monad m] [Alternative m] (s : σ) :\n (failure : StateT σ m α).run s = failure := (rfl)\n\n@[simp] theorem run_orElse {α σ} [Monad m] [Alternative m] (x y : StateT σ m α) (s : σ) :\n (x <|> y).run s = (x.run s <|> y.run s) := (rfl)\n\n@[simp] theorem run_throw [Monad m] [MonadExceptOf ε m] (e : ε) (s : σ) :\n (throw e : StateT σ m α).run s = (do let a ← throw e; pure (a, s)) := rfl\n\n@[simp] theorem run_throwThe [Monad m] [MonadExceptOf ε m] (e : ε) (s : σ) :\n (throwThe ε e : StateT σ m α).run s = (do let a ← throwThe ε e; pure (a, s)) := rfl\n\n@[simp] theorem run_tryCatch [Monad m] [MonadExceptOf ε m]\n (body : StateT σ m α) (handler : ε → StateT σ m α) (s : σ) :\n (tryCatch body handler).run s = tryCatch (body.run s) (handler · |>.run s) := rfl\n\n@[simp] theorem run_tryCatchThe [Monad m] [MonadExceptOf ε m]\n (body : StateT σ m α) (handler : ε → StateT σ m α) (s : σ) :\n (tryCatchThe ε body handler).run s = tryCatchThe ε (body.run s) (handler · |>.run s) := rfl\n\nend StateT\n" }, { "path": "Batteries/Control/Monad.lean", "content": "/-\nCopyright (c) 2025 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\n@[deprecated (since := \"2025-02-09\")] alias LawfulFunctor.map_inj_right_of_nonempty :=\nmap_inj_right_of_nonempty\n@[deprecated (since := \"2025-02-09\")] alias LawfulMonad.map_inj_right :=\nmap_inj_right\n" }, { "path": "Batteries/Control/Nondet/Basic.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Tactic.Lint.Misc\npublic import Batteries.Data.MLList.Basic\nimport Lean.Util.MonadBacktrack\n\n@[expose] public section\n\n/-!\n# A nondeterminism monad.\n\nWe represent nondeterministic values in a type `α` as a single field structure containing an\n`MLList m (σ × α)`, i.e. as a monadic lazy list of possible values,\neach equipped with the backtrackable state\nrequired to run further computations in the ambient monad.\n\nWe provide an `Alternative` `Monad` instance, as well as functions `bind`, `mapM`, and `filterMapM`,\nand functions `singletonM`, `ofListM`, `ofOptionM`, and `firstM`\nfor entering and leaving the nondeterministic world.\n\nOperations on the nondeterministic value via `bind`, `mapM`, and `filterMapM`\nrun with the appropriate backtrackable state, and are responsible for updating the state themselves\n(typically this doesn't need to be done explicitly,\nbut just happens as a side effect in the monad `m`).\n-/\n\nopen Lean (MonadBacktrack)\nopen Lean.MonadBacktrack\n\n/--\n`Nondet m α` is variation on `MLList m α` suitable for use with backtrackable monads `m`.\n\nWe think of `Nondet m α` as a nondeterministic value in `α`,\nwith the possible alternatives stored in a monadic lazy list.\n\nAlong with each `a : α` we store the backtrackable state, and ensure that monadic operations\non alternatives run with the appropriate state.\n\nOperations on the nondeterministic value via `bind`, `mapM`, and `filterMapM`\nrun with the appropriate backtrackable state, and are responsible for updating the state themselves\n(typically this doesn't need to be done explicitly,\nbut just happens as a side effect in the monad `m`).\n-/\n@[nolint unusedArguments]\nstructure Nondet (m : Type → Type) [MonadBacktrack σ m] (α : Type) : Type where\n /--\n Convert a non-deterministic value into a lazy list, keeping the backtrackable state.\n Be careful that monadic operations on the `MLList` will not respect this state!\n -/\n toMLList : MLList m (α × σ)\n\nnamespace Nondet\nvariable {m : Type → Type}\n\nsection Monad\nvariable [Monad m] [MonadBacktrack σ m]\n\n/-- The empty nondeterministic value. -/\ndef nil : Nondet m α := .mk .nil\n\ninstance : Inhabited (Nondet m α) := ⟨.nil⟩\n\n/--\nSquash a monadic nondeterministic value to a nondeterministic value.\n-/\ndef squash (L : Unit → m (Nondet m α)) : Nondet m α :=\n .mk <| MLList.squash fun _ => return (← L ()).toMLList\n\n/--\nBind a nondeterministic function over a nondeterministic value,\nensuring the function is run with the relevant backtrackable state at each value.\n-/\npartial def bind (L : Nondet m α) (f : α → Nondet m β) : Nondet m β := .squash fun _ => do\n match ← L.toMLList.uncons with\n | none => pure .nil\n | some (⟨x, s⟩, xs) => do\n let r := (Nondet.mk xs).bind f\n restoreState s\n match ← (f x).toMLList.uncons with\n | none => return r\n | some (y, ys) => return .mk <| .cons y (ys.append (fun _ => r.toMLList))\n\n/-- Convert any value in the monad to the singleton nondeterministic value. -/\ndef singletonM (x : m α) : Nondet m α :=\n .mk <| .singletonM do\n let a ← x\n return (a, ← saveState)\n\n/-- Convert a value to the singleton nondeterministic value. -/\ndef singleton (x : α) : Nondet m α := singletonM (pure x)\n\n/-- `Nondet m` is an alternative monad. -/\ninstance : AlternativeMonad (Nondet m) where\n pure a := singletonM (pure a)\n bind := bind\n failure := .nil\n orElse x y := .mk <| x.toMLList.append fun _ => (y ()).toMLList\n\ninstance : MonadLift m (Nondet m) where\n monadLift := singletonM\n\n/--\nLift a list of monadic values to a nondeterministic value.\nWe ensure that each monadic value is evaluated with the same backtrackable state.\n-/\ndef ofListM (L : List (m α)) : Nondet m α :=\n .squash fun _ => do\n let s ← saveState\n return .mk <| MLList.ofListM <| L.map fun x => do\n restoreState s\n let a ← x\n pure (a, ← saveState)\n\n/--\nLift a list of values to a nondeterministic value.\n(The backtrackable state in each will be identical:\nwhatever the state was when we first read from the result.)\n-/\ndef ofList (L : List α) : Nondet m α := ofListM (L.map pure)\n\n/-- Apply a function which returns values in the monad to every alternative of a `Nondet m α`. -/\ndef mapM (f : α → m β) (L : Nondet m α) : Nondet m β :=\n L.bind fun a => singletonM (f a)\n\n/-- Apply a function to each alternative in a `Nondet m α` . -/\ndef map (f : α → β) (L : Nondet m α) : Nondet m β :=\n L.mapM fun a => pure (f a)\n\n/-- Convert a monadic optional value to a nondeterministic value. -/\ndef ofOptionM (x : m (Option α)) : Nondet m α := .squash fun _ => do\n match ← x with\n | none => return .nil\n | some a => return singleton a\n\n/-- Convert an optional value to a nondeterministic value. -/\ndef ofOption (x : Option α) : Nondet m α := ofOptionM (pure x)\n\n/-- Filter and map a nondeterministic value using a monadic function which may return `none`. -/\ndef filterMapM (f : α → m (Option β)) (L : Nondet m α) : Nondet m β :=\n L.bind fun a => ofOptionM (f a)\n\n/-- Filter and map a nondeterministic value. -/\ndef filterMap (f : α → Option β) (L : Nondet m α) : Nondet m β :=\n L.filterMapM fun a => pure (f a)\n\n/-- Filter a nondeterministic value using a monadic predicate. -/\ndef filterM (p : α → m (ULift Bool)) (L : Nondet m α) : Nondet m α :=\n L.filterMapM fun a => do\n if (← p a).down then\n pure (some a)\n else\n pure none\n\n/-- Filter a nondeterministic value. -/\ndef filter (p : α → Bool) (L : Nondet m α) : Nondet m α :=\n L.filterM fun a => pure <| .up (p a)\n\n/--\nAll iterations of a non-deterministic function on an initial value.\n\n(That is, depth first search.)\n-/\npartial def iterate (f : α → Nondet m α) (a : α) : Nondet m α :=\n singleton a <|> (f a).bind (iterate f)\n\n/--\nConvert a non-deterministic value into a lazy list, by discarding the backtrackable state.\n-/\ndef toMLList' (L : Nondet m α) : MLList m α := L.toMLList.map (·.1)\n\n/--\nConvert a non-deterministic value into a list in the monad, retaining the backtrackable state.\n-/\ndef toList (L : Nondet m α) : m (List (α × σ)) := L.toMLList.force\n\n/--\nConvert a non-deterministic value into a list in the monad, by discarding the backtrackable state.\n-/\ndef toList' (L : Nondet m α) : m (List α) := L.toMLList.map (·.1) |>.force\n\nend Monad\n\nsection AlternativeMonad\nvariable [AlternativeMonad m] [MonadBacktrack σ m]\n\n/--\nFind the first alternative in a nondeterministic value, as a monadic value.\n-/\ndef head (L : Nondet m α) : m α := do\n let (x, s) ← L.toMLList.head\n restoreState s\n return x\n\n/--\nFind the value of a monadic function on the first alternative in a nondeterministic value\nwhere the function succeeds.\n-/\ndef firstM (L : Nondet m α) (f : α → m (Option β)) : m β :=\n L.filterMapM f |>.head\n\nend AlternativeMonad\n\nend Nondet\n\n/-- The `Id` monad is trivially backtrackable, with state `Unit`. -/\n-- This is useful so we can use `Nondet Id α` instead of `List α`\n-- as the basic non-determinism monad.\ninstance : MonadBacktrack Unit Id where\n saveState := pure ()\n restoreState _ := pure ()\n" }, { "path": "Batteries/Control/OptionT.lean", "content": "/-\nCopyright (c) 2017 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Sebastian Ullrich\n-/\nmodule\n\npublic import Batteries.Control.LawfulMonadState\nimport all Init.Control.Option\n\n@[expose] public section\n\n/-!\n# Lemmas About Option Monad Transformer\n\nThis file contains lemmas about the behavior of `OptionT` and `OptionT.run`.\n-/\n\nnamespace OptionT\n\n@[simp] theorem run_monadLift [Monad m] [LawfulMonad m] [MonadLiftT n m] (x : n α) :\n (monadLift x : OptionT m α).run = some <$> (monadLift x : m α) := (map_eq_pure_bind _ _).symm\n\n@[simp] theorem run_mapConst [Monad m] [LawfulMonad m] (x : OptionT m α) (y : β) :\n (Functor.mapConst y x).run = Option.map (Function.const α y) <$> x.run := run_map _ _\n\ninstance [Monad m] [LawfulMonad m] [MonadStateOf σ m] [LawfulMonadStateOf σ m] :\n LawfulMonadStateOf σ (OptionT m) where\n modifyGet_eq f := by simp [← liftM_modifyGet, ← liftM_get, LawfulMonadStateOf.modifyGet_eq]\n get_bind_const mx := OptionT.ext (by simp [← liftM_get])\n get_bind_get_bind mx := OptionT.ext (by simp [← liftM_get])\n get_bind_set_bind mx := OptionT.ext (by simp [← liftM_get, ← liftM_set])\n set_bind_get s := OptionT.ext (by simp [← liftM_get, ← liftM_set])\n set_bind_set s s' := OptionT.ext (by simp [← liftM_set])\n\nend OptionT\n" }, { "path": "Batteries/Data/Array/Basic.lean", "content": "/-\nCopyright (c) 2021 Floris van Doorn. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Arthur Paulino, Floris van Doorn, Jannis Limperg\n-/\nmodule\nimport Batteries.Tactic.Alias\nimport Batteries.Data.UInt\n\n@[expose] public section\n\n/-!\n## Definitions on Arrays\n\nThis file contains various definitions on `Array`. It does not contain\nproofs about these definitions, those are contained in other files in `Batteries.Data.Array`.\n-/\n\nnamespace Array\n\n/--\nCheck whether `xs` and `ys` are equal as sets, i.e. they contain the same\nelements when disregarding order and duplicates. `O(n*m)`! If your element type\nhas an `Ord` instance, it is asymptotically more efficient to sort the two\narrays, remove duplicates and then compare them elementwise.\n-/\ndef equalSet [BEq α] (xs ys : Array α) : Bool :=\n xs.all (ys.contains ·) && ys.all (xs.contains ·)\n\n/--\nReturns the first minimal element among `d` and elements of the array.\nIf `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered (in addition to `d`).\n-/\n@[inline]\nprotected def rangeMinWith [ord : Ord α]\n (xs : Array α) (d : α) (start := 0) (stop := xs.size) : α :=\n xs.foldl (init := d) (start := start) (stop := stop) fun min x =>\n if compare x min |>.isLT then x else min\n\n@[inherit_doc Array.rangeMinWith, deprecated Array.rangeMinWith (since := \"2026-01-08\")]\nprotected def minWith := @Array.rangeMinWith\n\n/--\nFind the first minimal element of an array. If the array is empty, `d` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMinD [ord : Ord α]\n (xs : Array α) (d : α) (start := 0) (stop := xs.size) : α :=\n if h: start < xs.size ∧ start < stop then\n xs.rangeMinWith xs[start] (start + 1) stop\n else\n d\n\n@[inherit_doc Array.rangeMinD, deprecated Array.rangeMinD (since := \"2026-01-08\")]\nprotected def minD := @Array.rangeMinD\n\n/--\nFind the first minimal element of an array. If the array is empty, `none` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMin? [ord : Ord α]\n (xs : Array α) (start := 0) (stop := xs.size) : Option α :=\n if h : start < xs.size ∧ start < stop then\n some $ xs.rangeMinD xs[start] start stop\n else\n none\n\n/--\nFind the first minimal element of an array. If the array is empty, `default` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMinI [ord : Ord α] [Inhabited α]\n (xs : Array α) (start := 0) (stop := xs.size) : α :=\n xs.rangeMinD default start stop\n\n@[inherit_doc Array.rangeMinI, deprecated Array.rangeMinI (since := \"2026-01-08\")]\nprotected def minI := @Array.rangeMinI\n\n/--\nReturns the first maximal element among `d` and elements of the array.\nIf `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered (in addition to `d`).\n-/\n@[inline]\nprotected def rangeMaxWith [ord : Ord α]\n (xs : Array α) (d : α) (start := 0) (stop := xs.size) : α :=\n xs.rangeMinWith (ord := ord.opposite) d start stop\n\n@[inherit_doc Array.rangeMaxWith, deprecated Array.rangeMaxWith (since := \"2026-01-08\")]\nprotected def maxWith := @Array.rangeMaxWith\n\n/--\nFind the first maximal element of an array. If the array is empty, `d` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMaxD [ord : Ord α]\n (xs : Array α) (d : α) (start := 0) (stop := xs.size) : α :=\n xs.rangeMinD (ord := ord.opposite) d start stop\n\n@[inherit_doc Array.rangeMaxD, deprecated Array.rangeMaxD (since := \"2026-01-08\")]\nprotected def maxD := @Array.rangeMaxD\n\n/--\nFind the first maximal element of an array. If the array is empty, `none` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMax? [ord : Ord α]\n (xs : Array α) (start := 0) (stop := xs.size) : Option α :=\n xs.rangeMin? (ord := ord.opposite) start stop\n\n/--\nFind the first maximal element of an array. If the array is empty, `default` is\nreturned. If `start` and `stop` are given, only the subarray `xs[start...stop]` is\nconsidered.\n-/\n@[inline]\nprotected def rangeMaxI [ord : Ord α] [Inhabited α]\n (xs : Array α) (start := 0) (stop := xs.size) : α :=\n xs.rangeMinI (ord := ord.opposite) start stop\n\n@[inherit_doc Array.rangeMaxI, deprecated Array.rangeMaxI (since := \"2026-01-08\")]\nprotected def maxI := @Array.rangeMaxI\n\n@[deprecated set (since := \"2026-02-02\")]\nalias setN := set\n\n/-\nThis is guaranteed by the Array docs but it is unprovable.\nMay be asserted to be true in an unsafe context via `Array.unsafe_sizeFitsUsize`\n-/\nprivate abbrev SizeFitsUSize (a : Array α) : Prop := a.size < USize.size\n\n/-\nThis is guaranteed by the Array docs but it is unprovable.\nCan be used in unsafe functions to write more efficient implementations\nthat avoid arbitrary precision integer arithmetic.\n-/\nprivate unsafe def unsafe_sizeFitsUSize (a : Array α) : SizeFitsUSize a :=\n lcProof\n\n@[inline]\nprivate def scanlMFast [Monad m] (f : β → α → m β) (init : β) (as : Array α)\n (start := 0) (stop := as.size) : m (Array β) :=\n let stop := min stop as.size\n let start := min start as.size\n loop f init as\n (start := USize.ofNat start) (stop := USize.ofNat stop)\n (h_stop := by grind only [USize.size_eq, USize.ofNat_eq_iff_mod_eq_toNat, = Nat.min_def])\n (acc := Array.mkEmpty <| stop - start + 1)\nwhere\n @[specialize]\n loop (f : β → α → m β) (init: β) (as: Array α) (start stop : USize)\n (h_stop : stop.toNat ≤ as.size) (acc : Array β) : m (Array β) := do\n if h_lt: start < stop then\n let next ← f init (as.uget start <| Nat.lt_of_lt_of_le h_lt h_stop)\n loop f next as (start + 1) stop h_stop (acc.push init)\n else\n pure <| acc.push init\n termination_by stop.toNat - min start.toNat stop.toNat\n decreasing_by\n have : start < (start + 1) := by grind only [USize.size_eq]\n grind only [Nat.min_def, USize.lt_iff_toNat_lt]\n\n/--\nFolds a monadic function over an array from the left, accumulating the partial results starting with\n`init`. The accumulated value is combined with the each element of the list in order, using `f`.\n\nThe optional parameters `start` and `stop` control the region of the array to be folded. Folding\nproceeds from `start` (inclusive) to `stop` (exclusive), so no folding occurs unless `start < stop`.\nBy default, the entire array is folded.\n\nExamples:\n```lean example\nexample [Monad m] (f : α → β → m α) :\n Array.scanlM f x₀ #[a, b, c] = (do\n let x₁ ← f x₀ a\n let x₂ ← f x₁ b\n let x₃ ← f x₂ c\n pure #[x₀, x₁, x₂, x₃])\n := by simp [scanlM, scanlM.loop]\n```\n\n```lean example\nexample [Monad m] (f : α → β → m α) :\n Array.scanlM f x₀ #[a, b, c] (start := 1) (stop := 3) = (do\n let x₁ ← f x₀ b\n let x₂ ← f x₁ c\n pure #[x₀, x₁, x₂])\n := by simp [scanlM, scanlM.loop]\n```\n-/\n@[implemented_by scanlMFast]\ndef scanlM [Monad m] (f : β → α → m β) (init : β) (as : Array α) (start := 0)\n (stop := as.size) : m (Array β) :=\n loop f init as (min start as.size) (min stop as.size) (Nat.min_le_right _ _) #[]\nwhere\n /-- auxiliary tail-recursive function for scanlM -/\n loop (f : β → α → m β) (init : β ) (as : Array α) (start stop : Nat)\n (h_stop : stop ≤ as.size) (acc : Array β) : m (Array β) := do\n if h_lt : start < stop then\n loop f (← f init as[start]) as (start + 1) stop h_stop (acc.push init)\n else\n pure <| acc.push init\n\nprivate theorem scanlM_loop_eq_scanlMFast_loop [Monad m]\n {f : β → α → m β} {init : β} {as : Array α} {h_size : as.SizeFitsUSize}\n {start stop : Nat} {h_start : start ≤ as.size}\n {h_stop : stop ≤ as.size} {acc : Array β} :\n scanlM.loop f init as start stop h_stop acc\n = scanlMFast.loop f init as (USize.ofNat start) (USize.ofNat stop)\n (by rw [USize.toNat_ofNat_of_le_of_lt h_size h_stop]; exact h_stop) acc := by\n generalize h_n : stop - start = n\n induction n using Nat.strongRecOn generalizing start acc init\n rename_i n ih\n rw [scanlM.loop, scanlMFast.loop]\n have h_stop_usize := USize.toNat_ofNat_of_le_of_lt h_size h_stop\n have h_start_usize := USize.toNat_ofNat_of_le_of_lt h_size h_start\n split\n case isTrue h_lt =>\n simp_all only [USize.toNat_ofNat', ↓reduceDIte, uget,\n show USize.ofNat start < USize.ofNat stop by simp_all [USize.lt_iff_toNat_lt]]\n apply bind_congr\n intro next\n have h_start_succ : USize.ofNat start + 1 = USize.ofNat (start + 1) := by\n simp_all only [← USize.toNat_inj, USize.toNat_add]\n grind only [USize.size_eq, USize.toNat_ofNat_of_le_of_lt]\n rw [h_start_succ]\n apply ih (stop - (start + 1)) <;> omega\n case isFalse h_nlt => grind [USize.lt_iff_toNat_lt]\n\n-- this theorem establishes that given the (unprovable) assumption that as.size < USize.size,\n-- the scanlMFast and scanlM are equivalent\n-- TODO (cmlsharp): prova an analogous theorem for scanrM\nprivate theorem scanlM_eq_scanlMFast [Monad m]\n {f : β → α → m β} {init : β} {as : Array α}\n {h_size : as.SizeFitsUSize} {start stop : Nat} :\n scanlM f init as start stop = scanlMFast f init as start stop := by\n unfold scanlM scanlMFast\n apply scanlM_loop_eq_scanlMFast_loop\n simp_all only [gt_iff_lt]\n apply Nat.min_le_right\n\n@[inline]\nprivate def scanrMFast [Monad m] (f : α → β → m β) (init : β) (as : Array α)\n (h_size : as.SizeFitsUSize) (start := as.size) (stop := 0) : m (Array β) :=\n let start := min start as.size\n let stop := min stop start\n loop f init as\n (start := USize.ofNat start) (stop := USize.ofNat stop)\n (h_start := by grind only [USize.size_eq, USize.ofNat_eq_iff_mod_eq_toNat, = Nat.min_def])\n (acc := Array.replicate (start - stop + 1) init)\n (by grind only [!Array.size_replicate, = Nat.min_def, USize.toNat_ofNat_of_le_of_lt])\nwhere\n @[specialize]\n loop (f : α → β → m β) (init : β) (as : Array α)\n (start stop : USize)\n (h_start : start.toNat ≤ as.size)\n (acc : Array β)\n (h_bound : start.toNat - stop.toNat < acc.size) :\n m (Array β) := do\n if h_gt : stop < start then\n let startM1 := start - 1\n have : startM1 < start := by grind only [!USize.sub_add_cancel, USize.lt_iff_le_and_ne,\n USize.lt_add_one, USize.le_zero_iff]\n have : startM1.toNat < as.size := Nat.lt_of_lt_of_le ‹_› ‹_›\n have : (startM1 - stop) < (start - stop) := by grind only\n [!USize.sub_add_cancel, USize.sub_right_inj, USize.add_comm, USize.lt_add_one,\n USize.add_assoc, USize.add_right_inj]\n let next ← f (as.uget startM1 ‹_›) init\n loop f next as\n (start := startM1)\n (stop := stop)\n (h_start := Nat.le_of_succ_le_succ (Nat.le_succ_of_le ‹_›))\n (acc := acc.uset (startM1 - stop) next\n (by grind only [USize.toNat_sub_of_le, USize.le_of_lt, USize.lt_iff_toNat_lt]))\n (h_bound :=\n (by grind only [USize.toNat_sub_of_le, = uset_eq_set, = size_set, USize.size_eq]))\n else\n pure acc\n termination_by start.toNat - stop.toNat\n decreasing_by\n grind only [USize.lt_iff_toNat_lt, USize.toNat_sub,\n USize.toNat_sub_of_le, USize.le_iff_toNat_le]\n\n@[inline]\nprivate unsafe def scanrMUnsafe [Monad m] (f : α → β → m β) (init : β) (as : Array α)\n (start := as.size) (stop := 0) : m (Array β) :=\n scanrMFast (h_size := as.unsafe_sizeFitsUSize) f init as (start := start) (stop := stop)\n\n/--\nFolds a monadic function over an array from the right, accumulating the partial results starting\nwith `init`. The accumulated value is combined with the each element of the list in order using `f`.\n\nThe optional parameters `start` and `stop` control the region of the array to be folded. Folding\nproceeds from `start` (exclusive) to `stop` (inclusive), so no folding occurs unless `start > stop`.\nBy default, the entire array is folded.\n\nExamples:\n```lean example\nexample [Monad m] (f : α → β → m β) :\n Array.scanrM f x₀ #[a, b, c] = (do\n let x₁ ← f c x₀\n let x₂ ← f b x₁\n let x₃ ← f a x₂\n pure #[x₃, x₂, x₁, x₀])\n := by simp [scanrM, scanrM.loop]\n```\n\n```lean example\nexample [Monad m] (f : α → β → m β) :\n Array.scanrM f x₀ #[a, b, c] (start := 3) (stop := 1) = (do\n let x₁ ← f c x₀\n let x₂ ← f b x₁\n pure #[x₂, x₁, x₀])\n := by simp [scanrM, scanrM.loop]\n```\n-/\n@[implemented_by scanrMUnsafe]\ndef scanrM [Monad m]\n (f : α → β → m β) (init : β) (as : Array α) (start := as.size) (stop := 0) : m (Array β) :=\n let start := min start as.size\n loop f init as start stop (Nat.min_le_right _ _) #[]\nwhere\n /-- auxiliary tail-recursive function for scanrM -/\n loop (f : α → β → m β) (init : β) (as : Array α)\n (start stop : Nat)\n (h_start : start ≤ as.size)\n (acc : Array β) :\n m (Array β) := do\n if h_gt : stop < start then\n let i := start - 1\n let next ← f as[i] init\n loop f next as i stop (by omega) (acc.push init)\n else\n pure <| acc.push init |>.reverse\n\n/--\nFold a function `f` over the array from the left, returning the array of partial results.\n```\nscanl (· + ·) 0 #[1, 2, 3] = #[0, 1, 3, 6]\n```\n-/\n@[inline]\ndef scanl (f : β → α → β) (init : β) (as : Array α) (start := 0) (stop := as.size) : Array β :=\n Id.run <| as.scanlM (pure <| f · ·) init start stop\n\n/--\nFold a function `f` over the array from the right, returning the array of partial results.\n```\nscanr (· + ·) 0 #[1, 2, 3] = #[6, 5, 3, 0]\n```\n-/\n@[inline]\ndef scanr (f : α → β → β) (init : β) (as : Array α) (start := as.size) (stop := 0) : Array β :=\n Id.run <| as.scanrM (pure <| f · ·) init start stop\n\nend Array\n\nnamespace Subarray\n\n/--\nFold a monadic function `f` over the subarray from the left, returning the list of partial results.\n-/\n@[inline]\ndef scanlM [Monad m] (f : β → α → m β) (init : β) (as : Subarray α) : m (Array β) :=\n as.array.scanlM f init (start := as.start) (stop := as.stop)\n\n/--\nFold a monadic function `f` over the subarray from the right, returning the list of partial results.\n-/\n@[inline]\ndef scanrM [Monad m] (f : α → β → m β) (init : β) (as : Subarray α) : m (Array β) :=\n as.array.scanrM f init (start := as.start) (stop := as.stop)\n\n/--\nFold a function `f` over the subarray from the left, returning the list of partial results.\n-/\n@[inline]\ndef scanl (f : β → α → β) (init : β) (as : Subarray α) : Array β :=\n as.array.scanl f init (start := as.start) (stop := as.stop)\n\n/--\nFold a function `f` over the subarray from the right, returning the list of partial results.\n-/\n@[inline]\ndef scanr (f : α → β → β) (init : β) (as : Subarray α) : Array β :=\n as.array.scanr f init (start := as.start) (stop := as.stop)\n\n/--\nCheck whether a subarray is empty.\n-/\n@[inline]\ndef isEmpty (as : Subarray α) : Bool :=\n as.start == as.stop\n\n/--\nCheck whether a subarray contains a given element.\n-/\n@[inline]\ndef contains [BEq α] (as : Subarray α) (a : α) : Bool :=\n as.any (· == a)\n\n/--\nRemove the first element of a subarray. Returns the element and the remaining\nsubarray, or `none` if the subarray is empty.\n-/\ndef popHead? (as : Subarray α) : Option (α × Subarray α) :=\n if h : as.start < as.stop\n then\n let head := as.array[as.start]'(Nat.lt_of_lt_of_le h as.stop_le_array_size)\n let tail :=\n ⟨{ as.internalRepresentation with\n start := as.start + 1\n start_le_stop := Nat.le_of_lt_succ $ Nat.succ_lt_succ h }⟩\n some (head, tail)\n else\n none\n\nend Subarray\n" }, { "path": "Batteries/Data/Array/Init/Lemmas.lean", "content": "/-\nCopyright (c) 2024 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\n\nAuthors: Kim Morrison\n-/\nmodule\n\n@[expose] public section\n\n/-!\nWhile this file is currently empty, it is intended as a home for any lemmas which are required for\ndefinitions in `Batteries.Data.Array.Basic`, but which are not provided by Lean.\n-/\n" }, { "path": "Batteries/Data/Array/Lemmas.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\n\nAuthors: Mario Carneiro, Gabriel Ebner\n-/\nmodule\n\npublic import Batteries.Data.List.Lemmas\n\n@[expose] public section\n\nnamespace Array\n\n@[deprecated forIn_toList (since := \"2025-07-01\")]\ntheorem forIn_eq_forIn_toList [Monad m]\n (as : Array α) (b : β) (f : α → β → m (ForInStep β)) :\n forIn as b f = forIn as.toList b f := by\n cases as\n simp\n\n/-! ### idxOf? -/\n\n@[grind =]\ntheorem idxOf?_toList [BEq α] {a : α} {l : Array α} :\n l.toList.idxOf? a = l.idxOf? a := by\n rcases l with ⟨l⟩\n simp\n\n/-! ### erase -/\n\n@[deprecated (since := \"2025-02-06\")] alias eraseP_toArray := List.eraseP_toArray\n@[deprecated (since := \"2025-02-06\")] alias erase_toArray := List.erase_toArray\n\n@[simp, grind =] theorem toList_erase [BEq α] (l : Array α) (a : α) :\n (l.erase a).toList = l.toList.erase a := by\n rcases l with ⟨l⟩\n simp\n\n@[simp] theorem size_eraseIdxIfInBounds (a : Array α) (i : Nat) :\n (a.eraseIdxIfInBounds i).size = if i < a.size then a.size-1 else a.size := by\n grind\n\ntheorem toList_drop (as: Array α) (n : Nat) :\n (as.drop n).toList = as.toList.drop n := by\n simp only [drop, toList_extract, size_eq_length_toList, List.drop_eq_extract]\n\n/-! ### set -/\n\ntheorem size_set! (a : Array α) (i v) : (a.set! i v).size = a.size := by simp\n\n/-! ### map -/\n\n/-! ### mem -/\n\n/-! ### insertAt -/\n\n@[deprecated (since := \"2025-02-06\")] alias getElem_insertIdx_lt := getElem_insertIdx_of_lt\n@[deprecated (since := \"2025-02-06\")] alias getElem_insertIdx_eq := getElem_insertIdx_self\n@[deprecated (since := \"2025-02-06\")] alias getElem_insertIdx_gt := getElem_insertIdx_of_gt\n\n/-! ### extract -/\n\n@[simp] theorem extract_empty_of_start_eq_stop {a : Array α} :\n a.extract i i = #[] := by grind\n\ntheorem extract_append_of_stop_le_size_left {a b : Array α} (h : j ≤ a.size) :\n (a ++ b).extract i j = a.extract i j := by grind\n\ntheorem extract_append_of_size_left_le_start {a b : Array α} (h : a.size ≤ i) :\n (a ++ b).extract i j = b.extract (i - a.size) (j - a.size) := by\n rw [extract_append]; grind\n\ntheorem extract_eq_of_size_le_stop {a : Array α} (h : a.size ≤ j) :\n a.extract i j = a.extract i := by grind\n" }, { "path": "Batteries/Data/Array/Match.lean", "content": "/-\nCopyright (c) 2023 F. G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: F. G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace Array\n\n/-- Prefix table for the Knuth-Morris-Pratt matching algorithm\n\n This is an array of the form `t = [(x₀,n₀), (x₁,n₁), (x₂, n₂), ...]` where for each `i`, `nᵢ` is\n the length of the longest proper prefix of `xs = [x₀,x₁,...,xᵢ]` which is also a suffix of `xs`.\n-/\nstructure PrefixTable (α : Type _) extends Array (α × Nat) where\n /-- Validity condition to help with termination proofs -/\n valid : (h : i < toArray.size) → toArray[i].2 ≤ i\n\ninstance : Inhabited (PrefixTable α) where\n default := ⟨#[], nofun⟩\n\n/-- Returns the size of the prefix table -/\nabbrev PrefixTable.size (t : PrefixTable α) := t.toArray.size\n\n/-- Transition function for the KMP matcher\n\n Assuming we have an input `xs` with a suffix that matches the pattern prefix `t.pattern[:len]`\n where `len : Fin (t.size+1)`. Then `xs.push x` has a suffix that matches the pattern prefix\n `t.pattern[:t.step x len]`. If `len` is as large as possible then `t.step x len` will also be\n as large as possible.\n-/\ndef PrefixTable.step [BEq α] (t : PrefixTable α) (x : α) : Fin (t.size+1) → Fin (t.size+1)\n | ⟨k, hk⟩ =>\n let cont := fun () =>\n match k with\n | 0 => ⟨0, Nat.zero_lt_succ _⟩\n | k + 1 =>\n have h2 : k < t.size := Nat.lt_of_succ_lt_succ hk\n let k' := t.toArray[k].2\n have hk' : k' < k + 1 := Nat.lt_succ_of_le (t.valid h2)\n step t x ⟨k', Nat.lt_trans hk' hk⟩\n if hsz : k < t.size then\n if x == t.toArray[k].1 then\n ⟨k+1, Nat.succ_lt_succ hsz⟩\n else cont ()\n else cont ()\ntermination_by k => k.val\n\n/-- Extend a prefix table by one element\n\n If `t` is the prefix table for `xs` then `t.extend x` is the prefix table for `xs.push x`.\n-/\ndef PrefixTable.extend [BEq α] (t : PrefixTable α) (x : α) : PrefixTable α where\n toArray := t.toArray.push (x, t.step x ⟨t.size, Nat.lt_succ_self _⟩)\n valid _ := by\n rw [Array.getElem_push]\n split\n · exact t.valid ..\n · next h => exact Nat.le_trans (Nat.lt_succ_iff.1 <| Fin.isLt ..) (Nat.not_lt.1 h)\n\n/-- Make prefix table from a pattern array -/\ndef mkPrefixTable [BEq α] (xs : Array α) : PrefixTable α := xs.foldl (·.extend) default\n\n/-- Make prefix table from a pattern stream -/\npartial def mkPrefixTableOfStream [BEq α] [Std.Stream σ α] (stream : σ) : PrefixTable α :=\n loop default stream\nwhere\n /-- Inner loop for `mkPrefixTableOfStream` -/\n loop (t : PrefixTable α) (stream : σ) :=\n match Stream.next? stream with\n | none => t\n | some (x, stream) => loop (t.extend x) stream\n\n/-- KMP matcher structure -/\nstructure Matcher (α) where\n /-- Prefix table for the pattern -/\n table : PrefixTable α\n /-- Current longest matching prefix -/\n state : Fin (table.size + 1) := 0\n\n/-- Make a KMP matcher for a given pattern array -/\ndef Matcher.ofArray [BEq α] (pat : Array α) : Matcher α where\n table := mkPrefixTable pat\n\n/-- Make a KMP matcher for a given a pattern stream -/\ndef Matcher.ofStream [BEq α] [Std.Stream σ α] (pat : σ) : Matcher α where\n table := mkPrefixTableOfStream pat\n\n/-- Find next match from a given stream\n\n Runs the stream until it reads a sequence that matches the sought pattern, then returns the stream\n state at that point and an updated matcher state.\n-/\npartial def Matcher.next? [BEq α] [Std.Stream σ α] (m : Matcher α) (stream : σ) :\n Option (σ × Matcher α) :=\n match Stream.next? stream with\n | none => none\n | some (x, stream) =>\n let state := m.table.step x m.state\n if state = m.table.size then\n some (stream, { m with state })\n else\n next? { m with state } stream\n\nnamespace Matcher\nopen Std Std.Iterators\n\n/-- Iterator transformer for KMP matcher. -/\nprotected structure Iterator (σ n α) [BEq α] (m : Matcher α) [Iterator σ n α] where\n /-- Inner iterator. -/\n inner : IterM (α := σ) n α\n /-- Matcher state. -/\n state : Fin (m.table.size + 1) := 0\n\n/-- Implementation datail for `Matcher.Iterator`. -/\ndef modifyStep [BEq α] (m : Matcher α) [Iterator σ n α]\n (it : IterM (α := m.Iterator σ n α) n σ) :\n it.internalState.inner.Step (α := σ) → IterStep (IterM (α := m.Iterator σ n α) n σ) σ\n | .done _ => .done\n | .skip it' _ => .skip ⟨{it.internalState with inner := it'}⟩\n | .yield it' x _ =>\n let state := m.table.step x m.state\n if state = m.table.size then\n .yield ⟨{inner := it', state := state}⟩ it'.internalState\n else\n .skip ⟨{inner := it', state := state}⟩\n\ninstance [Monad n] [BEq α] (m : Matcher α) [Iterator σ n α] :\n Iterator (m.Iterator σ n α) n σ where\n IsPlausibleStep it step := ∃ step', m.modifyStep it step' = step\n step it := it.internalState.inner.step >>=\n fun step => pure (.deflate ⟨m.modifyStep _ _, step.inflate, rfl⟩)\n\nprivate def finitenessRelation [Monad n] [BEq α] (m : Matcher α) [Iterator σ n α] [Finite σ n] :\n FinitenessRelation (m.Iterator σ n α) n where\n Rel := InvImage IterM.IsPlausibleSuccessorOf fun it => it.internalState.inner\n wf := InvImage.wf _ Finite.wf\n subrelation {it it'} h := by\n obtain ⟨_, hsucc, step, rfl⟩ := h\n simp only [IterM.Step] at step\n cases step with simp only [IterStep.successor, modifyStep, reduceCtorEq] at hsucc\n | skip =>\n cases hsucc\n apply IterM.isPlausibleSuccessorOf_of_skip\n assumption\n | yield =>\n split at hsucc\n · next heq =>\n cases hsucc\n split at heq\n · cases heq\n apply IterM.isPlausibleSuccessorOf_of_yield\n assumption\n · contradiction\n · next heq =>\n cases hsucc\n split at heq\n · contradiction\n · cases heq\n apply IterM.isPlausibleSuccessorOf_of_yield\n assumption\n · contradiction\n\ninstance [Monad n] [BEq α] (m : Matcher α) [Iterator σ n α] [inst : Finite σ n] :\n Finite (m.Iterator σ n α) n (β := σ) := .of_finitenessRelation m.finitenessRelation\n\nend Matcher\n\nend Array\n" }, { "path": "Batteries/Data/Array/Merge.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\n@[expose] public section\n\nnamespace Array\n\n/--\n`O(|xs| + |ys|)`. Merge arrays `xs` and `ys`. If the arrays are sorted according to `lt`, then the\nresult is sorted as well. If two (or more) elements are equal according to `lt`, they are preserved.\n-/\ndef merge (lt : α → α → Bool) (xs ys : Array α) : Array α :=\n go (Array.mkEmpty (xs.size + ys.size)) 0 0\nwhere\n /-- Auxiliary definition for `merge`. -/\n go (acc : Array α) (i j : Nat) : Array α :=\n if hi : i ≥ xs.size then\n acc ++ ys[j:]\n else if hj : j ≥ ys.size then\n acc ++ xs[i:]\n else\n let x := xs[i]\n let y := ys[j]\n if lt x y then go (acc.push x) (i + 1) j else go (acc.push y) i (j + 1)\n termination_by xs.size + ys.size - (i + j)\n\n-- We name `ord` so it can be provided as a named argument.\nset_option linter.unusedVariables.funArgs false in\n/--\n`O(|xs| + |ys|)`. Merge arrays `xs` and `ys`, which must be sorted according to `compare` and must\nnot contain duplicates. Equal elements are merged using `merge`. If `merge` respects the order\n(i.e. for all `x`, `y`, `y'`, `z`, if `x < y < z` and `x < y' < z` then `x < merge y y' < z`)\nthen the resulting array is again sorted.\n-/\ndef mergeDedupWith [ord : Ord α] (xs ys : Array α) (merge : α → α → α) : Array α :=\n go (Array.mkEmpty (xs.size + ys.size)) 0 0\nwhere\n /-- Auxiliary definition for `mergeDedupWith`. -/\n go (acc : Array α) (i j : Nat) : Array α :=\n if hi : i ≥ xs.size then\n acc ++ ys[j:]\n else if hj : j ≥ ys.size then\n acc ++ xs[i:]\n else\n let x := xs[i]\n let y := ys[j]\n match compare x y with\n | .lt => go (acc.push x) (i + 1) j\n | .gt => go (acc.push y) i (j + 1)\n | .eq => go (acc.push (merge x y)) (i + 1) (j + 1)\n termination_by xs.size + ys.size - (i + j)\n\n/--\n`O(|xs| + |ys|)`. Merge arrays `xs` and `ys`, which must be sorted according to `compare` and must\nnot contain duplicates. If an element appears in both `xs` and `ys`, only one copy is kept.\n-/\n@[inline] def mergeDedup [ord : Ord α] (xs ys : Array α) : Array α :=\n mergeDedupWith (ord := ord) xs ys fun x _ => x\n\nset_option linter.unusedVariables false in\n/--\n`O(|xs| * |ys|)`. Merge `xs` and `ys`, which do not need to be sorted. Elements which occur in\nboth `xs` and `ys` are only added once. If `xs` and `ys` do not contain duplicates, then neither\ndoes the result.\n-/\ndef mergeUnsortedDedup [eq : BEq α] (xs ys : Array α) : Array α :=\n -- Ideally we would check whether `xs` or `ys` have spare capacity, to prevent\n -- copying if possible. But Lean arrays don't expose their capacity.\n if xs.size < ys.size then go ys xs else go xs ys\nwhere\n /-- Auxiliary definition for `mergeUnsortedDedup`. -/\n @[inline] go (xs ys : Array α) :=\n let xsSize := xs.size\n ys.foldl (init := xs) fun xs y =>\n if xs.any (· == y) (stop := xsSize) then xs else xs.push y\n\n-- We name `eq` so it can be provided as a named argument.\nset_option linter.unusedVariables.funArgs false in\n/--\n`O(|xs|)`. Replace each run `[x₁, ⋯, xₙ]` of equal elements in `xs` with\n`f ⋯ (f (f x₁ x₂) x₃) ⋯ xₙ`.\n-/\ndef mergeAdjacentDups [eq : BEq α] (f : α → α → α) (xs : Array α) : Array α :=\n if h : 0 < xs.size then go (mkEmpty xs.size) 1 xs[0] else xs\nwhere\n /-- Auxiliary definition for `mergeAdjacentDups`. -/\n go (acc : Array α) (i : Nat) (hd : α) :=\n if h : i < xs.size then\n let x := xs[i]\n if x == hd then go acc (i + 1) (f hd x) else go (acc.push hd) (i + 1) x\n else\n acc.push hd\n termination_by xs.size - i\n\n/--\n`O(|xs|)`. Deduplicate a sorted array. The array must be sorted with to an order which agrees with\n`==`, i.e. whenever `x == y` then `compare x y == .eq`.\n-/\ndef dedupSorted [eq : BEq α] (xs : Array α) : Array α :=\n xs.mergeAdjacentDups (eq := eq) fun x _ => x\n\n/-- `O(|xs| log |xs|)`. Sort and deduplicate an array. -/\ndef sortDedup [ord : Ord α] (xs : Array α) : Array α :=\n have := ord.toBEq\n dedupSorted <| xs.qsort (compare · · |>.isLT)\n\nend Array\n" }, { "path": "Batteries/Data/Array/Monadic.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\n\nAuthors: Mario Carneiro, Gabriel Ebner\n-/\nmodule\n\npublic import Batteries.Classes.SatisfiesM\npublic import Batteries.Util.ProofWanted\nimport all Init.Data.Array.Basic -- for unfolding `modifyM`\n\n@[expose] public section\n\n/-!\n# Results about monadic operations on `Array`, in terms of `SatisfiesM`.\n\nThe pure versions of these theorems are proved in `Batteries.Data.Array.Lemmas` directly,\nin order to minimize dependence on `SatisfiesM`.\n-/\n\nnamespace Array\n\ntheorem SatisfiesM_foldlM [Monad m] [LawfulMonad m] {as : Array α} {init : β}\n {motive : Nat → β → Prop} {f : β → α → m β} (h0 : motive 0 init)\n (hf : ∀ i : Fin as.size, ∀ b, motive i.1 b → SatisfiesM (motive (i.1 + 1)) (f b as[i])) :\n SatisfiesM (motive as.size) (as.foldlM f init) := by\n let rec go {i j b} (h₁ : j ≤ as.size) (h₂ : as.size ≤ i + j) (H : motive j b) :\n SatisfiesM (motive as.size) (foldlM.loop f as as.size (Nat.le_refl _) i j b) := by\n unfold foldlM.loop; split\n · next hj =>\n split\n · cases Nat.not_le_of_gt (by simp [hj]) h₂\n · exact (hf ⟨j, hj⟩ b H).bind fun _ => go hj (by rwa [Nat.succ_add] at h₂)\n · next hj => exact Nat.le_antisymm h₁ (Nat.ge_of_not_lt hj) ▸ .pure H\n simp [foldlM]; exact go (Nat.zero_le _) (Nat.le_refl _) h0\n\ntheorem SatisfiesM_mapM [Monad m] [LawfulMonad m] {as : Array α} {f : α → m β}\n {motive : Nat → Prop} {p : Fin as.size → β → Prop} (h0 : motive 0)\n (hs : ∀ i, motive i.1 → SatisfiesM (p i · ∧ motive (i + 1)) (f as[i])) :\n SatisfiesM\n (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i])\n (Array.mapM f as) := by\n rw [mapM_eq_foldlM]\n refine SatisfiesM_foldlM (m := m) (β := Array β)\n (motive := fun i arr => motive i ∧ arr.size = i ∧ ∀ i h2, p i (arr[i.1]'h2)) ?z ?s\n |>.imp fun ⟨h₁, eq, h₂⟩ => ⟨h₁, eq, fun _ _ => h₂ ..⟩\n · case z => exact ⟨h0, rfl, nofun⟩\n · case s =>\n intro ⟨i, hi⟩ arr ⟨ih₁, eq, ih₂⟩\n refine (hs _ ih₁).map fun ⟨h₁, h₂⟩ => ⟨h₂, by simp [eq], fun j hj => ?_⟩\n simp [getElem_push] at hj ⊢; split; {apply ih₂}\n cases j; cases (Nat.le_or_eq_of_le_succ hj).resolve_left ‹_›; cases eq; exact h₁\n\ntheorem SatisfiesM_mapM' [Monad m] [LawfulMonad m] {as : Array α} {f : α → m β}\n {p : Fin as.size → β → Prop}\n (hs : ∀ i, SatisfiesM (p i) (f as[i])) :\n SatisfiesM\n (fun arr => ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i])\n (Array.mapM f as) :=\n (SatisfiesM_mapM (motive := fun _ => True) trivial (fun _ h => (hs _).imp (⟨·, h⟩))).imp (·.2)\n\ntheorem size_mapM [Monad m] [LawfulMonad m] (f : α → m β) (as : Array α) :\n SatisfiesM (fun arr => arr.size = as.size) (Array.mapM f as) :=\n (SatisfiesM_mapM' (fun _ => .trivial)).imp (·.1)\n\ntheorem SatisfiesM_anyM [Monad m] [LawfulMonad m] {p : α → m Bool} {as : Array α}\n (hstart : start ≤ min stop as.size) (tru : Prop) (fal : Nat → Prop) (h0 : fal start)\n (hp : ∀ i : Fin as.size, i.1 < stop → fal i.1 →\n SatisfiesM (bif · then tru else fal (i + 1)) (p as[i])) :\n SatisfiesM\n (fun res => bif res then tru else fal (min stop as.size))\n (anyM p as start stop) := by\n let rec go {stop j} (hj' : j ≤ stop) (hstop : stop ≤ as.size) (h0 : fal j)\n (hp : ∀ i : Fin as.size, i.1 < stop → fal i.1 →\n SatisfiesM (bif · then tru else fal (i + 1)) (p as[i])) :\n SatisfiesM\n (fun res => bif res then tru else fal stop)\n (anyM.loop p as stop hstop j) := by\n unfold anyM.loop; split\n · next hj =>\n exact (hp ⟨j, Nat.lt_of_lt_of_le hj hstop⟩ hj h0).bind fun\n | true, h => .pure h\n | false, h => go hj hstop h hp\n · next hj => exact .pure <| Nat.le_antisymm hj' (Nat.ge_of_not_lt hj) ▸ h0\n termination_by stop - j\n simp only [Array.anyM_eq_anyM_loop]\n exact go hstart _ h0 fun i hi => hp i <| Nat.lt_of_lt_of_le hi <| Nat.min_le_left ..\n\ntheorem SatisfiesM_anyM_iff_exists [Monad m] [LawfulMonad m]\n {p : α → m Bool} {as : Array α} {q : Fin as.size → Prop}\n (hp : ∀ i : Fin as.size, start ≤ i.1 → i.1 < stop → SatisfiesM (· = true ↔ q i) (p as[i])) :\n SatisfiesM\n (fun res => res = true ↔ ∃ i : Fin as.size, start ≤ i.1 ∧ i.1 < stop ∧ q i)\n (anyM p as start stop) := by\n cases Nat.le_total start (min stop as.size) with\n | inl hstart =>\n refine (SatisfiesM_anyM hstart\n (fal := fun j => start ≤ j ∧ ¬ ∃ i : Fin as.size, start ≤ i.1 ∧ i.1 < j ∧ q i)\n (tru := ∃ i : Fin as.size, start ≤ i.1 ∧ i.1 < stop ∧ q i) ?_ ?_).imp ?_\n · exact ⟨Nat.le_refl _, fun ⟨i, h₁, h₂, _⟩ => (Nat.not_le_of_gt h₂ h₁).elim⟩\n · refine fun i h₂ ⟨h₁, h₃⟩ => (hp _ h₁ h₂).imp fun hq => ?_\n unfold cond; split <;> simp at hq\n · exact ⟨_, h₁, h₂, hq⟩\n · refine ⟨Nat.le_succ_of_le h₁, h₃.imp fun ⟨j, h₃, h₄, h₅⟩ => ⟨j, h₃, ?_, h₅⟩⟩\n refine Nat.lt_of_le_of_ne (Nat.le_of_lt_succ h₄) fun e => hq (Fin.eq_of_val_eq e ▸ h₅)\n · intro\n | true, h => simp only [true_iff]; exact h\n | false, h =>\n simp only [false_iff, reduceCtorEq]\n exact h.2.imp fun ⟨j, h₁, h₂, hq⟩ => ⟨j, h₁, Nat.lt_min.2 ⟨h₂, j.2⟩, hq⟩\n | inr hstart =>\n rw [anyM_stop_le_start (h := hstart)]\n refine .pure ?_; simp; intro j h₁ h₂\n cases Nat.not_lt.2 (Nat.le_trans hstart h₁) (Nat.lt_min.2 ⟨h₂, j.2⟩)\n\ntheorem SatisfiesM_foldrM [Monad m] [LawfulMonad m]\n {as : Array α} {init : β} {motive : Nat → β → Prop} {f : α → β → m β}\n (h0 : motive as.size init)\n (hf : ∀ i : Fin as.size, ∀ b, motive (i.1 + 1) b → SatisfiesM (motive i.1) (f as[i] b)) :\n SatisfiesM (motive 0) (as.foldrM f init) := by\n let rec go {i b} (hi : i ≤ as.size) (H : motive i b) :\n SatisfiesM (motive 0) (foldrM.fold f as 0 i hi b) := by\n unfold foldrM.fold; simp; split\n · next hi => exact .pure (hi ▸ H)\n · next hi =>\n split; {simp at hi}\n · next i hi' =>\n exact (hf ⟨i, hi'⟩ b H).bind fun _ => go _\n simp [foldrM]; split; {exact go _ h0}\n · next h => exact .pure (Nat.eq_zero_of_not_pos h ▸ h0)\n\ntheorem SatisfiesM_mapFinIdxM [Monad m] [LawfulMonad m]\n {as : Array α} {f : (i : Nat) → α → i < as.size → m β} {motive : Nat → Prop}\n {p : (i : Nat) → β → i < as.size → Prop}\n (h0 : motive 0) (hs : ∀ i h, motive i → SatisfiesM (p i · h ∧ motive (i + 1)) (f i as[i] h)) :\n SatisfiesM\n (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p i arr[i] h)\n (Array.mapFinIdxM as f) := by\n let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : ∀ i h h', p i bs[i] h) (hm : motive j) :\n SatisfiesM\n (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p i arr[i] h)\n (Array.mapFinIdxM.map as f i j h bs) := by\n induction i generalizing j bs with simp [mapFinIdxM.map]\n | zero =>\n have := (Nat.zero_add _).symm.trans h\n exact .pure ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩\n | succ i ih =>\n refine (hs _ _ (by exact hm)).bind fun b hb => ih (by simp [h₁]) (fun i hi hi' => ?_) hb.2\n simp at hi'; simp [getElem_push]; split\n · next h => exact h₂ _ _ h\n · next h => cases h₁.symm ▸ (Nat.le_or_eq_of_le_succ hi').resolve_left h; exact hb.1\n simp [mapFinIdxM]; exact go rfl nofun h0\n\ntheorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] {as : Array α} {f : Nat → α → m β}\n {p : (i : Nat) → β → i < as.size → Prop} {motive : Nat → Prop}\n (h0 : motive 0) (hs : ∀ i h, motive i → SatisfiesM (p i · h ∧ motive (i + 1)) (f i as[i])) :\n SatisfiesM\n (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p i arr[i] h)\n (as.mapIdxM f) :=\n SatisfiesM_mapFinIdxM h0 hs\n\ntheorem size_mapFinIdxM [Monad m] [LawfulMonad m]\n (as : Array α) (f : (i : Nat) → α → i < as.size → m β) :\n SatisfiesM (fun arr => arr.size = as.size) (Array.mapFinIdxM as f) :=\n (SatisfiesM_mapFinIdxM (motive := fun _ => True) trivial\n (fun _ _ _ => .of_true fun _ => ⟨trivial, trivial⟩)).imp (·.2.1)\n\ntheorem size_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Nat → α → m β) :\n SatisfiesM (fun arr => arr.size = as.size) (Array.mapIdxM f as) :=\n size_mapFinIdxM _ _\n\ntheorem size_modifyM [Monad m] [LawfulMonad m] (as : Array α) (i : Nat) (f : α → m α) :\n SatisfiesM (·.size = as.size) (as.modifyM i f) := by\n unfold modifyM; split\n · exact .bind_pre <| .of_true fun _ => .pure <| by simp only [size_set]\n · exact .pure rfl\n\nend Array\n" }, { "path": "Batteries/Data/Array/Pairwise.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\nnamespace Array\n\n/--\n`Pairwise R as` means that all the elements of the array `as` are `R`-related to all elements with\nlarger indices.\n\n`Pairwise R #[1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3`\n\nFor example `as.Pairwise (· ≠ ·)` asserts that `as` has no duplicates, `as.Pairwise (· < ·)` asserts\nthat `as` is strictly sorted and `as.Pairwise (· ≤ ·)` asserts that `as` is weakly sorted.\n-/\ndef Pairwise (R : α → α → Prop) (as : Array α) : Prop := as.toList.Pairwise R\n\ntheorem pairwise_iff_getElem {as : Array α} : as.Pairwise R ↔\n ∀ (i j : Nat) (_ : i < as.size) (_ : j < as.size), i < j → R as[i] as[j] := by\n unfold Pairwise; simp [List.pairwise_iff_getElem, length_toList]\n\n@[deprecated (since := \"2025-02-19\")] alias pairwise_iff_get := pairwise_iff_getElem\n\ninstance (R : α → α → Prop) [DecidableRel R] (as) : Decidable (Pairwise R as) :=\n have : (∀ (j : Fin as.size) (i : Fin j.val), R as[i.val] (as[j.val])) ↔ Pairwise R as := by\n rw [pairwise_iff_getElem]\n constructor\n · intro h i j _ hj hlt; exact h ⟨j, hj⟩ ⟨i, hlt⟩\n · intro h ⟨j, hj⟩ ⟨i, hlt⟩; exact h i j (Nat.lt_trans hlt hj) hj hlt\n decidable_of_iff _ this\n\n@[grind ←]\ntheorem pairwise_empty : #[].Pairwise R := by\n unfold Pairwise; exact List.Pairwise.nil\n\n@[grind ←]\ntheorem pairwise_singleton (R : α → α → Prop) (a) : #[a].Pairwise R := by\n unfold Pairwise; exact List.pairwise_singleton ..\n\n@[grind =]\ntheorem pairwise_pair : #[a, b].Pairwise R ↔ R a b := by\n unfold Pairwise; exact List.pairwise_pair\n\n@[grind =]\ntheorem pairwise_append {as bs : Array α} :\n (as ++ bs).Pairwise R ↔ as.Pairwise R ∧ bs.Pairwise R ∧ (∀ x ∈ as, ∀ y ∈ bs, R x y) := by\n unfold Pairwise; simp [← mem_toList_iff, toList_append, ← List.pairwise_append]\n\n@[grind =]\ntheorem pairwise_push {as : Array α} :\n (as.push a).Pairwise R ↔ as.Pairwise R ∧ (∀ x ∈ as, R x a) := by\n unfold Pairwise\n simp [← mem_toList_iff, toList_push, List.pairwise_append]\n\n@[grind ←]\ntheorem pairwise_extract {as : Array α} (h : as.Pairwise R) (start stop) :\n (as.extract start stop).Pairwise R := by\n simp only [pairwise_iff_getElem, getElem_extract, size_extract] at h ⊢\n intro _ _ _ _ hlt\n apply h\n exact Nat.add_lt_add_left hlt start\n" }, { "path": "Batteries/Data/Array/Scan.lean", "content": "/-\nCopyright (c) 2026 Chad Sharp. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Chad Sharp\n-/\nmodule\n\npublic import Batteries.Data.Array.Basic\npublic import Batteries.Data.Array.Lemmas\nimport Batteries.Data.List.Scan\nimport Batteries.Data.List.Lemmas\n\npublic section\n\n/-!\n# Array\n\nProve basic results about `Array.scanl`, `Array.scanr`, `Array.scanlM` and `Array.scanrM`.\n-/\nnamespace Array\n\nset_option backward.isDefEq.respectTransparency false in\ntheorem scanlM.loop_toList [Monad m] [LawfulMonad m]\n {f : β → α → m β} {stop : Nat} (h : stop ≤ as.size) :\n Array.toList <$> scanlM.loop f init as start stop h acc =\n return acc.toList\n ++ (← as.toList.drop start\n |>.take (stop - start)\n |>.scanlM f init) := by\n induction h_ind : stop - start generalizing start acc init with\n | zero =>\n unfold scanlM.loop\n simp [show ¬(start < stop) by omega, ← Array.toList_push]\n | succ n ih =>\n unfold scanlM.loop\n rw [List.drop_eq_getElem_cons (by simp; omega)]\n simp [show start < stop by omega, show stop - (start + 1) = n by omega, ih]\n\ntheorem scanlM_eq_scanlM_toList [Monad m] [LawfulMonad m] {f : β → α → m β} {as : Array α} :\n as.scanlM f init = List.toArray <$> as.toList.scanlM f init := by\n apply map_toList_inj.mp\n simp [scanlM, Array.scanlM.loop_toList, ←Array.length_toList]\n\n@[simp, grind =]\ntheorem toList_scanlM [Monad m] [LawfulMonad m] {f : β → α → m β} {as : Array α} :\n toList <$> as.scanlM f init = as.toList.scanlM f init := by\n simp [scanlM_eq_scanlM_toList]\n\ntheorem scanrM.loop_toList [Monad m] [LawfulMonad m] {f : α → β → m β}\n {start : Nat} {h : start ≤ as.size} :\n Array.toList <$> scanrM.loop f init as start stop h acc =\n return (← as.toList.drop stop\n |>.take (start - stop)\n |>.scanrM f init)\n ++ acc.toList.reverse := by\n induction h_ind : start - stop generalizing stop acc init start with\n | zero =>\n simp [scanrM.loop, show ¬ stop < start by omega]\n | succ n ih =>\n unfold scanrM.loop\n simp_all only [bind_pure_comp, show stop < start by omega, ↓reduceDIte]\n simp only [map_bind]\n conv =>\n lhs\n arg 2\n ext a\n rw [ih (start := start - 1) (stop := stop) (acc := acc.push init) (by omega)]\n simp only [List.scanrM_eq_scanlM_reverse]\n have h_take := List.take_succ_drop (l := as.toList) (n := n) (stop := stop) (by simp; omega)\n simp only [h_take, List.reverse_append, List.reverse_singleton, List.singleton_append,\n List.scanlM_cons, map_bind, show stop + n = start - 1 by omega]\n apply bind_congr\n simp_all\n\ntheorem scanrM_eq_scanrM_toList [Monad m] [LawfulMonad m] {f : α → β → m β} {as : Array α} :\n as.scanrM f init = List.toArray <$> as.toList.scanrM f init := by\n apply map_toList_inj.mp\n simp [scanrM, Array.scanrM.loop_toList, ← Array.length_toList]\n\n@[simp, grind =]\ntheorem toList_scanrM [Monad m] [LawfulMonad m] {f : α → β → m β} {as : Array α} :\n toList <$> as.scanrM f init = as.toList.scanrM f init := by\n simp [scanrM_eq_scanrM_toList]\n\ntheorem scanlM_extract [Monad m] [LawfulMonad m] {f : β → α → m β} {as : Array α} :\n (as.extract start stop).scanlM f init = as.scanlM f init start stop := by\n rw (occs := [2]) [scanlM]\n apply map_toList_inj.mp\n rw [scanlM.loop_toList, scanlM_eq_scanlM_toList, bind_pure_comp]\n simp_all only [toList_extract, Functor.map_map, id_map', List.nil_append_fun, id_map]\n grind [List.take_eq_take_iff, List.drop_eq_drop_iff]\n\ntheorem scanrM_extract [Monad m] [LawfulMonad m] {f : α → β → m β} {as : Array α} :\n (as.extract stop start).scanrM f init = as.scanrM f init start stop := by\n rw (occs := [2]) [scanrM]\n apply map_toList_inj.mp\n rw [scanrM.loop_toList, scanrM_eq_scanrM_toList, bind_pure_comp]\n simp_all only [toList_extract, Functor.map_map, id_map', List.reverse_nil, List.append_nil]\n grind [List.take_eq_take_iff, List.drop_eq_drop_iff]\n\n@[simp, grind =]\ntheorem scanlM_empty [Monad m] {f : β → α → m β} {start stop : Nat} :\n #[].scanlM f init start stop = pure #[init] := by\n simp [scanlM, scanlM.loop]\n\n@[grind =]\ntheorem scanrM_empty [Monad m] {f : α → β → m β} {start stop : Nat} :\n #[].scanrM f init start stop = pure #[init] := by\n simp [scanrM, scanrM.loop]\n\ntheorem scanlM_reverse [Monad m] [LawfulMonad m] {f : β → α → m β} {as : Array α} :\n as.reverse.scanlM f init = Array.reverse <$> (as.scanrM (flip f) init) := by\n simp only [scanlM_eq_scanlM_toList, scanrM_eq_scanrM_toList]\n simp\n\n@[simp]\ntheorem scanlM_pure [Monad m] [LawfulMonad m] {f : β → α → β} {as : Array α} :\n as.scanlM (m := m) (pure <| f · ·) init = pure (as.scanl f init) := by\n simp only [scanl, scanlM_eq_scanlM_toList, scanlM_eq_scanlM_toList, List.scanlM_pure, map_pure]\n rfl\n\n@[simp]\ntheorem scanrM_pure [Monad m] [LawfulMonad m] {f : α → β → β} {as : Array α} :\n as.scanrM (m := m) (pure <| f · ·) init = pure (as.scanr f init) := by\n simp only [scanr, scanrM_eq_scanrM_toList, scanrM_eq_scanrM_toList, List.scanrM_pure, map_pure]\n rfl\n\n@[simp]\ntheorem idRun_scanlM {f : β → α → Id β} {as : Array α} :\n (as.scanlM f init).run = as.scanl (f · · |>.run) init :=\n scanlM_pure\n\n@[simp]\ntheorem idRun_scanrM {f : α → β → Id β} {as : Array α} :\n (as.scanrM f init).run = as.scanr (f · · |>.run) init :=\n scanrM_pure\n\n@[grind =]\ntheorem scanlM_map [Monad m] [LawfulMonad m] {f : α₁ → α₂ } {g: β → α₂ → m β} {as : Array α₁} :\n (as.map f).scanlM g init = as.scanlM (g · <| f ·) init := by\n simp only [scanlM_eq_scanlM_toList, toList_map, List.scanlM_map]\n\n@[grind =]\ntheorem scanrM_map [Monad m] [LawfulMonad m] {f : α₁ → α₂ } {g: α₂ → β → m β} {as : Array α₁} :\n (as.map f).scanrM g init = as.scanrM (fun a b => g (f a) b) init := by\n simp only [scanrM_eq_scanrM_toList, toList_map, List.scanrM_map]\n\n/-- ### Array.scanl -/\n\ntheorem scanl_eq_scanlM {f : β → α → β} {as: Array α} :\n as.scanl f init = (as.scanlM (m := Id) (pure <| f · ·) init).run := by\n simp\n\ntheorem scanl_eq_scanl_toList {f: β → α → β} {as : Array α} :\n as.scanl f init = (as.toList.scanl f init).toArray := by\n simp only [scanl_eq_scanlM, scanlM_eq_scanlM_toList]\n simp [List.idRun_scanlM]\n\n@[simp, grind =]\ntheorem toList_scanl {f : β → α → β} {as: Array α} :\n (as.scanl f init).toList = as.toList.scanl f init := by\n rw [scanl_eq_scanl_toList]\n\n@[simp]\ntheorem size_scanl {f : β → α → β} (init : β) (as : Array α) :\n size (scanl f init as) = as.size + 1 := by\n grind [size_eq_length_toList]\n\ngrind_pattern size_scanl => scanl f init as\n\n@[grind =]\ntheorem scanl_empty {f : β → α → β} (init : β) :\n scanl f init #[] = #[init] := by\n apply toList_inj.mp\n grind\n\n@[grind =]\ntheorem scanl_singleton {f : β → α → β} :\n scanl f init #[a] = #[init, f init a] := by\n apply toList_inj.mp\n grind\n\n@[simp]\ntheorem scanl_ne_empty {f : β → α → β} : scanl f init as ≠ #[] := by grind\n\n@[simp]\ntheorem scanl_eq_singleton_iff {f : β → α → β} (c : β) :\n scanl f init as = #[c] ↔ c = init ∧ as = #[] := by\n grind\n\n@[simp, grind =]\ntheorem getElem_scanl {f : β → α → β} {as: Array α} (h : i < (as.scanl f init).size) :\n (as.scanl f init)[i]'h = foldl f init (as.take i) := by\n simp only [scanl_eq_scanl_toList, ← foldl_toList]\n simp\n\n@[grind =]\ntheorem getElem?_scanl {f : β → α → β} :\n (scanl f a l)[i]? = if i ≤ l.size then some (foldl f a (l.take i)) else none := by\n grind\n\n@[grind =]\ntheorem take_scanl {f : β → α → β} (init : β) (as : Array α) :\n (scanl f init as).take (i + 1) = scanl f init (as.take i) := by\n grind\n\ntheorem getElem?_scanl_zero {f : β → α → β} : (scanl f init as)[0]? = some init := by simp\n\ntheorem getElem_scanl_zero {f : β → α → β} : (scanl f init as)[0] = init := by simp\n\ntheorem getElem?_succ_scanl {f : β → α → β} :\n (scanl f init as)[i + 1]? = (scanl f init as)[i]?.bind fun x => as[i]?.map fun y => f x y := by\n simp [scanl_eq_scanl_toList, List.getElem?_succ_scanl]\n\ntheorem getElem_succ_scanl {f : β → α → β} (h : i + 1 < (scanl f b as).size) :\n (as.scanl f b)[i + 1] = f (as.scanl f b)[i] (as[i]'(by grind)) := by\n simp only [scanl_eq_scanl_toList, List.getElem_toArray]\n grind [List.getElem_succ_scanl]\n\n@[grind =]\ntheorem scanl_push {f : β → α → β} {init: β} {a : α} {as : Array α} :\n (as.push a).scanl f init = (as.scanl f init).push (f (as.foldl f init) a) := by\n simp only [scanl_eq_scanl_toList]\n simp [List.scanl_append]\n\n@[grind =]\ntheorem scanl_map {f : γ → β → γ} {g : α → β} (init : γ) (as : Array α) :\n scanl f init (as.map g) = scanl (f · <| g ·) init as := by\n simp only [scanl_eq_scanl_toList, toList_map, List.scanl_map]\n\n@[simp, grind =]\ntheorem back_scanl {f : β → α → β} {as : Array α} :\n (as.scanl f init).back = as.foldl f init := by\n simp [Array.back_eq_getElem]\n\ntheorem back_scanl? {f : β → α → β} {as : Array α} :\n (as.scanl f init).back? = some (as.foldl f init) := by\n simp [Array.back?_eq_getElem?]\n\n/-! ### Array.scanr -/\n\ntheorem scanr_eq_scanrM {f : α → β → β} {as : Array α} :\n as.scanr f init = (as.scanrM (m := Id) (pure <| f · ·) init).run := by\n simp\n\ntheorem scanr_eq_scanr_toList {f : α → β → β} {as : Array α} :\n as.scanr f init = (as.toList.scanr f init).toArray := by\n simp only [scanr_eq_scanrM, scanrM_eq_scanrM_toList]\n simp [List.idRun_scanrM]\n\n@[simp, grind =]\ntheorem toList_scanr {f : α → β → β} {as : Array α} :\n (as.scanr f init).toList = as.toList.scanr f init := by\n rw [scanr_eq_scanr_toList]\n\n@[simp]\ntheorem size_scanr {f : α → β → β} (init : β) (as : Array α) :\n size (as.scanr f init) = as.size + 1 := by\n grind [size_eq_length_toList]\n\ngrind_pattern size_scanr => scanr f init as\n\n@[grind =]\ntheorem scanr_empty {f : α → β → β} {init: β} :\n #[].scanr f init = #[init] := by\n apply toList_inj.mp\n grind\n\n@[simp]\ntheorem scanr_ne_empty {f : α → β → β} {as : Array α} :\n as.scanr f init ≠ #[] := by\n grind\n\n@[grind =]\ntheorem scanr_push {f : α → β → β} {as : Array α} :\n (as.push a).scanr f init = (as.scanr f (f a init)).push init := by\n apply toList_inj.mp\n grind\n\n@[simp, grind =]\ntheorem back_scanr {f : α → β → β} {as : Array α} : (as.scanr f init).back = init := by\n simp [←getLast_toList, List.getLast_scanr]\n\ntheorem back?_scanr {f : α → β → β} {as : Array α} :\n (as.scanr f init).back? = some init := by\n simp [←getLast?_toList, List.getLast?_scanr]\n\n@[simp, grind =]\ntheorem getElem_scanr {f : α → β → β} (h : i < (scanr f b l).size) :\n (scanr f b l)[i] = foldr f b (l.drop i) := by\n simp only [← foldr_toList, scanr_eq_scanr_toList]\n grind [toList_drop]\n\n@[grind =]\ntheorem getElem?_scanr {f : α → β → β} :\n (scanr f b as)[i]? = if i < as.size + 1 then some (foldr f b (as.drop i)) else none := by\n grind\n\ntheorem getElem_scanr_zero {f : α → β → β} :\n (scanr f init as)[0] = as.foldr f init := by\n simp\n\ntheorem getElem?_scanr_zero {f : α → β → β} :\n (scanr f init as)[0]? = some (as.foldr f init ) := by\n simp\n\n@[grind =]\ntheorem scanr_map {f : β → γ → γ} {g : α → β} (init : γ) (as : Array α) :\n scanr f init (as.map g) = scanr (fun x acc => f (g x) acc) init as := by\n simp only [scanr_eq_scanr_toList, toList_map, List.scanr_map]\n\n@[grind =]\ntheorem scanl_reverse {f : β → α → β} {as : Array α} :\n scanl f init as.reverse = reverse (scanr (flip f) init as) := by\n apply toList_inj.mp\n simp only [scanl_eq_scanl_toList, scanr_eq_scanr_toList]\n simp\n\ntheorem scanl_extract {f : β → α → β} {as : Array α} :\n (as.extract start stop).scanl f init = as.scanl f init start stop := by\n unfold scanl\n rw [scanlM_extract]\n\ntheorem scanr_extract {f : α → β → β} {as : Array α} :\n (as.extract stop start).scanr f init = as.scanr f init start stop := by\n unfold scanr\n rw [scanrM_extract]\n\nend Array\n\nnamespace List\n\ntheorem toArray_scanlM [Monad m] [LawfulMonad m] {f : β → α → m β} {as : List α} :\n toArray <$> as.scanlM f init = as.toArray.scanlM f init := by\n rw [← Array.toList_scanlM]\n simp\n\ntheorem toArray_scanrM [Monad m] [LawfulMonad m] {f : α → β → m β} {as : List α} :\n toArray <$> as.scanrM f init = as.toArray.scanrM f init := by\n rw [← Array.toList_scanrM]\n simp\n\ntheorem toArray_scanl {f : β → α → β} {as : List α} :\n (as.scanl f init).toArray = as.toArray.scanl f init := by\n rw [← Array.toList_scanl]\n\ntheorem toArray_scanr {f : α → β → β} {as : List α} :\n (as.scanr f init).toArray = as.toArray.scanr f init := by\n rw [← Array.toList_scanr]\n\nend List\n\nnamespace Subarray\n\n@[simp]\ntheorem scanlM_eq_scanlM_extract [Monad m] [LawfulMonad m] {f : β → α → m β} {as : Subarray α} :\n as.scanlM f init = (as.array.extract as.start as.stop).scanlM f init := by\n simp only [scanlM, Array.scanlM_extract]\n\n@[simp]\ntheorem scanrM_eq_scanrM_extract [Monad m] [LawfulMonad m] {f : α → β → m β} {as : Subarray α} :\n as.scanrM f init = (as.array.extract as.stop as.start).scanrM f init := by\n simp only [scanrM, Array.scanrM_extract]\n\n@[simp]\ntheorem scanl_eq_scanl_extract {f : β → α → β} {as : Subarray α} :\n as.scanl f init = (as.array.extract as.start as.stop).scanl f init := by\n simp only [scanl, Array.scanl_extract]\n\n@[simp]\ntheorem scanr_eq_scanr_extract {f : α → β → β} {as : Subarray α} :\n as.scanr f init = (as.array.extract as.stop as.start).scanr f init := by\n simp only [scanr, Array.scanr_extract]\nend Subarray\n" }, { "path": "Batteries/Data/Array.lean", "content": "module\n\npublic import Batteries.Data.Array.Basic\npublic import Batteries.Data.Array.Init.Lemmas\npublic import Batteries.Data.Array.Lemmas\npublic import Batteries.Data.Array.Match\npublic import Batteries.Data.Array.Merge\npublic import Batteries.Data.Array.Monadic\npublic import Batteries.Data.Array.Pairwise\npublic import Batteries.Data.Array.Scan\n" }, { "path": "Batteries/Data/AssocList.lean", "content": "/-\nCopyright (c) 2019 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.List.Basic\n\n@[expose] public section\n\nnamespace Batteries\n\n/--\n`AssocList α β` is \"the same as\" `List (α × β)`, but flattening the structure\nleads to one fewer pointer indirection (in the current code generator).\nIt is mainly intended as a component of `HashMap`, but it can also be used as a plain\nkey-value map.\n-/\ninductive AssocList (α : Type u) (β : Type v) where\n /-- An empty list -/\n | nil\n /-- Add a `key, value` pair to the list -/\n | cons (key : α) (value : β) (tail : AssocList α β)\n deriving Inhabited\n\nnamespace AssocList\n\n/--\n`O(n)`. Convert an `AssocList α β` into the equivalent `List (α × β)`.\nThis is used to give specifications for all the `AssocList` functions\nin terms of corresponding list functions.\n-/\n@[simp] def toList : AssocList α β → List (α × β)\n | nil => []\n | cons a b es => (a, b) :: es.toList\n\ninstance : EmptyCollection (AssocList α β) := ⟨nil⟩\n\n@[simp] theorem empty_eq : (∅ : AssocList α β) = nil := rfl\n\n/-- `O(1)`. Is the list empty? -/\ndef isEmpty : AssocList α β → Bool\n | nil => true\n | _ => false\n\n@[simp] theorem isEmpty_eq (l : AssocList α β) : isEmpty l = l.toList.isEmpty := by\n cases l <;> simp [*, isEmpty, List.isEmpty]\n\n/-- The number of entries in an `AssocList`. -/\ndef length (L : AssocList α β) : Nat :=\n match L with\n | .nil => 0\n | .cons _ _ t => t.length + 1\n\n@[simp] theorem length_nil : length (nil : AssocList α β) = 0 := rfl\n@[simp] theorem length_cons : length (cons a b t) = length t + 1 := rfl\n\ntheorem length_toList (l : AssocList α β) : l.toList.length = l.length := by\n induction l <;> simp_all\n\n/-- `O(n)`. Fold a monadic function over the list, from head to tail. -/\n@[specialize] def foldlM [Monad m] (f : δ → α → β → m δ) : (init : δ) → AssocList α β → m δ\n | d, nil => pure d\n | d, cons a b es => do foldlM f (← f d a b) es\n\n@[simp] theorem foldlM_eq [Monad m] (f : δ → α → β → m δ) (init l) :\n foldlM f init l = l.toList.foldlM (fun d (a, b) => f d a b) init := by\n induction l generalizing init <;> simp [*, foldlM]\n\n/-- `O(n)`. Fold a function over the list, from head to tail. -/\n@[inline] def foldl (f : δ → α → β → δ) (init : δ) (as : AssocList α β) : δ :=\n Id.run (foldlM (fun d a b => pure (f d a b)) init as)\n\n@[simp] theorem foldl_eq (f : δ → α → β → δ) (init l) :\n foldl f init l = l.toList.foldl (fun d (a, b) => f d a b) init := by\n simp [foldl, foldlM_eq]\n\n/-- Optimized version of `toList`. -/\ndef toListTR (as : AssocList α β) : List (α × β) :=\n as.foldl (init := #[]) (fun r a b => r.push (a, b)) |>.toList\n\n@[csimp] theorem toList_eq_toListTR : @toList = @toListTR := by\n funext α β as; simp [toListTR]\n\n/-- `O(n)`. Run monadic function `f` on all elements in the list, from head to tail. -/\n@[specialize] def forM [Monad m] (f : α → β → m PUnit) : AssocList α β → m PUnit\n | nil => pure ⟨⟩\n | cons a b es => do f a b; forM f es\n\n@[simp] theorem forM_eq [Monad m] (f : α → β → m PUnit) (l) :\n forM f l = l.toList.forM (fun (a, b) => f a b) := by\n induction l <;> simp [*, forM]\n\n/-- `O(n)`. Map a function `f` over the keys of the list. -/\n@[simp] def mapKey (f : α → δ) : AssocList α β → AssocList δ β\n | nil => nil\n | cons k v t => cons (f k) v (mapKey f t)\n\n@[simp] theorem toList_mapKey (f : α → δ) (l : AssocList α β) :\n (mapKey f l).toList = l.toList.map (fun (a, b) => (f a, b)) := by\n induction l <;> simp [*]\n\n@[simp] theorem length_mapKey : (mapKey f l).length = l.length := by\n induction l <;> simp_all\n\n/-- `O(n)`. Map a function `f` over the values of the list. -/\n@[simp] def mapVal (f : α → β → δ) : AssocList α β → AssocList α δ\n | nil => nil\n | cons k v t => cons k (f k v) (mapVal f t)\n\n@[simp] theorem toList_mapVal (f : α → β → δ) (l : AssocList α β) :\n (mapVal f l).toList = l.toList.map (fun (a, b) => (a, f a b)) := by\n induction l <;> simp [*]\n\n@[simp] theorem length_mapVal : (mapVal f l).length = l.length := by\n induction l <;> simp_all\n\n/-- `O(n)`. Returns the first entry in the list whose entry satisfies `p`. -/\n@[specialize] def findEntryP? (p : α → β → Bool) : AssocList α β → Option (α × β)\n | nil => none\n | cons k v es => bif p k v then some (k, v) else findEntryP? p es\n\n@[simp] theorem findEntryP?_eq (p : α → β → Bool) (l : AssocList α β) :\n findEntryP? p l = l.toList.find? fun (a, b) => p a b := by\n induction l <;> simp [findEntryP?, List.find?_cons]; split <;> simp [*]\n\n/-- `O(n)`. Returns the first entry in the list whose key is equal to `a`. -/\n@[inline] def findEntry? [BEq α] (a : α) (l : AssocList α β) : Option (α × β) :=\n findEntryP? (fun k _ => k == a) l\n\n@[simp] theorem findEntry?_eq [BEq α] (a : α) (l : AssocList α β) :\n findEntry? a l = l.toList.find? (·.1 == a) := findEntryP?_eq ..\n\n/-- `O(n)`. Returns the first value in the list whose key is equal to `a`. -/\ndef find? [BEq α] (a : α) : AssocList α β → Option β\n | nil => none\n | cons k v es => match k == a with\n | true => some v\n | false => find? a es\n\ntheorem find?_eq_findEntry? [BEq α] (a : α) (l : AssocList α β) :\n find? a l = (l.findEntry? a).map (·.2) := by\n induction l <;> simp [find?, List.find?_cons]; split <;> simp [*]\n\n@[simp] theorem find?_eq [BEq α] (a : α) (l : AssocList α β) :\n find? a l = (l.toList.find? (·.1 == a)).map (·.2) := by simp [find?_eq_findEntry?]\n\n/-- `O(n)`. Returns true if any entry in the list satisfies `p`. -/\n@[specialize] def any (p : α → β → Bool) : AssocList α β → Bool\n | nil => false\n | cons k v es => p k v || any p es\n\n@[simp] theorem any_eq (p : α → β → Bool) (l : AssocList α β) :\n any p l = l.toList.any fun (a, b) => p a b := by induction l <;> simp [any, *]\n\n/-- `O(n)`. Returns true if every entry in the list satisfies `p`. -/\n@[specialize] def all (p : α → β → Bool) : AssocList α β → Bool\n | nil => true\n | cons k v es => p k v && all p es\n\n@[simp] theorem all_eq (p : α → β → Bool) (l : AssocList α β) :\n all p l = l.toList.all fun (a, b) => p a b := by induction l <;> simp [all, *]\n\n/-- Returns true if every entry in the list satisfies `p`. -/\ndef All (p : α → β → Prop) (l : AssocList α β) : Prop := ∀ a ∈ l.toList, p a.1 a.2\n\n/-- `O(n)`. Returns true if there is an element in the list whose key is equal to `a`. -/\n@[inline] def contains [BEq α] (a : α) (l : AssocList α β) : Bool := any (fun k _ => k == a) l\n\n@[simp] theorem contains_eq [BEq α] (a : α) (l : AssocList α β) :\n contains a l = l.toList.any (·.1 == a) := by\n induction l <;> simp [*, contains]\n\n/--\n`O(n)`. Replace the first entry in the list\nwith key equal to `a` to have key `a` and value `b`.\n-/\n@[simp] def replace [BEq α] (a : α) (b : β) : AssocList α β → AssocList α β\n | nil => nil\n | cons k v es => match k == a with\n | true => cons a b es\n | false => cons k v (replace a b es)\n\n@[simp] theorem toList_replace [BEq α] (a : α) (b : β) (l : AssocList α β) :\n (replace a b l).toList =\n l.toList.replaceF (bif ·.1 == a then some (a, b) else none) := by\n induction l <;> simp [replace]; split <;> simp [*]\n\n@[simp] theorem length_replace [BEq α] {a : α} : (replace a b l).length = l.length := by\n induction l\n · rfl\n · simp only [replace, length_cons]\n split <;> simp_all\n\n/-- `O(n)`. Remove the first entry in the list with key equal to `a`. -/\n@[specialize, simp] def eraseP (p : α → β → Bool) : AssocList α β → AssocList α β\n | nil => nil\n | cons k v es => bif p k v then es else cons k v (eraseP p es)\n\n@[simp] theorem toList_eraseP (p) (l : AssocList α β) :\n (eraseP p l).toList = l.toList.eraseP fun (a, b) => p a b := by\n induction l <;> simp [List.eraseP, cond]; split <;> simp [*]\n\n/-- `O(n)`. Remove the first entry in the list with key equal to `a`. -/\n@[inline] def erase [BEq α] (a : α) (l : AssocList α β) : AssocList α β :=\n eraseP (fun k _ => k == a) l\n\n@[simp] theorem toList_erase [BEq α] (a : α) (l : AssocList α β) :\n (erase a l).toList = l.toList.eraseP (·.1 == a) := toList_eraseP ..\n\n/--\n`O(n)`. Replace the first entry `a', b` in the list\nwith key equal to `a` to have key `a` and value `f a' b`.\n-/\n@[simp] def modify [BEq α] (a : α) (f : α → β → β) : AssocList α β → AssocList α β\n | nil => nil\n | cons k v es => match k == a with\n | true => cons a (f k v) es\n | false => cons k v (modify a f es)\n\n@[simp] theorem toList_modify [BEq α] (a : α) (l : AssocList α β) :\n (modify a f l).toList =\n l.toList.replaceF fun (k, v) => bif k == a then some (a, f k v) else none := by\n simp [cond]\n induction l with simp [List.replaceF]\n | cons k v es ih => cases k == a <;> simp [ih]\n\n@[simp] theorem length_modify [BEq α] {a : α} : (modify a f l).length = l.length := by\n induction l\n · rfl\n · simp only [modify, length_cons]\n split <;> simp_all\n\n/-- The implementation of `ForIn`, which enables `for (k, v) in aList do ...` notation. -/\n@[specialize] protected def forIn [Monad m]\n (as : AssocList α β) (init : δ) (f : (α × β) → δ → m (ForInStep δ)) : m δ :=\n match as with\n | nil => pure init\n | cons k v es => do\n match (← f (k, v) init) with\n | ForInStep.done d => pure d\n | ForInStep.yield d => es.forIn d f\n\ninstance [Monad m] : ForIn m (AssocList α β) (α × β) where\n forIn := AssocList.forIn\n\n@[simp] theorem forIn_eq [Monad m] (l : AssocList α β) (init : δ)\n (f : (α × β) → δ → m (ForInStep δ)) : forIn l init f = forIn l.toList init f := by\n simp only [forIn]\n induction l generalizing init <;> simp [AssocList.forIn]\n congr; funext a; split <;> simp [*]\n\n/-- Split the list into head and tail, if possible. -/\ndef pop? : AssocList α β → Option ((α × β) × AssocList α β)\n | nil => none\n | cons a b l => some ((a, b), l)\n\ninstance : Std.ToStream (AssocList α β) (AssocList α β) := ⟨fun x => x⟩\ninstance : Std.Stream (AssocList α β) (α × β) := ⟨pop?⟩\n\n/-- Converts a list into an `AssocList`. This is the inverse function to `AssocList.toList`. -/\n@[simp] def _root_.List.toAssocList : List (α × β) → AssocList α β\n | [] => nil\n | (a,b) :: es => cons a b (toAssocList es)\n\n@[simp] theorem _root_.List.toList_toAssocList (l : List (α × β)) : l.toAssocList.toList = l := by\n induction l <;> simp [*]\n\n@[simp] theorem toList_toAssocList (l : AssocList α β) : l.toList.toAssocList = l := by\n induction l <;> simp [*]\n\n@[simp] theorem _root_.List.length_toAssocList (l : List (α × β)) :\n l.toAssocList.length = l.length := by\n induction l <;> simp [*]\n\n/-- Implementation of `==` on `AssocList`. -/\nprotected def beq [BEq α] [BEq β] : AssocList α β → AssocList α β → Bool\n | .nil, .nil => true\n | .cons _ _ _, .nil => false\n | .nil, .cons _ _ _ => false\n | .cons a b t, .cons a' b' t' => a == a' && b == b' && AssocList.beq t t'\n\n/--\nBoolean equality for `AssocList`.\n(This relation cares about the ordering of the key-value pairs.)\n-/\ninstance [BEq α] [BEq β] : BEq (AssocList α β) where beq := AssocList.beq\n\n@[simp] theorem beq_nil₂ [BEq α] [BEq β] : ((.nil : AssocList α β) == .nil) = true := rfl\n@[simp] theorem beq_nil_cons [BEq α] [BEq β] : ((.nil : AssocList α β) == .cons a b t) = false :=\n rfl\n@[simp] theorem beq_cons_nil [BEq α] [BEq β] : ((.cons a b t : AssocList α β) == .nil) = false :=\n rfl\n@[simp] theorem beq_cons₂ [BEq α] [BEq β] :\n ((.cons a b t : AssocList α β) == .cons a' b' t') = (a == a' && b == b' && t == t') := rfl\n\ninstance [BEq α] [LawfulBEq α] [BEq β] [LawfulBEq β] : LawfulBEq (AssocList α β) where\n rfl {L} := by induction L <;> simp_all\n eq_of_beq {L M} := by\n induction L generalizing M with\n | nil => cases M <;> simp_all\n | cons a b L ih =>\n cases M with\n | nil => simp_all\n | cons a' b' M =>\n simp_all only [beq_cons₂, Bool.and_eq_true, beq_iff_eq, cons.injEq, true_and, and_imp]\n exact fun _ _ => ih\n\nprotected theorem beq_eq [BEq α] [BEq β] {l m : AssocList α β} :\n (l == m) = (l.toList == m.toList) := by\n simp [(· == ·)]\n induction l generalizing m <;> cases m <;> simp [*, (· == ·), AssocList.beq, List.beq]\n" }, { "path": "Batteries/Data/BinaryHeap/Basic.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, François G. Dorais\n-/\nmodule\n\npublic section\n\nnamespace Batteries\n\n/-- A max-heap data structure. -/\nstructure BinaryHeap (α) (lt : α → α → Bool) where\n /-- `O(1)`. Get data array for a `BinaryHeap`. -/\n arr : Array α\n\nnamespace BinaryHeap\n\nprivate def maxChild (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) : Option (Fin sz) :=\n let left := 2 * i.1 + 1\n let right := left + 1\n if hleft : left < sz then\n if hright : right < sz then\n if lt a[left] a[right] then\n some ⟨right, hright⟩\n else\n some ⟨left, hleft⟩\n else\n some ⟨left, hleft⟩\n else none\n\n/-- Core operation for binary heaps, expressed directly on arrays.\nGiven an array which is a max-heap, push item `i` down to restore the max-heap property. -/\ndef heapifyDown (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) :\n Vector α sz :=\n match h : maxChild lt a i with\n | none => a\n | some j =>\n have : i < j := by\n cases i; cases j\n simp only [maxChild] at h\n split at h\n · split at h\n · split at h <;> (cases h; simp +arith)\n · cases h; simp +arith\n · contradiction\n if lt a[i] a[j] then\n heapifyDown lt (a.swap i j) j\n else a\ntermination_by sz - i\n\n/-- Core operation for binary heaps, expressed directly on arrays.\nConstruct a heap from an unsorted array, by heapifying all the elements. -/\ndef mkHeap (lt : α → α → Bool) (a : Vector α sz) : Vector α sz :=\n loop (sz / 2) a (Nat.div_le_self ..)\nwhere\n /-- Inner loop for `mkHeap`. -/\n loop : (i : Nat) → (a : Vector α sz) → i ≤ sz → Vector α sz\n | 0, a, _ => a\n | i+1, a, h =>\n let a' := heapifyDown lt a ⟨i, Nat.lt_of_succ_le h⟩\n loop i a' (Nat.le_trans (Nat.le_succ _) h)\n\n/-- Core operation for binary heaps, expressed directly on arrays.\nGiven an array which is a max-heap, push item `i` up to restore the max-heap property. -/\ndef heapifyUp (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) :\n Vector α sz :=\n match i with\n | ⟨0, _⟩ => a\n | ⟨i'+1, hi⟩ =>\n let j := i'/2\n if lt a[j] a[i] then\n heapifyUp lt (a.swap i j) ⟨j, by get_elem_tactic⟩\n else a\n\n/-- `O(1)`. Build a new empty heap. -/\ndef empty (lt) : BinaryHeap α lt := ⟨#[]⟩\n\ninstance (lt) : Inhabited (BinaryHeap α lt) := ⟨empty _⟩\ninstance (lt) : EmptyCollection (BinaryHeap α lt) := ⟨empty _⟩\n\n/-- `O(1)`. Build a one-element heap. -/\ndef singleton (lt) (x : α) : BinaryHeap α lt := ⟨#[x]⟩\n\n/-- `O(1)`. Get the number of elements in a `BinaryHeap`. -/\ndef size (self : BinaryHeap α lt) : Nat := self.1.size\n\n/-- `O(1)`. Get data vector of a `BinaryHeap`. -/\ndef vector (self : BinaryHeap α lt) : Vector α self.size := ⟨self.1, rfl⟩\n\n/-- `O(1)`. Get an element in the heap by index. -/\ndef get (self : BinaryHeap α lt) (i : Fin self.size) : α := self.1[i]'(i.2)\n\n/-- `O(log n)`. Insert an element into a `BinaryHeap`, preserving the max-heap property. -/\ndef insert (self : BinaryHeap α lt) (x : α) : BinaryHeap α lt where\n arr := heapifyUp lt (self.vector.push x) ⟨_, Nat.lt_succ_self _⟩ |>.toArray\n\n@[simp] theorem size_insert (self : BinaryHeap α lt) (x : α) :\n (self.insert x).size = self.size + 1 := by\n simp [size, insert]\n\n/-- `O(1)`. Get the maximum element in a `BinaryHeap`. -/\ndef max (self : BinaryHeap α lt) : Option α := self.1[0]?\n\n/-- `O(log n)`. Remove the maximum element from a `BinaryHeap`.\nCall `max` first to actually retrieve the maximum element. -/\ndef popMax (self : BinaryHeap α lt) : BinaryHeap α lt :=\n if h0 : self.size = 0 then self else\n have hs : self.size - 1 < self.size := Nat.pred_lt h0\n have h0 : 0 < self.size := Nat.zero_lt_of_ne_zero h0\n let v := self.vector.swap _ _ h0 hs |>.pop\n if h : 0 < self.size - 1 then\n ⟨heapifyDown lt v ⟨0, h⟩ |>.toArray⟩\n else\n ⟨v.toArray⟩\n\n@[simp] theorem size_popMax (self : BinaryHeap α lt) :\n self.popMax.size = self.size - 1 := by\n simp only [popMax, size]\n split\n · simp +arith [*]\n · split <;> simp +arith\n\n/-- `O(log n)`. Return and remove the maximum element from a `BinaryHeap`. -/\ndef extractMax (self : BinaryHeap α lt) : Option α × BinaryHeap α lt :=\n (self.max, self.popMax)\n\ntheorem size_pos_of_max {self : BinaryHeap α lt} (h : self.max = some x) : 0 < self.size := by\n simp only [max, getElem?_def] at h\n split at h\n · assumption\n · contradiction\n\n/-- `O(log n)`. Equivalent to `extractMax (self.insert x)`, except that extraction cannot fail. -/\ndef insertExtractMax (self : BinaryHeap α lt) (x : α) : α × BinaryHeap α lt :=\n match e : self.max with\n | none => (x, self)\n | some m =>\n if lt x m then\n let v := self.vector.set 0 x (size_pos_of_max e)\n (m, ⟨heapifyDown lt v ⟨0, size_pos_of_max e⟩ |>.toArray⟩)\n else (x, self)\n\n/-- `O(log n)`. Equivalent to `(self.max, self.popMax.insert x)`. -/\ndef replaceMax (self : BinaryHeap α lt) (x : α) : Option α × BinaryHeap α lt :=\n match e : self.max with\n | none => (none, ⟨self.vector.push x |>.toArray⟩)\n | some m =>\n let v := self.vector.set 0 x (size_pos_of_max e)\n (some m, ⟨heapifyDown lt v ⟨0, size_pos_of_max e⟩ |>.toArray⟩)\n\n/-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `x ≤ self.get i`. -/\ndef decreaseKey (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where\n arr := heapifyDown lt (self.vector.set i x) i |>.toArray\n\n/-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `self.get i ≤ x`. -/\ndef increaseKey (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where\n arr := heapifyUp lt (self.vector.set i x) i |>.toArray\n\nend Batteries.BinaryHeap\n\n/-- `O(n)`. Convert an unsorted vector to a `BinaryHeap`. -/\ndef Batteries.Vector.toBinaryHeap (lt : α → α → Bool) (v : Vector α n) :\n Batteries.BinaryHeap α lt where\n arr := BinaryHeap.mkHeap lt v |>.toArray\n\nopen Batteries in\n/-- `O(n)`. Convert an unsorted array to a `BinaryHeap`. -/\ndef Array.toBinaryHeap (lt : α → α → Bool) (a : Array α) : Batteries.BinaryHeap α lt where\n arr := BinaryHeap.mkHeap lt ⟨a, rfl⟩ |>.toArray\n\nopen Batteries in\n/-- `O(n log n)`. Sort an array using a `BinaryHeap`. -/\n@[specialize] def Array.heapSort (a : Array α) (lt : α → α → Bool) : Array α :=\n loop (a.toBinaryHeap (flip lt)) #[]\nwhere\n /-- Inner loop for `heapSort`. -/\n loop (a : Batteries.BinaryHeap α (flip lt)) (out : Array α) : Array α :=\n match e: a.max with\n | none => out\n | some x =>\n have : a.popMax.size < a.size := by\n simp; exact Nat.sub_lt (Batteries.BinaryHeap.size_pos_of_max e) Nat.zero_lt_one\n loop a.popMax (out.push x)\n termination_by a.size\n" }, { "path": "Batteries/Data/BinaryHeap.lean", "content": "module\npublic import Batteries.Data.BinaryHeap.Basic\n" }, { "path": "Batteries/Data/BinomialHeap/Basic.lean", "content": "/-\nCopyright (c) 2019 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Jannis Limperg, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Classes.Order\npublic import Batteries.Control.ForInStep.Basic\n\n@[expose] public section\n\nnamespace Batteries\nnamespace BinomialHeap\nnamespace Imp\n\n/--\nA `HeapNode` is one of the internal nodes of the binomial heap.\nIt is always a perfect binary tree, with the depth of the tree stored in the `Heap`.\nHowever the interpretation of the two pointers is different: we view the `child`\nas going to the first child of this node, and `sibling` goes to the next sibling\nof this tree. So it actually encodes a forest where each node has children\n`node.child`, `node.child.sibling`, `node.child.sibling.sibling`, etc.\n\nEach edge in this forest denotes a `le a b` relation that has been checked, so\nthe root is smaller than everything else under it.\n-/\ninductive HeapNode (α : Type u) where\n /-- An empty forest, which has depth `0`. -/\n | nil : HeapNode α\n /-- A forest of rank `r + 1` consists of a root `a`,\n a forest `child` of rank `r` elements greater than `a`,\n and another forest `sibling` of rank `r`. -/\n | node (a : α) (child sibling : HeapNode α) : HeapNode α\n deriving Repr\n\n/--\nThe \"real size\" of the node, counting up how many values of type `α` are stored.\nThis is `O(n)` and is intended mainly for specification purposes.\nFor a well formed `HeapNode` the size is always `2^n - 1` where `n` is the depth.\n-/\n@[simp] def HeapNode.realSize : HeapNode α → Nat\n | .nil => 0\n | .node _ c s => c.realSize + 1 + s.realSize\n\n/-- A node containing a single element `a`. -/\ndef HeapNode.singleton (a : α) : HeapNode α := .node a .nil .nil\n\n/--\n`O(log n)`. The rank, or the number of trees in the forest.\nIt is also the depth of the forest.\n-/\ndef HeapNode.rank : HeapNode α → Nat\n | .nil => 0\n | .node _ _ s => s.rank + 1\n\n/-- Tail-recursive version of `HeapNode.rank`. -/\n@[inline] def HeapNode.rankTR (s : HeapNode α) : Nat := go s 0 where\n /-- Computes `s.rank + r` -/\n go : HeapNode α → Nat → Nat\n | .nil, r => r\n | .node _ _ s, r => go s (r + 1)\n\n@[csimp] theorem HeapNode.rankTR_eq : @rankTR = @rank := by\n funext α s; exact go s 0\nwhere\n go {α} : ∀ s n, @rankTR.go α s n = rank s + n\n | .nil, _ => (Nat.zero_add ..).symm\n | .node .., _ => by simp +arith only [rankTR.go, go, rank]\n\n/--\nA `Heap` is the top level structure in a binomial heap.\nIt consists of a forest of `HeapNode`s with strictly increasing ranks.\n-/\ninductive Heap (α : Type u) where\n /-- An empty heap. -/\n | nil : Heap α\n /-- A cons node contains a tree of root `val`, children `node` and rank `rank`,\n and then `next` which is the rest of the forest. -/\n | cons (rank : Nat) (val : α) (node : HeapNode α) (next : Heap α) : Heap α\n deriving Repr\n\n/--\n`O(n)`. The \"real size\" of the heap, counting up how many values of type `α` are stored.\nThis is intended mainly for specification purposes.\nPrefer `Heap.size`, which is the same for well formed heaps.\n-/\n@[simp] def Heap.realSize : Heap α → Nat\n | .nil => 0\n | .cons _ _ c s => c.realSize + 1 + s.realSize\n\n/-- `O(log n)`. The number of elements in the heap. -/\ndef Heap.size : Heap α → Nat\n | .nil => 0\n | .cons r _ _ s => 1 <<< r + s.size\n\n/-- `O(1)`. Is the heap empty? -/\n@[inline] def Heap.isEmpty : Heap α → Bool\n | .nil => true\n | _ => false\n\n/-- `O(1)`. The heap containing a single value `a`. -/\n@[inline] def Heap.singleton (a : α) : Heap α := .cons 0 a .nil .nil\n\n/-- `O(1)`. Auxiliary for `Heap.merge`: Is the minimum rank in `Heap` strictly larger than `n`? -/\ndef Heap.rankGT : Heap α → Nat → Prop\n | .nil, _ => True\n | .cons r .., n => n < r\n\ninstance : Decidable (Heap.rankGT s n) :=\n match s with\n | .nil => inferInstanceAs (Decidable True)\n | .cons .. => inferInstanceAs (Decidable (_ < _))\n\n/-- `O(log n)`. The number of trees in the forest. -/\n@[simp] def Heap.length : Heap α → Nat\n | .nil => 0\n | .cons _ _ _ r => r.length + 1\n\n/--\n`O(1)`. Auxiliary for `Heap.merge`: combines two heap nodes of the same rank\ninto one with the next larger rank.\n-/\n@[inline] def combine (le : α → α → Bool) (a₁ a₂ : α) (n₁ n₂ : HeapNode α) : α × HeapNode α :=\n if le a₁ a₂ then (a₁, .node a₂ n₂ n₁) else (a₂, .node a₁ n₁ n₂)\n\n/--\nMerge two forests of binomial trees. The forests are assumed to be ordered\nby rank and `merge` maintains this invariant.\n-/\n@[specialize] def Heap.merge (le : α → α → Bool) : Heap α → Heap α → Heap α\n | .nil, h => h\n | h, .nil => h\n | s₁@(.cons r₁ a₁ n₁ t₁), s₂@(.cons r₂ a₂ n₂ t₂) =>\n if r₁ < r₂ then .cons r₁ a₁ n₁ (merge le t₁ s₂)\n else if r₂ < r₁ then .cons r₂ a₂ n₂ (merge le s₁ t₂)\n else\n let (a, n) := combine le a₁ a₂ n₁ n₂\n let r := r₁ + 1\n if t₁.rankGT r then if t₂.rankGT r\n then .cons r a n (merge le t₁ t₂)\n else merge le (.cons r a n t₁) t₂\n else if t₂.rankGT r\n then merge le t₁ (.cons r a n t₂)\n else .cons r a n (merge le t₁ t₂)\ntermination_by s₁ s₂ => s₁.length + s₂.length\n\n/--\n`O(log n)`. Convert a `HeapNode` to a `Heap` by reversing the order of the nodes\nalong the `sibling` spine.\n-/\ndef HeapNode.toHeap (s : HeapNode α) : Heap α := go s s.rank .nil where\n /-- Computes `s.toHeap ++ res` tail-recursively, assuming `n = s.rank`. -/\n go : HeapNode α → Nat → Heap α → Heap α\n | .nil, _, res => res\n | .node a c s, n, res => go s (n - 1) (.cons (n - 1) a c res)\n\n/-- `O(log n)`. Get the smallest element in the heap, including the passed in value `a`. -/\n@[specialize] def Heap.headD (le : α → α → Bool) (a : α) : Heap α → α\n | .nil => a\n | .cons _ b _ hs => headD le (if le a b then a else b) hs\n\n/-- `O(log n)`. Get the smallest element in the heap, if it has an element. -/\n@[inline] def Heap.head? (le : α → α → Bool) : Heap α → Option α\n | .nil => none\n | .cons _ h _ hs => some <| headD le h hs\n\n/--\nThe return type of `FindMin`, which encodes various quantities needed to\nreconstruct the tree in `deleteMin`.\n-/\nstructure FindMin (α) where\n /-- The list of elements prior to the minimum element, encoded as a \"difference list\". -/\n before : Heap α → Heap α := id\n /-- The minimum element. -/\n val : α\n /-- The children of the minimum element. -/\n node : HeapNode α\n /-- The forest after the minimum element. -/\n next : Heap α\n\n/--\n`O(log n)`. Find the minimum element, and return a data structure `FindMin` with information\nneeded to reconstruct the rest of the binomial heap.\n-/\n@[specialize] def Heap.findMin (le : α → α → Bool) (k : Heap α → Heap α) :\n Heap α → FindMin α → FindMin α\n | .nil, res => res\n | .cons r a c s, res =>\n -- It is important that we check `le res.val a` here, not the other way\n -- around. This ensures that head? and findMin find the same element even\n -- when we have `le res.val a` and `le a res.val` (i.e. le is not antisymmetric).\n findMin le (k ∘ .cons r a c) s <| if le res.val a then res else ⟨k, a, c, s⟩\n\n/-- `O(log n)`. Find and remove the the minimum element from the binomial heap. -/\ndef Heap.deleteMin (le : α → α → Bool) : Heap α → Option (α × Heap α)\n | .nil => none\n | .cons r a c s =>\n let { before, val, node, next } := findMin le (.cons r a c) s ⟨id, a, c, s⟩\n some (val, node.toHeap.merge le (before next))\n\n/-- `O(log n)`. Get the tail of the binomial heap after removing the minimum element. -/\n@[inline] def Heap.tail? (le : α → α → Bool) (h : Heap α) : Option (Heap α) :=\n deleteMin le h |>.map (·.snd)\n\n/-- `O(log n)`. Remove the minimum element of the heap. -/\n@[inline] def Heap.tail (le : α → α → Bool) (h : Heap α) : Heap α := tail? le h |>.getD .nil\n\ntheorem Heap.realSize_merge (le) (s₁ s₂ : Heap α) :\n (s₁.merge le s₂).realSize = s₁.realSize + s₂.realSize := by\n unfold merge; split\n · simp\n · simp\n · next r₁ a₁ n₁ t₁ r₂ a₂ n₂ t₂ =>\n have IH₁ r a n := realSize_merge le t₁ (cons r a n t₂)\n have IH₂ r a n := realSize_merge le (cons r a n t₁) t₂\n have IH₃ := realSize_merge le t₁ t₂\n split; · simp [IH₁, Nat.add_assoc]\n split; · simp [IH₂, Nat.add_assoc, Nat.add_left_comm]\n split; simp only; rename_i a n eq\n have : n.realSize = n₁.realSize + 1 + n₂.realSize := by\n rw [combine] at eq; split at eq <;> cases eq <;>\n simp [Nat.add_assoc, Nat.add_left_comm, Nat.add_comm]\n split <;> split <;> simp [IH₁, IH₂, IH₃, this, Nat.add_assoc, Nat.add_left_comm]\ntermination_by s₁.length + s₂.length\n\nprivate def FindMin.HasSize (res : FindMin α) (n : Nat) : Prop :=\n ∃ m,\n (∀ s, (res.before s).realSize = m + s.realSize) ∧\n n = m + res.node.realSize + res.next.realSize + 1\n\nprivate theorem Heap.realSize_findMin {s : Heap α}\n (m) (hk : ∀ s, (k s).realSize = m + s.realSize)\n (eq : n = m + s.realSize) (hres : res.HasSize n) :\n (s.findMin le k res).HasSize n :=\n match s with\n | .nil => hres\n | .cons r a c s => by\n simp [findMin]\n refine realSize_findMin (m + c.realSize + 1)\n (by simp [hk, Nat.add_assoc]) (by simp [eq, Nat.add_assoc]) ?_\n split\n · exact hres\n · exact ⟨m, hk, by simp [eq, Nat.add_comm, Nat.add_left_comm]⟩\n\ntheorem HeapNode.realSize_toHeap (s : HeapNode α) : s.toHeap.realSize = s.realSize := go s where\n go {n res} : ∀ s : HeapNode α, (toHeap.go s n res).realSize = s.realSize + res.realSize\n | .nil => (Nat.zero_add _).symm\n | .node a c s => by simp [toHeap.go, go, Nat.add_assoc, Nat.add_left_comm]\n\ntheorem Heap.realSize_deleteMin {s : Heap α} (eq : s.deleteMin le = some (a, s')) :\n s.realSize = s'.realSize + 1 := by\n cases s with cases eq | cons r a c s => ?_\n have : (s.findMin le (cons r a c) ⟨id, a, c, s⟩).HasSize (c.realSize + s.realSize + 1) :=\n Heap.realSize_findMin (c.realSize + 1) (by simp) (Nat.add_right_comm ..) ⟨0, by simp⟩\n revert this\n match s.findMin le (cons r a c) ⟨id, a, c, s⟩ with\n | { before, val, node, next } =>\n intro ⟨m, ih₁, ih₂⟩; dsimp only at ih₁ ih₂\n rw [realSize, Nat.add_right_comm, ih₂]\n simp only [realSize_merge, HeapNode.realSize_toHeap, ih₁, Nat.add_assoc, Nat.add_left_comm]\n\ntheorem Heap.realSize_tail? {s : Heap α} : s.tail? le = some s' →\n s.realSize = s'.realSize + 1 := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact realSize_deleteMin eq₂\n\ntheorem Heap.realSize_tail (le) (s : Heap α) : (s.tail le).realSize = s.realSize - 1 := by\n simp only [Heap.tail]\n match eq : s.tail? le with\n | none => cases s with cases eq | nil => rfl\n | some tl => simp [Heap.realSize_tail? eq]\n\n/--\n`O(n log n)`. Monadic fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[specialize] def Heap.foldM [Monad m] (le : α → α → Bool) (s : Heap α)\n (init : β) (f : β → α → m β) : m β :=\n match eq : s.deleteMin le with\n | none => pure init\n | some (hd, tl) => do\n have : tl.realSize < s.realSize := by simp +arith [Heap.realSize_deleteMin eq]\n foldM le tl (← f init hd) f\ntermination_by s.realSize\n\n/--\n`O(n log n)`. Fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[inline] def Heap.fold (le : α → α → Bool) (s : Heap α) (init : β) (f : β → α → β) : β :=\n Id.run <| s.foldM le init f\n\n/-- `O(n log n)`. Convert the heap to an array in increasing order. -/\n@[inline] def Heap.toArray (le : α → α → Bool) (s : Heap α) : Array α := fold le s #[] Array.push\n\n/-- `O(n log n)`. Convert the heap to a list in increasing order. -/\n@[inline] def Heap.toList (le : α → α → Bool) (s : Heap α) : List α := (s.toArray le).toList\n\nsection\nvariable [Monad m] (nil : β) (join : α → β → β → m β)\n\n/-- `O(n)`. Fold a monadic function over the tree structure to accumulate a value. -/\n@[specialize] def HeapNode.foldTreeM : HeapNode α → m β\n | .nil => pure nil\n | .node a c s => do join a (← c.foldTreeM) (← s.foldTreeM)\n\n/-- `O(n)`. Fold a monadic function over the tree structure to accumulate a value. -/\n@[specialize] def Heap.foldTreeM : Heap α → m β\n | .nil => pure nil\n | .cons _ a c s => do join a (← c.foldTreeM nil join) (← s.foldTreeM)\n\nend\n\n/-- `O(n)`. Fold a function over the tree structure to accumulate a value. -/\n@[inline] def Heap.foldTree (nil : β) (join : α → β → β → β) (s : Heap α) : β :=\n Id.run <| s.foldTreeM nil join\n\n/-- `O(n)`. Convert the heap to a list in arbitrary order. -/\ndef Heap.toListUnordered (s : Heap α) : List α :=\n s.foldTree id (fun a c s l => a :: c (s l)) []\n\n/-- `O(n)`. Convert the heap to an array in arbitrary order. -/\ndef Heap.toArrayUnordered (s : Heap α) : Array α :=\n s.foldTree id (fun a c s r => s (c (r.push a))) #[]\n\n/--\nThe well formedness predicate for a heap node.\nIt asserts that:\n* If `a` is added at the top to make the forest into a tree, the resulting tree\n is a `le`-min-heap (if `le` is well-behaved)\n* When interpreting `child` and `sibling` as left and right children of a binary tree,\n it is a perfect binary tree with depth `r`\n-/\ndef HeapNode.WF (le : α → α → Bool) (a : α) : HeapNode α → Nat → Prop\n | .nil, r => r = 0\n | .node b c s, r => ∃ r', r = r' + 1 ∧ (∀ [TotalBLE le], le a b) ∧ c.WF le b r' ∧ s.WF le a r'\n\n/--\nThe well formedness predicate for a binomial heap.\nIt asserts that:\n* It consists of a list of well formed trees with the specified ranks\n* The ranks are in strictly increasing order, and all are at least `n`\n-/\ndef Heap.WF (le : α → α → Bool) (n : Nat) : Heap α → Prop\n | .nil => True\n | .cons r a c s => n ≤ r ∧ c.WF le a r ∧ s.WF le (r+1)\n\ntheorem Heap.WF.nil : Heap.nil.WF le n := trivial\n\ntheorem Heap.WF.singleton : (Heap.singleton a).WF le 0 := ⟨by decide, rfl, ⟨⟩⟩\n\ntheorem Heap.WF.of_rankGT (hlt : s.rankGT n) (h : Heap.WF le n' s) : s.WF le (n+1) :=\n match s with\n | .nil => trivial\n | .cons .. => let ⟨_, h₂, h₃⟩ := h; ⟨hlt, h₂, h₃⟩\n\ntheorem Heap.WF.of_le (hle : n ≤ n') (h : Heap.WF le n' s) : s.WF le n :=\n match s with\n | .nil => trivial\n | .cons .. => let ⟨h₁, h₂, h₃⟩ := h; ⟨Nat.le_trans hle h₁, h₂, h₃⟩\n\ntheorem Heap.rankGT.of_le (h : Heap.rankGT s n) (h' : n' ≤ n) : s.rankGT n' :=\n match s with\n | .nil => trivial\n | .cons .. => Nat.lt_of_le_of_lt h' h\n\ntheorem Heap.WF.rankGT (h : Heap.WF lt (n+1) s) : s.rankGT n :=\n match s with\n | .nil => trivial\n | .cons .. => Nat.lt_of_succ_le h.1\n\ntheorem Heap.WF.merge' (h₁ : s₁.WF le n) (h₂ : s₂.WF le n) :\n (merge le s₁ s₂).WF le n ∧ ((s₁.rankGT n ↔ s₂.rankGT n) → (merge le s₁ s₂).rankGT n) := by\n unfold merge; split\n · exact ⟨h₂, fun h => h.1 h₁⟩\n · exact ⟨h₁, fun h => h.2 h₂⟩\n · rename_i r₁ a₁ n₁ t₁ r₂ a₂ n₂ t₂\n let ⟨hr₁, hn₁, ht₁⟩ := h₁\n let ⟨hr₂, hn₂, ht₂⟩ := h₂\n split <;> rename_i lt₁\n · refine ⟨⟨hr₁, hn₁, And.left (merge' ht₁ ⟨lt₁, hn₂, ht₂⟩)⟩, fun h => ?_⟩\n exact h.2 <| Nat.lt_of_le_of_lt hr₁ lt₁\n split <;> rename_i lt₂\n · refine ⟨⟨hr₂, hn₂, And.left (merge' ⟨lt₂, hn₁, ht₁⟩ ht₂)⟩, fun h => ?_⟩\n exact h.1 <| Nat.lt_of_le_of_lt hr₂ lt₂\n cases Nat.le_antisymm (Nat.ge_of_not_lt lt₂) (Nat.ge_of_not_lt lt₁)\n split; rename_i a n eq\n have : n.WF le a (r₁+1) := by\n unfold combine at eq; split at eq <;> cases eq <;> rename_i h\n · exact ⟨r₁, rfl, h, hn₂, hn₁⟩\n · exact ⟨r₁, rfl, TotalBLE.total.resolve_left h, hn₁, hn₂⟩\n simp only; split <;> split <;> rename_i hl₁ hl₂\n · exact ⟨⟨Nat.le_succ_of_le hr₁, this,\n (merge' (ht₁.of_rankGT hl₁) (ht₂.of_rankGT hl₂)).1⟩,\n fun _ => Nat.lt_succ_of_le hr₁⟩\n · let ⟨ih₁, ih₂⟩ := merge' (s₁ := .cons ..)\n ⟨Nat.le_succ_of_le hr₁, this, ht₁.of_rankGT hl₁⟩\n (ht₂.of_le (Nat.le_succ_of_le hr₁))\n exact ⟨ih₁, fun _ => ih₂ ⟨fun _ => ht₂.rankGT.of_le hr₁, fun _ => Nat.lt_succ_of_le hr₁⟩⟩\n · let ⟨ih₁, ih₂⟩ := merge' (s₂ := .cons ..) (ht₁.of_le (Nat.le_succ_of_le hr₁))\n ⟨Nat.le_succ_of_le hr₁, this, ht₂.of_rankGT hl₂⟩\n exact ⟨ih₁, fun _ => ih₂ ⟨fun _ => Nat.lt_succ_of_le hr₁, fun _ => ht₁.rankGT.of_le hr₁⟩⟩\n · let ⟨ih₁, ih₂⟩ := merge' ht₁ ht₂\n exact ⟨⟨Nat.le_succ_of_le hr₁, this, ih₁.of_rankGT (ih₂ (iff_of_false hl₁ hl₂))⟩,\n fun _ => Nat.lt_succ_of_le hr₁⟩\ntermination_by s₁.length + s₂.length\n\ntheorem Heap.WF.merge (h₁ : s₁.WF le n) (h₂ : s₂.WF le n) : (merge le s₁ s₂).WF le n :=\n (merge' h₁ h₂).1\n\ntheorem HeapNode.WF.rank_eq : ∀ {n} {s : HeapNode α}, s.WF le a n → s.rank = n\n | _, .nil, h => h.symm\n | _, .node .., ⟨_, rfl, _, _, h⟩ => congrArg Nat.succ (rank_eq h)\n\ntheorem HeapNode.WF.toHeap {s : HeapNode α} (h : s.WF le a n) : s.toHeap.WF le 0 :=\n go h trivial\nwhere\n go {res} : ∀ {n s}, s.WF le a n → res.WF le s.rank → (HeapNode.toHeap.go s s.rank res).WF le 0\n | _, .nil, _, hr => hr\n | _, .node a c s, ⟨n, rfl, _, h, h'⟩, hr =>\n go (s := s) h' ⟨Nat.le_refl _, by rw [← h'.rank_eq] at h; exact h, hr⟩\n\n/--\nThe well formedness predicate for a `FindMin` value.\nThis is not actually a predicate, as it contains an additional data value\n`rank` corresponding to the rank of the returned node, which is omitted from `findMin`.\n-/\nstructure FindMin.WF (le : α → α → Bool) (res : FindMin α) where\n /-- The rank of the minimum element -/\n rank : Nat\n /-- `before` is a difference list which can be appended to a binomial heap\n with ranks at least `rank` to produce another well formed heap. -/\n before : ∀ {s}, s.WF le rank → (res.before s).WF le 0\n /-- `node` is a well formed forest of rank `rank` with `val` at the root. -/\n node : res.node.WF le res.val rank\n /-- `next` is a binomial heap with ranks above `rank + 1`. -/\n next : res.next.WF le (rank + 1)\n\n/-- The conditions under which `findMin` is well-formed. -/\ndef Heap.WF.findMin {s : Heap α} (h : s.WF le n) (hr : res.WF le)\n (hk : ∀ {s}, s.WF le n → (k s).WF le 0) : ((s : Heap α).findMin le k res).WF le :=\n match s with\n | .nil => hr\n | .cons r a c s => by\n let ⟨h₁, h₂, h₃⟩ := h\n simp [Heap.findMin]\n cases le res.val a with\n | true => exact findMin h₃ hr (fun h => hk ⟨h₁, h₂, h⟩)\n | false => exact findMin h₃ ⟨_, fun h => hk (h.of_le h₁), h₂, h₃⟩ (fun h => hk ⟨h₁, h₂, h⟩)\n\ntheorem Heap.WF.deleteMin {s : Heap α}\n (h : s.WF le n) (eq : s.deleteMin le = some (a, s')) : s'.WF le 0 := by\n cases s with cases eq | cons r a c s => ?_\n have : (s.findMin le (cons r a c) ⟨id, a, c, s⟩).WF le :=\n let ⟨_, h₂, h₃⟩ := h\n h₃.findMin ⟨_, fun h => h.of_le (Nat.zero_le _), h₂, h₃⟩\n fun h => ⟨Nat.zero_le _, h₂, h⟩\n revert this\n let { before, val, node, next } := s.findMin le (cons r a c) ⟨id, a, c, s⟩\n intro ⟨_, hk, ih₁, ih₂⟩\n exact ih₁.toHeap.merge <| hk (ih₂.of_le (Nat.le_succ _))\n\ntheorem Heap.WF.tail? (hwf : (s : Heap α).WF le n) : s.tail? le = some tl → tl.WF le 0 := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact hwf.deleteMin eq₂\n\ntheorem Heap.WF.tail (hwf : (s : Heap α).WF le n) : (s.tail le).WF le 0 := by\n simp only [Heap.tail]\n match eq : s.tail? le with\n | none => exact Heap.WF.nil\n | some tl => exact hwf.tail? eq\n\nend Imp\nend BinomialHeap\n\nopen BinomialHeap.Imp\n\n/--\nA [binomial heap](https://en.wikipedia.org/wiki/Binomial_heap) is a data structure which supports\nthe following primary operations:\n\n* `insert : α → BinomialHeap α → BinomialHeap α`: add an element to the heap\n* `deleteMin : BinomialHeap α → Option (α × BinomialHeap α)`:\n remove the minimum element from the heap\n* `merge : BinomialHeap α → BinomialHeap α → BinomialHeap α`: combine two heaps\n\nThe first two operations are known as a \"priority queue\", so this could be called\na \"mergeable priority queue\". The standard choice for a priority queue is a binary heap,\nwhich supports `insert` and `deleteMin` in `O(log n)`, but `merge` is `O(n)`.\nWith a `BinomialHeap`, all three operations are `O(log n)`.\n-/\ndef BinomialHeap (α : Type u) (le : α → α → Bool) :=\n { h : Heap α // h.WF le 0 }\n\n/-- `O(1)`. Make a new empty binomial heap. -/\n@[inline] def mkBinomialHeap (α : Type u) (le : α → α → Bool) : BinomialHeap α le :=\n ⟨.nil, Heap.WF.nil⟩\n\nnamespace BinomialHeap\nvariable {α : Type u} {le : α → α → Bool}\n\n/-- `O(1)`. Make a new empty binomial heap. -/\n@[inline] def empty : BinomialHeap α le := mkBinomialHeap α le\n\ninstance : EmptyCollection (BinomialHeap α le) := ⟨.empty⟩\ninstance : Inhabited (BinomialHeap α le) := ⟨.empty⟩\n\n/-- `O(1)`. Is the heap empty? -/\n@[inline] def isEmpty (b : BinomialHeap α le) : Bool := b.1.isEmpty\n\n/-- `O(log n)`. The number of elements in the heap. -/\n@[inline] def size (b : BinomialHeap α le) : Nat := b.1.size\n\n/-- `O(1)`. Make a new heap containing `a`. -/\n@[inline] def singleton (a : α) : BinomialHeap α le := ⟨Heap.singleton a, Heap.WF.singleton⟩\n\n/-- `O(log n)`. Merge the contents of two heaps. -/\n@[inline] def merge : BinomialHeap α le → BinomialHeap α le → BinomialHeap α le\n | ⟨b₁, h₁⟩, ⟨b₂, h₂⟩ => ⟨b₁.merge le b₂, h₁.merge h₂⟩\n\n/-- `O(log n)`. Add element `a` to the given heap `h`. -/\n@[inline] def insert (a : α) (h : BinomialHeap α le) : BinomialHeap α le := merge (singleton a) h\n\n/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/\ndef ofList (le : α → α → Bool) (as : List α) : BinomialHeap α le := as.foldl (flip insert) empty\n\n/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/\ndef ofArray (le : α → α → Bool) (as : Array α) : BinomialHeap α le := as.foldl (flip insert) empty\n\n/-- `O(log n)`. Remove and return the minimum element from the heap. -/\n@[inline] def deleteMin (b : BinomialHeap α le) : Option (α × BinomialHeap α le) :=\n match eq : b.1.deleteMin le with\n | none => none\n | some (a, tl) => some (a, ⟨tl, b.2.deleteMin eq⟩)\n\ninstance : Std.Stream (BinomialHeap α le) α := ⟨deleteMin⟩\n\n/--\n`O(n log n)`. Implementation of `for x in (b : BinomialHeap α le) ...` notation,\nwhich iterates over the elements in the heap in increasing order.\n-/\nprotected def forIn [Monad m] (b : BinomialHeap α le) (x : β) (f : α → β → m (ForInStep β)) : m β :=\n ForInStep.run <$> b.1.foldM le (.yield x) fun x a => x.bind (f a)\n\ninstance [Monad m] : ForIn m (BinomialHeap α le) α := ⟨BinomialHeap.forIn⟩\n\n/-- `O(log n)`. Returns the smallest element in the heap, or `none` if the heap is empty. -/\n@[inline] def head? (b : BinomialHeap α le) : Option α := b.1.head? le\n\n/-- `O(log n)`. Returns the smallest element in the heap, or panics if the heap is empty. -/\n@[inline] def head! [Inhabited α] (b : BinomialHeap α le) : α := b.head?.get!\n\n/-- `O(log n)`. Returns the smallest element in the heap, or `default` if the heap is empty. -/\n@[inline] def headI [Inhabited α] (b : BinomialHeap α le) : α := b.head?.getD default\n\n/-- `O(log n)`. Removes the smallest element from the heap, or `none` if the heap is empty. -/\n@[inline] def tail? (b : BinomialHeap α le) : Option (BinomialHeap α le) :=\n match eq : b.1.tail? le with\n | none => none\n | some tl => some ⟨tl, b.2.tail? eq⟩\n\n/-- `O(log n)`. Removes the smallest element from the heap, if possible. -/\n@[inline] def tail (b : BinomialHeap α le) : BinomialHeap α le := ⟨b.1.tail le, b.2.tail⟩\n\n/--\n`O(n log n)`. Monadic fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[inline] def foldM [Monad m] (b : BinomialHeap α le) (init : β) (f : β → α → m β) : m β :=\n b.1.foldM le init f\n\n/--\n`O(n log n)`. Fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[inline] def fold (b : BinomialHeap α le) (init : β) (f : β → α → β) : β := b.1.fold le init f\n\n/-- `O(n log n)`. Convert the heap to a list in increasing order. -/\n@[inline] def toList (b : BinomialHeap α le) : List α := b.1.toList le\n\n/-- `O(n log n)`. Convert the heap to an array in increasing order. -/\n@[inline] def toArray (b : BinomialHeap α le) : Array α := b.1.toArray le\n\n/-- `O(n)`. Convert the heap to a list in arbitrary order. -/\n@[inline] def toListUnordered (b : BinomialHeap α le) : List α := b.1.toListUnordered\n\n/-- `O(n)`. Convert the heap to an array in arbitrary order. -/\n@[inline] def toArrayUnordered (b : BinomialHeap α le) : Array α := b.1.toArrayUnordered\n" }, { "path": "Batteries/Data/BinomialHeap/Lemmas.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.BinomialHeap.Basic\n\n@[expose] public section\n\nnamespace Batteries.BinomialHeap\nnamespace Imp\n\ntheorem Heap.findMin_val : ((s : Heap α).findMin le k res).val = s.headD le res.val :=\n match s with\n | .nil => rfl\n | .cons r a c s => by rw [findMin, headD]; split <;> apply findMin_val\n\ntheorem Heap.deleteMin_fst : ((s : Heap α).deleteMin le).map (·.1) = s.head? le :=\n match s with\n | .nil => rfl\n | .cons r a c s => by simp only [deleteMin, findMin_val, Option.map, head?]\n\ntheorem HeapNode.WF.realSize_eq :\n ∀ {n} {s : HeapNode α}, s.WF le a n → s.realSize + 1 = 2 ^ n\n | _, .nil, rfl => rfl\n | _, .node .., ⟨_, rfl, _, c, s⟩ => by\n rw [realSize, realSize_eq c, Nat.pow_succ, Nat.mul_succ]\n simp [Nat.add_assoc, realSize_eq s]\n\ntheorem Heap.WF.size_eq :\n ∀ {s : Heap α}, s.WF le n → s.size = s.realSize\n | .nil, _ => rfl\n | .cons .., ⟨_, h₁, h₂⟩ => by\n simp [size, size_eq h₂]\n simp [Nat.one_shiftLeft, h₁.realSize_eq]\n\nend Imp\n" }, { "path": "Batteries/Data/BinomialHeap.lean", "content": "module\n\npublic import Batteries.Data.BinomialHeap.Basic\npublic import Batteries.Data.BinomialHeap.Lemmas\n" }, { "path": "Batteries/Data/BitVec/Basic.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace BitVec\n\n/-- `ofFnLEAux f` returns the `BitVec m` whose `i`th bit is `f i` when `i < m`, little endian. -/\n@[inline] def ofFnLEAux (m : Nat) (f : Fin n → Bool) : BitVec m :=\n Fin.foldr n (fun i v => v.shiftConcat (f i)) 0\n\n/-- `ofFnLE f` returns the `BitVec n` whose `i`th bit is `f i` with little endian ordering. -/\n@[inline] def ofFnLE (f : Fin n → Bool) : BitVec n := ofFnLEAux n f\n\n/-- `ofFnBE f` returns the `BitVec n` whose `i`th bit is `f i` with big endian ordering. -/\n@[inline] def ofFnBE (f : Fin n → Bool) : BitVec n := ofFnLE fun i => f i.rev\n" }, { "path": "Batteries/Data/BitVec/Lemmas.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\npublic import Batteries.Data.BitVec.Basic\npublic import Batteries.Data.Fin.OfBits\npublic import Batteries.Data.Nat.Lemmas\npublic import Batteries.Data.Int\n\n@[expose] public section\n\nnamespace BitVec\n\n@[simp]\ntheorem toNat_pow (b : BitVec w) (n : Nat) : (b ^ n).toNat = (b.toNat ^ n) % (2 ^ w) := by\n induction n <;> simp_all [Lean.Grind.Semiring.pow_succ]\n\n@[simp]\ntheorem ofNat_pow (w x n : Nat) : BitVec.ofNat w (x ^ n) = BitVec.ofNat w x ^ n := by\n rw [← toNat_inj, toNat_ofNat, toNat_pow, toNat_ofNat, Nat.pow_mod]\n\n@[simp] theorem toNat_ofFnLEAux (m : Nat) (f : Fin n → Bool) :\n (ofFnLEAux m f).toNat = Nat.ofBits f % 2 ^ m := by\n simp only [ofFnLEAux]\n induction n with\n | zero => rfl\n | succ n ih =>\n rw [Fin.foldr_succ, toNat_shiftConcat, Nat.shiftLeft_eq, Nat.pow_one, Nat.ofBits_succ, ih,\n ← Nat.mod_add_div (Nat.ofBits (f ∘ Fin.succ)) (2 ^ m), Nat.mul_add 2, Nat.add_right_comm,\n Nat.mul_left_comm, Nat.add_mul_mod_self_left, Nat.mul_comm 2]\n rfl\n\n@[simp] theorem toFin_ofFnLEAux (m : Nat) (f : Fin n → Bool) :\n (ofFnLEAux m f).toFin = Fin.ofNat (2 ^ m) (Nat.ofBits f) := by\n ext; simp\n\n@[simp, grind =] theorem toNat_ofFnLE (f : Fin n → Bool) : (ofFnLE f).toNat = Nat.ofBits f := by\n rw [ofFnLE, toNat_ofFnLEAux, Nat.mod_eq_of_lt (Nat.ofBits_lt_two_pow f)]\n\n@[simp, grind =] theorem toFin_ofFnLE (f : Fin n → Bool) : (ofFnLE f).toFin = Fin.ofBits f := by\n ext; simp\n\n@[simp, grind =] theorem toInt_ofFnLE (f : Fin n → Bool) : (ofFnLE f).toInt = Int.ofBits f := by\n simp only [BitVec.toInt, Int.ofBits, toNat_ofFnLE, Int.subNatNat_eq_coe]; rfl\n\n-- TODO: consider these for global `grind` attributes.\nattribute [local grind =] Fin.succ Fin.rev Fin.last Fin.zero_eta\n\ntheorem getElem_ofFnLEAux (f : Fin n → Bool) (i) (h : i < n) (h' : i < m) :\n (ofFnLEAux m f)[i] = f ⟨i, h⟩ := by\n simp only [ofFnLEAux]\n induction n generalizing i m with\n | zero => contradiction\n | succ n ih =>\n simp only [Fin.foldr_succ, getElem_shiftConcat]\n cases i with\n | zero => grind\n | succ i => rw [ih] <;> grind\n\n@[simp, grind =] theorem getElem_ofFnLE (f : Fin n → Bool) (i) (h : i < n) :\n (ofFnLE f)[i] = f ⟨i, h⟩ :=\n getElem_ofFnLEAux ..\n\n@[grind =]\ntheorem getLsb_ofFnLE (f : Fin n → Bool) (i) : (ofFnLE f).getLsb i = f i := by simp\n\n@[deprecated (since := \"2025-06-17\")] alias getLsb'_ofFnLE := getLsb_ofFnLE\n\ntheorem getLsbD_ofFnLE (f : Fin n → Bool) (i) :\n (ofFnLE f).getLsbD i = if h : i < n then f ⟨i, h⟩ else false := by\n grind\n\n@[simp, grind =] theorem getMsb_ofFnLE (f : Fin n → Bool) (i) : (ofFnLE f).getMsb i = f i.rev := by\n grind\n\n@[deprecated (since := \"2025-06-17\")] alias getMsb'_ofFnLE := getMsb_ofFnLE\n\n@[grind =]\ntheorem getMsbD_ofFnLE (f : Fin n → Bool) (i) :\n (ofFnLE f).getMsbD i = if h : i < n then f (Fin.rev ⟨i, h⟩) else false := by\n grind\n\ntheorem msb_ofFnLE (f : Fin n → Bool) :\n (ofFnLE f).msb = if h : n ≠ 0 then f ⟨n-1, Nat.sub_one_lt h⟩ else false := by\n grind\n\n@[simp, grind =] theorem toNat_ofFnBE (f : Fin n → Bool) :\n (ofFnBE f).toNat = Nat.ofBits (f ∘ Fin.rev) := by\n simp [ofFnBE]; rfl\n\n@[simp, grind =] theorem toFin_ofFnBE (f : Fin n → Bool) :\n (ofFnBE f).toFin = Fin.ofBits (f ∘ Fin.rev) := by\n ext; simp\n\n@[simp, grind =] theorem toInt_ofFnBE (f : Fin n → Bool) :\n (ofFnBE f).toInt = Int.ofBits (f ∘ Fin.rev) := by\n simp [ofFnBE]; rfl\n\n@[simp, grind =] theorem getElem_ofFnBE (f : Fin n → Bool) (i) (h : i < n) :\n (ofFnBE f)[i] = f (Fin.rev ⟨i, h⟩) := by simp [ofFnBE]\n\n@[grind =]\ntheorem getLsb_ofFnBE (f : Fin n → Bool) (i) : (ofFnBE f).getLsb i = f i.rev := by\n simp\n\n@[deprecated (since := \"2025-06-17\")] alias getLsb'_ofFnBE := getLsb_ofFnBE\n\ntheorem getLsbD_ofFnBE (f : Fin n → Bool) (i) :\n (ofFnBE f).getLsbD i = if h : i < n then f (Fin.rev ⟨i, h⟩) else false := by\n grind\n\n@[simp, grind =] theorem getMsb_ofFnBE (f : Fin n → Bool) (i) : (ofFnBE f).getMsb i = f i := by\n simp [ofFnBE]\n\n@[deprecated (since := \"2025-06-17\")] alias getMsb'_ofFnBE := getMsb_ofFnBE\n\n@[grind =]\ntheorem getMsbD_ofFnBE (f : Fin n → Bool) (i) :\n (ofFnBE f).getMsbD i = if h : i < n then f ⟨i, h⟩ else false := by\n grind\n\n@[grind =]\ntheorem msb_ofFnBE (f : Fin n → Bool) :\n (ofFnBE f).msb = if h : n ≠ 0 then f ⟨0, Nat.zero_lt_of_ne_zero h⟩ else false := by\n grind\n" }, { "path": "Batteries/Data/BitVec.lean", "content": "module\n\npublic import Batteries.Data.BitVec.Basic\npublic import Batteries.Data.BitVec.Lemmas\n" }, { "path": "Batteries/Data/Bool.lean", "content": "/-\nCopyright (c) 2026 Chad Sharp. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Chad Sharp\n-/\nmodule\n\n@[expose] public section\n\n/-!\nThis file contains `WellFoundedRelation` instances `Bool`.\n\nThey are provided as defs rather than instances, despite WellFoundedRelation being a class, as we\nprovide versions for both < and >. If you need instances, you may use the WellFoundedLT and\nWellFoundedGT classes available in Mathlib.\n-/\n\n/-- Boolean '<' is well founded -/\n@[implicit_reducible]\ndef Bool.lt_wfRel : WellFoundedRelation Bool where\n rel := (· < ·)\n wf := ⟨fun\n | false => ⟨false, nofun⟩\n | true => ⟨true, fun | false, _ => ⟨false, nofun⟩⟩⟩\n\n/-- Boolean '>' is well founded -/\n@[implicit_reducible]\ndef Bool.gt_wfRel : WellFoundedRelation Bool where\n rel := (· > ·)\n wf := ⟨fun\n | true => ⟨true, nofun⟩\n | false => ⟨false, fun | true, _ => ⟨true, nofun⟩⟩⟩\n" }, { "path": "Batteries/Data/ByteArray.lean", "content": "/-\nCopyright (c) 2023 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace ByteArray\n\nattribute [ext] ByteArray\n\ninstance : DecidableEq ByteArray :=\n fun _ _ => decidable_of_decidable_of_iff ByteArray.ext_iff.symm\n\ntheorem getElem_eq_data_getElem (a : ByteArray) (h : i < a.size) : a[i] = a.data[i] := rfl\n\n/-! ### uget/uset -/\n\n@[simp] theorem uset_eq_set (a : ByteArray) {i : USize} (h : i.toNat < a.size) (v : UInt8) :\n a.uset i v h = a.set i.toNat v := rfl\n\n/-! ### empty -/\n\n@[simp] theorem data_mkEmpty (cap) : (emptyWithCapacity cap).data = #[] := rfl\n\n/-! ### push -/\n\n@[simp] theorem get_push_eq (a : ByteArray) (x : UInt8) : (a.push x)[a.size] = x :=\n Array.getElem_push_eq ..\n\ntheorem get_push_lt (a : ByteArray) (x : UInt8) (i : Nat) (h : i < a.size) :\n (a.push x)[i]'(size_push .. ▸ Nat.lt_succ_of_lt h) = a[i] :=\n Array.getElem_push_lt ..\n\n/-! ### set -/\n\n@[simp] theorem size_set (a : ByteArray) (i : Fin a.size) (v : UInt8) :\n (a.set i v).size = a.size :=\n Array.size_set ..\n\n@[simp] theorem get_set_eq (a : ByteArray) (i : Fin a.size) (v : UInt8) : (a.set i v)[i.val] = v :=\n Array.getElem_set_self _\n\ntheorem get_set_ne (a : ByteArray) (i : Fin a.size) (v : UInt8) (hj : j < a.size) (h : i.val ≠ j) :\n (a.set i v)[j]'(a.size_set .. ▸ hj) = a[j] :=\n Array.getElem_set_ne (h := h) ..\n\ntheorem set_set (a : ByteArray) (i : Fin a.size) (v v' : UInt8) :\n (a.set i v).set i v' = a.set i v' :=\n ByteArray.ext <| Array.set_set ..\n\n/-! ### copySlice -/\n\n@[simp] theorem data_copySlice (a i b j len exact) :\n (copySlice a i b j len exact).data = b.data.extract 0 j ++ a.data.extract i (i + len)\n ++ b.data.extract (j + min len (a.data.size - i)) b.data.size := rfl\n\n/-! ### append -/\n\ntheorem get_append_left {a b : ByteArray} (hlt : i < a.size)\n (h : i < (a ++ b).size := size_append .. ▸ Nat.lt_of_lt_of_le hlt (Nat.le_add_right ..)) :\n (a ++ b)[i] = a[i] := by\n simp [getElem_eq_data_getElem]; exact Array.getElem_append_left hlt\n\ntheorem get_append_right {a b : ByteArray} (hle : a.size ≤ i) (h : i < (a ++ b).size)\n (h' : i - a.size < b.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) :\n (a ++ b)[i] = b[i - a.size] := by\n simp [getElem_eq_data_getElem]; exact Array.getElem_append_right hle\n\n/-! ### extract -/\n\ntheorem get_extract_aux {a : ByteArray} {start stop} (h : i < (a.extract start stop).size) :\n start + i < a.size := by\n apply Nat.add_lt_of_lt_sub'; apply Nat.lt_of_lt_of_le h\n rw [size_extract, ← Nat.sub_min_sub_right]; exact Nat.min_le_right ..\n\n@[simp] theorem get_extract {a : ByteArray} {start stop} (h : i < (a.extract start stop).size) :\n (a.extract start stop)[i] = a[start+i]'(get_extract_aux h) := by\n simp [getElem_eq_data_getElem]; rfl\n\n/-! ### ofFn -/\n\n/--- `ofFn f` with `f : Fin n → UInt8` returns the byte array whose `i`th element is `f i`. --/\n@[inline] def ofFn (f : Fin n → UInt8) : ByteArray :=\n Fin.foldl n (fun acc i => acc.push (f i)) (emptyWithCapacity n)\n\n@[simp] theorem ofFn_zero (f : Fin 0 → UInt8) : ofFn f = empty := by simp [ofFn]\n\ntheorem ofFn_succ (f : Fin (n+1) → UInt8) :\n ofFn f = (ofFn fun i => f i.castSucc).push (f (Fin.last n)) := by\n simp [ofFn, Fin.foldl_succ_last, emptyWithCapacity]\n\n@[simp] theorem data_ofFn (f : Fin n → UInt8) : (ofFn f).data = .ofFn f := by\n induction n with\n | zero => simp\n | succ n ih => simp [ofFn_succ, Array.ofFn_succ, ih, Fin.last]\n\n@[simp] theorem size_ofFn (f : Fin n → UInt8) : (ofFn f).size = n := by\n simp [size]\n\n@[simp] theorem get_ofFn (f : Fin n → UInt8) (i : Fin (ofFn f).size) :\n (ofFn f).get i = f (i.cast (size_ofFn f)) := by\n simp [get, Fin.cast]\n\n@[simp] theorem getElem_ofFn (f : Fin n → UInt8) (i) (h : i < (ofFn f).size) :\n (ofFn f)[i] = f ⟨i, size_ofFn f ▸ h⟩ := get_ofFn f ⟨i, h⟩\n\n/-! ### map/mapM -/\n\n/--\nUnsafe optimized implementation of `mapM`.\n\nThis function is unsafe because it relies on the implementation limit that the size of an array is\nalways less than `USize.size`.\n-/\n@[inline]\nunsafe def mapMUnsafe [Monad m] (a : ByteArray) (f : UInt8 → m UInt8) : m ByteArray :=\n loop a 0 a.usize\nwhere\n /-- Inner loop for `mapMUnsafe`. -/\n @[specialize]\n loop (a : ByteArray) (k s : USize) := do\n if k < a.usize then\n let x := a.uget k lcProof\n let y ← f x\n let a := a.uset k y lcProof\n loop a (k+1) s\n else pure a\n\n/-- `mapM f a` applies the monadic function `f` to each element of the array. -/\n@[implemented_by mapMUnsafe]\ndef mapM [Monad m] (a : ByteArray) (f : UInt8 → m UInt8) : m ByteArray := do\n let mut r := a\n for i in [0:r.size] do\n r := r.set! i (← f r[i]!)\n return r\n\n/-- `map f a` applies the function `f` to each element of the array. -/\n@[inline]\ndef map (a : ByteArray) (f : UInt8 → UInt8) : ByteArray :=\n mapM (m:=Id) a f\n" }, { "path": "Batteries/Data/ByteSlice.lean", "content": "\n/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, François G. Dorais\n-/\nmodule\n\npublic import Std.Data.ByteSlice\nimport all Std.Data.ByteSlice -- for unfolding `ByteSlice.size`\n\n@[expose] public section\n\nnamespace ByteSlice\n\n/-- Test whether a byte slice is empty. -/\nprotected abbrev isEmpty (s : ByteSlice) := s.start == s.stop\n\ntheorem stop_eq_start_add_size (s : ByteSlice) : s.stop = s.start + s.size := by\n rw [ByteSlice.size, Nat.add_sub_cancel' s.start_le_stop]\n\n/-- Returns the subslice obtained by removing the last element. -/\nabbrev pop (s : ByteSlice) : ByteSlice :=\n s.slice 0 (s.size - 1)\n\n/-- Returns the subslice obtained by removing the first element. -/\nabbrev popFront (s : ByteSlice) : ByteSlice :=\n s.slice 1 s.size\n\n/-- Folds a monadic function over a `ByteSubarray` from left to right. -/\n@[inline]\ndef foldlM [Monad m] (s : ByteSlice) (f : β → UInt8 → m β) (init : β) : m β :=\n s.toByteArray.foldlM f init s.start s.stop\n\n/-- Folds a function over a `ByteSubarray` from left to right. -/\n@[inline]\ndef foldl (s : ByteSlice) (f : β → UInt8 → β) (init : β) : β :=\n s.foldlM (m:=Id) f init\n\n/-- Implementation of `forIn` for a `ByteSlice`. -/\n@[specialize]\nprotected def forIn [Monad m] (s : ByteSlice) (init : β) (f : UInt8 → β → m (ForInStep β)) :\n m β := loop s.size (Nat.le_refl _) init\nwhere\n /-- Inner loop of the `forIn` implementation for `ByteSlice`. -/\n loop (i : Nat) (h : i ≤ s.size) (b : β) : m β := do\n match i, h with\n | 0, _ => pure b\n | i+1, h =>\n match (← f s[s.size - 1 - i] b) with\n | ForInStep.done b => pure b\n | ForInStep.yield b => loop i (Nat.le_of_succ_le h) b\n\ninstance [Monad m] : ForIn m ByteSlice UInt8 where\n forIn := ByteSlice.forIn\n\ninstance : Std.Stream ByteSlice UInt8 where\n next? s := s[0]? >>= (·, s.popFront)\n\ninstance : Coe ByteArray ByteSlice where\n coe := ByteArray.toByteSlice\n\nend ByteSlice\n\nnamespace Batteries\n\n/-- A subarray of a `ByteArray`. -/\n@[deprecated ByteSlice (since := \"2025-10-04\")]\nstructure ByteSubarray where\n /-- `O(1)`. Get data array of a `ByteSubarray`. -/\n array : ByteArray\n /-- `O(1)`. Get start index of a `ByteSubarray`. -/\n start : Nat\n /-- `O(1)`. Get stop index of a `ByteSubarray`. -/\n stop : Nat\n /-- Start index is before stop index. -/\n start_le_stop : start ≤ stop\n /-- Stop index is before end of data array. -/\n stop_le_array_size : stop ≤ array.size\n\nnamespace ByteSubarray\nset_option linter.deprecated false\n\nattribute [deprecated ByteSlice.byteArray (since := \"2025-10-04\")]\n ByteSubarray.array\n\nattribute [deprecated ByteSlice.start (since := \"2025-10-04\")]\n ByteSubarray.start\n\nattribute [deprecated ByteSlice.stop (since := \"2025-10-04\")]\n ByteSubarray.stop\n\nattribute [deprecated ByteSlice.start_le_stop (since := \"2025-10-04\")]\n ByteSubarray.start_le_stop\n\nattribute [deprecated ByteSlice.stop_le_size_byteArray (since := \"2025-10-04\")]\n ByteSubarray.stop_le_array_size\n\n/-- `O(1)`. Get the size of a `ByteSubarray`. -/\n@[deprecated ByteSlice.size (since := \"2025-10-04\")]\nprotected def size (self : ByteSubarray) := self.stop - self.start\n\n/-- `O(1)`. Test if a `ByteSubarray` is empty. -/\n@[deprecated ByteSlice.isEmpty (since := \"2025-10-04\")]\nprotected def isEmpty (self : ByteSubarray) := self.start == self.stop\n\n@[deprecated ByteSlice.stop_eq_start_add_size (since := \"2025-10-04\")]\ntheorem stop_eq_start_add_size (self : ByteSubarray) : self.stop = self.start + self.size := by\n rw [ByteSubarray.size, Nat.add_sub_cancel' self.start_le_stop]\n\n/-- `O(n)`. Extract a `ByteSubarray` to a `ByteArray`. -/\n@[deprecated ByteSlice.toByteArray (since := \"2025-10-04\")]\ndef toByteArray (self : ByteSubarray) : ByteArray :=\n self.array.extract self.start self.stop\n\n/-- `O(1)`. Get the element at index `i` from the start of a `ByteSubarray`. -/\n@[deprecated ByteSlice.get (since := \"2025-10-04\"), inline]\ndef get (self : ByteSubarray) (i : Fin self.size) : UInt8 :=\n have : self.start + i.1 < self.array.size := by\n apply Nat.lt_of_lt_of_le _ self.stop_le_array_size\n rw [stop_eq_start_add_size]\n apply Nat.add_lt_add_left i.is_lt self.start\n self.array[self.start + i.1]\n\ninstance : GetElem ByteSubarray Nat UInt8 fun self i => i < self.size where\n getElem self i h := self.get ⟨i, h⟩\n\n/-- `O(1)`. Pop the last element of a `ByteSubarray`. -/\n@[deprecated ByteSlice.pop (since := \"2025-10-04\"), inline]\ndef pop (self : ByteSubarray) : ByteSubarray :=\n if h : self.start = self.stop then self else\n {self with\n stop := self.stop - 1\n start_le_stop := Nat.le_pred_of_lt (Nat.lt_of_le_of_ne self.start_le_stop h)\n stop_le_array_size := Nat.le_trans (Nat.pred_le _) self.stop_le_array_size\n }\n\n/-- `O(1)`. Pop the first element of a `ByteSubarray`. -/\n@[deprecated ByteSlice.popFront (since := \"2025-10-04\"), inline]\ndef popFront (self : ByteSubarray) : ByteSubarray :=\n if h : self.start = self.stop then self else\n {self with\n start := self.start + 1\n start_le_stop := Nat.succ_le_of_lt (Nat.lt_of_le_of_ne self.start_le_stop h)\n }\n\n/-- Folds a monadic function over a `ByteSubarray` from left to right. -/\n@[deprecated ByteSlice.foldlM (since := \"2025-10-04\"), inline]\ndef foldlM [Monad m] (self : ByteSubarray) (f : β → UInt8 → m β) (init : β) : m β :=\n self.array.foldlM f init self.start self.stop\n\n/-- Folds a function over a `ByteSubarray` from left to right. -/\n@[deprecated ByteSlice.foldl (since := \"2025-10-04\"), inline]\ndef foldl (self : ByteSubarray) (f : β → UInt8 → β) (init : β) : β :=\n self.foldlM (m:=Id) f init\n\n/-- Implementation of `forIn` for a `ByteSubarray`. -/\n@[specialize]\n--@[deprecated ByteSlice.forIn (since := \"2025-10-04\"), specialize]\nprotected def forIn [Monad m] (self : ByteSubarray) (init : β) (f : UInt8 → β → m (ForInStep β)) :\n m β := loop self.size (Nat.le_refl _) init\nwhere\n /-- Inner loop of the `forIn` implementation for `ByteSubarray`. -/\n loop (i : Nat) (h : i ≤ self.size) (b : β) : m β := do\n match i, h with\n | 0, _ => pure b\n | i+1, h =>\n match (← f self[self.size - 1 - i] b) with\n | ForInStep.done b => pure b\n | ForInStep.yield b => loop i (Nat.le_of_succ_le h) b\n\ninstance [Monad m] : ForIn m ByteSubarray UInt8 where\n forIn := ByteSubarray.forIn\n\ninstance : Std.Stream ByteSubarray UInt8 where\n next? s := s[0]? >>= fun x => (x, s.popFront)\n\nend Batteries.ByteSubarray\n\nset_option linter.deprecated false in\n/-- `O(1)`. Coerce a byte array into a byte slice. -/\n@[deprecated ByteArray.toByteSlice (since := \"2025-10-04\")]\ndef ByteArray.toByteSubarray (array : ByteArray) : Batteries.ByteSubarray where\n array := array\n start := 0\n stop := array.size\n start_le_stop := Nat.zero_le _\n stop_le_array_size := Nat.le_refl _\n\nset_option linter.deprecated false in\ninstance : Coe ByteArray Batteries.ByteSubarray where\n coe := ByteArray.toByteSubarray\n" }, { "path": "Batteries/Data/Char/AsciiCasing.lean", "content": "/-\nCopyright (c) 2025 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Data.Char.Basic\npublic import Batteries.Tactic.Basic\n\n@[expose] public section\n\n/-! # Lemmas for ASCII-casing\n\nThese facts apply for ASCII characters only. Recall that `isAlpha`, `isLower`, `isUpper`, `toLower`,\n`toUpper` do not consider characters outside the ASCII character range (code points less than 128).\n-/\n\nnamespace Char\n\ntheorem not_isLower_of_isUpper {c : Char} : c.isUpper → ¬ c.isLower := by\n simp [isUpper, UInt32.le_iff_toNat_le, isLower]\n omega\n\ntheorem not_isUpper_of_isLower {c : Char} : c.isLower → ¬ c.isUpper := by\n simp [isUpper, UInt32.le_iff_toNat_le, isLower]\n omega\n\ntheorem toLower_eq_of_not_isUpper {c : Char} (h : ¬ c.isUpper) : c.toLower = c := by\n simp_all [isUpper, UInt32.le_iff_toNat_le, toLower]\n omega\n\ntheorem toLower_eq_of_isUpper {c : Char} (h : c.isUpper) : c.toLower = ofNat (c.toNat + 32) := by\n ext\n rw [val_ofNat, UInt32.ofNat_add]\n · simp_all [isUpper, toLower]\n · simp [isUpper, UInt32.le_iff_toNat_le] at h; grind\n\ntheorem toUpper_eq_of_not_isLower {c : Char} (h : ¬ c.isLower) : c.toUpper = c := by\n simp only [isLower, Bool.and_eq_true, decide_eq_true_eq] at h\n simp only [toUpper, dif_neg h]\n\ntheorem toUpper_eq_of_isLower {c : Char} (h : c.isLower) : c.toUpper = ofNat (c.toNat - 32) := by\n ext\n rw [val_ofNat, UInt32.ofNat_sub]\n · simp_all [toUpper, isLower]; grind\n · simp [isLower, UInt32.le_iff_toNat_le] at h; grind\n · simp [isLower, UInt32.le_iff_toNat_le] at h; grind\n\n@[simp] theorem isUpper_toLower_eq_false (c : Char) : c.toLower.isUpper = false := by\n simp only [isUpper, toLower]\n split <;> grind [UInt32.toNat_add, toNat_val]\n\n@[simp] theorem isLower_toUpper_eq_false (c : Char) : c.toUpper.isLower = false := by\n simp only [isLower, toUpper]\n split <;> grind [UInt32.toNat_add, toNat_val]\n\n@[simp] theorem isLower_toLower_eq_isAlpha (c : Char) : c.toLower.isLower = c.isAlpha := by\n rw [Bool.eq_iff_iff]\n by_cases h : c.isUpper\n · simp only [isLower, h, toLower_eq_of_isUpper, ↓Char.isValue, Char.reduceVal, ge_iff_le,\n UInt32.le_iff_toNat_le, UInt32.reduceToNat, toNat_val, Bool.and_eq_true, decide_eq_true_eq,\n isAlpha, Bool.true_or, iff_true]\n simp only [isUpper, ↓Char.isValue, Char.reduceVal, ge_iff_le, UInt32.le_iff_toNat_le,\n UInt32.reduceToNat, toNat_val, Bool.decide_and, Bool.and_eq_true, decide_eq_true_eq] at h\n have : (c.toNat + 32).isValidChar := by omega\n simp [toNat_ofNat, *]\n · simp [toLower_eq_of_not_isUpper, isAlpha, h]\n\n@[simp] theorem isUpper_toUpper_eq_isAlpha (c : Char) : c.toUpper.isUpper = c.isAlpha := by\n rw [Bool.eq_iff_iff]\n by_cases h : c.isLower\n · simp only [isUpper, h, toUpper_eq_of_isLower, ↓Char.isValue, Char.reduceVal, ge_iff_le,\n UInt32.le_iff_toNat_le, UInt32.reduceToNat, toNat_val, Bool.decide_and, Bool.and_eq_true,\n decide_eq_true_eq, isAlpha, Bool.or_true, iff_true]\n simp only [isLower, ↓Char.isValue, Char.reduceVal, ge_iff_le, UInt32.le_iff_toNat_le,\n UInt32.reduceToNat, toNat_val, Bool.and_eq_true, decide_eq_true_eq] at h\n have : (c.toNat - 32).isValidChar := by omega\n have : 32 ≤ c.toNat := by omega\n simp [toNat_ofNat, Nat.le_sub_iff_add_le, *]\n · simp [toUpper_eq_of_not_isLower, isAlpha, h]\n\n@[simp] theorem isAlpha_toLower_eq_isAlpha (c : Char) : c.toLower.isAlpha = c.isAlpha := by\n simp [isAlpha]\n\n@[simp] theorem isAlpha_toUpper_eq_isAlpha (c : Char) : c.toUpper.isAlpha = c.isAlpha := by\n simp [isAlpha]\n\n@[simp] theorem toLower_toLower_eq_toLower (c : Char) : c.toLower.toLower = c.toLower := by\n simp [toLower_eq_of_not_isUpper]\n\n@[simp] theorem toLower_toUpper_eq_toLower (c : Char) : c.toUpper.toLower = c.toLower := by\n by_cases hl : c.isLower\n · have hu : ¬ c.isUpper := not_isUpper_of_isLower hl\n have hu' : c.toUpper.isUpper := by simp [isAlpha, hl]\n have hv : (c.toNat - 32).isValidChar := by\n simp only [isLower, isUpper, UInt32.le_iff_toNat_le, toNat_val] at hl hu\n grind\n have h : 32 ≤ c.toNat := by\n simp only [isLower, ↓Char.isValue, Char.reduceVal, ge_iff_le, UInt32.le_iff_toNat_le,\n UInt32.reduceToNat, toNat_val, Bool.and_eq_true, decide_eq_true_eq, isUpper,\n Bool.decide_and, not_and, Nat.not_le] at hl hu\n omega\n rw [toLower_eq_of_isUpper hu', toUpper_eq_of_isLower hl, toLower_eq_of_not_isUpper hu,\n toNat_ofNat, if_pos hv, Nat.sub_add_cancel h, ofNat_toNat]\n · rw [toUpper_eq_of_not_isLower hl]\n\n@[simp] theorem toUpper_toUpper_eq_toUpper (c : Char) : c.toUpper.toUpper = c.toUpper := by\n simp [toUpper_eq_of_not_isLower]\n\n@[simp] theorem toUpper_toLower_eq_toUpper (c : Char) : c.toLower.toUpper = c.toUpper := by\n by_cases hu : c.isUpper\n · have hl : ¬ c.isLower := not_isLower_of_isUpper hu\n have hl' : c.toLower.isLower := by simp [isAlpha, hu]\n have hv : (c.toNat + 32).isValidChar := by\n simp only [isUpper, ↓Char.isValue, Char.reduceVal, ge_iff_le, UInt32.le_iff_toNat_le,\n UInt32.reduceToNat, toNat_val, Bool.decide_and, Bool.and_eq_true, decide_eq_true_eq,\n isLower, not_and, Nat.not_le] at hu hl\n omega\n rw [toUpper_eq_of_isLower hl', toLower_eq_of_isUpper hu, toUpper_eq_of_not_isLower hl,\n toNat_ofNat, if_pos hv, Nat.add_sub_cancel, ofNat_toNat]\n · rw [toLower_eq_of_not_isUpper hu]\n\n/-- Case folding for ASCII characters only.\n\nAlphabetic ASCII characters are mapped to their lowercase form, all other characters are left\nunchanged. This agrees with the Unicode case folding algorithm for ASCII characters.\n\n```\n#eval caseFoldAsciiOnly 'A' == 'a'\n#eval caseFoldAsciiOnly 'a' == 'a'\n#eval caseFoldAsciiOnly 'À' == 'À'\n#eval caseFoldAsciiOnly 'à' == 'à'\n#eval caseFoldAsciiOnly '$' == '$'\n```\n-/\nabbrev caseFoldAsciiOnly := Char.toLower\n\n/--\nBool-valued comparison of two `Char`s for *ASCII*-case insensitive equality.\n\n```\n#eval beqCaseInsensitiveAsciiOnly 'a' 'A' -- true\n#eval beqCaseInsensitiveAsciiOnly 'a' 'a' -- true\n#eval beqCaseInsensitiveAsciiOnly '$' '$' -- true\n#eval beqCaseInsensitiveAsciiOnly 'a' 'b' -- false\n#eval beqCaseInsensitiveAsciiOnly 'γ' 'Γ' -- false\n#eval beqCaseInsensitiveAsciiOnly 'ä' 'Ä' -- false\n```\n-/\ndef beqCaseInsensitiveAsciiOnly (c₁ c₂ : Char) : Bool :=\n c₁.caseFoldAsciiOnly == c₂.caseFoldAsciiOnly\n\ntheorem beqCaseInsensitiveAsciiOnly.eqv : Equivalence (beqCaseInsensitiveAsciiOnly · ·) := {\n refl _ := BEq.rfl\n trans _ _ := by simp_all [beqCaseInsensitiveAsciiOnly]\n symm := by simp_all [beqCaseInsensitiveAsciiOnly]}\n\n/--\nSetoid structure on `Char` using `beqCaseInsensitiveAsciiOnly`\n-/\n@[implicit_reducible]\ndef beqCaseInsensitiveAsciiOnly.isSetoid : Setoid Char:=\n ⟨(beqCaseInsensitiveAsciiOnly · ·), beqCaseInsensitiveAsciiOnly.eqv⟩\n\n/--\nASCII-case insensitive implementation comparison returning an `Ordering`. Useful for sorting.\n\n```\n#eval cmpCaseInsensitiveAsciiOnly 'a' 'A' -- eq\n#eval cmpCaseInsensitiveAsciiOnly 'a' 'a' -- eq\n#eval cmpCaseInsensitiveAsciiOnly '$' '$' -- eq\n#eval cmpCaseInsensitiveAsciiOnly 'a' 'b' -- lt\n#eval cmpCaseInsensitiveAsciiOnly 'γ' 'Γ' -- gt\n#eval cmpCaseInsensitiveAsciiOnly 'ä' 'Ä' -- gt\n```\n-/\ndef cmpCaseInsensitiveAsciiOnly (c₁ c₂ : Char) : Ordering :=\n compare c₁.caseFoldAsciiOnly c₂.caseFoldAsciiOnly\n" }, { "path": "Batteries/Data/Char/Basic.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg, François G. Dorais\n-/\nmodule\n\npublic import Batteries.Classes.Order\npublic import Batteries.Data.List.Lemmas\n\n@[expose] public section\n\nnamespace Char\n\ntheorem le_antisymm_iff {x y : Char} : x = y ↔ x ≤ y ∧ y ≤ x :=\n Char.ext_iff.trans UInt32.le_antisymm_iff\n\ninstance : Std.LawfulOrd Char :=\n .compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt Char.le_antisymm\n\n@[simp] theorem toNat_ofNatAux {n : Nat} (h : n.isValidChar) : toNat (ofNatAux n h) = n := by\n simp [ofNatAux, toNat]\n\ntheorem toNat_ofNat (n : Nat) : toNat (ofNat n) = if n.isValidChar then n else 0 := by\n split\n · simp [ofNat, *]\n · simp [ofNat, toNat, *]\n\n@[simp]\ntheorem val_ofNat (hn : Nat.isValidChar n) : (ofNat n).val = UInt32.ofNat n := by\n simp [ofNat, hn, ofNatAux, UInt32.ofNatLT_eq_ofNat]\n\n@[simp]\ntheorem ofNat_toNat_eq_val {c : Char} : UInt32.ofNat c.toNat = c.val := by\n rw [← toNat_val, UInt32.ofNat_toNat]\n\n/--\nMaximum character code point.\n(See [unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).)\n-/\nprotected abbrev max := 0x10FFFF\n\n/--\nMaximum surrogate code point.\n(See [unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).)\n-/\nprotected abbrev maxSurrogate := 0xDFFF\n\n/--\nMinimum surrogate code point.\n(See [unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).)\n-/\nprotected abbrev minSurrogate := 0xD800\n\n/--\nNumber of valid character code points.\n(See [unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).)\n-/\nprotected abbrev count := Char.max - Char.maxSurrogate + Char.minSurrogate\n\n@[grind .] theorem toNat_le_max (c : Char) : c.toNat ≤ Char.max := by\n match c.valid with\n | .inl h => simp only [toNat_val] at h; grind\n | .inr ⟨_, h⟩ => simp only [toNat_val] at h; grind\n\n@[grind .] theorem toNat_not_surrogate (c : Char) :\n ¬(Char.minSurrogate ≤ c.toNat ∧ c.toNat ≤ Char.maxSurrogate) := by\n match c.valid with\n | .inl h => simp only [toNat_val] at h; grind\n | .inr ⟨h, _⟩ => simp only [toNat_val] at h; grind\n\n/-- Returns `true` if `p` returns true for every `Char`. -/\nprotected def all (p : Char → Bool) : Bool :=\n Nat.all Char.minSurrogate (fun c h₁ => p <| Char.ofNatAux c <| .inl h₁) &&\n Nat.all (Char.max - Char.maxSurrogate) fun c h₂ =>\n p <| Char.ofNatAux (c + (Char.maxSurrogate + 1)) <| .inr (by grind)\n\nprivate theorem of_all_eq_true_aux (h : Char.all p) (n : Nat) (hn : n.isValidChar) :\n p (.ofNatAux n hn) := by\n simp only [Char.all, Nat.all_eq_finRange_all, List.all_eq_true, Bool.and_eq_true] at h\n match hn with\n | .inl hn =>\n have := h.1 ⟨n, by grind⟩\n grind\n | .inr ⟨hn, hn'⟩ =>\n -- https://github.com/leanprover/lean4/issues/11059\n have := h.2 ⟨n - (Char.maxSurrogate + 1), by rw [Char.maxSurrogate, Char.max]; omega ⟩\n grind\n\ntheorem eq_true_of_all_eq_true (h : Char.all p) (c : Char) : p c := by\n have : c.toNat.isValidChar := c.valid\n rw [← c.ofNat_toNat, ofNat, dif_pos this]\n exact of_all_eq_true_aux h c.toNat this\n\ntheorem exists_eq_false_of_all_eq_false (h : Char.all p = false) :\n ∃ c, p c = false := by\n simp only [Char.all, Nat.all_eq_finRange_all, List.all_eq_false, Bool.and_eq_false_iff] at h\n simp only [Bool.eq_false_iff]\n match h with\n | .inl ⟨⟨n, hn⟩, _, h⟩ => exact ⟨Char.ofNatAux n (.inl hn), h⟩\n | .inr ⟨⟨n, _⟩, _, h⟩ => exact ⟨Char.ofNatAux (n + (Char.maxSurrogate + 1)) (.inr (by grind)), h⟩\n\ntheorem all_eq_true_iff_forall_eq_true : Char.all p = true ↔ ∀ c, p c = true := by\n constructor\n · exact eq_true_of_all_eq_true\n · intro h\n cases heq : Char.all p\n · obtain ⟨c, hc⟩ := exists_eq_false_of_all_eq_false heq\n simp [h c] at hc\n · trivial\n\n/-- Returns `true` if `p` returns true for some `Char`. -/\nprotected def any (p : Char → Bool) : Bool :=\n Nat.any Char.minSurrogate (fun c h₁ => p <| Char.ofNatAux c <| .inl h₁) ||\n Nat.any (Char.max - Char.maxSurrogate) fun c h₂ =>\n p <| Char.ofNatAux (c + Char.maxSurrogate + 1) <| .inr (by grind)\n\ntheorem exists_eq_true_of_any_eq_true (h : Char.any p = true) : ∃ c, p c = true := by\n simp only [Char.any, Nat.any_eq_finRange_any, List.any_eq_true, Bool.or_eq_true] at h\n match h with\n | .inl ⟨⟨n, hn⟩, _, h⟩ => exact ⟨Char.ofNatAux n (.inl hn), h⟩\n | .inr ⟨⟨n, _⟩, _, h⟩ => exact ⟨Char.ofNatAux (n + Char.maxSurrogate + 1) (.inr (by grind)), h⟩\n\nprivate theorem of_any_eq_false_aux (h : Char.any p = false) (n : Nat) (hn : n.isValidChar) :\n p (.ofNatAux n hn) = false := by\n simp only [Char.any, Nat.any_eq_finRange_any, List.any_eq_false, Bool.or_eq_false_iff] at h\n match hn with\n | .inl hn =>\n have := h.1 ⟨n, hn⟩ (List.mem_finRange _)\n grind\n | .inr ⟨hn, hn'⟩ =>\n -- https://github.com/leanprover/lean4/issues/11059\n have := h.2 ⟨n - (Char.maxSurrogate + 1), by rw [Char.maxSurrogate, Char.max]; omega⟩\n (List.mem_finRange _)\n grind\n\ntheorem eq_false_of_any_eq_false (h : Char.any p = false) (c : Char) : p c = false := by\n have : c.toNat.isValidChar := c.valid\n rw [← c.ofNat_toNat, ofNat, dif_pos this]\n exact of_any_eq_false_aux h c.toNat this\n\ntheorem any_eq_true_iff_exists_eq_true : Char.any p = true ↔ ∃ c, p c = true := by\n constructor\n · exact exists_eq_true_of_any_eq_true\n · intro h\n cases heq : Char.any p\n · obtain ⟨c, hc⟩ := h\n simp [eq_false_of_any_eq_false heq] at hc\n · trivial\n\ninstance (P : Char → Prop) [DecidablePred P] : Decidable (∀ c, P c) :=\n match h : Char.all (P ·) with\n | true => isTrue <| fun c => of_decide_eq_true <| eq_true_of_all_eq_true h c\n | false => isFalse <| not_forall_of_exists_not <|\n match exists_eq_false_of_all_eq_false h with\n | ⟨c, hc⟩ => ⟨c, of_decide_eq_false hc⟩\n\ninstance (P : Char → Prop) [DecidablePred P] : Decidable (∃ c, P c) :=\n match h : Char.any (P ·) with\n | false => isFalse <| not_exists_of_forall_not <| fun c =>\n of_decide_eq_false <| eq_false_of_any_eq_false h c\n | true => isTrue <|\n match exists_eq_true_of_any_eq_true h with\n | ⟨c, hc⟩ => ⟨c, of_decide_eq_true hc⟩\n" }, { "path": "Batteries/Data/Char.lean", "content": "module\n\npublic import Batteries.Data.Char.AsciiCasing\npublic import Batteries.Data.Char.Basic\n" }, { "path": "Batteries/Data/DList/Basic.lean", "content": "/-\nCopyright (c) 2018 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura\n-/\nmodule\n\n@[expose] public section\n\nnamespace Batteries\n/--\nA difference List is a Function that, given a List, returns the original\ncontents of the difference List prepended to the given List.\nThis structure supports `O(1)` `append` and `push` operations on lists, making it\nuseful for append-heavy uses such as logging and pretty printing.\n-/\nstructure DList (α : Type u) where\n /-- \"Run\" a `DList` by appending it on the right by a `List α` to get another `List α`. -/\n apply : List α → List α\n /-- The `apply` function of a `DList` is completely determined by the list `apply []`. -/\n invariant : ∀ l, apply l = apply [] ++ l\n\nattribute [simp] DList.apply\n\nnamespace DList\nvariable {α : Type u}\nopen List\n\n/-- `O(1)` (`apply` is `O(|l|)`). Convert a `List α` into a `DList α`. -/\ndef ofList (l : List α) : DList α :=\n ⟨(l ++ ·), fun t => by simp⟩\n\n/-- `O(1)` (`apply` is `O(1)`). Return an empty `DList α`. -/\ndef empty : DList α :=\n ⟨id, fun _ => rfl⟩\n\ninstance : EmptyCollection (DList α) := ⟨DList.empty⟩\n\ninstance : Inhabited (DList α) := ⟨DList.empty⟩\n\n/-- `O(apply())`. Convert a `DList α` into a `List α` by running the `apply` function. -/\n@[simp] def toList : DList α → List α\n | ⟨f, _⟩ => f []\n\n/-- `O(1)` (`apply` is `O(1)`). A `DList α` corresponding to the list `[a]`. -/\ndef singleton (a : α) : DList α where\n apply := fun t => a :: t\n invariant := fun _ => rfl\n\n/-- `O(1)` (`apply` is `O(1)`). Prepend `a` on a `DList α`. -/\ndef cons : α → DList α → DList α\n | a, ⟨f, h⟩ => {\n apply := fun t => a :: f t\n invariant := by intro t; simp; rw [h]\n }\n\n/-- `O(1)` (`apply` is `O(1)`). Append two `DList α`. -/\ndef append : DList α → DList α → DList α\n | ⟨f, h₁⟩, ⟨g, h₂⟩ => {\n apply := f ∘ g\n invariant := by\n intro t\n show f (g t) = (f (g [])) ++ t\n rw [h₁ (g t), h₂ t, ← append_assoc (f []) (g []) t, ← h₁ (g [])]\n }\n\n/-- `O(1)` (`apply` is `O(1)`). Append an element at the end of a `DList α`. -/\ndef push : DList α → α → DList α\n | ⟨f, h⟩, a => {\n apply := fun t => f (a :: t)\n invariant := by\n intro t\n show f (a :: t) = f (a :: nil) ++ t\n rw [h [a], h (a::t), append_assoc (f []) [a] t]\n rfl\n }\n\ninstance : Append (DList α) := ⟨DList.append⟩\n\n/-- Convert a lazily-evaluated `List` to a `DList` -/\ndef ofThunk (l : Thunk (List α)) : DList α :=\n ⟨fun xs => l.get ++ xs, fun t => by simp⟩\n\n/-- Concatenates a list of difference lists to form a single difference list. Similar to\n`List.join`. -/\ndef join {α : Type _} : List (DList α) → DList α\n | [] => DList.empty\n | x :: xs => x ++ DList.join xs\n" }, { "path": "Batteries/Data/DList/Lemmas.lean", "content": "/-\nCopyright (c) 2017 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura\n-/\nmodule\n\npublic import Batteries.Data.DList.Basic\n\n@[expose] public section\n\n/-!\n# Difference list\n\nThis file provides a few results about `DList`.\n\nA difference list is a function that, given a list, returns the original content of the\ndifference list prepended to the given list. It is useful to represent elements of a given type\nas `a₁ + ... + aₙ` where `+ : α → α → α` is any operation, without actually computing.\n\nThis structure supports `O(1)` `append` and `push` operations on lists, making it\nuseful for append-heavy uses such as logging and pretty printing.\n-/\n\nnamespace Batteries.DList\n\nopen Function\n\ntheorem toList_ofList (l : List α) : DList.toList (DList.ofList l) = l := by\n cases l; rfl; simp [ofList]\n\ntheorem ofList_toList (l : DList α) : DList.ofList (DList.toList l) = l := by\n obtain ⟨app, inv⟩ := l\n simp only [ofList, toList, mk.injEq]\n funext x\n rw [(inv x)]\n\ntheorem toList_empty : toList (@empty α) = [] := by simp [empty]\n\ntheorem toList_singleton (x : α) : toList (singleton x) = [x] := by simp [singleton]\n\ntheorem toList_append (l₁ l₂ : DList α) : toList (l₁ ++ l₂) = toList l₁ ++ toList l₂ := by\n simp only [toList, append, Function.comp]; rw [invariant]\n\ntheorem toList_cons (x : α) (l : DList α) : toList (cons x l) = x :: toList l := by\n cases l; simp [cons]\n\ntheorem toList_push (x : α) (l : DList α) : toList (push l x) = toList l ++ [x] := by\n simp only [toList, push]; rw [invariant]\n\n@[simp]\ntheorem singleton_eq_ofThunk {α : Type _} {a : α} : singleton a = ofThunk [a] :=\n rfl\n\n@[simp]\ntheorem ofThunk_coe {α : Type _} {l : List α} : ofThunk l = ofList l :=\n rfl\n\nend Batteries.DList\n" }, { "path": "Batteries/Data/DList.lean", "content": "module\n\npublic import Batteries.Data.DList.Basic\npublic import Batteries.Data.DList.Lemmas\n" }, { "path": "Batteries/Data/Fin/Basic.lean", "content": "/-\nCopyright (c) 2017 Robert Y. Lewis. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Robert Y. Lewis, Keeley Hoek, Mario Carneiro, François G. Dorais, Quang Dao\n-/\nmodule\n\npublic import Batteries.Data.Nat.Lemmas\n\n@[expose] public section\n\nnamespace Fin\n\n/-- `min n m` as an element of `Fin (m + 1)` -/\ndef clamp (n m : Nat) : Fin (m + 1) := ⟨min n m, Nat.lt_succ_of_le (Nat.min_le_right ..)⟩\n\n/-- Heterogeneous monadic fold over `Fin n` from right to left:\n```\nFin.foldrM n f xₙ = do\n let xₙ₋₁ : α (n-1) ← f (n-1) xₙ\n let xₙ₋₂ : α (n-2) ← f (n-2) xₙ₋₁\n ...\n let x₀ : α 0 ← f 0 x₁\n pure x₀\n```\nThis is the dependent version of `Fin.foldrM`. -/\n@[inline] def dfoldrM [Monad m] (n : Nat) (α : Fin (n + 1) → Type _)\n (f : ∀ (i : Fin n), α i.succ → m (α i.castSucc)) (init : α (last n)) : m (α 0) :=\n loop n (Nat.lt_succ_self n) init where\n /--\n Inner loop for `Fin.dfoldrM`.\n ```\n Fin.dfoldrM.loop n f i h xᵢ = do\n let xᵢ₋₁ ← f (i-1) xᵢ\n ...\n let x₁ ← f 1 x₂\n let x₀ ← f 0 x₁\n pure x₀\n ```\n -/\n @[specialize] loop (i : Nat) (h : i < n + 1) (x : α ⟨i, h⟩) : m (α 0) :=\n match i with\n | i + 1 => (f ⟨i, Nat.lt_of_succ_lt_succ h⟩ x) >>= loop i (Nat.lt_of_succ_lt h)\n | 0 => pure x\n\n/-- Heterogeneous fold over `Fin n` from the right: `foldr 3 f x = f 0 (f 1 (f 2 x))`, where\n`f 2 : α 3 → α 2`, `f 1 : α 2 → α 1`, etc.\n\nThis is the dependent version of `Fin.foldr`. -/\n@[inline] def dfoldr (n : Nat) (α : Fin (n + 1) → Type _)\n (f : ∀ (i : Fin n), α i.succ → α i.castSucc) (init : α (last n)) : α 0 :=\n dfoldrM (m := Id) n α f init\n\n/-- Heterogeneous monadic fold over `Fin n` from left to right:\n```\nFin.foldlM n f x₀ = do\n let x₁ : α 1 ← f 0 x₀\n let x₂ : α 2 ← f 1 x₁\n ...\n let xₙ : α n ← f (n-1) xₙ₋₁\n pure xₙ\n```\nThis is the dependent version of `Fin.foldlM`. -/\n@[inline] def dfoldlM [Monad m] (n : Nat) (α : Fin (n + 1) → Type _)\n (f : ∀ (i : Fin n), α i.castSucc → m (α i.succ)) (init : α 0) : m (α (last n)) :=\n loop 0 (Nat.zero_lt_succ n) init where\n /-- Inner loop for `Fin.dfoldlM`.\n ```\n Fin.foldM.loop n α f i h xᵢ = do\n let xᵢ₊₁ : α (i+1) ← f i xᵢ\n ...\n let xₙ : α n ← f (n-1) xₙ₋₁\n pure xₙ\n ```\n -/\n @[specialize] loop (i : Nat) (h : i < n + 1) (x : α ⟨i, h⟩) : m (α (last n)) :=\n if h' : i < n then\n (f ⟨i, h'⟩ x) >>= loop (i + 1) (Nat.succ_lt_succ h')\n else\n haveI : ⟨i, h⟩ = last n := by ext; simp; omega\n _root_.cast (congrArg (fun i => m (α i)) this) (pure x)\n\n/-- Heterogeneous fold over `Fin n` from the left: `foldl 3 f x = f 0 (f 1 (f 2 x))`, where\n`f 0 : α 0 → α 1`, `f 1 : α 1 → α 2`, etc.\n\nThis is the dependent version of `Fin.foldl`. -/\n@[inline] def dfoldl (n : Nat) (α : Fin (n + 1) → Type _)\n (f : ∀ (i : Fin n), α i.castSucc → α i.succ) (init : α 0) : α (last n) :=\n dfoldlM (m := Id) n α f init\n\n/-- Sum of a tuple indexed by `Fin n`. -/\n@[inline] protected def sum [Zero α] [Add α] (x : Fin n → α) : α :=\n foldr n (x · + ·) 0\n\n/-- Product of a tuple indexed by `Fin n`. -/\n@[inline] protected def prod [One α] [Mul α] (x : Fin n → α) : α :=\n foldr n (x · * ·) 1\n\n/-- Count the number of true values of a decidable predicate on `Fin n`. -/\n@[inline] protected def countP (p : Fin n → Bool) : Nat :=\n Fin.sum (p · |>.toNat)\n\n/--\n`findSome? f` returns `f i` for the first `i` for which `f i` is `some _`, or `none` if no such\nelement is found. The function `f` is not evaluated on further inputs after the first `i` is found.\n-/\n@[inline] def findSome? (f : Fin n → Option α) : Option α :=\n foldl n (fun r i => r <|> f i) none\n\n/--\n`findSomeRev? f` returns `f i` for the last `i` for which `f i` is `some _`, or `none` if no such\nelement is found. The function `f` is not evaluated on further inputs after the first `i` is found.\n-/\n@[inline] def findSomeRev? (f : Fin n → Option α) : Option α :=\n findSome? (f ·.rev)\n\n\n/--\n`find? p` returns the first `i` for which `p i = true`, or `none` if no such element is found.\nThe function `p` is not evaluated on further inputs after the first `i` is found.\n-/\n@[inline] abbrev find? (p : Fin n → Bool) : Option (Fin n) :=\n findSome? <| Option.guard p\n\n/--\n`find? p` returns the first `i` for which `p i = true`, or `none` if no such element is found.\nThe function `p` is not evaluated on further inputs after the first `i` is found.\n-/\n@[inline] abbrev findRev? (p : Fin n → Bool) : Option (Fin n) :=\n findSomeRev? <| Option.guard p\n\n/-- Compute `i / n`, where `n` is a `Nat` and inferred the type of `i`. -/\ndef divNat (i : Fin (m * n)) : Fin m :=\n ⟨i / n, Nat.div_lt_of_lt_mul <| Nat.mul_comm m n ▸ i.is_lt⟩\n\n/-- Compute `i % n`, where `n` is a `Nat` and inferred the type of `i`. -/\ndef modNat (i : Fin (m * n)) : Fin n :=\n ⟨i % n, Nat.mod_lt _ <| Nat.pos_of_mul_pos_left i.pos⟩\n\n/--\nCompute the element of `Fin (m * n)` with quotient `i : Fin m` and remainder `j : Fin n`\nwhen divided by `n`.\n-/\ndef mkDivMod (i : Fin m) (j : Fin n) : Fin (m * n) :=\n ⟨n * i + j, Nat.mul_add_lt_mul_of_lt_of_lt i.is_lt j.is_lt⟩\n" }, { "path": "Batteries/Data/Fin/Fold.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais, Quang Dao\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\npublic import Batteries.Data.Fin.Basic\n\n@[expose] public section\n\nnamespace Fin\n\n/-! ### dfoldrM -/\n\ntheorem dfoldrM_loop_zero [Monad m] (f : (i : Fin n) → α i.succ → m (α i.castSucc)) (x) :\n dfoldrM.loop n α f 0 h x = pure x := rfl\n\ntheorem dfoldrM_loop_succ [Monad m] (f : (i : Fin n) → α i.succ → m (α i.castSucc)) (x) :\n dfoldrM.loop n α f (i+1) h x = f ⟨i, by omega⟩ x >>= dfoldrM.loop n α f i (by omega) := rfl\n\n-- TODO: This proof needs adjustment for lean4#12179 (backward.isDefEq.respectTransparency)\nset_option backward.isDefEq.respectTransparency false in\ntheorem dfoldrM_loop [Monad m] [LawfulMonad m] (f : (i : Fin (n+1)) → α i.succ → m (α i.castSucc))\n (x) : dfoldrM.loop (n+1) α f (i+1) h x =\n dfoldrM.loop n (α ∘ succ) (f ·.succ) i (by omega) x >>= f 0 := by\n induction i with\n | zero =>\n rw [dfoldrM_loop_zero, dfoldrM_loop_succ, pure_bind]\n conv => rhs; rw [← bind_pure (f 0 x)]\n rfl\n | succ i ih =>\n rw [dfoldrM_loop_succ, dfoldrM_loop_succ, bind_assoc]\n congr; funext; exact ih ..\n\n@[simp] theorem dfoldrM_zero [Monad m] (f : (i : Fin 0) → α i.succ → m (α i.castSucc)) (x) :\n dfoldrM 0 α f x = pure x := rfl\n\ntheorem dfoldrM_succ [Monad m] [LawfulMonad m] (f : (i : Fin (n+1)) → α i.succ → m (α i.castSucc))\n (x) : dfoldrM (n+1) α f x = dfoldrM n (α ∘ succ) (f ·.succ) x >>= f 0 := dfoldrM_loop ..\n\ntheorem dfoldrM_eq_foldrM [Monad m] [LawfulMonad m] (f : (i : Fin n) → α → m α) (x) :\n dfoldrM n (fun _ => α) f x = foldrM n f x := by\n induction n with\n | zero => simp only [dfoldrM_zero, foldrM_zero]\n | succ n ih => simp only [dfoldrM_succ, foldrM_succ, Function.comp_def, ih]\n\ntheorem dfoldr_eq_dfoldrM (f : (i : Fin n) → α i.succ → α i.castSucc) (x) :\n dfoldr n α f x = dfoldrM (m:=Id) n α f x := rfl\n\n/-! ### dfoldr -/\n\n@[simp] theorem dfoldr_zero (f : (i : Fin 0) → α i.succ → α i.castSucc) (x) :\n dfoldr 0 α f x = x := rfl\n\ntheorem dfoldr_succ (f : (i : Fin (n+1)) → α i.succ → α i.castSucc) (x) :\n dfoldr (n+1) α f x = f 0 (dfoldr n (α ∘ succ) (f ·.succ) x) := dfoldrM_succ ..\n\ntheorem dfoldr_succ_last {n : Nat} {α : Fin (n+2) → Sort _}\n (f : (i : Fin (n+1)) → α i.succ → α i.castSucc) (x : α (last (n+1))) :\n dfoldr (n+1) α f x = dfoldr n (α ∘ castSucc) (f ·.castSucc) (f (last n) x) := by\n induction n with\n | zero => simp only [dfoldr_succ, dfoldr_zero, last, zero_eta]\n | succ n ih => rw [dfoldr_succ, ih (α := α ∘ succ) (f ·.succ), dfoldr_succ]; congr\n\ntheorem dfoldr_eq_foldr (f : (i : Fin n) → α → α) (x) :\n dfoldr n (fun _ => α) f x = foldr n f x := by\n induction n with\n | zero => simp only [dfoldr_zero, foldr_zero]\n | succ n ih => simp only [dfoldr_succ, foldr_succ, Function.comp_def, ih]\n\n/-! ### dfoldlM -/\n\ntheorem dfoldlM_loop_lt [Monad m] (f : ∀ (i : Fin n), α i.castSucc → m (α i.succ)) (h : i < n) (x) :\n dfoldlM.loop n α f i (Nat.lt_add_right 1 h) x =\n (f ⟨i, h⟩ x) >>= (dfoldlM.loop n α f (i+1) (Nat.add_lt_add_right h 1)) := by\n rw [dfoldlM.loop, dif_pos h]\n\ntheorem dfoldlM_loop_eq [Monad m] (f : ∀ (i : Fin n), α i.castSucc → m (α i.succ)) (x) :\n dfoldlM.loop n α f n (Nat.le_refl _) x = pure x := by\n rw [dfoldlM.loop, dif_neg (Nat.lt_irrefl _)]; rfl\n\n@[simp] theorem dfoldlM_zero [Monad m] (f : (i : Fin 0) → α i.castSucc → m (α i.succ)) (x) :\n dfoldlM 0 α f x = pure x := by simp [dfoldlM, dfoldlM.loop]\n\ntheorem dfoldlM_loop [Monad m] (f : (i : Fin (n+1)) → α i.castSucc → m (α i.succ)) (h : i < n+1)\n (x) : dfoldlM.loop (n+1) α f i (Nat.lt_add_right 1 h) x =\n f ⟨i, h⟩ x >>= (dfoldlM.loop n (α ∘ succ) (f ·.succ ·) i h .) := by\n if h' : i < n then\n rw [dfoldlM_loop_lt _ h _]\n congr; funext\n rw [dfoldlM_loop_lt _ h' _, dfoldlM_loop]; rfl\n else\n cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h')\n rw [dfoldlM_loop_lt _ h]\n congr; funext\n rw [dfoldlM_loop_eq, dfoldlM_loop_eq]; rfl\n\ntheorem dfoldlM_succ [Monad m] (f : (i : Fin (n+1)) → α i.castSucc → m (α i.succ)) (x) :\n dfoldlM (n+1) α f x = f 0 x >>= (dfoldlM n (α ∘ succ) (f ·.succ ·) .) :=\n dfoldlM_loop ..\n\ntheorem dfoldlM_eq_foldlM [Monad m] (f : (i : Fin n) → α → m α) (x : α) :\n dfoldlM n (fun _ => α) f x = foldlM n (fun x i => f i x) x := by\n induction n generalizing x with\n | zero => simp only [dfoldlM_zero, foldlM_zero]\n | succ n ih =>\n simp only [dfoldlM_succ, foldlM_succ, Function.comp_apply, Function.comp_def]\n congr; ext; simp only [ih]\n\n/-! ### dfoldl -/\n\n@[simp] theorem dfoldl_zero (f : (i : Fin 0) → α i.castSucc → α i.succ) (x) :\n dfoldl 0 α f x = x := by simp [dfoldl, pure]\n\ntheorem dfoldl_succ (f : (i : Fin (n+1)) → α i.castSucc → α i.succ) (x) :\n dfoldl (n+1) α f x = dfoldl n (α ∘ succ) (f ·.succ ·) (f 0 x) := dfoldlM_succ ..\n\ntheorem dfoldl_succ_last (f : (i : Fin (n+1)) → α i.castSucc → α i.succ) (x) :\n dfoldl (n+1) α f x = f (last n) (dfoldl n (α ∘ castSucc) (f ·.castSucc ·) x) := by\n rw [dfoldl_succ]\n induction n with\n | zero => simp [last]\n | succ n ih => rw [dfoldl_succ, @ih (α ∘ succ) (f ·.succ ·), dfoldl_succ]; congr\n\ntheorem dfoldl_eq_dfoldlM (f : (i : Fin n) → α i.castSucc → α i.succ) (x) :\n dfoldl n α f x = dfoldlM (m := Id) n α f x := rfl\n\ntheorem dfoldl_eq_foldl (f : Fin n → α → α) (x : α) :\n dfoldl n (fun _ => α) f x = foldl n (fun x i => f i x) x := by\n induction n generalizing x with\n | zero => simp only [dfoldl_zero, foldl_zero]\n | succ n ih =>\n simp only [dfoldl_succ, foldl_succ, Function.comp_apply, Function.comp_def]\n congr; simp only [ih]\n\n/-! ### `Fin.fold{l/r}{M}` equals `List.fold{l/r}{M}` -/\n\ntheorem foldl_eq_foldl_finRange (f : α → Fin n → α) (x) :\n foldl n f x = (List.finRange n).foldl f x := by\n induction n generalizing x with\n | zero => rw [foldl_zero, List.finRange_zero, List.foldl_nil]\n | succ n ih => rw [foldl_succ, ih, List.finRange_succ, List.foldl_cons, List.foldl_map]\n\ntheorem foldr_eq_foldr_finRange (f : Fin n → α → α) (x) :\n foldr n f x = (List.finRange n).foldr f x := by\n induction n with\n | zero => rw [foldr_zero, List.finRange_zero, List.foldr_nil]\n | succ n ih => rw [foldr_succ, ih, List.finRange_succ, List.foldr_cons, List.foldr_map]\n" }, { "path": "Batteries/Data/Fin/Lemmas.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.Fin.Basic\npublic import Batteries.Data.Nat.Lemmas\npublic import Batteries.Data.List.Basic\npublic import Batteries.Util.ProofWanted\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\nnamespace Fin\n\nattribute [norm_cast] val_last\n\n/-! ### rev -/\n\n-- Forward port of lean4#11065\nattribute [grind =] rev_lt_rev rev_le_rev rev_rev\n\n/-! ### foldl/foldr -/\n\ntheorem foldl_assoc {op : α → α → α} [ha : Std.Associative op] {f : Fin n → α} {a₁ a₂} :\n foldl n (fun x i => op x (f i)) (op a₁ a₂) = op a₁ (foldl n (fun x i => op x (f i)) a₂) := by\n induction n generalizing a₂ with\n | zero => simp\n | succ n ih => simp only [foldl_succ, ha.assoc, ih]\n\ntheorem foldr_assoc {op : α → α → α} [ha : Std.Associative op] {f : Fin n → α} {a₁ a₂} :\n foldr n (fun i x => op (f i) x) (op a₁ a₂) = op (foldr n (fun i x => op (f i) x) a₁) a₂ := by\n simp only [← Fin.foldl_rev]\n haveI : Std.Associative (flip op) := ⟨fun a b c => (ha.assoc c b a).symm⟩\n exact foldl_assoc (op := flip op)\n\n/-! ### clamp -/\n\n@[simp] theorem coe_clamp (n m : Nat) : (clamp n m : Nat) = min n m := rfl\n\n/-! ### sum -/\n\n@[simp, grind =]\ntheorem sum_zero [Zero α] [Add α] (x : Fin 0 → α) :\n Fin.sum x = 0 := by\n simp [Fin.sum]\n\ntheorem sum_succ [Zero α] [Add α] (x : Fin (n + 1) → α) :\n Fin.sum x = x 0 + Fin.sum (x ·.succ) := by\n simp [Fin.sum, foldr_succ]\n\n@[simp, grind =]\ntheorem sum_eq_sum_map_finRange [Zero α] [Add α] (x : Fin n → α) :\n Fin.sum x = (List.finRange n |>.map x).sum := by\n simp only [Fin.sum, foldr_eq_finRange_foldr, List.sum, List.foldr_map]\n\n/-! ### prod -/\n\n@[simp, grind =]\ntheorem prod_zero [One α] [Mul α] (x : Fin 0 → α) :\n Fin.prod x = 1 := by\n simp [Fin.prod]\n\ntheorem prod_succ [One α] [Mul α] (x : Fin (n + 1) → α) :\n Fin.prod x = x 0 * Fin.prod (x ·.succ) := by\n simp [Fin.prod, foldr_succ]\n\n@[simp, grind =]\ntheorem prod_eq_prod_map_finRange [One α] [Mul α] (x : Fin n → α) :\n Fin.prod x = (List.finRange n |>.map x).prod := by\n simp only [Fin.prod, foldr_eq_finRange_foldr, List.prod, List.foldr_map]\n\n/-! ### countP -/\n\n@[simp, grind =] theorem countP_zero (p : Fin 0 → Bool) : Fin.countP p = 0 := by\n simp [Fin.countP]\n\n@[simp, grind =] theorem countP_one (p : Fin 1 → Bool) : Fin.countP p = (p 0).toNat := by\n simp [Fin.countP, List.finRange_succ]\n\ntheorem countP_succ (p : Fin (n + 1) → Bool) :\n Fin.countP p = (p 0).toNat + Fin.countP (p ·.succ) := by\n simp [Fin.countP, List.finRange_succ]; rfl\n\n@[simp, grind =]\ntheorem countP_eq_countP_map_finRange (x : Fin n → Bool) :\n Fin.countP x = (List.finRange n).countP x := by\n induction n with\n | zero => rfl\n | succ n ih => simp +arith [countP_succ, List.finRange_succ, List.countP_cons, List.countP_map,\n Bool.cond_eq_ite, Bool.toNat, ih]; rfl\n\n@[grind .]\ntheorem countP_le (p : Fin n → Bool) : Fin.countP p ≤ n := by\n induction n with simp only [countP_zero, countP_succ, Nat.le_refl]\n | succ _ ih =>\n rw [Nat.add_comm]\n apply Nat.add_le_add\n · exact ih ..\n · exact Bool.toNat_le ..\n\n/-! ### findSome? -/\n\n@[simp] theorem findSome?_zero {f : Fin 0 → Option α} : findSome? f = none := by simp [findSome?]\n\n@[simp] theorem findSome?_one {f : Fin 1 → Option α} : findSome? f = f 0 := by\n simp [findSome?, foldl_succ]\n\ntheorem findSome?_succ {f : Fin (n+1) → Option α} :\n findSome? f = (f 0).or (findSome? (f ·.succ)) := by\n simp only [findSome?, foldl_succ, Option.orElse_eq_orElse, Option.orElse_eq_or]\n exact Eq.trans (by cases (f 0) <;> rfl) foldl_assoc\n\ntheorem findSome?_succ_of_some {f : Fin (n+1) → Option α} (h : f 0 = some x) :\n findSome? f = some x := findSome?_succ.trans (h ▸ Option.some_or)\n\ntheorem findSome?_succ_of_isSome {f : Fin (n+1) → Option α} (h : (f 0).isSome) :\n findSome? f = f 0 := findSome?_succ.trans (Option.or_of_isSome h)\n\ntheorem findSome?_succ_of_none {f : Fin (n+1) → Option α} (h : f 0 = none) :\n findSome? f = findSome? (f ·.succ) := findSome?_succ.trans (Option.or_eq_right_of_none h)\n\ntheorem findSome?_succ_of_isNone {f : Fin (n+1) → Option α} (h : (f 0).isNone) :\n findSome? f = findSome? (f ·.succ) := findSome?_succ.trans (Option.or_of_isNone h)\n\n@[simp, grind =]\ntheorem findSome?_eq_some_iff {f : Fin n → Option α} :\n findSome? f = some a ↔ ∃ i, f i = some a ∧ ∀ j < i, f j = none := by\n induction n with\n | zero =>\n simp only [findSome?_zero, reduceCtorEq, forall_fin_zero, and_true, exists_fin_zero]\n | succ n ih =>\n simp only [findSome?_succ, Option.or_eq_some_iff, exists_fin_succ, forall_fin_succ,\n succ_lt_succ_iff, succ_pos, not_lt_zero, ih]\n grind\n\n@[simp, grind =] theorem findSome?_eq_none_iff {f : Fin n → Option α} :\n findSome? f = none ↔ ∀ i, f i = none := by\n induction n with\n | zero => simp only [findSome?_zero, forall_fin_zero]\n | succ n ih => simp only [findSome?_succ, Option.or_eq_none_iff, ih, forall_fin_succ]\n\ntheorem isNone_findSome?_iff {f : Fin n → Option α} :\n (findSome? f).isNone ↔ ∀ i, (f i).isNone := by simp\n\n@[deprecated (since := \"2025-09-28\")]\nalias findSome?_isNone_iff := isNone_findSome?_iff\n\n@[simp] theorem isSome_findSome?_iff {f : Fin n → Option α} :\n (findSome? f).isSome ↔ ∃ i, (f i).isSome := by\n cases h : findSome? f <;> grind\n\n@[deprecated (since := \"2025-09-28\")]\nalias findSome?_isSome_iff := isSome_findSome?_iff\n\ntheorem exists_minimal_of_findSome?_eq_some {f : Fin n → Option α}\n (h : findSome? f = some x) : ∃ i, f i = some x ∧ ∀ j < i, f j = none :=\n findSome?_eq_some_iff.1 h\n\ntheorem exists_eq_some_of_findSome?_eq_some {f : Fin n → Option α}\n (h : findSome? f = some x) : ∃ i, f i = some x := by grind\n\n@[deprecated (since := \"2025-09-28\")]\nalias exists_of_findSome?_eq_some := exists_eq_some_of_findSome?_eq_some\n\ntheorem eq_none_of_findSome?_eq_none {f : Fin n → Option α} (h : findSome? f = none) (i) :\n f i = none := findSome?_eq_none_iff.1 h i\n\ntheorem exists_isSome_of_isSome_findSome? {f : Fin n → Option α} (h : (findSome? f).isSome) :\n ∃ i, (f i).isSome := isSome_findSome?_iff.1 h\n\ntheorem isNone_of_isNone_findSome? {f : Fin n → Option α} (h : (findSome? f).isNone) :\n (f i).isNone := isNone_findSome?_iff.1 h i\n\ntheorem isSome_findSome?_of_isSome {f : Fin n → Option α} (h : (f i).isSome) :\n (findSome? f).isSome := isSome_findSome?_iff.2 ⟨_, h⟩\n\ntheorem map_findSome? (f : Fin n → Option α) (g : α → β) :\n (findSome? f).map g = findSome? (Option.map g <| f ·) := by\n induction n with\n | zero => simp\n | succ n ih => simp [findSome?_succ, Option.map_or, ih]\n\ntheorem findSome?_guard {p : Fin n → Bool} : findSome? (Option.guard p) = find? p := rfl\n\ntheorem bind_findSome?_guard_isSome {f : Fin n → Option α} :\n (findSome? (Option.guard fun i => (f i).isSome)).bind f = findSome? f := by\n\n cases hf : findSome? f with\n | none => grind\n | some x =>\n simp only [Option.bind_eq_some_iff, findSome?_eq_some_iff, Option.guard_eq_some_iff]\n grind\n\ntheorem findSome?_eq_findSome?_finRange (f : Fin n → Option α) :\n findSome? f = (List.finRange n).findSome? f := by\n induction n with\n | zero => simp\n | succ n ih =>\n rw [findSome?_succ, List.finRange_succ, List.findSome?_cons]\n cases f 0 <;> simp [ih, List.findSome?_map, Function.comp_def]\n\n/-! ### findSomeRev? -/\n\n@[simp]\ntheorem findSome?_rev {f : Fin n → Option α} : findSome? (f ·.rev) = findSomeRev? f := rfl\n\n@[simp]\ntheorem findSomeRev?_rev {f : Fin n → Option α} :\n findSomeRev? (f ·.rev) = findSome? f := by simp only [findSomeRev?, rev_rev]\n\n@[simp] theorem findSomeRev?_zero {f : Fin 0 → Option α} : findSomeRev? f = none := by\n simp [findSomeRev?]\n\n@[simp] theorem findSomeRev?_one {f : Fin 1 → Option α} : findSomeRev? f = f 0 := by\n simp [findSomeRev?]\n\ntheorem findSomeRev?_succ {f : Fin (n+1) → Option α} :\n findSomeRev? f = (f (last n)).or (findSomeRev? fun i => f i.castSucc) := by\n unfold findSomeRev?\n simp only [findSome?_succ, rev_succ, rev_zero]\n\n@[simp, grind =]\ntheorem findSomeRev?_eq_some_iff {f : Fin n → Option α} :\n findSomeRev? f = some a ↔ ∃ i, f i = some a ∧ ∀ j, i < j → f j = none :=\n findSome?_eq_some_iff.trans <| ⟨fun ⟨i, h⟩ => ⟨i.rev, by grind,\n fun j hj => have := h.2 j.rev; by grind⟩, fun ⟨i, _⟩ => ⟨i.rev, by grind⟩⟩\n\n@[simp, grind =] theorem findSomeRev?_eq_none_iff {f : Fin n → Option α} :\n findSomeRev? f = none ↔ ∀ i, f i = none :=\n findSome?_eq_none_iff.trans <| ⟨fun h i => have := h i.rev; by grind, by grind⟩\n\ntheorem isNone_findSomeRev?_iff {f : Fin n → Option α} :\n (findSomeRev? f).isNone ↔ ∀ i, (f i).isNone := by simp\n\n@[simp] theorem isSome_findSomeRev?_iff {f : Fin n → Option α} :\n (findSomeRev? f).isSome ↔ ∃ i, (f i).isSome := by\n cases h : findSomeRev? f <;> grind\n\ntheorem exists_minimal_of_findSomeRev?_eq_some {f : Fin n → Option α}\n (h : findSomeRev? f = some x) : ∃ i, f i = some x ∧ ∀ j, i < j → f j = none :=\n findSomeRev?_eq_some_iff.1 h\n\ntheorem exists_eq_some_of_findSomeRev?_eq_some {f : Fin n → Option α}\n (h : findSomeRev? f = some x) : ∃ i, f i = some x := by grind\n\ntheorem eq_none_of_findSomeRev?_eq_none {f : Fin n → Option α} (h : findSomeRev? f = none) (i) :\n f i = none := findSomeRev?_eq_none_iff.1 h i\n\ntheorem exists_isSome_of_isSome_findSomeRev? {f : Fin n → Option α} (h : (findSomeRev? f).isSome) :\n ∃ i, (f i).isSome := isSome_findSomeRev?_iff.1 h\n\ntheorem isNone_of_isNone_findSomeRev? {f : Fin n → Option α} (h : (findSomeRev? f).isNone) :\n (f i).isNone := isNone_findSomeRev?_iff.1 h i\n\ntheorem isSome_findSomeRev?_of_isSome {f : Fin n → Option α} (h : (f i).isSome) :\n (findSomeRev? f).isSome := isSome_findSomeRev?_iff.2 ⟨_, h⟩\n\ntheorem map_findSomeRev? (f : Fin n → Option α) (g : α → β) :\n (findSomeRev? f).map g = findSomeRev? (Option.map g <| f ·) := by\n induction n with\n | zero => grind [findSomeRev?_zero]\n | succ n ih => grind [findSomeRev?_succ]\n\n@[grind =_]\ntheorem findSomeRev?_guard {p : Fin n → Bool} : findSomeRev? (Option.guard p) = findRev? p := rfl\n\ntheorem bind_findSomeRev?_guard_isSome {f : Fin n → Option α} :\n (findSomeRev? (Option.guard fun i => (f i).isSome)).bind f = findSomeRev? f := by\n cases hf : findSomeRev? f with\n | none => grind\n | some x =>\n simp only [Option.bind_eq_some_iff, findSomeRev?_eq_some_iff, Option.guard_eq_some_iff]\n grind\n\n/-! ### find? -/\n\ntheorem find?_zero {p : Fin 0 → Bool} : find? p = none := by simp\n\ntheorem find?_one {p : Fin 1 → Bool} : find? p = if p 0 then some 0 else none := by\n simp [Option.guard]\n\ntheorem find?_succ {p : Fin (n+1) → Bool} :\n find? p = if p 0 then some 0 else (find? (p ·.succ)).map Fin.succ := by\n simp only [findSome?_succ, Option.guard, fun a => apply_ite (Option.or · a),\n Option.some_or, Option.none_or, map_findSome?, Option.map_if]\n\n@[grind =]\ntheorem find?_eq_some_iff {p : Fin n → Bool} :\n find? p = some i ↔ p i ∧ ∀ j, j < i → p j = false := by simp [and_assoc]\n\ntheorem isSome_find?_iff {p : Fin n → Bool} :\n (find? p).isSome ↔ ∃ i, p i := by simp\n\n@[deprecated (since := \"2025-09-28\")]\nalias find?_isSome_iff := isSome_find?_iff\n\n@[grind =]\ntheorem find?_eq_none_iff {p : Fin n → Bool} : find? p = none ↔ ∀ i, p i = false := by simp\n\ntheorem isNone_find?_iff {p : Fin n → Bool} : (find? p).isNone ↔ ∀ i, p i = false := by simp\n\n@[deprecated (since := \"2025-09-28\")]\nalias find?_isNone_iff := isNone_find?_iff\n\ntheorem eq_true_of_find?_eq_some {p : Fin n → Bool} (h : find? p = some i) : p i :=\n (find?_eq_some_iff.mp h).1\n\ntheorem eq_false_of_find?_eq_some_of_lt {p : Fin n → Bool} (h : find? p = some i) :\n ∀ j < i, p j = false := (find?_eq_some_iff.mp h).2\n\ntheorem eq_false_of_find?_eq_none {p : Fin n → Bool} (h : find? p = none) (i) :\n p i = false := find?_eq_none_iff.1 h i\n\ntheorem exists_eq_true_of_isSome_find? {p : Fin n → Bool} (h : (find? p).isSome) :\n ∃ i, p i := isSome_find?_iff.1 h\n\ntheorem eq_false_of_isNone_find? {p : Fin n → Bool} (h : (find? p).isNone) : p i = false :=\n isNone_find?_iff.1 h i\n\ntheorem isSome_find?_of_eq_true {p : Fin n → Bool} (h : p i) :\n (find? p).isSome := isSome_find?_iff.2 ⟨_, h⟩\n\ntheorem get_find?_eq_true {p : Fin n → Bool} (h : (find? p).isSome) : p ((find? p).get h) :=\n eq_true_of_find?_eq_some (Option.some_get _).symm\n\ntheorem get_find?_minimal {p : Fin n → Bool} (h : (find? p).isSome) :\n ∀ j, j < (find? p).get h → p j = false :=\n eq_false_of_find?_eq_some_of_lt (Option.some_get _).symm\n\ntheorem bind_find?_isSome {f : Fin n → Option α} :\n (find? (fun i => (f i).isSome)).bind f = findSome? f := bind_findSome?_guard_isSome\n\ntheorem find?_eq_find?_finRange {p : Fin n → Bool} : find? p = (List.finRange n).find? p :=\n (findSome?_eq_findSome?_finRange _).trans (List.findSome?_guard)\n\ntheorem exists_eq_true_iff_exists_minimal_eq_true (p : Fin n → Bool):\n (∃ i, p i) ↔ ∃ i, p i ∧ ∀ j < i, p j = false := by cases h : find? p <;> grind\n\ntheorem exists_iff_exists_minimal (p : Fin n → Prop) [DecidablePred p] :\n (∃ i, p i) ↔ ∃ i, p i ∧ ∀ j < i, ¬ p j := by cases h : find? (p ·) <;> grind\n\ntheorem find?_rev {p : Fin n → Bool} : find? (p ·.rev) = (findRev? p).map rev := by\n simp [← findSomeRev?_rev, map_findSomeRev?, Option.guard_eq_ite]\n\ntheorem map_rev_findRev? {p : Fin n → Bool} : (findRev? (p ·.rev)).map rev = find? p := by\n simp only [← find?_rev, rev_rev]\n\n/-! ### findRev? -/\n\ntheorem findRev?_zero {p : Fin 0 → Bool} : findRev? p = none := by grind\n\ntheorem findRev?_succ {p : Fin (n+1) → Bool} :\n findRev? p = if p (last n) then some (last n)\n else (findRev? fun i => p i.castSucc).map Fin.castSucc := by\n simp only [findSomeRev?_succ, Option.guard, fun a => apply_ite (Option.or · a),\n Option.some_or, Option.none_or, map_findSomeRev?, Option.map_if]\n\ntheorem findRev?_one {p : Fin 1 → Bool} : findRev? p = if p 0 then some 0 else none := by\n grind [findRev?_succ]\n\n@[grind =]\ntheorem findRev?_eq_some_iff {p : Fin n → Bool} :\n findRev? p = some i ↔ p i ∧ ∀ j, i < j → p j = false := by simp [and_assoc]\n\n@[grind =]\ntheorem findRev?_eq_none_iff {p : Fin n → Bool} : findRev? p = none ↔ ∀ i, p i = false := by simp\n\ntheorem isSome_findRev?_iff {p : Fin n → Bool} :\n (findRev? p).isSome ↔ ∃ i, p i := by simp\n\ntheorem isNone_findRev?_iff {p : Fin n → Bool} : (findRev? p).isNone ↔ ∀ i, p i = false := by simp\n\ntheorem eq_true_of_findRev?_eq_some {p : Fin n → Bool} (h : findRev? p = some i) : p i :=\n (findRev?_eq_some_iff.mp h).1\n\ntheorem eq_false_of_findRev?_eq_some_of_lt {p : Fin n → Bool} (h : findRev? p = some i) :\n ∀ j, i < j → p j = false := (findRev?_eq_some_iff.mp h).2\n\ntheorem eq_false_of_findRev?_eq_none {p : Fin n → Bool} (h : findRev? p = none) (i) :\n p i = false := findRev?_eq_none_iff.1 h i\n\ntheorem exists_eq_true_of_isSome_findRev? {p : Fin n → Bool} (h : (findRev? p).isSome) :\n ∃ i, p i := isSome_findRev?_iff.1 h\n\ntheorem eq_false_of_isNone_findRev? {p : Fin n → Bool} (h : (findRev? p).isNone) : p i = false :=\n isNone_findRev?_iff.1 h i\n\ntheorem isSome_findRev?_of_eq_true {p : Fin n → Bool} (h : p i) :\n (findRev? p).isSome := isSome_findRev?_iff.2 ⟨_, h⟩\n\ntheorem get_findRev?_eq_true {p : Fin n → Bool} (h : (findRev? p).isSome) :\n p ((findRev? p).get h) := eq_true_of_findRev?_eq_some (Option.some_get _).symm\n\ntheorem get_findRev?_maximal {p : Fin n → Bool} (h : (findRev? p).isSome) :\n ∀ j, (findRev? p).get h < j → p j = false :=\n eq_false_of_findRev?_eq_some_of_lt (Option.some_get _).symm\n\ntheorem exists_eq_true_iff_exists_maximal_eq_true (p : Fin n → Bool):\n (∃ i, p i) ↔ ∃ i, p i ∧ ∀ j , i < j → p j = false := by cases h : findRev? p <;> grind\n\ntheorem exists_iff_exists_maximal (p : Fin n → Prop) [DecidablePred p] :\n (∃ i, p i) ↔ ∃ i, p i ∧ ∀ j, i < j → ¬ p j := by cases h : findRev? (p ·) <;> grind\n\ntheorem bind_findRev?_isSome {f : Fin n → Option α} :\n (findRev? (fun i => (f i).isSome)).bind f = findSomeRev? f := bind_findSomeRev?_guard_isSome\n\ntheorem findRev?_rev {p : Fin n → Bool} : findRev? (p ·.rev) = (find? p).map rev := by\n simp [← findSome?_rev, map_findSome?, Option.guard_eq_ite]\n\ntheorem map_rev_find? {p : Fin n → Bool} : (find? (p ·.rev)).map rev = findRev? p := by\n simp only [← findRev?_rev, rev_rev]\n\ntheorem find?_le_findRev? {p : Fin n → Bool} : find? p ≤ findRev? p := by\n cases hl : find? p <;> cases hu : findRev? p <;> grind\n\ntheorem find?_eq_findRev?_iff {p : Fin n → Bool} : find? p = findRev? p ↔\n ∀ i j, p i = true → p j = true → i = j := by\n cases h : findRev? p <;> grind\n\n/-! ### divNat / modNat / mkDivMod -/\n\n@[simp] theorem coe_divNat (i : Fin (m * n)) : (i.divNat : Nat) = i / n := rfl\n\n@[simp] theorem coe_modNat (i : Fin (m * n)) : (i.modNat : Nat) = i % n := rfl\n\n@[simp] theorem coe_mkDivMod (i : Fin m) (j : Fin n) : (mkDivMod i j : Nat) = n * i + j := rfl\n\n@[simp] theorem divNat_mkDivMod (i : Fin m) (j : Fin n) : (mkDivMod i j).divNat = i := by\n ext; simp [Nat.mul_add_div (Nat.zero_lt_of_lt j.is_lt)]\n\n@[simp] theorem modNat_mkDivMod (i : Fin m) (j : Fin n) : (mkDivMod i j).modNat = j := by\n ext; simp [Nat.mod_eq_of_lt]\n\n@[simp] theorem divNat_mkDivMod_modNat (k : Fin (m * n)) :\n mkDivMod k.divNat k.modNat = k := by ext; simp [Nat.div_add_mod]\n" }, { "path": "Batteries/Data/Fin/OfBits.lean", "content": "/-\nCopyright (c) 2025 François G. Dorais. All rights reserved.\nReleased under Apache 2. license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Data.Nat.Lemmas\n\n@[expose] public section\n\nnamespace Fin\n\n/--\nConstruct an element of `Fin (2 ^ n)` from a sequence of bits (little endian).\n-/\nabbrev ofBits (f : Fin n → Bool) : Fin (2 ^ n) := ⟨Nat.ofBits f, Nat.ofBits_lt_two_pow f⟩\n\n@[simp] theorem val_ofBits (f : Fin n → Bool) : (ofBits f).val = Nat.ofBits f := rfl\n" }, { "path": "Batteries/Data/Fin.lean", "content": "module\n\npublic import Batteries.Data.Fin.Basic\npublic import Batteries.Data.Fin.Fold\npublic import Batteries.Data.Fin.Lemmas\npublic import Batteries.Data.Fin.OfBits\n" }, { "path": "Batteries/Data/FloatArray.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2. license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace FloatArray\n\nattribute [ext] FloatArray\n\n/--\nUnsafe optimized implementation of `mapM`.\n\nThis function is unsafe because it relies on the implementation limit that the size of an array is\nalways less than `USize.size`.\n-/\n@[inline]\nunsafe def mapMUnsafe [Monad m] (a : FloatArray) (f : Float → m Float) : m FloatArray :=\n loop a 0 a.usize\nwhere\n /-- Inner loop for `mapMUnsafe`. -/\n @[specialize]\n loop (a : FloatArray) (k s : USize) := do\n if k < s then\n let x := a.uget k lcProof\n let y ← f x\n let a := a.uset k y lcProof\n loop a (k+1) s\n else pure a\n\n/-- `mapM f a` applies the monadic function `f` to each element of the array. -/\n@[implemented_by mapMUnsafe]\ndef mapM [Monad m] (a : FloatArray) (f : Float → m Float) : m FloatArray := do\n let mut r := a\n for i in [0:r.size] do\n r := r.set! i (← f r[i]!)\n return r\n\n/-- `map f a` applies the function `f` to each element of the array. -/\n@[inline]\ndef map (a : FloatArray) (f : Float → Float) : FloatArray :=\n mapM (m:=Id) a f\n" }, { "path": "Batteries/Data/HashMap/Basic.lean", "content": "/-\nCopyright (c) 2018 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Lean.HashMap\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\nnamespace Std.HashMap\n\nvariable [BEq α] [Hashable α]\n\n/--\nGiven a key `a`, returns a key-value pair in the map whose key compares equal to `a`.\nNote that the returned key may not be identical to the input, if `==` ignores some part\nof the value.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.findEntry? \"one\" = some (\"one\", 1)\nhashMap.findEntry? \"three\" = none\n```\n-/\n-- This could be given a more efficient low level implementation.\n@[inline]\ndef findEntry? [BEq α] [Hashable α] (m : Std.HashMap α β) (k : α) : Option (α × β) :=\n if h : k ∈ m then some (m.getKey k h, m.get k h) else none\n\n/--\nVariant of `ofList` which accepts a function that combines values of duplicated keys.\n```\nofListWith [(\"one\", 1), (\"one\", 2)] (fun v₁ v₂ => v₁ + v₂) = {\"one\" => 3}\n```\n-/\ndef ofListWith [BEq α] [Hashable α] (l : List (α × β)) (f : β → β → β) : HashMap α β :=\n l.foldl (init := ∅) fun m p =>\n match m[p.1]? with\n | none => m.insert p.1 p.2\n | some v => m.insert p.1 <| f v p.2\n\nend Std.HashMap\n\nnamespace Batteries.HashMap\n\n@[reducible, deprecated (since := \"2025-05-31\")]\nalias LawfulHashable := LawfulHashable\n\n/--\n`HashMap α β` is a key-value map which stores elements in an array using a hash function\nto find the values. This allows it to have very good performance for lookups\n(average `O(1)` for a perfectly random hash function), but it is not a persistent data structure,\nmeaning that one should take care to use the map linearly when performing updates.\nCopies are `O(n)`.\n-/\n@[deprecated Std.HashMap (since := \"2025-04-09\")]\nstructure _root_.Batteries.HashMap (α : Type u) (β : Type v) [BEq α] [Hashable α] where\n /-- The inner `Std.HashMap` powering the `Batteries.HashMap`. -/\n inner : Std.HashMap α β\n\nset_option linter.deprecated false\n\n/-- Make a new hash map with the specified capacity. -/\n@[inline] def _root_.Batteries.mkHashMap [BEq α] [Hashable α] (capacity := 0) : HashMap α β :=\n ⟨.emptyWithCapacity capacity, .emptyWithCapacity⟩\n\ninstance [BEq α] [Hashable α] : Inhabited (HashMap α β) where\n default := mkHashMap\n\ninstance [BEq α] [Hashable α] : EmptyCollection (HashMap α β) := ⟨mkHashMap⟩\n\n/--\nMake a new empty hash map.\n```\n(empty : Batteries.HashMap Int Int).toList = []\n```\n-/\n@[inline] def empty [BEq α] [Hashable α] : HashMap α β := mkHashMap\n\nvariable {_ : BEq α} {_ : Hashable α}\n\n/--\nThe number of elements in the hash map.\n```\n(ofList [(\"one\", 1), (\"two\", 2)]).size = 2\n```\n-/\n@[inline] def size (self : HashMap α β) : Nat := self.inner.size\n\n/--\nIs the map empty?\n```\n(empty : Batteries.HashMap Int Int).isEmpty = true\n(ofList [(\"one\", 1), (\"two\", 2)]).isEmpty = false\n```\n-/\n@[inline] def isEmpty (self : HashMap α β) : Bool := self.inner.isEmpty\n\n/--\nInserts key-value pair `a, b` into the map.\nIf an element equal to `a` is already in the map, it is replaced by `b`.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.insert \"three\" 3 = {\"one\" => 1, \"two\" => 2, \"three\" => 3}\nhashMap.insert \"two\" 0 = {\"one\" => 1, \"two\" => 0}\n```\n-/\n@[inline] def insert (self : HashMap α β) (a : α) (b : β) : HashMap α β :=\n ⟨Std.HashMap.insert self.inner a b⟩\n\n/--\nSimilar to `insert`, but also returns a boolean flag indicating whether an existing entry has been\nreplaced with `a => b`.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.insert' \"three\" 3 = ({\"one\" => 1, \"two\" => 2, \"three\" => 3}, false)\nhashMap.insert' \"two\" 0 = ({\"one\" => 1, \"two\" => 0}, true)\n```\n-/\n@[inline] def insert' (m : HashMap α β) (a : α) (b : β) : HashMap α β × Bool :=\n let ⟨contains, insert⟩ := m.inner.containsThenInsert a b\n ⟨⟨insert⟩, contains⟩\n\n/--\nRemoves key `a` from the map. If it does not exist in the map, the map is returned unchanged.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.erase \"one\" = {\"two\" => 2}\nhashMap.erase \"three\" = {\"one\" => 1, \"two\" => 2}\n```\n-/\n@[inline] def erase (self : HashMap α β) (a : α) : HashMap α β := ⟨self.inner.erase a⟩\n\n/--\nPerforms an in-place edit of the value, ensuring that the value is used linearly.\nThe function `f` is passed the original key of the entry, along with the value in the map.\n```\n(ofList [(\"one\", 1), (\"two\", 2)]).modify \"one\" (fun _ v => v + 1) = {\"one\" => 2, \"two\" => 2}\n(ofList [(\"one\", 1), (\"two\", 2)]).modify \"three\" (fun _ v => v + 1) = {\"one\" => 1, \"two\" => 2}\n```\n-/\n@[inline] def modify (self : HashMap α β) (a : α) (f : α → β → β) : HashMap α β :=\n ⟨self.inner.modify a (f a)⟩\n\n/--\nLooks up an element in the map with key `a`.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.find? \"one\" = some 1\nhashMap.find? \"three\" = none\n```\n-/\n@[inline] def find? (self : HashMap α β) (a : α) : Option β := self.inner[a]?\n\n/--\nLooks up an element in the map with key `a`. Returns `b₀` if the element is not found.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.findD \"one\" 0 = 1\nhashMap.findD \"three\" 0 = 0\n```\n-/\n@[inline] def findD (self : HashMap α β) (a : α) (b₀ : β) : β := self.inner.getD a b₀\n\n/--\nLooks up an element in the map with key `a`. Panics if the element is not found.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.find! \"one\" = 1\nhashMap.find! \"three\" => panic!\n```\n-/\n@[inline] def find! [Inhabited β] (self : HashMap α β) (a : α) : β :=\n self.inner.getD a (panic! \"key is not in the map\")\n\ninstance : GetElem (HashMap α β) α (Option β) fun _ _ => True where\n getElem m k _ := m.inner[k]?\n\n/--\nGiven a key `a`, returns a key-value pair in the map whose key compares equal to `a`.\nNote that the returned key may not be identical to the input, if `==` ignores some part\nof the value.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.findEntry? \"one\" = some (\"one\", 1)\nhashMap.findEntry? \"three\" = none\n```\n-/\n-- This could be given a more efficient low level implementation.\n@[inline]\ndef findEntry? [BEq α] [Hashable α] (m : HashMap α β) (k : α) : Option (α × β) :=\n m.inner.findEntry? k\n\n/--\nReturns true if the element `a` is in the map.\n```\ndef hashMap := ofList [(\"one\", 1), (\"two\", 2)]\nhashMap.contains \"one\" = true\nhashMap.contains \"three\" = false\n```\n-/\n@[inline] def contains (self : HashMap α β) (a : α) : Bool := self.inner.contains a\n\n/--\nFolds a monadic function over the elements in the map (in arbitrary order).\n```\ndef sumEven (sum: Nat) (k : String) (v : Nat) : Except String Nat :=\n if v % 2 == 0 then pure (sum + v) else throw s!\"value {v} at key {k} is not even\"\n\nfoldM sumEven 0 (ofList [(\"one\", 1), (\"three\", 3)]) =\n Except.error \"value 3 at key three is not even\"\nfoldM sumEven 0 (ofList [(\"two\", 2), (\"four\", 4)]) = Except.ok 6\n```\n-/\n@[inline] def foldM [Monad m] (f : δ → α → β → m δ) (init : δ) (self : HashMap α β) : m δ :=\n Std.HashMap.foldM f init self.inner\n\n/--\nFolds a function over the elements in the map (in arbitrary order).\n```\nfold (fun sum _ v => sum + v) 0 (ofList [(\"one\", 1), (\"two\", 2)]) = 3\n```\n-/\n@[inline] def fold (f : δ → α → β → δ) (init : δ) (self : HashMap α β) : δ :=\n Std.HashMap.fold f init self.inner\n\n/--\nCombines two hashmaps using a monadic function `f` to combine two values at a key.\n```\ndef map1 := ofList [(\"one\", 1), (\"two\", 2)]\ndef map2 := ofList [(\"two\", 2), (\"three\", 3)]\ndef map3 := ofList [(\"two\", 3), (\"three\", 3)]\ndef mergeIfNoConflict? (_ : String) (v₁ v₂ : Nat) : Option Nat :=\n if v₁ != v₂ then none else some v₁\n\n\nmergeWithM mergeIfNoConflict? map1 map2 = some {\"one\" => 1, \"two\" => 2, \"three\" => 3}\nmergeWithM mergeIfNoConflict? map1 map3 = none\n```\n-/\n@[specialize] def mergeWithM [Monad m] (f : α → β → β → m β)\n (self other : HashMap α β) : m (HashMap α β) :=\n HashMap.mk <$> self.inner.mergeWithM f other.inner\n\n/--\nCombines two hashmaps using function `f` to combine two values at a key.\n```\nmergeWith (fun _ v₁ v₂ => v₁ + v₂ )\n (ofList [(\"one\", 1), (\"two\", 2)]) (ofList [(\"two\", 2), (\"three\", 3)]) =\n {\"one\" => 1, \"two\" => 4, \"three\" => 3}\n```\n-/\n@[inline] def mergeWith (f : α → β → β → β) (self other : HashMap α β) : HashMap α β :=\n ⟨self.inner.mergeWith f other.inner⟩\n\n/--\nRuns a monadic function over the elements in the map (in arbitrary order).\n```\ndef checkEven (k : String) (v : Nat) : Except String Unit :=\n if v % 2 == 0 then pure () else throw s!\"value {v} at key {k} is not even\"\n\nforM checkEven (ofList [(\"one\", 1), (\"three\", 3)]) = Except.error \"value 3 at key three is not even\"\nforM checkEven (ofList [(\"two\", 2), (\"four\", 4)]) = Except.ok ()\n```\n-/\n@[inline] def forM [Monad m] (f : α → β → m PUnit) (self : HashMap α β) : m PUnit :=\n Std.HashMap.forM f self.inner\n\n/--\nConverts the map into a list of key-value pairs.\n```\nopen List\n(ofList [(\"one\", 1), (\"two\", 2)]).toList ~ [(\"one\", 1), (\"two\", 2)]\n```\n-/\ndef toList (self : HashMap α β) : List (α × β) := self.inner.toList\n\n/--\nConverts the map into an array of key-value pairs.\n```\nopen List\n(ofList [(\"one\", 1), (\"two\", 2)]).toArray.data ~ #[(\"one\", 1), (\"two\", 2)].data\n```\n-/\ndef toArray (self : HashMap α β) : Array (α × β) := self.inner.toArray\n\n/-- The number of buckets in the hash map. -/\ndef numBuckets (self : HashMap α β) : Nat := Std.HashMap.Internal.numBuckets self.inner\n\n/--\nBuilds a `HashMap` from a list of key-value pairs.\nValues of duplicated keys are replaced by their respective last occurrences.\n```\nofList [(\"one\", 1), (\"one\", 2)] = {\"one\" => 2}\n```\n-/\ndef ofList [BEq α] [Hashable α] (l : List (α × β)) : HashMap α β :=\n ⟨Std.HashMap.ofList l⟩\n\n/--\nVariant of `ofList` which accepts a function that combines values of duplicated keys.\n```\nofListWith [(\"one\", 1), (\"one\", 2)] (fun v₁ v₂ => v₁ + v₂) = {\"one\" => 3}\n```\n-/\ndef ofListWith [BEq α] [Hashable α] (l : List (α × β)) (f : β → β → β) : HashMap α β :=\n ⟨Std.HashMap.ofListWith l f⟩\n" }, { "path": "Batteries/Data/HashMap.lean", "content": "module\n\npublic import Batteries.Data.HashMap.Basic\n" }, { "path": "Batteries/Data/Int.lean", "content": "/-\nCopyright (c) 2025 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Data.Nat.Lemmas\n\n@[expose] public section\n\nnamespace Int\n\n/--\n`testBit m n` returns whether the `(n+1)` least significant bit is `1` or `0`, using the two's\ncomplement convention for negative `m`.\n-/\ndef testBit : Int → Nat → Bool\n | ofNat m, n => Nat.testBit m n\n | negSucc m, n => !(Nat.testBit m n)\n\n/--\nConstruct an integer from a sequence of bits using little endian convention.\n\nThe sign is determined using the two's complement convention: the result is negative if and only if\n`n > 0` and `f (n-1) = true`.\n-/\ndef ofBits (f : Fin n → Bool) :=\n if 2 * Nat.ofBits f < 2 ^ n then\n ofNat (Nat.ofBits f)\n else\n subNatNat (Nat.ofBits f) (2 ^ n)\n\n@[simp] theorem ofBits_zero (f : Fin 0 → Bool) : ofBits f = 0 := by\n simp [ofBits]\n\n@[simp] theorem testBit_ofBits_lt {f : Fin n → Bool} (h : i < n) :\n (ofBits f).testBit i = f ⟨i, h⟩ := by\n simp only [ofBits]\n split\n · simp only [testBit, Nat.testBit_ofBits_lt, h]\n · have hlt := Nat.ofBits_lt_two_pow f\n simp [subNatNat_of_lt hlt, testBit, Nat.sub_sub, Nat.testBit_two_pow_sub_succ hlt, h]\n\n@[simp] theorem testBit_ofBits_ge {f : Fin n → Bool} (h : i ≥ n) :\n (ofBits f).testBit i = decide (ofBits f < 0) := by\n simp only [ofBits]\n split\n · have hge : ¬ ofNat (Nat.ofBits f) < 0 := by rw [Int.not_lt]; exact natCast_nonneg ..\n simp only [testBit, Nat.testBit_ofBits_ge _ _ h, hge, decide_false]\n · have hlt := Nat.ofBits_lt_two_pow f\n have h : 2 ^ n - Nat.ofBits f - 1 < 2 ^ i :=\n Nat.lt_of_lt_of_le (by omega) (Nat.pow_le_pow_right Nat.zero_lt_two h)\n simp [testBit, subNatNat_of_lt hlt, Nat.testBit_lt_two_pow h, negSucc_lt_zero]\n\ntheorem testBit_ofBits (f : Fin n → Bool) :\n (ofBits f).testBit i = if h : i < n then f ⟨i, h⟩ else decide (ofBits f < 0) := by\n split <;> simp_all\n" }, { "path": "Batteries/Data/List/ArrayMap.lean", "content": "/-\nCopyright (c) 2024 Michael Rothgang. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Michael Rothgang\n-/\nmodule\n\n@[expose] public section\n\nuniverse u v w\nvariable {α : Type u} {β : Type v}\n\nnamespace List\n\n/--\nThis function is provided as a more efficient runtime alternative to `(l.map f).toArray`.\n(It avoids the intermediate memory allocation of creating an intermediate list first.)\nFor verification purposes, we immediately simplify it to that form.\n-/\ndef toArrayMap (l : List α) (f : α → β) : Array β :=\n l.foldl (init := #[]) fun acc x => acc.push (f x)\n\n-- Future: a toArrayMapM version could be useful (e.g. in mathlib's DeriveToExpr)\n-- def toArrayMapM {m : Type v → Type w} [Monad m] (l : List α) (f : α → m β) : m (Array β) :=\n-- l.foldlM (init := #[]) fun acc x => acc.push (f x)\n\ntheorem toArrayMap_toList (l : List α) (f : α → β ) : (l.toArrayMap f).toList = l.map f := by\n suffices ∀ arr : Array β, (l.foldl (init := arr) fun acc x => acc.push (f x)).toList\n = arr.toList ++ l.map f from\n this #[]\n induction l with\n | nil => simp\n | cons head tail tail_ih =>\n intro arr\n have : arr.toList ++ f head :: map f tail = (arr.push (f head)).toList ++ map f tail := by simp\n rw [List.foldl_cons, List.map_cons, this, ← tail_ih]\n\n\n@[simp, grind =]\ntheorem toArrayMap_eq_toArray_map (l : List α) (f : α → β) : l.toArrayMap f = (l.map f).toArray :=\n Array.ext' (by simpa using toArrayMap_toList l f)\n\nend List\n" }, { "path": "Batteries/Data/List/Basic.lean", "content": "/-\nCopyright (c) 2016 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura\n-/\n\nmodule\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\nnamespace List\n\n/-! ## New definitions -/\n\n/--\nComputes the \"bag intersection\" of `l₁` and `l₂`, that is,\nthe collection of elements of `l₁` which are also in `l₂`. As each element\nis identified, it is removed from `l₂`, so elements are counted with multiplicity.\n-/\nprotected def bagInter {α} [BEq α] : List α → List α → List α\n | [], _ => []\n | _, [] => []\n | a :: l₁, l₂ => if l₂.elem a then a :: List.bagInter l₁ (l₂.erase a) else List.bagInter l₁ l₂\n\n/-- Computes the difference of `l₁` and `l₂`, by removing each element in `l₂` from `l₁`. -/\nprotected def diff {α} [BEq α] : List α → List α → List α\n | l, [] => l\n | l₁, a :: l₂ => if l₁.elem a then List.diff (l₁.erase a) l₂ else List.diff l₁ l₂\n\nopen Option Nat\n\n/-- Get the head and tail of a list, if it is nonempty. -/\n@[inline] def next? : List α → Option (α × List α)\n | [] => none\n | a :: l => some (a, l)\n\n/--\n`after p xs` is the suffix of `xs` after the first element that satisfies\n`p`, not including that element.\n```lean\nafter (· == 1) [0, 1, 2, 3] = [2, 3]\ndrop_while (· != 1) [0, 1, 2, 3] = [1, 2, 3]\n```\n-/\n@[specialize] def after (p : α → Bool) : List α → List α\n | [] => []\n | x :: xs => bif p x then xs else after p xs\n\n/-- Replaces the first element of the list for which `f` returns `some` with the returned value. -/\n@[simp] def replaceF (f : α → Option α) : List α → List α\n | [] => []\n | x :: xs => match f x with\n | none => x :: replaceF f xs\n | some a => a :: xs\n\n/-- Tail-recursive version of `replaceF`. -/\n@[inline] def replaceFTR (f : α → Option α) (l : List α) : List α := go l #[] where\n /-- Auxiliary for `replaceFTR`: `replaceFTR.go f xs acc = acc.toList ++ replaceF f xs`. -/\n @[specialize] go : List α → Array α → List α\n | [], acc => acc.toList\n | x :: xs, acc => match f x with\n | none => go xs (acc.push x)\n | some a' => acc.toListAppend (a' :: xs)\n\n@[csimp] theorem replaceF_eq_replaceFTR : @replaceF = @replaceFTR := by\n funext α p l; simp [replaceFTR]\n let rec go (acc) : ∀ xs, replaceFTR.go p xs acc = acc.toList ++ xs.replaceF p\n | [] => by simp [replaceFTR.go, replaceF]\n | x::xs => by\n simp [replaceFTR.go, replaceF]; cases p x <;> simp\n · rw [go _ xs]; simp\n exact (go #[] _).symm\n\n/--\nConstructs the union of two lists, by inserting the elements of `l₁` in reverse order to `l₂`.\nAs a result, `l₂` will always be a suffix, but only the last occurrence of each element in `l₁`\nwill be retained (but order will otherwise be preserved).\n-/\n@[inline] protected def union [BEq α] (l₁ l₂ : List α) : List α := foldr .insert l₂ l₁\n\ninstance [BEq α] : Union (List α) := ⟨List.union⟩\n\n/--\nConstructs the intersection of two lists, by filtering the elements of `l₁` that are in `l₂`.\nUnlike `bagInter` this does not preserve multiplicity: `[1, 1].inter [1]` is `[1, 1]`.\n-/\n@[inline] protected def inter [BEq α] (l₁ l₂ : List α) : List α := filter (elem · l₂) l₁\n\ninstance [BEq α] : Inter (List α) := ⟨List.inter⟩\n\n/--\nSplit a list at an index. Ensures the left list always has the specified length\nby right padding with the provided default element.\n```\nsplitAtD 2 [a, b, c] x = ([a, b], [c])\nsplitAtD 4 [a, b, c] x = ([a, b, c, x], [])\n```\n-/\ndef splitAtD (n : Nat) (l : List α) (dflt : α) : List α × List α := go n l [] where\n /-- Auxiliary for `splitAtD`: `splitAtD.go dflt n l acc = (acc.reverse ++ left, right)`\n if `splitAtD n l dflt = (left, right)`. -/\n go : Nat → List α → List α → List α × List α\n | n+1, x :: xs, acc => go n xs (x :: acc)\n | 0, xs, acc => (acc.reverse, xs)\n | n, [], acc => (acc.reverseAux (replicate n dflt), [])\n\n/-- Apply `f` to the last element of `l`, if it exists. -/\n@[inline] def modifyLast (f : α → α) (l : List α) : List α := go l #[] where\n /-- Auxiliary for `modifyLast`: `modifyLast.go f l acc = acc.toList ++ modifyLast f l`. -/\n @[specialize] go : List α → Array α → List α\n | [], _ => []\n | [x], acc => acc.toListAppend [f x]\n | x :: xs, acc => go xs (acc.push x)\n\ntheorem headD_eq_head? (l) (a : α) : headD l a = (head? l).getD a := by cases l <;> rfl\n\n/--\nTake `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l`\nelements `x`.\n-/\ndef takeD : Nat → List α → α → List α\n | 0, _, _ => []\n | n+1, l, x => l.headD x :: takeD n l.tail x\n\n@[simp] theorem takeD_zero (l) (a : α) : takeD 0 l a = [] := rfl\n@[simp] theorem takeD_succ (l) (a : α) :\n takeD (n+1) l a = l.head?.getD a :: takeD n l.tail a := by simp [takeD]\n\n@[simp] theorem takeD_nil (n) (a : α) : takeD n [] a = replicate n a := by\n induction n <;> simp [*, replicate_succ]\n\n/-- Tail-recursive version of `takeD`. -/\ndef takeDTR (n : Nat) (l : List α) (dflt : α) : List α := go n l #[] where\n /-- Auxiliary for `takeDTR`: `takeDTR.go dflt n l acc = acc.toList ++ takeD n l dflt`. -/\n go : Nat → List α → Array α → List α\n | n+1, x :: xs, acc => go n xs (acc.push x)\n | 0, _, acc => acc.toList\n | n, [], acc => acc.toListAppend (replicate n dflt)\n\ntheorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.toList ++ takeD n l dflt\n | 0, _ => by simp [takeDTR.go]\n | _+1, [] => by simp [takeDTR.go, replicate_succ]\n | _+1, _::l => by simp [takeDTR.go, takeDTR_go_eq _ l]\n\n@[csimp] theorem takeD_eq_takeDTR : @takeD = @takeDTR := by\n funext α f n l; simp [takeDTR, takeDTR_go_eq]\n\n\n/-- Tail-recursive helper function for `scanlM` and `scanrM` -/\n@[inline]\ndef scanAuxM [Monad m] (f : β → α → m β) (init : β) (l : List α) : m (List β) :=\n go l init []\nwhere\n /-- Auxiliary for `scanAuxM` -/\n @[specialize] go : List α → β → List β → m (List β)\n | [], last, acc => pure <| last :: acc\n | x :: xs, last, acc => do go xs (← f last x) (last :: acc)\n\n/--\nFold a list from left to right as with `foldl`, but the combining function\nalso receives each element's index added to an optional parameter `start`\n(i.e. the numbers that `f` takes as its first argument will be greater than or equal to `start` and\nless than `start + l.length`).\n-/\n@[specialize] def foldlIdx (f : Nat → α → β → α) (init : α) :\n List β → (start : Nat := 0) → α\n | [], _ => init\n | b :: l, s => foldlIdx f (f s init b) l (s + 1)\n\n/--\nFold a list from right to left as with `foldr`, but the combining function\nalso receives each element's index added to an optional parameter `start`\n(i.e. the numbers that `f` takes as its first argument will be greater than or equal to `start` and\nless than `start + l.length`).\n-/\ndef foldrIdx {α : Type u} {β : Type v} (f : Nat → α → β → β) (init : β) :\n (l : List α) → (start : Nat := 0) → β\n | [], _ => init\n | a :: l, s => f s a (foldrIdx f init l (s + 1))\n\n/-- A tail-recursive version of `foldrIdx`. -/\n@[inline] def foldrIdxTR (f : Nat → α → β → β) (init : β) (l : List α) (start : Nat := 0) : β :=\n l.foldr (fun a (acc, n) => (f (n - 1) a acc, n - 1)) (init, start + l.length) |>.1\n\n@[csimp] theorem foldrIdx_eq_foldrIdxTR : @foldrIdx = @foldrIdxTR := by\n funext _ _ f\n have go i xs s : xs.foldr (fun a xa => (f (xa.2 - 1) a xa.1, xa.2 - 1)) (i, s + xs.length) =\n (foldrIdx f i xs s, s) := by induction xs generalizing s <;> grind [foldrIdx]\n grind [foldrIdxTR]\n\n/-- `findIdxs p l s` is the list of indexes of elements of `l` that satisfy `p`, added to an\noptional parameter `s` (so that the members of `findIdxs p l s` will be greater than or\nequal to `s` and less than `l.length + s`). -/\n@[inline] def findIdxs (p : α → Bool) (l : List α) (start : Nat := 0) : List Nat :=\n foldrIdx (fun i a is => bif p a then i :: is else is) [] l start\n\n/--\nReturns the elements of `l` that satisfy `p` together with their indexes in\n`l` added to an optional parameter `start`. The returned list is ordered by index.\nWe have `l.findIdxsValues p s = (l.findIdxs p s).zip (l.filter p)`.\n-/\n@[inline] def findIdxsValues (p : α → Bool) (l : List α) (start : Nat := 0) : List (Nat × α) :=\n foldrIdx (fun i a l => if p a then (i, a) :: l else l) [] l start\n\n@[deprecated (since := \"2025-11-06\")]\nalias indexsValues := findIdxsValues\n\n/-- `findIdxNth p xs n` returns the index of the `n`th element for which `p` returns `true`.\nFor example:\n```\nfindIdxNth (· < 3) [5, 1, 3, 2, 4, 0, 1, 4] 2 = 5\n```\n-/\n@[inline] def findIdxNth (p : α → Bool) (xs : List α) (n : Nat) : Nat := go xs n 0 where\n /-- Auxiliary for `findIdxNth`: `findIdxNth.go p l n acc = findIdxNth p l n + acc`. -/\n @[specialize] go : (xs : List α) → (n : Nat) → (s : Nat) → Nat\n | [], _, s => s\n | a :: xs, 0, s => bif p a then s else go xs 0 (s + 1)\n | a :: xs, n + 1, s => bif !(p a) then go xs (n + 1) (s + 1) else go xs n (s + 1)\n\n/--\n`idxsOf a l s` is the list of all indexes of `a` in `l`, added to an\noptional parameter `s`. For example:\n```\nidxsOf b [a, b, a, a] = [1]\nidxsOf a [a, b, a, a] 5 = [5, 7, 8]\n```\n-/\n@[inline] def idxsOf [BEq α] (a : α) (xs : List α) (start : Nat := 0) : List Nat :=\n xs.findIdxs (· == a) start\n\n@[deprecated (since := \"2025-11-06\")]\nalias indexesOf := idxsOf\n\n/-- `idxOfNth a xs n` returns the index of the `n`th instance of `a` in `xs`, counting from `0`.\n\nFor example:\n```\nidxOfNth 1 [5, 1, 3, 2, 4, 0, 1, 4] 1 = 6\n```\n-/\ndef idxOfNth [BEq α] (a : α) (xs : List α) (n : Nat) : Nat :=\n xs.findIdxNth (· == a) n\n\n/-- `countPBefore p xs i hip` counts the number of `x` in `xs` before the `i`th index for\nwhich `p x = true`.\n\nFor example:\n```\ncountPBefore (· < 3) [5, 1, 3, 2, 4, 0, 1, 4] 5 = 2\n```\n-/\ndef countPBefore (p : α → Bool) (xs : List α) (i : Nat) : Nat := go xs i 0 where\n /-- Auxiliary for `countPBefore`: `countPBefore.go p l i acc = countPBefore p l i + acc`. -/\n @[specialize] go : (xs : List α) → (i : Nat) → (s : Nat) → Nat\n | _ :: _, 0, s => s\n | a :: xs, i + 1, s => bif p a then go xs i (s + 1) else go xs i s\n | [], _, s => s\n\n/-- `countBefore a xs n` counts the number of `x` in `xs` before the\n`i`th index for which `x == a` is true.\n\nFor example:\n```\ncountBefore 1 [5, 1, 3, 2, 4, 0, 1, 4] 6 = 1\n```\n-/\ndef countBefore [BEq α] (a : α) : List α → Nat → Nat :=\n countPBefore (· == a)\n\n/--\n`lookmap` is a combination of `lookup` and `filterMap`.\n`lookmap f l` will apply `f : α → Option α` to each element of the list,\nreplacing `a → b` at the first value `a` in the list such that `f a = some b`.\n-/\n@[inline] def lookmap (f : α → Option α) (l : List α) : List α := go l #[] where\n /-- Auxiliary for `lookmap`: `lookmap.go f l acc = acc.toList ++ lookmap f l`. -/\n @[specialize] go : List α → Array α → List α\n | [], acc => acc.toList\n | a :: l, acc => match f a with\n | some b => acc.toListAppend (b :: l)\n | none => go l (acc.push a)\n\n/--\n`inits l` is the list of initial segments of `l`.\n```\ninits [1, 2, 3] = [[], [1], [1, 2], [1, 2, 3]]\n```\n-/\n@[simp] def inits : List α → List (List α)\n | [] => [[]]\n | a :: l => [] :: map (fun t => a :: t) (inits l)\n\n/-- Tail-recursive version of `inits`. -/\ndef initsTR (l : List α) : List (List α) :=\n l.foldr (fun a arrs => (arrs.map fun t => a :: t).push []) #[[]] |>.toListRev\n\n@[csimp] theorem inits_eq_initsTR : @inits = @initsTR := by\n funext α l; simp [initsTR]; induction l <;> simp [*, map_reverse]\n\n/--\n`tails l` is the list of terminal segments of `l`.\n```\ntails [1, 2, 3] = [[1, 2, 3], [2, 3], [3], []]\n```\n-/\n@[simp] def tails : List α → List (List α)\n | [] => [[]]\n | a :: l => (a :: l) :: tails l\n\n/-- Tail-recursive version of `tails`. -/\ndef tailsTR (l : List α) : List (List α) := go l #[] where\n /-- Auxiliary for `tailsTR`: `tailsTR.go l acc = acc.toList ++ tails l`. -/\n go (l : List α) (acc : Array (List α)) : List (List α) :=\n match l with\n | [] => acc.toListAppend [[]]\n | _::xs => go xs (acc.push l)\n\n@[csimp] theorem tails_eq_tailsTR : @tails = @tailsTR := by\n funext α\n have H (l : List α) : ∀ acc, tailsTR.go l acc = acc.toList ++ tails l := by\n induction l <;> simp [*, tailsTR.go]\n simp (config := { unfoldPartialApp := true }) [tailsTR, H]\n\n/--\n`sublists' l` is the list of all (non-contiguous) sublists of `l`.\nIt differs from `sublists` only in the order of appearance of the sublists;\n`sublists'` uses the first element of the list as the MSB,\n`sublists` uses the first element of the list as the LSB.\n```\nsublists' [1, 2, 3] = [[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]]\n```\n-/\ndef sublists' (l : List α) : List (List α) :=\n let f a arr := arr.foldl (init := arr) fun r l => r.push (a :: l)\n (l.foldr f #[[]]).toList\n\n/--\n`sublists l` is the list of all (non-contiguous) sublists of `l`; cf. `sublists'`\nfor a different ordering.\n```\nsublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]]\n```\n-/\ndef sublists (l : List α) : List (List α) :=\n l.foldr (fun a acc => acc.flatMap fun x => [x, a :: x]) [[]]\n\n/-- A version of `List.sublists` that has faster runtime performance but worse kernel performance -/\ndef sublistsFast (l : List α) : List (List α) :=\n let f a arr := arr.foldl (init := Array.mkEmpty (arr.size * 2))\n fun r l => (r.push l).push (a :: l)\n (l.foldr f #[[]]).toList\n\n@[csimp] theorem sublists_eq_sublistsFast : @sublists = @sublistsFast :=\n funext <| fun _ => funext fun _ => foldr_hom Array.toList fun _ r =>\n flatMap_eq_foldl.trans <| (foldl_toArray _ _ _).symm.trans <|\n r.foldl_hom Array.toList <| fun r _ => r.toList_append.symm\n\nsection Forall₂\n\nvariable {r : α → β → Prop} {p : γ → δ → Prop}\n\n/--\n`Forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length,\nand whenever `a` is the nth element of `l₁`, and `b` is the nth element of `l₂`,\nthen `R a b` is satisfied.\n-/\ninductive Forall₂ (R : α → β → Prop) : List α → List β → Prop\n /-- Two nil lists are `Forall₂`-related -/\n | nil : Forall₂ R [] []\n /-- Two cons lists are related by `Forall₂ R`\n if the heads are related by `R` and the tails are related by `Forall₂ R` -/\n | cons {a b l₁ l₂} : R a b → Forall₂ R l₁ l₂ → Forall₂ R (a :: l₁) (b :: l₂)\n\nattribute [simp] Forall₂.nil\n\n@[simp] theorem forall₂_cons {R : α → β → Prop} {a b l₁ l₂} :\n Forall₂ R (a :: l₁) (b :: l₂) ↔ R a b ∧ Forall₂ R l₁ l₂ :=\n ⟨fun | .cons h tail => ⟨h, tail⟩, fun ⟨head, tail⟩ => .cons head tail⟩\n\n/--\nCheck for all elements `a`, `b`, where `a` and `b` are the nth element of the first and second\nList respectively, that `r a b = true`.\n-/\ndef all₂ (r : α → β → Bool) : List α → List β → Bool\n | [], [] => true\n | a::as, b::bs =>\n if r a b then\n all₂ r as bs\n else false\n | _, _ => false\n\n@[simp] theorem all₂_eq_true {r : α → β → Bool} :\n ∀ l₁ l₂, all₂ r l₁ l₂ ↔ Forall₂ (r · ·) l₁ l₂\n | [], [] => by simp [all₂]\n | a::as, b::bs => by\n by_cases h : r a b\n <;> simp [all₂, h, all₂_eq_true, forall₂_cons]\n | _::_, [] | [], _::_ => by\n simp [all₂]\n exact nofun\n\ninstance {R : α → β → Prop} [∀ a b, Decidable (R a b)] : ∀ l₁ l₂, Decidable (Forall₂ R l₁ l₂) :=\n fun l₁ l₂ => decidable_of_iff (all₂ (R · ·) l₁ l₂) (by simp [all₂_eq_true])\n\nend Forall₂\n\n/--\nTranspose of a list of lists, treated as a matrix.\n```\ntranspose [[1, 2], [3, 4], [5, 6]] = [[1, 3, 5], [2, 4, 6]]\n```\n-/\ndef transpose (l : List (List α)) : List (List α) := (l.foldr go #[]).toList where\n /-- `pop : List α → StateM (List α) (List α)` transforms the input list `old`\n by taking the head of the current state and pushing it on the head of `old`.\n If the state list is empty, then `old` is left unchanged. -/\n pop (old : List α) : StateM (List α) (List α)\n | [] => (old, [])\n | a :: l => (a :: old, l)\n\n /-- `go : List α → Array (List α) → Array (List α)` handles the insertion of\n a new list into all the lists in the array:\n `go [a, b, c] #[l₁, l₂, l₃] = #[a::l₁, b::l₂, c::l₃]`.\n If the new list is too short, the later lists are unchanged, and if it is too long\n the array is extended:\n ```\n go [a] #[l₁, l₂, l₃] = #[a::l₁, l₂, l₃]\n go [a, b, c, d] #[l₁, l₂, l₃] = #[a::l₁, b::l₂, c::l₃, [d]]\n ```\n -/\n go (l : List α) (acc : Array (List α)) : Array (List α) :=\n let (acc, l) := acc.mapM pop l\n l.foldl (init := acc) fun arr a => arr.push [a]\n\n/--\nList of all sections through a list of lists. A section\nof `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from\n`L₁`, whose second element comes from `L₂`, and so on.\n-/\n@[simp] def sections : List (List α) → List (List α)\n | [] => [[]]\n | l :: L => (sections L).flatMap fun s => l.map fun a => a :: s\n\n/-- Optimized version of `sections`. -/\ndef sectionsTR (L : List (List α)) : List (List α) :=\n bif L.any isEmpty then [] else (L.foldr go #[[]]).toList\nwhere\n /-- `go : List α → Array (List α) → Array (List α)` inserts one list into the accumulated\n list of sections `acc`: `go [a, b] #[l₁, l₂] = [a::l₁, b::l₁, a::l₂, b::l₂]`. -/\n go (l : List α) (acc : Array (List α)) : Array (List α) :=\n acc.foldl (init := #[]) fun acc' l' =>\n l.foldl (init := acc') fun acc' a =>\n acc'.push (a :: l')\n\ntheorem sections_eq_nil_of_isEmpty : ∀ {L}, L.any isEmpty → @sections α L = []\n | l :: L, h => by\n simp only [any, Bool.or_eq_true] at h\n match l, h with\n | [], .inl rfl => simp\n | l, .inr h => simp [sections, sections_eq_nil_of_isEmpty h]\n\n@[csimp] theorem sections_eq_sectionsTR : @sections = @sectionsTR := by\n funext α L; simp [sectionsTR]\n cases e : L.any isEmpty <;> simp [sections_eq_nil_of_isEmpty, *]\n clear e; induction L with | nil => rfl | cons l L IH => ?_\n simp [IH, sectionsTR.go]\n rfl\n\n/--\n`extractP p l` returns a pair of an element `a` of `l` satisfying the predicate\n`p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`.\n-/\ndef extractP (p : α → Bool) (l : List α) : Option α × List α := go l #[] where\n /-- Auxiliary for `extractP`:\n `extractP.go p l xs acc = (some a, acc.toList ++ out)` if `extractP p xs = (some a, out)`,\n and `extractP.go p l xs acc = (none, l)` if `extractP p xs = (none, _)`. -/\n go : List α → Array α → Option α × List α\n | [], _ => (none, l)\n | a :: l, acc => bif p a then (some a, acc.toListAppend l) else go l (acc.push a)\n\n/--\n`revzip l` returns a list of pairs of the elements of `l` paired\nwith the elements of `l` in reverse order.\n```\nrevzip [1, 2, 3, 4, 5] = [(1, 5), (2, 4), (3, 3), (4, 2), (5, 1)]\n```\n-/\ndef revzip (l : List α) : List (α × α) := zip l l.reverse\n\n/--\n`product l₁ l₂` is the list of pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂`.\n```\nproduct [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)]\n```\n-/\ndef product (l₁ : List α) (l₂ : List β) : List (α × β) := l₁.flatMap fun a => l₂.map (Prod.mk a)\n\n/-- Optimized version of `product`. -/\ndef productTR (l₁ : List α) (l₂ : List β) : List (α × β) :=\n l₁.foldl (fun acc a => l₂.foldl (fun acc b => acc.push (a, b)) acc) #[] |>.toList\n\n@[csimp] theorem product_eq_productTR : @product = @productTR := by\n funext α β l₁ l₂; simp only [product, productTR]\n rw [Array.foldl_toList_eq_flatMap]; rfl\n simp\n\n/-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`.\n```\nsigma [1, 2] (λ_, [(5 : Nat), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)]\n``` -/\nprotected def sigma {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) :=\n l₁.flatMap fun a => (l₂ a).map (Sigma.mk a)\n\n/-- Optimized version of `sigma`. -/\ndef sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) :=\n l₁.foldl (fun acc a => (l₂ a).foldl (fun acc b => acc.push ⟨a, b⟩) acc) #[] |>.toList\n\n@[csimp] theorem sigma_eq_sigmaTR : @List.sigma = @sigmaTR := by\n funext α β l₁ l₂; simp only [List.sigma, sigmaTR]\n rw [Array.foldl_toList_eq_flatMap]; rfl\n simp\n\n/-- `ofFnNthVal f i` returns `some (f i)` if `i < n` and `none` otherwise. -/\ndef ofFnNthVal {n} (f : Fin n → α) (i : Nat) : Option α :=\n if h : i < n then some (f ⟨i, h⟩) else none\n\n/-- `Disjoint l₁ l₂` means that `l₁` and `l₂` have no elements in common. -/\ndef Disjoint (l₁ l₂ : List α) : Prop :=\n ∀ ⦃a⦄, a ∈ l₁ → a ∈ l₂ → False\n\n/--\nReturns the longest initial prefix of two lists such that they are pairwise related by `R`.\n```\ntakeWhile₂ (· < ·) [1, 2, 4, 5] [5, 4, 3, 6] = ([1, 2], [5, 4])\n```\n-/\ndef takeWhile₂ (R : α → β → Bool) : List α → List β → List α × List β\n | a::as, b::bs => if R a b then\n let (as', bs') := takeWhile₂ R as bs\n (a::as', b::bs')\n else ([], [])\n | _, _ => ([], [])\n\n/-- Tail-recursive version of `takeWhile₂`. -/\n@[inline] def takeWhile₂TR (R : α → β → Bool) (as : List α) (bs : List β) : List α × List β :=\n go as bs [] []\nwhere\n /-- Auxiliary for `takeWhile₂TR`:\n `takeWhile₂TR.go R as bs acca accb = (acca.reverse ++ as', acca.reverse ++ bs')`\n if `takeWhile₂ R as bs = (as', bs')`. -/\n @[specialize] go : List α → List β → List α → List β → List α × List β\n | a::as, b::bs, acca, accb =>\n bif R a b then go as bs (a::acca) (b::accb) else (acca.reverse, accb.reverse)\n | _, _, acca, accb => (acca.reverse, accb.reverse)\n\n@[csimp] theorem takeWhile₂_eq_takeWhile₂TR : @takeWhile₂ = @takeWhile₂TR := by\n funext α β R as bs; simp [takeWhile₂TR]\n let rec go (as bs acca accb) : takeWhile₂TR.go R as bs acca accb =\n (acca.reverse ++ (as.takeWhile₂ R bs).1, accb.reverse ++ (as.takeWhile₂ R bs).2) := by\n unfold takeWhile₂TR.go takeWhile₂; split <;> simp\n rename_i a as b bs; unfold cond; cases R a b <;> simp [go as bs]\n exact (go as bs [] []).symm\n\n/--\n`pwFilter R l` is a maximal sublist of `l` which is `Pairwise R`.\n`pwFilter (·≠·)` is the erase duplicates function (cf. `eraseDups`), and `pwFilter (·<·)` finds\na maximal increasing subsequence in `l`. For example,\n```\npwFilter (·<·) [0, 1, 5, 2, 6, 3, 4] = [0, 1, 2, 3, 4]\n```\n-/\ndef pwFilter (R : α → α → Prop) [DecidableRel R] (l : List α) : List α :=\n l.foldr (fun x IH => if ∀ y ∈ IH, R x y then x :: IH else IH) []\n\n/--\n`IsChain R l` means that `R` holds between adjacent elements of `l`. Example:\n```\nIsChain R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d\n```\n-/\ninductive IsChain (R : α → α → Prop) : List α → Prop where\n /-- A list of length 0 is a chain. -/\n | nil : IsChain R []\n /-- A list of length 1 is a chain. -/\n | singleton (a : α) : IsChain R [a]\n /-- If `a` relates to `b` and `b::l` is a chain, then `a :: b :: l` is also a chain. -/\n | cons_cons (hr : R a b) (h : IsChain R (b :: l)) : IsChain R (a :: b :: l)\n\nattribute [simp, grind ←] IsChain.nil\nattribute [simp, grind ←] IsChain.singleton\n\n@[simp, grind =] theorem isChain_cons_cons : IsChain R (a :: b :: l) ↔ R a b ∧ IsChain R (b :: l) :=\n ⟨fun | .cons_cons hr h => ⟨hr, h⟩, fun ⟨hr, h⟩ => .cons_cons hr h⟩\n\ninstance {R : α → α → Prop} [h : DecidableRel R] : (l : List α) → Decidable (l.IsChain R)\n | [] => isTrue .nil | a :: l => go a l\nwhere\n go (a : α) (l : List α) : Decidable ((a :: l).IsChain R) :=\n match l with\n | [] => isTrue <| .singleton a\n | b :: l => haveI := (go b l); decidable_of_iff' _ isChain_cons_cons\n\n/-- `Chain R a l` means that `R` holds between adjacent elements of `a::l`.\n```\nChain R a [b, c, d] ↔ R a b ∧ R b c ∧ R c d\n``` -/\n@[deprecated IsChain (since := \"2025-09-19\")]\ndef Chain : (α → α → Prop) → α → List α → Prop := (IsChain · <| · :: ·)\n\nset_option linter.deprecated false in\n/-- A list of length 1 is a chain. -/\n@[deprecated IsChain.singleton (since := \"2025-09-19\")]\ntheorem Chain.nil {a : α} : Chain R a [] := IsChain.singleton a\n\nset_option linter.deprecated false in\n/-- If `a` relates to `b` and `b::l` is a chain, then `a :: b :: l` is also a chain. -/\n@[deprecated IsChain.cons_cons (since := \"2025-09-19\")]\ntheorem Chain.cons : R a b → Chain R b l → Chain R a (b :: l) := IsChain.cons_cons\n\n/-- `Chain' R l` means that `R` holds between adjacent elements of `l`.\n```\nChain' R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d\n``` -/\n@[deprecated IsChain (since := \"2025-09-19\")]\ndef Chain' : (α → α → Prop) → List α → Prop := (IsChain · ·)\n\n/-- **Deprecated:** Use `reverse ∘ eraseDups ∘ reverse` or just `eraseDups` instead. -/\n@[deprecated \"use `reverse ∘ eraseDups ∘ reverse` or just `eraseDups`\" (since := \"2026-01-03\")]\nabbrev eraseDup [BEq α] : List α → List α := pwFilter (· != ·)\n\n/--\n`rotate l n` rotates the elements of `l` to the left by `n`\n```\nrotate [0, 1, 2, 3, 4, 5] 2 = [2, 3, 4, 5, 0, 1]\n```\n-/\n@[inline] def rotate (l : List α) (n : Nat) : List α :=\n let (l₁, l₂) := List.splitAt (n % l.length) l\n l₂ ++ l₁\n\n/-- `rotate'` is the same as `rotate`, but slower. Used for proofs about `rotate` -/\n@[simp] def rotate' : List α → Nat → List α\n | [], _ => []\n | l, 0 => l\n | a :: l, n+1 => rotate' (l ++ [a]) n\n\n/--\n`mapDiagM f l` calls `f` on all elements in the upper triangular part of `l × l`.\nThat is, for each `e ∈ l`, it will run `f e e` and then `f e e'`\nfor each `e'` that appears after `e` in `l`.\n```\nmapDiagM f [1, 2, 3] =\n return [← f 1 1, ← f 1 2, ← f 1 3, ← f 2 2, ← f 2 3, ← f 3 3]\n```\n-/\ndef mapDiagM [Monad m] (f : α → α → m β) (l : List α) : m (List β) := go l #[] where\n /-- Auxiliary for `mapDiagM`: `mapDiagM.go as f acc = (acc.toList ++ ·) <$> mapDiagM f as` -/\n go : List α → Array β → m (List β)\n | [], acc => pure acc.toList\n | x::xs, acc => do\n let b ← f x x\n let acc ← xs.foldlM (·.push <$> f x ·) (acc.push b)\n go xs acc\n\n/--\n`forDiagM f l` calls `f` on all elements in the upper triangular part of `l × l`.\nThat is, for each `e ∈ l`, it will run `f e e` and then `f e e'`\nfor each `e'` that appears after `e` in `l`.\n```\nforDiagM f [1, 2, 3] = do f 1 1; f 1 2; f 1 3; f 2 2; f 2 3; f 3 3\n```\n-/\n@[simp] def forDiagM [Monad m] (f : α → α → m PUnit) : List α → m PUnit\n | [] => pure ⟨⟩\n | x :: xs => do f x x; xs.forM (f x); xs.forDiagM f\n\n/-- `getRest l l₁` returns `some l₂` if `l = l₁ ++ l₂`.\n If `l₁` is not a prefix of `l`, returns `none` -/\ndef getRest [DecidableEq α] : List α → List α → Option (List α)\n | l, [] => some l\n | [], _ => none\n | x :: l, y :: l₁ => if x = y then getRest l l₁ else none\n\n/-- `List.dropSlice n m xs` removes a slice of length `m` at index `n` in list `xs`. -/\n@[simp] def dropSlice : Nat → Nat → List α → List α\n | _, _, [] => []\n | 0, m, xs => xs.drop m\n | n+1, m, x :: xs => x :: dropSlice n m xs\n\n/-- Optimized version of `dropSlice`. -/\n@[inline] def dropSliceTR (n m : Nat) (l : List α) : List α :=\n match m with\n | 0 => l\n | m+1 => go m l n #[]\nwhere\n /-- Auxiliary for `dropSliceTR`: `dropSliceTR.go l m xs n acc = acc.toList ++ dropSlice n m xs`\n unless `n ≥ length xs`, in which case it is `l`. -/\n go (m : Nat) : List α → Nat → Array α → List α\n | [], _, _ => l\n | _::xs, 0, acc => acc.toListAppend (xs.drop m)\n | x::xs, n+1, acc => go m xs n (acc.push x)\n\ntheorem dropSlice_zero₂ : ∀ n l, @dropSlice α n 0 l = l\n | 0, [] | 0, _::_ | _+1, [] => rfl\n | n+1, x::xs => by simp [dropSlice, dropSlice_zero₂]\n\n@[csimp] theorem dropSlice_eq_dropSliceTR : @dropSlice = @dropSliceTR := by\n funext α n m l; simp [dropSliceTR]\n split; { rw [dropSlice_zero₂] }\n rename_i m\n let rec go (acc) : ∀ xs n, l = acc.toList ++ xs →\n dropSliceTR.go l m xs n acc = acc.toList ++ xs.dropSlice n (m+1)\n | [], n\n | _::xs, 0 => fun h => by simp [dropSliceTR.go, dropSlice, h]\n | x::xs, n+1 => by simp [dropSliceTR.go, dropSlice]; intro h; rw [go _ xs]; {simp}; simp [h]\n exact (go #[] _ _ rfl).symm\n\n/--\nLeft-biased version of `List.zipWith`. `zipWithLeft' f as bs` applies `f` to each\npair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is\napplied to `none` for the remaining `aᵢ`. Returns the results of the `f`\napplications and the remaining `bs`.\n```\nzipWithLeft' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])\nzipWithLeft' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])\n```\n-/\n@[simp] def zipWithLeft' (f : α → Option β → γ) : List α → List β → List γ × List β\n | [], bs => ([], bs)\n | a :: as, [] => ((a :: as).map fun a => f a none, [])\n | a :: as, b :: bs => let r := zipWithLeft' f as bs; (f a (some b) :: r.1, r.2)\n\n/-- Tail-recursive version of `zipWithLeft'`. -/\n@[inline] def zipWithLeft'TR (f : α → Option β → γ)\n (as : List α) (bs : List β) : List γ × List β := go as bs #[] where\n /-- Auxiliary for `zipWithLeft'TR`: `zipWithLeft'TR.go l acc = acc.toList ++ zipWithLeft' l`. -/\n go : List α → List β → Array γ → List γ × List β\n | [], bs, acc => (acc.toList, bs)\n | as, [], acc => (as.foldl (fun acc a => acc.push (f a none)) acc |>.toList, [])\n | a :: as, b :: bs, acc => go as bs (acc.push (f a (some b)))\n\n@[csimp] theorem zipWithLeft'_eq_zipWithLeft'TR : @zipWithLeft' = @zipWithLeft'TR := by\n funext α β γ f as bs; simp [zipWithLeft'TR]\n let rec go (acc) : ∀ as bs, zipWithLeft'TR.go f as bs acc =\n let (l, r) := as.zipWithLeft' f bs; (acc.toList ++ l, r)\n | [], bs => by simp [zipWithLeft'TR.go]\n | _::_, [] => by simp [zipWithLeft'TR.go]\n | a::as, b::bs => by simp [zipWithLeft'TR.go, go _ as bs]\n simp [go]\n\n/--\nRight-biased version of `List.zipWith`. `zipWithRight' f as bs` applies `f` to each\npair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is\napplied to `none` for the remaining `bᵢ`. Returns the results of the `f`\napplications and the remaining `as`.\n```\nzipWithRight' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])\nzipWithRight' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])\n```\n-/\n@[inline] def zipWithRight' (f : Option α → β → γ) (as : List α) (bs : List β) : List γ × List α :=\n zipWithLeft' (flip f) bs as\n\n/--\nLeft-biased version of `List.zip`. `zipLeft' as bs` returns the list of\npairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the\nremaining `aᵢ` are paired with `none`. Also returns the remaining `bs`.\n```\nzipLeft' [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])\nzipLeft' [1] ['a', 'b'] = ([(1, some 'a')], ['b'])\nzipLeft' = zipWithLeft' prod.mk\n```\n-/\n@[inline] def zipLeft' : List α → List β → List (α × Option β) × List β := zipWithLeft' Prod.mk\n\n/--\nRight-biased version of `List.zip`. `zipRight' as bs` returns the list of\npairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the\nremaining `bᵢ` are paired with `none`. Also returns the remaining `as`.\n```\nzipRight' [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])\nzipRight' [1, 2] ['a'] = ([(some 1, 'a')], [2])\nzipRight' = zipWithRight' prod.mk\n```\n-/\n@[inline] def zipRight' : List α → List β → List (Option α × β) × List α := zipWithRight' Prod.mk\n\n/--\nLeft-biased version of `List.zipWith`. `zipWithLeft f as bs` applies `f` to each pair\n`aᵢ ∈ as` and `bᵢ ‌∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`\nfor the remaining `aᵢ`.\n```\nzipWithLeft prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]\nzipWithLeft prod.mk [1] ['a', 'b'] = [(1, some 'a')]\nzipWithLeft f as bs = (zipWithLeft' f as bs).fst\n```\n-/\n@[simp] def zipWithLeft (f : α → Option β → γ) : List α → List β → List γ\n | [], _ => []\n | a :: as, [] => (a :: as).map fun a => f a none\n | a :: as, b :: bs => f a (some b) :: zipWithLeft f as bs\n\n/-- Tail-recursive version of `zipWithLeft`. -/\n@[inline] def zipWithLeftTR (f : α → Option β → γ)\n (as : List α) (bs : List β) : List γ := go as bs #[] where\n /-- Auxiliary for `zipWithLeftTR`: `zipWithLeftTR.go l acc = acc.toList ++ zipWithLeft l`. -/\n go : List α → List β → Array γ → List γ\n | [], _, acc => acc.toList\n | as, [], acc => as.foldl (fun acc a => acc.push (f a none)) acc |>.toList\n | a :: as, b :: bs, acc => go as bs (acc.push (f a (some b)))\n\n@[csimp] theorem zipWithLeft_eq_zipWithLeftTR : @zipWithLeft = @zipWithLeftTR := by\n funext α β γ f as bs; simp [zipWithLeftTR]\n let rec go (acc) : ∀ as bs, zipWithLeftTR.go f as bs acc = acc.toList ++ as.zipWithLeft f bs\n | [], bs => by simp [zipWithLeftTR.go]\n | _::_, [] => by simp [zipWithLeftTR.go]\n | a::as, b::bs => by simp [zipWithLeftTR.go, go _ as bs]\n simp [go]\n\n/--\nRight-biased version of `List.zipWith`. `zipWithRight f as bs` applies `f` to each\npair `aᵢ ∈ as` and `bᵢ ‌∈ bs`. If `as` is shorter than `bs`, `f` is applied to\n`none` for the remaining `bᵢ`.\n```\nzipWithRight prod.mk [1, 2] ['a'] = [(some 1, 'a')]\nzipWithRight prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]\nzipWithRight f as bs = (zipWithRight' f as bs).fst\n```\n-/\n@[inline] def zipWithRight (f : Option α → β → γ) (as : List α) (bs : List β) : List γ :=\n zipWithLeft (flip f) bs as\n\n/--\nLeft-biased version of `List.zip`. `zipLeft as bs` returns the list of pairs\n`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the\nremaining `aᵢ` are paired with `none`.\n```\nzipLeft [1, 2] ['a'] = [(1, some 'a'), (2, none)]\nzipLeft [1] ['a', 'b'] = [(1, some 'a')]\nzipLeft = zipWithLeft prod.mk\n```\n-/\n@[inline] def zipLeft : List α → List β → List (α × Option β) := zipWithLeft Prod.mk\n\n/--\nRight-biased version of `List.zip`. `zipRight as bs` returns the list of pairs\n`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the\nremaining `bᵢ` are paired with `none`.\n```\nzipRight [1, 2] ['a'] = [(some 1, 'a')]\nzipRight [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]\nzipRight = zipWithRight prod.mk\n```\n-/\n@[inline] def zipRight : List α → List β → List (Option α × β) := zipWithRight Prod.mk\n\n/--\nIf all elements of `xs` are `some xᵢ`, `allSome xs` returns the `xᵢ`. Otherwise\nit returns `none`.\n```\nallSome [some 1, some 2] = some [1, 2]\nallSome [some 1, none ] = none\n```\n-/\n@[inline] def allSome (l : List (Option α)) : Option (List α) := l.mapM id\n\n/--\n`fillNones xs ys` replaces the `none`s in `xs` with elements of `ys`. If there\nare not enough `ys` to replace all the `none`s, the remaining `none`s are\ndropped from `xs`.\n```\nfillNones [none, some 1, none, none] [2, 3] = [2, 1, 3]\n```\n-/\n@[simp, deprecated \"Deprecated without replacement.\" (since := \"2025-08-07\")]\ndef fillNones {α} : List (Option α) → List α → List α\n | [], _ => []\n | some a :: as, as' => a :: fillNones as as'\n | none :: as, [] => as.reduceOption\n | none :: as, a :: as' => a :: fillNones as as'\n\n/--\n`takeList as ns` extracts successive sublists from `as`. For `ns = n₁ ... nₘ`,\nit first takes the `n₁` initial elements from `as`, then the next `n₂` ones,\netc. It returns the sublists of `as` -- one for each `nᵢ` -- and the remaining\nelements of `as`. If `as` does not have at least as many elements as the sum of\nthe `nᵢ`, the corresponding sublists will have less than `nᵢ` elements.\n```\ntakeList ['a', 'b', 'c', 'd', 'e'] [2, 1, 1] = ([['a', 'b'], ['c'], ['d']], ['e'])\ntakeList ['a', 'b'] [3, 1] = ([['a', 'b'], []], [])\n```\n-/\ndef takeList {α} : List α → List Nat → List (List α) × List α\n | xs, [] => ([], xs)\n | xs, n :: ns =>\n let (xs₁, xs₂) := xs.splitAt n\n let (xss, rest) := takeList xs₂ ns\n (xs₁ :: xss, rest)\n\n/-- Tail-recursive version of `takeList`. -/\n@[inline] def takeListTR\n (xs : List α) (ns : List Nat) : List (List α) × List α := go ns xs #[] where\n /-- Auxiliary for `takeListTR`: `takeListTR.go as as' acc = acc.toList ++ takeList as as'`. -/\n go : List Nat → List α → Array (List α) → List (List α) × List α\n | [], xs, acc => (acc.toList, xs)\n | n :: ns, xs, acc =>\n let (xs₁, xs₂) := xs.splitAt n\n go ns xs₂ (acc.push xs₁)\n\n@[csimp] theorem takeList_eq_takeListTR : @takeList = @takeListTR := by\n funext α xs ns; simp [takeListTR]\n let rec go (acc) : ∀ ns xs, @takeListTR.go α ns xs acc =\n let (l, r) := xs.takeList ns; (acc.toList ++ l, r)\n | [], xs => by simp [takeListTR.go, takeList]\n | n::ns, xs => by simp [takeListTR.go, takeList, go _ ns]\n simp [go]\n\n/-- Auxliary definition used to define `toChunks`.\n `toChunksAux n xs i` returns `(xs.take i, (xs.drop i).toChunks (n+1))`,\n that is, the first `i` elements of `xs`, and the remaining elements chunked into\n sublists of length `n+1`. -/\ndef toChunksAux {α} (n : Nat) : List α → Nat → List α × List (List α)\n | [], _ => ([], [])\n | x :: xs, 0 =>\n let (l, L) := toChunksAux n xs n\n ([], (x :: l) :: L)\n | x :: xs, i+1 =>\n let (l, L) := toChunksAux n xs i\n (x :: l, L)\n\n/--\n`xs.toChunks n` splits the list into sublists of size at most `n`,\nsuch that `(xs.toChunks n).join = xs`.\n```\n[1, 2, 3, 4, 5, 6, 7, 8].toChunks 10 = [[1, 2, 3, 4, 5, 6, 7, 8]]\n[1, 2, 3, 4, 5, 6, 7, 8].toChunks 3 = [[1, 2, 3], [4, 5, 6], [7, 8]]\n[1, 2, 3, 4, 5, 6, 7, 8].toChunks 2 = [[1, 2], [3, 4], [5, 6], [7, 8]]\n[1, 2, 3, 4, 5, 6, 7, 8].toChunks 0 = [[1, 2, 3, 4, 5, 6, 7, 8]]\n```\n-/\ndef toChunks {α} : Nat → List α → List (List α)\n | _, [] => []\n | 0, xs => [xs]\n | n, x :: xs =>\n let rec\n /-- Auxliary definition used to define `toChunks`.\n `toChunks.go xs acc₁ acc₂` pushes elements into `acc₁` until it reaches size `n`,\n then it pushes the resulting list to `acc₂` and continues until `xs` is exhausted. -/\n go : List α → Array α → Array (List α) → List (List α)\n | [], acc₁, acc₂ => acc₂.push acc₁.toList |>.toList\n | x :: xs, acc₁, acc₂ =>\n if acc₁.size == n then\n go xs ((Array.mkEmpty n).push x) (acc₂.push acc₁.toList)\n else\n go xs (acc₁.push x) acc₂\n go xs #[x] #[]\n\n/-!\nWe add some n-ary versions of `List.zipWith` for functions with more than two arguments.\nThese can also be written in terms of `List.zip` or `List.zipWith`.\nFor example, `zipWith₃ f xs ys zs` could also be written as\n`zipWith id (zipWith f xs ys) zs`\nor as\n`(zip xs <| zip ys zs).map fun ⟨x, y, z⟩ => f x y z`.\n-/\n\n-- TODO(Mario): tail recursive\n/-- Ternary version of `List.zipWith`. -/\ndef zipWith₃ (f : α → β → γ → δ) : List α → List β → List γ → List δ\n | x :: xs, y :: ys, z :: zs => f x y z :: zipWith₃ f xs ys zs\n | _, _, _ => []\n\n/-- Quaternary version of `List.zipWith`. -/\ndef zipWith₄ (f : α → β → γ → δ → ε) : List α → List β → List γ → List δ → List ε\n | x :: xs, y :: ys, z :: zs, u :: us => f x y z u :: zipWith₄ f xs ys zs us\n | _, _, _, _ => []\n\n/-- Quinary version of `List.zipWith`. -/\ndef zipWith₅ (f : α → β → γ → δ → ε → ζ) : List α → List β → List γ → List δ → List ε → List ζ\n | x :: xs, y :: ys, z :: zs, u :: us, v :: vs => f x y z u v :: zipWith₅ f xs ys zs us vs\n | _, _, _, _, _ => []\n\n/-- An auxiliary function for `List.mapWithPrefixSuffix`. -/\n-- TODO(Mario): tail recursive\ndef mapWithPrefixSuffixAux {α β} (f : List α → α → List α → β) : List α → List α → List β\n | _, [] => []\n | prev, h :: t => f prev h t :: mapWithPrefixSuffixAux f (prev.concat h) t\n\n/--\n`List.mapWithPrefixSuffix f l` maps `f` across a list `l`.\nFor each `a ∈ l` with `l = pref ++ [a] ++ suff`, `a` is mapped to `f pref a suff`.\nExample: if `f : list Nat → Nat → list Nat → β`,\n`List.mapWithPrefixSuffix f [1, 2, 3]` will produce the list\n`[f [] 1 [2, 3], f [1] 2 [3], f [1, 2] 3 []]`.\n-/\ndef mapWithPrefixSuffix {α β} (f : List α → α → List α → β) (l : List α) : List β :=\n mapWithPrefixSuffixAux f [] l\n\n/--\n`List.mapWithComplement f l` is a variant of `List.mapWithPrefixSuffix`\nthat maps `f` across a list `l`.\nFor each `a ∈ l` with `l = pref ++ [a] ++ suff`, `a` is mapped to `f a (pref ++ suff)`,\ni.e., the list input to `f` is `l` with `a` removed.\nExample: if `f : Nat → list Nat → β`, `List.mapWithComplement f [1, 2, 3]` will produce the list\n`[f 1 [2, 3], f 2 [1, 3], f 3 [1, 2]]`.\n-/\ndef mapWithComplement {α β} (f : α → List α → β) : List α → List β :=\n mapWithPrefixSuffix fun pref a suff => f a (pref ++ suff)\n\n/--\nMap each element of a `List` to an action, evaluate these actions in order,\nand collect the results.\n-/\nprotected def traverse [Applicative F] (f : α → F β) : List α → F (List β)\n | [] => pure []\n | x :: xs => List.cons <$> f x <*> List.traverse f xs\n\n/--\n`Subperm l₁ l₂`, denoted `l₁ <+~ l₂`, means that `l₁` is a sublist of\na permutation of `l₂`. This is an analogue of `l₁ ⊆ l₂` which respects\nmultiplicities of elements, and is used for the `≤` relation on multisets.\n-/\ndef Subperm (l₁ l₂ : List α) : Prop := ∃ l, l ~ l₁ ∧ l <+ l₂\n\n@[inherit_doc] scoped infixl:50 \" <+~ \" => Subperm\n\n/--\n`O(|l₁| * (|l₁| + |l₂|))`. Computes whether `l₁` is a sublist of a permutation of `l₂`.\nSee `isSubperm_iff` for a characterization in terms of `List.Subperm`.\n-/\ndef isSubperm [BEq α] (l₁ l₂ : List α) : Bool := ∀ x ∈ l₁, count x l₁ ≤ count x l₂\n\n/--\n`O(|l|)`. Inserts `a` in `l` right before the first element such that `p` is true, or at the end of\nthe list if `p` always false on `l`.\n-/\ndef insertP (p : α → Bool) (a : α) (l : List α) : List α :=\n loop l []\nwhere\n /-- Inner loop for `insertP`. Tail recursive. -/\n loop : List α → List α → List α\n | [], r => reverseAux (a :: r) [] -- Note: `reverseAux` is tail recursive.\n | b :: l, r => bif p b then reverseAux (a :: r) (b :: l) else loop l (b :: r)\n\n/-- `dropPrefix? l p` returns\n`some r` if `l = p' ++ r` for some `p'` which is paiwise `==` to `p`,\nand `none` otherwise. -/\ndef dropPrefix? [BEq α] : List α → List α → Option (List α)\n | list, [] => some list\n | [], _ :: _ => none\n | a :: as, b :: bs => if a == b then dropPrefix? as bs else none\n\n/-- `dropSuffix? l s` returns\n`some r` if `l = r ++ s'` for some `s'` which is paiwise `==` to `s`,\nand `none` otherwise. -/\ndef dropSuffix? [BEq α] (l s : List α) : Option (List α) :=\n let (r, s') := l.splitAt (l.length - s.length)\n if s' == s then some r else none\n\n/-- `dropInfix? l i` returns\n`some (p, s)` if `l = p ++ i' ++ s` for some `i'` which is paiwise `==` to `i`,\nand `none` otherwise.\n\nNote that this is an inefficient implementation, and if computation time is a concern you should be\nusing the Knuth-Morris-Pratt algorithm as implemented in `Batteries.Data.List.Matcher`.\n-/\ndef dropInfix? [BEq α] (l i : List α) : Option (List α × List α) :=\n go l []\nwhere\n /-- Inner loop for `dropInfix?`. -/\n go : List α → List α → Option (List α × List α)\n | [], acc => if i.isEmpty then some (acc.reverse, []) else none\n | a :: as, acc => match (a :: as).dropPrefix? i with\n | none => go as (a :: acc)\n | some s => (acc.reverse, s)\n\n/--\nComputes the product of the elements of a list.\n\nExamples:\n\n[a, b, c].prod = a * (b * (c * 1))\n[2, 3, 5].prod = 30\n-/\n@[expose] def prod [Mul α] [One α] (xs : List α) : α :=\n xs.foldr (· * ·) 1\n\n/--\nComputes the partial sums of the elements of a list.\n\nExamples:\n\n`[a, b, c].partialSums = [0, 0 + a, (0 + a) + b, ((0 + a) + b) + c]`\n`[1, 2, 3].partialSums = [0, 1, 3, 6]`\n-/\ndef partialSums [Add α] [Zero α] (l : List α) : List α :=\n l.scanl (· + ·) 0\n\n/--\nComputes the partial products of the elements of a list.\n\nExamples:\n\n`[a, b, c].partialProds = [1, 1 * a, (1 * a) * b, ((1 * a) * b) * c]`\n`[2, 3, 5].partialProds = [1, 2, 6, 30]`\n-/\ndef partialProds [Mul α] [One α] (l : List α) : List α :=\n l.scanl (· * ·) 1\n" }, { "path": "Batteries/Data/List/Count.lean", "content": "/-\nCopyright (c) 2014 Parikshit Khanna. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro\n-/\nmodule\npublic import Batteries.Data.List.Lemmas\n\n@[expose] public section\n\n/-!\n# Counting in lists\n\nThis file proves basic properties of `List.countP` and `List.count`, which count the number of\nelements of a list satisfying a predicate and equal to a given element respectively. Their\ndefinitions can be found in `Batteries.Data.List.Basic`.\n-/\n\n\nopen Nat\n\nnamespace List\n\n/-! ### count -/\n\nsection count\n\ntheorem count_singleton' [DecidableEq α] (a b : α) : count a [b] = if b = a then 1 else 0 :=\n count_singleton.trans (by grind)\n\ntheorem count_concat [BEq α] [LawfulBEq α] (a : α) (l : List α) :\n count a (concat l a) = count a l + 1 := by simp\n\n/-! ### idxToSigmaCount, sigmaCountToIdx -/\n\n/-- `idxToSigmaCount` is essentially a `Fin`-to-`Fin` wrapper for `countBefore` that also\nincludes the corresponding element.\n\nFor example:\n```\nidxToSigmaCount [5, 1, 3, 2, 4, 0, 1, 4] 5 = ⟨0, 0⟩\n```\n-/\ndef idxToSigmaCount [BEq α] [ReflBEq α] (xs : List α) (i : Fin xs.length) :\n (x : α) × Fin (xs.count x) := ⟨xs[i.1], xs.countBefore xs[i.1] i, by grind⟩\n\n@[simp, grind =]\ntheorem fst_idxToSigmaCount [BEq α] [ReflBEq α] {xs: List α} {i : Fin xs.length} :\n (xs.idxToSigmaCount i).1 = xs[i.1] := rfl\n\n@[simp, grind =]\ntheorem snd_idxToSigmaCount [BEq α] [ReflBEq α] {xs: List α} {i : Fin xs.length} :\n (xs.idxToSigmaCount i).2 = ⟨xs.countBefore xs[i.1] i, by grind⟩ := rfl\n\n@[simp, grind =]\ntheorem coe_snd_idxToSigmaCount [BEq α] [ReflBEq α] {xs: List α} {i : Fin xs.length} :\n ((xs.idxToSigmaCount i).2 : Nat) = xs.countBefore xs[i.1] i := rfl\n\n/-- `sigmaCountToIdx` is a `_ × Fin`-to-`Fin` wrapper for `countBefore`.\n\nFor example:\n```\nsigmaCountToIdx [5, 1, 3, 2, 4, 0, 1, 4] ⟨0, 0⟩ = 5\n```\n-/\ndef sigmaCountToIdx [BEq α] (xs : List α) (xc : (x : α) × Fin (xs.count x)) :\n Fin xs.length := ⟨xs.idxOfNth xc.1 xc.2, by grind⟩\n\n@[simp, grind =]\ntheorem coe_sigmaCountToIdx [BEq α] {xs: List α} {xc : (x : α) × Fin (xs.count x)} :\n (xs.sigmaCountToIdx xc : Nat) = xs.idxOfNth xc.1 xc.2 := rfl\n\n@[simp, grind =]\ntheorem sigmaCountToIdx_idxToSigmaCount [BEq α] [ReflBEq α] {xs : List α}\n {i : Fin xs.length} : xs.sigmaCountToIdx (xs.idxToSigmaCount i) = i := by grind\n\ntheorem leftInverse_sigmaCountToIdx_idxToSigmaCount [BEq α] [ReflBEq α] {xs : List α} :\n xs.sigmaCountToIdx.LeftInverse xs.idxToSigmaCount := by grind\n\ntheorem rightInverse_idxToSigmaCount_sigmaCountToIdx [BEq α] [ReflBEq α] {xs : List α} :\n xs.idxToSigmaCount.RightInverse xs.sigmaCountToIdx := by grind\n\ntheorem injective_idxToSigmaCount [BEq α] [ReflBEq α] {xs : List α} :\n xs.idxToSigmaCount.Injective := leftInverse_sigmaCountToIdx_idxToSigmaCount.injective\n\ntheorem surjective_sigmaCountToIdx [BEq α] [ReflBEq α] {xs : List α} :\n xs.sigmaCountToIdx.Surjective := rightInverse_idxToSigmaCount_sigmaCountToIdx.surjective\n\n@[simp, grind =]\ntheorem idxToSigmaCount_sigmaCountToIdx [BEq α] [LawfulBEq α] {xs : List α}\n {xc : (x : α) × Fin (xs.count x)} : xs.idxToSigmaCount (xs.sigmaCountToIdx xc) = xc :=\n Sigma.ext getElem_idxOfNth_eq (heq_of_eqRec_eq (by grind) (by grind))\n\ntheorem leftInverse_idxToSigmaCount_sigmaCountToIdx [BEq α] [LawfulBEq α] {xs : List α} :\n xs.idxToSigmaCount.LeftInverse xs.sigmaCountToIdx := by grind\n\ntheorem rightInverse_sigmaCountToIdx_idxToSigmaCount [BEq α] [LawfulBEq α] {xs : List α} :\n xs.sigmaCountToIdx.RightInverse xs.idxToSigmaCount := by grind\n\ntheorem injective_sigmaCountToIdx [BEq α] [LawfulBEq α] {xs : List α} :\n xs.sigmaCountToIdx.Injective := leftInverse_idxToSigmaCount_sigmaCountToIdx.injective\n\ntheorem surjective_idxToSigmaCount [BEq α] [LawfulBEq α] {xs : List α} :\n xs.idxToSigmaCount.Surjective := rightInverse_sigmaCountToIdx_idxToSigmaCount.surjective\n" }, { "path": "Batteries/Data/List/Init/Lemmas.lean", "content": "/-\nCopyright (c) 2024 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\n\nAuthors: Kim Morrison\n-/\nmodule\n\n@[expose] public section\n\n/-!\nWhile this file is currently empty, it is intended as a home for any lemmas which are required for\ndefinitions in `Batteries.Data.List.Basic`, but which are not provided by Lean.\n-/\n" }, { "path": "Batteries/Data/List/Lemmas.lean", "content": "/-\nCopyright (c) 2014 Parikshit Khanna. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Control.ForInStep.Lemmas\npublic import Batteries.Data.List.Basic\n\n@[expose] public section\n\nnamespace List\n\ninstance instNeZeroNatLengthCons {a : α} {l : List α} : NeZero (a :: l).length :=\n ⟨Nat.succ_ne_zero _⟩\n\n/-! ### count -/\n\ntheorem count_getElem_take_succ [BEq α] [EquivBEq α] {xs : List α}\n {i : Nat} {hi} : (xs.take (i + 1)).count xs[i] = (xs.take i).count xs[i] + 1 := by\n grind [take_append_getElem]\n\ntheorem count_getElem_take_lt_count [BEq α] [EquivBEq α] {xs : List α}\n {i : Nat} {hi} : (xs.take i).count (xs[i]'hi) < xs.count xs[i] :=\n Nat.lt_of_succ_le (Nat.le_trans (Nat.le_of_eq count_getElem_take_succ.symm) <|\n (take_sublist _ _).count_le _)\n\n/-! ### zip -/\n\nattribute [grind =] zip_nil_left zip_nil_right zip_cons_cons\n\n/-! ### zipIdx -/\n\nattribute [grind =] zipIdx_nil zipIdx_cons\n\n/-! ### toArray-/\n\n@[deprecated List.getElem_toArray (since := \"2025-09-11\")]\ntheorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) :\n (Array.mk xs)[i] = xs[i] := List.getElem_toArray h\n\n/-! ### next? -/\n\n@[simp, grind =] theorem next?_nil : @next? α [] = none := rfl\n@[simp, grind =] theorem next?_cons (a l) : @next? α (a :: l) = some (a, l) := rfl\n\n/-! ### dropLast -/\n\ntheorem dropLast_eq_eraseIdx {xs : List α} {i : Nat} (last_idx : i + 1 = xs.length) :\n xs.dropLast = List.eraseIdx xs i := by\n ext\n grind\n\n/-! ### set -/\n\ntheorem set_eq_modify (a : α) : ∀ n (l : List α), l.set n a = l.modify n (fun _ => a)\n | 0, l => by cases l <;> rfl\n | _+1, [] => rfl\n | _+1, _ :: _ => congrArg (cons _) (set_eq_modify _ _ _)\n\ntheorem set_eq_take_cons_drop (a : α) {n l} (h : n < length l) :\n set l n a = take n l ++ a :: drop (n + 1) l := by\n rw [set_eq_modify, modify_eq_take_cons_drop h]\n\ntheorem modify_eq_set_getElem? (f : α → α) :\n ∀ n (l : List α), l.modify n f = ((fun a => l.set n (f a)) <$> l[n]?).getD l\n | 0, l => by cases l <;> simp\n | _+1, [] => rfl\n | n+1, b :: l =>\n (congrArg (cons _) (modify_eq_set_getElem? ..)).trans <| by cases h : l[n]? <;> simp [h]\n\n@[deprecated (since := \"2025-02-15\")] alias modify_eq_set_get? := modify_eq_set_getElem?\n\ntheorem modify_eq_set_get (f : α → α) {n} {l : List α} (h) :\n l.modify n f = l.set n (f (l.get ⟨n, h⟩)) := by\n rw [modify_eq_set_getElem?, getElem?_eq_getElem h]; rfl\n\ntheorem getElem?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) :\n (set l n a)[n]? = some a := by rw [getElem?_set_self', getElem?_eq_getElem h]; rfl\n\ntheorem getElem?_set_of_lt (a : α) {m n} (l : List α) (h : n < length l) :\n (set l m a)[n]? = if m = n then some a else l[n]? := by\n simp [getElem?_set', getElem?_eq_getElem h]\n\n@[deprecated (since := \"2025-02-15\")] alias get?_set_of_lt := getElem?_set_of_lt\n\ntheorem getElem?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) :\n (set l m a)[n]? = if m = n then some a else l[n]? := by\n simp [getElem?_set]; split <;> subst_vars <;> simp [*]\n\n@[deprecated (since := \"2025-02-15\")] alias get?_set_of_lt' := getElem?_set_of_lt'\n\n/-! ### tail -/\n\ntheorem length_tail_add_one (l : List α) (h : 0 < length l) :\n (length (tail l)) + 1 = length l := by grind\n\n/-! ### eraseP -/\n\n@[simp] theorem extractP_eq_find?_eraseP\n (l : List α) : extractP p l = (find? p l, eraseP p l) := by\n suffices ∀ (acc) (xs) (h : l = acc.toList ++ xs),\n extractP.go p l xs acc = (xs.find? p, acc.toList ++ xs.eraseP p) from this #[] _ rfl\n intros\n fun_induction extractP.go with grind\n\n/-! ### erase -/\n\ntheorem erase_eq_self_iff_forall_bne [BEq α] (a : α) (xs : List α) :\n xs.erase a = xs ↔ ∀ (x : α), x ∈ xs → ¬x == a := by\n rw [erase_eq_eraseP', eraseP_eq_self_iff]\n\n/-! ### findIdx? -/\n\n@[deprecated findIdx_eq_getD_findIdx? (since := \"2025-11-06\")]\ntheorem findIdx_eq_findIdx? (p : α → Bool) (l : List α) :\n l.findIdx p = (match l.findIdx? p with | some i => i | none => l.length) := by\n rw [findIdx_eq_getD_findIdx?]\n cases findIdx? p l <;> rfl\n\n/-! ### replaceF -/\n\ntheorem replaceF_nil : [].replaceF p = [] := rfl\n\ntheorem replaceF_cons (a : α) (l : List α) :\n (a :: l).replaceF p = match p a with\n | none => a :: replaceF p l\n | some a' => a' :: l := rfl\n\ntheorem replaceF_cons_of_some {l : List α} (p) (h : p a = some a') :\n (a :: l).replaceF p = a' :: l := by\n simp [h]\n\ntheorem replaceF_cons_of_none {l : List α} (p) (h : p a = none) :\n (a :: l).replaceF p = a :: l.replaceF p := by simp [h]\n\ntheorem replaceF_of_forall_none {l : List α} (h : ∀ a, a ∈ l → p a = none) : l.replaceF p = l := by\n induction l with\n | nil => rfl\n | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2]\n\ntheorem exists_of_replaceF : ∀ {l : List α} {a a'} (_ : a ∈ l) (_ : p a = some a'),\n ∃ a a' l₁ l₂,\n (∀ b ∈ l₁, p b = none) ∧ p a = some a' ∧ l = l₁ ++ a :: l₂ ∧ l.replaceF p = l₁ ++ a' :: l₂\n | b :: l, _, _, al, pa =>\n match pb : p b with\n | some b' => ⟨b, b', [], l, forall_mem_nil _, pb, by simp [pb]⟩\n | none =>\n match al with\n | .head .. => nomatch pb.symm.trans pa\n | .tail _ al =>\n let ⟨c, c', l₁, l₂, h₁, h₂, h₃, h₄⟩ := exists_of_replaceF al pa\n ⟨c, c', b::l₁, l₂, (forall_mem_cons ..).2 ⟨pb, h₁⟩,\n h₂, by rw [h₃, cons_append], by simp [pb, h₄]⟩\n\ntheorem exists_or_eq_self_of_replaceF (p) (l : List α) :\n l.replaceF p = l ∨ ∃ a a' l₁ l₂,\n (∀ b ∈ l₁, p b = none) ∧ p a = some a' ∧ l = l₁ ++ a :: l₂ ∧ l.replaceF p = l₁ ++ a' :: l₂ :=\n if h : ∃ a ∈ l, (p a).isSome then\n let ⟨_, ha, pa⟩ := h\n .inr (exists_of_replaceF ha (Option.get_mem pa))\n else\n .inl <| replaceF_of_forall_none fun a ha =>\n Option.not_isSome_iff_eq_none.1 fun h' => h ⟨a, ha, h'⟩\n\n@[simp] theorem length_replaceF : length (replaceF f l) = length l := by\n induction l <;> simp [replaceF]; split <;> simp [*]\n\n/-! ### disjoint -/\n\ntheorem disjoint_symm (d : Disjoint l₁ l₂) : Disjoint l₂ l₁ := fun _ i₂ i₁ => d i₁ i₂\n\ntheorem disjoint_comm : Disjoint l₁ l₂ ↔ Disjoint l₂ l₁ := ⟨disjoint_symm, disjoint_symm⟩\n\ntheorem disjoint_left : Disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₁ → a ∉ l₂ := by simp [Disjoint]\n\ntheorem disjoint_right : Disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₂ → a ∉ l₁ := disjoint_comm\n\ntheorem disjoint_iff_ne : Disjoint l₁ l₂ ↔ ∀ a ∈ l₁, ∀ b ∈ l₂, a ≠ b :=\n ⟨fun h _ al1 _ bl2 ab => h al1 (ab ▸ bl2), fun h _ al1 al2 => h _ al1 _ al2 rfl⟩\n\ntheorem disjoint_of_subset_left (ss : l₁ ⊆ l) (d : Disjoint l l₂) : Disjoint l₁ l₂ :=\n fun _ m => d (ss m)\n\ntheorem disjoint_of_subset_right (ss : l₂ ⊆ l) (d : Disjoint l₁ l) : Disjoint l₁ l₂ :=\n fun _ m m₁ => d m (ss m₁)\n\ntheorem disjoint_of_disjoint_cons_left {l₁ l₂} : Disjoint (a :: l₁) l₂ → Disjoint l₁ l₂ :=\n disjoint_of_subset_left (subset_cons_self _ _)\n\ntheorem disjoint_of_disjoint_cons_right {l₁ l₂} : Disjoint l₁ (a :: l₂) → Disjoint l₁ l₂ :=\n disjoint_of_subset_right (subset_cons_self _ _)\n\n@[simp] theorem disjoint_nil_left (l : List α) : Disjoint [] l := fun _ => not_mem_nil.elim\n\n@[simp] theorem disjoint_nil_right (l : List α) : Disjoint l [] := by\n rw [disjoint_comm]; exact disjoint_nil_left _\n\n@[simp 1100] theorem singleton_disjoint : Disjoint [a] l ↔ a ∉ l := by simp [Disjoint]\n\n@[simp 1100] theorem disjoint_singleton : Disjoint l [a] ↔ a ∉ l := by\n rw [disjoint_comm, singleton_disjoint]\n\n@[simp] theorem disjoint_append_left : Disjoint (l₁ ++ l₂) l ↔ Disjoint l₁ l ∧ Disjoint l₂ l := by\n simp [Disjoint, or_imp, forall_and]\n\n@[simp] theorem disjoint_append_right : Disjoint l (l₁ ++ l₂) ↔ Disjoint l l₁ ∧ Disjoint l l₂ :=\n disjoint_comm.trans <| by rw [disjoint_append_left]; simp [disjoint_comm]\n\n@[simp] theorem disjoint_cons_left : Disjoint (a::l₁) l₂ ↔ (a ∉ l₂) ∧ Disjoint l₁ l₂ :=\n (disjoint_append_left (l₁ := [a])).trans <| by simp [singleton_disjoint]\n\n@[simp] theorem disjoint_cons_right : Disjoint l₁ (a :: l₂) ↔ (a ∉ l₁) ∧ Disjoint l₁ l₂ :=\n disjoint_comm.trans <| by rw [disjoint_cons_left]; simp [disjoint_comm]\n\ntheorem disjoint_of_disjoint_append_left_left (d : Disjoint (l₁ ++ l₂) l) : Disjoint l₁ l :=\n (disjoint_append_left.1 d).1\n\ntheorem disjoint_of_disjoint_append_left_right (d : Disjoint (l₁ ++ l₂) l) : Disjoint l₂ l :=\n (disjoint_append_left.1 d).2\n\ntheorem disjoint_of_disjoint_append_right_left (d : Disjoint l (l₁ ++ l₂)) : Disjoint l l₁ :=\n (disjoint_append_right.1 d).1\n\ntheorem disjoint_of_disjoint_append_right_right (d : Disjoint l (l₁ ++ l₂)) : Disjoint l l₂ :=\n (disjoint_append_right.1 d).2\n\n/-! ### union -/\n\nsection union\n\nvariable [BEq α]\n\ntheorem union_def (l₁ l₂ : List α) : l₁ ∪ l₂ = foldr .insert l₂ l₁ := rfl\n\n@[simp, grind =] theorem nil_union (l : List α) : nil ∪ l = l := by simp [List.union_def, foldr]\n\n@[simp, grind =] theorem cons_union (a : α) (l₁ l₂ : List α) :\n (a :: l₁) ∪ l₂ = (l₁ ∪ l₂).insert a := by simp [List.union_def, foldr]\n\n@[simp, grind =] theorem mem_union_iff [LawfulBEq α] {x : α} {l₁ l₂ : List α} :\n x ∈ l₁ ∪ l₂ ↔ x ∈ l₁ ∨ x ∈ l₂ := by induction l₁ <;> simp [*, or_assoc]\n\nend union\n\n/-! ### inter -/\n\ntheorem inter_def [BEq α] (l₁ l₂ : List α) : l₁ ∩ l₂ = filter (elem · l₂) l₁ := rfl\n\n@[simp, grind =] theorem mem_inter_iff [BEq α] [LawfulBEq α] {x : α} {l₁ l₂ : List α} :\n x ∈ l₁ ∩ l₂ ↔ x ∈ l₁ ∧ x ∈ l₂ := by\n cases l₁ <;> simp [List.inter_def, mem_filter]\n\n/-! ### product -/\n\n/-- List.prod satisfies a specification of cartesian product on lists. -/\n@[simp]\ntheorem pair_mem_product {xs : List α} {ys : List β} {x : α} {y : β} :\n (x, y) ∈ product xs ys ↔ x ∈ xs ∧ y ∈ ys := by\n simp only [product, mem_map, Prod.mk.injEq,\n exists_eq_right_right, mem_flatMap, iff_self]\n\n/-! ### monadic operations -/\n\ntheorem forIn_eq_bindList [Monad m] [LawfulMonad m]\n (f : α → β → m (ForInStep β)) (l : List α) (init : β) :\n forIn l init f = ForInStep.run <$> (ForInStep.yield init).bindList f l := by\n induction l generalizing init <;> simp [*]\n congr; ext (b | b) <;> simp\n\n/-! ### diff -/\n\nsection Diff\nvariable [BEq α]\n\n@[simp] theorem diff_nil (l : List α) : l.diff [] = l := rfl\n\nvariable [LawfulBEq α]\n\n@[simp] theorem diff_cons (l₁ l₂ : List α) (a : α) : l₁.diff (a :: l₂) = (l₁.erase a).diff l₂ := by\n simp_all [List.diff, erase_of_not_mem]\n\ntheorem diff_cons_right (l₁ l₂ : List α) (a : α) : l₁.diff (a :: l₂) = (l₁.diff l₂).erase a := by\n apply Eq.symm; induction l₂ generalizing l₁ <;> simp [erase_comm, *]\n\ntheorem diff_erase (l₁ l₂ : List α) (a : α) : (l₁.diff l₂).erase a = (l₁.erase a).diff l₂ := by\n rw [← diff_cons_right, diff_cons]\n\n@[simp] theorem nil_diff (l : List α) : [].diff l = [] := by\n induction l <;> simp [*, erase_of_not_mem]\n\ntheorem cons_diff (a : α) (l₁ l₂ : List α) :\n (a :: l₁).diff l₂ = if a ∈ l₂ then l₁.diff (l₂.erase a) else a :: l₁.diff l₂ := by\n induction l₂ generalizing l₁ with\n | nil => rfl\n | cons b l₂ ih =>\n by_cases h : a = b\n next => simp [*]\n next =>\n have := Ne.symm h\n simp[*]\n\ntheorem cons_diff_of_mem {a : α} {l₂ : List α} (h : a ∈ l₂) (l₁ : List α) :\n (a :: l₁).diff l₂ = l₁.diff (l₂.erase a) := by rw [cons_diff, if_pos h]\n\ntheorem cons_diff_of_not_mem {a : α} {l₂ : List α} (h : a ∉ l₂) (l₁ : List α) :\n (a :: l₁).diff l₂ = a :: l₁.diff l₂ := by rw [cons_diff, if_neg h]\n\ntheorem diff_eq_foldl : ∀ l₁ l₂ : List α, l₁.diff l₂ = foldl List.erase l₁ l₂\n | _, [] => rfl\n | l₁, a :: l₂ => (diff_cons l₁ l₂ a).trans (diff_eq_foldl _ _)\n\n@[simp] theorem diff_append (l₁ l₂ l₃ : List α) : l₁.diff (l₂ ++ l₃) = (l₁.diff l₂).diff l₃ := by\n simp only [diff_eq_foldl, foldl_append]\n\ntheorem diff_sublist : ∀ l₁ l₂ : List α, l₁.diff l₂ <+ l₁\n | _, [] => .refl _\n | l₁, a :: l₂ =>\n calc\n l₁.diff (a :: l₂) = (l₁.erase a).diff l₂ := diff_cons ..\n _ <+ l₁.erase a := diff_sublist ..\n _ <+ l₁ := erase_sublist ..\n\ntheorem diff_subset (l₁ l₂ : List α) : l₁.diff l₂ ⊆ l₁ := (diff_sublist ..).subset\n\ntheorem mem_diff_of_mem {a : α} : ∀ {l₁ l₂ : List α}, a ∈ l₁ → a ∉ l₂ → a ∈ l₁.diff l₂\n | _, [], h₁, _ => h₁\n | l₁, b :: l₂, h₁, h₂ => by\n rw [diff_cons]\n exact mem_diff_of_mem ((mem_erase_of_ne <| ne_of_not_mem_cons h₂).2 h₁) (mt (.tail _) h₂)\n\ntheorem Sublist.diff_right : ∀ {l₁ l₂ l₃ : List α}, l₁ <+ l₂ → l₁.diff l₃ <+ l₂.diff l₃\n | _, _, [], h => h\n | l₁, l₂, a :: l₃, h => by simp only [diff_cons, (h.erase _).diff_right]\n\ntheorem Sublist.erase_diff_erase_sublist {a : α} :\n ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → (l₂.erase a).diff (l₁.erase a) <+ l₂.diff l₁\n | [], _, _ => erase_sublist\n | b :: l₁, l₂, h => by\n if heq : b = a then\n simp [heq]\n else\n simp [heq, erase_comm a]\n exact (erase_cons_head b _ ▸ h.erase b).erase_diff_erase_sublist\n\nend Diff\n\n/-! ### drop -/\n\ntheorem disjoint_take_drop : ∀ {l : List α}, l.Nodup → m ≤ n → Disjoint (l.take m) (l.drop n)\n | [], _, _ => by simp\n | x :: xs, hl, h => by\n cases m <;> cases n <;> simp only [disjoint_cons_left, drop, disjoint_nil_left,\n take]\n · case succ.zero => cases h\n · cases hl with | cons h₀ h₁ =>\n refine ⟨fun h => h₀ _ (mem_of_mem_drop h) rfl, ?_⟩\n exact disjoint_take_drop h₁ (Nat.le_of_succ_le_succ h)\n\n/-! ### Pairwise -/\n\nattribute [simp, grind ←] Pairwise.nil\n\n@[grind =] theorem pairwise_cons_cons :\n Pairwise R (a :: b :: l) ↔ R a b ∧ Pairwise R (a :: l) ∧ Pairwise R (b :: l) := by\n grind [pairwise_cons]\n\n@[grind →] protected theorem Pairwise.isChain (p : Pairwise R l) : IsChain R l := by\n induction p <;> grind [cases List]\n\n/-! ### IsChain -/\n\n@[deprecated (since := \"2025-09-19\")]\nalias chain_cons := isChain_cons_cons\n\ntheorem rel_of_isChain_cons_cons (p : IsChain R (a :: b :: l)) : R a b :=\n (isChain_cons_cons.1 p).1\n\nalias IsChain.rel := rel_of_isChain_cons_cons\n\n@[deprecated (since := \"2025-09-19\")]\nalias rel_of_chain_cons := rel_of_isChain_cons_cons\n\ntheorem isChain_of_isChain_cons (p : IsChain R (b :: l)) : IsChain R l := by grind [cases List]\n\nalias IsChain.of_cons := isChain_of_isChain_cons\n\n@[deprecated IsChain.of_cons (since := \"2026-02-10\")]\ntheorem isChain_cons_of_isChain_cons_cons : IsChain R (a :: b :: l) →\n IsChain R (b :: l) := IsChain.of_cons\n\n@[deprecated (since := \"2025-09-19\")]\nalias chain_of_chain_cons := isChain_cons_of_isChain_cons_cons\n\n@[deprecated IsChain.of_cons (since := \"2026-02-10\")]\ntheorem isChain_of_isChain_cons_cons : IsChain R (a :: b :: l) →\n IsChain R l := IsChain.of_cons ∘ IsChain.of_cons\n\n@[grind =>]\ntheorem IsChain.imp (H : ∀ ⦃a b : α⦄, R a b → S a b)\n (p : IsChain R l) : IsChain S l := by induction p with grind\n\n@[deprecated (since := \"2025-09-19\")]\nalias Chain.imp := IsChain.imp\n\ntheorem IsChain.cons_of_imp (h : ∀ c, R a c → R b c) :\n IsChain R (a :: l) → IsChain R (b :: l) := by grind [cases List]\n\n@[deprecated (since := \"2026-02-10\")]\nalias IsChain.cons_of_imp_of_cons := IsChain.cons_of_imp\n\ntheorem IsChain.cons_of_imp_of_imp (HRS : ∀ ⦃a b : α⦄, R a b → S a b)\n (Hab : ∀ ⦃c⦄, R a c → S b c) (h : IsChain R (a :: l)) : IsChain S (b :: l) := by\n grind [cases List]\n\n@[deprecated (since := \"2025-09-19\")]\nalias Chain.imp' := IsChain.cons_of_imp_of_imp\n\n@[deprecated (since := \"2025-09-19\")]\nprotected alias Pairwise.chain := Pairwise.isChain\n\ntheorem isChain_iff_pairwise [Trans R R R] : IsChain R l ↔ Pairwise R l := by\n induction l with | nil => grind | cons a l IH => cases l with | nil => grind | cons b l =>\n simp only [isChain_cons_cons, IH, pairwise_cons, mem_cons, forall_eq_or_imp, and_congr_left_iff,\n iff_self_and, and_imp]\n exact flip <| fun _ => flip (Trans.trans · <| · · ·)\n\n@[grind →] protected theorem IsChain.pairwise [Trans R R R] (c : IsChain R l) :\n Pairwise R l := isChain_iff_pairwise.mp c\n\ntheorem isChain_iff_getElem {l : List α} :\n IsChain R l ↔ ∀ (i : Nat) (_hi : i + 1 < l.length), R l[i] l[i + 1] := by\n induction l with | nil => grind | cons a l IH => cases l with | nil => grind | cons b l =>\n simp [IH, Nat.forall_lt_succ_left']\n\ntheorem IsChain.getElem {l : List α} (c : IsChain R l) (i : Nat) (hi : i + 1 < l.length) :\n R l[i] l[i + 1] := isChain_iff_getElem.mp c _ _\n\n/-! ### range', range -/\n\ntheorem isChain_range' (s : Nat) : ∀ n step : Nat,\n IsChain (fun a b => b = a + step) (range' s n step)\n | 0, _ => .nil\n | 1, _ => .singleton _\n | n + 2, step => (isChain_range' (s + step) (n + 1) step).cons_cons rfl\n\n@[deprecated isChain_range' (since := \"2025-09-19\")]\ntheorem chain_succ_range' (s n step : Nat) :\n IsChain (fun a b => b = a + step) (s :: range' (s + step) n step) := isChain_range' _ (n + 1) _\n\ntheorem isChain_lt_range' (s n : Nat) (h : 0 < step) :\n IsChain (· < ·) (range' s n step) :=\n (isChain_range' s n step).imp fun | _, _, rfl => Nat.lt_add_of_pos_right h\n\n@[deprecated isChain_lt_range' (since := \"2025-09-19\")]\ntheorem chain_lt_range' (s n : Nat) (h : 0 < step) :\n IsChain (· < ·) (s :: range' (s + step) n step) := isChain_lt_range' _ (n + 1) h\n\n/-! ### foldrIdx -/\n\n@[simp, grind =] theorem foldrIdx_nil : ([] : List α).foldrIdx f i s = i := rfl\n\n@[simp, grind =] theorem foldrIdx_cons :\n (x :: xs : List α).foldrIdx f i s = f s x (foldrIdx f i xs (s + 1)) := rfl\n\n@[grind =] theorem foldrIdx_start :\n (xs : List α).foldrIdx f i s = (xs : List α).foldrIdx (f <| · + s) i := by\n induction xs generalizing f s <;> grind\n\ntheorem foldrIdx_const : (xs : List α).foldrIdx (Function.const Nat f) i s = xs.foldr f i := by\n induction xs <;> grind\n\ntheorem foldrIdx_eq_foldr_zipIdx : (xs : List α).foldrIdx f i s =\n (xs.zipIdx s).foldr (fun ab => f ab.2 ab.1) i := by\n induction xs generalizing s <;> grind\n\n/-! ### foldlIdx -/\n\n@[simp, grind =] theorem foldlIdx_nil : ([] : List α).foldlIdx f i s = i := rfl\n\n@[simp, grind =] theorem foldlIdx_cons :\n (x :: xs : List α).foldlIdx f i s = foldlIdx f (f s i x) xs (s + 1) := rfl\n\ntheorem foldlIdx_start :\n (xs : List α).foldlIdx f i s = (xs : List α).foldlIdx (f <| · + s) i := by\n induction xs generalizing f i s <;> grind [Function.comp_def]\n\ntheorem foldlIdx_const : (xs : List α).foldlIdx (Function.const Nat f) i s = xs.foldl f i := by\n induction xs generalizing i s <;> grind\n\ntheorem foldlIdx_eq_foldl_zipIdx : (xs : List α).foldlIdx f i s =\n (xs.zipIdx s).foldl (fun b ab => f ab.2 b ab.1) i := by\n induction xs generalizing i s <;> grind\n\n/-! ### findIdxs -/\n\n@[simp, grind =] theorem findIdxs_nil : ([] : List α).findIdxs p s = [] := rfl\n\n@[simp, grind =] theorem findIdxs_cons :\n (x :: xs : List α).findIdxs p s =\n if p x then s :: xs.findIdxs p (s + 1) else xs.findIdxs p (s + 1) := by\n grind [findIdxs]\n\ntheorem findIdxs_singleton :\n [x].findIdxs p s = if p x then [s] else [] := by grind\n\ntheorem findIdxs_start :\n (xs : List α).findIdxs p s = (xs.findIdxs p).map (· + s) := by\n induction xs generalizing s <;> grind [map_inj_left]\n\ntheorem findIdxs_eq_filterMap_zipIdx : (xs : List α).findIdxs p s =\n ((xs.zipIdx s).filterMap fun ab => bif p ab.1 then ab.2 else none) := by\n induction xs generalizing s <;> grind\n\n@[simp, grind =]\ntheorem mem_findIdxs_iff_getElem_sub_pos :\n i ∈ (xs : List α).findIdxs p s ↔ s ≤ i ∧\n ∃ (hix : i - s < xs.length), p xs[i - s] := by\n induction xs generalizing s <;> grind\n\ntheorem mem_findIdxs_iff_exists_getElem_pos :\n i ∈ (xs : List α).findIdxs p ↔ ∃ (hix : i < xs.length), p xs[i] := by grind\n\ntheorem mem_findIdxs_iff_pos_getElem (hi : i < (xs : List α).length) :\n i ∈ xs.findIdxs p ↔ p xs[i] := by grind\n\ntheorem ge_of_mem_findIdxs : ∀ y ∈ (xs : List α).findIdxs p s, s ≤ y := by grind\n\ntheorem lt_add_of_mem_findIdxs :\n ∀ y ∈ (xs : List α).findIdxs p s, y < xs.length + s := by grind\n\ntheorem findIdxs_eq_nil_iff :\n (xs : List α).findIdxs p s = [] ↔ ∀ x ∈ xs, p x = false := by\n induction xs generalizing s <;> grind\n\n@[simp, grind =] theorem length_findIdxs : ((xs : List α).findIdxs p s).length = xs.countP p := by\n induction xs generalizing s <;> grind\n\n@[simp, grind .]\ntheorem pairwise_findIdxs : ((xs : List α).findIdxs p s).Pairwise (· < ·) := by\n induction xs generalizing s <;> grind [pairwise_cons]\n\n@[simp, grind .]\ntheorem isChain_findIdxs : ((xs : List α).findIdxs p s).IsChain (· < ·) :=\n pairwise_findIdxs.isChain\n\n@[simp, grind .]\ntheorem nodup_findIdxs : ((xs : List α).findIdxs p s).Nodup := pairwise_findIdxs.imp (by grind)\n\n@[simp, grind =]\ntheorem findIdxs_map :\n ((xs : List α).map f).findIdxs p s = xs.findIdxs (p ∘ f) s := by\n induction xs generalizing s <;> grind\n\n@[simp, grind =]\ntheorem findIdxs_append :\n ((xs : List α) ++ ys).findIdxs p s = xs.findIdxs p s ++ ys.findIdxs p (s + xs.length) := by\n induction xs generalizing s <;> grind\n\n@[simp, grind =]\ntheorem findIdxs_take :\n ((xs : List α).take n).findIdxs p s = (xs.findIdxs p s).take ((xs.take n).countP p) := by\n induction xs generalizing n s <;> cases n <;> grind [countP_eq_length_filter]\n\n@[simp, grind =>]\ntheorem le_getElem_findIdxs (h : i < ((xs : List α).findIdxs p s).length) :\n s ≤ (xs.findIdxs p s)[i] := by grind [getElem_mem]\n\n@[simp, grind =>]\ntheorem getElem_findIdxs_lt (h : i < ((xs : List α).findIdxs p s).length) :\n (xs.findIdxs p s)[i] < xs.length + s := by grind [getElem_mem]\n\ntheorem getElem_filter_eq_getElem_getElem_findIdxs_sub (s : Nat)\n (h : i < ((xs : List α).filter p).length) :\n (xs.filter p)[i] = xs[(xs.findIdxs p s)[i]'(by grind) - s]'(by grind) := by\n induction xs generalizing i s <;> grind\n\n@[grind =>]\ntheorem getElem_filter_eq_getElem_getElem_findIdxs\n (h : i < ((xs : List α).filter p).length) :\n (xs.filter p)[i] = xs[(xs.findIdxs p)[i]'(by grind)]'(by grind) :=\n getElem_filter_eq_getElem_getElem_findIdxs_sub 0 h\n\ntheorem getElem_getElem_findIdxs_sub (s : Nat)\n (h : i < ((xs : List α).findIdxs p s).length) :\n haveI : (findIdxs p xs s)[i] - s < xs.length := by grind\n p xs[(xs.findIdxs p s)[i] - s] := by\n rw [← getElem_filter_eq_getElem_getElem_findIdxs_sub s] <;> grind\n\ntheorem getElem_getElem_findIdxs\n (h : i < ((xs : List α).findIdxs p).length) :\n haveI : (findIdxs p xs)[i] < xs.length := by grind\n p xs[(xs.findIdxs p)[i]] := getElem_getElem_findIdxs_sub 0 h\n\n@[grind =]\ntheorem getElem_zero_findIdxs_eq_findIdx_add (h : 0 < ((xs : List α).findIdxs p s).length) :\n (xs.findIdxs p s)[0] = xs.findIdx p + s := by induction xs generalizing s <;> grind\n\n@[simp]\ntheorem getElem_zero_findIdxs_eq_findIdx (h : 0 < ((xs : List α).findIdxs p).length) :\n (xs.findIdxs p)[0] = xs.findIdx p := getElem_zero_findIdxs_eq_findIdx_add h\n\n@[grind =>]\ntheorem findIdx_add_mem_findIdxs (s : Nat)\n (h : (xs : List α).findIdx p < xs.length) : xs.findIdx p + s ∈ xs.findIdxs p s := by\n grind [mem_iff_getElem]\n\ntheorem findIdx_mem_findIdxs (h : (xs : List α).findIdx p < xs.length) :\n xs.findIdx p ∈ xs.findIdxs p := findIdx_add_mem_findIdxs 0 h\n\n/-! ### findIdxsValues -/\n\n@[grind =]\ntheorem findIdxsValues_eq_zip_filter_findIdxs :\n (xs : List α).findIdxsValues p s = (xs.findIdxs p s).zip (xs.filter p) := by\n induction xs generalizing s <;> grind [findIdxsValues]\n\n@[simp, grind =]\ntheorem unzip_findIdxsValues :\n ((xs : List α).findIdxsValues p s).unzip = (xs.findIdxs p s, xs.filter p) := by\n grind [unzip_zip]\n\n/-! ### findIdxNth -/\n\n@[simp, grind =] theorem findIdxNth_nil : ([] : List α).findIdxNth p n = 0 := rfl\n\n@[grind =]\ntheorem findIdxNth_cons {a : α} :\n (a :: xs).findIdxNth p n =\n if n = 0 then if p a then 0 else xs.findIdxNth p 0 + 1\n else if p a then xs.findIdxNth p (n - 1) + 1\n else xs.findIdxNth p n + 1 := by\n have H : ∀ n s, findIdxNth.go (p : α → Bool) xs n s = (xs : List α).findIdxNth p n + s := by\n induction xs <;> grind [findIdxNth, findIdxNth.go, cases Nat]\n cases n <;> grind [findIdxNth, findIdxNth.go]\n\n@[simp] theorem findIdxNth_cons_zero {a : α} :\n (a :: xs).findIdxNth p 0 = if p a then 0 else xs.findIdxNth p 0 + 1 := by grind\n\n@[simp] theorem findIdxNth_cons_succ {a : α} :\n (a :: xs).findIdxNth p (n + 1) =\n if p a then xs.findIdxNth p n + 1 else xs.findIdxNth p (n + 1) + 1 := by grind\n\ntheorem findIdxNth_cons_of_neg {a : α} (h : p a = false) :\n (a :: xs).findIdxNth p n = xs.findIdxNth p n + 1 := by grind\n\ntheorem findIdxNth_cons_of_pos {a : α} (h : p a) :\n (a :: xs).findIdxNth p n = if n = 0 then 0 else\n xs.findIdxNth p (n - 1) + 1 := by grind\n\ntheorem findIdxNth_cons_zero_of_pos {a : α} (h : p a) :\n (a :: xs).findIdxNth p 0 = 0 := by grind\n\ntheorem findIdxNth_cons_succ_of_pos {a : α} (h : p a) :\n (a :: xs).findIdxNth p (n + 1) = xs.findIdxNth p n + 1 := by grind\n\ntheorem getElem_findIdxs_eq_findIdxNth_add {xs : List α} {h : n < (xs.findIdxs p s).length} :\n (xs.findIdxs p s)[n] = xs.findIdxNth p n + s := by\n induction xs generalizing n s <;> grind\n\n@[grind =]\ntheorem getElem_findIdxs_eq_findIdxNth {xs : List α} {h : n < (xs.findIdxs p).length} :\n (xs.findIdxs p)[n] = xs.findIdxNth p n := getElem_findIdxs_eq_findIdxNth_add\n\ntheorem pos_findIdxNth_getElem {xs : List α} {h : xs.findIdxNth p n < xs.length} :\n p xs[xs.findIdxNth p n] := by induction xs generalizing n <;> grind\n\ngrind_pattern pos_findIdxNth_getElem => xs[xs.findIdxNth p n]\n\ntheorem findIdxNth_zero : (xs : List α).findIdxNth p 0 = xs.findIdx p := by\n induction xs <;> grind\n\n@[grind _=_]\ntheorem findIdxNth_lt_length_iff {xs : List α} :\n xs.findIdxNth p n < xs.length ↔ n < xs.countP p := by\n induction xs generalizing n <;> grind\n\n@[grind _=_]\ntheorem findIdxNth_eq_length_iff {xs : List α} :\n xs.findIdxNth p n = xs.length ↔ xs.countP p ≤ n := by\n induction xs generalizing n <;> grind\n\n@[simp, grind .]\ntheorem findIdxNth_le_length {xs : List α} :\n xs.findIdxNth p n ≤ xs.length := (n.lt_or_ge (xs.countP p)).elim (by grind) (by grind)\n\ntheorem findIdxNth_lt_length_of_lt_countP {xs : List α} (h : n < xs.countP p) :\n xs.findIdxNth p n < xs.length := by grind\n\ntheorem findIdxNth_eq_length_of_ge_countP {xs : List α} :\n xs.countP p ≤ n → xs.findIdxNth p n = xs.length := by grind\n\ntheorem findIdxNth_le_findIdxNth_iff {xs : List α} :\n xs.findIdxNth p n ≤ xs.findIdxNth p m ↔ countP p xs ≤ m ∨ n ≤ m := by\n induction xs generalizing n m with\n | nil => grind\n | cons a xs IH => cases h : p a <;> cases n <;> cases m <;> simp [h, IH]\n\ntheorem findIdxNth_lt_findIdxNth_iff {xs : List α} :\n xs.findIdxNth p n < xs.findIdxNth p m ↔ n < xs.countP p ∧ n < m := by\n simp [← Nat.not_le, findIdxNth_le_findIdxNth_iff]\n\ntheorem findIdxNth_eq_findIdxNth_iff {xs : List α} :\n xs.findIdxNth p n = xs.findIdxNth p m ↔\n (xs.countP p ≤ m ∨ n ≤ m) ∧ (xs.countP p ≤ n ∨ m ≤ n) := by\n simp only [Nat.le_antisymm_iff, findIdxNth_le_findIdxNth_iff]\n\ntheorem findIdxNth_lt_findIdxNth_iff_of_lt_countP {xs : List α} (hn : n < xs.countP p) :\n xs.findIdxNth p n < xs.findIdxNth p m ↔ n < m := by\n grind [findIdxNth_lt_findIdxNth_iff]\n\ntheorem findIdxNth_mono {xs : List α} (hnm : n ≤ m):\n xs.findIdxNth p n ≤ xs.findIdxNth p m := by\n grind [Nat.le_iff_lt_or_eq, findIdxNth_lt_findIdxNth_iff, findIdxNth_eq_findIdxNth_iff]\n\ntheorem findIdxNth_eq_findIdxNth_iff_of_left_lt_countP {xs : List α} (hn : n < xs.countP p) :\n xs.findIdxNth p n = xs.findIdxNth p m ↔ n = m := by\n grind [findIdxNth_eq_findIdxNth_iff]\n\ntheorem findIdxNth_eq_findIdxNth_iff_of_right_lt_countP {xs : List α} (hm : m < xs.countP p) :\n xs.findIdxNth p n = xs.findIdxNth p m ↔ n = m := by\n grind [findIdxNth_eq_findIdxNth_iff]\n\ntheorem findIdxNth_eq_findIdxNth_of_ge_countP_ge_countP {xs : List α} (hn : xs.countP p ≤ n)\n (hm : xs.countP p ≤ m) : xs.findIdxNth p n = xs.findIdxNth p m := by\n grind [findIdxNth_eq_findIdxNth_iff]\n\n/-! ### idxOf -/\n\n@[simp] theorem eraseIdx_idxOf_eq_erase [BEq α] (a : α) (l : List α) :\n l.eraseIdx (l.idxOf a) = l.erase a := by\n induction l with grind\n\n@[grind =] theorem idxOf_eq_getD_idxOf? [BEq α] (a : α) (l : List α) :\n l.idxOf a = (l.idxOf? a).getD l.length := by\n simp [idxOf, idxOf?, findIdx_eq_getD_findIdx?]\n\n@[deprecated (since := \"2025-11-06\")]\nalias idxOf_eq_idxOf? := idxOf_eq_getD_idxOf?\n\n@[simp, grind =]\ntheorem getElem_idxOf [BEq α] [LawfulBEq α] {x : α} {xs : List α} (h : idxOf x xs < xs.length) :\n xs[xs.idxOf x] = x := by induction xs <;> grind\n\n@[simp, grind =]\ntheorem Nodup.idxOf_getElem [BEq α] [LawfulBEq α] {xs : List α} (H : Nodup xs)\n (i : Nat) (h : i < xs.length) : idxOf xs[i] xs = i := by induction xs generalizing i <;> grind\n\n/-! ### idxsOf -/\n\n@[simp, grind =] theorem idxsOf_nil [BEq α] : ([] : List α).idxsOf x s = [] := rfl\n\n@[simp, grind =] theorem idxsOf_cons [BEq α] : (x :: xs : List α).idxsOf y s =\n if x == y then s :: xs.idxsOf y (s + 1) else xs.idxsOf y (s + 1) := findIdxs_cons\n\ntheorem idxsOf_start [BEq α] :\n (xs : List α).idxsOf x s = (xs.idxsOf x).map (· + s) := findIdxs_start\n\ntheorem idxsOf_eq_filterMap_zipIdx [BEq α] : (xs : List α).idxsOf x s =\n ((xs.zipIdx s).filterMap fun ab => bif ab.1 == x then ab.2 else none) :=\n findIdxs_eq_filterMap_zipIdx\n\n@[simp, grind =]\ntheorem mem_idxsOf_iff_getElem_sub_pos [BEq α] :\n i ∈ (xs : List α).idxsOf x s ↔ s ≤ i ∧\n ∃ (hix : i - s < xs.length), xs[i - s] == x := mem_findIdxs_iff_getElem_sub_pos\n\ntheorem mem_idxsOf_iff_exists_getElem_pos [BEq α] :\n i ∈ (xs : List α).idxsOf x ↔ ∃ (hix : i < xs.length), xs[i] == x := by grind\n\ntheorem mem_idxsOf_iff_getElem_pos [BEq α] (hi : i < (xs : List α).length) :\n i ∈ xs.idxsOf x ↔ xs[i] == x := by grind\n\ntheorem ge_of_mem_idxsOf [BEq α] : ∀ y ∈ (xs : List α).idxsOf x s, s ≤ y := by grind\n\ntheorem lt_add_of_mem_idxsOf [BEq α] :\n ∀ y ∈ (xs : List α).idxsOf x s, y < xs.length + s := by grind\n\ntheorem idxsOf_eq_nil_iff [BEq α] :\n (xs : List α).idxsOf x s = [] ↔ ∀ y ∈ xs, (y == x) = false := findIdxs_eq_nil_iff\n\n@[simp, grind =] theorem length_idxsOf [BEq α] :\n ((xs : List α).idxsOf x s).length = xs.count x := length_findIdxs\n\n@[simp, grind .]\ntheorem pairwise_idxsOf [BEq α] : ((xs : List α).idxsOf x s).Pairwise (· < ·) :=\n pairwise_findIdxs\n\n@[simp, grind .]\ntheorem isChain_idxsOf [BEq α] : ((xs : List α).idxsOf x s).IsChain (· < ·) :=\n pairwise_idxsOf.isChain\n\n@[simp, grind .]\ntheorem nodup_idxsOf [BEq α] : ((xs : List α).idxsOf x s).Nodup :=\n pairwise_idxsOf.imp (by grind)\n\n@[simp, grind =]\ntheorem idxsOf_map [BEq α] {f : β → α} :\n ((xs : List β).map f).idxsOf x s = xs.findIdxs (f · == x) s := findIdxs_map\n\n@[simp, grind =]\ntheorem idxsOf_append [BEq α] :\n ((xs : List α) ++ ys).idxsOf x s = xs.idxsOf x s ++ ys.idxsOf x (s + xs.length) :=\n findIdxs_append\n\n@[simp, grind =]\ntheorem idxsOf_take [BEq α] :\n ((xs : List α).take n).idxsOf x s = (xs.idxsOf x s).take ((xs.take n).count x) :=\n findIdxs_take\n\n@[simp, grind =>]\ntheorem le_getElem_idxsOf [BEq α] (h : i < ((xs : List α).idxsOf x s).length) :\n s ≤ (xs.idxsOf x s)[i] := by grind [getElem_mem]\n\n@[simp, grind =>]\ntheorem getElem_idxsOf_lt [BEq α] (h : i < ((xs : List α).idxsOf x s).length) :\n (xs.idxsOf x s)[i] < xs.length + s := by grind [getElem_mem]\n\n@[grind =>]\ntheorem getElem_getElem_idxsOf_sub [BEq α] (s : Nat)\n (h : i < ((xs : List α).idxsOf x s).length) :\n haveI : (idxsOf x xs s)[i] - s < xs.length := by grind\n xs[(xs.idxsOf x s)[i] - s] == x := getElem_getElem_findIdxs_sub s h\n\n@[simp]\ntheorem getElem_getElem_idxsOf_sub_of_lawful [BEq α] [LawfulBEq α] (s : Nat)\n (h : i < ((xs : List α).idxsOf x s).length) :\n haveI : (idxsOf x xs s)[i] - s < xs.length := by grind\n xs[(xs.idxsOf x s)[i] - s] = x := by grind [getElem_getElem_idxsOf_sub]\n\ntheorem getElem_getElem_idxsOf [BEq α] (h : i < ((xs : List α).idxsOf x).length) :\n haveI : (idxsOf x xs)[i] < xs.length := by grind\n xs[(xs.idxsOf x)[i]] == x := by grind\n\n@[simp]\ntheorem getElem_getElem_idxsOf_of_lawful [BEq α] [LawfulBEq α]\n (h : i < ((xs : List α).idxsOf x).length) :\n haveI : (idxsOf x xs)[i] < xs.length := by grind\n xs[(xs.idxsOf x)[i]] = x := by grind\n\n@[grind =>]\ntheorem mem_idxsOf_getElem [BEq α] [EquivBEq α] (h : i < (xs : List α).length) :\n i ∈ xs.idxsOf xs[i] := by grind\n\n@[grind =]\ntheorem getElem_zero_idxsOf_eq_idxOf_add [BEq α] (h : 0 < ((xs : List α).idxsOf x s).length) :\n (xs.idxsOf x s)[0] = xs.idxOf x + s := getElem_zero_findIdxs_eq_findIdx_add h\n\n@[simp]\ntheorem getElem_zero_idxsOf_eq_idxOf [BEq α] (h : 0 < ((xs : List α).idxsOf x).length) :\n (xs.idxsOf x)[0] = xs.idxOf x := getElem_zero_idxsOf_eq_idxOf_add h\n\n@[grind =>]\ntheorem idxOf_add_mem_idxsOf [BEq α] (s : Nat) (h : (xs : List α).idxOf x < xs.length) :\n xs.idxOf x + s ∈ xs.idxsOf x s := findIdx_add_mem_findIdxs s h\n\ntheorem idxOf_mem_idxsOf [BEq α] (h : (xs : List α).idxOf x < xs.length) :\n xs.idxOf x ∈ xs.idxsOf x := idxOf_add_mem_idxsOf 0 h\n\n/-! ### idxOfNth -/\n\n@[simp, grind =] theorem idxOfNth_nil [BEq α] : ([] : List α).idxOfNth x n = 0 := rfl\n\n@[grind =]\ntheorem idxOfNth_cons [BEq α] {a : α} :\n (a :: xs).idxOfNth x n =\n if n = 0 then if a == x then 0 else xs.idxOfNth x 0 + 1\n else if a == x then xs.idxOfNth x (n - 1) + 1\n else xs.idxOfNth x n + 1 := findIdxNth_cons\n\n@[simp] theorem idxOfNth_cons_zero [BEq α] {a : α} :\n (a :: xs).idxOfNth x 0 = if a == x then 0 else xs.idxOfNth x 0 + 1 := by grind\n\n@[simp] theorem idxOfNth_cons_succ [BEq α] {a : α} :\n (a :: xs).idxOfNth x (n + 1) =\n if a == x then xs.idxOfNth x n + 1\n else xs.idxOfNth x (n + 1) + 1 := by grind\n\ntheorem idxOfNth_cons_of_not_beq {a : α} [BEq α] (h : (a == x) = false) :\n (a :: xs).idxOfNth x n = xs.idxOfNth x n + 1 := by grind\n\ntheorem idxOfNth_cons_of_beq {a : α} [BEq α] (h : a == x) :\n (a :: xs).idxOfNth x n = if n = 0 then 0 else xs.idxOfNth x (n - 1) + 1 := by grind\n\ntheorem idxOfNth_cons_zero_of_beq {a : α} [BEq α] (h : a == x) :\n (a :: xs).idxOfNth x 0 = 0 := by grind\n\ntheorem idxOfNth_cons_succ_of_beq {a : α} [BEq α] (h : a == x) :\n (a :: xs).idxOfNth x (n + 1) = xs.idxOfNth x n + 1 := by grind\n\ntheorem getElem_idxOf_eq_idxOfNth_add {xs : List α} [BEq α] {h : n < (xs.idxsOf x s).length} :\n (xs.idxsOf x s)[n] = xs.idxOfNth x n + s := by\n induction xs generalizing n s <;> grind\n\n@[grind =]\ntheorem getElem_idxOf_eq_idxOfNth {xs : List α} [BEq α] {h : n < (xs.idxsOf x).length} :\n (xs.idxsOf x)[n] = xs.idxOfNth x n := getElem_idxOf_eq_idxOfNth_add\n\ntheorem getElem_idxOfNth_beq {xs : List α} [BEq α] {h : xs.idxOfNth x n < xs.length} :\n xs[xs.idxOfNth x n] == x := pos_findIdxNth_getElem (p := (· == x))\n\ngrind_pattern getElem_idxOfNth_beq => xs[xs.idxOfNth x n]\n\n@[simp, grind =]\ntheorem getElem_idxOfNth_eq {xs : List α} [BEq α] [LawfulBEq α] {h : xs.idxOfNth x n < xs.length} :\n xs[xs.idxOfNth x n] = x := eq_of_beq getElem_idxOfNth_beq\n\ntheorem idxOfNth_zero [BEq α] : (xs : List α).idxOfNth x 0 = xs.idxOf x := by\n induction xs <;> grind\n\n@[grind _=_]\ntheorem idxOfNth_lt_length_iff [BEq α] {xs : List α} :\n xs.idxOfNth x n < xs.length ↔ n < xs.count x := findIdxNth_lt_length_iff\n\n@[grind _=_]\ntheorem idxOfNth_eq_length_iff [BEq α] {xs : List α} :\n xs.idxOfNth x n = xs.length ↔ xs.count x ≤ n := findIdxNth_eq_length_iff\n\n@[grind .]\ntheorem idxOfNth_le_length [BEq α] {xs : List α} :\n xs.idxOfNth x n ≤ xs.length := findIdxNth_le_length\n\ntheorem idxOfNth_lt_length_of_lt_count {xs : List α} [BEq α] :\n n < xs.count x → xs.idxOfNth x n < xs.length := by grind\n\ntheorem idxOfNth_eq_length_of_ge_count {xs : List α} [BEq α] :\n xs.count x ≤ n → xs.idxOfNth x n = xs.length := by grind\n\ntheorem idxOfNth_lt_idxOfNth_iff [BEq α] {xs : List α} :\n xs.idxOfNth x n < xs.idxOfNth x m ↔ n < xs.count x ∧ n < m := findIdxNth_lt_findIdxNth_iff\n\ntheorem idxOfNth_eq_idxOfNth_iff [BEq α] {xs : List α} :\n xs.idxOfNth x n = xs.idxOfNth x m ↔\n (xs.count x ≤ m ∨ n ≤ m) ∧ (xs.count x ≤ n ∨ m ≤ n) := findIdxNth_eq_findIdxNth_iff\n\ntheorem idxOfNth_lt_idxOfNth_iff_of_lt_count [BEq α] {xs : List α} (hn : n < xs.count x) :\n xs.idxOfNth x n < xs.idxOfNth x m ↔ n < m := findIdxNth_lt_findIdxNth_iff_of_lt_countP hn\n\ntheorem idxOfNth_mono [BEq α] {xs : List α} (hnm : n ≤ m):\n xs.idxOfNth x n ≤ xs.idxOfNth x m := findIdxNth_mono hnm\n\ntheorem idxOfNth_eq_idxOfNth_iff_of_left_lt_count [BEq α] {xs : List α}\n (hn : n < xs.count x) : xs.idxOfNth x n = xs.idxOfNth x m ↔ n = m :=\n findIdxNth_eq_findIdxNth_iff_of_left_lt_countP hn\n\ntheorem idxOfNth_eq_idxOfNth_iff_of_right_lt_count [BEq α] {xs : List α}\n (hm : m < xs.count x) : xs.idxOfNth x n = xs.idxOfNth x m ↔ n = m :=\n findIdxNth_eq_findIdxNth_iff_of_right_lt_countP hm\n\ntheorem idxOfNth_eq_idxOfNth_of_ge_countP_ge_countP [BEq α] {xs : List α}\n (hn : xs.count x ≤ n) (hm : xs.count x ≤ m) : xs.idxOfNth x n = xs.idxOfNth x m :=\n findIdxNth_eq_findIdxNth_of_ge_countP_ge_countP hn hm\n\n/-! ### countPBefore -/\n\n@[simp, grind =] theorem countPBefore_nil : ([] : List α).countPBefore p n = 0 := rfl\n\n@[grind =]\ntheorem countPBefore_cons {a : α} :\n (a :: xs).countPBefore p i =\n if i = 0 then 0 else if p a then xs.countPBefore p (i - 1) + 1\n else xs.countPBefore p (i - 1) := by\n have H : ∀ i s, countPBefore.go (p : α → Bool) xs i s = countPBefore.go p xs i 0 + s := by\n induction xs <;> grind [countPBefore, countPBefore.go, cases Nat]\n cases i <;> grind [countPBefore, countPBefore.go]\n\ntheorem countPBefore_cons_zero {a : α} :\n (a :: xs).countPBefore p 0 = 0 := by grind\n\n@[simp] theorem countPBefore_cons_succ {a : α} :\n (a :: xs).countPBefore p (i + 1) =\n if p a then xs.countPBefore p i + 1 else xs.countPBefore p i := by grind\n\n@[simp, grind =] theorem countPBefore_zero :\n (xs : List α).countPBefore p 0 = 0 := by grind [cases List]\n\n@[grind =]\ntheorem countPBefore_succ :\n (xs : List α).countPBefore p (i + 1) =\n if h : xs = [] then 0\n else if p (xs.head h) then xs.tail.countPBefore p i + 1\n else xs.tail.countPBefore p i := by grind [cases List]\n\ntheorem countPBefore_cons_succ_of_neg {a : α} (h : p a = false) :\n (a :: xs).countPBefore p (i + 1) = xs.countPBefore p i := by grind\n\ntheorem countPBefore_cons_succ_of_pos {a : α} (h : p a) :\n (a :: xs).countPBefore p (i + 1) = xs.countPBefore p i + 1 := by grind\n\ntheorem countPBefore_eq_countP_take : (xs : List α).countPBefore p i = (xs.take i).countP p := by\n induction xs generalizing i <;> grind [cases Nat]\n\ntheorem countPBefore_of_ge_length {xs : List α} (hi : xs.length ≤ i) :\n xs.countPBefore p i = xs.countP p := by\n rw [countPBefore_eq_countP_take, take_of_length_le (by grind)]\n\ntheorem countPBefore_length {xs : List α} :\n xs.countPBefore p xs.length = xs.countP p := countPBefore_of_ge_length (by grind)\n\n@[simp, grind <=]\ntheorem findIdxNth_countPBefore_of_lt_length_of_pos {xs : List α} {h : i < xs.length}\n (hip : p xs[i]) : xs.findIdxNth p (xs.countPBefore p i) = i := by\n induction xs generalizing i <;> grind\n\n@[simp, grind <=]\ntheorem countPBefore_findIdxNth_of_lt_countP {xs : List α} :\n n < xs.countP p → xs.countPBefore p (xs.findIdxNth p n) = n := by\n induction xs generalizing n <;> grind\n\ntheorem pos_iff_exists_findIdxNth {xs : List α} {h : i < xs.length} :\n p xs[i] ↔ ∃ n, xs.findIdxNth p n = i := ⟨fun h => ⟨xs.countPBefore p i, by grind⟩, by grind⟩\n\ntheorem countPBefore_le_countP {xs : List α} (p : α → Bool) :\n xs.countPBefore p i ≤ xs.countP p := by\n rw [countPBefore_eq_countP_take]\n exact (take_sublist _ _).countP_le\n\ntheorem countPBefore_mono {xs : List α} (hij : i ≤ j) :\n xs.countPBefore p i ≤ xs.countPBefore p j := by\n simp only [countPBefore_eq_countP_take]\n exact (take_sublist_take_left hij).countP_le\n\n@[grind <=]\ntheorem countPBefore_lt_countP_of_lt_length_of_pos {xs : List α} {h : i < xs.length}\n (hip : p xs[i]) : xs.countPBefore p i < xs.countP p := by\n rwa [← findIdxNth_lt_length_iff, findIdxNth_countPBefore_of_lt_length_of_pos hip]\n\n/-! ### countBefore -/\n\n@[simp, grind =] theorem countBefore_nil [BEq α] : ([] : List α).countBefore x i = 0 := rfl\n\n@[grind =]\ntheorem countBefore_cons [BEq α] {a : α} :\n (a :: xs).countBefore x i =\n if i = 0 then 0 else if a == x then xs.countBefore x (i - 1) + 1\n else xs.countBefore x (i - 1) := countPBefore_cons\n\n@[simp] theorem countBefore_zero [BEq α] : (xs : List α).countBefore p 0 = 0 := countPBefore_zero\n\n@[simp] theorem countBefore_cons_succ {a : α} [BEq α] :\n (a :: xs).countBefore x (i + 1) = xs.countBefore x i + if a == x then 1 else 0 := by grind\n\ntheorem countBefore_cons_succ_of_not_beq [BEq α] {a : α} (h : (a == x) = false):\n (a :: xs).countBefore x (i + 1) = xs.countBefore x i := by grind\n\ntheorem countBefore_cons_succ_of_beq {a : α} [BEq α] (h : a == x) :\n (a :: xs).countBefore x (i + 1) = xs.countBefore x i + 1 := by grind\n\ntheorem countBefore_eq_count_take [BEq α] :\n (xs : List α).countBefore x i = (xs.take i).count x := by\n induction xs generalizing i <;> cases i <;> grind\n\n@[grind <=]\ntheorem countBefore_idxOfNth_of_lt_count [BEq α] {xs : List α} (hn : n < xs.count x) :\n xs.countBefore x (xs.idxOfNth x n) = n := countPBefore_findIdxNth_of_lt_countP hn\n\n@[grind <=]\ntheorem idxOfNth_countBefore_of_lt_length_of_beq [BEq α] {xs : List α} {h : i < xs.length}\n (hip : xs[i] == x) : xs.idxOfNth x (xs.countBefore x i) = i :=\n findIdxNth_countPBefore_of_lt_length_of_pos hip\n\n@[simp, grind =]\ntheorem idxOfNth_countBefore_getElem [BEq α] [ReflBEq α] {xs : List α}\n {h : i < xs.length} : xs.idxOfNth xs[i] (xs.countBefore xs[i] i) = i :=\n idxOfNth_countBefore_of_lt_length_of_beq BEq.rfl\n\ntheorem beq_iff_exists_findIdxNth [BEq α] {xs : List α} {h : i < xs.length} :\n xs[i] == x ↔ ∃ n, xs.idxOfNth x n = i := ⟨fun h => ⟨xs.countBefore x i, by grind⟩, by grind⟩\n\ntheorem countBefore_le_count [BEq α] {xs : List α} :\n xs.countBefore x i ≤ xs.count x := by\n induction xs generalizing i <;> cases i <;> grind\n\n@[grind <=]\ntheorem countBefore_lt_count_of_lt_length_of_beq [BEq α] {xs : List α} {h : i < xs.length}\n (hip : xs[i] == x) : xs.countBefore x i < xs.count x :=\n countPBefore_lt_countP_of_lt_length_of_pos hip\n\n@[simp, grind <=]\ntheorem countBefore_lt_count_getElem [BEq α] [ReflBEq α] {xs : List α} {h : i < xs.length} :\n xs.countBefore xs[i] i < xs.count xs[i] :=\n countBefore_lt_count_of_lt_length_of_beq BEq.rfl\n\ntheorem countBefore_of_ge_length [BEq α] {xs : List α} (hi : xs.length ≤ i) :\n xs.countBefore x i = xs.count x := countPBefore_of_ge_length hi\n\n/-! ### insertP -/\n\ntheorem insertP_loop (a : α) (l r : List α) :\n insertP.loop p a l r = reverseAux r (insertP p a l) := by\n induction l generalizing r with simp [insertP, insertP.loop, cond]\n | cons b l ih => rw [ih (b :: r), ih [b]]; split <;> simp\n\n@[simp] theorem insertP_nil (p : α → Bool) (a) : insertP p a [] = [a] := rfl\n\n@[simp] theorem insertP_cons_pos (p : α → Bool) (a b l) (h : p b) :\n insertP p a (b :: l) = a :: b :: l := by\n simp only [insertP, insertP.loop, cond, h]; rfl\n\n@[simp] theorem insertP_cons_neg (p : α → Bool) (a b l) (h : ¬ p b) :\n insertP p a (b :: l) = b :: insertP p a l := by\n simp only [insertP, insertP.loop, cond, h]; exact insertP_loop ..\n\n@[simp] theorem length_insertP (p : α → Bool) (a l) : (insertP p a l).length = l.length + 1 := by\n induction l with simp [insertP, insertP.loop, cond]\n | cons _ _ ih => split <;> simp [insertP_loop, ih]\n\n@[simp] theorem mem_insertP (p : α → Bool) (a l) : a ∈ insertP p a l := by\n induction l with simp [insertP, insertP.loop, cond]\n | cons _ _ ih => split <;> simp [insertP_loop, ih]\n\n/-! ### dropPrefix?, dropSuffix?, dropInfix?-/\n\nopen Option\n\n@[simp] theorem dropPrefix?_nil [BEq α] {p : List α} : dropPrefix? p [] = some p := by\n simp [dropPrefix?]\n\ntheorem dropPrefix?_eq_some_iff [BEq α] {l p s : List α} :\n dropPrefix? l p = some s ↔ ∃ p', l = p' ++ s ∧ p' == p := by\n unfold dropPrefix?\n split\n · simp\n · simp\n · rename_i a as b bs\n simp only [ite_none_right_eq_some]\n constructor\n · rw [dropPrefix?_eq_some_iff]\n rintro ⟨w, p', rfl, h⟩\n refine ⟨a :: p', by simp_all⟩\n · rw [dropPrefix?_eq_some_iff]\n rintro ⟨p, h, w⟩\n rw [cons_eq_append_iff] at h\n obtain (⟨rfl, rfl⟩ | ⟨a', rfl, rfl⟩) := h\n · simp at w\n · simp only [cons_beq_cons, Bool.and_eq_true] at w\n refine ⟨w.1, a', rfl, w.2⟩\n\ntheorem dropPrefix?_append_of_beq [BEq α] {l₁ l₂ : List α} (p : List α) (h : l₁ == l₂) :\n dropPrefix? (l₁ ++ p) l₂ = some p := by\n simp [dropPrefix?_eq_some_iff, h]\n\ntheorem dropSuffix?_eq_some_iff [BEq α] {l p s : List α} :\n dropSuffix? l s = some p ↔ ∃ s', l = p ++ s' ∧ s' == s := by\n unfold dropSuffix?\n rw [splitAt_eq]\n simp only [ite_none_right_eq_some, some.injEq]\n constructor\n · rintro ⟨w, rfl⟩\n refine ⟨_, by simp, w⟩\n · rintro ⟨s', rfl, w⟩\n simp [length_eq_of_beq w, w]\n\n@[simp] theorem dropSuffix?_nil [BEq α] {s : List α} : dropSuffix? s [] = some s := by\n simp [dropSuffix?_eq_some_iff]\n\ntheorem dropInfix?_go_eq_some_iff [BEq α] {i l acc p s : List α} :\n dropInfix?.go i l acc = some (p, s) ↔ ∃ p',\n p = acc.reverse ++ p' ∧\n -- `i` is an infix up to `==`\n (∃ i', l = p' ++ i' ++ s ∧ i' == i) ∧\n -- and there is no shorter prefix for which that is the case\n (∀ p'' i'' s'', l = p'' ++ i'' ++ s'' → i'' == i → p''.length ≥ p'.length) := by\n unfold dropInfix?.go\n split\n · simp only [isEmpty_iff, ite_none_right_eq_some, some.injEq, Prod.mk.injEq, nil_eq,\n append_assoc, append_eq_nil_iff, ge_iff_le, and_imp]\n constructor\n · rintro ⟨rfl, rfl, rfl⟩\n simp\n · rintro ⟨p', rfl, ⟨_, ⟨rfl, rfl, rfl⟩, h⟩, w⟩\n simp_all\n · rename_i a t\n split <;> rename_i h\n · rw [dropInfix?_go_eq_some_iff]\n constructor\n · rintro ⟨p', rfl, ⟨i', rfl, h₂⟩, w⟩\n refine ⟨a :: p', ?_⟩\n simp [h₂]\n intro p'' i'' s'' h₁ h₂\n rw [cons_eq_append_iff] at h₁\n obtain (⟨rfl, h₁⟩ | ⟨p'', rfl, h₁⟩) := h₁\n · rw [append_assoc, ← h₁] at h\n have := dropPrefix?_append_of_beq s'' h₂\n simp_all\n · simpa using w p'' i'' s'' (by simpa using h₁) h₂\n · rintro ⟨p', rfl, ⟨i', h₁, h₂⟩, w⟩\n rw [cons_eq_append_iff] at h₁\n simp at h₁\n obtain (⟨⟨rfl, rfl⟩, rfl⟩ | ⟨a', h₁, rfl⟩) := h₁\n · simp only [nil_beq_eq, isEmpty_iff] at h₂\n simp only [h₂] at h\n simp at h\n · rw [append_eq_cons_iff] at h₁\n obtain (⟨rfl, rfl⟩ | ⟨p', rfl, rfl⟩) := h₁\n · rw [← cons_append] at h\n have := dropPrefix?_append_of_beq s h₂\n simp_all\n · refine ⟨p', ?_⟩\n simp only [reverse_cons, append_assoc, singleton_append, append_cancel_left_eq,\n append_cancel_right_eq, exists_eq_left', ge_iff_le, true_and]\n refine ⟨h₂, ?_⟩\n intro p'' i'' s'' h₃ h₄\n rw [← append_assoc] at h₃\n rw [h₃] at w\n simpa using w (a :: p'') i'' s'' (by simp) h₄\n · rename_i s'\n simp only [some.injEq, Prod.mk.injEq, append_assoc, ge_iff_le]\n rw [dropPrefix?_eq_some_iff] at h\n obtain ⟨p', h, w⟩ := h\n constructor\n · rintro ⟨rfl, rfl⟩\n simpa using ⟨p', by simp_all⟩\n · rintro ⟨p'', rfl, ⟨i', h₁, h₂⟩, w'⟩\n specialize w' [] p' s' (by simpa using h) w\n simp at w'\n simp [w'] at h₁ ⊢\n rw [h] at h₁\n apply append_inj_right h₁\n replace w := length_eq_of_beq w\n replace h₂ := length_eq_of_beq h₂\n simp_all\n\ntheorem dropInfix?_eq_some_iff [BEq α] {l i p s : List α} :\n dropInfix? l i = some (p, s) ↔\n -- `i` is an infix up to `==`\n (∃ i', l = p ++ i' ++ s ∧ i' == i) ∧\n -- and there is no shorter prefix for which that is the case\n (∀ p' i' s', l = p' ++ i' ++ s' → i' == i → p'.length ≥ p.length) := by\n unfold dropInfix?\n rw [dropInfix?_go_eq_some_iff]\n simp\n\n@[simp] theorem dropInfix?_nil [BEq α] {s : List α} : dropInfix? s [] = some ([], s) := by\n simp [dropInfix?_eq_some_iff]\n\n/-! ### IsPrefixOf?, IsSuffixOf? -/\n\n@[simp] theorem isSome_isPrefixOf?_eq_isPrefixOf [BEq α] (xs ys : List α) :\n (xs.isPrefixOf? ys).isSome = xs.isPrefixOf ys := by\n match xs, ys with\n | [], _ => simp [List.isPrefixOf?]\n | _::_, [] => rfl\n | _::_, _::_ =>\n simp only [List.isPrefixOf?, List.isPrefixOf]\n split <;> simp [*, isSome_isPrefixOf?_eq_isPrefixOf]\n\n@[simp] theorem isPrefixOf?_eq_some_iff_append_eq [BEq α] [LawfulBEq α] {xs ys zs : List α} :\n xs.isPrefixOf? ys = some zs ↔ xs ++ zs = ys := by\n induction xs generalizing ys with\n | nil => simp [isPrefixOf?, Eq.comm]\n | cons => cases ys <;> simp [isPrefixOf?, *]\n\ntheorem append_eq_of_isPrefixOf?_eq_some [BEq α] [LawfulBEq α] {xs ys zs : List α}\n (h : xs.isPrefixOf? ys = some zs) : xs ++ zs = ys := by simp_all\n\n@[simp] theorem isSome_isSuffixOf?_eq_isSuffixOf [BEq α] (xs ys : List α) :\n (xs.isSuffixOf? ys).isSome = xs.isSuffixOf ys := by\n simp [List.isSuffixOf?, isSuffixOf]\n\n@[simp] theorem isSuffixOf?_eq_some_iff_append_eq [BEq α] [LawfulBEq α] {xs ys zs : List α} :\n xs.isSuffixOf? ys = some zs ↔ zs ++ xs = ys := by\n simp only [isSuffixOf?, map_eq_some_iff, isPrefixOf?_eq_some_iff_append_eq]\n constructor\n · intro\n | ⟨_, h, heq⟩ =>\n rw [List.reverse_eq_iff] at heq\n rw [heq] at h\n rw [← reverse_inj, reverse_append, h]\n · intro h\n exists zs.reverse\n simp [← h]\n\ntheorem append_eq_of_isSuffixOf?_eq_some [BEq α] [LawfulBEq α] {xs ys zs : List α}\n (h : xs.isSuffixOf? ys = some zs) : zs ++ xs = ys := by simp_all\n\n/-! ### finRange -/\n\ntheorem get_finRange (i : Fin (finRange n).length) :\n (finRange n).get i = Fin.cast length_finRange i := by simp\n\n@[simp, grind =]\ntheorem finRange_eq_nil_iff : finRange n = [] ↔ n = 0 := by\n simp [eq_nil_iff_length_eq_zero]\n\ntheorem finRange_eq_pmap_range : finRange n = (range n).pmap Fin.mk (by simp) := by\n apply List.ext_getElem <;> simp [finRange]\n\ntheorem nodup_finRange (n) : (finRange n).Nodup := by\n rw [finRange_eq_pmap_range]\n exact (Pairwise.pmap nodup_range _) fun _ _ _ _ => @Fin.ne_of_val_ne _ ⟨_, _⟩ ⟨_, _⟩\n\ntheorem pairwise_lt_finRange (n) : Pairwise (· < ·) (finRange n) := by\n rw [finRange_eq_pmap_range]\n exact List.pairwise_lt_range.pmap (by simp) (by simp)\n\ntheorem pairwise_le_finRange (n) : Pairwise (· ≤ ·) (finRange n) := by\n rw [finRange_eq_pmap_range]\n exact List.pairwise_le_range.pmap (by simp) (by simp)\n\n@[simp]\ntheorem map_get_finRange (l : List α) : (finRange l.length).map l.get = l := by\n apply ext_getElem <;> simp\n\n@[simp]\ntheorem map_getElem_finRange (l : List α) : (finRange l.length).map (l[·.1]) = l := by\n apply ext_getElem <;> simp\n\n@[simp]\ntheorem map_coe_finRange_eq_range : (finRange n).map (↑·) = List.range n := by\n apply List.ext_getElem <;> simp\n/-! ### sum/prod -/\n\n@[simp, grind =]\ntheorem prod_nil [Mul α] [One α] : ([] : List α).prod = 1 := rfl\n\n@[simp, grind =]\ntheorem prod_cons [Mul α] [One α] {a : α} {l : List α} : (a :: l).prod = a * l.prod := rfl\n\ntheorem prod_one_cons [Mul α] [One α] [Std.LawfulLeftIdentity (α := α) (· * ·) 1] {l : List α} :\n (1 :: l).prod = l.prod := by simp [Std.LawfulLeftIdentity.left_id]\n\ntheorem prod_singleton [Mul α] [One α] [Std.LawfulRightIdentity (α := α) (· * ·) 1] {a : α} :\n [a].prod = a := by simp [Std.LawfulRightIdentity.right_id]\n\ntheorem prod_pair [Mul α] [One α] [Std.LawfulRightIdentity (α := α) (· * ·) 1] {a b : α} :\n [a, b].prod = a * b := by simp [Std.LawfulRightIdentity.right_id]\n\n@[simp, grind =]\ntheorem prod_append [Mul α] [One α] [Std.LawfulLeftIdentity (α := α) (· * ·) 1]\n [Std.Associative (α := α) (· * ·)] {l₁ l₂ : List α} : (l₁ ++ l₂).prod = l₁.prod * l₂.prod := by\n induction l₁ with simp [Std.LawfulLeftIdentity.left_id, Std.Associative.assoc, *]\n\ntheorem prod_concat [Mul α] [One α] [Std.LawfulIdentity (α := α) (· * ·) 1]\n [Std.Associative (α := α) (· * ·)] {l : List α} {a : α} :\n (l.concat a).prod = l.prod * a := by simp [Std.LawfulRightIdentity.right_id]\n\n@[simp, grind =]\ntheorem prod_flatten [Mul α] [One α] [Std.LawfulIdentity (α := α) (· * ·) 1]\n [Std.Associative (α := α) (· * ·)] {l : List (List α)} :\n l.flatten.prod = (l.map prod).prod := by\n induction l with simp [*]\n\ntheorem prod_eq_foldr [Mul α] [One α] {l : List α} :\n l.prod = l.foldr (· * ·) 1 := rfl\n\ntheorem prod_eq_foldl [Mul α] [One α] [Std.Associative (α := α) (· * ·)]\n [Std.LawfulIdentity (α := α) (· * ·) 1] {l : List α} :\n l.prod = l.foldl (· * ·) 1 := foldr_eq_foldl ..\n\ntheorem sum_zero_cons [Add α] [Zero α] [Std.LawfulLeftIdentity (α := α) (· + ·) 0] {l : List α} :\n (0 :: l).sum = l.sum := by simp [Std.LawfulLeftIdentity.left_id]\n\ntheorem sum_pair [Add α] [Zero α] [Std.LawfulRightIdentity (α := α) (· + ·) 0] {a b : α} :\n [a, b].sum = a + b := by simp [Std.LawfulRightIdentity.right_id]\n\ntheorem sum_concat [Add α] [Zero α] [Std.LawfulIdentity (α := α) (· + ·) 0]\n [Std.Associative (α := α) (· + ·)] {l : List α} {a : α} :\n (l.concat a).sum = l.sum + a := by simp [Std.LawfulRightIdentity.right_id]\n\n@[simp, grind =]\ntheorem sum_flatten [Add α] [Zero α] [Std.LawfulIdentity (α := α) (· + ·) 0]\n [Std.Associative (α := α) (· + ·)] {l : List (List α)} :\n l.flatten.sum = (l.map sum).sum := by\n induction l with simp [*]\n\ntheorem take_succ_drop {l : List α} {n stop : Nat}\n (h : n < l.length - stop) :\n (l.drop stop |>.take (n + 1)) = (l.drop stop |>.take n) ++ [l[stop + n]'(by omega)] := by\n rw [← List.take_append_getElem (by simpa [← List.length_drop] using h)]\n simp [List.getElem_drop]\n" }, { "path": "Batteries/Data/List/Matcher.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Data.Array.Match\n\n@[expose] public section\n\nnamespace List\n\n/-- Knuth-Morris-Pratt matcher type\n\nThis type is used to keep data for running the Knuth-Morris-Pratt (KMP) list matching algorithm.\nKMP is a linear time algorithm to locate all contiguous sublists of a list that match a given\npattern. Generating the algorithm data is also linear in the length of the pattern but the data can\nbe re-used to match the same pattern over multiple lists.\n\nThe KMP data for a pattern can be generated using `Matcher.ofList`. Then `Matcher.find?` and\n`Matcher.findAll` can be used to run the algorithm on an input list.\n```\ndef m := Matcher.ofList [0,1,1,0]\n\n#eval Option.isSome <| m.find? [2,1,1,0,1,1,2] -- false\n#eval Option.isSome <| m.find? [0,0,1,1,0,0] -- true\n\n#eval Array.size <| m.findAll [0,1,1,0,1,1,0] -- 2\n#eval Array.size <| m.findAll [0,1,1,0,1,1,0,1,1,0] -- 3\n```\n-/\nstructure Matcher (α : Type _) extends Array.Matcher α where\n /-- The pattern for the matcher -/\n pattern : List α\n\n/-- Make KMP matcher from list pattern. -/\n@[inline] def Matcher.ofList [BEq α] (pattern : List α) : Matcher α where\n toMatcher := Array.Matcher.ofStream pattern\n pattern := pattern\n\n/-- List stream that keeps count of items read. -/\nlocal instance (α) : Std.Stream (List α × Nat) α where\n next?\n | ([], _) => none\n | (x::xs, n) => (x, xs, n+1)\n\n/--\nFind all start and end positions of all infix sublists of `l` matching `m.pattern`.\nThe sublists may be overlapping.\n-/\npartial def Matcher.findAll [BEq α] (m : Matcher α) (l : List α) : Array (Nat × Nat) :=\n loop (l, 0) m.toMatcher #[]\nwhere\n /-- Accumulator loop for `List.Matcher.findAll` -/\n loop (l : List α × Nat) (am : Array.Matcher α) (occs : Array (Nat × Nat)) : Array (Nat × Nat) :=\n match am.next? l with\n | none => occs\n | some (l, am) => loop l am (occs.push (l.snd - m.table.size, l.snd))\n\n/--\nFind the start and end positions of the first infix sublist of `l` matching `m.pattern`,\nor `none` if there is no such sublist.\n-/\ndef Matcher.find? [BEq α] (m : Matcher α) (l : List α) : Option (Nat × Nat) :=\n match m.next? (l, 0) with\n | none => none\n | some (l, _) => some (l.snd - m.table.size, l.snd)\n\n/--\nReturns all the start and end positions of all infix sublists of of `l` that match `pattern`.\nThe sublists may be overlapping.\n-/\n@[inline] def findAllInfix [BEq α] (l pattern : List α) : Array (Nat × Nat) :=\n (Matcher.ofList pattern).findAll l\n\n/--\nReturns the start and end positions of the first infix sublist of `l` that matches `pattern`,\nor `none` if there is no such sublist.\n-/\n@[inline] def findInfix? [BEq α] (l pattern : List α) : Option (Nat × Nat) :=\n (Matcher.ofList pattern).find? l\n\n/--\nReturns true iff `pattern` occurs as an infix sublist of `l`.\n-/\n@[inline] def containsInfix [BEq α] (l pattern : List α) : Bool :=\n findInfix? l pattern |>.isSome\n" }, { "path": "Batteries/Data/List/Monadic.lean", "content": "/-\nCopyright (c) 2024 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Classes.SatisfiesM\n\n@[expose] public section\n\n/-!\n# Results about monadic operations on `List`, in terms of `SatisfiesM`.\n\n-/\n\nnamespace List\n\ntheorem satisfiesM_foldlM [Monad m] [LawfulMonad m] {f : β → α → m β} (h₀ : motive b)\n (h₁ : ∀ (b) (_ : motive b) (a : α) (_ : a ∈ l), SatisfiesM motive (f b a)) :\n SatisfiesM motive (List.foldlM f b l) := by\n induction l generalizing b with\n | nil => exact SatisfiesM.pure h₀\n | cons hd tl ih =>\n simp only [foldlM_cons]\n apply SatisfiesM.bind_pre\n let ⟨q, qh⟩ := h₁ b h₀ hd mem_cons_self\n exact ⟨(fun ⟨b, bh⟩ => ⟨b, ih bh (fun b bh a am => h₁ b bh a (mem_cons_of_mem hd am))⟩) <$> q,\n by simpa using qh⟩\n\ntheorem satisfiesM_foldrM [Monad m] [LawfulMonad m] {f : α → β → m β} (h₀ : motive b)\n (h₁ : ∀ (a : α) (_ : a ∈ l) (b) (_ : motive b), SatisfiesM motive (f a b)) :\n SatisfiesM motive (List.foldrM f b l) := by\n induction l with\n | nil => exact SatisfiesM.pure h₀\n | cons hd tl ih =>\n simp only [foldrM_cons]\n apply SatisfiesM.bind_pre\n let ⟨q, qh⟩ := ih (fun a am b hb => h₁ a (mem_cons_of_mem hd am) b hb)\n exact ⟨(fun ⟨b, bh⟩ => ⟨b, h₁ hd mem_cons_self b bh⟩) <$> q,\n by simpa using qh⟩\n\nend List\n" }, { "path": "Batteries/Data/List/Pairwise.lean", "content": "/-\nCopyright (c) 2018 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, James Gallicchio\n-/\nmodule\n\npublic import Batteries.Data.List.Basic\n\n@[expose] public section\n\n/-!\n# Pairwise relations on a list\n\nThis file provides basic results about `List.Pairwise` and `List.pwFilter` (definitions are in\n`Batteries.Data.List.Basic`).\n`Pairwise r [a 0, ..., a (n - 1)]` means `∀ i j, i < j → r (a i) (a j)`. For example,\n`Pairwise (≠) l` means that all elements of `l` are distinct, and `Pairwise (<) l` means that `l`\nis strictly increasing.\n`pwFilter r l` is the list obtained by iteratively adding each element of `l` that doesn't break\nthe pairwiseness of the list we have so far. It thus yields `l'` a maximal sublist of `l` such that\n`Pairwise r l'`.\n\n## Tags\n\nsorted, nodup\n-/\n\n\nopen Nat Function\n\nnamespace List\n\n/-! ### Pairwise -/\n\ntheorem pairwise_iff_get : Pairwise R l ↔ ∀ (i j) (_hij : i < j), R (get l i) (get l j) := by\n rw [pairwise_iff_getElem]\n constructor <;> intro h\n · intros i j h'\n exact h _ _ _ _ h'\n · intros i j hi hj h'\n exact h ⟨i, hi⟩ ⟨j, hj⟩ h'\n\n/-! ### Pairwise filtering -/\n\n@[simp] theorem pwFilter_nil [DecidableRel R] : pwFilter R [] = [] := rfl\n\n@[simp] theorem pwFilter_cons_of_pos [DecidableRel (α := α) R] {a : α} {l : List α}\n (h : ∀ b ∈ pwFilter R l, R a b) : pwFilter R (a :: l) = a :: pwFilter R l := if_pos h\n\n@[simp] theorem pwFilter_cons_of_neg [DecidableRel (α := α) R] {a : α} {l : List α}\n (h : ¬∀ b ∈ pwFilter R l, R a b) : pwFilter R (a :: l) = pwFilter R l := if_neg h\n\ntheorem pwFilter_map [DecidableRel (α := α) R] (f : β → α) :\n ∀ l : List β, pwFilter R (map f l) = map f (pwFilter (fun x y => R (f x) (f y)) l)\n | [] => rfl\n | x :: xs => by\n if h : ∀ b ∈ pwFilter R (map f xs), R (f x) b then\n have h' : ∀ b : β, b ∈ pwFilter (fun x y : β => R (f x) (f y)) xs → R (f x) (f b) :=\n fun b hb => h _ (by rw [pwFilter_map f xs]; apply mem_map_of_mem hb)\n rw [map, pwFilter_cons_of_pos h, pwFilter_cons_of_pos h', pwFilter_map f xs, map]\n else\n rw [map, pwFilter_cons_of_neg h, pwFilter_cons_of_neg ?_, pwFilter_map f xs]\n refine fun hh => h fun a ha => ?_\n rw [pwFilter_map f xs, mem_map] at ha\n let ⟨b, hb₀, hb₁⟩ := ha; exact hb₁ ▸ hh _ hb₀\n\ntheorem pwFilter_sublist [DecidableRel (α := α) R] : ∀ l : List α, pwFilter R l <+ l\n | [] => nil_sublist _\n | x :: l =>\n if h : ∀ y ∈ pwFilter R l, R x y then\n pwFilter_cons_of_pos h ▸ (pwFilter_sublist l).cons_cons _\n else\n pwFilter_cons_of_neg h ▸ Sublist.cons _ (pwFilter_sublist l)\n\ntheorem pwFilter_subset [DecidableRel (α := α) R] (l : List α) : pwFilter R l ⊆ l :=\n (pwFilter_sublist _).subset\n\ntheorem pairwise_pwFilter [DecidableRel (α := α) R] : ∀ l : List α, Pairwise R (pwFilter R l)\n | [] => Pairwise.nil\n | x :: l =>\n if h : ∀ y ∈ pwFilter R l, R x y then\n pwFilter_cons_of_pos h ▸ pairwise_cons.2 ⟨h, pairwise_pwFilter l⟩\n else\n pwFilter_cons_of_neg h ▸ pairwise_pwFilter l\n\ntheorem pwFilter_eq_self [DecidableRel (α := α) R] {l : List α} :\n pwFilter R l = l ↔ Pairwise R l := by\n refine ⟨fun e => e ▸ pairwise_pwFilter l, fun p => ?_⟩\n induction l with\n | nil => rfl\n | cons x l IH =>\n let ⟨al, p⟩ := pairwise_cons.1 p\n rw [pwFilter_cons_of_pos fun b hb => ?_, IH p]\n rw [IH p] at hb\n exact al _ hb\n\n@[simp] theorem pwFilter_idem [DecidableRel (α := α) R] :\n pwFilter R (pwFilter R l) = pwFilter R l := pwFilter_eq_self.2 (pairwise_pwFilter ..)\n\ntheorem forall_mem_pwFilter [DecidableRel (α := α) R]\n (neg_trans : ∀ {x y z}, R x z → R x y ∨ R y z) (a : α) (l : List α) :\n (∀ b ∈ pwFilter R l, R a b) ↔ ∀ b ∈ l, R a b := by\n refine ⟨?_, fun h b hb => h _ <| pwFilter_subset (R := R) _ hb⟩\n induction l with\n | nil => exact fun _ _ h => (not_mem_nil h).elim\n | cons x l IH =>\n simp only [forall_mem_cons]\n if h : ∀ y ∈ pwFilter R l, R x y then\n simpa [pwFilter_cons_of_pos h] using fun r H => ⟨r, IH H⟩\n else\n refine pwFilter_cons_of_neg h ▸ fun H => ⟨?_, IH H⟩\n match e : find? (fun y => ¬R x y) (pwFilter R l) with\n | none => exact h.elim fun y hy => by simpa using find?_eq_none.1 e y hy\n | some k =>\n have := find?_some e\n apply (neg_trans (H k (mem_of_find?_eq_some e))).resolve_right\n rw [decide_eq_true_iff] at this; exact this\n" }, { "path": "Batteries/Data/List/Perm.lean", "content": "/-\nCopyright (c) 2015 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\npublic import Batteries.Data.List.Count\nimport Batteries.Util.ProofWanted\n\n@[expose] public section\n\n/-!\n# List Permutations\n\nThis file introduces the `List.Perm` relation, which is true if two lists are permutations of one\nanother.\n\n## Notation\n\nThe notation `~` is used for permutation equivalence.\n-/\n\nopen Nat\n\nnamespace List\n\nopen Perm (swap)\n\n@[simp] theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩\n\ntheorem Perm.subperm_left {l l₁ l₂ : List α} (p : l₁ ~ l₂) : l <+~ l₁ ↔ l <+~ l₂ :=\n suffices ∀ {l₁ l₂ : List α}, l₁ ~ l₂ → l <+~ l₁ → l <+~ l₂ from ⟨this p, this p.symm⟩\n fun p ⟨_u, pu, su⟩ =>\n let ⟨v, pv, sv⟩ := exists_perm_sublist su p\n ⟨v, pv.trans pu, sv⟩\n\ntheorem Perm.subperm_right {l₁ l₂ l : List α} (p : l₁ ~ l₂) : l₁ <+~ l ↔ l₂ <+~ l :=\n ⟨fun ⟨u, pu, su⟩ => ⟨u, pu.trans p, su⟩, fun ⟨u, pu, su⟩ => ⟨u, pu.trans p.symm, su⟩⟩\n\ntheorem Sublist.subperm {l₁ l₂ : List α} (s : l₁ <+ l₂) : l₁ <+~ l₂ := ⟨l₁, .rfl, s⟩\n\ntheorem Perm.subperm {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁ <+~ l₂ := ⟨l₂, p.symm, Sublist.refl _⟩\n\n@[refl] theorem Subperm.refl (l : List α) : l <+~ l := Perm.rfl.subperm\n\ntheorem Subperm.trans {l₁ l₂ l₃ : List α} (s₁₂ : l₁ <+~ l₂) (s₂₃ : l₂ <+~ l₃) : l₁ <+~ l₃ :=\n let ⟨_l₂', p₂, s₂⟩ := s₂₃\n let ⟨l₁', p₁, s₁⟩ := p₂.subperm_left.2 s₁₂\n ⟨l₁', p₁, s₁.trans s₂⟩\n\ntheorem Subperm.cons_self : l <+~ a :: l := ⟨l, .refl _, sublist_cons_self ..⟩\n\ntheorem Subperm.cons_right {α : Type _} {l l' : List α} (x : α) (h : l <+~ l') : l <+~ x :: l' :=\n h.trans (sublist_cons_self x l').subperm\n\ntheorem Subperm.length_le {l₁ l₂ : List α} : l₁ <+~ l₂ → length l₁ ≤ length l₂\n | ⟨_l, p, s⟩ => p.length_eq ▸ s.length_le\n\ntheorem Subperm.perm_of_length_le {l₁ l₂ : List α} : l₁ <+~ l₂ → length l₂ ≤ length l₁ → l₁ ~ l₂\n | ⟨_l, p, s⟩, h => (s.eq_of_length_le <| p.symm.length_eq ▸ h) ▸ p.symm\n\ntheorem Subperm.antisymm {l₁ l₂ : List α} (h₁ : l₁ <+~ l₂) (h₂ : l₂ <+~ l₁) : l₁ ~ l₂ :=\n h₁.perm_of_length_le h₂.length_le\n\ntheorem Subperm.subset {l₁ l₂ : List α} : l₁ <+~ l₂ → l₁ ⊆ l₂\n | ⟨_l, p, s⟩ => Subset.trans p.symm.subset s.subset\n\ntheorem Subperm.filter (p : α → Bool) ⦃l l' : List α⦄ (h : l <+~ l') :\n filter p l <+~ filter p l' := by\n let ⟨xs, hp, h⟩ := h\n exact ⟨_, hp.filter p, h.filter p⟩\n\n@[simp] theorem subperm_nil : l <+~ [] ↔ l = [] :=\n ⟨fun h => length_eq_zero_iff.1 $ Nat.le_zero.1 h.length_le, by rintro rfl; rfl⟩\n\n@[simp] theorem singleton_subperm_iff {α} {l : List α} {a : α} : [a] <+~ l ↔ a ∈ l := by\n refine ⟨fun ⟨s, hla, h⟩ => ?_, fun h => ⟨[a], .rfl, singleton_sublist.mpr h⟩⟩\n rwa [perm_singleton.mp hla, singleton_sublist] at h\n\ntheorem Subperm.countP_le (p : α → Bool) {l₁ l₂ : List α} : l₁ <+~ l₂ → countP p l₁ ≤ countP p l₂\n | ⟨_l, p', s⟩ => p'.countP_eq p ▸ s.countP_le\n\ntheorem Subperm.count_le [BEq α] {l₁ l₂ : List α} (s : l₁ <+~ l₂) (a) :\n count a l₁ ≤ count a l₂ := s.countP_le _\n\ntheorem subperm_cons (a : α) {l₁ l₂ : List α} : a :: l₁ <+~ a :: l₂ ↔ l₁ <+~ l₂ := by\n refine ⟨fun ⟨l, p, s⟩ => ?_, fun ⟨l, p, s⟩ => ⟨a :: l, p.cons a, s.cons_cons _⟩⟩\n match s with\n | .cons _ s' => exact (p.subperm_left.2 <| (sublist_cons_self _ _).subperm).trans s'.subperm\n | .cons_cons _ s' => exact ⟨_, p.cons_inv, s'⟩\n\n/-- Weaker version of `Subperm.cons_left` -/\ntheorem cons_subperm_of_not_mem_of_mem {a : α} {l₁ l₂ : List α} (h₁ : a ∉ l₁) (h₂ : a ∈ l₂)\n (s : l₁ <+~ l₂) : a :: l₁ <+~ l₂ := by\n obtain ⟨l, p, s⟩ := s\n induction s generalizing l₁ with\n | slnil => cases h₂\n | @cons r₁ _ b s' ih =>\n simp at h₂\n match h₂ with\n | .inl e => subst_vars; exact ⟨_ :: r₁, p.cons _, s'.cons_cons _⟩\n | .inr m => let ⟨t, p', s'⟩ := ih h₁ m p; exact ⟨t, p', s'.cons _⟩\n | @cons_cons _ r₂ b _ ih =>\n have bm : b ∈ l₁ := p.subset mem_cons_self\n have am : a ∈ r₂ := by\n simp only [mem_cons] at h₂\n exact h₂.resolve_left fun e => h₁ <| e.symm ▸ bm\n obtain ⟨t₁, t₂, rfl⟩ := append_of_mem bm\n have st : t₁ ++ t₂ <+ t₁ ++ b :: t₂ := by simp\n obtain ⟨t, p', s'⟩ := ih (mt (st.subset ·) h₁) am (.cons_inv <| p.trans perm_middle)\n exact ⟨b :: t, (p'.cons b).trans <| (swap ..).trans (perm_middle.symm.cons a), s'.cons_cons _⟩\n\ntheorem subperm_append_left {l₁ l₂ : List α} : ∀ l, l ++ l₁ <+~ l ++ l₂ ↔ l₁ <+~ l₂\n | [] => .rfl\n | a :: l => (subperm_cons a).trans (subperm_append_left l)\n\ntheorem subperm_append_right {l₁ l₂ : List α} (l) : l₁ ++ l <+~ l₂ ++ l ↔ l₁ <+~ l₂ :=\n (perm_append_comm.subperm_left.trans perm_append_comm.subperm_right).trans (subperm_append_left l)\n\ntheorem Subperm.exists_of_length_lt {l₁ l₂ : List α} (s : l₁ <+~ l₂) (h : length l₁ < length l₂) :\n ∃ a, a :: l₁ <+~ l₂ := by\n obtain ⟨l, p, s⟩ := s\n suffices length l < length l₂ → ∃ a : α, a :: l <+~ l₂ from\n (this <| p.symm.length_eq ▸ h).imp fun a => (p.cons a).subperm_right.1\n clear h p l₁\n induction s with intro h\n | slnil => cases h\n | cons a s IH =>\n match Nat.lt_or_eq_of_le (Nat.le_of_lt_succ h) with\n | .inl h => exact (IH h).imp fun a s => s.trans (sublist_cons_self _ _).subperm\n | .inr h => exact ⟨a, s.eq_of_length h ▸ .refl _⟩\n | cons_cons b _ IH =>\n exact (IH <| Nat.lt_of_succ_lt_succ h).imp fun a s =>\n (swap ..).subperm_right.1 <| (subperm_cons _).2 s\n\ntheorem subperm_of_subset (d : Nodup l₁) (H : l₁ ⊆ l₂) : l₁ <+~ l₂ := by\n induction d with\n | nil => exact ⟨nil, .nil, nil_sublist _⟩\n | cons h _ IH =>\n have ⟨H₁, H₂⟩ := forall_mem_cons.1 H\n exact cons_subperm_of_not_mem_of_mem (h _ · rfl) H₁ (IH H₂)\n\ntheorem perm_ext_iff_of_nodup {l₁ l₂ : List α} (d₁ : Nodup l₁) (d₂ : Nodup l₂) :\n l₁ ~ l₂ ↔ ∀ a, a ∈ l₁ ↔ a ∈ l₂ := by\n refine ⟨fun p _ => p.mem_iff, fun H => ?_⟩\n exact (subperm_of_subset d₁ fun a => (H a).1).antisymm <| subperm_of_subset d₂ fun a => (H a).2\n\ntheorem Nodup.perm_iff_eq_of_sublist {l₁ l₂ l : List α} (d : Nodup l)\n (s₁ : l₁ <+ l) (s₂ : l₂ <+ l) : l₁ ~ l₂ ↔ l₁ = l₂ := by\n refine ⟨fun h => ?_, fun h => by rw [h]⟩\n induction s₂ generalizing l₁ with simp [Nodup, List.forall_mem_ne] at d\n | slnil => exact h.eq_nil\n | cons a s₂ IH =>\n match s₁ with\n | .cons _ s₁ => exact IH d.2 s₁ h\n | .cons_cons _ s₁ =>\n have := Subperm.subset ⟨_, h.symm, s₂⟩ (.head _)\n exact (d.1 this).elim\n | cons_cons a _ IH =>\n match s₁ with\n | .cons _ s₁ =>\n have := Subperm.subset ⟨_, h, s₁⟩ (.head _)\n exact (d.1 this).elim\n | .cons_cons _ s₁ => rw [IH d.2 s₁ h.cons_inv]\n\ntheorem subperm_cons_erase [BEq α] [LawfulBEq α] (a : α) (l : List α) : l <+~ a :: l.erase a :=\n if h : a ∈ l then\n (perm_cons_erase h).subperm\n else\n (erase_of_not_mem h).symm ▸ (sublist_cons_self _ _).subperm\n\ntheorem erase_subperm [BEq α] (a : α) (l : List α) : l.erase a <+~ l := erase_sublist.subperm\n\ntheorem Subperm.erase [BEq α] [LawfulBEq α] (a : α) (h : l₁ <+~ l₂) : l₁.erase a <+~ l₂.erase a :=\n let ⟨l, hp, hs⟩ := h\n ⟨l.erase a, hp.erase _, hs.erase _⟩\n\ntheorem Perm.diff_right [BEq α] [LawfulBEq α] (t : List α) (h : l₁ ~ l₂) :\n l₁.diff t ~ l₂.diff t := by\n induction t generalizing l₁ l₂ h with simp only [List.diff]\n | nil => exact h\n | cons x t ih =>\n simp only [elem_eq_mem, decide_eq_true_eq, Perm.mem_iff h]\n split\n · exact ih (h.erase _)\n · exact ih h\n\ntheorem Perm.diff_left [BEq α] [LawfulBEq α] (l : List α) (h : t₁ ~ t₂) :\n l.diff t₁ = l.diff t₂ := by\n induction h generalizing l with try simp [List.diff]\n | cons x _ ih => apply ite_congr rfl <;> (intro; apply ih)\n | swap x y =>\n if h : x = y then\n simp [h]\n else\n simp [mem_erase_of_ne h, mem_erase_of_ne (Ne.symm h), erase_comm x y]\n split <;> simp\n | trans => simp only [*]\n\ntheorem Perm.diff [BEq α] [LawfulBEq α] {l₁ l₂ t₁ t₂ : List α} (hl : l₁ ~ l₂) (ht : t₁ ~ t₂) :\n l₁.diff t₁ ~ l₂.diff t₂ :=\n ht.diff_left l₂ ▸ hl.diff_right _\n\ntheorem Subperm.diff_right [BEq α] [LawfulBEq α] (h : l₁ <+~ l₂) (t : List α) :\n l₁.diff t <+~ l₂.diff t := by\n induction t generalizing l₁ l₂ h with simp [List.diff, *]\n | cons x t ih =>\n split <;> rename_i hx1\n · simp [h.subset hx1]\n exact ih (h.erase _)\n · split\n · rw [← erase_of_not_mem hx1]\n exact ih (h.erase _)\n · exact ih h\n\ntheorem erase_cons_subperm_cons_erase [BEq α] [LawfulBEq α] (a b : α) (l : List α) :\n (a :: l).erase b <+~ a :: l.erase b := by\n if h : a = b then\n rw [h, erase_cons_head]; apply subperm_cons_erase\n else\n have : ¬(a == b) = true := by simp only [beq_false_of_ne h, not_false_eq_true, reduceCtorEq]\n rw [erase_cons_tail this]\n\ntheorem subperm_cons_diff [BEq α] [LawfulBEq α] {a : α} {l₁ l₂ : List α} :\n (a :: l₁).diff l₂ <+~ a :: l₁.diff l₂ := by\n induction l₂ with\n | nil => exact ⟨a :: l₁, by simp [List.diff]⟩\n | cons b l₂ ih =>\n rw [diff_cons, diff_cons, ← diff_erase, ← diff_erase]\n exact Subperm.trans (.erase _ ih) (erase_cons_subperm_cons_erase ..)\n\ntheorem subset_cons_diff [BEq α] [LawfulBEq α] {a : α} {l₁ l₂ : List α} :\n (a :: l₁).diff l₂ ⊆ a :: l₁.diff l₂ :=\n subperm_cons_diff.subset\n\n/-- The list version of `add_tsub_cancel_of_le` for multisets. -/\ntheorem subperm_append_diff_self_of_count_le [BEq α] [LawfulBEq α] {l₁ l₂ : List α}\n (h : ∀ x ∈ l₁, count x l₁ ≤ count x l₂) : l₁ ++ l₂.diff l₁ ~ l₂ := by\n induction l₁ generalizing l₂ with\n | nil => simp\n | cons hd tl IH =>\n have : hd ∈ l₂ := by\n rw [← count_pos_iff]\n exact Nat.lt_of_lt_of_le (count_pos_iff.mpr (.head _)) (h hd (.head _))\n have := perm_cons_erase this\n refine Perm.trans ?_ this.symm\n rw [cons_append, diff_cons, perm_cons]\n refine IH fun x hx => ?_\n specialize h x (.tail _ hx)\n rw [perm_iff_count.mp this] at h\n if hx : hd = x then subst hd; simpa [Nat.succ_le_succ_iff] using h\n else simpa [hx] using h\n\n/-- The list version of `Multiset.le_iff_count`. -/\ntheorem subperm_ext_iff [BEq α] [LawfulBEq α] {l₁ l₂ : List α} :\n l₁ <+~ l₂ ↔ ∀ x ∈ l₁, count x l₁ ≤ count x l₂ := by\n refine ⟨fun h x _ => h.count_le x, fun h => ?_⟩\n have : l₁ <+~ l₂.diff l₁ ++ l₁ := (subperm_append_right l₁).mpr nil_subperm\n refine this.trans (Perm.subperm ?_)\n exact perm_append_comm.trans (subperm_append_diff_self_of_count_le h)\n\ntheorem isSubperm_iff [BEq α] [LawfulBEq α] {l₁ l₂ : List α} : l₁.isSubperm l₂ ↔ l₁ <+~ l₂ := by\n simp [isSubperm, subperm_ext_iff]\n\ninstance decidableSubperm [BEq α] [LawfulBEq α] :\n DecidableRel ((· <+~ ·) : List α → List α → Prop) := fun _ _ =>\n decidable_of_iff _ isSubperm_iff\n\ntheorem Subperm.cons_left [BEq α] [LawfulBEq α] (h : l₁ <+~ l₂) (x : α)\n (hx : count x l₁ < count x l₂) : x :: l₁ <+~ l₂ := by\n rw [subperm_ext_iff] at h ⊢\n intro y hy\n if hy' : y = x then\n subst x; simpa using Nat.succ_le_of_lt hx\n else\n rw [count_cons_of_ne (Ne.symm hy')]\n refine h y ?_\n simpa [hy'] using hy\n\ntheorem Perm.union_right [BEq α] [LawfulBEq α] (t₁ : List α) (h : l₁ ~ l₂) :\n l₁ ∪ t₁ ~ l₂ ∪ t₁ := by\n induction h with\n | nil => rfl\n | cons a _ ih => exact ih.insert a\n | swap => apply perm_insert_swap\n | trans _ _ ih_1 ih_2 => exact ih_1.trans ih_2\n\ntheorem Perm.union_left [BEq α] [LawfulBEq α] (l : List α) (h : t₁ ~ t₂) : l ∪ t₁ ~ l ∪ t₂ := by\n induction l with\n | nil => simp only [nil_union, h]\n | cons _ _ ih => simp only [cons_union, Perm.insert _ ih]\n\ntheorem Perm.union [BEq α] [LawfulBEq α] {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) :\n l₁ ∪ t₁ ~ l₂ ∪ t₂ :=\n (p₁.union_right t₁).trans (p₂.union_left l₂)\n\ntheorem Perm.inter_right [BEq α] (t₁ : List α) : l₁ ~ l₂ → l₁ ∩ t₁ ~ l₂ ∩ t₁ := .filter _\n\ntheorem Perm.inter_left [BEq α] [LawfulBEq α] (l : List α) (p : t₁ ~ t₂) : l ∩ t₁ = l ∩ t₂ :=\n filter_congr fun a _ => by simpa using p.mem_iff (a := a)\n\ntheorem Perm.inter [BEq α] [LawfulBEq α] {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) :\n l₁ ∩ t₁ ~ l₂ ∩ t₂ :=\n p₂.inter_left l₂ ▸ p₁.inter_right t₁\n\ntheorem Perm.flatten_congr :\n ∀ {l₁ l₂ : List (List α)} (_ : List.Forall₂ (· ~ ·) l₁ l₂), l₁.flatten ~ l₂.flatten\n | _, _, .nil => .rfl\n | _ :: _, _ :: _, .cons h₁ h₂ => h₁.append (Perm.flatten_congr h₂)\n\ntheorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by\n induction l with simp [insertP, insertP.loop, cond]\n | cons _ _ ih =>\n split\n · exact Perm.refl ..\n · rw [insertP_loop, reverseAux, reverseAux]\n exact Perm.trans (Perm.cons _ ih) (Perm.swap ..)\n\ntheorem Perm.insertP (p : α → Bool) (a) (h : l₁ ~ l₂) : insertP p a l₁ ~ insertP p a l₂ :=\n Perm.trans (perm_insertP ..) <| Perm.trans (Perm.cons _ h) <| Perm.symm (perm_insertP ..)\n\n/-! ### idxInj -/\n\n/-- `Subperm.idxInj` is an injective map from `Fin xs.length` to `Fin ys.length`\nwhich exists when we have `xs <+~ ys`: conceptually it represents an embedding of\none list into the other. For example:\n```\n(by decide : [1, 0, 1] <+~ [5, 0, 1, 3, 1]).idxInj 1 = 1\n```\n-/\ndef Subperm.idxInj [BEq α] [ReflBEq α] {xs ys : List α} (h : xs <+~ ys) (i : Fin xs.length) :\n Fin ys.length :=\n ⟨ys.idxOfNth xs[i.1] (xs.countBefore xs[i] i), idxOfNth_lt_length_of_lt_count <|\n Nat.lt_of_lt_of_le countBefore_lt_count_getElem <| h.count_le _⟩\n\n@[simp, grind =]\ntheorem coe_idxInj [BEq α] [ReflBEq α] {xs ys : List α} {h : xs <+~ ys}\n {i : Fin xs.length} :\n (h.idxInj i : Nat) = ys.idxOfNth xs[i] (xs.countBefore xs[i] i) := rfl\n\ntheorem Subperm.getElem_idxInj_eq_getElem [BEq α] [LawfulBEq α] {xs ys : List α}\n (h : xs <+~ ys) {i : Fin xs.length} :\n ys[(h.idxInj i : Nat)] = xs[(i : Nat)] := getElem_idxOfNth_eq\n\ntheorem Subperm.idxInj_injective [BEq α] [LawfulBEq α] {xs ys : List α}\n (h : xs <+~ ys) : h.idxInj.Injective := fun _ _ hij => by\n have H := congrArg (fun i : Fin ys.length => xs.idxOfNth ys[i] (ys.countBefore ys[i] i)) hij\n grind\n\n@[simp]\ntheorem Subperm.idxInj_inj [BEq α] [LawfulBEq α] {xs ys : List α}\n {h : xs <+~ ys} (i j : Fin xs.length) :\n h.idxInj i = h.idxInj j ↔ i = j := h.idxInj_injective.eq_iff\n\n/-! ### idxBij -/\n\n/-- `Perm.idxBij` is a bijective map from `Fin xs.length` to `Fin ys.length`\nwhich exists when we have `xs.Perm ys`: conceptually it represents a permuting of\none list into the other. For example:\n```\n(by decide : [0, 1, 1, 3, 5] ~ [5, 0, 1, 3, 1]).idxBij 2 = 4\n```\n-/\ndef Perm.idxBij [BEq α] [ReflBEq α] {xs ys : List α} (h : xs ~ ys) :\n Fin xs.length → Fin ys.length := h.subperm.idxInj\n\n@[simp, grind =]\ntheorem Perm.subperm_idxBij [BEq α] [ReflBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.subperm.idxInj = h.idxBij := rfl\n\n@[simp, grind =]\ntheorem Perm.coe_idxBij [BEq α] [ReflBEq α] {xs ys : List α} (h : xs ~ ys)\n {i : Fin xs.length} : (h.idxBij i : Nat) = ys.idxOfNth xs[i] (xs.countBefore xs[i] i) := rfl\n\ntheorem Perm.getElem_idxBij_eq_getElem [BEq α] [LawfulBEq α] {xs ys : List α}\n (hxy : xs.Perm ys) (i : Fin xs.length) : ys[(hxy.idxBij i : Nat)] = xs[(i : Nat)] :=\n getElem_idxOfNth_eq\n\ntheorem Perm.getElem_idxBij_symm_eq_getElem [BEq α] [LawfulBEq α] {xs ys : List α}\n (hxy : xs.Perm ys) (i : Fin ys.length) : xs[(hxy.symm.idxBij i : Nat)] = ys[(i : Nat)] :=\n getElem_idxOfNth_eq\n\ntheorem Perm.idxBij_leftInverse_idxBij_symm [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.idxBij.LeftInverse h.symm.idxBij := by grind\n\ntheorem Perm.idxBij_rightInverse_idxBij_symm [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.idxBij.RightInverse h.symm.idxBij := by grind\n\ntheorem Perm.idxBij_symm_rightInverse_idxBij [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.symm.idxBij.RightInverse h.idxBij := h.idxBij_leftInverse_idxBij_symm\n\ntheorem Perm.idxBij_symm_leftInverse_idxBij [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.symm.idxBij.LeftInverse h.idxBij := h.idxBij_rightInverse_idxBij_symm\n\ntheorem Perm.idxBij_idxBij_symm [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys)\n {i : Fin ys.length} : h.idxBij (h.symm.idxBij i) = i := h.idxBij_leftInverse_idxBij_symm _\n\ntheorem Perm.idxBij_symm_idxBij [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys)\n {i : Fin xs.length} : h.symm.idxBij (h.idxBij i) = i := h.idxBij_rightInverse_idxBij_symm _\n\ntheorem Perm.idxBij_injective [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.idxBij.Injective := h.idxBij_rightInverse_idxBij_symm.injective\n\ntheorem Perm.idxBij_surjective [BEq α] [LawfulBEq α] {xs ys : List α} (h : xs ~ ys) :\n h.idxBij.Surjective := h.idxBij_symm_rightInverse_idxBij.surjective\n" }, { "path": "Batteries/Data/List/Scan.lean", "content": "/-\nCopyright (c) 2014 Parikshit Khanna. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.List.Basic\npublic import Batteries.Data.List.Lemmas\nimport Batteries.Util.ProofWanted\nmeta import Batteries.Tactic.Init\n\n@[expose] public section\n\n/-!\n# List scan\n\nProve basic results about `List.scanl`, `List.scanr`, `List.scanlM` and `List.scanrM`.\n-/\n\nnamespace List\n\n/-! ### partialSums/partialProd -/\n\n@[simp, grind =]\ntheorem length_partialSums [Add α] [Zero α] {l : List α} :\n l.partialSums.length = l.length + 1 := by\n simp [partialSums]\n\n@[simp]\ntheorem partialSums_ne_nil [Add α] [Zero α] {l : List α} :\n l.partialSums ≠ [] := by simp [ne_nil_iff_length_pos]\n\n@[simp, grind =]\ntheorem partialSums_nil [Add α] [Zero α] : ([] : List α).partialSums = [0] := by\n simp [partialSums]\n\ntheorem partialSums_cons [Add α] [Zero α] [Std.Associative (α := α) (· + ·)]\n [Std.LawfulIdentity (α := α) (· + ·) 0] {l : List α} :\n (a :: l).partialSums = 0 :: l.partialSums.map (a + ·) := by\n simp only [partialSums, scanl_cons, Std.LawfulLeftIdentity.left_id, cons.injEq]\n induction l generalizing a with\n | nil =>\n simp only [Std.LawfulRightIdentity.right_id, scanl_nil, map_cons, map_nil]\n | cons b l ih =>\n simp [Std.LawfulLeftIdentity.left_id, Std.LawfulRightIdentity.right_id]\n rw [ih (a := b), ih (a := a + b), map_map]\n congr; funext; simp [Std.Associative.assoc]\n\ntheorem partialSums_append [Add α] [Zero α] [Std.Associative (α := α) (· + ·)]\n [Std.LawfulIdentity (α := α) (· + ·) 0] {l₁ l₂ : List α} :\n (l₁ ++ l₂).partialSums = l₁.partialSums ++ l₂.partialSums.tail.map (l₁.sum + · ) := by\n induction l₁ generalizing l₂ with\n | nil => cases l₂ <;> simp [partialSums, Std.LawfulLeftIdentity.left_id]\n | cons _ _ ih =>\n simp only [cons_append, partialSums_cons, ih, map_tail, map_append, map_map, sum_cons,\n cons.injEq, append_cancel_left_eq, true_and]\n congr 2; funext; simp [Std.Associative.assoc]\n\n@[simp, grind =]\ntheorem getElem_partialSums [Add α] [Zero α] [Std.Associative (α := α) (· + ·)]\n [Std.LawfulIdentity (α := α) (· + ·) 0] {l : List α} (h : i < l.partialSums.length) :\n l.partialSums[i] = (l.take i).sum := by\n simp [partialSums, sum_eq_foldl]\n\n@[simp, grind =]\ntheorem getElem?_partialSums [Add α] [Zero α] [Std.Associative (α := α) (· + ·)]\n [Std.LawfulIdentity (α := α) (· + ·) 0] {l : List α} :\n l.partialSums[i]? = if i ≤ l.length then some (l.take i).sum else none := by\n split <;> grind\n\n@[simp, grind =]\ntheorem take_partialSums [Add α] [Zero α] {l : List α} :\n l.partialSums.take (i+1) = (l.take i).partialSums := by\n simp [partialSums, take_scanl]\n\n@[simp, grind =]\ntheorem length_partialProds [Mul α] [One α] {l : List α} :\n l.partialProds.length = l.length + 1 := by\n simp [partialProds]\n\n@[simp, grind =]\ntheorem partialProds_nil [Mul α] [One α]\n : ([] : List α).partialProds = [1]\n := by simp [partialProds]\n\ntheorem partialProds_cons [Mul α] [One α] [Std.Associative (α := α) (· * ·)]\n [Std.LawfulIdentity (α := α) (· * ·) 1] {l : List α} :\n (a :: l).partialProds = 1 :: l.partialProds.map (a * ·) := by\n simp only [partialProds, scanl_cons, Std.LawfulLeftIdentity.left_id, cons.injEq]\n induction l generalizing a with\n | nil =>\n simp only [Std.LawfulRightIdentity.right_id, scanl_nil, map_cons, map_nil]\n | cons b l ih =>\n simp [Std.LawfulLeftIdentity.left_id, Std.LawfulRightIdentity.right_id]\n rw [ih (a := b), ih (a := a * b), map_map]\n congr; funext; simp [Std.Associative.assoc]\n\ntheorem partialProds_append [Mul α] [One α] [Std.Associative (α := α) (· * ·)]\n [Std.LawfulIdentity (α := α) (· * ·) 1] {l₁ l₂ : List α} :\n (l₁ ++ l₂).partialProds = l₁.partialProds ++ l₂.partialProds.tail.map (l₁.prod * · ) := by\n induction l₁ generalizing l₂ with\n | nil => cases l₂ <;> simp [partialProds, Std.LawfulLeftIdentity.left_id]\n | cons _ _ ih =>\n simp only [cons_append, partialProds_cons, ih, map_tail, map_append, map_map, prod_cons,\n cons.injEq, append_cancel_left_eq, true_and]\n congr 2; funext; simp [Std.Associative.assoc]\n\n@[simp, grind =]\ntheorem getElem_partialProds [Mul α] [One α] [Std.Associative (α := α) (· * ·)]\n [Std.LawfulIdentity (α := α) (· * ·) 1] {l : List α} (h : i < l.partialProds.length) :\n l.partialProds[i] = (l.take i).prod := by\n simp [partialProds, prod_eq_foldl]\n\n@[simp, grind =]\ntheorem getElem?_partialProds [Mul α] [One α] [Std.Associative (α := α) (· * ·)]\n [Std.LawfulIdentity (α := α) (· * ·) 1] {l : List α} :\n l.partialProds[i]? = if i ≤ l.length then some (l.take i).prod else none := by\n split <;> grind\n\n@[simp, grind =]\ntheorem take_partialProds [Mul α] [One α] {l : List α} :\n l.partialProds.take (i+1) = (l.take i).partialProds := by\n simp [partialProds, take_scanl]\n\n/-! ### flatten -/\n\ntheorem length_flatten_mem_partialSums_map_length (L : List (List α)) :\n L.flatten.length ∈ (L.map length).partialSums := by\n induction L with\n | nil => simp\n | cons l L ih =>\n simp [flatten_cons, partialSums_cons]\n right\n simpa using ih\n\ntheorem getElem_flatten_aux₁ (L : List (List α)) (i : Nat) (h : i < L.flatten.length) :\n (L.map length).partialSums.findIdx (· > i) - 1 < L.length := by\n have := findIdx_lt_length_of_exists\n (xs := (L.map length).partialSums) (p := fun x => decide (x > i))\n specialize this ⟨L.flatten.length,\n length_flatten_mem_partialSums_map_length L, by grind⟩\n simp at this\n simp\n have : 0 < findIdx (fun x => decide (i < x)) (map length L).partialSums := by\n by_contra w\n simp at w\n omega\n\ntheorem getElem_flatten_aux₂ (L : List (List α)) (i : Nat) (h : i < L.flatten.length) :\n let j := (L.map length).partialSums.findIdx (· > i) - 1\n have hj : j < L.length := getElem_flatten_aux₁ L i h\n let k := i - (L.take j).flatten.length\n k < L[j].length := by\n induction L generalizing i with\n | nil => simp at h\n | cons l L ih =>\n simp only [map_cons, partialSums_cons, findIdx_cons, Nat.not_lt_zero, decide_false,\n findIdx_map, Function.comp_def, cond_false, Nat.add_one_sub_one, length_flatten, map_take,\n getElem_cons]\n split <;> rename_i h'\n · simp only [h', take_zero, sum_nil, Nat.sub_zero]\n rw [findIdx_eq (by simp)] at h'\n simp_all\n · have : l.length ≤ i := by\n rw [findIdx_eq (by simp)] at h'\n simp_all\n rw [take_cons (by grind)]\n specialize ih (i - l.length) (by grind)\n have p : ∀ x, i - l.length < x ↔ i < l.length + x := by grind\n simp only [p, length_flatten, map_take] at ih\n grind\n\n/--\nIndexing into a flattened list: `L.flatten[i]` equals `L[j][k]` where\n`j` is the sublist index and `k` is the offset within that sublist.\n\nThe indices are computed as:\n- `j` is one less than where the cumulative sum first exceeds `i`\n- `k` is `i` minus the total length of the first `j` sublists\n\nThis theorem states that these indices are in range and the equality holds.\n-/\ntheorem getElem_flatten (L : List (List α)) (i : Nat) (h : i < L.flatten.length) :\n L.flatten[i] =\n let j := (L.map length).partialSums.findIdx (· > i) - 1\n have hj : j < L.length := getElem_flatten_aux₁ L i h\n let k := i - (L.take j).flatten.length\n have hk : k < L[j].length := getElem_flatten_aux₂ L i h\n L[j][k] := by\n induction L generalizing i with\n | nil => simp at h\n | cons l L ih =>\n simp only [flatten_cons, getElem_append]\n split <;> rename_i h'\n · have : findIdx (fun x => decide (x > i)) (map length (l :: L)).partialSums = 1 := by\n simp [partialSums_cons, findIdx_cons]\n rw [findIdx_eq] <;> grind\n simp only [this]\n simp\n · rw [ih]\n have : findIdx (fun x => decide (x > i)) (map length (l :: L)).partialSums =\n findIdx (fun x => decide (x > i - l.length)) (map length L).partialSums + 1 := by\n simp [partialSums_cons, findIdx_cons, Function.comp_def]\n congr\n funext x\n grind\n simp only [this]\n simp only [getElem_cons]\n split <;> rename_i h''\n · simp [findIdx_eq] at h''\n · congr 1\n rw [take_cons]\n · simp\n omega\n · simp\n\n/--\nTaking the first `i` elements of a flattened list\ncan be expressed as the flattening of the first `j` complete sublists, plus the first\n`k` elements of the `j`-th sublist.\n\nThe indices are computed as:\n- `j` is one less than where the cumulative sum first exceeds `i`\n- `k` is `i` minus the total length of the first `j` sublists\n-/\nproof_wanted take_flatten (L : List (List α)) (i : Nat) :\n let j := (L.map length).partialSums.findIdx (· > i) - 1\n let k := i - (L.take j).flatten.length\n L.flatten.take i = (L.take j).flatten ++ (L[j]?.getD []).take k\n" }, { "path": "Batteries/Data/List.lean", "content": "module\n\npublic import Batteries.Data.List.ArrayMap\npublic import Batteries.Data.List.Basic\npublic import Batteries.Data.List.Count\npublic import Batteries.Data.List.Init.Lemmas\npublic import Batteries.Data.List.Lemmas\npublic import Batteries.Data.List.Matcher\npublic import Batteries.Data.List.Monadic\npublic import Batteries.Data.List.Pairwise\npublic import Batteries.Data.List.Perm\npublic import Batteries.Data.List.Scan\n" }, { "path": "Batteries/Data/MLList/Basic.lean", "content": "/-\nCopyright (c) 2018 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Keeley Hoek, Simon Hudon, Kim Morrison\n-/\nmodule\n\npublic import Batteries.Control.AlternativeMonad\n\npublic section\n\n/-! # Monadic lazy lists.\n\nLazy lists with \"laziness\" controlled by an arbitrary monad.\n-/\n\n\n/-!\nIn an initial section we describe the specification of `MLList`,\nand provide a private unsafe implementation,\nand then a public `opaque` wrapper of this implementation, satisfying the specification.\n-/\nnamespace MLList\n\nprivate structure Spec (m : Type u → Type u) where\n listM : Type u → Type u\n nil : listM α\n cons : α → listM α → listM α\n thunk : (Unit → listM α) → listM α\n squash : (Unit → m (listM α)) → listM α\n uncons : [Monad m] → listM α → m (Option (α × listM α))\n uncons? : listM α → Option (Option (α × listM α))\n\nprivate instance : Nonempty (Spec m) := .intro\n { listM := fun _ => PUnit\n nil := ⟨⟩\n cons := fun _ _ => ⟨⟩\n thunk := fun _ => ⟨⟩\n squash := fun _ => ⟨⟩\n uncons := fun _ => pure none\n uncons? := fun _ => none }\n\nprivate unsafe inductive MLListImpl (m : Type u → Type u) (α : Type u) : Type u\n | nil : MLListImpl m α\n | cons : α → MLListImpl m α → MLListImpl m α\n | thunk : Thunk (MLListImpl m α) → MLListImpl m α\n | squash : (Unit → m (MLListImpl m α)) → MLListImpl m α\n\nprivate unsafe def unconsImpl {m : Type u → Type u} [Monad m] :\n MLListImpl m α → m (Option (α × MLListImpl m α))\n | .nil => pure none\n | .thunk t => unconsImpl t.get\n | .squash t => t () >>= unconsImpl\n | .cons x xs => return (x, xs)\n\nprivate unsafe def uncons?Impl : MLListImpl m α → Option (Option (α × MLListImpl m α))\n | .nil => pure none\n | .cons x xs => pure (x, xs)\n | _ => none\n\n@[inline] private unsafe def specImpl (m) : Spec m where\n listM := MLListImpl m\n nil := .nil\n cons := .cons\n thunk f := .thunk (.mk f)\n squash := .squash\n uncons := unconsImpl\n uncons? := uncons?Impl\n\n@[implemented_by specImpl]\nprivate opaque spec (m) : MLList.Spec m\n\nend MLList\n\n/-- A monadic lazy list, controlled by an arbitrary monad. -/\ndef MLList (m : Type u → Type u) (α : Type u) : Type u := (MLList.spec m).listM α\n\nnamespace MLList\n\n/-- The empty `MLList`. -/\n@[inline] def nil : MLList m α := (MLList.spec m).nil\n\n/--\nConstructs a `MLList` from head and tail.\n-/\n@[inline] def cons : α → MLList m α → MLList m α := (MLList.spec m).cons\n\n/-- Embed a non-monadic thunk as a lazy list. -/\n@[inline] def thunk : (Unit → MLList m α) → MLList m α := (MLList.spec m).thunk\n\n/-- Lift a monadic lazy list inside the monad to a monadic lazy list. -/\ndef squash : (Unit → m (MLList m α)) → MLList m α := (MLList.spec m).squash\n\n/-- Deconstruct a `MLList`, returning inside the monad an optional pair `α × MLList m α`\nrepresenting the head and tail of the list. -/\n@[inline] def uncons [Monad m] : MLList.{u} m α → m (Option (α × MLList m α)) :=\n (MLList.spec m).uncons\n\n/-- Try to deconstruct a `MLList`, returning an optional pair `α × MLList m α`\nrepresenting the head and tail of the list if it is already evaluated, and `none` otherwise. -/\n@[inline] def uncons? : MLList.{u} m α → Option (Option (α × MLList m α)) :=\n (MLList.spec m).uncons?\n\ninstance : EmptyCollection (MLList m α) := ⟨nil⟩\ninstance : Inhabited (MLList m α) := ⟨nil⟩\n\nprivate local instance [Monad n] : Inhabited (δ → (α → δ → n (ForInStep δ)) → n δ) where\n default d _ := pure d in\n/-- The implementation of `ForIn`, which enables `for a in L do ...` notation. -/\n@[specialize] protected partial def forIn [Monad m] [Monad n] [MonadLiftT m n]\n (as : MLList m α) (init : δ) (f : α → δ → n (ForInStep δ)) : n δ := do\n match ← as.uncons with\n | none => pure init\n | some (a, t) => match (← f a init) with\n | ForInStep.done d => pure d\n | ForInStep.yield d => t.forIn d f\n\ninstance [Monad m] [Monad n] [MonadLiftT m n] : ForIn n (MLList m α) α where\n forIn := MLList.forIn\n\n/-- Construct a singleton monadic lazy list from a single monadic value. -/\ndef singletonM [Monad m] (x : m α) : MLList m α :=\n .squash fun _ => do return .cons (← x) .nil\n\n/-- Construct a singleton monadic lazy list from a single value. -/\ndef singleton [Monad m] (x : α) : MLList m α :=\n .singletonM (pure x)\n\n/-- Construct a `MLList` recursively. Failures from `f` will result in `uncons` failing. -/\npartial def fix [Monad m] (f : α → m α) (x : α) : MLList m α :=\n cons x <| squash fun _ => fix f <$> f x\n\n/--\nConstructs an `MLList` recursively, with state in `α`, recording terms from `β`.\nIf `f` returns `none` the list will terminate.\n\nVariant of `MLList.fix?` that allows returning values of a different type.\n-/\npartial def fix?' [Monad m] (f : α → m (Option (β × α))) (init : α) : MLList m β :=\n squash fun _ => do\n match ← f init with\n | none => pure .nil\n | some (b, a) => pure (.cons b (fix?' f a))\n\n/--\nConstructs an `MLList` recursively. If `f` returns `none` the list will terminate.\n\nReturns the initial value as the first element.\n-/\npartial def fix? [Monad m] (f : α → m (Option α)) (x : α) : MLList m α :=\n cons x <| squash fun _ => do\n match ← f x with\n | none => return nil\n | some x' => return fix? f x'\n\n/-- Construct a `MLList` by iteration. (`m` must be a stateful monad for this to be useful.) -/\npartial def iterate [Monad m] (f : m α) : MLList m α :=\n squash fun _ => return cons (← f) (iterate f)\n\n/-- Repeatedly apply a function `f : α → m (α × List β)` to an initial `a : α`,\naccumulating the elements of the resulting `List β` as a single monadic lazy list.\n\n(This variant allows starting with a specified `List β` of elements, as well. )-/\npartial def fixlWith [Monad m] {α β : Type u} (f : α → m (α × List β))\n (s : α) (l : List β) : MLList m β :=\n thunk fun _ =>\n match l with\n | b :: rest => cons b (fixlWith f s rest)\n | [] => squash fun _ => do\n let (s', l) ← f s\n match l with\n | b :: rest => pure <| cons b (fixlWith f s' rest)\n | [] => pure <| fixlWith f s' []\n\n/-- Repeatedly apply a function `f : α → m (α × List β)` to an initial `a : α`,\naccumulating the elements of the resulting `List β` as a single monadic lazy list. -/\ndef fixl [Monad m] {α β : Type u} (f : α → m (α × List β)) (s : α) : MLList m β :=\n fixlWith f s []\n\n/-- Compute, inside the monad, whether a `MLList` is empty. -/\ndef isEmpty [Monad m] (xs : MLList m α) : m (ULift Bool) :=\n (ULift.up ∘ Option.isNone) <$> uncons xs\n\n/-- Convert a `List` to a `MLList`. -/\ndef ofList : List α → MLList m α\n | [] => nil\n | h :: t => cons h (thunk fun _ => ofList t)\n\n/-- Convert a `List` of values inside the monad into a `MLList`. -/\ndef ofListM [Monad m] : List (m α) → MLList m α\n | [] => nil\n | h :: t => squash fun _ => return cons (← h) (ofListM t)\n\n/-- Extract a list inside the monad from a `MLList`. -/\npartial def force [Monad m] (L : MLList m α) : m (List α) := do\n match ← L.uncons with\n | none => pure []\n | some (x, xs) => return x :: (← xs.force)\n\n/-- Extract an array inside the monad from a `MLList`. -/\ndef asArray [Monad m] (L : MLList m α) : m (Array α) := do\n let mut r := #[]\n for a in L do\n r := r.push a\n return r\n\n/-- Performs a monadic case distinction on a `MLList` when the motive is a `MLList` as well. -/\n@[specialize]\ndef casesM [Monad m] (xs : MLList m α)\n (hnil : Unit → m (MLList m β)) (hcons : α → MLList m α → m (MLList m β)) : MLList m β :=\n squash fun _ => do\n match ← xs.uncons with\n | none => hnil ()\n | some (x, xs) => hcons x xs\n\n/--\nPerforms a case distinction on a `MLList` when the motive is a `MLList` as well.\n(We need to be in a monadic context to distinguish a nil from a cons.)\n-/\n@[specialize]\ndef cases [Monad m] (xs : MLList m α)\n (hnil : Unit → MLList m β) (hcons : α → MLList m α → MLList m β) : MLList m β :=\n match xs.uncons? with\n | none => xs.casesM (fun _ => return hnil ()) (fun x xs => return hcons x xs)\n | some none => thunk hnil\n | some (some (x, xs)) => thunk fun _ => hcons x xs\n\n/-- Gives the monadic lazy list consisting all of folds of a function on a given initial element.\nThus `[a₀, a₁, ...].foldsM f b` will give `[b, ← f b a₀, ← f (← f b a₀) a₁, ...]`. -/\npartial def foldsM [Monad m] (f : β → α → m β) (init : β) (L : MLList m α) : MLList m β :=\n cons init <| squash fun _ => do\n match ← L.uncons with\n | none => return nil\n | some (x, xs) => return foldsM f (← f init x) xs\n\n/-- Gives the monadic lazy list consisting all of folds of a function on a given initial element.\nThus `[a₀, a₁, ...].foldsM f b` will give `[b, f b a₀, f (f b a₀) a₁, ...]`. -/\ndef folds [Monad m] (f : β → α → β) (init : β) (L : MLList m α) : MLList m β :=\n L.foldsM (fun b a => pure (f b a)) init\n\n/-- Take the first `n` elements, as a list inside the monad. -/\npartial def takeAsList [Monad m] (xs : MLList m α) (n : Nat) : m (List α) :=\n go n [] xs\nwhere\n /-- Implementation of `MLList.takeAsList`. -/\n go (r : Nat) (acc : List α) (xs : MLList m α) : m (List α) :=\n match r with\n | 0 => pure acc.reverse\n | r+1 => do match ← xs.uncons with\n | none => pure acc.reverse\n | some (x, xs) => go r (x :: acc) xs\n\n/-- Take the first `n` elements, as an array inside the monad. -/\npartial def takeAsArray [Monad m] (xs : MLList m α) (n : Nat) : m (Array α) :=\n go n #[] xs\nwhere\n /-- Implementation of `MLList.takeAsArray`. -/\n go (r : Nat) (acc : Array α) (xs : MLList m α) : m (Array α) :=\n match r with\n | 0 => pure acc\n | r+1 => do match ← xs.uncons with\n | none => pure acc\n | some (x, xs) => go r (acc.push x) xs\n\n/-- Take the first `n` elements. -/\npartial def take [Monad m] (xs : MLList m α) : Nat → MLList m α\n | 0 => nil\n | n+1 => xs.cases (fun _ => nil) fun h l => cons h (l.take n)\n\n/-- Drop the first `n` elements. -/\ndef drop [Monad m] (xs : MLList m α) : Nat → MLList m α\n | 0 => xs\n | n+1 => xs.cases (fun _ => nil) fun _ l => l.drop n\n\n/-- Apply a function which returns values in the monad to every element of a `MLList`. -/\npartial def mapM [Monad m] (f : α → m β) (xs : MLList m α) : MLList m β :=\n xs.cases (fun _ => nil) fun x xs => squash fun _ => return cons (← f x) (xs.mapM f)\n\n/-- Apply a function to every element of a `MLList`. -/\ndef map [Monad m] (f : α → β) (L : MLList m α) : MLList m β :=\n L.mapM fun a => pure (f a)\n\n/-- Filter a `MLList` using a monadic function. -/\npartial def filterM [Monad m] (p : α → m (ULift Bool)) (L : MLList m α) : MLList m α :=\n L.casesM (fun _ => pure nil) fun x xs =>\n return if (← p x).down then cons x (filterM p xs) else filterM p xs\n\n/-- Filter a `MLList`. -/\ndef filter [Monad m] (p : α → Bool) (L : MLList m α) : MLList m α :=\n L.filterM fun a => pure <| .up (p a)\n\n/-- Filter and transform a `MLList` using a function that returns values inside the monad. -/\n-- Note that the type signature has changed since Lean 3, when we allowed `f` to fail.\n-- Use `try?` from `Mathlib.Control.Basic` to lift a possibly failing function to `Option`.\npartial def filterMapM [Monad m] (f : α → m (Option β)) (xs : MLList m α) : MLList m β :=\n xs.casesM (fun _ => pure nil) fun x xs => do\n match ← f x with\n | none => return xs.filterMapM f\n | some a => return cons a (xs.filterMapM f)\n\n/-- Filter and transform a `MLList` using an `Option` valued function. -/\ndef filterMap [Monad m] (f : α → Option β) : MLList m α → MLList m β :=\n filterMapM fun a => do pure (f a)\n\n/-- Take the initial segment of the lazy list, until the function `f` first returns `false`. -/\npartial def takeWhileM [Monad m] (f : α → m (ULift Bool)) (L : MLList m α) : MLList m α :=\n L.casesM (fun _ => pure nil) fun x xs =>\n return if !(← f x).down then nil else cons x (xs.takeWhileM f)\n\n/-- Take the initial segment of the lazy list, until the function `f` first returns `false`. -/\ndef takeWhile [Monad m] (f : α → Bool) : MLList m α → MLList m α :=\n takeWhileM fun a => pure (.up (f a))\n\n/-- Concatenate two monadic lazy lists. -/\npartial def append [Monad m] (xs : MLList m α) (ys : Unit → MLList m α) : MLList m α :=\n xs.cases ys fun x xs => cons x (append xs ys)\n\n/-- Join a monadic lazy list of monadic lazy lists into a single monadic lazy list. -/\npartial def join [Monad m] (xs : MLList m (MLList m α)) : MLList m α :=\n xs.cases (fun _ => nil) fun x xs => append x (fun _ => join xs)\n\n/-- Enumerate the elements of a monadic lazy list, starting at a specified offset. -/\npartial def enumFrom [Monad m] (n : Nat) (xs : MLList m α) : MLList m (Nat × α) :=\n xs.cases (fun _ => nil) fun x xs => cons (n, x) (xs.enumFrom (n+1))\n\n/-- Enumerate the elements of a monadic lazy list. -/\ndef enum [Monad m] : MLList m α → MLList m (Nat × α) := enumFrom 0\n\n/-- The infinite monadic lazy list of natural numbers.-/\ndef range [Monad m] : MLList m Nat := MLList.fix (fun n => pure (n + 1)) 0\n\n/-- Iterate through the elements of `Fin n`. -/\npartial def fin (n : Nat) : MLList m (Fin n) := go 0 where\n /-- Implementation of `MLList.fin`. -/\n go (i : Nat) : MLList m (Fin n) :=\n if h : i < n then cons ⟨i, h⟩ (thunk fun _ => go (i+1)) else nil\n\n/-- Convert an array to a monadic lazy list. -/\npartial def ofArray {α : Type} (L : Array α) : MLList m α := go 0 where\n /-- Implementation of `MLList.ofArray`. -/\n go (i : Nat) : MLList m α :=\n if h : i < L.size then cons L[i] (thunk fun _ => go (i+1)) else nil\n\n/-- Group the elements of a lazy list into chunks of a given size.\nIf the lazy list is finite, the last chunk may be smaller (possibly even length 0). -/\npartial def chunk [Monad m] (L : MLList m α) (n : Nat) : MLList m (Array α) := go n #[] L where\n /-- Implementation of `MLList.chunk`. -/\n go (r : Nat) (acc : Array α) (M : MLList m α) : MLList m (Array α) :=\n match r with\n | 0 => cons acc (thunk fun _ => go n #[] M)\n | r+1 => squash fun _ => do\n match ← M.uncons with\n | none => return cons acc nil\n | some (a, M') => return go r (acc.push a) M'\n\n/-- Add one element to the end of a monadic lazy list. -/\ndef concat [Monad m] (L : MLList m α) (a : α) : MLList m α := L.append (fun _ => cons a nil)\n\n/-- Take the product of two monadic lazy lists. -/\npartial def zip [Monad m] (L : MLList m α) (M : MLList m β) : MLList.{u} m (α × β) :=\n L.cases (fun _ => nil) fun a L =>\n M.cases (fun _ => nil) fun b M =>\n cons (a, b) (L.zip M)\n\n/-- Apply a function returning a monadic lazy list to each element of a monadic lazy list,\njoining the results. -/\npartial def bind [Monad m] (xs : MLList m α) (f : α → MLList m β) : MLList m β :=\n xs.cases (fun _ => nil) fun x xs =>\n match xs.uncons? with\n | some none => f x\n | _ => append (f x) (fun _ => bind xs f)\n\n/-- Convert any value in the monad to the singleton monadic lazy list. -/\ndef monadLift [Monad m] (x : m α) : MLList m α :=\n squash fun _ => return cons (← x) nil\n\n/-- Lift the monad of a lazy list. -/\npartial def liftM [Monad m] [Monad n] [MonadLiftT m n] (L : MLList m α) : MLList n α :=\n squash fun _ =>\n return match ← (uncons L : m _) with\n | none => nil\n | some (a, L') => cons a L'.liftM\n\n/-- Given a lazy list in a state monad, run it on some initial state, recording the states. -/\npartial def runState [Monad m] (L : MLList (StateT.{u} σ m) α) (s : σ) : MLList m (α × σ) :=\n squash fun _ =>\n return match ← (uncons L).run s with\n | (none, _) => nil\n | (some (a, L'), s') => cons (a, s') (L'.runState s')\n\n/-- Given a lazy list in a state monad, run it on some initial state. -/\ndef runState' [Monad m] (L : MLList (StateT.{u} σ m) α) (s : σ) : MLList m α :=\n L.runState s |>.map (·.1)\n\n/-- Run a lazy list in a `ReaderT` monad on some fixed state. -/\npartial def runReader [Monad m] (L : MLList (ReaderT.{u, u} ρ m) α) (r : ρ) :\n MLList m α :=\n squash fun _ =>\n return match ← (uncons L).run r with\n | none => nil\n | some (a, L') => cons a (L'.runReader r)\n\n/-- Run a lazy list in a `StateRefT'` monad on some initial state. -/\npartial def runStateRef [Monad m] [MonadLiftT (ST ω) m] (L : MLList (StateRefT' ω σ m) α) (s : σ) :\n MLList m α :=\n squash fun _ =>\n return match ← (uncons L).run s with\n | (none, _) => nil\n | (some (a, L'), s') => cons a (L'.runStateRef s')\n\n/-- Return the head of a monadic lazy list if it exists, as an `Option` in the monad. -/\ndef head? [Monad m] (L : MLList m α) : m (Option α) := return (← L.uncons).map (·.1)\n\n/-- Take the initial segment of the lazy list,\nup to and including the first place where `f` gives `true`. -/\npartial def takeUpToFirstM [Monad m] (L : MLList m α) (f : α → m (ULift Bool)) : MLList m α :=\n L.casesM (fun _ => pure nil) fun x xs =>\n return cons x <| if (← (f x)).down then nil else xs.takeUpToFirstM f\n\n/-- Take the initial segment of the lazy list,\nup to and including the first place where `f` gives `true`. -/\ndef takeUpToFirst [Monad m] (L : MLList m α) (f : α → Bool) : MLList m α :=\n L.takeUpToFirstM fun a => pure (.up (f a))\n\n/-- Gets the last element of a monadic lazy list, as an option in the monad.\nThis will run forever if the list is infinite. -/\npartial def getLast? [Monad m] (L : MLList m α) : m (Option α) := do\n match ← uncons L with\n | none => return none\n | some (x, xs) => aux x xs\nwhere\n /-- Implementation of `MLList.aux`. -/\n aux (x : α) (L : MLList m α) : m (Option α) := do\n match ← uncons L with\n | none => return some x\n | some (y, ys) => aux y ys\n\n/-- Gets the last element of a monadic lazy list, or the default value if the list is empty.\nThis will run forever if the list is infinite. -/\npartial def getLast! [Monad m] [Inhabited α] (L : MLList m α) : m α := Option.get! <$> L.getLast?\n\n/-- Folds a binary function across a monadic lazy list, from an initial starting value.\nThis will run forever if the list is infinite. -/\npartial def foldM [Monad m] (f : β → α → m β) (init : β) (L : MLList m α) : m β :=\n return (← L.foldsM f init |>.getLast?).getD init -- `foldsM` is always non-empty, anyway.\n\n/-- Folds a binary function across a monadic lazy list, from an initial starting value.\nThis will run forever if the list is infinite. -/\npartial def fold [Monad m] (f : β → α → β) (init : β) (L : MLList m α) : m β :=\n L.foldM (fun b a => pure (f b a)) init\n\n/--\nReturn the head of a monadic lazy list, as a value in the monad.\nFails if the list is empty.\n-/\ndef head [AlternativeMonad m] (L : MLList m α) : m α := do\n let some (r, _) ← L.uncons | failure\n return r\n\n/--\nApply a function returning values inside the monad to a monadic lazy list,\nreturning only the first successful result.\n-/\ndef firstM [AlternativeMonad m] (L : MLList m α) (f : α → m (Option β)) : m β :=\n (L.filterMapM f).head\n\n/-- Return the first value on which a predicate returns true. -/\ndef first [AlternativeMonad m] (L : MLList m α) (p : α → Bool) : m α := (L.filter p).head\n\ninstance [Monad m] : AlternativeMonad (MLList m) where\n pure a := cons a nil\n map := map\n bind := bind\n failure := nil\n orElse := MLList.append\n\ninstance [Monad m] : MonadLift m (MLList m) where\n monadLift := monadLift\n" }, { "path": "Batteries/Data/MLList/Heartbeats.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Data.MLList.Basic\npublic import Lean.Util.Heartbeats\n\n@[expose] public section\n\n/-!\n# Truncate a `MLList` when running out of available heartbeats.\n-/\n\nopen Lean\nopen Lean.Core (CoreM)\n\n/-- Take an initial segment of a monadic lazy list,\nstopping when there is less than `percent` of the remaining allowed heartbeats.\n\nIf `getMaxHeartbeats` returns `0`, then this passes through the original list unmodified.\n\nThe `initial` heartbeat counter is recorded when the first element of the list is requested.\nThen each time an element is requested from the wrapped list the heartbeat counter is checked, and\nif `current * 100 / initial < percent` then that element is returned,\nbut no further elements.\n-/\ndef MLList.whileAtLeastHeartbeatsPercent [Monad m] [MonadLiftT CoreM m]\n (L : MLList m α) (percent : Nat := 10) : MLList m α :=\n MLList.squash fun _ => do\n if (← getMaxHeartbeats) = 0 then do\n return L\n let initialHeartbeats ← getRemainingHeartbeats\n return L.takeUpToFirstM fun _ => do\n pure <| .up <| (← getRemainingHeartbeats) * 100 / initialHeartbeats < percent\n" }, { "path": "Batteries/Data/MLList/IO.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Lean.System.IO\npublic import Batteries.Data.MLList.Basic\n\n@[expose] public section\n\n/-!\n# IO operations using monadic lazy lists.\n-/\n\nnamespace MLList\n\n/--\nGive a list of tasks, return the monadic lazy list which\nreturns the values as they become available.\n-/\ndef ofTaskList (tasks : List (Task α)) : MLList BaseIO α :=\n fix?' (init := tasks) fun t => do\n if h : 0 < t.length then\n some <$> IO.waitAny' t h\n else\n pure none\n" }, { "path": "Batteries/Data/MLList.lean", "content": "module\n\npublic import Batteries.Data.MLList.Basic\npublic import Batteries.Data.MLList.Heartbeats\npublic import Batteries.Data.MLList.IO\n" }, { "path": "Batteries/Data/NameSet.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Lean.Data.NameMap.Basic\n\n@[expose] public section\n\n\nnamespace Lean.NameSet\n\ninstance : Singleton Name NameSet where\n singleton := fun n => (∅ : NameSet).insert n\n\ninstance : Union NameSet where\n union := fun s t => s.foldl (fun t n => t.insert n) t\n\ninstance : Inter NameSet where\n inter := fun s t => s.foldl (fun r n => if t.contains n then r.insert n else r) {}\n\ninstance : SDiff NameSet where\n sdiff := fun s t => t.foldl (fun s n => s.erase n) s\n\nend Lean.NameSet\n" }, { "path": "Batteries/Data/Nat/Basic.lean", "content": "/-\nCopyright (c) 2016 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro\n-/\nmodule\n\n@[expose] public section\n\nnamespace Nat\n\n/--\n Recursor identical to `Nat.recOn` but uses notations `0` for `Nat.zero` and `·+1` for `Nat.succ`\n-/\n@[elab_as_elim]\nprotected def recAuxOn {motive : Nat → Sort _} (t : Nat) (zero : motive 0)\n (succ : ∀ n, motive n → motive (n+1)) : motive t := Nat.recAux zero succ t\n\n/--\n Strong recursor for `Nat`\n-/\n@[elab_as_elim]\nprotected def strongRec {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → motive m) → motive n)\n (t : Nat) : motive t := ind t fun m _ => Nat.strongRec ind m\n\n/--\n Strong recursor via a `Nat`-valued measure\n-/\n@[elab_as_elim]\ndef strongRecMeasure (f : α → Nat) {motive : α → Sort _}\n (ind : ∀ x, (∀ y, f y < f x → motive y) → motive x) (x : α) : motive x :=\n ind x fun y _ => strongRecMeasure f ind y\ntermination_by f x\n\n/--\n Simple diagonal recursor for `Nat`\n-/\n@[elab_as_elim]\nprotected def recDiagAux {motive : Nat → Nat → Sort _}\n (zero_left : ∀ n, motive 0 n)\n (zero_right : ∀ m, motive m 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) :\n (m n : Nat) → motive m n\n | 0, _ => zero_left _\n | _, 0 => zero_right _\n | _+1, _+1 => succ_succ _ _ (Nat.recDiagAux zero_left zero_right succ_succ _ _)\n\n/--\n Diagonal recursor for `Nat`\n-/\n@[elab_as_elim]\nprotected def recDiag {motive : Nat → Nat → Sort _}\n (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1))\n (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) :\n (m n : Nat) → motive m n := Nat.recDiagAux left right succ_succ\nwhere\n /-- Left leg for `Nat.recDiag` -/\n left : ∀ n, motive 0 n\n | 0 => zero_zero\n | _+1 => zero_succ _ (left _)\n /-- Right leg for `Nat.recDiag` -/\n right : ∀ m, motive m 0\n | 0 => zero_zero\n | _+1 => succ_zero _ (right _)\n\n/--\n Diagonal recursor for `Nat`\n-/\n@[elab_as_elim]\nprotected def recDiagOn {motive : Nat → Nat → Sort _} (m n : Nat)\n (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1))\n (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) :\n motive m n := Nat.recDiag zero_zero zero_succ succ_zero succ_succ m n\n\n/--\n Diagonal recursor for `Nat`\n-/\n@[elab_as_elim]\nprotected def casesDiagOn {motive : Nat → Nat → Sort _} (m n : Nat)\n (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 (n+1))\n (succ_zero : ∀ m, motive (m+1) 0)\n (succ_succ : ∀ m n, motive (m+1) (n+1)) :\n motive m n :=\n Nat.recDiag zero_zero (fun _ _ => zero_succ _) (fun _ _ => succ_zero _)\n (fun _ _ _ => succ_succ _ _) m n\n\n/--\nInteger square root function. Implemented via Newton's method.\n-/\ndef sqrt (n : Nat) : Nat :=\n if n ≤ 1 then n else\n iter n (1 <<< ((n.log2 / 2) + 1))\nwhere\n /-- Auxiliary for `sqrt`. If `guess` is greater than the integer square root of `n`,\n returns the integer square root of `n`. -/\n iter (n guess : Nat) : Nat :=\n let next := (guess + n / guess) / 2\n if _h : next < guess then\n iter n next\n else\n guess\n termination_by guess\n\n/--\nConstruct a natural number from a sequence of bits using little endian convention.\n-/\n@[inline] def ofBits (f : Fin n → Bool) : Nat :=\n Fin.foldr n (fun i v => 2 * v + (f i).toNat) 0\n\n-- Forward port of lean4#10739\ninstance {n : Nat} : NeZero (n^0) := ⟨Nat.one_ne_zero⟩\n" }, { "path": "Batteries/Data/Nat/Bisect.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic import Batteries.Tactic.Basic\n\n@[expose] public section\n\nnamespace Nat\n\n/-- Average of two natural numbers rounded toward zero. -/\nabbrev avg (a b : Nat) := (a + b) / 2\n\ntheorem avg_comm (a b : Nat) : avg a b = avg b a := by\n rw [avg, Nat.add_comm]\n\ntheorem avg_le_left (h : b ≤ a) : avg a b ≤ a := by\n apply Nat.div_le_of_le_mul; simp +arith [*]\n\ntheorem avg_le_right (h : a ≤ b) : avg a b ≤ b := by\n apply Nat.div_le_of_le_mul; simp +arith [*]\n\ntheorem avg_lt_left (h : b < a) : avg a b < a := by\n apply Nat.div_lt_of_lt_mul; omega\n\ntheorem avg_lt_right (h : a < b) : avg a b < b := by\n apply Nat.div_lt_of_lt_mul; omega\n\ntheorem le_avg_left (h : a ≤ b) : a ≤ avg a b := by\n apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp +arith [*]\n\ntheorem le_avg_right (h : b ≤ a) : b ≤ avg a b := by\n apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp +arith [*]\n\ntheorem le_add_one_of_avg_eq_left (h : avg a b = a) : b ≤ a + 1 := by\n cases Nat.lt_or_ge b (a+2) with\n | inl hlt => exact Nat.le_of_lt_add_one hlt\n | inr hge =>\n absurd Nat.lt_irrefl a\n conv => rhs; rw [← h]\n rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two]\n omega\n\ntheorem le_add_one_of_avg_eq_right (h : avg a b = b) : a ≤ b + 1 := by\n cases Nat.lt_or_ge a (b+2) with\n | inl hlt => exact Nat.le_of_lt_add_one hlt\n | inr hge =>\n absurd Nat.lt_irrefl b\n conv => rhs; rw [← h]\n rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two]\n omega\n\n/--\nGiven natural numbers `a < b` such that `p a = true` and `p b = false`, `bisect` finds a natural\nnumber `a ≤ c < b` such that `p c = true` and `p (c+1) = false`.\n-/\ndef bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true) (hstop : p stop = false) :=\n let mid := avg start stop\n have hmidstop : mid < stop := by apply Nat.div_lt_of_lt_mul; omega\n if hstartmid : start < mid then\n match hmid : p mid with\n | false => bisect hstartmid hstart hmid\n | true => bisect hmidstop hmid hstop\n else\n mid\ntermination_by stop - start\n\ntheorem bisect_lt_stop {p : Nat → Bool} (h : start < stop) (hstart : p start = true)\n (hstop : p stop = false) : bisect h hstart hstop < stop := by\n unfold bisect\n simp only; split\n · split\n · next h' _ =>\n have : avg start stop - start < stop - start := by\n apply Nat.sub_lt_sub_right\n · exact Nat.le_of_lt h'\n · exact Nat.avg_lt_right h\n apply Nat.lt_trans\n · exact bisect_lt_stop ..\n · exact avg_lt_right h\n · exact bisect_lt_stop ..\n · exact avg_lt_right h\n\ntheorem start_le_bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true)\n (hstop : p stop = false) : start ≤ bisect h hstart hstop := by\n unfold bisect\n simp only; split\n · split\n · next h' _ =>\n have : avg start stop - start < stop - start := by\n apply Nat.sub_lt_sub_right\n · exact Nat.le_of_lt h'\n · exact avg_lt_right h\n exact start_le_bisect ..\n · next h' _ =>\n apply Nat.le_trans\n · exact Nat.le_of_lt h'\n · exact start_le_bisect ..\n · exact le_avg_left (Nat.le_of_lt h)\n\ntheorem bisect_true {p : Nat → Bool} (h : start < stop) (hstart : p start = true)\n (hstop : p stop = false) : p (bisect h hstart hstop) = true := by\n unfold bisect\n simp only; split\n · split\n · have : avg start stop - start < stop - start := by\n apply Nat.sub_lt_sub_right\n · exact Nat.le_avg_left (Nat.le_of_lt h)\n · exact Nat.avg_lt_right h\n exact bisect_true ..\n · exact bisect_true ..\n · next h' =>\n rw [← hstart]; congr\n apply Nat.le_antisymm\n · exact Nat.le_of_not_gt h'\n · exact Nat.le_avg_left (Nat.le_of_lt h)\n\ntheorem bisect_add_one_false {p : Nat → Bool} (h : start < stop) (hstart : p start = true)\n (hstop : p stop = false) : p (bisect h hstart hstop + 1) = false := by\n unfold bisect\n simp only; split\n · split\n · have : avg start stop - start < stop - start := by\n apply Nat.sub_lt_sub_right\n · exact Nat.le_avg_left (Nat.le_of_lt h)\n · exact Nat.avg_lt_right h\n exact bisect_add_one_false ..\n · exact bisect_add_one_false ..\n · next h' =>\n have heq : avg start stop = start := by\n apply Nat.le_antisymm\n · exact Nat.le_of_not_gt h'\n · exact Nat.le_avg_left (Nat.le_of_lt h)\n rw [← hstop, heq]; congr\n apply Nat.le_antisymm\n · exact Nat.succ_le_of_lt h\n · exact Nat.le_add_one_of_avg_eq_left heq\n" }, { "path": "Batteries/Data/Nat/Bitwise/Lemmas.lean", "content": "/-\nCopyright (c) 2025 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\n\nmodule\n\n@[expose] public section\n\n/-! # Bitwise Lemmas\n\nThis module defines properties of the bitwise operations on natural numbers.\n\nThis file is complements `Init.Data.Nat.Bitwise.Lemmas` with properties that\nare not necessary for the bitvector library.\n-/\n\nnamespace Nat\n\n/-! ### and -/\n\n@[simp] theorem and_self_left (a b : Nat) : a &&& (a &&& b) = a &&& b := by\n apply Nat.eq_of_testBit_eq; simp\n\n@[simp] theorem and_self_right (a b : Nat) : ((a &&& b) &&& b) = (a &&& b) := by\n apply Nat.eq_of_testBit_eq; simp\n\ntheorem and_left_comm (x y z : Nat) : x &&& (y &&& z) = y &&& (x &&& z) := by\n apply Nat.eq_of_testBit_eq; simp [Bool.and_left_comm]\n\ntheorem and_right_comm (x y z : Nat) : (x &&& y) &&& z = (x &&& z) &&& y := by\n apply Nat.eq_of_testBit_eq; simp [Bool.and_right_comm]\n\n/-! ### or -/\n\n@[simp] theorem or_self_left (a b : Nat) : a ||| (a ||| b) = a ||| b := by\n apply Nat.eq_of_testBit_eq; simp\n\n@[simp] theorem or_self_right (a b : Nat) : (a ||| b) ||| b = a ||| b := by\n apply Nat.eq_of_testBit_eq; simp\n\ntheorem or_left_comm (x y z : Nat) : x ||| (y ||| z) = y ||| (x ||| z) := by\n apply Nat.eq_of_testBit_eq; simp [Bool.or_left_comm]\n\ntheorem or_right_comm (x y z : Nat) : (x ||| y) ||| z = (x ||| z) ||| y := by\n apply Nat.eq_of_testBit_eq; simp [Bool.or_right_comm]\n\n/-! ### xor -/\n\ntheorem xor_left_comm (x y z : Nat) : x ^^^ (y ^^^ z) = y ^^^ (x ^^^ z) := by\n apply Nat.eq_of_testBit_eq; simp only [testBit_xor, Bool.xor_left_comm, implies_true]\n\ntheorem xor_right_comm (x y z : Nat) : (x ^^^ y) ^^^ z = (x ^^^ z) ^^^ y := by\n apply Nat.eq_of_testBit_eq; simp only [testBit_xor, Bool.xor_right_comm, implies_true]\n\n@[simp] theorem xor_xor_cancel_left (x y : Nat) : x ^^^ (x ^^^ y) = y := by\n apply Nat.eq_of_testBit_eq; simp\n\n@[simp] theorem xor_xor_cancel_right (x y : Nat) : (x ^^^ y) ^^^ y = x := by\n apply Nat.eq_of_testBit_eq; simp\n\ntheorem eq_of_xor_eq_zero {x y : Nat} : x ^^^ y = 0 → x = y := by\n intro h; rw [← xor_xor_cancel_left x y, h, xor_zero]\n\n@[simp] theorem xor_eq_zero_iff {x y : Nat} : x ^^^ y = 0 ↔ x = y :=\n ⟨eq_of_xor_eq_zero, fun | rfl => Nat.xor_self _⟩\n\ntheorem xor_ne_zero_iff {x y : Nat} : x ^^^ y ≠ 0 ↔ x ≠ y := by simp\n\n/-! ### injectivity lemmas -/\n\ntheorem xor_right_injective {x : Nat} : Function.Injective (x ^^^ ·) := by\n intro y z h; rw [← xor_xor_cancel_left x y, ← xor_xor_cancel_left x z]; simp only [h]\n\ntheorem xor_left_injective {x : Nat} : Function.Injective (· ^^^ x) := by\n intro y z h; rw [← xor_xor_cancel_right y x, ← xor_xor_cancel_right z x]; simp only [h]\n\n@[simp] theorem xor_right_inj {x y z : Nat} : x ^^^ y = x ^^^ z ↔ y = z :=\n ⟨(xor_right_injective ·), fun | rfl => rfl⟩\n\n@[simp] theorem xor_left_inj {x y z : Nat} : x ^^^ z = y ^^^ z ↔ x = y :=\n ⟨(xor_left_injective ·), fun | rfl => rfl⟩\n\ntheorem and_or_right_injective {m x y : Nat} : x &&& m = y &&& m → x ||| m = y ||| m → x = y := by\n intro ha ho\n apply Nat.eq_of_testBit_eq\n intro i\n rw [← Bool.and_or_inj_right_iff (m := m.testBit i)]\n simp [← testBit_and, ← testBit_or, ha, ho]\n\ntheorem and_or_right_inj {m x y : Nat} : x &&& m = y &&& m ∧ x ||| m = y ||| m ↔ x = y :=\n ⟨fun ⟨ha, ho⟩ => and_or_right_injective ha ho, fun | rfl => ⟨rfl, rfl⟩⟩\n\ntheorem and_or_left_injective {m x y : Nat} : m &&& x = m &&& y → m ||| x = m ||| y → x = y := by\n intro ha ho\n apply Nat.eq_of_testBit_eq\n intro i\n rw [← Bool.and_or_inj_left_iff (m := m.testBit i)]\n simp [← testBit_and, ← testBit_or, ha, ho]\n\ntheorem and_or_left_inj {m x y : Nat} : m &&& x = m &&& y ∧ m ||| x = m ||| y ↔ x = y :=\n ⟨fun ⟨ha, ho⟩ => and_or_left_injective ha ho, fun | rfl => ⟨rfl, rfl⟩⟩\n" }, { "path": "Batteries/Data/Nat/Bitwise.lean", "content": "module\n\npublic import Batteries.Data.Nat.Bitwise.Lemmas\n" }, { "path": "Batteries/Data/Nat/Gcd.lean", "content": "/-\nCopyright (c) 2014 Jeremy Avigad. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\n/-!\n# Definitions and properties of `coprime`\n-/\n\nnamespace Nat\n\n@[deprecated (since := \"2025-08-04\")]\nalias Coprime.mul := Coprime.mul_left\n" }, { "path": "Batteries/Data/Nat/Lemmas.lean", "content": "/-\nCopyright (c) 2016 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\npublic import Batteries.Data.Nat.Basic\n\n@[expose] public section\n\n/-! # Basic lemmas about natural numbers\n\nThe primary purpose of the lemmas in this file is to assist with reasoning\nabout sizes of objects, array indices and such. For a more thorough development\nof the theory of natural numbers, we recommend using Mathlib.\n-/\n\nnamespace Nat\n\n/-! ### rec/cases -/\n\n@[simp] theorem recAux_zero {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive n → motive (n+1)) :\n Nat.recAux zero succ 0 = zero := rfl\n\ntheorem recAux_succ {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive n → motive (n+1)) (n) :\n Nat.recAux zero succ (n+1) = succ n (Nat.recAux zero succ n) := rfl\n\n@[simp] theorem recAuxOn_zero {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive n → motive (n+1)) :\n Nat.recAuxOn 0 zero succ = zero := rfl\n\ntheorem recAuxOn_succ {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive n → motive (n+1)) (n) :\n Nat.recAuxOn (n+1) zero succ = succ n (Nat.recAuxOn n zero succ) := rfl\n\n@[simp] theorem casesAuxOn_zero {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive (n+1)) :\n Nat.casesAuxOn 0 zero succ = zero := rfl\n\ntheorem casesAuxOn_succ {motive : Nat → Sort _} (zero : motive 0)\n (succ : ∀ n, motive (n+1)) (n) :\n Nat.casesAuxOn (n+1) zero succ = succ n := rfl\n\ntheorem strongRec_eq {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → motive m) → motive n)\n (t : Nat) : Nat.strongRec ind t = ind t fun m _ => Nat.strongRec ind m := by\n conv => lhs; unfold Nat.strongRec\n\ntheorem strongRecOn_eq {motive : Nat → Sort _} (ind : ∀ n, (∀ m, m < n → motive m) → motive n)\n (t : Nat) : Nat.strongRecOn t ind = ind t fun m _ => Nat.strongRecOn m ind :=\n WellFounded.fix_eq WellFoundedRelation.wf ind t\n\n@[simp] theorem recDiagAux_zero_left {motive : Nat → Nat → Sort _}\n (zero_left : ∀ n, motive 0 n) (zero_right : ∀ m, motive m 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (n) :\n Nat.recDiagAux zero_left zero_right succ_succ 0 n = zero_left n := by cases n <;> rfl\n\n@[simp] theorem recDiagAux_zero_right {motive : Nat → Nat → Sort _}\n (zero_left : ∀ n, motive 0 n) (zero_right : ∀ m, motive m 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m)\n (h : zero_left 0 = zero_right 0 := by first | assumption | trivial) :\n Nat.recDiagAux zero_left zero_right succ_succ m 0 = zero_right m := by cases m; exact h; rfl\n\ntheorem recDiagAux_succ_succ {motive : Nat → Nat → Sort _}\n (zero_left : ∀ n, motive 0 n) (zero_right : ∀ m, motive m 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m n) :\n Nat.recDiagAux zero_left zero_right succ_succ (m+1) (n+1)\n = succ_succ m n (Nat.recDiagAux zero_left zero_right succ_succ m n) := rfl\n\n@[simp] theorem recDiag_zero_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) :\n Nat.recDiag (motive:=motive) zero_zero zero_succ succ_zero succ_succ 0 0 = zero_zero := rfl\n\ntheorem recDiag_zero_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (n) :\n Nat.recDiag zero_zero zero_succ succ_zero succ_succ 0 (n+1)\n = zero_succ n (Nat.recDiag zero_zero zero_succ succ_zero succ_succ 0 n) := by\n simp [Nat.recDiag]; rfl\n\ntheorem recDiag_succ_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m) :\n Nat.recDiag zero_zero zero_succ succ_zero succ_succ (m+1) 0\n = succ_zero m (Nat.recDiag zero_zero zero_succ succ_zero succ_succ m 0) := by\n simp [Nat.recDiag]; cases m <;> rfl\n\ntheorem recDiag_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m n) :\n Nat.recDiag zero_zero zero_succ succ_zero succ_succ (m+1) (n+1)\n = succ_succ m n (Nat.recDiag zero_zero zero_succ succ_zero succ_succ m n) := rfl\n\n@[simp] theorem recDiagOn_zero_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) :\n Nat.recDiagOn (motive:=motive) 0 0 zero_zero zero_succ succ_zero succ_succ = zero_zero := rfl\n\ntheorem recDiagOn_zero_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (n) :\n Nat.recDiagOn 0 (n+1) zero_zero zero_succ succ_zero succ_succ\n = zero_succ n (Nat.recDiagOn 0 n zero_zero zero_succ succ_zero succ_succ) :=\n Nat.recDiag_zero_succ ..\n\ntheorem recDiagOn_succ_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m) :\n Nat.recDiagOn (m+1) 0 zero_zero zero_succ succ_zero succ_succ\n = succ_zero m (Nat.recDiagOn m 0 zero_zero zero_succ succ_zero succ_succ) :=\n Nat.recDiag_succ_zero ..\n\ntheorem recDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 n → motive 0 (n+1)) (succ_zero : ∀ m, motive m 0 → motive (m+1) 0)\n (succ_succ : ∀ m n, motive m n → motive (m+1) (n+1)) (m n) :\n Nat.recDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ\n = succ_succ m n (Nat.recDiagOn m n zero_zero zero_succ succ_zero succ_succ) := rfl\n\n@[simp] theorem casesDiagOn_zero_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 (n+1)) (succ_zero : ∀ m, motive (m+1) 0)\n (succ_succ : ∀ m n, motive (m+1) (n+1)) :\n Nat.casesDiagOn 0 0 (motive:=motive) zero_zero zero_succ succ_zero succ_succ = zero_zero := rfl\n\n@[simp] theorem casesDiagOn_zero_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 (n+1)) (succ_zero : ∀ m, motive (m+1) 0)\n (succ_succ : ∀ m n, motive (m+1) (n+1)) (n) :\n Nat.casesDiagOn 0 (n+1) zero_zero zero_succ succ_zero succ_succ = zero_succ n := rfl\n\n@[simp] theorem casesDiagOn_succ_zero {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 (n+1)) (succ_zero : ∀ m, motive (m+1) 0)\n (succ_succ : ∀ m n, motive (m+1) (n+1)) (m) :\n Nat.casesDiagOn (m+1) 0 zero_zero zero_succ succ_zero succ_succ = succ_zero m := rfl\n\n@[simp] theorem casesDiagOn_succ_succ {motive : Nat → Nat → Sort _} (zero_zero : motive 0 0)\n (zero_succ : ∀ n, motive 0 (n+1)) (succ_zero : ∀ m, motive (m+1) 0)\n (succ_succ : ∀ m n, motive (m+1) (n+1)) (m n) :\n Nat.casesDiagOn (m+1) (n+1) zero_zero zero_succ succ_zero succ_succ = succ_succ m n := rfl\n\n/-! ## strong case -/\n\n/-- Strong case analysis on `a < b ∨ b ≤ a` -/\nprotected def lt_sum_ge (a b : Nat) : a < b ⊕' b ≤ a :=\n if h : a < b then .inl h else .inr (Nat.not_lt.1 h)\n\n/-- Strong case analysis on `a < b ∨ a = b ∨ b < a` -/\nprotected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a :=\n match h : compare a b with\n | .lt => .inl (Nat.compare_eq_lt.1 h)\n | .eq => .inr (.inl (Nat.compare_eq_eq.1 h))\n | .gt => .inr (.inr (Nat.compare_eq_gt.1 h))\n\n/-! ### div/mod -/\n\n-- TODO mod_core_congr, mod_def\n\n-- TODO div_core_congr, div_def\n\n-- TODO cont_to_bool_mod_two\n\n/-! ### sum -/\n\n@[deprecated (since := \"2025-07-31\")]\nalias sum_append := List.sum_append_nat\n\n/-! ### ofBits -/\n\n@[simp] theorem ofBits_zero (f : Fin 0 → Bool) : ofBits f = 0 := rfl\n\ntheorem ofBits_succ (f : Fin (n+1) → Bool) : ofBits f = 2 * ofBits (f ∘ Fin.succ) + (f 0).toNat :=\n Fin.foldr_succ ..\n\ntheorem ofBits_lt_two_pow (f : Fin n → Bool) : ofBits f < 2 ^ n := by\n induction n with\n | zero => simp\n | succ n ih =>\n calc ofBits f\n = 2 * ofBits (f ∘ Fin.succ) + (f 0).toNat := ofBits_succ ..\n _ < 2 * (ofBits (f ∘ Fin.succ) + 1) := Nat.add_lt_add_left (Bool.toNat_lt _) ..\n _ ≤ 2 * 2 ^ n := Nat.mul_le_mul_left 2 (ih ..)\n _ = 2 ^ (n + 1) := Nat.pow_add_one' .. |>.symm\n\n@[simp] theorem testBit_ofBits_lt (f : Fin n → Bool) (i : Nat) (h : i < n) :\n (ofBits f).testBit i = f ⟨i, h⟩ := by\n induction n generalizing i with\n | zero => contradiction\n | succ n ih =>\n simp only [ofBits_succ]\n match i with\n | 0 => simp [mod_eq_of_lt (Bool.toNat_lt _)]\n | i+1 =>\n rw [testBit_add_one, mul_add_div Nat.zero_lt_two, Nat.div_eq_of_lt (Bool.toNat_lt _)]\n exact ih (f ∘ Fin.succ) i (Nat.lt_of_succ_lt_succ h)\n\n@[simp] theorem testBit_ofBits_ge (f : Fin n → Bool) (i : Nat) (h : n ≤ i) :\n (ofBits f).testBit i = false := by\n apply testBit_lt_two_pow\n apply Nat.lt_of_lt_of_le\n · exact ofBits_lt_two_pow f\n · exact Nat.pow_le_pow_right Nat.zero_lt_two h\n\ntheorem testBit_ofBits (f : Fin n → Bool) :\n (ofBits f).testBit i = if h : i < n then f ⟨i, h⟩ else false := by\n cases Nat.lt_or_ge i n with\n | inl h => simp [h]\n | inr h => simp [h, Nat.not_lt_of_ge h]\n\ntheorem ofBits_testBit (x n) : ofBits (fun i : Fin n => x.testBit i) = x % 2 ^ n := by\n apply eq_of_testBit_eq; simp [testBit_ofBits]\n\n/-! ### Misc -/\n\ntheorem mul_add_lt_mul_of_lt_of_lt {m n x y : Nat} (hx : x < m) (hy : y < n) :\n n * x + y < m * n := calc\n _ < n * x + n := Nat.add_lt_add_left hy _\n _ = n * (x + 1) := Nat.mul_add_one .. |>.symm\n _ ≤ n * m := Nat.mul_le_mul_left _ hx\n _ = m * n := Nat.mul_comm ..\n\ntheorem add_mul_lt_mul_of_lt_of_lt {m n x y : Nat} (hx : x < m) (hy : y < n) :\n x + m * y < m * n := by\n rw [Nat.add_comm, Nat.mul_comm _ n]\n exact mul_add_lt_mul_of_lt_of_lt hy hx\n" }, { "path": "Batteries/Data/Nat.lean", "content": "module\n\npublic import Batteries.Data.Nat.Basic\npublic import Batteries.Data.Nat.Bisect\npublic import Batteries.Data.Nat.Bitwise\npublic import Batteries.Data.Nat.Bitwise.Lemmas\npublic import Batteries.Data.Nat.Gcd\npublic import Batteries.Data.Nat.Lemmas\n" }, { "path": "Batteries/Data/PairingHeap.lean", "content": "/-\nCopyright (c) 2022 Yuyang Zhao. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Yuyang Zhao\n-/\nmodule\n\npublic import Batteries.Classes.Order\n\n@[expose] public section\n\nnamespace Batteries.PairingHeapImp\n\n/--\nA `Heap` is the nodes of the pairing heap.\nEach node have two pointers: `child` going to the first child of this node,\nand `sibling` goes to the next sibling of this tree.\nSo it actually encodes a forest where each node has children\n`node.child`, `node.child.sibling`, `node.child.sibling.sibling`, etc.\n\nEach edge in this forest denotes a `le a b` relation that has been checked, so\nthe root is smaller than everything else under it.\n-/\ninductive Heap (α : Type u) where\n /-- An empty forest, which has depth `0`. -/\n | nil : Heap α\n /-- A forest consists of a root `a`, a forest `child` elements greater than `a`,\n and another forest `sibling`. -/\n | node (a : α) (child sibling : Heap α) : Heap α\n deriving Repr\n\n/-- `O(n)`. The number of elements in the heap. -/\ndef Heap.size : Heap α → Nat\n | .nil => 0\n | .node _ c s => c.size + 1 + s.size\n\n/-- A node containing a single element `a`. -/\ndef Heap.singleton (a : α) : Heap α := .node a .nil .nil\n\n/-- `O(1)`. Is the heap empty? -/\ndef Heap.isEmpty : Heap α → Bool\n | .nil => true\n | _ => false\n\n/-- `O(1)`. Merge two heaps. Ignore siblings. -/\n@[specialize] def Heap.merge (le : α → α → Bool) : Heap α → Heap α → Heap α\n | .nil, .nil => .nil\n | .nil, .node a₂ c₂ _ => .node a₂ c₂ .nil\n | .node a₁ c₁ _, .nil => .node a₁ c₁ .nil\n | .node a₁ c₁ _, .node a₂ c₂ _ =>\n if le a₁ a₂ then .node a₁ (.node a₂ c₂ c₁) .nil else .node a₂ (.node a₁ c₁ c₂) .nil\n\n/-- Auxiliary for `Heap.deleteMin`: merge the forest in pairs. -/\n@[specialize] def Heap.combine (le : α → α → Bool) : Heap α → Heap α\n | h₁@(.node _ _ h₂@(.node _ _ s)) => merge le (merge le h₁ h₂) (s.combine le)\n | h => h\n\n/-- `O(1)`. Get the smallest element in the heap, including the passed in value `a`. -/\n@[inline] def Heap.headD (a : α) : Heap α → α\n | .nil => a\n | .node a _ _ => a\n\n/-- `O(1)`. Get the smallest element in the heap, if it has an element. -/\n@[inline] def Heap.head? : Heap α → Option α\n | .nil => none\n | .node a _ _ => some a\n\n/-- Amortized `O(log n)`. Find and remove the the minimum element from the heap. -/\n@[inline] def Heap.deleteMin (le : α → α → Bool) : Heap α → Option (α × Heap α)\n | .nil => none\n | .node a c _ => (a, combine le c)\n\n/-- Amortized `O(log n)`. Get the tail of the pairing heap after removing the minimum element. -/\n@[inline] def Heap.tail? (le : α → α → Bool) (h : Heap α) : Option (Heap α) :=\n deleteMin le h |>.map (·.snd)\n\n/-- Amortized `O(log n)`. Remove the minimum element of the heap. -/\n@[inline] def Heap.tail (le : α → α → Bool) (h : Heap α) : Heap α :=\n tail? le h |>.getD .nil\n\n/-- A predicate says there is no more than one tree. -/\ninductive Heap.NoSibling : Heap α → Prop\n /-- An empty heap is no more than one tree. -/\n | nil : NoSibling .nil\n /-- Or there is exactly one tree. -/\n | node (a c) : NoSibling (.node a c .nil)\n\ninstance : Decidable (Heap.NoSibling s) :=\n match s with\n | .nil => isTrue .nil\n | .node a c .nil => isTrue (.node a c)\n | .node _ _ (.node _ _ _) => isFalse nofun\n\ntheorem Heap.noSibling_merge (le) (s₁ s₂ : Heap α) :\n (s₁.merge le s₂).NoSibling := by\n unfold merge\n (split <;> try split) <;> constructor\n\ntheorem Heap.noSibling_combine (le) (s : Heap α) :\n (s.combine le).NoSibling := by\n unfold combine; split\n · exact noSibling_merge _ _ _\n · match s with\n | nil | node _ _ nil => constructor\n | node _ _ (node _ _ s) => rename_i h; exact (h _ _ _ _ _ rfl).elim\n\ntheorem Heap.noSibling_deleteMin {s : Heap α} (eq : s.deleteMin le = some (a, s')) :\n s'.NoSibling := by\n cases s with cases eq | node a c => exact noSibling_combine _ _\n\ntheorem Heap.noSibling_tail? {s : Heap α} : s.tail? le = some s' →\n s'.NoSibling := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact noSibling_deleteMin eq₂\n\ntheorem Heap.noSibling_tail (le) (s : Heap α) : (s.tail le).NoSibling := by\n simp only [Heap.tail]\n match eq : s.tail? le with\n | none => cases s with cases eq | nil => constructor\n | some tl => exact Heap.noSibling_tail? eq\n\ntheorem Heap.size_merge_node (le) (a₁ : α) (c₁ s₁ : Heap α) (a₂ : α) (c₂ s₂ : Heap α) :\n (merge le (.node a₁ c₁ s₁) (.node a₂ c₂ s₂)).size = c₁.size + c₂.size + 2 := by\n unfold merge; dsimp; split <;> simp +arith [size]\n\ntheorem Heap.size_merge (le) {s₁ s₂ : Heap α} (h₁ : s₁.NoSibling) (h₂ : s₂.NoSibling) :\n (merge le s₁ s₂).size = s₁.size + s₂.size := by\n match h₁, h₂ with\n | .nil, .nil | .nil, .node _ _ | .node _ _, .nil => simp [merge, size]\n | .node _ _, .node _ _ => unfold merge; dsimp; split <;> simp +arith [size]\n\ntheorem Heap.size_combine (le) (s : Heap α) :\n (s.combine le).size = s.size := by\n unfold combine; split\n · rename_i a₁ c₁ a₂ c₂ s\n rw [size_merge le (noSibling_merge _ _ _) (noSibling_combine _ _),\n size_merge_node, size_combine le s]\n simp +arith [size]\n · rfl\n\ntheorem Heap.size_deleteMin {s : Heap α} (h : s.NoSibling) (eq : s.deleteMin le = some (a, s')) :\n s.size = s'.size + 1 := by\n cases h with cases eq | node a c => rw [size_combine, size, size]\n\ntheorem Heap.size_tail? {s : Heap α} (h : s.NoSibling) : s.tail? le = some s' →\n s.size = s'.size + 1 := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact size_deleteMin h eq₂\n\ntheorem Heap.size_tail (le) {s : Heap α} (h : s.NoSibling) : (s.tail le).size = s.size - 1 := by\n simp only [Heap.tail]\n match eq : s.tail? le with\n | none => cases s with cases eq | nil => rfl\n | some tl => simp [Heap.size_tail? h eq]\n\ntheorem Heap.size_deleteMin_lt {s : Heap α} (eq : s.deleteMin le = some (a, s')) :\n s'.size < s.size := by\n cases s with cases eq | node a c => simp +arith [size_combine, size]\n\ntheorem Heap.size_tail?_lt {s : Heap α} : s.tail? le = some s' →\n s'.size < s.size := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact size_deleteMin_lt eq₂\n\n/--\n`O(n log n)`. Monadic fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[specialize] def Heap.foldM [Monad m] (le : α → α → Bool) (s : Heap α)\n (init : β) (f : β → α → m β) : m β :=\n match eq : s.deleteMin le with\n | none => pure init\n | some (hd, tl) =>\n have : tl.size < s.size := by simp +arith [Heap.size_deleteMin_lt eq]\n do foldM le tl (← f init hd) f\ntermination_by s.size\n\n/--\n`O(n log n)`. Fold over the elements of a heap in increasing order,\nby repeatedly pulling the minimum element out of the heap.\n-/\n@[inline] def Heap.fold (le : α → α → Bool) (s : Heap α) (init : β) (f : β → α → β) : β :=\n Id.run <| s.foldM le init f\n\n/-- `O(n log n)`. Convert the heap to an array in increasing order. -/\n@[inline] def Heap.toArray (le : α → α → Bool) (s : Heap α) : Array α := fold le s #[] Array.push\n\n/-- `O(n log n)`. Convert the heap to a list in increasing order. -/\n@[inline] def Heap.toList (le : α → α → Bool) (s : Heap α) : List α := (s.toArray le).toList\n\n/-- `O(n)`. Fold a monadic function over the tree structure to accumulate a value. -/\n@[specialize] def Heap.foldTreeM [Monad m] (nil : β) (join : α → β → β → m β) : Heap α → m β\n | .nil => pure nil\n | .node a c s => do join a (← c.foldTreeM nil join) (← s.foldTreeM nil join)\n\n/-- `O(n)`. Fold a function over the tree structure to accumulate a value. -/\n@[inline] def Heap.foldTree (nil : β) (join : α → β → β → β) (s : Heap α) : β :=\n Id.run <| s.foldTreeM nil join\n\n/-- `O(n)`. Convert the heap to a list in arbitrary order. -/\ndef Heap.toListUnordered (s : Heap α) : List α :=\n s.foldTree id (fun a c s l => a :: c (s l)) []\n\n/-- `O(n)`. Convert the heap to an array in arbitrary order. -/\ndef Heap.toArrayUnordered (s : Heap α) : Array α :=\n s.foldTree id (fun a c s r => s (c (r.push a))) #[]\n\n/--\nThe well formedness predicate for a heap node.\nIt asserts that:\n* If `a` is added at the top to make the forest into a tree, the resulting tree\n is a `le`-min-heap (if `le` is well-behaved)\n-/\ndef Heap.NodeWF (le : α → α → Bool) (a : α) : Heap α → Prop\n | .nil => True\n | .node b c s => (∀ [TotalBLE le], le a b) ∧ c.NodeWF le b ∧ s.NodeWF le a\n\n/--\nThe well formedness predicate for a pairing heap.\nIt asserts that:\n* There is no more than one tree.\n* It is a `le`-min-heap (if `le` is well-behaved)\n-/\ninductive Heap.WF (le : α → α → Bool) : Heap α → Prop\n /-- It is an empty heap. -/\n | nil : WF le .nil\n /-- There is exactly one tree and it is a `le`-min-heap. -/\n | node (h : c.NodeWF le a) : WF le (.node a c .nil)\n\ntheorem Heap.WF.singleton : (Heap.singleton a).WF le := node trivial\n\ntheorem Heap.WF.merge_node (h₁ : NodeWF le a₁ c₁) (h₂ : NodeWF le a₂ c₂) :\n (merge le (.node a₁ c₁ s₁) (.node a₂ c₂ s₂)).WF le := by\n unfold merge; dsimp\n split <;> rename_i h\n · exact node ⟨fun [_] => h, h₂, h₁⟩\n · exact node ⟨fun [_] => TotalBLE.total.resolve_left h, h₁, h₂⟩\n\ntheorem Heap.WF.merge (h₁ : s₁.WF le) (h₂ : s₂.WF le) :\n (merge le s₁ s₂).WF le :=\n match h₁, h₂ with\n | .nil, .nil => nil\n | .nil, .node h₂ => node h₂\n | .node h₁, .nil => node h₁\n | .node h₁, .node h₂ => merge_node h₁ h₂\n\ntheorem Heap.WF.combine (h : s.NodeWF le a) : (combine le s).WF le :=\n match s with\n | .nil => nil\n | .node _b _c .nil => node h.2.1\n | .node _b₁ _c₁ (.node _b₂ _c₂ _s) => merge (merge_node h.2.1 h.2.2.2.1) (combine h.2.2.2.2)\n\ntheorem Heap.WF.deleteMin {s : Heap α} (h : s.WF le)\n (eq : s.deleteMin le = some (a, s')) : s'.WF le := by\n cases h with cases eq | node h => exact Heap.WF.combine h\n\ntheorem Heap.WF.tail? (hwf : (s : Heap α).WF le) : s.tail? le = some tl →\n tl.WF le := by\n simp only [Heap.tail?]; intro eq\n match eq₂ : s.deleteMin le, eq with\n | some (a, tl), rfl => exact hwf.deleteMin eq₂\n\ntheorem Heap.WF.tail (hwf : (s : Heap α).WF le) : (s.tail le).WF le := by\n simp only [Heap.tail]\n match eq : s.tail? le with\n | none => exact Heap.WF.nil\n | some tl => exact hwf.tail? eq\n\ntheorem Heap.deleteMin_fst : ((s : Heap α).deleteMin le).map (·.1) = s.head? :=\n match s with\n | .nil => rfl\n | .node _ _ _ => rfl\n\nend PairingHeapImp\n\nopen PairingHeapImp\n\n/--\nA [pairing heap](https://en.wikipedia.org/wiki/Pairing_heap) is a data structure which supports\nthe following primary operations:\n\n* `insert : α → PairingHeap α → PairingHeap α`: add an element to the heap\n* `deleteMin : PairingHeap α → Option (α × PairingHeap α)`:\n remove the minimum element from the heap\n* `merge : PairingHeap α → PairingHeap α → PairingHeap α`: combine two heaps\n\nThe first two operations are known as a \"priority queue\", so this could be called\na \"mergeable priority queue\". The standard choice for a priority queue is a binary heap,\nwhich supports `insert` and `deleteMin` in `O(log n)`, but `merge` is `O(n)`.\nWith a `PairingHeap`, `insert` and `merge` are `O(1)`, `deleteMin` is amortized `O(log n)`.\n\nNote that `deleteMin` may be `O(n)` in a single operation. So if you need an efficient\npersistent priority queue, you should use other data structures with better worst-case time.\n-/\ndef PairingHeap (α : Type u) (le : α → α → Bool) :=\n { h : Heap α // h.WF le }\n\n/-- `O(1)`. Make a new empty pairing heap. -/\n@[inline] def mkPairingHeap (α : Type u) (le : α → α → Bool) : PairingHeap α le :=\n ⟨.nil, Heap.WF.nil⟩\n\nnamespace PairingHeap\nvariable {α : Type u} {le : α → α → Bool}\n\n/-- `O(1)`. Make a new empty pairing heap. -/\n@[inline] def empty : PairingHeap α le := mkPairingHeap α le\n\ninstance : Inhabited (PairingHeap α le) := ⟨.empty⟩\n\n/-- `O(1)`. Is the heap empty? -/\n@[inline] def isEmpty (b : PairingHeap α le) : Bool := b.1.isEmpty\n\n/-- `O(n)`. The number of elements in the heap. -/\n@[inline] def size (b : PairingHeap α le) : Nat := b.1.size\n\n/-- `O(1)`. Make a new heap containing `a`. -/\n@[inline] def singleton (a : α) : PairingHeap α le :=\n ⟨Heap.singleton a, Heap.WF.singleton⟩\n\n/-- `O(1)`. Merge the contents of two heaps. -/\n@[inline] def merge : PairingHeap α le → PairingHeap α le → PairingHeap α le\n | ⟨b₁, h₁⟩, ⟨b₂, h₂⟩ => ⟨b₁.merge le b₂, h₁.merge h₂⟩\n\n/-- `O(1)`. Add element `a` to the given heap `h`. -/\n@[inline] def insert (a : α) (h : PairingHeap α le) : PairingHeap α le :=\n merge (singleton a) h\n\n/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/\ndef ofList (le : α → α → Bool) (as : List α) : PairingHeap α le :=\n as.foldl (flip insert) empty\n\n/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/\ndef ofArray (le : α → α → Bool) (as : Array α) : PairingHeap α le :=\n as.foldl (flip insert) empty\n\n/-- Amortized `O(log n)`. Remove and return the minimum element from the heap. -/\n@[inline] def deleteMin (b : PairingHeap α le) : Option (α × PairingHeap α le) :=\n match eq : b.1.deleteMin le with\n | none => none\n | some (a, tl) => some (a, ⟨tl, b.2.deleteMin eq⟩)\n\n/-- `O(1)`. Returns the smallest element in the heap, or `none` if the heap is empty. -/\n@[inline] def head? (b : PairingHeap α le) : Option α := b.1.head?\n\n/-- `O(1)`. Returns the smallest element in the heap, or panics if the heap is empty. -/\n@[inline] def head! [Inhabited α] (b : PairingHeap α le) : α := b.head?.get!\n\n/-- `O(1)`. Returns the smallest element in the heap, or `default` if the heap is empty. -/\n@[inline] def headI [Inhabited α] (b : PairingHeap α le) : α := b.head?.getD default\n\n/--\nAmortized `O(log n)`. Removes the smallest element from the heap, or `none` if the heap is empty.\n-/\n@[inline] def tail? (b : PairingHeap α le) : Option (PairingHeap α le) :=\n match eq : b.1.tail? le with\n | none => none\n | some tl => some ⟨tl, b.2.tail? eq⟩\n\n/-- Amortized `O(log n)`. Removes the smallest element from the heap, if possible. -/\n@[inline] def tail (b : PairingHeap α le) : PairingHeap α le := ⟨b.1.tail le, b.2.tail⟩\n\n/-- `O(n log n)`. Convert the heap to a list in increasing order. -/\n@[inline] def toList (b : PairingHeap α le) : List α := b.1.toList le\n\n/-- `O(n log n)`. Convert the heap to an array in increasing order. -/\n@[inline] def toArray (b : PairingHeap α le) : Array α := b.1.toArray le\n\n/-- `O(n)`. Convert the heap to a list in arbitrary order. -/\n@[inline] def toListUnordered (b : PairingHeap α le) : List α := b.1.toListUnordered\n\n/-- `O(n)`. Convert the heap to an array in arbitrary order. -/\n@[inline] def toArrayUnordered (b : PairingHeap α le) : Array α := b.1.toArrayUnordered\n" }, { "path": "Batteries/Data/RBMap/Alter.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.RBMap.WF\n\n@[expose] public section\n\n/-!\n# Path operations; `modify` and `alter`\n\nThis develops the necessary theorems to construct the `modify` and `alter` functions on `RBSet`\nusing path operations for in-place modification of an `RBTree`.\n-/\n\nnamespace Batteries\n\nnamespace RBNode\nopen RBColor\n\nattribute [simp] Path.fill\n\n/-! ## path balance -/\n\n/-- Asserts that property `p` holds on the root of the tree, if any. -/\ndef OnRoot (p : α → Prop) : RBNode α → Prop\n | nil => True\n | node _ _ x _ => p x\n\nnamespace Path\n\n/-- Same as `fill` but taking its arguments in a pair for easier composition with `zoom`. -/\n@[inline] def fill' : RBNode α × Path α → RBNode α := fun (t, path) => path.fill t\n\ntheorem zoom_fill' (cut : α → Ordering) (t : RBNode α) (path : Path α) :\n fill' (zoom cut t path) = path.fill t := by\n induction t generalizing path with\n | nil => rfl\n | node _ _ _ _ iha ihb => unfold zoom; split <;> [apply iha; apply ihb; rfl]\n\ntheorem zoom_fill (H : zoom cut t path = (t', path')) : path.fill t = path'.fill t' :=\n (H ▸ zoom_fill' cut t path).symm\n\nvariable (c₀ : RBColor) (n₀ : Nat) in\n/--\nThe balance invariant for a path. `path.Balanced c₀ n₀ c n` means that `path` is a red-black tree\nwith balance invariant `c₀, n₀`, but it has a \"hole\" where a tree with balance invariant `c, n`\nhas been removed. The defining property is `Balanced.fill`: if `path.Balanced c₀ n₀ c n` and you\nfill the hole with a tree satisfying `t.Balanced c n`, then `(path.fill t).Balanced c₀ n₀` .\n-/\nprotected inductive Balanced : Path α → RBColor → Nat → Prop where\n /-- The root of the tree is `c₀, n₀`-balanced by assumption. -/\n | protected root : Path.root.Balanced c₀ n₀\n /-- Descend into the left subtree of a red node. -/\n | redL : Balanced y black n → parent.Balanced red n →\n (Path.left red parent v y).Balanced black n\n /-- Descend into the right subtree of a red node. -/\n | redR : Balanced x black n → parent.Balanced red n →\n (Path.right red x v parent).Balanced black n\n /-- Descend into the left subtree of a black node. -/\n | blackL : Balanced y c₂ n → parent.Balanced black (n + 1) →\n (Path.left black parent v y).Balanced c₁ n\n /-- Descend into the right subtree of a black node. -/\n | blackR : Balanced x c₁ n → parent.Balanced black (n + 1) →\n (Path.right black x v parent).Balanced c₂ n\n\n/--\nThe defining property of a balanced path: If `path` is a `c₀,n₀` tree with a `c,n` hole,\nthen filling the hole with a `c,n` tree yields a `c₀,n₀` tree.\n-/\nprotected theorem Balanced.fill {path : Path α} {t} :\n path.Balanced c₀ n₀ c n → t.Balanced c n → (path.fill t).Balanced c₀ n₀\n | .root, h => h\n | .redL hb H, ha | .redR ha H, hb => H.fill (.red ha hb)\n | .blackL hb H, ha | .blackR ha H, hb => H.fill (.black ha hb)\n\nprotected theorem _root_.Batteries.RBNode.Balanced.zoom : t.Balanced c n → path.Balanced c₀ n₀ c n →\n zoom cut t path = (t', path') → ∃ c n, t'.Balanced c n ∧ path'.Balanced c₀ n₀ c n\n | .nil, hp => fun e => by cases e; exact ⟨_, _, .nil, hp⟩\n | .red ha hb, hp => by\n unfold zoom; split\n · exact ha.zoom (.redL hb hp)\n · exact hb.zoom (.redR ha hp)\n · intro e; cases e; exact ⟨_, _, .red ha hb, hp⟩\n | .black ha hb, hp => by\n unfold zoom; split\n · exact ha.zoom (.blackL hb hp)\n · exact hb.zoom (.blackR ha hp)\n · intro e; cases e; exact ⟨_, _, .black ha hb, hp⟩\n\nprotected theorem Balanced.ins {path : Path α}\n (hp : path.Balanced c₀ n₀ c n) (ht : t.RedRed (c = red) n) :\n ∃ n, (path.ins t).Balanced black n := by\n induction hp generalizing t with\n | root => exact ht.setBlack\n | redL hr hp ih => match ht with\n | .balanced .nil => exact ih (.balanced (.red .nil hr))\n | .balanced (.red ha hb) => exact ih (.redred rfl (.red ha hb) hr)\n | .balanced (.black ha hb) => exact ih (.balanced (.red (.black ha hb) hr))\n | redR hl hp ih => match ht with\n | .balanced .nil => exact ih (.balanced (.red hl .nil))\n | .balanced (.red ha hb) => exact ih (.redred rfl hl (.red ha hb))\n | .balanced (.black ha hb) => exact ih (.balanced (.red hl (.black ha hb)))\n | blackL hr _hp ih => exact have ⟨c, h⟩ := ht.balance1 hr; ih (.balanced h)\n | blackR hl _hp ih => exact have ⟨c, h⟩ := ht.balance2 hl; ih (.balanced h)\n\nprotected theorem Balanced.insertNew {path : Path α} (H : path.Balanced c n black 0) :\n ∃ n, (path.insertNew v).Balanced black n := H.ins (.balanced (.red .nil .nil))\n\nprotected theorem Balanced.del {path : Path α}\n (hp : path.Balanced c₀ n₀ c n) (ht : t.DelProp c' n) (hc : c = black → c' ≠ red) :\n ∃ n, (path.del t c').Balanced black n := by\n induction hp generalizing t c' with\n | root => match c', ht with\n | red, ⟨_, h⟩ | black, ⟨_, _, h⟩ => exact h.setBlack\n | @redL _ n _ _ hb hp ih => match c', n, ht with\n | red, _, _ => cases hc rfl rfl\n | black, _, ⟨_, rfl, ha⟩ => exact ih ((hb.balLeft ha).of_false nofun) nofun\n | @redR _ n _ _ ha hp ih => match c', n, ht with\n | red, _, _ => cases hc rfl rfl\n | black, _, ⟨_, rfl, hb⟩ => exact ih ((ha.balRight hb).of_false nofun) nofun\n | @blackL _ _ n _ _ _ hb hp ih => match c', n, ht with\n | red, _, ⟨_, ha⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ nofun\n | black, _, ⟨_, rfl, ha⟩ => exact ih ⟨_, rfl, (hb.balLeft ha).imp fun _ => ⟨⟩⟩ nofun\n | @blackR _ _ n _ _ _ ha hp ih => match c', n, ht with\n | red, _, ⟨_, hb⟩ => exact ih ⟨_, rfl, .redred ⟨⟩ ha hb⟩ nofun\n | black, _, ⟨_, rfl, hb⟩ => exact ih ⟨_, rfl, (ha.balRight hb).imp fun _ => ⟨⟩⟩ nofun\n\n/--\nThe property of a path returned by `t.zoom cut`. Each of the parents visited along the path have\nthe appropriate ordering relation to the cut.\n-/\ndef Zoomed (cut : α → Ordering) : Path α → Prop\n | .root => True\n | .left _ parent x _ => cut x = .lt ∧ parent.Zoomed cut\n | .right _ _ x parent => cut x = .gt ∧ parent.Zoomed cut\n\ntheorem zoom_zoomed₂ (e : zoom cut t path = (t', path'))\n (hp : path.Zoomed cut) : path'.Zoomed cut :=\n match t, e with\n | nil, rfl => hp\n | node .., e => by\n revert e; unfold zoom; split\n · next h => exact fun e => zoom_zoomed₂ e ⟨h, hp⟩\n · next h => exact fun e => zoom_zoomed₂ e ⟨h, hp⟩\n · intro e; cases e; exact hp\n\n/--\n`path.RootOrdered cmp v` is true if `v` would be able to fit into the hole\nwithout violating the ordering invariant.\n-/\ndef RootOrdered (cmp : α → α → Ordering) : Path α → α → Prop\n | .root, _ => True\n | .left _ parent x _, v => cmpLT cmp v x ∧ parent.RootOrdered cmp v\n | .right _ _ x parent, v => cmpLT cmp x v ∧ parent.RootOrdered cmp v\n\ntheorem _root_.Batteries.RBNode.cmpEq.RootOrdered_congr\n {cmp : α → α → Ordering} (h : cmpEq cmp a b) :\n ∀ {t : Path α}, t.RootOrdered cmp a ↔ t.RootOrdered cmp b\n | .root => .rfl\n | .left .. => and_congr h.lt_congr_left h.RootOrdered_congr\n | .right .. => and_congr h.lt_congr_right h.RootOrdered_congr\n\ntheorem Zoomed.toRootOrdered {cmp} :\n ∀ {path : Path α}, path.Zoomed (cmp v) → path.RootOrdered cmp v\n | .root, h => h\n | .left .., ⟨h, hp⟩ => ⟨⟨h⟩, hp.toRootOrdered⟩\n | .right .., ⟨h, hp⟩ => ⟨⟨Std.OrientedCmp.gt_iff_lt.1 h⟩, hp.toRootOrdered⟩\n\n/-- The ordering invariant for a `Path`. -/\ndef Ordered (cmp : α → α → Ordering) : Path α → Prop\n | .root => True\n | .left _ parent x b => parent.Ordered cmp ∧\n b.All (cmpLT cmp x ·) ∧ parent.RootOrdered cmp x ∧\n b.All (parent.RootOrdered cmp) ∧ b.Ordered cmp\n | .right _ a x parent => parent.Ordered cmp ∧\n a.All (cmpLT cmp · x) ∧ parent.RootOrdered cmp x ∧\n a.All (parent.RootOrdered cmp) ∧ a.Ordered cmp\n\nprotected theorem Ordered.fill : ∀ {path : Path α} {t},\n (path.fill t).Ordered cmp ↔ path.Ordered cmp ∧ t.Ordered cmp ∧ t.All (path.RootOrdered cmp)\n | .root, _ => ⟨fun H => ⟨⟨⟩, H, .trivial ⟨⟩⟩, (·.2.1)⟩\n | .left .., _ => by\n simp [Ordered.fill, RBNode.Ordered, Ordered, RootOrdered, All_and]\n exact ⟨\n fun ⟨hp, ⟨ax, xb, ha, hb⟩, ⟨xp, ap, bp⟩⟩ => ⟨⟨hp, xb, xp, bp, hb⟩, ha, ⟨ax, ap⟩⟩,\n fun ⟨⟨hp, xb, xp, bp, hb⟩, ha, ⟨ax, ap⟩⟩ => ⟨hp, ⟨ax, xb, ha, hb⟩, ⟨xp, ap, bp⟩⟩⟩\n | .right .., _ => by\n simp [Ordered.fill, RBNode.Ordered, Ordered, RootOrdered, All_and]\n exact ⟨\n fun ⟨hp, ⟨ax, xb, ha, hb⟩, ⟨xp, ap, bp⟩⟩ => ⟨⟨hp, ax, xp, ap, ha⟩, hb, ⟨xb, bp⟩⟩,\n fun ⟨⟨hp, ax, xp, ap, ha⟩, hb, ⟨xb, bp⟩⟩ => ⟨hp, ⟨ax, xb, ha, hb⟩, ⟨xp, ap, bp⟩⟩⟩\n\ntheorem _root_.Batteries.RBNode.Ordered.zoom' {t : RBNode α} {path : Path α}\n (ht : t.Ordered cmp) (hp : path.Ordered cmp) (tp : t.All (path.RootOrdered cmp))\n (pz : path.Zoomed cut) (eq : t.zoom cut path = (t', path')) :\n t'.Ordered cmp ∧ path'.Ordered cmp ∧ t'.All (path'.RootOrdered cmp) ∧ path'.Zoomed cut :=\n have ⟨hp', ht', tp'⟩ := Ordered.fill.1 <| zoom_fill eq ▸ Ordered.fill.2 ⟨hp, ht, tp⟩\n ⟨ht', hp', tp', zoom_zoomed₂ eq pz⟩\n\ntheorem _root_.Batteries.RBNode.Ordered.zoom {t : RBNode α}\n (ht : t.Ordered cmp) (eq : t.zoom cut = (t', path')) :\n t'.Ordered cmp ∧ path'.Ordered cmp ∧ t'.All (path'.RootOrdered cmp) ∧ path'.Zoomed cut :=\n ht.zoom' (path := .root) ⟨⟩ (.trivial ⟨⟩) ⟨⟩ eq\n\ntheorem Ordered.ins : ∀ {path : Path α} {t : RBNode α},\n t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.ins t).Ordered cmp\n | .root, _, ht, _, _ => Ordered.setBlack.2 ht\n | .left red parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by\n unfold Path.ins\n have ⟨ax, ap⟩ := All_and.1 H\n exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩\n | .right red a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by\n unfold Path.ins\n have ⟨xb, bp⟩ := All_and.1 H\n exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩\n | .left black parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by\n unfold Path.ins\n have ⟨ax, ap⟩ := All_and.1 H\n exact hp.ins (ha.balance1 ax xb hb) (balance1_All.2 ⟨xp, ap, bp⟩)\n | .right black a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by\n unfold Path.ins\n have ⟨xb, bp⟩ := All_and.1 H\n exact hp.ins (ha.balance2 ax xb hb) (balance2_All.2 ⟨xp, ap, bp⟩)\n\ntheorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.RootOrdered cmp v) :\n (path.insertNew v).Ordered cmp :=\n hp.ins ⟨⟨⟩, ⟨⟩, ⟨⟩, ⟨⟩⟩ ⟨vp, ⟨⟩, ⟨⟩⟩\n\ntheorem Ordered.del : ∀ {path : Path α} {t : RBNode α} {c},\n t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.del t c).Ordered cmp\n | .root, _, _, ht, _, _ => Ordered.setBlack.2 ht\n | .left _ parent x b, a, red, ha, ⟨hp, xb, xp, bp, hb⟩, H => by\n unfold Path.del\n have ⟨ax, ap⟩ := All_and.1 H\n exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩\n | .right _ a x parent, b, red, hb, ⟨hp, ax, xp, ap, ha⟩, H => by\n unfold Path.del\n have ⟨xb, bp⟩ := All_and.1 H\n exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩\n | .left _ parent x b, a, black, ha, ⟨hp, xb, xp, bp, hb⟩, H => by\n unfold Path.del\n have ⟨ax, ap⟩ := All_and.1 H\n exact hp.del (ha.balLeft ax xb hb) (ap.balLeft xp bp)\n | .right _ a x parent, b, black, hb, ⟨hp, ax, xp, ap, ha⟩, H => by\n unfold Path.del\n have ⟨xb, bp⟩ := All_and.1 H\n exact hp.del (ha.balRight ax xb hb) (ap.balRight xp bp)\n\nend Path\n\n/-! ## alter -/\n\n/-- The `alter` function preserves the ordering invariants. -/\nprotected theorem Ordered.alter {t : RBNode α}\n (H : ∀ {x t' p}, t.zoom cut = (t', p) → f t'.root? = some x →\n p.RootOrdered cmp x ∧ t'.OnRoot (cmpEq cmp x))\n (h : t.Ordered cmp) : (alter cut f t).Ordered cmp := by\n simp [alter]; split\n · next path eq =>\n have ⟨_, hp, _, _⟩ := h.zoom eq; split\n · exact h\n · next hf => exact hp.insertNew (H eq hf).1\n · next path eq =>\n have ⟨⟨ax, xb, ha, hb⟩, hp, ⟨_, ap, bp⟩, _⟩ := h.zoom eq; split\n · exact hp.del (ha.append ax xb hb) (ap.append bp)\n · next hf =>\n have ⟨yp, xy⟩ := H eq hf\n apply Path.Ordered.fill.2\n exact ⟨hp, ⟨ax.imp xy.lt_congr_right.2, xb.imp xy.lt_congr_left.2, ha, hb⟩, yp, ap, bp⟩\n\n/-- The `alter` function preserves the balance invariants. -/\nprotected theorem Balanced.alter {t : RBNode α}\n (h : t.Balanced c n) : ∃ c n, (t.alter cut f).Balanced c n := by\n simp [alter]; split\n · next path eq =>\n split\n · exact ⟨_, _, h⟩\n · have ⟨_, _, .nil, h⟩ := h.zoom .root eq\n exact ⟨_, h.insertNew⟩\n · next path eq =>\n have ⟨_, _, h, hp⟩ := h.zoom .root eq\n split\n · match h with\n | .red ha hb => exact ⟨_, hp.del ((ha.append hb).of_false (· rfl rfl)) nofun⟩\n | .black ha hb => exact ⟨_, hp.del ⟨_, rfl, (ha.append hb).imp fun _ => ⟨⟩⟩ nofun⟩\n · match h with\n | .red ha hb => exact ⟨_, _, hp.fill (.red ha hb)⟩\n | .black ha hb => exact ⟨_, _, hp.fill (.black ha hb)⟩\n\ntheorem modify_eq_alter (t : RBNode α) : t.modify cut f = t.alter cut (.map f) := by\n simp [modify, alter]\n\n/-- The `modify` function preserves the ordering invariants. -/\nprotected theorem Ordered.modify {t : RBNode α}\n (H : (t.zoom cut).1.OnRoot fun x => cmpEq cmp (f x) x)\n (h : t.Ordered cmp) : (modify cut f t).Ordered cmp :=\n modify_eq_alter _ ▸ h.alter @fun\n | _, .node .., _, eq, rfl => by\n rw [eq] at H; exact ⟨H.RootOrdered_congr.2 (h.zoom eq).2.2.1.1, H⟩\n\n/-- The `modify` function preserves the balance invariants. -/\nprotected theorem Balanced.modify {t : RBNode α}\n (h : t.Balanced c n) : ∃ c n, (t.modify cut f).Balanced c n := modify_eq_alter _ ▸ h.alter\n\ntheorem WF.alter {t : RBNode α}\n (H : ∀ {x t' p}, t.zoom cut = (t', p) → f t'.root? = some x →\n p.RootOrdered cmp x ∧ t'.OnRoot (cmpEq cmp x))\n (h : WF cmp t) : WF cmp (alter cut f t) :=\n let ⟨h₁, _, _, h₂⟩ := h.out; WF_iff.2 ⟨h₁.alter H, h₂.alter⟩\n\ntheorem WF.modify {t : RBNode α}\n (H : (t.zoom cut).1.OnRoot fun x => cmpEq cmp (f x) x)\n (h : WF cmp t) : WF cmp (t.modify cut f) :=\n let ⟨h₁, _, _, h₂⟩ := h.out; WF_iff.2 ⟨h₁.modify H, h₂.modify⟩\n\ntheorem find?_eq_zoom : ∀ {t : RBNode α} (p := .root), t.find? cut = (t.zoom cut p).1.root?\n | .nil, _ => rfl\n | .node .., _ => by unfold find? zoom; split <;> [apply find?_eq_zoom; apply find?_eq_zoom; rfl]\n\nend RBNode\n\nnamespace RBSet\nopen RBNode\n\n/--\nA sufficient condition for `ModifyWF` is that the new element compares equal to the original.\n-/\ntheorem ModifyWF.of_eq {t : RBSet α cmp}\n (H : ∀ {x}, RBNode.find? cut t.val = some x → cmpEq cmp (f x) x) : ModifyWF t cut f := by\n refine ⟨.modify ?_ t.2⟩\n revert H; rw [find?_eq_zoom]\n cases (t.1.zoom cut).1 <;> intro H <;> [trivial; exact H rfl]\n\nend RBSet\n\nnamespace RBMap\n\n/--\n`O(log n)`. In-place replace the corresponding to key `k`.\nThis takes the element out of the tree while `f` runs,\nso it uses the element linearly if `t` is unshared.\n-/\ndef modify (t : RBMap α β cmp) (k : α) (f : β → β) : RBMap α β cmp :=\n @RBSet.modifyP _ _ t (cmp k ·.1) (fun (a, b) => (a, f b))\n (.of_eq fun _ => ⟨Std.ReflCmp.compare_self (cmp := Ordering.byKey Prod.fst cmp)⟩)\n\n/-- Auxiliary definition for `alter`. -/\ndef alter.adapt (k : α) (f : Option β → Option β) : Option (α × β) → Option (α × β)\n | none =>\n match f none with\n | none => none\n | some v => some (k, v)\n | some (k', v') =>\n match f (some v') with\n | none => none\n | some v => some (k', v)\n\n/--\n`O(log n)`. `alterP cut f t` simultaneously handles inserting, erasing and replacing an element\nusing a function `f : Option α → Option α`. It is passed the result of `t.findP? cut`\nand can either return `none` to remove the element or `some a` to replace/insert\nthe element with `a` (which must have the same ordering properties as the original element).\n\nThe element is used linearly if `t` is unshared.\n\nThe `AlterWF` assumption is required because `f` may change\nthe ordering properties of the element, which would break the invariants.\n-/\n@[specialize] def alter\n (t : RBMap α β cmp) (k : α) (f : Option β → Option β) : RBMap α β cmp := by\n refine @RBSet.alterP _ _ t (cmp k ·.1) (alter.adapt k f) ⟨.alter (@fun _ t' p eq => ?_) t.2⟩\n cases t' <;> simp [alter.adapt, RBNode.root?] <;> split <;> intro h <;> cases h\n · exact ⟨(t.2.out.1.zoom eq).2.2.2.toRootOrdered, ⟨⟩⟩\n · refine ⟨(?a).RootOrdered_congr.2 (t.2.out.1.zoom eq).2.2.1.1, ?a⟩\n exact ⟨Std.ReflCmp.compare_self (cmp := Ordering.byKey Prod.fst cmp)⟩\n\nend RBMap\n" }, { "path": "Batteries/Data/RBMap/Basic.lean", "content": "/-\nCopyright (c) 2017 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Classes.Order\npublic import Batteries.Control.ForInStep.Basic\npublic import Batteries.Tactic.Lint.Misc\n\n@[expose] public section\n\n/-!\n# Red-black trees\n\nNote: users are recommended to use `Std.TreeMap` instead of `Batteries.RBMap`.\n`Std.TreeMap` is a mostly drop-in replacement (notably, there is no `ToStream` instance yet),\nand has more complete and consistent API. This implementation will eventually be deprecated.\n\nThis module implements a type `RBMap α β cmp` which is a functional data structure for\nstoring a key-value store in a binary search tree.\n\nIt is built on the simpler `RBSet α cmp` type, which stores a set of values of type `α`\nusing the function `cmp : α → α → Ordering` for determining the ordering relation.\nThe tree will never store two elements that compare `.eq` under the `cmp` function,\nbut the function does not have to satisfy `cmp x y = .eq → x = y`, and in the map case\n`α` is a key-value pair and the `cmp` function only compares the keys.\n-/\n\nnamespace Batteries\n\n/--\nIn a red-black tree, every node has a color which is either \"red\" or \"black\"\n(this particular choice of colors is conventional). A nil node is considered black.\n-/\ninductive RBColor where\n /-- A red node is required to have black children. -/\n | red\n /-- Every path from the root to a leaf must pass through the same number of black nodes. -/\n | black\n deriving Repr\n\n/--\nA red-black tree. (This is an internal implementation detail of the `RBSet` type,\nwhich includes the invariants of the tree.) This is a binary search tree augmented with\na \"color\" field which is either red or black for each node and used to implement\nthe re-balancing operations.\nSee: [Red–black tree](https://en.wikipedia.org/wiki/Red%E2%80%93black_tree)\n-/\ninductive RBNode (α : Type u) where\n /-- An empty tree. -/\n | nil\n /-- A node consists of a value `v`, a subtree `l` of smaller items,\n and a subtree `r` of larger items. The color `c` is either `red` or `black`\n and participates in the red-black balance invariant (see `Balanced`). -/\n | node (c : RBColor) (l : RBNode α) (v : α) (r : RBNode α)\n deriving Repr\n\nnamespace RBNode\nopen RBColor\n\ninstance : EmptyCollection (RBNode α) := ⟨nil⟩\n\n/-- The minimum element of a tree is the left-most value. -/\nprotected def min? : RBNode α → Option α\n | nil => none\n | node _ nil v _ => some v\n | node _ l _ _ => l.min?\n\n/-- The maximum element of a tree is the right-most value. -/\nprotected def max? : RBNode α → Option α\n | nil => none\n | node _ _ v nil => some v\n | node _ _ _ r => r.max?\n\n/--\nFold a function in tree order along the nodes. `v₀` is used at `nil` nodes and\n`f` is used to combine results at branching nodes.\n-/\n@[specialize] def fold (v₀ : σ) (f : σ → α → σ → σ) : RBNode α → σ\n | nil => v₀\n | node _ l v r => f (l.fold v₀ f) v (r.fold v₀ f)\n\n/-- Fold a function on the values from left to right (in increasing order). -/\n@[specialize] def foldl (f : σ → α → σ) : (init : σ) → RBNode α → σ\n | b, nil => b\n | b, node _ l v r => foldl f (f (foldl f b l) v) r\n\n/-- Fold a function on the values from right to left (in decreasing order). -/\n@[specialize] def foldr (f : α → σ → σ) : RBNode α → (init : σ) → σ\n | nil, b => b\n | node _ l v r, b => l.foldr f <| f v <| r.foldr f b\n\n/-- `O(n)`. Convert the tree to a list in ascending order. -/\ndef toList (t : RBNode α) : List α := t.foldr (·::·) []\n\n/-- Run monadic function `f` on each element of the tree (in increasing order). -/\n@[specialize] def forM [Monad m] (f : α → m PUnit) : RBNode α → m PUnit\n | nil => pure ⟨⟩\n | node _ l v r => do forM f l; f v; forM f r\n\n/-- Fold a monadic function on the values from left to right (in increasing order). -/\n@[specialize] def foldlM [Monad m] (f : σ → α → m σ) : (init : σ) → RBNode α → m σ\n | b, nil => pure b\n | b, node _ l v r => do foldlM f (← f (← foldlM f b l) v) r\n\n/-- Implementation of `for x in t` loops over a `RBNode` (in increasing order). -/\n@[inline] protected def forIn [Monad m]\n (as : RBNode α) (init : σ) (f : α → σ → m (ForInStep σ)) : m σ := do\n ForInStep.run <$> visit as init\nwhere\n /-- Inner loop of `forIn`. -/\n @[specialize] visit : RBNode α → σ → m (ForInStep σ)\n | nil, b => return ForInStep.yield b\n | node _ l v r, b => ForInStep.bindM (visit l b) fun b => ForInStep.bindM (f v b) (visit r ·)\n\ninstance [Monad m] : ForIn m (RBNode α) α where\n forIn := RBNode.forIn\n\n/--\nAn auxiliary data structure (an iterator) over an `RBNode` which lazily\npulls elements from the left.\n-/\nprotected inductive Stream (α : Type _)\n /-- The stream is empty. -/\n | nil\n /-- We are ready to deliver element `v` with right child `r`,\n and where `tail` represents all the subtrees we have yet to destructure. -/\n | cons (v : α) (r : RBNode α) (tail : RBNode.Stream α)\n\n/-- `O(log n)`. Turn a node into a stream, by descending along the left spine. -/\ndef toStream : RBNode α → (_ : RBNode.Stream α := .nil) → RBNode.Stream α\n | nil, acc => acc\n | node _ l v r, acc => toStream l (.cons v r acc)\n\nnamespace Stream\n\n/-- `O(1)` amortized, `O(log n)` worst case: Get the next element from the stream. -/\ndef next? : RBNode.Stream α → Option (α × RBNode.Stream α)\n | nil => none\n | cons v r tail => some (v, toStream r tail)\n\n/-- Fold a function on the values from left to right (in increasing order). -/\n@[specialize] def foldl (f : σ → α → σ) : (init : σ) → RBNode.Stream α → σ\n | b, nil => b\n | b, cons v r tail => foldl f (r.foldl f (f b v)) tail\n\n/-- Fold a function on the values from right to left (in decreasing order). -/\n@[specialize] def foldr (f : α → σ → σ) : RBNode.Stream α → (init : σ) → σ\n | nil, b => b\n | cons v r tail, b => f v <| r.foldr f <| tail.foldr f b\n\n/-- `O(n)`. Convert the stream to a list in ascending order. -/\ndef toList (t : RBNode.Stream α) : List α := t.foldr (·::·) []\n\nend Stream\n\ninstance : Std.ToStream (RBNode α) (RBNode.Stream α) := ⟨(·.toStream)⟩\ninstance : Std.Stream (RBNode.Stream α) α := ⟨Stream.next?⟩\n\n/-- Returns `true` iff every element of the tree satisfies `p`. -/\n@[specialize] def all (p : α → Bool) : RBNode α → Bool\n | nil => true\n | node _ l v r => p v && all p l && all p r\n\n/-- Returns `true` iff any element of the tree satisfies `p`. -/\n@[specialize] def any (p : α → Bool) : RBNode α → Bool\n | nil => false\n | node _ l v r => p v || any p l || any p r\n\n/-- Asserts that `p` holds on every element of the tree. -/\ndef All (p : α → Prop) : RBNode α → Prop\n | nil => True\n | node _ l v r => p v ∧ All p l ∧ All p r\n\ntheorem All.imp (H : ∀ {x : α}, p x → q x) : ∀ {t : RBNode α}, t.All p → t.All q\n | nil => id\n | node .. => fun ⟨h, hl, hr⟩ => ⟨H h, hl.imp H, hr.imp H⟩\n\ntheorem all_iff {t : RBNode α} : t.all p ↔ t.All (p ·) := by\n induction t <;> simp [*, all, All, and_assoc]\n\ninstance {t : RBNode α} [DecidablePred p] : Decidable (t.All p) :=\n decidable_of_iff (t.all p) (by simp [all_iff])\n\n/-- Asserts that `p` holds on some element of the tree. -/\ndef Any (p : α → Prop) : RBNode α → Prop\n | nil => False\n | node _ l v r => p v ∨ Any p l ∨ Any p r\n\ntheorem any_iff {t : RBNode α} : t.any p ↔ t.Any (p ·) := by\n induction t <;> simp [*, any, Any, or_assoc]\n\ninstance {t : RBNode α} [DecidablePred p] : Decidable (t.Any p) :=\n decidable_of_iff (t.any p) (by simp [any_iff])\n\n/-- True if `x` is an element of `t` \"exactly\", i.e. up to equality, not the `cmp` relation. -/\ndef EMem (x : α) (t : RBNode α) : Prop := t.Any (x = ·)\n\ninstance : Membership α (RBNode α) where\n mem t x := EMem x t\n\n/-- True if the specified `cut` matches at least one element of of `t`. -/\ndef MemP (cut : α → Ordering) (t : RBNode α) : Prop := t.Any (cut · = .eq)\n\n/-- True if `x` is equivalent to an element of `t`. -/\n@[reducible] def Mem (cmp : α → α → Ordering) (x : α) (t : RBNode α) : Prop := MemP (cmp x) t\n\n-- These instances are put in a special namespace because they are usually not what users want\n-- when deciding membership in a RBSet, since this does a naive linear search through the tree.\n-- The real `O(log n)` instances are defined in `Data.RBMap.Lemmas`.\n@[nolint docBlame] scoped instance Slow.instDecidableEMem [DecidableEq α] {t : RBNode α} :\n Decidable (EMem x t) := inferInstanceAs (Decidable (Any ..))\n\n@[nolint docBlame] scoped instance Slow.instDecidableMemP {t : RBNode α} :\n Decidable (MemP cut t) := inferInstanceAs (Decidable (Any ..))\n\n@[nolint docBlame] scoped instance Slow.instDecidableMem {t : RBNode α} :\n Decidable (Mem cmp x t) := inferInstanceAs (Decidable (Any ..))\n\n/--\nAsserts that `t₁` and `t₂` have the same number of elements in the same order,\nand `R` holds pairwise between them. The tree structure is ignored.\n-/\n@[specialize] def all₂ (R : α → β → Bool) (t₁ : RBNode α) (t₂ : RBNode β) : Bool :=\n let result := StateT.run (s := t₂.toStream) <| t₁.forM fun a s => do\n let (b, s) ← s.next?\n bif R a b then pure (⟨⟩, s) else none\n result matches some (_, .nil)\n\ninstance [BEq α] : BEq (RBNode α) where\n beq a b := a.all₂ (· == ·) b\n\n/--\nWe say that `x < y` under the comparator `cmp` if `cmp x y = .lt`.\n\n* In order to avoid assuming the comparator is always lawful, we use a\n local `∀ [Std.TransCmp cmp]` binder in the relation so that the ordering\n properties of the tree only need to hold if the comparator is lawful.\n* The `Nonempty` wrapper is a no-op because this is already a proposition,\n but it prevents the `[Std.TransCmp cmp]` binder from being introduced when we don't want it.\n-/\ndef cmpLT (cmp : α → α → Ordering) (x y : α) : Prop :=\n Nonempty (∀ [Std.TransCmp cmp], cmp x y = .lt)\n\ntheorem cmpLT_iff [Std.TransCmp cmp] : cmpLT cmp x y ↔ cmp x y = .lt :=\n ⟨fun ⟨h⟩ => h, (⟨·⟩)⟩\n\ninstance (cmp) [Std.TransCmp cmp] : Decidable (cmpLT cmp x y) := decidable_of_iff' _ cmpLT_iff\n\n/-- We say that `x ≈ y` under the comparator `cmp` if `cmp x y = .eq`. See also `cmpLT`. -/\ndef cmpEq (cmp : α → α → Ordering) (x y : α) : Prop :=\n Nonempty (∀ [Std.TransCmp cmp], cmp x y = .eq)\n\ntheorem cmpEq_iff [Std.TransCmp cmp] : cmpEq cmp x y ↔ cmp x y = .eq := ⟨fun ⟨h⟩ => h, (⟨·⟩)⟩\n\ninstance (cmp) [Std.TransCmp cmp] : Decidable (cmpEq cmp x y) := decidable_of_iff' _ cmpEq_iff\n\n/-- `O(n)`. Verifies an ordering relation on the nodes of the tree. -/\ndef isOrdered (cmp : α → α → Ordering)\n (t : RBNode α) (l : Option α := none) (r : Option α := none) : Bool :=\n match t with\n | nil =>\n match l, r with\n | some l, some r => cmp l r = .lt\n | _, _ => true\n | node _ a v b => isOrdered cmp a l v && isOrdered cmp b v r\n\n/-- The first half of Okasaki's `balance`, concerning red-red sequences in the left child. -/\n@[inline] def balance1 : RBNode α → α → RBNode α → RBNode α\n | node red (node red a x b) y c, z, d\n | node red a x (node red b y c), z, d => node red (node black a x b) y (node black c z d)\n | a, x, b => node black a x b\n\n/-- The second half of Okasaki's `balance`, concerning red-red sequences in the right child. -/\n@[inline] def balance2 : RBNode α → α → RBNode α → RBNode α\n | a, x, node red b y (node red c z d)\n | a, x, node red (node red b y c) z d => node red (node black a x b) y (node black c z d)\n | a, x, b => node black a x b\n\n/-- Returns `red` if the node is red, otherwise `black`. (Nil nodes are treated as `black`.) -/\n@[inline] def isRed : RBNode α → RBColor\n | node c .. => c\n | _ => black\n\n/--\nReturns `black` if the node is black, otherwise `red`.\n(Nil nodes are treated as `red`, which is not the usual convention but useful for deletion.)\n-/\n@[inline] def isBlack : RBNode α → RBColor\n | node c .. => c\n | _ => red\n\n/-- Changes the color of the root to `black`. -/\ndef setBlack : RBNode α → RBNode α\n | nil => nil\n | node _ l v r => node black l v r\n\n/-- `O(n)`. Reverses the ordering of the tree without any rebalancing. -/\n@[simp] def reverse : RBNode α → RBNode α\n | nil => nil\n | node c l v r => node c r.reverse v l.reverse\n\nsection Insert\n\n/--\nThe core of the `insert` function. This adds an element `x` to a balanced red-black tree.\nImportantly, the result of calling `ins` is not a proper red-black tree,\nbecause it has a broken balance invariant.\n(See `Balanced.ins` for the balance invariant of `ins`.)\nThe `insert` function does the final fixup needed to restore the invariant.\n-/\n@[specialize] def ins (cmp : α → α → Ordering) (x : α) : RBNode α → RBNode α\n | nil => node red nil x nil\n | node red a y b =>\n match cmp x y with\n | Ordering.lt => node red (ins cmp x a) y b\n | Ordering.gt => node red a y (ins cmp x b)\n | Ordering.eq => node red a x b\n | node black a y b =>\n match cmp x y with\n | Ordering.lt => balance1 (ins cmp x a) y b\n | Ordering.gt => balance2 a y (ins cmp x b)\n | Ordering.eq => node black a x b\n\n/--\n`insert cmp t v` inserts element `v` into the tree, using the provided comparator\n`cmp` to put it in the right place and automatically rebalancing the tree as necessary.\n-/\n@[specialize] def insert (cmp : α → α → Ordering) (t : RBNode α) (v : α) : RBNode α :=\n match isRed t with\n | red => (ins cmp v t).setBlack\n | black => ins cmp v t\n\nend Insert\n\n/-- Recolor the root of the tree to `red` if possible. -/\ndef setRed : RBNode α → RBNode α\n | node _ a v b => node red a v b\n | nil => nil\n\n/-- Rebalancing a tree which has shrunk on the left. -/\ndef balLeft (l : RBNode α) (v : α) (r : RBNode α) : RBNode α :=\n match l with\n | node red a x b => node red (node black a x b) v r\n | l => match r with\n | node black a y b => balance2 l v (node red a y b)\n | node red (node black a y b) z c => node red (node black l v a) y (balance2 b z (setRed c))\n | r => node red l v r -- unreachable\n\n/-- Rebalancing a tree which has shrunk on the right. -/\ndef balRight (l : RBNode α) (v : α) (r : RBNode α) : RBNode α :=\n match r with\n | node red b y c => node red l v (node black b y c)\n | r => match l with\n | node black a x b => balance1 (node red a x b) v r\n | node red a x (node black b y c) => node red (balance1 (setRed a) x b) y (node black c v r)\n | l => node red l v r -- unreachable\n\n/-- The number of nodes in the tree. -/\n@[simp] def size : RBNode α → Nat\n | nil => 0\n | node _ x _ y => x.size + y.size + 1\n\n/-- Concatenate two trees with the same black-height. -/\ndef append : RBNode α → RBNode α → RBNode α\n | nil, x | x, nil => x\n | node red a x b, node red c y d =>\n match append b c with\n | node red b' z c' => node red (node red a x b') z (node red c' y d)\n | bc => node red a x (node red bc y d)\n | node black a x b, node black c y d =>\n match append b c with\n | node red b' z c' => node red (node black a x b') z (node black c' y d)\n | bc => balLeft a x (node black bc y d)\n | a@(node black ..), node red b x c => node red (append a b) x c\n | node red a x b, c@(node black ..) => node red a x (append b c)\ntermination_by x y => x.size + y.size\n\n/-! ## erase -/\n\n/--\nThe core of the `erase` function. The tree returned from this function has a broken invariant,\nwhich is restored in `erase`.\n-/\n@[specialize] def del (cut : α → Ordering) : RBNode α → RBNode α\n | nil => nil\n | node _ a y b =>\n match cut y with\n | .lt => match a.isBlack with\n | black => balLeft (del cut a) y b\n | red => node red (del cut a) y b\n | .gt => match b.isBlack with\n | black => balRight a y (del cut b)\n | red => node red a y (del cut b)\n | .eq => append a b\n\n/--\nThe `erase cut t` function removes an element from the tree `t`.\nThe `cut` function is used to locate an element in the tree:\nit returns `.gt` if we go too high and `.lt` if we go too low;\nif it returns `.eq` we will remove the element.\n(The function `cmp k` for some key `k` is a valid cut function, but we can also use cuts that\nare not of this form as long as they are suitably monotonic.)\n-/\n@[specialize] def erase (cut : α → Ordering) (t : RBNode α) : RBNode α := (del cut t).setBlack\n\n/-- Finds an element in the tree satisfying the `cut` function. -/\n@[specialize] def find? (cut : α → Ordering) : RBNode α → Option α\n | nil => none\n | node _ a y b =>\n match cut y with\n | .lt => find? cut a\n | .gt => find? cut b\n | .eq => some y\n\n/-- `upperBound? cut` retrieves the smallest entry larger than or equal to `cut`, if it exists. -/\n@[specialize] def upperBound? (cut : α → Ordering) : RBNode α → (ub : Option α := .none) → Option α\n | nil, ub => ub\n | node _ a y b, ub =>\n match cut y with\n | .lt => upperBound? cut a (some y)\n | .gt => upperBound? cut b ub\n | .eq => some y\n\n/-- `lowerBound? cut` retrieves the largest entry smaller than or equal to `cut`, if it exists. -/\n@[specialize] def lowerBound? (cut : α → Ordering) : RBNode α → (lb : Option α := .none) → Option α\n | nil, lb => lb\n | node _ a y b, lb =>\n match cut y with\n | .lt => lowerBound? cut a lb\n | .gt => lowerBound? cut b (some y)\n | .eq => some y\n\n/-- Returns the root of the tree, if any. -/\ndef root? : RBNode α → Option α\n | nil => none\n | node _ _ v _ => some v\n\n/--\n`O(n)`. Map a function on every value in the tree.\nThis requires `IsMonotone` on the function in order to preserve the order invariant.\n-/\n@[specialize] def map (f : α → β) : RBNode α → RBNode β\n | nil => nil\n | node c l v r => node c (l.map f) (f v) (r.map f)\n\n/-- Converts the tree into an array in increasing sorted order. -/\ndef toArray (n : RBNode α) : Array α := n.foldl (init := #[]) (·.push ·)\n\n/--\nA `RBNode.Path α` is a \"cursor\" into an `RBNode` which represents the path\nfrom the root to a subtree. Note that the path goes from the target subtree\nup to the root, which is reversed from the normal way data is stored in the tree.\nSee [Zipper](https://en.wikipedia.org/wiki/Zipper_(data_structure)) for more information.\n-/\ninductive Path (α : Type u) where\n /-- The root of the tree, which is the end of the path of parents. -/\n | root\n /-- A path that goes down the left subtree. -/\n | left (c : RBColor) (parent : Path α) (v : α) (r : RBNode α)\n /-- A path that goes down the right subtree. -/\n | right (c : RBColor) (l : RBNode α) (v : α) (parent : Path α)\n\n/-- Fills the `Path` with a subtree. -/\ndef Path.fill : Path α → RBNode α → RBNode α\n | .root, t => t\n | .left c parent y b, a\n | .right c a y parent, b => parent.fill (node c a y b)\n\n/--\nLike `find?`, but instead of just returning the element, it returns the entire subtree\nat the element and a path back to the root for reconstructing the tree.\n-/\n@[specialize] def zoom (cut : α → Ordering) : RBNode α → (e : Path α := .root) → RBNode α × Path α\n | nil, path => (nil, path)\n | n@(node c a y b), path =>\n match cut y with\n | .lt => zoom cut a (.left c path y b)\n | .gt => zoom cut b (.right c a y path)\n | .eq => (n, path)\n\n/--\nThis function does the second part of `RBNode.ins`,\nwhich unwinds the stack and rebuilds the tree.\n-/\ndef Path.ins : Path α → RBNode α → RBNode α\n | .root, t => t.setBlack\n | .left red parent y b, a\n | .right red a y parent, b => parent.ins (node red a y b)\n | .left black parent y b, a => parent.ins (balance1 a y b)\n | .right black a y parent, b => parent.ins (balance2 a y b)\n\n/--\n`path.insertNew v` inserts element `v` into the tree, assuming that `path` is zoomed in\non a `nil` node such that inserting a new element at this position is valid.\n-/\n@[inline] def Path.insertNew (path : Path α) (v : α) : RBNode α :=\n path.ins (node red nil v nil)\n\n/--\n`path.insert t v` inserts element `v` into the tree, assuming that `(t, path)` was the result of a\nprevious `zoom` operation (so either the root of `t` is equivalent to `v` or it is empty).\n-/\ndef Path.insert (path : Path α) (t : RBNode α) (v : α) : RBNode α :=\n match t with\n | nil => path.insertNew v\n | node c a _ b => path.fill (node c a v b)\n\n/--\n`path.del t c` does the second part of `RBNode.del`, which unwinds the stack\nand rebuilds the tree. The `c` argument is the color of the node before the deletion\n(we used `t₀.isBlack` for this in `RBNode.del` but the original tree is no longer\navailable in this formulation).\n-/\ndef Path.del : Path α → RBNode α → RBColor → RBNode α\n | .root, t, _ => t.setBlack\n | .left c parent y b, a, red\n | .right c a y parent, b, red => parent.del (node red a y b) c\n | .left c parent y b, a, black => parent.del (balLeft a y b) c\n | .right c a y parent, b, black => parent.del (balRight a y b) c\n\n/--\n`path.erase t v` removes the root element of `t` from the tree, assuming that `(t, path)` was\nthe result of a previous `zoom` operation.\n-/\ndef Path.erase (path : Path α) (t : RBNode α) : RBNode α :=\n match t with\n | nil => path.fill nil\n | node c a _ b => path.del (a.append b) c\n\n/--\n`modify cut f t` uses `cut` to find an element,\nthen modifies the element using `f` and reinserts it into the tree.\n\nBecause the tree structure is not modified,\n`f` must not modify the ordering properties of the element.\n\nThe element in `t` is used linearly if `t` is unshared.\n-/\n@[specialize] def modify (cut : α → Ordering) (f : α → α) (t : RBNode α) : RBNode α :=\n match zoom cut t with\n | (nil, _) => t -- TODO: profile whether it would be better to use `path.fill nil` here\n | (node c a x b, path) => path.fill (node c a (f x) b)\n\n/--\n`alter cut f t` simultaneously handles inserting, erasing and replacing an element\nusing a function `f : Option α → Option α`. It is passed the result of `t.find? cut`\nand can either return `none` to remove the element or `some a` to replace/insert\nthe element with `a` (which must have the same ordering properties as the original element).\n\nThe element is used linearly if `t` is unshared.\n-/\n@[specialize] def alter (cut : α → Ordering) (f : Option α → Option α) (t : RBNode α) : RBNode α :=\n match zoom cut t with\n | (nil, path) =>\n match f none with\n | none => t -- TODO: profile whether it would be better to use `path.fill nil` here\n | some y => path.insertNew y\n | (node c a x b, path) =>\n match f (some x) with\n | none => path.del (a.append b) c\n | some y => path.fill (node c a y b)\n\n/--\nThe ordering invariant of a red-black tree, which is a binary search tree.\nThis says that every element of a left subtree is less than the root, and\nevery element in the right subtree is greater than the root, where the\nless than relation `x < y` is understood to mean `cmp x y = .lt`.\n\nBecause we do not assume that `cmp` is lawful when stating this property,\nwe write it in such a way that if `cmp` is not lawful then the condition holds trivially.\nThat way we can prove the ordering invariants without assuming `cmp` is lawful.\n-/\ndef Ordered (cmp : α → α → Ordering) : RBNode α → Prop\n | nil => True\n | node _ a x b => a.All (cmpLT cmp · x) ∧ b.All (cmpLT cmp x ·) ∧ a.Ordered cmp ∧ b.Ordered cmp\n\n-- This is in the Slow namespace because it is `O(n^2)` where a `O(n)` algorithm exists\n-- (see `isOrdered_iff` in `Data.RBMap.Lemmas`). Prefer `isOrdered` or the other instance.\n@[nolint docBlame] scoped instance Slow.instDecidableOrdered (cmp) [Std.TransCmp cmp] :\n ∀ t : RBNode α, Decidable (Ordered cmp t)\n | nil => inferInstanceAs (Decidable True)\n | node _ a _ b =>\n haveI := instDecidableOrdered cmp a\n haveI := instDecidableOrdered cmp b\n inferInstanceAs (Decidable (And ..))\n\n/--\nThe red-black balance invariant. `Balanced t c n` says that the color of the root node is `c`,\nand the black-height (the number of black nodes on any path from the root) of the tree is `n`.\nAdditionally, every red node must have black children.\n-/\ninductive Balanced : RBNode α → RBColor → Nat → Prop where\n /-- A nil node is balanced with black-height 0, and it is considered black. -/\n | protected nil : Balanced nil black 0\n /-- A red node is balanced with black-height `n`\n if its children are both black with with black-height `n`. -/\n | protected red : Balanced x black n → Balanced y black n → Balanced (node red x v y) red n\n /-- A black node is balanced with black-height `n + 1`\n if its children both have black-height `n`. -/\n | protected black : Balanced x c₁ n → Balanced y c₂ n → Balanced (node black x v y) black (n + 1)\n\n/--\nThe well-formedness invariant for a red-black tree. The first constructor is the real invariant,\nand the others allow us to \"cheat\" in this file and define `insert` and `erase`,\nwhich have more complex proofs that are delayed to `Batteries.Data.RBMap.Lemmas`.\n-/\ninductive WF (cmp : α → α → Ordering) : RBNode α → Prop\n /-- The actual well-formedness invariant: a red-black tree has the\n ordering and balance invariants. -/\n | mk : t.Ordered cmp → t.Balanced c n → WF cmp t\n /-- Inserting into a well-formed tree yields another well-formed tree.\n (See `Ordered.insert` and `Balanced.insert` for the actual proofs.) -/\n | insert : WF cmp t → WF cmp (t.insert cmp a)\n /-- Erasing from a well-formed tree yields another well-formed tree.\n (See `Ordered.erase` and `Balanced.erase` for the actual proofs.) -/\n | erase : WF cmp t → WF cmp (t.erase cut)\n\nend RBNode\n\nopen RBNode\n\n/--\nAn `RBSet` is a self-balancing binary search tree.\nThe `cmp` function is the comparator that will be used for performing searches;\nit should satisfy the requirements of `TransCmp` for it to have sensible behavior.\n-/\ndef RBSet (α : Type u) (cmp : α → α → Ordering) : Type u := {t : RBNode α // t.WF cmp}\n\n/-- `O(1)`. Construct a new empty tree. -/\n@[inline] def mkRBSet (α : Type u) (cmp : α → α → Ordering) : RBSet α cmp := ⟨.nil, .mk ⟨⟩ .nil⟩\n\nnamespace RBSet\n\n/-- `O(1)`. Construct a new empty tree. -/\n@[inline] def empty : RBSet α cmp := mkRBSet ..\n\ninstance (α : Type u) (cmp : α → α → Ordering) : EmptyCollection (RBSet α cmp) := ⟨empty⟩\n\ninstance (α : Type u) (cmp : α → α → Ordering) : Inhabited (RBSet α cmp) := ⟨∅⟩\n\n/-- `O(1)`. Construct a new tree with one element `v`. -/\n@[inline] def single (v : α) : RBSet α cmp :=\n ⟨.node .red .nil v .nil, .mk ⟨⟨⟩, ⟨⟩, ⟨⟩, ⟨⟩⟩ (.red .nil .nil)⟩\n\n/-- `O(n)`. Fold a function on the values from left to right (in increasing order). -/\n@[inline] def foldl (f : σ → α → σ) (init : σ) (t : RBSet α cmp) : σ := t.1.foldl f init\n\n/-- `O(n)`. Fold a function on the values from right to left (in decreasing order). -/\n@[inline] def foldr (f : α → σ → σ) (init : σ) (t : RBSet α cmp) : σ := t.1.foldr f init\n\n/-- `O(n)`. Fold a monadic function on the values from left to right (in increasing order). -/\n@[inline] def foldlM [Monad m] (f : σ → α → m σ) (init : σ) (t : RBSet α cmp) : m σ :=\n t.1.foldlM f init\n\n/-- `O(n)`. Run monadic function `f` on each element of the tree (in increasing order). -/\n@[inline] def forM [Monad m] (f : α → m PUnit) (t : RBSet α cmp) : m PUnit := t.1.forM f\n\ninstance [Monad m] : ForIn m (RBSet α cmp) α where\n forIn t := t.1.forIn\n\ninstance : Std.ToStream (RBSet α cmp) (RBNode.Stream α) := ⟨fun x => x.1.toStream .nil⟩\n\n/-- `O(1)`. Is the tree empty? -/\n@[inline] def isEmpty : RBSet α cmp → Bool\n | ⟨nil, _⟩ => true\n | _ => false\n\n/-- `O(n)`. Convert the tree to a list in ascending order. -/\n@[inline] def toList (t : RBSet α cmp) : List α := t.1.toList\n\n/-- `O(log n)`. Returns the entry `a` such that `a ≤ k` for all keys in the RBSet. -/\n@[inline] protected def min? (t : RBSet α cmp) : Option α := t.1.min?\n\n/-- `O(log n)`. Returns the entry `a` such that `a ≥ k` for all keys in the RBSet. -/\n@[inline] protected def max? (t : RBSet α cmp) : Option α := t.1.max?\n\ninstance [Repr α] : Repr (RBSet α cmp) where\n reprPrec m prec := Repr.addAppParen (\"RBSet.ofList \" ++ repr m.toList) prec\n\n/-- `O(log n)`. Insert element `v` into the tree. -/\n@[inline] def insert (t : RBSet α cmp) (v : α) : RBSet α cmp := ⟨t.1.insert cmp v, t.2.insert⟩\n\n/--\nInsert all elements from a collection into a `RBSet α cmp`.\n-/\ndef insertMany [ForIn Id ρ α] (s : RBSet α cmp) (as : ρ) :\n RBSet α cmp := Id.run do\n let mut s := s\n for a in as do\n s := s.insert a\n return s\n\n/--\n`O(log n)`. Remove an element from the tree using a cut function.\nThe `cut` function is used to locate an element in the tree:\nit returns `.gt` if we go too high and `.lt` if we go too low;\nif it returns `.eq` we will remove the element.\n(The function `cmp k` for some key `k` is a valid cut function, but we can also use cuts that\nare not of this form as long as they are suitably monotonic.)\n-/\n@[inline] def erase (t : RBSet α cmp) (cut : α → Ordering) : RBSet α cmp :=\n ⟨t.1.erase cut, t.2.erase⟩\n\n/-- `O(log n)`. Find an element in the tree using a cut function. -/\n@[inline] def findP? (t : RBSet α cmp) (cut : α → Ordering) : Option α := t.1.find? cut\n\n/-- `O(log n)`. Returns an element in the tree equivalent to `x` if one exists. -/\n@[inline] def find? (t : RBSet α cmp) (x : α) : Option α := t.1.find? (cmp x)\n\n/-- `O(log n)`. Find an element in the tree, or return a default value `v₀`. -/\n@[inline] def findPD (t : RBSet α cmp) (cut : α → Ordering) (v₀ : α) : α := (t.findP? cut).getD v₀\n\n/--\n`O(log n)`. `upperBoundP cut` retrieves the smallest entry comparing `gt` or `eq` under `cut`,\nif it exists. If multiple keys in the map return `eq` under `cut`, any of them may be returned.\n-/\n@[inline] def upperBoundP? (t : RBSet α cmp) (cut : α → Ordering) : Option α := t.1.upperBound? cut\n\n/--\n`O(log n)`. `upperBound? k` retrieves the largest entry smaller than or equal to `k`,\nif it exists.\n-/\n@[inline] def upperBound? (t : RBSet α cmp) (k : α) : Option α := t.upperBoundP? (cmp k)\n\n/--\n`O(log n)`. `lowerBoundP cut` retrieves the largest entry comparing `lt` or `eq` under `cut`,\nif it exists. If multiple keys in the map return `eq` under `cut`, any of them may be returned.\n-/\n@[inline] def lowerBoundP? (t : RBSet α cmp) (cut : α → Ordering) : Option α := t.1.lowerBound? cut\n\n/--\n`O(log n)`. `lowerBound? k` retrieves the largest entry smaller than or equal to `k`,\nif it exists.\n-/\n@[inline] def lowerBound? (t : RBSet α cmp) (k : α) : Option α := t.lowerBoundP? (cmp k)\n\n/-- `O(log n)`. Returns true if the given cut returns `eq` for something in the RBSet. -/\n@[inline] def containsP (t : RBSet α cmp) (cut : α → Ordering) : Bool := (t.findP? cut).isSome\n\n/-- `O(log n)`. Returns true if the given key `a` is in the RBSet. -/\n@[inline] def contains (t : RBSet α cmp) (a : α) : Bool := (t.find? a).isSome\n\n/-- `O(n log n)`. Build a tree from an unsorted list by inserting them one at a time. -/\n@[inline] def ofList (l : List α) (cmp : α → α → Ordering) : RBSet α cmp :=\n l.foldl (fun r p => r.insert p) (mkRBSet α cmp)\n\n/-- `O(n log n)`. Build a tree from an unsorted array by inserting them one at a time. -/\n@[inline] def ofArray (l : Array α) (cmp : α → α → Ordering) : RBSet α cmp :=\n l.foldl (fun r p => r.insert p) (mkRBSet α cmp)\n\n/-- `O(n)`. Returns true if the given predicate is true for all items in the RBSet. -/\n@[inline] def all (t : RBSet α cmp) (p : α → Bool) : Bool := t.1.all p\n\n/-- `O(n)`. Returns true if the given predicate is true for any item in the RBSet. -/\n@[inline] def any (t : RBSet α cmp) (p : α → Bool) : Bool := t.1.any p\n\n/--\nAsserts that `t₁` and `t₂` have the same number of elements in the same order,\nand `R` holds pairwise between them. The tree structure is ignored.\n-/\n@[inline] def all₂ (R : α → β → Bool) (t₁ : RBSet α cmpα) (t₂ : RBSet β cmpβ) : Bool :=\n t₁.1.all₂ R t₂.1\n\n/-- True if `x` is an element of `t` \"exactly\", i.e. up to equality, not the `cmp` relation. -/\ndef EMem (x : α) (t : RBSet α cmp) : Prop := t.1.EMem x\n\n/-- True if the specified `cut` matches at least one element of of `t`. -/\ndef MemP (cut : α → Ordering) (t : RBSet α cmp) : Prop := t.1.MemP cut\n\n/-- True if `x` is equivalent to an element of `t`. -/\ndef Mem (x : α) (t : RBSet α cmp) : Prop := MemP (cmp x) t\n\ninstance : Membership α (RBSet α cmp) where\n mem t x := Mem x t\n\n-- These instances are put in a special namespace because they are usually not what users want\n-- when deciding membership in a RBSet, since this does a naive linear search through the tree.\n-- The real `O(log n)` instances are defined in `Data.RBMap.Lemmas`.\n@[nolint docBlame] scoped instance Slow.instDecidableEMem [DecidableEq α] {t : RBSet α cmp} :\n Decidable (EMem x t) := inferInstanceAs (Decidable (Any ..))\n\n@[nolint docBlame] scoped instance Slow.instDecidableMemP {t : RBSet α cmp} :\n Decidable (MemP cut t) := inferInstanceAs (Decidable (Any ..))\n\n@[nolint docBlame] scoped instance Slow.instDecidableMem {t : RBSet α cmp} :\n Decidable (Mem x t) := inferInstanceAs (Decidable (Any ..))\n\n/--\nReturns true if `t₁` and `t₂` are equal as sets (assuming `cmp` and `==` are compatible),\nignoring the internal tree structure.\n-/\ninstance [BEq α] : BEq (RBSet α cmp) where\n beq a b := a.all₂ (· == ·) b\n\n/-- `O(n)`. The number of items in the RBSet. -/\ndef size (m : RBSet α cmp) : Nat := m.1.size\n\n/-- `O(log n)`. Returns the minimum element of the tree, or panics if the tree is empty. -/\n@[inline] def min! [Inhabited α] (t : RBSet α cmp) : α := t.min?.getD (panic! \"tree is empty\")\n\n/-- `O(log n)`. Returns the maximum element of the tree, or panics if the tree is empty. -/\n@[inline] def max! [Inhabited α] (t : RBSet α cmp) : α := t.max?.getD (panic! \"tree is empty\")\n\n/--\n`O(log n)`. Attempts to find the value with key `k : α` in `t` and panics if there is no such key.\n-/\n@[inline] def findP! [Inhabited α] (t : RBSet α cmp) (cut : α → Ordering) : α :=\n (t.findP? cut).getD (panic! \"key is not in the tree\")\n\n/--\n`O(log n)`. Attempts to find the value with key `k : α` in `t` and panics if there is no such key.\n-/\n@[inline] def find! [Inhabited α] (t : RBSet α cmp) (k : α) : α :=\n (t.find? k).getD (panic! \"key is not in the tree\")\n\n/-- The predicate asserting that the result of `modifyP` is safe to construct. -/\nclass ModifyWF (t : RBSet α cmp) (cut : α → Ordering) (f : α → α) : Prop where\n /-- The resulting tree is well formed. -/\n wf : (t.1.modify cut f).WF cmp\n\n/--\n`O(log n)`. In-place replace an element found by `cut`.\nThis takes the element out of the tree while `f` runs,\nso it uses the element linearly if `t` is unshared.\n\nThe `ModifyWF` assumption is required because `f` may change\nthe ordering properties of the element, which would break the invariants.\n-/\ndef modifyP (t : RBSet α cmp) (cut : α → Ordering) (f : α → α)\n [wf : ModifyWF t cut f] : RBSet α cmp := ⟨t.1.modify cut f, wf.wf⟩\n\n/-- The predicate asserting that the result of `alterP` is safe to construct. -/\nclass AlterWF (t : RBSet α cmp) (cut : α → Ordering) (f : Option α → Option α) : Prop where\n /-- The resulting tree is well formed. -/\n wf : (t.1.alter cut f).WF cmp\n\n/--\n`O(log n)`. `alterP cut f t` simultaneously handles inserting, erasing and replacing an element\nusing a function `f : Option α → Option α`. It is passed the result of `t.findP? cut`\nand can either return `none` to remove the element or `some a` to replace/insert\nthe element with `a` (which must have the same ordering properties as the original element).\n\nThe element is used linearly if `t` is unshared.\n\nThe `AlterWF` assumption is required because `f` may change\nthe ordering properties of the element, which would break the invariants.\n-/\ndef alterP (t : RBSet α cmp) (cut : α → Ordering) (f : Option α → Option α)\n [wf : AlterWF t cut f] : RBSet α cmp := ⟨t.1.alter cut f, wf.wf⟩\n\n/--\n`O(n₂ * log (n₁ + n₂))`. Merges the maps `t₁` and `t₂`.\nIf equal keys exist in both, the key from `t₂` is preferred.\n-/\ndef union (t₁ t₂ : RBSet α cmp) : RBSet α cmp :=\n t₂.foldl .insert t₁\n\ninstance : Union (RBSet α cmp) := ⟨RBSet.union⟩\n\n/--\n`O(n₂ * log (n₁ + n₂))`. Merges the maps `t₁` and `t₂`. If equal keys exist in both,\nthen use `mergeFn a₁ a₂` to produce the new merged value.\n-/\ndef mergeWith (mergeFn : α → α → α) (t₁ t₂ : RBSet α cmp) : RBSet α cmp :=\n t₂.foldl (init := t₁) fun t₁ a₂ =>\n t₁.insert <| match t₁.find? a₂ with | some a₁ => mergeFn a₁ a₂ | none => a₂\n\n/--\n`O(n₁ * log (n₁ + n₂))`. Intersects the maps `t₁` and `t₂`\nusing `mergeFn a b` to produce the new value.\n-/\ndef intersectWith (cmp : α → β → Ordering) (mergeFn : α → β → γ)\n (t₁ : RBSet α cmpα) (t₂ : RBSet β cmpβ) : RBSet γ cmpγ :=\n t₁.foldl (init := ∅) fun acc a =>\n match t₂.findP? (cmp a) with\n | some b => acc.insert <| mergeFn a b\n | none => acc\n\n/-- `O(n * log n)`. Constructs the set of all elements satisfying `p`. -/\ndef filter (t : RBSet α cmp) (p : α → Bool) : RBSet α cmp :=\n t.foldl (init := ∅) fun acc a => bif p a then acc.insert a else acc\n\n/--\n`O(n * log n)`. Map a function on every value in the set.\nIf the function is monotone, consider using the more efficient `RBSet.mapMonotone` instead.\n-/\ndef map (t : RBSet α cmpα) (f : α → β) : RBSet β cmpβ :=\n t.foldl (init := ∅) fun acc a => acc.insert <| f a\n\n/--\n`O(n₁ * (log n₁ + log n₂))`. Constructs the set of all elements of `t₁` that are not in `t₂`.\n-/\ndef sdiff (t₁ t₂ : RBSet α cmp) : RBSet α cmp := t₁.filter (!t₂.contains ·)\n\ninstance : SDiff (Batteries.RBSet α cmp) := ⟨RBSet.sdiff⟩\n\nend RBSet\n\n/- TODO(Leo): define dRBMap -/\n\n/--\nAn `RBMap` is a self-balancing binary search tree, used to store a key-value map.\nThe `cmp` function is the comparator that will be used for performing searches;\nit should satisfy the requirements of `TransCmp` for it to have sensible behavior.\n-/\ndef RBMap (α : Type u) (β : Type v) (cmp : α → α → Ordering) : Type (max u v) :=\n RBSet (α × β) (Ordering.byKey Prod.fst cmp)\n\n/-- `O(1)`. Construct a new empty map. -/\n@[inline] def mkRBMap (α : Type u) (β : Type v) (cmp : α → α → Ordering) : RBMap α β cmp :=\n mkRBSet ..\n\n/-- `O(1)`. Construct a new empty map. -/\n@[inline] def RBMap.empty {α : Type u} {β : Type v} {cmp : α → α → Ordering} : RBMap α β cmp :=\n mkRBMap ..\n\ninstance (α : Type u) (β : Type v) (cmp : α → α → Ordering) : EmptyCollection (RBMap α β cmp) :=\n ⟨RBMap.empty⟩\n\ninstance (α : Type u) (β : Type v) (cmp : α → α → Ordering) : Inhabited (RBMap α β cmp) := ⟨∅⟩\n\n/-- `O(1)`. Construct a new tree with one key-value pair `k, v`. -/\n@[inline] def RBMap.single (k : α) (v : β) : RBMap α β cmp := RBSet.single (k, v)\n\nnamespace RBMap\nvariable {α : Type u} {β : Type v} {σ : Type w} {cmp : α → α → Ordering}\n\n/-- `O(n)`. Fold a function on the values from left to right (in increasing order). -/\n@[inline] def foldl (f : σ → α → β → σ) : (init : σ) → RBMap α β cmp → σ\n | b, ⟨t, _⟩ => t.foldl (fun s (a, b) => f s a b) b\n\n/-- `O(n)`. Fold a function on the values from right to left (in decreasing order). -/\n@[inline] def foldr (f : α → β → σ → σ) : (init : σ) → RBMap α β cmp → σ\n | b, ⟨t, _⟩ => t.foldr (fun (a, b) s => f a b s) b\n\n/-- `O(n)`. Fold a monadic function on the values from left to right (in increasing order). -/\n@[inline] def foldlM [Monad m] (f : σ → α → β → m σ) : (init : σ) → RBMap α β cmp → m σ\n | b, ⟨t, _⟩ => t.foldlM (fun s (a, b) => f s a b) b\n\n/-- `O(n)`. Run monadic function `f` on each element of the tree (in increasing order). -/\n@[inline] def forM [Monad m] (f : α → β → m PUnit) (t : RBMap α β cmp) : m PUnit :=\n t.1.forM (fun (a, b) => f a b)\n\ninstance [Monad m] : ForIn m (RBMap α β cmp) (α × β) := inferInstanceAs (ForIn _ (RBSet ..) _)\n\ninstance : Std.ToStream (RBMap α β cmp) (RBNode.Stream (α × β)) :=\n inferInstanceAs (Std.ToStream (RBSet ..) _)\n\n/-- `O(n)`. Constructs the array of keys of the map. -/\n@[inline] def keysArray (t : RBMap α β cmp) : Array α :=\n t.1.foldl (init := #[]) (·.push ·.1)\n\n/-- `O(n)`. Constructs the list of keys of the map. -/\n@[inline] def keysList (t : RBMap α β cmp) : List α :=\n t.1.foldr (init := []) (·.1 :: ·)\n\n/--\nAn \"iterator\" over the keys of the map. This is a trivial wrapper over the underlying map,\nbut it comes with a small API to use it in a `for` loop or convert it to an array or list.\n-/\ndef Keys (α β cmp) := RBMap α β cmp\n\n/--\nThe keys of the map. This is an `O(1)` wrapper operation, which\ncan be used in `for` loops or converted to an array or list.\n-/\n@[inline] def keys (t : RBMap α β cmp) : Keys α β cmp := t\n\n@[inline, inherit_doc keysArray] def Keys.toArray := @keysArray\n\n@[inline, inherit_doc keysList] def Keys.toList := @keysList\n\ninstance : CoeHead (Keys α β cmp) (Array α) := ⟨keysArray⟩\n\ninstance : CoeHead (Keys α β cmp) (List α) := ⟨keysList⟩\n\ninstance [Monad m] : ForIn m (Keys α β cmp) α where\n forIn t init f := t.val.forIn init (f ·.1)\n\ninstance [Monad m] : ForM m (Keys α β cmp) α where\n forM t f := t.val.forM (f ·.1)\n\n/-- The result of `toStream` on a `Keys`. -/\ndef Keys.Stream (α β) := RBNode.Stream (α × β)\n\n/-- A stream over the iterator. -/\ndef Keys.toStream (t : Keys α β cmp) : Keys.Stream α β := t.1.toStream\n\n/-- `O(1)` amortized, `O(log n)` worst case: Get the next element from the stream. -/\ndef Keys.Stream.next? (t : Stream α β) : Option (α × Stream α β) :=\n match inline (RBNode.Stream.next? t) with\n | none => none\n | some ((a, _), t) => some (a, t)\n\ninstance : Std.ToStream (Keys α β cmp) (Keys.Stream α β) := ⟨Keys.toStream⟩\ninstance : Std.Stream (Keys.Stream α β) α := ⟨Keys.Stream.next?⟩\n\n/-- `O(n)`. Constructs the array of values of the map. -/\n@[inline] def valuesArray (t : RBMap α β cmp) : Array β :=\n t.1.foldl (init := #[]) (·.push ·.2)\n\n/-- `O(n)`. Constructs the list of values of the map. -/\n@[inline] def valuesList (t : RBMap α β cmp) : List β :=\n t.1.foldr (init := []) (·.2 :: ·)\n\n/--\nAn \"iterator\" over the values of the map. This is a trivial wrapper over the underlying map,\nbut it comes with a small API to use it in a `for` loop or convert it to an array or list.\n-/\ndef Values (α β cmp) := RBMap α β cmp\n\n/--\nThe \"keys\" of the map. This is an `O(1)` wrapper operation, which\ncan be used in `for` loops or converted to an array or list.\n-/\n@[inline] def values (t : RBMap α β cmp) : Values α β cmp := t\n\n@[inline, inherit_doc valuesArray] def Values.toArray := @valuesArray\n\n@[inline, inherit_doc valuesList] def Values.toList := @valuesList\n\ninstance : CoeHead (Values α β cmp) (Array β) := ⟨valuesArray⟩\n\ninstance : CoeHead (Values α β cmp) (List β) := ⟨valuesList⟩\n\ninstance [Monad m] : ForIn m (Values α β cmp) β where\n forIn t init f := t.val.forIn init (f ·.2)\n\ninstance [Monad m] : ForM m (Values α β cmp) β where\n forM t f := t.val.forM (f ·.2)\n\n/-- The result of `toStream` on a `Values`. -/\ndef Values.Stream (α β) := RBNode.Stream (α × β)\n\n/-- A stream over the iterator. -/\ndef Values.toStream (t : Values α β cmp) : Values.Stream α β := t.1.toStream\n\n/-- `O(1)` amortized, `O(log n)` worst case: Get the next element from the stream. -/\ndef Values.Stream.next? (t : Stream α β) : Option (β × Stream α β) :=\n match inline (RBNode.Stream.next? t) with\n | none => none\n | some ((_, b), t) => some (b, t)\n\ninstance : Std.ToStream (Values α β cmp) (Values.Stream α β) := ⟨Values.toStream⟩\ninstance : Std.Stream (Values.Stream α β) β := ⟨Values.Stream.next?⟩\n\n/-- `O(1)`. Is the tree empty? -/\n@[inline] def isEmpty : RBMap α β cmp → Bool := RBSet.isEmpty\n\n/-- `O(n)`. Convert the tree to a list in ascending order. -/\n@[inline] def toList : RBMap α β cmp → List (α × β) := RBSet.toList\n\n/-- `O(log n)`. Returns the key-value pair `(a, b)` such that `a ≤ k` for all keys in the RBMap. -/\n@[inline] protected def min? : RBMap α β cmp → Option (α × β) := RBSet.min?\n\n/-- `O(log n)`. Returns the key-value pair `(a, b)` such that `a ≥ k` for all keys in the RBMap. -/\n@[inline] protected def max? : RBMap α β cmp → Option (α × β) := RBSet.max?\n\ninstance [Repr α] [Repr β] : Repr (RBMap α β cmp) where\n reprPrec m prec := Repr.addAppParen (\"RBMap.ofList \" ++ repr m.toList) prec\n\n/-- `O(log n)`. Insert key-value pair `(k, v)` into the tree. -/\n@[inline] def insert (t : RBMap α β cmp) (k : α) (v : β) : RBMap α β cmp := RBSet.insert t (k, v)\n\n/-- `O(log n)`. Remove an element `k` from the map. -/\n@[inline] def erase (t : RBMap α β cmp) (k : α) : RBMap α β cmp := RBSet.erase t (cmp k ·.1)\n\n/-- `O(n log n)`. Build a tree from an unsorted list by inserting them one at a time. -/\n@[inline] def ofList (l : List (α × β)) (cmp : α → α → Ordering) : RBMap α β cmp :=\n RBSet.ofList l _\n\n/-- `O(n log n)`. Build a tree from an unsorted array by inserting them one at a time. -/\n@[inline] def ofArray (l : Array (α × β)) (cmp : α → α → Ordering) : RBMap α β cmp :=\n RBSet.ofArray l _\n\n/-- `O(log n)`. Find an entry in the tree with key equal to `k`. -/\n@[inline] def findEntry? (t : RBMap α β cmp) (k : α) : Option (α × β) := t.findP? (cmp k ·.1)\n\n/-- `O(log n)`. Find the value corresponding to key `k`. -/\n@[inline] def find? (t : RBMap α β cmp) (k : α) : Option β := t.findEntry? k |>.map (·.2)\n\n/-- `O(log n)`. Find the value corresponding to key `k`, or return `v₀` if it is not in the map. -/\n@[inline] def findD (t : RBMap α β cmp) (k : α) (v₀ : β) : β := (t.find? k).getD v₀\n\n/--\n`O(log n)`. `lowerBound? k` retrieves the key-value pair of the largest key\nsmaller than or equal to `k`, if it exists.\n-/\n@[inline] def lowerBound? (t : RBMap α β cmp) (k : α) : Option (α × β) :=\n RBSet.lowerBoundP? t (cmp k ·.1)\n\n/-- `O(log n)`. Returns true if the given key `a` is in the RBMap. -/\n@[inline] def contains (t : RBMap α β cmp) (a : α) : Bool := (t.findEntry? a).isSome\n\n/-- `O(n)`. Returns true if the given predicate is true for all items in the RBMap. -/\n@[inline] def all (t : RBMap α β cmp) (p : α → β → Bool) : Bool := RBSet.all t fun (a, b) => p a b\n\n/-- `O(n)`. Returns true if the given predicate is true for any item in the RBMap. -/\n@[inline] def any (t : RBMap α β cmp) (p : α → β → Bool) : Bool := RBSet.any t fun (a, b) => p a b\n\n/--\nAsserts that `t₁` and `t₂` have the same number of elements in the same order,\nand `R` holds pairwise between them. The tree structure is ignored.\n-/\n@[inline] def all₂ (R : α × β → γ × δ → Bool) (t₁ : RBMap α β cmpα) (t₂ : RBMap γ δ cmpγ) : Bool :=\n RBSet.all₂ R t₁ t₂\n\n/-- Asserts that `t₁` and `t₂` have the same set of keys (up to equality). -/\n@[inline] def eqKeys (t₁ : RBMap α β cmp) (t₂ : RBMap α γ cmp) : Bool :=\n t₁.all₂ (cmp ·.1 ·.1 = .eq) t₂\n\n/--\nReturns true if `t₁` and `t₂` have the same keys and values\n(assuming `cmp` and `==` are compatible), ignoring the internal tree structure.\n-/\ninstance [BEq α] [BEq β] : BEq (RBMap α β cmp) := inferInstanceAs (BEq (RBSet ..))\n\n/-- `O(n)`. The number of items in the RBMap. -/\ndef size : RBMap α β cmp → Nat := RBSet.size\n\n/-- `O(log n)`. Returns the minimum element of the map, or panics if the map is empty. -/\n@[inline] def min! [Inhabited α] [Inhabited β] : RBMap α β cmp → α × β := RBSet.min!\n\n/-- `O(log n)`. Returns the maximum element of the map, or panics if the map is empty. -/\n@[inline] def max! [Inhabited α] [Inhabited β] : RBMap α β cmp → α × β := RBSet.max!\n\n/-- Attempts to find the value with key `k : α` in `t` and panics if there is no such key. -/\n@[inline] def find! [Inhabited β] (t : RBMap α β cmp) (k : α) : β :=\n (t.find? k).getD (panic! \"key is not in the map\")\n\n/--\n`O(n₂ * log (n₁ + n₂))`. Merges the maps `t₁` and `t₂`, if a key `a : α` exists in both,\nthen use `mergeFn a b₁ b₂` to produce the new merged value.\n-/\ndef mergeWith (mergeFn : α → β → β → β) (t₁ t₂ : RBMap α β cmp) : RBMap α β cmp :=\n RBSet.mergeWith (fun (_, b₁) (a, b₂) => (a, mergeFn a b₁ b₂)) t₁ t₂\n\n/--\n`O(n₁ * log (n₁ + n₂))`. Intersects the maps `t₁` and `t₂`\nusing `mergeFn a b` to produce the new value.\n-/\ndef intersectWith (mergeFn : α → β → γ → δ)\n (t₁ : RBMap α β cmp) (t₂ : RBMap α γ cmp) : RBMap α δ cmp :=\n RBSet.intersectWith (cmp ·.1 ·.1) (fun (a, b₁) (_, b₂) => (a, mergeFn a b₁ b₂)) t₁ t₂\n\n/-- `O(n * log n)`. Constructs the set of all elements satisfying `p`. -/\ndef filter (t : RBMap α β cmp) (p : α → β → Bool) : RBMap α β cmp :=\n RBSet.filter t fun (a, b) => p a b\n\n/--\n`O(n₁ * (log n₁ + log n₂))`. Constructs the set of all elements of `t₁` that are not in `t₂`.\n-/\ndef sdiff (t₁ t₂ : RBMap α β cmp) : RBMap α β cmp := t₁.filter fun a _ => !t₂.contains a\n\nend RBMap\nend Batteries\nopen Batteries\n\n@[inherit_doc RBMap.ofList]\nabbrev List.toRBMap (l : List (α × β)) (cmp : α → α → Ordering) : RBMap α β cmp :=\n RBMap.ofList l cmp\n" }, { "path": "Batteries/Data/RBMap/Depth.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.RBMap.WF\n\n@[expose] public section\n\n/-!\n# RBNode depth bounds\n-/\n\nnamespace Batteries.RBNode\nopen RBColor\n\n/--\n`O(n)`. `depth t` is the maximum number of nodes on any path to a leaf.\nIt is an upper bound on most tree operations.\n-/\ndef depth : RBNode α → Nat\n | nil => 0\n | node _ a _ b => max a.depth b.depth + 1\n\ntheorem size_lt_depth : ∀ t : RBNode α, t.size < 2 ^ t.depth\n | .nil => (by decide : 0 < 1)\n | .node _ a _ b => by\n rw [size, depth, Nat.add_right_comm, Nat.pow_succ, Nat.mul_two]\n refine Nat.add_le_add\n (Nat.lt_of_lt_of_le a.size_lt_depth ?_) (Nat.lt_of_lt_of_le b.size_lt_depth ?_)\n · exact Nat.pow_le_pow_right (by decide) (Nat.le_max_left ..)\n · exact Nat.pow_le_pow_right (by decide) (Nat.le_max_right ..)\n\n/--\n`depthLB c n` is the best upper bound on the depth of any balanced red-black tree\nwith root colored `c` and black-height `n`.\n-/\ndef depthLB : RBColor → Nat → Nat\n | red, n => n + 1\n | black, n => n\n\ntheorem depthLB_le : ∀ c n, n ≤ depthLB c n\n | red, _ => Nat.le_succ _\n | black, _ => Nat.le_refl _\n\n/--\n`depthUB c n` is the best upper bound on the depth of any balanced red-black tree\nwith root colored `c` and black-height `n`.\n-/\ndef depthUB : RBColor → Nat → Nat\n | red, n => 2 * n + 1\n | black, n => 2 * n\n\ntheorem depthUB_le : ∀ c n, depthUB c n ≤ 2 * n + 1\n | red, _ => Nat.le_refl _\n | black, _ => Nat.le_succ _\n\ntheorem depthUB_le_two_depthLB : ∀ c n, depthUB c n ≤ 2 * depthLB c n\n | red, _ => Nat.le_succ _\n | black, _ => Nat.le_refl _\n\ntheorem Balanced.depth_le : @Balanced α t c n → t.depth ≤ depthUB c n\n | .nil => Nat.le_refl _\n | .red hl hr => Nat.succ_le_succ <| Nat.max_le.2 ⟨hl.depth_le, hr.depth_le⟩\n | .black hl hr => Nat.succ_le_succ <| Nat.max_le.2\n ⟨Nat.le_trans hl.depth_le (depthUB_le ..), Nat.le_trans hr.depth_le (depthUB_le ..)⟩\n\ntheorem Balanced.le_size : @Balanced α t c n → 2 ^ depthLB c n ≤ t.size + 1\n | .nil => Nat.le_refl _\n | .red hl hr => by\n rw [size, Nat.add_right_comm (size _), Nat.add_assoc, depthLB, Nat.pow_succ, Nat.mul_two]\n exact Nat.add_le_add hl.le_size hr.le_size\n | .black hl hr => by\n rw [size, Nat.add_right_comm (size _), Nat.add_assoc, depthLB, Nat.pow_succ, Nat.mul_two]\n refine Nat.add_le_add (Nat.le_trans ?_ hl.le_size) (Nat.le_trans ?_ hr.le_size) <;>\n exact Nat.pow_le_pow_right (by decide) (depthLB_le ..)\n\ntheorem Balanced.depth_bound (h : @Balanced α t c n) : t.depth ≤ 2 * (t.size + 1).log2 :=\n Nat.le_trans h.depth_le <| Nat.le_trans (depthUB_le_two_depthLB ..) <|\n Nat.mul_le_mul_left _ <| (Nat.le_log2 (Nat.succ_ne_zero _)).2 h.le_size\n\n/--\nA well formed tree has `t.depth ∈ O(log t.size)`, that is, it is well balanced.\nThis justifies the `O(log n)` bounds on most searching operations of `RBSet`.\n-/\ntheorem WF.depth_bound {t : RBNode α} (h : t.WF cmp) : t.depth ≤ 2 * (t.size + 1).log2 :=\n let ⟨_, _, h⟩ := h.out.2; h.depth_bound\n" }, { "path": "Batteries/Data/RBMap/Lemmas.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Basic\npublic import Batteries.Data.RBMap.Alter\npublic import Batteries.Data.List.Lemmas\n\n@[expose] public section\n\n/-!\n# Additional lemmas for Red-black trees\n-/\n\nnamespace Batteries\nnamespace RBNode\nopen RBColor\n\nattribute [simp] fold foldl foldr Any forM foldlM Ordered\n\n@[simp] theorem min?_reverse (t : RBNode α) : t.reverse.min? = t.max? := by\n unfold RBNode.max?; split <;> simp [RBNode.min?]\n unfold RBNode.min?; rw [min?.match_1.eq_3]\n · apply min?_reverse\n · simpa [reverse_eq_iff]\n\n@[simp] theorem max?_reverse (t : RBNode α) : t.reverse.max? = t.min? := by\n rw [← min?_reverse, reverse_reverse]\n\n@[simp] theorem mem_nil {x} : ¬x ∈ (.nil : RBNode α) := by simp [Membership.mem, EMem]\n@[simp] theorem mem_node {y c a x b} :\n y ∈ (.node c a x b : RBNode α) ↔ y = x ∨ y ∈ a ∨ y ∈ b := by simp [Membership.mem, EMem]\n\ntheorem All_def {t : RBNode α} : t.All p ↔ ∀ x ∈ t, p x := by\n induction t <;> simp [or_imp, forall_and, *]\n\ntheorem Any_def {t : RBNode α} : t.Any p ↔ ∃ x ∈ t, p x := by\n induction t <;> simp [or_and_right, exists_or, *]\n\ntheorem memP_def : MemP cut t ↔ ∃ x ∈ t, cut x = .eq := Any_def\n\ntheorem mem_def : Mem cmp x t ↔ ∃ y ∈ t, cmp x y = .eq := Any_def\n\ntheorem mem_congr [Std.TransCmp (α := α) cmp] {t : RBNode α} (h : cmp x y = .eq) :\n Mem cmp x t ↔ Mem cmp y t := by\n rw [Mem, Mem, iff_iff_eq]; congr 1; funext; rw [Std.TransCmp.congr_left h]\n\ntheorem isOrdered_iff' [Std.TransCmp (α := α) cmp] {t : RBNode α} :\n isOrdered cmp t L R ↔\n (∀ a ∈ L, t.All (cmpLT cmp a ·)) ∧\n (∀ a ∈ R, t.All (cmpLT cmp · a)) ∧\n (∀ a ∈ L, ∀ b ∈ R, cmpLT cmp a b) ∧\n Ordered cmp t := by\n induction t generalizing L R with\n | nil =>\n simp [isOrdered]; split <;> simp [cmpLT_iff]\n next h => intro _ ha _ hb; cases h _ _ ha hb\n | node _ l v r =>\n simp [isOrdered, *]\n exact ⟨\n fun ⟨⟨Ll, lv, Lv, ol⟩, ⟨vr, rR, vR, or⟩⟩ => ⟨\n fun _ h => ⟨Lv _ h, Ll _ h, (Lv _ h).trans_l vr⟩,\n fun _ h => ⟨vR _ h, (vR _ h).trans_r lv, rR _ h⟩,\n fun _ hL _ hR => (Lv _ hL).trans (vR _ hR),\n lv, vr, ol, or⟩,\n fun ⟨hL, hR, _, lv, vr, ol, or⟩ => ⟨\n ⟨fun _ h => (hL _ h).2.1, lv, fun _ h => (hL _ h).1, ol⟩,\n ⟨vr, fun _ h => (hR _ h).2.2, fun _ h => (hR _ h).1, or⟩⟩⟩\n\ntheorem isOrdered_iff [Std.TransCmp (α := α) cmp] {t : RBNode α} :\n isOrdered cmp t ↔ Ordered cmp t := by simp [isOrdered_iff']\n\ninstance (cmp) [Std.TransCmp (α := α) cmp] (t) : Decidable (Ordered cmp t) :=\n decidable_of_iff _ isOrdered_iff\n\n/--\nA cut is like a homomorphism of orderings: it is a monotonic predicate with respect to `cmp`,\nbut it can make things that are distinguished by `cmp` equal.\nThis is sufficient for `find?` to locate an element on which `cut` returns `.eq`,\nbut there may be other elements, not returned by `find?`, on which `cut` also returns `.eq`.\n-/\nclass IsCut (cmp : α → α → Ordering) (cut : α → Ordering) : Prop where\n /-- The set `{x | cut x = .lt}` is downward-closed. -/\n le_lt_trans [Std.TransCmp cmp] : cmp x y ≠ .gt → cut x = .lt → cut y = .lt\n /-- The set `{x | cut x = .gt}` is upward-closed. -/\n le_gt_trans [Std.TransCmp cmp] : cmp x y ≠ .gt → cut y = .gt → cut x = .gt\n\ntheorem IsCut.lt_trans [IsCut cmp cut] [Std.TransCmp cmp]\n (H : cmp x y = .lt) : cut x = .lt → cut y = .lt :=\n IsCut.le_lt_trans <| Std.OrientedCmp.not_gt_of_gt <| Std.OrientedCmp.gt_iff_lt.2 H\n\ntheorem IsCut.gt_trans [IsCut cmp cut] [Std.TransCmp cmp]\n (H : cmp x y = .lt) : cut y = .gt → cut x = .gt :=\n IsCut.le_gt_trans <| Std.OrientedCmp.not_gt_of_gt <| Std.OrientedCmp.gt_iff_lt.2 H\n\ntheorem IsCut.congr [IsCut cmp cut] [Std.TransCmp cmp] (H : cmp x y = .eq) :\n cut x = cut y := by\n cases ey : cut y\n · exact IsCut.le_lt_trans (fun h => nomatch H.symm.trans <| Std.OrientedCmp.gt_iff_lt.1 h) ey\n · cases ex : cut x\n · exact IsCut.le_lt_trans (fun h => nomatch H.symm.trans h) ex |>.symm.trans ey\n · rfl\n · refine IsCut.le_gt_trans (cmp := cmp) (fun h => ?_) ex |>.symm.trans ey\n cases H.symm.trans <| Std.OrientedCmp.gt_iff_lt.1 h\n · exact IsCut.le_gt_trans (fun h => nomatch H.symm.trans h) ey\n\ninstance (cmp cut) [@IsCut α cmp cut] : IsCut (flip cmp) (cut · |>.swap) where\n le_lt_trans h₁ h₂ := by\n have : Std.TransCmp cmp := inferInstanceAs (Std.TransCmp (flip (flip cmp)))\n rw [IsCut.le_gt_trans (cmp := cmp) h₁ (Ordering.swap_inj.1 h₂)]; rfl\n le_gt_trans h₁ h₂ := by\n have : Std.TransCmp cmp := inferInstanceAs (Std.TransCmp (flip (flip cmp)))\n rw [IsCut.le_lt_trans (cmp := cmp) h₁ (Ordering.swap_inj.1 h₂)]; rfl\n\n/--\n`IsStrictCut` upgrades the `IsCut` property to ensure that at most one element of the tree\ncan match the cut, and hence `find?` will return the unique such element if one exists.\n-/\nclass IsStrictCut (cmp : α → α → Ordering) (cut : α → Ordering) : Prop extends IsCut cmp cut where\n /-- If `cut = x`, then `cut` and `x` have compare the same with respect to other elements. -/\n exact [Std.TransCmp cmp] : cut x = .eq → cmp x y = cut y\n\n/-- A \"representable cut\" is one generated by `cmp a` for some `a`. This is always a valid cut. -/\ninstance (cmp) (a : α) : IsStrictCut cmp (cmp a) where\n le_lt_trans h₁ h₂ := Std.TransCmp.lt_of_lt_of_le h₂ h₁\n le_gt_trans h₁ := Decidable.not_imp_not.1 (Std.TransCmp.le_trans · h₁)\n exact h := (Std.TransCmp.congr_left h).symm\n\ninstance (cmp cut) [@IsStrictCut α cmp cut] : IsStrictCut (flip cmp) (cut · |>.swap) where\n exact h := by\n have : Std.TransCmp cmp := inferInstanceAs (Std.TransCmp (flip (flip cmp)))\n rw [← IsStrictCut.exact (cmp := cmp) (Ordering.swap_inj.1 h), ← Std.OrientedCmp.eq_swap]; rfl\n\nsection fold\n\ntheorem foldr_cons (t : RBNode α) (l) : t.foldr (·::·) l = t.toList ++ l := by\n unfold toList\n induction t generalizing l with\n | nil => rfl\n | node _ a _ b iha ihb => rw [foldr, foldr, iha, iha (_::_), ihb]; simp\n\n@[simp] theorem toList_nil : (.nil : RBNode α).toList = [] := rfl\n\n@[simp] theorem toList_node : (.node c a x b : RBNode α).toList = a.toList ++ x :: b.toList := by\n rw [toList, foldr, foldr_cons]; rfl\n\n@[simp] theorem toList_reverse (t : RBNode α) : t.reverse.toList = t.toList.reverse := by\n induction t <;> simp [*]\n\n@[simp] theorem mem_toList {t : RBNode α} : x ∈ t.toList ↔ x ∈ t := by\n induction t <;> simp [*, or_left_comm]\n\n@[simp] theorem mem_reverse {t : RBNode α} : a ∈ t.reverse ↔ a ∈ t := by rw [← mem_toList]; simp\n\ntheorem min?_eq_toList_head? {t : RBNode α} : t.min? = t.toList.head? := by\n induction t with\n | nil => rfl\n | node _ l _ _ ih =>\n cases l <;> simp [RBNode.min?, ih]\n\ntheorem max?_eq_toList_getLast? {t : RBNode α} : t.max? = t.toList.getLast? := by\n rw [← min?_reverse, min?_eq_toList_head?]; simp\n\ntheorem foldr_eq_foldr_toList {t : RBNode α} : t.foldr f init = t.toList.foldr f init := by\n induction t generalizing init <;> simp [*]\n\ntheorem foldl_eq_foldl_toList {t : RBNode α} : t.foldl f init = t.toList.foldl f init := by\n induction t generalizing init <;> simp [*]\n\ntheorem foldl_reverse {α β : Type _} {t : RBNode α} {f : β → α → β} {init : β} :\n t.reverse.foldl f init = t.foldr (flip f) init := by\n simp (config := {unfoldPartialApp := true})\n [foldr_eq_foldr_toList, foldl_eq_foldl_toList, flip]\n\ntheorem foldr_reverse {α β : Type _} {t : RBNode α} {f : α → β → β} {init : β} :\n t.reverse.foldr f init = t.foldl (flip f) init :=\n foldl_reverse.symm.trans (by simp; rfl)\n\ntheorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {t : RBNode α} :\n t.forM (m := m) f = t.toList.forM f := by induction t <;> simp [*]\n\ntheorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {t : RBNode α} :\n t.foldlM (m := m) f init = t.toList.foldlM f init := by\n induction t generalizing init <;> simp [*]\n\ntheorem forIn_visit_eq_bindList [Monad m] [LawfulMonad m] {t : RBNode α} :\n forIn.visit (m := m) f t init = (ForInStep.yield init).bindList f t.toList := by\n induction t generalizing init <;> simp [*, forIn.visit]\n\ntheorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {t : RBNode α} :\n forIn (m := m) t init f = forIn t.toList init f := by\n conv => lhs; simp only [forIn, RBNode.forIn]\n rw [List.forIn_eq_bindList, forIn_visit_eq_bindList]\n\nend fold\n\nnamespace Stream\n\nattribute [simp] foldl foldr\n\ntheorem foldr_cons (t : RBNode.Stream α) (l) : t.foldr (·::·) l = t.toList ++ l := by\n unfold toList; apply Eq.symm; induction t <;> simp [*, foldr, RBNode.foldr_cons]\n\n@[simp] theorem toList_nil : (.nil : RBNode.Stream α).toList = [] := rfl\n\n@[simp] theorem toList_cons :\n (.cons x r s : RBNode.Stream α).toList = x :: r.toList ++ s.toList := by\n rw [toList, toList, foldr, RBNode.foldr_cons]; rfl\n\ntheorem foldr_eq_foldr_toList {s : RBNode.Stream α} : s.foldr f init = s.toList.foldr f init := by\n induction s <;> simp [*, RBNode.foldr_eq_foldr_toList]\n\ntheorem foldl_eq_foldl_toList {t : RBNode.Stream α} : t.foldl f init = t.toList.foldl f init := by\n induction t generalizing init <;> simp [*, RBNode.foldl_eq_foldl_toList]\n\ntheorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {t : RBNode α} :\n forIn (m := m) t init f = forIn t.toList init f := by\n conv => lhs; simp only [forIn, RBNode.forIn]\n rw [List.forIn_eq_bindList, forIn_visit_eq_bindList]\n\nend Stream\n\ntheorem toStream_toList' {t : RBNode α} {s} : (t.toStream s).toList = t.toList ++ s.toList := by\n induction t generalizing s <;> simp [*, toStream]\n\n@[simp] theorem toStream_toList {t : RBNode α} : t.toStream.toList = t.toList := by\n simp [toStream_toList']\n\ntheorem Stream.next?_toList {s : RBNode.Stream α} :\n (s.next?.map fun (a, b) => (a, b.toList)) = s.toList.next? := by\n cases s <;> simp [next?, toStream_toList']\n\ntheorem ordered_iff {t : RBNode α} :\n t.Ordered cmp ↔ t.toList.Pairwise (cmpLT cmp) := by\n induction t with\n | nil => simp\n | node c l v r ihl ihr =>\n simp [*, List.pairwise_append, Ordered, All_def,\n and_assoc, and_left_comm, and_comm, imp_and, forall_and]\n exact fun _ _ hl hr a ha b hb => (hl _ ha).trans (hr _ hb)\n\ntheorem Ordered.toList_sorted {t : RBNode α} : t.Ordered cmp → t.toList.Pairwise (cmpLT cmp) :=\n ordered_iff.1\n\ntheorem min?_mem {t : RBNode α} (h : t.min? = some a) : a ∈ t := by\n rw [min?_eq_toList_head?] at h\n rw [← mem_toList]\n revert h; cases toList t <;> rintro ⟨⟩; constructor\n\ntheorem Ordered.min?_le {t : RBNode α} [Std.TransCmp cmp] (ht : t.Ordered cmp)\n (h : t.min? = some a) (x) (hx : x ∈ t) : cmp a x ≠ .gt := by\n rw [min?_eq_toList_head?] at h\n rw [← mem_toList] at hx\n have := ht.toList_sorted\n revert h hx this; cases toList t <;> rintro ⟨⟩ (_ | ⟨_, hx⟩) (_ | ⟨h1,h2⟩)\n · rw [Std.ReflCmp.compare_self (cmp := cmp)]; decide\n · rw [(h1 _ hx).1]; decide\n\ntheorem max?_mem {t : RBNode α} (h : t.max? = some a) : a ∈ t := by\n simpa using min?_mem ((min?_reverse _).trans h)\n\ntheorem Ordered.le_max? {t : RBNode α} [Std.TransCmp cmp] (ht : t.Ordered cmp)\n (h : t.max? = some a) (x) (hx : x ∈ t) : cmp x a ≠ .gt :=\n ht.reverse.min?_le ((min?_reverse _).trans h) _ (by simpa using hx)\n\n@[simp] theorem setBlack_toList {t : RBNode α} : t.setBlack.toList = t.toList := by\n cases t <;> simp [setBlack]\n\n@[simp] theorem setRed_toList {t : RBNode α} : t.setRed.toList = t.toList := by\n cases t <;> simp [setRed]\n\n@[simp] theorem balance1_toList {l : RBNode α} {v r} :\n (l.balance1 v r).toList = l.toList ++ v :: r.toList := by\n unfold balance1; split <;> simp\n\n@[simp] theorem balance2_toList {l : RBNode α} {v r} :\n (l.balance2 v r).toList = l.toList ++ v :: r.toList := by\n unfold balance2; split <;> simp\n\n@[simp] theorem balLeft_toList {l : RBNode α} {v r} :\n (l.balLeft v r).toList = l.toList ++ v :: r.toList := by\n unfold balLeft; split <;> (try simp); split <;> simp\n\n@[simp] theorem balRight_toList {l : RBNode α} {v r} :\n (l.balRight v r).toList = l.toList ++ v :: r.toList := by\n unfold balRight; split <;> (try simp); split <;> simp\n\ntheorem size_eq {t : RBNode α} : t.size = t.toList.length := by\n induction t <;> simp [*, size]; rfl\n\n@[simp] theorem reverse_size (t : RBNode α) : t.reverse.size = t.size := by simp [size_eq]\n\n@[simp] theorem Any_reverse {t : RBNode α} : t.reverse.Any p ↔ t.Any p := by simp [Any_def]\n\n@[simp] theorem memP_reverse {t : RBNode α} : MemP cut t.reverse ↔ MemP (cut · |>.swap) t := by\n simp [MemP]\n\ntheorem Mem_reverse [Std.OrientedCmp (α := α) cmp] {t : RBNode α} :\n Mem cmp x t.reverse ↔ Mem (flip cmp) x t := by\n simp [Mem]; apply Iff.of_eq; congr; funext x; rw [← Std.OrientedCmp.eq_swap]; rfl\n\nsection find?\n\ntheorem find?_some_eq_eq {t : RBNode α} : x ∈ t.find? cut → cut x = .eq := by\n induction t <;> simp [find?]; split <;> try assumption\n intro | rfl => assumption\n\ntheorem find?_some_mem {t : RBNode α} : x ∈ t.find? cut → x ∈ t := by\n induction t <;> simp [find?]; split <;> simp (config := {contextual := true}) [*]\n\ntheorem find?_some_memP {t : RBNode α} (h : x ∈ t.find? cut) : MemP cut t :=\n memP_def.2 ⟨_, find?_some_mem h, find?_some_eq_eq h⟩\n\ntheorem Ordered.memP_iff_find? [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (ht : Ordered cmp t) : MemP cut t ↔ ∃ x, t.find? cut = some x := by\n refine ⟨fun H => ?_, fun ⟨x, h⟩ => find?_some_memP h⟩\n induction t with simp [find?] at H ⊢\n | nil => cases H\n | node _ l _ r ihl ihr =>\n let ⟨lx, xr, hl, hr⟩ := ht\n split\n · next ev =>\n refine ihl hl ?_\n rcases H with ev' | hx | hx\n · cases ev.symm.trans ev'\n · exact hx\n · have ⟨z, hz, ez⟩ := Any_def.1 hx\n cases ez.symm.trans <| IsCut.lt_trans (All_def.1 xr _ hz).1 ev\n · next ev =>\n refine ihr hr ?_\n rcases H with ev' | hx | hx\n · cases ev.symm.trans ev'\n · have ⟨z, hz, ez⟩ := Any_def.1 hx\n cases ez.symm.trans <| IsCut.gt_trans (All_def.1 lx _ hz).1 ev\n · exact hx\n · exact ⟨_, rfl⟩\n\ntheorem Ordered.unique [Std.TransCmp (α := α) cmp] (ht : Ordered cmp t)\n (hx : x ∈ t) (hy : y ∈ t) (e : cmp x y = .eq) : x = y := by\n induction t with\n | nil => cases hx\n | node _ l _ r ihl ihr =>\n let ⟨lx, xr, hl, hr⟩ := ht\n rcases hx, hy with ⟨rfl | hx | hx, rfl | hy | hy⟩\n · rfl\n · cases e.symm.trans <| Std.OrientedCmp.gt_iff_lt.2 (All_def.1 lx _ hy).1\n · cases e.symm.trans (All_def.1 xr _ hy).1\n · cases e.symm.trans (All_def.1 lx _ hx).1\n · exact ihl hl hx hy\n · cases e.symm.trans ((All_def.1 lx _ hx).trans (All_def.1 xr _ hy)).1\n · cases e.symm.trans <| Std.OrientedCmp.gt_iff_lt.2 (All_def.1 xr _ hx).1\n · cases e.symm.trans <| Std.OrientedCmp.gt_iff_lt.2\n ((All_def.1 lx _ hy).trans (All_def.1 xr _ hx)).1\n · exact ihr hr hx hy\n\ntheorem Ordered.find?_some [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n (ht : Ordered cmp t) : t.find? cut = some x ↔ x ∈ t ∧ cut x = .eq := by\n refine ⟨fun h => ⟨find?_some_mem h, find?_some_eq_eq h⟩, fun ⟨hx, e⟩ => ?_⟩\n have ⟨y, hy⟩ := ht.memP_iff_find?.1 (memP_def.2 ⟨_, hx, e⟩)\n exact ht.unique hx (find?_some_mem hy) ((IsStrictCut.exact e).trans (find?_some_eq_eq hy)) ▸ hy\n\n@[simp] theorem find?_reverse (t : RBNode α) (cut : α → Ordering) :\n t.reverse.find? cut = t.find? (cut · |>.swap) := by\n induction t <;> simp [*, find?]\n cases cut _ <;> simp [Ordering.swap]\n\n/--\nAuxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary.\n-/\ndef setRoot (v : α) : RBNode α → RBNode α\n | nil => node red nil v nil\n | node c a _ b => node c a v b\n\n/--\nAuxiliary definition for `zoom_ins`: set the root of the tree to `v`, creating a node if necessary.\n-/\ndef delRoot : RBNode α → RBNode α\n | nil => nil\n | node _ a _ b => a.append b\n\nend find?\n\nsection «upperBound? and lowerBound?»\n\n@[simp] theorem upperBound?_reverse (t : RBNode α) (cut ub) :\n t.reverse.upperBound? cut ub = t.lowerBound? (cut · |>.swap) ub := by\n induction t generalizing ub <;> simp [lowerBound?, upperBound?]\n split <;> simp [*, Ordering.swap]\n\n@[simp] theorem lowerBound?_reverse (t : RBNode α) (cut lb) :\n t.reverse.lowerBound? cut lb = t.upperBound? (cut · |>.swap) lb := by\n simpa using (upperBound?_reverse t.reverse (cut · |>.swap) lb).symm\n\ntheorem upperBound?_eq_find? {t : RBNode α} {cut} (ub) (H : t.find? cut = some x) :\n t.upperBound? cut ub = some x := by\n induction t generalizing ub with simp [find?] at H\n | node c a y b iha ihb =>\n simp [upperBound?]; split at H\n · apply iha _ H\n · apply ihb _ H\n · exact H\n\ntheorem lowerBound?_eq_find? {t : RBNode α} {cut} (lb) (H : t.find? cut = some x) :\n t.lowerBound? cut lb = some x := by\n rw [← reverse_reverse t] at H ⊢; rw [lowerBound?_reverse]; rw [find?_reverse] at H\n exact upperBound?_eq_find? _ H\n\n/-- The value `x` returned by `upperBound?` is greater or equal to the `cut`. -/\ntheorem upperBound?_ge' {t : RBNode α} (H : ∀ {x}, x ∈ ub → cut x ≠ .gt) :\n t.upperBound? cut ub = some x → cut x ≠ .gt := by\n induction t generalizing ub with\n | nil => exact H\n | node _ _ _ _ ihl ihr =>\n simp [upperBound?]; split\n · next hv => exact ihl fun | rfl, e => nomatch hv.symm.trans e\n · exact ihr H\n · next hv => intro | rfl, e => cases hv.symm.trans e\n\n/-- The value `x` returned by `upperBound?` is greater or equal to the `cut`. -/\ntheorem upperBound?_ge {t : RBNode α} : t.upperBound? cut = some x → cut x ≠ .gt :=\n upperBound?_ge' nofun\n\n/-- The value `x` returned by `lowerBound?` is less or equal to the `cut`. -/\ntheorem lowerBound?_le' {t : RBNode α} (H : ∀ {x}, x ∈ lb → cut x ≠ .lt) :\n t.lowerBound? cut lb = some x → cut x ≠ .lt := by\n rw [← reverse_reverse t, lowerBound?_reverse, Ne, ← Ordering.swap_inj]\n exact upperBound?_ge' fun h => by specialize H h; rwa [Ne, ← Ordering.swap_inj] at H\n\n/-- The value `x` returned by `lowerBound?` is less or equal to the `cut`. -/\ntheorem lowerBound?_le {t : RBNode α} : t.lowerBound? cut = some x → cut x ≠ .lt :=\n lowerBound?_le' nofun\n\ntheorem All.upperBound?_ub {t : RBNode α} (hp : t.All p) (H : ∀ {x}, ub = some x → p x) :\n t.upperBound? cut ub = some x → p x := by\n induction t generalizing ub with\n | nil => exact H\n | node _ _ _ _ ihl ihr =>\n simp [upperBound?]; split\n · exact ihl hp.2.1 fun | rfl => hp.1\n · exact ihr hp.2.2 H\n · exact fun | rfl => hp.1\n\ntheorem All.upperBound? {t : RBNode α} (hp : t.All p) : t.upperBound? cut = some x → p x :=\n hp.upperBound?_ub nofun\n\ntheorem All.lowerBound?_lb {t : RBNode α} (hp : t.All p) (H : ∀ {x}, lb = some x → p x) :\n t.lowerBound? cut lb = some x → p x := by\n rw [← reverse_reverse t, lowerBound?_reverse]\n exact All.upperBound?_ub (All.reverse.2 hp) H\n\ntheorem All.lowerBound? {t : RBNode α} (hp : t.All p) : t.lowerBound? cut = some x → p x :=\n hp.lowerBound?_lb nofun\n\ntheorem upperBound?_mem_ub {t : RBNode α}\n (h : t.upperBound? cut ub = some x) : x ∈ t ∨ ub = some x :=\n All.upperBound?_ub (p := fun x => x ∈ t ∨ ub = some x) (All_def.2 fun _ => .inl) Or.inr h\n\ntheorem upperBound?_mem {t : RBNode α} (h : t.upperBound? cut = some x) : x ∈ t :=\n (upperBound?_mem_ub h).resolve_right nofun\n\ntheorem lowerBound?_mem_lb {t : RBNode α}\n (h : t.lowerBound? cut lb = some x) : x ∈ t ∨ lb = some x :=\n All.lowerBound?_lb (p := fun x => x ∈ t ∨ lb = some x) (All_def.2 fun _ => .inl) Or.inr h\n\ntheorem lowerBound?_mem {t : RBNode α} (h : t.lowerBound? cut = some x) : x ∈ t :=\n (lowerBound?_mem_lb h).resolve_right nofun\n\ntheorem upperBound?_of_some {t : RBNode α} : ∃ x, t.upperBound? cut (some y) = some x := by\n induction t generalizing y <;> simp [upperBound?]; split <;> simp [*]\n\ntheorem lowerBound?_of_some {t : RBNode α} : ∃ x, t.lowerBound? cut (some y) = some x := by\n rw [← reverse_reverse t, lowerBound?_reverse]; exact upperBound?_of_some\n\ntheorem Ordered.upperBound?_exists [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (h : Ordered cmp t) : (∃ x, t.upperBound? cut = some x) ↔ ∃ x ∈ t, cut x ≠ .gt := by\n refine ⟨fun ⟨x, hx⟩ => ⟨_, upperBound?_mem hx, upperBound?_ge hx⟩, fun H => ?_⟩\n obtain ⟨x, hx, e⟩ := H\n induction t generalizing x with\n | nil => cases hx\n | node _ _ _ _ _ ihr =>\n simp [upperBound?]; split\n · exact upperBound?_of_some\n · rcases hx with rfl | hx | hx\n · contradiction\n · next hv => cases e <| IsCut.gt_trans (All_def.1 h.1 _ hx).1 hv\n · exact ihr h.2.2.2 _ hx e\n · exact ⟨_, rfl⟩\n\ntheorem Ordered.lowerBound?_exists [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (h : Ordered cmp t) : (∃ x, t.lowerBound? cut = some x) ↔ ∃ x ∈ t, cut x ≠ .lt := by\n conv => enter [2, 1, x]; rw [Ne, ← Ordering.swap_inj]\n rw [← reverse_reverse t, lowerBound?_reverse]\n simpa [-Ordering.swap_inj] using h.reverse.upperBound?_exists (cut := (cut · |>.swap))\n\ntheorem Ordered.upperBound?_least_ub [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (h : Ordered cmp t) (hub : ∀ {x}, ub = some x → t.All (cmpLT cmp · x)) :\n t.upperBound? cut ub = some x → y ∈ t → cut x = .lt → cmp y x = .lt → cut y = .gt := by\n induction t generalizing ub with\n | nil => nofun\n | node _ _ _ _ ihl ihr =>\n simp [upperBound?]; split <;> rename_i hv <;> rintro h₁ (rfl | hy' | hy') hx h₂\n · rcases upperBound?_mem_ub h₁ with h₁ | ⟨⟨⟩⟩\n · cases Std.OrientedCmp.not_lt_of_lt h₂ (All_def.1 h.1 _ h₁).1\n · cases Std.OrientedCmp.not_lt_of_lt h₂ h₂\n · exact ihl h.2.2.1 (by rintro _ ⟨⟨⟩⟩; exact h.1) h₁ hy' hx h₂\n · refine (Std.OrientedCmp.not_lt_of_lt h₂ ?_).elim; have := (All_def.1 h.2.1 _ hy').1\n rcases upperBound?_mem_ub h₁ with h₁ | ⟨⟨⟩⟩\n · exact Std.TransCmp.lt_trans (All_def.1 h.1 _ h₁).1 this\n · exact this\n · exact hv\n · exact IsCut.gt_trans (cut := cut) (cmp := cmp) (All_def.1 h.1 _ hy').1 hv\n · exact ihr h.2.2.2 (fun h => (hub h).2.2) h₁ hy' hx h₂\n · cases h₁; cases Std.OrientedCmp.not_lt_of_lt h₂ h₂\n · cases h₁; cases hx.symm.trans hv\n · cases h₁; cases hx.symm.trans hv\n\ntheorem Ordered.lowerBound?_greatest_lb [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (h : Ordered cmp t) (hlb : ∀ {x}, lb = some x → t.All (cmpLT cmp x ·)) :\n t.lowerBound? cut lb = some x → y ∈ t → cut x = .gt → cmp x y = .lt → cut y = .lt := by\n intro h1 h2 h3 h4\n rw [← reverse_reverse t, lowerBound?_reverse] at h1\n rw [← Ordering.swap_inj] at h3 ⊢\n revert h2 h3 h4\n simpa [-Ordering.swap_inj] using\n h.reverse.upperBound?_least_ub (fun h => All.reverse.2 <| (hlb h).imp .flip) h1\n\n/--\nA statement of the least-ness of the result of `upperBound?`. If `x` is the return value of\n`upperBound?` and it is strictly greater than the cut, then any other `y < x` in the tree is in fact\nstrictly less than the cut (so there is no exact match, and nothing closer to the cut).\n-/\ntheorem Ordered.upperBound?_least [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (ht : Ordered cmp t) (H : t.upperBound? cut = some x) (hy : y ∈ t)\n (xy : cmp y x = .lt) (hx : cut x = .lt) : cut y = .gt :=\n ht.upperBound?_least_ub (by nofun) H hy hx xy\n\n/--\nA statement of the greatest-ness of the result of `lowerBound?`. If `x` is the return value of\n`lowerBound?` and it is strictly less than the cut, then any other `y > x` in the tree is in fact\nstrictly greater than the cut (so there is no exact match, and nothing closer to the cut).\n-/\ntheorem Ordered.lowerBound?_greatest [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (ht : Ordered cmp t) (H : t.lowerBound? cut none = some x) (hy : y ∈ t)\n (xy : cmp x y = .lt) (hx : cut x = .gt) : cut y = .lt :=\n ht.lowerBound?_greatest_lb (by nofun) H hy hx xy\n\ntheorem Ordered.memP_iff_upperBound? [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (ht : Ordered cmp t) : t.MemP cut ↔ ∃ x, t.upperBound? cut = some x ∧ cut x = .eq := by\n refine memP_def.trans ⟨fun ⟨y, hy, ey⟩ => ?_, fun ⟨x, hx, e⟩ => ⟨_, upperBound?_mem hx, e⟩⟩\n have ⟨x, hx⟩ := ht.upperBound?_exists.2 ⟨_, hy, fun h => nomatch ey.symm.trans h⟩\n refine ⟨x, hx, ?_⟩; cases ex : cut x\n · cases e : cmp x y\n · cases ey.symm.trans <| IsCut.lt_trans e ex\n · cases ey.symm.trans <| IsCut.congr e |>.symm.trans ex\n · cases ey.symm.trans <| ht.upperBound?_least hx hy (Std.OrientedCmp.gt_iff_lt.1 e) ex\n · rfl\n · cases upperBound?_ge hx ex\n\ntheorem Ordered.memP_iff_lowerBound? [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n (ht : Ordered cmp t) : t.MemP cut ↔ ∃ x, t.lowerBound? cut = some x ∧ cut x = .eq := by\n refine memP_def.trans ⟨fun ⟨y, hy, ey⟩ => ?_, fun ⟨x, hx, e⟩ => ⟨_, lowerBound?_mem hx, e⟩⟩\n have ⟨x, hx⟩ := ht.lowerBound?_exists.2 ⟨_, hy, fun h => nomatch ey.symm.trans h⟩\n refine ⟨x, hx, ?_⟩; cases ex : cut x\n · cases lowerBound?_le hx ex\n · rfl\n · cases e : cmp x y\n · cases ey.symm.trans <| ht.lowerBound?_greatest hx hy e ex\n · cases ey.symm.trans <| IsCut.congr e |>.symm.trans ex\n · cases ey.symm.trans <| IsCut.gt_trans (Std.OrientedCmp.gt_iff_lt.1 e) ex\n\n/-- A stronger version of `lowerBound?_greatest` that holds when the cut is strict. -/\ntheorem Ordered.lowerBound?_lt [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n (ht : Ordered cmp t) (H : t.lowerBound? cut = some x) (hy : y ∈ t) :\n cmp x y = .lt ↔ cut y = .lt := by\n refine ⟨fun h => ?_, fun h => Std.OrientedCmp.gt_iff_lt.1 ?_⟩\n · cases e : cut x\n · cases lowerBound?_le H e\n · exact IsStrictCut.exact e |>.symm.trans h\n · exact ht.lowerBound?_greatest H hy h e\n · by_contra h'; exact lowerBound?_le H <| IsCut.le_lt_trans (cmp := cmp) (cut := cut) h' h\n\n/-- A stronger version of `upperBound?_least` that holds when the cut is strict. -/\ntheorem Ordered.lt_upperBound? [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n (ht : Ordered cmp t) (H : t.upperBound? cut = some x) (hy : y ∈ t) :\n cmp y x = .lt ↔ cut y = .gt := by\n rw [← reverse_reverse t, upperBound?_reverse] at H\n rw [← Ordering.swap_inj (o₂ := .gt)]\n revert hy; simpa [-Ordering.swap_inj] using ht.reverse.lowerBound?_lt H\n\nend «upperBound? and lowerBound?»\n\nnamespace Path\n\nattribute [simp] RootOrdered Ordered\n\n/-- The list of elements to the left of the hole.\n(This function is intended for specification purposes only.) -/\n@[simp] def listL : Path α → List α\n | .root => []\n | .left _ parent _ _ => parent.listL\n | .right _ l v parent => parent.listL ++ (l.toList ++ [v])\n\n/-- The list of elements to the right of the hole.\n(This function is intended for specification purposes only.) -/\n@[simp] def listR : Path α → List α\n | .root => []\n | .left _ parent v r => v :: r.toList ++ parent.listR\n | .right _ _ _ parent => parent.listR\n\n/-- Wraps a list of elements with the left and right elements of the path. -/\nabbrev withList (p : Path α) (l : List α) : List α := p.listL ++ l ++ p.listR\n\ntheorem rootOrdered_iff {p : Path α} (hp : p.Ordered cmp) :\n p.RootOrdered cmp v ↔ (∀ a ∈ p.listL, cmpLT cmp a v) ∧ (∀ a ∈ p.listR, cmpLT cmp v a) := by\n induction p with\n (simp [All_def] at hp; simp [*, and_assoc, and_left_comm, and_comm, or_imp, forall_and])\n | left _ _ x _ ih => exact fun vx _ _ _ ha => vx.trans (hp.2.1 _ ha)\n | right _ _ x _ ih => exact fun xv _ _ _ ha => (hp.2.1 _ ha).trans xv\n\ntheorem ordered_iff {p : Path α} :\n p.Ordered cmp ↔ p.listL.Pairwise (cmpLT cmp) ∧ p.listR.Pairwise (cmpLT cmp) ∧\n ∀ x ∈ p.listL, ∀ y ∈ p.listR, cmpLT cmp x y := by\n induction p with\n | root => simp\n | left _ _ x _ ih | right _ _ x _ ih => ?_\n all_goals\n rw [Ordered, and_congr_right_eq fun h => by simp [All_def, rootOrdered_iff h]; rfl]\n simp [List.pairwise_append, or_imp, forall_and, ih, RBNode.ordered_iff]\n -- FIXME: simp [and_assoc, and_left_comm, and_comm] is really slow here\n · exact ⟨\n fun ⟨⟨hL, hR, LR⟩, xr, ⟨Lx, xR⟩, ⟨rL, rR⟩, hr⟩ =>\n ⟨hL, ⟨⟨xr, xR⟩, hr, hR, rR⟩, Lx, fun _ ha _ hb => rL _ hb _ ha, LR⟩,\n fun ⟨hL, ⟨⟨xr, xR⟩, hr, hR, rR⟩, Lx, Lr, LR⟩ =>\n ⟨⟨hL, hR, LR⟩, xr, ⟨Lx, xR⟩, ⟨fun _ ha _ hb => Lr _ hb _ ha, rR⟩, hr⟩⟩\n · exact ⟨\n fun ⟨⟨hL, hR, LR⟩, lx, ⟨Lx, xR⟩, ⟨lL, lR⟩, hl⟩ =>\n ⟨⟨hL, ⟨hl, lx⟩, fun _ ha _ hb => lL _ hb _ ha, Lx⟩, hR, LR, lR, xR⟩,\n fun ⟨⟨hL, ⟨hl, lx⟩, Ll, Lx⟩, hR, LR, lR, xR⟩ =>\n ⟨⟨hL, hR, LR⟩, lx, ⟨Lx, xR⟩, ⟨fun _ ha _ hb => Ll _ hb _ ha, lR⟩, hl⟩⟩\n\ntheorem zoom_zoomed₁ (e : zoom cut t path = (t', path')) :\n t'.OnRoot (cut · = .eq) :=\n match t, e with\n | nil, rfl => trivial\n | node .., e => by\n revert e; unfold zoom; split\n · exact zoom_zoomed₁\n · exact zoom_zoomed₁\n · next H => intro e; cases e; exact H\n\n@[simp] theorem fill_toList {p : Path α} : (p.fill t).toList = p.withList t.toList := by\n induction p generalizing t <;> simp [*]\n\ntheorem _root_.Batteries.RBNode.zoom_toList {t : RBNode α} (eq : t.zoom cut = (t', p')) :\n p'.withList t'.toList = t.toList := by rw [← fill_toList, ← zoom_fill eq]; rfl\n\n@[simp] theorem ins_toList {p : Path α} : (p.ins t).toList = p.withList t.toList := by\n match p with\n | .root | .left red .. | .right red .. | .left black .. | .right black .. =>\n simp [ins, ins_toList]\n\n@[simp] theorem insertNew_toList {p : Path α} : (p.insertNew v).toList = p.withList [v] := by\n simp [insertNew]\n\ntheorem insert_toList {p : Path α} :\n (p.insert t v).toList = p.withList (t.setRoot v).toList := by\n simp [insert]; split <;> simp [setRoot]\n\nprotected theorem Balanced.insert {path : Path α} (hp : path.Balanced c₀ n₀ c n) :\n t.Balanced c n → ∃ c n, (path.insert t v).Balanced c n\n | .nil => ⟨_, hp.insertNew⟩\n | .red ha hb => ⟨_, _, hp.fill (.red ha hb)⟩\n | .black ha hb => ⟨_, _, hp.fill (.black ha hb)⟩\n\ntheorem Ordered.insert : ∀ {path : Path α} {t : RBNode α},\n path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → path.RootOrdered cmp v →\n t.OnRoot (cmpEq cmp v) → (path.insert t v).Ordered cmp\n | _, nil, hp, _, _, vp, _ => hp.insertNew vp\n | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩, vp, xv => Ordered.fill.2\n ⟨hp, ⟨ax.imp xv.lt_congr_right.2, xb.imp xv.lt_congr_left.2, ha, hb⟩, vp, ap, bp⟩\n\ntheorem Ordered.erase : ∀ {path : Path α} {t : RBNode α},\n path.Ordered cmp → t.Ordered cmp → t.All (path.RootOrdered cmp) → (path.erase t).Ordered cmp\n | _, nil, hp, ht, tp => Ordered.fill.2 ⟨hp, ht, tp⟩\n | _, node .., hp, ⟨ax, xb, ha, hb⟩, ⟨_, ap, bp⟩ => hp.del (ha.append ax xb hb) (ap.append bp)\n\ntheorem zoom_ins {t : RBNode α} {cmp : α → α → Ordering} :\n t.zoom (cmp v) path = (t', path') →\n path.ins (t.ins cmp v) = path'.ins (t'.setRoot v) := by\n unfold RBNode.ins; split <;> simp [zoom]\n · intro | rfl, rfl => rfl\n all_goals\n · split\n · exact zoom_ins\n · exact zoom_ins\n · intro | rfl => rfl\n\ntheorem insertNew_eq_insert (h : zoom (cmp v) t = (nil, path)) :\n path.insertNew v = (t.insert cmp v).setBlack :=\n insert_setBlack .. ▸ (zoom_ins h).symm\n\ntheorem ins_eq_fill {path : Path α} {t : RBNode α} :\n path.Balanced c₀ n₀ c n → t.Balanced c n → path.ins t = (path.fill t).setBlack\n | .root, h => rfl\n | .redL hb H, ha | .redR ha H, hb => by unfold ins; exact ins_eq_fill H (.red ha hb)\n | .blackL hb H, ha => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance1_eq ha]\n | .blackR ha H, hb => by rw [ins, fill, ← ins_eq_fill H (.black ha hb), balance2_eq hb]\n\ntheorem zoom_insert {path : Path α} {t : RBNode α} (ht : t.Balanced c n)\n (H : zoom (cmp v) t = (t', path)) :\n (path.insert t' v).setBlack = (t.insert cmp v).setBlack := by\n have ⟨_, _, ht', hp'⟩ := ht.zoom .root H\n cases ht' with simp [insert]\n | nil => simp [insertNew_eq_insert H, setBlack_idem]\n | red hl hr => rw [← ins_eq_fill hp' (.red hl hr), insert_setBlack]; exact (zoom_ins H).symm\n | black hl hr => rw [← ins_eq_fill hp' (.black hl hr), insert_setBlack]; exact (zoom_ins H).symm\n\ntheorem zoom_del {t : RBNode α} :\n t.zoom cut path = (t', path') →\n path.del (t.del cut) (match t with | node c .. => c | _ => red) =\n path'.del t'.delRoot (match t' with | node c .. => c | _ => red) := by\n rw [RBNode.del.eq_def]; split <;> simp [zoom]\n · intro | rfl, rfl => rfl\n · next c a y b =>\n split\n · have IH := @zoom_del (t := a)\n match a with\n | nil => intro | rfl => rfl\n | node black .. | node red .. => apply IH\n · have IH := @zoom_del (t := b)\n match b with\n | nil => intro | rfl => rfl\n | node black .. | node red .. => apply IH\n · intro | rfl => rfl\n\n/-- Asserts that `p` holds on all elements to the left of the hole. -/\ndef AllL (p : α → Prop) : Path α → Prop\n | .root => True\n | .left _ parent _ _ => parent.AllL p\n | .right _ a x parent => a.All p ∧ p x ∧ parent.AllL p\n\n/-- Asserts that `p` holds on all elements to the right of the hole. -/\ndef AllR (p : α → Prop) : Path α → Prop\n | .root => True\n | .left _ parent x b => parent.AllR p ∧ p x ∧ b.All p\n | .right _ _ _ parent => parent.AllR p\n\nend Path\n\ntheorem insert_toList_zoom {t : RBNode α} (ht : Balanced t c n)\n (e : zoom (cmp v) t = (t', p)) :\n (t.insert cmp v).toList = p.withList (t'.setRoot v).toList := by\n rw [← setBlack_toList, ← Path.zoom_insert ht e, setBlack_toList, Path.insert_toList]\n\ntheorem insert_toList_zoom_nil {t : RBNode α} (ht : Balanced t c n)\n (e : zoom (cmp v) t = (nil, p)) :\n (t.insert cmp v).toList = p.withList [v] := insert_toList_zoom ht e\n\ntheorem exists_insert_toList_zoom_nil {t : RBNode α} (ht : Balanced t c n)\n (e : zoom (cmp v) t = (nil, p)) :\n ∃ L R, t.toList = L ++ R ∧ (t.insert cmp v).toList = L ++ v :: R :=\n ⟨p.listL, p.listR, by simp [← zoom_toList e, insert_toList_zoom_nil ht e]⟩\n\ntheorem insert_toList_zoom_node {t : RBNode α} (ht : Balanced t c n)\n (e : zoom (cmp v) t = (node c' l v' r, p)) :\n (t.insert cmp v).toList = p.withList (node c l v r).toList := insert_toList_zoom ht e\n\ntheorem exists_insert_toList_zoom_node {t : RBNode α} (ht : Balanced t c n)\n (e : zoom (cmp v) t = (node c' l v' r, p)) :\n ∃ L R, t.toList = L ++ v' :: R ∧ (t.insert cmp v).toList = L ++ v :: R := by\n refine ⟨p.listL ++ l.toList, r.toList ++ p.listR, ?_⟩\n simp [← zoom_toList e, insert_toList_zoom_node ht e]\n\ntheorem mem_insert_self {t : RBNode α} (ht : Balanced t c n) : v ∈ t.insert cmp v := by\n rw [← mem_toList, List.mem_iff_append]\n exact match e : zoom (cmp v) t with\n | (nil, p) => let ⟨_, _, _, h⟩ := exists_insert_toList_zoom_nil ht e; ⟨_, _, h⟩\n | (node .., p) => let ⟨_, _, _, h⟩ := exists_insert_toList_zoom_node ht e; ⟨_, _, h⟩\n\ntheorem mem_insert_of_mem {t : RBNode α} (ht : Balanced t c n) (h : v' ∈ t) :\n v' ∈ t.insert cmp v ∨ cmp v v' = .eq := by\n match e : zoom (cmp v) t with\n | (nil, p) =>\n let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_nil ht e\n simp [← mem_toList, h₁] at h\n simp [← mem_toList, h₂]; cases h <;> simp [*]\n | (node .., p) =>\n let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_node ht e\n simp [← mem_toList, h₁] at h\n simp [← mem_toList, h₂]; rcases h with h|h|h <;> simp [*]\n exact .inr (Path.zoom_zoomed₁ e)\n\ntheorem exists_find?_insert_self [Std.TransCmp (α := α) cmp] [IsCut cmp cut]\n {t : RBNode α} (ht : Balanced t c n) (ht₂ : Ordered cmp t) (hv : cut v = .eq) :\n ∃ x, (t.insert cmp v).find? cut = some x :=\n ht₂.insert.memP_iff_find?.1 <| memP_def.2 ⟨_, mem_insert_self ht, hv⟩\n\ntheorem find?_insert_self [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n {t : RBNode α} (ht : Balanced t c n) (ht₂ : Ordered cmp t) (hv : cut v = .eq) :\n (t.insert cmp v).find? cut = some v :=\n ht₂.insert.find?_some.2 ⟨mem_insert_self ht, hv⟩\n\ntheorem mem_insert [Std.TransCmp (α := α) cmp] {t : RBNode α}\n (ht : Balanced t c n) (ht₂ : Ordered cmp t) :\n v' ∈ t.insert cmp v ↔ (v' ∈ t ∧ t.find? (cmp v) ≠ some v') ∨ v' = v := by\n refine ⟨fun h => ?_, fun | .inl ⟨h₁, h₂⟩ => ?_ | .inr h => ?_⟩\n · match e : zoom (cmp v) t with\n | (nil, p) =>\n let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_nil ht e\n simp [← mem_toList, h₂] at h; rw [← or_assoc, or_right_comm] at h\n refine h.imp_left fun h => ?_\n simp [← mem_toList, h₁, h]\n rw [find?_eq_zoom, e]; nofun\n | (node .., p) =>\n let ⟨_, _, h₁, h₂⟩ := exists_insert_toList_zoom_node ht e\n simp [← mem_toList, h₂] at h; simp [← mem_toList, h₁]; rw [or_left_comm] at h ⊢\n rcases h with _|h <;> simp [*]\n refine .inl fun h => ?_\n rw [find?_eq_zoom, e] at h; cases h\n suffices cmpLT cmp v' v' by cases Std.ReflCmp.compare_self.symm.trans this.1\n have := ht₂.toList_sorted; simp [h₁, List.pairwise_append] at this\n exact h.elim (this.2.2 _ · |>.1) (this.2.1.1 _)\n · exact (mem_insert_of_mem ht h₁).resolve_right fun h' => h₂ <| ht₂.find?_some.2 ⟨h₁, h'⟩\n · exact h ▸ mem_insert_self ht\n\nend RBNode\n\nopen RBNode (IsCut IsStrictCut)\n\nnamespace RBSet\n\n@[simp] theorem val_toList {t : RBSet α cmp} : t.1.toList = t.toList := rfl\n\n@[simp] theorem mkRBSet_eq : mkRBSet α cmp = ∅ := rfl\n@[simp] theorem empty_eq : @RBSet.empty α cmp = ∅ := rfl\n@[simp] theorem default_eq : (default : RBSet α cmp) = ∅ := rfl\n@[simp] theorem empty_toList : toList (∅ : RBSet α cmp) = [] := rfl\n@[simp] theorem single_toList : toList (single a : RBSet α cmp) = [a] := rfl\n\ntheorem mem_toList {t : RBSet α cmp} : x ∈ toList t ↔ x ∈ t.1 := RBNode.mem_toList\n\ntheorem mem_congr [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} (h : cmp x y = .eq) :\n x ∈ t ↔ y ∈ t := RBNode.mem_congr h\n\ntheorem mem_iff_mem_toList {t : RBSet α cmp} : x ∈ t ↔ ∃ y ∈ toList t, cmp x y = .eq :=\n RBNode.mem_def.trans <| by simp [mem_toList]\n\ntheorem mem_of_mem_toList [Std.OrientedCmp (α := α) cmp] {t : RBSet α cmp} (h : x ∈ toList t) :\n x ∈ t := mem_iff_mem_toList.2 ⟨_, h, Std.ReflCmp.compare_self⟩\n\ntheorem foldl_eq_foldl_toList {t : RBSet α cmp} : t.foldl f init = t.toList.foldl f init :=\n RBNode.foldl_eq_foldl_toList\n\ntheorem foldr_eq_foldr_toList {t : RBSet α cmp} : t.foldr f init = t.toList.foldr f init :=\n RBNode.foldr_eq_foldr_toList\n\ntheorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {t : RBSet α cmp} :\n t.foldlM (m := m) f init = t.toList.foldlM f init := RBNode.foldlM_eq_foldlM_toList\n\ntheorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {t : RBSet α cmp} :\n t.forM (m := m) f = t.toList.forM f := RBNode.forM_eq_forM_toList\n\ntheorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {t : RBSet α cmp} :\n forIn (m := m) t init f = forIn t.toList init f := RBNode.forIn_eq_forIn_toList\n\ntheorem toStream_eq {t : RBSet α cmp} : Std.toStream t = t.1.toStream .nil := rfl\n\n@[simp] theorem toStream_toList {t : RBSet α cmp} : (Std.toStream t).toList = t.toList := by\n simp [toStream_eq]\n\ntheorem isEmpty_iff_toList_eq_nil {t : RBSet α cmp} :\n t.isEmpty ↔ t.toList = [] := by obtain ⟨⟨⟩, _⟩ := t <;> simp [toList, isEmpty]\n\ntheorem toList_sorted {t : RBSet α cmp} : t.toList.Pairwise (RBNode.cmpLT cmp) :=\n t.2.out.1.toList_sorted\n\ntheorem findP?_some_eq_eq {t : RBSet α cmp} : t.findP? cut = some y → cut y = .eq :=\n RBNode.find?_some_eq_eq\n\ntheorem find?_some_eq_eq {t : RBSet α cmp} : t.find? x = some y → cmp x y = .eq :=\n findP?_some_eq_eq\n\ntheorem findP?_some_mem_toList {t : RBSet α cmp} (h : t.findP? cut = some y) :\n y ∈ toList t := mem_toList.2 <| RBNode.find?_some_mem h\n\ntheorem find?_some_mem_toList {t : RBSet α cmp} (h : t.find? x = some y) : y ∈ toList t :=\n findP?_some_mem_toList h\n\ntheorem findP?_some_memP {t : RBSet α cmp} (h : t.findP? cut = some y) : t.MemP cut :=\n RBNode.find?_some_memP h\n\ntheorem find?_some_mem {t : RBSet α cmp} (h : t.find? x = some y) : x ∈ t :=\n findP?_some_memP h\n\ntheorem mem_toList_unique [Std.TransCmp (α := α) cmp] {t : RBSet α cmp}\n (hx : x ∈ toList t) (hy : y ∈ toList t) (e : cmp x y = .eq) : x = y :=\n t.2.out.1.unique (mem_toList.1 hx) (mem_toList.1 hy) e\n\ntheorem findP?_some [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut] {t : RBSet α cmp} :\n t.findP? cut = some y ↔ y ∈ toList t ∧ cut y = .eq :=\n t.2.out.1.find?_some.trans <| by simp [mem_toList]\n\ntheorem find?_some [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} :\n t.find? x = some y ↔ y ∈ toList t ∧ cmp x y = .eq := findP?_some\n\ntheorem memP_iff_findP? [Std.TransCmp (α := α) cmp] [IsCut cmp cut] {t : RBSet α cmp} :\n MemP cut t ↔ ∃ y, t.findP? cut = some y := t.2.out.1.memP_iff_find?\n\ntheorem mem_iff_find? [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} :\n x ∈ t ↔ ∃ y, t.find? x = some y := memP_iff_findP?\n\n@[simp] theorem contains_iff [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} :\n t.contains x ↔ x ∈ t := Option.isSome_iff_exists.trans mem_iff_find?.symm\n\ninstance [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} : Decidable (x ∈ t) :=\n decidable_of_iff _ contains_iff\n\ntheorem size_eq (t : RBSet α cmp) : t.size = t.toList.length := RBNode.size_eq\n\ntheorem mem_toList_insert_self (v) (t : RBSet α cmp) : v ∈ toList (t.insert v) :=\n let ⟨_, _, h⟩ := t.2.out.2; mem_toList.2 (RBNode.mem_insert_self h)\n\ntheorem mem_insert_self [Std.OrientedCmp (α := α) cmp] (v) (t : RBSet α cmp) :\n v ∈ t.insert v := mem_of_mem_toList <| mem_toList_insert_self v t\n\ntheorem mem_insert_of_eq [Std.TransCmp (α := α) cmp] (t : RBSet α cmp)\n (h : cmp v v' = .eq) : v' ∈ t.insert v := (mem_congr h).1 (mem_insert_self ..)\n\ntheorem mem_toList_insert_of_mem (v) {t : RBSet α cmp} (h : v' ∈ toList t) :\n v' ∈ toList (t.insert v) ∨ cmp v v' = .eq :=\n let ⟨_, _, ht⟩ := t.2.out.2\n .imp_left mem_toList.2 <| RBNode.mem_insert_of_mem ht <| mem_toList.1 h\n\ntheorem mem_insert_of_mem_toList [Std.OrientedCmp (α := α) cmp] (v) {t : RBSet α cmp}\n (h : v' ∈ toList t) : v' ∈ t.insert v :=\n match mem_toList_insert_of_mem v h with\n | .inl h' => mem_of_mem_toList h'\n | .inr h' => mem_iff_mem_toList.2 ⟨_, mem_toList_insert_self .., Std.OrientedCmp.eq_comm.1 h'⟩\n\ntheorem mem_insert_of_mem [Std.TransCmp (α := α) cmp] (v) {t : RBSet α cmp}\n (h : v' ∈ t) : v' ∈ t.insert v :=\n let ⟨_, h₁, h₂⟩ := mem_iff_mem_toList.1 h\n (mem_congr h₂).2 (mem_insert_of_mem_toList v h₁)\n\ntheorem mem_toList_insert [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} :\n v' ∈ toList (t.insert v) ↔ (v' ∈ toList t ∧ t.find? v ≠ some v') ∨ v' = v := by\n let ⟨ht₁, _, _, ht₂⟩ := t.2.out\n simpa [mem_toList] using RBNode.mem_insert ht₂ ht₁\n\ntheorem mem_insert [Std.TransCmp (α := α) cmp] {t : RBSet α cmp} :\n v' ∈ t.insert v ↔ v' ∈ t ∨ cmp v v' = .eq := by\n refine ⟨fun h => ?_, fun | .inl h => mem_insert_of_mem _ h | .inr h => mem_insert_of_eq _ h⟩\n let ⟨_, h₁, h₂⟩ := mem_iff_mem_toList.1 h\n match mem_toList_insert.1 h₁ with\n | .inl ⟨h₃, _⟩ => exact .inl <| mem_iff_mem_toList.2 ⟨_, h₃, h₂⟩\n | .inr rfl => exact .inr <| Std.OrientedCmp.eq_comm.1 h₂\n\ntheorem find?_congr [Std.TransCmp (α := α) cmp] (t : RBSet α cmp) (h : cmp v₁ v₂ = .eq) :\n t.find? v₁ = t.find? v₂ := by simp only [find?]; congr 1; funext; rw [Std.TransCmp.congr_left h]\n\ntheorem findP?_insert_of_eq [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n (t : RBSet α cmp) (h : cut v = .eq) : (t.insert v).findP? cut = some v :=\n findP?_some.2 ⟨mem_toList_insert_self .., h⟩\n\ntheorem find?_insert_of_eq [Std.TransCmp (α := α) cmp] (t : RBSet α cmp) (h : cmp v' v = .eq) :\n (t.insert v).find? v' = some v := findP?_insert_of_eq t h\n\ntheorem findP?_insert_of_ne [Std.TransCmp (α := α) cmp] [IsStrictCut cmp cut]\n (t : RBSet α cmp) (h : cut v ≠ .eq) : (t.insert v).findP? cut = t.findP? cut := by\n refine Option.ext fun u =>\n findP?_some.trans <| .trans (and_congr_left fun h' => ?_) findP?_some.symm\n rw [mem_toList_insert, or_iff_left, and_iff_left]\n · exact mt (fun h => by rwa [IsCut.congr (cut := cut) (find?_some_eq_eq h)]) h\n · rintro rfl; contradiction\n\ntheorem find?_insert_of_ne [Std.TransCmp (α := α) cmp] (t : RBSet α cmp) (h : cmp v' v ≠ .eq) :\n (t.insert v).find? v' = t.find? v' := findP?_insert_of_ne t h\n\ntheorem findP?_insert [Std.TransCmp (α := α) cmp] (t : RBSet α cmp) (v cut) [IsStrictCut cmp cut] :\n (t.insert v).findP? cut = if cut v = .eq then some v else t.findP? cut := by\n split <;> [exact findP?_insert_of_eq t ‹_›; exact findP?_insert_of_ne t ‹_›]\n\ntheorem find?_insert [Std.TransCmp (α := α) cmp] (t : RBSet α cmp) (v v') :\n (t.insert v).find? v' = if cmp v' v = .eq then some v else t.find? v' := findP?_insert ..\n\ntheorem upperBoundP?_eq_findP? {t : RBSet α cmp} {cut} (H : t.findP? cut = some x) :\n t.upperBoundP? cut = some x := RBNode.upperBound?_eq_find? _ H\n\ntheorem lowerBoundP?_eq_findP? {t : RBSet α cmp} {cut} (H : t.findP? cut = some x) :\n t.lowerBoundP? cut = some x := RBNode.lowerBound?_eq_find? _ H\n\ntheorem upperBound?_eq_find? {t : RBSet α cmp} (H : t.find? x = some y) :\n t.upperBound? x = some y := upperBoundP?_eq_findP? H\n\ntheorem lowerBound?_eq_find? {t : RBSet α cmp} (H : t.find? x = some y) :\n t.lowerBound? x = some y := lowerBoundP?_eq_findP? H\n\n/-- The value `x` returned by `upperBoundP?` is greater or equal to the `cut`. -/\ntheorem upperBoundP?_ge {t : RBSet α cmp} : t.upperBoundP? cut = some x → cut x ≠ .gt :=\n RBNode.upperBound?_ge\n\n/-- The value `y` returned by `upperBound? x` is greater or equal to `x`. -/\ntheorem upperBound?_ge {t : RBSet α cmp} : t.upperBound? x = some y → cmp x y ≠ .gt :=\n upperBoundP?_ge\n\n/-- The value `x` returned by `lowerBoundP?` is less or equal to the `cut`. -/\ntheorem lowerBoundP?_le {t : RBSet α cmp} : t.lowerBoundP? cut = some x → cut x ≠ .lt :=\n RBNode.lowerBound?_le\n\n/-- The value `y` returned by `lowerBound? x` is less or equal to `x`. -/\ntheorem lowerBound?_le {t : RBSet α cmp} : t.lowerBound? x = some y → cmp x y ≠ .lt :=\n lowerBoundP?_le\n\ntheorem upperBoundP?_mem_toList {t : RBSet α cmp} (h : t.upperBoundP? cut = some x) :\n x ∈ t.toList := mem_toList.2 (RBNode.upperBound?_mem h)\n\ntheorem upperBound?_mem_toList {t : RBSet α cmp} (h : t.upperBound? x = some y) :\n y ∈ t.toList := upperBoundP?_mem_toList h\n\ntheorem lowerBoundP?_mem_toList {t : RBSet α cmp} (h : t.lowerBoundP? cut = some x) :\n x ∈ t.toList := mem_toList.2 (RBNode.lowerBound?_mem h)\n\ntheorem lowerBound?_mem_toList {t : RBSet α cmp} (h : t.lowerBound? x = some y) :\n y ∈ t.toList := lowerBoundP?_mem_toList h\n\ntheorem upperBoundP?_mem [Std.OrientedCmp (α := α) cmp] {t : RBSet α cmp}\n (h : t.upperBoundP? cut = some x) : x ∈ t := mem_of_mem_toList (upperBoundP?_mem_toList h)\n\ntheorem lowerBoundP?_mem [Std.OrientedCmp (α := α) cmp] {t : RBSet α cmp}\n (h : t.lowerBoundP? cut = some x) : x ∈ t := mem_of_mem_toList (lowerBoundP?_mem_toList h)\n\ntheorem upperBound?_mem [Std.OrientedCmp (α := α) cmp] {t : RBSet α cmp}\n (h : t.upperBound? x = some y) : y ∈ t := upperBoundP?_mem h\n\ntheorem lowerBound?_mem [Std.OrientedCmp (α := α) cmp] {t : RBSet α cmp}\n (h : t.lowerBound? x = some y) : y ∈ t := lowerBoundP?_mem h\n\ntheorem upperBoundP?_exists {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut] :\n (∃ x, t.upperBoundP? cut = some x) ↔ ∃ x ∈ t, cut x ≠ .gt := by\n simp [upperBoundP?, t.2.out.1.upperBound?_exists, mem_toList, mem_iff_mem_toList]\n exact ⟨\n fun ⟨x, h1, h2⟩ => ⟨x, ⟨x, h1, Std.ReflCmp.compare_self⟩, h2⟩,\n fun ⟨x, ⟨y, h1, h2⟩, eq⟩ => ⟨y, h1, IsCut.congr (cut := cut) h2 ▸ eq⟩⟩\n\ntheorem lowerBoundP?_exists {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut] :\n (∃ x, t.lowerBoundP? cut = some x) ↔ ∃ x ∈ t, cut x ≠ .lt := by\n simp [lowerBoundP?, t.2.out.1.lowerBound?_exists, mem_toList, mem_iff_mem_toList]\n exact ⟨\n fun ⟨x, h1, h2⟩ => ⟨x, ⟨x, h1, Std.ReflCmp.compare_self⟩, h2⟩,\n fun ⟨x, ⟨y, h1, h2⟩, eq⟩ => ⟨y, h1, IsCut.congr (cut := cut) h2 ▸ eq⟩⟩\n\ntheorem upperBound?_exists {t : RBSet α cmp} [Std.TransCmp cmp] :\n (∃ y, t.upperBound? x = some y) ↔ ∃ y ∈ t, cmp x y ≠ .gt := upperBoundP?_exists\n\ntheorem lowerBound?_exists {t : RBSet α cmp} [Std.TransCmp cmp] :\n (∃ y, t.lowerBound? x = some y) ↔ ∃ y ∈ t, cmp x y ≠ .lt := lowerBoundP?_exists\n\n/--\nA statement of the least-ness of the result of `upperBoundP?`. If `x` is the return value of\n`upperBoundP?` and it is strictly greater than the cut, then any other `y < x` in the tree is in\nfact strictly less than the cut (so there is no exact match, and nothing closer to the cut).\n-/\ntheorem upperBoundP?_least {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut]\n (H : t.upperBoundP? cut = some x) (hy : y ∈ t)\n (xy : cmp y x = .lt) (hx : cut x = .lt) : cut y = .gt :=\n let ⟨_, h1, h2⟩ := mem_iff_mem_toList.1 hy\n IsCut.congr (cut := cut) h2 ▸\n t.2.out.1.upperBound?_least H (mem_toList.1 h1) (Std.TransCmp.congr_left h2 ▸ xy) hx\n\n/--\nA statement of the greatest-ness of the result of `lowerBoundP?`. If `x` is the return value of\n`lowerBoundP?` and it is strictly less than the cut, then any other `y > x` in the tree is in fact\nstrictly greater than the cut (so there is no exact match, and nothing closer to the cut).\n-/\ntheorem lowerBoundP?_greatest {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut]\n (H : t.lowerBoundP? cut = some x) (hy : y ∈ t)\n (xy : cmp x y = .lt) (hx : cut x = .gt) : cut y = .lt :=\n let ⟨_, h1, h2⟩ := mem_iff_mem_toList.1 hy\n IsCut.congr (cut := cut) h2 ▸\n t.2.out.1.lowerBound?_greatest H (mem_toList.1 h1) (Std.TransCmp.congr_right h2 ▸ xy) hx\n\ntheorem memP_iff_upperBoundP? {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut] :\n t.MemP cut ↔ ∃ x, t.upperBoundP? cut = some x ∧ cut x = .eq := t.2.out.1.memP_iff_upperBound?\n\ntheorem memP_iff_lowerBoundP? {t : RBSet α cmp} [Std.TransCmp cmp] [IsCut cmp cut] :\n t.MemP cut ↔ ∃ x, t.lowerBoundP? cut = some x ∧ cut x = .eq := t.2.out.1.memP_iff_lowerBound?\n\ntheorem mem_iff_upperBound? {t : RBSet α cmp} [Std.TransCmp cmp] :\n x ∈ t ↔ ∃ y, t.upperBound? x = some y ∧ cmp x y = .eq := memP_iff_upperBoundP?\n\ntheorem mem_iff_lowerBound? {t : RBSet α cmp} [Std.TransCmp cmp] :\n x ∈ t ↔ ∃ y, t.lowerBound? x = some y ∧ cmp x y = .eq := memP_iff_lowerBoundP?\n\n/-- A stronger version of `upperBoundP?_least` that holds when the cut is strict. -/\ntheorem lt_upperBoundP? {t : RBSet α cmp} [Std.TransCmp cmp] [IsStrictCut cmp cut]\n (H : t.upperBoundP? cut = some x) (hy : y ∈ t) : cmp y x = .lt ↔ cut y = .gt :=\n let ⟨_, h1, h2⟩ := mem_iff_mem_toList.1 hy\n IsCut.congr (cut := cut) h2 ▸ Std.TransCmp.congr_left h2 ▸\n t.2.out.1.lt_upperBound? H (mem_toList.1 h1)\n\n/-- A stronger version of `lowerBoundP?_greatest` that holds when the cut is strict. -/\ntheorem lowerBoundP?_lt {t : RBSet α cmp} [Std.TransCmp cmp] [IsStrictCut cmp cut]\n (H : t.lowerBoundP? cut = some x) (hy : y ∈ t) : cmp x y = .lt ↔ cut y = .lt :=\n let ⟨_, h1, h2⟩ := mem_iff_mem_toList.1 hy\n IsCut.congr (cut := cut) h2 ▸ Std.TransCmp.congr_right h2 ▸\n t.2.out.1.lowerBound?_lt H (mem_toList.1 h1)\n\ntheorem lt_upperBound? {t : RBSet α cmp} [Std.TransCmp cmp]\n (H : t.upperBound? x = some y) (hz : z ∈ t) : cmp z y = .lt ↔ cmp z x = .lt :=\n (lt_upperBoundP? H hz).trans Std.OrientedCmp.gt_iff_lt\n\ntheorem lowerBound?_lt {t : RBSet α cmp} [Std.TransCmp cmp]\n (H : t.lowerBound? x = some y) (hz : z ∈ t) : cmp y z = .lt ↔ cmp x z = .lt :=\n lowerBoundP?_lt H hz\n\nend RBSet\n\nnamespace RBMap\n\n-- @[simp] -- FIXME: RBSet.val_toList already triggers here, seems bad?\ntheorem val_toList {t : RBMap α β cmp} : t.1.toList = t.toList := rfl\n\n@[simp] theorem mkRBSet_eq : mkRBMap α β cmp = ∅ := rfl\n@[simp] theorem empty_eq : @RBMap.empty α β cmp = ∅ := rfl\n@[simp] theorem default_eq : (default : RBMap α β cmp) = ∅ := rfl\n@[simp] theorem empty_toList : toList (∅ : RBMap α β cmp) = [] := rfl\n@[simp] theorem single_toList : toList (single a b : RBMap α β cmp) = [(a, b)] := rfl\n\ntheorem mem_toList {t : RBMap α β cmp} : x ∈ toList t ↔ x ∈ t.1 := RBNode.mem_toList\n\ntheorem foldl_eq_foldl_toList {t : RBMap α β cmp} :\n t.foldl f init = t.toList.foldl (fun r p => f r p.1 p.2) init :=\n RBNode.foldl_eq_foldl_toList\n\ntheorem foldr_eq_foldr_toList {t : RBMap α β cmp} :\n t.foldr f init = t.toList.foldr (fun p r => f p.1 p.2 r) init :=\n RBNode.foldr_eq_foldr_toList\n\ntheorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} :\n t.foldlM (m := m) f init = t.toList.foldlM (fun r p => f r p.1 p.2) init :=\n RBNode.foldlM_eq_foldlM_toList\n\ntheorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} :\n t.forM (m := m) f = t.toList.forM (fun p => f p.1 p.2) :=\n RBNode.forM_eq_forM_toList\n\ntheorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {t : RBMap α β cmp} :\n forIn (m := m) t init f = forIn t.toList init f := RBNode.forIn_eq_forIn_toList\n\ntheorem toStream_eq {t : RBMap α β cmp} : Std.toStream t = t.1.toStream .nil := rfl\n\n@[simp] theorem toStream_toList {t : RBMap α β cmp} : (Std.toStream t).toList = t.toList :=\n RBSet.toStream_toList\n\ntheorem toList_sorted {t : RBMap α β cmp} : t.toList.Pairwise (RBNode.cmpLT (cmp ·.1 ·.1)) :=\n RBSet.toList_sorted\n\ntheorem findEntry?_some_eq_eq {t : RBMap α β cmp} : t.findEntry? x = some (y, v) → cmp x y = .eq :=\n RBSet.findP?_some_eq_eq\n\ntheorem findEntry?_some_mem_toList {t : RBMap α β cmp} (h : t.findEntry? x = some y) :\n y ∈ toList t := RBSet.findP?_some_mem_toList h\n\ntheorem find?_some_mem_toList {t : RBMap α β cmp} (h : t.find? x = some v) :\n ∃ y, (y, v) ∈ toList t ∧ cmp x y = .eq := by\n obtain ⟨⟨y, v⟩, h', rfl⟩ := Option.map_eq_some_iff.1 h\n exact ⟨_, findEntry?_some_mem_toList h', findEntry?_some_eq_eq h'⟩\n\ntheorem mem_toList_unique [Std.TransCmp (α := α) cmp] {t : RBMap α β cmp}\n (hx : x ∈ toList t) (hy : y ∈ toList t) (e : cmp x.1 y.1 = .eq) : x = y :=\n RBSet.mem_toList_unique hx hy e\n\n/-- A \"representable cut\" is one generated by `cmp a` for some `a`. This is always a valid cut. -/\ninstance (cmp) (a : α) : IsStrictCut cmp (cmp a) where\n le_lt_trans h₁ h₂ := Std.TransCmp.lt_of_lt_of_le h₂ h₁\n le_gt_trans h₁ := Decidable.not_imp_not.1 (Std.TransCmp.le_trans · h₁)\n exact h := (Std.TransCmp.congr_left h).symm\n\ninstance (f : α → β) (cmp) [Std.TransCmp (α := β) cmp] (x : β) :\n IsStrictCut (Ordering.byKey f cmp) (fun y => cmp x (f y)) where\n le_lt_trans h₁ h₂ := Std.TransCmp.lt_of_lt_of_le h₂ h₁\n le_gt_trans h₁ := Decidable.not_imp_not.1 (Std.TransCmp.le_trans · h₁)\n exact h := (Std.TransCmp.congr_left h).symm\n\ntheorem findEntry?_some [Std.TransCmp (α := α) cmp] {t : RBMap α β cmp} :\n t.findEntry? x = some y ↔ y ∈ toList t ∧ cmp x y.1 = .eq := RBSet.findP?_some\n\ntheorem find?_some [Std.TransCmp (α := α) cmp] {t : RBMap α β cmp} :\n t.find? x = some v ↔ ∃ y, (y, v) ∈ toList t ∧ cmp x y = .eq := by\n simp only [find?, findEntry?_some, Option.map_eq_some_iff]; constructor\n · rintro ⟨_, h, rfl⟩; exact ⟨_, h⟩\n · rintro ⟨b, h⟩; exact ⟨_, h, rfl⟩\n\ntheorem contains_iff_findEntry? {t : RBMap α β cmp} :\n t.contains x ↔ ∃ v, t.findEntry? x = some v := Option.isSome_iff_exists\n\ntheorem contains_iff_find? {t : RBMap α β cmp} :\n t.contains x ↔ ∃ v, t.find? x = some v := by\n simp only [contains_iff_findEntry?, Prod.exists, find?, Option.map_eq_some_iff, and_comm,\n exists_eq_left]\n rw [exists_comm]\n\ntheorem size_eq (t : RBMap α β cmp) : t.size = t.toList.length := RBNode.size_eq\n\ntheorem mem_toList_insert_self (v) (t : RBMap α β cmp) : (k, v) ∈ toList (t.insert k v) :=\n RBSet.mem_toList_insert_self ..\n\ntheorem mem_toList_insert_of_mem (v) {t : RBMap α β cmp} (h : y ∈ toList t) :\n y ∈ toList (t.insert k v) ∨ cmp k y.1 = .eq := RBSet.mem_toList_insert_of_mem _ h\n\ntheorem mem_toList_insert [Std.TransCmp (α := α) cmp] {t : RBMap α β cmp} :\n y ∈ toList (t.insert k v) ↔ (y ∈ toList t ∧ t.findEntry? k ≠ some y) ∨ y = (k, v) :=\n RBSet.mem_toList_insert\n\ntheorem findEntry?_congr [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (h : cmp k₁ k₂ = .eq) :\n t.findEntry? k₁ = t.findEntry? k₂ := by\n simp only [findEntry?]; congr; funext; rw [Std.TransCmp.congr_left h]\n\ntheorem find?_congr [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (h : cmp k₁ k₂ = .eq) :\n t.find? k₁ = t.find? k₂ := by simp [find?, findEntry?_congr _ h]\n\ntheorem findEntry?_insert_of_eq [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp)\n (h : cmp k' k = .eq) : (t.insert k v).findEntry? k' = some (k, v) :=\n RBSet.findP?_insert_of_eq _ h\n\ntheorem find?_insert_of_eq [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (h : cmp k' k = .eq) :\n (t.insert k v).find? k' = some v := by rw [find?, findEntry?_insert_of_eq _ h]; rfl\n\ntheorem findEntry?_insert_of_ne [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp)\n (h : cmp k' k ≠ .eq) : (t.insert k v).findEntry? k' = t.findEntry? k' :=\n RBSet.findP?_insert_of_ne _ h\n\ntheorem find?_insert_of_ne [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (h : cmp k' k ≠ .eq) :\n (t.insert k v).find? k' = t.find? k' := by simp [find?, findEntry?_insert_of_ne _ h]\n\ntheorem findEntry?_insert [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (k v k') :\n (t.insert k v).findEntry? k' = if cmp k' k = .eq then some (k, v) else t.findEntry? k' :=\n RBSet.findP?_insert ..\n\ntheorem find?_insert [Std.TransCmp (α := α) cmp] (t : RBMap α β cmp) (k v k') :\n (t.insert k v).find? k' = if cmp k' k = .eq then some v else t.find? k' := by\n split <;> [exact find?_insert_of_eq t ‹_›; exact find?_insert_of_ne t ‹_›]\n\nend RBMap\n" }, { "path": "Batteries/Data/RBMap/WF.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.RBMap.Basic\npublic import Batteries.Tactic.SeqFocus\n\n@[expose] public section\n\n/-!\n# Lemmas for Red-black trees\n\nThe main theorem in this file is `WF_def`, which shows that the `RBNode.WF.mk` constructor\nsubsumes the others, by showing that `insert` and `erase` satisfy the red-black invariants.\n-/\n\nnamespace Batteries\n\nnamespace RBNode\nopen RBColor\n\nattribute [simp] All\n\ntheorem All.trivial (H : ∀ {x : α}, p x) : ∀ {t : RBNode α}, t.All p\n | nil => _root_.trivial\n | node .. => ⟨H, All.trivial H, All.trivial H⟩\n\ntheorem All_and {t : RBNode α} : t.All (fun a => p a ∧ q a) ↔ t.All p ∧ t.All q := by\n induction t <;> simp [*, and_assoc, and_left_comm]\n\nprotected theorem cmpLT.flip (h₁ : cmpLT cmp x y) : cmpLT (flip cmp) y x :=\n ⟨have : Std.TransCmp cmp := inferInstanceAs (Std.TransCmp (flip (flip cmp))); h₁.1⟩\n\ntheorem cmpLT.trans (h₁ : cmpLT cmp x y) (h₂ : cmpLT cmp y z) : cmpLT cmp x z :=\n ⟨Std.TransCmp.lt_trans h₁.1 h₂.1⟩\n\ntheorem cmpLT.trans_l {cmp x y} (H : cmpLT cmp x y) {t : RBNode α}\n (h : t.All (cmpLT cmp y ·)) : t.All (cmpLT cmp x ·) := h.imp fun h => H.trans h\n\ntheorem cmpLT.trans_r {cmp x y} (H : cmpLT cmp x y) {a : RBNode α}\n (h : a.All (cmpLT cmp · x)) : a.All (cmpLT cmp · y) := h.imp fun h => h.trans H\n\ntheorem cmpEq.lt_congr_left (H : cmpEq cmp x y) : cmpLT cmp x z ↔ cmpLT cmp y z :=\n ⟨fun ⟨h⟩ => ⟨Std.TransCmp.congr_left H.1 ▸ h⟩, fun ⟨h⟩ => ⟨Std.TransCmp.congr_left H.1 ▸ h⟩⟩\n\ntheorem cmpEq.lt_congr_right (H : cmpEq cmp y z) : cmpLT cmp x y ↔ cmpLT cmp x z :=\n ⟨fun ⟨h⟩ => ⟨Std.TransCmp.congr_right H.1 ▸ h⟩, fun ⟨h⟩ => ⟨Std.TransCmp.congr_right H.1 ▸ h⟩⟩\n\n@[simp] theorem reverse_reverse (t : RBNode α) : t.reverse.reverse = t := by\n induction t <;> simp [*]\n\ntheorem reverse_eq_iff {t t' : RBNode α} : t.reverse = t' ↔ t = t'.reverse := by\n constructor <;> rintro rfl <;> simp\n\n@[simp] theorem reverse_balance1 (l : RBNode α) (v : α) (r : RBNode α) :\n (balance1 l v r).reverse = balance2 r.reverse v l.reverse := by\n unfold balance1 balance2; split <;> simp\n · rw [balance2.match_1.eq_2]; simp [reverse_eq_iff]; intros; solve_by_elim\n · rw [balance2.match_1.eq_3] <;> (simp [reverse_eq_iff]; intros; solve_by_elim)\n\n@[simp] theorem reverse_balance2 (l : RBNode α) (v : α) (r : RBNode α) :\n (balance2 l v r).reverse = balance1 r.reverse v l.reverse := by\n refine Eq.trans ?_ (reverse_reverse _); rw [reverse_balance1]; simp\n\n@[simp] theorem All.reverse {t : RBNode α} : t.reverse.All p ↔ t.All p := by\n induction t <;> simp [*, and_comm]\n\n/-- The `reverse` function reverses the ordering invariants. -/\nprotected theorem Ordered.reverse : ∀ {t : RBNode α}, t.Ordered cmp → t.reverse.Ordered (flip cmp)\n | .nil, _ => ⟨⟩\n | .node .., ⟨lv, vr, hl, hr⟩ =>\n ⟨(All.reverse.2 vr).imp cmpLT.flip, (All.reverse.2 lv).imp cmpLT.flip, hr.reverse, hl.reverse⟩\n\nprotected theorem Balanced.reverse {t : RBNode α} : t.Balanced c n → t.reverse.Balanced c n\n | .nil => .nil\n | .black hl hr => .black hr.reverse hl.reverse\n | .red hl hr => .red hr.reverse hl.reverse\n\n/-- The `balance1` function preserves the ordering invariants. -/\nprotected theorem Ordered.balance1 {l : RBNode α} {v : α} {r : RBNode α}\n (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·))\n (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balance1 l v r).Ordered cmp := by\n unfold balance1; split\n · next a x b y c =>\n have ⟨yv, _, cv⟩ := lv; have ⟨xy, yc, hx, hc⟩ := hl\n exact ⟨xy, ⟨yv, yc, yv.trans_l vr⟩, hx, cv, vr, hc, hr⟩\n · next a x b y c _ =>\n have ⟨_, _, yv, _, cv⟩ := lv; have ⟨ax, ⟨xy, xb, _⟩, ha, by_, yc, hb, hc⟩ := hl\n exact ⟨⟨xy, xy.trans_r ax, by_⟩, ⟨yv, yc, yv.trans_l vr⟩, ⟨ax, xb, ha, hb⟩, cv, vr, hc, hr⟩\n · exact ⟨lv, vr, hl, hr⟩\n\n@[simp] theorem balance1_All {l : RBNode α} {v : α} {r : RBNode α} :\n (balance1 l v r).All p ↔ p v ∧ l.All p ∧ r.All p := by\n unfold balance1; split <;> simp [and_assoc, and_left_comm]\n\n/-- The `balance2` function preserves the ordering invariants. -/\nprotected theorem Ordered.balance2 {l : RBNode α} {v : α} {r : RBNode α}\n (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·))\n (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balance2 l v r).Ordered cmp := by\n rw [← reverse_reverse (balance2 ..), reverse_balance2]\n exact .reverse <| hr.reverse.balance1\n ((All.reverse.2 vr).imp cmpLT.flip) ((All.reverse.2 lv).imp cmpLT.flip) hl.reverse\n\n@[simp] theorem balance2_All {l : RBNode α} {v : α} {r : RBNode α} :\n (balance2 l v r).All p ↔ p v ∧ l.All p ∧ r.All p := by\n unfold balance2; split <;> simp [and_assoc, and_left_comm]\n\n@[simp] theorem reverse_setBlack {t : RBNode α} : (setBlack t).reverse = setBlack t.reverse := by\n unfold setBlack; split <;> simp\n\nprotected theorem Ordered.setBlack {t : RBNode α} : (setBlack t).Ordered cmp ↔ t.Ordered cmp := by\n unfold setBlack; split <;> simp [Ordered]\n\nprotected theorem Balanced.setBlack : t.Balanced c n → ∃ n', (setBlack t).Balanced black n'\n | .nil => ⟨_, .nil⟩\n | .black hl hr | .red hl hr => ⟨_, hl.black hr⟩\n\ntheorem setBlack_idem {t : RBNode α} : t.setBlack.setBlack = t.setBlack := by cases t <;> rfl\n\n@[simp] theorem reverse_ins [inst : Std.OrientedCmp (α := α) cmp] {t : RBNode α} :\n (ins cmp x t).reverse = ins (flip cmp) x t.reverse := by\n induction t with\n | nil => simp [ins]\n | node c a y b iha ihb =>\n cases c <;>\n (simp only [ins, Std.OrientedCmp.eq_swap (cmp := cmp) (a := x) (b := y)]; split) <;>\n simp_all [ins, reverse, flip]\n\nprotected theorem All.ins {x : α} {t : RBNode α}\n (h₁ : p x) (h₂ : t.All p) : (ins cmp x t).All p := by\n induction t <;> unfold ins <;> try simp [*]\n split <;> cases ‹_=_› <;> split <;> simp at h₂ <;> simp [*]\n\n/-- The `ins` function preserves the ordering invariants. -/\nprotected theorem Ordered.ins : ∀ {t : RBNode α}, t.Ordered cmp → (ins cmp x t).Ordered cmp\n | nil, _ => ⟨⟨⟩, ⟨⟩, ⟨⟩, ⟨⟩⟩\n | node red a y b, ⟨ay, yb, ha, hb⟩ => by\n unfold ins; split\n · next h => exact ⟨ay.ins ⟨h⟩, yb, ha.ins, hb⟩\n · next h => exact ⟨ay, yb.ins ⟨Std.OrientedCmp.gt_iff_lt.1 h⟩, ha, hb.ins⟩\n · next h => exact (⟨\n ay.imp fun ⟨h'⟩ => ⟨(Std.TransCmp.congr_right h).trans h'⟩,\n yb.imp fun ⟨h'⟩ => ⟨(Std.TransCmp.congr_left h).trans h'⟩, ha, hb⟩)\n | node black a y b, ⟨ay, yb, ha, hb⟩ => by\n unfold ins; split\n · next h => exact ha.ins.balance1 (ay.ins ⟨h⟩) yb hb\n · next h => exact ha.balance2 ay (yb.ins ⟨Std.OrientedCmp.gt_iff_lt.1 h⟩) hb.ins\n · next h => exact (⟨\n ay.imp fun ⟨h'⟩ => ⟨(Std.TransCmp.congr_right h).trans h'⟩,\n yb.imp fun ⟨h'⟩ => ⟨(Std.TransCmp.congr_left h).trans h'⟩, ha, hb⟩)\n\n@[simp] theorem isRed_reverse {t : RBNode α} : t.reverse.isRed = t.isRed := by\n cases t <;> simp [isRed]\n\n@[simp] theorem reverse_insert [inst : Std.OrientedCmp (α := α) cmp] {t : RBNode α} :\n (insert cmp t x).reverse = insert (flip cmp) t.reverse x := by\n simp [insert]; split <;> simp\n\ntheorem insert_setBlack {t : RBNode α} :\n (t.insert cmp v).setBlack = (t.ins cmp v).setBlack := by\n unfold insert; split <;> simp [setBlack_idem]\n\n/-- The `insert` function preserves the ordering invariants. -/\nprotected theorem Ordered.insert (h : t.Ordered cmp) : (insert cmp t v).Ordered cmp := by\n unfold RBNode.insert; split <;> simp [Ordered.setBlack, h.ins (x := v)]\n\n/--\nThe red-red invariant is a weakening of the red-black balance invariant which allows\nthe root to be red with red children, but does not allow any other violations.\nIt occurs as a temporary condition in the `insert` and `erase` functions.\n\nThe `p` parameter allows the `.redred` case to be dependent on an additional condition.\nIf it is false, then this is equivalent to the usual red-black invariant.\n-/\ninductive RedRed (p : Prop) : RBNode α → Nat → Prop where\n /-- A balanced tree has the red-red invariant. -/\n | balanced : Balanced t c n → RedRed p t n\n /-- A red node with balanced red children has the red-red invariant (if `p` is true). -/\n | redred : p → Balanced a c₁ n → Balanced b c₂ n → RedRed p (node red a x b) n\n\n/-- When `p` is false, the red-red case is impossible so the tree is balanced. -/\nprotected theorem RedRed.of_false (h : ¬p) : RedRed p t n → ∃ c, Balanced t c n\n | .balanced h => ⟨_, h⟩\n | .redred hp .. => nomatch h hp\n\n/-- A `red` node with the red-red invariant has balanced children. -/\nprotected theorem RedRed.of_red : RedRed p (node red a x b) n →\n ∃ c₁ c₂, Balanced a c₁ n ∧ Balanced b c₂ n\n | .balanced (.red ha hb) | .redred _ ha hb => ⟨_, _, ha, hb⟩\n\n/-- The red-red invariant is monotonic in `p`. -/\nprotected theorem RedRed.imp (h : p → q) : RedRed p t n → RedRed q t n\n | .balanced h => .balanced h\n | .redred hp ha hb => .redred (h hp) ha hb\n\nprotected theorem RedRed.reverse : RedRed p t n → RedRed p t.reverse n\n | .balanced h => .balanced h.reverse\n | .redred hp ha hb => .redred hp hb.reverse ha.reverse\n\n/-- If `t` has the red-red invariant, then setting the root to black yields a balanced tree. -/\nprotected theorem RedRed.setBlack : t.RedRed p n → ∃ n', (setBlack t).Balanced black n'\n | .balanced h => h.setBlack\n | .redred _ hl hr => ⟨_, hl.black hr⟩\n\n/-- The `balance1` function repairs the balance invariant when the first argument is red-red. -/\nprotected theorem RedRed.balance1 {l : RBNode α} {v : α} {r : RBNode α}\n (hl : l.RedRed p n) (hr : r.Balanced c n) : ∃ c, (balance1 l v r).Balanced c (n + 1) := by\n unfold balance1; split\n · have .redred _ (.red ha hb) hc := hl; exact ⟨_, .red (.black ha hb) (.black hc hr)⟩\n · have .redred _ ha (.red hb hc) := hl; exact ⟨_, .red (.black ha hb) (.black hc hr)⟩\n · next H1 H2 => match hl with\n | .balanced hl => exact ⟨_, .black hl hr⟩\n | .redred _ (c₁ := black) (c₂ := black) ha hb => exact ⟨_, .black (.red ha hb) hr⟩\n | .redred _ (c₁ := red) (.red ..) _ => cases H1 _ _ _ _ _ rfl\n | .redred _ (c₂ := red) _ (.red ..) => cases H2 _ _ _ _ _ rfl\n\n/-- The `balance2` function repairs the balance invariant when the second argument is red-red. -/\nprotected theorem RedRed.balance2 {l : RBNode α} {v : α} {r : RBNode α}\n (hl : l.Balanced c n) (hr : r.RedRed p n) : ∃ c, (balance2 l v r).Balanced c (n + 1) :=\n (hr.reverse.balance1 hl.reverse (v := v)).imp fun _ h => by simpa using h.reverse\n\n/-- The `balance1` function does nothing if the first argument is already balanced. -/\ntheorem balance1_eq {l : RBNode α} {v : α} {r : RBNode α}\n (hl : l.Balanced c n) : balance1 l v r = node black l v r := by\n unfold balance1; split <;> first | rfl | nomatch hl\n\n/-- The `balance2` function does nothing if the second argument is already balanced. -/\ntheorem balance2_eq {l : RBNode α} {v : α} {r : RBNode α}\n (hr : r.Balanced c n) : balance2 l v r = node black l v r :=\n (reverse_reverse _).symm.trans <| by simp [balance1_eq hr.reverse]\n\n/-! ## insert -/\n\n/--\nThe balance invariant of the `ins` function.\nThe result of inserting into the tree either yields a balanced tree,\nor a tree which is almost balanced except that it has a red-red violation at the root.\n-/\nprotected theorem Balanced.ins (cmp v) {t : RBNode α}\n (h : t.Balanced c n) : (ins cmp v t).RedRed (t.isRed = red) n := by\n induction h with\n | nil => exact .balanced (.red .nil .nil)\n | @red a n b x hl hr ihl ihr =>\n unfold ins; split\n · match ins cmp v a, ihl with\n | _, .balanced .nil => exact .balanced (.red .nil hr)\n | _, .balanced (.red ha hb) => exact .redred rfl (.red ha hb) hr\n | _, .balanced (.black ha hb) => exact .balanced (.red (.black ha hb) hr)\n | _, .redred h .. => cases hl <;> cases h\n · match ins cmp v b, ihr with\n | _, .balanced .nil => exact .balanced (.red hl .nil)\n | _, .balanced (.red ha hb) => exact .redred rfl hl (.red ha hb)\n | _, .balanced (.black ha hb) => exact .balanced (.red hl (.black ha hb))\n | _, .redred h .. => cases hr <;> cases h\n · exact .balanced (.red hl hr)\n | @black a ca n b cb x hl hr ihl ihr =>\n unfold ins; split\n · exact have ⟨c, h⟩ := ihl.balance1 hr; .balanced h\n · exact have ⟨c, h⟩ := ihr.balance2 hl; .balanced h\n · exact .balanced (.black hl hr)\n\n/--\nThe `insert` function is balanced if the input is balanced.\n(We lose track of both the color and the black-height of the result,\nso this is only suitable for use on the root of the tree.)\n-/\ntheorem Balanced.insert {t : RBNode α} (h : t.Balanced c n) :\n ∃ c' n', (insert cmp t v).Balanced c' n' := by\n unfold RBNode.insert\n match ins cmp v t, h.ins cmp v with\n | _, .balanced h => split <;> [exact ⟨_, h.setBlack⟩; exact ⟨_, _, h⟩]\n | _, .redred _ ha hb => have .node red .. := t; exact ⟨_, _, .black ha hb⟩\n\n@[simp] theorem reverse_setRed {t : RBNode α} : (setRed t).reverse = setRed t.reverse := by\n unfold setRed; split <;> simp\n\nprotected theorem All.setRed {t : RBNode α} (h : t.All p) : (setRed t).All p := by\n unfold setRed; split <;> simp_all\n\n/-- The `setRed` function preserves the ordering invariants. -/\nprotected theorem Ordered.setRed {t : RBNode α} : (setRed t).Ordered cmp ↔ t.Ordered cmp := by\n unfold setRed; split <;> simp [Ordered]\n\n@[simp] theorem reverse_balLeft (l : RBNode α) (v : α) (r : RBNode α) :\n (balLeft l v r).reverse = balRight r.reverse v l.reverse := by\n suffices ∀ r' l', r' = r.reverse → l' = l.reverse →\n (balLeft l v r).reverse = balRight r' v l' from this _ _ rfl rfl\n intros r' l' hr hl\n fun_cases balLeft l v r <;> fun_cases balRight r' v l' <;>\n grind [reverse, reverse_reverse, reverse_balance2, reverse_setRed]\n\n@[simp] theorem reverse_balRight (l : RBNode α) (v : α) (r : RBNode α) :\n (balRight l v r).reverse = balLeft r.reverse v l.reverse := by\n rw [← reverse_reverse (balLeft ..)]; simp\n\nprotected theorem All.balLeft\n (hl : l.All p) (hv : p v) (hr : r.All p) : (balLeft l v r).All p := by\n unfold balLeft; split <;> (try simp_all); split <;> simp_all [All.setRed]\n\n/-- The `balLeft` function preserves the ordering invariants. -/\nprotected theorem Ordered.balLeft {l : RBNode α} {v : α} {r : RBNode α}\n (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·))\n (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balLeft l v r).Ordered cmp := by\n unfold balLeft; split\n · exact ⟨lv, vr, hl, hr⟩\n split\n · exact hl.balance2 lv vr hr\n · have ⟨vy, va, _⟩ := vr.2.1; have ⟨⟨yz, _, bz⟩, zc, ⟨ay, yb, ha, hb⟩, hc⟩ := hr\n exact ⟨⟨vy, vy.trans_r lv, ay⟩, balance2_All.2 ⟨yz, yb, (yz.trans_l zc).setRed⟩,\n ⟨lv, va, hl, ha⟩, hb.balance2 bz zc.setRed (Ordered.setRed.2 hc)⟩\n · exact ⟨lv, vr, hl, hr⟩\n\n/-- The balancing properties of the `balLeft` function. -/\nprotected theorem Balanced.balLeft (hl : l.RedRed True n) (hr : r.Balanced cr (n + 1)) :\n (balLeft l v r).RedRed (cr = red) (n + 1) := by\n unfold balLeft; split\n · next a x b => exact\n let ⟨ca, cb, ha, hb⟩ := hl.of_red\n match cr with\n | red => .redred rfl (.black ha hb) hr\n | black => .balanced (.red (.black ha hb) hr)\n · next H => exact match hl with\n | .redred .. => nomatch H _ _ _ rfl\n | .balanced hl => match hr with\n | .black ha hb =>\n let ⟨c, h⟩ := RedRed.balance2 hl (.redred trivial ha hb); .balanced h\n | .red (.black ha hb) (.black hc hd) =>\n let ⟨c, h⟩ := RedRed.balance2 hb (.redred trivial hc hd); .redred rfl (.black hl ha) h\n\nprotected theorem All.balRight\n (hl : l.All p) (hv : p v) (hr : r.All p) : (balRight l v r).All p :=\n All.reverse.1 <| reverse_balRight .. ▸ (All.reverse.2 hr).balLeft hv (All.reverse.2 hl)\n\n/-- The `balRight` function preserves the ordering invariants. -/\nprotected theorem Ordered.balRight {l : RBNode α} {v : α} {r : RBNode α}\n (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·))\n (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (balRight l v r).Ordered cmp := by\n rw [← reverse_reverse (balRight ..), reverse_balRight]\n exact .reverse <| hr.reverse.balLeft\n ((All.reverse.2 vr).imp cmpLT.flip) ((All.reverse.2 lv).imp cmpLT.flip) hl.reverse\n\n/-- The balancing properties of the `balRight` function. -/\nprotected theorem Balanced.balRight (hl : l.Balanced cl (n + 1)) (hr : r.RedRed True n) :\n (balRight l v r).RedRed (cl = red) (n + 1) := by\n rw [← reverse_reverse (balRight ..), reverse_balRight]\n exact .reverse <| hl.reverse.balLeft hr.reverse\n\n-- note: reverse_append is false!\n\nprotected theorem All.append (hl : l.All p) (hr : r.All p) : (append l r).All p := by\n unfold append; split <;> try simp [*]\n · have ⟨hx, ha, hb⟩ := hl; have ⟨hy, hc, hd⟩ := hr\n have := hb.append hc; split <;> simp_all\n · have ⟨hx, ha, hb⟩ := hl; have ⟨hy, hc, hd⟩ := hr\n have := hb.append hc; split <;> simp_all [All.balLeft]\n · simp_all [hl.append hr.2.1]\n · simp_all [hl.2.2.append hr]\ntermination_by l.size + r.size\n\n/-- The `append` function preserves the ordering invariants. -/\nprotected theorem Ordered.append {l : RBNode α} {v : α} {r : RBNode α}\n (lv : l.All (cmpLT cmp · v)) (vr : r.All (cmpLT cmp v ·))\n (hl : l.Ordered cmp) (hr : r.Ordered cmp) : (append l r).Ordered cmp := by\n unfold append; split\n · exact hr\n · exact hl\n · have ⟨xv, _, bv⟩ := lv; have ⟨ax, xb, ha, hb⟩ := hl\n have ⟨vy, vc, _⟩ := vr; have ⟨cy, yd, hc, hd⟩ := hr\n have : _ ∧ _ ∧ _ := ⟨hb.append bv vc hc, xb.append (xv.trans_l vc), (vy.trans_r bv).append cy⟩\n split\n · next H =>\n have ⟨⟨b'z, c'z, hb', hc'⟩, ⟨xz, xb', _⟩, zy, _, c'y⟩ := H ▸ this\n have az := xz.trans_r ax; have zd := zy.trans_l yd\n exact ⟨⟨xz, az, b'z⟩, ⟨zy, c'z, zd⟩, ⟨ax, xb', ha, hb'⟩, c'y, yd, hc', hd⟩\n · have ⟨hbc, xbc, bcy⟩ := this; have xy := xv.trans vy\n exact ⟨ax, ⟨xy, xbc, xy.trans_l yd⟩, ha, bcy, yd, hbc, hd⟩\n · have ⟨xv, _, bv⟩ := lv; have ⟨ax, xb, ha, hb⟩ := hl\n have ⟨vy, vc, _⟩ := vr; have ⟨cy, yd, hc, hd⟩ := hr\n have : _ ∧ _ ∧ _ := ⟨hb.append bv vc hc, xb.append (xv.trans_l vc), (vy.trans_r bv).append cy⟩\n split\n · next H =>\n have ⟨⟨b'z, c'z, hb', hc'⟩, ⟨xz, xb', _⟩, zy, _, c'y⟩ := H ▸ this\n have az := xz.trans_r ax; have zd := zy.trans_l yd\n exact ⟨⟨xz, az, b'z⟩, ⟨zy, c'z, zd⟩, ⟨ax, xb', ha, hb'⟩, c'y, yd, hc', hd⟩\n · have ⟨hbc, xbc, bcy⟩ := this; have xy := xv.trans vy\n exact ha.balLeft ax ⟨xy, xbc, xy.trans_l yd⟩ ⟨bcy, yd, hbc, hd⟩\n · have ⟨vx, vb, _⟩ := vr; have ⟨bx, yc, hb, hc⟩ := hr\n exact ⟨(vx.trans_r lv).append bx, yc, hl.append lv vb hb, hc⟩\n · have ⟨xv, _, bv⟩ := lv; have ⟨ax, xb, ha, hb⟩ := hl\n exact ⟨ax, xb.append (xv.trans_l vr), ha, hb.append bv vr hr⟩\ntermination_by l.size + r.size\n\n/-- The balance properties of the `append` function. -/\nprotected theorem Balanced.append {l r : RBNode α}\n (hl : l.Balanced c₁ n) (hr : r.Balanced c₂ n) :\n (l.append r).RedRed (c₁ = black → c₂ ≠ black) n := by\n unfold append; split\n · exact .balanced hr\n · exact .balanced hl\n · next b c _ _ =>\n have .red ha hb := hl; have .red hc hd := hr\n have ⟨_, IH⟩ := (hb.append hc).of_false (· rfl rfl); split\n · next e =>\n have .red hb' hc' := e ▸ IH\n exact .redred nofun (.red ha hb') (.red hc' hd)\n · next bcc _ H =>\n match bcc, append b c, IH, H with\n | black, _, IH, _ => exact .redred nofun ha (.red IH hd)\n | red, _, .red .., H => cases H _ _ _ rfl\n · next b c _ _ =>\n have .black ha hb := hl; have .black hc hd := hr\n have IH := hb.append hc; split\n · next e => match e ▸ IH with\n | .balanced (.red hb' hc') | .redred _ hb' hc' =>\n exact .balanced (.red (.black ha hb') (.black hc' hd))\n · next H =>\n match append b c, IH, H with\n | bc, .balanced hbc, _ =>\n unfold balLeft; split\n · have .red ha' hb' := ha\n exact .balanced (.red (.black ha' hb') (.black hbc hd))\n · exact have ⟨c, h⟩ := RedRed.balance2 ha (.redred trivial hbc hd); .balanced h\n | _, .redred .., H => cases H _ _ _ rfl\n · have .red hc hd := hr; have IH := hl.append hc\n have .black ha hb := hl; have ⟨c, IH⟩ := IH.of_false (· rfl rfl)\n exact .redred nofun IH hd\n · have .red ha hb := hl; have IH := hb.append hr\n have .black hc hd := hr; have ⟨c, IH⟩ := IH.of_false (· rfl rfl)\n exact .redred nofun ha IH\ntermination_by l.size + r.size\n\n/-! ## erase -/\n\n/--\nThe invariant of the `del` function.\n* If the input tree is black, then the result of deletion is a red-red tree with\n black-height lowered by 1.\n* If the input tree is red or nil, then the result of deletion is a balanced tree with\n some color and the same black-height.\n-/\ndef DelProp (p : RBColor) (t : RBNode α) (n : Nat) : Prop :=\n match p with\n | black => ∃ n', n = n' + 1 ∧ RedRed True t n'\n | red => ∃ c, Balanced t c n\n\n/-- The `DelProp` property is a strengthened version of the red-red invariant. -/\ntheorem DelProp.redred (h : DelProp c t n) : ∃ n', RedRed (c = black) t n' := by\n unfold DelProp at h\n exact match c, h with\n | red, ⟨_, h⟩ => ⟨_, .balanced h⟩\n | black, ⟨_, _, h⟩ => ⟨_, h.imp fun _ => rfl⟩\n\nprotected theorem All.del : ∀ {t : RBNode α}, t.All p → (del cut t).All p\n | .nil, h => h\n | .node .., ⟨hy, ha, hb⟩ => by\n unfold del; split\n · split\n · exact ha.del.balLeft hy hb\n · exact ⟨hy, ha.del, hb⟩\n · split\n · exact ha.balRight hy hb.del\n · exact ⟨hy, ha, hb.del⟩\n · exact ha.append hb\n\n/-- The `del` function preserves the ordering invariants. -/\nprotected theorem Ordered.del : ∀ {t : RBNode α}, t.Ordered cmp → (del cut t).Ordered cmp\n | .nil, _ => ⟨⟩\n | .node _ a y b, ⟨ay, yb, ha, hb⟩ => by\n unfold del; split\n · split\n · exact ha.del.balLeft ay.del yb hb\n · exact ⟨ay.del, yb, ha.del, hb⟩\n · split\n · exact ha.balRight ay yb.del hb.del\n · exact ⟨ay, yb.del, ha, hb.del⟩\n · exact ha.append ay yb hb\n\n/-- The `del` function has the `DelProp` property. -/\nprotected theorem Balanced.del {t : RBNode α} (h : t.Balanced c n) :\n (t.del cut).DelProp t.isBlack n := by\n induction h with\n | nil => exact ⟨_, .nil⟩\n | @black a _ n b _ _ ha hb iha ihb =>\n refine ⟨_, rfl, ?_⟩\n unfold del; split\n · exact match a, n, iha with\n | .nil, _, ⟨c, ha⟩ | .node red .., _, ⟨c, ha⟩ => .redred ⟨⟩ ha hb\n | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).imp fun _ => ⟨⟩\n · exact match b, n, ihb with\n | .nil, _, ⟨c, hb⟩ | .node .red .., _, ⟨c, hb⟩ => .redred ⟨⟩ ha hb\n | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).imp fun _ => ⟨⟩\n · exact (ha.append hb).imp fun _ => ⟨⟩\n | @red a n b _ ha hb iha ihb =>\n unfold del; split\n · exact match a, n, iha with\n | .nil, _, _ => ⟨_, .red ha hb⟩\n | .node black .., _, ⟨n, rfl, ha⟩ => (hb.balLeft ha).of_false nofun\n · exact match b, n, ihb with\n | .nil, _, _ => ⟨_, .red ha hb⟩\n | .node black .., _, ⟨n, rfl, hb⟩ => (ha.balRight hb).of_false nofun\n · exact (ha.append hb).of_false (· rfl rfl)\n\n/-- The `erase` function preserves the ordering invariants. -/\nprotected theorem Ordered.erase {t : RBNode α} (h : t.Ordered cmp) : (erase cut t).Ordered cmp :=\n Ordered.setBlack.2 h.del\n\n/-- The `erase` function preserves the balance invariants. -/\nprotected theorem Balanced.erase {t : RBNode α}\n (h : t.Balanced c n) : ∃ n, (t.erase cut).Balanced black n :=\n have ⟨_, h⟩ := h.del.redred; h.setBlack\n\n/-- The well-formedness invariant implies the ordering and balance properties. -/\ntheorem WF.out {t : RBNode α} (h : t.WF cmp) : t.Ordered cmp ∧ ∃ c n, t.Balanced c n := by\n induction h with\n | mk o h => exact ⟨o, _, _, h⟩\n | insert _ ih => have ⟨o, _, _, h⟩ := ih; exact ⟨o.insert, h.insert⟩\n | erase _ ih => have ⟨o, _, _, h⟩ := ih; exact ⟨o.erase, _, h.erase⟩\n\n/--\nThe well-formedness invariant for a red-black tree is exactly the `mk` constructor,\nbecause the other constructors of `WF` are redundant.\n-/\n@[simp] theorem WF_iff {t : RBNode α} : t.WF cmp ↔ t.Ordered cmp ∧ ∃ c n, t.Balanced c n :=\n ⟨fun h => h.out, fun ⟨o, _, _, h⟩ => .mk o h⟩\n\n/-- The `map` function preserves the balance invariants. -/\nprotected theorem Balanced.map {t : RBNode α} : t.Balanced c n → (t.map f).Balanced c n\n | .nil => .nil\n | .red hl hr => .red hl.map hr.map\n | .black hl hr => .black hl.map hr.map\n\n/-- The property of a map function `f` which ensures the `map` operation is valid. -/\nclass IsMonotone (cmpα cmpβ) (f : α → β) : Prop where\n /-- If `x < y` then `f x < f y`. -/\n lt_mono : cmpLT cmpα x y → cmpLT cmpβ (f x) (f y)\n\n/-- Sufficient condition for `map` to preserve an `All` quantifier. -/\nprotected theorem All.map {f : α → β} (H : ∀ {x}, p x → q (f x)) :\n ∀ {t : RBNode α}, t.All p → (t.map f).All q\n | nil, _ => ⟨⟩\n | node .., ⟨hx, ha, hb⟩ => ⟨H hx, ha.map H, hb.map H⟩\n\n/-- The `map` function preserves the order invariants if `f` is monotone. -/\nprotected theorem Ordered.map (f : α → β) [IsMonotone cmpα cmpβ f] :\n ∀ {t : RBNode α}, t.Ordered cmpα → (t.map f).Ordered cmpβ\n | nil, _ => ⟨⟩\n | node _ a x b, ⟨ax, xb, ha, hb⟩ => by\n refine ⟨ax.map ?_, xb.map ?_, ha.map f, hb.map f⟩ <;> exact IsMonotone.lt_mono\n\nend RBNode\n\nnamespace RBSet\nexport RBNode (IsMonotone)\n\n/--\n`O(n)`. Map a function on every value in the set.\nThis requires `IsMonotone` on the function in order to preserve the order invariant.\nIf the function is not monotone, use `RBSet.map` instead.\n-/\n@[inline] def mapMonotone (f : α → β) [IsMonotone cmpα cmpβ f] (t : RBSet α cmpα) : RBSet β cmpβ :=\n ⟨t.1.map f, have ⟨h₁, _, _, h₂⟩ := t.2.out; .mk (h₁.map _) h₂.map⟩\n\nend RBSet\n\nnamespace RBMap\nexport RBNode (IsMonotone)\n\nnamespace Imp\n\n/--\nApplies `f` to the second component.\nWe extract this as a function so that `IsMonotone (mapSnd f)` can be an instance.\n-/\n@[inline] def mapSnd (f : α → β → γ) := fun (a, b) => (a, f a b)\n\nopen Ordering (byKey)\n\ninstance (cmp : α → α → Ordering) (f : α → β → γ) :\n IsMonotone (byKey Prod.fst cmp) (byKey Prod.fst cmp) (mapSnd f) where\n lt_mono | ⟨h⟩ => ⟨@fun _ => @h {\n eq_swap := @fun (a₁, b₁) (a₂, b₂) =>\n Std.OrientedCmp.eq_swap (cmp := byKey Prod.fst cmp) (a := (a₁, f a₁ b₁)) (b := (a₂, f a₂ b₂))\n isLE_trans := @fun (a₁, b₁) (a₂, b₂) (a₃, b₃) =>\n Std.TransCmp.isLE_trans (cmp := byKey Prod.fst cmp)\n (a := (a₁, f a₁ b₁)) (b := (a₂, f a₂ b₂)) (c := (a₃, f a₃ b₃))\n }⟩\n\nend Imp\n\n/-- `O(n)`. Map a function on the values in the map. -/\ndef mapVal (f : α → β → γ) (t : RBMap α β cmp) : RBMap α γ cmp := t.mapMonotone (Imp.mapSnd f)\n\nend RBMap\n" }, { "path": "Batteries/Data/RBMap.lean", "content": "module\n\npublic import Batteries.Data.RBMap.Alter\npublic import Batteries.Data.RBMap.Basic\npublic import Batteries.Data.RBMap.Depth\npublic import Batteries.Data.RBMap.Lemmas\npublic import Batteries.Data.RBMap.WF\n" }, { "path": "Batteries/Data/Random/MersenneTwister.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\npublic section\n\n/-! # Mersenne Twister\n\nGeneric implementation for the Mersenne Twister pseudorandom number generator.\n\nAll choices of parameters from Matsumoto and Nishimura (1998) are supported, along with later\nrefinements. Parameters for the standard 32-bit MT19937 and 64-bit MT19937-64 algorithms are\nprovided. Both `RandomGen` and `Stream` interfaces are provided.\n\nUse `mt19937.init seed` to create a MT19937 PRNG with a 32 bit seed value; use\n`mt19937_64.init seed` to create a MT19937-64 PRNG with a 64 bit seed value. If omitted, default\nseed choices will be used.\n\nSample usage:\n```\nimport Batteries.Data.Random.MersenneTwister\n\nopen Batteries.Random.MersenneTwister\n\ndef mtgen := mt19937.init -- default seed 4357\n\n#eval (Stream.take mtgen 5).fst -- [874448474, 2424656266, 2174085406, 1265871120, 3155244894]\n```\n\n### References:\n\n- Matsumoto, Makoto and Nishimura, Takuji (1998),\n [**Mersenne twister: A 623-dimensionally equidistributed uniform pseudo-random number generator**](https://doi.org/10.1145/272991.272995),\n ACM Trans. Model. Comput. Simul. 8, No. 1, 3-30.\n [ZBL0917.65005](https://zbmath.org/?q=an:0917.65005).\n\n- Nishimura, Takuji (2000),\n [**Tables of 64-bit Mersenne twisters**](https://doi.org/10.1145/369534.369540),\n ACM Trans. Model. Comput. Simul. 10, No. 4, 348-357.\n [ZBL1390.65014](https://zbmath.org/?q=an:1390.65014).\n-/\n\nnamespace Batteries.Random.MersenneTwister\n\n/--\nMersenne Twister configuration.\n\nLetters in parentheses correspond to variable names used by Matsumoto and Nishimura (1998) and\nNishimura (2000).\n-/\nstructure Config where\n /-- Word size (`w`). -/\n wordSize : Nat\n /-- Degree of recurrence (`n`). -/\n stateSize : Nat\n /-- Middle word (`m`). -/\n shiftSize : Fin stateSize\n /-- Twist value (`r`). -/\n maskBits : Fin wordSize\n /-- Coefficients of the twist matrix (`a`). -/\n xorMask : BitVec wordSize\n /-- Tempering shift parameters (`u`, `s`, `t`, `l`). -/\n temperingShifts : Nat × Nat × Nat × Nat\n /-- Tempering mask parameters (`d`, `b`, `c`). -/\n temperingMasks : BitVec wordSize × BitVec wordSize × BitVec wordSize\n /-- Initialization multiplier (`f`). -/\n initMult : BitVec wordSize\n /-- Default initialization seed value. -/\n initSeed : BitVec wordSize\n\nprivate abbrev Config.uMask (cfg : Config) : BitVec cfg.wordSize :=\n BitVec.allOnes cfg.wordSize <<< cfg.maskBits.val\n\nprivate abbrev Config.lMask (cfg : Config) : BitVec cfg.wordSize :=\n BitVec.allOnes cfg.wordSize >>> (cfg.wordSize - cfg.maskBits.val)\n\n@[simp] theorem Config.zero_lt_wordSize (cfg : Config) : 0 < cfg.wordSize :=\n Nat.zero_lt_of_lt cfg.maskBits.is_lt\n\n@[simp] theorem Config.zero_lt_stateSize (cfg : Config) : 0 < cfg.stateSize :=\n Nat.zero_lt_of_lt cfg.shiftSize.is_lt\n\n/-- Mersenne Twister State. -/\nstructure State (cfg : Config) where\n /-- Data for current state. -/\n data : Vector (BitVec cfg.wordSize) cfg.stateSize\n /-- Current data index. -/\n index : Fin cfg.stateSize\n\n/-- Mersenne Twister initialization given an optional seed. -/\n@[specialize cfg] protected def Config.init (cfg : MersenneTwister.Config)\n (seed : BitVec cfg.wordSize := cfg.initSeed) : State cfg :=\n ⟨loop seed (.mkEmpty cfg.stateSize) (Nat.zero_le _), 0, cfg.zero_lt_stateSize⟩\nwhere\n /-- Inner loop for Mersenne Twister initalization. -/\n loop (w : BitVec cfg.wordSize) (v : Array (BitVec cfg.wordSize)) (h : v.size ≤ cfg.stateSize) :=\n if heq : v.size = cfg.stateSize then ⟨v, heq⟩ else\n let v := v.push w\n let w := cfg.initMult * (w ^^^ (w >>> cfg.wordSize - 2)) + v.size\n loop w v (by simp only [v, Array.size_push]; omega)\n\n/-- Apply the twisting transformation to the given state. -/\n@[specialize cfg] protected def State.twist (state : State cfg) : State cfg :=\n let i := state.index\n let i' : Fin cfg.stateSize :=\n if h : i.val+1 < cfg.stateSize then ⟨i.val+1, h⟩ else ⟨0, cfg.zero_lt_stateSize⟩\n let y := state.data[i] &&& cfg.uMask ||| state.data[i'] &&& cfg.lMask\n let x := state.data[i+cfg.shiftSize] ^^^ bif y[0] then y >>> 1 ^^^ cfg.xorMask else y >>> 1\n ⟨state.data.set i x, i'⟩\n\n/-- Update the state by a number of generation steps (default 1). -/\n-- TODO: optimize to `O(log(steps))` using the minimal polynomial\nprotected def State.update (state : State cfg) : (steps : Nat := 1) → State cfg\n | 0 => state\n | steps+1 => state.twist.update steps\n\n/-- Mersenne Twister iteration. -/\n@[specialize cfg] protected def State.next (state : State cfg) : BitVec cfg.wordSize × State cfg :=\n let i := state.index\n let s := state.twist\n (temper s.data[i], s)\nwhere\n /-- Tempering step for Mersenne Twister. -/\n @[inline] temper (x : BitVec cfg.wordSize) :=\n match cfg.temperingShifts, cfg.temperingMasks with\n | (u, s, t, l), (d, b, c) =>\n let x := x ^^^ x >>> u &&& d\n let x := x ^^^ x <<< s &&& b\n let x := x ^^^ x <<< t &&& c\n x ^^^ x >>> l\n\ninstance (cfg) : Std.Stream (State cfg) (BitVec cfg.wordSize) where\n next? s := s.next\n\n/-- 32 bit Mersenne Twister (MT19937) configuration. -/\ndef mt19937 : Config where\n wordSize := 32\n stateSize := 624\n shiftSize := 397\n maskBits := 31\n xorMask := 0x9908b0df\n temperingShifts := (11, 7, 15, 18)\n temperingMasks := (0xffffffff, 0x9d2c5680, 0xefc60000)\n initMult := 1812433253\n initSeed := 4357\n\n/-- 64 bit Mersenne Twister (MT19937-64) configuration. -/\ndef mt19937_64 : Config where\n wordSize := 64\n stateSize := 312\n shiftSize := 156\n maskBits := 31\n xorMask := 0xb5026f5aa96619e9\n temperingShifts := (29, 17, 37, 43)\n temperingMasks := (0x5555555555555555, 0x71d67fffeda60000, 0xfff7eee000000000)\n initMult := 6364136223846793005\n initSeed := 19650218\n" }, { "path": "Batteries/Data/Random.lean", "content": "module\n\npublic import Batteries.Data.Random.MersenneTwister\n" }, { "path": "Batteries/Data/Range/Lemmas.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.SeqFocus\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\nnamespace Std.Legacy.Range\n\ntheorem size_stop_le_start : ∀ r : Range, r.stop ≤ r.start → r.size = 0\n | ⟨start, stop, step, _⟩, h => by\n simp_all [size]\n omega\n\ntheorem size_step_1 (start stop) : size ⟨start, stop, 1, by decide⟩ = stop - start := by\n simp [size]\n" }, { "path": "Batteries/Data/Range.lean", "content": "module\n\npublic import Batteries.Data.Range.Lemmas\n" }, { "path": "Batteries/Data/Rat/Float.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Lean.Float\n\n@[expose] public section\n\n/-! # Rational Numbers and Float -/\n\nnamespace Rat\n\n/-- Convert this rational number to a `Float` value. -/\nprotected def toFloat (a : Rat) : Float := a.num.divFloat a.den\n\n/-- Convert this floating point number to a rational value. -/\nprotected def _root_.Float.toRat? (a : Float) : Option Rat :=\n a.toRatParts.map fun (v, exp) =>\n mkRat (v.sign * v.natAbs <<< exp.toNat) (1 <<< (-exp).toNat)\n\n/--\nConvert this floating point number to a rational value,\nmapping non-finite values (`inf`, `-inf`, `nan`) to 0.\n-/\nprotected def _root_.Float.toRat0 (a : Float) : Rat := a.toRat?.getD 0\n\ninstance : Coe Rat Float := ⟨Rat.toFloat⟩\n\nend Rat\n" }, { "path": "Batteries/Data/Rat.lean", "content": "module\n\npublic import Batteries.Data.Rat.Float\n" }, { "path": "Batteries/Data/RunningStats.lean", "content": "/-\nCopyright (c) 2025 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\n\nmodule\npublic import Init.Data.Nat\n\nsection\n\n/-! # Running Statistics\n\nThis module implements Welford's one-pass algorithm for calculating the mean and\nstandard deviation of a sample or a population. The advantage of this algorithm is\nthat it is not necessary to store the data.\n\nThe algorithm uses the recurrence formulas for the mean `μ`, variance `σ²`\nand the sample variance `s²`:\n```\n μₖ = μₖ₋₁ + (xₖ − μₖ₋₁)/k\n σ²ₖ = σ²ₖ₋₁*(k-1)/k + (xₖ − μₖ₋₁)*(xₖ − μₖ)/k\n s²ₖ = s²ₖ₋₁*(k-2)/(k-1) + (xₖ - μₖ₋₁)²/k\n```\nTo improve performance, Welford's algorithm keeps track of the two running\nquantities:\n```\n Mₖ = Mₖ₋₁ + (xₖ - Mₖ₋₁)/k\n Sₖ = Sₖ₋₁ + (xₖ - Mₖ₋₁)*(xₖ - Mₖ)\n```\nThen: `μₖ = Mₖ`, `σ²ₖ = Sₖ/k`, `s²ₖ = Sₖ/(k-1)`.\n-/\n\nnamespace Batteries\n\n/-- Compute running statistics of a data stream using Welford's algorithm. -/\npublic structure RunningStats where\n /-- Initialize running statistics. -/\n init ::\n /-- Number of data points, -/\n count : Nat := 0\n /-- Mean of data points. -/\n mean : Float := 0.0\n /-- Variance of data points times the number of data points. -/\n var : Float := 0.0\n\nnamespace RunningStats\n\n/-- Add a new data point to running statistics. -/\n@[inline]\npublic def push (data : Float) (s : RunningStats) : RunningStats :=\n let count := s.count + 1\n let mean := s.mean + (data - s.mean) / count.toFloat\n let var := s.var + (data - s.mean) * (data - mean)\n {count, mean, var}\n\n/-- Variance of running data stream. -/\n@[inline]\npublic def variance (s : RunningStats) : Float :=\n if s.count ≤ 1 then 0.0 else s.var / s.count.toFloat\n\n/-- Unbiased variance of running data stream. -/\n@[inline]\npublic def sampleVariance (s : RunningStats) : Float :=\n if s.count ≤ 2 then 0.0 else s.var / (s.count - 1).toFloat\n\n/-- Standard deviation of running data stream. -/\n@[inline]\npublic def standardDeviation (s : RunningStats) : Float :=\n Float.sqrt s.sampleVariance\n" }, { "path": "Batteries/Data/Stream.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2. license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace Std.Stream\n\n/-- Drop up to `n` values from the stream `s`. -/\ndef drop [Stream σ α] (s : σ) : Nat → σ\n | 0 => s\n | n+1 =>\n match next? s with\n | none => s\n | some (_, s) => drop s n\n\n/-- Read up to `n` values from the stream `s` as a list from first to last. -/\ndef take [Stream σ α] (s : σ) : Nat → List α × σ\n | 0 => ([], s)\n | n+1 =>\n match next? s with\n | none => ([], s)\n | some (a, s) =>\n match take s n with\n | (as, s) => (a :: as, s)\n\n@[simp] theorem fst_take_zero [Stream σ α] (s : σ) :\n (take s 0).fst = [] := rfl\n\ntheorem fst_take_succ [Stream σ α] (s : σ) :\n (take s (n+1)).fst = match next? s with\n | none => []\n | some (a, s) => a :: (take s n).fst := by\n simp only [take]; split <;> rfl\n\n@[simp] theorem snd_take_eq_drop [Stream σ α] (s : σ) (n : Nat) :\n (take s n).snd = drop s n := by\n induction n generalizing s with\n | zero => rfl\n | succ n ih =>\n simp only [take, drop]\n split <;> simp [ih]\n\n/-- Tail recursive version of `Stream.take`. -/\ndef takeTR [Stream σ α] (s : σ) (n : Nat) : List α × σ :=\n loop s [] n\nwhere\n /-- Inner loop for `Stream.takeTR`. -/\n loop (s : σ) (acc : List α)\n | 0 => (acc.reverse, s)\n | n+1 => match next? s with\n | none => (acc.reverse, s)\n | some (a, s) => loop s (a :: acc) n\n\ntheorem fst_takeTR_loop [Stream σ α] (s : σ) (acc : List α) (n : Nat) :\n (takeTR.loop s acc n).fst = acc.reverseAux (take s n).fst := by\n induction n generalizing acc s with\n | zero => rfl\n | succ n ih => simp only [take, takeTR.loop]; split; rfl; simp [ih]\n\ntheorem fst_takeTR [Stream σ α] (s : σ) (n : Nat) : (takeTR s n).fst = (take s n).fst :=\n fst_takeTR_loop ..\n\ntheorem snd_takeTR_loop [Stream σ α] (s : σ) (acc : List α) (n : Nat) :\n (takeTR.loop s acc n).snd = drop s n := by\n induction n generalizing acc s with\n | zero => rfl\n | succ n ih => simp only [takeTR.loop, drop]; split; rfl; simp [ih]\n\ntheorem snd_takeTR [Stream σ α] (s : σ) (n : Nat) :\n (takeTR s n).snd = drop s n := snd_takeTR_loop ..\n\n@[csimp] theorem take_eq_takeTR : @take = @takeTR := by\n funext; ext : 1; rw [fst_takeTR]; rw [snd_takeTR, snd_take_eq_drop]\n\nend Stream\n\n@[simp] theorem List.stream_drop_eq_drop (l : List α) : Stream.drop l n = l.drop n := by\n induction n generalizing l with\n | zero => rfl\n | succ n ih =>\n match l with\n | [] => rfl\n | _::_ => simp [Stream.drop, List.drop_succ_cons, ih]\n\n@[simp] theorem List.stream_take_eq_take_drop (l : List α) :\n Stream.take l n = (l.take n, l.drop n) := by\n induction n generalizing l with\n | zero => rfl\n | succ n ih =>\n match l with\n | [] => rfl\n | _::_ => simp [Stream.take, ih]\n" }, { "path": "Batteries/Data/String/AsciiCasing.lean", "content": "/-\nCopyright (c) 2025 Christopher Bailey. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Christopher Bailey, F. G. Dorais\n-/\nmodule\n/- Failing on nightly-2025-12-18\npublic import Batteries.Data.Char\npublic import Batteries.Data.Char.AsciiCasing\n\n@[expose] public section\n\nnamespace String\n\n/-- Case folding for ASCII characters only.\n\nAlphabetic ASCII characters are mapped to their lowercase form, all other characters are left\nunchanged. This agrees with the Unicode case folding algorithm for ASCII characters.\n\n```\n#eval \"ABC\".caseFoldAsciiOnly == \"abc\" -- true\n#eval \"x\".caseFoldAsciiOnly == \"y\" -- false\n#eval \"Àà\".caseFoldAsciiOnly == \"Àà\" -- true\n#eval \"1$#!\".caseFoldAsciiOnly == \"1$#!\" -- true\n```\n-/\nabbrev caseFoldAsciiOnly (s : String) := s.map Char.caseFoldAsciiOnly\n\n-- TODO: Reimplement with finite iterators/streams when available for `String`.\nprivate partial def beqCaseInsensitiveAsciiOnlyImpl (s₁ s₂ : String) : Bool :=\n s₁.length == s₂.length && loop (ToStream.toStream s₁) (ToStream.toStream s₂)\nwhere\n loop i₁ i₂ := match Stream.next? i₁, Stream.next? i₂ with\n | some (c₁, i₁), some (c₂, i₂) => c₁.beqCaseInsensitiveAsciiOnly c₂ && loop i₁ i₂\n | none, none => true\n | _, _ => false\n\n/--\nBool-valued comparison of two `String`s for *ASCII*-case insensitive equality.\n\n#eval \"abc\".beqCaseInsensitiveAsciiOnly \"ABC\" -- true\n#eval \"cba\".beqCaseInsensitiveAsciiOnly \"ABC\" -- false\n#eval \"$\".beqCaseInsensitiveAsciiOnly \"$\" -- true\n#eval \"a\".beqCaseInsensitiveAsciiOnly \"b\" -- false\n#eval \"γ\".beqCaseInsensitiveAsciiOnly \"Γ\" -- false\n-/\n@[implemented_by beqCaseInsensitiveAsciiOnlyImpl]\ndef beqCaseInsensitiveAsciiOnly (s₁ s₂ : String) : Bool :=\n s₁.caseFoldAsciiOnly == s₂.caseFoldAsciiOnly\n\ntheorem beqCaseInsensitiveAsciiOnly.eqv : Equivalence (beqCaseInsensitiveAsciiOnly · ·) := {\n refl _ := BEq.rfl\n trans _ _ := by simp_all [beqCaseInsensitiveAsciiOnly]\n symm := by simp_all [beqCaseInsensitiveAsciiOnly]\n}\n\n/--\nSetoid structure on `String` usig `beqCaseInsensitiveAsciiOnly`\n-/\ndef beqCaseInsensitiveAsciiOnly.isSetoid : Setoid String :=\n ⟨(beqCaseInsensitiveAsciiOnly · ·), beqCaseInsensitiveAsciiOnly.eqv⟩\n\n-- TODO: Reimplement with finite iterators/streams when available for `String`.\nprivate partial def cmpCaseInsensitiveAsciiOnlyImpl (s₁ s₂ : String) : Ordering :=\n loop (ToStream.toStream s₁) (ToStream.toStream s₂)\nwhere\n loop i₁ i₂ := match Stream.next? i₁, Stream.next? i₂ with\n | some (c₁, i₁), some (c₂, i₂) => c₁.cmpCaseInsensitiveAsciiOnly c₂ |>.then (loop i₁ i₂)\n | some _, none => .gt\n | none, some _ => .lt\n | none, none => .eq\n\n/--\nASCII-case insensitive implementation comparison returning an `Ordering`. Useful for sorting.\n\n```\n#eval cmpCaseInsensitiveAsciiOnly \"a\" \"A\" -- eq\n#eval cmpCaseInsensitiveAsciiOnly \"a\" \"a\" -- eq\n#eval cmpCaseInsensitiveAsciiOnly \"$\" \"$\" -- eq\n#eval cmpCaseInsensitiveAsciiOnly \"a\" \"b\" -- lt\n#eval cmpCaseInsensitiveAsciiOnly \"γ\" \"Γ\" -- gt\n```\n-/\n@[implemented_by cmpCaseInsensitiveAsciiOnlyImpl]\ndef cmpCaseInsensitiveAsciiOnly (s₁ s₂ : String) : Ordering :=\n compare s₁.caseFoldAsciiOnly s₂.caseFoldAsciiOnly\n-/\n" }, { "path": "Batteries/Data/String/Basic.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg, James Gallicchio, F. G. Dorais\n-/\nmodule\n\n@[expose] public section\n\ninstance : Coe String Substring.Raw := ⟨String.toRawSubstring⟩\n\nnamespace String\n\n/-- Count the occurrences of a character in a string. -/\ndef count (s : String) (c : Char) : Nat :=\n s.foldl (fun n d => if d = c then n + 1 else n) 0\n\n/--\nConvert a string of assumed-ASCII characters into a byte array.\n(If any characters are non-ASCII they will be reduced modulo 256.)\n\nNote: if you just need the underlying `ByteArray` of a non-ASCII string,\nuse `String.toUTF8`.\n-/\ndef toAsciiByteArray (s : String) : ByteArray :=\n let rec\n /--\n Internal implementation of `toAsciiByteArray`.\n `loop p out = out ++ toAsciiByteArray ({ s with startPos := p } : Substring)`\n -/\n loop (p : Pos.Raw) (out : ByteArray) : ByteArray :=\n if h : p.atEnd s then out else\n let c := p.get s\n have : utf8ByteSize s - (Pos.Raw.next s p).byteIdx < utf8ByteSize s - p.byteIdx :=\n Nat.sub_lt_sub_left (Nat.lt_of_not_le <| mt decide_eq_true h)\n (Nat.lt_add_of_pos_right (Char.utf8Size_pos _))\n loop (p.next s) (out.push c.toUInt8)\n termination_by utf8ByteSize s - p.byteIdx\n loop 0 ByteArray.empty\n" }, { "path": "Batteries/Data/String/Legacy.lean", "content": "/-\nCopyright (c) 2016 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthor: Leonardo de Moura, Mario Carneiro\n-/\nmodule\n\n/-!\n# Legacy implementations of `String` operations\n\nThis file includes old definitions of `String` functions that were downstreamed from core to prevent\n`Batteries.Data.String.Lemmas` from breaking.\n-/\n\npublic section\n\nset_option linter.deprecated false\n\nnamespace String\n\nprivate noncomputable def utf8ByteSize' : String → Nat\n | s => go s.toList\nwhere\n go : List Char → Nat\n | [] => 0\n | c::cs => go cs + c.utf8Size\n\nprivate theorem utf8ByteSize'_eq (s : String) : s.utf8ByteSize' = s.utf8ByteSize := by\n suffices ∀ l, utf8ByteSize'.go l = (ofList l).utf8ByteSize by\n obtain ⟨m, rfl⟩ := s.exists_eq_ofList\n rw [utf8ByteSize', this, ofList_toList]\n intro l\n induction l with\n | nil => simp [utf8ByteSize'.go]\n | cons c cs ih =>\n rw [utf8ByteSize'.go, ih, ← List.singleton_append, String.ofList_append,\n utf8ByteSize_append, Nat.add_comm]\n congr\n rw [← size_toByteArray, String.toByteArray_ofList, List.utf8Encode_singleton,\n List.size_toByteArray, length_utf8EncodeChar]\n\nprivate theorem set_next_add (s : String) (i : Pos.Raw) (c : Char) (b₁ b₂)\n (h : (i.next s).1 + b₁ = s.rawEndPos.1 + b₂) :\n (i.next (i.set s c)).1 + b₁ = (i.set s c).rawEndPos.1 + b₂ := by\n simp [Pos.Raw.next, Pos.Raw.get, Pos.Raw.set, rawEndPos, ← utf8ByteSize'_eq, utf8ByteSize'] at h ⊢\n rw [Nat.add_comm i.1, Nat.add_assoc] at h ⊢\n let rec foo : ∀ cs a b₁ b₂,\n (Pos.Raw.utf8GetAux cs a i).utf8Size + b₁ = utf8ByteSize'.go cs + b₂ →\n (Pos.Raw.utf8GetAux (Pos.Raw.utf8SetAux c cs a i) a i).utf8Size + b₁ =\n utf8ByteSize'.go (Pos.Raw.utf8SetAux c cs a i) + b₂\n | [], _, _, _, h => h\n | c'::cs, a, b₁, b₂, h => by\n unfold Pos.Raw.utf8SetAux\n apply iteInduction (motive := fun p =>\n (Pos.Raw.utf8GetAux p a i).utf8Size + b₁ = utf8ByteSize'.go p + b₂) <;>\n intro h' <;> simp [Pos.Raw.utf8GetAux, h', utf8ByteSize'.go] at h ⊢\n next =>\n rw [Nat.add_assoc, Nat.add_left_comm] at h ⊢; rw [Nat.add_left_cancel h]\n next =>\n rw [Nat.add_assoc] at h ⊢\n refine foo cs (a + c') b₁ (c'.utf8Size + b₂) h\n exact foo s.toList 0 _ _ h\n\nprivate theorem mapAux_lemma (s : String) (i : Pos.Raw) (c : Char) (h : ¬i.atEnd s) :\n (i.set s c).rawEndPos.1 - (i.next (i.set s c)).1 < s.rawEndPos.1 - i.1 := by\n suffices (i.set s c).rawEndPos.1 - (i.next (i.set s c)).1 = s.rawEndPos.1 - (i.next s).1 by\n rw [this]\n apply Nat.sub_lt_sub_left (Nat.gt_of_not_le (mt decide_eq_true h)) (Pos.Raw.lt_next ..)\n have := set_next_add s i c (s.rawEndPos.byteIdx - (i.next s).byteIdx) 0\n have := set_next_add s i c 0 ((i.next s).byteIdx - s.rawEndPos.byteIdx)\n omega\n\n/-- Implementation of `String.Legacy.map`. -/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), specialize]\ndef Legacy.mapAux (f : Char → Char) (i : Pos.Raw) (s : String) : String :=\n if h : i.atEnd s then s\n else\n let c := f (i.get s)\n have := mapAux_lemma s i c h\n let s := i.set s c\n mapAux f (i.next s) s\ntermination_by s.rawEndPos.1 - i.1\n\n/--\nApplies the function `f` to every character in a string, returning a string that contains the\nresulting characters.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.map`.\n\nExamples:\n * `\"abc123\".map Char.toUpper = \"ABC123\"`\n * `\"\".map Char.toUpper = \"\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.map (f : Char → Char) (s : String) : String :=\n mapAux f 0 s\n\n/--\nRemoves the specified number of characters (Unicode code points) from the start of the string.\n\nIf `n` is greater than `s.length`, returns `\"\"`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.drop`.\n\nExamples:\n * `\"red green blue\".drop 4 = \"green blue\"`\n * `\"red green blue\".drop 10 = \"blue\"`\n * `\"red green blue\".drop 50 = \"\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.drop (s : String) (n : Nat) : String :=\n (s.toRawSubstring.drop n).toString\n\n/--\nCreates a new string that contains the first `n` characters (Unicode code points) of `s`.\n\nIf `n` is greater than `s.length`, returns `s`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.take`.\n\nExamples:\n* `\"red green blue\".take 3 = \"red\"`\n* `\"red green blue\".take 1 = \"r\"`\n* `\"red green blue\".take 0 = \"\"`\n* `\"red green blue\".take 100 = \"red green blue\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.take (s : String) (n : Nat) : String :=\n (s.toRawSubstring.take n).toString\n\n/--\nCreates a new string that contains the longest prefix of `s` in which `p` returns `true` for all\ncharacters.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.takeWhile`.\n\nExamples:\n* `\"red green blue\".takeWhile (·.isLetter) = \"red\"`\n* `\"red green blue\".takeWhile (· == 'r') = \"r\"`\n* `\"red green blue\".takeWhile (· != 'n') = \"red gree\"`\n* `\"red green blue\".takeWhile (fun _ => true) = \"red green blue\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.takeWhile (s : String) (p : Char → Bool) : String :=\n (s.toRawSubstring.takeWhile p).toString\n\n/--\nCreates a new string by removing the longest prefix from `s` in which `p` returns `true` for all\ncharacters.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.dropWhile`.\n\nExamples:\n* `\"red green blue\".dropWhile (·.isLetter) = \" green blue\"`\n* `\"red green blue\".dropWhile (· == 'r') = \"ed green blue\"`\n* `\"red green blue\".dropWhile (· != 'n') = \"n blue\"`\n* `\"red green blue\".dropWhile (fun _ => true) = \"\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.dropWhile (s : String) (p : Char → Bool) : String :=\n (s.toRawSubstring.dropWhile p).toString\n\n/--\nAuxiliary definition for `String.Legacy.foldl`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.foldlAux`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), specialize]\ndef Legacy.foldlAux {α : Type u} (f : α → Char → α) (s : String) (stopPos : Pos.Raw)\n (i : Pos.Raw) (a : α) : α :=\n if h : i < stopPos then\n have := Nat.sub_lt_sub_left h (Pos.Raw.lt_next s i)\n foldlAux f s stopPos (i.next s) (f a (i.get s))\n else a\ntermination_by stopPos.1 - i.1\n\n/--\nFolds a function over a string from the left, accumulating a value starting with `init`. The\naccumulated value is combined with each character in order, using `f`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.foldl`.\n\nExamples:\n * `\"coffee tea water\".foldl (fun n c => if c.isWhitespace then n + 1 else n) 0 = 2`\n * `\"coffee tea and water\".foldl (fun n c => if c.isWhitespace then n + 1 else n) 0 = 3`\n * `\"coffee tea water\".foldl (·.push ·) \"\" = \"coffee tea water\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.foldl {α : Type u} (f : α → Char → α) (init : α) (s : String) : α :=\n foldlAux f s s.rawEndPos 0 init\n\n/--\nReturns the first character in `s`. If `s = \"\"`, returns `(default : Char)`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.front`.\n\nExamples:\n* `\"abc\".front = 'a'`\n* `\"\".front = (default : Char)`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline, expose]\ndef Legacy.front (s : String) : Char :=\n Pos.Raw.get s 0\n\n/--\nReturns the last character in `s`. If `s = \"\"`, returns `(default : Char)`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `String.back`.\n\nExamples:\n* `\"abc\".back = 'c'`\n* `\"\".back = (default : Char)`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline, expose]\ndef Legacy.back (s : String) : Char :=\n (s.rawEndPos.prev s).get s\n\n/--\nAuxuliary definition for `String.Legacy.posOf`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\")]\ndef Legacy.posOfAux (s : String) (c : Char) (stopPos : Pos.Raw) (pos : Pos.Raw) : Pos.Raw :=\n if h : pos < stopPos then\n if pos.get s == c then pos\n else\n have := Nat.sub_lt_sub_left h (Pos.Raw.lt_next s pos)\n posOfAux s c stopPos (pos.next s)\n else pos\ntermination_by stopPos.1 - pos.1\n\n/--\nReturns the position of the first occurrence of a character, `c`, in a string `s`. If `s` does not\ncontain `c`, returns `s.rawEndPos`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n* `\"abcba\".posOf 'a' = ⟨0⟩`\n* `\"abcba\".posOf 'z' = ⟨5⟩`\n* `\"L∃∀N\".posOf '∀' = ⟨4⟩`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.posOf (s : String) (c : Char) : Pos.Raw :=\n posOfAux s c s.rawEndPos 0\n\n/--\nAuxuliary definition for `String.Legacy.revPosOf`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\")]\ndef Legacy.revPosOfAux (s : String) (c : Char) (pos : Pos.Raw) : Option Pos.Raw :=\n if h : pos = 0 then none\n else\n have := Pos.Raw.prev_lt_of_pos s pos h\n let pos := pos.prev s\n if pos.get s == c then some pos\n else revPosOfAux s c pos\ntermination_by pos.1\n\n/--\nReturns the position of the last occurrence of a character, `c`, in a string `s`. If `s` does not\ncontain `c`, returns `none`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n* `\"abcabc\".revPosOf 'a' = some ⟨3⟩`\n* `\"abcabc\".revPosOf 'z' = none`\n* `\"L∃∀N\".revPosOf '∀' = some ⟨4⟩`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.revPosOf (s : String) (c : Char) : Option Pos.Raw :=\n revPosOfAux s c s.rawEndPos\n\n/--\nAuxuliary definition for `String.Legacy.find`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\")]\ndef Legacy.findAux (s : String) (p : Char → Bool) (stopPos : Pos.Raw) (pos : Pos.Raw) : Pos.Raw :=\n if h : pos < stopPos then\n if p (pos.get s) then pos\n else\n have := Nat.sub_lt_sub_left h (Pos.Raw.lt_next s pos)\n findAux s p stopPos (pos.next s)\n else pos\ntermination_by stopPos.1 - pos.1\n\n/--\nFinds the position of the first character in a string for which the Boolean predicate `p` returns\n`true`. If there is no such character in the string, then the end position of the string is\nreturned.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n * `\"coffee tea water\".find (·.isWhitespace) = ⟨6⟩`\n * `\"tea\".find (· == 'X') = ⟨3⟩`\n * `\"\".find (· == 'X') = ⟨0⟩`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.find (s : String) (p : Char → Bool) : Pos.Raw :=\n findAux s p s.rawEndPos 0\n\n/--\nAuxuliary definition for `String.Legacy.revFind`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\")]\ndef Legacy.revFindAux (s : String) (p : Char → Bool) (pos : Pos.Raw) : Option Pos.Raw :=\n if h : pos = 0 then none\n else\n have := Pos.Raw.prev_lt_of_pos s pos h\n let pos := pos.prev s\n if p (pos.get s) then some pos\n else revFindAux s p pos\ntermination_by pos.1\n\n/--\nFinds the position of the last character in a string for which the Boolean predicate `p` returns\n`true`. If there is no such character in the string, then `none` is returned.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n * `\"coffee tea water\".revFind (·.isWhitespace) = some ⟨10⟩`\n * `\"tea\".revFind (· == 'X') = none`\n * `\"\".revFind (· == 'X') = none`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.revFind (s : String) (p : Char → Bool) : Option Pos.Raw :=\n revFindAux s p s.rawEndPos\n\n/--\nAuxuliary definition for `String.Legacy.foldr`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), specialize]\ndef Legacy.foldrAux {α : Type u} (f : Char → α → α) (a : α) (s : String)\n (i begPos : Pos.Raw) : α :=\n if h : begPos < i then\n have := Pos.Raw.prev_lt_of_pos s i <| mt (congrArg String.Pos.Raw.byteIdx) <|\n Ne.symm <| Nat.ne_of_lt <| Nat.lt_of_le_of_lt (Nat.zero_le _) h\n let i := i.prev s\n let a := f (i.get s) a\n foldrAux f a s i begPos\n else a\ntermination_by i.1\n\n/--\nFolds a function over a string from the right, accumulating a value starting with `init`. The\naccumulated value is combined with each character in reverse order, using `f`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n * `\"coffee tea water\".foldr (fun c n => if c.isWhitespace then n + 1 else n) 0 = 2`\n * `\"coffee tea and water\".foldr (fun c n => if c.isWhitespace then n + 1 else n) 0 = 3`\n * `\"coffee tea water\".foldr (fun c s => c.push s) \"\" = \"retaw dna aet eeffoc\"`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.foldr {α : Type u} (f : Char → α → α) (init : α) (s : String) : α :=\n foldrAux f init s s.rawEndPos 0\n\n/--\nAuxuliary definition for `String.Legacy.any`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), specialize]\ndef Legacy.anyAux (s : String) (stopPos : Pos.Raw) (p : Char → Bool) (i : Pos.Raw) :\n Bool :=\n if h : i < stopPos then\n if p (i.get s) then true\n else\n have := Nat.sub_lt_sub_left h (Pos.Raw.lt_next s i)\n anyAux s stopPos p (i.next s)\n else false\ntermination_by stopPos.1 - i.1\n\n/--\nChecks whether there is a character in a string for which the Boolean predicate `p` returns `true`.\n\nShort-circuits at the first character for which `p` returns `true`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n * `\"brown\".any (·.isLetter) = true`\n * `\"brown\".any (·.isWhitespace) = false`\n * `\"brown and orange\".any (·.isLetter) = true`\n * `\"\".any (fun _ => false) = false`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.any (s : String) (p : Char → Bool) : Bool :=\n anyAux s s.rawEndPos p 0\n\n/--\nChecks whether the Boolean predicate `p` returns `true` for every character in a string.\n\nShort-circuits at the first character for which `p` returns `false`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n * `\"brown\".all (·.isLetter) = true`\n * `\"brown and orange\".all (·.isLetter) = false`\n * `\"\".all (fun _ => false) = true`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.all (s : String) (p : Char → Bool) : Bool :=\n !Legacy.any s (fun c => !p c)\n\n/--\nChecks whether a string contains the specified character.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n\nExamples:\n* `\"green\".contains 'e' = true`\n* `\"green\".contains 'x' = false`\n* `\"\".contains 'x' = false`\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.contains (s : String) (c : Char) : Bool :=\n Legacy.any s (fun a => a == c)\n\nend String\n\nnamespace Substring.Raw\n\n/--\nFolds a function over a substring from the left, accumulating a value starting with `init`. The\naccumulated value is combined with each character in order, using `f`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`. Its runtime behavior is equivalent to that of `Substring.Raw.foldl`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.foldl {α : Type u} (f : α → Char → α) (init : α) (s : Substring.Raw) : α :=\n match s with\n | ⟨s, b, e⟩ => String.Legacy.foldlAux f s e b init\n\n/--\nFolds a function over a substring from the right, accumulating a value starting with `init`. The\naccumulated value is combined with each character in reverse order, using `f`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.foldr {α : Type u} (f : Char → α → α) (init : α) (s : Substring.Raw) : α :=\n match s with\n | ⟨s, b, e⟩ => String.Legacy.foldrAux f init s e b\n\n/--\nChecks whether the Boolean predicate `p` returns `true` for any character in a substring.\n\nShort-circuits at the first character for which `p` returns `true`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.any (s : Substring.Raw) (p : Char → Bool) : Bool :=\n match s with\n | ⟨s, b, e⟩ => String.Legacy.anyAux s e p b\n\n/--\nChecks whether the Boolean predicate `p` returns `true` for every character in a substring.\n\nShort-circuits at the first character for which `p` returns `false`.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.all (s : Substring.Raw) (p : Char → Bool) : Bool :=\n !Legacy.any s (fun c => !p c)\n\n/--\nChecks whether a substring contains the specified character.\n\nThis is an old implementation, preserved here for users of the lemmas in\n`Batteries.Data.String.Lemmas`.\n-/\n@[deprecated \"Use the new `String` API.\" (since := \"2026-03-26\"), inline]\ndef Legacy.contains (s : Substring.Raw) (c : Char) : Bool :=\n Legacy.any s (fun a => a == c)\n\nend Substring.Raw\n" }, { "path": "Batteries/Data/String/Lemmas.lean", "content": "/-\nCopyright (c) 2023 Bulhwi Cha. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Bulhwi Cha, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.String.Basic\npublic import Batteries.Tactic.Lint.Misc\npublic import Batteries.Tactic.SeqFocus\npublic import Batteries.Classes.Order\npublic import Batteries.Data.List.Basic\npublic import Batteries.Data.String.Legacy\nimport all Init.Data.String.Defs -- for unfolding `isEmpty`\nimport all Init.Data.String.Substring -- for unfolding `Substring` functions\nimport all Init.Data.String.Iterator -- for unfolding `Iterator` functions\nimport all Init.Data.String.Extra -- for unfolding `Substring.toIterator`\nimport all Init.Data.String.TakeDrop -- for unfolding `drop`\nimport all Init.Data.String.Modify -- for unfolding `String.mapAux`\nimport all Batteries.Data.String.Legacy -- for unfolding `String.Legacy.map`\nimport all Init.Data.String.Legacy -- for unfolding `String.splitOnAux`\n\n@[expose] public section\n\nset_option linter.deprecated false\n\nnamespace String\n\n-- TODO(kmill): add `@[ext]` attribute to `String.ext` in core.\nattribute [ext (iff := false)] ext\n\ntheorem lt_antisymm {s₁ s₂ : String} (h₁ : ¬s₁ < s₂) (h₂ : ¬s₂ < s₁) : s₁ = s₂ := by\n simp at h₁ h₂\n exact String.le_antisymm h₂ h₁\n\ninstance : Std.LawfulLTOrd String :=\n .compareOfLessAndEq_of_irrefl_of_trans_of_antisymm\n String.lt_irrefl String.lt_trans String.lt_antisymm\n\n@[deprecated length_ofList (since := \"2025-10-31\")]\ntheorem mk_length (s : List Char) : (String.ofList s).length = s.length :=\n length_ofList\n\ntheorem Pos.Raw.offsetBy_eq {p q : Pos.Raw} : p.offsetBy q = ⟨q.byteIdx + p.byteIdx⟩ := by\n ext\n simp\n\nprivate theorem add_utf8Size_pos : 0 < i + Char.utf8Size c :=\n Nat.add_pos_right _ (Char.utf8Size_pos c)\n\nprivate theorem ne_add_utf8Size_add_self : i ≠ n + Char.utf8Size c + i :=\n Nat.ne_of_lt (Nat.lt_add_of_pos_left add_utf8Size_pos)\n\nprivate theorem ne_self_add_add_utf8Size : i ≠ i + (n + Char.utf8Size c) :=\n Nat.ne_of_lt (Nat.lt_add_of_pos_right add_utf8Size_pos)\n\n/-- The UTF-8 byte length of a list of characters. (This is intended for specification purposes.) -/\n@[inline] def utf8Len : List Char → Nat\n | [] => 0\n | c::cs => utf8Len cs + c.utf8Size\n\ntheorem utf8ByteSize_ofList (cs) : utf8ByteSize (String.ofList cs) = utf8Len cs := by\n induction cs with\n | nil => simp [utf8Len]\n | cons c cs ih =>\n rw [utf8Len, ← ih, ← List.singleton_append, String.ofList_append,\n utf8ByteSize_append, Nat.add_comm]\n congr\n rw [← size_toByteArray, String.toByteArray_ofList, List.utf8Encode_singleton,\n List.size_toByteArray, length_utf8EncodeChar]\n\n@[deprecated utf8ByteSize_ofList (since := \"2025-10-31\")]\ntheorem utf8ByteSize_mk (cs) : utf8ByteSize (ofList cs) = utf8Len cs :=\n utf8ByteSize_ofList cs\n\n@[simp] theorem utf8Len_nil : utf8Len [] = 0 := rfl\n\n@[simp] theorem utf8Len_cons (c cs) : utf8Len (c :: cs) = utf8Len cs + c.utf8Size := rfl\n\n@[simp] theorem utf8Len_append (cs₁ cs₂) : utf8Len (cs₁ ++ cs₂) = utf8Len cs₁ + utf8Len cs₂ := by\n induction cs₁ <;> simp [*, Nat.add_right_comm]\n\ntheorem utf8Len_reverseAux (cs₁ cs₂) :\n utf8Len (cs₁.reverseAux cs₂) = utf8Len cs₁ + utf8Len cs₂ := by\n induction cs₁ generalizing cs₂ <;> simp_all [← Nat.add_assoc, Nat.add_right_comm]\n\n@[simp] theorem utf8Len_reverse (cs) : utf8Len cs.reverse = utf8Len cs := utf8Len_reverseAux ..\n\n@[simp] theorem utf8Len_eq_zero : utf8Len l = 0 ↔ l = [] := by\n cases l <;> simp [Nat.ne_zero_iff_zero_lt.mpr (Char.utf8Size_pos _)]\n\nsection\nopen List\ntheorem utf8Len_le_of_sublist : ∀ {cs₁ cs₂}, cs₁ <+ cs₂ → utf8Len cs₁ ≤ utf8Len cs₂\n | _, _, .slnil => Nat.le_refl _\n | _, _, .cons _ h => Nat.le_trans (utf8Len_le_of_sublist h) (Nat.le_add_right ..)\n | _, _, .cons_cons _ h => Nat.add_le_add_right (utf8Len_le_of_sublist h) _\n\ntheorem utf8Len_le_of_infix (h : cs₁ <:+: cs₂) : utf8Len cs₁ ≤ utf8Len cs₂ :=\n utf8Len_le_of_sublist h.sublist\n\ntheorem utf8Len_le_of_suffix (h : cs₁ <:+ cs₂) : utf8Len cs₁ ≤ utf8Len cs₂ :=\n utf8Len_le_of_sublist h.sublist\n\ntheorem utf8Len_le_of_prefix (h : cs₁ <+: cs₂) : utf8Len cs₁ ≤ utf8Len cs₂ :=\n utf8Len_le_of_sublist h.sublist\nend\n\n@[simp] theorem rawEndPos_ofList (cs : List Char) : rawEndPos (ofList cs ) = ⟨utf8Len cs⟩ := by\n apply Pos.Raw.ext\n simp [String.rawEndPos, utf8ByteSize_ofList]\n\n@[deprecated rawEndPos_ofList (since := \"2025-10-31\")]\ntheorem rawEndPos_asString (cs : List Char) : rawEndPos (ofList cs) = ⟨utf8Len cs⟩ :=\n rawEndPos_ofList cs\n\n@[deprecated rawEndPos_ofList (since := \"2025-10-21\")]\ntheorem endPos_asString (cs : List Char) : rawEndPos (ofList cs) = ⟨utf8Len cs⟩ :=\n rawEndPos_ofList cs\n\n@[deprecated rawEndPos_ofList (since := \"2025-10-21\")]\ntheorem rawEndPos_mk (cs : List Char) : rawEndPos (ofList cs) = ⟨utf8Len cs⟩ :=\n rawEndPos_ofList cs\n\n@[deprecated rawEndPos_ofList (since := \"2025-10-21\")]\ntheorem endPos_mk (cs : List Char) : rawEndPos (ofList cs) = ⟨utf8Len cs⟩ :=\n rawEndPos_ofList cs\n\n@[simp]\ntheorem utf8Len_toList (s : String) : utf8Len s.toList = s.utf8ByteSize := by\n rw [← utf8ByteSize_ofList, ofList_toList]\n\n@[deprecated utf8Len_toList (since := \"2025-10-21\")]\ntheorem utf8Len_data (s : String) : utf8Len s.toList = s.utf8ByteSize :=\n utf8Len_toList s\n\nnamespace Pos.Raw\n\n-- TODO(kmill): add `@[ext]` attribute to `String.Pos.ext` in core.\nattribute [ext (iff := false)] ext\n\ntheorem lt_addChar (p : Pos.Raw) (c : Char) : p < p + c :=\n Nat.lt_add_of_pos_right (Char.utf8Size_pos _)\n\nprivate theorem zero_ne_addChar {i : Pos.Raw} {c : Char} : 0 ≠ i + c :=\n ne_of_lt add_utf8Size_pos\n\n/-- A string position is valid if it is equal to the UTF-8 length of an initial substring of `s`. -/\ninductive Valid : String → Pos.Raw → Prop where\n /--\n A string position is valid if it is equal to the UTF-8 length of an initial substring of `s`.\n -/\n | mk (cs cs' : List Char) {p} (hp : p.1 = utf8Len cs) : Valid (String.ofList (cs ++ cs')) p\n\ntheorem Valid.intro {s : String} {p : Pos.Raw}\n (h : ∃ cs cs', cs ++ cs' = s.toList ∧ p.1 = utf8Len cs) : Valid s p := by\n obtain ⟨cs, cs', h₁, h₂⟩ := h\n rw [← String.ofList_toList (s := s), ← h₁]\n exact .mk cs cs' h₂\n\ntheorem Valid.exists : {s : String} → {p : Pos.Raw} → Valid s p →\n ∃ cs cs', String.ofList (cs ++ cs') = s ∧ p = ⟨utf8Len cs⟩\n | _, _, .mk cs cs' rfl => ⟨cs, cs', rfl, rfl⟩\n\n@[simp] theorem valid_zero : Valid s 0 := .intro ⟨[], s.toList, rfl, rfl⟩\n\n@[simp] theorem valid_rawEndPos : Valid s (rawEndPos s) :=\n .intro ⟨s.toList, [], by simp, by simp⟩\n\n@[deprecated valid_rawEndPos (since := \"2025-10-21\")]\ntheorem valid_endPos : Valid s (rawEndPos s) :=\n valid_rawEndPos\n\ntheorem Valid.le_rawEndPos : ∀ {s p}, Valid s p → p ≤ rawEndPos s\n | _, ⟨_⟩, .mk cs cs' rfl => by simp [rawEndPos, le_iff, utf8ByteSize_ofList]\n\n@[deprecated le_rawEndPos (since := \"2025-10-21\")]\ntheorem Valid.le_endPos : ∀ {s p}, Valid s p → p ≤ rawEndPos s :=\n le_rawEndPos\n\nend Pos.Raw\n\n@[deprecated rawEndPos_eq_zero_iff (since := \"2025-10-21\")]\ntheorem endPos_eq_zero (s : String) : rawEndPos s = 0 ↔ s = \"\" :=\n rawEndPos_eq_zero_iff\n\n/--\nInduction along the valid positions in a list of characters.\n(This definition is intended only for specification purposes.)\n-/\ndef utf8InductionOn {motive : List Char → Pos.Raw → Sort u}\n (s : List Char) (i p : Pos.Raw)\n (nil : ∀ i, motive [] i)\n (eq : ∀ c cs, motive (c :: cs) p)\n (ind : ∀ (c : Char) cs i, i ≠ p → motive cs (i + c) → motive (c :: cs) i) :\n motive s i :=\n match s with\n | [] => nil i\n | c::cs =>\n if h : i = p then\n h ▸ eq c cs\n else ind c cs i h (utf8InductionOn cs (i + c) p nil eq ind)\n\ntheorem utf8GetAux_add_right_cancel (s : List Char) (i p n : Nat) :\n Pos.Raw.utf8GetAux s ⟨i + n⟩ ⟨p + n⟩ = Pos.Raw.utf8GetAux s ⟨i⟩ ⟨p⟩ := by\n apply utf8InductionOn s ⟨i⟩ ⟨p⟩ (motive := fun s i =>\n Pos.Raw.utf8GetAux s ⟨i.byteIdx + n⟩ ⟨p + n⟩ = Pos.Raw.utf8GetAux s i ⟨p⟩) <;>\n simp only [Pos.Raw.utf8GetAux, Char.reduceDefault, implies_true, ↓reduceIte, ne_eq,\n Pos.Raw.byteIdx_add_char]\n intro c cs ⟨i⟩ h ih\n simp only [Pos.Raw.ext_iff, Pos.Raw.add_char_eq] at h ⊢\n simp only [Nat.add_right_cancel_iff, h, ↓reduceIte]\n rw [Nat.add_right_comm]\n exact ih\n\ntheorem utf8GetAux_addChar_right_cancel (s : List Char) (i p : Pos.Raw) (c : Char) :\n Pos.Raw.utf8GetAux s (i + c) (p + c) = Pos.Raw.utf8GetAux s i p :=\n utf8GetAux_add_right_cancel ..\n\ntheorem utf8GetAux_of_valid (cs cs' : List Char) {i p : Nat} (hp : i + utf8Len cs = p) :\n Pos.Raw.utf8GetAux (cs ++ cs') ⟨i⟩ ⟨p⟩ = cs'.headD default := by\n match cs, cs' with\n | [], [] => rfl\n | [], c::cs' => simp [← hp, Pos.Raw.utf8GetAux]\n | c::cs, cs' =>\n simp only [List.cons_append, Pos.Raw.utf8GetAux, Char.reduceDefault]\n rw [if_neg]\n case hnc => simp only [← hp, utf8Len_cons, Pos.Raw.ext_iff]; exact ne_self_add_add_utf8Size\n refine utf8GetAux_of_valid cs cs' ?_\n simpa [Nat.add_assoc, Nat.add_comm] using hp\n\ntheorem get_of_valid (cs cs' : List Char) :\n Pos.Raw.get (ofList (cs ++ cs')) ⟨utf8Len cs⟩ = cs'.headD default := by\n rw [Pos.Raw.get, String.toList_ofList]\n exact utf8GetAux_of_valid _ _ (Nat.zero_add _)\n\ntheorem get_cons_addChar (c : Char) (cs : List Char) (i : Pos.Raw) :\n (i + c).get (ofList (c :: cs)) = i.get (ofList cs) := by\n simp [Pos.Raw.get, Pos.Raw.utf8GetAux, Pos.Raw.zero_ne_addChar, utf8GetAux_addChar_right_cancel]\n\ntheorem utf8GetAux?_of_valid (cs cs' : List Char) {i p : Nat} (hp : i + utf8Len cs = p) :\n Pos.Raw.utf8GetAux? (cs ++ cs') ⟨i⟩ ⟨p⟩ = cs'.head? := by\n match cs, cs' with\n | [], [] => rfl\n | [], c::cs' => simp [← hp, Pos.Raw.utf8GetAux?]\n | c::cs, cs' =>\n simp only [List.cons_append, Pos.Raw.utf8GetAux?]\n rw [if_neg]\n case hnc => simp only [← hp, Pos.Raw.ext_iff]; exact ne_self_add_add_utf8Size\n refine utf8GetAux?_of_valid cs cs' ?_\n simpa [Nat.add_assoc, Nat.add_comm] using hp\n\ntheorem get?_of_valid (cs cs' : List Char) :\n Pos.Raw.get? (ofList (cs ++ cs')) ⟨utf8Len cs⟩ = cs'.head? := by\n rw [Pos.Raw.get?, String.toList_ofList]\n exact utf8GetAux?_of_valid _ _ (Nat.zero_add _)\n\ntheorem utf8SetAux_of_valid (c' : Char) (cs cs' : List Char) {i p : Nat} (hp : i + utf8Len cs = p) :\n Pos.Raw.utf8SetAux c' (cs ++ cs') ⟨i⟩ ⟨p⟩ = cs ++ cs'.modifyHead fun _ => c' := by\n match cs, cs' with\n | [], [] => rfl\n | [], c::cs' => simp [← hp, Pos.Raw.utf8SetAux]\n | c::cs, cs' =>\n simp only [Pos.Raw.utf8SetAux, List.cons_append]\n rw [if_neg]\n case hnc => simp only [← hp, Pos.Raw.ext_iff]; exact ne_self_add_add_utf8Size\n refine congrArg (c::·) (utf8SetAux_of_valid c' cs cs' ?_)\n simpa [Nat.add_assoc, Nat.add_comm] using hp\n\ntheorem set_of_valid (cs cs' : List Char) (c' : Char) :\n Pos.Raw.set (ofList (cs ++ cs')) ⟨utf8Len cs⟩ c' =\n ofList (cs ++ cs'.modifyHead fun _ => c') := by\n ext\n rw [Pos.Raw.set, String.toList_ofList, String.toList_ofList, String.toList_ofList,\n utf8SetAux_of_valid _ _ _]\n exact Nat.zero_add _\n\ntheorem modify_of_valid (cs cs' : List Char) :\n Pos.Raw.modify (ofList (cs ++ cs')) ⟨utf8Len cs⟩ f = ofList (cs ++ cs'.modifyHead f) := by\n rw [Pos.Raw.modify, set_of_valid, get_of_valid]; cases cs' <;> rfl\n\ntheorem next_of_valid' (cs cs' : List Char) :\n Pos.Raw.next (ofList (cs ++ cs')) ⟨utf8Len cs⟩ =\n ⟨utf8Len cs + (cs'.headD default).utf8Size⟩ := by\n simp only [Pos.Raw.next, get_of_valid]; rfl\n\ntheorem next_of_valid (cs : List Char) (c : Char) (cs' : List Char) :\n Pos.Raw.next (ofList (cs ++ c :: cs')) ⟨utf8Len cs⟩ =\n ⟨utf8Len cs + c.utf8Size⟩ := next_of_valid' ..\n\n@[simp] theorem atEnd_iff (s : String) (p : Pos.Raw) : p.atEnd s ↔ s.rawEndPos ≤ p :=\n decide_eq_true_iff\n\ntheorem valid_next {p : Pos.Raw} (h : p.Valid s) (h₂ : p < s.rawEndPos) :\n (Pos.Raw.next s p).Valid s := by\n match s, p, h with\n | _, ⟨_⟩, .mk cs [] rfl => simp at h₂\n | _, ⟨_⟩, .mk cs (c::cs') rfl =>\n rw [next_of_valid]\n simpa using Pos.Raw.Valid.mk (cs ++ [c]) cs' rfl\n\ntheorem utf8PrevAux_of_valid {cs cs' : List Char} {c : Char} {i p : Nat}\n (hp : i + (utf8Len cs + c.utf8Size) = p) :\n Pos.Raw.utf8PrevAux (cs ++ c :: cs') ⟨i⟩ ⟨p⟩ = ⟨i + utf8Len cs⟩ := by\n match cs with\n | [] => simp [Pos.Raw.utf8PrevAux, ← hp, Pos.Raw.add_char_eq]\n | c'::cs =>\n simp only [Pos.Raw.utf8PrevAux, List.cons_append, utf8Len_cons, ← hp]\n rw [if_neg]\n case hnc =>\n simp only [Pos.Raw.le_iff, Pos.Raw.byteIdx_add_char]\n grind [!Char.utf8Size_pos]\n refine (utf8PrevAux_of_valid (by simp [Nat.add_assoc, Nat.add_left_comm])).trans ?_\n simp [Nat.add_assoc, Nat.add_comm]\n\ntheorem prev_of_valid (cs : List Char) (c : Char) (cs' : List Char) :\n Pos.Raw.prev (ofList (cs ++ c :: cs')) ⟨utf8Len cs + c.utf8Size⟩ = ⟨utf8Len cs⟩ := by\n simp only [Pos.Raw.prev, String.toList_ofList]\n rw [utf8PrevAux_of_valid] <;> simp\n\ntheorem prev_of_valid' (cs cs' : List Char) :\n Pos.Raw.prev (ofList (cs ++ cs')) ⟨utf8Len cs⟩ = ⟨utf8Len cs.dropLast⟩ := by\n match cs, cs.eq_nil_or_concat with\n | _, .inl rfl => apply Pos.Raw.prev_zero\n | _, .inr ⟨cs, c, rfl⟩ => simp [prev_of_valid, -ofList_append]\n\ntheorem back_eq_get_prev_rawEndPos {s : String} : Legacy.back s = (s.rawEndPos.prev s).get s := rfl\n\ntheorem atEnd_of_valid (cs : List Char) (cs' : List Char) :\n String.Pos.Raw.atEnd (ofList (cs ++ cs')) ⟨utf8Len cs⟩ ↔ cs' = [] := by\n rw [atEnd_iff]\n cases cs' <;> simp [rawEndPos, utf8ByteSize_ofList]\n exact Nat.add_pos_left (Char.utf8Size_pos _) _\n\nunseal Legacy.posOfAux Legacy.findAux in\ntheorem posOfAux_eq (s c) : Legacy.posOfAux s c = Legacy.findAux s (· == c) := (rfl)\n\nunseal Legacy.posOfAux Legacy.findAux in\ntheorem posOf_eq (s c) : Legacy.posOf s c = Legacy.find s (· == c) := (rfl)\n\nunseal Legacy.revPosOfAux Legacy.revFindAux in\ntheorem revPosOfAux_eq (s c) : Legacy.revPosOfAux s c = Legacy.revFindAux s (· == c) := (rfl)\n\nunseal Legacy.revPosOfAux Legacy.revFindAux in\ntheorem revPosOf_eq (s c) : Legacy.revPosOf s c = Legacy.revFind s (· == c) := (rfl)\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.findAux\ntheorem findAux_of_valid (p) : ∀ l m r,\n Legacy.findAux (ofList (l ++ m ++ r)) p ⟨utf8Len l + utf8Len m⟩ ⟨utf8Len l⟩ =\n ⟨utf8Len l + utf8Len (m.takeWhile (!p ·))⟩\n | l, [], r => by unfold Legacy.findAux List.takeWhile; simp\n | l, c::m, r => by\n unfold Legacy.findAux List.takeWhile\n rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)]\n have h1 := get_of_valid l (c::m++r); have h2 := next_of_valid l c (m++r)\n simp only [List.cons_append, Char.reduceDefault, List.headD_cons] at h1 h2\n simp only [List.append_assoc, List.cons_append, h1, utf8Len_cons, h2]\n cases p c\n · simp only [Bool.false_eq_true, ↓reduceIte, Bool.not_false, utf8Len_cons]\n have foo := findAux_of_valid p (l++[c]) m r\n simp only [List.append_assoc, List.cons_append, utf8Len_append,\n utf8Len_cons, utf8Len_nil, Nat.zero_add, List.nil_append] at foo\n rw [Nat.add_right_comm, Nat.add_assoc] at foo\n rw [foo, Nat.add_right_comm, Nat.add_assoc]\n · simp\n\ntheorem find_of_valid (p s) : Legacy.find s p = ⟨utf8Len (s.toList.takeWhile (!p ·))⟩ := by\n simpa using findAux_of_valid p [] s.toList []\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.revFindAux\ntheorem revFindAux_of_valid (p) : ∀ l r,\n Legacy.revFindAux (ofList (l.reverse ++ r)) p ⟨utf8Len l⟩ =\n (l.dropWhile (!p ·)).tail?.map (⟨utf8Len ·⟩)\n | [], r => by unfold Legacy.revFindAux List.dropWhile; simp\n | c::l, r => by\n unfold Legacy.revFindAux List.dropWhile\n rw [dif_neg (by exact Pos.Raw.ne_of_gt add_utf8Size_pos)]\n have h1 := get_of_valid l.reverse (c::r); have h2 := prev_of_valid l.reverse c r\n simp only [utf8Len_reverse, Char.reduceDefault, List.headD_cons] at h1 h2\n simp only [List.reverse_cons, List.append_assoc, List.singleton_append,\n utf8Len_cons, h2, h1]\n cases p c <;> simp only [Bool.false_eq_true, ↓reduceIte, Bool.not_false, Bool.not_true,\n List.tail?_cons, Option.map_some]\n exact revFindAux_of_valid p l (c::r)\n\ntheorem revFind_of_valid (p s) :\n Legacy.revFind s p = (s.toList.reverse.dropWhile (!p ·)).tail?.map (⟨utf8Len ·⟩) := by\n simpa using revFindAux_of_valid p s.toList.reverse []\n\ntheorem firstDiffPos_loop_eq (l₁ l₂ r₁ r₂ stop p)\n (hl₁ : p = utf8Len l₁) (hl₂ : p = utf8Len l₂)\n (hstop : stop = min (utf8Len l₁ + utf8Len r₁) (utf8Len l₂ + utf8Len r₂)) :\n firstDiffPos.loop (ofList (l₁ ++ r₁)) (ofList (l₂ ++ r₂)) ⟨stop⟩ ⟨p⟩ =\n ⟨p + utf8Len (List.takeWhile₂ (· = ·) r₁ r₂).1⟩ := by\n unfold List.takeWhile₂; split <;> unfold firstDiffPos.loop\n · next a r₁ b r₂ =>\n rw [\n dif_pos <| by\n rw [hstop, ← hl₁, ← hl₂]\n refine Nat.lt_min.2 ⟨?_, ?_⟩ <;> exact Nat.lt_add_of_pos_right add_utf8Size_pos,\n show Pos.Raw.get (ofList (l₁ ++ a :: r₁)) ⟨p⟩ = a by\n simp [hl₁, get_of_valid, -ofList_append],\n show Pos.Raw.get (ofList (l₂ ++ b :: r₂)) ⟨p⟩ = b by\n simp [hl₂, get_of_valid, -ofList_append]]\n simp only [bne_iff_ne, ne_eq, ite_not, decide_eq_true_eq]\n split\n · simp only [utf8Len_cons]\n subst b\n rw [show Pos.Raw.next (ofList (l₁ ++ a :: r₁)) ⟨p⟩ = ⟨utf8Len l₁ + a.utf8Size⟩ by\n simp [hl₁, -ofList_append, next_of_valid]]\n simpa [← hl₁, ← Nat.add_assoc, Nat.add_right_comm] using\n firstDiffPos_loop_eq (l₁ ++ [a]) (l₂ ++ [a]) r₁ r₂ stop (p + a.utf8Size)\n (by simp [hl₁]) (by simp [hl₂]) (by simp [hstop, ← Nat.add_assoc, Nat.add_right_comm])\n · simp\n · next h =>\n rw [dif_neg] <;> simp [hstop, ← hl₁, ← hl₂, -Nat.not_lt, Nat.lt_min]\n intro h₁ h₂\n have : ∀ {cs}, 0 < utf8Len cs → cs ≠ [] := by rintro _ h rfl; simp at h\n obtain ⟨a, as, e₁⟩ := List.exists_cons_of_ne_nil (this h₁)\n obtain ⟨b, bs, e₂⟩ := List.exists_cons_of_ne_nil (this h₂)\n exact h _ _ _ _ e₁ e₂\n\ntheorem firstDiffPos_eq (a b : String) :\n firstDiffPos a b = ⟨utf8Len (List.takeWhile₂ (· = ·) a.toList b.toList).1⟩ := by\n simpa [firstDiffPos] using\n firstDiffPos_loop_eq [] [] a.toList b.toList\n ((utf8Len a.toList).min (utf8Len b.toList)) 0 rfl rfl (by simp)\n\ntheorem Pos.Raw.extract.go₂_add_right_cancel (s : List Char) (i e n : Nat) :\n go₂ s ⟨i + n⟩ ⟨e + n⟩ = go₂ s ⟨i⟩ ⟨e⟩ := by\n apply utf8InductionOn s ⟨i⟩ ⟨e⟩ (motive := fun s i =>\n go₂ s ⟨i.byteIdx + n⟩ ⟨e + n⟩ = go₂ s i ⟨e⟩)\n <;> simp only [ne_eq, go₂, Pos.Raw.byteIdx_add_char, implies_true, ↓reduceIte]\n intro c cs ⟨i⟩ h ih\n simp only [Pos.Raw.ext_iff, Pos.Raw.add_char_eq] at h ⊢\n simp only [Nat.add_right_cancel_iff, h, ↓reduceIte, List.cons.injEq, true_and]\n rw [Nat.add_right_comm]\n exact ih\n\ntheorem Pos.Raw.extract.go₂_append_left : ∀ (s t : List Char) (i e : Nat),\n e = utf8Len s + i → go₂ (s ++ t) ⟨i⟩ ⟨e⟩ = s\n| [], t, i, _, rfl => by cases t <;> simp [go₂]\n| c :: cs, t, i, _, rfl => by\n simp only [List.cons_append, utf8Len_cons, go₂, Pos.Raw.ext_iff, ne_add_utf8Size_add_self,\n ↓reduceIte, Pos.Raw.add_char_eq, List.cons.injEq, true_and]\n apply go₂_append_left; rw [Nat.add_right_comm, Nat.add_assoc]\n\ntheorem Pos.Raw.extract.go₁_add_right_cancel (s : List Char) (i b e n : Nat) :\n go₁ s ⟨i + n⟩ ⟨b + n⟩ ⟨e + n⟩ = go₁ s ⟨i⟩ ⟨b⟩ ⟨e⟩ := by\n apply utf8InductionOn s ⟨i⟩ ⟨b⟩ (motive := fun s i =>\n go₁ s ⟨i.byteIdx + n⟩ ⟨b + n⟩ ⟨e + n⟩ = go₁ s i ⟨b⟩ ⟨e⟩)\n <;> simp only [ne_eq, go₁, Pos.Raw.byteIdx_add_char, implies_true, ↓reduceIte]\n · intro c cs\n apply go₂_add_right_cancel\n · intro c cs ⟨i⟩ h ih\n simp only [Pos.Raw.ext_iff, Pos.Raw.add_char_eq] at h ih ⊢\n simp only [Nat.add_right_cancel_iff, h, ↓reduceIte]\n rw [Nat.add_right_comm]\n exact ih\n\ntheorem Pos.Raw.extract.go₁_cons_addChar (c : Char) (cs : List Char) (b e : Pos.Raw) :\n go₁ (c :: cs) 0 (b + c) (e + c) = go₁ cs 0 b e := by\n simp only [go₁, Pos.Raw.ext_iff, Pos.Raw.byteIdx_zero, byteIdx_add_char,\n Nat.ne_of_lt add_utf8Size_pos, ↓reduceIte]\n apply go₁_add_right_cancel\n\ntheorem Pos.Raw.extract.go₁_append_right : ∀ (s t : List Char) (i b : Nat) (e : Pos.Raw),\n b = utf8Len s + i → go₁ (s ++ t) ⟨i⟩ ⟨b⟩ e = go₂ t ⟨b⟩ e\n| [], t, i, _, e, rfl => by cases t <;> simp [go₁, go₂]\n| c :: cs, t, i, _, e, rfl => by\n simp only [go₁, utf8Len_cons, Pos.Raw.ext_iff, ne_add_utf8Size_add_self, ↓reduceIte,\n List.cons_append, Pos.Raw.add_char_eq]\n apply go₁_append_right; rw [Nat.add_right_comm, Nat.add_assoc]\n\ntheorem Pos.Raw.extract.go₁_zero_utf8Len (s : List Char) : go₁ s 0 0 ⟨utf8Len s⟩ = s :=\n (go₁_append_right [] s 0 0 ⟨utf8Len s⟩ rfl).trans <| by\n simpa using go₂_append_left s [] 0 (utf8Len s) rfl\n\ntheorem extract_cons_addChar (c : Char) (cs : List Char) (b e : Pos.Raw) :\n Pos.Raw.extract (ofList (c :: cs)) (b + c) (e + c) = Pos.Raw.extract (ofList cs) b e := by\n simp only [Pos.Raw.extract, Pos.Raw.byteIdx_add_char, ge_iff_le, Nat.add_le_add_iff_right]\n split <;> [rfl; simp [Pos.Raw.extract.go₁_cons_addChar]]\n\ntheorem extract_zero_rawEndPos (s : String) : Pos.Raw.extract s 0 (rawEndPos s) = s := by\n obtain ⟨l, rfl⟩ := s.exists_eq_ofList\n match l with\n | [] => rfl\n | c :: cs =>\n simp only [Pos.Raw.extract, Pos.Raw.byteIdx_zero, rawEndPos_ofList, utf8Len_cons, ge_iff_le,\n Nat.le_zero_eq, Nat.ne_of_gt add_utf8Size_pos, ↓reduceIte, String.toList_ofList]\n congr\n apply Pos.Raw.extract.go₁_zero_utf8Len\n\n@[deprecated extract_zero_rawEndPos (since := \"2025-10-21\")]\ntheorem extract_zero_endPos (s : String) : Pos.Raw.extract s 0 (rawEndPos s) = s :=\n extract_zero_rawEndPos s\n\ntheorem extract_of_valid (l m r : List Char) :\n Pos.Raw.extract (ofList (l ++ m ++ r)) ⟨utf8Len l⟩ ⟨utf8Len l + utf8Len m⟩ = ofList m := by\n simp only [Pos.Raw.extract]\n split\n · next h => rw [utf8Len_eq_zero.1 <| Nat.le_zero.1 <| Nat.add_le_add_iff_left.1 h, ofList_nil]\n · congr\n rw [List.append_assoc, String.toList_ofList,\n Pos.Raw.extract.go₁_append_right _ _ _ _ _ (by rfl)]\n apply Pos.Raw.extract.go₂_append_left; apply Nat.add_comm\n\ntheorem splitAux_of_valid (p l m r acc) :\n splitAux (ofList (l ++ m ++ r)) p ⟨utf8Len l⟩ ⟨utf8Len l + utf8Len m⟩ acc =\n acc.reverse ++ (List.splitOnPPrepend p r m.reverse).map ofList := by\n unfold splitAux\n simp only [List.append_assoc, atEnd_iff, rawEndPos_ofList, utf8Len_append, Pos.Raw.mk_le_mk,\n Nat.add_le_add_iff_left, (by omega : utf8Len m + utf8Len r ≤ utf8Len m ↔ utf8Len r = 0),\n utf8Len_eq_zero, List.reverse_cons, dite_eq_ite]\n split\n · subst r\n simpa using extract_of_valid l m []\n · obtain ⟨c, r, rfl⟩ := r.exists_cons_of_ne_nil ‹_›\n simp only [by\n simpa [-ofList_append] using\n (⟨get_of_valid (l ++ m) (c :: r), next_of_valid (l ++ m) c r,\n extract_of_valid l m (c :: r)⟩ :\n _ ∧ _ ∧ _)]\n split <;> rename_i h\n · simpa [Nat.add_assoc, List.splitOnPPrepend_cons_eq_if, h] using\n splitAux_of_valid p (l++m++[c]) [] r ((ofList m)::acc)\n · simpa [List.splitOnPPrepend_cons_eq_if, h, Nat.add_assoc] using\n splitAux_of_valid p l (m++[c]) r acc\n\ntheorem splitToList_of_valid (s p) : splitToList s p = (List.splitOnP p s.toList).map ofList := by\n simpa [splitToList] using splitAux_of_valid p [] [] s.toList []\n\n@[deprecated splitToList_of_valid (since := \"2025-10-18\")]\ntheorem split_of_valid (s p) : splitToList s p = (List.splitOnP p s.toList).map ofList :=\n splitToList_of_valid s p\n\n-- TODO: splitOn\n\n@[simp] theorem toString_toSubstring (s : String) : s.toRawSubstring.toString = s :=\n extract_zero_rawEndPos _\n\nattribute [simp] toSubstring'\n\ntheorem join_eq (ss : List String) : join ss = ofList (ss.map toList).flatten := by\n suffices ∀ (ss : List String) t, ss.foldl (· ++ ·) t =\n ofList (t.toList ++ (ss.map toList).flatten) by\n simpa [join] using this ss \"\"\n intro ss t\n induction ss generalizing t with\n | nil => simp\n | cons s ss ih => simp [ih]\n\n@[deprecated toList_join (since := \"2025-10-31\")]\ntheorem data_join (ss : List String) : (join ss).toList = (ss.map toList).flatten :=\n toList_join\n\nnamespace Legacy.Iterator\n\n@[simp] theorem forward_eq_nextn : forward = nextn := by\n funext it n; induction n generalizing it <;> simp [forward, nextn, *]\n\ntheorem hasNext_cons_addChar (c : Char) (cs : List Char) (i : Pos.Raw) :\n hasNext ⟨String.ofList (c :: cs), i + c⟩ = hasNext ⟨String.ofList cs, i⟩ := by\n simp [hasNext, utf8ByteSize_ofList]; lia\n\n/-- Validity for a string iterator. -/\ndef Valid (it : Iterator) : Prop := it.pos.Valid it.s\n\n/-- `it.ValidFor l r` means that `it` is a string iterator whose underlying string is\n`l.reverse ++ r`, and where the cursor is pointing at the end of `l.reverse`. -/\ninductive ValidFor (l r : List Char) : Iterator → Prop\n /-- The canonical constructor for `ValidFor`. -/\n | mk : ValidFor l r ⟨String.ofList (l.reverseAux r), ⟨utf8Len l⟩⟩\n\nattribute [simp] toString pos\n\nnamespace ValidFor\n\ntheorem valid : ∀ {it}, ValidFor l r it → Valid it\n | _, ⟨⟩ => by simpa [List.reverseAux_eq] using Pos.Raw.Valid.mk l.reverse r rfl\n\ntheorem out : ∀ {it}, ValidFor l r it → it = ⟨String.ofList (l.reverseAux r), ⟨utf8Len l⟩⟩\n | _, ⟨⟩ => rfl\n\ntheorem out' :\n ∀ {it}, ValidFor l r it → it = ⟨String.ofList (l.reverse ++ r), ⟨utf8Len l.reverse⟩⟩\n | _, ⟨⟩ => by simp [List.reverseAux_eq]\n\ntheorem mk' : ValidFor l r ⟨String.ofList (l.reverse ++ r), ⟨utf8Len l.reverse⟩⟩ := by\n simpa [List.reverseAux_eq] using mk\n\ntheorem of_eq : ∀ it, it.1.toList = l.reverseAux r → it.2.1 = utf8Len l → ValidFor l r it\n | ⟨s, ⟨_⟩⟩, h, rfl => by\n rw [← s.ofList_toList, h]\n exact ⟨⟩\n\ntheorem _root_.String.validFor_mkIterator (s) : (mkIterator s).ValidFor [] s.toList :=\n .of_eq _ (by simp [mkIterator]) (by simp [mkIterator])\n\ntheorem remainingBytes : ∀ {it}, ValidFor l r it → it.remainingBytes = utf8Len r\n | _, ⟨⟩ => by simp [Iterator.remainingBytes, Nat.add_sub_cancel_left,\n rawEndPos_ofList, -ofList_append]\n\ntheorem toString : ∀ {it}, ValidFor l r it → it.1 = String.ofList (l.reverseAux r)\n | _, ⟨⟩ => rfl\n\ntheorem pos : ∀ {it}, ValidFor l r it → it.2 = ⟨utf8Len l⟩\n | _, ⟨⟩ => rfl\n\ntheorem pos_eq_zero {l r it} (h : ValidFor l r it) : it.2 = 0 ↔ l = [] := by\n simp [h.pos, Pos.Raw.ext_iff]\n\ntheorem pos_eq_rawEndPos {l r it} (h : ValidFor l r it) : it.2 = it.1.rawEndPos ↔ r = [] := by\n simp only [h.pos, h.toString, rawEndPos_ofList, utf8Len_reverseAux, Pos.Raw.ext_iff]\n exact (Nat.add_left_cancel_iff (m := 0)).trans <| eq_comm.trans utf8Len_eq_zero\n\n@[deprecated pos_eq_rawEndPos (since := \"2025-10-21\")]\ntheorem pos_eq_endPos {l r it} (h : ValidFor l r it) : it.2 = it.1.rawEndPos ↔ r = [] :=\n pos_eq_rawEndPos h\n\ntheorem curr : ∀ {it}, ValidFor l r it → it.curr = r.headD default\n | it, h => by cases h.out'; apply get_of_valid\n\ntheorem next : ∀ {it}, ValidFor l (c :: r) it → ValidFor (c :: l) r it.next\n | it, h => by\n cases h.out'\n simp only [Iterator.next, next_of_valid l.reverse c r]\n rw [← List.reverseAux_eq, utf8Len_reverse]; constructor\n\ntheorem prev : ∀ {it}, ValidFor (c :: l) r it → ValidFor l (c :: r) it.prev\n | it, h => by\n cases h.out'\n have := prev_of_valid l.reverse c r\n simp only [utf8Len_reverse] at this\n simp only [Iterator.prev, List.reverse_cons, List.append_assoc, List.singleton_append,\n utf8Len_append, utf8Len_reverse, utf8Len_cons, utf8Len_nil, Nat.zero_add, this]\n exact .of_eq _ (by simp [List.reverseAux_eq]) (by simp)\n\ntheorem prev_nil : ∀ {it}, ValidFor [] r it → ValidFor [] r it.prev\n | it, h => by\n simp only [Iterator.prev, h.toString, List.reverseAux_nil, h.pos, utf8Len_nil,\n Pos.Raw.mk_zero, Pos.Raw.prev_zero]\n constructor\n\ntheorem atEnd : ∀ {it}, ValidFor l r it → (it.atEnd ↔ r = [])\n | it, h => by\n simp only [Iterator.atEnd, h.pos, h.toString, rawEndPos_ofList, utf8Len_reverseAux, ge_iff_le,\n decide_eq_true_eq]\n exact Nat.add_le_add_iff_left.trans <| Nat.le_zero.trans utf8Len_eq_zero\n\ntheorem hasNext : ∀ {it}, ValidFor l r it → (it.hasNext ↔ r ≠ [])\n | it, h => by simp [Iterator.hasNext, ← h.atEnd, Iterator.atEnd]\n\ntheorem hasPrev : ∀ {it}, ValidFor l r it → (it.hasPrev ↔ l ≠ [])\n | it, h => by simp [Iterator.hasPrev, h.pos, Nat.pos_iff_ne_zero]\n\ntheorem setCurr' : ∀ {it}, ValidFor l r it →\n ValidFor l (r.modifyHead fun _ => c) (it.setCurr c)\n | it, h => by\n cases h.out'\n simp only [setCurr, utf8Len_reverse]\n refine .of_eq _ ?_ (by simp)\n have := set_of_valid l.reverse r c\n simp only [utf8Len_reverse] at this; simp [-ofList_append, List.reverseAux_eq, this]\n\ntheorem setCurr (h : ValidFor l (c :: r) it) :\n ValidFor l (c :: r) (it.setCurr c) := h.setCurr'\n\ntheorem toEnd (h : ValidFor l r it) : ValidFor (r.reverse ++ l) [] it.toEnd := by\n simp only [Iterator.toEnd, h.toString, rawEndPos_ofList, utf8Len_reverseAux]\n exact .of_eq _ (by simp [List.reverseAux_eq]) (by simp [Nat.add_comm])\n\ntheorem toEnd' (it : Iterator) : ValidFor it.s.toList.reverse [] it.toEnd := by\n simp only [Iterator.toEnd]\n exact .of_eq _ (by simp [List.reverseAux_eq])\n (by simp [-size_toByteArray, rawEndPos, utf8ByteSize])\n\ntheorem extract (h₁ : ValidFor l (m ++ r) it₁)\n (h₂ : ValidFor (m.reverse ++ l) r it₂) : it₁.extract it₂ = String.ofList m := by\n cases h₁.out; cases h₂.out\n simp only [Iterator.extract, List.reverseAux_eq, List.reverse_append, List.reverse_reverse,\n List.append_assoc, ne_eq, not_true_eq_false, decide_false, utf8Len_append, utf8Len_reverse,\n gt_iff_lt, Pos.Raw.lt_iff, Nat.not_lt.2 (Nat.le_add_left ..), Bool.or_self, Bool.false_eq_true,\n ↓reduceIte]\n simpa [Nat.add_comm] using extract_of_valid l.reverse m r\n\ntheorem remainingToString {it} (h : ValidFor l r it) :\n it.remainingToString = String.ofList r := by\n cases h.out\n simpa [rawEndPos_ofList, -ofList_append, Iterator.remainingToString, List.reverseAux_eq]\n using extract_of_valid l.reverse r []\n\ntheorem nextn : ∀ {it}, ValidFor l r it →\n ∀ n, n ≤ r.length → ValidFor ((r.take n).reverse ++ l) (r.drop n) (it.nextn n)\n | it, h, 0, _ => by simp [h, Iterator.nextn]\n | it, h, n+1, hn => by\n simp only [Iterator.nextn]\n have a::r := r\n simpa using h.next.nextn _ (Nat.le_of_succ_le_succ hn)\n\ntheorem prevn : ∀ {it}, ValidFor l r it →\n ∀ n, n ≤ l.length → ValidFor (l.drop n) ((l.take n).reverse ++ r) (it.prevn n)\n | it, h, 0, _ => by simp [h, Iterator.prevn]\n | it, h, n+1, hn => by\n simp only [Iterator.prevn]\n have a::l := l\n simpa using h.prev.prevn _ (Nat.le_of_succ_le_succ hn)\n\nend ValidFor\n\nnamespace Valid\n\ntheorem validFor : ∀ {it}, Valid it → ∃ l r, ValidFor l r it\n | ⟨_, ⟨_⟩⟩, .mk l r rfl =>\n ⟨l.reverse, r, by simpa [List.reverseAux_eq] using @ValidFor.mk l.reverse r⟩\n\ntheorem _root_.String.valid_mkIterator (s) : (mkIterator s).Valid := s.validFor_mkIterator.valid\n\ntheorem remainingBytes_le : ∀ {it}, Valid it → it.remainingBytes ≤ utf8ByteSize it.s\n | _, h =>\n let ⟨l, r, h⟩ := h.validFor\n by simp [utf8ByteSize_ofList, h.remainingBytes, h.toString, Nat.le_add_left]\n\ntheorem next : ∀ {it}, Valid it → it.hasNext → Valid it.next\n | _, h, hn => by\n let ⟨l, r, h⟩ := h.validFor\n obtain ⟨c, r, rfl⟩ := List.exists_cons_of_ne_nil (h.hasNext.1 hn)\n exact h.next.valid\n\ntheorem prev : ∀ {it}, Valid it → Valid it.prev\n | _, h =>\n match h.validFor with\n | ⟨[], _, h⟩ => h.prev_nil.valid\n | ⟨_::_, _, h⟩ => h.prev.valid\n\ntheorem setCurr : ∀ {it}, Valid it → Valid (it.setCurr c)\n | it, h => by\n let ⟨l, r, h⟩ := h.validFor\n exact h.setCurr'.valid\n\ntheorem toEnd (it : String.Legacy.Iterator) : Valid it.toEnd := (ValidFor.toEnd' _).valid\n\ntheorem remainingToString {it} (h : ValidFor l r it) :\n it.remainingToString = String.ofList r := by\n cases h.out\n simpa [-ofList_append, rawEndPos_ofList, Iterator.remainingToString, List.reverseAux_eq]\n using extract_of_valid l.reverse r []\n\ntheorem prevn (h : Valid it) : ∀ n, Valid (it.prevn n)\n | 0 => h\n | n+1 => h.prev.prevn n\n\nend Valid\nend Legacy.Iterator\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.offsetOfPosAux\ntheorem offsetOfPosAux_of_valid : ∀ l m r n,\n String.Pos.Raw.offsetOfPosAux (ofList (l ++ m ++ r)) ⟨utf8Len l + utf8Len m⟩ ⟨utf8Len l⟩ n =\n n + m.length\n | l, [], r, n => by unfold String.Pos.Raw.offsetOfPosAux; simp\n | l, c::m, r, n => by\n unfold String.Pos.Raw.offsetOfPosAux\n rw [if_neg (by exact Nat.not_le.2 (Nat.lt_add_of_pos_right add_utf8Size_pos))]\n simp only [List.append_assoc, atEnd_of_valid l (c::m++r)]\n simp only [List.cons_append, utf8Len_cons, next_of_valid l c (m ++ r)]\n simpa [← Nat.add_assoc, Nat.add_right_comm] using\n offsetOfPosAux_of_valid (l++[c]) m r (n + 1)\n\ntheorem offsetOfPos_of_valid (l r) :\n String.Pos.Raw.offsetOfPos (ofList (l ++ r)) ⟨utf8Len l⟩ = l.length := by\n simpa using offsetOfPosAux_of_valid [] l r 0\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.Legacy.foldlAux\ntheorem foldlAux_of_valid (f : α → Char → α) : ∀ l m r a,\n Legacy.foldlAux f (ofList (l ++ m ++ r)) ⟨utf8Len l + utf8Len m⟩ ⟨utf8Len l⟩ a = m.foldl f a\n | l, [], r, a => by unfold Legacy.foldlAux; simp\n | l, c::m, r, a => by\n unfold Legacy.foldlAux\n rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)]\n simp only [List.append_assoc, List.cons_append, utf8Len_cons, next_of_valid l c (m ++ r),\n get_of_valid l (c :: (m ++ r)), Char.reduceDefault, List.headD_cons, List.foldl_cons]\n simpa [← Nat.add_assoc, Nat.add_right_comm] using foldlAux_of_valid f (l++[c]) m r (f a c)\n\ntheorem foldl_eq (f : α → Char → α) (s a) : Legacy.foldl f a s = s.toList.foldl f a := by\n simpa using foldlAux_of_valid f [] s.toList [] a\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.foldrAux\ntheorem foldrAux_of_valid (f : Char → α → α) (l m r a) :\n Legacy.foldrAux f a (ofList (l ++ m ++ r)) ⟨utf8Len l + utf8Len m⟩ ⟨utf8Len l⟩ =\n m.foldr f a := by\n rw [← m.reverse_reverse]\n induction m.reverse generalizing r a with (unfold Legacy.foldrAux; simp)\n | cons c m IH =>\n rw [if_pos add_utf8Size_pos]\n simp only [← Nat.add_assoc, by simpa using prev_of_valid (l ++ m.reverse) c r]\n simp only [by simpa using get_of_valid (l ++ m.reverse) (c :: r)]\n simpa using IH (c::r) (f c a)\n\ntheorem foldr_eq (f : Char → α → α) (s a) : Legacy.foldr f a s = s.toList.foldr f a := by\n simpa using foldrAux_of_valid f [] s.toList [] a\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.anyAux\ntheorem anyAux_of_valid (p : Char → Bool) : ∀ l m r,\n Legacy.anyAux (ofList (l ++ m ++ r)) ⟨utf8Len l + utf8Len m⟩ p ⟨utf8Len l⟩ = m.any p\n | l, [], r => by unfold Legacy.anyAux; simp\n | l, c::m, r => by\n unfold Legacy.anyAux\n rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)]\n simp only [List.append_assoc, List.cons_append, get_of_valid l (c :: (m ++ r)),\n Char.reduceDefault, List.headD_cons, utf8Len_cons, next_of_valid l c (m ++ r),\n Bool.if_true_left, Bool.decide_eq_true, List.any_cons]\n cases p c <;> simp\n simpa [← Nat.add_assoc, Nat.add_right_comm] using anyAux_of_valid p (l++[c]) m r\n\ntheorem any_eq (s : String) (p : Char → Bool) : Legacy.any s p = s.toList.any p := by\n simpa using anyAux_of_valid p [] s.toList []\n\ntheorem any_iff (s : String) (p : Char → Bool) :\n Legacy.any s p ↔ ∃ c ∈ s.toList, p c := by simp [any_eq]\n\ntheorem all_eq (s : String) (p : Char → Bool) : Legacy.all s p = s.toList.all p := by\n rw [Legacy.all, any_eq, List.all_eq_not_any_not]\n\ntheorem all_iff (s : String) (p : Char → Bool) :\n Legacy.all s p ↔ ∀ c ∈ s.toList, p c := by simp [all_eq]\n\ntheorem contains_iff (s : String) (c : Char) : Legacy.contains s c ↔ c ∈ s.toList := by\n simp [Legacy.contains, any_iff]\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.mapAux\ntheorem mapAux_of_valid (f : Char → Char) :\n ∀ l r, Legacy.mapAux f ⟨utf8Len l⟩ (ofList (l ++ r)) = ofList (l ++ r.map f)\n | l, [] => by unfold Legacy.mapAux; simp\n | l, c::r => by\n unfold Legacy.mapAux\n rw [dif_neg (by rw [atEnd_of_valid]; simp)]\n simp only [get_of_valid l (c :: r), Char.reduceDefault,\n List.headD_cons, set_of_valid l (c :: r), List.modifyHead_cons, next_of_valid l (f c) r,\n List.map_cons]\n simpa using mapAux_of_valid f (l++[f c]) r\n\ntheorem map_eq (f : Char → Char) (s) : Legacy.map f s = ofList (s.toList.map f) := by\n simpa using mapAux_of_valid f [] s.toList\n\n-- TODO: substrEq\n-- TODO: isPrefixOf\n-- TODO: replace\n\n@[nolint unusedHavesSuffices] -- false positive from unfolding String.takeWhileAux\ntheorem takeWhileAux_of_valid (p : Char → Bool) : ∀ l m r,\n Substring.Raw.takeWhileAux (ofList (l ++ m ++ r)) ⟨utf8Len l + utf8Len m⟩ p ⟨utf8Len l⟩ =\n ⟨utf8Len l + utf8Len (m.takeWhile p)⟩\n | l, [], r => by unfold Substring.Raw.takeWhileAux List.takeWhile; simp\n | l, c::m, r => by\n unfold Substring.Raw.takeWhileAux List.takeWhile\n rw [dif_pos (by exact Nat.lt_add_of_pos_right add_utf8Size_pos)]\n simp only [List.append_assoc, List.cons_append, get_of_valid l (c :: (m ++ r)),\n Char.reduceDefault, List.headD_cons, utf8Len_cons, next_of_valid l c (m ++ r)]\n cases p c <;> simp\n simpa [← Nat.add_assoc, Nat.add_right_comm] using takeWhileAux_of_valid p (l++[c]) m r\n\n@[simp]\ntheorem map_eq_empty_iff (s : String) (f : Char → Char) : (Legacy.map f s) = \"\" ↔ s = \"\" := by\n simp only [map_eq, ← toList_eq_nil_iff, toList_ofList, List.map_eq_nil_iff]\n\n@[simp]\ntheorem map_isEmpty_eq_isEmpty (s : String) (f : Char → Char) :\n (Legacy.map f s).isEmpty = s.isEmpty := by\n rw [Bool.eq_iff_iff]; simp [isEmpty_iff, map_eq_empty_iff]\n\n@[simp]\ntheorem Legacy.length_map (s : String) (f : Char → Char) : (Legacy.map f s).length = s.length := by\n simp only [← length_toList, map_eq, String.toList_ofList, List.length_map]\n\ntheorem Legacy.length_eq_of_map_eq {a b : String} {f g : Char → Char} :\n Legacy.map f a = Legacy.map g b → a.length = b.length := by\n intro h; rw [← length_map a f, ← length_map b g, h]\n\ntheorem length_eq_of_map_eq {a b : String} {f g : Char → Char} :\n map f a = map g b → a.length = b.length := by\n intro h; rw [← @length_map f a, ← @length_map g b, h]\n\nend String\n\nopen String\n\nnamespace Substring.Raw\n\n/-- Validity for a substring. -/\nstructure Valid (s : Substring.Raw) : Prop where\n /-- The start position of a valid substring is valid. -/\n startValid : s.startPos.Valid s.str\n /-- The stop position of a valid substring is valid. -/\n stopValid : s.stopPos.Valid s.str\n /-- The stop position of a substring is at least the start. -/\n le : s.startPos ≤ s.stopPos\n\ntheorem Valid_default : Valid default := ⟨Pos.Raw.valid_zero, Pos.Raw.valid_zero, Nat.le_refl _⟩\n\n/-- A substring is represented by three lists `l m r`, where `m` is the middle section\n(the actual substring) and `l ++ m ++ r` is the underlying string. -/\ninductive ValidFor (l m r : List Char) : Substring.Raw → Prop\n /-- The constructor for `ValidFor`. -/\n | mk : ValidFor l m r ⟨String.ofList (l ++ m ++ r), ⟨utf8Len l⟩, ⟨utf8Len l + utf8Len m⟩⟩\n\nnamespace ValidFor\n\ntheorem valid : ∀ {s}, ValidFor l m r s → Valid s\n | _, ⟨⟩ => ⟨.intro ⟨l, m ++ r, by simp⟩, .intro ⟨l ++ m, r, by simp⟩, Nat.le_add_right ..⟩\n\ntheorem of_eq : ∀ s,\n s.str.toList = l ++ m ++ r →\n s.startPos.1 = utf8Len l →\n s.stopPos.1 = utf8Len l + utf8Len m →\n ValidFor l m r s\n | ⟨s, ⟨_⟩, ⟨_⟩⟩, h, rfl, rfl => by\n rw [← s.ofList_toList, h]\n exact ⟨⟩\n\ntheorem _root_.String.validFor_toSubstring (s : String) : ValidFor [] s.toList [] s :=\n .of_eq _ (by simp [toRawSubstring]) rfl (by simp [toRawSubstring, rawEndPos])\n\ntheorem str : ∀ {s}, ValidFor l m r s → s.str = String.ofList (l ++ m ++ r)\n | _, ⟨⟩ => rfl\n\ntheorem startPos : ∀ {s}, ValidFor l m r s → s.startPos = ⟨utf8Len l⟩\n | _, ⟨⟩ => rfl\n\ntheorem stopPos : ∀ {s}, ValidFor l m r s → s.stopPos = ⟨utf8Len l + utf8Len m⟩\n | _, ⟨⟩ => rfl\n\ntheorem bsize : ∀ {s}, ValidFor l m r s → s.bsize = utf8Len m\n | _, ⟨⟩ => by simp [Substring.Raw.bsize, Nat.add_sub_cancel_left]\n\ntheorem isEmpty : ∀ {s}, ValidFor l m r s → (s.isEmpty ↔ m = [])\n | _, h => by simp [Substring.Raw.isEmpty, h.bsize]\n\ntheorem toString : ∀ {s}, ValidFor l m r s → s.toString = String.ofList m\n | _, ⟨⟩ => extract_of_valid l m r\n\ntheorem toIterator : ∀ {s}, ValidFor l m r s → s.toLegacyIterator.ValidFor l.reverse (m ++ r)\n | _, h => by\n simp only [Substring.Raw.toLegacyIterator]\n exact .of_eq _ (by simp [h.str, List.reverseAux_eq]) (by simp [h.startPos])\n\ntheorem get : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s → s.get ⟨utf8Len m₁⟩ = c\n | _, ⟨⟩ => by simpa using get_of_valid (l ++ m₁) (c :: m₂ ++ r)\n\ntheorem next : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s →\n s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + c.utf8Size⟩\n | _, ⟨⟩ => by\n simp only [Substring.Raw.next, utf8Len_append, utf8Len_cons, List.append_assoc,\n List.cons_append]\n rw [if_neg (mt Pos.Raw.ext_iff.1 ?a)]\n case a =>\n simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using\n @ne_add_utf8Size_add_self (utf8Len l + utf8Len m₁) (utf8Len m₂) c\n have := next_of_valid (l ++ m₁) c (m₂ ++ r)\n simp only [List.append_assoc, utf8Len_append, Pos.Raw.offsetBy_eq] at this ⊢; rw [this]\n simp [Nat.add_assoc, Nat.add_sub_cancel_left]\n\ntheorem next_stop : ∀ {s}, ValidFor l m r s → s.next ⟨utf8Len m⟩ = ⟨utf8Len m⟩\n | _, ⟨⟩ => by simp [Substring.Raw.next, Pos.Raw.offsetBy_eq]\n\ntheorem prev : ∀ {s}, ValidFor l (m₁ ++ c :: m₂) r s →\n s.prev ⟨utf8Len m₁ + c.utf8Size⟩ = ⟨utf8Len m₁⟩\n | _, ⟨⟩ => by\n simp only [Substring.Raw.prev, List.append_assoc, List.cons_append]\n rw [if_neg (mt Pos.Raw.ext_iff.1 <| Ne.symm ?a)]\n case a => simpa [Nat.add_comm] using @ne_add_utf8Size_add_self (utf8Len l) (utf8Len m₁) c\n have := prev_of_valid (l ++ m₁) c (m₂ ++ r)\n simp only [List.append_assoc, utf8Len_append, Nat.add_assoc,\n Pos.Raw.offsetBy_eq] at this ⊢; rw [this]\n simp [Nat.add_sub_cancel_left]\n\ntheorem nextn_stop : ∀ {s}, ValidFor l m r s → ∀ n, s.nextn n ⟨utf8Len m⟩ = ⟨utf8Len m⟩\n | _, _, 0 => rfl\n | _, h, n+1 => by simp [Substring.Raw.nextn, h.next_stop, h.nextn_stop n]\n\ntheorem nextn : ∀ {s}, ValidFor l (m₁ ++ m₂) r s →\n ∀ n, s.nextn n ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + utf8Len (m₂.take n)⟩\n | _, _, 0 => by simp [Substring.Raw.nextn]\n | s, h, n+1 => by\n simp only [Substring.Raw.nextn]\n match m₂ with\n | [] => simp at h; simp [h.next_stop, h.nextn_stop]\n | c::m₂ =>\n rw [h.next]\n have := @nextn l (m₁ ++ [c]) m₂ r s (by simp [h]) n\n simp at this; rw [this]; simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm]\n\ntheorem prevn : ∀ {s}, ValidFor l (m₁.reverse ++ m₂) r s →\n ∀ n, s.prevn n ⟨utf8Len m₁⟩ = ⟨utf8Len (m₁.drop n)⟩\n | _, _, 0 => by simp [Substring.Raw.prevn]\n | s, h, n+1 => by\n simp only [Substring.Raw.prevn]\n match m₁ with\n | [] => simp\n | c::m₁ =>\n rw [List.reverse_cons, List.append_assoc] at h\n have := h.prev; simp at this; simp [this, h.prevn n]\n\ntheorem front : ∀ {s}, ValidFor l (c :: m) r s → s.front = c\n | _, h => h.get (m₁ := [])\n\ntheorem drop :\n ∀ {s}, ValidFor l m r s → ∀ n, ValidFor (l ++ m.take n) (m.drop n) r (s.drop n)\n | s, h, n => by\n have : Substring.Raw.nextn {..} .. = _ := h.nextn (m₁ := []) n\n simp only [utf8Len_nil, Pos.Raw.mk_zero, Nat.zero_add] at this\n simp only [Substring.Raw.drop, this]\n simp only [h.str, List.append_assoc, h.startPos, h.stopPos]\n rw [← List.take_append_drop n m] at h\n refine .of_eq _ (by simp) (by simp) ?_\n conv => lhs; rw [← List.take_append_drop n m]\n simp [-List.take_append_drop, Nat.add_assoc]\n\ntheorem take : ∀ {s}, ValidFor l m r s →\n ∀ n, ValidFor l (m.take n) (m.drop n ++ r) (s.take n)\n | s, h, n => by\n have : Substring.Raw.nextn {..} .. = _ := h.nextn (m₁ := []) n\n simp at this\n simp only [Substring.Raw.take, this]\n simp only [h.str, List.append_assoc, h.startPos]\n rw [← List.take_append_drop n m] at h\n refine .of_eq _ ?_ (by simp) (by simp)\n conv => lhs; rw [← List.take_append_drop n m]\n simp [-List.take_append_drop]\n\n-- TODO: takeRight, dropRight\n\ntheorem atEnd : ∀ {s}, ValidFor l m r s → (s.atEnd ⟨p⟩ ↔ p = utf8Len m)\n | _, ⟨⟩ => by simp [Substring.Raw.atEnd, Pos.Raw.ext_iff, Nat.add_left_cancel_iff]\n\ntheorem extract' : ∀ {s}, ValidFor l (ml ++ mm ++ mr) r s →\n ValidFor ml mm mr ⟨String.ofList (ml ++ mm ++ mr), b, e⟩ →\n ∃ l' r', ValidFor l' mm r' (s.extract b e)\n | _, ⟨⟩, ⟨⟩ => by\n simp only [Substring.Raw.extract, ge_iff_le, Pos.Raw.mk_le_mk, List.append_assoc,\n utf8Len_append]\n split\n · next h =>\n rw [utf8Len_eq_zero.1 <| Nat.le_zero.1 <| Nat.add_le_add_iff_left.1 h]\n exact ⟨[], [], ⟨⟩⟩\n · next h =>\n refine ⟨l ++ ml, mr ++ r, .of_eq _ (by simp) ?_ ?_⟩ <;>\n simp only [Pos.Raw.byteIdx_offsetBy, Nat.min_eq_min, utf8Len_append]\n <;> rw [Nat.min_eq_right]\n <;> try simp [Nat.add_le_add_iff_left, Nat.le_add_right]\n rw [Nat.add_assoc]\n\ntheorem extract : ∀ {s}, ValidFor l m r s →\n ValidFor ml mm mr ⟨String.ofList m, b, e⟩ → ∃ l' r', ValidFor l' mm r' (s.extract b e) := by\n intro s h₁ h₂\n obtain rfl : m = ml ++ mm ++ mr := by simpa using congrArg String.toList h₂.str\n exact extract' h₁ h₂\n\n-- TODO: splitOn\n\ntheorem foldl (f) (init : α) :\n ∀ {s}, ValidFor l m r s → Legacy.foldl f init s = m.foldl f init\n | _, ⟨⟩ => by simp [-ofList_append, -List.append_assoc, Substring.Raw.Legacy.foldl,\n foldlAux_of_valid]\n\ntheorem foldr (f) (init : α) :\n ∀ {s}, ValidFor l m r s → Legacy.foldr f init s = m.foldr f init\n | _, ⟨⟩ => by simp [-ofList_append, -List.append_assoc, Substring.Raw.Legacy.foldr,\n foldrAux_of_valid]\n\ntheorem any (f) : ∀ {s}, ValidFor l m r s → Legacy.any s f = m.any f\n | _, ⟨⟩ => by simp [-ofList_append, -List.append_assoc, Legacy.any, anyAux_of_valid]\n\ntheorem all (f) : ∀ {s}, ValidFor l m r s → Legacy.all s f = m.all f\n | _, h => by simp [Legacy.all, h.any, List.all_eq_not_any_not]\n\ntheorem contains (c) : ∀ {s}, ValidFor l m r s → (Legacy.contains s c ↔ c ∈ m)\n | _, h => by simp [Legacy.contains, h.any]\n\ntheorem takeWhile (p : Char → Bool) : ∀ {s}, ValidFor l m r s →\n ValidFor l (m.takeWhile p) (m.dropWhile p ++ r) (s.takeWhile p)\n | _, ⟨⟩ => by\n simp only [Substring.Raw.takeWhile, takeWhileAux_of_valid]\n apply ValidFor.of_eq <;> simp\n rw [← List.append_assoc, List.takeWhile_append_dropWhile]\n\ntheorem dropWhile (p : Char → Bool) : ∀ {s}, ValidFor l m r s →\n ValidFor (l ++ m.takeWhile p) (m.dropWhile p) r (s.dropWhile p)\n | _, ⟨⟩ => by\n simp only [Substring.Raw.dropWhile, takeWhileAux_of_valid]\n apply ValidFor.of_eq <;> simp\n rw [Nat.add_assoc, ← utf8Len_append (m.takeWhile p), List.takeWhile_append_dropWhile]\n\n-- TODO: takeRightWhile\n\nend ValidFor\n\nnamespace Valid\n\ntheorem validFor : ∀ {s}, Valid s → ∃ l m r, ValidFor l m r s\n | ⟨_, ⟨_⟩, ⟨_⟩⟩, ⟨.mk l mr rfl, t, h⟩ => by\n obtain ⟨lm, r, h₁, h₂⟩ := t.exists\n have e : lm ++ r = l ++ mr := by\n simpa [← String.ofList_inj, ← String.toByteArray_inj] using h₁\n obtain rfl := Pos.Raw.ext_iff.1 h₂\n simp only [Pos.Raw.mk_le_mk] at *\n have := (or_iff_right_iff_imp.2 fun h => ?x).1 (List.append_eq_append_iff.1 e)\n case x =>\n match l, r, h with | _, _, ⟨m, rfl, rfl⟩ => ?_\n simp only [utf8Len_append] at h\n cases utf8Len_eq_zero.1 <| Nat.le_zero.1 (Nat.le_of_add_le_add_left (c := 0) h)\n exact ⟨[], by simp⟩\n match lm, mr, this with\n | _, _, ⟨m, rfl, rfl⟩ => exact ⟨l, m, r, by simpa using ValidFor.mk⟩\n\ntheorem valid : ∀ {s}, ValidFor l m r s → Valid s\n | _, ⟨⟩ => ⟨.intro ⟨l, m ++ r, by simp, by simp⟩,\n .intro ⟨l ++ m, r, by simp, by simp⟩, Nat.le_add_right ..⟩\n\ntheorem _root_.String.valid_toSubstring (s : String) : Valid s :=\n s.validFor_toSubstring.valid\n\ntheorem bsize : ∀ {s}, Valid s → s.bsize = utf8Len s.toString.toList\n | _, h => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.bsize, h.toString]\n\ntheorem isEmpty : ∀ {s}, Valid s → (s.isEmpty ↔ s.toString = \"\")\n | _, h => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.isEmpty, h.toString, String.ext_iff]\n\ntheorem get : ∀ {s}, Valid s → s.toString.toList = m₁ ++ c :: m₂ → s.get ⟨utf8Len m₁⟩ = c\n | _, h, e => by\n let ⟨l, m, r, h⟩ := h.validFor\n simp only [h.toString, String.toList_ofList] at e; subst e; simp [h.get]\n\ntheorem next : ∀ {s}, Valid s → s.toString.toList = m₁ ++ c :: m₂ →\n s.next ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + c.utf8Size⟩\n | _, h, e => by\n let ⟨l, m, r, h⟩ := h.validFor\n simp only [h.toString, String.toList_ofList] at e; subst e; simp [h.next]\n\ntheorem next_stop : ∀ {s}, Valid s → s.next ⟨s.bsize⟩ = ⟨s.bsize⟩\n | _, h => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.bsize, h.next_stop]\n\ntheorem prev : ∀ {s}, Valid s → s.toString.toList = m₁ ++ c :: m₂ →\n s.prev ⟨utf8Len m₁ + c.utf8Size⟩ = ⟨utf8Len m₁⟩\n | _, h, e => by\n let ⟨l, m, r, h⟩ := h.validFor\n simp only [h.toString, String.toList_ofList] at e; subst e; simp [h.prev]\n\ntheorem nextn_stop : ∀ {s}, Valid s → ∀ n, s.nextn n ⟨s.bsize⟩ = ⟨s.bsize⟩\n | _, h, n => let ⟨l, m, r, h⟩ := h.validFor; by simp [h.bsize, h.nextn_stop]\n\ntheorem nextn : ∀ {s}, Valid s → s.toString.toList = m₁ ++ m₂ →\n ∀ n, s.nextn n ⟨utf8Len m₁⟩ = ⟨utf8Len m₁ + utf8Len (m₂.take n)⟩\n | _, h, e => by\n let ⟨l, m, r, h⟩ := h.validFor\n simp only [h.toString, String.toList_ofList] at e; subst e; simp [h.nextn]\n\ntheorem prevn : ∀ {s}, Valid s → s.toString.toList = m₁.reverse ++ m₂ →\n ∀ n, s.prevn n ⟨utf8Len m₁⟩ = ⟨utf8Len (m₁.drop n)⟩\n | _, h, e => by\n let ⟨l, m, r, h⟩ := h.validFor\n simp only [h.toString, String.toList_ofList] at e; subst e; simp [h.prevn]\n\ntheorem front : ∀ {s}, Valid s → s.toString.toList = c :: m → s.front = c\n | _, h => h.get (m₁ := [])\n\ntheorem drop : ∀ {s}, Valid s → ∀ n, Valid (s.drop n)\n | _, h, _ => let ⟨_, _, _, h⟩ := h.validFor; (h.drop _).valid\n\ntheorem data_drop : ∀ {s}, Valid s → ∀ n, (s.drop n).toString.toList = s.toString.toList.drop n\n | _, h, _ => let ⟨_, _, _, h⟩ := h.validFor; by simp [(h.drop _).toString, h.toString]\n\ntheorem take : ∀ {s}, Valid s → ∀ n, Valid (s.take n)\n | _, h, _ => let ⟨_, _, _, h⟩ := h.validFor; (h.take _).valid\n\ntheorem data_take : ∀ {s}, Valid s → ∀ n, (s.take n).toString.toList = s.toString.toList.take n\n | _, h, _ => let ⟨_, _, _, h⟩ := h.validFor; by simp [(h.take _).toString, h.toString]\n\n-- TODO: takeRight, dropRight\n\ntheorem atEnd : ∀ {s}, Valid s → (s.atEnd ⟨p⟩ ↔ p = utf8ByteSize s.toString)\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [utf8ByteSize_ofList,\n h.atEnd, h.toString]\n\ntheorem extract : ∀ {s}, Valid s → Valid ⟨s.toString, b, e⟩ → Valid (s.extract b e)\n | _, h₁, h₂ => by\n let ⟨l, m, r, h₁⟩ := h₁.validFor\n rw [h₁.toString] at h₂\n let ⟨ml, mm, mr, h₂⟩ := h₂.validFor\n have ⟨l', r', h₃⟩ := h₁.extract h₂\n exact h₃.valid\n\ntheorem toString_extract : ∀ {s}, Valid s → Valid ⟨s.toString, b, e⟩ →\n (s.extract b e).toString = String.Pos.Raw.extract s.toString b e\n | _, h₁, h₂ => by\n let ⟨l, m, r, h₁⟩ := h₁.validFor\n rw [h₁.toString] at h₂\n let ⟨ml, mm, mr, h₂⟩ := h₂.validFor\n have ⟨l', r', h₃⟩ := h₁.extract h₂\n rw [h₃.toString, h₁.toString, ← h₂.toString, toString]\n\ntheorem foldl (f) (init : α) :\n ∀ {s}, Valid s → Legacy.foldl f init s = s.toString.toList.foldl f init\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [h.foldl, h.toString]\n\ntheorem foldr (f) (init : α) :\n ∀ {s}, Valid s → Legacy.foldr f init s = s.toString.toList.foldr f init\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [h.foldr, h.toString]\n\ntheorem any (f) : ∀ {s}, Valid s → Legacy.any s f = s.toString.toList.any f\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [h.any, h.toString]\n\ntheorem all (f) : ∀ {s}, Valid s → Legacy.all s f = s.toString.toList.all f\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [h.all, h.toString]\n\ntheorem contains (c) : ∀ {s}, Valid s → (Legacy.contains s c ↔ c ∈ s.toString.toList)\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [h.contains, h.toString]\n\ntheorem takeWhile (p : Char → Bool) : ∀ {s}, Valid s → Valid (s.takeWhile p)\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; (h.takeWhile _).valid\n\ntheorem data_takeWhile (p) : ∀ {s}, Valid s →\n (s.takeWhile p).toString.toList = s.toString.toList.takeWhile p\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [(h.takeWhile _).toString, h.toString]\n\ntheorem dropWhile (p : Char → Bool) : ∀ {s}, Valid s → Valid (s.dropWhile p)\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; (h.dropWhile _).valid\n\ntheorem data_dropWhile (p) : ∀ {s}, Valid s →\n (s.dropWhile p).toString.toList = s.toString.toList.dropWhile p\n | _, h => let ⟨_, _, _, h⟩ := h.validFor; by simp [(h.dropWhile _).toString, h.toString]\n\n-- TODO: takeRightWhile\n\nend Valid\nend Substring.Raw\n\nnamespace String\n\ntheorem drop_eq (s : String) (n : Nat) : Legacy.drop s n = ofList (s.toList.drop n) :=\n (s.validFor_toSubstring.drop n).toString\n\n@[simp] theorem toList_drop (s : String) (n : Nat) :\n (Legacy.drop s n).toList = s.toList.drop n := by\n simp [drop_eq]\n\n@[simp] theorem drop_empty {n : Nat} : Legacy.drop \"\" n = \"\" := by simp [drop_eq, List.drop_nil]\n\ntheorem take_eq (s : String) (n : Nat) : Legacy.take s n = ofList (s.toList.take n) :=\n (s.validFor_toSubstring.take n).toString\n\n@[simp] theorem toList_take (s : String) (n : Nat) :\n (Legacy.take s n).toList = s.toList.take n := by\n simp [take_eq]\n\ntheorem takeWhile_eq (p : Char → Bool) (s : String) :\n Legacy.takeWhile s p = ofList (s.toList.takeWhile p) :=\n (s.validFor_toSubstring.takeWhile p).toString\n\n@[simp] theorem toList_takeWhile (p : Char → Bool) (s : String) :\n (Legacy.takeWhile s p).toList = s.toList.takeWhile p := by simp [takeWhile_eq]\n\ntheorem dropWhile_eq (p : Char → Bool) (s : String) :\n Legacy.dropWhile s p = ofList (s.toList.dropWhile p) :=\n (s.validFor_toSubstring.dropWhile p).toString\n\n@[simp] theorem toList_dropWhile (p : Char → Bool) (s : String) :\n (Legacy.dropWhile s p).toList = s.toList.dropWhile p := by simp [dropWhile_eq]\n\nend String\n" }, { "path": "Batteries/Data/String/Matcher.lean", "content": "/-\nCopyright (c) 2023 F. G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: F. G. Dorais\n-/\nmodule\n\npublic import Batteries.Data.Array.Match\npublic import Batteries.Data.String.Basic\n\n@[expose] public section\n\nnamespace String\n\n/-- Knuth-Morris-Pratt matcher type\n\nThis type is used to keep data for running the Knuth-Morris-Pratt (KMP) string matching algorithm.\nKMP is a linear time algorithm to locate all substrings of a string that match a given pattern.\nGenerating the algorithm data is also linear in the length of the pattern but the data can be\nre-used to match the same pattern over different strings.\n\nThe KMP data for a pattern string can be generated using `Matcher.ofString`. Then `Matcher.find?`\nand `Matcher.findAll` can be used to run the algorithm on an input string.\n```\ndef m := Matcher.ofString \"abba\"\n\n#eval Option.isSome <| m.find? \"AbbabbA\" -- false\n#eval Option.isSome <| m.find? \"aabbaa\" -- true\n\n#eval Array.size <| m.findAll \"abbabba\" -- 2\n#eval Array.size <| m.findAll \"abbabbabba\" -- 3\n```\n-/\nstructure Matcher extends Array.Matcher Char where\n /-- The pattern for the matcher -/\n pattern : Substring.Raw\n\n/-- Make KMP matcher from pattern substring -/\n@[inline] def Matcher.ofSubstring (pattern : Substring.Raw) : Matcher where\n toMatcher := Array.Matcher.ofStream pattern\n pattern := pattern\n\n/-- Make KMP matcher from pattern string -/\n@[inline] def Matcher.ofString (pattern : String) : Matcher :=\n Matcher.ofSubstring pattern\n\n/-- The byte size of the string pattern for the matcher -/\nabbrev Matcher.patternSize (m : Matcher) : Nat := m.pattern.bsize\n\n/-- Find all substrings of `s` matching `m.pattern`. -/\npartial def Matcher.findAll (m : Matcher) (s : Substring.Raw) : Array Substring.Raw :=\n loop s m.toMatcher #[]\nwhere\n /-- Accumulator loop for `String.Matcher.findAll` -/\n loop (s : Substring.Raw) (am : Array.Matcher Char) (occs : Array Substring.Raw) :\n Array Substring.Raw :=\n match am.next? s with\n | none => occs\n | some (s, am) =>\n loop s am <| occs.push { s with\n startPos := ⟨s.startPos.byteIdx - m.patternSize⟩\n stopPos := s.startPos }\n\n/-- Find the first substring of `s` matching `m.pattern`, or `none` if no such substring exists. -/\ndef Matcher.find? (m : Matcher) (s : Substring.Raw) : Option Substring.Raw :=\n match m.next? s with\n | none => none\n | some (s, _) =>\n some { s with\n startPos := ⟨s.startPos.byteIdx - m.patternSize⟩\n stopPos := s.startPos }\n\nend String\n\nnamespace Substring.Raw\n\n/--\nReturns all the substrings of `s` that match `pattern`.\n-/\n@[inline] def findAllSubstr (s pattern : Substring.Raw) : Array Substring.Raw :=\n (String.Matcher.ofSubstring pattern).findAll s\n\n/--\nReturns the first substring of `s` that matches `pattern`,\nor `none` if there is no such substring.\n-/\n@[inline] def findSubstr? (s pattern : Substring.Raw) : Option Substring.Raw :=\n (String.Matcher.ofSubstring pattern).find? s\n\n/--\nReturns true iff `pattern` occurs as a substring of `s`.\n-/\n@[inline] def containsSubstr (s pattern : Substring.Raw) : Bool :=\n s.findSubstr? pattern |>.isSome\n\nend Substring.Raw\n\nsection Deprecations\n\n@[deprecated Substring.Raw.findAllSubstr (since := \"2025-11-16\"),\n inherit_doc Substring.Raw.findAllSubstr]\nabbrev Substring.findAllSubstr := Substring.Raw.findAllSubstr\n\n@[deprecated Substring.Raw.findSubstr? (since := \"2025-11-16\"),\n inherit_doc Substring.Raw.findSubstr?]\nabbrev Substring.findSubstr? := Substring.Raw.findSubstr?\n\n@[deprecated Substring.Raw.containsSubstr (since := \"2025-11-16\"),\n inherit_doc Substring.Raw.containsSubstr]\nabbrev Substring.containsSubstr := Substring.Raw.containsSubstr\n\nend Deprecations\n\nnamespace String\n\n@[inherit_doc Substring.Raw.findAllSubstr]\nabbrev findAllSubstr (s : String) (pattern : Substring.Raw) : Array Substring.Raw :=\n (String.Matcher.ofSubstring pattern).findAll s\n\n@[inherit_doc Substring.Raw.findSubstr?]\nabbrev findSubstr? (s : String) (pattern : Substring.Raw) : Option Substring.Raw :=\n s.toRawSubstring.findSubstr? pattern\n\n@[deprecated String.contains (since := \"2026-02-25\"), inherit_doc Substring.Raw.containsSubstr]\nabbrev containsSubstr (s : String) (pattern : Substring.Raw) : Bool :=\n s.toRawSubstring.containsSubstr pattern\n\nend String\n" }, { "path": "Batteries/Data/String.lean", "content": "module\n\npublic import Batteries.Data.String.AsciiCasing\npublic import Batteries.Data.String.Basic\npublic import Batteries.Data.String.Legacy\npublic import Batteries.Data.String.Lemmas\npublic import Batteries.Data.String.Matcher\n" }, { "path": "Batteries/Data/UInt.lean", "content": "/-\nCopyright (c) 2023 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Classes.Order\n\n@[expose] public section\n\n/-! ### UInt8 -/\n\n@[ext] theorem UInt8.ext : {x y : UInt8} → x.toNat = y.toNat → x = y\n | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl\n\n@[simp] theorem UInt8.toUInt16_toNat (x : UInt8) : x.toUInt16.toNat = x.toNat := rfl\n\n@[simp] theorem UInt8.toUInt32_toNat (x : UInt8) : x.toUInt32.toNat = x.toNat := rfl\n\n@[simp] theorem UInt8.toUInt64_toNat (x : UInt8) : x.toUInt64.toNat = x.toNat := rfl\n\ninstance : Std.LawfulOrd UInt8 :=\n Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt UInt8.le_antisymm\n\ntheorem UInt8.le_iff_toNat_le_toNat {x y : UInt8} : x ≤ y ↔ x.toNat ≤ y.toNat := .rfl\n\ntheorem UInt8.lt_iff_toNat_lt_toNat {x y : UInt8} : x < y ↔ x.toNat < y.toNat := .rfl\n\ntheorem UInt8.compare_eq_toNat_compare_toNat (x y : UInt8) :\n compare x y = compare x.toNat y.toNat := by\n simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt8.ext_iff]\n\ntheorem UInt8.max_def (x y : UInt8) : max x y = if x ≤ y then y else x := rfl\n\ntheorem UInt8.min_def (x y : UInt8) : min x y = if x ≤ y then x else y := rfl\n\ntheorem UInt8.toNat_max (x y : UInt8) : (max x y).toNat = max x.toNat y.toNat := by\n rw [max_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_right h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_left (Nat.le_of_not_ge h)]\n\ntheorem UInt8.toNat_min (x y : UInt8) : (min x y).toNat = min x.toNat y.toNat := by\n rw [min_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_left h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_right (Nat.le_of_not_ge h)]\n\n/-! ### UInt16 -/\n\n@[ext] theorem UInt16.ext : {x y : UInt16} → x.toNat = y.toNat → x = y\n | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl\n\n@[simp] theorem UInt16.toUInt8_toNat (x : UInt16) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl\n\n@[simp] theorem UInt16.toUInt32_toNat (x : UInt16) : x.toUInt32.toNat = x.toNat := rfl\n\n@[simp] theorem UInt16.toUInt64_toNat (x : UInt16) : x.toUInt64.toNat = x.toNat := rfl\n\ninstance : Std.LawfulOrd UInt16 :=\n Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt UInt16.le_antisymm\n\ntheorem UInt16.le_iff_toNat_le_toNat {x y : UInt16} : x ≤ y ↔ x.toNat ≤ y.toNat := .rfl\n\ntheorem UInt16.lt_iff_toNat_lt_toNat {x y : UInt16} : x < y ↔ x.toNat < y.toNat := .rfl\n\ntheorem UInt16.compare_eq_toNat_compare_toNat (x y : UInt16) :\n compare x y = compare x.toNat y.toNat := by\n simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt16.ext_iff]\n\ntheorem UInt16.max_def (x y : UInt16) : max x y = if x ≤ y then y else x := rfl\n\ntheorem UInt16.min_def (x y : UInt16) : min x y = if x ≤ y then x else y := rfl\n\ntheorem UInt16.toNat_max (x y : UInt16) : (max x y).toNat = max x.toNat y.toNat := by\n rw [max_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_right h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_left (Nat.le_of_not_ge h)]\n\ntheorem UInt16.toNat_min (x y : UInt16) : (min x y).toNat = min x.toNat y.toNat := by\n rw [min_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_left h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_right (Nat.le_of_not_ge h)]\n\n/-! ### UInt32 -/\n\n@[ext] theorem UInt32.ext : {x y : UInt32} → x.toNat = y.toNat → x = y\n | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl\n\n@[simp] theorem UInt32.toUInt8_toNat (x : UInt32) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl\n\n@[simp] theorem UInt32.toUInt16_toNat (x : UInt32) : x.toUInt16.toNat = x.toNat % 2 ^ 16 := rfl\n\n@[simp] theorem UInt32.toUInt64_toNat (x : UInt32) : x.toUInt64.toNat = x.toNat := rfl\n\ninstance : Std.LawfulOrd UInt32 :=\n Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt UInt32.le_antisymm\n\ntheorem UInt32.le_iff_toNat_le_toNat {x y : UInt32} : x ≤ y ↔ x.toNat ≤ y.toNat := .rfl\n\ntheorem UInt32.lt_iff_toNat_lt_toNat {x y : UInt32} : x < y ↔ x.toNat < y.toNat := .rfl\n\ntheorem UInt32.compare_eq_toNat_compare_toNat (x y : UInt32) :\n compare x y = compare x.toNat y.toNat := by\n simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt32.ext_iff]\n\ntheorem UInt32.max_def (x y : UInt32) : max x y = if x ≤ y then y else x := rfl\n\ntheorem UInt32.min_def (x y : UInt32) : min x y = if x ≤ y then x else y := rfl\n\ntheorem UInt32.toNat_max (x y : UInt32) : (max x y).toNat = max x.toNat y.toNat := by\n rw [max_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_right h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_left (Nat.le_of_not_ge h)]\n\ntheorem UInt32.toNat_min (x y : UInt32) : (min x y).toNat = min x.toNat y.toNat := by\n rw [min_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_left h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_right (Nat.le_of_not_ge h)]\n\n/-! ### UInt64 -/\n\n@[ext] theorem UInt64.ext : {x y : UInt64} → x.toNat = y.toNat → x = y\n | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl\n\n@[simp] theorem UInt64.toUInt8_toNat (x : UInt64) : x.toUInt8.toNat = x.toNat % 2 ^ 8 := rfl\n\n@[simp] theorem UInt64.toUInt16_toNat (x : UInt64) : x.toUInt16.toNat = x.toNat % 2 ^ 16 := rfl\n\n@[simp] theorem UInt64.toUInt32_toNat (x : UInt64) : x.toUInt32.toNat = x.toNat % 2 ^ 32 := rfl\n\ninstance : Std.LawfulOrd UInt64 :=\n Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt UInt64.le_antisymm\n\ntheorem UInt64.le_iff_toNat_le_toNat {x y : UInt64} : x ≤ y ↔ x.toNat ≤ y.toNat := .rfl\n\ntheorem UInt64.lt_iff_toNat_lt_toNat {x y : UInt64} : x < y ↔ x.toNat < y.toNat := .rfl\n\ntheorem UInt64.compare_eq_toNat_compare_toNat (x y : UInt64) :\n compare x y = compare x.toNat y.toNat := by\n simp only [compare, compareOfLessAndEq, lt_iff_toNat_lt_toNat, UInt64.ext_iff]\n\ntheorem UInt64.max_def (x y : UInt64) : max x y = if x ≤ y then y else x := rfl\n\ntheorem UInt64.min_def (x y : UInt64) : min x y = if x ≤ y then x else y := rfl\n\ntheorem UInt64.toNat_max (x y : UInt64) : (max x y).toNat = max x.toNat y.toNat := by\n rw [max_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_right h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.max_eq_left (Nat.le_of_not_ge h)]\n\ntheorem UInt64.toNat_min (x y : UInt64) : (min x y).toNat = min x.toNat y.toNat := by\n rw [min_def]\n split\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_left h]\n · next h =>\n rw [le_iff_toNat_le_toNat] at h\n rw [Nat.min_eq_right (Nat.le_of_not_ge h)]\n\n/-! ### USize -/\n\n@[ext] theorem USize.ext : {x y : USize} → x.toNat = y.toNat → x = y\n | ⟨⟨_,_⟩⟩, ⟨⟨_,_⟩⟩, rfl => rfl\n\ntheorem USize.toUInt64_toNat (x : USize) : x.toUInt64.toNat = x.toNat := by simp\n\ntheorem UInt32.toUSize_toNat (x : UInt32) : x.toUSize.toNat = x.toNat := by simp\n\ninstance : Std.LawfulOrd USize :=\n Std.LawfulCmp.compareOfLessAndEq_of_irrefl_of_trans_of_not_lt_of_antisymm\n (fun _ => Nat.lt_irrefl _) Nat.lt_trans Nat.not_lt USize.le_antisymm\n\ntheorem USize.toNat_ofNat_of_le_of_lt (h : n < USize.size) (hn : i ≤ n) :\n (USize.ofNat i).toNat = i :=\n USize.toNat_ofNat_of_lt' (Nat.lt_of_le_of_lt ‹_› ‹_›)\n\ntheorem USize.pred_toNat {i : USize} (h_gt : 0 < i) :\n (i - 1).toNat = i.toNat - 1 := by\n have h_gt_nat := USize.lt_iff_toNat_lt.mp h_gt\n have h_bound := i.toNat_lt_size\n cases System.Platform.numBits_eq\n all_goals\n simp_all only [USize.size, USize.toNat_sub, USize.reduceToNat]\n omega\n" }, { "path": "Batteries/Data/UnionFind/Basic.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Lint.Misc\npublic import Batteries.Tactic.SeqFocus\npublic import Batteries.Util.Panic\n\n@[expose] public section\n\nnamespace Batteries\n\n/-- Union-find node type -/\nstructure UFNode where\n /-- Parent of node -/\n parent : Nat\n /-- Rank of node -/\n rank : Nat\n\nnamespace UnionFind\n\n/-- Parent of a union-find node, defaults to self when the node is a root -/\ndef parentD (arr : Array UFNode) (i : Nat) : Nat :=\n if h : i < arr.size then arr[i].parent else i\n\n/-- Rank of a union-find node, defaults to 0 when the node is a root -/\ndef rankD (arr : Array UFNode) (i : Nat) : Nat :=\n if h : i < arr.size then arr[i].rank else 0\n\ntheorem parentD_eq {arr : Array UFNode} {i} (h) :\n parentD arr i = arr[i].parent := dif_pos _\n\ntheorem rankD_eq {arr : Array UFNode} {i} (h) : rankD arr i = arr[i].rank := dif_pos _\n\ntheorem parentD_of_not_lt : ¬i < arr.size → parentD arr i = i := (dif_neg ·)\n\ntheorem lt_of_parentD : parentD arr i ≠ i → i < arr.size :=\n Decidable.not_imp_comm.1 parentD_of_not_lt\n\ntheorem parentD_set {arr : Array UFNode} {x v i h} :\n parentD (arr.set x v h) i = if x = i then v.parent else parentD arr i := by\n rw [parentD]; simp only [Array.size_set, parentD]\n split\n · split <;> simp_all\n · split <;> [(subst i; cases ‹¬_› h); rfl]\n\ntheorem rankD_set {arr : Array UFNode} {x v i h} :\n rankD (arr.set x v h) i = if x = i then v.rank else rankD arr i := by\n rw [rankD]; simp only [Array.size_set, rankD]\n split\n · split <;> simp_all\n · split <;> [(subst i; cases ‹¬_› h); rfl]\n\nend UnionFind\n\nopen UnionFind\n\n/-- ### Union-find data structure\n\nThe `UnionFind` structure is an implementation of disjoint-set data structure\nthat uses path compression to make the primary operations run in amortized\nnearly linear time. The nodes of a `UnionFind` structure `s` are natural\nnumbers smaller than `s.size`. The structure associates with a canonical\nrepresentative from its equivalence class. The structure can be extended\nusing the `push` operation and equivalence classes can be updated using the\n`union` operation.\n\nThe main operations for `UnionFind` are:\n\n* `empty`/`mkEmpty` are used to create a new empty structure.\n* `size` returns the size of the data structure.\n* `push` adds a new node to a structure, unlinked to any other node.\n* `union` links two nodes of the data structure, joining their equivalence\n classes, and performs path compression.\n* `find` returns the canonical representative of a node and updates the data\n structure using path compression.\n* `root` returns the canonical representative of a node without altering the\n data structure.\n* `checkEquiv` checks whether two nodes have the same canonical representative\n and updates the structure using path compression.\n\nMost use cases should prefer `find` over `root` to benefit from the speedup from path-compression.\n\nThe main operations use `Fin s.size` to represent nodes of the union-find structure.\nSome alternatives are provided:\n\n* `unionN`, `findN`, `rootN`, `checkEquivN` use `Fin n` with a proof that `n = s.size`.\n* `union!`, `find!`, `root!`, `checkEquiv!` use `Nat` and panic when the indices are out of bounds.\n* `findD`, `rootD`, `checkEquivD` use `Nat` and treat out of bound indices as isolated nodes.\n\nThe noncomputable relation `UnionFind.Equiv` is provided to use the equivalence relation from a\n`UnionFind` structure in the context of proofs.\n-/\nstructure UnionFind where\n /-- Array of union-find nodes -/\n arr : Array UFNode\n /-- Validity for parent nodes -/\n parentD_lt : ∀ {i}, i < arr.size → parentD arr i < arr.size\n /-- Validity for rank -/\n rankD_lt : ∀ {i}, parentD arr i ≠ i → rankD arr i < rankD arr (parentD arr i)\n\nnamespace UnionFind\n\n/-- Size of union-find structure. -/\n@[inline] abbrev size (self : UnionFind) := self.arr.size\n\n/-- Create an empty union-find structure with specific capacity -/\ndef mkEmpty (c : Nat) : UnionFind where\n arr := Array.mkEmpty c\n parentD_lt := nofun\n rankD_lt := nofun\n\n/-- Empty union-find structure -/\ndef empty := mkEmpty 0\n\ninstance : EmptyCollection UnionFind := ⟨.empty⟩\n\n/-- Parent of union-find node -/\nabbrev parent (self : UnionFind) (i : Nat) : Nat := parentD self.arr i\n\ntheorem parent'_lt (self : UnionFind) (i : Nat) (h) : self.arr[i].parent < self.size := by\n simp [← parentD_eq, parentD_lt, h]\n\ntheorem parent_lt (self : UnionFind) (i : Nat) : self.parent i < self.size ↔ i < self.size := by\n simp only [parentD]; split <;> simp only [*, parent'_lt]\n\n/-- Rank of union-find node -/\nabbrev rank (self : UnionFind) (i : Nat) : Nat := rankD self.arr i\n\ntheorem rank_lt {self : UnionFind} {i : Nat} : self.parent i ≠ i →\n self.rank i < self.rank (self.parent i) := by simpa only [rank] using self.rankD_lt\n\ntheorem rank'_lt (self : UnionFind) (i h) : self.arr[i].parent ≠ i →\n self.rank i < self.rank (self.arr[i]).parent := by\n simpa only [← parentD_eq] using self.rankD_lt\n\n/-- Maximum rank of nodes in a union-find structure -/\nnoncomputable def rankMax (self : UnionFind) := self.arr.foldr (max ·.rank) 0 + 1\n\ntheorem rank'_lt_rankMax (self : UnionFind) (i : Nat) (h) : (self.arr[i]).rank < self.rankMax := by\n let rec go : ∀ {l} {x : UFNode}, x ∈ l → x.rank ≤ List.foldr (max ·.rank) 0 l\n | a::l, _, List.Mem.head _ => by dsimp; apply Nat.le_max_left\n | a::l, _, .tail _ h => by dsimp; exact Nat.le_trans (go h) (Nat.le_max_right ..)\n simp only [rankMax, ← Array.foldr_toList]\n exact Nat.lt_succ_iff.2 <| go (self.arr.toList.getElem_mem _)\n\ntheorem rankD_lt_rankMax (self : UnionFind) (i : Nat) :\n rankD self.arr i < self.rankMax := by\n simp [rankD]; split <;> [apply rank'_lt_rankMax; apply Nat.succ_pos]\n\ntheorem lt_rankMax (self : UnionFind) (i : Nat) : self.rank i < self.rankMax := rankD_lt_rankMax ..\n\ntheorem push_rankD (arr : Array UFNode) : rankD (arr.push ⟨arr.size, 0⟩) i = rankD arr i := by\n simp only [rankD, Array.size_push, Array.getElem_push, dite_eq_ite]\n split <;> split <;> first | simp | cases ‹¬_› (Nat.lt_succ_of_lt ‹_›)\n\ntheorem push_parentD (arr : Array UFNode) : parentD (arr.push ⟨arr.size, 0⟩) i = parentD arr i := by\n simp only [parentD, Array.size_push, Array.getElem_push, dite_eq_ite]\n split <;> split <;> try simp\n · exact Nat.le_antisymm (Nat.ge_of_not_lt ‹_›) (Nat.le_of_lt_succ ‹_›)\n · cases ‹¬_› (Nat.lt_succ_of_lt ‹_›)\n\n/-- Add a new node to a union-find structure, unlinked with any other nodes -/\ndef push (self : UnionFind) : UnionFind where\n arr := self.arr.push ⟨self.arr.size, 0⟩\n parentD_lt {i} := by\n simp only [Array.size_push, push_parentD]; simp only [parentD]\n split <;> [exact fun _ => Nat.lt_succ_of_lt (self.parent'_lt ..); exact id]\n rankD_lt := by simp only [push_parentD, ne_eq, push_rankD]; exact self.rank_lt\n\n/-- Root of a union-find node. -/\ndef root (self : UnionFind) (x : Fin self.size) : Fin self.size :=\n let y := self.arr[x.1].parent\n if h : y = x then\n x\n else\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ h)\n self.root ⟨y, self.parent'_lt x _⟩\ntermination_by self.rankMax - self.rank x\n\n@[inherit_doc root]\ndef rootN (self : UnionFind) (x : Fin n) (h : n = self.size) : Fin n :=\n match n, h with | _, rfl => self.root x\n\n/-- Root of a union-find node. Panics if index is out of bounds. -/\ndef root! (self : UnionFind) (x : Nat) : Nat :=\n if h : x < self.size then self.root ⟨x, h⟩ else panicWith x \"index out of bounds\"\n\n/-- Root of a union-find node. Returns input if index is out of bounds. -/\ndef rootD (self : UnionFind) (x : Nat) : Nat :=\n if h : x < self.size then self.root ⟨x, h⟩ else x\n\nset_option backward.proofsInPublic true in -- for `rw [root]`\n@[nolint unusedHavesSuffices]\ntheorem parent_root (self : UnionFind) (x : Fin self.size) :\n (self.arr[(self.root x).1]).parent = self.root x := by\n rw [root]; split <;> [assumption; skip]\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n apply parent_root\ntermination_by self.rankMax - self.rank x\n\ntheorem parent_rootD (self : UnionFind) (x : Nat) :\n self.parent (self.rootD x) = self.rootD x := by\n rw [rootD]\n split\n · simp [parentD, parent_root]\n · simp [parentD_of_not_lt, *]\n\n@[nolint unusedHavesSuffices]\ntheorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = self.rootD x := by\n simp only [rootD, parent_lt]\n split\n · simp only [parentD, ↓reduceDIte, *]\n (conv => rhs; rw [root]); split\n · rw [root, dif_pos] <;> simp_all\n · simp\n · simp only [not_false_eq_true, parentD_of_not_lt, *]\n\ntheorem rootD_lt {self : UnionFind} {x : Nat} : self.rootD x < self.size ↔ x < self.size := by\n simp only [rootD]; split <;> simp [*]\n\n@[nolint unusedHavesSuffices]\ntheorem rootD_eq_self {self : UnionFind} {x : Nat} : self.rootD x = x ↔ self.parent x = x := by\n refine ⟨fun h => by rw [← h, parent_rootD], fun h => ?_⟩\n rw [rootD]; split <;> [rw [root, dif_pos (by rwa [parent, parentD_eq ‹_›] at h)]; rfl]\n\ntheorem rootD_rootD {self : UnionFind} {x : Nat} : self.rootD (self.rootD x) = self.rootD x :=\n rootD_eq_self.2 (parent_rootD ..)\n\ntheorem rootD_ext {m1 m2 : UnionFind}\n (H : ∀ x, m1.parent x = m2.parent x) {x} : m1.rootD x = m2.rootD x := by\n if h : m2.parent x = x then\n rw [rootD_eq_self.2 h, rootD_eq_self.2 ((H _).trans h)]\n else\n have := Nat.sub_lt_sub_left (m2.lt_rankMax x) (m2.rank_lt h)\n rw [← rootD_parent, H, rootD_ext H, rootD_parent]\ntermination_by m2.rankMax - m2.rank x\n\ntheorem le_rank_root {self : UnionFind} {x : Nat} : self.rank x ≤ self.rank (self.rootD x) := by\n if h : self.parent x = x then\n rw [rootD_eq_self.2 h]; exact Nat.le_refl ..\n else\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank_lt h)\n rw [← rootD_parent]\n exact Nat.le_trans (Nat.le_of_lt (self.rank_lt h)) le_rank_root\ntermination_by self.rankMax - self.rank x\n\ntheorem lt_rank_root {self : UnionFind} {x : Nat} :\n self.rank x < self.rank (self.rootD x) ↔ self.parent x ≠ x := by\n refine ⟨fun h h' => Nat.ne_of_lt h (by rw [rootD_eq_self.2 h']), fun h => ?_⟩\n rw [← rootD_parent]\n exact Nat.lt_of_lt_of_le (self.rank_lt h) le_rank_root\n\n/-- Auxiliary data structure for find operation -/\nstructure FindAux (n : Nat) where\n /-- Array of nodes -/\n s : Array UFNode\n /-- Index of root node -/\n root : Fin n\n /-- Size requirement -/\n size_eq : s.size = n\n\n/-- Auxiliary function for find operation -/\ndef findAux (self : UnionFind) (x : Fin self.size) : FindAux self.size :=\n let y := self.arr[x.1].parent\n if h : y = x then\n ⟨self.arr, x, rfl⟩\n else\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ h)\n let ⟨arr₁, root, H⟩ := self.findAux ⟨y, self.parent'_lt _ x.2⟩\n ⟨arr₁.modify x fun s => { s with parent := root }, root, by simp [H]⟩\ntermination_by self.rankMax - self.rank x\n\n@[nolint unusedHavesSuffices]\ntheorem findAux_root {self : UnionFind} {x : Fin self.size} :\n (findAux self x).root = self.root x := by\n rw [findAux, root]\n simp only [dite_eq_ite]\n split <;> simp only\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n exact findAux_root\ntermination_by self.rankMax - self.rank x\n\n@[nolint unusedHavesSuffices]\ntheorem findAux_s {self : UnionFind} {x : Fin self.size} :\n (findAux self x).s = if self.arr[x.1].parent = x then self.arr else\n (self.findAux ⟨_, self.parent'_lt x x.2⟩).s.modify x fun s =>\n { s with parent := self.rootD x } := by\n rw [show self.rootD _ = (self.findAux ⟨_, self.parent'_lt x x.2⟩).root from _]\n · rw [findAux]; split <;> rfl\n · rw [← rootD_parent, parent, parentD_eq (Fin.is_lt _)]\n simp only [rootD, findAux_root]\n apply dif_pos\n\ntheorem rankD_findAux {self : UnionFind} {x : Fin self.size} :\n rankD (findAux self x).s i = self.rank i := by\n if h : i < self.size then\n rw [findAux_s]; split <;> [rfl; skip]\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n have := lt_of_parentD (by rwa [parentD_eq])\n rw [rankD_eq (by simp [FindAux.size_eq, h]), Array.getElem_modify]\n split <;>\n simp [← rankD_eq, rankD_findAux (x := ⟨_, self.parent'_lt _ x.2⟩)]\n else\n simp only [rankD, rank]\n rw [dif_neg (by rwa [FindAux.size_eq]), dif_neg h]\ntermination_by self.rankMax - self.rank x\n\ntheorem parentD_findAux {self : UnionFind} {x : Fin self.size} :\n parentD (findAux self x).s i =\n if i = x then self.rootD x else parentD (self.findAux ⟨_, self.parent'_lt _ x.2⟩).s i := by\n rw [findAux_s]; split <;> [split; skip]\n · subst i; rw [rootD_eq_self.2 _] <;> simp [parentD_eq, *]\n · rw [findAux_s]; simp [*]\n · next h =>\n rw [parentD]; split <;> rename_i h'\n · rw [Array.getElem_modify (by simpa using h')]\n simp only [@eq_comm _ i]\n split <;> simp [← parentD_eq]\n · rw [if_neg (mt (by rintro rfl; simp [FindAux.size_eq]) h')]\n rw [parentD, dif_neg]; simpa using h'\n\ntheorem parentD_findAux_rootD {self : UnionFind} {x : Fin self.size} :\n parentD (findAux self x).s (self.rootD x) = self.rootD x := by\n rw [parentD_findAux]; split <;> [rfl; rename_i h]\n rw [rootD_eq_self, parent, parentD_eq x.2] at h\n have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n rw [← rootD_parent, parent, parentD_eq x.2]\n exact parentD_findAux_rootD (x := ⟨_, self.parent'_lt _ x.2⟩)\ntermination_by self.rankMax - self.rank x\n\ntheorem parentD_findAux_lt {self : UnionFind} {x : Fin self.size} (h : i < self.size) :\n parentD (findAux self x).s i < self.size := by\n if h' : self.arr[x.1].parent = x then\n rw [findAux_s, if_pos h']; apply self.parentD_lt h\n else\n rw [parentD_findAux]\n split\n · simp [rootD_lt]\n · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n apply parentD_findAux_lt h\ntermination_by self.rankMax - self.rank x\n\ntheorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) :\n parentD (findAux self x).s i = self.rootD i ∧ self.rootD i = self.rootD x ∨\n parentD (findAux self x).s i = self.parent i := by\n if h' : self.arr[x.1].parent = x then\n rw [findAux_s, if_pos h']; exact .inr rfl\n else\n rw [parentD_findAux]\n split\n · simp [*]\n · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n refine (parentD_findAux_or self ⟨_, self.parent'_lt _ x.2⟩ i)\n |>.imp_left (.imp_right fun h => ?_)\n simp only [h, ← parentD_eq, rootD_parent]\ntermination_by self.rankMax - self.rank x\n\ntheorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} :\n parentD (findAux self x).s i ≠ i →\n self.rank i < self.rank (parentD (findAux self x).s i) := by\n if h' : self.arr[x.1].parent = x then\n rw [findAux_s, if_pos h']; apply self.rank_lt\n else\n rw [parentD_findAux]; split <;> rename_i h <;> intro h'\n · subst i; rwa [lt_rank_root, Ne, ← rootD_eq_self]\n · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ _ ‹_›)\n apply lt_rankD_findAux h'\ntermination_by self.rankMax - self.rank x\n\n/-- Find root of a union-find node, updating the structure using path compression. -/\ndef find (self : UnionFind) (x : Fin self.size) :\n (s : UnionFind) × {_root : Fin s.size // s.size = self.size} :=\n let r := self.findAux x\n { 1.arr := r.s\n 2.1.val := r.root\n 1.parentD_lt := fun h => by\n simp only [FindAux.size_eq] at *\n exact parentD_findAux_lt h\n 1.rankD_lt := fun h => by rw [rankD_findAux, rankD_findAux]; exact lt_rankD_findAux h\n 2.1.isLt := show _ < r.s.size by rw [r.size_eq]; exact r.root.2\n 2.2 := by simp [size, r.size_eq] }\n\n@[inherit_doc find]\ndef findN (self : UnionFind) (x : Fin n) (h : n = self.size) : UnionFind × Fin n :=\n match n, h with | _, rfl => match self.find x with | ⟨s, r, h⟩ => (s, Fin.cast h r)\n\n/-- Find root of a union-find node, updating the structure using path compression.\n Panics if index is out of bounds. -/\ndef find! (self : UnionFind) (x : Nat) : UnionFind × Nat :=\n if h : x < self.size then\n match self.find ⟨x, h⟩ with | ⟨s, r, _⟩ => (s, r)\n else\n panicWith (self, x) \"index out of bounds\"\n\n/-- Find root of a union-find node, updating the structure using path compression.\n Returns inputs unchanged when index is out of bounds. -/\ndef findD (self : UnionFind) (x : Nat) : UnionFind × Nat :=\n if h : x < self.size then\n match self.find ⟨x, h⟩ with | ⟨s, r, _⟩ => (s, r)\n else\n (self, x)\n\n@[simp] theorem find_size (self : UnionFind) (x : Fin self.size) :\n (self.find x).1.size = self.size := by simp [find, size, FindAux.size_eq]\n\n@[simp] theorem find_root_2 (self : UnionFind) (x : Fin self.size) :\n (self.find x).2.1.1 = self.rootD x := by simp [find, findAux_root, rootD]\n\n@[simp] theorem find_parent_1 (self : UnionFind) (x : Fin self.size) :\n (self.find x).1.parent x = self.rootD x := by\n simp only [parent, find]\n rw [parentD_findAux, if_pos rfl]\n\ntheorem find_parent_or (self : UnionFind) (x : Fin self.size) (i) :\n (self.find x).1.parent i = self.rootD i ∧ self.rootD i = self.rootD x ∨\n (self.find x).1.parent i = self.parent i := parentD_findAux_or ..\n\n@[simp] theorem find_root_1 (self : UnionFind) (x : Fin self.size) (i : Nat) :\n (self.find x).1.rootD i = self.rootD i := by\n if h : (self.find x).1.parent i = i then\n rw [rootD_eq_self.2 h]\n obtain ⟨h1, _⟩ | h1 := find_parent_or self x i <;> rw [h1] at h\n · rw [h]\n · rw [rootD_eq_self.2 h]\n else\n have := Nat.sub_lt_sub_left ((self.find x).1.lt_rankMax _) ((self.find x).1.rank_lt h)\n rw [← rootD_parent, find_root_1 self x ((self.find x).1.parent i)]\n obtain ⟨h1, _⟩ | h1 := find_parent_or self x i\n · rw [h1, rootD_rootD]\n · rw [h1, rootD_parent]\ntermination_by (self.find x).1.rankMax - (self.find x).1.rank i\ndecreasing_by exact this -- why is this needed? It is way slower without it\n\n/-- Link two union-find nodes -/\ndef linkAux (self : Array UFNode) (x y : Fin self.size) : Array UFNode :=\n if x.1 = y then\n self\n else\n let nx := self[x.1]\n let ny := self[y.1]\n if ny.rank < nx.rank then\n self.set y {ny with parent := x}\n else\n let arr₁ := self.set x {nx with parent := y}\n if nx.rank = ny.rank then\n arr₁.set y {ny with rank := ny.rank + 1} (by simp [arr₁])\n else\n arr₁\n\ntheorem setParentBump_rankD_lt {arr : Array UFNode} {x y : Fin arr.size}\n (hroot : arr[x.1].rank < arr[y.1].rank ∨ arr[y.1].parent = y)\n (H : arr[x.1].rank ≤ arr[y.1].rank) {i : Nat}\n (rankD_lt : parentD arr i ≠ i → rankD arr i < rankD arr (parentD arr i))\n (hP : parentD arr' i = if x.1 = i then y.1 else parentD arr i)\n (hR : ∀ {i}, rankD arr' i =\n if y.1 = i ∧ arr[x.1].rank = arr[y.1].rank then\n arr[y.1].rank + 1\n else rankD arr i) :\n ¬parentD arr' i = i → rankD arr' i < rankD arr' (parentD arr' i) := by\n simp only [ne_eq, hP, hR, implies_true] at *; split <;> rename_i h₁ <;> [simp [← h₁]; skip] <;>\n split <;> rename_i h₂ <;> intro h\n · simp [h₂] at h\n · simp only [rankD_eq, x.2, y.2]\n split <;> rename_i h₃\n · rw [← h₃]; apply Nat.lt_succ_self\n · exact Nat.lt_of_le_of_ne H h₃\n · cases h₂.1\n simp only [h₂.2, false_or, Nat.lt_irrefl] at hroot\n simp only [hroot, parentD_eq y.2, not_true_eq_false] at h\n · have := rankD_lt h\n split <;> rename_i h₃\n · rw [← rankD_eq, h₃.1]; exact Nat.lt_succ_of_lt this\n · exact this\n\ntheorem setParent_rankD_lt {arr : Array UFNode} {x y : Fin arr.size}\n (h : arr[x.1].rank < arr[y.1].rank) {i : Nat}\n (rankD_lt : parentD arr i ≠ i → rankD arr i < rankD arr (parentD arr i)) :\n let arr' := arr.set x ⟨y, arr[x].rank⟩\n parentD arr' i ≠ i → rankD arr' i < rankD arr' (parentD arr' i) :=\n setParentBump_rankD_lt (.inl h) (Nat.le_of_lt h) rankD_lt parentD_set\n (by simp [rankD_set, Nat.ne_of_lt h, rankD_eq])\n\n@[simp] theorem linkAux_size : (linkAux self x y).size = self.size := by\n simp only [linkAux]\n split <;> [rfl; split] <;> [skip; split] <;> simp\n\n/-- Link a union-find node to a root node. -/\ndef link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : UnionFind where\n arr := linkAux self.arr x y\n parentD_lt h := by\n simp only [linkAux_size] at *\n simp only [linkAux]\n split <;> [skip; split <;> [skip; split]]\n · exact self.parentD_lt h\n · rw [parentD_set]; split <;> [exact x.2; exact self.parentD_lt h]\n · rw [parentD_set]; split\n · exact self.parent'_lt ..\n · rw [parentD_set]; split <;> [exact y.2; exact self.parentD_lt h]\n · rw [parentD_set]; split <;> [exact y.2; exact self.parentD_lt h]\n rankD_lt := by\n rw [parent, parentD_eq (Fin.is_lt _)] at yroot\n simp only [linkAux, ne_eq]\n split <;> [skip; split <;> [skip; split]]\n · exact self.rankD_lt\n · exact setParent_rankD_lt ‹_› self.rankD_lt\n · refine setParentBump_rankD_lt (.inr yroot) (Nat.le_of_eq ‹_›) self.rankD_lt (by\n simp only [parentD_set, ite_eq_right_iff]\n rintro rfl\n simp [*, parentD_eq]) fun {i} => ?_\n simp only [rankD_set]\n split\n · simp_all\n · simp_all only [Nat.lt_irrefl, not_false_eq_true,\n and_true, ite_false, ite_eq_right_iff]\n rintro rfl\n simp [rankD_eq, *]\n · exact setParent_rankD_lt (Nat.lt_of_le_of_ne (Nat.not_lt.1 ‹_›) ‹_›) self.rankD_lt\n\n@[inherit_doc link]\ndef linkN (self : UnionFind) (x y : Fin n) (yroot : self.parent y = y) (h : n = self.size) :\n UnionFind := match n, h with | _, rfl => self.link x y yroot\n\n/-- Link a union-find node to a root node. Panics if either index is out of bounds. -/\ndef link! (self : UnionFind) (x y : Nat) (yroot : self.parent y = y) : UnionFind :=\n if h : x < self.size ∧ y < self.size then\n self.link ⟨x, h.1⟩ ⟨y, h.2⟩ yroot\n else\n panicWith self \"index out of bounds\"\n\n/-- Link two union-find nodes, uniting their respective classes. -/\ndef union (self : UnionFind) (x y : Fin self.size) : UnionFind :=\n let ⟨self₁, rx, ex⟩ := self.find x\n have hy := by rw [ex]; exact y.2\n match eq : self₁.find ⟨y, hy⟩ with\n | ⟨self₂, ry, ey⟩ =>\n self₂.link ⟨rx, by rw [ey]; exact rx.2⟩ ry <| by\n have := find_root_1 self₁ ⟨y, hy⟩ (⟨y, hy⟩ : Fin _)\n rw [← find_root_2, eq] at this; simp at this\n rw [← this, parent_rootD]\n\n@[inherit_doc union]\ndef unionN (self : UnionFind) (x y : Fin n) (h : n = self.size) : UnionFind :=\n match n, h with | _, rfl => self.union x y\n\n/-- Link two union-find nodes, uniting their respective classes.\nPanics if either index is out of bounds. -/\ndef union! (self : UnionFind) (x y : Nat) : UnionFind :=\n if h : x < self.size ∧ y < self.size then\n self.union ⟨x, h.1⟩ ⟨y, h.2⟩\n else\n panicWith self \"index out of bounds\"\n\n/-- Check whether two union-find nodes are equivalent, updating structure using path compression. -/\ndef checkEquiv (self : UnionFind) (x y : Fin self.size) : UnionFind × Bool :=\n let ⟨s, ⟨r₁, _⟩, h⟩ := self.find x\n let ⟨s, ⟨r₂, _⟩, _⟩ := s.find (h ▸ y)\n (s, r₁ == r₂)\n\n@[inherit_doc checkEquiv]\ndef checkEquivN (self : UnionFind) (x y : Fin n) (h : n = self.size) : UnionFind × Bool :=\n match n, h with | _, rfl => self.checkEquiv x y\n\n/-- Check whether two union-find nodes are equivalent, updating structure using path compression.\nPanics if either index is out of bounds. -/\ndef checkEquiv! (self : UnionFind) (x y : Nat) : UnionFind × Bool :=\n if h : x < self.size ∧ y < self.size then\n self.checkEquiv ⟨x, h.1⟩ ⟨y, h.2⟩\n else\n panicWith (self, false) \"index out of bounds\"\n\n/-- Check whether two union-find nodes are equivalent with path compression,\nreturns `x == y` if either index is out of bounds -/\ndef checkEquivD (self : UnionFind) (x y : Nat) : UnionFind × Bool :=\n let (s, x) := self.findD x\n let (s, y) := s.findD y\n (s, x == y)\n\n/-- Equivalence relation from a `UnionFind` structure -/\ndef Equiv (self : UnionFind) (a b : Nat) : Prop := self.rootD a = self.rootD b\n" }, { "path": "Batteries/Data/UnionFind/Lemmas.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Data.UnionFind.Basic\n\n@[expose] public section\n\nnamespace Batteries.UnionFind\n\n@[simp] theorem arr_empty : empty.arr = #[] := rfl\n@[simp] theorem parent_empty : empty.parent a = a := rfl\n@[simp] theorem rank_empty : empty.rank a = 0 := rfl\n@[simp] theorem rootD_empty : empty.rootD a = a := rfl\n\n@[simp] theorem arr_push {m : UnionFind} : m.push.arr = m.arr.push ⟨m.arr.size, 0⟩ := rfl\n\n@[simp] theorem parentD_push {arr : Array UFNode} :\n parentD (arr.push ⟨arr.size, 0⟩) a = parentD arr a := by\n simp [parentD]; split <;> split <;> try simp [Array.getElem_push, *]\n · next h1 h2 =>\n simp [Nat.lt_succ_iff] at h1 h2\n exact Nat.le_antisymm h2 h1\n · next h1 h2 => cases h1 (Nat.lt_succ_of_lt h2)\n\n@[simp] theorem parent_push {m : UnionFind} : m.push.parent a = m.parent a := by simp [parent]\n\n@[simp] theorem rankD_push {arr : Array UFNode} :\n rankD (arr.push ⟨arr.size, 0⟩) a = rankD arr a := by\n simp [rankD]; split <;> split <;> try simp [Array.getElem_push, *]\n next h1 h2 => cases h1 (Nat.lt_succ_of_lt h2)\n\n@[simp] theorem rank_push {m : UnionFind} : m.push.rank a = m.rank a := by simp [rank]\n\n@[simp] theorem rankMax_push {m : UnionFind} : m.push.rankMax = m.rankMax := by simp [rankMax]\n\n@[simp] theorem root_push {self : UnionFind} : self.push.rootD x = self.rootD x :=\n rootD_ext fun _ => parent_push\n\n@[simp] theorem arr_link : (link self x y yroot).arr = linkAux self.arr x y := rfl\n\ntheorem parentD_linkAux {self} {x y : Fin self.size} :\n parentD (linkAux self x y) i =\n if x.1 = y then\n parentD self i\n else\n if self[y.1].rank < self[x.1].rank then\n if y = i then x else parentD self i\n else\n if x = i then y else parentD self i := by\n dsimp only [linkAux]; split <;> [rfl; split] <;> [rw [parentD_set]; split] <;> rw [parentD_set]\n split <;> [(subst i; rwa [if_neg, parentD_eq]); rw [parentD_set]]\n\ntheorem parent_link {self} {x y : Fin self.size} (yroot) {i} :\n (link self x y yroot).parent i =\n if x.1 = y then\n self.parent i\n else\n if self.rank y < self.rank x then\n if y = i then x else self.parent i\n else\n if x = i then y else self.parent i := by\n simp [rankD_eq]; exact parentD_linkAux\n\ntheorem root_link {self : UnionFind} {x y : Fin self.size}\n (xroot : self.parent x = x) (yroot : self.parent y = y) :\n ∃ r, (r = x ∨ r = y) ∧ ∀ i,\n (link self x y yroot).rootD i =\n if self.rootD i = x ∨ self.rootD i = y then r.1 else self.rootD i := by\n if h : x.1 = y then\n refine ⟨x, .inl rfl, fun i => ?_⟩\n rw [rootD_ext (m2 := self) (fun _ => by rw [parent_link, if_pos h])]\n split <;> [obtain _ | _ := ‹_› <;> simp [*]; rfl]\n else\n have {x y : Fin self.size}\n (xroot : self.parent x = x) (yroot : self.parent y = y) {m : UnionFind}\n (hm : ∀ i, m.parent i = if y = i then x.1 else self.parent i) :\n ∃ r, (r = x ∨ r = y) ∧ ∀ i,\n m.rootD i = if self.rootD i = x ∨ self.rootD i = y then r.1 else self.rootD i := by\n let rec go (i) :\n m.rootD i = if self.rootD i = x ∨ self.rootD i = y then x.1 else self.rootD i := by\n if h : m.parent i = i then\n rw [rootD_eq_self.2 h]; rw [hm i] at h; split at h\n · rw [if_pos, h]; simp [← h, rootD_eq_self, xroot]\n · rw [rootD_eq_self.2 ‹_›]; split <;> [skip; rfl]\n next h' => exact h'.resolve_right (Ne.symm ‹_›)\n else\n have _ := Nat.sub_lt_sub_left (m.lt_rankMax i) (m.rank_lt h)\n rw [← rootD_parent, go (m.parent i)]\n rw [hm i]; split <;> [subst i; rw [rootD_parent]]\n simp [rootD_eq_self.2 xroot, rootD_eq_self.2 yroot]\n termination_by m.rankMax - m.rank i\n exact ⟨x, .inl rfl, go⟩\n if hr : self.rank y < self.rank x then\n exact this xroot yroot fun i => by simp [parent_link, h, hr]\n else\n simpa (config := {singlePass := true}) [or_comm] using\n this yroot xroot fun i => by simp [parent_link, h, hr]\n\nnonrec theorem Equiv.rfl : Equiv self a a := rfl\nnonrec theorem Equiv.symm : Equiv self a b → Equiv self b a := .symm\nnonrec theorem Equiv.trans : Equiv self a b → Equiv self b c → Equiv self a c := .trans\n\n@[simp] theorem equiv_empty : Equiv empty a b ↔ a = b := by simp [Equiv]\n\n@[simp] theorem equiv_push : Equiv self.push a b ↔ Equiv self a b := by simp [Equiv]\n\n@[simp] theorem equiv_rootD : Equiv self (self.rootD a) a := by simp [Equiv, rootD_rootD]\n@[simp] theorem equiv_rootD_l : Equiv self (self.rootD a) b ↔ Equiv self a b := by\n simp [Equiv, rootD_rootD]\n@[simp] theorem equiv_rootD_r : Equiv self a (self.rootD b) ↔ Equiv self a b := by\n simp [Equiv, rootD_rootD]\n\ntheorem equiv_find : Equiv (self.find x).1 a b ↔ Equiv self a b := by simp [Equiv, find_root_1]\n\ntheorem equiv_link {self : UnionFind} {x y : Fin self.size}\n (xroot : self.parent x = x) (yroot : self.parent y = y) :\n Equiv (link self x y yroot) a b ↔\n Equiv self a b ∨ Equiv self a x ∧ Equiv self y b ∨ Equiv self a y ∧ Equiv self x b := by\n have {m : UnionFind} {x y : Fin self.size}\n (xroot : self.rootD x = x) (yroot : self.rootD y = y)\n (hm : ∀ i, m.rootD i = if self.rootD i = x ∨ self.rootD i = y then x.1 else self.rootD i) :\n Equiv m a b ↔\n Equiv self a b ∨ Equiv self a x ∧ Equiv self y b ∨ Equiv self a y ∧ Equiv self x b := by\n simp [Equiv, hm, xroot, yroot]\n by_cases h1 : rootD self a = x <;> by_cases h2 : rootD self b = x <;>\n simp [h1, h2, imp_false, Decidable.not_not, -left_eq_ite_iff]\n · simp [Ne.symm h2, -left_eq_ite_iff]; split <;> simp [@eq_comm _ _ (rootD self b), *]\n · by_cases h1 : rootD self a = y <;> by_cases h2 : rootD self b = y <;>\n simp [@eq_comm _ _ (rootD self b), *]\n obtain ⟨r, ha, hr⟩ := root_link xroot yroot; revert hr\n rw [← rootD_eq_self] at xroot yroot\n obtain rfl | rfl := ha\n · exact this xroot yroot\n · simpa [or_comm, and_comm] using this yroot xroot\n\ntheorem equiv_union {self : UnionFind} {x y : Fin self.size} :\n Equiv (union self x y) a b ↔\n Equiv self a b ∨ Equiv self a x ∧ Equiv self y b ∨ Equiv self a y ∧ Equiv self x b := by\n simp [union]; rw [equiv_link (by simp [← rootD_eq_self, rootD_rootD])]; simp [equiv_find]\n" }, { "path": "Batteries/Data/UnionFind.lean", "content": "module\n\npublic import Batteries.Data.UnionFind.Basic\npublic import Batteries.Data.UnionFind.Lemmas\n" }, { "path": "Batteries/Data/Vector/Basic.lean", "content": "/-\nCopyright (c) 2024 Shreyas Srinivas. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Shreyas Srinivas, François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\n/-!\n# Vectors\n\n`Vector α n` is a thin wrapper around `Array α` for arrays of fixed size `n`.\n-/\n\nnamespace Vector\n\n/--\nReturns `true` when all elements of the vector are pairwise distinct using `==` for comparison.\n-/\n@[inline] def allDiff [BEq α] (as : Vector α n) : Bool :=\n as.toArray.allDiff\n" }, { "path": "Batteries/Data/Vector/Lemmas.lean", "content": "/-\nCopyright (c) 2024 Shreyas Srinivas. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Shreyas Srinivas, François G. Dorais, Eric Wieser\n-/\nmodule\n\n@[expose] public section\n\nnamespace Vector\n\ntheorem toArray_injective : ∀ {v w : Vector α n}, v.toArray = w.toArray → v = w\n | {..}, {..}, rfl => rfl\n\n\n/-! ### mk lemmas -/\n\n@[simp] theorem get_mk (a : Array α) (h : a.size = n) (i) :\n (Vector.mk a h).get i = a[i] := rfl\n\n@[simp] theorem getD_mk (a : Array α) (h : a.size = n) (i x) :\n (Vector.mk a h).getD i x = a.getD i x := rfl\n\n@[simp] theorem uget_mk (a : Array α) (h : a.size = n) (i) (hi : i.toNat < n) :\n (Vector.mk a h).uget i hi = a.uget i (by simp [h, hi]) := rfl\n\n/-! ### tail lemmas -/\n\ntheorem tail_eq_of_zero {v : Vector α 0} : v.tail = #v[] := Vector.eq_empty\n\ntheorem tail_eq_of_ne_zero [NeZero n] {v : Vector α n} :\n v.tail = v.eraseIdx 0 n.pos_of_neZero := by\n simp only [tail_eq_cast_extract]\n ext\n simp only [getElem_cast, getElem_extract, getElem_eraseIdx, Nat.not_lt_zero, ↓reduceDIte]\n congr 1\n omega\n\n-- This is not a `@[simp]` lemma because the LHS simplifies to `Vector.extract`.\ntheorem toList_tail {v : Vector α n} :\n v.tail.toList = v.toList.tail :=\n match n with\n | 0 => by simp [Vector.eq_empty]\n | _ + 1 => by\n apply List.ext_getElem\n · simp\n · intro i h₁ h₂\n simp only [Nat.add_one_sub_one, tail_eq_cast_extract, getElem_toList, getElem_cast,\n getElem_extract, List.getElem_tail]\n congr 1\n omega\n\n/-! ### getElem lemmas -/\n\ntheorem getElem_tail {v : Vector α n} {i : Nat} (hi : i < n - 1) :\n v.tail[i] = v[i + 1] :=\n match n with\n | _ + 1 =>\n getElem_congr_coll tail_eq_of_ne_zero |>.trans <|\n getElem_eraseIdx (Nat.zero_lt_succ _) hi\n\n/-! ### get lemmas -/\n\ntheorem get_eq_getElem (v : Vector α n) (i : Fin n) : v.get i = v[(i : Nat)] := rfl\n\n@[simp] theorem get_push_last (v : Vector α n) (a : α) :\n (v.push a).get (Fin.last n) = a :=\n getElem_push_last\n\n@[simp] theorem get_push_castSucc (v : Vector α n) (a : α) (i : Fin n) :\n (v.push a).get (Fin.castSucc i) = v.get i :=\n getElem_push_lt _\n\n@[simp] theorem get_map (v : Vector α n) (f : α → β) (i : Fin n) :\n (v.map f).get i = f (v.get i) :=\n getElem_map _ _\n\n@[simp] theorem get_reverse (v : Vector α n) (i : Fin n) :\n v.reverse.get i = v.get (i.rev) :=\n getElem_reverse _ |>.trans <| congrArg v.get <| Fin.ext <| by simp; omega\n\n@[simp] theorem get_replicate (n : Nat) (a : α) (i : Fin n) : (replicate n a).get i = a :=\n getElem_replicate _\n\n@[simp] theorem get_range (n : Nat) (i : Fin n) : (range n).get i = i :=\n getElem_range _\n\n@[simp] theorem get_ofFn (f : Fin n → α) (i : Fin n) : (ofFn f).get i = f i :=\n getElem_ofFn _\n\n@[simp] theorem get_cast (v : Vector α m) (h : m = n) (i : Fin n) :\n (v.cast h).get i = v.get (i.cast h.symm) :=\n getElem_cast _\n\n-- This is not a `@[simp]` lemma because the LHS simplifies to `Vector.extract`.\ntheorem get_tail (v : Vector α (n + 1)) (i : Fin n) :\n v.tail.get i = v.get i.succ := getElem_tail _\n\n/-! ### finIdxOf? lemmas -/\n\n@[simp]\ntheorem finIdxOf?_empty [BEq α] (v : Vector α 0) : v.finIdxOf? a = none := by\n simp [v.eq_empty]\n\n@[simp]\ntheorem finIdxOf?_eq_none_iff [BEq α] [LawfulBEq α] {v : Vector α n} {a : α} :\n v.finIdxOf? a = none ↔ a ∉ v := by\n obtain ⟨xs, rfl⟩ := v\n simp\n\n@[simp]\ntheorem finIdxOf?_eq_some_iff [BEq α] [LawfulBEq α] {v : Vector α n} {a : α} {i : Fin n} :\n v.finIdxOf? a = some i ↔ v.get i = a ∧ ∀ j < i, ¬v.get j = a := by\n obtain ⟨xs, rfl⟩ := v\n simp\n\n@[simp]\ntheorem isSome_finIdxOf? [BEq α] [PartialEquivBEq α] {v : Vector α n} {a : α} :\n (v.finIdxOf? a).isSome = v.contains a := by\n obtain ⟨v, rfl⟩ := v\n simp\n\n@[simp]\ntheorem isNone_finIdxOf? [BEq α] [PartialEquivBEq α] {v : Vector α n} {a : α} :\n (v.finIdxOf? a).isNone = !v.contains a := by\n obtain ⟨v, rfl⟩ := v\n simp\n" }, { "path": "Batteries/Data/Vector/Monadic.lean", "content": "/-\nCopyright (c) 2025 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Classes.SatisfiesM\npublic import Batteries.Data.Array.Monadic\n\n@[expose] public section\n\nnamespace Vector\n\ntheorem mapM_mk [Monad m] [LawfulMonad m] [MonadSatisfying m]\n (a : Array α) (h : a.size = n) (f : α → m β) :\n (Vector.mk a h).mapM f =\n (fun ⟨a, h'⟩ => Vector.mk a (h'.trans h)) <$> satisfying (Array.size_mapM f a) := by\n rw [← _root_.map_inj_right Vector.toArray_inj.mp]\n simp only [Functor.map_map, MonadSatisfying.val_eq, toArray_mapM]\n\ntheorem mapIdxM_mk [Monad m] [LawfulMonad m] [MonadSatisfying m]\n (a : Array α) (h : a.size = n) (f : Nat → α → m β) :\n (Vector.mk a h).mapIdxM f =\n (fun ⟨a, h'⟩ => Vector.mk a (h'.trans h)) <$> satisfying (Array.size_mapIdxM a f) := by\n rw [← _root_.map_inj_right Vector.toArray_inj.mp]\n simp only [Functor.map_map, MonadSatisfying.val_eq, toArray_mapIdxM]\n\ntheorem mapFinIdxM_mk [Monad m] [LawfulMonad m] [MonadSatisfying m]\n (a : Array α) (h : a.size = n) (f : (i : Nat) → α → (h : i < n) → m β) :\n (Vector.mk a h).mapFinIdxM f =\n (fun ⟨a, h'⟩ => Vector.mk a (h'.trans h)) <$> satisfying\n (Array.size_mapFinIdxM a (fun i a h' => f i a (h ▸ h'))) := by\n rw [← _root_.map_inj_right Vector.toArray_inj.mp]\n simp only [Functor.map_map, MonadSatisfying.val_eq, toArray_mapFinIdxM]\n" }, { "path": "Batteries/Data/Vector.lean", "content": "module\n\npublic import Batteries.Data.Vector.Basic\npublic import Batteries.Data.Vector.Lemmas\npublic import Batteries.Data.Vector.Monadic\n" }, { "path": "Batteries/Lean/AttributeExtra.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Lean.TagAttribute\npublic import Std.Data.HashMap.Basic\n\n@[expose] public section\n\nopen Lean\n\nnamespace Lean\n\nopen Std\n\n/--\n`TagAttributeExtra` works around a limitation of `TagAttribute`, which is that definitions\nmust be tagged in the same file that declares the definition.\nThis works well for definitions in lean core, but for attributes declared outside the core\nthis is problematic because we may want to tag declarations created before the attribute\nwas defined.\n\nTo resolve this, we allow a one-time exception to the rule that attributes must be applied\nin the same file as the declaration: During the declaration of the attribute itself,\nwe can tag arbitrary other definitions, but once the attribute is declared we must tag things\nin the same file as normal.\n-/\nstructure TagAttributeExtra where\n /-- The environment extension for the attribute. -/\n ext : PersistentEnvExtension Name Name NameSet\n /-- A list of \"base\" declarations which have been pre-tagged. -/\n base : NameHashSet\n deriving Inhabited\n\n/--\nRegisters a new tag attribute. The `extra` field is a list of definitions from other modules\nwhich will be \"pre-tagged\" and are not subject to the usual restriction on tagging in the same\nfile as the declaration.\n\nNote: The `extra` fields bypass the `validate` function -\nwe assume the builtins are also pre-validated.\n-/\ndef registerTagAttributeExtra (name : Name) (descr : String) (extra : List Name)\n (validate : Name → AttrM Unit := fun _ => pure ()) (ref : Name := by exact decl_name%) :\n IO TagAttributeExtra := do\n let { ext, .. } ← registerTagAttribute name descr validate ref\n pure { ext, base := extra.foldl (·.insert ·) {} }\n\nnamespace TagAttributeExtra\n\n/-- Does declaration `decl` have the tag `attr`? -/\ndef hasTag (attr : TagAttributeExtra) (env : Environment) (decl : Name) : Bool :=\n match env.getModuleIdxFor? decl with\n | some modIdx => (attr.ext.getModuleEntries env modIdx).binSearchContains decl Name.quickLt\n | none => (attr.ext.getState env).contains decl\n || attr.base.contains decl\n\n/-- Get the list of declarations tagged with the tag attribute `attr`. -/\ndef getDecls (attr : TagAttributeExtra) (env : Environment) : Array Name := Id.run do\n let decls := TagAttribute.getDecls.core <| attr.ext.toEnvExtension.getState env\n attr.base.fold (·.push ·) decls\n\nend TagAttributeExtra\n\n/--\n`ParametricAttributeExtra` works around a limitation of `ParametricAttribute`, which is that\ndefinitions must be tagged in the same file that declares the definition.\nThis works well for definitions in lean core, but for attributes declared outside the core\nthis is problematic because we may want to tag declarations created before the attribute\nwas defined.\n\nTo resolve this, we allow a one-time exception to the rule that attributes must be applied\nin the same file as the declaration: During the declaration of the attribute itself,\nwe can tag arbitrary other definitions, but once the attribute is declared we must tag things\nin the same file as normal.\n-/\nstructure ParametricAttributeExtra (α : Type) where\n /-- The underlying `ParametricAttribute`. -/\n attr : ParametricAttribute α\n /-- A list of pre-tagged declarations with their values. -/\n base : Std.HashMap Name α\n deriving Inhabited\n\n/--\nRegisters a new parametric attribute. The `extra` field is a list of definitions from other modules\nwhich will be \"pre-tagged\" and are not subject to the usual restriction on tagging in the same\nfile as the declaration.\n-/\ndef registerParametricAttributeExtra (impl : ParametricAttributeImpl α)\n (extra : List (Name × α)) : IO (ParametricAttributeExtra α) := do\n let attr ← registerParametricAttribute impl\n pure { attr, base := extra.foldl (fun s (a, b) => s.insert a b) {} }\n\nnamespace ParametricAttributeExtra\n\n/--\nGets the parameter of attribute `attr` associated to declaration `decl`,\nor `none` if `decl` is not tagged.\n-/\ndef getParam? [Inhabited α] (attr : ParametricAttributeExtra α)\n (env : Environment) (decl : Name) : Option α :=\n attr.attr.getParam? env decl <|> attr.base[decl]?\n\n/-- Applies attribute `attr` to declaration `decl`, given a value for the parameter. -/\ndef setParam (attr : ParametricAttributeExtra α)\n (env : Environment) (decl : Name) (param : α) : Except String Environment :=\n attr.attr.setParam env decl param\n\nend ParametricAttributeExtra\n" }, { "path": "Batteries/Lean/EStateM.lean", "content": "/-\nCopyright (c) 2024 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\nimport all Init.Control.EState\n\n@[expose] public section\n\nnamespace EStateM\n\nopen Backtrackable\n\nnamespace Result\n\n/-- Map a function over an `EStateM.Result`, preserving states and errors. -/\ndef map {ε σ α β} (f : α → β) (x : Result ε σ α) : Result ε σ β :=\n match x with\n | .ok a s' => .ok (f a) s'\n | .error e s' => .error e s'\n\n@[simp] theorem map_ok {ε σ α β} (f : α → β) (a : α) (s : σ) :\n (Result.ok a s : Result ε σ α).map f = .ok (f a) s := rfl\n\n@[simp] theorem map_error {ε σ α β} (f : α → β) (e : ε) (s : σ) :\n (Result.error e s : Result ε σ α).map f = .error e s := rfl\n\n@[simp] theorem map_eq_ok {ε σ α β} {f : α → β} {x : Result ε σ α} {b : β} {s : σ} :\n x.map f = .ok b s ↔ ∃ a, x = .ok a s ∧ b = f a := by\n cases x <;> simp [and_assoc, and_comm, eq_comm]\n\n@[simp] theorem map_eq_error {ε σ α β} (f : α → β) {x : Result ε σ α} {e : ε} {s : σ} :\n x.map f = .error e s ↔ x = .error e s := by\n cases x <;> simp [eq_comm]\n\nend Result\n\n@[simp] theorem dummySave_apply (s : σ) : EStateM.dummySave s = PUnit.unit := rfl\n\n@[simp] theorem dummyRestore_apply (s : σ) : EStateM.dummyRestore s = Function.const _ s := rfl\n\n@[simp] theorem run'_pure (x : α) (s : σ) :\n (pure x : EStateM ε σ α).run' s = some x := rfl\n\n@[simp] theorem run'_bind (x : EStateM ε σ α) (f : α → EStateM ε σ β) (s : σ) :\n (x >>= f).run' s = match x.run s with\n | .ok a s => (f a).run' s\n | .error _ _ => none := by\n rw [run', run_bind]\n cases x.run s <;> rfl\n\n@[simp] theorem run_map (f : α → β) (x : EStateM ε σ α) (s : σ) :\n (f <$> x).run s = (x.run s).map f := rfl\n\n@[simp] theorem run'_map (f : α → β) (x : EStateM ε σ α) (s : σ) :\n (f <$> x).run' s = Option.map f (x.run' s) := by\n rw [run', run', run_map]\n cases x.run s <;> rfl\n\ntheorem run_seq (f : EStateM ε σ (α → β)) (x : EStateM ε σ α) (s : σ) :\n (f <*> x).run s = match f.run s with\n | .ok g s => Result.map g (x.run s)\n | .error e s => .error e s := by\n simp only [seq_eq_bind_map, run_bind, run_map]\n cases f.run s <;> rfl\n\ntheorem run'_seq (f : EStateM ε σ (α → β)) (x : EStateM ε σ α) (s : σ) :\n (f <*> x).run' s = match f.run s with\n | .ok g s => Option.map g (x.run' s)\n | .error _ _ => none := by\n simp only [seq_eq_bind_map, run'_bind, run'_map]\n cases f.run s <;> rfl\n\n@[simp] theorem run_seqLeft (x : EStateM ε σ α) (y : EStateM ε σ β) (s : σ) :\n (x <* y).run s = match x.run s with\n | .ok v s => Result.map (fun _ => v) (y.run s)\n | .error e s => .error e s := by\n simp [seqLeft_eq_bind]\n rfl\n\n@[simp] theorem run'_seqLeft (x : EStateM ε σ α) (y : EStateM ε σ β) (s : σ) :\n (x <* y).run' s = match x.run s with\n | .ok v s => Option.map (fun _ => v) (y.run' s)\n | .error _ _ => none := by\n simp [seqLeft_eq_bind]\n\n@[simp] theorem run_seqRight (x : EStateM ε σ α) (y : EStateM ε σ β) (s : σ) :\n (x *> y).run s = match x.run s with\n | .ok _ s => y.run s\n | .error e s => .error e s := rfl\n\n@[simp] theorem run'_seqRight (x : EStateM ε σ α) (y : EStateM ε σ β) (s : σ) :\n (x *> y).run' s = match x.run s with\n | .ok _ s => y.run' s\n | .error _ _ => none := by\n rw [run', run_seqRight]\n cases x.run s <;> rfl\n\n@[simp] theorem run'_get (s : σ) :\n (get : EStateM ε σ σ).run' s = some s := rfl\n\n@[simp] theorem run'_set (v s : σ) :\n (set v : EStateM ε σ PUnit).run' s = some PUnit.unit := rfl\n\n@[simp] theorem run'_modify (f : σ → σ) (s : σ) :\n (modify f : EStateM ε σ PUnit).run' s = some PUnit.unit := rfl\n\n@[simp] theorem run'_modifyGet (f : σ → α × σ) (s : σ) :\n (modifyGet f : EStateM ε σ α).run' s = some (f s).1 := rfl\n\n@[simp] theorem run_getModify (f : σ → σ) :\n (getModify f : EStateM ε σ σ).run s = Result.ok s (f s) := rfl\n\n@[simp] theorem run'_getModify (f : σ → σ) (s : σ) :\n (getModify f : EStateM ε σ σ).run' s = some s := rfl\n\n@[simp] theorem run'_throw (e : ε) (s : σ) :\n (throw e : EStateM ε σ α).run' s = none := rfl\n\n@[simp] theorem run_orElse {δ} [h : Backtrackable δ σ] (x₁ x₂ : EStateM ε σ α) (s : σ) :\n (x₁ <|> x₂).run s = match x₁.run s with\n | .ok x s => .ok x s\n | .error _ s' => x₂.run (restore s' (save s)) := by\n show (EStateM.orElse _ _).run _ = _\n unfold EStateM.orElse\n simp only [EStateM.run]\n match x₁ s with | .ok _ _ => rfl | .error _ _ => simp\n\n@[simp] theorem run'_orElse {δ} [h : Backtrackable δ σ] (x₁ x₂ : EStateM ε σ α) (s : σ) :\n (x₁ <|> x₂).run' s = match x₁.run s with\n | .ok x _ => some x\n | .error _ s' => x₂.run' (restore s' (save s)) := by\n rw [run', run_orElse]\n cases x₁.run s <;> rfl\n\n@[simp] theorem run_tryCatch {δ} [h : Backtrackable δ σ]\n (body : EStateM ε σ α) (handler : ε → EStateM ε σ α) (s : σ) :\n (tryCatch body handler).run s = match body.run s with\n | .ok x s => .ok x s\n | .error e s' => (handler e).run (restore s' (save s)) := by\n show (EStateM.tryCatch _ _).run _ = _\n unfold EStateM.tryCatch\n simp only [EStateM.run]\n cases body s <;> rfl\n\n@[simp] theorem run'_tryCatch {δ} [h : Backtrackable δ σ]\n (body : EStateM ε σ α) (handler : ε → EStateM ε σ α) (s : σ) :\n (tryCatch body handler).run' s = match body.run s with\n | .ok x _ => some x\n | .error e s' => (handler e).run' (restore s' (save s)) := by\n rw [run', run_tryCatch]\n cases body.run s <;> rfl\n\n@[simp] theorem run'_adaptExcept (f : ε → ε) (x : EStateM ε σ α) (s : σ) :\n (adaptExcept f x).run' s = x.run' s := by\n rw [run', run', run_adaptExcept]\n cases x.run s <;> rfl\n\n@[simp] theorem run_tryFinally' (x : EStateM ε σ α)\n (h : Option α → EStateM ε σ β) (s : σ) : (tryFinally' x h).run s = match x.run s with\n | .ok a s => match (h (some a)).run s with\n | .ok b s => Result.ok (a, b) s\n | .error e s => Result.error e s\n | .error e₁ s => match (h none).run s with\n | .ok _ s => Result.error e₁ s\n | .error e₂ s => Result.error e₂ s := rfl\n\n@[simp] theorem run'_tryFinally' (x : EStateM ε σ α)\n (h : Option α → EStateM ε σ β) (s : σ) :\n (tryFinally' x h).run' s = match x.run s with\n | .ok a s => Option.map (a, ·) ((h (some a)).run' s)\n | .error _ _ => none := by\n simp [run', run_tryFinally']\n match x.run s with\n | .ok a s => simp only; cases (h (some a)).run s <;> rfl\n | .error e s => simp only; cases (h none).run s <;> rfl\n\n@[simp] theorem run_fromStateM (x : StateM σ α) (s : σ) :\n (fromStateM x : EStateM ε σ α).run s =\n Result.ok (x.run s).1 (x.run s).2 := (rfl)\n\n@[simp] theorem run'_fromStateM (x : StateM σ α) (s : σ) :\n (fromStateM x : EStateM ε σ α).run' s = some (x.run' s) := (rfl)\n\n@[ext] theorem ext {ε σ α} {x y : EStateM ε σ α} (h : ∀ s, x.run s = y.run s) : x = y := by\n funext s\n exact h s\n\nend EStateM\n" }, { "path": "Batteries/Lean/Except.lean", "content": "/-\nCopyright (c) 2023 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Lean.Util.Trace\n\n@[expose] public section\n\nopen Lean\n\nderiving instance DecidableEq for Except\n\nnamespace Except\n\n/-- Visualize an `Except` using a checkmark or a cross. -/\ndef emoji : Except ε α → String\n | .error _ => crossEmoji\n | .ok _ => checkEmoji\n\n@[simp] theorem map_error {ε : Type u} (f : α → β) (e : ε) :\n f <$> (.error e : Except ε α) = .error e := rfl\n\n@[simp] theorem map_ok {ε : Type u} (f : α → β) (x : α) :\n f <$> (.ok x : Except ε α) = .ok (f x) := rfl\n\n/-- Map a function over an `Except` value, using a proof that the value is `.ok`. -/\ndef pmap {ε : Type u} {α β : Type v} (x : Except ε α) (f : (a : α) → x = .ok a → β) : Except ε β :=\n match x with\n | .error e => .error e\n | .ok a => .ok (f a rfl)\n\n@[simp] theorem pmap_error {ε : Type u} {α β : Type v} (e : ε)\n (f : (a : α) → Except.error e = Except.ok a → β) :\n Except.pmap (.error e) f = .error e := rfl\n\n@[simp] theorem pmap_ok {ε : Type u} {α β : Type v} (a : α)\n (f : (a' : α) → (.ok a : Except ε α) = .ok a' → β) :\n Except.pmap (.ok a) f = .ok (f a rfl) := rfl\n\n@[simp] theorem pmap_id {ε : Type u} {α : Type v} (x : Except ε α) :\n x.pmap (fun a _ => a) = x := by cases x <;> simp\n\n@[simp] theorem map_pmap (g : β → γ) (x : Except ε α) (f : (a : α) → x = .ok a → β) :\n g <$> x.pmap f = x.pmap fun a h => g (f a h) := by\n cases x <;> simp\n\nend Except\n\nnamespace ExceptT\n\n-- This will be redundant after nightly-2024-11-08.\nattribute [ext] ExceptT.ext\n\n@[simp] theorem mk_run (x : ExceptT ε m α) : ExceptT.mk (ExceptT.run x) = x := rfl\n\n@[simp]\ntheorem map_mk [Monad m] [LawfulMonad m] (f : α → β) (x : m (Except ε α)) :\n f <$> ExceptT.mk x = ExceptT.mk ((f <$> · ) <$> x) := by\n simp only [Functor.map, Except.map, ExceptT.map, map_eq_pure_bind]\n congr\n funext a\n split <;> simp\n\nend ExceptT\n" }, { "path": "Batteries/Lean/Expr.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Lean.Elab.Term\npublic import Lean.Elab.Binders\n\n@[expose] public section\n\n/-!\n# Additional operations on Expr and related types\n\nThis file defines basic operations on the types expr, name, declaration, level, environment.\n\nThis file is mostly for non-tactics.\n-/\n\nnamespace Lean.Expr\n\nopen Lean.Elab.Term in\n/-- Converts an `Expr` into a `Syntax`, by creating a fresh metavariable\nassigned to the expr and returning a named metavariable syntax `?a`. -/\ndef toSyntax (e : Expr) : TermElabM Syntax.Term := withFreshMacroScope do\n let stx ← `(?a)\n let mvar ← elabTermEnsuringType stx (← Meta.inferType e)\n mvar.mvarId!.assign e\n pure stx\n\n/-- Like `withApp` but ignores metadata. -/\n@[inline]\ndef withApp' (e : Expr) (k : Expr → Array Expr → α) : α :=\n let dummy := mkSort .zero\n let nargs := e.getAppNumArgs'\n go e (.replicate nargs dummy) (nargs - 1)\nwhere\n /-- Auxiliary definition for `withApp'`. -/\n @[specialize]\n go : Expr → Array Expr → Nat → α\n | mdata _ b, as, i => go b as i\n | app f a , as, i => go f (as.set! i a) (i-1)\n | f , as, _ => k f as\n\n/-- Like `getAppArgs` but ignores metadata. -/\n@[inline]\ndef getAppArgs' (e : Expr) : Array Expr :=\n e.withApp' λ _ as => as\n\n/-- Like `traverseApp` but ignores metadata. -/\ndef traverseApp' {m} [Monad m]\n (f : Expr → m Expr) (e : Expr) : m Expr :=\n e.withApp' λ fn args => return mkAppN (← f fn) (← args.mapM f)\n\n/-- Like `withAppRev` but ignores metadata. -/\n@[inline]\ndef withAppRev' (e : Expr) (k : Expr → Array Expr → α) : α :=\n go e (Array.mkEmpty e.getAppNumArgs')\nwhere\n /-- Auxiliary definition for `withAppRev'`. -/\n @[specialize]\n go : Expr → Array Expr → α\n | mdata _ b, as => go b as\n | app f a , as => go f (as.push a)\n | f , as => k f as\n\n/-- Like `getAppRevArgs` but ignores metadata. -/\n@[inline]\ndef getAppRevArgs' (e : Expr) : Array Expr :=\n e.withAppRev' λ _ as => as\n\n/-- Like `getRevArgD` but ignores metadata. -/\ndef getRevArgD' : Expr → Nat → Expr → Expr\n | mdata _ b, n , v => getRevArgD' b n v\n | app _ a , 0 , _ => a\n | app f _ , i+1, v => getRevArgD' f i v\n | _ , _ , v => v\n\n/-- Like `getArgD` but ignores metadata. -/\n@[inline]\ndef getArgD' (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs') : Expr :=\n getRevArgD' e (n - i - 1) v₀\n\n/-- Like `isAppOf` but ignores metadata. -/\ndef isAppOf' (e : Expr) (n : Name) : Bool :=\n match e.getAppFn' with\n | const c .. => c == n\n | _ => false\n\n/-- Turns an expression that is a natural number literal into a natural number. -/\ndef natLit! : Expr → Nat\n | lit (Literal.natVal v) => v\n | _ => panic! \"nat literal expected\"\n\n/-- Turns an expression that is a constructor of `Int` applied to a natural number literal\ninto an integer. -/\ndef intLit! (e : Expr) : Int :=\n if e.isAppOfArity ``Int.ofNat 1 then\n e.appArg!.natLit!\n else if e.isAppOfArity ``Int.negOfNat 1 then\n .negOfNat e.appArg!.natLit!\n else\n panic! \"not a raw integer literal\"\n\n\nopen Lean Elab Term in\n/-- Annotates a `binderIdent` with the binder information from an `fvar`. -/\ndef addLocalVarInfoForBinderIdent (fvar : Expr) (tk : TSyntax ``binderIdent) : MetaM Unit :=\n -- the only TermElabM thing we do in `addLocalVarInfo` is check inPattern,\n -- which we assume is always false for this function\n discard <| TermElabM.run do\n match tk with\n | `(binderIdent| $n:ident) => Elab.Term.addLocalVarInfo n fvar\n | tk => Elab.Term.addLocalVarInfo (Unhygienic.run `(_%$tk)) fvar\n" }, { "path": "Batteries/Lean/Float.lean", "content": "/-\n Copyright (c) 2023 Mario Carneiro. All rights reserved.\n Released under Apache 2.0 license as described in the file LICENSE.\n Authors: Mario Carneiro\n-/\nmodule\n\n@[expose] public section\n\nnamespace Float\n\n/--\nThe floating point value \"positive infinity\", also used to represent numerical computations\nwhich produce finite values outside of the representable range of `Float`.\n-/\ndef inf : Float := 1/0\n\n/--\nThe floating point value \"not a number\", used to represent erroneous numerical computations\nsuch as `0 / 0`. Using `nan` in any float operation will return `nan`, and all comparisons\ninvolving `nan` return `false`, including in particular `nan == nan`.\n-/\ndef nan : Float := 0/0\n\n/-- Returns `v, exp` integers such that `f = v * 2^exp`.\n(`e` is not minimal, but `v.abs` will be at most `2^53 - 1`.)\nReturns `none` when `f` is not finite (i.e. `inf`, `-inf` or a `nan`). -/\ndef toRatParts (f : Float) : Option (Int × Int) :=\n if f.isFinite then\n let (f', exp) := f.frExp\n let x := (2^53:Nat).toFloat * f'\n let v := if x < 0 then\n (-(-x).floor.toUInt64.toNat : Int)\n else\n (x.floor.toUInt64.toNat : Int)\n some (v, exp - 53)\n else none\n\n/-- Returns `v, exp` integers such that `f = v * 2^exp`.\nLike `toRatParts`, but `e` is guaranteed to be minimal (`n` is always odd), unless `n = 0`.\n`n.abs` will be at most `2^53 - 1` because `Float` has 53 bits of precision.\nReturns `none` when `f` is not finite (i.e. `inf`, `-inf` or a `nan`). -/\npartial def toRatParts' (f : Float) : Option (Int × Int) :=\n f.toRatParts.map fun (n, e) =>\n if n == 0 then (0, 0) else\n let neg : Bool := n < 0\n let v := n.natAbs.toUInt64\n let c := trailingZeros v 0\n let v := (v >>> c.toUInt64).toNat\n (if neg then -v else v, e + c.toNat)\nwhere\n /-- Calculates the number of trailing bits in a `UInt64`. Requires `v ≠ 0`. -/\n -- Note: it's a bit dumb to be using a loop here, but it is hopefully written\n -- such that LLVM can tell we are computing trailing bits and do good things to it\n -- TODO: prove termination under suitable assumptions (only relevant if `Float` is not opaque)\n trailingZeros (v : UInt64) (c : UInt8) :=\n if v &&& 1 == 0 then trailingZeros (v >>> 1) (c + 1) else c\n\n/-- Converts `f` to a string, including all decimal digits. -/\ndef toStringFull (f : Float) : String :=\n if let some (v, exp) := toRatParts f then\n let v' := v.natAbs\n let s := if exp ≥ 0 then\n Nat.repr (v' * (2^exp.toNat:Nat))\n else\n let e := (-exp).toNat\n let intPart := v' / 2^e\n let rem := v' % 2^e\n if rem == 0 then\n Nat.repr intPart\n else\n let rem := Nat.repr ((2^e + v' % 2^e) * 5^e)\n let rem := rem.dropEndWhile (· == '0')\n s!\"{intPart}.{rem.drop 1}\"\n if v < 0 then s!\"-{s}\" else s\n else f.toString -- inf, -inf, nan\n\nend Float\n\n/--\nDivide two natural numbers, to produce a correctly rounded (nearest-ties-to-even) `Float` result.\n-/\nprotected def Nat.divFloat (a b : Nat) : Float :=\n if b = 0 then\n if a = 0 then Float.nan else Float.inf\n else\n let ea := a.log2\n let eb := b.log2\n if eb + 1024 < ea then Float.inf else\n let eb' := if b <<< ea ≤ a <<< eb then eb else eb + 1\n let mantissa : UInt64 := (a <<< (eb' + 53) / b <<< ea).toUInt64\n let rounded := if mantissa &&& 3 == 1 && a <<< (eb' + 53) == mantissa.toNat * (b <<< ea) then\n mantissa >>> 1\n else\n (mantissa + 1) >>> 1\n rounded.toFloat.scaleB (ea - (eb' + 52))\n\n/--\nDivide two integers, to produce a correctly rounded (nearest-ties-to-even) `Float` result.\n-/\nprotected def Int.divFloat (a b : Int) : Float :=\n if (a ≥ 0) == (b ≥ 0) then\n a.natAbs.divFloat b.natAbs\n else\n -a.natAbs.divFloat b.natAbs\n" }, { "path": "Batteries/Lean/HashMap.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Std.Data.HashMap.Basic\n\n@[expose] public section\nnamespace Std.HashMap\n\nvariable [BEq α] [Hashable α]\n\n/--\n`O(|other|)` amortized. Merge two `HashMap`s.\nThe values of keys which appear in both maps are combined using the monadic function `f`.\n-/\n@[specialize]\ndef mergeWithM {m α β} [BEq α] [Hashable α] [Monad m] (f : α → β → β → m β)\n (self other : HashMap α β) : m (HashMap α β) :=\n other.foldM (init := self) fun map k v₂ =>\n match map[k]? with\n | none => return map.insert k v₂\n | some v₁ => return map.insert k (← f k v₁ v₂)\n\n/--\n`O(|other|)` amortized. Merge two `HashMap`s.\nThe values of keys which appear in both maps are combined using `f`.\n-/\n@[inline]\ndef mergeWith (f : α → β → β → β) (self other : HashMap α β) : HashMap α β :=\n -- Implementing this function directly, rather than via `mergeWithM`, gives\n -- us less constrained universes.\n other.fold (init := self) fun map k v₂ =>\n match map[k]? with\n | none => map.insert k v₂\n | some v₁ => map.insert k <| f k v₁ v₂\n" }, { "path": "Batteries/Lean/HashSet.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Std.Data.HashSet.Basic\n\n@[expose] public section\n\nnamespace Std.HashSet\n\nvariable [BEq α] [Hashable α]\n\n/--\n`O(n)`. Returns `true` if `f` returns `true` for any element of the set.\n-/\n@[specialize]\ndef anyM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do\n for a in s do\n if ← f a then\n return true\n return false\n\n/--\n`O(n)`. Returns `true` if `f` returns `true` for all elements of the set.\n-/\n@[specialize]\ndef allM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do\n for a in s do\n if !(← f a) then\n return false\n return true\n\ninstance : BEq (HashSet α) where\n beq s t := s.all (t.contains ·) && t.all (s.contains ·)\n" }, { "path": "Batteries/Lean/IO/Process.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\n@[expose] public section\n\n/-!\n# Running external commands.\n-/\n\nnamespace IO.Process\n\nopen System (FilePath)\n\n/--\nPipe `input` into stdin of the spawned process,\nthen return `(exitCode, stdout, stdErr)` upon completion.\n-/\ndef runCmdWithInput' (cmd : String) (args : Array String)\n (input : String := \"\") (throwFailure := true) : IO Output := do\n let child ← spawn\n { cmd := cmd, args := args, stdin := .piped, stdout := .piped, stderr := .piped }\n let (stdin, child) ← child.takeStdin\n stdin.putStr input\n stdin.flush\n let stdout ← IO.asTask child.stdout.readToEnd Task.Priority.dedicated\n let err ← child.stderr.readToEnd\n let exitCode ← child.wait\n if exitCode != 0 && throwFailure then\n throw $ IO.userError err\n else\n let out ← IO.ofExcept stdout.get\n return ⟨exitCode, out, err⟩\n\n/--\nPipe `input` into stdin of the spawned process,\nthen return the entire content of stdout as a `String` upon completion.\n-/\ndef runCmdWithInput (cmd : String) (args : Array String)\n (input : String := \"\") (throwFailure := true) : IO String := do\n return (← runCmdWithInput' cmd args input throwFailure).stdout\n" }, { "path": "Batteries/Lean/Json.lean", "content": "/-\n Copyright (c) 2022 E.W.Ayers. All rights reserved.\n Released under Apache 2.0 license as described in the file LICENSE.\n Authors: E.W.Ayers, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Lean.Float\npublic import Lean.Data.Json.FromToJson.Basic\n\n@[expose] public section\n\nopen Lean\n\ninstance : OfScientific JsonNumber where\n ofScientific mantissa exponentSign decimalExponent :=\n if exponentSign then\n { mantissa := mantissa, exponent := decimalExponent }\n else\n { mantissa := (mantissa * 10 ^ decimalExponent : Nat), exponent := 0 }\n\ninstance : Neg JsonNumber where\n neg jn := ⟨-jn.mantissa, jn.exponent⟩\n\ninstance : ToJson Float where\n toJson x :=\n match x.toRatParts' with\n | none => Json.null\n | some (n, d) =>\n if d < 0 then\n Json.num { mantissa := n * (5^d.natAbs : Nat), exponent := d.natAbs }\n else\n Json.num { mantissa := n * (2^d.natAbs : Nat), exponent := 0 }\n" }, { "path": "Batteries/Lean/LawfulMonad.lean", "content": "/-\nCopyright (c) 2024 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Lean.Elab.Command\nimport all Init.System.ST\n\n@[expose] public section\n\n/-!\n# Construct `LawfulMonad` instances for the Lean monad stack.\n-/\n\nopen Lean Elab Term Tactic Command\n\ninstance : LawfulMonad (ST σ) := .mk' _\n (id_map := fun x => rfl)\n (pure_bind := fun x f => rfl)\n (bind_assoc := fun f g x => rfl)\n\ninstance : LawfulMonad (EST ε σ) := .mk' _\n (id_map := fun x => funext fun v => by dsimp [Functor.map, EST.bind]; cases x v <;> rfl)\n (pure_bind := fun x f => rfl)\n (bind_assoc := fun f g x => funext fun v => by dsimp [Bind.bind, EST.bind]; cases f v <;> rfl)\n\ninstance : LawfulMonad (EIO ε) := inferInstanceAs <| LawfulMonad (EST _ _)\ninstance : LawfulMonad BaseIO := inferInstanceAs <| LawfulMonad (ST _)\ninstance : LawfulMonad IO := inferInstanceAs <| LawfulMonad (EIO _)\n\ninstance : LawfulMonad CoreM :=\n inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ (EIO Exception))\ninstance : LawfulMonad MetaM :=\n inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ CoreM)\ninstance : LawfulMonad TermElabM :=\n inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ MetaM)\ninstance : LawfulMonad TacticM :=\n inferInstanceAs <| LawfulMonad (ReaderT _ $ StateRefT' _ _ $ TermElabM)\ninstance : LawfulMonad CommandElabM :=\n inferInstanceAs <| LawfulMonad (ReaderT _ $ StateRefT' _ _ $ EIO _)\n" }, { "path": "Batteries/Lean/LawfulMonadLift.lean", "content": "/-\nCopyright (c) 2025 Quang Dao. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Quang Dao\n-/\nmodule\n\npublic import Lean.Elab.Command\nimport all Lean.CoreM -- for unfolding `liftIOCore`\nimport all Init.System.IO -- for unfolding `BaseIO.toEIO`\nimport all Init.Control.StateRef -- for unfolding `StateRefT'.lift`\nimport all Init.System.ST\n\n@[expose] public section\n\n/-!\n# Lawful instances of `MonadLift` for the Lean monad stack.\n-/\n\nopen Lean Elab Term Tactic Command\n\ninstance : LawfulMonadLift (ST σ) (EST ε σ) where\n monadLift_pure _ := rfl\n monadLift_bind _ _ := rfl\n\ninstance : LawfulMonadLift BaseIO (EIO ε) :=\n inferInstanceAs <| LawfulMonadLift (ST IO.RealWorld) (EST ε IO.RealWorld)\n\n/-! ### `EIO.adapt` simp lemmas -/\n\n@[simp] theorem EIO.adapt_pure (f : ε₁ → ε₂) (a : α) :\n EIO.adapt f (pure a : EIO ε₁ α) = (pure a : EIO ε₂ α) := by rfl\n\nprivate theorem EIO.bind_eq_EST_bind (ma : EIO ε α) (f : α → EIO ε β) :\n (ma >>= f) = EST.bind ma f := by rfl\n\nprivate theorem EIO.adapt_EST_bind (f : ε₁ → ε₂) (ma : EIO ε₁ α) (g : α → EIO ε₁ β) :\n EIO.adapt f (EST.bind ma g) = EST.bind (EIO.adapt f ma) (fun a => EIO.adapt f (g a)) := by\n funext s; simp only [EIO.adapt, EST.bind]; cases ma s <;> rfl\n\n@[simp] theorem EIO.adapt_bind (f : ε₁ → ε₂) (ma : EIO ε₁ α) (g : α → EIO ε₁ β) :\n EIO.adapt f (ma >>= g) = EIO.adapt f ma >>= fun a => EIO.adapt f (g a) := by\n simp only [EIO.bind_eq_EST_bind, EIO.adapt_EST_bind]\n\n/-! ### `StateRefT'.lift` simp lemmas -/\n\n@[simp] theorem StateRefT'.lift_pure [Monad m] (a : α) :\n (StateRefT'.lift (pure a) : StateRefT' ω σ m α) = pure a := by rfl\n\n@[simp] theorem StateRefT'.lift_bind [Monad m] (ma : m α) (f : α → m β) :\n (StateRefT'.lift (ma >>= f) : StateRefT' ω σ m β) =\n StateRefT'.lift ma >>= fun a => StateRefT'.lift (f a) := by rfl\n\n/-! ### `LawfulMonadLift IO CoreM` -/\n\nprivate theorem Core.run_liftIOCore (x : IO α) (r : Core.Context) :\n ReaderT.run (Core.liftIOCore x) r =\n (StateRefT'.lift\n (EIO.adapt\n (fun err => Exception.error r.ref (MessageData.ofFormat (format (toString err)))) x) :\n StateRefT' IO.RealWorld Core.State (EIO Exception) α) := by rfl\n\ninstance : LawfulMonadLift IO CoreM where\n monadLift_pure a := by\n ext r\n simp [MonadLift.monadLift, Core.run_liftIOCore]\n monadLift_bind ma f := by\n ext r\n simp [MonadLift.monadLift, Core.run_liftIOCore]\n\ninstance : LawfulMonadLiftT (EIO Exception) CommandElabM := inferInstance\ninstance : LawfulMonadLiftT (EIO Exception) CoreM := inferInstance\ninstance : LawfulMonadLiftT CoreM MetaM := inferInstance\ninstance : LawfulMonadLiftT MetaM TermElabM := inferInstance\ninstance : LawfulMonadLiftT TermElabM TacticM := inferInstance\n" }, { "path": "Batteries/Lean/Meta/Basic.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Jannis Limperg\n-/\nmodule\n\npublic import Lean.Meta.Tactic.Intro\npublic import Batteries.Control.AlternativeMonad\nimport Lean.Meta.SynthInstance\n\npublic section\n\nopen Lean Lean.Meta\n\nnamespace Lean\n\n/--\nSort the given `FVarId`s by the order in which they appear in the current local\ncontext. If any of the `FVarId`s do not appear in the current local context, the\nresult is unspecified.\n-/\ndef Meta.sortFVarsByContextOrder [Monad m] [MonadLCtx m]\n (hyps : Array FVarId) : m (Array FVarId) :=\n return (← getLCtx).sortFVarsByContextOrder hyps\n\ninstance : AlternativeMonad Lean.Meta.MetaM where\n\nnamespace MetavarContext\n\n/--\nGet the `MetavarDecl` of `mvarId`. If `mvarId` is not a declared metavariable\nin the given `MetavarContext`, throw an error.\n-/\ndef getExprMVarDecl [Monad m] [MonadError m] (mctx : MetavarContext)\n (mvarId : MVarId) : m MetavarDecl := do\n if let some mdecl := mctx.decls.find? mvarId then\n return mdecl\n else\n throwError \"unknown metavariable '?{mvarId.name}'\"\n\n/--\nDeclare a metavariable. You must make sure that the metavariable is not already\ndeclared.\n-/\ndef declareExprMVar (mctx : MetavarContext) (mvarId : MVarId)\n (mdecl : MetavarDecl) : MetavarContext :=\n { mctx with decls := mctx.decls.insert mvarId mdecl }\n\n/--\nCheck whether a metavariable is assigned or delayed-assigned. A\ndelayed-assigned metavariable is already 'solved' but the solution cannot be\nsubstituted yet because we have to wait for some other metavariables to be\nassigned first. So in most situations you want to treat a delayed-assigned\nmetavariable as assigned.\n-/\ndef isExprMVarAssignedOrDelayedAssigned (mctx : MetavarContext)\n (mvarId : MVarId) : Bool :=\n mctx.eAssignment.contains mvarId || mctx.dAssignment.contains mvarId\n\n/--\nCheck whether a metavariable is declared in the given `MetavarContext`.\n-/\ndef isExprMVarDeclared (mctx : MetavarContext) (mvarId : MVarId) : Bool :=\n mctx.decls.contains mvarId\n\n/--\nErase any assignment or delayed assignment of the given metavariable.\n-/\ndef eraseExprMVarAssignment (mctx : MetavarContext) (mvarId : MVarId) :\n MetavarContext :=\n { mctx with\n eAssignment := mctx.eAssignment.erase mvarId\n dAssignment := mctx.dAssignment.erase mvarId }\n\n/--\nObtain all unassigned metavariables from the given `MetavarContext`. If\n`includeDelayed` is `true`, delayed-assigned metavariables are considered\nunassigned.\n-/\ndef unassignedExprMVars (mctx : MetavarContext) (includeDelayed := false) :\n Array MVarId := Id.run do\n let mut result := #[]\n for (mvarId, _) in mctx.decls do\n if ! mctx.eAssignment.contains mvarId &&\n (includeDelayed || ! mctx.dAssignment.contains mvarId) then\n result := result.push mvarId\n return result\n\nend MetavarContext\n\n\nnamespace MVarId\n\n/--\nCheck whether a metavariable is declared.\n-/\ndef isDeclared [Monad m] [MonadMCtx m] (mvarId : MVarId) : m Bool :=\n return (← getMCtx).isExprMVarDeclared mvarId\n\n/--\nErase any assignment or delayed assignment of the given metavariable.\n-/\ndef eraseAssignment [MonadMCtx m] (mvarId : MVarId) : m Unit :=\n modifyMCtx (·.eraseExprMVarAssignment mvarId)\n\n/-- Solve a goal by synthesizing an instance. -/\n-- FIXME: probably can just be `g.inferInstance` once leanprover/lean4#2054 is fixed\ndef synthInstance (g : MVarId) : MetaM Unit := do\n g.assign (← Lean.Meta.synthInstance (← g.getType))\n\n/-- Get the type the given metavariable after instantiating metavariables and cleaning up\nannotations. -/\ndef getTypeCleanup (mvarId : MVarId) : MetaM Expr :=\n return (← instantiateMVars (← mvarId.getType)).cleanupAnnotations\n\nend MVarId\n\n\nnamespace Meta\n\n/--\nObtain all unassigned metavariables. If `includeDelayed` is `true`,\ndelayed-assigned metavariables are considered unassigned.\n-/\ndef getUnassignedExprMVars [Monad m] [MonadMCtx m] (includeDelayed := false) :\n m (Array MVarId) :=\n return (← getMCtx).unassignedExprMVars (includeDelayed := includeDelayed)\n\n/--\nRun a computation with hygiene turned off.\n-/\ndef unhygienic [MonadWithOptions m] (x : m α) : m α :=\n withOptions (tactic.hygienic.set · false) x\n\n/--\nA variant of `mkFreshId` which generates names with a particular prefix. The\ngenerated names are unique and have the form `.` where `N` is a\nnatural number. They are not suitable as user-facing names.\n-/\ndef mkFreshIdWithPrefix [Monad m] [MonadNameGenerator m] («prefix» : Name) :\n m Name := do\n let ngen ← getNGen\n let r := { ngen with namePrefix := «prefix» }.curr\n setNGen ngen.next\n pure r\n\n/--\n`saturate1 goal tac` runs `tac` on `goal`, then on the resulting goals, etc.,\nuntil `tac` does not apply to any goal any more (i.e. it returns `none`). The\norder of applications is depth-first, so if `tac` generates goals `[g₁, g₂, ⋯]`,\nwe apply `tac` to `g₁` and recursively to all its subgoals before visiting `g₂`.\nIf `tac` does not apply to `goal`, `saturate1` returns `none`. Otherwise it\nreturns the generated subgoals to which `tac` did not apply. `saturate1`\nrespects the `MonadRecDepth` recursion limit.\n-/\npartial def saturate1 [Monad m] [MonadError m] [MonadRecDepth m] [MonadLiftT (ST IO.RealWorld) m]\n (goal : MVarId) (tac : MVarId → m (Option (Array MVarId))) : m (Option (Array MVarId)) := do\n let some goals ← tac goal | return none\n let acc ← ST.mkRef #[]\n goals.forM (go acc)\n return some (← acc.get)\nwhere\n /-- Auxiliary definition for `saturate1`. -/\n go (acc : IO.Ref (Array MVarId)) (goal : MVarId) : m Unit :=\n withIncRecDepth do\n match ← tac goal with\n | none => acc.modify fun s => s.push goal\n | some goals => goals.forM (go acc)\n" }, { "path": "Batteries/Lean/Meta/DiscrTree.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg, Kim Morrison\n-/\nmodule\n\npublic import Lean.Meta.DiscrTree\npublic import Batteries.Data.Array.Merge\npublic import Batteries.Lean.Meta.Expr\npublic import Batteries.Lean.PersistentHashMap\n\n@[expose] public section\n\nnamespace Lean.Meta.DiscrTree\n\nnamespace Key\n\n/--\nCompare two `Key`s. The ordering is total but otherwise arbitrary. (It uses\n`Name.quickCmp` internally.)\n-/\nprotected def cmp : Key → Key → Ordering\n | .lit v₁, .lit v₂ => compare v₁ v₂\n | .fvar n₁ a₁, .fvar n₂ a₂ => n₁.name.quickCmp n₂.name |>.then <| compare a₁ a₂\n | .const n₁ a₁, .const n₂ a₂ => n₁.quickCmp n₂ |>.then <| compare a₁ a₂\n | .proj s₁ i₁ a₁, .proj s₂ i₂ a₂ =>\n s₁.quickCmp s₂ |>.then <| compare i₁ i₂ |>.then <| compare a₁ a₂\n | k₁, k₂ => compare k₁.ctorIdx k₂.ctorIdx\n\ninstance : Ord Key := ⟨Key.cmp⟩\n\nend Key\n\n\nnamespace Trie\n\n/--\nMerge two `Trie`s. Duplicate values are preserved.\n-/\npartial def mergePreservingDuplicates : Trie α → Trie α → Trie α\n | node vs₁ cs₁, node vs₂ cs₂ =>\n node (vs₁ ++ vs₂) (mergeChildren cs₁ cs₂)\nwhere\n /-- Auxiliary definition for `mergePreservingDuplicates`. -/\n mergeChildren (cs₁ cs₂ : Array (Key × Trie α)) :\n Array (Key × Trie α) :=\n Array.mergeDedupWith\n (ord := ⟨compareOn (·.fst)⟩) cs₁ cs₂\n (fun (k₁, t₁) (_, t₂) => (k₁, mergePreservingDuplicates t₁ t₂))\n\nend Trie\n\n/--\nMerge two `DiscrTree`s. Duplicate values are preserved.\n-/\n@[inline]\ndef mergePreservingDuplicates (t u : DiscrTree α) : DiscrTree α :=\n ⟨t.root.mergeWith u.root fun _ trie₁ trie₂ =>\n trie₁.mergePreservingDuplicates trie₂⟩\n" }, { "path": "Batteries/Lean/Meta/Expr.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.Expr\n\n@[expose] public section\n\nnamespace Lean.Literal\n\ninstance : Ord Literal where\n compare\n | natVal n₁, natVal n₂ => compare n₁ n₂\n | strVal s₁, strVal s₂ => compare s₁ s₂\n | natVal _, strVal _ => .lt\n | strVal _, natVal _ => .gt\n" }, { "path": "Batteries/Lean/Meta/Inaccessible.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.Meta.Basic\n\n@[expose] public section\n\nopen Lean Lean.Meta Std\n\n/--\nObtain the inaccessible fvars from the given local context. An fvar is\ninaccessible if (a) its user name is inaccessible or (b) it is shadowed by a\nlater fvar with the same user name.\n-/\ndef Lean.LocalContext.inaccessibleFVars (lctx : LocalContext) :\n Array LocalDecl :=\n let (result, _) :=\n lctx.foldr (β := Array LocalDecl × Std.HashSet Name)\n (init := (Array.mkEmpty lctx.numIndices, {}))\n fun ldecl (result, seen) =>\n if ldecl.isImplementationDetail then\n (result, seen)\n else\n let result :=\n if ldecl.userName.hasMacroScopes || seen.contains ldecl.userName then\n result.push ldecl\n else\n result\n (result, seen.insert ldecl.userName)\n result.reverse\n\n/--\nObtain the inaccessible fvars from the current local context. An fvar is\ninaccessible if (a) its user name is inaccessible or (b) it is shadowed by a\nlater fvar with the same user name.\n-/\ndef Lean.Meta.getInaccessibleFVars [Monad m] [MonadLCtx m] :\n m (Array LocalDecl) :=\n return (← getLCtx).inaccessibleFVars\n\n/--\nRename all inaccessible fvars. An fvar is inaccessible if (a) its user name is\ninaccessible or (b) it is shadowed by a later fvar with the same user name. This\nfunction gives all inaccessible fvars a unique, accessible user name. It returns\nthe new goal and the fvars that were renamed.\n-/\ndef Lean.MVarId.renameInaccessibleFVars (mvarId : MVarId) :\n MetaM (MVarId × Array FVarId) := do\n let mdecl ← mvarId.getDecl\n let mut lctx := mdecl.lctx\n let inaccessibleFVars := lctx.inaccessibleFVars\n if inaccessibleFVars.isEmpty then\n return (mvarId, #[])\n let mut renamedFVars := Array.mkEmpty lctx.decls.size\n for ldecl in inaccessibleFVars do\n let newName := lctx.getUnusedName ldecl.userName\n lctx := lctx.setUserName ldecl.fvarId newName\n renamedFVars := renamedFVars.push ldecl.fvarId\n let newMVar ← mkFreshExprMVarAt lctx mdecl.localInstances mdecl.type\n mvarId.assign newMVar\n return (newMVar.mvarId!, renamedFVars)\n" }, { "path": "Batteries/Lean/Meta/InstantiateMVars.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Batteries.Lean.Meta.Basic\n\n@[expose] public section\n\nopen Lean Lean.Meta\n\nnamespace Lean.MVarId\n\n/--\nInstantiate metavariables in the type of the given metavariable, update the\nmetavariable's declaration and return the new type.\n-/\ndef instantiateMVarsInType [Monad m] [MonadMCtx m] [MonadError m]\n (mvarId : MVarId) : m Expr := do\n let mdecl ← (← getMCtx).getExprMVarDecl mvarId\n let type := mdecl.type\n if type.hasMVar then\n let type ← instantiateMVars type\n let mdecl := { mdecl with type }\n modifyMCtx (·.declareExprMVar mvarId mdecl)\n return type\n else\n return type\n\n/--\nInstantiate metavariables in the `LocalDecl` of the given fvar, update the\n`LocalDecl` and return the new `LocalDecl.`\n-/\ndef instantiateMVarsInLocalDecl [Monad m] [MonadMCtx m] [MonadError m]\n (mvarId : MVarId) (fvarId : FVarId) : m LocalDecl := do\n let mdecl ← (← getMCtx).getExprMVarDecl mvarId\n let (some ldecl) := mdecl.lctx.find? fvarId | throwError\n \"unknown fvar '{fvarId.name}' (in local context of mvar '?{mvarId.name}')\"\n let ldecl ← Lean.instantiateLocalDeclMVars ldecl\n let mdecl :=\n { mdecl with lctx := mdecl.lctx.modifyLocalDecl fvarId fun _ => ldecl }\n modifyMCtx (·.declareExprMVar mvarId mdecl)\n return ldecl\n\n/--\nInstantiate metavariables in the local context of the given metavariable, update\nthe metavariable's declaration and return the new local context.\n-/\ndef instantiateMVarsInLocalContext [Monad m] [MonadMCtx m] [MonadError m]\n (mvarId : MVarId) : m LocalContext := do\n let mdecl ← (← getMCtx).getExprMVarDecl mvarId\n let lctx ← instantiateLCtxMVars mdecl.lctx\n modifyMCtx (·.declareExprMVar mvarId { mdecl with lctx })\n return lctx\n\n/--\nInstantiate metavariables in the local context and type of the given\nmetavariable.\n-/\ndef instantiateMVars [Monad m] [MonadMCtx m] [MonadError m] (mvarId : MVarId) :\n m Unit := do\n discard $ (← getMCtx).getExprMVarDecl mvarId\n -- The line above throws an error if the `mvarId` is not declared. The line\n -- below panics.\n instantiateMVarDeclMVars mvarId\n\nend Lean.MVarId\n" }, { "path": "Batteries/Lean/Meta/SavedState.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Batteries.Lean.Meta.Basic\npublic import Batteries.Lean.MonadBacktrack\n\n@[expose] public section\n\nnamespace Lean.Meta.SavedState\n\n/--\nRun the action `x` in state `s`. Returns the result of `x` and the state after\n`x` was executed. The global state remains unchanged.\n-/\ndef runMetaM (s : Meta.SavedState) (x : MetaM α) :\n MetaM (α × Meta.SavedState) :=\n withoutModifyingState' do restoreState s; x\n\n/--\nRun the action `x` in state `s`. Returns the result of `x`. The global state\nremains unchanged.\n-/\ndef runMetaM' (s : Meta.SavedState) (x : MetaM α) : MetaM α :=\n withoutModifyingState do restoreState s; x\n\nend SavedState\n\n\n/--\nReturns the mvars that are not declared in `preState`, but declared and\nunassigned in `postState`. Delayed-assigned mvars are considered assigned.\n-/\ndef getIntroducedExprMVars (preState postState : SavedState) :\n MetaM (Array MVarId) := do\n let unassignedPost ← postState.runMetaM' getUnassignedExprMVars\n preState.runMetaM' do\n unassignedPost.filterM fun mvarId => return ! (← mvarId.isDeclared)\n\n/--\nReturns the mvars that are declared but unassigned in `preState`, and\nassigned in `postState`. Delayed-assigned mvars are considered assigned.\n-/\ndef getAssignedExprMVars (preState postState : SavedState) :\n MetaM (Array MVarId) := do\n let unassignedPre ← preState.runMetaM' getUnassignedExprMVars\n postState.runMetaM' do\n unassignedPre.filterM (·.isAssignedOrDelayedAssigned)\n\nend Lean.Meta\n" }, { "path": "Batteries/Lean/Meta/Simp.lean", "content": "/-\nCopyright (c) 2022 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison, Gabriel Ebner, Floris van Doorn\n-/\nmodule\n\npublic import Lean.Elab.Tactic.Simp\npublic import Batteries.Tactic.OpenPrivate\nimport all Lean.Elab.Tactic.Simp -- for accessing `mkDischargeWrapper`\n\n\npublic section\n\n/-!\n# Helper functions for using the simplifier.\n\n[TODO] Reunification of `mkSimpContext'` with core.\n-/\n\nnamespace Lean\n\nnamespace Meta.Simp\nopen Elab.Tactic\n\n/-- Flip the proof in a `Simp.Result`. -/\ndef mkEqSymm (e : Expr) (r : Simp.Result) : MetaM Simp.Result :=\n ({ expr := e, proof? := · }) <$>\n match r.proof? with\n | none => pure none\n | some p => some <$> Meta.mkEqSymm p\n\n/-- Construct the `Expr` `cast h e`, from a `Simp.Result` with proof `h`. -/\ndef mkCast (r : Simp.Result) (e : Expr) : MetaM Expr := do\n mkAppM ``cast #[← r.getProof, e]\n\n/-- Construct a `Simp.DischargeWrapper` from the `Syntax` for a `simp` discharger. -/\nnonrec def mkDischargeWrapper := mkDischargeWrapper\n\n-- copied from core\n/--\nIf `ctx == false`, the config argument is assumed to have type `Meta.Simp.Config`,\nand `Meta.Simp.ConfigCtx` otherwise.\nIf `ctx == false`, the `discharge` option must be none\n-/\ndef mkSimpContext' (simpTheorems : SimpTheorems) (stx : Syntax) (eraseLocal : Bool)\n (kind := SimpKind.simp) (ctx := false) (ignoreStarArg : Bool := false) :\n TacticM MkSimpContextResult := do\n if ctx && !stx[2].isNone then\n if kind == SimpKind.simpAll then\n throwError \"'simp_all' tactic does not support 'discharger' option\"\n if kind == SimpKind.dsimp then\n throwError \"'dsimp' tactic does not support 'discharger' option\"\n let dischargeWrapper ← mkDischargeWrapper stx[2]\n let simpOnly := !stx[3].isNone\n let simpTheorems ← if simpOnly then\n simpOnlyBuiltins.foldlM (·.addConst ·) {}\n else\n pure simpTheorems\n let simprocs ← if simpOnly then pure {} else Simp.getSimprocs\n let congrTheorems ← Meta.getSimpCongrTheorems\n let ctx ← Simp.mkContext (← elabSimpConfig stx[1] (kind := kind)) #[simpTheorems] congrTheorems\n let r ← elabSimpArgs stx[4] (simprocs := #[simprocs]) ctx eraseLocal kind\n (ignoreStarArg := ignoreStarArg)\n return { r with dischargeWrapper }\n\n\nend Simp\n\nend Lean.Meta\n" }, { "path": "Batteries/Lean/Meta/UnusedNames.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.LocalContext\n\npublic section\n\nopen Lean Lean.Meta\n\nnamespace Lean.Name\n\nprivate def parseIndexSuffix (s : String.Slice) : Option Nat :=\n if s.isEmpty then\n none\n else if s.front == '_' then\n s.drop 1 |>.toNat?\n else\n none\n\n/--\nResult type of `Lean.Name.matchUpToIndexSuffix`. See there for details.\n-/\ninductive MatchUpToIndexSuffix\n /-- Exact match. -/\n | exactMatch\n /-- No match. -/\n | noMatch\n /-- Match up to suffix. -/\n | suffixMatch (i : Nat)\n\n/--\nSucceeds if `n` is equal to `query`, except `n` may have an additional `_i`\nsuffix for some natural number `i`. More specifically:\n\n- If `n = query`, the result is `exactMatch`.\n- If `n = query ++ \"_i\"` for some natural number `i`, the result is\n `suffixMatch i`.\n- Otherwise the result is `noMatch`.\n-/\ndef matchUpToIndexSuffix (n : Name) (query : Name) :\n MatchUpToIndexSuffix :=\n match n, query with\n | .str pre₁ s₁, .str pre₂ s₂ =>\n if pre₁ != pre₂ then\n .noMatch\n else\n if let some suffix := s₁.dropPrefix? s₂ then\n if suffix.isEmpty then\n .exactMatch\n else\n if let some i := parseIndexSuffix suffix then\n .suffixMatch i\n else\n .noMatch\n else\n .noMatch\n | n, query => if n == query then .exactMatch else .noMatch\n\nend Name\n\n\nnamespace LocalContext\n\n/--\nObtain the least natural number `i` such that `suggestion ++ \"_i\"` is an unused\nname in the given local context. If `suggestion` itself is unused, the result\nis `none`.\n-/\ndef getUnusedUserNameIndex (lctx : LocalContext) (suggestion : Name) :\n Option Nat := Id.run do\n let mut minSuffix := none\n for ldecl in lctx do\n let hypName := ldecl.userName\n if hypName.hasMacroScopes then\n continue\n match ldecl.userName.matchUpToIndexSuffix suggestion with\n | .exactMatch => minSuffix := updateMinSuffix minSuffix 1\n | .noMatch => continue\n | .suffixMatch i => minSuffix := updateMinSuffix minSuffix (i + 1)\n minSuffix\nwhere\n /-- Auxiliary definition for `getUnusedUserNameIndex`. -/\n @[inline]\n updateMinSuffix : Option Nat → Nat → Option Nat\n | none, j => some j\n | some i, j => some $ i.max j\n\n/--\nObtain a name `n` such that `n` is unused in the given local context and\n`suggestion` is a prefix of `n`. This is similar to `getUnusedName` but uses\na different algorithm which may or may not be faster.\n-/\ndef getUnusedUserName (lctx : LocalContext) (suggestion : Name) : Name :=\n let suggestion := suggestion.eraseMacroScopes\n match lctx.getUnusedUserNameIndex suggestion with\n | none => suggestion\n | some i => suggestion.appendIndexAfter i\n\n/--\nObtain `n` distinct names such that each name is unused in the given local\ncontext and `suggestion` is a prefix of each name.\n-/\ndef getUnusedUserNames (lctx : LocalContext) (n : Nat) (suggestion : Name) :\n Array Name :=\n if n == 0 then\n #[]\n else\n let suggestion := suggestion.eraseMacroScopes\n let acc := Array.mkEmpty n\n match lctx.getUnusedUserNameIndex suggestion with\n | none => loop (acc.push suggestion) (n - 1) 1\n | some i => loop acc n i\nwhere\n /-- Auxiliary definition for `getUnusedUserNames`. -/\n loop (acc : Array Name) (n i : Nat) : Array Name :=\n match n with\n | 0 => acc\n | n + 1 => loop (acc.push $ suggestion.appendIndexAfter i) n (i + 1)\n\nend Lean.LocalContext\n\n\nnamespace Lean.Meta\n\n/--\nObtain a name `n` such that `n` is unused in the current local context and\n`suggestion` is a prefix of `n`.\n-/\ndef getUnusedUserName [Monad m] [MonadLCtx m] (suggestion : Name) : m Name :=\n return (← getLCtx).getUnusedUserName suggestion\n\n/--\nObtain `n` distinct names such that each name is unused in the current local\ncontext and `suggestion` is a prefix of each name.\n-/\ndef getUnusedUserNames [Monad m] [MonadLCtx m] (n : Nat) (suggestion : Name) :\n m (Array Name) :=\n return (← getLCtx).getUnusedUserNames n suggestion\n" }, { "path": "Batteries/Lean/MonadBacktrack.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.Util.MonadBacktrack\n\n@[expose] public section\n\nnamespace Lean\n\n/--\nExecute the action `x`, then restore the initial state. Returns the state after\n`x` finished.\n-/\ndef withoutModifyingState' [Monad m] [MonadBacktrack s m] [MonadFinally m]\n (x : m α) : m (α × s) :=\n withoutModifyingState do\n let result ← x\n let finalState ← saveState\n return (result, finalState)\n\nend Lean\n" }, { "path": "Batteries/Lean/NameMapAttribute.lean", "content": "/-\nCopyright (c) 2022 E.W.Ayers. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: E.W.Ayers\n-/\nmodule\n\npublic import Lean.Attributes\n\n@[expose] public section\n\nnamespace Lean\n\n/-- Forward port of lean4#12469 -/\nlocal instance [Inhabited α] : Inhabited (Thunk α) := ⟨.pure default⟩\n\n/-- Environment extension that maps declaration names to `α`.\nThis uses a `Thunk` to avoid computing the name map when it isn't used. -/\ndef NameMapExtension (α : Type) := SimplePersistentEnvExtension (Name × α) (Thunk (NameMap α))\n\ninstance : Inhabited (NameMapExtension α) :=\n inferInstanceAs <| Inhabited (SimplePersistentEnvExtension ..)\n\n/-- Look up a value in the given extension in the environment. -/\ndef NameMapExtension.find? (ext : NameMapExtension α) (env : Environment) : Name → Option α :=\n (SimplePersistentEnvExtension.getState ext env).get.find?\n\n/-- Add the given k,v pair to the NameMapExtension. -/\ndef NameMapExtension.add [Monad M] [MonadEnv M] [MonadError M]\n (ext : NameMapExtension α) (k : Name) (v : α) : M Unit := do\n if let some _ := ext.find? (← getEnv) k then\n throwError \"Already exists entry for {ext.name} {k}\"\n else\n ext.addEntry (← getEnv) (k, v) |> setEnv\n\n/-- Registers a new extension with the given name and type. -/\ndef registerNameMapExtension (α) (name : Name := by exact decl_name%) :\n IO (NameMapExtension α) := do\n registerSimplePersistentEnvExtension {\n name\n addImportedFn arr := .mk fun _ => arr.foldl (·.insertMany ·) ∅\n addEntryFn s n := s.map (·.insert n.1 n.2)\n }\n\n/-- The inputs to `registerNameMapAttribute`. -/\nstructure NameMapAttributeImpl (α : Type) where\n /-- The name of the attribute -/\n name : Name\n /-- The declaration which creates the attribute -/\n ref : Name := by exact decl_name%\n /-- The description of the attribute -/\n descr : String\n /-- This function is called when the attribute is applied.\n It should produce a value of type `α` from the given attribute syntax. -/\n add (src : Name) (stx : Syntax) : AttrM α\n deriving Inhabited\n\n/-- Similar to `registerParametricAttribute` except that attributes do not\nhave to be assigned in the same file as the declaration. -/\ndef registerNameMapAttribute (impl : NameMapAttributeImpl α) : IO (NameMapExtension α) := do\n let ext ← registerNameMapExtension α impl.ref\n registerBuiltinAttribute {\n name := impl.name\n descr := impl.descr\n add := fun src stx _kind => do\n let a : α ← impl.add src stx\n ext.add src a\n }\n return ext\n" }, { "path": "Batteries/Lean/PersistentHashMap.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.Data.PersistentHashMap\n\n@[expose] public section\n\nnamespace Lean.PersistentHashMap\n\nvariable [BEq α] [Hashable α]\n\n/--\nBuilds a `PersistentHashMap` from a list of key-value pairs. Values of\nduplicated keys are replaced by their respective last occurrences.\n-/\ndef ofList (xs : List (α × β)) : PersistentHashMap α β :=\n xs.foldl (init := {}) fun m (k, v) => m.insert k v\n\n/--\nVariant of `ofList` which accepts a function that combines values of duplicated\nkeys.\n-/\ndef ofListWith (xs : List (α × β)) (f : α → β → β → β) :\n PersistentHashMap α β :=\n xs.foldl (init := {}) fun m (k, v) =>\n match m.find? k with\n | none => m.insert k v\n | some v' => m.insert k <| f k v v'\n\n/--\nBuilds a `PersistentHashMap` from an array of key-value pairs. Values of\nduplicated keys are replaced by their respective last occurrences.\n-/\ndef ofArray (xs : Array (α × β)) : PersistentHashMap α β :=\n xs.foldl (init := {}) fun m (k, v) => m.insert k v\n\n/--\nVariant of `ofArray` which accepts a function that combines values of duplicated\nkeys.\n-/\ndef ofArrayWith (xs : Array (α × β)) (f : α → β → β → β) :\n PersistentHashMap α β :=\n xs.foldl (init := {}) fun m (k, v) =>\n match m.find? k with\n | none => m.insert k v\n | some v' => m.insert k <| f k v v'\n\n/--\nMerge two `PersistentHashMap`s. The values of keys which appear in both maps are\ncombined using the monadic function `f`.\n-/\n@[specialize]\ndef mergeWithM [Monad m] (self other : PersistentHashMap α β)\n (f : α → β → β → m β) : m (PersistentHashMap α β) :=\n other.foldlM (init := self) fun map k v₂ =>\n match map.find? k with\n | none => return map.insert k v₂\n | some v₁ => return map.insert k (← f k v₁ v₂)\n\n/--\nMerge two `PersistentHashMap`s. The values of keys which appear in both maps are\ncombined using `f`.\n-/\n@[inline]\ndef mergeWith (self other : PersistentHashMap α β) (f : α → β → β → β) :\n PersistentHashMap α β :=\n -- Implementing this function directly, rather than via `mergeWithM`, gives\n -- us less constrained universes.\n other.foldl (init := self) fun map k v₂ =>\n match map.find? k with\n | none => map.insert k v₂\n | some v₁ => map.insert k <| f k v₁ v₂\n" }, { "path": "Batteries/Lean/PersistentHashSet.lean", "content": "/-\nCopyright (c) 2022 Jannis Limperg. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jannis Limperg\n-/\nmodule\n\npublic import Lean.Data.PersistentHashSet\n\n@[expose] public section\n\nnamespace Lean.PersistentHashSet\n\nvariable [BEq α] [Hashable α]\n\ninstance [Monad m] : ForIn m (PersistentHashSet α) α where\n forIn s init step := do\n let mut state := init\n for (k, _) in s.set do\n match ← step k state with\n | .done state' => return state'\n | .yield state' => state := state'\n return state\n\n/--\nReturns `true` if `f` returns `true` for any element of the set.\n-/\n@[specialize]\ndef anyM [Monad m] (s : PersistentHashSet α) (f : α → m Bool) : m Bool := do\n for a in s do\n if ← f a then\n return true\n return false\n\n/--\nReturns `true` if `f` returns `true` for any element of the set.\n-/\n@[inline]\ndef any (s : PersistentHashSet α) (f : α → Bool) : Bool :=\n Id.run <| s.anyM f\n\n/--\nReturns `true` if `f` returns `true` for all elements of the set.\n-/\n@[specialize]\ndef allM [Monad m] (s : PersistentHashSet α) (f : α → m Bool) : m Bool := do\n for a in s do\n if ! (← f a) then\n return false\n return true\n\n/--\nReturns `true` if `f` returns `true` for all elements of the set.\n-/\n@[inline]\ndef all (s : PersistentHashSet α) (f : α → Bool) : Bool :=\n Id.run <| s.allM f\n\ninstance : BEq (PersistentHashSet α) where\n beq s t := s.all (t.contains ·) && t.all (s.contains ·)\n\n/--\nInsert all elements from a collection into a `PersistentHashSet`.\n-/\ndef insertMany [ForIn Id ρ α] (s : PersistentHashSet α) (as : ρ) :\n PersistentHashSet α := Id.run do\n let mut s := s\n for a in as do\n s := s.insert a\n return s\n\n/--\nObtain a `PersistentHashSet` from an array.\n-/\n@[inline]\nprotected def ofArray [BEq α] [Hashable α] (as : Array α) : PersistentHashSet α :=\n PersistentHashSet.empty.insertMany as\n\n/--\nObtain a `PersistentHashSet` from a list.\n-/\n@[inline]\nprotected def ofList [BEq α] [Hashable α] (as : List α) : PersistentHashSet α :=\n PersistentHashSet.empty.insertMany as\n\n/--\nMerge two `PersistentHashSet`s.\n-/\n@[inline]\ndef merge (s t : PersistentHashSet α) : PersistentHashSet α :=\n s.insertMany t\n" }, { "path": "Batteries/Lean/Position.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Thomas R. Murrills\n-/\nmodule\n\npublic import Lean.Syntax\npublic import Lean.Data.Lsp.Utf16\n\npublic section\n\nnamespace Lean\n\n/-- Return the beginning of the line contatining character `pos`. -/\ndef findLineStart (s : String) (pos : String.Pos.Raw) : String.Pos.Raw :=\n (s.pos! pos).revFind? '\\n' |>.map (·.next!) |>.getD s.startPos |>.offset\n\n/--\nReturn the indentation (number of leading spaces) of the line containing `pos`,\nand whether `pos` is the first non-whitespace character in the line.\n-/\ndef findIndentAndIsStart (s : String) (pos : String.Pos.Raw) : Nat × Bool :=\n let start := findLineStart s pos\n let body := (s.pos! start).find (· ≠ ' ') |>.offset\n (start.byteDistance body, body == pos)\n\n/--\nIf `pos` is a `Lean.Position`, then `pos.getDeclsAfter` returns the array of names of declarations\nwhose selection range begins in position at least `pos`. By using the `selectionRange`, which is\nusually smaller than the `range`, we err on the side of including declarations when possible.\n\nBy default, this only inspects the local branch of the environment. This is compatible with being\nused to find declarations from the current command in a linter, where we have already waited for\nasync tasks/parallel branches to complete. Further, since the environment exposed to linters does\nnot include constants added after the elaboration of the current command, it is safe to use this on\nthe command's start position without picking up later declarations.\n-/\nprotected def Position.getDeclsAfter (env : Environment) (pos : Position)\n (asyncMode := EnvExtension.AsyncMode.local) : Array Name :=\n declRangeExt.getState env asyncMode |>.foldl (init := #[])\n fun acc name { selectionRange .. } =>\n if selectionRange.pos.lt pos then acc else acc.push name\n\n/--\nIf `pos` is a `String.Pos.Raw`, then `pos.getDeclsAfter` returns the array of names of declarations\nwhose selection range begins in position at least `pos`. By using the `selectionRange`, which is\nusually smaller than the `range`, we err on the side of including declarations when possible.\n\nBy default, this is intended for use in linters, where only the current environment branch needs to\nbe checked. See the docstring for `Lean.Position.getDeclsAfter` for details.\n-/\n@[inline] protected def _root_.String.Pos.Raw.getDeclsAfter (env : Environment) (map : FileMap)\n (pos : String.Pos.Raw) (asyncMode := EnvExtension.AsyncMode.local) : Array Name :=\n map.toPosition pos |>.getDeclsAfter env asyncMode\n\n/-- Converts a `DeclarationRange` to a `Syntax.Range`. This assumes that the\n`DeclarationRange` is sourced in the given `FileMap`. -/\ndef DeclarationRange.toSyntaxRange (map : FileMap) (range : DeclarationRange) : Syntax.Range :=\n ⟨map.ofPosition range.pos, map.ofPosition range.endPos⟩\n\n/-- Yields the `Syntax.Range` for the declaration `decl` in the current file. If `decl` is not in\nthe current file, yields `none`.\n\nBy default, this provides the \"selection range\", which is usually the declaration's identifier or\ne.g. the `instance` token for an unnamed instance. If `fullRange` is instead set to `true`, this\nreturns the full declaration range (which includes modifiers, such as the docstring). -/\ndef findDeclarationSyntaxRange? {m : Type → Type} [Monad m] [MonadEnv m] [MonadLiftT BaseIO m]\n [MonadFileMap m] (decl : Name) (fullRange := false) : m (Option Syntax.Range) := do\n if (← getEnv).isImportedConst decl then return none\n let some ranges ← findDeclarationRanges? decl | return none\n return (if fullRange then ranges.range else ranges.selectionRange).toSyntaxRange (← getFileMap)\n\n/-- Runs `x` with a synthetic ref that has position info locating the given `decl` if it is defined\nin the current file, or else runs `x` without modifying the ref. This is useful for logging on a\ndeclaration's name from within linters.\n\nBy default, this uses the \"selection range\" of the declaration, which is usually the declaration's\nidentifier or e.g. the `instance` token for an unnamed instance. (This is also the place that\nreceives hovers for the declaration.)\n\nIf `fullRange` is instead set to `true`, this uses the full declaration range, which includes the\nmodifiers (such as the docstring, if there is one) and the body of the declaration.\n\n`canonical` applies to the synthetic syntax generated for the ref; see `Syntax.ofRange`. -/\n@[always_inline, inline]\ndef withDeclRef? {α} {m : Type → Type} [Monad m] [MonadEnv m] [MonadLiftT BaseIO m]\n [MonadFileMap m] [MonadRef m] (decl : Name) (x : m α)\n (fullRange := false) (canonical := true) : m α := do\n let some range ← findDeclarationSyntaxRange? decl fullRange | x\n withRef (.ofRange range canonical) x\n\nend Lean\n" }, { "path": "Batteries/Lean/SatisfiesM.lean", "content": "/-\nCopyright (c) 2024 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\npublic import Batteries.Classes.SatisfiesM\npublic import Batteries.Lean.LawfulMonad\npublic import Lean.Elab.Command\nimport all Init.System.ST\n\n@[expose] public section\n\n/-!\n# Construct `MonadSatisfying` instances for the Lean monad stack.\n-/\n\nopen Lean Elab Term Tactic Command\n\n-- Note: as of nightly-2025-10-23, after https://github.com/leanprover/lean4/pull/10625\n-- these instances need to be re-implemented.\n\n-- instance : MonadSatisfying (EIO ε) := inferInstanceAs <| MonadSatisfying (EStateM _ _)\n-- instance : MonadSatisfying BaseIO := inferInstanceAs <| MonadSatisfying (EIO _)\n-- instance : MonadSatisfying IO := inferInstanceAs <| MonadSatisfying (EIO _)\n\n-- instance : MonadSatisfying (EST ε σ) := inferInstanceAs <| MonadSatisfying (EStateM _ _)\n\n-- instance : MonadSatisfying CoreM :=\n-- inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ (EIO _))\n\n-- instance : MonadSatisfying MetaM :=\n-- inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ CoreM)\n\n-- instance : MonadSatisfying TermElabM :=\n-- inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ MetaM)\n\n-- instance : MonadSatisfying TacticM :=\n-- inferInstanceAs <| MonadSatisfying (ReaderT _ $ StateRefT' _ _ TermElabM)\n\n-- instance : MonadSatisfying CommandElabM :=\n-- inferInstanceAs <| MonadSatisfying (ReaderT _ $ StateRefT' _ _ (EIO _))\n" }, { "path": "Batteries/Lean/Syntax.lean", "content": "/-\nCopyright (c) 2022 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic import Lean.Syntax\n\n@[expose] public section\n\n/-!\n# Helper functions for working with typed syntaxes.\n-/\n\nnamespace Lean\n\n/--\nApplies the given function to every subsyntax.\n\nLike `Syntax.replaceM` but for typed syntax.\n(Note there are no guarantees of type correctness here.)\n-/\ndef TSyntax.replaceM [Monad M] (f : Syntax → M (Option Syntax)) (stx : TSyntax k) : M (TSyntax k) :=\n .mk <$> stx.1.replaceM f\n" }, { "path": "Batteries/Lean/System/IO.lean", "content": "/-\nCopyright (c) 2023 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nmodule\n\n@[expose] public section\n\n/-!\n# Functions for manipulating a list of tasks\n\n* `IO.waitAny'` is a wrapper for `IO.waitAny` that also returns the remaining tasks.\n* `List.waitAll : List (Task α) → Task (List α)` gathers a list of tasks into a task returning\n the list of all results.\n-/\n\nset_option autoImplicit true\n\n-- duplicated from `lean4/src/Init/System/IO.lean`\nlocal macro \"nonempty_list\" : tactic =>\n `(tactic| exact Nat.zero_lt_succ _)\n\n/--\nGiven a list of tasks, create the task returning the list of results,\nby waiting for each.\n-/\ndef List.waitAll (tasks : List (Task α)) : Task (List α) :=\n match tasks with\n | [] => .pure []\n | task :: tasks => task.bind (prio := .max) fun a =>\n tasks.waitAll.map (prio := .max) fun as => a :: as\n" }, { "path": "Batteries/Lean/TagAttribute.lean", "content": "/-\nCopyright (c) 2022 Gabriel Ebner. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic import Lean.Attributes\n\n@[expose] public section\n\n/-- Get the list of declarations tagged with the tag attribute `attr`. -/\ndef Lean.TagAttribute.getDecls (attr : TagAttribute) (env : Environment) : Array Name :=\n core <| attr.ext.toEnvExtension.getState env\nwhere\n /-- Implementation of `TagAttribute.getDecls`. -/\n core (st : PersistentEnvExtensionState Name NameSet) : Array Name := Id.run do\n let mut decls := st.state.toArray\n for ds in st.importedEntries do\n decls := decls ++ ds\n decls\n" }, { "path": "Batteries/Lean/Util/EnvSearch.lean", "content": "/-\nCopyright (c) 2021 Shing Tak Lam. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Shing Tak Lam, Daniel Selsam, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Lint.Misc\n\nnamespace Lean\n\n/--\nFind constants in current environment that match find options and predicate.\n-/\npublic meta def getMatchingConstants {m} [Monad m] [MonadEnv m]\n (p : ConstantInfo → m Bool)\n (includeImports := true)\n : m (Array ConstantInfo) := do\n let matches_ ←\n if includeImports then\n (← getEnv).constants.map₁.foldM (init := #[]) check\n else\n pure #[]\n (← getEnv).constants.map₂.foldlM (init := matches_) check\nwhere\n /-- Check constant should be returned -/\n @[nolint unusedArguments]\n check matches_ (_name : Name) cinfo := do\n if ← p cinfo then\n pure $ matches_.push cinfo\n else\n pure matches_\n" }, { "path": "Batteries/Linter/UnnecessarySeqFocus.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Batteries.Lean.AttributeExtra\npublic meta import Lean.Linter.Basic\n\npublic meta section\n\nnamespace Batteries.Linter\nopen Lean Elab Command Linter Std\n\n/--\nEnables the 'unnecessary `<;>`' linter. This will warn whenever the `<;>` tactic combinator\nis used when `;` would work.\n\n```\nexample : True := by apply id <;> trivial\n```\nThe `<;>` is unnecessary here because `apply id` only makes one subgoal.\nPrefer `apply id; trivial` instead.\n\nIn some cases, the `<;>` is syntactically necessary because a single tactic is expected:\n```\nexample : True := by\n cases () with apply id <;> apply id\n | unit => trivial\n```\nIn this case, you should use parentheses, as in `(apply id; apply id)`:\n```\nexample : True := by\n cases () with (apply id; apply id)\n | unit => trivial\n```\n-/\nregister_option linter.unnecessarySeqFocus : Bool := {\n defValue := true\n descr := \"enable the 'unnecessary <;>' linter\"\n}\nexample : True := by\n cases () with apply id <;> apply id\n | unit => trivial\n\nnamespace UnnecessarySeqFocus\n\n/-- Gets the value of the `linter.unnecessarySeqFocus` option. -/\ndef getLinterUnnecessarySeqFocus (o : LinterOptions) : Bool :=\n getLinterValue linter.unnecessarySeqFocus o\n\n/--\nThe `multigoal` attribute keeps track of tactics that operate on multiple goals,\nmeaning that `tac` acts differently from `focus tac`. This is used by the\n'unnecessary `<;>`' linter to prevent false positives where `tac <;> tac'` cannot\nbe replaced by `(tac; tac')` because the latter would expose `tac` to a different set of goals.\n-/\ninitialize multigoalAttr : TagAttributeExtra ←\n registerTagAttributeExtra `multigoal \"this tactic acts on multiple goals\" [\n ``Parser.Tactic.«tacticNext_=>_»,\n ``Parser.Tactic.allGoals,\n ``Parser.Tactic.anyGoals,\n ``Parser.Tactic.case,\n ``Parser.Tactic.case',\n ``Parser.Tactic.Conv.«convNext__=>_»,\n ``Parser.Tactic.Conv.allGoals,\n ``Parser.Tactic.Conv.anyGoals,\n ``Parser.Tactic.Conv.case,\n ``Parser.Tactic.Conv.case',\n ``Parser.Tactic.rotateLeft,\n ``Parser.Tactic.rotateRight,\n ``Parser.Tactic.show,\n ``Parser.Tactic.tacticStop_\n ]\n\n/-- The information we record for each `<;>` node appearing in the syntax. -/\nstructure Entry where\n /-- The `<;>` node itself. -/\n stx : Syntax\n /--\n * `true`: this `<;>` has been used unnecessarily at least once\n * `false`: it has never been executed\n * If it has been used properly at least once, the entry is removed from the table.\n -/\n used : Bool\n\n/-- The monad for collecting used tactic syntaxes. -/\nabbrev M (ω) := StateRefT (Std.HashMap Lean.Syntax.Range Entry) (ST ω)\n\n/-- True if this is a `<;>` node in either `tactic` or `conv` classes. -/\n@[inline] def isSeqFocus (k : SyntaxNodeKind) : Bool :=\n k == ``Parser.Tactic.«tactic_<;>_» || k == ``Parser.Tactic.Conv.«conv_<;>_»\n\n/-- Accumulates the set of tactic syntaxes that should be evaluated at least once. -/\n@[specialize] partial def getTactics {ω} (stx : Syntax) : M ω Unit := do\n if let .node _ k args := stx then\n if isSeqFocus k then\n let r := stx.getRange? true\n if let some r := r then\n modify fun m => m.insert r { stx, used := false }\n args.forM getTactics\n\n/--\nTraverse the info tree down a given path.\nEach `(n, i)` means that the array must have length `n` and we will descend into the `i`'th child.\n-/\ndef getPath : Info → PersistentArray InfoTree → List ((n : Nat) × Fin n) → Option Info\n | i, _, [] => some i\n | _, c, ⟨n, i, h⟩::ns =>\n if e : c.size = n then\n if let .node i c' := c[i] then getPath i c' ns else none\n else none\n\nmutual\nvariable (env : Environment)\n/-- Search for tactic executions in the info tree and remove executed tactic syntaxes. -/\npartial def markUsedTacticsList (trees : PersistentArray InfoTree) : M ω Unit :=\n trees.forM markUsedTactics\n\n/-- Search for tactic executions in the info tree and remove executed tactic syntaxes. -/\npartial def markUsedTactics : InfoTree → M ω Unit\n | .node i c => do\n if let .ofTacticInfo i := i then\n if let some r := i.stx.getRange? true then\n if let some entry := (← get)[r]? then\n if i.stx.getKind == ``Parser.Tactic.«tactic_<;>_» then\n let isBad := do\n unless i.goalsBefore.length == 1 || !multigoalAttr.hasTag env i.stx[0].getKind do\n none\n -- Note: this uses the exact sequence of tactic applications\n -- in the macro expansion of `<;> : tactic`\n let .ofTacticInfo i ← getPath (.ofTacticInfo i) c\n [⟨1, 0⟩, ⟨2, 1⟩, ⟨1, 0⟩, ⟨5, 0⟩] | none\n guard <| i.goalsAfter.length == 1\n modify fun s => if isBad.isSome then s.insert r { entry with used := true } else s.erase r\n else if i.stx.getKind == ``Parser.Tactic.Conv.«conv_<;>_» then\n let isBad := do\n unless i.goalsBefore.length == 1 || !multigoalAttr.hasTag env i.stx[0].getKind do\n none\n -- Note: this uses the exact sequence of tactic applications\n -- in the macro expansion of `<;> : conv`\n let .ofTacticInfo i ← getPath (.ofTacticInfo i) c\n [⟨1, 0⟩, ⟨1, 0⟩, ⟨1, 0⟩, ⟨1, 0⟩, ⟨1, 0⟩, ⟨2, 1⟩, ⟨1, 0⟩, ⟨5, 0⟩] | none\n guard <| i.goalsAfter.length == 1\n modify fun s => if isBad.isSome then s.insert r { entry with used := true } else s.erase r\n markUsedTacticsList c\n | .context _ t => markUsedTactics t\n | .hole _ => pure ()\n\nend\n\n@[inherit_doc Batteries.Linter.linter.unnecessarySeqFocus]\ndef unnecessarySeqFocusLinter : Linter where run := withSetOptionIn fun stx => do\n unless getLinterUnnecessarySeqFocus (← getLinterOptions) && (← getInfoState).enabled do\n return\n if (← get).messages.hasErrors then\n return\n let trees ← getInfoTrees\n let env ← getEnv\n let go {ω} : M ω Unit := do\n getTactics stx\n markUsedTacticsList env trees\n let (_, map) := runST fun _ => go.run {}\n let unused := map.fold (init := #[]) fun acc r { stx, used } =>\n if used then acc.push (stx[1].getRange?.getD r, stx[1]) else acc\n let key (r : Lean.Syntax.Range) := (r.start.byteIdx, (-r.stop.byteIdx : Int))\n let mut last : Lean.Syntax.Range := ⟨0, 0⟩\n for (r, stx) in let _ := @lexOrd; let _ := @ltOfOrd.{0}; unused.qsort (key ·.1 < key ·.1) do\n if last.start ≤ r.start && r.stop ≤ last.stop then continue\n logLint linter.unnecessarySeqFocus stx\n \"Used `tac1 <;> tac2` where `(tac1; tac2)` would suffice\"\n last := r\n\ninitialize addLinter unnecessarySeqFocusLinter\n" }, { "path": "Batteries/Linter/UnreachableTactic.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.Parser.Syntax\npublic meta import Init.Try\npublic meta import Batteries.Tactic.Unreachable\npublic meta import Lean.Linter.Basic\n\npublic meta section\n\nnamespace Batteries.Linter\nopen Lean Elab Command Linter Std\n\n/--\nEnables the 'unreachable tactic' linter. This will warn on any tactics that are never executed.\nFor example, in `example : True := by trivial <;> done`, the tactic `done` is never executed\nbecause `trivial` produces no subgoals; you could put `sorry` or `apply I_don't_exist`\nor anything else there and no error would result.\n\nA common source of such things is `simp <;> tac` in the case that `simp` improves and\ncloses a subgoal that was previously being closed by `tac`.\n-/\nregister_option linter.unreachableTactic : Bool := {\n defValue := true\n descr := \"enable the 'unreachable tactic' linter\"\n}\n\nnamespace UnreachableTactic\n/-- Gets the value of the `linter.unreachableTactic` option. -/\ndef getLinterUnreachableTactic (o : LinterOptions) : Bool :=\n getLinterValue linter.unreachableTactic o\n\n/-- The monad for collecting used tactic syntaxes. -/\nabbrev M := StateRefT (Std.HashMap Lean.Syntax.Range Syntax) IO\n\n/--\nA list of blacklisted syntax kinds, which are expected to have subterms that contain\nunevaluated tactics.\n-/\ninitialize ignoreTacticKindsRef : IO.Ref NameHashSet ←\n IO.mkRef <| (∅ : NameHashSet)\n |>.insert ``Parser.Term.binderTactic\n |>.insert ``Lean.Parser.Term.dynamicQuot\n |>.insert ``Lean.Parser.Tactic.quotSeq\n |>.insert ``Lean.Parser.Tactic.tacticStop_\n |>.insert ``Lean.Parser.Command.notation\n |>.insert ``Lean.Parser.Command.mixfix\n |>.insert ``Lean.Parser.Command.registerTryTactic\n |>.insert ``Lean.Parser.Tactic.discharger\n\n/-- Is this a syntax kind that contains intentionally unevaluated tactic subterms? -/\ndef isIgnoreTacticKind (ignoreTacticKinds : NameHashSet) (k : SyntaxNodeKind) : Bool :=\n match k with\n | .str _ \"quot\" => true\n | _ => ignoreTacticKinds.contains k\n\n/--\nAdds a new syntax kind whose children will be ignored by the `unreachableTactic` linter.\nThis should be called from an `initialize` block.\n-/\ndef addIgnoreTacticKind (kind : SyntaxNodeKind) : IO Unit :=\n ignoreTacticKindsRef.modify (·.insert kind)\n\nvariable (ignoreTacticKinds : NameHashSet) (isTacKind : SyntaxNodeKind → Bool) in\n/-- Accumulates the set of tactic syntaxes that should be evaluated at least once. -/\n@[specialize] partial def getTactics (stx : Syntax) : M Unit := do\n if let .node _ k args := stx then\n if !isIgnoreTacticKind ignoreTacticKinds k then\n args.forM getTactics\n if isTacKind k then\n if let some r := stx.getRange? true then\n modify fun m => m.insert r stx\n\nmutual\nvariable (isTacKind : SyntaxNodeKind → Bool)\n/-- Search for tactic executions in the info tree and remove executed tactic syntaxes. -/\npartial def eraseUsedTacticsList (trees : PersistentArray InfoTree) : M Unit :=\n trees.forM eraseUsedTactics\n\n/-- Search for tactic executions in the info tree and remove executed tactic syntaxes. -/\npartial def eraseUsedTactics : InfoTree → M Unit\n | .node i c => do\n if let .ofTacticInfo i := i then\n if let some r := i.stx.getRange? true then\n modify (·.erase r)\n eraseUsedTacticsList c\n | .context _ t => eraseUsedTactics t\n | .hole _ => pure ()\n\nend\n\n@[inherit_doc Batteries.Linter.linter.unreachableTactic]\ndef unreachableTacticLinter : Linter where run := withSetOptionIn fun stx => do\n unless getLinterUnreachableTactic (← getLinterOptions) && (← getInfoState).enabled do\n return\n if (← get).messages.hasErrors then\n return\n let cats := (Parser.parserExtension.getState (← getEnv)).categories\n -- These lookups may fail when the linter is run in a fresh, empty environment\n let some tactics := Parser.ParserCategory.kinds <$> cats.find? `tactic\n | return\n let some convs := Parser.ParserCategory.kinds <$> cats.find? `conv\n | return\n let trees ← getInfoTrees\n let go : M Unit := do\n getTactics (← ignoreTacticKindsRef.get) (fun k => tactics.contains k || convs.contains k) stx\n eraseUsedTacticsList trees\n let (_, map) ← go.run {}\n let unreachable := map.toArray\n let key (r : Lean.Syntax.Range) := (r.start.byteIdx, (-r.stop.byteIdx : Int))\n let mut last : Lean.Syntax.Range := ⟨0, 0⟩\n for (r, stx) in let _ := @lexOrd; let _ := @ltOfOrd.{0}; unreachable.qsort (key ·.1 < key ·.1) do\n if stx.getKind ∈ [``Batteries.Tactic.unreachable, ``Batteries.Tactic.unreachableConv] then\n continue\n if last.start ≤ r.start && r.stop ≤ last.stop then continue\n logLint linter.unreachableTactic stx \"this tactic is never executed\"\n last := r\n\ninitialize addLinter unreachableTacticLinter\n" }, { "path": "Batteries/Linter.lean", "content": "module\n\npublic meta import Batteries.Linter.UnreachableTactic\npublic meta import Batteries.Linter.UnnecessarySeqFocus\n" }, { "path": "Batteries/Logic.lean", "content": "/-\nCopyright (c) 2014 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro\n-/\nmodule\n\npublic import Batteries.Tactic.Alias\n\n@[expose] public section\n\ninstance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) :=\n inferInstanceAs <| DecidablePred fun x => p (f x)\n\n/-! ## id -/\n\ntheorem Function.id_def : @id α = fun x => x := rfl\n\n/-! ## decidable -/\n\nprotected alias ⟨Decidable.exists_not_of_not_forall, _⟩ := Decidable.not_forall\n\n/-! ## classical logic -/\n\nnamespace Classical\n\nalias ⟨exists_not_of_not_forall, _⟩ := not_forall\n\nend Classical\n\n/-! ## equality -/\n\ntheorem heq_iff_eq {a b : α} : a ≍ b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩\n\n@[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') :\n (@Eq.rec α a (fun _ _ => β) y a' h) = y := by cases h; rfl\n\ntheorem congrArg₂ (f : α → β → γ) {x x' : α} {y y' : β}\n (hx : x = x') (hy : y = y') : f x y = f x' y' := by subst hx hy; rfl\n\ntheorem congrFun₂ {β : α → Sort _} {γ : ∀ a, β a → Sort _}\n {f g : ∀ a b, γ a b} (h : f = g) (a : α) (b : β a) :\n f a b = g a b :=\n congrFun (congrFun h _) _\n\ntheorem congrFun₃ {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a b, γ a b → Sort _}\n {f g : ∀ a b c, δ a b c} (h : f = g) (a : α) (b : β a) (c : γ a b) :\n f a b c = g a b c :=\n congrFun₂ (congrFun h _) _ _\n\ntheorem funext₂ {β : α → Sort _} {γ : ∀ a, β a → Sort _}\n {f g : ∀ a b, γ a b} (h : ∀ a b, f a b = g a b) : f = g :=\n funext fun _ => funext <| h _\n\ntheorem funext₃ {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a b, γ a b → Sort _}\n {f g : ∀ a b c, δ a b c} (h : ∀ a b c, f a b c = g a b c) : f = g :=\n funext fun _ => funext₂ <| h _\n\nprotected theorem Eq.congr (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) : x₁ = x₂ ↔ y₁ = y₂ := by\n subst h₁; subst h₂; rfl\n\ntheorem Eq.congr_left {x y z : α} (h : x = y) : x = z ↔ y = z := by rw [h]\n\ntheorem Eq.congr_right {x y z : α} (h : x = y) : z = x ↔ z = y := by rw [h]\n\nalias congr_arg := congrArg\nalias congr_arg₂ := congrArg₂\nalias congr_fun := congrFun\nalias congr_fun₂ := congrFun₂\nalias congr_fun₃ := congrFun₃\n\ntheorem heq_of_cast_eq : ∀ (e : α = β) (_ : cast e a = a'), a ≍ a'\n | rfl, rfl => .rfl\n\ntheorem cast_eq_iff_heq : cast e a = a' ↔ a ≍ a' :=\n ⟨heq_of_cast_eq _, fun h => by cases h; rfl⟩\n\ntheorem eqRec_eq_cast {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _}\n (x : motive a rfl) {a' : α} (e : a = a') :\n @Eq.rec α a motive x a' e = cast (e ▸ rfl) x := by\n subst e; rfl\n\n--Porting note: new theorem. More general version of `eqRec_heq`\ntheorem eqRec_heq_self {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _}\n (x : motive a rfl) {a' : α} (e : a = a') : @Eq.rec α a motive x a' e ≍ x := by\n subst e; rfl\n\n@[simp]\ntheorem eqRec_heq_iff_heq {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _}\n {x : motive a rfl} {a' : α} {e : a = a'} {β : Sort _} {y : β} :\n @Eq.rec α a motive x a' e ≍ y ↔ x ≍ y := by\n subst e; rfl\n\n@[simp]\ntheorem heq_eqRec_iff_heq {α : Sort _} {a : α} {motive : (a' : α) → a = a' → Sort _}\n {x : motive a rfl} {a' : α} {e : a = a'} {β : Sort _} {y : β} :\n y ≍ @Eq.rec α a motive x a' e ↔ y ≍ x := by\n subst e; rfl\n\n/-! ## miscellaneous -/\n\n@[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim\n@[simp] theorem not_nonempty_pempty : ¬Nonempty PEmpty := fun ⟨h⟩ => h.elim\n\n-- TODO(Mario): profile first, this is a dangerous instance\n-- instance (priority := 10) {α} [Subsingleton α] : DecidableEq α\n-- | a, b => isTrue (Subsingleton.elim a b)\n\n-- TODO(Mario): profile adding `@[simp]` to `eq_iff_true_of_subsingleton`\n\n/-- If all points are equal to a given point `x`, then `α` is a subsingleton. -/\ntheorem subsingleton_of_forall_eq (x : α) (h : ∀ y, y = x) : Subsingleton α :=\n ⟨fun a b => h a ▸ h b ▸ rfl⟩\n\ntheorem subsingleton_iff_forall_eq (x : α) : Subsingleton α ↔ ∀ y, y = x :=\n ⟨fun _ y => Subsingleton.elim y x, subsingleton_of_forall_eq x⟩\n\ntheorem congr_eqRec {β : α → Sort _} (f : (x : α) → β x → γ) (h : x = x') (y : β x) :\n f x' (Eq.rec y h) = f x y := by cases h; rfl\n" }, { "path": "Batteries/Tactic/Alias.lean", "content": "/-\nCopyright (c) 2017 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, David Renshaw, François G. Dorais\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.Elab.DeclarationRange\npublic meta import Lean.Compiler.NoncomputableAttr\npublic meta import Lean.DocString\npublic meta import Batteries.CodeAction.Deprecated\n\npublic meta section\n\n/-!\n# The `alias` command\n\nThe `alias` command is used to create synonyms. The plain command can create a synonym of any\ndeclaration. There is also a version to create synonyms for the forward and reverse implications of\nan iff theorem.\n-/\n\nnamespace Batteries.Tactic.Alias\n\nopen Lean Elab Parser.Command\n\n/-- An alias can be in one of three forms -/\ninductive AliasInfo where\n /-- Plain alias -/\n | plain (n : Name)\n /-- Forward direction of an iff alias -/\n | forward (n : Name)\n /-- Reverse direction of an iff alias -/\n | reverse (n : Name)\nderiving Inhabited\n\n/-- The name underlying an alias target -/\ndef AliasInfo.name : AliasInfo → Name\n | plain n => n\n | forward n => n\n | reverse n => n\n\n/-- The docstring for an alias. -/\ndef AliasInfo.toString : AliasInfo → String\n | plain n => s!\"**Alias** of `{n}`.\"\n | forward n => s!\"**Alias** of the forward direction of `{n}`.\"\n | reverse n => s!\"**Alias** of the reverse direction of `{n}`.\"\n\n\n/-- Environment extension for registering aliases -/\ninitialize aliasExt : MapDeclarationExtension AliasInfo ← mkMapDeclarationExtension\n\n/-- Get the alias information for a name -/\ndef getAliasInfo [Monad m] [MonadEnv m] (name : Name) : m (Option AliasInfo) := do\n return aliasExt.find? (← getEnv) name\n\n/-- Set the alias info for a new declaration -/\ndef setAliasInfo [MonadEnv m] (info : AliasInfo) (declName : Name) : m Unit :=\n modifyEnv (aliasExt.insert · declName info)\n\n/-- Updates the `deprecated` declaration to point to `target` if no target is provided. -/\ndef setDeprecatedTarget (target : Name) (arr : Array Attribute) : Array Attribute × Bool :=\n StateT.run (m := Id) (s := false) do\n arr.mapM fun s => do\n if s.name == `deprecated then\n if let `(deprecated| deprecated%$tk $[$desc:str]? $[(since := $since)]?) := s.stx then\n set true\n let stx := Unhygienic.run\n `(deprecated| deprecated%$tk $(mkCIdent target) $[$desc:str]? $[(since := $since)]?)\n pure { s with stx }\n else pure s\n else pure s\n\n/--\n The command `alias name := target` creates a synonym of `target` with the given name.\n\n The command `alias ⟨fwd, rev⟩ := target` creates synonyms for the forward and reverse directions\n of an iff theorem. Use `_` if only one direction is required.\n\n These commands accept all modifiers and attributes that `def` and `theorem` do.\n -/\nelab (name := alias) mods:declModifiers \"alias \" alias:ident \" := \" name:ident : command => do\n Lean.withExporting (isExporting := (← Command.getScope).isPublic) do\n Command.liftTermElabM do\n let name ← realizeGlobalConstNoOverloadWithInfo name\n let cinfo ← getConstInfo name\n let declMods ← elabModifiers mods\n Lean.withExporting (isExporting := declMods.isInferredPublic (← getEnv)) do\n let (attrs, machineApplicable) := setDeprecatedTarget name declMods.attrs\n let env ← getEnv\n let declMods := { declMods with\n computeKind :=\n if isNoncomputable env name then .noncomputable\n else if isMarkedMeta env name then .meta\n else declMods.computeKind\n isUnsafe := declMods.isUnsafe || cinfo.isUnsafe\n attrs\n }\n let (declName, _) ← mkDeclName (← getCurrNamespace) declMods alias.getId\n let decl : Declaration := if wasOriginallyTheorem (← getEnv) name then\n .thmDecl { cinfo.toConstantVal with\n name := declName\n value := mkConst name (cinfo.toConstantVal.levelParams.map mkLevelParam)\n }\n else\n .defnDecl { cinfo.toConstantVal with\n name := declName\n value := mkConst name (cinfo.levelParams.map mkLevelParam)\n hints := .regular 0 -- FIXME\n safety := if declMods.isUnsafe then .unsafe else .safe\n }\n checkNotAlreadyDeclared declName\n addDecl decl\n if !declMods.isNoncomputable then\n if declMods.isMeta then\n modifyEnv (markMeta · declName)\n compileDecl decl\n addDeclarationRangesFromSyntax declName (← getRef) alias\n Term.addTermInfo' alias (← mkConstWithLevelParams declName) (isBinder := true)\n if let some (doc, isVerso) := declMods.docString? then\n addDocStringOf isVerso declName (mkNullNode #[]) doc\n enableRealizationsForConst declName\n Term.applyAttributes declName declMods.attrs\n let info := (← getAliasInfo name).getD <| AliasInfo.plain name\n setAliasInfo info declName\n if machineApplicable then\n modifyEnv (machineApplicableDeprecated.tag · declName)\n /- alias doesn't trigger the missing docs linter so we add a default. We can't just check\n `declMods` because a docstring may have been added by an attribute. -/\n if (← findDocString? (← getEnv) declName).isNone then\n let mut doc := info.toString\n if let some origDoc ← findDocString? (← getEnv) name then\n doc := s!\"{doc}\\n\\n---\\n\\n{origDoc}\"\n addDocStringCore declName doc\n\n/--\nGiven a possibly forall-quantified iff expression `prf`, produce a value for one\nof the implication directions (determined by `mp`).\n-/\ndef mkIffMpApp (mp : Bool) (ty prf : Expr) : MetaM Expr := do\n Meta.forallTelescope ty fun xs ty => do\n let some (lhs, rhs) := ty.iff?\n | throwError \"Target theorem must have the form `∀ x y z, a ↔ b`\"\n Meta.mkLambdaFVars xs <|\n mkApp3 (mkConst (if mp then ``Iff.mp else ``Iff.mpr)) lhs rhs (mkAppN prf xs)\n\nprivate def addSide (mp : Bool) (declName : Name) (declMods : Modifiers) (thm : ConstantInfo) :\n TermElabM Unit := do\n checkNotAlreadyDeclared declName\n let value ← mkIffMpApp mp thm.type (mkConst thm.name (thm.levelParams.map mkLevelParam))\n let type ← Meta.inferType value\n addDecl <| Declaration.thmDecl {\n name := declName\n value := value\n type := type\n levelParams := thm.levelParams\n }\n if let some (doc, isVerso) := declMods.docString? then\n addDocStringOf isVerso declName (mkNullNode #[]) doc\n Term.applyAttributes declName declMods.attrs\n let info := match ← getAliasInfo thm.name with\n | some (.plain name) => if mp then AliasInfo.forward name else AliasInfo.reverse name\n | _ => if mp then AliasInfo.forward thm.name else AliasInfo.reverse thm.name\n setAliasInfo info declName\n /- alias doesn't trigger the missing docs linter so we add a default. We can't just check\n `declMods` because a docstring may have been added by an attribute. -/\n if (← findDocString? (← getEnv) declName).isNone then\n let mut doc := info.toString\n if let some origDoc ← findDocString? (← getEnv) thm.name then\n doc := s!\"{doc}\\n\\n---\\n\\n{origDoc}\"\n addDocStringCore declName doc\n\n@[inherit_doc «alias»]\nelab (name := aliasLR) mods:declModifiers \"alias \"\n \"⟨\" aliasFwd:binderIdent \", \" aliasRev:binderIdent \"⟩\" \" := \" name:ident : command => do\n Lean.withExporting (isExporting := (← Command.getScope).isPublic) do\n Command.liftTermElabM do\n let name ← realizeGlobalConstNoOverloadWithInfo name\n let declMods ← elabModifiers mods\n let declMods := { declMods with attrs := (setDeprecatedTarget name declMods.attrs).1 }\n Lean.withExporting (isExporting := declMods.isInferredPublic (← getEnv)) do\n let thm ← getConstInfo name\n if let `(binderIdent| $idFwd:ident) := aliasFwd then\n let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idFwd.getId\n addSide true declName declMods thm\n addDeclarationRangesFromSyntax declName (← getRef) idFwd\n Term.addTermInfo' idFwd (← mkConstWithLevelParams declName) (isBinder := true)\n if let `(binderIdent| $idRev:ident) := aliasRev then\n let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idRev.getId\n addSide false declName declMods thm\n addDeclarationRangesFromSyntax declName (← getRef) idRev\n Term.addTermInfo' idRev (← mkConstWithLevelParams declName) (isBinder := true)\n" }, { "path": "Batteries/Tactic/Basic.lean", "content": "module\n\npublic meta import Lean.Elab.Tactic.ElabTerm\npublic meta import Batteries.Linter\npublic meta import Batteries.Tactic.Init\npublic meta import Batteries.Tactic.SeqFocus\npublic meta import Batteries.Util.ProofWanted\n\n-- This is an import only file for common tactics used throughout Batteries\n" }, { "path": "Batteries/Tactic/Case.lean", "content": "/-\nCopyright (c) 2023 Kyle Miller. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kyle Miller\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.BuiltinTactic\npublic meta import Lean.Elab.Tactic.RenameInaccessibles\n\npublic meta section\n\n/-!\n# Extensions to the `case` tactic\n\nAdds a variant of `case` that looks for a goal with a particular type, rather than a goal\nwith a particular tag.\nFor consistency with `case`, it takes a tag as well, but the tag can be a hole `_`.\n\nAlso adds `case'` extensions.\n-/\n\nnamespace Batteries.Tactic\nopen Lean Meta Elab Tactic\n\n/-- Clause for a `case ... : ...` tactic. -/\nsyntax casePattArg := Parser.Tactic.caseArg (\" : \" term)?\n\n/-- The body of a `case ... | ...` tactic that's a tactic sequence (or hole). -/\nsyntax casePattTac := \" => \" (hole <|> syntheticHole <|> tacticSeq)\n\n/-- The body of a `case ... | ...` tactic that's an exact term. -/\nsyntax casePattExpr := \" := \" colGt term\n\n/-- The body of a `case ... : ...` tactic. -/\nsyntax casePattBody := casePattTac <|> casePattExpr\n\n/--\n* `case _ : t => tac` finds the first goal that unifies with `t` and then solves it\n using `tac` or else fails. Like `show`, it changes the type of the goal to `t`.\n The `_` can optionally be a case tag, in which case it only looks at goals\n whose tag would be considered by `case` (goals with an exact tag match,\n followed by goals with the tag as a suffix, followed by goals with the tag as a prefix).\n\n* `case _ n₁ ... nₘ : t => tac` additionally names the `m` most recent hypotheses with\n inaccessible names to the given names. The names are renamed before matching against `t`.\n The `_` can optionally be a case tag.\n\n* `case _ : t := e` is short for `case _ : t => exact e`.\n\n* `case _ : t₁ | _ : t₂ | ... => tac`\n is equivalent to `(case _ : t₁ => tac); (case _ : t₂ => tac); ...`\n but with all matching done on the original list of goals --\n each goal is consumed as they are matched, so patterns may repeat or overlap.\n\n* `case _ : t` will make the matched goal be the first goal.\n `case _ : t₁ | _ : t₂ | ...` makes the matched goals be the first goals in the given order.\n\n* `case _ : t := _` and `case _ : t := ?m` are the same as `case _ : t` but in the `?m` case the\n goal tag is changed to `m`.\n In particular, the goal becomes metavariable `?m`.\n-/\n-- Low priority so that type-free `case` doesn't conflict with core `case`,\n-- though it should be a drop-in replacement.\nsyntax (name := casePatt) (priority := low)\n \"case \" sepBy1(casePattArg, \" | \") (casePattBody)? : tactic\n\nmacro_rules\n | `(tactic| case $[$ps:casePattArg]|* := $t) => `(tactic| case $[$ps:casePattArg]|* => exact $t)\n | `(tactic| case $[$ps:casePattArg]|*) => `(tactic| case $[$ps:casePattArg]|* => ?_)\n\n/-- `case' _ : t => tac` is similar to the `case _ : t => tac` tactic,\nbut it does not ensure the goal has been solved after applying `tac`,\nnor does it admit the goal if `tac` failed.\nRecall that `case` closes the goal using `sorry` when `tac` fails,\nand the tactic execution is not interrupted. -/\nsyntax (name := casePatt') (priority := low)\n \"case' \" sepBy1(casePattArg, \" | \") casePattTac : tactic\n\n/-- Filter the `mvarIds` by tag. Returns those `MVarId`s that have `tag`\neither as its user name, as a suffix of its user name, or as a prefix of its user name.\nThe results are sorted in this order.\nThis is like `Lean.Elab.Tactic.findTag?` but it returns all results rather than just the first. -/\nprivate def filterTag (mvarIds : List MVarId) (tag : Name) : TacticM (List MVarId) := do\n let gs ← mvarIds.toArray.filterMapM fun mvarId => do\n let userName := (← mvarId.getDecl).userName\n if tag == userName then\n return some (0, mvarId)\n else if tag.isSuffixOf userName then\n return some (1, mvarId)\n else if tag.isPrefixOf userName then\n return some (2, mvarId)\n else\n return none\n -- Insertion sort is a stable sort:\n let gs := gs.insertionSort (·.1 < ·.1)\n return gs |>.map (·.2) |>.toList\n\n/-- Find the first goal among those matching `tag` whose type unifies with `patt`.\nThe `renameI` array consists of names to use to rename inaccessibles.\nThe `patt` term is elaborated in the context where the inaccessibles have been renamed.\n\nReturns the found goal, goals caused by elaborating `patt`, and the remaining goals. -/\ndef findGoalOfPatt (gs : List MVarId)\n (tag : TSyntax ``binderIdent) (patt? : Option Term) (renameI : TSyntaxArray `Lean.binderIdent) :\n TacticM (MVarId × List MVarId × List MVarId) :=\n Term.withoutErrToSorry do\n let fgs ← match tag with\n | `(binderIdent|$tag:ident) => filterTag gs tag.getId\n | _ => pure gs\n for g in fgs do\n let gs := gs.erase g\n if let some patt := patt? then\n let s ← saveState\n try\n let g ← renameInaccessibles g renameI\n -- Make a copy of `g` so that we don't assign type hints to `g` if we don't need to.\n let gCopy ← g.withContext <| mkFreshExprSyntheticOpaqueMVar (← g.getType) (← g.getTag)\n let g' :: gs' ← run gCopy.mvarId! <| withoutRecover <|\n evalTactic (← `(tactic| refine_lift show $patt from ?_))\n | throwNoGoalsToBeSolved -- This should not happen\n -- Avoid assigning the type hint if the original type and the new type are\n -- defeq at reducible transparency.\n if ← g.withContext <| withReducible <| isDefEq (← g.getType) (← g'.getType) then\n g.assign (.mvar g')\n else\n g.assign gCopy\n return (g', gs', gs)\n catch _ =>\n restoreState s\n else\n let g ← renameInaccessibles g renameI\n return (g, [], gs)\n throwError \"\\\n No goals with tag {tag} unify with the term {patt?.getD (← `(_))}, \\\n or too many names provided for renaming inaccessible variables.\"\n\n/-- Given a `casePattBody`, either give a synthetic hole or a tactic sequence\n(along with the syntax for the `=>`).\nConverts holes into synthetic holes since they are processed with `elabTermWithHoles`. -/\ndef processCasePattBody (stx : TSyntax ``casePattTac) :\n TacticM (Term ⊕ (Syntax × TSyntax ``Parser.Tactic.tacticSeq)) := do\n match stx with\n | `(casePattTac| => $t:hole) => return Sum.inl ⟨← withRef t `(?_)⟩\n | `(casePattTac| => $t:syntheticHole) => return Sum.inl ⟨t⟩\n | `(casePattTac| =>%$arr $tac:tacticSeq) => return Sum.inr (arr, tac)\n | _ => throwUnsupportedSyntax\n\n/-- Implementation for `case` and `case'`. -/\ndef evalCase (close : Bool) (stx : Syntax)\n (tags : Array (TSyntax `Lean.binderIdent))\n (hss : Array (TSyntaxArray `Lean.binderIdent))\n (patts? : Array (Option Term))\n (caseBody : TSyntax `Batteries.Tactic.casePattTac) :\n TacticM Unit := do\n let body ← processCasePattBody caseBody\n -- Accumulated goals in the hole cases.\n let mut acc : List MVarId := []\n -- Accumulated goals from refining patterns\n let mut pattref : List MVarId := []\n for tag in tags, hs in hss, patt? in patts? do\n let (g, gs', gs) ← findGoalOfPatt (← getUnsolvedGoals) tag patt? hs\n setGoals gs\n pattref := pattref ++ gs'\n match body with\n | Sum.inl hole =>\n let gs' ← run g <| withRef hole do\n let (val, gs') ← elabTermWithHoles hole (← getMainTarget) `case\n unless ← occursCheck g val do\n throwError \"\\\n 'case' tactic failed, value{indentExpr val}\\n\\\n depends on the main goal metavariable '{Expr.mvar g}'\"\n g.assign val\n setGoals gs'\n acc := acc ++ gs'\n | Sum.inr (arr, tac) =>\n if close then\n if tag matches `(binderIdent|$_:ident) then\n -- If a tag is provided, follow the behavior of the core `case` tactic and clear the tag.\n g.setTag .anonymous\n discard <| run g do\n withCaseRef arr tac do\n closeUsingOrAdmit (withTacticInfoContext stx (evalTactic tac))\n else\n let mvarTag ← g.getTag\n let gs' ← run g <| withCaseRef arr tac (evalTactic tac)\n if let [g'] := gs' then\n -- If a single goal is remaining, follow the core `case'` tactic and preserve the tag.\n g'.setTag mvarTag\n acc := acc ++ gs'\n setGoals (acc ++ pattref ++ (← getUnsolvedGoals))\n\nelab_rules : tactic\n | `(tactic| case $[$tags $hss* $[: $patts?]?]|* $caseBody:casePattTac) => do\n evalCase (close := true) (← getRef) tags hss patts? caseBody\n\nelab_rules : tactic\n | `(tactic| case' $[$tags $hss* $[: $patts?]?]|* $caseBody:casePattTac) => do\n evalCase (close := false) (← getRef) tags hss patts? caseBody\n" }, { "path": "Batteries/Tactic/Congr.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Miyahara Kō\n-/\nmodule\n\npublic meta import Lean.Meta.Tactic.Congr\npublic meta import Lean.Elab.Tactic.Config\npublic meta import Lean.Elab.Tactic.Ext\npublic meta import Lean.Elab.Tactic.RCases\n\npublic meta section\n\n/-! # `congr with` tactic, `rcongr` tactic -/\n\nnamespace Batteries.Tactic\nopen Lean Meta Elab Tactic\n\n/-- Configuration options for `congr` & `rcongr` -/\nstructure Congr.Config where\n /-- If `closePre := true`, it will attempt to close new goals using `Eq.refl`, `HEq.refl`, and\n `assumption` with reducible transparency. -/\n closePre : Bool := true\n /-- If `closePost := true`, it will try again on goals on which `congr` failed to make progress\n with default transparency. -/\n closePost : Bool := true\n\n/-- Function elaborating `Congr.Config` -/\ndeclare_config_elab Congr.elabConfig Congr.Config\n\n@[inherit_doc Lean.Parser.Tactic.congr]\nsyntax (name := congrConfig) \"congr\" Parser.Tactic.config (ppSpace num)? : tactic\n\n/--\nApply congruence (recursively) to goals of the form `⊢ f as = f bs` and `⊢ f as ≍ f bs`.\n* `congr n` controls the depth of the recursive applications.\n This is useful when `congr` is too aggressive in breaking down the goal.\n For example, given `⊢ f (g (x + y)) = f (g (y + x))`,\n `congr` produces the goals `⊢ x = y` and `⊢ y = x`,\n while `congr 2` produces the intended `⊢ x + y = y + x`.\n* If, at any point, a subgoal matches a hypothesis then the subgoal will be closed.\n* You can use `congr with p (: n)?` to call `ext p (: n)?` to all subgoals generated by `congr`.\n For example, if the goal is `⊢ f '' s = g '' s` then `congr with x` generates the goal\n `x : α ⊢ f x = g x`.\n-/\nsyntax (name := congrConfigWith) \"congr\" (Parser.Tactic.config)? (ppSpace colGt num)?\n \" with\" (ppSpace colGt rintroPat)* (\" : \" num)? : tactic\n\nelab_rules : tactic\n | `(tactic| congr $cfg:config $[$n?]?) => do\n let config ← Congr.elabConfig (mkOptionalNode cfg)\n let hugeDepth := 1000000\n let depth := n?.map (·.getNat) |>.getD hugeDepth\n liftMetaTactic fun mvarId =>\n mvarId.congrN depth (closePre := config.closePre) (closePost := config.closePost)\n\nmacro_rules\n | `(tactic| congr $(cfg)? $(depth)? with $ps* $[: $n]?) =>\n match cfg with\n | none => `(tactic| congr $(depth)? <;> ext $ps* $[: $n]?)\n | some cfg => `(tactic| congr $cfg $(depth)? <;> ext $ps* $[: $n]?)\n\n/--\nRecursive core of `rcongr`. Calls `ext pats <;> congr` and then itself recursively,\nunless `ext pats <;> congr` made no progress.\n-/\npartial def rcongrCore (g : MVarId) (config : Congr.Config) (pats : List (TSyntax `rcasesPat))\n (acc : Array MVarId) : TermElabM (Array MVarId) := do\n let mut acc := acc\n for (g, qs) in (← Ext.extCore g pats (failIfUnchanged := false)).2 do\n let s ← saveState\n let gs ← g.congrN 1000000 (closePre := config.closePre) (closePost := config.closePost)\n if ← not <$> g.isAssigned <||> gs.anyM fun g' => return (← g'.getType).eqv (← g.getType) then\n s.restore\n acc := acc.push g\n else\n for g in gs do\n acc ← rcongrCore g config qs acc\n pure acc\n\n/--\nRepeatedly apply `congr` and `ext`, using the given patterns as arguments for `ext`.\n\nThere are two ways this tactic stops:\n* `congr` fails (makes no progress), after having already applied `ext`.\n* `congr` canceled out the last usage of `ext`. In this case, the state is reverted to before\n the `congr` was applied.\n\nFor example, when the goal is\n```\n⊢ (fun x => f x + 3) '' s = (fun x => g x + 3) '' s\n```\nthen `rcongr x` produces the goal\n```\nx : α ⊢ f x = g x\n```\nThis gives the same result as `congr; ext x; congr`.\n\nIn contrast, `congr` would produce\n```\n⊢ (fun x => f x + 3) = (fun x => g x + 3)\n```\nand `congr with x` (or `congr; ext x`) would produce\n```\nx : α ⊢ f x + 3 = g x + 3\n```\n-/\nelab (name := rcongr) \"rcongr\" cfg:((Parser.Tactic.config)?) ps:(ppSpace colGt rintroPat)* :\n tactic => do\n let gs ← rcongrCore (← getMainGoal) (← Congr.elabConfig cfg)\n (RCases.expandRIntroPats ps).toList #[]\n replaceMainGoal gs.toList\n" }, { "path": "Batteries/Tactic/Exact.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Batteries.Tactic.Alias\n\npublic meta section\n\n/-! # `exact` tactic (`MetaM` version) -/\n\nopen Lean Meta\n\n/--\n`MetaM` version of `Lean.Elab.Tactic.evalExact`: add `mvarId := x` to the metavariable assignment.\nThis method wraps `Lean.MVarId.assign`, checking whether `mvarId` is already assigned, and whether\nthe expression has the right type. -/\ndef Lean.MVarId.assignIfDefEq (g : MVarId) (e : Expr) : MetaM Unit := do\n guard <| ← isDefEq (← g.getType) (← inferType e)\n g.checkNotAssigned `assignIfDefEq\n g.assign e\n\n@[deprecated (since := \"2025-04-09\")]\nalias Lean.MVarId.assignIfDefeq := Lean.MVarId.assignIfDefEq\n" }, { "path": "Batteries/Tactic/GeneralizeProofs.lean", "content": "/-\nCopyright (c) 2022 Alex J. Best. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Alex J. Best, Kyle Miller\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.Location\npublic meta import Batteries.Lean.Expr\n\n/-!\n# The `generalize_proofs` tactic\n\nGeneralize any proofs occurring in the goal or in chosen hypotheses,\nreplacing them by local hypotheses.\nWhen these hypotheses are named, this makes it easy to refer to these proofs later in a proof,\ncommonly useful when dealing with functions like `Classical.choose` that produce data from proofs.\nIt is also useful to eliminate proof terms to handle issues with dependent types.\n\nFor example:\n```lean\ndef List.nthLe {α} (l : List α) (n : ℕ) (_h : n < l.length) : α := sorry\nexample : List.nthLe [1, 2] 1 (by simp) = 2 := by\n -- ⊢ [1, 2].nthLe 1 ⋯ = 2\n generalize_proofs h\n -- h : 1 < [1, 2].length\n -- ⊢ [1, 2].nthLe 1 h = 2\n```\n\nThe tactic is similar in spirit to `Lean.Meta.AbstractNestedProofs` in core.\nOne difference is that it the tactic tries to propagate expected types so that\nwe get `1 < [1, 2].length` in the above example rather than `1 < Nat.succ 1`.\n-/\n\npublic meta section\n\nnamespace Batteries.Tactic\nopen Lean Meta Elab Parser.Tactic Elab.Tactic\n\ninitialize registerTraceClass `Tactic.generalize_proofs\n\nnamespace GeneralizeProofs\n\n/--\nConfiguration for the `generalize_proofs` tactic.\n-/\nstructure Config where\n /-- The maximum recursion depth when generalizing proofs.\n When `maxDepth > 0`, then proofs are generalized from the types of the generalized proofs too. -/\n maxDepth : Nat := 8\n /-- When `abstract` is `true`, then the tactic will create universally quantified proofs\n to account for bound variables.\n When it is `false` then such proofs are left alone. -/\n abstract : Bool := true\n /-- (Debugging) When `true`, enables consistency checks. -/\n debug : Bool := false\n\n/-- Elaborates a `Parser.Tactic.config` for `generalize_proofs`. -/\ndeclare_config_elab elabConfig Config\n\n/-- State for the `MGen` monad. -/\nstructure GState where\n /-- Mapping from propositions to an fvar in the local context with that type. -/\n propToFVar : ExprMap Expr\n\n/-- Monad used to generalize proofs.\nCarries `Mathlib.Tactic.GeneralizeProofs.Config` and `Mathlib.Tactic.GeneralizeProofs.State`. -/\nabbrev MGen := ReaderT Config <| StateRefT GState MetaM\n\n/-- Inserts a prop/fvar pair into the `propToFVar` map. -/\ndef MGen.insertFVar (prop fvar : Expr) : MGen Unit :=\n modify fun s => { s with propToFVar := s.propToFVar.insert prop fvar }\n\n/-- Context for the `MAbs` monad. -/\nstructure AContext where\n /-- The local fvars corresponding to bound variables.\n Abstraction needs to be sure that these variables do not appear in abstracted terms. -/\n fvars : Array Expr := #[]\n /-- A copy of `propToFVar` from `GState`. -/\n propToFVar : ExprMap Expr\n /-- The recursion depth, for how many times `visit` is called from within `visitProof. -/\n depth : Nat := 0\n /-- The initial local context, for resetting when recursing. -/\n initLCtx : LocalContext\n /-- The tactic configuration. -/\n config : Config\n\n/-- State for the `MAbs` monad. -/\nstructure AState where\n /-- The prop/proof triples to add to the local context.\n The proofs must not refer to fvars in `fvars`. -/\n generalizations : Array (Expr × Expr) := #[]\n /-- Map version of `generalizations`. Use `MAbs.findProof?` and `MAbs.insertProof`. -/\n propToProof : ExprMap Expr := {}\n\n/--\nMonad used to abstract proofs, to prepare for generalization.\nHas a cache (of expr/type? pairs),\nand it also has a reader context `Mathlib/Tactic/GeneralizeProofs/AContext.lean`\nand a state `Mathlib/Tactic/GeneralizeProofs/AState.lean`.\n-/\nabbrev MAbs := ReaderT AContext <| MonadCacheT (Expr × Option Expr) Expr <| StateRefT AState MetaM\n\n/-- Runs `MAbs` in `MGen`. Returns the value and the `generalizations`. -/\ndef MGen.runMAbs {α : Type} (mx : MAbs α) : MGen (α × Array (Expr × Expr)) := do\n let s ← get\n let (x, s') ← mx\n |>.run { initLCtx := ← getLCtx, propToFVar := s.propToFVar, config := (← read) }\n |>.run |>.run {}\n return (x, s'.generalizations)\n\n/--\nFinds a proof of `prop` by looking at `propToFVar` and `propToProof`.\n-/\ndef MAbs.findProof? (prop : Expr) : MAbs (Option Expr) := do\n if let some pf := (← read).propToFVar[prop]? then\n return pf\n else\n return (← get).propToProof[prop]?\n\n/--\nGeneralize `prop`, where `proof` is its proof.\n-/\ndef MAbs.insertProof (prop pf : Expr) : MAbs Unit := do\n if (← read).config.debug then\n unless ← isDefEq prop (← inferType pf) do\n throwError \"insertProof: proof{indentD pf}does not have type{indentD prop}\"\n unless ← Lean.MetavarContext.isWellFormed (← read).initLCtx pf do\n throwError \"insertProof: proof{indentD pf}\\nis not well-formed in the initial context\\n\\\n fvars: {(← read).fvars}\"\n unless ← Lean.MetavarContext.isWellFormed (← read).initLCtx prop do\n throwError \"insertProof: proof{indentD prop}\\nis not well-formed in the initial context\\n\\\n fvars: {(← read).fvars}\"\n modify fun s =>\n { s with\n generalizations := s.generalizations.push (prop, pf)\n propToProof := s.propToProof.insert prop pf }\n\n/-- Runs `x` with an additional local variable. -/\ndef MAbs.withLocal {α : Type} (fvar : Expr) (x : MAbs α) : MAbs α :=\n withReader (fun r => {r with fvars := r.fvars.push fvar}) x\n\n/-- Runs `x` with an increased recursion depth and the initial local context, clearing `fvars`. -/\ndef MAbs.withRecurse {α : Type} (x : MAbs α) : MAbs α := do\n withLCtx (← read).initLCtx (← getLocalInstances) do\n withReader (fun r => {r with fvars := #[], depth := r.depth + 1}) x\n\n/--\nComputes expected types for each argument to `f`,\ngiven that the type of `mkAppN f args` is supposed to be `ty?`\n(where if `ty?` is none, there's no type to propagate inwards).\n-/\ndef appArgExpectedTypes (f : Expr) (args : Array Expr) (ty? : Option Expr) :\n MetaM (Array (Option Expr)) :=\n withTransparency .all <| withNewMCtxDepth do\n -- Try using the expected type, but (*) below might find a bad solution\n (guard ty?.isSome *> go f args ty?) <|> go f args none\nwhere\n /-- Core implementation for `appArgExpectedTypes`. -/\n go (f : Expr) (args : Array Expr) (ty? : Option Expr) : MetaM (Array (Option Expr)) := do\n -- Metavariables for each argument to `f`:\n let mut margs := #[]\n -- The current type of `mAppN f margs`:\n let mut fty ← inferType f\n -- Whether we have already unified the type `ty?` with `fty` (once `margs` is filled)\n let mut unifiedFTy := false\n for h : i in [0 : args.size] do\n unless i < margs.size do\n let (margs', _, fty') ← forallMetaBoundedTelescope fty (args.size - i)\n if margs'.isEmpty then throwError \"could not make progress at argument {i}\"\n fty := fty'\n margs := margs ++ margs'\n let arg := args[i]\n let marg := margs[i]!\n if !unifiedFTy && margs.size == args.size then\n if let some ty := ty? then\n unifiedFTy := (← observing? <| isDefEq fty ty).getD false -- (*)\n unless ← isDefEq (← inferType marg) (← inferType arg) do\n throwError s!\"failed isDefEq types {i}, {← ppExpr marg}, {← ppExpr arg}\"\n unless ← isDefEq marg arg do\n throwError s!\"failed isDefEq values {i}, {← ppExpr marg}, {← ppExpr arg}\"\n unless ← marg.mvarId!.isAssigned do\n marg.mvarId!.assign arg\n margs.mapM fun marg => do\n -- Note: all mvars introduced by `appArgExpectedTypes` are assigned by this point\n -- so there is no mvar leak.\n return (← instantiateMVars (← inferType marg)).cleanupAnnotations\n\n/--\nDoes `mkLambdaFVars fvars e` but\n1. zeta reduces let bindings\n2. only includes used fvars\n3. returns the list of fvars that were actually abstracted\n-/\ndef mkLambdaFVarsUsedOnly (fvars : Array Expr) (e : Expr) : MetaM (Array Expr × Expr) := do\n let mut e := e\n let mut fvars' : List Expr := []\n for i' in [0:fvars.size] do\n let i := fvars.size - i' - 1\n let fvar := fvars[i]!\n e ← mkLambdaFVars #[fvar] e\n match e with\n | .letE _ _ v b _ =>\n e := b.instantiate1 v\n | .lam _ _ b _ =>\n if b.hasLooseBVars then\n fvars' := fvar :: fvars'\n else\n e := b\n | _ => unreachable!\n return (fvars'.toArray, e)\n\n/--\nAbstract proofs occurring in the expression.\nA proof is *abstracted* if it is of the form `f a b ...` where `a b ...` are bound variables\n(that is, they are variables that are not present in the initial local context)\nand where `f` contains no bound variables.\nIn this form, `f` can be immediately lifted to be a local variable and generalized.\nThe abstracted proofs are recorded in the state.\n\nThis function is careful to track the type of `e` based on where it's used,\nsince the inferred type might be different.\nFor example, `(by simp : 1 < [1, 2].length)` has `1 < Nat.succ 1` as the inferred type,\nbut from knowing it's an argument to `List.nthLe` we can deduce `1 < [1, 2].length`.\n-/\npartial def abstractProofs (e : Expr) (ty? : Option Expr) : MAbs Expr := do\n if (← read).depth ≤ (← read).config.maxDepth then\n MAbs.withRecurse <| visit (← instantiateMVars e) ty?\n else\n return e\nwhere\n /--\n Core implementation of `abstractProofs`.\n -/\n visit (e : Expr) (ty? : Option Expr) : MAbs Expr := do\n trace[Tactic.generalize_proofs] \"visit (fvars := {(← read).fvars}) e is {e}\"\n if (← read).config.debug then\n if let some ty := ty? then\n unless ← isDefEq (← inferType e) ty do\n throwError \"visit: type of{indentD e}\\nis not{indentD ty}\"\n if e.isAtomic then\n return e\n else\n checkCache (e, ty?) fun _ => do\n if ← isProof e then\n visitProof e ty?\n else\n match e with\n | .forallE n t b i =>\n withLocalDecl n i (← visit t none) fun x => MAbs.withLocal x do\n mkForallFVars #[x] (← visit (b.instantiate1 x) none)\n | .lam n t b i => do\n withLocalDecl n i (← visit t none) fun x => MAbs.withLocal x do\n let ty'? ←\n if let some ty := ty? then\n let .forallE _ _ tyB _ ← whnfD ty\n | throwError \"Expecting forall in abstractProofs .lam\"\n pure <| some <| tyB.instantiate1 x\n else\n pure none\n mkLambdaFVars #[x] (← visit (b.instantiate1 x) ty'?)\n | .letE n t v b nondep =>\n let t' ← visit t none\n mapLetDecl n t' (← visit v t') (nondep := nondep) fun x => MAbs.withLocal x do\n visit (b.instantiate1 x) ty?\n | .app .. =>\n e.withApp fun f args => do\n let f' ← visit f none\n let argTys ← appArgExpectedTypes f' args ty?\n let mut args' := #[]\n for arg in args, argTy in argTys do\n args' := args'.push <| ← visit arg argTy\n return mkAppN f' args'\n | .mdata _ b => return e.updateMData! (← visit b ty?)\n -- Giving up propagating expected types for `.proj`, which we shouldn't see anyway:\n | .proj _ _ b => return e.updateProj! (← visit b none)\n | _ => unreachable!\n /--\n Core implementation of abstracting a proof.\n -/\n visitProof (e : Expr) (ty? : Option Expr) : MAbs Expr := do\n let eOrig := e\n let fvars := (← read).fvars\n -- Strip metadata and beta reduce, in case there are some false dependencies\n let e := e.withApp' fun f args => f.beta args\n -- If head is atomic and arguments are bound variables, then it's already abstracted.\n if e.withApp' fun f args => f.isAtomic && args.all fvars.contains then\n return e\n -- Abstract `fvars` out of `e` to make the abstracted proof `pf`\n -- The use of `mkLambdaFVarsUsedOnly` is *key* to make sure that the fvars in `fvars`\n -- don't leak into the expression, since that would poison the cache in `MonadCacheT`.\n let e ←\n if let some ty := ty? then\n if (← read).config.debug then\n unless ← isDefEq ty (← inferType e) do\n throwError m!\"visitProof: incorrectly propagated type{indentD ty}\\nfor{indentD e}\"\n mkExpectedTypeHint e ty\n else pure e\n trace[Tactic.generalize_proofs] \"before mkLambdaFVarsUsedOnly, e = {e}\\nfvars={fvars}\"\n if (← read).config.debug then\n unless ← Lean.MetavarContext.isWellFormed (← getLCtx) e do\n throwError m!\"visitProof: proof{indentD e}\\nis not well-formed in the current context\\n\\\n fvars: {fvars}\"\n let (fvars', pf) ← mkLambdaFVarsUsedOnly fvars e\n if !(← read).config.abstract && !fvars'.isEmpty then\n trace[Tactic.generalize_proofs] \"'abstract' is false and proof uses fvars, not abstracting\"\n return eOrig\n trace[Tactic.generalize_proofs] \"after mkLambdaFVarsUsedOnly, pf = {pf}\\nfvars'={fvars'}\"\n if (← read).config.debug then\n unless ← Lean.MetavarContext.isWellFormed (← read).initLCtx pf do\n throwError m!\"visitProof: proof{indentD pf}\\nis not well-formed in the initial context\\n\\\n fvars: {fvars}\\n{(← mkFreshExprMVar none).mvarId!}\"\n let pfTy ← instantiateMVars (← inferType pf)\n -- Visit the proof type to normalize it and abstract more proofs\n let pfTy ← abstractProofs pfTy none\n -- Check if there is already a recorded proof for this proposition.\n trace[Tactic.generalize_proofs] \"finding {pfTy}\"\n if let some pf' ← MAbs.findProof? pfTy then\n trace[Tactic.generalize_proofs] \"found proof\"\n return mkAppN pf' fvars'\n -- Record the proof in the state and return the proof.\n MAbs.insertProof pfTy pf\n trace[Tactic.generalize_proofs] \"added proof\"\n return mkAppN pf fvars'\n\n/--\nCreate a mapping of all propositions in the local context to their fvars.\n-/\ndef initialPropToFVar : MetaM (ExprMap Expr) := do\n -- Visit decls in reverse order so that in case there are duplicates,\n -- earlier proofs are preferred\n (← getLCtx).foldrM (init := {}) fun decl m => do\n if !decl.isImplementationDetail then\n let ty := (← instantiateMVars decl.type).cleanupAnnotations\n if ← Meta.isProp ty then\n return m.insert ty decl.toExpr\n return m\n\n/--\nGeneralizes the proofs in the type `e` and runs `k` in a local context with these propositions.\nThis continuation `k` is passed\n1. an array of fvars for the propositions\n2. an array of proof terms (extracted from `e`) that prove these propositions\n3. the generalized `e`, which refers to these fvars\n\nThe `propToFVar` map is updated with the new proposition fvars.\n-/\npartial def withGeneralizedProofs {α : Type} [Nonempty α] (e : Expr) (ty? : Option Expr)\n (k : Array Expr → Array Expr → Expr → MGen α) :\n MGen α := do\n let propToFVar := (← get).propToFVar\n trace[Tactic.generalize_proofs] \"pre-abstracted{indentD e}\\npropToFVar: {propToFVar.toArray}\"\n let (e, generalizations) ← MGen.runMAbs <| abstractProofs e ty?\n trace[Tactic.generalize_proofs] \"\\\n post-abstracted{indentD e}\\nnew generalizations: {generalizations}\"\n let rec\n /-- Core loop for `withGeneralizedProofs`, adds generalizations one at a time. -/\n go [Nonempty α] (i : Nat) (fvars pfs : Array Expr)\n (proofToFVar propToFVar : ExprMap Expr) : MGen α := do\n if h : i < generalizations.size then\n let (ty, pf) := generalizations[i]\n let ty := (← instantiateMVars (ty.replace proofToFVar.get?)).cleanupAnnotations\n withLocalDeclD (← mkFreshUserName `pf) ty fun fvar => do\n go (i + 1) (fvars := fvars.push fvar) (pfs := pfs.push pf)\n (proofToFVar := proofToFVar.insert pf fvar)\n (propToFVar := propToFVar.insert ty fvar)\n else\n withNewLocalInstances fvars 0 do\n let e' := e.replace proofToFVar.get?\n trace[Tactic.generalize_proofs] \"after: e' = {e}\"\n modify fun s => { s with propToFVar }\n k fvars pfs e'\n go 0 #[] #[] (proofToFVar := {}) (propToFVar := propToFVar)\n\n/--\nMain loop for `Lean.MVarId.generalizeProofs`.\nThe `fvars` array is the array of fvars to generalize proofs for,\nand `rfvars` is the array of fvars that have been reverted.\nThe `g` metavariable has all of these fvars reverted.\n-/\npartial def generalizeProofsCore\n (g : MVarId) (fvars rfvars : Array FVarId) (target : Bool) :\n MGen (Array Expr × MVarId) :=\n go g 0 #[]\nwhere\n /-- Loop for `generalizeProofsCore`. -/\n go (g : MVarId) (i : Nat) (hs : Array Expr) : MGen (Array Expr × MVarId) := g.withContext do\n let tag ← g.getTag\n if h : i < rfvars.size then\n trace[Tactic.generalize_proofs] \"generalizeProofsCore {i}{g}\\n{(← get).propToFVar.toArray}\"\n let fvar := rfvars[i]\n if fvars.contains fvar then\n -- This is one of the hypotheses that was intentionally reverted.\n let tgt ← instantiateMVars <| ← g.getType\n let ty := (if tgt.isLet then tgt.letType! else tgt.bindingDomain!).cleanupAnnotations\n if ← pure tgt.isLet <&&> Meta.isProp ty then\n -- Clear the proof value (using proof irrelevance) and `go` again\n let tgt' := Expr.forallE tgt.letName! ty tgt.letBody! .default\n let g' ← mkFreshExprSyntheticOpaqueMVar tgt' tag\n g.assign <| .app g' tgt.letValue!\n return ← go g'.mvarId! i hs\n if let some pf := (← get).propToFVar[ty]? then\n -- Eliminate this local hypothesis using the pre-existing proof, using proof irrelevance\n let tgt' := tgt.bindingBody!.instantiate1 pf\n let g' ← mkFreshExprSyntheticOpaqueMVar tgt' tag\n g.assign <| .lam tgt.bindingName! tgt.bindingDomain! g' tgt.bindingInfo!\n return ← go g'.mvarId! (i + 1) hs\n -- Now the main case, handling forall or let\n match tgt with\n | .forallE n t b bi =>\n let prop ← Meta.isProp t\n withGeneralizedProofs t none fun hs' pfs' t' => do\n let t' := t'.cleanupAnnotations\n let tgt' := Expr.forallE n t' b bi\n let g' ← mkFreshExprSyntheticOpaqueMVar tgt' tag\n g.assign <| mkAppN (← mkLambdaFVars hs' g') pfs'\n let (fvar', g') ← g'.mvarId!.intro1P\n g'.withContext do Elab.pushInfoLeaf <|\n .ofFVarAliasInfo { id := fvar', baseId := fvar, userName := ← fvar'.getUserName }\n if prop then\n -- Make this prop available as a proof\n MGen.insertFVar t' (.fvar fvar')\n go g' (i + 1) (hs ++ hs')\n | .letE n t v b nondep =>\n withGeneralizedProofs t none fun hs' pfs' t' => do\n withGeneralizedProofs v t' fun hs'' pfs'' v' => do\n let tgt' := Expr.letE n t' v' b nondep\n let g' ← mkFreshExprSyntheticOpaqueMVar tgt' tag\n g.assign <| mkAppN (← mkLambdaFVars (hs' ++ hs'') g') (pfs' ++ pfs'')\n let (fvar', g') ← g'.mvarId!.intro1P\n g'.withContext do Elab.pushInfoLeaf <|\n .ofFVarAliasInfo { id := fvar', baseId := fvar, userName := ← fvar'.getUserName }\n go g' (i + 1) (hs ++ hs' ++ hs'')\n | _ => unreachable!\n else\n -- This is one of the hypotheses that was incidentally reverted.\n let (fvar', g') ← g.intro1P\n g'.withContext do Elab.pushInfoLeaf <|\n .ofFVarAliasInfo { id := fvar', baseId := fvar, userName := ← fvar'.getUserName }\n go g' (i + 1) hs\n else if target then\n trace[Tactic.generalize_proofs] \"\\\n generalizeProofsCore target{g}\\n{(← get).propToFVar.toArray}\"\n withGeneralizedProofs (← g.getType) none fun hs' pfs' ty' => do\n let g' ← mkFreshExprSyntheticOpaqueMVar ty' tag\n g.assign <| mkAppN (← mkLambdaFVars hs' g') pfs'\n return (hs ++ hs', g'.mvarId!)\n else\n return (hs, g)\n\n\nend GeneralizeProofs\n\n/--\nGeneralize proofs in the hypotheses `fvars` and, if `target` is true, the target.\nReturns the fvars for the generalized proofs and the new goal.\n\nIf a hypothesis is a proposition and a `let` binding, this will clear the value of the let binding.\n\nIf a hypothesis is a proposition that already appears in the local context, it will be eliminated.\n\nOnly *nontrivial* proofs are generalized. These are proofs that aren't of the form `f a b ...`\nwhere `f` is atomic and `a b ...` are bound variables.\nThese sorts of proofs cannot be meaningfully generalized, and also these are the sorts of proofs\nthat are left in a term after generalization.\n-/\npartial def _root_.Lean.MVarId.generalizeProofs\n (g : MVarId) (fvars : Array FVarId) (target : Bool) (config : GeneralizeProofs.Config := {}) :\n MetaM (Array Expr × MVarId) := do\n let (rfvars, g) ← g.revert fvars (clearAuxDeclsInsteadOfRevert := true)\n g.withContext do\n let s := { propToFVar := ← GeneralizeProofs.initialPropToFVar }\n GeneralizeProofs.generalizeProofsCore g fvars rfvars target |>.run config |>.run' s\n\n/--\n`generalize_proofs ids* [at locs]?` generalizes proofs in the current goal,\nturning them into new local hypotheses.\n\n- `generalize_proofs` generalizes proofs in the target.\n- `generalize_proofs at h₁ h₂` generalized proofs in hypotheses `h₁` and `h₂`.\n- `generalize_proofs at *` generalizes proofs in the entire local context.\n- `generalize_proofs pf₁ pf₂ pf₃` uses names `pf₁`, `pf₂`, and `pf₃` for the generalized proofs.\n These can be `_` to not name proofs.\n\nIf a proof is already present in the local context, it will use that rather than create a new\nlocal hypothesis.\n\nWhen doing `generalize_proofs at h`, if `h` is a let binding, its value is cleared,\nand furthermore if `h` duplicates a preceding local hypothesis then it is eliminated.\n\nThe tactic is able to abstract proofs from under binders, creating universally quantified\nproofs in the local context.\nTo disable this, use `generalize_proofs -abstract`.\nThe tactic is also set to recursively abstract proofs from the types of the generalized proofs.\nThis can be controlled with the `maxDepth` configuration option,\nwith `generalize_proofs (config := { maxDepth := 0 })` turning this feature off.\n\nFor example:\n```lean\ndef List.nthLe {α} (l : List α) (n : ℕ) (_h : n < l.length) : α := sorry\nexample : List.nthLe [1, 2] 1 (by simp) = 2 := by\n -- ⊢ [1, 2].nthLe 1 ⋯ = 2\n generalize_proofs h\n -- h : 1 < [1, 2].length\n -- ⊢ [1, 2].nthLe 1 h = 2\n```\n-/\nelab (name := generalizeProofsElab) \"generalize_proofs\" config:Parser.Tactic.optConfig\n hs:(ppSpace colGt binderIdent)* loc?:(location)? : tactic => withMainContext do\n let config ← GeneralizeProofs.elabConfig config\n let (fvars, target) ←\n match expandOptLocation (Lean.mkOptionalNode loc?) with\n | .wildcard => pure ((← getLCtx).getFVarIds, true)\n | .targets t target => pure (← getFVarIds t, target)\n liftMetaTactic1 fun g => do\n let (pfs, g) ← g.generalizeProofs fvars target config\n -- Rename the proofs using `hs` and record info\n g.withContext do\n let mut lctx ← getLCtx\n for h in hs, fvar in pfs do\n if let `(binderIdent| $s:ident) := h then\n lctx := lctx.setUserName fvar.fvarId! s.getId\n Expr.addLocalVarInfoForBinderIdent fvar h\n withLCtx lctx (← getLocalInstances) do\n let g' ← mkFreshExprSyntheticOpaqueMVar (← g.getType) (← g.getTag)\n g.assign g'\n return g'.mvarId!\n\nend Batteries.Tactic\n" }, { "path": "Batteries/Tactic/HelpCmd.lean", "content": "/-\nCopyright (c) 2024 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro, Edward van de Meent\n-/\nmodule\n\npublic meta import Lean.Elab.Syntax\npublic meta import Lean.DocString\npublic meta import Batteries.Util.LibraryNote\n\npublic meta section\n\n/-!\n\n# The `#help` command\n\nThe `#help` command can be used to list all definitions in a variety of extensible aspects of lean.\n\n* `#help option` lists options (used in `set_option myOption`)\n* `#help attr` lists attributes (used in `@[myAttr] def foo := ...`)\n* `#help cats` lists syntax categories (like `term`, `tactic`, `stx` etc)\n* `#help cat C` lists elements of syntax category C\n * `#help term`, `#help tactic`, `#help conv`, `#help command`\n are shorthand for `#help cat term` etc.\n * `#help cat+ C` also shows `elab` and `macro` definitions associated to the syntaxes\n* `#help note \"some note\"` lists library notes for which \"some note\" is a prefix of the label\n\nMost forms take an optional identifier to narrow the search; for example `#help option pp` shows\nonly `pp.*` options. However, `#help cat` makes the identifier mandatory, while `#help note` takes\na mandatory string literal, rather than an identifier.\n\n-/\n\nnamespace Batteries.Tactic\nopen Lean Meta Elab Tactic Command\n\n/--\nThe command `#help option` shows all options that have been defined in the current environment.\nEach option has a format like:\n```\noption pp.all : Bool := false\n (pretty printer) display coercions, implicit parameters, proof terms, fully qualified names,\n universe, and disable beta reduction and notations during pretty printing\n```\nThis says that `pp.all` is an option which can be set to a `Bool` value, and the default value is\n`false`. If an option has been modified from the default using e.g. `set_option pp.all true`,\nit will appear as a `(currently: true)` note next to the option.\n\nThe form `#help option id` will show only options that begin with `id`.\n-/\nsyntax withPosition(\"#help \" colGt &\"option\" (colGt ppSpace Parser.rawIdent)?) : command\n\nprivate def elabHelpOption (id : Option Ident) : CommandElabM Unit := do\n let id := id.map (·.raw.getId.toString false)\n let mut decls : Std.TreeMap _ _ compare := {}\n for (name, decl) in show NameMap OptionDecl from ← getOptionDecls do\n let name := name.toString false\n if let some id := id then\n if !id.isPrefixOf name then\n continue\n decls := decls.insert name decl\n let mut msg := Format.nil\n let opts ← getOptions\n if decls.isEmpty then\n match id with\n | some id => throwError \"no options start with {id}\"\n | none => throwError \"no options found (!)\"\n for (name, decl) in decls do\n let mut msg1 := match decl.defValue with\n | .ofString val => s!\"String := {repr val}\"\n | .ofBool val => s!\"Bool := {repr val}\"\n | .ofName val => s!\"Name := {repr val}\"\n | .ofNat val => s!\"Nat := {repr val}\"\n | .ofInt val => s!\"Int := {repr val}\"\n | .ofSyntax val => s!\"Syntax := {repr val}\"\n if let some val := opts.find? (.mkSimple name) then\n msg1 := s!\"{msg1} (currently: {val})\"\n msg := msg ++ .nest 2 (f!\"option {name} : {msg1}\" ++ .line ++ decl.descr) ++ .line ++ .line\n logInfo msg\n\nelab_rules : command | `(#help option $(id)?) => elabHelpOption id\n\n/--\nThe command `#help attribute` (or the short form `#help attr`) shows all attributes that have been\ndefined in the current environment.\nEach attribute has a format like:\n```\n[inline]: mark definition to always be inlined\n```\nThis says that `inline` is an attribute that can be placed on definitions like\n`@[inline] def foo := 1`. (Individual attributes may have restrictions on where they can be\napplied; see the attribute's documentation for details.) Both the attribute's `descr` field as well\nas the docstring will be displayed here.\n\nThe form `#help attr id` will show only attributes that begin with `id`.\n-/\nsyntax withPosition(\"#help \" colGt (&\"attr\" <|> &\"attribute\")\n (colGt ppSpace Parser.rawIdent)?) : command\n\nprivate def elabHelpAttr (id : Option Ident) : CommandElabM Unit := do\n let id := id.map (·.raw.getId.toString false)\n let mut decls : Std.TreeMap _ _ compare := {}\n /-\n #adaptation_note\n On nightly-2024-06-21, added the `.toList` here:\n without it the requisite `ForIn` instance can't be found.\n -/\n for (name, decl) in (← attributeMapRef.get).toList do\n let name := name.toString false\n if let some id := id then\n if !id.isPrefixOf name then\n continue\n decls := decls.insert name decl\n let mut msg := Format.nil\n let env ← getEnv\n if decls.isEmpty then\n match id with\n | some id => throwError \"no attributes start with {id}\"\n | none => throwError \"no attributes found (!)\"\n for (name, decl) in decls do\n let mut msg1 := s!\"[{name}]: {decl.descr}\"\n if let some doc ← findDocString? env decl.ref then\n msg1 := s!\"{msg1}\\n{doc.trimAscii}\"\n msg := msg ++ .nest 2 msg1 ++ .line ++ .line\n logInfo msg\n\nelab_rules : command\n | `(#help attr $(id)?) => elabHelpAttr id\n | `(#help attribute $(id)?) => elabHelpAttr id\n\n/--\nThe command `#help cats` shows all syntax categories that have been defined in the\ncurrent environment.\nEach syntax has a format like:\n```\ncategory command [Lean.Parser.initFn✝]\n```\nThe name of the syntax category in this case is `command`, and `Lean.Parser.initFn✝` is the\nname of the declaration that introduced it. (It is often an anonymous declaration like this,\nbut you can click to go to the definition.) It also shows the doc string if available.\n\nThe form `#help cats id` will show only syntax categories that begin with `id`.\n-/\nsyntax withPosition(\"#help \" colGt &\"cats\" (colGt ppSpace Parser.rawIdent)?) : command\n\nprivate def elabHelpCats (id : Option Ident) : CommandElabM Unit := do\n let id := id.map (·.raw.getId.toString false)\n let mut decls : Std.TreeMap _ _ compare := {}\n for (name, cat) in (Parser.parserExtension.getState (← getEnv)).categories do\n let name := name.toString false\n if let some id := id then\n if !id.isPrefixOf name then\n continue\n decls := decls.insert name cat\n let mut msg := MessageData.nil\n let env ← getEnv\n if decls.isEmpty then\n match id with\n | some id => throwError \"no syntax categories start with {id}\"\n | none => throwError \"no syntax categories found (!)\"\n for (name, cat) in decls do\n let mut msg1 := m!\"category {name} [{mkConst cat.declName}]\"\n if let some doc ← findDocString? env cat.declName then\n msg1 := msg1 ++ Format.line ++ doc.trimAscii.copy\n msg := msg ++ .nest 2 msg1 ++ (.line ++ .line : Format)\n logInfo msg\n\nelab_rules : command | `(#help cats $(id)?) => elabHelpCats id\n\n/--\nThe command `#help cat C` shows all syntaxes that have been defined in syntax category `C` in the\ncurrent environment.\nEach syntax has a format like:\n```\nsyntax \"first\"... [Parser.tactic.first]\n `first | tac | ...` runs each `tac` until one succeeds, or else fails.\n```\nThe quoted string is the leading token of the syntax, if applicable. It is followed by the full\nname of the syntax (which you can also click to go to the definition), and the documentation.\n\n* The form `#help cat C id` will show only attributes that begin with `id`.\n* The form `#help cat+ C` will also show information about any `macro`s and `elab`s\n associated to the listed syntaxes.\n-/\nsyntax withPosition(\"#help \" colGt &\"cat\" \"+\"? colGt ident\n (colGt ppSpace (Parser.rawIdent <|> str))?) : command\n\nprivate def tokensToList (tks : Parser.FirstTokens) : List String :=\n match tks with\n | .epsilon | .unknown => []\n | .tokens tks | .optTokens tks => tks\n\nprivate def elabHelpCat (more : Option Syntax) (catStx : Ident) (id : Option String) :\n CommandElabM Unit := do\n let mut decls : Std.TreeMap _ _ compare := {}\n let mut rest : Std.TreeMap _ _ compare := {}\n let catName := catStx.getId.eraseMacroScopes\n let categories := (Parser.parserExtension.getState (← getEnv)).categories\n let some cat := categories.find? catName\n | throwErrorAt catStx \"{catStx} is not a syntax category\"\n liftTermElabM <| Term.addCategoryInfo catStx catName\n let mut declsArray : Array (SyntaxNodeKind × List String × Bool) := {}\n let mut tokenUsage : Std.HashMap String Nat := {}\n for (k, _) in cat.kinds do\n let mut used := false\n try\n let (leading, parser) ← liftCoreM <| Parser.mkParserOfConstant categories k\n let tks := tokensToList parser.info.firstTokens\n let tks := tks.filter (· != \"$\") -- filter antiquotations\n -- collect the usage of every token regardless of filtering to make sure that the\n -- token detection is independent of a filter\n for tk in tks.eraseDups do\n tokenUsage := tokenUsage.alter tk fun n => some (n.getD 0 + 1)\n if let some id := id then\n unless tks.any (·.startsWith id) do\n continue\n unless tks.isEmpty do\n used := true\n declsArray := declsArray.push (k, tks, leading)\n catch _ =>\n pure ()\n if !used && id.isNone then\n rest := rest.insert (k.toString false) k\n for (kind, tks, leading) in declsArray do\n -- we choose the first, least common token\n let winnerTk := tks.minOn? (tokenUsage[·]!) |>.get!\n decls := decls.alter winnerTk fun arr => some (arr.getD #[] |>.push (kind, leading))\n let mut msg := MessageData.nil\n if decls.isEmpty && rest.isEmpty then\n match id with\n | some id => throwError \"no {catName} declarations start with {id}\"\n | none => throwError \"no {catName} declarations found\"\n let env ← getEnv\n let addMsg (k : SyntaxNodeKind) (msg msg1 : MessageData) : CommandElabM MessageData := do\n let mut msg1 := msg1\n if let some doc ← findDocString? env k then\n msg1 := msg1 ++ Format.line ++ doc.trimAscii.copy\n msg1 := .nest 2 msg1\n if more.isSome then\n let addElabs {α} (type : String) (attr : KeyedDeclsAttribute α)\n (msg : MessageData) : CommandElabM MessageData := do\n let mut msg := msg\n for e in attr.getEntries env k do\n let x := e.declName\n msg := msg ++ Format.line ++ m!\"+ {type} {mkConst x}\"\n if let some doc ← findDocString? env x then\n msg := msg ++ .nest 2 (Format.line ++ doc.trimAscii.copy)\n pure msg\n msg1 ← addElabs \"macro\" macroAttribute msg1\n match catName with\n | `term => msg1 ← addElabs \"term elab\" Term.termElabAttribute msg1\n | `command => msg1 ← addElabs \"command elab\" commandElabAttribute msg1\n | `tactic | `conv => msg1 ← addElabs \"tactic elab\" tacticElabAttribute msg1\n | _ => pure ()\n return msg ++ msg1 ++ (.line ++ .line : Format)\n for (name, ks) in decls do\n for (k, leading) in ks do\n if leading then\n msg ← addMsg k msg m!\"syntax {repr name}... [{mkConst k}]\"\n else\n msg ← addMsg k msg m!\"syntax ...{repr name}... [{mkConst k}]\"\n for (_, k) in rest do\n msg ← addMsg k msg m!\"syntax ... [{mkConst k}]\"\n logInfo msg\n\nelab_rules : command\n | `(#help cat $[+%$more]? $cat) => elabHelpCat more cat none\n | `(#help cat $[+%$more]? $cat $id:ident) => elabHelpCat more cat (id.getId.toString false)\n | `(#help cat $[+%$more]? $cat $id:str) => elabHelpCat more cat id.getString\n\nopen Lean Parser Batteries.Util.LibraryNote in\n/--\n`#help note \"foo\"` searches for all library notes whose\nlabel starts with \"foo\", then displays those library notes sorted alphabetically by label,\ngrouped by label.\nThe command only displays the library notes that are declared in\nimported files or in the same file above the line containing the command.\n-/\nelab \"#help \" colGt &\"note\" colGt ppSpace name:strLit : command => do\n let env ← getEnv\n\n -- get the library notes from both this and imported files\n let local_entries := (libraryNoteExt.getEntries env).reverse\n let imported_entries := (libraryNoteExt.toEnvExtension.getState env).importedEntries\n\n -- The key for searching and sorting library notes is their value as a string,\n -- without any «escaping using french quotes».\n let key (n : LibraryNoteEntry) := n.toString (escape := false)\n\n -- filter for the appropriate notes while casting to list\n let label_prefix := name.getString\n let imported_entries_filtered := imported_entries.flatten.toList.filterMap\n fun x => if label_prefix.isPrefixOf (key x) then some x else none\n let valid_entries := (imported_entries_filtered ++ local_entries.filterMap\n fun x => if label_prefix.isPrefixOf (key x) then some x else none)\n |>.mergeSort (key · ≤ key ·)\n\n -- display results in a readable style\n if valid_entries.isEmpty then\n logError \"Note not found\"\n else\n logInfo <| \"\\n\\n\".intercalate <|\n ← valid_entries.filterMapM\n fun x => do\n -- Use encoded name (spaces → underscores) for docstring lookup,\n -- matching the declaration name created by `library_note`\n let encodedName := encodeNameForExport x\n let some doc ← findDocString? env <| (`LibraryNote).eraseMacroScopes.append encodedName |\n return none\n return \"library_note \" ++ x.toString (escape := true) ++ \"\\n\" ++\n \"/-- \" ++ doc.trimAscii ++ \" -/\"\n\n/--\nThe command `#help term` shows all term syntaxes that have been defined in the current environment.\nSee `#help cat` for more information.\n-/\nsyntax withPosition(\"#help \" colGt &\"term\" \"+\"?\n (colGt ppSpace (Parser.rawIdent <|> str))?) : command\nmacro_rules\n | `(#help term%$tk $[+%$more]? $(id)?) =>\n `(#help cat$[+%$more]? $(mkIdentFrom tk `term) $(id)?)\n\n/--\nThe command `#help tactic` shows all tactics that have been defined in the current environment.\nSee `#help cat` for more information.\n-/\nsyntax withPosition(\"#help \" colGt &\"tactic\" \"+\"?\n (colGt ppSpace (Parser.rawIdent <|> str))?) : command\nmacro_rules\n | `(#help tactic%$tk $[+%$more]? $(id)?) =>\n `(#help cat$[+%$more]? $(mkIdentFrom tk `tactic) $(id)?)\n\n/--\nThe command `#help conv` shows all tactics that have been defined in the current environment.\nSee `#help cat` for more information.\n-/\nsyntax withPosition(\"#help \" colGt &\"conv\" \"+\"?\n (colGt ppSpace (Parser.rawIdent <|> str))?) : command\nmacro_rules\n | `(#help conv%$tk $[+%$more]? $(id)?) =>\n `(#help cat$[+%$more]? $(mkIdentFrom tk `conv) $(id)?)\n\n/--\nThe command `#help command` shows all commands that have been defined in the current environment.\nSee `#help cat` for more information.\n-/\nsyntax withPosition(\"#help \" colGt &\"command\" \"+\"?\n (colGt ppSpace (Parser.rawIdent <|> str))?) : command\nmacro_rules\n | `(#help command%$tk $[+%$more]? $(id)?) =>\n `(#help cat$[+%$more]? $(mkIdentFrom tk `command) $(id)?)\n" }, { "path": "Batteries/Tactic/Init.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.ElabTerm\npublic meta import Lean.Meta.MatchUtil\n\npublic meta section\n\n/-!\n# Simple tactics that are used throughout Batteries.\n-/\n\nnamespace Batteries.Tactic\nopen Lean Parser.Tactic Elab Elab.Tactic Meta\n\n/--\n`_` in tactic position acts like the `done` tactic: it fails and gives the list\nof goals if there are any. It is useful as a placeholder after starting a tactic block\nsuch as `by _` to make it syntactically correct and show the current goal.\n-/\nmacro \"_\" : tactic => `(tactic| {})\n\n/--\nLike `exact`, but takes a list of terms and checks that all goals are discharged after the tactic.\n-/\nelab (name := exacts) \"exacts \" \"[\" hs:term,* \"]\" : tactic => do\n for stx in hs.getElems do\n evalTactic (← `(tactic| exact $stx))\n evalTactic (← `(tactic| done))\n\n/--\n`by_contra_core` is the component of `by_contra` that turns the goal into the form `p → False`.\n`by_contra h` is defined as `by_contra_core` followed by `rintro h`.\n* If the goal is a negation `¬q`, the goal becomes `q → False`.\n* If the goal has a `Decidable` instance, it uses `Decidable.byContradiction` instead of\n `Classical.byContradiction`.\n-/\nscoped macro \"by_contra_core\" : tactic => `(tactic| first\n | guard_target = Not _; change _ → False\n | refine @Decidable.byContradiction _ _ ?_\n | refine @Classical.byContradiction _ ?_)\n\n/--\n`by_contra h` proves `⊢ p` by contradiction,\nintroducing a hypothesis `h : ¬p` and proving `False`.\n* If `p` is a negation `¬q`, `h : q` will be introduced instead of `¬¬q`.\n* If `p` is decidable, it uses `Decidable.byContradiction` instead of `Classical.byContradiction`.\n* If `h` is omitted, the introduced variable will be called `this`.\n-/\nsyntax (name := byContra) \"by_contra\" (ppSpace colGt rcasesPatMed)? (\" : \" term)? : tactic\n\nmacro_rules\n| `(tactic| by_contra $[$pat?]? $[: $ty?]?) => do\n let pat ← pat?.getDM `(rcasesPatMed| $(mkIdent `this):ident)\n `(tactic| (by_contra_core; rintro ($pat:rcasesPatMed) $[: $ty?]?))\n\n/--\nGiven a proof `h` of `p`, `absurd h` changes the goal to `⊢ ¬ p`.\nIf `p` is a negation `¬q` then the goal is changed to `⊢ q` instead.\n-/\nmacro \"absurd \" h:term : tactic =>\n -- we can't use `( :)` here as that would make `·` behave weirdly.\n `(tactic|\n first\n | refine @absurd _ _ ?_ $h\n | refine @absurd _ _ $h ?_)\n\n/-- `split_ands` applies `And.intro` until it does not make progress. -/\nsyntax \"split_ands\" : tactic\nmacro_rules | `(tactic| split_ands) => `(tactic| repeat' refine And.intro ?_ ?_)\n\n/--\n`fapply e` is like `apply e` but it adds goals in the order they appear,\nrather than putting the dependent goals first.\n-/\nelab \"fapply \" e:term : tactic =>\n evalApplyLikeTactic (·.apply (cfg := {newGoals := .all})) e\n\n/--\n`eapply e` is like `apply e` but it does not add subgoals for variables that appear\nin the types of other goals. Note that this can lead to a failure where there are\nno goals remaining but there are still metavariables in the term:\n```\nexample (h : ∀ x : Nat, x = x → True) : True := by\n eapply h\n rfl\n -- no goals\n-- (kernel) declaration has metavariables '_example'\n```\n-/\nelab \"eapply \" e:term : tactic =>\n evalApplyLikeTactic (·.apply (cfg := {newGoals := .nonDependentOnly})) e\n\n/-- Deprecated variant of `trivial`. -/\nelab (name := triv) \"triv\" : tactic => throwError \"`triv` has been removed; use `trivial` instead\"\n\n/-- `conv` tactic to close a goal using an equality theorem. -/\nmacro (name := Conv.exact) \"exact \" t:term : conv => `(conv| tactic => exact $t)\n\n/-- The `conv` tactic `equals` claims that the currently focused subexpression is equal\n to the given expression, and proves this claim using the given tactic.\n```\nexample (P : (Nat → Nat) → Prop) : P (fun n => n - n) := by\n conv in (_ - _) => equals 0 =>\n -- current goal: ⊢ n - n = 0\n apply Nat.sub_self\n -- current goal: P (fun n => 0)\n```\n-/\nelab (name := Conv.equals) \"equals \" t:term \" => \" tac:tacticSeq : conv => do\n let mvarId ← getMainGoal\n mvarId.withContext do\n let goal ← mvarId.getType\n let some (α, _, rhs) ← matchEq? goal | throwError \"invalid 'conv' goal\"\n let e ← Term.withSynthesize do\n Term.elabTermEnsuringType t (some α)\n unless ← isDefEq rhs e do throwError m!\"failed to resolve{indentExpr rhs}\\n=?={indentExpr e}\"\n evalTactic <| ← `(conv| tactic => · $tac)\n" }, { "path": "Batteries/Tactic/Instances.lean", "content": "/-\nCopyright (c) 2023 Kyle Miller. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kyle Miller\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.PrettyPrinter\n\npublic meta section\n\n/-! # `#instances` command\n\nThe `#instances` command prints lists all instances that apply to the given type, if it is a class.\nIt is similar to `#synth` but it only does the very first step of the instance synthesis algorithm,\nwhich is to enumerate potential instances.\n-/\n\nopen Lean Elab Command Meta\n\nnamespace Batteries.Tactic.Instances\n\n/-- `#instances term` prints all the instances for the given class.\nFor example, `#instances Add _` gives all `Add` instances, and `#instances Add Nat` gives the\n`Nat` instance. The `term` can be any type that can appear in `[...]` binders.\n\nTrailing underscores can be omitted, and `#instances Add` and `#instances Add _` are equivalent;\nthe command adds metavariables until the argument is no longer a function.\n\nThe `#instances` command is closely related to `#synth`, but `#synth` does the full\ninstance synthesis algorithm and `#instances` does the first step of finding potential instances. -/\nelab (name := instancesCmd) tk:\"#instances \" stx:term : command => runTermElabM fun _ => do\n let type ← Term.elabTerm stx none\n -- Throw in missing arguments using metavariables.\n let (args, _, _) ← withDefault <| forallMetaTelescopeReducing (← inferType type)\n -- Use free variables for explicit quantifiers\n withDefault <| forallTelescopeReducing (mkAppN type args) fun _ type => do\n let some className ← isClass? type\n | throwErrorAt stx \"type class instance expected{indentExpr type}\"\n let globalInstances ← getGlobalInstancesIndex\n let result ← globalInstances.getUnify type\n let erasedInstances ← getErasedInstances\n let mut msgs := #[]\n for e in result.insertionSort fun e₁ e₂ => e₁.priority < e₂.priority do\n let Expr.const c _ := e.val | unreachable!\n if erasedInstances.contains c then\n continue\n let mut msg := m!\"\\n\"\n if e.priority != 1000 then -- evalPrio default := 1000\n msg := msg ++ m!\"(prio {e.priority}) \"\n msgs := msgs.push <| msg ++ MessageData.signature c\n for linst in ← getLocalInstances do\n if linst.className == className then\n msgs := msgs.push m!\"(local) {linst.fvar} : {← inferType linst.fvar}\"\n if msgs.isEmpty then\n logInfoAt tk m!\"No instances\"\n else\n let instances := if msgs.size == 1 then \"instance\" else \"instances\"\n logInfoAt tk <| msgs.reverse.foldl (·++·) m!\"{msgs.size} {instances}:\\n\"\n\n@[inherit_doc instancesCmd]\nmacro tk:\"#instances\" bi:(ppSpace bracketedBinder)* \" : \" t:term : command =>\n `(command| variable $bi* in #instances%$tk $t)\n" }, { "path": "Batteries/Tactic/Lemma.lean", "content": "/-\nCopyright (c) 2024 Johan Commelin. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Johan Commelin, Damiano Testa\n-/\nmodule\n\npublic meta import Lean.Meta.Tactic.TryThis\npublic meta import Lean.Elab.Command\n\npublic meta section\n\n/-!\n# Control for `lemma` command\n\nThe `lemma` command exists in `Mathlib`, but not in `Std`.\n\nThis file enforces the convention by introducing a code-action\nto replace `lemma` by `theorem`.\n-/\n\nnamespace Batteries.Tactic.Lemma\n\nopen Lean Elab.Command Meta.Tactic\n\n/-- Enables the use of `lemma` as a synonym for `theorem` -/\nregister_option lang.lemmaCmd : Bool := {\n defValue := false\n descr := \"enable the use of the `lemma` command as a synonym for `theorem`\"\n}\n\n/-- Check whether `lang.lemmaCmd` option is enabled -/\ndef checkLangLemmaCmd (o : Options) : Bool := o.get `lang.lemmaCmd lang.lemmaCmd.defValue\n\n/-- `lemma` is not supported, please use `theorem` instead -/\nsyntax (name := lemmaCmd) declModifiers\n group(\"lemma \" declId ppIndent(declSig) declVal) : command\n\n/-- Elaborator for the `lemma` command, if the option `lang.lemmaCmd` is false the command\nemits a warning and code action instructing the user to use `theorem` instead.-/\n@[command_elab «lemmaCmd»] def elabLemma : CommandElab := fun stx => do\n unless checkLangLemmaCmd (← getOptions) do\n let lemmaStx := stx[1][0]\n Elab.Command.liftTermElabM <|\n TryThis.addSuggestion lemmaStx { suggestion := \"theorem\" }\n logErrorAt lemmaStx\n \"`lemma` is not supported by default, please use `theorem` instead.\\n\\\n Use `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file.\\n\\\n Use the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally.\"\n let out ← Elab.liftMacroM <| do\n let stx := stx.modifyArg 1 fun stx =>\n let stx := stx.modifyArg 0 (mkAtomFrom · \"theorem\" (canonical := true))\n stx.setKind ``Parser.Command.theorem\n pure <| stx.setKind ``Parser.Command.declaration\n Elab.Command.elabCommand out\n" }, { "path": "Batteries/Tactic/Lint/Basic.lean", "content": "/-\nCopyright (c) 2020 Floris van Doorn. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Structure\npublic meta import Lean.Elab.InfoTree.Main\npublic meta import Lean.Elab.Exception\npublic meta import Lean.ExtraModUses\n\npublic meta section\n\nopen Lean Meta\n\nnamespace Batteries.Tactic.Lint\n\n/-!\n# Basic linter types and attributes\n\nThis file defines the basic types and attributes used by the linting\nframework. A linter essentially consists of a function\n`(declaration : Name) → MetaM (Option MessageData)`, this function together with some\nmetadata is stored in the `Linter` structure. We define two attributes:\n\n * `@[env_linter]` applies to a declaration of type `Linter`\n and adds it to the default linter set.\n\n * `@[nolint linterName]` omits the tagged declaration from being checked by\n the linter with name `linterName`.\n-/\n\n/--\nReturns true if `decl` is an automatically generated declaration.\n\nAlso returns true if `decl` is an internal name or created during macro\nexpansion.\n-/\ndef isAutoDecl (decl : Name) : CoreM Bool := do\n if decl.hasMacroScopes then return true\n if decl.isInternal then return true\n let env ← getEnv\n if isReservedName env decl then return true\n if let Name.str n s := decl then\n if (← isAutoDecl n) then return true\n if s.startsWith \"proof_\"\n || s.startsWith \"match_\"\n || s.startsWith \"unsafe_\"\n || s.startsWith \"grind_\"\n then return true\n if env.isConstructor n && s ∈ [\"injEq\", \"inj\", \"sizeOf_spec\", \"elim\", \"noConfusion\"] then\n return true\n if let ConstantInfo.inductInfo _ := (← getEnv).find? n then\n if s.startsWith \"brecOn_\" || s.startsWith \"below_\" then return true\n if s ∈ [casesOnSuffix, recOnSuffix, brecOnSuffix, belowSuffix,\n \"ndrec\", \"ndrecOn\", \"noConfusionType\", \"noConfusion\", \"ofNat\", \"toCtorIdx\", \"ctorIdx\",\n \"ctorElim\", \"ctorElimType\"] then\n return true\n if let some _ := isSubobjectField? env n (.mkSimple s) then\n return true\n -- Coinductive/inductive lattice-theoretic predicates:\n if let ConstantInfo.inductInfo _ := env.find? (Name.str n \"_functor\") then\n if s == \"functor_unfold\" || s == casesOnSuffix || s == \"mutual\" then return true\n if env.isConstructor (Name.str (Name.str n \"_functor\") s) then return true\n pure false\n\n/-- A linting test for the `#lint` command. -/\nstructure Linter where\n /-- `test` defines a test to perform on every declaration. It should never fail. Returning `none`\n signifies a passing test. Returning `some msg` reports a failing test with error `msg`. -/\n test : Name → MetaM (Option MessageData)\n /-- `noErrorsFound` is the message printed when all tests are negative -/\n noErrorsFound : MessageData\n /-- `errorsFound` is printed when at least one test is positive -/\n errorsFound : MessageData\n /-- If `isFast` is false, this test will be omitted from `#lint-`. -/\n isFast := true\n\n/-- A `NamedLinter` is a linter associated to a particular declaration. -/\nstructure NamedLinter extends Linter where\n /-- The name of the named linter. This is just the declaration name without the namespace. -/\n name : Name\n /-- The linter declaration name -/\n declName : Name\n\n/-- Gets a linter by declaration name. -/\ndef getLinter (name declName : Name) : CoreM NamedLinter := unsafe\n return { ← evalConstCheck Linter ``Linter declName with name, declName }\n\n/-- Defines the `env_linter` extension for adding a linter to the default set. -/\ninitialize batteriesLinterExt :\n SimplePersistentEnvExtension (Name × Bool) (NameMap (Name × Bool)) ←\n let addEntryFn := fun m (n, b) => m.insert (n.updatePrefix .anonymous) (n, b)\n registerSimplePersistentEnvExtension {\n addImportedFn := fun nss =>\n nss.foldl (init := {}) fun m ns => ns.foldl (init := m) addEntryFn\n addEntryFn\n }\n\n/--\nDefines the `@[env_linter]` attribute for adding a linter to the default set.\nThe form `@[env_linter disabled]` will not add the linter to the default set,\nbut it will be shown by `#list_linters` and can be selected by the `#lint` command.\n\nLinters are named using their declaration names, without the namespace. These must be distinct.\n-/\nsyntax (name := env_linter) \"env_linter\" &\" disabled\"? : attr\n\ninitialize registerBuiltinAttribute {\n name := `env_linter\n descr := \"Use this declaration as a linting test in #lint\"\n add := fun decl stx kind => do\n let dflt := stx[1].isNone\n unless kind == .global do throwError \"invalid attribute `env_linter`, must be global\"\n let shortName := decl.updatePrefix .anonymous\n if let some (declName, _) := (batteriesLinterExt.getState (← getEnv)).find? shortName then\n Elab.addConstInfo stx declName\n throwError\n \"invalid attribute `env_linter`, linter `{shortName}` has already been declared\"\n /- Just as `env_linter`s must be `global`, they also must be accessible from `#lint`, and thus\n must be `public` and `meta`.\n\n `Linter.mk` is already `meta` and thus will likely cause an error anyway, but the explicit\n instruction to mark this declaration `meta` might help the user resolve that and similar\n errors. -/\n let isPublic := !isPrivateName decl; let isMeta := isMarkedMeta (← getEnv) decl\n unless isPublic && isMeta do\n throwError \"invalid attribute `env_linter`, \\\n declaration `{.ofConstName decl}` must be marked as `public` and `meta`\\\n {if isPublic then \" but is only marked `public`\" else \"\"}\\\n {if isMeta then \" but is only marked `meta`\" else \"\"}\"\n let constInfo ← getConstInfo decl\n unless ← (isDefEq constInfo.type (mkConst ``Linter)).run' do\n throwError \"`{.ofConstName decl}` must have type `{.ofConstName ``Linter}`, got \\\n `{constInfo.type}`\"\n modifyEnv fun env => batteriesLinterExt.addEntry env (decl, dflt)\n}\n\n/-- `@[nolint linterName]` omits the tagged declaration from being checked by\nthe linter with name `linterName`. -/\nsyntax (name := nolint) \"nolint\" (ppSpace ident)+ : attr\n\n/-- Defines the user attribute `nolint` for skipping `#lint` -/\ninitialize nolintAttr : ParametricAttribute (Array Name) ←\n registerParametricAttribute {\n name := `nolint\n descr := \"Do not report this declaration in any of the tests of `#lint`\"\n getParam := fun _ => fun\n | `(attr| nolint $[$ids]*) => ids.mapM fun id => withRef id <| do\n let shortName := id.getId.eraseMacroScopes\n let some (declName, _) := (batteriesLinterExt.getState (← getEnv)).find? shortName\n | throwError \"linter '{shortName}' not found\"\n Elab.addConstInfo id declName\n recordExtraModUseFromDecl (isMeta := false) declName\n pure shortName\n | _ => Elab.throwUnsupportedSyntax\n }\n\n/-- Returns true if `decl` should be checked\nusing `linter`, i.e., if there is no `nolint` attribute. -/\ndef shouldBeLinted [Monad m] [MonadEnv m] (linter : Name) (decl : Name) : m Bool :=\n return !((nolintAttr.getParam? (← getEnv) decl).getD #[]).contains linter\n" }, { "path": "Batteries/Tactic/Lint/Frontend.lean", "content": "/-\nCopyright (c) 2020 Floris van Doorn. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Batteries.Tactic.Lint.Basic\n\npublic meta section\n\n/-!\n# Linter frontend and commands\n\nThis file defines the linter commands which spot common mistakes in the code.\n* `#lint`: check all declarations in the current file\n* `#lint in Pkg`: check all declarations in the package `Pkg`\n (so excluding core or other projects, and also excluding the current file)\n* `#lint in all`: check all declarations in the environment\n (the current file and all imported files)\n\nFor a list of default / non-default linters, see the \"Linting Commands\" user command doc entry.\n\nThe command `#list_linters` prints a list of the names of all available linters.\n\nYou can append a `*` to any command (e.g. `#lint* in Batteries`) to omit the slow tests.\n\nYou can append a `-` to any command (e.g. `#lint- in Batteries`) to run a silent lint\nthat suppresses the output if all checks pass.\nA silent lint will fail if any test fails.\n\nYou can append a `+` to any command (e.g. `#lint+ in Batteries`) to run a verbose lint\nthat reports the result of each linter, including the successes.\n\nYou can append a sequence of linter names to any command to run extra tests, in addition to the\ndefault ones. e.g. `#lint doc_blame_thm` will run all default tests and `doc_blame_thm`.\n\nYou can append `only name1 name2 ...` to any command to run a subset of linters, e.g.\n`#lint only unused_arguments in Batteries`\n\nYou can add custom linters by defining a term of type `Linter` with the\n`@[env_linter]` attribute.\nA linter defined with the name `Batteries.Tactic.Lint.myNewCheck` can be run with `#lint myNewCheck`\nor `#lint only myNewCheck`.\nIf you add the attribute `@[env_linter disabled]` to `linter.myNewCheck` it will be\nregistered, but not run by default.\n\nAdding the attribute `@[nolint doc_blame unused_arguments]` to a declaration\nomits it from only the specified linter checks.\n\n## Tags\n\nsanity check, lint, cleanup, command, tactic\n-/\n\nnamespace Batteries.Tactic.Lint\nopen Lean Elab Command\n\n/-- Verbosity for the linter output. -/\ninductive LintVerbosity\n /-- `low`: only print failing checks, print nothing on success. -/\n | low\n /-- `medium`: only print failing checks, print confirmation on success. -/\n | medium\n /-- `high`: print output of every check. -/\n | high\n deriving Inhabited, DecidableEq, Repr\n\n/-- `getChecks slow runOnly runAlways` produces a list of linters.\n`runOnly` is an optional list of names that should resolve to declarations with type `NamedLinter`.\nIf populated, only these linters are run (regardless of the default configuration).\n`runAlways` is an optional list of names that should resolve to declarations with type\n`NamedLinter`. If populated, these linters are always run (regardless of their configuration).\nSpecifying a linter in `runAlways` but not `runOnly` is an error.\nOtherwise, it uses all enabled linters in the environment tagged with `@[env_linter]`.\nIf `slow` is false, it only uses the fast default tests. -/\ndef getChecks (slow : Bool) (runOnly : Option (List Name)) (runAlways : Option (List Name)) :\n CoreM (Array NamedLinter) := do\n let mut result := #[]\n for (name, declName, default) in batteriesLinterExt.getState (← getEnv) do\n let shouldRun := match (runOnly, runAlways) with\n | (some only, some always) => only.contains name && (always.contains name || default)\n | (some only, none) => only.contains name\n | (none, some always) => default || always.contains name\n | _ => default\n if shouldRun then\n let linter ← getLinter name declName\n if slow || linter.isFast then\n let _ := Inhabited.mk linter\n result := result.binInsert (·.name.lt ·.name) linter\n pure result\n\n/-- Traces via `IO.println` if `inIO` is `true`, and via `trace[...]` otherwise. It seems that\n`trace` messages in a running `CoreM` are not propagated through to `IO` in the current setup. We\nuse `IO.println` directly instead of running `printTraces` at the end of our `CoreM` action so that\ntrace messages are printed to stdout immediately, and are not lost if any part of the action hangs.\n\nThis declaration is `macro_inline`, so it should have the same thunky behavior as `trace[...]`. -/\n@[macro_inline, expose]\ndef traceLintCore (msg : String) (inIO : Bool) : CoreM Unit := do\n if inIO then\n if ← getBoolOption `trace.Batteries.Lint then\n IO.println msg\n else\n trace[Batteries.Lint] msg\n\n/-- Traces via `IO.println` if `inIO` is `true`, and via `trace[...]` otherwise. Prepends\n`currentModule` and `linter` (if present).\n\nThis declaration is `macro_inline`, so it should have the same thunky behavior as `trace[...]`. -/\n@[macro_inline, expose]\ndef traceLint (msg : String) (inIO : Bool) (currentModule linterName : Option Name := none) :\n CoreM Unit :=\n traceLintCore (inIO := inIO)\n s!\"{if let some m := currentModule then s!\"[{m}] \" else \"\"}\\\n {if let some l := linterName then s!\"- {l}: \" else \"\"}\\\n {msg}\"\n\n/--\nRuns all the specified linters on all the specified declarations in parallel,\nproducing a list of results.\n-/\ndef lintCore (decls : Array Name) (linters : Array NamedLinter)\n -- For tracing:\n (currentModule : Option Name := none) (inIO : Bool := false) :\n CoreM (Array (NamedLinter × Std.HashMap Name MessageData)) := do\n traceLint\n s!\"Running linters:\\n {\"\\n \".intercalate <| linters.map (s!\"{·.name}\") |>.toList}\"\n inIO currentModule\n\n let tasks : Array (NamedLinter × Array (Name × Task (Except Exception <| Option MessageData))) ←\n linters.mapM fun linter => do\n traceLint \"(0/2) Starting...\" inIO currentModule linter.name\n let decls ← decls.filterM (shouldBeLinted linter.name)\n (linter, ·) <$> decls.mapM fun decl => (decl, ·) <$> do\n let act : MetaM (Option MessageData) := do\n let result ← linter.test decl\n if inIO then\n -- Ensure any trace messages are propagated to stdout\n printTraces\n return result\n EIO.asTask <| (← Core.wrapAsync (fun _ =>\n act |>.run' mkMetaContext -- We use the context used by `Command.liftTermElabM`\n ) (cancelTk? := none)) ()\n\n let result ← tasks.mapM fun (linter, decls) => do\n traceLint \"(1/2) Getting...\" inIO currentModule linter.name\n let mut msgs : Std.HashMap Name MessageData := {}\n for (declName, msgTask) in decls do\n let msg? ← match msgTask.get with\n | Except.ok msg? => pure msg?\n | Except.error err => pure m!\"LINTER FAILED:\\n{err.toMessageData}\"\n\n if let .some msg := msg? then\n msgs := msgs.insert declName msg\n traceLint\n s!\"(2/2) {if msgs.isEmpty then \"Passed!\" else\n s!\"Failed with {msgs.size} messages\\\n {if inIO then \", but these may include declarations in `nolints.json`\" else \"\"}.\"}\"\n inIO currentModule linter.name\n pure (linter, msgs)\n traceLint \"Completed linting!\" inIO currentModule\n return result\n\n\n/-- Sorts a map with declaration keys as names by line number. -/\ndef sortResults (results : Std.HashMap Name α) : CoreM <| Array (Name × α) := do\n let mut key : Std.HashMap Name Nat := {}\n for (n, _) in results.toArray do\n if let some range ← findDeclarationRanges? n then\n key := key.insert n <| range.range.pos.line\n pure $ results.toArray.qsort fun (a, _) (b, _) => key.getD a 0 < key.getD b 0\n\n/-- Formats a linter warning as `#check` command with comment. -/\ndef printWarning (declName : Name) (warning : MessageData) (useErrorFormat : Bool := false)\n (filePath : System.FilePath := default) : CoreM MessageData := do\n if useErrorFormat then\n if let some range ← findDeclarationRanges? declName then\n let msg ← addMessageContextPartial\n m!\"{filePath}:{range.range.pos.line}:{range.range.pos.column + 1}: error: {\n ← mkConstWithLevelParams declName} {warning}\"\n return msg\n addMessageContextPartial m!\"#check {← mkConstWithLevelParams declName} /- {warning} -/\"\n\n/-- Formats a map of linter warnings using `print_warning`, sorted by line number. -/\ndef printWarnings (results : Std.HashMap Name MessageData) (filePath : System.FilePath := default)\n (useErrorFormat : Bool := false) : CoreM MessageData := do\n (MessageData.joinSep ·.toList Format.line) <$>\n (← sortResults results).mapM fun (declName, warning) =>\n printWarning declName warning (useErrorFormat := useErrorFormat) (filePath := filePath)\n\n/--\nFormats a map of linter warnings grouped by filename with `-- filename` comments.\nThe first `drop_fn_chars` characters are stripped from the filename.\n-/\ndef groupedByFilename (results : Std.HashMap Name MessageData) (useErrorFormat : Bool := false) :\n CoreM MessageData := do\n let sp ← if useErrorFormat then getSrcSearchPath else pure {}\n let grouped : Std.HashMap Name (System.FilePath × Std.HashMap Name MessageData) ←\n results.foldM (init := {}) fun grouped declName msg => do\n let mod ← findModuleOf? declName\n let mod := mod.getD (← getEnv).mainModule\n grouped.insert mod <$>\n match grouped[mod]? with\n | some (fp, msgs) => pure (fp, msgs.insert declName msg)\n | none => do\n let fp ← if useErrorFormat then\n pure <| (← sp.findWithExt \"lean\" mod).getD (modToFilePath \".\" mod \"lean\")\n else pure default\n pure (fp, .insert {} declName msg)\n let grouped' := grouped.toArray.qsort fun (a, _) (b, _) => toString a < toString b\n (MessageData.joinSep · (Format.line ++ Format.line)) <$>\n grouped'.toList.mapM fun (mod, fp, msgs) => do\n pure m!\"-- {mod}\\n{← printWarnings msgs (filePath := fp) (useErrorFormat := useErrorFormat)}\"\n\n/--\nFormats the linter results as Lean code with comments and `#check` commands.\n-/\ndef formatLinterResults\n (results : Array (NamedLinter × Std.HashMap Name MessageData))\n (decls : Array Name)\n (groupByFilename : Bool)\n (whereDesc : String) (runSlowLinters : Bool)\n (verbose : LintVerbosity) (numLinters : Nat) (useErrorFormat : Bool := false) :\n CoreM MessageData := do\n let formattedResults ← results.filterMapM fun (linter, results) => do\n if !results.isEmpty then\n let warnings ←\n if groupByFilename || useErrorFormat then\n groupedByFilename results (useErrorFormat := useErrorFormat)\n else\n printWarnings results\n pure $ some m!\"/- The `{linter.name}` linter reports:\\n{linter.errorsFound} -/\\n{warnings}\\n\"\n else if verbose = LintVerbosity.high then\n pure $ some m!\"/- OK: {linter.noErrorsFound} -/\"\n else\n pure none\n let mut s := MessageData.joinSep formattedResults.toList Format.line\n let numAutoDecls := (← decls.filterM isAutoDecl).size\n let failed := results.map (·.2.size) |>.foldl (·+·) 0\n unless verbose matches LintVerbosity.low do\n s := m!\"-- Found {failed} error{if failed == 1 then \"\" else \"s\"\n } in {decls.size - numAutoDecls} declarations (plus {\n numAutoDecls} automatically generated ones) {whereDesc\n } with {numLinters} linters\\n\\n{s}\"\n unless runSlowLinters do s := m!\"{s}-- (slow linters skipped)\\n\"\n pure s\n\n/-- Get the list of declarations in the current module. -/\ndef getDeclsInCurrModule : CoreM (Array Name) := do\n pure $ (← getEnv).constants.map₂.foldl (init := #[]) fun r k _ => r.push k\n\n/-- Get the list of all declarations in the environment. -/\ndef getAllDecls : CoreM (Array Name) := do\n pure $ (← getEnv).constants.map₁.fold (init := ← getDeclsInCurrModule) fun r k _ => r.push k\n\n/-- Get the list of all declarations in the specified package. -/\ndef getDeclsInPackage (pkg : Name) : CoreM (Array Name) := do\n let env ← getEnv\n let mut decls ← getDeclsInCurrModule\n let modules := env.header.moduleNames.map (pkg.isPrefixOf ·)\n return env.constants.map₁.fold (init := decls) fun decls declName _ =>\n if modules[env.const2ModIdx[declName]?.get!]! then\n decls.push declName\n else decls\n\n/-- The `in foo` config argument allows running the linter on a specified project. -/\nsyntax inProject := \" in \" ident\n\nopen Elab Command in\n/-- The command `#lint` runs the linters on the current file (by default).\n\n`#lint only someLinter` can be used to run only a single linter. -/\nelab tk:\"#lint\" verbosity:(\"+\" <|> \"-\")? fast:\"*\"? only:(&\" only\")?\n linters:(ppSpace ident)* project:(inProject)? : command => do\n let (decls, whereDesc, groupByFilename) ← match project with\n | none => do pure (← liftCoreM getDeclsInCurrModule, \"in the current file\", false)\n | some cfg => match cfg with\n | `(inProject| in $id) =>\n let id := id.getId.eraseMacroScopes\n if id == `all then\n pure (← liftCoreM getAllDecls, \"in all files\", true)\n else\n pure (← liftCoreM (getDeclsInPackage id), s!\"in {id}\", true)\n | _ => throwUnsupportedSyntax\n let verbosity : LintVerbosity ← match verbosity with\n | none => pure .medium\n | some ⟨.node _ `token.«+» _⟩ => pure .high\n | some ⟨.node _ `token.«-» _⟩ => pure .low\n | _ => throwUnsupportedSyntax\n let fast := fast.isSome\n let onlyNames : Option (List Name) := match only.isSome with\n | true => some (linters.map fun l => l.getId).toList\n | false => none\n let linters ← liftCoreM do\n let mut result ← getChecks (slow := !fast) (runOnly := onlyNames) none\n let linterState := batteriesLinterExt.getState (← getEnv)\n for id in linters do\n let name := id.getId.eraseMacroScopes\n let some (declName, _) := linterState.find? name | throwErrorAt id \"not a linter: {name}\"\n Elab.addConstInfo id declName\n let linter ← getLinter name declName\n result := result.binInsert (·.name.lt ·.name) linter\n pure result\n let results ← liftCoreM <| lintCore decls linters\n let failed := results.any (!·.2.isEmpty)\n let mut fmtResults ← liftCoreM <|\n formatLinterResults results decls (groupByFilename := groupByFilename)\n whereDesc (runSlowLinters := !fast) verbosity linters.size\n if failed then\n logError fmtResults\n else if verbosity != LintVerbosity.low then\n logInfoAt tk m!\"{fmtResults}\\n-- All linting checks passed!\"\n\nopen Elab Command in\n/-- The command `#list_linters` prints a list of all available linters. -/\nelab \"#list_linters\" : command => do\n let mut result := #[]\n for (name, _, dflt) in batteriesLinterExt.getState (← getEnv) do\n result := result.binInsert (·.1.lt ·.1) (name, dflt)\n let mut msg := m!\"Available linters (linters marked with (*) are in the default lint set):\"\n for (name, dflt) in result do\n msg := msg ++ m!\"\\n{name}{if dflt then \" (*)\" else \"\"}\"\n logInfo msg\n\ninitialize registerTraceClass `Batteries.Lint\n" }, { "path": "Batteries/Tactic/Lint/Misc.lean", "content": "/-\nCopyright (c) 2020 Floris van Doorn. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Floris van Doorn, Robert Y. Lewis, Arthur Paulino, Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Util.CollectLevelParams\npublic meta import Lean.Util.ForEachExpr\npublic meta import Lean.Meta.Check\npublic meta import Lean.Meta.Instances\npublic meta import Lean.Util.Recognizers\npublic meta import Lean.DocString\npublic meta import Batteries.Tactic.Lint.Basic\n\npublic meta section\n\nopen Lean Meta Std\n\nnamespace Batteries.Tactic.Lint\n\n/-!\n# Various linters\n\nThis file defines several small linters.\n-/\n\n/-- A linter for checking whether a declaration has a namespace twice consecutively in its name. -/\n@[env_linter] def dupNamespace : Linter where\n noErrorsFound := \"No declarations have a duplicate namespace.\"\n errorsFound := \"DUPLICATED NAMESPACES IN NAME:\"\n test declName := do\n if ← isAutoDecl declName then return none\n if ← isImplicitReducible declName then return none\n let nm := declName.components\n let some (dup, _) := nm.zip nm.tail! |>.find? fun (x, y) => x == y\n | return none\n return m!\"The namespace {dup} is duplicated in the name\"\n\n/-- A linter for checking for unused arguments.\nWe skip all declarations that contain `sorry` in their value. -/\n@[env_linter] def unusedArguments : Linter where\n noErrorsFound := \"No unused arguments.\"\n errorsFound := \"UNUSED ARGUMENTS.\"\n test declName := do\n if ← isAutoDecl declName then return none\n if ← isProjectionFn declName then return none\n let info ← getConstInfo declName\n let ty := info.type\n let some val := info.value? | return none\n if val.hasSorry || ty.hasSorry then return none\n forallTelescope ty fun args ty => do\n let mut e := (mkAppN val args).headBeta\n e := mkApp e ty\n for arg in args do\n let ldecl ← getFVarLocalDecl arg\n e := mkApp e ldecl.type\n if let some val := ldecl.value? then\n e := mkApp e val\n let unused := args.zip (.range args.size) |>.filter fun (arg, _) =>\n !e.containsFVar arg.fvarId!\n if unused.isEmpty then return none\n addMessageContextFull <| .joinSep (← unused.toList.mapM fun (arg, i) =>\n return m!\"argument {i+1} {arg} : {← inferType arg}\") m!\", \"\n\n/-- A linter for checking definition doc strings. -/\n@[env_linter] def docBlame : Linter where\n noErrorsFound := \"No definitions are missing documentation.\"\n errorsFound := \"DEFINITIONS ARE MISSING DOCUMENTATION STRINGS:\"\n test declName := do\n -- leanprover/lean4#12263: isGlobalInstance was removed, use isInstance instead\n if (← isAutoDecl declName) || (← isInstance declName) then\n return none -- FIXME: scoped/local instances should also not be linted\n if let .str p _ := declName then\n if ← isInstance p then\n -- auxillary functions for instances should not be linted\n return none\n if let .str _ s := declName then\n if s == \"parenthesizer\" || s == \"formatter\" || s == \"delaborator\" || s == \"quot\" then\n return none\n let kind ← match ← getConstInfo declName with\n | .axiomInfo .. => pure \"axiom\"\n | .opaqueInfo .. => pure \"constant\"\n | .defnInfo info =>\n -- leanprover/lean4#2575: Prop projections are generated as `def`s\n if ← isProjectionFn declName <&&> isProp info.type then\n return none\n pure \"definition\"\n | .inductInfo .. => pure \"inductive\"\n | _ => return none\n let (none) ← findDocString? (← getEnv) declName | return none\n return m!\"{kind} missing documentation string\"\n\n/-- A linter for checking theorem doc strings. -/\n@[env_linter disabled] def docBlameThm : Linter where\n noErrorsFound := \"No theorems are missing documentation.\"\n errorsFound := \"THEOREMS ARE MISSING DOCUMENTATION STRINGS:\"\n test declName := do\n if ← isAutoDecl declName then\n return none\n let kind ← match ← getConstInfo declName with\n | .thmInfo .. => pure \"theorem\"\n | .defnInfo info =>\n -- leanprover/lean4#2575:\n -- projections are generated as `def`s even when they should be `theorem`s\n if ← isProjectionFn declName <&&> isProp info.type then\n pure \"Prop projection\"\n else\n return none\n | _ => return none\n let (none) ← findDocString? (← getEnv) declName | return none\n return m!\"{kind} missing documentation string\"\n\n/-- A linter for checking whether the correct declaration constructor (definition or theorem)\nhas been used. -/\n@[env_linter] def defLemma : Linter where\n noErrorsFound := \"All declarations correctly marked as def/lemma.\"\n errorsFound := \"INCORRECT DEF/LEMMA:\"\n test declName := do\n if (← isAutoDecl declName) || (← isImplicitReducible declName) then\n return none\n -- leanprover/lean4#2575:\n -- projections are generated as `def`s even when they should be `theorem`s\n if ← isProjectionFn declName then return none\n let info ← getConstInfo declName\n let isThm ← match info with\n | .defnInfo .. => pure false\n | .thmInfo .. => pure true\n | _ => return none\n match isThm, ← isProp info.type with\n | true, false => pure \"is a lemma/theorem, should be a def\"\n | false, true => pure \"is a def, should be lemma/theorem\"\n | _, _ => return none\n\n/-- A linter for checking whether statements of declarations are well-typed.\n\nThis linter is disabled by default: declarations are already type-checked when added to the\nenvironment, so re-checking every statement is redundant in normal use. As an alternative\ndefence-in-depth measure for catching kernel/elaborator bugs, prefer running an external\nchecker such as `lean4checker` or `trepplein`.\n-/\n@[env_linter disabled] def checkType : Linter where\n noErrorsFound :=\n \"The statements of all declarations type-check with default reducibility settings.\"\n errorsFound := \"THE STATEMENTS OF THE FOLLOWING DECLARATIONS DO NOT TYPE-CHECK.\"\n isFast := true\n test declName := do\n if ← isAutoDecl declName then return none\n if ← isTypeCorrect (← getConstInfo declName).type then return none\n return m!\"the statement doesn't type check.\"\n\n/--\n`univParamsGrouped e` computes for each `level` `u` of `e` the parameters that occur in `u`,\nand returns the corresponding set of lists of parameters.\nIn pseudo-mathematical form, this returns `{{p : parameter | p ∈ u} | (u : level) ∈ e}`\nFIXME: We use `Array Name` instead of `HashSet Name`, since `HashSet` does not have an equality\ninstance. It will ignore `nm₀.proof_i` declarations.\n-/\nprivate def univParamsGrouped (e : Expr) (nm₀ : Name) : Std.HashSet (Array Name) :=\n runST fun σ => do\n let res ← ST.mkRef (σ := σ) {}\n e.forEach fun\n | .sort u =>\n res.modify (·.insert (CollectLevelParams.visitLevel u {}).params)\n | .const n us => do\n if let .str n s .. := n then\n if n == nm₀ && s.startsWith \"proof_\" then\n return\n res.modify <| us.foldl (·.insert <| CollectLevelParams.visitLevel · {} |>.params)\n | _ => pure ()\n res.get\n\n/--\nThe good parameters are the parameters that occur somewhere in the set as a singleton or\n(recursively) with only other good parameters.\nAll other parameters in the set are bad.\n-/\nprivate partial def badParams (l : Array (Array Name)) : Array Name :=\n let goodLevels := l.filterMap fun\n | #[u] => some u\n | _ => none\n if goodLevels.isEmpty then\n l.flatten.toList.eraseDups.toArray\n else\n badParams <| l.map (·.filter (!goodLevels.contains ·))\n\n/-- A linter for checking that there are no bad `max u v` universe levels.\nChecks whether all universe levels `u` in the type of `d` are \"good\".\nThis means that `u` either occurs in a `level` of `d` by itself, or (recursively)\nwith only other good levels.\nWhen this fails, usually this means that there is a level `max u v`, where neither `u` nor `v`\noccur by themselves in a level. It is ok if *one* of `u` or `v` never occurs alone. For example,\n`(α : Type u) (β : Type (max u v))` is a occasionally useful method of saying that `β` lives in\na higher universe level than `α`.\n-/\n@[env_linter] def checkUnivs : Linter where\n noErrorsFound :=\n \"All declarations have good universe levels.\"\n errorsFound := \"THE STATEMENTS OF THE FOLLOWING DECLARATIONS HAVE BAD UNIVERSE LEVELS. \\\n This usually means that there is a `max u v` in the type where neither `u` nor `v` \\\n occur by themselves. Solution: Find the type (or type bundled with data) that has this \\\n universe argument and provide the universe level explicitly. If this happens in an implicit \\\n argument of the declaration, a better solution is to move this argument to a `variables` \\\n command (then it's not necessary to provide the universe level).\\n\\n\\\n It is possible that this linter gives a false positive on definitions where the value of the \\\n definition has the universes occur separately, and the definition will usually be used with \\\n explicit universe arguments. In this case, feel free to add `@[nolint checkUnivs]`.\"\n isFast := true\n test declName := do\n if ← isAutoDecl declName then return none\n let bad := badParams (univParamsGrouped (← getConstInfo declName).type declName).toArray\n if bad.isEmpty then return none\n return m!\"universes {bad} only occur together.\"\n\n/-- A linter for checking that declarations aren't syntactic tautologies.\nChecks whether a lemma is a declaration of the form `∀ a b ... z, e₁ = e₂`\nwhere `e₁` and `e₂` are identical exprs.\nWe call declarations of this form syntactic tautologies.\nSuch lemmas are (mostly) useless and sometimes introduced unintentionally when proving basic facts\nwith rfl when elaboration results in a different term than the user intended. -/\n@[env_linter] def synTaut : Linter where\n noErrorsFound :=\n \"No declarations are syntactic tautologies.\"\n errorsFound := \"THE FOLLOWING DECLARATIONS ARE SYNTACTIC TAUTOLOGIES. \\\n This usually means that they are of the form `∀ a b ... z, e₁ = e₂` where `e₁` and `e₂` are \\\n identical expressions. We call declarations of this form syntactic tautologies. \\\n Such lemmas are (mostly) useless and sometimes introduced unintentionally when proving \\\n basic facts using `rfl`, when elaboration results in a different term than the user intended. \\\n You should check that the declaration really says what you think it does.\"\n isFast := true\n test declName := do\n if ← isAutoDecl declName then return none\n forallTelescope (← getConstInfo declName).type fun _ ty => do\n let some (lhs, rhs) := ty.eq?.map (fun (_, l, r) => (l, r)) <|> ty.iff?\n | return none\n if lhs == rhs then\n return m!\"LHS equals RHS syntactically\"\n return none\n\n/--\nReturn a list of unused `let_fun` terms in an expression that introduce proofs.\n-/\n@[nolint unusedArguments]\ndef findUnusedHaves (_ : Expr) : MetaM (Array MessageData) := do\n -- adaptation note: kmill 2025-06-29. `Expr.letFun?` is deprecated.\n -- This linter needs to be updated for `Expr.letE (nondep := true)`, but it has false\n -- positives, so I am disabling it for now.\n return #[]\n /-\n let res ← IO.mkRef #[]\n forEachExpr e fun e => do\n match e.letFun? with\n | some (n, t, _, b) =>\n if n.isInternal then return\n if b.hasLooseBVars then return\n unless ← Meta.isProp t do return\n let msg ← addMessageContextFull m!\"unnecessary have {n.eraseMacroScopes} : {t}\"\n res.modify (·.push msg)\n | _ => return\n res.get\n -/\n\n/-- A linter for checking that declarations don't have unused term mode have statements. -/\n@[env_linter] def unusedHavesSuffices : Linter where\n noErrorsFound := \"No declarations have unused term mode have statements.\"\n errorsFound := \"THE FOLLOWING DECLARATIONS HAVE INEFFECTUAL TERM MODE HAVE/SUFFICES BLOCKS. \\\n In the case of `have` this is a term of the form `have h := foo, bar` where `bar` does not \\\n refer to `foo`. Such statements have no effect on the generated proof, and can just be \\\n replaced by `bar`, in addition to being ineffectual, they may make unnecessary assumptions \\\n in proofs appear as if they are used. \\\n For `suffices` this is a term of the form `suffices h : foo, proof_of_goal, proof_of_foo` \\\n where `proof_of_goal` does not refer to `foo`. \\\n Such statements have no effect on the generated proof, and can just be replaced by \\\n `proof_of_goal`, in addition to being ineffectual, they may make unnecessary assumptions \\\n in proofs appear as if they are used.\"\n test declName := do\n if ← isAutoDecl declName then return none\n let info ← getConstInfo declName\n let mut unused ← findUnusedHaves info.type\n if let some value := info.value? then\n unused := unused ++ (← findUnusedHaves value)\n unless unused.isEmpty do\n return some <| .joinSep unused.toList \", \"\n return none\n\n/--\nA linter for checking if variables appearing on both sides of an iff are explicit. Ideally, such\nvariables should be implicit instead.\n-/\n@[env_linter disabled] def explicitVarsOfIff : Linter where\n noErrorsFound := \"No explicit variables on both sides of iff\"\n errorsFound := \"EXPLICIT VARIABLES ON BOTH SIDES OF IFF\"\n test declName := do\n if ← isAutoDecl declName then return none\n forallTelescope (← getConstInfo declName).type fun args ty => do\n let some (lhs, rhs) := ty.iff? | return none\n let explicit ← args.filterM fun arg =>\n return (← getFVarLocalDecl arg).binderInfo.isExplicit &&\n lhs.containsFVar arg.fvarId! && rhs.containsFVar arg.fvarId!\n if explicit.isEmpty then return none\n addMessageContextFull m!\"should be made implicit: {\n MessageData.joinSep (explicit.toList.map (m!\"{·}\")) \", \"}\"\n" }, { "path": "Batteries/Tactic/Lint/Simp.lean", "content": "/-\nCopyright (c) 2020 Gabriel Ebner. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Meta.Tactic.Simp.Main\npublic meta import Batteries.Tactic.Lint.Basic\npublic meta import Batteries.Tactic.OpenPrivate\npublic meta import Batteries.Util.LibraryNote\nimport all Lean.Meta.Tactic.Simp.SimpTheorems\n\npublic meta section\nopen Lean Meta\n\nnamespace Batteries.Tactic.Lint\n\n/-!\n# Linter for simplification lemmas\n\nThis files defines several linters that prevent common mistakes when declaring simp lemmas:\n\n * `simpNF` checks that the left-hand side of a simp lemma is not simplified by a different lemma.\n * `simpVarHead` checks that the head symbol of the left-hand side is not a variable.\n * `simpComm` checks that commutativity lemmas are not marked as simplification lemmas.\n-/\n\n/-- The data associated to a simp theorem. -/\nstructure SimpTheoremInfo where\n /-- The hypotheses of the theorem -/\n hyps : Array Expr\n /-- The thing to replace -/\n lhs : Expr\n /-- The result of replacement -/\n rhs : Expr\n\n/-- Is this hypothesis a condition that might turn into a `simp` side-goal?\ni.e. is it a proposition that isn't marked as instance implicit? -/\ndef isCondition (h : Expr) : MetaM Bool := do\n let ldecl ← h.fvarId!.getDecl\n if ldecl.binderInfo.isInstImplicit then return false\n isProp ldecl.type\n\n/-- Runs the continuation on all the simp theorems encoded in the given type. -/\ndef withSimpTheoremInfos (ty : Expr) (k : SimpTheoremInfo → MetaM α) : MetaM (Array α) :=\n withReducible do\n let e ← preprocess (← mkSorry ty true) ty (inv := false) (isGlobal := true)\n e.toArray.mapM fun (_, ty') => do\n forallTelescopeReducing ty' fun hyps eq => do\n let some (_, lhs, rhs) := eq.eq? | throwError \"not an equality {eq}\"\n k { hyps, lhs, rhs }\n\n/-- When true, the `simpNF` linter sets `backward.isDefEq.respectTransparency true` when\ncomparing expressions in `isSimpEq`. This is stricter and will flag more simp lemmas as\nnot in simp-normal form, in particular those where the left-hand side is not in normal form\nup to reducible defeq (e.g. lemmas involving type synonyms or bundled carrier types).\n\nDefaults to `false` to preserve the historical linter behavior, which uses\n`backward.isDefEq.respectTransparency false` to avoid false positives when `simp`/`dsimp`\nchanges implicit arguments by unfolding carrier types in bundled structures.\n\nTo find simp lemmas that fail with the stricter check, use:\n```\nset_option linter.simpNF.respectTransparency true in\n#lint only simpNF\n```\n-/\nregister_option linter.simpNF.respectTransparency : Bool := {\n defValue := false\n descr := \"if true, the simpNF linter uses backward.isDefEq.respectTransparency when \\\n comparing expressions (catches more defeq abuse, but may produce false positives)\"\n}\n\n/-- Checks whether two expressions are equal for the simplifier. That is,\nthey are reducibly-definitional equal, and they have the same head symbol. -/\ndef isSimpEq (a b : Expr) (whnfFirst := true) : MetaM Bool := withReducible do\n let a ← if whnfFirst then whnf a else pure a\n let b ← if whnfFirst then whnf b else pure b\n if a.getAppFn.constName? != b.getAppFn.constName? then return false\n -- By default we use the old `isDefEq` behavior that does not respect transparency when\n -- checking implicit arguments. Without this, `simp`/`dsimp` changes to implicit arguments\n -- (e.g. unfolding carrier types) would cause false positives.\n -- Set `linter.simpNF.respectTransparency` to `true` to use the stricter behavior,\n -- which catches simp lemmas that rely on defeq abuse through type synonyms.\n let rt := linter.simpNF.respectTransparency.get (← getOptions)\n withOptions (fun opts => opts.setBool `backward.isDefEq.respectTransparency rt) do\n isDefEq a b\n\n/-- Constructs a message from all the simp theorems encoded in the given type. -/\ndef checkAllSimpTheoremInfos (ty : Expr) (k : SimpTheoremInfo → MetaM (Option MessageData)) :\n MetaM (Option MessageData) := do\n let errors :=\n (← withSimpTheoremInfos ty fun i => do (← k i).mapM addMessageContextFull).filterMap id\n if errors.isEmpty then\n return none\n return MessageData.joinSep errors.toList Format.line\n\n/-- Returns true if this is a `@[simp]` declaration. -/\ndef isSimpTheorem (declName : Name) : MetaM Bool := do\n pure $ (← getSimpTheorems).lemmaNames.contains (.decl declName)\n\nopen Lean.Meta.DiscrTree in\n/-- Returns the list of elements in the discrimination tree. -/\npartial def _root_.Lean.Meta.DiscrTree.elements (d : DiscrTree α) : Array α :=\n d.root.foldl (init := #[]) fun arr _ => trieElements arr\nwhere\n /-- Returns the list of elements in the trie. -/\n trieElements (arr)\n | Trie.node vs children =>\n children.foldl (init := arr ++ vs) fun arr (_, child) => trieElements arr child\n\n/-- Add message `msg` to any errors thrown inside `k`. -/\ndef decorateError (msg : MessageData) (k : MetaM α) : MetaM α := do\n try k catch e => throw (.error e.getRef m!\"{msg}\\n{e.toMessageData}\")\n\n/-- Render the list of simp lemmas. -/\ndef formatLemmas (usedSimps : Simp.UsedSimps) (simpName : String) (higherOrder : Option Bool) :\n MetaM MessageData := do\n let mut args := if higherOrder == none then #[] else #[m!\"*\"]\n let env ← getEnv\n for (thm, _) in usedSimps.map.toArray.qsort (·.2 < ·.2) do\n if let .decl declName := thm then\n if env.contains declName && declName != ``eq_self then\n args := args.push m! \"{← mkConstWithFreshMVarLevels declName}\"\n let contextual? := if higherOrder == some true then \" +contextual\" else \"\"\n return m!\"{simpName}{contextual?} only {args.toList}\"\n\n/-- A linter for simp lemmas whose lhs is not in simp-normal form, and which hence never fire. -/\n@[env_linter] def simpNF : Linter where\n noErrorsFound := \"All left-hand sides of simp lemmas are in simp-normal form.\"\n errorsFound := \"SOME SIMP LEMMAS ARE NOT IN SIMP-NORMAL FORM.\nPlease change the lemma to make sure their left-hand sides are in simp normal form.\nTo learn about simp normal forms, see\nhttps://leanprover-community.github.io/extras/simp.html#simp-normal-form\nand https://lean-lang.org/doc/reference/latest/The-Simplifier/Simp-Normal-Forms/.\"\n test := fun declName => do\n unless ← isSimpTheorem declName do return none\n withConfig Elab.Term.setElabConfig do\n checkAllSimpTheoremInfos (← getConstInfo declName).type fun { lhs, rhs, hyps, .. } => do\n -- we use `simp [*]` so that simp lemmas with hypotheses apply to themselves\n -- higher order simp lemmas need `simp +contextual [*]` to be able to apply to themselves\n let mut simpTheorems ← getSimpTheorems\n let mut higherOrder := false\n for h in hyps do\n if ← isCondition h then\n simpTheorems ← simpTheorems.add (.fvar h.fvarId!) #[] h\n if !higherOrder then\n higherOrder ← forallTelescope (← inferType h) fun hyps _ => hyps.anyM isCondition\n let ctx ← Simp.mkContext (config := { contextual := higherOrder })\n (simpTheorems := #[simpTheorems]) (congrTheorems := ← getSimpCongrTheorems)\n let isRfl ← isRflTheorem declName\n let simplify (e : Expr) (ctx : Simp.Context) (stats : Simp.Stats := {}) :\n MetaM (Simp.Result × Simp.Stats) := do\n if !isRfl then\n simp e ctx (stats := stats)\n else\n let (e, s) ← dsimp e ctx (stats := stats)\n return (Simp.Result.mk e .none .true, s)\n let ({ expr := lhs', proof? := prf1, .. }, prf1Stats) ←\n decorateError \"simplify fails on left-hand side:\" <| simplify lhs ctx\n if prf1Stats.usedTheorems.map.contains (.decl declName) then return none\n let ({ expr := rhs', .. }, stats) ←\n decorateError \"simplify fails on right-hand side:\" <| simplify rhs ctx prf1Stats\n let lhs'EqRhs' ← isSimpEq lhs' rhs' (whnfFirst := false)\n let lhsInNF ← isSimpEq lhs' lhs\n let simpName := if !isRfl then \"simp\" else \"dsimp\"\n if lhs'EqRhs' then\n if prf1.isNone then return none -- TODO: FP rewriting foo.eq_2 using `simp only [foo]`\n return m!\"\\\n {simpName} can prove this:\\\n \\n by {← formatLemmas stats.usedTheorems simpName higherOrder}\\\n \\nOne of the lemmas above could be a duplicate.\\\n \\nIf that's not the case try reordering lemmas or adding @[priority].\"\n else if ¬ lhsInNF then\n return m!\"\\\n Left-hand side simplifies from\\\n \\n {lhs}\\\n \\nto\\\n \\n {lhs'}\\\n \\nusing\\\n \\n {← formatLemmas prf1Stats.usedTheorems simpName higherOrder}\\\n \\nTry to change the left-hand side to the simplified term!\"\n else if lhs == lhs' then\n let lhsType ← inferType lhs\n let mut hints := m!\"\"\n for h in hyps do\n let ldecl ← h.fvarId!.getDecl\n let mut name := ldecl.userName\n if name.hasMacroScopes then\n name := sanitizeName name |>.run' { options := ← getOptions }\n if ← isProp ldecl.type then\n -- improve the error message if the hypothesis isn't in `simp` normal form\n let ({ expr := hType', .. }, stats) ←\n decorateError m!\"simplify fails on hypothesis ({name} : {ldecl.type}):\" <|\n simplify ldecl.type (← Simp.Context.mkDefault)\n unless ← isSimpEq hType' ldecl.type do\n hints := hints ++ m!\"\\\n \\nThe simp lemma may be invalid because hypothesis {name} simplifies from\\\n \\n {ldecl.type}\\\n \\nto\\\n \\n {hType'}\\\n \\nusing\\\n \\n {← formatLemmas stats.usedTheorems simpName none}\\\n \\nTry to change the hypothesis to the simplified term!\"\n else\n -- improve the error message if the argument can't be filled in by `simp`\n if !ldecl.binderInfo.isInstImplicit &&\n !lhs.containsFVar h.fvarId! && !lhsType.containsFVar h.fvarId! then\n hints := hints ++ m!\"\\\n \\nThe simp lemma is invalid because the value of argument\\\n \\n {name} : {ldecl.type}\\\n \\ncannot be inferred by `simp`.\"\n return m!\"\\\n Left-hand side does not simplify, when using the simp lemma on itself.\n \\nThis usually means that it will never apply.{hints}\\n\"\n else\n return none\n\nlibrary_note «simp-normal form» /--\nThis note gives you some tips to debug any errors that the simp-normal form linter raises.\n\nThe reason that a lemma was considered faulty is because its left-hand side is not in simp-normal\nform.\nThese lemmas are hence never used by the simplifier.\n\nThis linter gives you a list of other simp lemmas: look at them!\n\nHere are some tips depending on the error raised by the linter:\n\n 1. 'the left-hand side reduces to XYZ':\n you should probably use XYZ as the left-hand side.\n\n 2. 'simp can prove this':\n This typically means that lemma is a duplicate, or is shadowed by another lemma:\n\n 2a. Always put more general lemmas after specific ones:\n ```\n @[simp] lemma zero_add_zero : 0 + 0 = 0 := rfl\n @[simp] lemma add_zero : x + 0 = x := rfl\n ```\n\n And not the other way around! The simplifier always picks the last matching lemma.\n\n 2b. You can also use `@[priority]` instead of moving simp-lemmas around in the file.\n\n Tip: the default priority is 1000.\n Use `@[priority 1100]` instead of moving a lemma down,\n and `@[priority 900]` instead of moving a lemma up.\n\n 2c. Conditional simp lemmas are tried last. If they are shadowed\n just remove the `simp` attribute.\n\n 2d. If two lemmas are duplicates, the linter will complain about the first one.\n Try to fix the second one instead!\n (You can find it among the other simp lemmas the linter prints out!)\n\n 3. 'try_for tactic failed, timeout':\n This typically means that there is a loop of simp lemmas.\n Try to apply squeeze_simp to the right-hand side (removing this lemma from the simp set) to see\n what lemmas might be causing the loop.\n\n Another trick is to `set_option trace.simplify.rewrite true` and\n then apply `try_for 10000 { simp }` to the right-hand side. You will\n see a periodic sequence of lemma applications in the trace message.\n-/\n\n/--\nA linter for simp lemmas whose lhs has a variable as head symbol,\nand which hence never fire.\n-/\n@[env_linter] def simpVarHead : Linter where\n noErrorsFound :=\n \"No left-hand sides of a simp lemma has a variable as head symbol.\"\n errorsFound := \"LEFT-HAND SIDE HAS VARIABLE AS HEAD SYMBOL.\nSome simp lemmas have a variable as head symbol of the left-hand side (after whnfR):\"\n test := fun declName => do\n unless ← isSimpTheorem declName do return none\n checkAllSimpTheoremInfos (← getConstInfo declName).type fun {lhs, ..} => do\n let lhs ← whnfR lhs\n let headSym := lhs.getAppFn\n unless headSym.isFVar do return none\n return m!\"Left-hand side has variable as head symbol: {headSym}\"\n\nprivate def Expr.eqOrIff? : Expr → Option (Expr × Expr)\n | .app (.app (.app (.const ``Eq _) _) lhs) rhs\n | .app (.app (.const ``Iff _) lhs) rhs\n => (lhs, rhs)\n | _ => none\n\n/-- A linter for commutativity lemmas that are marked simp. -/\n@[env_linter] def simpComm : Linter where\n noErrorsFound := \"No commutativity lemma is marked simp.\"\n errorsFound := \"COMMUTATIVITY LEMMA IS SIMP.\nSome commutativity lemmas are simp lemmas:\"\n test := fun declName => withSimpGlobalConfig do withReducible do\n unless ← isSimpTheorem declName do return none\n let ty := (← getConstInfo declName).type\n forallTelescopeReducing ty fun _ ty' => do\n let some (lhs, rhs) := ty'.eqOrIff? | return none\n unless lhs.getAppFn.constName? == rhs.getAppFn.constName? do return none\n let (_, _, ty') ← forallMetaTelescopeReducing ty\n let some (lhs', rhs') := ty'.eqOrIff? | return none\n unless ← isDefEq rhs lhs' do return none\n unless ← withNewMCtxDepth (isDefEq rhs lhs') do return none\n -- make sure that the discrimination tree will actually find this match (see #69)\n if (← (← DiscrTree.empty.insert rhs ()).getMatch lhs').isEmpty then\n return none\n -- ensure that the second application makes progress:\n if ← isDefEq lhs' rhs' then return none\n pure m!\"should not be marked simp\"\n" }, { "path": "Batteries/Tactic/Lint/TypeClass.lean", "content": "/-\nCopyright (c) 2022 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Meta.Instances\npublic meta import Batteries.Tactic.Lint.Basic\n\npublic meta section\n\nnamespace Batteries.Tactic.Lint\nopen Lean Meta\n\n/--\nLints for instances with arguments that cannot be filled in, like\n```\ninstance {α β : Type} [Group α] : Mul α where ...\n```\n-/\n@[env_linter] def impossibleInstance : Linter where\n noErrorsFound := \"No instance has arguments that are impossible to infer\"\n errorsFound := \"SOME INSTANCES HAVE ARGUMENTS THAT ARE IMPOSSIBLE TO INFER\nThese are arguments that are not instance-implicit and do not appear in\nanother instance-implicit argument or the return type.\"\n test declName := do\n unless ← isInstance declName do return none\n forallTelescopeReducing (← inferType (← mkConstWithLevelParams declName)) fun args ty => do\n let argTys ← args.mapM inferType\n let impossibleArgs ← args.zipIdx.filterMapM fun (arg, i) => do\n let fv := arg.fvarId!\n if (← fv.getDecl).binderInfo.isInstImplicit then return none\n if ty.containsFVar fv then return none\n if argTys[i+1:].any (·.containsFVar fv) then return none\n return some m!\"argument {i+1} {arg} : {← inferType arg}\"\n if impossibleArgs.isEmpty then return none\n addMessageContextFull <| .joinSep impossibleArgs.toList \", \"\n\n/--\nA linter for checking if any declaration whose type is not a class is marked as an instance.\n-/\n@[env_linter] def nonClassInstance : Linter where\n noErrorsFound := \"No instances of non-classes\"\n errorsFound := \"INSTANCES OF NON-CLASSES\"\n test declName := do\n if !(← isInstance declName) then return none\n let info ← getConstInfo declName\n if !(← isClass? info.type).isSome then return \"should not be an instance\"\n return none\n" }, { "path": "Batteries/Tactic/Lint.lean", "content": "module\n\npublic import Batteries.Tactic.Lint.Basic\npublic import Batteries.Tactic.Lint.Misc\npublic import Batteries.Tactic.Lint.Simp\npublic import Batteries.Tactic.Lint.TypeClass\npublic import Batteries.Tactic.Lint.Frontend\n" }, { "path": "Batteries/Tactic/NoMatch.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.DocString\npublic meta import Lean.Elab.Tactic.Basic\n\npublic meta section\n\n/-!\nDeprecation warnings for `match ⋯ with.`, `fun.`, `λ.`, and `intro.`.\n-/\nnamespace Batteries.Tactic\nopen Lean Elab Term Tactic Parser.Term\n\n/--\nThe syntax `match ⋯ with.` has been deprecated in favor of `nomatch ⋯`.\n\nBoth now support multiple discriminants.\n-/\nelab (name := matchWithDot) (priority := low)\n tk:\"match \" t:term,* \" with\" \".\" : term <= expectedType? => do\n logWarningAt tk (← findDocString? (← getEnv) ``matchWithDot).get!\n elabTerm (← `(nomatch%$tk $[$t],*)) expectedType?\n\n/-- The syntax `fun.` has been deprecated in favor of `nofun`. -/\nelab (name := funDot) (priority := low) tk:\"fun\" \".\" : term <= expectedType? => do\n logWarningAt tk (← findDocString? (← getEnv) ``funDot).get!\n elabTerm (← `(nofun)) expectedType?\n\n/-- The syntax `λ.` has been deprecated in favor of `nofun`. -/\nelab (name := lambdaDot) (priority := low) tk:\"λ\" \".\" : term <= expectedType? => do\n logWarningAt tk (← findDocString? (← getEnv) ``lambdaDot).get!\n elabTerm (← `(nofun)) expectedType?\n\n@[inherit_doc matchWithDot]\nmacro (priority := low) \"match \" discrs:term,* \" with\" \".\" : tactic =>\n `(tactic| exact match $discrs,* with.)\n\n/--\nThe syntax `intro.` is deprecated in favor of `nofun`.\n-/\nelab (name := introDot) tk:\"intro\" \".\" : tactic => do\n logWarningAt tk (← findDocString? (← getEnv) ``introDot).get!\n evalTactic (← `(tactic| nofun))\n" }, { "path": "Batteries/Tactic/OpenPrivate.lean", "content": "/-\nCopyright (c) 2021 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.Util.FoldConsts\npublic meta import Lean.Parser.Module\n\npublic meta section\n\nopen Lean Parser.Tactic Elab Command\n\nnamespace Lean\n\n/-- Collects the names of private declarations referenced in definition `n`. -/\ndef Meta.collectPrivateIn [Monad m] [MonadEnv m] [MonadError m]\n (n : Name) (set := NameSet.empty) : m NameSet := do\n let c ← getConstInfo n\n let traverse value := Expr.foldConsts value set fun c a =>\n if isPrivateName c then a.insert c else a\n if let some value := c.value? then return traverse value\n if let some c := (← getEnv).find? (n ++ `_cstage1) then\n if let some value := c.value? then return traverse value\n return traverse c.type\n\n/-- Get the module index given a module name. -/\ndef Environment.moduleIdxForModule? (env : Environment) (mod : Name) : Option ModuleIdx :=\n (env.allImportedModuleNames.idxOf? mod).map fun idx => idx\n\ninstance : DecidableEq ModuleIdx := instDecidableEqNat\n\n/-- Get the list of declarations in a module (referenced by index). -/\ndef Environment.declsInModuleIdx (env : Environment) (idx : ModuleIdx) : List Name :=\n env.const2ModIdx.fold (fun acc n i => if i = idx then n :: acc else acc) []\n\n/-- Add info to the info tree corresponding to a module name. -/\ndef Elab.addModuleInfo [Monad m] [MonadInfoTree m] (stx : Ident) : m Unit := do\n -- HACK: The server looks specifically for ofCommandInfo nodes on `import` syntax\n -- to do go-to-def for modules, so we have to add something that looks like an import\n -- to the info tree. (Ideally this would be an `.ofModuleInfo` node instead.)\n pushInfoLeaf <| .ofCommandInfo {\n elaborator := `import\n stx := Unhygienic.run `(Parser.Module.import| import $stx) |>.raw.copyHeadTailInfoFrom stx\n }\n\nnamespace Elab.Command\n\n/-- Core elaborator for `open private` and `export private`. -/\ndef elabOpenPrivateLike (ids : Array Ident) (tgts mods : Option (Array Ident))\n (f : (priv full user : Name) → CommandElabM Name) : CommandElabM Unit := do\n let mut names := NameSet.empty\n for tgt in tgts.getD #[] do\n let n ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo tgt\n names ← Meta.collectPrivateIn n names\n let env ← getEnv\n for mod in mods.getD #[] do\n let some modIdx := env.moduleIdxForModule? mod.getId\n | throwError \"unknown module {mod}\"\n addModuleInfo mod\n for declName in env.declsInModuleIdx modIdx do\n if isPrivateName declName then\n names := names.insert declName\n let appendNames (msg : MessageData) : MessageData := Id.run do\n let mut msg := msg\n for c in names do\n if let some info := env.findConstVal? c then\n msg := msg ++ m!\"{mkConst c (info.levelParams.map mkLevelParam)}\\n\"\n else if let some name := privateToUserName? c then\n msg := msg ++ s!\"{name}\\n\"\n msg\n if ids.isEmpty && !names.isEmpty then\n logInfo (appendNames \"found private declarations:\\n\")\n let mut decls := #[]\n for id in ids do\n let n := id.getId\n let rec\n /-- finds private declarations `n ++ suff` where `n` resolves and `n ++ suff` realizes -/\n findAll n suff := do\n let mut found := []\n for c in names do\n if n.isSuffixOf c then\n let (c', ok) ← if suff.isAnonymous then\n pure (c, true)\n else\n let c' := c ++ suff\n if (← getEnv).contains c' then pure (c', true)\n else try\n liftCoreM (executeReservedNameAction c')\n pure (c', (← getEnv).containsOnBranch c')\n catch _ => pure (c', false)\n if ok then\n addConstInfo id c'\n found := c'::found\n unless found = [] do return found\n match n with\n | .str p s => findAll p (Name.mkSimple s ++ suff)\n | _ => pure []\n match ← findAll n .anonymous with\n | [] => throwError appendNames m!\"'{n}' not found in the provided declarations:\\n\"\n | [c] =>\n if let some name := privateToUserName? c then\n let new ← f c name n\n decls := decls.push (.explicit n new)\n else unreachable!\n | found => throwError s!\"provided name is ambiguous: found {found.map privateToUserName?}\"\n modifyScope fun scope => Id.run do\n let mut openDecls := scope.openDecls\n for decl in decls do\n openDecls := decl::openDecls\n { scope with openDecls := openDecls }\n\n/--\nThe command `open private a b c in foo bar` will look for private definitions named `a`, `b`, `c`\nin declarations `foo` and `bar` and open them in the current scope. This does not make the\ndefinitions public, but rather makes them accessible in the current section by the short name `a`\ninstead of the (unnameable) internal name for the private declaration, something like\n`_private.Other.Module.0.Other.Namespace.foo.a`, which cannot be typed directly because of the `0`\nname component.\n\nIt is also possible to specify the module instead with\n`open private a b c from Other.Module`.\n-/\nsyntax (name := openPrivate) \"open\" ppSpace \"private\" (ppSpace ident)*\n (\" in\" (ppSpace ident)*)? (\" from\" (ppSpace ident)*)? : command\n\n/-- Elaborator for `open private`. -/\n@[command_elab openPrivate] def elabOpenPrivate : CommandElab\n| `(open private $ids* $[in $tgts*]? $[from $mods*]?) =>\n elabOpenPrivateLike ids tgts mods fun c _ _ => pure c\n| _ => throwUnsupportedSyntax\n\n/--\nThe command `export private a b c in foo bar` is similar to `open private`, but instead of opening\nthem in the current scope it will create public aliases to the private definition. The definition\nwill exist at exactly the original location and name, as if the `private` keyword was not used\noriginally.\n\nIt will also open the newly created alias definition under the provided short name, like\n`open private`.\nIt is also possible to specify the module instead with\n`export private a b c from Other.Module`.\n-/\nsyntax (name := exportPrivate) \"export\" ppSpace \"private\" (ppSpace ident)*\n (\" in\" (ppSpace ident)*)? (\" from\" (ppSpace ident)*)? : command\n\n/-- Elaborator for `export private`. -/\n@[command_elab exportPrivate] def elabExportPrivate : CommandElab\n| `(export private $ids* $[in $tgts*]? $[from $mods*]?) =>\n elabOpenPrivateLike ids tgts mods fun c name _ => liftCoreM do\n let cinfo ← getConstInfo c\n if (← getEnv).contains name then\n throwError s!\"'{name}' has already been declared\"\n let decl := Declaration.defnDecl {\n name := name,\n levelParams := cinfo.levelParams,\n type := cinfo.type,\n value := mkConst c (cinfo.levelParams.map mkLevelParam),\n hints := ReducibilityHints.abbrev,\n safety := if cinfo.isUnsafe then DefinitionSafety.unsafe else DefinitionSafety.safe\n }\n addDecl decl\n compileDecl decl\n pure name\n| _ => throwUnsupportedSyntax\n" }, { "path": "Batteries/Tactic/PermuteGoals.lean", "content": "/-\nCopyright (c) 2022 Arthur Paulino. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Arthur Paulino, Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.Basic\n\npublic meta section\n\n/-!\n# The `on_goal`, `pick_goal`, and `swap` tactics.\n\n`pick_goal n` moves the `n`-th goal to the front. If `n` is negative this is counted from the back.\n\n`on_goal n => tacSeq` focuses on the `n`-th goal and runs a tactic block `tacSeq`.\nIf `tacSeq` does not close the goal any resulting subgoals are inserted back into the list of goals.\nIf `n` is negative this is counted from the back.\n\n`swap` is a shortcut for `pick_goal 2`, which interchanges the 1st and 2nd goals.\n-/\n\nnamespace Batteries.Tactic\n\nopen Lean Elab.Tactic\n\n/--\nIf the current goals are `g₁ ⋯ gᵢ ⋯ gₙ`, `splitGoalsAndGetNth i` returns\n`(gᵢ, [g₁, ⋯, gᵢ₋₁], [gᵢ₊₁, ⋯, gₙ])`.\n\nIf `reverse` is passed as `true`, the `i`-th goal is picked by counting backwards.\nFor instance, `splitGoalsAndGetNth 1 true` puts the last goal in the first component\nof the returned term.\n-/\ndef splitGoalsAndGetNth (nth : Nat) (reverse : Bool := false) :\n TacticM (MVarId × List MVarId × List MVarId) := do\n if nth = 0 then throwError \"goals are 1-indexed\"\n let goals ← getGoals\n let nGoals := goals.length\n if nth > nGoals then throwError \"goal index out of bounds\"\n let n := if ¬reverse then nth - 1 else nGoals - nth\n let (gl, g :: gr) := goals.splitAt n | throwNoGoalsToBeSolved\n pure (g, gl, gr)\n\n/--\n`pick_goal n` will move the `n`-th goal to the front.\n\n`pick_goal -n` will move the `n`-th goal (counting from the bottom) to the front.\n\nSee also `Tactic.rotate_goals`, which moves goals from the front to the back and vice-versa.\n-/\nelab \"pick_goal \" reverse:\"-\"? n:num : tactic => do\n let (g, gl, gr) ← splitGoalsAndGetNth n.1.toNat !reverse.isNone\n setGoals $ g :: (gl ++ gr)\n\n/-- `swap` is a shortcut for `pick_goal 2`, which interchanges the 1st and 2nd goals. -/\nmacro \"swap\" : tactic => `(tactic| pick_goal 2)\n\n/--\n`on_goal n => tacSeq` creates a block scope for the `n`-th goal and tries the sequence\nof tactics `tacSeq` on it.\n\n`on_goal -n => tacSeq` does the same, but the `n`-th goal is chosen by counting from the\nbottom.\n\nThe goal is not required to be solved and any resulting subgoals are inserted back into the\nlist of goals, replacing the chosen goal.\n-/\nelab \"on_goal \" reverse:\"-\"? n:num \" => \" seq:tacticSeq : tactic => do\n let (g, gl, gr) ← splitGoalsAndGetNth n.1.toNat !reverse.isNone\n setGoals [g]\n evalTactic seq\n setGoals $ gl ++ (← getUnsolvedGoals) ++ gr\n" }, { "path": "Batteries/Tactic/PrintDependents.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.Util.FoldConsts\n\npublic meta section\n\n/-!\n# `#print dependents` command\n\nThis is a variation on `#print axioms` where one instead specifies the axioms to avoid,\nand it prints a list of all the theorems in the file that depend on that axiom, and the list\nof all theorems directly referenced that are \"to blame\" for this dependency. Useful for debugging\nunexpected dependencies.\n-/\nnamespace Batteries.Tactic\nopen Lean Elab Command\n\nnamespace CollectDependents\n\n/-- Collects the result of a `CollectDependents` query. -/\nstructure State where\n /-- If true, an axiom not in the initial list will be considered as marked. -/\n otherAxiom : Bool := true\n /-- The cached results on visited constants. -/\n result : NameMap Bool := {}\n\n/-- The monad used by `CollectDependents`. -/\nabbrev M := ReaderT Environment $ StateM State\n\n/--\nConstructs the initial state, marking the constants in `cs`. The result of `collect` will say\nwhether a given declaration depends transitively on one of these constants.\n\nIf `otherAxiom` is true, any axiom not specified in `cs` will also be tracked.\n-/\ndef mkState (cs : Array (Name × Bool)) (otherAxiom := true) : State :=\n { otherAxiom, result := cs.foldl (fun r (c, b) => r.insert c b) {} }\n\n/-- Collect the results for a given constant. -/\npartial def collect (c : Name) : M Bool := do\n let collectExpr (e : Expr) : M Bool := e.getUsedConstants.anyM collect\n let s ← get\n if let some b := s.result.find? c then return b\n modify fun s => { s with result := s.result.insert c false }\n let env ← read\n let r ← match env.find? c with\n | some (ConstantInfo.axiomInfo _) => pure s.otherAxiom\n | some (ConstantInfo.defnInfo v) => collectExpr v.type <||> collectExpr v.value\n | some (ConstantInfo.thmInfo v) => collectExpr v.type <||> collectExpr v.value\n | some (ConstantInfo.opaqueInfo v) => collectExpr v.type <||> collectExpr v.value\n | some (ConstantInfo.quotInfo _) => pure false\n | some (ConstantInfo.ctorInfo v) => collectExpr v.type\n | some (ConstantInfo.recInfo v) => collectExpr v.type\n | some (ConstantInfo.inductInfo v) => collectExpr v.type <||> v.ctors.anyM collect\n | none => pure false\n modify fun s => { s with result := s.result.insert c r }\n pure r\n\nend CollectDependents\n\n/--\nThe command `#print dependents X Y` prints a list of all the declarations in the file that\ntransitively depend on `X` or `Y`. After each declaration, it shows the list of all declarations\nreferred to directly in the body which also depend on `X` or `Y`.\n\nFor example, `#print axioms bar'` below shows that `bar'` depends on `Classical.choice`, but not\nwhy. `#print dependents Classical.choice` says that `bar'` depends on `Classical.choice` because\nit uses `foo` and `foo` uses `Classical.em`. `bar` is not listed because it is proved without using\n`Classical.choice`.\n```\nimport Batteries.Tactic.PrintDependents\n\ntheorem foo : x = y ∨ x ≠ y := Classical.em _\ntheorem bar : 1 = 1 ∨ 1 ≠ 1 := by simp\ntheorem bar' : 1 = 1 ∨ 1 ≠ 1 := foo\n\n#print axioms bar'\n-- 'bar'' depends on axioms: [Classical.choice, Quot.sound, propext]\n\n#print dependents Classical.choice\n-- foo: Classical.em\n-- bar': foo\n```\n\n-/\nelab tk:\"#print\" &\"dependents\" ids:(ppSpace colGt ident)* : command => do\n let env ← getEnv\n let ids ← ids.mapM fun c => return (← liftCoreM <| realizeGlobalConstNoOverloadWithInfo c, true)\n let init := CollectDependents.mkState ids false\n let mut state := init\n let mut out := #[]\n for (c, _) in env.constants.map₂ do\n let (b, state') := CollectDependents.collect c |>.run env |>.run state\n state := state'\n if b then\n if let some ranges ← findDeclarationRanges? c then\n out := out.push (c, ranges.range.pos.1)\n let msg ← out.qsort (·.2 < ·.2) |>.mapM fun (c, _) => do\n let mut msg := m!\"{MessageData.ofConst (← mkConstWithLevelParams c)}: \"\n if init.result.contains c then\n msg := msg ++ m!\"\"\n else\n let consts := match env.find? c with\n | some (ConstantInfo.defnInfo v) => v.type.getUsedConstants ++ v.value.getUsedConstants\n | some (ConstantInfo.thmInfo v) => v.type.getUsedConstants ++ v.value.getUsedConstants\n | some (ConstantInfo.opaqueInfo v) => v.type.getUsedConstants ++ v.value.getUsedConstants\n | some (ConstantInfo.ctorInfo v) => v.type.getUsedConstants\n | some (ConstantInfo.recInfo v) => v.type.getUsedConstants\n | some (ConstantInfo.inductInfo v) => v.type.getUsedConstants ++ v.ctors\n | _ => #[]\n for c in Std.TreeSet.ofArray consts Name.cmp do\n if state.result.find? c = some true then\n msg := msg ++ m!\"{MessageData.ofConst (← mkConstWithLevelParams c)} \"\n return msg\n logInfoAt tk (.joinSep msg.toList \"\\n\")\n" }, { "path": "Batteries/Tactic/PrintOpaques.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Command\npublic meta import Lean.Util.FoldConsts\n\npublic meta section\n\nopen Lean Elab Command\n\nnamespace Batteries.Tactic.CollectOpaques\n\n/-- Collects the result of a `CollectOpaques` query. -/\nstructure State where\n /-- The set visited constants. -/\n visited : NameSet := {}\n /-- The collected opaque defs. -/\n opaques : Array Name := #[]\n\n/-- The monad used by `CollectOpaques`. -/\nabbrev M := ReaderT Environment <| StateT State MetaM\n\n/-- Collect the results for a given constant. -/\npartial def collect (c : Name) : M Unit := do\n let collectExpr (e : Expr) : M Unit := e.getUsedConstants.forM collect\n let s ← get\n unless s.visited.contains c do\n modify fun s => { s with visited := s.visited.insert c }\n let env ← read\n match env.find? c with\n | some (ConstantInfo.ctorInfo _)\n | some (ConstantInfo.recInfo _)\n | some (ConstantInfo.inductInfo _)\n | some (ConstantInfo.quotInfo _) =>\n pure ()\n | some (ConstantInfo.defnInfo v)\n | some (ConstantInfo.thmInfo v) =>\n unless ← Meta.isProp v.type do collectExpr v.value\n | some (ConstantInfo.axiomInfo v)\n | some (ConstantInfo.opaqueInfo v) =>\n unless ← Meta.isProp v.type do\n modify fun s => { s with opaques := s.opaques.push c }\n | none =>\n throwUnknownConstant c\n\nend CollectOpaques\n\n/--\nThe command `#print opaques X` prints all opaque definitions that `X` depends on.\n\nOpaque definitions include partial definitions and axioms. Only dependencies that occur in a\ncomputationally relevant context are listed, occurrences within proof terms are omitted. This is\nuseful to determine whether and how a definition is possibly platform dependent, possibly partial,\nor possibly noncomputable.\n\nThe command `#print opaques Std.HashMap.insert` shows that `Std.HashMap.insert` depends on the\nopaque definitions: `System.Platform.getNumBits` and `UInt64.toUSize`. Thus `Std.HashMap.insert`\nmay have different behavior when compiled on a 32 bit or 64 bit platform.\n\nThe command `#print opaques Stream.forIn` shows that `Stream.forIn` is possibly partial since it\ndepends on the partial definition `Stream.forIn.visit`. Indeed, `Stream.forIn` may not terminate\nwhen the input stream is unbounded.\n\nThe command `#print opaques Classical.choice` shows that `Classical.choice` is itself an opaque\ndefinition: it is an axiom. However, `#print opaques Classical.axiomOfChoice` returns nothing\nsince it is a proposition, hence not computationally relevant. (The command `#print axioms` does\nreveal that `Classical.axiomOfChoice` depends on the `Classical.choice` axiom.)\n-/\nelab \"#print\" &\"opaques\" name:ident : command => do\n let constName ← liftCoreM <| realizeGlobalConstNoOverloadWithInfo name\n let env ← getEnv\n let (_, s) ← liftTermElabM <| ((CollectOpaques.collect constName).run env).run {}\n if s.opaques.isEmpty then\n logInfo m!\"'{constName}' does not use any opaque or partial definitions\"\n else\n logInfo m!\"'{constName}' depends on opaque or partial definitions: {s.opaques.toList}\"\n" }, { "path": "Batteries/Tactic/PrintPrefix.lean", "content": "/-\nCopyright (c) 2021 Shing Tak Lam. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Shing Tak Lam, Daniel Selsam, Mario Carneiro\n-/\nmodule\n\npublic meta import Batteries.Lean.Util.EnvSearch\npublic meta import Lean.Elab.Tactic.Config\npublic meta import Lean.Elab.Command\n\npublic meta section\n\nnamespace Batteries.Tactic\nopen Lean Elab Command\n\n/--\nOptions to control `#print prefix` command and `getMatchingConstants`.\n-/\nstructure PrintPrefixConfig where\n /-- Include declarations in imported environment. -/\n imported : Bool := true\n /-- Include declarations whose types are propositions. -/\n propositions : Bool := true\n /-- Exclude declarations whose types are not propositions. -/\n propositionsOnly : Bool := false\n /-- Print the type of a declaration. -/\n showTypes : Bool := true\n /--\n Include internal declarations (names starting with `_`, `match_` or `proof_`)\n -/\n internals : Bool := false\n\n/-- Function elaborating `Config`. -/\ndeclare_command_config_elab elabPrintPrefixConfig PrintPrefixConfig\n\n/--\n`reverseName name` reverses the components of a name.\n-/\nprivate def reverseName : Name → (pre : Name := .anonymous) → Name\n| .anonymous, p => p\n| .str q s, p => reverseName q (.str p s)\n| .num q n, p => reverseName q (.num p n)\n\n/--\n`takeNameSuffix n name` returns a pair `(pre, suf)` where `suf` contains the last `n` components\nof the name and `pre` contains the rest.\n-/\nprivate def takeNameSuffix (cnt : Nat) (name : Name) (pre : Name := .anonymous) : Name × Name :=\n match cnt, name with\n | .succ cnt, .str q s => takeNameSuffix cnt q (.str pre s)\n | .succ cnt, .num q n => takeNameSuffix cnt q (.num pre n)\n | _, name => (name, reverseName pre)\n\n/--\n`matchName opts pre cinfo` returns true if the search options should include the constant.\n-/\nprivate def matchName (opts : PrintPrefixConfig)\n (pre : Name) (cinfo : ConstantInfo) : MetaM Bool := do\n let name := cinfo.name\n unless (← hasConst name) do -- some compiler decls are not known to the elab env, ignore them\n return false\n let preCnt := pre.getNumParts\n let nameCnt := name.getNumParts\n if preCnt > nameCnt then return false\n let (root, post) := takeNameSuffix (nameCnt - preCnt) name\n if root ≠ pre then return false\n if !opts.internals && post.isInternalDetail then return false\n if opts.propositions != opts.propositionsOnly then return opts.propositions\n let isProp := (Expr.isProp <$> Lean.Meta.inferType cinfo.type) <|> pure false\n pure <| opts.propositionsOnly == (← isProp)\n\nprivate def lexNameLt : Name -> Name -> Bool\n| _, .anonymous => false\n| .anonymous, _ => true\n| .num p m, .num q n => m < n || m == n && lexNameLt p q\n| .num _ _, .str _ _ => true\n| .str _ _, .num _ _ => false\n| .str p m, .str q n => m < n || m == n && lexNameLt p q\n\nprivate def matchingConstants (opts : PrintPrefixConfig) (pre : Name)\n : MetaM (Array MessageData) := do\n let cinfos ← getMatchingConstants (matchName opts pre) opts.imported\n let cinfos := cinfos.qsort fun p q => lexNameLt (reverseName p.name) (reverseName q.name)\n cinfos.mapM fun cinfo => do\n if opts.showTypes then\n pure <| MessageData.signature cinfo.name ++ \"\\n\"\n else\n pure m!\"{MessageData.ofConst (← mkConstWithLevelParams cinfo.name)}\\n\"\n\n/--\nThe command `#print prefix foo` will print all definitions that start with\nthe namespace `foo`.\n\nFor example, the command below will print out definitions in the `List` namespace:\n\n```lean\n#print prefix List\n```\n\n`#print prefix` can be controlled by flags in `PrintPrefixConfig`. These provide\noptions for filtering names and formatting. For example,\n`#print prefix` by default excludes internal names, but this can be controlled\nvia config:\n```lean\n#print prefix (config := {internals := true}) List\n```\n\nBy default, `#print prefix` prints the type after each name. This can be controlled\nby setting `showTypes` to `false`:\n```lean\n#print prefix (config := {showTypes := false}) List\n```\n\nThe complete set of flags can be seen in the documentation\nfor `Lean.Elab.Command.PrintPrefixConfig`.\n-/\nelab (name := printPrefix) tk:\"#print \" colGt \"prefix\"\n cfg:Lean.Parser.Tactic.optConfig name:(ident)? : command => do\n if let some name := name then\n let opts ← elabPrintPrefixConfig cfg\n liftTermElabM do\n let mut msgs ← matchingConstants opts name.getId\n if msgs.isEmpty then\n if let [name] ← resolveGlobalConst name then\n msgs ← matchingConstants opts name\n logInfoAt tk (.joinSep msgs.toList \"\")\n" }, { "path": "Batteries/Tactic/SeqFocus.lean", "content": "/-\nCopyright (c) 2022 Jeremy Avigad. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Jeremy Avigad\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.Basic\n\npublic meta section\n\nopen Lean Elab Meta Tactic\n\nnamespace Batteries.Tactic\n\n/-- Assuming there are `n` goals, `map_tacs [t1; t2; ...; tn]` applies each `ti` to the respective\ngoal and leaves the resulting subgoals. -/\nelab \"map_tacs \" \"[\" ts:sepBy(tactic, \"; \") \"]\" : tactic => do\n let goals ← getUnsolvedGoals\n let tacs := ts.getElems\n let length := tacs.size\n if length < goals.length then\n throwError \"not enough tactics\"\n else if length > goals.length then\n throwError \"too many tactics\"\n let mut goalsNew := #[]\n for tac in tacs, goal in goals do\n if ← goal.isAssigned then continue\n setGoals [goal]\n try\n evalTactic tac\n goalsNew := goalsNew ++ (← getUnsolvedGoals)\n catch ex =>\n if (← read).recover then\n logException ex\n goalsNew := goalsNew.push goal\n else\n throw ex\n setGoals goalsNew.toList\n\n/-- `t <;> [t1; t2; ...; tn]` focuses on the first goal and applies `t`, which should result in `n`\nsubgoals. It then applies each `ti` to the corresponding goal and collects the resulting\nsubgoals. -/\nmacro:1 (name := seq_focus) t:tactic \" <;> \" \"[\" ts:sepBy(tactic, \"; \") \"]\" : tactic =>\n `(tactic| focus ( $t:tactic; map_tacs [$ts;*]) )\n" }, { "path": "Batteries/Tactic/ShowUnused.lean", "content": "/-\nCopyright (c) 2024 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Util.FoldConsts\npublic meta import Lean.Linter.UnusedVariables\n\npublic meta section\n\n/-!\n# The `#show_unused` command\n\n`#show_unused decl1 decl2 ..` will highlight every theorem or definition in the current file\nnot involved in the definition of declarations `decl1`, `decl2`, etc. The result is shown\nboth in the message on `#show_unused`, as well as on the declarations themselves.\n-/\n\nnamespace Batteries.Tactic.ShowUnused\nopen Lean Elab Command\n\nvariable (env : Environment) in\nprivate partial def visit (n : Name) : StateM NameSet Unit := do\n if (← get).contains n then\n modify (·.erase n)\n let rec visitExpr (e : Expr) : StateM NameSet Unit := e.getUsedConstants.forM visit\n match env.find? n with\n | some (ConstantInfo.axiomInfo v) => visitExpr v.type\n | some (ConstantInfo.defnInfo v) => visitExpr v.type *> visitExpr v.value\n | some (ConstantInfo.thmInfo v) => visitExpr v.type *> visitExpr v.value\n | some (ConstantInfo.opaqueInfo v) => visitExpr v.type *> visitExpr v.value\n | some (ConstantInfo.quotInfo _) => pure ()\n | some (ConstantInfo.ctorInfo v) => visitExpr v.type\n | some (ConstantInfo.recInfo v) => visitExpr v.type\n | some (ConstantInfo.inductInfo v) => visitExpr v.type *> v.ctors.forM visit\n | none => pure ()\n\n/--\n`#show_unused decl1 decl2 ..` will highlight every theorem or definition in the current file\nnot involved in the definition of declarations `decl1`, `decl2`, etc. The result is shown\nboth in the message on `#show_unused`, as well as on the declarations themselves.\n```\ndef foo := 1\ndef baz := 2\ndef bar := foo\n#show_unused bar -- highlights `baz`\n```\n-/\nelab tk:\"#show_unused\" ids:(ppSpace colGt ident)* : command => do\n let ns ← ids.mapM fun s => liftCoreM <| realizeGlobalConstNoOverloadWithInfo s\n let env ← getEnv\n let decls := env.constants.map₂.foldl (fun m n _ => m.insert n) {}\n let mut unused := #[]\n let fileMap ← getFileMap\n for c in ((ns.forM (visit env)).run decls).2 do\n if let some { selectionRange := range, .. } := declRangeExt.find? env c then\n unused := unused.push (c, {\n start := fileMap.ofPosition range.pos\n stop := fileMap.ofPosition range.endPos\n })\n unused := unused.qsort (·.2.start < ·.2.start)\n let pos := fileMap.toPosition <| (tk.getPos? <|> (← getRef).getPos?).getD 0\n let pfx := m!\"#show_unused (line {pos.line}) says:\\n\"\n let post := m!\" is not used transitively by \\\n {← ns.mapM (MessageData.ofConst <$> mkConstWithLevelParams ·)}\"\n for (c, range) in unused do\n logWarningAt (Syntax.ofRange range) <|\n .tagged Linter.linter.unusedVariables.name <|\n m!\"{pfx}{MessageData.ofConst (← mkConstWithLevelParams c)}{post}\"\n if unused.isEmpty then\n logInfoAt tk \"No unused definitions\"\n else\n logWarningAt tk <| m!\"unused definitions in this file:\\n\" ++\n m!\"\\n\".joinSep (← unused.toList.mapM (toMessageData <$> mkConstWithLevelParams ·.1))\n" }, { "path": "Batteries/Tactic/SqueezeScope.lean", "content": "/-\nCopyright (c) 2022 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.SimpTrace\n\npublic meta section\n\n/-!\n# `squeeze_scope` tactic\n\nThe `squeeze_scope` tactic allows aggregating multiple calls to `simp` coming from the same syntax\nbut in different branches of execution, such as in `cases x <;> simp`.\nThe reported `simp` call covers all simp lemmas used by this syntax.\n-/\nnamespace Batteries.Tactic\nopen Lean Elab Parser Tactic Meta.Tactic\n\n/--\n`squeeze_scope a => tacs` is part of the implementation of `squeeze_scope`.\nInside `tacs`, invocations of `simp` wrapped with `squeeze_wrap a _ => ...` will contribute\nto the accounting associated to scope `a`.\n-/\nlocal syntax (name := squeezeScopeIn) \"squeeze_scope \" ident \" => \" tacticSeq : tactic\n/--\n`squeeze_wrap a x => tac` is part of the implementation of `squeeze_scope`.\nHere `tac` will be a `simp` or `dsimp` syntax, and `squeeze_wrap` will run the tactic\nand contribute the generated `usedSimps` to the `squeezeScopes[a][x]` variable.\n-/\nlocal syntax (name := squeezeWrap) \"squeeze_wrap \" ident ppSpace ident \" => \" tactic : tactic\n\nopen TSyntax.Compat in\n/--\nThe `squeeze_scope` tactic allows aggregating multiple calls to `simp` coming from the same syntax\nbut in different branches of execution, such as in `cases x <;> simp`.\nThe reported `simp` call covers all simp lemmas used by this syntax.\n```\n@[simp] def bar (z : Nat) := 1 + z\n@[simp] def baz (z : Nat) := 1 + z\n\n@[simp] def foo : Nat → Nat → Nat\n | 0, z => bar z\n | _+1, z => baz z\n\nexample : foo x y = 1 + y := by\n cases x <;> simp? -- two printouts:\n -- \"Try this: simp only [foo, bar]\"\n -- \"Try this: simp only [foo, baz]\"\n\nexample : foo x y = 1 + y := by\n squeeze_scope\n cases x <;> simp -- only one printout: \"Try this: simp only [foo, baz, bar]\"\n```\n-/\nmacro (name := squeezeScope) \"squeeze_scope \" seq:tacticSeq : tactic => do\n let a ← withFreshMacroScope `(a)\n let seq ← seq.raw.rewriteBottomUpM fun stx =>\n match stx.getKind with\n | ``dsimp | ``simpAll | ``simp\n | ``dsimpTrace | ``simpAllTrace | ``simpTrace => do\n withFreshMacroScope `(tactic| squeeze_wrap $a x => $stx)\n | _ => pure stx\n `(tactic| squeeze_scope $a => $seq)\n\nopen Meta\n\n/--\nWe implement `squeeze_scope` using a global variable that tracks all `squeeze_scope` invocations\nin flight. It is a map `a => (x => (stx, simps))` where `a` is a unique identifier for\nthe `squeeze_scope` invocation which is shared with all contained simps, and `x` is a unique\nidentifier for a particular piece of simp syntax (which can be called multiple times).\nWithin that, `stx` is the simp syntax itself, and `simps` is the aggregated list of simps used\nso far.\n-/\ninitialize squeezeScopes : IO.Ref (NameMap (NameMap (Syntax × List Simp.UsedSimps))) ← IO.mkRef {}\n\nelab_rules : tactic\n | `(tactic| squeeze_scope $a => $tac) => do\n let a := a.getId\n let old ← squeezeScopes.modifyGet fun map => (map.find? a, map.insert a {})\n let reset map := match old with | some old => map.insert a old | none => map.erase a\n let new ← try\n Elab.Tactic.evalTactic tac\n squeezeScopes.modifyGet fun map => (map.find? a, reset map)\n catch e =>\n squeezeScopes.modify reset\n throw e\n if let some new := new then\n for (_, stx, usedSimps) in new do\n let usedSimps := usedSimps.reverse.foldl\n (fun s usedSimps => usedSimps.toArray.foldl .insert s) {}\n let stx' ← mkSimpCallStx stx usedSimps\n TryThis.addSuggestion stx[0] stx' (origSpan? := stx)\n\nelab_rules : tactic\n | `(tactic| squeeze_wrap $a $x => $tac) => do\n let stx := tac.raw\n -- Returns (stats, syntaxToStore) where syntaxToStore is the non-trace syntax for mkSimpCallStx\n let (stats, stxToStore) ← match stx.getKind with\n | ``Parser.Tactic.simp => do\n let { ctx, simprocs, dischargeWrapper, .. } ←\n withMainContext <| mkSimpContext stx (eraseLocal := false)\n let stats ← dischargeWrapper.with fun discharge? =>\n simpLocation ctx simprocs discharge? (expandOptLocation stx[5])\n pure (stats, stx)\n | ``Parser.Tactic.simpAll => do\n let { ctx, simprocs, .. } ← mkSimpContext stx\n (eraseLocal := true) (kind := .simpAll) (ignoreStarArg := true)\n let (result?, stats) ← simpAll (← getMainGoal) ctx simprocs\n match result? with\n | none => replaceMainGoal []\n | some mvarId => replaceMainGoal [mvarId]\n pure (stats, stx)\n | ``Parser.Tactic.dsimp => do\n let { ctx, simprocs, .. } ← withMainContext <|\n mkSimpContext stx (eraseLocal := false) (kind := .dsimp)\n let stats ← dsimpLocation' ctx simprocs (expandOptLocation stx[5])\n pure (stats, stx)\n | ``simpTrace => do\n -- Convert simp? to simp and run\n match tac with\n | `(tactic| simp?%$tk $[!%$bang]? $cfg:optConfig $(discharger)? $[only%$o]?\n $[[$args,*]]? $(loc)?) =>\n let simpStx ← if bang.isSome then\n `(tactic| simp!%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]? $[$loc]?)\n else\n `(tactic| simp%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]? $[$loc]?)\n let { ctx, simprocs, dischargeWrapper, .. } ←\n withMainContext <| mkSimpContext simpStx.raw (eraseLocal := false)\n let stats ← dischargeWrapper.with fun discharge? =>\n simpLocation ctx simprocs discharge? (expandOptLocation simpStx.raw[5])\n pure (stats, simpStx.raw)\n | _ => Elab.throwUnsupportedSyntax\n | ``simpAllTrace => do\n -- Convert simp_all? to simp_all and run\n match tac with\n | `(tactic| simp_all?%$tk $[!%$bang]? $cfg:optConfig $(discharger)? $[only%$o]?\n $[[$args,*]]?) =>\n let simpStx ← if bang.isSome then\n `(tactic| simp_all!%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]?)\n else\n `(tactic| simp_all%$tk $cfg:optConfig $[$discharger]? $[only%$o]? $[[$args,*]]?)\n let { ctx, simprocs, .. } ← mkSimpContext simpStx.raw\n (eraseLocal := true) (kind := .simpAll) (ignoreStarArg := true)\n let (result?, stats) ← simpAll (← getMainGoal) ctx simprocs\n match result? with\n | none => replaceMainGoal []\n | some mvarId => replaceMainGoal [mvarId]\n pure (stats, simpStx.raw)\n | _ => Elab.throwUnsupportedSyntax\n | ``dsimpTrace => do\n -- Convert dsimp? to dsimp and run\n match tac with\n | `(tactic| dsimp?%$tk $[!%$bang]? $cfg:optConfig $[only%$o]? $[[$args,*]]? $(loc)?) =>\n let simpStx ← if bang.isSome then\n `(tactic| dsimp!%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]? $[$loc]?)\n else\n `(tactic| dsimp%$tk $cfg:optConfig $[only%$o]? $[[$args,*]]? $[$loc]?)\n let { ctx, simprocs, .. } ← withMainContext <|\n mkSimpContext simpStx.raw (eraseLocal := false) (kind := .dsimp)\n let stats ← dsimpLocation' ctx simprocs (expandOptLocation simpStx.raw[5])\n pure (stats, simpStx.raw)\n | _ => Elab.throwUnsupportedSyntax\n | _ => Elab.throwUnsupportedSyntax\n let a := a.getId; let x := x.getId\n squeezeScopes.modify fun map => Id.run do\n let some map1 := map.find? a | return map\n let newSimps := match map1.find? x with\n | some (stx, oldSimps) => (stx, stats.usedTheorems :: oldSimps)\n | none => (stxToStore, [stats.usedTheorems])\n map.insert a (map1.insert x newSimps)\n" }, { "path": "Batteries/Tactic/Trans.lean", "content": "/-\nCopyright (c) 2022 Siddhartha Gadgil. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Siddhartha Gadgil, Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.ElabTerm\n\npublic meta section\n\n/-!\n# `trans` tactic\n\nThis implements the `trans` tactic, which can apply transitivity theorems with an optional middle\nvariable argument.\n-/\n\n/-- Compose using transitivity, homogeneous case. -/\n@[expose] def Trans.simple {r : α → α → Sort _} [Trans r r r] : r a b → r b c → r a c := trans\n\nnamespace Batteries.Tactic\nopen Lean Meta Elab\n\ninitialize registerTraceClass `Tactic.trans\n\n/-- Environment extension storing transitivity lemmas -/\ninitialize transExt :\n SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←\n registerSimpleScopedEnvExtension {\n addEntry := fun dt (n, ks) => dt.insertKeyValue ks n\n initial := {}\n }\n\ninitialize registerBuiltinAttribute {\n name := `trans\n descr := \"transitive relation\"\n add := fun decl _ kind => MetaM.run' do\n let declTy := (← getConstInfo decl).type\n let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy\n let fail := throwError\n \"@[trans] attribute only applies to lemmas proving\n x ∼ y → y ∼ z → x ∼ z, got {indentExpr declTy} with target {indentExpr targetTy}\"\n let .app (.app rel _) _ := targetTy | fail\n let some yzHyp := xs.back? | fail\n let some xyHyp := xs.pop.back? | fail\n let .app (.app _ _) _ ← inferType yzHyp | fail\n let .app (.app _ _) _ ← inferType xyHyp | fail\n let key ← withReducible <| DiscrTree.mkPath rel\n transExt.add (decl, key) kind\n}\n\nopen Lean.Elab.Tactic\n\n/-- solving `e ← mkAppM' f #[x]` -/\ndef getExplicitFuncArg? (e : Expr) : MetaM (Option <| Expr × Expr) := do\n match e with\n | Expr.app f a => do\n if ← isDefEq (← mkAppM' f #[a]) e then\n return some (f, a)\n else\n getExplicitFuncArg? f\n | _ => return none\n\n/-- solving `tgt ← mkAppM' rel #[x, z]` given `tgt = f z` -/\ndef getExplicitRelArg? (tgt f z : Expr) : MetaM (Option <| Expr × Expr) := do\n match f with\n | Expr.app rel x => do\n let check: Bool ← do\n try\n let folded ← mkAppM' rel #[x, z]\n isDefEq folded tgt\n catch _ =>\n pure false\n if check then\n return some (rel, x)\n else\n getExplicitRelArg? tgt rel z\n | _ => return none\n\n/-- refining `tgt ← mkAppM' rel #[x, z]` dropping more arguments if possible -/\ndef getExplicitRelArgCore (tgt rel x z : Expr) : MetaM (Expr × Expr) := do\n match rel with\n | Expr.app rel' _ => do\n let check: Bool ← do\n try\n let folded ← mkAppM' rel' #[x, z]\n isDefEq folded tgt\n catch _ =>\n pure false\n if !check then\n return (rel, x)\n else\n getExplicitRelArgCore tgt rel' x z\n | _ => return (rel ,x)\n\n/-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent\narrow. -/\ninductive TransRelation\n /-- Expression for transitive relation. -/\n | app (rel : Expr)\n /-- Constant name for transitive relation. -/\n | implies (name : Name) (bi : BinderInfo)\n\n/-- Finds an explicit binary relation in the argument, if possible. -/\ndef getRel (tgt : Expr) : MetaM (Option (TransRelation × Expr × Expr)) := do\n match tgt with\n | .forallE name binderType body info => return .some (.implies name info, binderType, body)\n | .app f z =>\n match (← getExplicitRelArg? tgt f z) with\n | some (rel, x) =>\n let (rel, x) ← getExplicitRelArgCore tgt rel x z\n return some (.app rel, x, z)\n | none =>\n return none\n | _ => return none\n\n/--\n`trans` applies to a goal whose target has the form `t ~ u` where `~` is a transitive relation,\nthat is, a relation which has a transitivity lemma tagged with the attribute [trans].\n\n* `trans s` replaces the goal with the two subgoals `t ~ s` and `s ~ u`.\n* If `s` is omitted, then a metavariable is used instead.\n\nAdditionally, `trans` also applies to a goal whose target has the form `t → u`,\nin which case it replaces the goal with `t → s` and `s → u`.\n-/\nelab \"trans\" t?:(ppSpace colGt term)? : tactic => withMainContext do\n let tgt := (← instantiateMVars (← (← getMainGoal).getType)).cleanupAnnotations\n let .some (rel, x, z) ← getRel tgt |\n throwError (m!\"transitivity lemmas only apply to binary relations and \" ++\n m!\"non-dependent arrows, not {indentExpr tgt}\")\n match rel with\n | .implies name info =>\n -- only consider non-dependent arrows\n if z.hasLooseBVars then\n throwError \"`trans` is not implemented for dependent arrows{indentExpr tgt}\"\n -- parse the intermeditate term\n let middleType ← mkFreshExprMVar none\n let t'? ← t?.mapM (elabTermWithHoles · middleType (← getMainTag))\n let middle ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar middleType)\n liftMetaTactic fun goal => do\n -- create two new goals\n let g₁ ← mkFreshExprMVar (some <| .forallE name x middle info) .synthetic\n let g₂ ← mkFreshExprMVar (some <| .forallE name middle z info) .synthetic\n -- close the original goal with `fun x => g₂ (g₁ x)`\n goal.assign (.lam name x (.app g₂ (.app g₁ (.bvar 0))) .default)\n pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [middle.mvarId!]\n return\n | .app rel =>\n trace[Tactic.trans]\"goal decomposed\"\n trace[Tactic.trans]\"rel: {indentExpr rel}\"\n trace[Tactic.trans]\"x: {indentExpr x}\"\n trace[Tactic.trans]\"z: {indentExpr z}\"\n -- first trying the homogeneous case\n try\n let ty ← inferType x\n let t'? ← t?.mapM (elabTermWithHoles · ty (← getMainTag))\n let s ← saveState\n trace[Tactic.trans]\"trying homogeneous case\"\n let lemmas :=\n (← (transExt.getState (← getEnv)).getUnify rel).push ``Trans.simple\n for lem in lemmas do\n trace[Tactic.trans]\"trying lemma {lem}\"\n try\n liftMetaTactic fun g => do\n let lemTy ← inferType (← mkConstWithLevelParams lem)\n let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size\n let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar ty)\n let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic\n let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic\n g.assign (← mkAppOptM lem (.replicate (arity - 2) none ++ #[some g₁, some g₂]))\n pure <| [g₁.mvarId!, g₂.mvarId!] ++\n if let some (_, gs') := t'? then gs' else [y.mvarId!]\n return\n catch _ => s.restore\n pure ()\n catch _ =>\n trace[Tactic.trans]\"trying heterogeneous case\"\n let t'? ← t?.mapM (elabTermWithHoles · none (← getMainTag))\n let s ← saveState\n for lem in (← (transExt.getState (← getEnv)).getUnify rel).push\n ``HEq.trans |>.push ``Trans.trans do\n try\n liftMetaTactic fun g => do\n trace[Tactic.trans]\"trying lemma {lem}\"\n let lemTy ← inferType (← mkConstWithLevelParams lem)\n let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size\n trace[Tactic.trans]\"arity: {arity}\"\n trace[Tactic.trans]\"lemma-type: {lemTy}\"\n let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar none)\n trace[Tactic.trans]\"obtained y: {y}\"\n trace[Tactic.trans]\"rel: {indentExpr rel}\"\n trace[Tactic.trans]\"x:{indentExpr x}\"\n trace[Tactic.trans]\"z: {indentExpr z}\"\n let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic\n trace[Tactic.trans]\"obtained g₂: {g₂}\"\n let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic\n trace[Tactic.trans]\"obtained g₁: {g₁}\"\n g.assign (← mkAppOptM lem (.replicate (arity - 2) none ++ #[some g₁, some g₂]))\n pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [y.mvarId!]\n return\n catch e =>\n trace[Tactic.trans]\"failed: {e.toMessageData}\"\n s.restore\n throwError m!\"no applicable transitivity lemma found for {indentExpr tgt}\"\n\n/-- Synonym for `trans` tactic. -/\nsyntax \"transitivity\" (ppSpace colGt term)? : tactic\nset_option hygiene false in\nmacro_rules\n | `(tactic| transitivity) => `(tactic| trans)\n | `(tactic| transitivity $e) => `(tactic| trans $e)\n\nend Batteries.Tactic\n" }, { "path": "Batteries/Tactic/Unreachable.lean", "content": "/-\nCopyright (c) 2021 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic meta import Lean.Elab.Tactic.Basic\n\npublic meta section\n\nnamespace Batteries.Tactic\n\n/--\nThis tactic causes a panic when run (at compile time).\n(This is distinct from `exact unreachable!`, which inserts code which will panic at run time.)\n\nIt is intended for tests to assert that a tactic will never be executed, which is otherwise an\nunusual thing to do (and the `unreachableTactic` linter will give a warning if you do).\n\nThe `unreachableTactic` linter has a special exception for uses of `unreachable!`.\n```\nexample : True := by trivial <;> unreachable!\n```\n-/\nelab (name := unreachable) \"unreachable!\" : tactic => do\n panic! \"unreachable tactic has been reached\"\n -- Note that `panic!` does not actually halt execution or early exit,\n -- so we still have to throw an error after panicking.\n throwError \"unreachable tactic has been reached\"\n\n@[inherit_doc unreachable] macro (name := unreachableConv) \"unreachable!\" : conv =>\n `(conv| tactic' => unreachable!)\n" }, { "path": "Batteries/Util/Cache.lean", "content": "/-\nCopyright (c) 2021 Gabriel Ebner. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic import Lean.Meta.DiscrTree\n\n@[expose] public section\n\n/-!\n# Once-per-file cache for tactics\n\nThis file defines cache data structures for tactics\nthat are initialized the first time they are accessed.\nSince Lean 4 starts one process per file, these caches are once-per-file\nand can for example be used to cache information about the imported modules.\n\nThe `Cache α` data structure is the most generic version we define.\nIt is created using `Cache.mk f` where `f : MetaM α` performs the initialization of the cache:\n```\ninitialize numberOfImports : Cache Nat ← Cache.mk do\n (← getEnv).imports.size\n\n-- (does not work in the same module where the cache is defined)\n#eval show MetaM Nat from numberOfImports.get\n```\n\nThe `DeclCache α` data structure computes a fold over the environment's constants:\n`DeclCache.mk empty f` constructs such a cache\nwhere `empty : α` and `f : Name → ConstantInfo → α → MetaM α`.\nThe result of the constants in the imports is cached between tactic invocations,\nwhile for constants defined in the same file `f` is evaluated again every time.\nThis kind of cache can be used e.g. to populate discrimination trees.\n-/\n\nopen Lean Meta\n\nnamespace Batteries.Tactic\n\n/-- Once-per-file cache. -/\ndef Cache (α : Type) := IO.Ref <| MetaM α ⊕ Task (Except Exception α)\n\n-- This instance is required as we use `Cache` with `initialize`.\n-- One might expect an `Inhabited` instance here,\n-- but there is no way to construct such without using choice anyway.\ninstance : Nonempty (Cache α) := inferInstanceAs <| Nonempty (IO.Ref _)\n\n/-- Creates a cache with an initialization function. -/\ndef Cache.mk (init : MetaM α) : IO (Cache α) := IO.mkRef <| Sum.inl init\n\n@[inherit_doc Core.wrapAsync]\ndef _root_.Lean.Meta.wrapAsync {α : Type} (act : α → MetaM β) (cancelTk? : Option IO.CancelToken) :\n MetaM (α → EIO Exception β) := do\n let metaCtx ← readThe Meta.Context\n let metaSt ← getThe Meta.State\n Core.wrapAsync (fun a => act a |>.run' metaCtx metaSt) cancelTk?\n\n/--\nAccess the cache. Calling this function for the first time will initialize the cache\nwith the function provided in the constructor.\n-/\ndef Cache.get (cache : Cache α) : MetaM α := do\n let t ← match ← ST.Ref.get (m := BaseIO) cache with\n | .inr t => pure t\n | .inl init =>\n let res ← EIO.asTask <| (← Meta.wrapAsync (fun _ => init) (cancelTk? := none)) ()\n cache.set (m := BaseIO) (.inr res)\n pure res\n match t.get with\n | Except.ok res => pure res\n | Except.error err => throw err\n\n/--\nCached fold over the environment's declarations,\nwhere a given function is applied to `α` for every constant.\n-/\nstructure DeclCache (α : Type) where mk' ::\n /-- The cached data. -/\n cache : Cache α\n /-- Function for adding a declaration from the current file to the cache. -/\n addDecl : Name → ConstantInfo → α → MetaM α\n /-- Function for adding a declaration from the library to the cache.\n Defaults to the same behaviour as adding a declaration from the current file. -/\n addLibraryDecl : Name → ConstantInfo → α → MetaM α := addDecl\n deriving Nonempty\n\n/--\nCreates a `DeclCache`.\n\nFirst, if `pre` is nonempty, run that for a value,\nand if successful populate the cache with that value.\n\nIf `pre` is empty, or it fails,\nthe cached structure `α` is initialized with `empty`,\nand then `addLibraryDecl` is called for every imported constant.\nAfter all imported constants have been added, we run `post`.\nFinally, the result is cached.\n\nWhen `get` is called, `addDecl` is also called for every constant in the current file.\n-/\ndef DeclCache.mk (profilingName : String) (pre : MetaM α := failure) (empty : α)\n (addDecl : Name → ConstantInfo → α → MetaM α)\n (addLibraryDecl : Name → ConstantInfo → α → MetaM α := addDecl)\n (post : α → MetaM α := fun a => pure a) : IO (DeclCache α) := do\n let cache ← Cache.mk do\n try\n -- We allow arbitrary failures in the `pre` tactic,\n -- and fall back on folding over the entire environment.\n -- In practice the `pre` tactic may be unpickling an `.olean`,\n -- and may fail after leanprover/lean4#2766 because the embedded hash is incorrect.\n pre\n catch _ =>\n profileitM Exception profilingName (← getOptions) do\n post <|← (← getEnv).constants.map₁.foldM (init := empty) fun a n c =>\n addLibraryDecl n c a\n pure { cache, addDecl }\n\n/--\nAccess the cache. Calling this function for the first time will initialize the cache\nwith the function provided in the constructor.\n-/\ndef DeclCache.get (cache : DeclCache α) : MetaM α := do\n (← getEnv).constants.map₂.foldlM (init := ← cache.cache.get) fun a n c =>\n cache.addDecl n c a\n\n/--\nA type synonym for a `DeclCache` containing a pair of discrimination trees.\nThe first will store declarations in the current file,\nthe second will store declarations from imports (and will hopefully be \"read-only\" after creation).\n-/\n@[reducible] def DiscrTreeCache (α : Type) : Type := DeclCache (DiscrTree α × DiscrTree α)\n\n/--\nBuild a `DiscrTreeCache`,\nfrom a function that returns a collection of keys and values for each declaration.\n-/\ndef DiscrTreeCache.mk [BEq α] (profilingName : String)\n (processDecl : Name → ConstantInfo → MetaM (Array (Array DiscrTree.Key × α)))\n (post? : Option (Array α → Array α) := none)\n (init : MetaM (DiscrTree α) := failure) :\n IO (DiscrTreeCache α) :=\n let updateTree := fun name constInfo tree => do\n return (← processDecl name constInfo).foldl (init := tree) fun t (k, v) =>\n t.insertKeyValue k v\n let addDecl := fun name constInfo (tree₁, tree₂) =>\n return (← updateTree name constInfo tree₁, tree₂)\n let addLibraryDecl := fun name constInfo (tree₁, tree₂) =>\n return (tree₁, ← updateTree name constInfo tree₂)\n let post := match post? with\n | some f => fun (T₁, T₂) => return (T₁, T₂.mapArrays f)\n | none => fun T => pure T\n let init' := return ({}, ← init)\n DeclCache.mk profilingName init' ({}, {}) addDecl addLibraryDecl (post := post)\n\n/--\nGet matches from both the discrimination tree for declarations in the current file,\nand for the imports.\n\nNote that if you are calling this multiple times with the same environment,\nit will rebuild the discrimination tree for the current file multiple times,\nand it would be more efficient to call `c.get` once,\nand then call `DiscrTree.getMatch` multiple times.\n-/\ndef DiscrTreeCache.getMatch (c : DiscrTreeCache α) (e : Expr) : MetaM (Array α) := do\n let (locals, imports) ← c.get\n -- `DiscrTree.getMatch` returns results in batches, with more specific lemmas coming later.\n -- Hence we reverse this list, so we try out more specific lemmas earlier.\n return (← locals.getMatch e).reverse ++ (← imports.getMatch e).reverse\n" }, { "path": "Batteries/Util/ExtendedBinder.lean", "content": "/-\nCopyright (c) 2021 Microsoft Corporation. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\n@[expose] public section\n\n/-!\nDefines an extended binder syntax supporting `∀ ε > 0, ...` etc.\n-/\n\nnamespace Batteries.ExtendedBinder\nopen Lean\n\n\n-- We also provide special versions of ∀/∃ that take a list of extended binders.\n-- The built-in binders are not reused because that results in overloaded syntax.\n\n/--\nAn extended binder has the form `x`, `x : ty`, or `x pred`\nwhere `pred` is a `binderPred` like `< 2`.\n-/\nsyntax extBinder := binderIdent ((\" : \" term) <|> binderPred)?\n/-- A extended binder in parentheses -/\nsyntax extBinderParenthesized := \" (\" extBinder \")\" -- TODO: inlining this definition breaks\n/-- A list of parenthesized binders -/\nsyntax extBinderCollection := extBinderParenthesized*\n/-- A single (unparenthesized) binder, or a list of parenthesized binders -/\nsyntax extBinders := (ppSpace extBinder) <|> extBinderCollection\n\n/-- The syntax `∃ᵉ (x < 2) (y < 3), p x y` is shorthand for `∃ x < 2, ∃ y < 3, p x y`. -/\nsyntax \"∃ᵉ\" extBinders \", \" term : term\nmacro_rules\n | `(∃ᵉ, $b) => pure b\n | `(∃ᵉ ($p:extBinder) $[($ps:extBinder)]*, $b) =>\n `(∃ᵉ $p:extBinder, ∃ᵉ $[($ps:extBinder)]*, $b)\nmacro_rules -- TODO: merging the two macro_rules breaks expansion\n | `(∃ᵉ $x:binderIdent, $b) => `(∃ $x:binderIdent, $b)\n | `(∃ᵉ $x:binderIdent : $ty:term, $b) => `(∃ $x:binderIdent : $ty:term, $b)\n | `(∃ᵉ $x:binderIdent $p:binderPred, $b) => `(∃ $x:binderIdent $p:binderPred, $b)\n\n/-- The syntax `∀ᵉ (x < 2) (y < 3), p x y` is shorthand for `∀ x < 2, ∀ y < 3, p x y`. -/\nsyntax \"∀ᵉ\" extBinders \", \" term : term\nmacro_rules\n | `(∀ᵉ, $b) => pure b\n | `(∀ᵉ ($p:extBinder) $[($ps:extBinder)]*, $b) =>\n `(∀ᵉ $p:extBinder, ∀ᵉ $[($ps:extBinder)]*, $b)\nmacro_rules -- TODO: merging the two macro_rules breaks expansion\n | `(∀ᵉ _, $b) => `(∀ _, $b)\n | `(∀ᵉ $x:ident, $b) => `(∀ $x:ident, $b)\n | `(∀ᵉ _ : $ty:term, $b) => `(∀ _ : $ty:term, $b)\n | `(∀ᵉ $x:ident : $ty:term, $b) => `(∀ $x:ident : $ty:term, $b)\n | `(∀ᵉ $x:binderIdent $p:binderPred, $b) => `(∀ $x:binderIdent $p:binderPred, $b)\n" }, { "path": "Batteries/Util/LibraryNote.lean", "content": "/-\nCopyright (c) 2022 Gabriel Ebner. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Gabriel Ebner\n-/\nmodule\n\npublic meta import Lean.Elab.Command\n\npublic meta section\n\n/-!\n# Define the `library_note` command.\n-/\n\nnamespace Batteries.Util\n\nopen Lean\n\n/-- A library note is identified by the name of its declaration, and its content should be contained\nin its doc-string. -/\n@[expose] def LibraryNote := Unit\nderiving Inhabited\n\nnamespace LibraryNote\n\n/-- Entry for library notes in the environment extension.\n\nWe only store the name, and look up the constant's docstring to find its contents.\n-/\n@[expose] def LibraryNoteEntry := Name\nderiving Inhabited\n\n/-- Encode a name to be safe for the Lean export format.\n\nThe current export format (used by `lean4export` and consumed by external type checkers like\n`nanoda_lib`) does not support whitespace in declaration names. Library notes often have\nhuman-readable names with spaces like `«my library note»`, which would produce declarations\nlike `LibraryNote.«my library note»` that cannot be exported.\n\nThis function replaces spaces with underscores to produce export-safe names like\n`LibraryNote.my_library_note`.\n-/\ndef encodeNameForExport (n : Name) : Name :=\n n.componentsRev.foldl (init := .anonymous) fun acc c =>\n match c with\n | .str _ s => .str acc (s.replace \" \" \"_\")\n | .num _ k => .num acc k\n | .anonymous => acc\n\n/-- Environment extension supporting `library_note`. -/\ninitialize libraryNoteExt : SimplePersistentEnvExtension LibraryNoteEntry (Array LibraryNoteEntry) ←\n registerSimplePersistentEnvExtension {\n addEntryFn := Array.push\n addImportedFn := Array.flatMap id\n }\n\nopen Elab Command in\n/-- `library_note «my note» /-- documentation -/` creates a library note named `my note`\nin the `LibraryNote` namespace, whose content is `/-- documentation -/`.\nThis can then be cross-referenced using\n```\n-- See note [some tag]\n```\nin doc-comments.\nYou can access the contents using, for example, `#print LibraryNote.my_note`.\n(Note: spaces in the name are converted to underscores in the declaration name for\ncompatibility with the Lean export format.)\nUse `#help note \"some tag\"` to display all notes with the tag `\"some tag\"` in the infoview.\nThis command can be imported from Batteries.Tactic.HelpCmd .\n-/\nelab \"library_note \" name:ident ppSpace dc:docComment : command => do\n let origName := name.getId\n -- Store original name (with spaces) for lookup via `#help note`\n modifyEnv (libraryNoteExt.addEntry · origName)\n -- Use encoded name (spaces → underscores) for declaration, for export format compatibility\n let safeName := encodeNameForExport origName\n let stx ← `(\n $dc:docComment\n meta def $(mkIdent (`_root_.LibraryNote ++ safeName)) : LibraryNote :=\n default)\n elabCommandTopLevel stx\n\nopen Elab Command in\n/-- Support the old `library_note \"foo\"` syntax, with a deprecation warning. -/\nelab \"library_note \" name:str ppSpace dc:docComment : command => do\n let name' := Name.mkSimple name.getString\n let stx ← `(library_note $(mkIdent name'):ident $dc:docComment)\n elabCommandTopLevel stx\n logWarningAt name <|\n \"deprecation warning: library_note now takes an identifier instead of a string.\\n\" ++\n \"Hint: replace the double quotes with «french quotes».\"\n\nopen Elab Command in\n/-- Support the old `library_note2 «foo»` syntax, with a deprecation warning. -/\nelab \"library_note2 \" name:ident ppSpace dc:docComment : command => do\n let stx ← `(library_note $name:ident $dc:docComment)\n elabCommandTopLevel stx\n logWarningAt name <|\n \"deprecation warning: library_note2 has been replaced with library_note.\"\n\nopen Elab Command in\n/-- Support the old `library_note2 \"foo\"` syntax, with a deprecation warning. -/\nelab \"library_note2 \" name:str ppSpace dc:docComment : command => do\n let stx ← `(library_note name $dc:docComment)\n elabCommandTopLevel stx\n logWarningAt name <|\n \"deprecation warning: library_note2 has been replaced with library_note.\"\n" }, { "path": "Batteries/Util/Panic.lean", "content": "/-\nCopyright (c) 2024 François G. Dorais. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: François G. Dorais\n-/\nmodule\n\n@[expose] public section\n\nnamespace Batteries\n\n/-- Panic with a specific default value `v`. -/\ndef panicWith (v : α) (msg : String) : α := @panic α ⟨v⟩ msg\n\n@[simp] theorem panicWith_eq (v : α) (msg) : panicWith v msg = v := rfl\n" }, { "path": "Batteries/Util/Pickle.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nmodule\n\npublic import Lean.Environment\n\n@[expose] public section\n\n/-!\n# Pickling and unpickling objects\n\nBy abusing `saveModuleData` and `readModuleData` we can pickle and unpickle objects to disk.\n-/\n\nopen Lean System\n\n/--\nSave an object to disk.\nIf you need to write multiple objects from within a single declaration,\nyou will need to provide a unique `key` for each.\n-/\ndef pickle {α : Type} (path : FilePath) (x : α) (key : Name := by exact decl_name%) : IO Unit :=\n saveModuleData path key (unsafe unsafeCast x)\n\n/--\nLoad an object from disk.\nNote: The returned `CompactedRegion` can be used to free the memory behind the value\nof type `α`, using `CompactedRegion.free` (which is only safe once all references to the `α` are\nreleased). Ignoring the `CompactedRegion` results in the data being leaked.\nUse `withUnpickle` to call `CompactedRegion.free` automatically.\n\nThis function is unsafe because the data being loaded may not actually have type `α`, and this\nmay cause crashes or other bad behavior.\n-/\nunsafe def unpickle (α : Type) (path : FilePath) : IO (α × CompactedRegion) := do\n let (x, region) ← readModuleData path\n pure (unsafeCast x, region)\n\n/-- Load an object from disk and run some continuation on it, freeing memory afterwards. -/\nunsafe def withUnpickle [Monad m] [MonadLiftT IO m] {α β : Type}\n (path : FilePath) (f : α → m β) : m β := do\n let (x, region) ← unpickle α path\n let r ← f x\n region.free\n pure r\n" }, { "path": "Batteries/Util/ProofWanted.lean", "content": "/-\nCopyright (c) 2023 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: David Thrane Christiansen\n-/\nmodule\n\npublic meta import Lean.Elab.Exception\npublic meta import Lean.Elab.Command\n\npublic meta section\n\n\nopen Lean Parser Elab Command\n\n/-- This proof would be a welcome contribution to the library!\n\nThe syntax of `proof_wanted` declarations is just like that of `theorem`, but without `:=` or the\nproof. Lean checks that `proof_wanted` declarations are well-formed (e.g. it ensures that all the\nmentioned names are in scope, and that the theorem statement is a valid proposition), but they are\ndiscarded afterwards. This means that they cannot be used as axioms.\n\nTypical usage:\n```\n@[simp] proof_wanted empty_find? [BEq α] [Hashable α] {a : α} :\n (∅ : HashMap α β).find? a = none\n```\n-/\n@[command_parser]\ndef «proof_wanted» := leading_parser\n declModifiers false >> \"proof_wanted\" >> declId >> ppIndent declSig\n\n/-- Elaborate a `proof_wanted` declaration. The declaration is translated to an axiom during\nelaboration, but it's then removed from the environment.\n-/\n@[command_elab «proof_wanted»]\ndef elabProofWanted : CommandElab\n | `($mods:declModifiers proof_wanted $name $args* : $res) => withoutModifyingEnv do\n -- The helper axiom is used instead of `sorry` to avoid spurious warnings\n elabCommand <| ← `(\n section\n set_option linter.unusedVariables false\n axiom helper {α : Sort _} : α\n $mods:declModifiers theorem $name $args* : $res := helper\n end)\n | _ => throwUnsupportedSyntax\n" }, { "path": "Batteries.lean", "content": "module\n\npublic import Batteries.Classes.Cast\npublic import Batteries.Classes.Deprecated\npublic import Batteries.Classes.Order\npublic import Batteries.Classes.RatCast\npublic import Batteries.Classes.SatisfiesM\npublic import Batteries.CodeAction\npublic import Batteries.CodeAction.Attr\npublic import Batteries.CodeAction.Basic\npublic import Batteries.CodeAction.Deprecated\npublic import Batteries.CodeAction.Match\npublic import Batteries.CodeAction.Misc\npublic import Batteries.Control.AlternativeMonad\npublic import Batteries.Control.ForInStep\npublic import Batteries.Control.ForInStep.Basic\npublic import Batteries.Control.ForInStep.Lemmas\npublic import Batteries.Control.LawfulMonadState\npublic import Batteries.Control.Lemmas\npublic import Batteries.Control.Monad\npublic import Batteries.Control.Nondet.Basic\npublic import Batteries.Control.OptionT\npublic import Batteries.Data.Array\npublic import Batteries.Data.AssocList\npublic import Batteries.Data.Bool\npublic import Batteries.Data.BinaryHeap\npublic import Batteries.Data.BinomialHeap\npublic import Batteries.Data.BitVec\npublic import Batteries.Data.ByteArray\npublic import Batteries.Data.ByteSlice\npublic import Batteries.Data.Char\npublic import Batteries.Data.DList\npublic import Batteries.Data.Fin\npublic import Batteries.Data.FloatArray\npublic import Batteries.Data.HashMap\npublic import Batteries.Data.Int\npublic import Batteries.Data.List\npublic import Batteries.Data.MLList\npublic import Batteries.Data.NameSet\npublic import Batteries.Data.Nat\npublic import Batteries.Data.PairingHeap\npublic import Batteries.Data.RBMap\npublic import Batteries.Data.Random\npublic import Batteries.Data.Range\npublic import Batteries.Data.Rat\npublic import Batteries.Data.RunningStats\npublic import Batteries.Data.Stream\npublic import Batteries.Data.String\npublic import Batteries.Data.UInt\npublic import Batteries.Data.UnionFind\npublic import Batteries.Data.Vector\npublic import Batteries.Lean.AttributeExtra\npublic import Batteries.Lean.EStateM\npublic import Batteries.Lean.Except\npublic import Batteries.Lean.Expr\npublic import Batteries.Lean.Float\npublic import Batteries.Lean.HashMap\npublic import Batteries.Lean.HashSet\npublic import Batteries.Lean.IO.Process\npublic import Batteries.Lean.Json\npublic import Batteries.Lean.LawfulMonad\npublic import Batteries.Lean.LawfulMonadLift\npublic import Batteries.Lean.Meta.Basic\npublic import Batteries.Lean.Meta.DiscrTree\npublic import Batteries.Lean.Meta.Expr\npublic import Batteries.Lean.Meta.Inaccessible\npublic import Batteries.Lean.Meta.InstantiateMVars\npublic import Batteries.Lean.Meta.SavedState\npublic import Batteries.Lean.Meta.Simp\npublic import Batteries.Lean.Meta.UnusedNames\npublic import Batteries.Lean.MonadBacktrack\npublic import Batteries.Lean.NameMapAttribute\npublic import Batteries.Lean.PersistentHashMap\npublic import Batteries.Lean.PersistentHashSet\npublic import Batteries.Lean.Position\npublic import Batteries.Lean.SatisfiesM\npublic import Batteries.Lean.Syntax\npublic import Batteries.Lean.System.IO\npublic import Batteries.Lean.TagAttribute\npublic import Batteries.Lean.Util.EnvSearch\npublic import Batteries.Linter\npublic import Batteries.Linter.UnnecessarySeqFocus\npublic import Batteries.Linter.UnreachableTactic\npublic import Batteries.Logic\npublic import Batteries.Tactic.Alias\npublic import Batteries.Tactic.Basic\npublic import Batteries.Tactic.Case\npublic import Batteries.Tactic.Congr\npublic import Batteries.Tactic.Exact\npublic import Batteries.Tactic.GeneralizeProofs\npublic import Batteries.Tactic.HelpCmd\npublic import Batteries.Tactic.Init\npublic import Batteries.Tactic.Instances\npublic import Batteries.Tactic.Lemma\npublic import Batteries.Tactic.Lint\npublic import Batteries.Tactic.Lint.Basic\npublic import Batteries.Tactic.Lint.Frontend\npublic import Batteries.Tactic.Lint.Misc\npublic import Batteries.Tactic.Lint.Simp\npublic import Batteries.Tactic.Lint.TypeClass\npublic import Batteries.Tactic.NoMatch\npublic import Batteries.Tactic.OpenPrivate\npublic import Batteries.Tactic.PermuteGoals\npublic import Batteries.Tactic.PrintDependents\npublic import Batteries.Tactic.PrintOpaques\npublic import Batteries.Tactic.PrintPrefix\npublic import Batteries.Tactic.SeqFocus\npublic import Batteries.Tactic.ShowUnused\npublic import Batteries.Tactic.SqueezeScope\npublic import Batteries.Tactic.Trans\npublic import Batteries.Tactic.Unreachable\npublic import Batteries.Util.Cache\npublic import Batteries.Util.ExtendedBinder\npublic import Batteries.Util.LibraryNote\npublic import Batteries.Util.Panic\npublic import Batteries.Util.Pickle\npublic import Batteries.Util.ProofWanted\n" }, { "path": "BatteriesTest/ArrayMap.lean", "content": "import Batteries.Data.List.ArrayMap\n\nopen List\n\n/-- info: #[3, 4, 5, 6] -/\n#guard_msgs in\n#eval List.toArrayMap [0, 1, 2, 3] (fun n => n + 3)\n\n/-- info: #[7, 9, 15, 25] -/\n#guard_msgs in\n#eval toArrayMap [0, 1, 2, 3] (fun n => 2 * n ^ 2 + 7)\n" }, { "path": "BatteriesTest/Char.lean", "content": "import Batteries.Data.Char\n\n/- Failing on nightly-2025-12-18\n#guard Char.caseFoldAsciiOnly 'A' == 'a'\n#guard Char.caseFoldAsciiOnly 'a' == 'a'\n#guard Char.caseFoldAsciiOnly 'À' == 'À'\n#guard Char.caseFoldAsciiOnly 'à' == 'à'\n#guard Char.caseFoldAsciiOnly '$' == '$'\n\n#guard Char.beqCaseInsensitiveAsciiOnly 'a' 'A' == true\n#guard Char.beqCaseInsensitiveAsciiOnly 'a' 'a' == true\n#guard Char.beqCaseInsensitiveAsciiOnly '$' '$' == true\n#guard Char.beqCaseInsensitiveAsciiOnly 'a' 'b' == false\n#guard Char.beqCaseInsensitiveAsciiOnly 'γ' 'Γ' == false\n#guard Char.beqCaseInsensitiveAsciiOnly 'ä' 'Ä' == false\n\n#guard Char.cmpCaseInsensitiveAsciiOnly 'a' 'A' == .eq\n#guard Char.cmpCaseInsensitiveAsciiOnly 'a' 'a' == .eq\n#guard Char.cmpCaseInsensitiveAsciiOnly '$' '$' == .eq\n#guard Char.cmpCaseInsensitiveAsciiOnly 'a' 'b' == .lt\n#guard Char.cmpCaseInsensitiveAsciiOnly 'γ' 'Γ' == .gt\n#guard Char.cmpCaseInsensitiveAsciiOnly 'ä' 'Ä' == .gt\n-/\n" }, { "path": "BatteriesTest/GeneralizeProofs.lean", "content": "import Batteries.Tactic.GeneralizeProofs\n\nprivate axiom test_sorry : ∀ {α}, α\nset_option autoImplicit true\nnoncomputable def List.nthLe (l : List α) (n) (_h : n < l.length) : α := test_sorry\n\n-- For debugging `generalize_proofs`\n-- set_option trace.Tactic.generalize_proofs true\n\nexample : List.nthLe [1, 2] 1 (by simp) = 2 := by\n generalize_proofs h\n guard_hyp h :ₛ 1 < List.length [1, 2]\n guard_target =ₛ [1, 2].nthLe 1 h = 2\n exact test_sorry\n\nexample (x : Nat) (h : x < 2) : Classical.choose (⟨x, h⟩ : ∃ x, x < 2) < 2 := by\n generalize_proofs a\n guard_hyp a :ₛ ∃ x, x < 2\n guard_target =ₛ Classical.choose a < 2\n exact Classical.choose_spec a\n\nexample (x : Nat) (h : x < 2) :\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2) = Classical.choose (⟨x, h⟩ : ∃ x, x < 2) := by\n generalize_proofs a\n guard_hyp a :ₛ ∃ x, x < 2\n guard_target =ₛ Classical.choose a = Classical.choose a\n rfl\n\nexample (x : Nat) (h : x < 2) (h' : x < 1) :\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2)\n = Classical.choose (⟨x, (by clear h; omega)⟩ : ∃ x, x < 2) := by\n generalize_proofs a\n guard_hyp a :ₛ ∃ x, x < 2\n guard_target =ₛ Classical.choose a = Classical.choose a\n rfl\n\nexample (x : Nat) (h h' : x < 2) :\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2) = Classical.choose (⟨x, h'⟩ : ∃ x, x < 2) := by\n change _ at h'\n fail_if_success guard_target =ₛ\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2) = Classical.choose (⟨x, h⟩ : ∃ x, x < 2)\n generalize_proofs at h'\n fail_if_success change _ at h'\n guard_target =ₛ Classical.choose (⟨x, h⟩ : ∃ x, x < 2) = Classical.choose (⟨x, h⟩ : ∃ x, x < 2)\n generalize_proofs a\n guard_target =ₛ Classical.choose a = Classical.choose a\n rfl\n\nexample (x : Nat) (h : x < 2) :\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2)\n = Classical.choose (⟨x, Nat.lt_succ_of_lt h⟩ : ∃ x, x < 3) := by\n generalize_proofs a a'\n guard_hyp a :ₛ ∃ x, x < 2\n guard_hyp a' :ₛ ∃ x, x < 3\n guard_target =ₛ Classical.choose a = Classical.choose a'\n exact test_sorry\n\nexample (x : Nat) (h : x < 2) : Classical.choose (⟨x, h⟩ : ∃ x, x < 2) =\n Classical.choose (⟨x, Nat.lt_succ_of_lt h⟩ : ∃ x, x < 3) := by\n generalize_proofs\n guard_target = Classical.choose _ = Classical.choose _\n exact test_sorry\n\nexample (x : Nat) (h : x < 2) : Classical.choose (⟨x, h⟩ : ∃ x, x < 2) =\n Classical.choose (⟨x, Nat.lt_succ_of_lt h⟩ : ∃ x, x < 3) := by\n generalize_proofs _ a\n guard_hyp a : ∃ x, x < 3\n guard_target = Classical.choose _ = Classical.choose a\n exact test_sorry\n\nexample (a : ∃ x, x < 2) : Classical.choose a < 2 := by\n generalize_proofs\n guard_target =ₛ Classical.choose a < 2\n exact Classical.choose_spec a\n\nexample (a : ∃ x, x < 2) : Classical.choose a < 2 := by\n generalize_proofs t\n guard_target =ₛ Classical.choose a < 2\n exact Classical.choose_spec a\n\nexample (x : Nat) (h : x < 2) (H : Classical.choose (⟨x, h⟩ : ∃ x, x < 2) < 2) :\n Classical.choose (⟨x, h⟩ : ∃ x, x < 2) < 2 := by\n generalize_proofs a at H ⊢\n guard_hyp a :ₛ ∃ x, x < 2\n guard_hyp H :ₛ Classical.choose a < 2\n guard_target =ₛ Classical.choose a < 2\n exact H\n\nexample (H : ∀ y, ∃ (x : Nat) (h : x < y), Classical.choose (⟨x, h⟩ : ∃ x, x < y) < y) :\n ∀ y, ∃ (x : Nat) (h : x < y), Classical.choose (⟨x, h⟩ : ∃ x, x < y) < y := by\n generalize_proofs -abstract\n guard_target =ₛ ∀ y, ∃ (x : Nat) (h : x < y), Classical.choose (⟨x, h⟩ : ∃ x, x < y) < y\n generalize_proofs a at H ⊢\n guard_hyp a :ₛ ∀ (y w : Nat), w < y → ∃ x, x < y\n guard_hyp H :ₛ ∀ (y : Nat), ∃ x h, Classical.choose (a y x h) < y\n guard_target =ₛ ∀ (y : Nat), ∃ x h, Classical.choose (a y x h) < y\n exact H\n\nexample (H : ∀ y, ∃ (x : Nat) (h : x < y), Classical.choose (⟨x, h⟩ : ∃ x, x < y) < y) :\n ∀ y, ∃ (x : Nat) (h : x < y), Classical.choose (⟨x, h⟩ : ∃ x, x < y) < y := by\n generalize_proofs a at *\n guard_hyp a :ₛ ∀ (y w : Nat), w < y → ∃ x, x < y\n guard_hyp H :ₛ ∀ (y : Nat), ∃ x h, Classical.choose (a y x h) < y\n guard_target =ₛ ∀ (y : Nat), ∃ x h, Classical.choose (a y x h) < y\n exact H\n\nnamespace zulip1\n/-!\nhttps://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.60generalize_proofs.60.20sometimes.20silently.20has.20no.20effect/near/407162574\n-/\n\ntheorem t (x : Option Unit) : x.isSome = true := test_sorry\ndef p : Unit → Prop := test_sorry\n\ntheorem good (x : Option Unit) : p (Option.get x test_sorry) → x.isSome = true := by\n generalize_proofs h\n exact fun _ => h\n\ntheorem was_bad (x : Option Unit) : p (Option.get x (t x)) → x.isSome = true := by\n generalize_proofs h\n exact fun _ => h\n\nend zulip1\n\nsection\n\nattribute [local instance] Classical.propDecidable\n\nexample (H : ∀ x, x = 1) : (if h : ∃ (k : Nat), k = 1 then Classical.choose h else 0) = 1 := by\n rw [dif_pos ?hc]\n case hc => exact ⟨1, rfl⟩\n generalize_proofs h\n guard_hyp h :ₛ ∃ x, x = 1\n guard_target =ₛ Classical.choose h = 1\n apply H\n\nend\n\nsection\n\n-- make sure it handles `let` declarations well\n\n-- this was https://github.com/leanprover-community/mathlib4/issues/24222\nexample : True := by\n let n : Fin 1 := ⟨0, id Nat.zero_lt_one⟩\n generalize_proofs h at *\n guard_hyp h :ₛ 0 < 1\n guard_hyp n :=ₛ ⟨0, h⟩\n trivial\n\nexample : True := by\n have h := Nat.zero_lt_one\n let n : Fin 1 := ⟨0, id Nat.zero_lt_one⟩\n generalize_proofs at *\n guard_hyp h :ₛ 0 < 1\n guard_hyp n :=ₛ ⟨0, h⟩\n trivial\n\nexample : True := by\n let p := id Nat.zero_lt_one\n generalize_proofs at *\n guard_hyp p :ₛ 0 < 1\n trivial\n\nexample : True := by\n let p := Nat.zero_lt_one\n generalize_proofs at *\n guard_hyp p :ₛ 0 < 1\n let q := id Nat.zero_lt_one\n generalize_proofs at *\n fail_if_success change _ at q\n guard_hyp p :ₛ 0 < 1\n trivial\n\nexample (P : Sort _) (p : P) : True := by\n let p' : P := p\n generalize_proofs at *\n guard_hyp p :ₛ P\n guard_hyp p' :=ₛ p\n trivial\n\nexample (P : True → Sort _) (p : True → P (by decide)) : True := by\n let p' := p (by decide)\n generalize_proofs h at *\n guard_hyp h :ₛ True\n guard_hyp p :ₛ True → P h\n guard_hyp p' :=ₛ p h\n exact h\n\nend\n\n/-!\nExtracting proofs from under let bindings\n-/\n/--\ntrace: pf✝ : ∀ (n : Nat), 0 < n + 1\n⊢ have n := 0;\n ↑⟨0, ⋯⟩ = 0\n-/\n#guard_msgs in\nexample : have n := 0; (⟨0, id (by simp)⟩ : Fin (n + 1)).val = 0 := by\n generalize_proofs\n trace_state\n rfl\n/--\ntrace: pf✝ : ∀ (n : Nat), 0 < n + 1\n⊢ have n := 0;\n ↑⟨0, ⋯⟩ = 0\n-/\n#guard_msgs in\nexample : have n := 0; (⟨0, id (by simp)⟩ : Fin (n + 1)).val = 0 := by\n generalize_proofs\n trace_state\n rfl\n" }, { "path": "BatteriesTest/Internal/DummyLabelAttr.lean", "content": "/-\nCopyright (c) 2023 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nimport Lean.LabelAttribute\n\n/-- A dummy label attribute, which can be used for testing. -/\n-- This can't live in `Batteries.Tactic.LabelAttr`\n-- (because we can't use the extension in the same file it is initialized)\n-- and it can't live in `test/`, because files there can not import other files in `test/`.\nregister_label_attr dummy_label_attr\n" }, { "path": "BatteriesTest/Internal/DummyLibraryNote.lean", "content": "import Batteries.Util.LibraryNote\n\nlibrary_note «test1» /--\n1: This is a testnote for testing the library note feature of batteries.\nThe `#help note` command should be able to find this note when imported.\n-/\n\nlibrary_note «test2» /--\n2: This is a second testnote for testing the library note feature of batteries.\n-/\n\nlibrary_note «temporary note» /--\n1: This is a testnote whose label also starts with \"te\", but gets sorted before \"test\"\n-/\n" }, { "path": "BatteriesTest/Internal/DummyLibraryNote2.lean", "content": "import BatteriesTest.Internal.DummyLibraryNote\n\nlibrary_note «test3» /--\n3: this is a note in a different file importing the above testnotes,\nbut still imported by the actual testfile.\n-/\n\nlibrary_note «Test» /--\n1: this is a testnote with a label starting with \"Te\"\n-/\n\nlibrary_note «Other» /--\n1: this is a testnote with a label not starting with \"te\",\nso it shouldn't appear when looking for notes with label starting with \"te\".\n-/\n" }, { "path": "BatteriesTest/MLList.lean", "content": "import Lean.Meta.Basic\nimport Batteries.Data.MLList.IO\nimport Batteries.Data.List.Basic\n\nset_option linter.missingDocs false\n\n/-! ### Test fix to performance problem in `asArray`. -/\n\ndef g (n : Nat) : MLList Lean.Meta.MetaM Nat := do\n for _ in [:n] do\n if true then\n continue\n return n\n\n/-- info: #[3000] -/\n-- This used to fail before add the `uncons?` field to the implementation of `MLList`.\n#guard_msgs in\n#eval MLList.asArray $ (g 3000)\n\n/-!\n### Test `MLList.ofTaskList`.\n\nWe generate three tasks which sleep for `100`, `50`, and `1` milliseconds respectively,\nand then verify that `MLList.ofTaskList` return their results in the order they complete.\n-/\n\n/- This test is very flaky, so it's disabled for now.\n\ndef sleep (n : UInt32) : BaseIO (Task UInt32) :=\n IO.asTask (do IO.sleep n; return n) |>.map fun t => t.map fun\n | .ok n => n\n | .error _ => 0\n\ndef sleeps : MLList BaseIO UInt32 := .squash fun _ => do\n let r ← [100,50,1].map sleep |>.traverse id\n return .ofTaskList r\n\n/-- info: [1, 50, 100] -/\n#guard_msgs in\n#eval sleeps.force\n-/\n" }, { "path": "BatteriesTest/OpenPrivateDefs.lean", "content": "/-!\nThis file contains a private declaration. It's tested in `openPrivate.lean`.\n-/\nprivate def secretNumber : Nat := 2\n" }, { "path": "BatteriesTest/String.lean", "content": "/- Failing on nightly-2025-12-18\nimport Batteries.Data.String.AsciiCasing\n\n#guard \"ABC\".caseFoldAsciiOnly == \"abc\"\n#guard \"x\".caseFoldAsciiOnly != \"y\"\n#guard \"Àà\".caseFoldAsciiOnly == \"Àà\"\n#guard \"1$#!\".caseFoldAsciiOnly == \"1$#!\"\n\n#guard \"abc\".beqCaseInsensitiveAsciiOnly \"ABC\" == true\n#guard \"cba\".beqCaseInsensitiveAsciiOnly \"ABC\" == false\n#guard \"a\".beqCaseInsensitiveAsciiOnly \"a\" == true\n#guard \"$\".beqCaseInsensitiveAsciiOnly \"$\" == true\n#guard \"a\".beqCaseInsensitiveAsciiOnly \"b\" == false\n#guard \"γ\".beqCaseInsensitiveAsciiOnly \"Γ\" == false\n#guard \"ä\".beqCaseInsensitiveAsciiOnly \"Ä\" == false\n\n#guard \"abc\".cmpCaseInsensitiveAsciiOnly \"ABC\" == .eq\n#guard \"abc\".cmpCaseInsensitiveAsciiOnly \"xyz\" == .lt\n#guard \"a\".cmpCaseInsensitiveAsciiOnly \"a\" == .eq\n#guard \"$\".cmpCaseInsensitiveAsciiOnly \"$\" == .eq\n#guard \"a__\".cmpCaseInsensitiveAsciiOnly \"b__\" == .lt\n#guard \"γ\".cmpCaseInsensitiveAsciiOnly \"Γ\" == .gt\n#guard \"ä\".cmpCaseInsensitiveAsciiOnly \"Ä\" == .gt\n\n#guard [\n (\"\", \"\"),\n (\" \", \" \"),\n (\"a\", \"A\"),\n (\"abc\", \"ABC\"),\n (\"aBc\", \"AbC\"),\n (\"123\", \"123\"),\n (\"国际化与本地化\", \"国际化与本地化\"),\n (\"ABC😂🔰🍑xyz\", \"abc😂🔰🍑XYZ\")\n].all (fun (a, b) => a.beqCaseInsensitiveAsciiOnly b && a.cmpCaseInsensitiveAsciiOnly b = .eq)\n\n#guard [\n (\"国际化\", \"国际化与本地化\"),\n (\"\", \" \"),\n (\"a\", \"b\"),\n (\"ab\", \"ba\"),\n (\"123\", \"124\"),\n (\"😂\", \"🍑\"),\n (\"🔰🍑\", \"😂🔰🍑aaa\")\n] |>.all fun (a, b) =>\n a ≠ b && !(a.beqCaseInsensitiveAsciiOnly b) && a.cmpCaseInsensitiveAsciiOnly b != .eq\n-/\n" }, { "path": "BatteriesTest/absurd.lean", "content": "import Batteries.Tactic.Basic\n\n/-! Tests for `absurd` tactic -/\n\n-- Basic example\n/--\nerror: unsolved goals\np : Prop\nh : p\n⊢ ¬p\n-/\n#guard_msgs in\nexample {p : Prop} (h : p) : 0 = 0 := by\n absurd h\n\n-- Negative example\n/--\nerror: unsolved goals\np : Prop\nh : ¬p\n⊢ p\n-/\n#guard_msgs in\nexample {p : Prop} (h : ¬p) : 0 = 1 := by\n absurd h\n\n-- Inequality example\n/--\nerror: unsolved goals\nn : Nat\nh : n ≠ 0\n⊢ n = 0\n-/\n#guard_msgs in\nexample (h : n ≠ 0) : 0 = 2 := by\n absurd h\n\n-- Example with implies false\n/--\nerror: unsolved goals\np : Prop\nh : p → False\n⊢ p\n-/\n#guard_msgs in\nexample {p : Prop} (h : p → False) : 0 = 3 := by\n absurd h\n\n/--\nerror: unsolved goals\np : Prop\nh : p\n⊢ ¬p\n-/\n#guard_msgs in\nexample {p : Prop} {h : p} : ∀ {x : True}, 0 = 0 := by\n absurd h\n\n-- `·` should not be legal\n/--\nerror: invalid occurrence of `·` notation, it must be surrounded by parentheses (e.g. `(· + 1)`)\n---\nerror: unsolved goals\np : Prop\nh : p\n⊢ ∀ {x : True}, 0 = 0\n-/\n#guard_msgs in\nexample {p : Prop} {h : p} : ∀ {_ : True}, 0 = 0 := by\n absurd ·\n" }, { "path": "BatteriesTest/alias.lean", "content": "import Batteries.Tactic.Alias\n\nset_option linter.unusedVariables false\nset_option linter.missingDocs false\n\nopen Lean Meta\nnamespace A\n\n/-- doc string for foo -/\ntheorem foo : 1 + 1 = 2 := rfl\n\n/-- doc string for `alias foo` -/\nalias foo1 := foo\n@[deprecated (since := \"2038-01-20\")] alias foo2 := foo\n@[deprecated foo2 (since := \"2038-01-20\")] alias _root_.B.foo3 := foo\n@[deprecated foo2 \"it was never a good idea anyway\" (since := \"last thursday\")] alias foo4 := foo\n\nexample : 1 + 1 = 2 := foo1\n/-- warning: `A.foo2` has been deprecated: Use `A.foo` instead -/\n#guard_msgs in example : 1 + 1 = 2 := foo2\n/--\nwarning: `B.foo3` has been deprecated: Use `A.foo2` instead\n\nNote: The updated constant is in a different namespace. Dot notation may need to be changed (e.g., from `x.foo3` to `foo2 x`).\n-/\n#guard_msgs in example : 1 + 1 = 2 := B.foo3\n/-- warning: `A.foo4` has been deprecated: it was never a good idea anyway -/\n#guard_msgs in example : 1 + 1 = 2 := foo4\n\n/-- doc string for bar -/\ndef bar : Nat := 5\nalias bar1 := bar\nalias _root_.B.bar2 := bar\nexample : bar1 = 5 := rfl\nexample : B.bar2 = 5 := rfl\n\ntheorem baz (x : Nat) : x = x := rfl\nalias baz1 := baz\nexample : 3 = 3 := baz1 3\n\n/-- doc string for foobar -/\ndef foobar : Nat → Nat := id\n@[inherit_doc foobar] alias foobar1 := foobar\n@[simp] alias foobar2 := foobar\n/-- doc string for foobar2 -/\ndef foobar3 (n : Nat) := foobar1 n\n\n/-- error: `simp` made no progress -/\n#guard_msgs in\nexample : foobar1 x = foobar x := by simp\nexample : foobar2 x = foobar x := by simp\n\n/- Test protected -/\n\n/-- doc string for Foo.barbaz -/\nprotected alias Foo.barbaz := trivial\n/-- error: Unknown identifier `barbaz` -/\n#guard_msgs in example : True := barbaz\nexample : True := Foo.barbaz\n\n/- Test noncomputable -/\n\n/-- doc string for foobaz -/\nnoncomputable def foobaz : Nat → Nat := id\nalias foobaz1 := foobaz\n\n/-- error: Failed to find LCNF signature for A.foobaz1 -/\n#guard_msgs in def foobaz2 (n : Nat) := foobaz1 n\n\nnoncomputable alias foobaz3 := id\n/-- error: Failed to find LCNF signature for A.foobaz3 -/\n#guard_msgs in def foobaz4 (n : Nat) := foobaz3 n\n\n/- Test unsafe -/\n\n/-- doc string for barbaz -/\nunsafe def barbaz : Nat → Nat := id\nalias barbaz1 := barbaz\n/-- error: (kernel) invalid declaration, it uses unsafe declaration 'A.barbaz1' -/\n#guard_msgs in def barbaz2 (n : Nat) := barbaz1 n\n\nunsafe alias barbaz3 := id\n/-- error: (kernel) invalid declaration, it uses unsafe declaration 'A.barbaz3' -/\n#guard_msgs in def barbaz4 (n : Nat) := barbaz3 n\n\n/- iff version -/\n\n@[deprecated (since := \"2038-01-20\")] alias ⟨mpId, mprId⟩ := Iff.rfl\n\n/-- info: A.mpId {a : Prop} : a → a -/\n#guard_msgs in #check mpId\n/-- info: A.mprId {a : Prop} : a → a -/\n#guard_msgs in #check mprId\n\n/--\nwarning: `A.mpId` has been deprecated: Use `Iff.rfl` instead\n\nNote: The updated constant has a different type:\n ∀ {a : Prop}, a ↔ a\ninstead of\n ∀ {a : Prop}, a → a\n\nNote: The updated constant is in a different namespace. Dot notation may need to be changed (e.g., from `x.mpId` to `Iff.rfl x`).\n---\nwarning: `A.mprId` has been deprecated: Use `Iff.rfl` instead\n\nNote: The updated constant has a different type:\n ∀ {a : Prop}, a ↔ a\ninstead of\n ∀ {a : Prop}, a → a\n\nNote: The updated constant is in a different namespace. Dot notation may need to be changed (e.g., from `x.mprId` to `Iff.rfl x`).\n-/\n#guard_msgs in example := And.intro @mpId @mprId\n\n/- Test environment extension -/\n\n/-- info: **Alias** of `A.foo`. -/\n#guard_msgs in\n#eval show MetaM _ from do\n match ← Batteries.Tactic.Alias.getAliasInfo `A.foo1 with\n | some i => IO.println i.toString\n | none => IO.println \"alias not found\"\n" }, { "path": "BatteriesTest/array.lean", "content": "import Batteries.Data.Array\n\nsection\nvariable {α : Type _}\nvariable [Inhabited α]\nvariable (a : Array α)\nvariable (i j : Nat)\nvariable (v d : α)\nvariable (g : i < (a.set! i v).size)\nvariable (j_lt : j < (a.set! i v).size)\n\n#check_simp (a.set! i v)[i] ~> v\n#check_simp (a.set! i v)[i]! ~> (a.setIfInBounds i v)[i]!\n#check_simp (a.set! i v).getD i d ~> if i < a.size then v else d\n#check_simp (a.set! i v)[i] ~> v\n\n-- Checks with different index values.\n#check_simp (a.set! i v)[j]'j_lt ~> (a.setIfInBounds i v)[j]'_\n#check_simp (a.setIfInBounds i v)[j]'j_lt !~>\n\n-- This doesn't work currently.\n-- It will be address in the comprehensive overhaul of array lemmas.\n-- #check_simp (a.set! i v)[i]? ~> .some v\n\nend\n" }, { "path": "BatteriesTest/array_scan.lean", "content": "import Batteries.Data.Array.Basic\n\nopen Array\n\n/- Docstring examples for `Array.scan{l,r,lM,rM}` -/\n\nexample [Monad m] (f : α → β → m α) :\n Array.scanlM f x₀ #[a, b, c] = (do\n let x₁ ← f x₀ a\n let x₂ ← f x₁ b\n let x₃ ← f x₂ c\n pure #[x₀, x₁, x₂, x₃]) := by\n simp [scanlM, scanlM.loop]\n\nexample [Monad m] (f : α → β → m α) :\n Array.scanlM f x₀ #[a, b, c] (start := 1) (stop := 3) = (do\n let x₁ ← f x₀ b\n let x₂ ← f x₁ c\n pure #[x₀, x₁, x₂]) := by\n simp [scanlM, scanlM.loop]\n\nexample [Monad m] (f : α → β → m β) :\n Array.scanrM f x₀ #[a, b, c] = (do\n let x₁ ← f c x₀\n let x₂ ← f b x₁\n let x₃ ← f a x₂\n pure #[x₃, x₂, x₁, x₀]) := by\n simp [scanrM, scanrM.loop]\n\nexample [Monad m] (f : α → β → m β) :\n Array.scanrM f x₀ #[a, b, c] (start := 3) (stop := 1) = (do\n let x₁ ← f c x₀\n let x₂ ← f b x₁\n pure #[x₂, x₁, x₀]) := by\n simp [scanrM, scanrM.loop]\n\n#guard scanl (· + ·) 0 #[1, 2, 3] == #[0, 1, 3, 6]\n\n#guard scanr (· + ·) 0 #[1, 2, 3] == #[6, 5, 3, 0]\n" }, { "path": "BatteriesTest/by_contra.lean", "content": "import Batteries.Tactic.Basic\n\nprivate def nonDecid (P : Prop) (x : P) : P := by\n by_contra h\n guard_hyp h : ¬P\n guard_target = False\n exact h x\n\nprivate def decid (P : Prop) [Decidable P] (x : P) : P := by\n by_contra h\n guard_hyp h : ¬P\n guard_target = False\n exact h x\n\nexample (P : Prop) [Decidable P] : nonDecid P = decid P := by\n delta nonDecid decid\n guard_target =ₛ\n (fun x : P => Classical.byContradiction fun h => h x) =\n (fun x : P => Decidable.byContradiction fun h => h x)\n rfl\n\nexample (P : Prop) : P → P := by\n by_contra\n guard_hyp this : ¬(P → P)\n exact ‹¬(P → P)› id\n\nexample (P : Prop) : {_ : P} → P := by\n by_contra\n guard_hyp this : ¬(P → P)\n exact ‹¬(P → P)› id\n\n/-!\nhttps://github.com/leanprover-community/batteries/issues/1196:\n\nPreviously the second error had a `Decidable True` subgoal, which only appeared in the presence of\nthe first unclosed goal.\n-/\n/--\nerror: unsolved goals\ncase left\n⊢ True\n---\nerror: unsolved goals\ncase right\nthis : ¬True\n⊢ False\n-/\n#guard_msgs in\nexample : True ∧ True := by\n constructor\n · skip\n · by_contra\n\nexample (n : Nat) (h : n ≠ 0) : n ≠ 0 := by\n by_contra rfl\n simp only [Ne, not_true_eq_false] at h\n\nexample (p q : Prop) (hnp : ¬ p) : ¬ (p ∧ q) := by\n by_contra ⟨hp, _⟩\n exact hnp hp\n\nexample (p q : Prop) (hnp : ¬ p) (hnq : ¬ q) : ¬ (p ∨ q) := by\n by_contra hp | hq\n · exact hnp hp\n · exact hnq hq\n\n/--\nerror: unsolved goals\nn : Nat\nthis : n ≠ 0\n⊢ False\n-/\n#guard_msgs in\nexample (n : Nat) : n = 0 := by\n by_contra : n ≠ 0\n\n/--\nerror: unsolved goals\nn : Nat\nh_ne : n ≠ 0\n⊢ False\n-/\n#guard_msgs in\nexample (n : Nat) : n = 0 := by\n by_contra h_ne : n ≠ 0\n" }, { "path": "BatteriesTest/case.lean", "content": "import Batteries.Tactic.Case\n\nset_option linter.missingDocs false\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n fail_if_success show z = z\n case _ : z = _\n · exact h'\n exact h\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n case _ : z = _ =>\n exact h'\n case left =>\n exact h\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n case _ : z = _ | left => assumption\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n case _ : _ | _ : _ => assumption\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n case left | _ : z = _ => assumption\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z = w := by\n constructor\n case _ : z = _ => ?foo\n case foo := h'\n case left := h\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z + 0 = w := by\n constructor\n case right : z = _ =>\n guard_target =ₛ z = w\n exact h'\n case _ : x = y := h\n\nexample (h : x = y) : x = y ∧ x = y := by\n constructor\n case _ : x = y | _ : x = y => ?foo\n -- Closes both\n case foo => exact h\n\nexample (h : x = y) : x = y ∧ x = y ∧ x = y := by\n refine ⟨?foo, ?_, ?_⟩\n · exact h\n case _ : x = y | _ : x = y => ?foo\n -- This metavariable was already assigned, so no more goals.\n\n/--\nerror: 'case' tactic failed, value\n ?left\ndepends on the main goal metavariable '?left'\n-/\n#guard_msgs in\nexample : False ∧ True := by\n constructor\n case _ : False => ?left\n\n/--\nerror: Type mismatch\n ?right\nhas type\n True\nbut is expected to have type\n False\n-/\n#guard_msgs in\nexample : False ∧ True := by\n constructor\n case _ : False => ?right\n\n/--\nerror: 'case' tactic failed, value\n ?right\ndepends on the main goal metavariable '?right'\n-/\n#guard_msgs in\nexample : False ∧ False := by\n constructor\n case left => ?right\n case right => ?left\n\nexample (h : x = y) (h' : z = w) : x = y ∧ z + 0 = w := by\n constructor\n case _ : z = _ =>\n guard_target =ₛ z = w\n exact h'\n case left =>\n exact h\n\nexample (x y z : α) (h : x = y) (h' : y = z) : x = z := by\n apply Eq.trans\n case _ : id α := y\n -- Note: `case` inserts a `let_fun` since `id α` and `α` aren't defeq with reducible transparency\n · guard_target =ₛ x = show id α from y\n exact h\n · guard_target = y = z\n exact h'\n\nexample (x y z : α) (h : x = y) (h' : y = z) : x = z := by\n apply Eq.trans\n case _ : α := y\n -- Note: `case` detects defeq with reducible transparency, so doesn't insert type hint\n · guard_target =ₛ x = y\n exact h\n · guard_target = y = z\n exact h'\n\ndef Injective (f : α → β) : Prop := ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂\n\ntheorem cancel_injective (h : Injective f) : f x = f y ↔ x = y := by\n refine ⟨fun e => h e, ?_⟩\n intro h\n cases h\n rfl\n\nexample (h : Injective f) (h' : f x = f y) : x = y := by\n rw [cancel_injective] at h'\n case _ : Injective f := h\n exact h'\n\nexample (h : Injective f) (h' : f x = f y) : x = y := by\n rw [cancel_injective] at h'\n case _ : Injective f\n · exact h\n exact h'\n\nexample (hf : Injective f) (hg : Injective g) (h : g (f x) = g (f y)) : x = y := by\n rw [cancel_injective, cancel_injective] at h\n case _ : Injective f | _ : Injective g => assumption\n exact h\n\nexample (hf : Injective f) (hg : Injective g) (h : g (f x) = g (f y)) : x = y := by\n rw [cancel_injective, cancel_injective] at h\n repeat case _ : Injective _ => assumption\n exact h\n\nexample (hf : Injective f) (hg : Injective g) (h : g (f x) = g (f y)) : x = y := by\n rw [cancel_injective, cancel_injective] at h\n case _ : Injective f | _ : Injective g\n · guard_target = Injective f\n assumption\n · guard_target = Injective g\n assumption\n exact h\n\nexample (hf : Injective f) (hg : Injective g) (h : g (f x) = g (f y)) : x = y := by\n rw [cancel_injective, cancel_injective] at h\n case _ : Injective f | _ : Injective g => _\n · guard_target = Injective f\n assumption\n · guard_target = Injective g\n assumption\n exact h\n\nexample (a : Nat) : 0 + a = a := by\n induction a\n case _ n ih : 0 + (n + 1) = n + 1 =>\n guard_target =ₛ 0 + (n + 1) = n + 1\n rw [← Nat.add_assoc, ih]\n case _ : 0 + 0 = 0 := rfl\n\nexample (a : Nat) : 0 + a = a := by\n induction a\n case _ n ih : 0 + (n + 1) = n + 1 | _ : 0 + 0 = 0\n · rw [← Nat.add_assoc, ih]\n · rfl\n\nexample : True ∧ ∀ x : Nat, x = x := by\n constructor\n case' _ : ∀ _, _ =>\n intro z\n case left => trivial\n guard_target =ₛ z = z\n rfl\n\n-- Test focusing by full match, suffix match, and prefix match\n#guard_msgs in\nexample : True := by\n have x : Bool := ?a\n have y : Nat := ?a.b.c\n have z : String := ?c.b.a\n case a : Bool := true\n case a : Nat := 0\n case a : String := \"\"\n trivial\n\n-- Test priorities when focusing by full match, suffix match, and prefix match\nexample : True := by\n let x : Nat := ?a\n let y : Nat := ?c.b.a\n let z : Nat := ?c'.b.a\n let w : Nat := ?a.b.c\n case a : Nat := 0\n case a : Nat := 1\n case a : Nat := 2\n case a : Nat := 3\n guard_hyp x : Nat := 0\n guard_hyp y : Nat := 2\n guard_hyp z : Nat := 1\n guard_hyp w : Nat := 3\n trivial\n\n-- Test renaming when not pattern matching\nexample (n : Nat) : 0 ≤ n := by\n induction n\n case _ : 0 ≤ 0 | succ n ih\n · guard_target =ₛ 0 ≤ 0\n constructor\n · guard_target =ₛ 0 ≤ n + 1\n guard_hyp ih : 0 ≤ n\n simp\n" }, { "path": "BatteriesTest/congr.lean", "content": "import Batteries.Tactic.Congr\n\nsection congr\n\nexample (c : Prop → Prop → Prop → Prop) (x x' y z z' : Prop)\n (h₀ : x ↔ x') (h₁ : z ↔ z') : c x y z ↔ c x' y z' := by\n apply Iff.of_eq -- FIXME: not needed in lean 3\n congr\n · guard_target =ₐ x = x'\n apply_ext_theorem\n assumption\n · guard_target =ₐ z = z'\n ext\n assumption\n\nexample {α β γ δ} {F : ∀ {α β}, (α → β) → γ → δ} {f g : α → β} {s : γ}\n (h : ∀ x : α, f x = g x) : F f s = F g s := by\n congr with x\n -- apply_assumption -- FIXME\n apply h\n\nexample {α β : Type _} {f : _ → β} {x y : { x : { x : α // x = x } // x = x }}\n (h : x.1 = y.1) : f x = f y := by\n congr with : 1\n exact h\n\nexample {α β : Type _} {F : _ → β} {f g : { f : α → β // f = f }}\n (h : ∀ x : α, (f : α → β) x = (g : α → β) x) : F f = F g := by\n rcongr x\n revert x\n guard_target = type_of% h\n exact h\n\nsection\n\n-- Adaptation note: the next two examples have always failed if `List.ext` was in scope,\n-- but until nightly-2024-04-24 (when `List.ext` was upstreamed), it wasn't in scope.\n-- In order to preserve the test behaviour we locally remove the `ext` attribute.\nattribute [-ext] List.ext_getElem?\n\nexample {ls : List Nat} :\n (ls.map fun _ => (ls.map fun y => 1 + y).sum + 1) =\n (ls.map fun _ => (ls.map fun y => Nat.succ y).sum + 1) := by\n rcongr (_x y)\n guard_target =ₐ 1 + y = y.succ\n rw [Nat.add_comm]\n\nexample {ls : List Nat} {f g : Nat → Nat} {h : ∀ x, f x = g x} :\n (ls.map fun x => f x + 3) = ls.map fun x => g x + 3 := by\n rcongr x\n exact h x\n\nend\n\n-- succeed when either `ext` or `congr` can close the goal\nexample : () = () := by rcongr\n\nexample : 0 = 0 := by rcongr\n\nexample {α} (a : α) : a = a := by congr\n\nexample : { f : Nat → Nat // f = id } :=\n ⟨_, by\n congr (config := { closePre := false, closePost := false }) with x\n exact Nat.zero_add x⟩\n\n-- FIXME(?): congr doesn't fail\n-- example {α} (a b : α) (h : False) : a = b := by\n-- fail_if_success congr\n-- cases h\n\nend congr\n" }, { "path": "BatteriesTest/conv_equals.lean", "content": "/-\nCopyright (c) 2023 Joachim Breitner. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Joachim Breitner\n-/\n\nimport Batteries.Tactic.Basic\n\n-- The example from the doc string, for quick comparision\n-- and keeping the doc up-to-date\n-- (only `guard_target` added)\n\n/-- warning: declaration uses `sorry` -/\n#guard_msgs in\nexample (P : (Nat → Nat) → Prop) : P (fun n => n - n) := by\n conv in (_ - _) => equals 0 =>\n -- current goal: ⊢ n - n = 0\n guard_target =ₛ n - n = 0\n apply Nat.sub_self\n guard_target =ₛ P (fun n => 0)\n -- current goal: P (fun n => 0)\n sorry\n\n-- This tests that the goal created by equals must be closed\n\n-- Using #guard_msgs below triggers this linter\nset_option linter.unreachableTactic false\n\n/--\nerror: unsolved goals\nP : (Nat → Nat) → Prop\nn : Nat\n⊢ n - n = 0\n---\nerror: No goals to be solved\n-/\n#guard_msgs in\nexample (P : (Nat → Nat) → Prop) : P (fun n => n - n) := by\n conv in (_ - _) =>\n equals 0 => skip -- this should complain\n -- and at this point, there should be no goal left\n tactic => sorry\n sorry\n\n/-- warning: declaration uses `sorry` -/\n#guard_msgs in\nexample (P : Nat → Prop) : P 12 := by\n conv =>\n enter [1]\n equals (12 : Fin 37) =>\n guard_target =ₛ (12 : Nat) = (12 : Fin 37)\n rfl\n guard_target =ₛ P (12 : Fin 37)\n sorry\n\n/--\nerror: Type mismatch\n 12\nhas type\n Nat\nbut is expected to have type\n Fin 37\n---\nerror: unsolved goals\nP : Fin 37 → Prop\n⊢ 12 = sorry\n-/\n#guard_msgs in\nexample (P : Fin 37 → Prop) : P 12 := by\n conv =>\n enter [1]\n equals (12 : Nat) => skip\n sorry\n" }, { "path": "BatteriesTest/except.lean", "content": "-- Test: core does not currently provide DecidableEq for Except.\n-- If this test fails, it means core now provides DecidableEq for Except\n-- and the Batteries instance in Batteries.Lean.Except should be removed.\n\n/--\nerror: failed to synthesize instance of type class\n DecidableEq (Except ?m.1 ?m.2)\n\nHint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command.\n-/\n#guard_msgs in\n#check (inferInstance : DecidableEq (Except _ _))\n" }, { "path": "BatteriesTest/exfalso.lean", "content": "import Batteries.Tactic.Basic\n\nprivate axiom test_sorry : ∀ {α}, α\n\nexample {A} (h : False) : A := by\n exfalso\n exact h\n\nexample {A} : False → A := by\n exfalso\n show False -- exfalso is not supposed to close the goal yet\n exact test_sorry\n" }, { "path": "BatteriesTest/float.lean", "content": "import Batteries.Lean.Float\n\n#guard 0.0.toRatParts == some (0, -53)\n#guard (2^(-1000):Float).toRatParts == some (4503599627370496, -1052)\n#guard (2^(-30):Float).toRatParts == some (4503599627370496, -82)\n#guard 0.1.toRatParts == some (7205759403792794, -56)\n#guard 0.5.toRatParts == some (4503599627370496, -53)\n#guard 5.0.toRatParts == some (5629499534213120, -50)\n#guard (-5.0).toRatParts == some (-5629499534213120, -50)\n#guard 5.5.toRatParts == some (6192449487634432, -50)\n#guard 500000000000000.5.toRatParts == some (8000000000000008, -4)\n#guard 5000000000000000.5.toRatParts == some (5000000000000000, 0)\n#guard 1e1000.toRatParts == none\n#guard (-1e1000).toRatParts == none\n#guard (-0/0:Float).toRatParts == none\n\n#guard 0.0.toRatParts' == some (0, 0)\n#guard (2^(-1000):Float).toRatParts' == some (1, -1000)\n#guard (2^(-30):Float).toRatParts' == some (1, -30)\n#guard 0.1.toRatParts' == some (3602879701896397, -55)\n#guard 0.5.toRatParts' == some (1, -1)\n#guard 5.0.toRatParts' == some (5, 0)\n#guard (-5.0).toRatParts' == some (-5, 0)\n#guard 5.5.toRatParts' == some (11, -1)\n#guard 500000000000000.5.toRatParts' == some (1000000000000001, -1)\n#guard 5000000000000000.5.toRatParts' == some (152587890625, 15)\n#guard 1e1000.toRatParts' == none\n#guard (-1e1000).toRatParts' == none\n#guard (-0/0:Float).toRatParts' == none\n\n#guard 0.0.toStringFull == \"0\"\n#guard (2^(-1000):Float).toStringFull.length == 1002\n#guard (2^(-30):Float).toStringFull == \"0.000000000931322574615478515625\"\n#guard 0.1.toStringFull == \"0.1000000000000000055511151231257827021181583404541015625\"\n#guard 0.5.toStringFull == \"0.5\"\n#guard 5.0.toStringFull == \"5\"\n#guard (-5.0).toStringFull == \"-5\"\n#guard 5.5.toStringFull == \"5.5\"\n#guard 500000000000000.5.toStringFull == \"500000000000000.5\"\n#guard 5000000000000000.5.toStringFull == \"5000000000000000\"\n#guard 1e1000.toStringFull == \"inf\"\n#guard (-1e1000).toStringFull == \"-inf\"\n#guard (-0/0:Float).toStringFull == \"NaN\"\n\n#guard Nat.divFloat 1 0 == Float.inf\n#guard Nat.divFloat 50 0 == Float.inf\n#guard (Nat.divFloat 0 0).isNaN\n#guard Nat.divFloat 1 3 == (1 / 3 : Float)\n#guard Nat.divFloat 1 6 == (1 / 6 : Float)\n#guard Nat.divFloat 2 3 == (2 / 3 : Float)\n#guard Nat.divFloat 100 17 == (100 / 17 : Float)\n#guard Nat.divFloat 5000000000000000 1 == (5000000000000000 : Float)\n#guard [0,0,0,1,1,1,2,2,2,2,2,3,3,3,4,4,4].zipIdx.all fun p =>\n Nat.divFloat (5000000000000000*4+p.2) 4 == (5000000000000000+p.1).toFloat\n#guard Nat.divFloat ((2^53-1)*(2^(1024-53))) 1 == ((2^53-1)*(2^(1024-53)))\n#guard Nat.divFloat (((2^53-1)*4+1)*(2^(1024-53))) 4 == ((2^53-1)*(2^(1024-53)))\n#guard Nat.divFloat (((2^53-1)*4+2)*(2^(1024-53))) 4 == Float.inf\n#guard Nat.divFloat (((2^53-1)*4+3)*(2^(1024-53))) 4 == Float.inf\n#guard Nat.divFloat (((2^53-1)*4+4)*(2^(1024-53))) 4 == Float.inf\n\n#guard Int.divFloat 1 3 == (1 / 3 : Float)\n#guard Int.divFloat (-1) 3 == (-1 / 3 : Float)\n#guard Int.divFloat 1 (-3) == (1 / -3 : Float)\n#guard Int.divFloat (-1) (-3) == (-1 / -3 : Float)\n#guard Int.divFloat (-1) 0 == -Float.inf\n#guard (Int.divFloat 0 0).isNaN\n#guard (Int.divFloat 0 1).toString == \"0.000000\"\n#guard (Int.divFloat 0 (-1)).toString == \"-0.000000\"\n" }, { "path": "BatteriesTest/help_cmd.lean", "content": "import Batteries.Tactic.HelpCmd\n\n/-! The `#help` command\n\nThe `#help` command family currently contains these subcommands:\n\n* `#help attr` / `#help attribute`\n* `#help cat`\n* `#help cats`\n* `#help command` (abbrev for `#help cat command`)\n* `#help conv` (abbrev for `#help cat conv`)\n* `#help option`\n* `#help tactic` (abbrev for `#help cat tactic`)\n* `#help term` (abbrev for `#help cat term`)\n\nAll forms take an optional identifier prefix to narrow the search. The `#help cat` command has a\nvariant `#help cat+` that displays additional information, similarly for commands derived from\n`#help cat`.\n\nWARNING: Some of these tests will need occasional updates when new features are added and even when\nsome documentation is edited. This type of break will be unexpected but the fix will not be\nunexpected! Just update the guard text to match the output after your addition.\n-/\n\n/-! `#help attr` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help attr\n\n/--\nerror: no attributes start with foobarbaz\n-/\n#guard_msgs in\n#help attr foobarbaz\n\n/--\ninfo: [inline]: mark definition to be inlined\n Changes the inlining behavior. This attribute comes in several variants:\n - `@[inline]`: marks the definition to be inlined when it is appropriate.\n - `@[inline_if_reduce]`: marks the definition to be inlined if an application of it after inlining\n and applying reduction isn't a `match` expression. This attribute can be used for inlining\n structurally recursive functions.\n - `@[noinline]`: marks the definition to never be inlined.\n - `@[always_inline]`: marks the definition to always be inlined.\n - `@[macro_inline]`: marks the definition to always be inlined at the beginning of compilation.\n This makes it possible to define functions that evaluate some of their parameters lazily.\n Example:\n ```\n @[macro_inline]\n def test (x y : Nat) : Nat :=\n if x = 42 then x else y\n ⏎\n #eval test 42 (2^1000000000000) -- doesn't compute 2^1000000000000\n ```\n Only non-recursive functions may be marked `@[macro_inline]`.\n\n[inline_if_reduce]: mark definition to be inlined when resultant term after reduction is not a `cases_on` application\n Changes the inlining behavior. This attribute comes in several variants:\n - `@[inline]`: marks the definition to be inlined when it is appropriate.\n - `@[inline_if_reduce]`: marks the definition to be inlined if an application of it after inlining\n and applying reduction isn't a `match` expression. This attribute can be used for inlining\n structurally recursive functions.\n - `@[noinline]`: marks the definition to never be inlined.\n - `@[always_inline]`: marks the definition to always be inlined.\n - `@[macro_inline]`: marks the definition to always be inlined at the beginning of compilation.\n This makes it possible to define functions that evaluate some of their parameters lazily.\n Example:\n ```\n @[macro_inline]\n def test (x y : Nat) : Nat :=\n if x = 42 then x else y\n ⏎\n #eval test 42 (2^1000000000000) -- doesn't compute 2^1000000000000\n ```\n Only non-recursive functions may be marked `@[macro_inline]`.\n-/\n#guard_msgs in\n#help attr inl\n\n/-! `#help cat` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help cat term\n\n/--\nerror: foobarbaz is not a syntax category\n-/\n#guard_msgs in\n#help cat foobarbaz\n\n/--\ninfo:\nsyntax \"(\"... [«prec(_)»]\n Parentheses are used for grouping precedence expressions.\n\nsyntax ...\"+\"... [Lean.Parser.Syntax.addPrec]\n Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`.\n\nsyntax ...\"-\"... [Lean.Parser.Syntax.subPrec]\n Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`.\n\nsyntax \"arg\"... [precArg]\n Precedence used for application arguments (`do`, `by`, ...).\n\nsyntax \"lead\"... [precLead]\n Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...).\n\nsyntax \"max\"... [precMax]\n Maximum precedence used in term parsers, in particular for terms in\n function position (`ident`, `paren`, ...)\n\nsyntax \"min\"... [precMin]\n Minimum precedence used in term parsers.\n\nsyntax \"min1\"... [precMin1]\n `(min+1)` (we can only write `min+1` after `Meta.lean`)\n\nsyntax \"num\"... [Lean.Parser.Syntax.numPrec]\n-/\n#guard_msgs in\n#help cat prec\n\n/--\ninfo:\nsyntax \"(\"... [«prec(_)»]\n Parentheses are used for grouping precedence expressions.\n+ macro «_aux_Init_Notation___macroRules_prec(_)_1»\n Parentheses are used for grouping precedence expressions.\n\nsyntax ...\"+\"... [Lean.Parser.Syntax.addPrec]\n Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`.\n+ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_addPrec_1\n\nsyntax ...\"-\"... [Lean.Parser.Syntax.subPrec]\n Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`.\n+ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_subPrec_1\n\nsyntax \"arg\"... [precArg]\n Precedence used for application arguments (`do`, `by`, ...).\n+ macro _aux_Init_Notation___macroRules_precArg_1\n Precedence used for application arguments (`do`, `by`, ...).\n\nsyntax \"lead\"... [precLead]\n Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...).\n+ macro _aux_Init_Notation___macroRules_precLead_1\n Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...).\n\nsyntax \"max\"... [precMax]\n Maximum precedence used in term parsers, in particular for terms in\n function position (`ident`, `paren`, ...)\n+ macro _aux_Init_Notation___macroRules_precMax_1\n Maximum precedence used in term parsers, in particular for terms in\n function position (`ident`, `paren`, ...)\n\nsyntax \"min\"... [precMin]\n Minimum precedence used in term parsers.\n+ macro _aux_Init_Notation___macroRules_precMin_1\n Minimum precedence used in term parsers.\n\nsyntax \"min1\"... [precMin1]\n `(min+1)` (we can only write `min+1` after `Meta.lean`)\n+ macro _aux_Init_Notation___macroRules_precMin1_1\n `(min+1)` (we can only write `min+1` after `Meta.lean`)\n\nsyntax \"num\"... [Lean.Parser.Syntax.numPrec]\n-/\n#guard_msgs in\n#help cat+ prec\n\n/-! `#help cats` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help cats\n\n/--\nerror: no syntax categories start with foobarbaz\n-/\n#guard_msgs in\n#help cats foobarbaz\n\n/--\ninfo: category prec [Lean.Parser.Category.prec]\n `prec` is a builtin syntax category for precedences. A precedence is a value\n that expresses how tightly a piece of syntax binds: for example `1 + 2 * 3` is\n parsed as `1 + (2 * 3)` because `*` has a higher precedence than `+`.\n Higher numbers denote higher precedence.\n In addition to literals like `37`, there are some special named precedence levels:\n * `arg` for the precedence of function arguments\n * `max` for the highest precedence used in term parsers (not actually the maximum possible value)\n * `lead` for the precedence of terms not supposed to be used as arguments\n and you can also add and subtract precedences.\n\ncategory prio [Lean.Parser.Category.prio]\n `prio` is a builtin syntax category for priorities.\n Priorities are used in many different attributes.\n Higher numbers denote higher priority, and for example typeclass search will\n try high priority instances before low priority.\n In addition to literals like `37`, you can also use `low`, `mid`, `high`, as well as\n add and subtract priorities.\n-/\n#guard_msgs in\n#help cats pr\n\n/-! `#help command` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help command\n\n/--\nerror: no command declarations start with foobarbaz\n-/\n#guard_msgs in\n#help command foobarbaz\n\n/--\ninfo: syntax \"#eval\"... [Lean.Parser.Command.eval]\n `#eval e` evaluates the expression `e` by compiling and evaluating it.\n ⏎\n * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result.\n * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m`\n to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`.\n Users can define `MonadEval` instances to extend the list of supported monads.\n ⏎\n The `#eval` command gracefully degrades in capability depending on what is imported.\n Importing the `Lean.Elab.Command` module provides full capabilities.\n ⏎\n Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly,\n since the presence of `sorry` can lead to runtime instability and crashes.\n This check can be overridden with the `#eval! e` command.\n ⏎\n Options:\n * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the\n usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances.\n * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value.\n * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance\n when there is no other way to print the result.\n ⏎\n See also: `#reduce e` for evaluation by term reduction.\n\nsyntax \"#eval!\"... [Lean.Parser.Command.evalBang]\n `#eval e` evaluates the expression `e` by compiling and evaluating it.\n ⏎\n * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result.\n * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m`\n to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`.\n Users can define `MonadEval` instances to extend the list of supported monads.\n ⏎\n The `#eval` command gracefully degrades in capability depending on what is imported.\n Importing the `Lean.Elab.Command` module provides full capabilities.\n ⏎\n Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly,\n since the presence of `sorry` can lead to runtime instability and crashes.\n This check can be overridden with the `#eval! e` command.\n ⏎\n Options:\n * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the\n usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances.\n * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value.\n * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance\n when there is no other way to print the result.\n ⏎\n See also: `#reduce e` for evaluation by term reduction. syntax \"#exit\"... [Lean.Parser.Command.exit]\n-/\n#guard_msgs in\n#help command \"#e\"\n\n-- Notably, we don't show a generic `\"/--\"` in the following test:\n\n/-- info: syntax \"abbrev\"... [Lean.Parser.Command.declaration] -/\n#guard_msgs in\n#help command def\n\n/--\ninfo: syntax \"#eval\"... [Lean.Parser.Command.eval]\n `#eval e` evaluates the expression `e` by compiling and evaluating it.\n ⏎\n * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result.\n * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m`\n to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`.\n Users can define `MonadEval` instances to extend the list of supported monads.\n ⏎\n The `#eval` command gracefully degrades in capability depending on what is imported.\n Importing the `Lean.Elab.Command` module provides full capabilities.\n ⏎\n Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly,\n since the presence of `sorry` can lead to runtime instability and crashes.\n This check can be overridden with the `#eval! e` command.\n ⏎\n Options:\n * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the\n usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances.\n * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value.\n * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance\n when there is no other way to print the result.\n ⏎\n See also: `#reduce e` for evaluation by term reduction.\n+ command elab Lean.Elab.Command.elabEval\n\nsyntax \"#eval!\"... [Lean.Parser.Command.evalBang]\n `#eval e` evaluates the expression `e` by compiling and evaluating it.\n ⏎\n * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result.\n * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m`\n to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`.\n Users can define `MonadEval` instances to extend the list of supported monads.\n ⏎\n The `#eval` command gracefully degrades in capability depending on what is imported.\n Importing the `Lean.Elab.Command` module provides full capabilities.\n ⏎\n Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly,\n since the presence of `sorry` can lead to runtime instability and crashes.\n This check can be overridden with the `#eval! e` command.\n ⏎\n Options:\n * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the\n usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances.\n * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value.\n * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance\n when there is no other way to print the result.\n ⏎\n See also: `#reduce e` for evaluation by term reduction.\n+ command elab Lean.Elab.Command.elabEvalBang\n\nsyntax \"#exit\"... [Lean.Parser.Command.exit]\n+ command elab Lean.Elab.Command.elabExit\n-/\n#guard_msgs in\n#help command+ \"#e\"\n\n/-! #help conv -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help conv\n\n/--\nerror: no conv declarations start with foobarbaz\n-/\n#guard_msgs in\n#help conv foobarbaz\n\n/--\ninfo:\nsyntax \"reduce\"... [Lean.Parser.Tactic.Conv.reduce]\n Puts term in normal form, this tactic is meant for debugging purposes only.\n\nsyntax \"repeat\"... [Lean.Parser.Tactic.Conv.convRepeat_]\n `repeat convs` runs the sequence `convs` repeatedly until it fails to apply.\n\nsyntax \"rewrite\"... [Lean.Parser.Tactic.Conv.rewrite]\n `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information.\n-/\n#guard_msgs in\n#help conv \"re\"\n\n/--\ninfo:\nsyntax \"reduce\"... [Lean.Parser.Tactic.Conv.reduce]\n Puts term in normal form, this tactic is meant for debugging purposes only.\n+ tactic elab Lean.Elab.Tactic.Conv.evalReduce\n\nsyntax \"repeat\"... [Lean.Parser.Tactic.Conv.convRepeat_]\n `repeat convs` runs the sequence `convs` repeatedly until it fails to apply.\n+ macro Lean.Parser.Tactic.Conv._aux_Init_Conv___macroRules_Lean_Parser_Tactic_Conv_convRepeat__1\n\nsyntax \"rewrite\"... [Lean.Parser.Tactic.Conv.rewrite]\n `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information.\n+ tactic elab Lean.Elab.Tactic.Conv.evalRewrite\n-/\n#guard_msgs in\n#help conv+ \"re\"\n\n/-! `#help option` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help option\n\n/--\nerror: no options start with foobarbaz\n-/\n#guard_msgs in\n#help option foobarbaz\n\n/--\ninfo:\noption pp.instanceTypes : Bool := false\n (pretty printer) when printing explicit applications, show the types of inst-implicit arguments\n\noption pp.instances : Bool := true\n (pretty printer) if set to false, replace inst-implicit arguments to explicit applications with\nplaceholders\n\noption pp.instantiateMVars : Bool := true\n (pretty printer) instantiate mvars before delaborating\n-/\n#guard_msgs in\n#help option pp.ins\n\n/-! `#help tactic` -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help tactic\n\n/--\nerror: no tactic declarations start with foobarbaz\n-/\n#guard_msgs in\n#help tactic foobarbaz\n\n/--\ninfo:\nsyntax \"by_cases\"... [«tacticBy_cases_:_»]\n `by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch,\nand `h : ¬ p` in the second branch.\n-/\n#guard_msgs in\n#help tactic by\n\n/--\ninfo:\nsyntax \"by_cases\"... [«tacticBy_cases_:_»]\n `by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.\n+ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__2»\n+ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__1»\n-/\n#guard_msgs in\n#help tactic+ by\n\n/-! #help term -/\n\n-- this is a long and constantly updated listing, we don't check the output\n#guard_msgs(error, drop info) in\n#help term\n\n/--\nerror: no term declarations start with foobarbaz\n-/\n#guard_msgs in\n#help term foobarbaz\n\n/--\ninfo: syntax \"debug_assert!\"... [Lean.Parser.Term.debugAssert]\n `debug_assert! cond` panics if `cond` evaluates to `false` and the executing code has been built\n with debug assertions enabled (see the `debugAssertions` option).\n\nsyntax \"decl_name%\"... [Lean.Parser.Term.declName]\n A macro which evaluates to the name of the currently elaborating declaration.\n\nsyntax \"default_or_ofNonempty%\"... [Lean.Parser.Term.defaultOrOfNonempty]\n-/\n#guard_msgs in\n#help term de\n\n/--\ninfo: syntax \"debug_assert!\"... [Lean.Parser.Term.debugAssert]\n `debug_assert! cond` panics if `cond` evaluates to `false` and the executing code has been built\n with debug assertions enabled (see the `debugAssertions` option).\n+ term elab Lean.Elab.Term.elabDebugAssert\n\nsyntax \"decl_name%\"... [Lean.Parser.Term.declName]\n A macro which evaluates to the name of the currently elaborating declaration.\n+ term elab Lean.Elab.Term.elabDeclName\n\nsyntax \"default_or_ofNonempty%\"... [Lean.Parser.Term.defaultOrOfNonempty]\n+ term elab Lean.Elab.Term.Op.elabDefaultOrNonempty\n-/\n#guard_msgs in\n#help term+ de\n" }, { "path": "BatteriesTest/import_lean.lean", "content": "import Lean\nimport Batteries\n\n/-!\nThis file ensures that we can import all of `Lean` and `Batteries` without name conflicts.\n-/\n" }, { "path": "BatteriesTest/instances.lean", "content": "import Batteries.Tactic.Instances\n\nset_option linter.missingDocs false\n\n/--\nerror: type class instance expected\n Fin 1\n-/\n#guard_msgs in\n#instances Fin 1\n\n/--\ninfo: 3 instances:\n\ninstAddNat : Add Nat\n(prio 100) Lean.Grind.Semiring.toAdd.{u} {α : Type u} [self : Lean.Grind.Semiring α] : Add α\n(prio 100) Lean.Grind.AddCommMonoid.toAdd.{u} {M : Type u} [self : Lean.Grind.AddCommMonoid M] : Add M\n-/\n#guard_msgs in\n#instances Add Nat\n\nnamespace Testing\nclass A (α : Type)\n\n/-- info: No instances -/\n#guard_msgs in\n#instances A\n\ninstance (priority := high) : A Nat := ⟨⟩\ninstance : A Int := ⟨⟩\ninstance : A Bool := ⟨⟩\n\n/--\ninfo: 3 instances:\n\n(prio 10000) Testing.instANat : A Nat\nTesting.instABool : A Bool\nTesting.instAInt : A Int\n-/\n#guard_msgs in\n#instances A _\n\n/--\ninfo: 3 instances:\n\n(prio 10000) Testing.instANat : A Nat\nTesting.instABool : A Bool\nTesting.instAInt : A Int\n-/\n#guard_msgs in\n#instances A\n\n/-- info: No instances -/\n#guard_msgs in\n#instances (α : Type) → A α\n\ninstance : A α := ⟨⟩\n\n/--\ninfo: 5 instances:\n(local) inst✝ : A β\n(prio 10000) Testing.instANat : A Nat\nTesting.instABool : A Bool\nTesting.instAInt : A Int\nTesting.instA {α : Type} : A α\n-/\n#guard_msgs in\n#instances [A β] : A\n\n/--\ninfo: 1 instance:\n\nTesting.instA {α : Type} : A α\n-/\n#guard_msgs in\n#instances (α : Type) → A α\n\nend Testing\n" }, { "path": "BatteriesTest/isIndependentOf.lean", "content": "import Batteries.Lean.Meta.Basic\nimport Batteries.Tactic.PermuteGoals\nimport Lean.Meta.Tactic.IndependentOf\n\nopen Lean Meta Elab.Tactic\n\nelab \"check_indep\" : tactic => do\n match ← getGoals with\n | [] => throwError \"Expected goal\"\n | g :: l =>\n let res := if ←g.isIndependentOf l then \"\" else \"not \"\n let t ← instantiateMVars (← g.getType)\n logWarning s!\"{←ppExpr (.mvar g)} : {←ppExpr t} is {res}independent of:\"\n l.forM fun g' => do\n logInfo s!\" {←ppExpr (.mvar g')} : {←ppExpr (← g'.getType)}\"\n let ppD (l : LocalDecl) : TacticM PUnit := do\n logInfo s!\" {←ppExpr (.fvar l.fvarId)} : {←ppExpr l.type}\"\n let _ ← (←g'.getDecl).lctx.forM ppD\n pure ()\n\n/-- warning: ?w : Nat is not independent of: -/\n#guard_msgs(warning, drop info) in\nexample : ∃ (n : Nat), ∀(x : Fin n), x.val = 0 := by\n apply Exists.intro\n intro x\n swap\n check_indep\n exact 0\n revert x\n intro ⟨x, lt⟩\n contradiction\n\n-- This is a tricker one, where the dependency is via a hypothesis.\n/-- warning: ?w : Nat is not independent of: -/\n#guard_msgs(warning, drop info) in\nexample : ∃ (n : Nat), ∀(x : Fin n) (y : Nat), x.val = y → y = 0 := by\n apply Exists.intro\n intro x y p\n swap\n check_indep\n exact 0\n revert x\n intro ⟨x, lt⟩\n contradiction\n" }, { "path": "BatteriesTest/kmp_matcher.lean", "content": "import Batteries.Data.String.Matcher\nimport Batteries.Data.List.Matcher\n\n/-! # Tests for the Knuth-Morris-Pratt (KMP) matching algorithm -/\n\n/-! ### String API -/\n\n/-- Matcher for pattern \"abba\" -/\ndef m := String.Matcher.ofString \"abba\"\n\n#guard ! Option.isSome (m.find? \"AbbabbA\")\n\n#guard Option.isSome (m.find? \"aabbaa\")\n\n#guard Array.size (m.findAll \"abbabba\") = 2\n\n#guard Array.size (m.findAll \"abbabbabba\") = 3\n\n#guard Option.isSome (\"xyyxx\".findSubstr? \"xy\")\n\n#guard ! Option.isSome (\"xyyxx\".findSubstr? \"xyx\")\n\n#guard Array.size (\"xyyxx\".findAllSubstr \"xyx\") = 0\n\n#guard Array.size (\"xyyxxyx\".findAllSubstr \"xyx\") = 1\n\n#guard Array.size (\"xyxyyxxyx\".findAllSubstr \"xyx\") = 2\n\n#guard Array.size (\"xyxyxyyxxyxyx\".findAllSubstr \"xyx\") = 4\n\n/-! ### List API -/\n\ndef lm := List.Matcher.ofList [0,1,1,0]\n\n#guard lm.find? [2,1,1,0,1,1,2] == none\n\n#guard lm.find? [0,0,1,1,0,0] == some (1, 5)\n\n#guard (lm.findAll [0,1,1,0,1,1,0]).size == 2\n\n#guard (lm.findAll [0,1,1,0,1,1,0,1,1,0]).size == 3\n" }, { "path": "BatteriesTest/lemma_cmd.lean", "content": "import Batteries.Tactic.Lemma\n\n-- lemma disabled by default\n/--\ninfo: Try this:\n [apply] theorem\n---\nerror: `lemma` is not supported by default, please use `theorem` instead.\nUse `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file.\nUse the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally.\n-/\n#guard_msgs in\nlemma test1 : 3 < 7 := by decide\n\n-- lemma enabled for one command\nset_option lang.lemmaCmd true in\nlemma test2 : 3 < 7 := by decide\n\n-- lemma disabled again\n/--\ninfo: Try this:\n [apply] theorem\n---\nerror: `lemma` is not supported by default, please use `theorem` instead.\nUse `set_option lang.lemmaCmd true` to enable the use of the `lemma` command in a file.\nUse the command line option `-Dlang.lemmaCmd=true` to enable the use of `lemma` globally.\n-/\n#guard_msgs in\nlemma test3 : 3 < 7 := by decide\n\n-- lemma enabled for rest of file\nset_option lang.lemmaCmd true\n\nlemma test4 : 3 < 7 := by decide\n\nlemma test5 : 3 < 7 := by decide\n" }, { "path": "BatteriesTest/library_note.lean", "content": "import Batteries.Tactic.HelpCmd\nimport BatteriesTest.Internal.DummyLibraryNote2\n\n/--\nerror: Note not found\n-/\n#guard_msgs in\n#help note \"no note\"\n\n/--\ninfo: library_note Other\n/-- 1: this is a testnote with a label not starting with \"te\",\nso it shouldn't appear when looking for notes with label starting with \"te\". -/\n-/\n#guard_msgs in\n#help note \"Other\"\n\nlibrary_note «test4» /--\n4: This note was not imported, and therefore appears below the imported notes.\n-/\n\nlibrary_note «test5» /--\n5: This note was also not imported, and therefore appears below the imported notes,\nand the previously added note.\n-/\n\n\n/--\ninfo: library_note «temporary note»\n/-- 1: This is a testnote whose label also starts with \"te\", but gets sorted before \"test\" -/\n\nlibrary_note test1\n/-- 1: This is a testnote for testing the library note feature of batteries.\nThe `#help note` command should be able to find this note when imported. -/\n\nlibrary_note test2\n/-- 2: This is a second testnote for testing the library note feature of batteries. -/\n\nlibrary_note test3\n/-- 3: this is a note in a different file importing the above testnotes,\nbut still imported by the actual testfile. -/\n\nlibrary_note test4\n/-- 4: This note was not imported, and therefore appears below the imported notes. -/\n\nlibrary_note test5\n/-- 5: This note was also not imported, and therefore appears below the imported notes,\nand the previously added note. -/\n-/\n#guard_msgs in\n#help note \"te\"\n\n/-! ## Tests for space-to-underscore encoding in declaration names\n\nLibrary notes with spaces in their names should create declarations with underscores,\nfor compatibility with the Lean export format (which doesn't support whitespace in names).\n-/\n\n-- Test that a note with spaces creates a declaration with underscores\nlibrary_note «note with spaces» /--\nThis note has spaces in its name to test export format compatibility.\n-/\n\n-- Verify the declaration name has underscores, not spaces\n/-- info: LibraryNote.note_with_spaces : Batteries.Util.LibraryNote -/\n#guard_msgs in\n#check LibraryNote.note_with_spaces\n\n-- Test that a note with multiple consecutive spaces works\nlibrary_note «note with multiple spaces» /--\nThis note has multiple consecutive spaces.\n-/\n\n/-- info: LibraryNote.note__with___multiple____spaces : Batteries.Util.LibraryNote -/\n#guard_msgs in\n#check LibraryNote.note__with___multiple____spaces\n\n/--\ninfo: library_note «note with spaces»\n/-- This note has spaces in its name to test export format compatibility. -/\n-/\n#guard_msgs in\n#help note \"note with\"\n" }, { "path": "BatteriesTest/lintTC.lean", "content": "import Batteries.Tactic.Lint.TypeClass\nimport Lean.Elab.Command\n\nopen Batteries.Tactic.Lint\n\nnamespace A\n\n/--\nwarning: unused variable `β`\n\nNote: This linter can be disabled with `set_option linter.unusedVariables false`\n-/\n#guard_msgs in\nlocal instance impossible {α β : Type} [Inhabited α] : Nonempty α := ⟨default⟩\n\nrun_meta guard (← impossibleInstance.test ``impossible).isSome\n\nend A\n\nnamespace B\ninstance bad : Nat := 1\n\nrun_meta guard (← nonClassInstance.test ``bad).isSome\ninstance good : Inhabited Nat := ⟨1⟩\n\nrun_meta guard (← nonClassInstance.test ``good).isNone\nend B\n" }, { "path": "BatteriesTest/lintTrace.lean", "content": "import Batteries.Tactic.Lint\n\n/-!\nTests tracing in `#lint`.\n\nNote that this does not test tracing in `runLinter` per se.\n-/\n\n-- oops, no docstring\ndef foo := 3\n\ntheorem bar : foo = 3 := rfl\n\nset_option trace.Batteries.Lint true\n\n/--\ntrace: [Batteries.Lint] Running linters:\n docBlame\n[Batteries.Lint] - docBlame: (0/2) Starting...\n[Batteries.Lint] - docBlame: (1/2) Getting...\n[Batteries.Lint] - docBlame: (2/2) Failed with 1 messages.\n[Batteries.Lint] Completed linting!\n-/\n#guard_msgs (trace, drop error) in\n#lint- only docBlame\n\n/--\ntrace: [Batteries.Lint] Running linters:\n defLemma\n[Batteries.Lint] - defLemma: (0/2) Starting...\n[Batteries.Lint] - defLemma: (1/2) Getting...\n[Batteries.Lint] - defLemma: (2/2) Passed!\n[Batteries.Lint] Completed linting!\n-/\n#guard_msgs in\n#lint- only defLemma\n" }, { "path": "BatteriesTest/lint_coinductive.lean", "content": "import Batteries.Tactic.Lint\n\n/-! Tests that linters skip auto-generated declarations from coinductive predicates. -/\n\n/-- A coinductive stream predicate for testing. -/\ncoinductive MyStream (α : Type) : Prop where\n | cons : α → MyStream α → MyStream α\n\nmutual\n /-- Coinductive half of a mutual block for testing. -/\n coinductive tick : Prop where\n | mk : ¬tock → tick\n\n /-- Inductive half of a mutual block for testing. -/\n inductive tock : Prop where\n | mk : ¬tick → tock\nend\n\n#guard_msgs in\n#lint- only defLemma\n\n#guard_msgs in\n#lint- only docBlame\n" }, { "path": "BatteriesTest/lint_docBlame.lean", "content": "import Batteries.Tactic.Lint\n\nset_option linter.missingDocs false\n\n/-- A docstring is needed here -/\nstructure AtLeastThirtySeven where\n /-- and here -/\n val : Nat := 1\n -- but not here\n prop : 37 ≤ val\n\n-- or here\ntheorem AtLeastThirtySeven.lt (x : AtLeastThirtySeven) : 36 < x.val := x.prop\n\n#lint- only docBlame\n" }, { "path": "BatteriesTest/lint_docBlameThm.lean", "content": "import Batteries.Tactic.Lint\n\nset_option linter.missingDocs false\n\n-- A docstring is not needed here\nstructure AtLeastThirtySeven where\n -- or here\n val : Nat := 1\n /-- but is needed here -/\n prop : 37 ≤ val\n\n/-- and here -/\ntheorem AtLeastThirtySeven.lt (x : AtLeastThirtySeven) : 36 < x.val := x.prop\n\n#lint- only docBlameThm\n" }, { "path": "BatteriesTest/lint_dupNamespace.lean", "content": "import Batteries.Tactic.Lint\n\n-- internal names should be ignored\ntheorem Foo.Foo._bar : True := trivial\n\n#lint- only dupNamespace\n" }, { "path": "BatteriesTest/lint_lean.lean", "content": "import Batteries.Tactic.Lint\n\n/-!\nThis test file runs the environment linters set up in Batteries on the core Lean4 repository.\n\nEverything is commented out as it is too slow to run in regular Batteries CI\n(and in any case there are many failures still),\nbut it is useful to run locally to see what the linters would catch.\n-/\n\n-- We can't apply `nolint` attributes to imported declarations,\n-- but if we move the environment linters up to Lean,\n-- these nolints should be installed there.\n-- (And in the meantime you can \"manually\" ignore them!)\n-- attribute [nolint dupNamespace] Lean.Elab.Tactic.Tactic\n-- attribute [nolint dupNamespace] Lean.Parser.Parser Lean.Parser.Parser.rec Lean.Parser.Parser.mk\n-- Lean.Parser.Parser.info Lean.Parser.Parser.fn\n-- attribute [nolint explicitVarsOfIff] Iff.refl\n\n/-! Failing lints that need work. -/\n\n-- Many fixed in https://github.com/leanprover/lean4/pull/4620 and subsequent PRs\n-- and should be checked again.\n-- #lint only simpNF in all -- Found 22 errors\n\n/-! Lints that fail, but that we're not intending to do anything about. -/\n\n-- Mostly fixed in https://github.com/leanprover/lean4/pull/4621\n-- There are many false positives here.\n-- To run this properly we would need to ignore all declarations with `@[extern]`.\n-- #lint only unusedArguments in all -- Found 89 errors\n\n-- After https://github.com/leanprover/lean4/pull/4616, these are all intentional and have\n-- `nolint` attributes above.\n-- #lint only dupNamespace in all -- Found 6 errors\n\n-- After https://github.com/leanprover/lean4/pull/4619 all of these should be caused by `abbrev`.\n-- Unless we decide to upstream something like `alias`, we're not planning on fixing these.\n-- #lint only defLemma in all -- Found 31 errors\n\n/-! Lints that have succeeded in the past, and hopefully still do! -/\n\n-- #lint only explicitVarsOfIff in all -- Found 1 errors, `Iff.refl`, which could be nolinted.\n-- #lint only impossibleInstance in all -- Found 0 errors\n-- #lint only simpVarHead in all -- Found 0 error\n-- #lint only unusedHavesSuffices in all -- Found 0 errors\n-- #lint only checkUnivs in all -- Found 0 errors\n" }, { "path": "BatteriesTest/lint_simpNF.lean", "content": "import Batteries.Tactic.Lint\n\nset_option linter.missingDocs false\n\nstructure Equiv (α : Sort _) (β : Sort _) where\n toFun : α → β\n invFun : β → α\n\ninfixl:25 \" ≃ \" => Equiv\n\nnamespace Equiv\n\ninstance : CoeFun (α ≃ β) fun _ => α → β := ⟨toFun⟩\n\nprotected def symm (e : α ≃ β) : β ≃ α := ⟨e.invFun, e.toFun⟩\n\ndef sumCompl {α : Type _} (p : α → Prop) [DecidablePred p] :\n Sum { a // p a } { a // ¬p a } ≃ α where\n toFun := Sum.elim Subtype.val Subtype.val\n invFun a := if h : p a then Sum.inl ⟨a, h⟩ else Sum.inr ⟨a, h⟩\n\n@[simp]\ntheorem sumCompl_apply_symm_of_pos (p : α → Prop) [DecidablePred p] (a : α) (h : p a) :\n (sumCompl p).symm a = Sum.inl ⟨a, h⟩ :=\n dif_pos h\n\ndef foo (n : Nat) : Nat := if n = n then n else 0\n\n@[simp]\ntheorem foo_eq_id : foo = id := by\n funext n\n simp [foo]\n\n-- The following `dsimp`-lemma is (correctly) not flagged by the linter\n@[defeq, simp]\ntheorem foo_eq_ite (n : Nat) : foo n = if n = n then n else 0 := by\n rfl\n\nend Equiv\n\nnamespace List\n\nprivate axiom test_sorry : ∀ {α}, α\n\n@[simp]\ntheorem ofFn_getElem_eq_map {β : Type _} (l : List α) (f : α → β) :\n ofFn (fun i : Fin l.length => f <| l[(i : Nat)]) = l.map f := test_sorry\n\nexample {β : Type _} (l : List α) (f : α → β) :\n ofFn (fun i : Fin l.length => f <| l[(i : Nat)]) = l.map f := by simp only [ofFn_getElem_eq_map]\n\nend List\n\n/-! This tests that `simpNF` is not accidentally using `quasiPatternApprox := true`. -/\n\ndef eqToFun {X Y : Type} (p : X = Y) : X → Y := by rw [p]; exact id\n\n@[simp]\ntheorem eqToFun_comp_eq_self {β} {X : Type} {f : β → Type}\n (z : ∀ b, X → f b) {j j' : β} (w : j = j') :\n eqToFun (by simp [w]) ∘ z j' = z j := by\n cases w; rfl\n\n@[simp]\ntheorem eqToFun_comp_iso_hom_eq_self {β} {X : Type} {f : β → Type}\n (z : ∀ b, X ≃ f b) {j j' : β} (w : j = j') :\n eqToFun (by simp [w]) ∘ (z j').toFun = (z j).toFun := by\n cases w; rfl\n\n/-! Test that the simpNF linter does not report false positives when `dsimp` changes\nimplicit arguments (e.g. unfolding carrier types in bundled structures).\nSee https://github.com/leanprover/lean4/pull/12179. -/\nsection BackwardDefEqRespectTransparency\n\nclass MyClass (α : Type) where\n op : α → α\n\nstructure Bundle where\n carrier : Type\n [inst : MyClass carrier]\n\nattribute [instance] Bundle.inst\n\ndef Bundle.of (X : Type) [MyClass X] : Bundle where\n carrier := X\n\n@[simp]\ntheorem Bundle.of_carrier (X : Type) [MyClass X] : (Bundle.of X).carrier = X := rfl\n\n-- This simp lemma has a LHS where the implicit `α` argument to `MyClass.op` is\n-- `Bundle.carrier (Bundle.of X)` rather than `X`. `dsimp [Bundle.of_carrier]` can\n-- partially unfold this, but the result is the same up to the old defeq behavior.\n-- The linter should not flag this.\n@[simp]\ntheorem Bundle.of_op {X : Type} [MyClass X] :\n @MyClass.op (Bundle.of X).carrier (Bundle.of X).inst = @MyClass.op X _ := rfl\n\nend BackwardDefEqRespectTransparency\n\n#lint- only simpNF\n" }, { "path": "BatteriesTest/lint_simpNF_respectTransparency.lean", "content": "/-\nCopyright (c) 2025 Lean FRO, LLC. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nimport Batteries.Tactic.Lint\n\nset_option linter.missingDocs false\n\n/-!\nTest that `linter.simpNF.respectTransparency true` catches simp lemmas whose LHS involves\nbundled carrier types that are only equal up to `backward.isDefEq.respectTransparency false`.\n\nWith the default setting (`false`), `Bundle.of_op` is NOT flagged (see `lint_simpNF.lean`).\nWith the strict setting (`true`), it IS flagged because the LHS is not in simp-normal form:\n`dsimp [Bundle.of_carrier]` simplifies the implicit carrier argument.\n-/\n\nprivate class MyClass (α : Type) where\n op : α → α\n\nprivate structure Bundle where\n carrier : Type\n [inst : MyClass carrier]\n\nattribute [instance] Bundle.inst\n\nprivate def Bundle.of (X : Type) [MyClass X] : Bundle where\n carrier := X\n\n@[simp]\nprivate theorem Bundle.of_carrier (X : Type) [MyClass X] : (Bundle.of X).carrier = X := rfl\n\n@[simp]\nprivate theorem Bundle.of_op {X : Type} [MyClass X] :\n @MyClass.op (Bundle.of X).carrier (Bundle.of X).inst = @MyClass.op X _ := rfl\n\n/--\nerror: -- Found 1 error in 0 declarations (plus 31 automatically generated ones) in the current file with 1 linters\n\n/- The `simpNF` linter reports:\nSOME SIMP LEMMAS ARE NOT IN SIMP-NORMAL FORM.\nPlease change the lemma to make sure their left-hand sides are in simp normal form.\nTo learn about simp normal forms, see\nhttps://leanprover-community.github.io/extras/simp.html#simp-normal-form\nand https://lean-lang.org/doc/reference/latest/The-Simplifier/Simp-Normal-Forms/. -/\n#check @Bundle.of_op /- Left-hand side simplifies from\n MyClass.op\nto\n MyClass.op\nusing\n dsimp only [*, Bundle.of_carrier]\nTry to change the left-hand side to the simplified term! -/\n-/\n#guard_msgs in\nset_option linter.simpNF.respectTransparency true in\n#lint only simpNF\n" }, { "path": "BatteriesTest/lint_unreachableTactic.lean", "content": "import Batteries.Linter.UnreachableTactic\n\n-- The warning generated by `linter.unreachableTactic` is not suppressed by `#guard_msgs`,\n-- because the linter is run on `#guard_msgs` itself. This is a known issue, see\n-- https://leanprover.zulipchat.com/#narrow/stream/348111-batteries/topic/unreachableTactic.20linter.20not.20suppressed.20by.20.60.23guard_msgs.60\n-- We jump through an extra hoop here to silence the warning.\nset_option linter.unreachableTactic false in\n#guard_msgs(drop warning) in\nset_option linter.unreachableTactic true in\n/--\nwarning: this tactic is never executed\n\nNote: This linter can be disabled with `set_option linter.unreachableTactic false`\n-/\n#guard_msgs in\nexample : 1 = 1 := by\n rfl <;> simp\n\n/--\nwarning: declaration uses `sorry`\n-/\n#guard_msgs in\nexample : 1 = 1 := by\n stop\n rfl\n\n#guard_msgs (drop warning) in\ndef t : Nat → Nat := sorry\n\n#guard_msgs (drop warning) in\n@[simp]\ntheorem a : aa = 0 → t aa = 0 := sorry\n\n#guard_msgs in\nexample (ha : aa = 0) : t aa = 0 := by\n simp (disch := assumption)\n" }, { "path": "BatteriesTest/linterVisibility.lean", "content": "module\n\n-- import `Linter` into both private and public scopes for testing\nimport Batteries.Tactic.Lint.Basic\npublic import Batteries.Tactic.Lint.Basic\n\nopen Batteries.Tactic.Lint\n\n/--\nerror: invalid attribute `env_linter`, declaration `foo` must be marked as `public` and `meta`\n-/\n#guard_msgs (error, drop warning) in\n@[env_linter] def foo : Linter := sorry\n\n/--\nerror: invalid attribute `env_linter`, declaration `foo'` must be marked as `public` and `meta` but is only marked `public`\n-/\n#guard_msgs (error, drop warning) in\n@[env_linter] public def foo' : Linter := sorry\n\n/--\nerror: invalid attribute `env_linter`, declaration `foo''` must be marked as `public` and `meta` but is only marked `meta`\n-/\n#guard_msgs (error, drop warning) in\n@[env_linter] meta def foo'' : Linter := sorry\n" }, { "path": "BatteriesTest/lintsimp.lean", "content": "import Batteries.Tactic.Lint\n\nopen Batteries.Tactic.Lint\nset_option linter.missingDocs false\n\ndef f : Nat := 0\ndef g : Nat := 0\ndef h : Nat := 0\n@[simp] theorem fg : f = g := rfl\n@[simp] theorem fh : f = h := rfl\n\nrun_meta guard (← [``fg, ``fh].anyM fun n => return (← simpNF.test n).isSome)\n\n@[simp] theorem test_and_comm : a ∧ b ↔ b ∧ a := And.comm\nrun_meta guard (← simpComm.test ``test_and_comm).isSome\n\n@[simp] theorem Prod.mk_fst : (a, b).1 = id a := rfl\nrun_meta guard (← simpVarHead.test ``Prod.mk_fst).isSome\n\ndef SemiconjBy [Mul M] (a x y : M) : Prop :=\n a * x = y * a\n\nstructure MulOpposite (α : Type u) : Type u where\n op :: unop : α\n\npostfix:max \"ᵐᵒᵖ\" => MulOpposite\n\nnamespace MulOpposite\n\ninstance [Mul α] : Mul αᵐᵒᵖ where mul x y := op (unop y * unop x)\n\n@[simp] theorem unop_inj {x y : αᵐᵒᵖ} : unop x = unop y ↔ x = y := by\n cases x; cases y; simp\n\n#guard_msgs (drop warning) in\n@[simp] theorem semiconj_by_unop [Mul α] {a x y : αᵐᵒᵖ} :\n SemiconjBy (unop a) (unop y) (unop x) ↔ SemiconjBy a x y := sorry\n\nrun_meta guard (← simpComm.test ``unop_inj).isNone\n\nrun_meta guard (← simpComm.test ``semiconj_by_unop).isNone\n\nend MulOpposite\n\nsection\n\ndef MyPred (_ : Nat → Nat) : Prop := True\n\n@[simp] theorem bad1 (f : Unit → Nat → Nat) : MyPred (f ()) ↔ True := by\n rw [MyPred]\n\n@[simp] theorem bad2 (f g : Nat → Nat) : MyPred (fun x => f (g x)) ↔ True := by\n rw [MyPred]\n\n-- Note, this is not a proper regression test because #671 depends on how the `MetaM` is\n-- executed, and `run_meta` sets the options appropriately. But setting the config\n-- explicitly here would amount to replicating the fix in the test itself.\nrun_meta guard (← simpNF.test ``bad1).isNone\nrun_meta guard (← simpNF.test ``bad2).isNone\n\nend\n" }, { "path": "BatteriesTest/lintunused.lean", "content": "import Batteries.Tactic.Lint\n\n-- should be ignored as the proof contains sorry\n/-- warning: declaration uses `sorry` -/\n#guard_msgs in\ntheorem Foo (h : 1 = 1) : True :=\n sorry\n\n#lint- only unusedArguments\n" }, { "path": "BatteriesTest/list_enumeration.lean", "content": "import Batteries.Data.List.Perm\n\nopen List\n\n#guard findIdxNth (· < 3) [5, 1, 3, 2, 4, 0, 1, 4] 2 == 5\n#guard idxOfNth 1 [5, 1, 3, 2, 4, 0, 1, 4] 1 == 6\n#guard countPBefore (· < 3) [5, 1, 3, 2, 4, 0, 1, 4] 5 == 2\n#guard countBefore 1 [5, 1, 3, 2, 4, 0, 1, 4] 6 == 1\n#guard (by decide : [1, 0, 1] <+~ [5, 0, 1, 3, 1]).idxInj 1 = 1\n#guard (by decide : [0, 1, 1, 3, 5] ~ [5, 0, 1, 3, 1]).idxBij 2 == 4\n" }, { "path": "BatteriesTest/list_sublists.lean", "content": "import Batteries.Data.List.Basic\n\n-- this times out with `sublistsFast`\nset_option maxRecDepth 562 in\nexample : [1, 2, 3].sublists.sublists.length = 256 := rfl\n" }, { "path": "BatteriesTest/mersenne_twister.lean", "content": "import Batteries.Data.Random.MersenneTwister\nimport Batteries.Data.Stream\n\nopen Batteries.Random.MersenneTwister\n\n#guard (Std.Stream.take mt19937.init 5).1 == [874448474, 2424656266, 2174085406, 1265871120, 3155244894]\n\n/- Sample output was generated using `numpy`'s implementation of MT19937:\n```python\nfrom numpy import array, uint32\nfrom numpy.random import MT19937\n\nmt = MT19937()\nmt.state = {\n 'bit_generator' : 'MT19937',\n 'state' : {\n 'pos' : 624,\n 'key' : array([\n 4357, 1673174024, 1301878288, 1129097449, 2180885271, 2495295730, 3729202114, 3451529139, 2624228201, 696045212,\n 2296245684, 4097888573, 2110311931, 1672374534, 381896678, 2887874951, 3859861197, 420983856, 1691952728, 4233606289,\n 1707944415, 3515687962, 4265198858, 1433261659, 1131854641, 228846788, 3811811324, 873525989, 588291779, 2854617646,\n 948269870, 3798261295, 3422826645, 340138072, 3671734944, 3961007161, 2839350439, 3264455490, 310719058, 2570596611,\n 3750039289, 648992492, 3816674884, 2210726029, 371217291, 196912982, 3046892150, 470118103, 1302935133, 362465408,\n 1360220904, 2946174945, 1630294895, 3570642538, 1798333338, 1196832683, 226789057, 2740096276, 1062441100, 1875507765,\n 2599873619, 1037523070, 4029519294, 3231722367, 2232344613, 3458909352, 2906353456, 3064815497, 3166305847,\n 3658630546, 3632421090, 885320275, 1621369481, 1258557244, 2827734740, 3209486301, 131295515, 2191201702, 44141830,\n 1183978535, 4202966509, 801836240, 2303299448, 333191985, 4114943231, 1490315450, 453120554, 759253243, 1381163601,\n 3455606116, 1027445020, 1144697221, 3040135651, 4176273102, 798935118, 49817807, 2492997557, 3171983608, 2742334400,\n 1282687705, 1047297991, 3697219554, 1400278898, 3276297123, 843040281, 354711436, 4156544868, 2873126701, 3990490795,\n 3966874614, 1376536470, 4189022583, 2283386237, 3645931808, 1312021512, 679663233, 3054458511, 1152865034, 1927729338,\n 538380875, 374984161, 2453495220, 514433452, 1271601365, 3737270131, 630101278, 1292962526, 2908018207, 1209528133,\n 413117768, 3762161744, 2194986537, 1414304087, 379722290, 2862208514, 3551161587, 3402627497, 2411204572, 3033657332,\n 4161252989, 2267825211, 963150406, 2081690150, 4014304967, 1977732365, 2412979568, 613038232, 418857425, 3682807839,\n 3416550746, 3692470090, 2764012443, 3255912817, 2160692740, 3914318396, 3437441061, 2828481795, 3655629678, 582770030,\n 2946380655, 3506851541, 612362648, 3394202848, 1530337657, 3360830183, 570641538, 153365650, 1624454723, 80526649,\n 1365694508, 2272925828, 34250189, 3066169803, 631734422, 3706776758, 3443270679, 659846301, 3707435456, 3573851432,\n 1017208097, 1100519855, 1824765866, 3284762074, 2887949547, 569464065, 3057970772, 1726477004, 3119183733, 3349922451,\n 4162228670, 249085950, 3854319807, 1155219045, 811161064, 207675760, 50531529, 141911159, 3819613906, 2655884066,\n 3517624211, 514724041, 2094583932, 3681571092, 3518053661, 2207473499, 961982182, 1423628102, 628853095, 3823741997,\n 1450180112, 1817911736, 384378993, 1749521215, 4080873978, 2604100714, 2468900411, 1718743185, 3679944356, 623522652,\n 2974445253, 351789091, 776787982, 4087231118, 395771407, 2634989045, 2547249720, 2502583808, 3550523417, 648947207,\n 2361409826, 2639137202, 4179155171, 3136025689, 3233151180, 3765213604, 459508845, 412632299, 3365801270, 1208603094,\n 1978375863, 3608769469, 2648322656, 994422344, 1463198657, 1938300111, 1983437898, 3617090298, 582545291, 604707873,\n 615071476, 1976468460, 4251555349, 2373160371, 4138683998, 927249694, 4178996063, 3071856005, 3264724616, 2539911824,\n 1383596905, 3639900055, 2590770034, 1029541954, 369472051, 3757991913, 1470517532, 2317808180, 1065978813, 3301489275,\n 4087716742, 2662718566, 678716423, 274451277, 1625396912, 3598469848, 3639725841, 726808159, 1490990746, 4062476682,\n 2411471067, 1395972017, 1390554948, 1854727292, 2494590309, 1377225539, 2540041390, 3288614830, 706906287, 1416719637,\n 609008344, 2311429920, 821102265, 2034260263, 3587569090, 3115591378, 3545840515, 4166871929, 139581804, 2421643972,\n 1250638605, 4212965387, 2794805718, 3306616566, 2466109783, 2200482525, 1496197888, 381089640, 2743249505, 4221427695,\n 1247199466, 1746114586, 2065302059, 1348936513, 2997505940, 3911013644, 428274869, 2816055507, 580438782, 135588414,\n 916674047, 445684901, 1016784680, 654791600, 1282652681, 92916407, 1411782674, 1367985506, 1207661779, 3531669257,\n 627085756, 1857409876, 4107311709, 1384928667, 2576697382, 2875531654, 4151312039, 116927085, 1281879888, 414036984,\n 3931190705, 4100135295, 1170799418, 3130902186, 4055536507, 3692691153, 480878564, 2201474460, 3663014917, 4155766371,\n 1987039566, 4121861326, 2525025103, 2465094709, 2536129400, 1843468352, 2926058841, 533253191, 1988389474, 1209435122,\n 4141112867, 2699109017, 2373614092, 1694129124, 2730600877, 2249161515, 1355638390, 3319290902, 2209534967,\n 1463955965, 204923808, 1025015944, 214266113, 3382305551, 2455594378, 1861944634, 1820710091, 449145441, 4119339060,\n 2660525612, 3515028309, 3466454003, 1024657310, 50945886, 2913140895, 721595333, 3416444872, 2701847760, 2352361641,\n 234184151, 3927502002, 3834792578, 3469473651, 4193637929, 2873594460, 1994191988, 1690724605, 1956524219, 476427462,\n 212379302, 1370380615, 327076237, 1984104432, 682581272, 2521259089, 3543809183, 3275489242, 241390538, 3496199707,\n 2497799665, 770560132, 1626015420, 2776148645, 3717161347, 3970592238, 710750702, 3421625839, 876972885, 2108460056,\n 1195168096, 1195766777, 3121053543, 2819333890, 1916084498, 717897923, 3627489721, 1970264748, 1813355780, 4148615245,\n 556824139, 411448086, 4228776246, 1732939415, 3206934813, 1949588544, 3291105704, 1044314017, 222045743, 3079457322,\n 638497370, 1849452395, 921039233, 1115861204, 3019093836, 2828923381, 4185943827, 3344827454, 3923907710, 760572735,\n 3828284133, 1559197800, 724485616, 1828677449, 2985767159, 4119101778, 1077348258, 3518446099, 2585587017, 1855673084,\n 3495712148, 3265984413, 2998815707, 760668518, 2487249862, 3060757479, 3249514669, 4222804112, 1010910776, 3893641969,\n 395812799, 2591540346, 1194664170, 49789115, 1363873041, 1005502756, 1164343260, 3646613829, 459869347, 3679832718,\n 1137706766, 4189431951, 1412889205, 622040248, 1536739968, 3066727065, 666661511, 1672188834, 2714762802, 4135248739,\n 35606745, 2775710540, 4083752484, 3680159469, 1950331243, 251641782, 1501029974, 486869303, 1720971325, 241603808,\n 28070600, 2737782337, 910469455, 3810848458, 118398842, 3078470155, 2559096993, 2933522804, 2264615020, 3793195157,\n 1614887475, 45727966, 3193899422, 1157273055, 2178255365, 2646663432, 724754192, 168779241, 4048503831, 3483948530,\n 3996648642, 939343027, 917914729, 3030111132, 3908302516, 29247037, 3568084731, 1034472966, 1408004326, 1693666951,\n 3712665549, 3120003376, 3374542680, 2868373905, 1362838239, 1421625626, 4275252746, 548825947, 622261297, 3152835012,\n 2926192892, 423356389, 151058371, 3820087086, 1673993262, 252457775, 1317185941, 2594135384, 817169312, 2016796985,\n 2292688295, 1654933570, 2158435154, 2703640067, 3260663801, 3267419116, 2293555012, 2721936781, 1727868043, 91884630,\n 265685878, 1143096279, 961294173, 403541376, 2338233320, 1725318369, 4101205103, 4268086122, 3418016922, 1065995435,\n 1936572353, 265163284, 3043694988, 2167402293, 2057323859, 4033232254, 3258990270, 1137868927, 2142656805, 4216785320,\n 1188509744, 1051071625, 196974391, 2445666962, 3092595170, 2833121107, 2474761097, 2190021692, 1852037076, 3577763037,\n 3794354715, 2124118694, 2641147398, 1551493415, 1913661165, 1313919440, 2232801400, 1781682225, 1340417535, 994676154,\n 251493162, 2162155003, 1678056273, 3810976356, 1505106460, 3361449605, 1041703651, 1727972302, 3959583054, 3140845007,\n 3202914485, 2878334456, 2354150592, 3334993881, 1015617735, 506838242, 4168775794, 839674019, 4238769945, 849116300,\n 4189642852, 1596908589, 556328875, 2369067254, 2431152278, 1004682871], dtype=uint32)}}\n\nprint(mt.random_raw(5))\n```\n-/\n" }, { "path": "BatteriesTest/nondet.lean", "content": "import Batteries.Control.Nondet.Basic\nimport Batteries.Lean.Meta.Basic\n\nset_option linter.missingDocs false\n\nopen Lean Meta\n\ndef M := StateT (List Nat) MetaM\n\nderiving instance AlternativeMonad for M\n\ninstance : MonadBacktrack (List Nat) M where\n saveState := StateT.get\n restoreState := StateT.set\n\ndef record (n : Nat) : M Unit := do\n discard <| restoreState (n :: (← saveState))\n\ndef iotaM [AlternativeMonad m] [MonadBacktrack σ m] (n : Nat) : Nondet m Nat :=\n Nondet.ofList (List.range' 1 n).reverse\n\n/-- info: (52, []) -/\n#guard_msgs in\n#eval show MetaM (Nat × List Nat) from StateT.run (iotaM 52 : Nondet M Nat).head []\n\n/-- info: ((), [52]) -/\n#guard_msgs in\n#eval show MetaM (Unit × List Nat) from StateT.run (((iotaM 52).mapM record).head) []\n\ndef x : Nondet M Nat :=\n (iotaM 52).filterMapM fun x => do\n record x\n if x % 7 = 0 then\n return some (x^2)\n else\n return none\n\n/-- info: (2401, [49]) -/\n#guard_msgs in\n#eval show MetaM (Nat × List Nat) from StateT.run x.head []\n\ndef divisors (n : Nat) : List Nat := List.range' 1 (n - 1) |>.reverse.filter fun m => n % m = 0\nexample : divisors 52 = [26, 13, 4, 2, 1] := rfl\n\ndef divisorsM [Monad m] [MonadBacktrack σ m] (n : Nat) : Nondet m Nat :=\n Nondet.ofList (divisors n)\n\n/-- Take the numbers `32, ..., 1`, replace each with their divisors, then replace again. -/\ndef y : Nondet M Nat :=\n (iotaM 32)\n |>.bind fun x => do\n record x\n divisorsM x\n |>.bind fun x => do\n record x\n divisorsM x\n\n/-- info: [8, 4, 2, 1, 4, 2, 1, 2, 1, 1, 5, 3, 1, 5, 2, 1, 3, 2, 1, 1, 1, 1, 7] -/\n#guard_msgs in\n#eval show MetaM (List Nat) from StateT.run' (y.toMLList'.takeAsList 23) []\n\n-- All ways to find `4 ∣ a ∣ b`, with `b = 32, ..., 1`.\n/-- info: ([(4, [16, 32]), (4, [8, 32]), (4, [12, 24]), (4, [8, 24]), (4, [8, 16])], [1]) -/\n#guard_msgs in\n#eval show MetaM (List (Nat × List Nat) × List Nat) from\n StateT.run (y.filter (· = 4)).toMLList.force []\n\n/-- info: [15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1] -/\n#guard_msgs in\n#eval (iotaM 15 : Nondet MetaM Nat).toList'\n\n-- Depth first search of the divisors of 255.\n/-- info: [255, 85, 17, 1, 5, 1, 1, 51, 17, 1, 3, 1, 1, 17, 1, 15, 5, 1, 3, 1, 1, 5, 1, 3, 1, 1] -/\n#guard_msgs in\n#eval (Nondet.iterate divisorsM 255 : Nondet Id Nat).toList'\n" }, { "path": "BatteriesTest/norm_cast.lean", "content": "\n/-!\n# Tests for norm_cast involving `Rat`.\n-/\n\nset_option linter.missingDocs false\n\n-- set_option trace.Meta.Tactic.simp true\n\nvariable (aq bq cq dq : Rat)\n\nexample : az = bz ↔ (az : Rat) = bz := by norm_cast\n\n-- zero and one cause special problems\nexample : aq < (1 : Nat) ↔ (aq : Rat) < (1 : Int) := by norm_cast\n\n--testing numerals\nexample : ((42 : Nat) : Rat) = 42 := by norm_cast\nexample : ((42 : Int) : Rat) = 42 := by norm_cast\n\n-- We don't yet have `{n m : Int} : (↑n : Rat) ≤ ↑m ↔ n ≤ m` in Batteries\n-- example (n : Int) (h : n + 1 > 0) : ((n + 1 : Int) : Rat) > 0 := by exact_mod_cast h\n" }, { "path": "BatteriesTest/omega/benchmark.lean", "content": "\n/-!\n# Benchmarking the `omega` tactic\n\nAs it's important that `omega` is fast, particularly when it has nothing to do,\nthis file maintains a benchmark suite for `omega`. It is particularly low-tech,\nand currently only reproducible on Kim Morrison's FRO machine;\nnevertheless it seems useful to keep the benchmark history in the repository.\n\nThe benchmark file consists of the test suite from `omega`'s initial release,\nwith one test removed (in which a test-for-failure succeeds with today's `omega`).\n\nThe benchmark consists of `lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"`\nrun on a freshly rebooted machine!\n\n2024-02-06 feat: omega uses Lean.HashMap instead of Std.Data.HashMap (#588)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.530 s ± 0.008 s [User: 2.249 s, System: 0.276 s]\n Range (min … max): 2.513 s … 2.542 s 10 runs\n\n2024-02-03 feat: omega handles min, max, if (#575)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.526 s ± 0.009 s [User: 2.250 s, System: 0.272 s]\n Range (min … max): 2.513 s … 2.542 s 10 runs\n\n2024-02-02 fix: revert OmegaM state when not multiplying out (#570)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.569 s ± 0.004 s [User: 2.291 s, System: 0.273 s]\n Range (min … max): 2.563 s … 2.574 s 10 runs\n\n2024-01-12 feat: omega handles double negation and implication hypotheses (#522)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.575 s ± 0.004 s [User: 2.302 s, System: 0.268 s]\n Range (min … max): 2.570 s … 2.581 s 10 runs\n\n2024-01-10 feat: omega understands Prod.Lex (#511)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.567 s ± 0.006 s [User: 2.295 s, System: 0.268 s]\n Range (min … max): 2.559 s … 2.576 s 10 runs\n\n2024-01-10 feat: omega handles iff and implications (#503)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.348 s ± 0.007 s [User: 2.060 s, System: 0.282 s]\n Range (min … max): 2.335 s … 2.356 s 10 runs\n\n2023-12-21 feat: omega (#463)\nkim@carica std4 % lake build && hyperfine \"lake env lean test/omega/benchmark.lean\"\nBenchmark 1: lake env lean test/omega/benchmark.lean\n Time (mean ± σ): 2.362 s ± 0.008 s [User: 2.080 s, System: 0.277 s]\n Range (min … max): 2.349 s … 2.372 s 10 runs\n\n-/\n\nexample : True := by\n fail_if_success omega\n trivial\n\n-- set_option trace.omega true\nexample (_ : (1 : Int) < (0 : Int)) : False := by omega\n\nexample (_ : (0 : Int) < (0 : Int)) : False := by omega\nexample (_ : (0 : Int) < (1 : Int)) : True := by (fail_if_success omega); trivial\n\nexample {x : Int} (_ : 0 ≤ x) (_ : x ≤ 1) : True := by (fail_if_success omega); trivial\nexample {x : Int} (_ : 0 ≤ x) (_ : x ≤ -1) : False := by omega\n\nexample {x : Int} (_ : x % 2 < x - 2 * (x / 2)) : False := by omega\nexample {x : Int} (_ : x % 2 > 5) : False := by omega\n\nexample {x : Int} (_ : 2 * (x / 2) > x) : False := by omega\nexample {x : Int} (_ : 2 * (x / 2) ≤ x - 2) : False := by omega\n\nexample {x : Nat} : x / 0 = 0 := by omega\nexample {x : Int} : x / 0 = 0 := by omega\n\nexample {x : Int} : x / 2 + x / (-2) = 0 := by omega\n\nexample (_ : 7 < 3) : False := by omega\nexample (_ : 0 < 0) : False := by omega\n\nexample {x : Nat} (_ : x > 7) (_ : x < 3) : False := by omega\nexample {x : Nat} (_ : x ≥ 7) (_ : x ≤ 3) : False := by omega\n\nexample {x y : Nat} (_ : x + y > 10) (_ : x < 5) (_ : y < 5) : False := by omega\n\nexample {x y : Int} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega\nexample {x y : Nat} (_ : x + y > 10) (_ : 2 * x < 11) (_ : y < 5) : False := by omega\n\nexample {x y : Int} (_ : 2 * x + 4 * y = 5) : False := by omega\nexample {x y : Nat} (_ : 2 * x + 4 * y = 5) : False := by omega\n\nexample {x y : Int} (_ : 6 * x + 7 * y = 5) : True := by (fail_if_success omega); trivial\n\nexample {x y : Nat} (_ : 6 * x + 7 * y = 5) : False := by omega\n\nexample {x : Nat} (_ : x < 0) : False := by omega\n\nexample {x y z : Int} (_ : x + y > z) (_ : x < 0) (_ : y < 0) (_ : z > 0) : False := by omega\n\nexample {x y : Nat} (_ : x - y = 0) (_ : x > y) : False := by\n fail_if_success omega (config := { splitNatSub := false })\n omega\n\nexample {x y z : Int} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega\n\nexample {x y z : Nat} (_ : x - y - z = 0) (_ : x > y + z) : False := by omega\n\nexample {a b c d e f : Nat} (_ : a - b - c - d - e - f = 0) (_ : a > b + c + d + e + f) :\n False := by\n omega\n\nexample {x y : Nat} (h₁ : x - y ≤ 0) (h₂ : y < x) : False := by omega\n\nexample {x y : Int} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega\n\nexample {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 6) : False := by omega\n\nexample {x y : Nat} (_ : x / 2 - y / 3 < 1) (_ : 3 * x ≥ 2 * y + 4) : False := by omega\n\nexample {x y : Nat} (_ : x / 2 - y / 3 < x % 2) (_ : 3 * x ≥ 2 * y + 4) : False := by omega\n\nexample {x : Int} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega\n\nexample {x : Nat} (h₁ : 5 ≤ x) (h₂ : x ≤ 4) : False := by omega\n\nexample {x : Nat} (h₁ : x / 3 ≥ 2) (h₂ : x < 6) : False := by omega\n\nexample {x : Int} {y : Nat} (_ : 0 < x) (_ : x + y ≤ 0) : False := by omega\n\nexample {a b c : Nat} (_ : a - (b - c) ≤ 5) (_ : b ≥ c + 3) (_ : a + c ≥ b + 6) : False := by omega\n\nexample {x : Nat} : 1 < (1 + ((x + 1 : Nat) : Int) + 2) / 2 := by omega\n\nexample {x : Nat} : (x + 4) / 2 ≤ x + 2 := by omega\n\nexample {x : Int} {m : Nat} (_ : 0 < m) (_ : ¬x % ↑m < (↑m + 1) / 2) : -↑m / 2 ≤ x % ↑m - ↑m := by\n omega\n\n\nexample (h : (7 : Int) = 0) : False := by omega\n\nexample (h : (7 : Int) ≤ 0) : False := by omega\n\nexample (h : (-7 : Int) + 14 = 0) : False := by omega\n\nexample (h : (-7 : Int) + 14 ≤ 0) : False := by omega\n\nexample (h : (1 : Int) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 = 0) : False := by\n omega\n\nexample (h : (7 : Int) - 14 = 0) : False := by omega\n\nexample (h : (14 : Int) - 7 ≤ 0) : False := by omega\n\nexample (h : (1 : Int) - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 - 1 + 1 = 0) : False := by\n omega\n\nexample (h : -(7 : Int) = 0) : False := by omega\n\nexample (h : -(-7 : Int) ≤ 0) : False := by omega\n\nexample (h : 2 * (7 : Int) = 0) : False := by omega\n\nexample (h : (7 : Int) < 0) : False := by omega\n\nexample {x : Int} (h : x + x + 1 = 0) : False := by omega\n\nexample {x : Int} (h : 2 * x + 1 = 0) : False := by omega\n\nexample {x y : Int} (h : x + x + y + y + 1 = 0) : False := by omega\n\nexample {x y : Int} (h : 2 * x + 2 * y + 1 = 0) : False := by omega\n\nexample {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 ≤ 3 - x) : False := by omega\n\nexample {x : Int} (h₁ : 0 ≤ -7 + x) (h₂ : 0 < 4 - x) : False := by omega\n\nexample {x : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : 2 * x + 1 ≤ 0) : False := by omega\n\nexample {x : Int} (h₁ : 0 < 2 * x + 2) (h₂ : 2 * x + 1 ≤ 0) : False := by omega\n\nexample {x y : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : 2 * y + 1 ≤ 0) : False := by omega\n\nexample {x y z : Int} (h₁ : 0 ≤ 2 * x + 1) (h₂ : x = y) (h₃ : y = z) (h₄ : 2 * z + 1 ≤ 0) :\n False := by omega\n\nexample {x1 x2 x3 x4 x5 x6 : Int} (h : 0 ≤ 2 * x1 + 1) (h : x1 = x2) (h : x2 = x3) (h : x3 = x4)\n (h : x4 = x5) (h : x5 = x6) (h : 2 * x6 + 1 ≤ 0) : False := by omega\n\nexample {x : Int} (_ : 1 ≤ -3 * x) (_ : 1 ≤ 2 * x) : False := by omega\n\nexample {x y : Int} (_ : 2 * x + 3 * y = 0) (_ : 1 ≤ x) (_ : 1 ≤ y) : False := by omega\n\nexample {x y z : Int} (_ : 2 * x + 3 * y = 0) (_ : 3 * y + 4 * z = 0) (_ : 1 ≤ x) (_ : 1 ≤ -z) :\n False := by omega\n\nexample {x y z : Int} (_ : 2 * x + 3 * y + 4 * z = 0) (_ : 1 ≤ x + y) (_ : 1 ≤ y + z)\n (_ : 1 ≤ x + z) : False := by omega\n\nexample {x y : Int} (_ : 1 ≤ 3 * x) (_ : y ≤ 2) (_ : 6 * x - 2 ≤ y) : False := by omega\n\nexample {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 1 ≤ x) : False := by\n omega\nexample {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x ≥ 1) : False := by\n omega\nexample {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : 0 < x) : False := by\n omega\nexample {x y : Int} (_ : y = x) (_ : 0 ≤ x - 2 * y) (_ : x - 2 * y ≤ 1) (_ : x > 0) : False := by\n omega\n\nexample {x : Nat} (_ : 10 ∣ x) (_ : ¬ 5 ∣ x) : False := by omega\nexample {x y : Nat} (_ : 5 ∣ x) (_ : ¬ 10 ∣ x) (_ : y = 7) (_ : x - y ≤ 2) (_ : x ≥ 6) : False := by\n omega\n\nexample (x : Nat) : x % 4 - x % 8 = 0 := by omega\n\nexample {n : Nat} (_ : n > 0) : (2*n - 1) % 2 = 1 := by omega\n\nexample (x : Int) (_ : x > 0 ∧ x < -1) : False := by omega\nexample (x : Int) (_ : x > 7) : x < 0 ∨ x > 3 := by omega\n\nexample (_ : ∃ n : Nat, n < 0) : False := by omega\nexample (_ : { x : Int // x < 0 ∧ x > 0 }) : False := by omega\nexample {x y : Int} (_ : x < y) (z : { z : Int // y ≤ z ∧ z ≤ x }) : False := by omega\n\nexample (a b c d e : Int)\n (ha : 2 * a + b + c + d + e = 4)\n (hb : a + 2 * b + c + d + e = 5)\n (hc : a + b + 2 * c + d + e = 6)\n (hd : a + b + c + 2 * d + e = 7)\n (he : a + b + c + d + 2 * e = 8) : e = 3 := by omega\n\nexample (a b c d e : Int)\n (ha : 2 * a + b + c + d + e = 4)\n (hb : a + 2 * b + c + d + e = 5)\n (hc : a + b + 2 * c + d + e = 6)\n (hd : a + b + c + 2 * d + e = 7)\n (he : a + b + c + d + 2 * e = 8 ∨ e = 3) : e = 3 := by\n fail_if_success omega (config := { splitDisjunctions := false })\n omega\n\nexample {a b : Int} (h : a < b) (w : b < a) : False := by omega\n\nexample (_e b c a v0 v1 : Int) (_h1 : v0 = 5 * a) (_h2 : v1 = 3 * b) (h3 : v0 + v1 + c = 10) :\n v0 + 5 + (v1 - 3) + (c - 2) = 10 := by omega\n\nexample (h : (1 : Int) < 0) (_ : ¬ (37 : Int) < 42) (_ : True) (_ : (-7 : Int) < 5) :\n (3 : Int) < 7 := by omega\n\nexample (A B : Int) (h : 0 < A * B) : 0 < 8 * (A * B) := by omega\n\nexample (A B : Nat) (h : 7 < A * B) : 0 < A*B/8 := by omega\nexample (A B : Int) (h : 7 < A * B) : 0 < A*B/8 := by omega\n\nexample (ε : Int) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε := by omega\n\nexample (x y z : Int) (h1 : 2*x < 3*y) (h2 : -4*x + z/2 < 0) (h3 : 12*y - z < 0) : False := by omega\n\nexample (ε : Int) (h1 : ε > 0) : ε / 2 < ε := by omega\n\nexample (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 := by omega\nexample (ε : Int) (_ : ε > 0) : ε / 3 + ε / 3 + ε / 3 ≤ ε := by omega\nexample (ε : Int) (_ : ε > 0) : ε - 2 ≤ ε / 3 + ε / 3 + ε / 3 ∧ ε / 3 + ε / 3 + ε / 3 ≤ ε := by\n omega\n\nexample (x : Int) (h : 0 < x) : 0 < x / 1 := by omega\n\nexample (x : Int) (h : 5 < x) : 0 < x/2/3 := by omega\n\nexample (_a b _c : Nat) (h2 : b + 2 > 3 + b) : False := by omega\nexample (_a b _c : Int) (h2 : b + 2 > 3 + b) : False := by omega\n\nexample (g v V c h : Int) (_ : h = 0) (_ : v = V) (_ : V > 0) (_ : g > 0)\n (_ : 0 ≤ c) (_ : c < 1) : v ≤ V := by omega\n\nexample (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (h3 : 12 * y - 4 * z < 0) :\n False := by\n omega\n\nexample (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5)\n (h3 : 12 * y - 4 * z < 0) : False := by omega\n\nexample (a b c : Int) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10) (h4 : a + b - c < 3) : False := by\n omega\n\nexample (_ b _ : Int) (h2 : b > 0) (h3 : ¬ b ≥ 0) : False := by\n omega\n\nexample (x y z : Int) (hx : x ≤ 3 * y) (h2 : y ≤ 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by\n omega\n\nexample (x y z : Int) (h1 : 2 * x < 3 * y) (h2 : -4 * x + 2 * z < 0) (_h3 : x * y < 5) :\n ¬ 12 * y - 4 * z < 0 := by\n omega\n\nexample (x y z : Int) (hx : ¬ x > 3 * y) (h2 : ¬ y > 2 * z) (h3 : x ≥ 6 * z) : x = 3 * y := by\n omega\n\nexample (x y : Int) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0)\n (h'' : (6 + 3 * y) * y ≥ 0) : False := by omega\n\nexample (a : Int) (ha : 0 ≤ a) : 0 * 0 ≤ 2 * a := by omega\n\nexample (x y : Int) (h : x < y) : x ≠ y := by omega\n\nexample (x y : Int) (h : x < y) : ¬ x = y := by omega\n\nexample (prime : Nat → Prop) (x y z : Int) (h1 : 2 * x + ((-3) * y) < 0) (h2 : (-4) * x + 2* z < 0)\n (h3 : 12 * y + (-4) * z < 0) (_ : prime 7) : False := by omega\n\nexample (i n : Nat) (h : (2 : Int) ^ i ≤ 2 ^ n) : (0 : Int) ≤ 2 ^ n - 2 ^ i := by omega\n\n-- Check we use `exfalso` on non-comparison goals.\nexample (prime : Nat → Prop) (_ b _ : Nat) (h2 : b > 0) (h3 : b < 0) : prime 10 := by\n omega\n\nexample (a b c : Nat) (h2 : (2 : Nat) > 3) : a + b - c ≥ 3 := by omega\n\n-- Verify that we split conjunctions in hypotheses.\nexample (x y : Int)\n (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3 ∧ (x + 4) * x ≥ 0 ∧ (6 + 3 * y) * y ≥ 0) :\n False := by omega\n\nexample (mess : Nat → Nat) (S n : Nat) :\n mess S + (n * mess S + n * 2 + 1) < n * mess S + mess S + (n * 2 + 2) := by omega\n\nexample (p n p' n' : Nat) (h : p + n' = p' + n) : n + p' = n' + p := by\n omega\n\nexample (a b c : Int) (h1 : 32 / a < b) (h2 : b < c) : 32 / a < c := by omega\n" }, { "path": "BatteriesTest/on_goal.lean", "content": "import Batteries.Tactic.PermuteGoals\nimport Batteries.Tactic.Unreachable\n\nexample (p q r : Prop) : p → q → r → p ∧ q ∧ r := by\n intros\n constructor\n on_goal 2 =>\n guard_target = q ∧ r\n constructor\n assumption\n -- Note that we have not closed all the subgoals here.\n guard_target = p\n assumption\n guard_target = r\n assumption\n\nexample (p q r : Prop) : p → q → r → p ∧ q ∧ r := by\n intros a b c\n constructor\n fail_if_success on_goal -3 => unreachable!\n fail_if_success on_goal -1 => exact a\n fail_if_success on_goal 0 => unreachable!\n fail_if_success on_goal 2 => exact a\n fail_if_success on_goal 3 => unreachable!\n on_goal 1 => exact a\n constructor\n swap\n exact c\n exact b\n\nexample (p q : Prop) : p → q → p ∧ q := by\n intros a b\n constructor\n fail_if_success pick_goal -3\n fail_if_success pick_goal 0\n fail_if_success pick_goal 3\n pick_goal -1\n exact b\n exact a\n\nexample (p : Prop) : p → p := by\n intros\n fail_if_success swap -- can't swap with a single goal\n assumption\n" }, { "path": "BatteriesTest/openPrivate.lean", "content": "import Batteries.Tactic.OpenPrivate\n\nimport BatteriesTest.OpenPrivateDefs\n\n\n\n/-- error: Unknown identifier `secretNumber` -/\n#guard_msgs in\n#eval secretNumber\n\n\n-- It works with one space between the tokens\n/-- info: 2 -/\n#guard_msgs in\nopen private secretNumber from BatteriesTest.OpenPrivateDefs in\n#eval secretNumber\n\n\n-- It also works with other kinds of whitespace between the tokens\n\n/-- info: 2 -/\n#guard_msgs in\nopen private secretNumber from BatteriesTest.OpenPrivateDefs in\n#eval secretNumber\n\n\n/-- info: 2 -/\n#guard_msgs in\nopen\n private secretNumber from BatteriesTest.OpenPrivateDefs in\n#eval secretNumber\n\n/-- info: 2 -/\n#guard_msgs in\nopen /- Being sneaky! -/ private secretNumber from BatteriesTest.OpenPrivateDefs in\n#eval secretNumber\n\n/--\ninfo: @[defeq] private theorem secretNumber.eq_def : secretNumber✝ = 2 :=\nEq.refl secretNumber✝\n-/\n#guard_msgs in\nopen private secretNumber.eq_def from BatteriesTest.OpenPrivateDefs in\n#print secretNumber.eq_def\n" }, { "path": "BatteriesTest/print_opaques.lean", "content": "import Batteries.Tactic.PrintOpaques\n\npartial def foo : Unit → Nat := foo\ndef bar : Unit → Nat := foo\n\n/--\ninfo: 'bar' depends on opaque or partial definitions: [foo]\n-/\n#guard_msgs in\n#print opaques bar\n\nopaque qux : Nat\ndef quux : Bool := qux == 0\n\n/--\ninfo: 'quux' depends on opaque or partial definitions: [qux]\n-/\n#guard_msgs in\n#print opaques quux\n\n/-! Examples from the documentation. -/\n\n/--\ninfo: 'Classical.choice' depends on opaque or partial definitions: [Classical.choice]\n-/\n#guard_msgs in\n#print opaques Classical.choice\n\n/--\ninfo: 'Classical.axiomOfChoice' does not use any opaque or partial definitions\n-/\n#guard_msgs in\n#print opaques Classical.axiomOfChoice\n\n/--\ninfo: 'Std.HashMap.insert' depends on opaque or partial definitions: [System.Platform.getNumBits]\n-/\n#guard_msgs in\n#print opaques Std.HashMap.insert\n\n/--\ninfo: 'Std.Stream.forIn' depends on opaque or partial definitions: [_private.Init.Data.Stream.0.Std.Stream.forIn.visit]\n-/\n#guard_msgs in\n#print opaques Std.Stream.forIn\n" }, { "path": "BatteriesTest/print_prefix.lean", "content": "import Batteries.Tactic.PrintPrefix\n\ninductive TEmpty : Type\n/--\ninfo: TEmpty : Type\nTEmpty.casesOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t\nTEmpty.ctorIdx : TEmpty → Nat\nTEmpty.noConfusion.{u} {P : Sort u} {t t' : TEmpty} (eq : t = t') : TEmpty.noConfusionType P t t'\nTEmpty.noConfusionType.{u} (P : Sort u) (t t' : TEmpty) : Sort u\nTEmpty.rec.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t\nTEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t\n-/\n#guard_msgs in\n#print prefix TEmpty -- Test type that probably won't change much.\n\n/-- info: -/\n#guard_msgs in\n#print prefix -imported Empty\n\nnamespace EmptyPrefixTest\n\nend EmptyPrefixTest\n\n-- Note. This error message could be cleaned up, but left during migration from Mathlib\n/--\nerror: Unknown constant `EmptyPrefixTest`\n-/\n#guard_msgs in\n#print prefix EmptyPrefixTest\n\nnamespace Prefix.Test\n\n/-- Supress lint -/\ndef foo (_l:List String) : Int := 0\n\nend Prefix.Test\n\n/-- info: Prefix.Test.foo (_l : List String) : Int -/\n#guard_msgs in\n#print prefix Prefix.Test\n\n/-- Supress lint -/\nstructure TestStruct where\n /-- Supress lint -/\n foo : Int\n /-- Supress lint -/\n bar : Int\n\n/--\ninfo: TestStruct : Type\nTestStruct.bar (self : TestStruct) : Int\nTestStruct.casesOn.{u} {motive : TestStruct → Sort u} (t : TestStruct)\n (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t\nTestStruct.ctorIdx : TestStruct → Nat\nTestStruct.foo (self : TestStruct) : Int\nTestStruct.mk (foo bar : Int) : TestStruct\nTestStruct.mk.inj {foo bar foo✝ bar✝ : Int} :\n { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝\nTestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) :\n ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝)\nTestStruct.mk.noConfusion.{u} {P : Sort u} {foo bar foo' bar' : Int}\n (eq : { foo := foo, bar := bar } = { foo := foo', bar := bar' }) (k : foo = foo' → bar = bar' → P) : P\nTestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar\nTestStruct.noConfusion.{u} {P : Sort u} {t t' : TestStruct} (eq : t = t') : TestStruct.noConfusionType P t t'\nTestStruct.noConfusionType.{u} (P : Sort u) (t t' : TestStruct) : Sort u\nTestStruct.rec.{u} {motive : TestStruct → Sort u} (mk : (foo bar : Int) → motive { foo := foo, bar := bar })\n (t : TestStruct) : motive t\nTestStruct.recOn.{u} {motive : TestStruct → Sort u} (t : TestStruct)\n (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t\n-/\n#guard_msgs in\n#print prefix TestStruct\n\n/--\ninfo: TestStruct : Type\nTestStruct.bar (self : TestStruct) : Int\nTestStruct.casesOn.{u} {motive : TestStruct → Sort u} (t : TestStruct)\n (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t\nTestStruct.ctorIdx : TestStruct → Nat\nTestStruct.foo (self : TestStruct) : Int\nTestStruct.mk (foo bar : Int) : TestStruct\nTestStruct.mk.noConfusion.{u} {P : Sort u} {foo bar foo' bar' : Int}\n (eq : { foo := foo, bar := bar } = { foo := foo', bar := bar' }) (k : foo = foo' → bar = bar' → P) : P\nTestStruct.noConfusion.{u} {P : Sort u} {t t' : TestStruct} (eq : t = t') : TestStruct.noConfusionType P t t'\nTestStruct.noConfusionType.{u} (P : Sort u) (t t' : TestStruct) : Sort u\nTestStruct.rec.{u} {motive : TestStruct → Sort u} (mk : (foo bar : Int) → motive { foo := foo, bar := bar })\n (t : TestStruct) : motive t\nTestStruct.recOn.{u} {motive : TestStruct → Sort u} (t : TestStruct)\n (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t\n-/\n#guard_msgs in\n#print prefix -propositions TestStruct\n\n/--\ninfo: TestStruct.mk.inj {foo bar foo✝ bar✝ : Int} :\n { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝\nTestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) :\n ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝)\nTestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar\n-/\n#guard_msgs in\n#print prefix +propositionsOnly TestStruct\n\n/--\ninfo: TestStruct\nTestStruct.bar\nTestStruct.casesOn\nTestStruct.ctorIdx\nTestStruct.foo\nTestStruct.mk\nTestStruct.mk.inj\nTestStruct.mk.injEq\nTestStruct.mk.noConfusion\nTestStruct.mk.sizeOf_spec\nTestStruct.noConfusion\nTestStruct.noConfusionType\nTestStruct.rec\nTestStruct.recOn\n-/\n#guard_msgs in\n#print prefix -showTypes TestStruct\n\n/--\nArtificial test function to show #print prefix filters out internals\nincluding match_/proof_.\n\nNote. Internal names are inherently subject to change. This test case may\nfail regularly when the Lean version is changed. If so, we should disable\nthe test case using this function below until a more robust solution is found.\n-/\ndef testMatchProof : (n : Nat) → Fin n → Unit\n | _, ⟨0, _⟩ => ()\n | Nat.succ as, ⟨Nat.succ i, h⟩ => testMatchProof as ⟨i, Nat.le_of_succ_le_succ h⟩\n\n/-- info: testMatchProof (n : Nat) : Fin n → Unit -/\n#guard_msgs in\n#print prefix testMatchProof\n\n/--\ninfo: testMatchProof (n : Nat) : Fin n → Unit\ntestMatchProof._f (x✝ : Nat) (f : Nat.below (motive := fun x => Fin x → Unit) x✝) : Fin x✝ → Unit\ntestMatchProof._proof_1 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as\ntestMatchProof._sunfold (n : Nat) : Fin n → Unit\ntestMatchProof._unsafe_rec (n : Nat) : Fin n → Unit\ntestMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) (x✝ : Nat) (x✝¹ : Fin x✝)\n (h_1 : (n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩)\n (h_2 : (as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) : motive x✝ x✝¹\n-/\n#guard_msgs in\n#print prefix +internals testMatchProof\n\nprivate inductive TestInd where\n| foo : TestInd\n| bar : TestInd\n\n/--\ninfo: TestInd : Type\nTestInd.bar : TestInd\nTestInd.bar.elim.{u} {motive : TestInd → Sort u} (t : TestInd) (h : t.ctorIdx = 1) (bar : motive TestInd.bar) : motive t\nTestInd.bar.sizeOf_spec : sizeOf TestInd.bar = 1\nTestInd.casesOn.{u} {motive : TestInd → Sort u} (t : TestInd) (foo : motive TestInd.foo) (bar : motive TestInd.bar) :\n motive t\nTestInd.ctorElim.{u} {motive : TestInd → Sort u} (ctorIdx : Nat) (t : TestInd) (h : ctorIdx = t.ctorIdx)\n (k : TestInd.ctorElimType ctorIdx) : motive t\nTestInd.ctorElimType.{u} {motive : TestInd → Sort u} (ctorIdx : Nat) : Sort (max 1 u)\nTestInd.ctorIdx : TestInd → Nat\nTestInd.foo : TestInd\nTestInd.foo.elim.{u} {motive : TestInd → Sort u} (t : TestInd) (h : t.ctorIdx = 0) (foo : motive TestInd.foo) : motive t\nTestInd.foo.sizeOf_spec : sizeOf TestInd.foo = 1\nTestInd.noConfusion.{v✝} {P : Sort v✝} {x y : TestInd} (h : x = y) : TestInd.noConfusionType P x y\nTestInd.noConfusionType.{v✝} (P : Sort v✝) (x y : TestInd) : Sort v✝\nTestInd.rec.{u} {motive : TestInd → Sort u} (foo : motive TestInd.foo) (bar : motive TestInd.bar) (t : TestInd) :\n motive t\nTestInd.recOn.{u} {motive : TestInd → Sort u} (t : TestInd) (foo : motive TestInd.foo) (bar : motive TestInd.bar) :\n motive t\nTestInd.toCtorIdx : TestInd → Nat\n-/\n#guard_msgs in\n#print prefix TestInd\n\n-- `#print prefix` does nothing if no identifier is provided\n#guard_msgs in\n#print prefix\n" }, { "path": "BatteriesTest/proof_wanted.lean", "content": "import Batteries.Util.ProofWanted\n\n/-!\nNo unused variable warnings.\n-/\n#guard_msgs in proof_wanted foo (x : Nat) : True\n\n/-!\nWhen not a proposition, rely on `theorem` command failing.\n-/\n/--\nerror: type of theorem `foo` is not a proposition\n Nat → Nat\n-/\n#guard_msgs in proof_wanted foo (x : Nat) : Nat\n" }, { "path": "BatteriesTest/register_label_attr.lean", "content": "import BatteriesTest.Internal.DummyLabelAttr\nimport Lean.LabelAttribute\n\nset_option linter.missingDocs false\n\nopen Lean\n\ndef f := 0\n\n/-- info: #[] -/ #guard_msgs in #eval labelled `dummy_label_attr\n\nattribute [dummy_label_attr] f\n\n/-- info: #[`f] -/ #guard_msgs in #eval labelled `dummy_label_attr\n\nsection\n\nattribute [-dummy_label_attr] f\n\n/-- info: #[] -/ #guard_msgs in #eval labelled `dummy_label_attr\n\nend\n\n/-- info: #[`f] -/ #guard_msgs in #eval labelled `dummy_label_attr\n\n-- Adding the label again is a no-op\nattribute [dummy_label_attr] f\n\n/-- info: #[`f] -/ #guard_msgs in #eval labelled `dummy_label_attr\n" }, { "path": "BatteriesTest/rfl.lean", "content": "import Lean.Elab.Tactic.Rfl\n-- Adaptation note: we should be able to remove this import after nightly-2024-03-19\n\nset_option linter.missingDocs false\n\nexample (a : Nat) : a = a := rfl\n\nexample (a : Nat) : a = a := by rfl\n\nopen Setoid\n\nuniverse u\nvariable {α : Sort u} [Setoid α]\n\n@[refl] def iseqv_refl (a : α) : a ≈ a :=\n iseqv.refl a\n\nexample (a : α) : a ≈ a := by rfl\n\nexample (a : Nat) : a ≤ a := by (fail_if_success rfl); apply Nat.le_refl\n\nattribute [refl] Nat.le_refl\n\nexample (a : Nat) : a ≤ a := by rfl\n\nstructure Foo\n\ndef Foo.le (_ _ : Foo) := Unit → True\ninstance : LE Foo := ⟨Foo.le⟩\n\n@[refl] theorem Foo.le_refl (a : Foo) : a ≤ a := fun _ => trivial\n\nexample (a : Foo) : a ≤ a := by apply Foo.le_refl\nexample (a : Foo) : a ≤ a := by rfl\n\nexample (x : Nat) : x ≤ x := by\n show _\n rfl\n" }, { "path": "BatteriesTest/satisfying.lean", "content": "import Batteries.Lean.SatisfiesM\nimport Batteries.Data.Array.Monadic\n\nopen Lean Meta Array Elab Term Tactic Command\n\n-- Note: as of nightly-2025-10-23, after https://github.com/leanprover/lean4/pull/10625\n-- the `MonadSatisfying` instances for the core monad stack need to be re-implemented.\n-- See `Batteries.Lean.LawfulMonad` first.\n\n-- example (xs : Array Expr) : MetaM { ts : Array Expr // ts.size = xs.size } := do\n-- let r ← satisfying (xs.size_mapM inferType)\n-- return r\n" }, { "path": "BatteriesTest/seq_focus.lean", "content": "import Batteries.Tactic.SeqFocus\n\nexample : (True ∧ (∃ x : Nat, x = x)) ∧ True := by\n constructor\n constructor\n -- error: too many tactics\n fail_if_success map_tacs [trivial; exact ⟨0, rfl⟩; trivial; trivial]\n -- error: not enough tactics\n fail_if_success map_tacs [trivial; exact ⟨0, rfl⟩]\n map_tacs [trivial; exact ⟨0, rfl⟩; trivial]\n\nexample : ((True ∧ True) ∧ (∃ x : Nat, x = x)) ∧ (True ∧ (∃ x : Nat, x = x)) := by\n constructor\n constructor\n map_tacs [(constructor; trivial); exact ⟨0, rfl⟩; constructor]\n trivial\n trivial\n exact ⟨0, rfl⟩\n\nexample : (True ∧ (∃ x : Nat, x = x)) ∧ True := by\n constructor\n -- error: not enough tactics\n fail_if_success constructor <;> [trivial]\n map_tacs [constructor <;> [trivial; exact ⟨0, rfl⟩]; constructor]\n" }, { "path": "BatteriesTest/show_term.lean", "content": "/-\nCopyright (c) 2021 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\n\n/--\ninfo: Try this:\n [apply] exact (n, 37)\n-/\n#guard_msgs in example (n : Nat) : Nat × Nat := by\n show_term\n constructor\n exact n\n exact 37\n\n/--\ninfo: Try this:\n [apply] refine (?_, ?_)\n-/\n#guard_msgs in example : Nat × Nat := by\n show_term constructor\n repeat exact 42\n\n/--\ninfo: Try this:\n [apply] fun {X} => X\n-/\n#guard_msgs in example : {_a : Nat} → Nat :=\n show_term by\n intro X\n exact X\n" }, { "path": "BatteriesTest/show_unused.lean", "content": "import Batteries.Tactic.ShowUnused\n\ndef foo := 1\ndef baz := 2\ndef bar := foo\n\n/--\nwarning: #show_unused (line 14) says:\nbaz is not used transitively by [bar]\n---\nwarning: unused definitions in this file:\nbaz\n-/\n#guard_msgs in #show_unused bar\n" }, { "path": "BatteriesTest/simp_trace.lean", "content": "import Batteries.Tactic.SqueezeScope\n\n-- undo changes to simp set after test was written\nattribute [-simp] Nat.add_left_cancel_iff Nat.add_right_cancel_iff\n\nset_option linter.missingDocs false\n\n/--\ninfo: Try this:\n [apply] simp only [Nat.add_comm]\n-/\n#guard_msgs in\nexample : x + 1 = 1 + x := by simp? [Nat.add_comm, Nat.mul_comm]\n/--\ninfo: Try this:\n [apply] dsimp only [Nat.reduceAdd]\n-/\n#guard_msgs in\nexample : 1 + 1 = 2 := by dsimp?\n\n-- Helper definitions for squeeze_scope tests\n@[simp] def bar (z : Nat) := 1 + z\n@[simp] def baz (z : Nat) := 1 + z\n\n@[simp] def foo : Nat → Nat → Nat\n | 0, z => bar z\n | _+1, z => baz z\n\n@[simp] def qux : Bool → Nat → Nat\n | true, z => bar z\n | false, z => baz z\n\ndef myId (x : Nat) := x\ndef myId2 (x : Nat) := x\n\ndef myPair : Bool → Nat → Nat\n | true, x => myId x\n | false, x => myId2 x\n\n-- Without squeeze_scope: multiple printouts\n/--\ninfo: Try this:\n [apply] simp only [foo, bar]\n---\ninfo: Try this:\n [apply] simp only [foo, baz]\n-/\n#guard_msgs in\nexample : foo x y = 1 + y := by\n cases x <;> simp? -- two printouts:\n -- \"Try this: simp only [foo, bar]\"\n -- \"Try this: simp only [foo, baz]\"\n\n-- With squeeze_scope: single aggregated printout\n/--\ninfo: Try this:\n [apply] simp only [foo, bar, baz]\n-/\n#guard_msgs in\nexample : foo x y = 1 + y := by\n squeeze_scope\n cases x <;> simp -- only one printout: \"Try this: simp only [foo, baz, bar]\"\n\n-- squeeze_scope works with simp?\n/--\ninfo: Try this:\n [apply] simp only [foo, bar, baz]\n-/\n#guard_msgs in\nexample : foo x y = 1 + y := by\n squeeze_scope\n cases x <;> simp?\n\n-- squeeze_scope works with simp_all?\n/--\ninfo: Try this:\n [apply] simp_all only [qux, baz, bar]\n-/\n#guard_msgs in\nexample : qux b y = 1 + y := by\n squeeze_scope\n cases b <;> simp_all?\n\n-- squeeze_scope works with dsimp?\n/--\ninfo: Try this:\n [apply] dsimp only [myPair, myId2, myId]\n-/\n#guard_msgs in\nexample : myPair b x = x := by\n squeeze_scope\n cases b <;> dsimp? [myPair, myId, myId2]\n" }, { "path": "BatteriesTest/simpa.lean", "content": "/-\nCopyright (c) 2022 Arthur Paulino. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Arthur Paulino, Gabriel Ebner\n-/\n\nset_option linter.missingDocs false\n\nexample {P : Prop} (p : P) : P := by simpa\n\nexample {P : Prop} (p : False) : P := by simp at p\n\ndef foo (n : α) := [n]\n\nsection unnecessarySimpa\n\n/--\nwarning: try 'simp' instead of 'simpa'\n\nNote: This linter can be disabled with `set_option linter.unnecessarySimpa false`\n-/\n#guard_msgs in\nexample : foo n = [n] := by\n simpa only [foo]\n\n/--\nwarning: Try `simp at h` instead of `simpa using h`\n\nNote: This linter can be disabled with `set_option linter.unnecessarySimpa false`\n-/\n#guard_msgs in\nexample (h : foo n ≠ [n]) : False := by\n simpa [foo] using h\n\nend unnecessarySimpa\n\nexample (p : Nat → Prop) (h : p (a + b)) : p (b + a) := by\n have : a + b = b + a := Nat.add_comm _ _\n simpa [this] using h\n\ndef Injective (f : α → β) : Prop := ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂\n\nnamespace div_left_inj_issue\n\nclass Inv (α : Type u) where\n inv : α → α\n\nclass Group (α) extends Mul α, Div α, Inv α\n\nvariable [Group G]\n\naxiom div_eq_mul_inv (a b : G) : a / b = a * Inv.inv b\n\naxiom mul_left_injective (a : G) : Injective (· * a)\n\ntheorem div_left_injective (b : G) : Injective fun a => a / b := by\n simpa only [div_eq_mul_inv] using fun a a' h => mul_left_injective (Inv.inv b) h\n\nend div_left_inj_issue\n\nnamespace Prod\n\ntheorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ a₁ = a₂ ∧ b₁ = b₂ :=\n Iff.of_eq (mk.injEq _ _ _ _)\n\ntheorem mk.inj_left {α β : Type _} (a : α) : Injective (Prod.mk a : β → α × β) := by\n intro b₁ b₂ h\n simpa only [true_and, Prod.mk.inj_iff, eq_self] using h\n\nend Prod\n\ntheorem implicit_lambda (h : ∀ {x : Nat}, a = x) : a = 2 := by\n simpa using h\n\ntheorem implicit_lambda2 (h : a = 2) : ∀ {_ : Nat}, a = 2 := by\n simpa using h\n\ntheorem no_implicit_lambda (h : ∀ {x : Nat}, a = x) : ∀ {x : Nat}, a = x := by\n simpa using @h\n\n#guard_msgs (drop warning) in\ntheorem thm : (a : Int) ≤ b - c ↔ a + b ≤ c := sorry\n\n#guard_msgs (drop warning) in\ntheorem thm2 : (b : Int) - c ≤ (a - b) - (a - c) := sorry\n\nexample : (b - c : Int) + (a - b) + a ≤ c := by\n simpa only [thm] using thm2\n\nexample : (b - c : Int) + (a - b) + a ≤ c := by\n simpa only [thm] using @thm2\n\nexample (P : Bool) (h : ¬ ¬ P) : P := by\n have : ¬ ¬ P := h\n simpa\n\n/--\ninfo: Try this:\n [apply] simpa only using h\n-/\n#guard_msgs in\nexample (p : Prop) (h : p) : p := by simpa? using h\n\n/--\ninfo: Try this:\n [apply] simpa only [and_true] using h\n-/\n#guard_msgs in\nexample (p : Prop) (h : p ∧ True) : p := by simpa? using h\n" }, { "path": "BatteriesTest/solve_by_elim.lean", "content": "/-\nCopyright (c) 2021 Kim Morrison. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Kim Morrison\n-/\nimport Batteries.Tactic.PermuteGoals\nimport BatteriesTest.Internal.DummyLabelAttr\nimport Lean.Meta.Tactic.Constructor\nimport Lean.Elab.SyntheticMVars\nimport Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig builtin\n\nset_option autoImplicit true\n\nopen Lean Elab Tactic in\n/--\n`fconstructor` is like `constructor`\n(it calls `apply` using the first matching constructor of an inductive datatype)\nexcept that it does not reorder goals.\n-/\nelab \"fconstructor\" : tactic => withMainContext do\n let mvarIds' ← (← getMainGoal).constructor {newGoals := .all}\n Term.synthesizeSyntheticMVarsNoPostponing\n replaceMainGoal mvarIds'\n\n-- Test that `solve_by_elim*`, which works on multiple goals,\n-- successfully uses the relevant local hypotheses for each goal.\nexample (f g : Nat → Prop) : (∃ k : Nat, f k) ∨ (∃ k : Nat, g k) ↔ ∃ k : Nat, f k ∨ g k := by\n fconstructor\n rintro (⟨n, fn⟩ | ⟨n, gn⟩)\n on_goal 3 => rintro ⟨n, hf | hg⟩\n solve_by_elim* (config := {maxDepth := 13}) [Or.inl, Or.inr, Exists.intro]\n\nsection «using»\n\n/-- -/\n@[dummy_label_attr] axiom foo : 1 = 2\n\nexample : 1 = 2 := by\n fail_if_success solve_by_elim\n solve_by_elim using dummy_label_attr\n\nend «using»\n\nsection issue1581\n\n/-- -/\naxiom mySorry {α} : α\n\n@[dummy_label_attr] theorem le_rfl [LE α] {b c : α} (_h : b = c) : b ≤ c := mySorry\n\nexample : 5 ≤ 7 := by\n apply_rules using dummy_label_attr\n guard_target = 5 = 7\n exact mySorry\n\nexample : 5 ≤ 7 := by\n apply_rules [le_rfl]\n guard_target = 5 = 7\n exact mySorry\n\nend issue1581\n" }, { "path": "BatteriesTest/trans.lean", "content": "import Batteries.Tactic.Trans\n\n-- testing that the attribute is recognized and used\ndef nleq (a b : Nat) : Prop := a ≤ b\n\n@[trans] def nleq_trans : nleq a b → nleq b c → nleq a c := Nat.le_trans\n\nexample (a b c : Nat) : nleq a b → nleq b c → nleq a c := by\n intro h₁ h₂\n trans b\n assumption\n assumption\n\nexample (a b c : Nat) : nleq a b → nleq b c → nleq a c := by intros; trans <;> assumption\n\n-- using `Trans` typeclass\n@[trans] def eq_trans {a b c : α} : a = b → b = c → a = c := by\n intro h₁ h₂\n apply Eq.trans h₁ h₂\n\nexample (a b c : Nat) : a = b → b = c → a = c := by intros; trans <;> assumption\n\nexample (a b c : Nat) : a = b → b = c → a = c := by\n intro h₁ h₂\n trans b\n assumption\n assumption\n\nexample : @Trans Nat Nat Nat (· ≤ ·) (· ≤ ·) (· ≤ ·) := inferInstance\n\nexample (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by\n intros h₁ h₂\n trans ?b\n case b => exact b\n exact h₁\n exact h₂\n\nexample (a b c : α) (R : α → α → Prop) [Trans R R R] : R a b → R b c → R a c := by\n intros h₁ h₂\n trans ?b\n case b => exact b\n exact h₁\n exact h₂\n\nexample (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by\n intros h₁ h₂\n trans\n exact h₁\n exact h₂\n\nexample (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by intros; trans <;> assumption\n\nexample (a b c : Nat) : a < b → b < c → a < c := by\n intro h₁ h₂\n trans b\n assumption\n assumption\n\nexample (a b c : Nat) : a < b → b < c → a < c := by intros; trans <;> assumption\n\nexample (x n p : Nat) (h₁ : n * Nat.succ p ≤ x) : n * p ≤ x := by\n trans\n · apply Nat.mul_le_mul_left; apply Nat.le_succ\n · apply h₁\n\nexample (a : α) (c : γ) : ∀ b : β, a ≍ b → b ≍ c → a ≍ c := by\n intro b h₁ h₂\n trans b\n assumption\n assumption\n\ndef MyLE (n m : Nat) := ∃ k, n + k = m\n\n@[trans] theorem MyLE.trans {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by\n cases h1\n cases h2\n subst_vars\n exact ⟨_, Eq.symm <| Nat.add_assoc _ _ _⟩\n\nexample {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by\n trans <;> assumption\n\n/-- `trans` for implications. -/\nexample {A B C : Prop} (h : A → B) (g : B → C) : A → C := by\n trans B\n · guard_target =ₛ A → B -- ensure we have `B` and not a free metavariable.\n exact h\n · guard_target =ₛ B → C\n exact g\n\n/-- `trans` for arrows between types. -/\nexample {A B C : Type} (h : A → B) (g : B → C) : A → C := by\n trans\n rotate_right\n · exact B\n · exact h\n · exact g\n\nuniverse u v w\n\n/-- `trans` for arrows between types. -/\nexample {A : Type u} {B : Type v} {C : Type w} (h : A → B) (g : B → C) : A → C := by\n trans\n rotate_right\n · exact B\n · exact h\n · exact g\n" }, { "path": "BatteriesTest/tryThis.lean", "content": "/-\nCopyright (c) 2023 Thomas Murrills. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Thomas Murrills\n-/\nimport Lean.Meta.Tactic.TryThis\n\nopen Lean.Meta.Tactic.TryThis\n\n/-!\nThis test file demonstrates the `Try This:` widget and describes how certain examples should\nlook. Note that while the evaluations here shouldn't fail, they also aren't tests in the traditional\nsense—CI has no way of inspecting the HTML output, and therefore no way of checking that the\noutput is styled correctly.\n\nAll clickables should dim on mouseover without changing color drastically.\n\nBoth widgets should provide a (list of) `Try this: rfl` code actions.\n-/\n\n/-! # Setup -/\n\nopen Lean Meta Elab Term Expr\n/-- Add a suggestion. -/\nelab \"add_suggestion\" s:term : tactic => unsafe do\n addSuggestion (← getRef) (← evalTerm Suggestion (.const ``Suggestion []) s)\n\n/-- Add a suggestion with a header. -/\nelab \"add_suggestion\" s:term \"with_header\" h:str : tactic => unsafe do\n addSuggestion (← getRef) (← evalTerm Suggestion (.const ``Suggestion []) s)\n (header := h.getString)\n\n/-- Add a suggestion. -/\nelab \"add_suggestions\" s:term : tactic => unsafe do\n let s ← evalTerm (Array Suggestion) (.app (.const ``Array [.zero]) (.const ``Suggestion [])) s\n addSuggestions (← getRef) s\n\n/-- Add suggestions with a header. -/\nelab \"add_suggestions\" s:term \"with_header\" h:str : tactic => unsafe do\n let s ← evalTerm (Array Suggestion) (.app (.const ``Array [.zero]) (.const ``Suggestion [])) s\n addSuggestions (← getRef) s (header := h.getString)\n\n/-- Demo adding a suggestion. -/\nmacro \"#demo1\" s:term : command => `(example : True := by add_suggestion $s; trivial)\n\n/-- Demo adding a suggestion with a header. -/\nmacro \"#demo1\" s:term \"with_header\" h:str : command => `(example : True := by\n add_suggestion $s with_header $h; trivial)\n\n/-- Demo adding suggestions. -/\nmacro \"#demo\" s:term : command => `(example : True := by\n add_suggestions $s; trivial)\n\n/-- Demo adding suggestions with a header. -/\nmacro \"#demo\" s:term \"with_header\" h:str : command => `(example : True := by\n add_suggestions $s with_header $h; trivial)\n\n/-- A basic suggestion. -/\nprivate def s : Suggestion := Unhygienic.run `(tactic| rfl)\n\n/-! # Demos -/\n\n/--\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` with `rfl` in text-link color.\n#demo1 s\n\n/--\ninfo: Try these:\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n-/\n#guard_msgs in\n/-\n```\nTry these:\n• rfl\n• rfl\n• rfl\n• rfl\n```\nwith `rfl` in text-link color.\n-/\n#demo #[s,s,s,s]\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.value` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.value` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try these:\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n-/\n#guard_msgs in\n/-\n```\nTry these:\n• rfl -- red\n• rfl -- red-orange\n• rfl -- orange\n• rfl -- yellow\n• rfl -- yellow-green\n• rfl -- light green\n• rfl -- green\n```\n-/\n#demo #[0.0, 1/6, 2/6, 3/6, 4/6, 5/6, 1.0].map fun t => {s with style? := some <| .value t}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.error` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.error` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- error color, no squiggle\n#demo1 {s with style? := some <| .error (decorated := false)}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- gold color with warning squiggle\n#demo1 {s with style? := some .warning}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- gold color with no squiggle\n#demo1 {s with style? := some <| .warning (decorated := false)}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.success` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.success` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- Lean green\n#demo1 {s with style? := some .success}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.asHypothesis` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.asHypothesis` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- styled like a goal hypothesis\n#demo1 {s with style? := some .asHypothesis}\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.asInaccessible` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.asInaccessible` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n-- `Try this: rfl` -- styled like an inaccessible goal hypothesis\n#demo1 {s with style? := some .asInaccessible}\n\n/--\ninfo: Try this:\n [apply] Starfleet\n-/\n#guard_msgs in\n-- `Try this: Starfleet`\n#demo1 {s with preInfo? := \"Sta\", postInfo? := \"eet\"}\n\n/--\ninfo: Try this:\n [apply] a secret message\n-/\n#guard_msgs in\n-- `Try this: a secret message`\n#demo1 {s with messageData? := m!\"a secret message\"}\n\n/--\ninfo: Try these:\n [apply] a secret message\n [apply] another secret message\n-/\n#guard_msgs in\n/-\n```\nTry these:\n• a secret message\n• another secret message\n```\n-/\n#demo #[\n {s with messageData? := m!\"a secret message\"},\n {s with messageData? := m!\"another secret message\"}\n]\n\n/--\ninfo: Our only hope is ⏎\n [apply] rfl\n-/\n#guard_msgs in\n#demo1 s with_header \"Our only hope is \"\n\n/--\ninfo: We've got everything here! Such as:\n [apply] rfl\n [apply] rfl\n [apply] rfl\n [apply] rfl\n-/\n#guard_msgs in\n#demo #[s,s,s,s] with_header \"We've got everything here! Such as:\"\n\n/--\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.error` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.error` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.warning` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.success` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.success` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.value` has been deprecated: `SuggestionStyle` is not used anymore.\n---\nwarning: `Lean.Meta.Tactic.TryThis.SuggestionStyle.value` has been deprecated: `SuggestionStyle` is not used anymore.\n---\ninfo: Grab bag:\n [apply] This is not a tactic.\n [apply] This could be a tactic--but watch out!\n [apply] rfl. Finally, a tactic that just works.\n [apply] I'm just link-styled.\n [apply] On a scale of 0 to 1, I'd put this at 0.166667.\n-/\n#guard_msgs in\n#demo #[\n {s with\n suggestion := \"not a tactic\",\n preInfo? := \"This is \",\n postInfo? := \".\",\n style? := some .error},\n {s with\n suggestion := \"This\",\n postInfo? := \" could be a tactic--but watch out!\",\n style? := some .warning},\n {s with\n postInfo? := \". Finally, a tactic that just works.\",\n style? := some .success},\n {s with\n preInfo? := \"I'm just \"\n suggestion := \"link-styled\",\n postInfo? := \".\"},\n {s with\n preInfo? := \"On a scale of 0 to 1, I'd put \",\n suggestion := \"this\",\n postInfo? := \" at 0.166667.\",\n style? := some (.value (1/6))}\n] with_header \"Grab bag:\"\n\n/-- error: No suggestions available -/\n#guard_msgs in\n#demo #[]\n\n/- The messages and suggestion should still read `Try this: rfl`, but the text in the lightbulb\nmenu should read \"Consider rfl, please\" -/\n/--\ninfo: Try this:\n [apply] rfl\n-/\n#guard_msgs in\n#demo1 { s with toCodeActionTitle? := fun text => \"Consider \" ++ text ++ \", please\" }\n\n/-- Add suggestions with a default code action title prefix. -/\nelab \"add_suggestions\" s:term \"with_code_action_prefix\" h:str : tactic => unsafe do\n let s ← evalTerm (Array Suggestion) (.app (.const ``Array [.zero]) (.const ``Suggestion [])) s\n addSuggestions (← getRef) s (codeActionPrefix? := h.getString)\n\n/-- Demo adding suggestions with a header. -/\nmacro \"#demo\" s:term \"with_code_action_prefix\" h:str : command => `(example : True := by\n add_suggestions $s with_code_action_prefix $h; trivial)\n\n/- The messages and suggestions should still read `Try these: ...`, but the text in the lightbulb\nmenu should read \"Maybe use: rfl\"; \"Maybe use: rfl\"; \"Also consider rfl, please!\" -/\n/--\ninfo: Try these:\n [apply] rfl\n [apply] rfl\n [apply] rfl\n-/\n#guard_msgs in\n#demo #[\n s,\n s,\n { s with toCodeActionTitle? := fun text => \"Also consider \" ++ text ++ \", please!\" }\n] with_code_action_prefix \"Maybe use: \"\n" }, { "path": "BatteriesTest/vector.lean", "content": "import Batteries.Data.Vector\n\n/-! ### Testing decidable quantifiers for `Vector`. -/\n\nexample : ∃ v : Vector Bool 6, v.toList.count true = 3 := by decide\n\ninductive Gate : Nat → Type\n| const : Bool → Gate 0\n| if : ∀ {n}, Gate n → Gate n → Gate (n + 1)\n\nnamespace Gate\n\ndef and : Gate 2 := .if (.if (.const true) (.const false)) (.if (.const false) (.const false))\n\ndef eval (g : Gate n) (v : Vector Bool n) : Bool :=\n match g, v with\n | .const b, _ => b\n | .if g₁ g₂, v => if v.1.back! then eval g₁ v.pop else eval g₂ v.pop\n\nexample : ∀ v, and.eval v = (v[0] && v[1]) := by decide\nexample : ∃ v, and.eval v = false := by decide\n\nend Gate\n" }, { "path": "BatteriesTest/where.lean", "content": "-- None of these imports are really necessary, except to create namespace mentioned below.\nimport Lean.Elab.Term\nimport Lean.Elab.Command\nimport Batteries.Data.UnionFind.Basic\n\n-- Return to pristine state\nset_option linter.missingDocs false\nset_option internal.cmdlineSnapshots false\nset_option experimental.module false\nset_option Elab.inServer false\n\n/-- info: -- In root namespace with initial scope -/\n#guard_msgs in #where\n\nnoncomputable section\n/-- info: noncomputable section -/\n#guard_msgs in #where\nend\n\nnamespace WhereTest\nvariable (x : Nat) (α : Type)\n/--\ninfo: namespace WhereTest\n\nvariable (x : Nat) (α : Type)\n-/\n#guard_msgs in #where\n\nuniverse u v w\n\n/--\ninfo: namespace WhereTest\n\nuniverse u v w\n\nvariable (x : Nat) (α : Type)\n-/\n#guard_msgs in #where\n\nset_option pp.piBinderTypes false\n\n/--\ninfo: namespace WhereTest\n\nuniverse u v w\n\nvariable (x : Nat) (α : Type)\n\nset_option pp.piBinderTypes false\n-/\n#guard_msgs in #where\nend WhereTest\n\nopen Lean Meta\n\n/--\ninfo: open Lean Lean.Meta\n-/\n#guard_msgs in #where\n\nopen Elab hiding TermElabM\n\n/--\ninfo: open Lean Lean.Meta\nopen Lean.Elab hiding TermElabM\n-/\n#guard_msgs in #where\n\nopen Command Batteries\nopen Array renaming map -> listMap\n\n/--\ninfo: open Lean Lean.Meta\nopen Lean.Elab hiding TermElabM\nopen Lean.Elab.Command Batteries\nopen Array renaming map → listMap\n-/\n#guard_msgs in #where\n" }, { "path": "LICENSE", "content": " Apache License\n Version 2.0, January 2004\n http://www.apache.org/licenses/\n\n TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION\n\n 1. Definitions.\n\n \"License\" shall mean the terms and conditions for use, reproduction,\n and distribution as defined by Sections 1 through 9 of this document.\n\n \"Licensor\" shall mean the copyright owner or entity authorized by\n the copyright owner that is granting the License.\n\n \"Legal Entity\" shall mean the union of the acting entity and all\n other entities that control, are controlled by, or are under common\n control with that entity. For the purposes of this definition,\n \"control\" means (i) the power, direct or indirect, to cause the\n direction or management of such entity, whether by contract or\n otherwise, or (ii) ownership of fifty percent (50%) or more of the\n outstanding shares, or (iii) beneficial ownership of such entity.\n\n \"You\" (or \"Your\") shall mean an individual or Legal Entity\n exercising permissions granted by this License.\n\n \"Source\" form shall mean the preferred form for making modifications,\n including but not limited to software source code, documentation\n source, and configuration files.\n\n \"Object\" form shall mean any form resulting from mechanical\n transformation or translation of a Source form, including but\n not limited to compiled object code, generated documentation,\n and conversions to other media types.\n\n \"Work\" shall mean the work of authorship, whether in Source or\n Object form, made available under the License, as indicated by a\n copyright notice that is included in or attached to the work\n (an example is provided in the Appendix below).\n\n \"Derivative Works\" shall mean any work, whether in Source or Object\n form, that is based on (or derived from) the Work and for which the\n editorial revisions, annotations, elaborations, or other modifications\n represent, as a whole, an original work of authorship. For the purposes\n of this License, Derivative Works shall not include works that remain\n separable from, or merely link (or bind by name) to the interfaces of,\n the Work and Derivative Works thereof.\n\n \"Contribution\" shall mean any work of authorship, including\n the original version of the Work and any modifications or additions\n to that Work or Derivative Works thereof, that is intentionally\n submitted to Licensor for inclusion in the Work by the copyright owner\n or by an individual or Legal Entity authorized to submit on behalf of\n the copyright owner. For the purposes of this definition, \"submitted\"\n means any form of electronic, verbal, or written communication sent\n to the Licensor or its representatives, including but not limited to\n communication on electronic mailing lists, source code control systems,\n and issue tracking systems that are managed by, or on behalf of, the\n Licensor for the purpose of discussing and improving the Work, but\n excluding communication that is conspicuously marked or otherwise\n designated in writing by the copyright owner as \"Not a Contribution.\"\n\n \"Contributor\" shall mean Licensor and any individual or Legal Entity\n on behalf of whom a Contribution has been received by Licensor and\n subsequently incorporated within the Work.\n\n 2. Grant of Copyright License. Subject to the terms and conditions of\n this License, each Contributor hereby grants to You a perpetual,\n worldwide, non-exclusive, no-charge, royalty-free, irrevocable\n copyright license to reproduce, prepare Derivative Works of,\n publicly display, publicly perform, sublicense, and distribute the\n Work and such Derivative Works in Source or Object form.\n\n 3. Grant of Patent License. Subject to the terms and conditions of\n this License, each Contributor hereby grants to You a perpetual,\n worldwide, non-exclusive, no-charge, royalty-free, irrevocable\n (except as stated in this section) patent license to make, have made,\n use, offer to sell, sell, import, and otherwise transfer the Work,\n where such license applies only to those patent claims licensable\n by such Contributor that are necessarily infringed by their\n Contribution(s) alone or by combination of their Contribution(s)\n with the Work to which such Contribution(s) was submitted. If You\n institute patent litigation against any entity (including a\n cross-claim or counterclaim in a lawsuit) alleging that the Work\n or a Contribution incorporated within the Work constitutes direct\n or contributory patent infringement, then any patent licenses\n granted to You under this License for that Work shall terminate\n as of the date such litigation is filed.\n\n 4. Redistribution. You may reproduce and distribute copies of the\n Work or Derivative Works thereof in any medium, with or without\n modifications, and in Source or Object form, provided that You\n meet the following conditions:\n\n (a) You must give any other recipients of the Work or\n Derivative Works a copy of this License; and\n\n (b) You must cause any modified files to carry prominent notices\n stating that You changed the files; and\n\n (c) You must retain, in the Source form of any Derivative Works\n that You distribute, all copyright, patent, trademark, and\n attribution notices from the Source form of the Work,\n excluding those notices that do not pertain to any part of\n the Derivative Works; and\n\n (d) If the Work includes a \"NOTICE\" text file as part of its\n distribution, then any Derivative Works that You distribute must\n include a readable copy of the attribution notices contained\n within such NOTICE file, excluding those notices that do not\n pertain to any part of the Derivative Works, in at least one\n of the following places: within a NOTICE text file distributed\n as part of the Derivative Works; within the Source form or\n documentation, if provided along with the Derivative Works; or,\n within a display generated by the Derivative Works, if and\n wherever such third-party notices normally appear. The contents\n of the NOTICE file are for informational purposes only and\n do not modify the License. You may add Your own attribution\n notices within Derivative Works that You distribute, alongside\n or as an addendum to the NOTICE text from the Work, provided\n that such additional attribution notices cannot be construed\n as modifying the License.\n\n You may add Your own copyright statement to Your modifications and\n may provide additional or different license terms and conditions\n for use, reproduction, or distribution of Your modifications, or\n for any such Derivative Works as a whole, provided Your use,\n reproduction, and distribution of the Work otherwise complies with\n the conditions stated in this License.\n\n 5. Submission of Contributions. Unless You explicitly state otherwise,\n any Contribution intentionally submitted for inclusion in the Work\n by You to the Licensor shall be under the terms and conditions of\n this License, without any additional terms or conditions.\n Notwithstanding the above, nothing herein shall supersede or modify\n the terms of any separate license agreement you may have executed\n with Licensor regarding such Contributions.\n\n 6. Trademarks. This License does not grant permission to use the trade\n names, trademarks, service marks, or product names of the Licensor,\n except as required for reasonable and customary use in describing the\n origin of the Work and reproducing the content of the NOTICE file.\n\n 7. Disclaimer of Warranty. Unless required by applicable law or\n agreed to in writing, Licensor provides the Work (and each\n Contributor provides its Contributions) on an \"AS IS\" BASIS,\n WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or\n implied, including, without limitation, any warranties or conditions\n of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A\n PARTICULAR PURPOSE. You are solely responsible for determining the\n appropriateness of using or redistributing the Work and assume any\n risks associated with Your exercise of permissions under this License.\n\n 8. Limitation of Liability. In no event and under no legal theory,\n whether in tort (including negligence), contract, or otherwise,\n unless required by applicable law (such as deliberate and grossly\n negligent acts) or agreed to in writing, shall any Contributor be\n liable to You for damages, including any direct, indirect, special,\n incidental, or consequential damages of any character arising as a\n result of this License or out of the use or inability to use the\n Work (including but not limited to damages for loss of goodwill,\n work stoppage, computer failure or malfunction, or any and all\n other commercial damages or losses), even if such Contributor\n has been advised of the possibility of such damages.\n\n 9. Accepting Warranty or Additional Liability. While redistributing\n the Work or Derivative Works thereof, You may choose to offer,\n and charge a fee for, acceptance of support, warranty, indemnity,\n or other liability obligations and/or rights consistent with this\n License. However, in accepting such obligations, You may act only\n on Your own behalf and on Your sole responsibility, not on behalf\n of any other Contributor, and only if You agree to indemnify,\n defend, and hold each Contributor harmless for any liability\n incurred by, or claims asserted against, such Contributor by reason\n of your accepting any such warranty or additional liability.\n\n END OF TERMS AND CONDITIONS\n\n APPENDIX: How to apply the Apache License to your work.\n\n To apply the Apache License to your work, attach the following\n boilerplate notice, with the fields enclosed by brackets \"[]\"\n replaced with your own identifying information. (Don't include\n the brackets!) The text should be enclosed in the appropriate\n comment syntax for the file format. We also recommend that a\n file or class name and description of purpose be included on the\n same \"printed page\" as the copyright notice for easier\n identification within third-party archives.\n\n Copyright [yyyy] [name of copyright owner]\n\n Licensed under the Apache License, Version 2.0 (the \"License\");\n you may not use this file except in compliance with the License.\n You may obtain a copy of the License at\n\n http://www.apache.org/licenses/LICENSE-2.0\n\n Unless required by applicable law or agreed to in writing, software\n distributed under the License is distributed on an \"AS IS\" BASIS,\n WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.\n See the License for the specific language governing permissions and\n limitations under the License.\n" }, { "path": "README.md", "content": "# Batteries\n\nThe \"batteries included\" extended library for Lean 4. This is a collection of data structures and tactics intended for use by both computer-science applications and mathematics applications of Lean 4.\n\n# Using `batteries`\n\nTo use `batteries` in your project, add the following to your `lakefile.lean`:\n```lean\nrequire \"leanprover-community\" / \"batteries\" @ git \"main\"\n```\nOr add the following to your `lakefile.toml`:\n```toml\n[[require]]\nname = \"batteries\"\nscope = \"leanprover-community\"\nrev = \"main\"\n```\n\nAdditionally, please make sure that you're using the version of Lean that the current version of `batteries` expects. The easiest way to do this is to copy the [`lean-toolchain`](./lean-toolchain) file from this repository to your project. Once you've added the dependency declaration, the command `lake update` checks out the current version of `batteries` and writes it the Lake manifest file. Don't run this command again unless you're prepared to potentially also update your Lean compiler version, as it will retrieve the latest version of dependencies and add them to the manifest.\n\n# Build instructions\n\n* Get the newest version of `elan`. If you already have installed a version of Lean, you can run\n ```sh\n elan self update\n ```\n If the above command fails, or if you need to install `elan`, run\n ```sh\n curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh\n ```\n If this also fails, follow the instructions under `Regular install` [here](https://leanprover-community.github.io/get_started.html).\n* To build `batteries` run `lake build`.\n* To build and run all tests, run `lake test`.\n* To run the environment linter, run `lake lint`.\n* If you added a new file, run the command `scripts/updateBatteries.sh` to update the imports.\n\n# Documentation\n\nYou can generate `batteries` documentation with\n\n```sh\ncd docs\nlake build Batteries:docs\n```\n\nThe top-level HTML file will be located at `docs/doc/index.html`, though to actually expose the\ndocumentation you need to run an HTTP server (e.g. `python3 -m http.server`) in the `docs/doc` directory.\n\nNote that documentation for the latest nightly of `batteries` is also available as part of [the Mathlib 4\ndocumentation][mathlib4 docs].\n\n[mathlib4 docs]: https://leanprover-community.github.io/mathlib4_docs/Batteries.html\n\n# Contributing\n\nThe first step to contribute is to create a fork of Batteries.\nThen add your contributions to a branch of your fork and make a PR to Batteries.\nDo not make your changes to the main branch of your fork, that may lead to complications on your end.\n\nEvery pull request should have exactly one of the status labels `awaiting-review`, `awaiting-author`\nor `WIP` (in progress).\nTo change the status label of a pull request, add a comment containing one of these options and\n_nothing else_.\nThis will remove the previous label and replace it by the requested status label.\nThese labels are used for triage.\n\nOne of the easiest ways to contribute is to find a missing proof and complete it. The\n[`proof_wanted`](https://github.com/search?q=repo%3Aleanprover-community%2Fbatteries+language%3ALean+%2F^proof_wanted%2F&type=code)\ndeclaration documents statements that have been identified as being useful, but that have not yet\nbeen proven.\n\n### Mathlib Adaptations\n\nBatteries PRs often affect Mathlib, a key component of the Lean ecosystem.\nWhen Batteries changes in a significant way, Mathlib must adapt promptly.\nWhen necessary, Batteries contributors are expected to either create an adaptation PR on Mathlib, or ask for assistance for and to collaborate with this necessary process.\n\nEvery Batteries PR has an automatically created [Mathlib Nightly Testing](https://github.com/leanprover-community/mathlib4-nightly-testing/) branch called `batteries-pr-testing-N` where `N` is the number of the Batteries PR.\nThis is a clone of Mathlib where the Batteries requirement points to the Batteries PR branch instead of the main branch.\nBatteries uses this branch to check whether the Batteries PR needs Mathlib adaptations.\nA tag `builds-mathlib` will be issued when this branch needs no adaptation; a tag `breaks-mathlib` will be issued when the branch does need an adaptation.\n\nThe first step in creating an adaptation PR is to switch to the `batteries-pr-testing-N` branch and push changes to that branch until the Mathlib CI process works.\nYou may need to ask for write access to [Mathlib Nightly Testing](https://github.com/leanprover-community/mathlib4-nightly-testing/) to do that.\nChanges to the Batteries PR will be integrated automatically as you work on this process.\nDo not redirect the Batteries requirement to main until the Batteries PR is merged.\nPlease ask questions to Batteries and Mathlib maintainers if you run into issues with this process.\n\nWhen everything works, create an adaptation PR on Mathlib from the `batteries-pr-testing-N` branch.\nYou may need to ping a Mathlib maintainer to review the PR, ask if you don't know who to ping.\nOnce the Mathlib adaptation PR and the original Batteries PR have been reviewed and accepted, the Batteries PR will be merged first. Then, the Mathlib PR's lakefile needs to be repointed to the Batteries main branch: change the Batteries line to\n```lean\nrequire \"leanprover-community\" / \"batteries\" @ git \"main\"\n```\nOnce CI once again checks out on Mathlib, the adaptation PR can be merged using the regular Mathlib process.\n" }, { "path": "Shake/Main.lean", "content": "/-\nCopyright (c) 2023 Mario Carneiro. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Mario Carneiro\n-/\nimport Lake.CLI.Main\n\n/-! # `lake exe shake` command\n\nThis command will check the current project (or a specified target module) and all dependencies for\nunused imports. This works by looking at generated `.olean` files to deduce required imports and\nensuring that every import is used to contribute some constant. Because recompilation is not needed\nthis is quite fast (about 8 seconds to check `Mathlib` and all dependencies), but it has some known\nlimitations:\n\n* Tactics that are used during elaboration generally leave no trace in the proof term, so\n they will be incorrectly marked as unused.\n* Similarly, files that contribute only notations will not be detected.\n* Conversely, files that define tactics and notations are also likely to have false positives\n because the notation itself does not depend on the referenced constant (it elaborates to a\n name literal rather than an actual reference to the target constant).\n\nTo mitigate this, the `scripts/noshake.json` file is used to suppress known false positives. See\n`ShakeCfg` for information regarding the file format.\n\n-/\n\n/-- help string for the command line interface -/\ndef help : String := \"Lean project tree shaking tool\nUsage: lake exe shake [OPTIONS] ..\n\nArguments:\n \n A module path like `Mathlib`. All files transitively reachable from the\n provided module(s) will be checked.\n\nOptions:\n --force\n Skips the `lake build --no-build` sanity check\n\n --fix\n Apply the suggested fixes directly. Make sure you have a clean checkout\n before running this, so you can review the changes.\n\n --cfg (default: scripts/noshake.json)\n Use FILE to specify which imports we should ignore.\n\n --update\n Assume that all issues we find are false positives and update the config\n file to include them.\n\n --no-downstream\n Unless disabled, shake will check downstream files that were transitively\n depending on the import we want to remove and re-add the import to these\n downstream files.\n\n# The noshake.json file\n\nThe file passed in the --cfg argument is a JSON file with the following\nstructure:\n\n {\n \\\"ignoreAll\\\": [NAME],\n \\\"ignoreImport\\\": [NAME],\n \\\"ignore\\\": {NAME: [NAME]}\n }\n\nThe fields can be omitted if empty. They have the following interpretation:\n\n* ignoreAll:\n All imports in these files should be treated as necessary\n* ignore[X]:\n All imports in the list should be treated as necessary when processing X\n* ignoreImport:\n These files should be treated as necessary when imported into any other file.\n\"\n\nopen Lean\n\n/-- We use `Nat` as a bitset for doing efficient set operations.\nThe bit indexes will usually be a module index. -/\nabbrev Bitset := Nat\n\n/-- The main state of the checker, containing information on all loaded modules. -/\nstructure State where\n /-- Maps a module name to its index in the module list. -/\n toIdx : Std.HashMap Name USize := {}\n /-- Maps a module index to the module name. -/\n modNames : Array Name := #[]\n /-- Maps a module index to the module data. -/\n mods : Array ModuleData := #[]\n /-- `j ∈ deps[i]` if module `j` is a direct dependency of module `i` -/\n deps : Array (Array USize) := #[]\n /-- `j ∈ transDeps[i]` is the reflexive transitive closure of `deps` -/\n transDeps : Array Bitset := #[]\n /-- `j ∈ needs[i]` if module `i` uses a constant declared in module `j`.\n Note: this is left empty if `args.downstream` is false, we calculate `needs` on demand -/\n needs : Array Bitset := #[]\n /-- Maps a constant name to the module index containing it.\n A value of `none` means the constant was found in multiple modules,\n in which case we do not track it. -/\n constToIdx : Std.HashMap Name (Option USize) := {}\n\n/-- Returns `true` if this is a constant whose body should not be considered for dependency\ntracking purposes. -/\ndef isBlacklisted (name : Name) : Bool :=\n -- Compiler-produced definitions are skipped, because they can sometimes pick up spurious\n -- dependencies due to specializations in unrelated files. Even if we remove these modules\n -- from the import path, the compiler will still just find another way to compile the definition.\n if let .str _ \"_cstage2\" := name then true else\n if let .str _ \"_cstage1\" := name then true else\n false\n\n/-- Calculates the value of the `needs[i]` bitset for a given module `mod`.\nBit `j` is set in the result if some constant from module `j` is used in this module. -/\ndef calcNeeds (constToIdx : Std.HashMap Name (Option USize)) (mod : ModuleData) : Bitset :=\n mod.constants.foldl (init := 0) fun deps ci =>\n if isBlacklisted ci.name then deps else\n let deps := visitExpr ci.type deps\n match ci.value? with\n | some e => visitExpr e deps\n | none => deps\nwhere\n /-- Accumulate the results from expression `e` into `deps`. -/\n visitExpr e deps :=\n Lean.Expr.foldConsts e deps fun c deps => match constToIdx[c]? with\n | some (some i) => deps ||| (1 <<< i.toNat)\n | _ => deps\n\n/-- Calculates the same as `calcNeeds` but tracing each module to a specific constant. -/\ndef getExplanations (constToIdx : Std.HashMap Name (Option USize)) (mod : ModuleData) :\n Std.HashMap USize (Name × Name) :=\n mod.constants.foldl (init := {}) fun deps ci =>\n if isBlacklisted ci.name then deps else\n let deps := visitExpr ci.name ci.type deps\n match ci.value? with\n | some e => visitExpr ci.name e deps\n | none => deps\nwhere\n /-- Accumulate the results from expression `e` into `deps`. -/\n visitExpr name e deps :=\n Lean.Expr.foldConsts e deps fun c deps => match constToIdx[c]? with\n | some (some i) =>\n if\n if let some (name', _) := deps[i]? then\n decide (name.toString.length < name'.toString.length)\n else true\n then\n deps.insert i (name, c)\n else\n deps\n | _ => deps\n\n/-- Load all the modules in `imports` into the `State`, as well as their transitive dependencies.\nReturns a pair `(imps, transImps)` where:\n\n* `j ∈ imps` if `j` is one of the module indexes in `imports`\n* `j ∈ transImps` if module `j` is transitively reachable from `imports`\n-/\npartial def loadModules (imports : Array Import) : StateT State IO (Array USize × Bitset) := do\n let mut imps := #[]\n let mut transImps := 0\n for imp in imports do\n let s ← get\n if let some i := s.toIdx[imp.module]? then\n imps := imps.push i\n transImps := transImps ||| s.transDeps[i]!\n else\n let mFile ← findOLean imp.module\n unless (← mFile.pathExists) do\n throw <| IO.userError s!\"object file '{mFile}' of module {imp.module} does not exist\"\n let (mod, _) ← readModuleData mFile\n let (deps, transDeps) ← loadModules mod.imports\n let s ← get\n let n := s.mods.size.toUSize\n let transDeps := transDeps ||| (1 <<< n.toNat)\n imps := imps.push n\n transImps := transImps ||| transDeps\n set (σ := State) {\n toIdx := s.toIdx.insert imp.module n\n modNames := s.modNames.push imp.module\n mods := s.mods.push mod\n deps := s.deps.push deps\n transDeps := s.transDeps.push transDeps\n needs := s.needs\n constToIdx := mod.constNames.foldl (init := s.constToIdx) fun m a =>\n match m.getThenInsertIfNew? a n with\n | (some (some _), m) =>\n -- Note: If a constant is found in multiple modules, we assume it is an auto-generated\n -- definition which is created on demand, and therefore it is safe to ignore any\n -- dependencies via this definition because it will just be re-created in the current\n -- module if we don't import it.\n m.insert a none\n | (_, m) => m\n }\n return (imps, transImps)\n\n/-- The list of edits that will be applied in `--fix`. `edits[i] = (removed, added)` where:\n\n* If `j ∈ removed` then we want to delete module named `j` from the imports of `i`\n* If `j ∈ added` then we want to add module index `j` to the imports of `i`.\n We keep this as a bitset because we will do transitive reduction before applying it\n-/\nabbrev Edits := Std.HashMap Name (NameSet × Bitset)\n\n/-- Register that we want to remove `tgt` from the imports of `src`. -/\ndef Edits.remove (ed : Edits) (src tgt : Name) : Edits :=\n match ed.get? src with\n | none => ed.insert src (NameSet.insert ∅ tgt, 0)\n | some (a, b) => ed.insert src (a.insert tgt, b)\n\n/-- Register that we want to add `tgt` to the imports of `src`. -/\ndef Edits.add (ed : Edits) (src : Name) (tgt : Nat) : Edits :=\n match ed.get? src with\n | none => ed.insert src (∅, 1 <<< tgt)\n | some (a, b) => ed.insert src (a, b ||| (1 <<< tgt))\n\n/-- Parse a source file to extract the location of the import lines, for edits and error messages.\n\nReturns `(path, inputCtx, imports, endPos)` where `imports` is the `Lean.Parser.Module.import` list\nand `endPos` is the position of the end of the header.\n-/\ndef parseHeaderFromString (text path : String) :\n IO (System.FilePath × Parser.InputContext ×\n TSyntaxArray ``Parser.Module.import × String.Pos.Raw) := do\n let inputCtx := Parser.mkInputContext text path\n let (header, parserState, msgs) ← Parser.parseHeader inputCtx\n if !msgs.toList.isEmpty then -- skip this file if there are parse errors\n msgs.forM fun msg => msg.toString >>= IO.println\n throw <| .userError \"parse errors in file\"\n -- the insertion point for `add` is the first newline after the imports\n let insertion := header.raw.getTailPos?.getD parserState.pos\n let insertion := (text.pos! insertion).find '\\n' |>.next!\n pure (path, inputCtx, .mk header.raw[2].getArgs, insertion.offset)\n\n/-- Parse a source file to extract the location of the import lines, for edits and error messages.\n\nReturns `(path, inputCtx, imports, endPos)` where `imports` is the `Lean.Parser.Module.import` list\nand `endPos` is the position of the end of the header.\n-/\ndef parseHeader (srcSearchPath : SearchPath) (mod : Name) :\n IO (System.FilePath × Parser.InputContext ×\n TSyntaxArray ``Parser.Module.import × String.Pos.Raw) := do\n -- Parse the input file\n let some path ← srcSearchPath.findModuleWithExt \"lean\" mod\n | throw <| .userError \"error: failed to find source file for {mod}\"\n let text ← IO.FS.readFile path\n parseHeaderFromString text path.toString\n\n/-- Gets the name `Foo` in `import Foo`. -/\ndef importId : TSyntax ``Parser.Module.import → Name\n | `(Parser.Module.import| import $id) => id.getId\n | stx => panic! s!\"unexpected syntax {stx}\"\n\n/-- Analyze and report issues from module `i`. Arguments:\n\n* `s`: The main state (contains all the modules and dependency information)\n* `srcSearchPath`: Used to find the path for error reporting purposes\n* `ignoreImps`: if `j ∈ ignoreImps` then it will be treated as used\n* `i`: the module index\n* `needs`: this is the same as `s.needs[i]`, except that this array may not\n be initialized if `downstream` mode is disabled so we pass it in here\n* `edits`: accumulates the list of edits to apply if `--fix` is true\n* `downstream`: if true, then we report downstream files that need to be fixed too\n-/\ndef visitModule (s : State) (srcSearchPath : SearchPath) (ignoreImps : Bitset)\n (i : Nat) (needs : Bitset) (edits : Edits)\n (downstream := true) (githubStyle := false) (explain := false) : IO Edits := do\n -- Do transitive reduction of `needs` in `deps` and transitive closure in `transDeps`.\n -- Include the `ignoreImps` in `transDeps`\n let mut deps := needs\n let mut transDeps := needs ||| ignoreImps\n for j in [0:s.mods.size] do\n if deps &&& (1 <<< j) != 0 then\n let deps2 := s.transDeps[j]!\n deps := deps ^^^ (deps &&& deps2) ^^^ (1 <<< j)\n transDeps := transDeps ||| deps2\n\n -- Any import which is not in `transDeps` was unused.\n -- Also accumulate `newDeps` which is the transitive closure of the remaining imports\n let mut toRemove := #[]\n let mut newDeps := 0\n for imp in s.mods[i]!.imports do\n let j := s.toIdx[imp.module]!\n if transDeps &&& (1 <<< j.toNat) == 0 then\n toRemove := toRemove.push j\n else\n newDeps := newDeps ||| s.transDeps[j]!\n\n if toRemove.isEmpty then return edits -- nothing to do\n\n -- If `newDeps` does not cover `needs`, then we have to add back some imports until it does.\n -- To minimize new imports we pick only new imports which are not transitively implied by\n -- another new import\n let mut toAdd := #[]\n for j in [0:s.mods.size] do\n if deps &&& (1 <<< j) != 0 && newDeps &&& (1 <<< j) == 0 then\n toAdd := toAdd.push j\n newDeps := newDeps ||| s.transDeps[j]!\n\n -- mark and report the removals\n let mut edits := toRemove.foldl (init := edits) fun edits n =>\n edits.remove s.modNames[i]! s.modNames[n]!\n if githubStyle then\n try\n let (path, inputCtx, imports, endHeader) ← parseHeader srcSearchPath s.modNames[i]!\n for stx in imports do\n if toRemove.any fun i => s.modNames[i]! == importId stx then\n let pos := inputCtx.fileMap.toPosition stx.raw.getPos?.get!\n println! \"{path}:{pos.line}:{pos.column+1}: warning: unused import \\\n (use `lake exe shake --fix` to fix this, or `lake exe shake --update` to ignore)\"\n if !toAdd.isEmpty then\n -- we put the insert message on the beginning of the last import line\n let pos := inputCtx.fileMap.toPosition endHeader\n println! \"{path}:{pos.line-1}:1: warning: \\\n import {toAdd.map (s.modNames[·]!)} instead\"\n catch _ => pure ()\n if let some path ← srcSearchPath.findModuleWithExt \"lean\" s.modNames[i]! then\n println! \"{path}:\"\n else\n println! \"{s.modNames[i]!}:\"\n println! \" remove {toRemove.map (s.modNames[·]!)}\"\n\n -- mark and report the additions\n if !toAdd.isEmpty then\n edits := toAdd.foldl (init := edits) fun edits n =>\n edits.add s.modNames[i]! n\n println! \" add {toAdd.map (s.modNames[·]!)}\"\n\n if downstream && !toRemove.isEmpty then\n -- In `downstream` mode, we should also check all the other modules to find out if\n -- we have a situation like `A -> B -/> C -> D`, where we are removing the `B -> C` import\n -- but `D` depends on `A` and only directly imports `C`.\n -- This situation occurs when `A ∈ needs[D]`, `C ∈ transDeps[D]`, and `A ∉ newTransDeps[D]`,\n -- where `newTransDeps` is the result of recalculating `transDeps` after breaking the `B -> C`\n -- link.\n\n -- calculate `newTransDeps[C]`, removing all `B -> C` links from `toRemove` and adding `toAdd`\n let mut newTransDepsI := 1 <<< i\n for j in s.deps[i]! do\n if !toRemove.contains j then\n newTransDepsI := newTransDepsI ||| s.transDeps[j]!\n for j in toAdd do\n newTransDepsI := newTransDepsI ||| s.transDeps[j]!\n\n let mut newTransDeps := s.transDeps.set! i newTransDepsI -- deep copy\n let mut reAdded := #[]\n for j in [i+1:s.mods.size] do -- for each module `D`\n if s.transDeps[j]! &&& (1 <<< i) != 0 then -- which imports `C`\n -- calculate `newTransDeps[D]` assuming no change to the imports of `D`\n let mut newTransDepsJ := s.deps[j]!.foldl (init := 1 <<< j) fun d k =>\n d ||| newTransDeps[k]!\n let diff := s.transDeps[j]! ^^^ newTransDepsJ\n if diff != 0 then -- if the dependency closure of `D` changed\n let mut reAdd := diff &&& s.needs[j]!\n if reAdd != 0 then -- and there are things from `needs[D]` which were lost:\n -- Add them back.\n -- `reAdd` is the set of all files `A` which have to be added back\n -- to the closure of `D`, but some of them might be importing others,\n -- so we take the transitive reduction of `reAdd`.\n let mut reAddArr := []\n let mut k := j\n while reAdd != 0 do -- note: this loop terminates because `reAdd ⊆ [0:k]`\n k := k - 1\n if reAdd &&& (1 <<< k) != 0 then\n reAddArr := k :: reAddArr\n reAdd := reAdd ^^^ (reAdd &&& newTransDeps[k]!)\n -- add these to `newTransDeps[D]` so that files downstream of `D`\n -- (later in the `for j` loop) will take this into account\n newTransDepsJ := newTransDepsJ ||| newTransDeps[k]!\n edits := reAddArr.foldl (init := edits) (·.add s.modNames[j]! ·)\n reAdded := reAdded.push (j, reAddArr)\n newTransDeps := newTransDeps.set! j newTransDepsJ\n if !reAdded.isEmpty then\n println! \" instead\"\n for (j, reAddArr) in reAdded do\n println! \" import {reAddArr.map (s.modNames[·]!)} in {s.modNames[j]!}\"\n\n if explain then\n let explanation := getExplanations s.constToIdx s.mods[i]!\n let sanitize n := if n.hasMacroScopes then (sanitizeName n).run' { options := {} } else n\n let run (j : USize) := do\n if let some (n, c) := explanation[j]? then\n println! \" note: {s.modNames[i]!} requires {s.modNames[j]!}\\\n \\n because {sanitize n} refers to {sanitize c}\"\n for imp in s.mods[i]!.imports do run <| s.toIdx[imp.module]!\n for i in toAdd do run i.toUSize\n\n return edits\n\n/-- Convert a list of module names to a bitset of module indexes -/\ndef toBitset (s : State) (ns : List Name) : Bitset :=\n ns.foldl (init := 0) fun c name =>\n match s.toIdx[name]? with\n | some i => c ||| (1 <<< i.toNat)\n | none => c\n\n/-- The parsed CLI arguments. See `help` for more information -/\nstructure Args where\n /-- `--help`: shows the help -/\n help : Bool := false\n /-- `--force`: skips the `lake build --no-build` sanity check -/\n force : Bool := false\n /-- `--no-downstream`: disables downstream mode -/\n downstream : Bool := true\n /-- `--gh-style`: output messages that can be parsed by `gh-problem-matcher-wrap` -/\n githubStyle : Bool := false\n /-- `--explain`: give constants explaining why each module is needed -/\n explain : Bool := false\n /-- `--fix`: apply the fixes directly -/\n fix : Bool := false\n /-- `--update`: update the config file -/\n update : Bool := false\n /-- `--global`: with `--update`, add imports to `ignoreImport` instead of `ignore` -/\n global : Bool := false\n /-- `--cfg FILE`: choose a custom location for the config file -/\n cfg : Option String := none\n /-- `..`: the list of root modules to check -/\n mods : Array Name := #[]\n\ninstance {α} [FromJson α] : FromJson (NameMap α) where\n fromJson? j := do\n (← j.getObj?).foldlM (init := mkNameMap _) fun m a b => do\n m.insert a.toName <$> fromJson? b\ninstance {α} [ToJson α] : ToJson (NameMap α) where\n toJson m := Json.obj <| m.foldl (init := ∅) fun m a b =>\n m.insert (toString a) (toJson b)\n\n/-- The config file format, which we both read and write. -/\nstructure ShakeCfg where\n /-- All imports from modules in this list will be ignored -/\n ignoreAll? : Option (List Name) := none\n /-- The modules in this list will be ignored as imports of any other file -/\n ignoreImport? : Option (List Name) := [`Init, `Lean]\n /-- If `X` maps to `Y` then an import of `Y` in module `X` will be ignored -/\n ignore? : Option (NameMap (Array Name)) := none\n deriving FromJson, ToJson\n\n/-- The main entry point. See `help` for more information on arguments. -/\ndef main (args : List String) : IO UInt32 := do\n initSearchPath (← findSysroot)\n -- Parse the arguments\n let rec parseArgs (args : Args) : List String → Args\n | [] => args\n | \"--help\" :: rest => parseArgs { args with help := true } rest\n | \"--force\" :: rest => parseArgs { args with force := true } rest\n | \"--no-downstream\" :: rest => parseArgs { args with downstream := false } rest\n | \"--fix\" :: rest => parseArgs { args with fix := true } rest\n | \"--explain\" :: rest => parseArgs { args with explain := true } rest\n | \"--gh-style\" :: rest => parseArgs { args with githubStyle := true } rest\n | \"--update\" :: rest => parseArgs { args with update := true } rest\n | \"--global\" :: rest => parseArgs { args with global := true } rest\n | \"--cfg\" :: cfg :: rest => parseArgs { args with cfg := cfg } rest\n | \"--\" :: rest => { args with mods := args.mods ++ rest.map (·.toName) }\n | other :: rest => parseArgs { args with mods := args.mods.push other.toName } rest\n let args := parseArgs {} args\n\n -- Bail if `--help` is passed\n if args.help then\n IO.println help\n IO.Process.exit 0\n\n if !args.force then\n if (← IO.Process.output { cmd := \"lake\", args := #[\"build\", \"--no-build\"] }).exitCode != 0 then\n IO.println \"There are out of date oleans. Run `lake build` or `lake exe cache get` first\"\n IO.Process.exit 1\n\n -- Determine default module(s) to run shake on\n let defaultTargetModules : Array Name ← try\n let (elanInstall?, leanInstall?, lakeInstall?) ← Lake.findInstall?\n let config ← Lake.MonadError.runEIO <| Lake.mkLoadConfig { elanInstall?, leanInstall?, lakeInstall? }\n let some workspace ← Lake.loadWorkspace config |>.toBaseIO\n | throw <| IO.userError \"failed to load Lake workspace\"\n let defaultTargetModules := workspace.root.defaultTargets.flatMap fun target =>\n if let some lib := workspace.root.findLeanLib? target then\n lib.roots\n else if let some exe := workspace.root.findLeanExe? target then\n #[exe.config.root]\n else\n #[]\n pure defaultTargetModules\n catch _ =>\n pure #[]\n\n -- Parse the `--cfg` argument\n let srcSearchPath ← getSrcSearchPath\n let cfgFile ← if let some cfg := args.cfg then\n pure (some ⟨cfg⟩)\n else if let some mod := defaultTargetModules[0]? then\n if let some path ← srcSearchPath.findModuleWithExt \"lean\" mod then\n pure (some (path.parent.get! / \"scripts\" / \"noshake.json\"))\n else\n pure none\n else pure none\n\n -- Read the config file\n -- `isValidCfgFile` is `false` if and only if the config file is present and invalid.\n let (cfg, isValidCfgFile) ← if let some file := cfgFile then\n try\n pure (← IO.ofExcept (Json.parse (← IO.FS.readFile file) >>= fromJson? (α := ShakeCfg)), true)\n catch e =>\n -- The `cfgFile` is invalid, so we print the error and return `isValidCfgFile = false`.\n println! \"{e.toString}\"\n pure ({}, false)\n else pure ({}, true)\n if !isValidCfgFile then\n IO.println s!\"Invalid config file '{cfgFile.get!}'\"\n IO.Process.exit 1\n else\n -- the list of root modules\n let mods := if args.mods.isEmpty then defaultTargetModules else args.mods\n -- Only submodules of `pkg` will be edited or have info reported on them\n let pkg := mods[0]!.components.head!\n\n -- Load all the modules\n let mut (_, s) ← (loadModules (mods.map ({module := ·}))).run {}\n\n -- Parse the config file\n let ignoreMods := toBitset s (cfg.ignoreAll?.getD [])\n let ignoreImps := toBitset s (cfg.ignoreImport?.getD [])\n let ignore := (cfg.ignore?.getD {}).foldl (init := (∅ : Std.HashMap _ _)) fun m a v =>\n m.insert a (toBitset s v.toList)\n\n let noIgnore (i : Nat) :=\n !s.mods[i]!.constNames.isEmpty && -- skip import-only mods\n ignoreMods &&& (1 <<< i) == 0 &&\n pkg.isPrefixOf s.modNames[i]!\n\n -- Run the calculation of the `needs` array in parallel\n let needs := s.mods.mapIdx fun i mod =>\n if args.downstream || noIgnore i then\n some <| Task.spawn fun _ =>\n -- remove the module from its own `needs`\n (calcNeeds s.constToIdx mod ||| (1 <<< i)) ^^^ (1 <<< i)\n else\n none\n if args.downstream then\n s := { s with needs := needs.map (·.get!.get) }\n\n if args.fix then\n println! \"The following changes will be made automatically:\"\n\n -- Check all selected modules\n let mut edits : Edits := ∅\n for i in [0:s.mods.size], t in needs do\n if let some t := t then\n if noIgnore i then\n let ignoreImps := ignoreImps ||| ignore.getD s.modNames[i]! 0\n edits ← visitModule s srcSearchPath ignoreImps i t.get edits\n args.downstream args.githubStyle args.explain\n\n -- Write the config file\n if args.update then\n if let some cfgFile := cfgFile then\n let mut ignore := cfg.ignore?.getD {}\n let ignoreImport := cfg.ignoreImport?.getD {}\n let mut ignoreImportSet : NameSet := ignoreImport.foldl .insert {}\n -- if `args.fix` is true then we assume the errors will be fixed after,\n -- so it's just reformatting the existing file\n if !args.fix then\n if args.global then\n -- in global mode all the edits are added to `ignoreImport`\n ignoreImportSet := edits.fold (init := ignoreImportSet)\n (fun ignore _ (remove, _) => ignore.append remove)\n else\n -- in local mode all the edits are added to `ignore`\n ignore := edits.fold (init := ignore) fun ignore mod (remove, _) =>\n let ns := (ignore.getD mod #[]).foldl (init := remove) (·.insert ·)\n if ns.isEmpty then ignore.erase mod else\n ignore.insert mod ns.toArray\n -- If an entry is in `ignoreAll`, the `ignore` key is redundant\n for i in cfg.ignoreAll?.getD {} do\n if ignore.contains i then\n ignore := ignore.erase i\n -- If an entry is in `ignoreImport`, the `ignore` value is redundant\n ignore := ignore.foldl (init := {}) fun ignore mod ns =>\n let ns := ns.filter (!ignoreImportSet.contains ·)\n if ns.isEmpty then ignore else ignore.insert mod (ns.qsort (·.toString < ·.toString))\n -- Sort the lists alphabetically\n let ignoreImport := (ignoreImportSet.toArray.qsort (·.toString < ·.toString)).toList\n let cfg : ShakeCfg := {\n ignoreAll? := cfg.ignoreAll?.filter (!·.isEmpty)\n ignoreImport? := (some ignoreImport).filter (!·.isEmpty)\n ignore? := (some ignore).filter (!·.isEmpty)\n }\n IO.FS.writeFile cfgFile <| toJson cfg |>.pretty.push '\\n'\n\n if !args.fix then\n -- return error if any issues were found\n return if edits.isEmpty then 0 else 1\n\n -- Apply the edits to existing files\n let count ← edits.foldM (init := 0) fun count mod (remove, add) => do\n -- Only edit files in the current package\n if !pkg.isPrefixOf mod then\n return count\n -- Compute the transitive reduction of `add` and convert to a list of names\n let add := if add == 0 then #[] else Id.run do\n let mut val := add\n for i in [0:s.mods.size] do\n if val &&& (1 <<< i) != 0 then\n val := val ^^^ (val &&& s.transDeps[i]!) ^^^ (1 <<< i)\n let mut out := #[]\n for i in [0:s.mods.size] do\n if val &&& (1 <<< i) != 0 then\n out := out.push s.modNames[i]!\n out.qsort Name.lt\n\n -- Parse the input file\n let (path, inputCtx, imports, insertion) ←\n try parseHeader srcSearchPath mod\n catch e => println! e.toString; return count\n let text := String.Pos.Raw.extract inputCtx.inputString 0 inputCtx.endPos\n let insertion := text.pos! insertion\n\n -- Calculate the edit result\n let mut pos : text.Pos := text.startPos\n let mut out : String := \"\"\n let mut seen : NameSet := {}\n for stx in imports do\n let startPos : text.Pos := text.pos! stx.raw.getPos?.get!\n let mod := importId stx\n if remove.contains mod || seen.contains mod then\n out := out ++ startPos.extract pos\n -- We use the end position of the syntax, but include whitespace up to the first newline\n pos := startPos.find '\\n' |>.next!\n seen := seen.insert mod\n out := out ++ pos.extract insertion\n for mod in add do\n if !seen.contains mod then\n seen := seen.insert mod\n out := out ++ s!\"import {mod}\\n\"\n out := out ++ insertion.extract text.endPos\n\n IO.FS.writeFile path out\n return count + 1\n\n -- Since we throw an error upon encountering issues, we can be sure that everything worked\n -- if we reach this point of the script.\n if count > 0 then\n println! \"Successfully applied {count} suggestions.\"\n else\n println! \"No edits required.\"\n return 0\n\n-- self-test so that future grammar changes cause a build failure\n/-- info: #[`Lake.CLI.Main] -/\n#guard_msgs (whitespace := lax) in\n#eval show MetaM _ from do\n let (_, _, imports, _) ← parseHeaderFromString (← getFileMap).source (← getFileName)\n return imports.map importId\n" }, { "path": "bors.toml", "content": "status = [\"Build\"]\nuse_squash_merge = true\ntimeout_sec = 28800\nblock_labels = [\"not-ready-to-merge\", \"WIP\", \"blocked-by-other-PR\", \"merge-conflict\"]\ndelete_merged_branches = true\ncut_body_after = \"---\"\n" }, { "path": "docs/lakefile.toml", "content": "name = \"docs\"\nreservoir = false\npackagesDir = \"../.lake/packages\"\nbuildDir = \".\"\n\n[[require]]\nscope = \"leanprover\"\nname = \"doc-gen4\"\nrev = \"main\"\n\n[[require]]\nname = \"batteries\"\npath = \"..\"\n" }, { "path": "lake-manifest.json", "content": "{\"version\": \"1.2.0\",\n \"packagesDir\": \".lake/packages\",\n \"packages\": [],\n \"name\": \"batteries\",\n \"lakeDir\": \".lake\",\n \"fixedToolchain\": false}\n" }, { "path": "lakefile.toml", "content": "name = \"batteries\"\ntestDriver = \"BatteriesTest\"\nlintDriver = \"runLinter\"\ndefaultTargets = [\"Batteries\", \"runLinter\"]\n\n[leanOptions]\nlinter.missingDocs = true\n\n[[lean_lib]]\nname = \"Batteries\"\n\n[[lean_lib]]\nname = \"BatteriesTest\"\nglobs = [\"BatteriesTest.+\"]\nleanOptions = {linter.missingDocs = false}\n\n[[lean_exe]]\nname = \"runLinter\"\nsrcDir = \"scripts\"\nsupportInterpreter = true\n\n[[lean_exe]]\nname = \"test\"\nsrcDir = \"scripts\"\n\n# `lake exe shake` checks files for unnecessary imports.\n[[lean_exe]]\nname = \"shake\"\nroot = \"Shake.Main\"\nsupportInterpreter = true\n" }, { "path": "lean-toolchain", "content": "leanprover/lean4:v4.30.0-rc2\n" }, { "path": "scripts/check_imports.lean", "content": "/-\nCopyright (c) 2024 Joe Hendrix. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: Joe Hendrix\n-/\nimport Batteries\n\n/-!\nThis test checks that all directories in `Batteries/Data/` have corresponding\n`Batteries.Data.` modules imported by `Batteries` that import all of the submodules\nunder that directory.\n\nIt will also check that `Batteries` imports all the expected modules.\n\nIt has a flag (`autofix` below) to automatically fix the errors found. This\ncommand may need to be rerun to fix all errors; it tries to avoid overwriting\nexisting files.\n-/\n\nopen Lean System\n\n/-- Monad to log errors to stderr while record error count. -/\nabbrev LogIO := StateRefT (Bool × Bool) IO\n\ndef runLogIO (act : LogIO Unit) : MetaM Unit := do\n let ((), (warnings, _)) ← act.run (false, false)\n if warnings then\n throwError \"Fatal error\"\n\ndef warn (fixable : Bool) (msg : String) : LogIO Unit := do\n modify (fun (_, u) => (true, u || not fixable))\n liftM (IO.eprintln msg)\n\n-- | Predicate indicates if warnings are present and if they fixable.\ndef getWarningInfo : LogIO (Bool × Bool) := get\n\ndef createModuleHashmap (env : Environment) : Std.HashMap Name ModuleData := Id.run do\n let mut nameMap := {}\n for i in [0:env.header.moduleNames.size] do\n let nm := env.header.moduleNames[i]!\n let md := env.header.moduleData[i]!\n nameMap := nameMap.insert nm md\n pure nameMap\n\n/-- Get the imports we expect in a directory of `Batteries.Data`. -/\npartial def addModulesIn (recurse : Bool) (prev : Array Name) (root : Name := .anonymous)\n (path : FilePath) : IO (Array Name) := do\n let mut r := prev\n for entry in ← path.readDir do\n if ← entry.path.isDir then\n if recurse then\n r ← addModulesIn recurse r (root.mkStr entry.fileName) entry.path\n else\n let .some mod := FilePath.fileStem entry.fileName\n | continue\n r := r.push (root.mkStr mod)\n pure r\n\ndef modulePath (name : Name) : FilePath :=\n let path := name.toString.replace \".\" FilePath.pathSeparator.toString\n s!\"{path}.lean\"\n\ndef writeImportModule (path : FilePath) (imports : Array Name) : IO Unit := do\n let imports := imports.qsort (·.toString < ·.toString)\n let lines := imports.map (s!\"public import {·}\\n\")\n let contents := String.join (\"module\\n\" :: \"\\n\" :: lines.toList)\n IO.println s!\"Generating {path}\"\n IO.FS.writeFile path contents\n\n/-- Check for imports and return true if warnings issued. -/\ndef checkMissingImports (modName : Name) (modData : ModuleData) (reqImports : Array Name) :\n LogIO Bool := do\n let names : Std.HashSet Name := Std.HashSet.ofArray (modData.imports.map (·.module))\n let mut warned := false\n for req in reqImports do\n if !names.contains req then\n warn true s!\"Missing import {req} in {modName}\"\n warned := true\n pure warned\n\n/-- Check directory entry in `Batteries/Data/` -/\ndef checkBatteriesDataDir\n (modMap : Std.HashMap Name ModuleData)\n (entry : IO.FS.DirEntry) (autofix : Bool := false) : LogIO Unit := do\n let moduleName := `Batteries.Data ++ .mkSimple entry.fileName\n let requiredImports ← addModulesIn (recurse := true) #[] (root := moduleName) entry.path\n let .some module := modMap[moduleName]?\n | warn true s!\"Could not find {moduleName}; Not imported into Batteries.\"\n let path := modulePath moduleName\n -- We refuse to generate imported modules whose path doesn't exist.\n -- The import failure will be fixed later and the file rerun\n if autofix then\n if ← path.pathExists then\n warn false s!\"Skipping writing of {moduleName}: rerun after {moduleName} imported.\"\n else\n writeImportModule path requiredImports\n return\n let hasDecls : Bool := module.constants.size > 0\n if hasDecls then\n warn false\n s!\"Expected {moduleName} to not contain additional declarations.\\n\\\n Declarations should be moved out.\\n\\\n This error cannot be automatically fixed.\"\n let warned ← checkMissingImports moduleName module requiredImports\n if autofix && warned && !hasDecls then\n writeImportModule (modulePath moduleName) requiredImports\n\n/-- Compute imports expected by `Batteries.lean` -/\ndef expectedBatteriesImports : IO (Array Name) := do\n let mut needed := #[]\n for top in ← FilePath.readDir \"Batteries\" do\n if top.fileName == \"Data\" then\n needed ← addModulesIn (recurse := false) needed `Batteries.Data top.path\n else\n let nm := `Batteries\n let rootname := FilePath.withExtension top.fileName \"\"\n let root := nm.mkStr rootname.toString\n if ← top.path.isDir then\n needed ← addModulesIn (recurse := true) needed (root := root) top.path\n else\n needed := needed.push root\n pure needed\n\ndef checkBatteriesDataImports : MetaM Unit := do\n -- N.B. This can be used to automatically fix Batteries.lean as well as\n -- other import files.\n -- It uses an environment variable to do that.\n -- The easiest way to use this is run `./scripts/updateBatteries.sh.`\n let autofix := (← IO.getEnv \"__LEAN_BATTERIES_AUTOFIX_IMPORTS\").isSome\n let env ← getEnv\n let modMap := createModuleHashmap env\n runLogIO do\n for entry in ← FilePath.readDir (\"Batteries\" / \"Data\") do\n if ← entry.path.isDir then\n checkBatteriesDataDir (autofix := autofix) modMap entry\n let batteriesImports ← expectedBatteriesImports\n let .some batteriesMod := modMap[`Batteries]?\n | warn false \"Missing Batteries module!; Run `lake build`.\"\n let warned ← checkMissingImports `Batteries batteriesMod batteriesImports\n if autofix && warned then\n writeImportModule \"Batteries.lean\" batteriesImports\n match ← getWarningInfo with\n | (false, _) =>\n pure ()\n | (_, true) =>\n IO.eprintln s!\"Found errors that cannot be automatically fixed.\\n\\\n Address unfixable issues and rerun lake build && ./scripts/updateBatteries.sh.\"\n | _ =>\n if autofix then\n IO.eprintln s!\"Found missing imports and attempted fixes.\\n\\\n Run lake build && ./scripts/updateBatteries.sh to verify.\\n\\\n Multiple runs may be needed.\"\n else\n IO.eprintln s!\"Found missing imports.\\n\\\n Run lake build && ./scripts/updateBatteries.sh to attempt automatic fixes.\"\n\nrun_meta checkBatteriesDataImports\n" }, { "path": "scripts/create-adaptation-pr.sh", "content": "#!/usr/bin/env bash\n\n# Make this script robust against unintentional errors.\n# See e.g. http://redsymbol.net/articles/unofficial-bash-strict-mode/ for explanation.\nset -euo pipefail\nIFS=$'\\n\\t'\n\n# We need to make the script robust against changes on disk\n# that might have happened during the script execution, e.g. from switching branches.\n# We do that by making sure the entire script is parsed before execution starts\n# using the following pattern\n# {\n# # script content\n# exit\n# }\n# (see https://stackoverflow.com/a/2358432).\n# So please do not delete the following line, or the final two lines of this script.\n{\n\n# Default values\nAUTO=\"no\"\n\n# Function to display usage\nusage() {\n echo \"Usage: $0 \"\n echo \" or\"\n echo \" $0 --bumpversion= --nightlydate= --nightlysha= [--auto=]\"\n echo \"BUMPVERSION: The upcoming release that we are targeting, e.g., 'v4.10.0'\"\n echo \"NIGHTLYDATE: The date of the nightly toolchain currently used on 'nightly-testing'\"\n echo \"NIGHTLYSHA: The SHA of the nightly toolchain that we want to adapt to\"\n echo \"AUTO: Optional flag to specify automatic mode, default is 'no'\"\n exit 1\n}\n\n# Parse arguments\nif [ $# -eq 2 ] && [[ $1 != --* ]] && [[ $2 != --* ]]; then\n BUMPVERSION=$1\n NIGHTLYDATE=$2\nelif [ $# -ge 2 ]; then\n for arg in \"$@\"; do\n case $arg in\n --bumpversion=*)\n BUMPVERSION=\"${arg#*=}\"\n shift\n ;;\n --nightlydate=*)\n NIGHTLYDATE=\"${arg#*=}\"\n shift\n ;;\n --nightlysha=*)\n NIGHTLYSHA=\"${arg#*=}\"\n shift\n ;;\n --auto=*)\n AUTO=\"${arg#*=}\"\n shift\n ;;\n *)\n usage\n ;;\n esac\n done\nelse\n usage\nfi\n\n# Validate required arguments\nif [ -z \"$BUMPVERSION\" ] || [ -z \"$NIGHTLYDATE\" ]; then\n usage\nfi\n\n# Check if 'gh' command is available\nif ! command -v gh &> /dev/null; then\n echo \"'gh' (GitHub CLI) is not installed. Please install it and try again.\"\n exit 1\nfi\n\necho \"### Creating a PR for the nightly adaptation for $NIGHTLYDATE\"\n\necho\necho \"### [auto] save the current branch name\"\n\nusr_branch=$(git branch --show-current)\n\necho\necho \"### [auto] checkout main and pull the latest changes\"\n\ngit checkout main\ngit pull\n\necho\necho \"### [auto] checkout 'bump/$BUMPVERSION' and merge the latest changes from 'origin/main'\"\n\ngit checkout \"bump/$BUMPVERSION\"\ngit pull\ngit merge --no-edit origin/main || true # ignore error if there are conflicts\n\n# Check if there are merge conflicts\nif git diff --name-only --diff-filter=U | grep -q .; then\n echo\n echo \"### [auto] Conflict resolution\"\n echo \"### Automatically choosing 'lean-toolchain' and 'lake-manifest.json' from the newer branch\"\n echo \"### In this case, the newer branch is 'bump/$BUMPVERSION'\"\n git checkout \"bump/$BUMPVERSION\" -- lean-toolchain lake-manifest.json\n git add lean-toolchain lake-manifest.json\n\n # Check if there are more merge conflicts after auto-resolution\n if ! git diff --name-only --diff-filter=U | grep -q .; then\n # Auto-commit the resolved conflicts if no other conflicts remain\n git commit -m \"Auto-resolved conflicts in lean-toolchain and lake-manifest.json\"\n fi\nfi\n\nif git diff --name-only --diff-filter=U | grep -q . || ! git diff-index --quiet HEAD --; then\n if [ \"$AUTO\" = \"yes\" ]; then\n echo \"Auto mode enabled. Bailing out due to unresolved conflicts or uncommitted changes.\"\n exit 1\n fi\nfi\n\n# Loop until all conflicts are resolved and committed\nwhile git diff --name-only --diff-filter=U | grep -q . || ! git diff-index --quiet HEAD --; do\n echo\n echo \"### [user] Conflict resolution\"\n echo \"We are merging the latest changes from 'origin/main' into 'bump/$BUMPVERSION'\"\n echo \"There seem to be conflicts or uncommitted files\"\n echo \"\"\n echo \" 1) Open $(pwd) in a new terminal and run 'git status'\"\n echo \" 2) Make sure to commit the resolved conflicts, but do not push them\"\n read -rp \" 3) Press enter to continue, when you are done\"\ndone\n\necho \"All conflicts resolved and committed.\"\necho \"Proceeding with git push...\"\ngit push\n\necho\necho \"### [auto] create a new branch 'bump/nightly-$NIGHTLYDATE' and merge the latest changes from 'origin/nightly-testing'\"\n\ngit checkout -b \"bump/nightly-$NIGHTLYDATE\" || git checkout \"bump/nightly-$NIGHTLYDATE\"\ngit merge --no-edit \"$NIGHTLYSHA\" || true # ignore error if there are conflicts\n\n# Check if there are merge conflicts\nif git diff --name-only --diff-filter=U | grep -q .; then\n echo\n echo \"### [auto] Conflict resolution\"\n echo \"### Automatically choosing 'lean-toolchain' and 'lake-manifest.json' from 'nightly-testing'\"\n git checkout \"$NIGHTLYSHA\" -- lean-toolchain lake-manifest.json\n git add lean-toolchain lake-manifest.json\nfi\n\nif git diff --name-only --diff-filter=U | grep -q .; then\n if [ \"$AUTO\" = \"yes\" ]; then\n echo \"Auto mode enabled. Bailing out due to unresolved conflicts or uncommitted changes.\"\n exit 1\n fi\nfi\n\n# Check if there are more merge conflicts\nif git diff --name-only --diff-filter=U | grep -q .; then\n echo\n echo \"### [user] Conflict resolution\"\n echo \"We are merging the latest changes from 'origin/nightly-testing' into 'bump/nightly-$NIGHTLYDATE'\"\n echo \"Specifically, we are merging the following version of 'origin/nightly-testing':\"\n echo \"$NIGHTLYSHA\"\n echo \"There seem to be conflicts: please resolve them\"\n echo \"\"\n echo \" 1) Open $(pwd) in a new terminal and run 'git status'\"\n echo \" 2) Run 'git add' on the resolved files, but do not commit\"\n read -rp \" 3) Press enter to continue, when you are done\"\nfi\n\necho\necho \"### [auto] commit the changes and push the branch\"\n\npr_title=\"chore: adaptations for nightly-$NIGHTLYDATE\"\n# Create a commit with the PR title\n# We allow an empty commit,\n# as the user might have inadvertently already committed changes\n# In general, we do not want this command to fail.\ngit commit --allow-empty -m \"$pr_title\"\ngit push --set-upstream origin \"bump/nightly-$NIGHTLYDATE\"\n\n# Check if there is a diff between bump/nightly-$NIGHTLYDATE and bump/$BUMPVERSION\nif git diff --name-only \"bump/$BUMPVERSION\" \"bump/nightly-$NIGHTLYDATE\" | grep -q .; then\n\n echo\n echo \"### [auto] create a PR for the new branch\"\n echo \"Creating a pull request. Setting the base of the PR to 'bump/$BUMPVERSION'\"\n echo \"Running the following 'gh' command to do this:\"\n gh_command=\"gh pr create -t \\\"$pr_title\\\" -b '' -B bump/$BUMPVERSION\"\n echo \"> $gh_command\"\n gh_output=$(eval \"$gh_command\")\n # Extract the PR number from the output\n pr_number=$(echo \"$gh_output\" | sed 's/.*\\/pull\\/\\([0-9]*\\).*/\\1/')\n\n echo\n echo \"### [auto] post a link to the PR on Zulip\"\n\n zulip_title=\"batteries#$pr_number adaptations for nightly-$NIGHTLYDATE\"\n zulip_body=$(printf \"> %s\\n\\nPlease review this PR. At the end of the month this diff will land in 'main'.\" \"$pr_title batteries#$pr_number\")\n\n echo \"Posting the link to the PR in a new thread on the #nightly-testing-batteries channel on Zulip\"\n echo \"Here is the message:\"\n echo \"Title: $zulip_title\"\n echo \" Body: $zulip_body\"\n\n if command -v zulip-send >/dev/null 2>&1; then\n zulip_command=\"zulip-send --stream nightly-testing-batteries --subject \\\"$zulip_title\\\" --message \\\"$zulip_body\\\"\"\n echo \"Running the following 'zulip-send' command to do this:\"\n echo \"> $zulip_command\"\n eval \"$zulip_command\"\n else\n echo \"Zulip CLI is not installed. Install it to send messages automatically.\"\n if [ \"$AUTO\" = \"yes\" ]; then\n exit 1\n else\n echo \"Please send the message manually.\"\n read -rp \"Press enter to continue\"\n fi\n fi\n\n# else, let the user know that no PR is needed\nelse\n echo\n echo \"### [auto] No PR needed\"\n echo \"The changes in 'bump/nightly-$NIGHTLYDATE' are the same as in 'bump/$BUMPVERSION'\"\n echo \"No PR is needed\"\n\nfi\n\necho\necho \"### [auto] checkout the 'nightly-testing' branch and merge the new branch into it\"\n\ngit checkout nightly-testing\ngit pull\ngit merge --no-edit \"bump/nightly-$NIGHTLYDATE\" || true # ignore error if there are conflicts\n\n# Check if there are merge conflicts\nif git diff --name-only --diff-filter=U | grep -q .; then\n echo\n echo \"### [auto] Conflict resolution\"\n echo \"### Automatically choosing lean-toolchain and lake-manifest.json from the newer branch\"\n echo \"### In this case, the newer branch is 'bump/nightly-$NIGHTLYDATE'\"\n git checkout \"bump/nightly-$NIGHTLYDATE\" -- lean-toolchain lake-manifest.json\n git add lean-toolchain lake-manifest.json\n\n # Check if there are more merge conflicts after auto-resolution\n if ! git diff --name-only --diff-filter=U | grep -q .; then\n # Auto-commit the resolved conflicts if no other conflicts remain\n git commit -m \"Auto-resolved conflicts in lean-toolchain and lake-manifest.json\"\n fi\nfi\n\nif git diff --name-only --diff-filter=U | grep -q . || ! git diff-index --quiet HEAD --; then\n if [ \"$AUTO\" = \"yes\" ]; then\n echo \"Auto mode enabled. Bailing out due to unresolved conflicts or uncommitted changes.\"\n echo \"PR has been created, and message posted to Zulip.\"\n echo \"Error occurred while merging the new branch into 'nightly-testing'.\"\n exit 2\n fi\nfi\n\n# Loop until all conflicts are resolved and committed\nwhile git diff --name-only --diff-filter=U | grep -q . || ! git diff-index --quiet HEAD --; do\n echo\n echo \"### [user] Conflict resolution\"\n echo \"We are merging the new PR bump/nightly-$NIGHTLYDATE into 'nightly-testing'\"\n echo \"There seem to be conflicts or uncommitted files\"\n echo \"\"\n echo \" 1) Open $(pwd) in a new terminal and run 'git status'\"\n echo \" 2) Make sure to commit the resolved conflicts, but do not push them\"\n read -rp \" 3) Press enter to continue, when you are done\"\ndone\n\necho \"All conflicts resolved and committed.\"\necho \"Proceeding with git push...\"\ngit push\n\necho\necho \"### [auto] finished: checkout the original branch\"\n\ngit checkout \"$usr_branch\"\n\n# These last two lines are needed to make the script robust against changes on disk\n# that might have happened during the script execution, e.g. from switching branches\n# See the top of the file for more details.\nexit\n}\n" }, { "path": "scripts/lintWhitespace.sh", "content": "#!/bin/bash\n\ntmpfile=$(mktemp)\nissues_found=0\n\nfind Batteries -type f -name \"*.lean\" | while IFS= read -r file; do\n # Check for trailing whitespace and print line number if found\n while IFS=: read -r line_num line; do\n echo \"Trailing whitespace found in $file at line $line_num: $line\"\n echo 1 > \"$tmpfile\"\n done < <(grep -n \"[[:blank:]]$\" \"$file\")\n\n # Check if the last line ends with a new line\n if [ \"$(tail -c 1 \"$file\" | od -c | awk 'NR==1 {print $2}')\" != \"\\n\" ]; then\n echo \"Last line does not end with a new line in: $file\"\n echo 1 > \"$tmpfile\"\n fi\ndone\n\nif [ -f \"$tmpfile\" ]; then\n issues_found=$(<\"$tmpfile\")\nfi\nrm -f \"$tmpfile\"\n\nexit $issues_found\n" }, { "path": "scripts/merge-lean-testing-pr.sh", "content": "#!/usr/bin/env bash\nset -eu\n\n# This scripts merges a `lean-pr-testing-NNNN` branch into `nightly-testing`.\n# This script is a copy of the same script in mathlib4, and should be kept in sync.\n# Note that Mathlib uses `lakefile.lean`, while Batteries uses `lakefile.toml`\n\nif [ \"$#\" -ne 1 ]; then\n echo \"Usage: $0 \"\n exit 1\nfi\n\nPR_NUMBER=$1\nBRANCH_NAME=\"lean-pr-testing-$PR_NUMBER\"\n\ngit checkout nightly-testing\ngit pull --ff-only\n\nif ! git merge origin/$BRANCH_NAME; then\n echo \"Merge conflicts detected. Resolving conflicts in favor of current version...\"\n git checkout --ours lean-toolchain lakefile.toml lake-manifest.json\n git add lean-toolchain lakefile.toml lake-manifest.json\nfi\n\nsed \"s/$BRANCH_NAME/nightly-testing/g\" < lakefile.toml > lakefile.toml.new\nmv lakefile.toml.new lakefile.toml\ngit add lakefile.toml\n\n# Check for merge conflicts\nif git ls-files -u | grep -q '^'; then\n echo \"Merge conflicts detected. Please resolve conflicts manually.\"\n git status\n exit 1\nfi\n\nif ! lake update; then\n echo \"Lake update failed. Please resolve conflicts manually.\"\n git status\n exit 1\nfi\n\n# Add files touched by lake update\ngit add lakefile.toml lake-manifest.json\n\n# Attempt to commit. This will fail if there are conflicts.\nif git commit -m \"merge $BRANCH_NAME\"; then\n echo \"Merge successful.\"\n # Note: This script does NOT push. The caller is responsible for pushing.\n # This allows the nightly_bump_and_merge.yml workflow to batch multiple\n # merges into a single push, avoiding spurious CI failures.\n exit 0\nelse\n echo \"Merge failed. Please resolve conflicts manually.\"\n git status\n exit 1\nfi\n" }, { "path": "scripts/nolints.json", "content": "[[\"unusedArguments\", \"imp_intro\"]]\n" }, { "path": "scripts/noshake.json", "content": "{\"ignoreImport\": [\"Init\", \"Lean\"],\n \"ignore\":\n {\"Batteries.Tactic.Lint.Simp\":\n [\"Batteries.Tactic.OpenPrivate\", \"Batteries.Util.LibraryNote\"],\n \"Batteries.Tactic.Exact\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Logic\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Linter.UnreachableTactic\":\n [\"Batteries.Tactic.Unreachable\", \"Lean.Parser.Syntax\"],\n \"Batteries.Lean.Util.EnvSearch\": [\"Batteries.Tactic.Lint.Misc\"],\n \"Batteries.Lean.Meta.Simp\": [\"Batteries.Tactic.OpenPrivate\"],\n \"Batteries.Data.UnionFind.Basic\":\n [\"Batteries.Tactic.Lint.Misc\", \"Batteries.Tactic.SeqFocus\"],\n \"Batteries.Data.String.Matcher\": [\"Batteries.Data.String.Basic\"],\n \"Batteries.Data.String.Lemmas\":\n [\"Batteries.Data.String.Basic\",\n \"Batteries.Tactic.Lint.Misc\",\n \"Std.Classes.Ord.String\"],\n \"Batteries.Data.Rat.Lemmas\": [\"Batteries.Tactic.SeqFocus\"],\n \"Batteries.Data.Range.Lemmas\":\n [\"Batteries.Tactic.Alias\", \"Batteries.Tactic.SeqFocus\"],\n \"Batteries.Data.RBMap.Lemmas\": [\"Batteries.Tactic.Basic\"],\n \"Batteries.Data.RBMap.Basic\": [\"Batteries.Tactic.Lint.Misc\"],\n \"Batteries.Data.Nat.Lemmas\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.Nat.Bisect\": [\"Batteries.Tactic.Basic\"],\n \"Batteries.Data.List.Lemmas\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.HashMap.Lemmas\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.HashMap.Basic\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.Fin.Lemmas\": [\"Batteries.Util.ProofWanted\"],\n \"Batteries.Data.Fin.Fold\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.Char.AsciiCasing\": [\"Batteries.Tactic.Basic\"],\n \"Batteries.Data.BitVec.Lemmas\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.Array.Pairwise\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Data.Array.Monadic\": [\"Batteries.Util.ProofWanted\"],\n \"Batteries.Data.Array.Lemmas\": [\"Batteries.Data.List.Lemmas\"],\n \"Batteries.Control.Nondet.Basic\": [\"Batteries.Tactic.Lint.Misc\"],\n \"Batteries.Control.Monad\": [\"Batteries.Tactic.Alias\"],\n \"Batteries.Control.AlternativeMonad\": [\"Batteries.Control.Lemmas\"],\n \"Batteries.CodeAction.Misc\": [\"Lean.Server.CodeActions.Provider\"],\n \"Batteries.Classes.Order\":\n [\"Batteries.Tactic.Basic\", \"Batteries.Tactic.SeqFocus\"]}}\n" }, { "path": "scripts/runLinter.lean", "content": "import Batteries.Tactic.Lint\nimport Batteries.Data.Array.Basic\nimport Lake.CLI.Main\n\nopen Lean Core Elab Command Batteries.Tactic.Lint\nopen System (FilePath)\n\n/-- The list of `nolints` pulled from the `nolints.json` file -/\nabbrev NoLints := Array (Name × Name)\n\n/-- Read the given file path and deserialize it as JSON. -/\ndef readJsonFile (α) [FromJson α] (path : System.FilePath) : IO α := do\n let _ : MonadExceptOf String IO := ⟨throw ∘ IO.userError, fun x _ => x⟩\n liftExcept <| fromJson? <|← liftExcept <| Json.parse <|← IO.FS.readFile path\n\n/-- Serialize the given value `a : α` to the file as JSON. -/\ndef writeJsonFile [ToJson α] (path : System.FilePath) (a : α) : IO Unit :=\n IO.FS.writeFile path <| toJson a |>.pretty.push '\\n'\n\nopen Lake\n\n/-- Returns the root modules of `lean_exe` or `lean_lib` default targets in the Lake workspace. -/\ndef resolveDefaultRootModules : IO (Array Name) := do\n -- load the Lake workspace\n let (elanInstall?, leanInstall?, lakeInstall?) ← findInstall?\n let config ← MonadError.runEIO <| mkLoadConfig { elanInstall?, leanInstall?, lakeInstall? }\n let some workspace ← loadWorkspace config |>.toBaseIO\n | throw <| IO.userError \"failed to load Lake workspace\"\n\n -- build an array of all root modules of `lean_exe` and `lean_lib` default targets\n let defaultTargetModules := workspace.root.defaultTargets.flatMap fun target =>\n if let some lib := workspace.root.findLeanLib? target then\n lib.roots\n else if let some exe := workspace.root.findLeanExe? target then\n #[exe.config.root]\n else\n #[]\n return defaultTargetModules\n\n/-- Arguments for `runLinter`. -/\nstructure LinterConfig where\n /-- Whether to update nolints. Default is `false`; set to `true` with `--update`. -/\n updateNoLints : Bool := false\n /-- Whether to throw an error if necessary oleans are not already present (as opposed to building\n them). Default is `false`; set to `true` with `--no-build`. -/\n noBuild : Bool := false\n /-- Whether to enable tracing. Default is `false`; set to `true` with `--trace` or `-v`. -/\n trace := false\n\n@[always_inline, inline]\nprivate def Except.consError (e : ε) : Except (List ε) α → Except (List ε) α\n | Except.error errs => Except.error <| e :: errs\n | Except.ok _ => Except.error [e]\n\n/--\nParse args list for `runLinter` and return the config and specified module arguments. Default\nconfig settings are determined by the default values for fields of `LinterConfig`.\n\nThrows an exception if unable to parse the arguments.\nReturns `none` for the specified module if no modules are specified.-/\ndef parseLinterArgs (args : List String) :\n Except (List String) (LinterConfig × List Name) :=\n go {} [] args\nwhere\n /-- Traverses the list, handling the non-flag elements as modules and erroring if parsing fails. -/\n go (parsed : LinterConfig) (mods: List Name) : List String → Except (List String) (LinterConfig × List Name)\n | arg :: rest =>\n if let some parsed := parseArg parsed arg then\n go parsed mods rest\n else\n match arg.toName with \n | .anonymous => Except.error [s!\"could not parse argument '{arg}'\"]\n | mod => go parsed (mod :: mods) rest\n | [] => Except.ok (parsed, mods.reverse)\n\n /-- Parses a single config argument. -/\n parseArg (parsed : LinterConfig) : String → Option LinterConfig\n | \"--update\" => some { parsed with updateNoLints := true }\n | \"--no-build\" => some { parsed with noBuild := true }\n | \"--trace\"\n | \"-v\" => some { parsed with trace := true }\n | _ => none\n\n/--\nReturn an array of the modules to lint.\n\nIf `specifiedModules` is not empty, return an array containing only `specifiedModule`.\nOtherwise, resolve the default root modules from the Lake workspace. -/\ndef determineModulesToLint (specifiedModules : List Name) : IO (Array Name) := do\n match specifiedModules with\n | [] =>\n println!\"Automatically detecting modules to lint\"\n let defaultModules ← resolveDefaultRootModules\n println!\"Default modules: {defaultModules}\"\n return defaultModules\n | modules =>\n println!\"Running linter on specified modules: {modules}\"\n return modules.toArray\n\n/-- Run the Batteries linter on a given module and update the linter if `update` is `true`. -/\nunsafe def runLinterOnModule (cfg : LinterConfig) (module : Name) : IO Unit := do\n let { updateNoLints, noBuild, trace } := cfg\n initSearchPath (← findSysroot)\n let rec\n /-- Builds `module` if the filepath `olean` does not exist. Throws if olean is not found and\n `noBuild := true`. -/\n buildIfNeeded (module : Name) : IO Unit := do\n let olean ← findOLean module\n unless (← olean.pathExists) do\n if noBuild then\n IO.eprintln s!\"[{module}] Could not find olean for module `{module}` at given path:\\n \\\n {olean}\"\n IO.Process.exit 1\n else\n if trace then\n IO.println s!\"[{module}] Could not find olean for module `{module}` at given path:\\n \\\n {olean}\\n\\\n [{module}] Building `{module}`.\"\n -- run `lake build +module` (and ignore result) if the file hasn't been built yet\n let child ← IO.Process.spawn {\n cmd := (← IO.getEnv \"LAKE\").getD \"lake\"\n args := #[\"build\", s!\"+{module}\"]\n stdin := .null\n }\n _ ← child.wait\n -- No need to trace on completion, lake's \"Build completed successfully\" reaches stdout\n\n buildIfNeeded module\n -- If the linter is being run on a target that doesn't import `Batteries.Tactic.List`,\n -- the linters are ineffective. So we import it here.\n let lintModule := `Batteries.Tactic.Lint\n buildIfNeeded lintModule\n let nolintsFile : FilePath := \"scripts/nolints.json\"\n let nolints ← if ← nolintsFile.pathExists then\n readJsonFile NoLints nolintsFile\n else\n pure #[]\n unsafe Lean.enableInitializersExecution\n let env ← importModules #[module, lintModule] {} (trustLevel := 1024) (loadExts := true)\n let mut opts : Options := {}\n -- Propagate `trace` to `CoreM`\n if trace then\n opts := opts.setBool `trace.Batteries.Lint true\n let ctx := {\n fileName := \"\"\n fileMap := default\n options := opts }\n let state := { env }\n Prod.fst <$> (CoreM.toIO · ctx state) do\n traceLint s!\"Starting lint...\" (inIO := true) (currentModule := module)\n let decls ← getDeclsInPackage module.getRoot\n let linters ← getChecks (slow := true) (runAlways := none) (runOnly := none)\n let results ← lintCore decls linters (inIO := true) (currentModule := module)\n if updateNoLints then\n traceLint s!\"Updating nolints file at {nolintsFile}\" (inIO := true) (currentModule := module)\n writeJsonFile (α := NoLints) nolintsFile <|\n .qsort (lt := fun (a, b) (c, d) => a.lt c || (a == c && b.lt d)) <|\n .flatten <| results.map fun (linter, decls) =>\n decls.fold (fun res decl _ => res.push (linter.name, decl)) #[]\n if trace then\n let mut nolintTally : Std.HashMap Name Nat := {}\n for (linter, _) in nolints do\n nolintTally := nolintTally.alter linter fun\n | none => some 1\n | some n => some (n+1)\n let msgs := nolintTally.toList.map fun (linter, n) => s!\"{linter}: {n}\"\n IO.println s!\"[{module}] {nolintsFile} summary (number of nolints per linter):\\n \\\n {\"\\n \".intercalate msgs}\"\n let results := results.map fun (linter, decls) =>\n .mk linter <| nolints.foldl (init := decls) fun decls (linter', decl') =>\n if linter.name == linter' then decls.erase decl' else decls\n let failed := results.any (!·.2.isEmpty)\n if failed then\n let fmtResults ←\n formatLinterResults results decls (groupByFilename := true) (useErrorFormat := true)\n s!\"in {module}\" (runSlowLinters := true) .medium linters.size\n IO.print (← fmtResults.toString)\n IO.Process.exit 1\n else\n IO.println s!\"-- Linting passed for {module}.\"\n\n/--\nUsage: `runLinter [--update] [--trace | -v] [--no-build] [Batteries.Data.Nat.Basic]...`\n\nRuns the linters on all declarations in the given modules\n(or all root modules of Lake `lean_lib` and `lean_exe` default targets if no module is specified).\n\nIf `--update` is set, the `nolints` file is updated to remove any declarations that no longer need\nto be nolinted.\n\nIf `--trace` (or, synonymously, `-v`) is set, tracing will be enabled and logged to stdout.\n\nIf `--no-build` is set, `runLinter` will throw if either the oleans to be linted or the oleans\nwhich drive the linting itself are not present.\n-/\nunsafe def main (args : List String) : IO Unit := do\n let linterArgs := parseLinterArgs args\n let (cfg, mods) ← match linterArgs with\n | Except.ok args => pure args\n | Except.error msgs => do\n IO.eprintln s!\"Error parsing args:\\n {\"\\n \".intercalate msgs}\"\n IO.eprintln \"Usage: \\\n runLinter [--update] [--trace | -v] [--no-build] [Batteries.Data.Nat.Basic]...\"\n IO.Process.exit 1\n\n let modulesToLint ← determineModulesToLint mods\n\n modulesToLint.forM <| runLinterOnModule cfg\n -- TODO: Remove manual Process.exit\n -- We are doing this to shortcut around a race in Lean's IO finalizers that we have observed in Mathlib CI\n -- (https://leanprover.zulipchat.com/#narrow/channel/287929-mathlib4/topic/slow.20linting.20step.20CI.3F/with/568830914)\n IO.Process.exit 0\n" }, { "path": "scripts/updateBatteries.sh", "content": "#!/bin/sh\nset -e\n# This command updates the `Batteries.lean` file to include a list of all files\n# in the `Batteries` directory.\n__LEAN_BATTERIES_AUTOFIX_IMPORTS=true lake env lean scripts/check_imports.lean\n" } ]