diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 61af30e96e..8f8349df89 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -54,4 +54,4 @@ jobs: - name: Don't 'import Lean', use precise imports if: always() run: | - ! (find . -name "*.lean" ! -path "./test/import_lean.lean" -type f -print0 | xargs -0 grep -E -n '^import Lean$') + ! (find . -name "*.lean" ! -path "./BatteriesTest/import_lean.lean" -type f -print0 | xargs -0 grep -E -n '^import Lean$') diff --git a/.github/workflows/docs-deploy.yml b/.github/workflows/docs-deploy.yml new file mode 100644 index 0000000000..39746f19d3 --- /dev/null +++ b/.github/workflows/docs-deploy.yml @@ -0,0 +1,38 @@ +name: Deploy Docs + +on: + workflow_dispatch: + schedule: + - cron: '0 10 * * *' # daily (UTC 10:00) + +permissions: + contents: write + +jobs: + deploy-docs: + runs-on: ubuntu-latest + if: github.repository_owner == 'leanprover-community' + steps: + + - name: Checkout + uses: actions/checkout@v4 + + - name: Install Lean + uses: leanprover/lean-action@v1 + with: + test: false + lint: false + use-github-cache: true + + - name: Build Docs + working-directory: docs + run: lake build -q Batteries:docs + + - name: Deploy Docs + run: | + git config user.name "leanprover-community-batteries-bot" + git config user.email "leanprover-community-batteries-bot@users.noreply.github.com" + git checkout -b docs + git add docs/doc docs/doc-data + git commit -m "chore: generate docs" + git push origin docs --force diff --git a/.github/workflows/docs-release.yml b/.github/workflows/docs-release.yml new file mode 100644 index 0000000000..2926a31340 --- /dev/null +++ b/.github/workflows/docs-release.yml @@ -0,0 +1,46 @@ +name: Release Docs + +on: + push: + tags: + - "v[0-9]+.[0-9]+.[0-9]+" + - "v[0-9]+.[0-9]+.[0-9]+-rc[0-9]+" + +permissions: + contents: write + +jobs: + build-docs: + runs-on: ubuntu-latest + if: github.repository_owner == 'leanprover-community' + steps: + + - name: Checkout + uses: actions/checkout@v4 + + - name: Install Lean + uses: leanprover/lean-action@v1 + with: + test: false + lint: false + use-github-cache: true + + - name: Build Docs + working-directory: docs + run: lake build -q Batteries:docs + + - name: Compress Docs + working-directory: docs + env: + TAG_NAME: ${{ github.ref_name }} + run: | + tar -czf docs-${TAG_NAME}.tar.gz doc doc-data + zip -rq docs-${TAG_NAME}.zip doc doc-data + + - name: Release Docs + uses: softprops/action-gh-release@v2 + with: + files: | + docs/docs-${{ github.ref_name }}.tar.gz + docs/docs-${{ github.ref_name }}.zip + fail_on_unmatched_files: true diff --git a/.github/workflows/labels-from-status.yml b/.github/workflows/labels-from-status.yml new file mode 100644 index 0000000000..8ad37be1ae --- /dev/null +++ b/.github/workflows/labels-from-status.yml @@ -0,0 +1,62 @@ +# This workflow assigns `awaiting-review` or `WIP` labels to new PRs, and it removes +# `awaiting-review`, `awaiting-author`, or `WIP` label from closed PRs. +# It does not modify labels for open PRs that already have one of the `awaiting-review`, +# `awaiting-author`, or `WIP` labels. + +name: Label PR from status change + +permissions: + contents: read + pull-requests: write + +on: + pull_request: + types: + - closed + - opened + - reopened + - converted_to_draft + - ready_for_review + branches: + - main + +jobs: + auto-label: + if: github.repository_owner == 'leanprover-community' + runs-on: ubuntu-latest + steps: + + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + + - name: Unlabel closed PR + if: github.event.pull_request.state == 'closed' + uses: actions-ecosystem/action-remove-labels@v1 + with: + labels: | + WIP + awaiting-author + awaiting-review + + - name: Label unlabeled draft PR as WIP + if: | + github.event.pull_request.state == 'open' && + github.event.pull_request.draft && + ! contains(github.event.pull_request.labels.*.name, 'awaiting-author') && + ! contains(github.event.pull_request.labels.*.name, 'awaiting-review') && + ! contains(github.event.pull_request.labels.*.name, 'WIP') + uses: actions-ecosystem/action-add-labels@v1 + with: + labels: WIP + + - name: Label unlabeled other PR as awaiting-review + if: | + github.event.pull_request.state == 'open' && + ! github.event.pull_request.draft && + ! contains(github.event.pull_request.labels.*.name, 'awaiting-author') && + ! contains(github.event.pull_request.labels.*.name, 'awaiting-review') && + ! contains(github.event.pull_request.labels.*.name, 'WIP') + uses: actions-ecosystem/action-add-labels@v1 + with: + labels: awaiting-review diff --git a/.github/workflows/test_mathlib.yml b/.github/workflows/test_mathlib.yml index 15062cb521..3bb9c6dd71 100644 --- a/.github/workflows/test_mathlib.yml +++ b/.github/workflows/test_mathlib.yml @@ -12,15 +12,22 @@ jobs: runs-on: ubuntu-latest if: github.event.workflow_run.conclusion == 'success' && github.event.workflow_run.event == 'pull_request' && github.repository == 'leanprover-community/batteries' steps: - - name: Retrieve information about the original workflow - uses: potiuk/get-workflow-origin@v1_1 - id: workflow-info + - name: Checkout PR + uses: actions/checkout@v4 with: - token: ${{ secrets.GITHUB_TOKEN }} - sourceRunId: ${{ github.event.workflow_run.id }} + fetch-depth: 0 + + - name: Get PR info + id: pr-info + run: | + echo "pullRequestNumber=$(gh pr list --search $SHA --json number -q '.[0].number' || echo '')" >> $GITHUB_OUTPUT + echo "targetBranch=$(gh pr list --search $SHA --json baseRefName -q '.[0].baseRefName' || echo '')" >> $GITHUB_OUTPUT + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + SHA: ${{ github.event.workflow_run.head_sha }} - name: Checkout mathlib4 repository - if: steps.workflow-info.outputs.pullRequestNumber != '' + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' uses: actions/checkout@v4 with: repository: leanprover-community/mathlib4 @@ -28,37 +35,21 @@ jobs: ref: master fetch-depth: 0 - - name: install elan + - name: Install elan + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' run: | set -o pipefail curl -sSfL https://github.com/leanprover/elan/releases/download/v3.0.0/elan-x86_64-unknown-linux-gnu.tar.gz | tar xz ./elan-init -y --default-toolchain none echo "$HOME/.elan/bin" >> "${GITHUB_PATH}" - - name: Retrieve PR information - if: steps.workflow-info.outputs.pullRequestNumber != '' - id: pr-info - uses: actions/github-script@v6 - env: - PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }} - with: - script: | - const prNumber = process.env.PR_NUMBER; - const { data: pr } = await github.rest.pulls.get({ - owner: context.repo.owner, - repo: context.repo.repo, - pull_number: prNumber - }); - core.exportVariable('HEAD_REPO', pr.head.repo.full_name); - core.exportVariable('HEAD_BRANCH', pr.head.ref); - - name: Check if tag exists - if: steps.workflow-info.outputs.pullRequestNumber != '' + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' id: check_mathlib_tag env: - PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }} - HEAD_REPO: ${{ env.HEAD_REPO }} - HEAD_BRANCH: ${{ env.HEAD_BRANCH }} + PR_NUMBER: ${{ steps.pr-info.outputs.pullRequestNumber }} + HEAD_REPO: ${{ github.event.workflow_run.head_repository.full_name }} + HEAD_BRANCH: ${{ github.event.workflow_run.head_branch }} run: | git config user.name "leanprover-community-mathlib4-bot" git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com" @@ -74,7 +65,7 @@ jobs: echo "Branch does not exist, creating it." git switch -c batteries-pr-testing-$PR_NUMBER "$BASE" - # Use the fork and branch name to modify the lakefile.lean + # Modify the lakefile.lean with the fork and branch name sed -i "s,require \"leanprover-community\" / \"batteries\" @ git \".\+\",require \"leanprover-community\" / \"batteries\" from git \"https://github.com/$HEAD_REPO\" @ \"$HEAD_BRANCH\",g" lakefile.lean lake update batteries @@ -90,8 +81,8 @@ jobs: fi - name: Push changes - if: steps.workflow-info.outputs.pullRequestNumber != '' + if: steps.pr-info.outputs.pullRequestNumber != '' && steps.pr-info.outputs.targetBranch == 'main' env: - PR_NUMBER: ${{ steps.workflow-info.outputs.pullRequestNumber }} + PR_NUMBER: ${{ steps.pr-info.outputs.pullRequestNumber }} run: | git push origin batteries-pr-testing-$PR_NUMBER diff --git a/Batteries.lean b/Batteries.lean index aa1f557133..5db6bc2f6f 100644 --- a/Batteries.lean +++ b/Batteries.lean @@ -32,13 +32,13 @@ import Batteries.Data.PairingHeap import Batteries.Data.RBMap import Batteries.Data.Range import Batteries.Data.Rat +import Batteries.Data.Stream import Batteries.Data.String -import Batteries.Data.Sum import Batteries.Data.UInt import Batteries.Data.UnionFind import Batteries.Data.Vector import Batteries.Lean.AttributeExtra -import Batteries.Lean.Delaborator +import Batteries.Lean.EStateM import Batteries.Lean.Except import Batteries.Lean.Expr import Batteries.Lean.Float @@ -46,9 +46,8 @@ import Batteries.Lean.HashMap import Batteries.Lean.HashSet import Batteries.Lean.IO.Process import Batteries.Lean.Json -import Batteries.Lean.Meta.AssertHypotheses +import Batteries.Lean.LawfulMonad import Batteries.Lean.Meta.Basic -import Batteries.Lean.Meta.Clear import Batteries.Lean.Meta.DiscrTree import Batteries.Lean.Meta.Expr import Batteries.Lean.Meta.Inaccessible @@ -62,6 +61,7 @@ import Batteries.Lean.NameMapAttribute import Batteries.Lean.PersistentHashMap import Batteries.Lean.PersistentHashSet import Batteries.Lean.Position +import Batteries.Lean.SatisfiesM import Batteries.Lean.Syntax import Batteries.Lean.System.IO import Batteries.Lean.TagAttribute @@ -70,13 +70,12 @@ import Batteries.Linter import Batteries.Linter.UnnecessarySeqFocus import Batteries.Linter.UnreachableTactic import Batteries.Logic -import Batteries.StdDeprecations import Batteries.Tactic.Alias import Batteries.Tactic.Basic import Batteries.Tactic.Case -import Batteries.Tactic.Classical import Batteries.Tactic.Congr import Batteries.Tactic.Exact +import Batteries.Tactic.HelpCmd import Batteries.Tactic.Init import Batteries.Tactic.Instances import Batteries.Tactic.Lemma @@ -94,12 +93,13 @@ import Batteries.Tactic.PrintPrefix import Batteries.Tactic.SeqFocus import Batteries.Tactic.ShowUnused import Batteries.Tactic.SqueezeScope +import Batteries.Tactic.Trans import Batteries.Tactic.Unreachable import Batteries.Tactic.Where -import Batteries.Test.Internal.DummyLabelAttr import Batteries.Util.Cache import Batteries.Util.ExtendedBinder import Batteries.Util.LibraryNote +import Batteries.Util.Panic import Batteries.Util.Pickle import Batteries.Util.ProofWanted import Batteries.WF diff --git a/Batteries/Classes/SatisfiesM.lean b/Batteries/Classes/SatisfiesM.lean index c8fc1f0be9..834cbbea68 100644 --- a/Batteries/Classes/SatisfiesM.lean +++ b/Batteries/Classes/SatisfiesM.lean @@ -1,8 +1,11 @@ /- Copyright (c) 2022 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro +Authors: Mario Carneiro, Kim Morrison -/ +import Batteries.Lean.EStateM +import Batteries.Lean.Except +import Batteries.Tactic.Lint /-! ## SatisfiesM @@ -12,6 +15,13 @@ and enables Hoare-like reasoning over monadic expressions. For example, given a function `f : α → m β`, to say that the return value of `f` satisfies `Q` whenever the input satisfies `P`, we write `∀ a, P a → SatisfiesM Q (f a)`. +For any monad equipped with `MonadSatisfying m` +one can lift `SatisfiesM` to a monadic value in `Subtype`, +using `satisfying x h : m {a // p a}`, where `x : m α` and `h : SatisfiesM p x`. +This includes `Option`, `ReaderT`, `StateT`, and `ExceptT`, and the Lean monad stack. +(Although it is not entirely clear one should treat the Lean monad stack as lawful, +even though Lean accepts this.) + ## Notes `SatisfiesM` is not yet a satisfactory solution for verifying the behaviour of large scale monadic @@ -23,7 +33,7 @@ presumably requiring more syntactic support (and smarter `do` blocks) from Lean. Or it may be that such a solution will look different! This is an open research program, and for now one should not be overly ambitious using `SatisfiesM`. -In particular lemmas about pure operations on data structures in `batteries` except for `HashMap` +In particular lemmas about pure operations on data structures in `Batteries` except for `HashMap` should avoid `SatisfiesM` for now, so that it is easy to migrate to other approaches in future. -/ @@ -52,7 +62,7 @@ protected theorem trivial [Applicative m] [LawfulApplicative m] {x : m α} : /-- The `SatisfiesM p x` predicate is monotonic in `p`. -/ theorem imp [Functor m] [LawfulFunctor m] {x : m α} (h : SatisfiesM p x) (H : ∀ {a}, p a → q a) : SatisfiesM q x := - let ⟨x, h⟩ := h; ⟨(fun ⟨a, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ + let ⟨x, h⟩ := h; ⟨(fun ⟨_, h⟩ => ⟨_, H h⟩) <$> x, by rw [← h, ← comp_map]; rfl⟩ /-- `SatisfiesM` distributes over `<$>`, general version. -/ protected theorem map [Functor m] [LawfulFunctor m] {x : m α} @@ -158,25 +168,133 @@ end SatisfiesM ⟨by revert x; intro | .ok _, ⟨.ok ⟨_, h⟩, rfl⟩, _, rfl => exact h, fun h => match x with | .ok a => ⟨.ok ⟨a, h _ rfl⟩, rfl⟩ | .error e => ⟨.error e, rfl⟩⟩ +theorem SatisfiesM_EStateM_eq : + SatisfiesM (m := EStateM ε σ) p x ↔ ∀ s a s', x.run s = .ok a s' → p a := by + constructor + · rintro ⟨x, rfl⟩ s a s' h + match w : x.run s with + | .ok a s' => simp at h; exact h.1 + | .error e s' => simp [w] at h + · intro w + refine ⟨?_, ?_⟩ + · intro s + match q : x.run s with + | .ok a s' => exact .ok ⟨a, w s a s' q⟩ s' + | .error e s' => exact .error e s' + · ext s + rw [EStateM.run_map, EStateM.run] + split <;> simp_all + @[simp] theorem SatisfiesM_ReaderT_eq [Monad m] : - SatisfiesM (m := ReaderT ρ m) p x ↔ ∀ s, SatisfiesM p (x s) := + SatisfiesM (m := ReaderT ρ m) p x ↔ ∀ s, SatisfiesM p (x.run s) := (exists_congr fun a => by exact ⟨fun eq _ => eq ▸ rfl, funext⟩).trans Classical.skolem.symm theorem SatisfiesM_StateRefT_eq [Monad m] : - SatisfiesM (m := StateRefT' ω σ m) p x ↔ ∀ s, SatisfiesM p (x s) := by simp + SatisfiesM (m := StateRefT' ω σ m) p x ↔ ∀ s, SatisfiesM p (x s) := by simp [ReaderT.run] @[simp] theorem SatisfiesM_StateT_eq [Monad m] [LawfulMonad m] : - SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x s) := by + SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x.run s) := by + change SatisfiesM (m := StateT ρ m) (α := α) p x ↔ ∀ s, SatisfiesM (m := m) (p ·.1) (x s) refine .trans ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, h⟩ => ?_⟩ Classical.skolem.symm · refine ⟨fun s => (fun ⟨⟨a, h⟩, s'⟩ => ⟨⟨a, s'⟩, h⟩) <$> f s, fun s => ?_⟩ rw [← comp_map, map_eq_pure_bind]; rfl · refine ⟨fun s => (fun ⟨⟨a, s'⟩, h⟩ => ⟨⟨a, h⟩, s'⟩) <$> f s, funext fun s => ?_⟩ - show _ >>= _ = _; simp [map_eq_pure_bind, ← h] + show _ >>= _ = _; simp [← h] @[simp] theorem SatisfiesM_ExceptT_eq [Monad m] [LawfulMonad m] : - SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x := by + SatisfiesM (m := ExceptT ρ m) (α := α) p x ↔ + SatisfiesM (m := m) (∀ a, · = .ok a → p a) x.run := by + change _ ↔ SatisfiesM (m := m) (∀ a, · = .ok a → p a) x refine ⟨fun ⟨f, eq⟩ => eq ▸ ?_, fun ⟨f, eq⟩ => eq ▸ ?_⟩ · exists (fun | .ok ⟨a, h⟩ => ⟨.ok a, fun | _, rfl => h⟩ | .error e => ⟨.error e, nofun⟩) <$> f show _ = _ >>= _; rw [← comp_map, map_eq_pure_bind]; congr; funext a; cases a <;> rfl · exists ((fun | ⟨.ok a, h⟩ => .ok ⟨a, h _ rfl⟩ | ⟨.error e, _⟩ => .error e) <$> f : m _) - show _ >>= _ = _; simp [← comp_map, map_eq_pure_bind]; congr; funext ⟨a, h⟩; cases a <;> rfl + show _ >>= _ = _; simp [← comp_map, ← bind_pure_comp]; congr; funext ⟨a, h⟩; cases a <;> rfl + +/-- +If a monad has `MonadSatisfying m`, then we can lift a `h : SatisfiesM (m := m) p x` predicate +to monadic value `satisfying x p : m { x // p x }`. + +Reader, state, and exception monads have `MonadSatisfying` instances if the base monad does. +-/ +class MonadSatisfying (m : Type u → Type v) [Functor m] [LawfulFunctor m] where + /-- Lift a `SatisfiesM` predicate to a monadic value. -/ + satisfying {p : α → Prop} {x : m α} (h : SatisfiesM (m := m) p x) : m {a // p a} + /-- The value of the lifted monadic value is equal to the original monadic value. -/ + val_eq {p : α → Prop} {x : m α} (h : SatisfiesM (m := m) p x) : Subtype.val <$> satisfying h = x + +export MonadSatisfying (satisfying) + +namespace MonadSatisfying + +instance : MonadSatisfying Id where + satisfying {α p x} h := ⟨x, by obtain ⟨⟨_, h⟩, rfl⟩ := h; exact h⟩ + val_eq {α p x} h := rfl + +instance : MonadSatisfying Option where + satisfying {α p x?} h := + have h' := SatisfiesM_Option_eq.mp h + match x? with + | none => none + | some x => some ⟨x, h' x rfl⟩ + val_eq {α p x?} h := by cases x? <;> simp + +instance : MonadSatisfying (Except ε) where + satisfying {α p x?} h := + have h' := SatisfiesM_Except_eq.mp h + match x? with + | .ok x => .ok ⟨x, h' x rfl⟩ + | .error e => .error e + val_eq {α p x?} h := by cases x? <;> simp + +-- This will be redundant after nightly-2024-11-08. +attribute [ext] ReaderT.ext + +instance [Monad m] [LawfulMonad m][MonadSatisfying m] : MonadSatisfying (ReaderT ρ m) where + satisfying {α p x} h := + have h' := SatisfiesM_ReaderT_eq.mp h + fun r => satisfying (h' r) + val_eq {α p x} h := by + have h' := SatisfiesM_ReaderT_eq.mp h + ext r + rw [ReaderT.run_map, ← MonadSatisfying.val_eq (h' r)] + rfl + +instance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (StateRefT' ω σ m) := + inferInstanceAs <| MonadSatisfying (ReaderT _ _) + +-- This will be redundant after nightly-2024-11-08. +attribute [ext] StateT.ext + +instance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (StateT ρ m) where + satisfying {α p x} h := + have h' := SatisfiesM_StateT_eq.mp h + fun r => (fun ⟨⟨a, r'⟩, h⟩ => ⟨⟨a, h⟩, r'⟩) <$> satisfying (h' r) + val_eq {α p x} h := by + have h' := SatisfiesM_StateT_eq.mp h + ext r + rw [← MonadSatisfying.val_eq (h' r), StateT.run_map] + simp [StateT.run] + +instance [Monad m] [LawfulMonad m] [MonadSatisfying m] : MonadSatisfying (ExceptT ε m) where + satisfying {α p x} h := + let x' := satisfying (SatisfiesM_ExceptT_eq.mp h) + ExceptT.mk ((fun ⟨y, w⟩ => y.pmap fun a h => ⟨a, w _ h⟩) <$> x') + val_eq {α p x} h:= by + ext + rw [← MonadSatisfying.val_eq (SatisfiesM_ExceptT_eq.mp h)] + simp + +instance : MonadSatisfying (EStateM ε σ) where + satisfying {α p x} h := + have h' := SatisfiesM_EStateM_eq.mp h + fun s => match w : x.run s with + | .ok a s' => .ok ⟨a, h' s a s' w⟩ s' + | .error e s' => .error e s' + val_eq {α p x} h := by + ext s + rw [EStateM.run_map, EStateM.run] + simp only + split <;> simp_all + +end MonadSatisfying diff --git a/Batteries/CodeAction/Misc.lean b/Batteries/CodeAction/Misc.lean index 4ad0a8099d..1ff2505a76 100644 --- a/Batteries/CodeAction/Misc.lean +++ b/Batteries/CodeAction/Misc.lean @@ -3,11 +3,9 @@ Copyright (c) 2023 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import Lean.Elab.BuiltinTerm -import Lean.Elab.BuiltinNotation +import Lean.Elab.Tactic.Induction import Batteries.Lean.Position import Batteries.CodeAction.Attr -import Lean.Meta.Tactic.TryThis import Lean.Server.CodeActions.Provider /-! @@ -236,28 +234,39 @@ def removeAfterDoneAction : TacticCodeAction := fun _ _ _ stk node => do pure #[{ eager }] /-- -Similar to `getElabInfo`, but returns the names of binders instead of just the numbers; +Similar to `getElimExprInfo`, but returns the names of binders instead of just the numbers; intended for code actions which need to name the binders. -/ -def getElimNames (inductName declName : Name) : MetaM (Array (Name × Array Name)) := do - let inductVal ← getConstInfoInduct inductName - let decl ← getConstInfo declName - forallTelescopeReducing decl.type fun xs type => do +def getElimExprNames (elimType : Expr) : MetaM (Array (Name × Array Name)) := do + -- let inductVal ← getConstInfoInduct inductName + -- let decl ← getConstInfo declName + forallTelescopeReducing elimType fun xs type => do let motive := type.getAppFn let targets := type.getAppArgs + let motiveType ← inferType motive let mut altsInfo := #[] - for i in [inductVal.numParams:xs.size] do - let x := xs[i]! + for _h : i in [:xs.size] do + let x := xs[i] if x != motive && !targets.contains x then let xDecl ← x.fvarId!.getDecl - let args ← forallTelescopeReducing xDecl.type fun args _ => do - let lctx ← getLCtx - pure <| args.filterMap fun y => - let yDecl := (lctx.find? y.fvarId!).get! - if yDecl.binderInfo.isExplicit then some yDecl.userName else none - altsInfo := altsInfo.push (xDecl.userName, args) + if xDecl.binderInfo.isExplicit then + let args ← forallTelescopeReducing xDecl.type fun args _ => do + let lctx ← getLCtx + pure <| args.filterMap fun y => + let yDecl := (lctx.find? y.fvarId!).get! + if yDecl.binderInfo.isExplicit then some yDecl.userName else none + altsInfo := altsInfo.push (xDecl.userName, args) pure altsInfo +/-- Finds the `TermInfo` for an elaborated term `stx`. -/ +def findTermInfo? (node : InfoTree) (stx : Term) : Option TermInfo := + match node.findInfo? fun + | .ofTermInfo i => i.stx.getKind == stx.raw.getKind && i.stx.getRange? == stx.raw.getRange? + | _ => false + with + | some (.ofTermInfo info) => pure info + | _ => none + /-- Invoking tactic code action "Generate an explicit pattern match for 'induction'" in the following: @@ -278,18 +287,39 @@ It also works for `cases`. @[tactic_code_action Parser.Tactic.cases Parser.Tactic.induction] def casesExpand : TacticCodeAction := fun _ snap ctx _ node => do let .node (.ofTacticInfo info) _ := node | return #[] - let (discr, induction, alts) ← match info.stx with - | `(tactic| cases $[$_ :]? $e $[$alts:inductionAlts]?) => pure (e, false, alts) - | `(tactic| induction $e $[generalizing $_*]? $[$alts:inductionAlts]?) => pure (e, true, alts) + let (targets, induction, using_, alts) ← match info.stx with + | `(tactic| cases $[$[$_ :]? $targets],* $[using $u]? $(alts)?) => + pure (targets, false, u, alts) + | `(tactic| induction $[$targets],* $[using $u]? $[generalizing $_*]? $(alts)?) => + pure (targets, true, u, alts) | _ => return #[] - if let some alts := alts then - -- this detects the incomplete syntax `cases e with` - unless alts.raw[2][0][0][0][0].isMissing do return #[] - let some (.ofTermInfo discrInfo) := node.findInfo? fun i => - i.stx.getKind == discr.raw.getKind && i.stx.getRange? == discr.raw.getRange? - | return #[] - let .const name _ := (← discrInfo.runMetaM ctx (do whnf (← inferType discrInfo.expr))).getAppFn + let some discrInfos := targets.mapM (findTermInfo? node) | return #[] + let some discr₀ := discrInfos[0]? | return #[] + let mut some ctors ← discr₀.runMetaM ctx do + let targets := discrInfos.map (·.expr) + match using_ with + | none => + if Tactic.tactic.customEliminators.get (← getOptions) then + if let some elimName ← getCustomEliminator? targets induction then + return some (← getElimExprNames (← getConstInfo elimName).type) + matchConstInduct (← whnf (← inferType discr₀.expr)).getAppFn + (fun _ => failure) fun val _ => do + let elimName := if induction then mkRecName val.name else mkCasesOnName val.name + return some (← getElimExprNames (← getConstInfo elimName).type) + | some u => + let some info := findTermInfo? node u | return none + return some (← getElimExprNames (← inferType info.expr)) | return #[] + let mut fallback := none + if let some alts := alts then + if let `(Parser.Tactic.inductionAlts| with $(_)? $alts*) := alts then + for alt in alts do + match alt with + | `(Parser.Tactic.inductionAlt| | _ $_* => $fb) => fallback := fb.raw.getRange? + | `(Parser.Tactic.inductionAlt| | $id:ident $_* => $_) => + ctors := ctors.filter (fun x => x.1 != id.getId) + | _ => pure () + if ctors.isEmpty then return #[] let tacName := info.stx.getKind.updatePrefix .anonymous let eager := { title := s!"Generate an explicit pattern match for '{tacName}'." @@ -301,15 +331,21 @@ def casesExpand : TacticCodeAction := fun _ snap ctx _ node => do lazy? := some do let tacPos := info.stx.getPos?.get! let endPos := doc.meta.text.utf8PosToLspPos info.stx.getTailPos?.get! - let startPos := if alts.isSome then - let stx' := info.stx.setArg (if induction then 4 else 3) mkNullNode - doc.meta.text.utf8PosToLspPos stx'.getTailPos?.get! - else endPos - let elimName := if induction then mkRecName name else mkCasesOnName name - let ctors ← discrInfo.runMetaM ctx (getElimNames name elimName) - let newText := if ctors.isEmpty then "" else Id.run do - let mut str := " with" - let indent := "\n".pushn ' ' (findIndentAndIsStart doc.meta.text.source tacPos).1 + let indent := "\n".pushn ' ' (findIndentAndIsStart doc.meta.text.source tacPos).1 + let (startPos, str') := if alts.isSome then + let stx' := if fallback.isSome then + info.stx.modifyArg (if induction then 4 else 3) + (·.modifyArg 0 (·.modifyArg 2 (·.modifyArgs (·.filter fun s => + !(s matches `(Parser.Tactic.inductionAlt| | _ $_* => $_)))))) + else info.stx + (doc.meta.text.utf8PosToLspPos stx'.getTailPos?.get!, "") + else (endPos, " with") + let fallback := if let some ⟨startPos, endPos⟩ := fallback then + doc.meta.text.source.extract startPos endPos + else + "sorry" + let newText := Id.run do + let mut str := str' for (name, args) in ctors do let mut ctor := toString name if let some _ := (Parser.getTokenTable snap.env).find? ctor then @@ -324,7 +360,7 @@ def casesExpand : TacticCodeAction := fun _ snap ctx _ node => do else args for arg in args do str := str ++ if arg.hasNum || arg.isInternal then " _" else s!" {arg}" - str := str ++ s!" => sorry" + str := str ++ s!" => " ++ fallback str pure { eager with edit? := some <|.ofTextEdit doc.versionedIdentifier { diff --git a/Batteries/Control/Nondet/Basic.lean b/Batteries/Control/Nondet/Basic.lean index c6d384b9dd..aa616a2857 100644 --- a/Batteries/Control/Nondet/Basic.lean +++ b/Batteries/Control/Nondet/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2023 Scott Morrison. All rights reserved. +Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Batteries.Tactic.Lint.Misc import Batteries.Data.MLList.Basic diff --git a/Batteries/Data/Array/Basic.lean b/Batteries/Data/Array/Basic.lean index ad6b8129e6..403c42d9e2 100644 --- a/Batteries/Data/Array/Basic.lean +++ b/Batteries/Data/Array/Basic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Floris van Doorn, Jannis Limperg -/ import Batteries.Data.Array.Init.Lemmas +import Batteries.Tactic.Alias /-! ## Definitions on Arrays @@ -14,10 +15,6 @@ proofs about these definitions, those are contained in other files in `Batteries namespace Array -/-- Drop `none`s from a Array, and replace each remaining `some a` with `a`. -/ -def reduceOption (l : Array (Option α)) : Array α := - l.filterMap id - /-- Check whether `xs` and `ys` are equal as sets, i.e. they contain the same elements when disregarding order and duplicates. `O(n*m)`! If your element type @@ -27,13 +24,6 @@ arrays, remove duplicates and then compare them elementwise. def equalSet [BEq α] (xs ys : Array α) : Bool := xs.all (ys.contains ·) && ys.all (xs.contains ·) -set_option linter.unusedVariables.funArgs false in -/-- -Sort an array using `compare` to compare elements. --/ -def qsortOrd [ord : Ord α] (xs : Array α) : Array α := - xs.qsort fun x y => compare x y |>.isLT - set_option linter.unusedVariables.funArgs false in /-- Returns the first minimal element among `d` and elements of the array. @@ -129,11 +119,7 @@ protected def maxI [ord : Ord α] [Inhabited α] (xs : Array α) (start := 0) (stop := xs.size) : α := xs.minI (ord := ord.opposite) start stop -/-- -`O(|join L|)`. `join L` concatenates all the arrays in `L` into one array. -* `join #[#[a], #[], #[b, c], #[d, e, f]] = #[a, b, c, d, e, f]` --/ -@[inline] def join (l : Array (Array α)) : Array α := l.foldl (· ++ ·) #[] +@[deprecated (since := "2024-10-15")] alias join := flatten /-! ### Safe Nat Indexed Array functions @@ -148,7 +134,7 @@ should prove the index bound. A proof by `get_elem_tactic` is provided as a default argument for `h`. This will perform the update destructively provided that `a` has a reference count of 1 when called. -/ -def setN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) (x : α) : Array α := +abbrev setN (a : Array α) (i : Nat) (x : α) (h : i < a.size := by get_elem_tactic) : Array α := a.set ⟨i, h⟩ x /-- @@ -157,7 +143,7 @@ Uses `get_elem_tactic` to supply a proof that the indices are in range. `hi` and `hj` are both given a default argument `by get_elem_tactic`. This will perform the update destructively provided that `a` has a reference count of 1 when called. -/ -def swapN (a : Array α) (i j : Nat) +abbrev swapN (a : Array α) (i j : Nat) (hi : i < a.size := by get_elem_tactic) (hj : j < a.size := by get_elem_tactic) : Array α := Array.swap a ⟨i,hi⟩ ⟨j, hj⟩ @@ -166,8 +152,8 @@ def swapN (a : Array α) (i j : Nat) The old entry is returned alongwith the modified vector. Automatically generates proof of `i < a.size` with `get_elem_tactic` where feasible. -/ -def swapAtN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) (x : α) : α × Array α := - swapAt a ⟨i,h⟩ x +abbrev swapAtN (a : Array α) (i : Nat) (x : α) (h : i < a.size := by get_elem_tactic) : + α × Array α := swapAt a ⟨i,h⟩ x /-- `eraseIdxN a i h` Removes the element at position `i` from a vector of length `n`. @@ -176,29 +162,23 @@ that the index is valid. This function takes worst case O(n) time because it has to backshift all elements at positions greater than i. -/ -def eraseIdxN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) : Array α := +abbrev eraseIdxN (a : Array α) (i : Nat) (h : i < a.size := by get_elem_tactic) : Array α := a.feraseIdx ⟨i, h⟩ -end Array - - -namespace Subarray - /-- -The empty subarray. +Remove the element at a given index from an array, panics if index is out of bounds. -/ -protected def empty : Subarray α where - array := #[] - start := 0 - stop := 0 - start_le_stop := Nat.le_refl 0 - stop_le_array_size := Nat.le_refl 0 +def eraseIdx! (a : Array α) (i : Nat) : Array α := + if h : i < a.size then + a.feraseIdx ⟨i, h⟩ + else + have : Inhabited (Array α) := ⟨a⟩ + panic! s!"index {i} out of bounds" + +end Array -instance : EmptyCollection (Subarray α) := - ⟨Subarray.empty⟩ -instance : Inhabited (Subarray α) := - ⟨{}⟩ +namespace Subarray /-- Check whether a subarray is empty. diff --git a/Batteries/Data/Array/Lemmas.lean b/Batteries/Data/Array/Lemmas.lean index d384a334ab..8a5544089d 100644 --- a/Batteries/Data/Array/Lemmas.lean +++ b/Batteries/Data/Array/Lemmas.lean @@ -11,30 +11,22 @@ import Batteries.Util.ProofWanted namespace Array -theorem forIn_eq_forIn_data [Monad m] +theorem forIn_eq_forIn_toList [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : - forIn as b f = forIn as.data b f := by - let rec loop : ∀ {i h b j}, j + i = as.size → - Array.forIn.loop as f i h b = forIn (as.data.drop j) b f - | 0, _, _, _, rfl => by rw [List.drop_length]; rfl - | i+1, _, _, j, ij => by - simp only [forIn.loop, Nat.add] - have j_eq : j = size as - 1 - i := by simp [← ij, ← Nat.add_assoc] - have : as.size - 1 - i < as.size := j_eq ▸ ij ▸ Nat.lt_succ_of_le (Nat.le_add_right ..) - have : as[size as - 1 - i] :: as.data.drop (j + 1) = as.data.drop j := by - rw [j_eq]; exact List.getElem_cons_drop _ _ this - simp only [← this, List.forIn_cons]; congr; funext x; congr; funext b - rw [loop (i := i)]; rw [← ij, Nat.succ_add]; rfl - conv => lhs; simp only [forIn, Array.forIn] - rw [loop (Nat.zero_add _)]; rfl + forIn as b f = forIn as.toList b f := by + cases as + simp + +@[deprecated (since := "2024-09-09")] alias forIn_eq_forIn_data := forIn_eq_forIn_toList @[deprecated (since := "2024-08-13")] alias forIn_eq_data_forIn := forIn_eq_forIn_data /-! ### zipWith / zip -/ -theorem data_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : - (as.zipWith bs f).data = as.data.zipWith f bs.data := by +theorem toList_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : + (as.zipWith bs f).toList = as.toList.zipWith f bs.toList := by let rec loop : ∀ (i : Nat) cs, i ≤ as.size → i ≤ bs.size → - (zipWithAux f as bs i cs).data = cs.data ++ (as.data.drop i).zipWith f (bs.data.drop i) := by + (zipWithAux f as bs i cs).toList = + cs.toList ++ (as.toList.drop i).zipWith f (bs.toList.drop i) := by intro i cs hia hib unfold zipWithAux by_cases h : i = as.size ∨ i = bs.size @@ -59,30 +51,33 @@ theorem data_zipWith (f : α → β → γ) (as : Array α) (bs : Array β) : have has : i < as.size := Nat.lt_of_le_of_ne hia h.1 have hbs : i < bs.size := Nat.lt_of_le_of_ne hib h.2 simp only [has, hbs, dite_true] - rw [loop (i+1) _ has hbs, Array.push_data] + rw [loop (i+1) _ has hbs, Array.push_toList] have h₁ : [f as[i] bs[i]] = List.zipWith f [as[i]] [bs[i]] := rfl - let i_as : Fin as.data.length := ⟨i, has⟩ - let i_bs : Fin bs.data.length := ⟨i, hbs⟩ + let i_as : Fin as.toList.length := ⟨i, has⟩ + let i_bs : Fin bs.toList.length := ⟨i, hbs⟩ rw [h₁, List.append_assoc] congr - rw [← List.zipWith_append (h := by simp), getElem_eq_data_getElem, getElem_eq_data_getElem] - show List.zipWith f (as.data[i_as] :: List.drop (i_as + 1) as.data) - ((List.get bs.data i_bs) :: List.drop (i_bs + 1) bs.data) = - List.zipWith f (List.drop i as.data) (List.drop i bs.data) - simp only [data_length, Fin.getElem_fin, List.getElem_cons_drop, List.get_eq_getElem] + rw [← List.zipWith_append (h := by simp), getElem_eq_getElem_toList, + getElem_eq_getElem_toList] + show List.zipWith f (as.toList[i_as] :: List.drop (i_as + 1) as.toList) + ((List.get bs.toList i_bs) :: List.drop (i_bs + 1) bs.toList) = + List.zipWith f (List.drop i as.toList) (List.drop i bs.toList) + simp only [length_toList, Fin.getElem_fin, List.getElem_cons_drop, List.get_eq_getElem] simp [zipWith, loop 0 #[] (by simp) (by simp)] +@[deprecated (since := "2024-09-09")] alias data_zipWith := toList_zipWith @[deprecated (since := "2024-08-13")] alias zipWith_eq_zipWith_data := data_zipWith -theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : +@[simp] theorem size_zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : (as.zipWith bs f).size = min as.size bs.size := by - rw [size_eq_length_data, data_zipWith, List.length_zipWith] + rw [size_eq_length_toList, toList_zipWith, List.length_zipWith] -theorem data_zip (as : Array α) (bs : Array β) : - (as.zip bs).data = as.data.zip bs.data := - data_zipWith Prod.mk as bs +theorem toList_zip (as : Array α) (bs : Array β) : + (as.zip bs).toList = as.toList.zip bs.toList := + toList_zipWith Prod.mk as bs +@[deprecated (since := "2024-09-09")] alias data_zip := toList_zip @[deprecated (since := "2024-08-13")] alias zip_eq_zip_data := data_zip -theorem size_zip (as : Array α) (bs : Array β) : +@[simp] theorem size_zip (as : Array α) (bs : Array β) : (as.zip bs).size = min as.size bs.size := as.size_zipWith bs Prod.mk @@ -90,42 +85,26 @@ theorem size_zip (as : Array α) (bs : Array β) : theorem size_filter_le (p : α → Bool) (l : Array α) : (l.filter p).size ≤ l.size := by - simp only [← data_length, filter_data] + simp only [← length_toList, toList_filter] apply List.length_filter_le -/-! ### join -/ - -@[simp] theorem data_join {l : Array (Array α)} : l.join.data = (l.data.map data).join := by - dsimp [join] - simp only [foldl_eq_foldl_data] - generalize l.data = l - have : ∀ a : Array α, (List.foldl ?_ a l).data = a.data ++ ?_ := ?_ - exact this #[] - induction l with - | nil => simp - | cons h => induction h.data <;> simp [*] -@[deprecated (since := "2024-08-13")] alias join_data := data_join - -theorem mem_join : ∀ {L : Array (Array α)}, a ∈ L.join ↔ ∃ l, l ∈ L ∧ a ∈ l := by - simp only [mem_def, data_join, List.mem_join, List.mem_map] - intro l - constructor - · rintro ⟨_, ⟨s, m, rfl⟩, h⟩ - exact ⟨s, m, h⟩ - · rintro ⟨s, h₁, h₂⟩ - refine ⟨s.data, ⟨⟨s, h₁, rfl⟩, h₂⟩⟩ +/-! ### flatten -/ + +@[deprecated (since := "2024-09-09")] alias data_join := toList_flatten +@[deprecated (since := "2024-08-13")] alias join_data := toList_flatten +@[deprecated (since := "2024-10-15")] alias mem_join := mem_flatten /-! ### indexOf? -/ -theorem indexOf?_data [BEq α] {a : α} {l : Array α} : - l.data.indexOf? a = (l.indexOf? a).map Fin.val := by +theorem indexOf?_toList [BEq α] {a : α} {l : Array α} : + l.toList.indexOf? a = (l.indexOf? a).map Fin.val := by simpa using aux l 0 where aux (l : Array α) (i : Nat) : - ((l.data.drop i).indexOf? a).map (·+i) = (indexOfAux l a i).map Fin.val := by + ((l.toList.drop i).indexOf? a).map (·+i) = (indexOfAux l a i).map Fin.val := by rw [indexOfAux] if h : i < l.size then - rw [List.drop_eq_getElem_cons h, ←getElem_eq_data_getElem, List.indexOf?_cons] + rw [List.drop_eq_getElem_cons h, ←getElem_eq_getElem_toList, List.indexOf?_cons] if h' : l[i] == a then simp [h, h'] else @@ -137,71 +116,29 @@ where /-! ### erase -/ -theorem eraseIdx_data_swap {l : Array α} (i : Nat) (lt : i + 1 < size l) : - (l.swap ⟨i+1, lt⟩ ⟨i, Nat.lt_of_succ_lt lt⟩).data.eraseIdx (i+1) = l.data.eraseIdx i := by - let ⟨xs⟩ := l - induction i generalizing xs <;> let x₀::x₁::xs := xs - case zero => simp [swap, get] - case succ i ih _ => - have lt' := Nat.lt_of_succ_lt_succ lt - have : (swap ⟨x₀::x₁::xs⟩ ⟨i.succ + 1, lt⟩ ⟨i.succ, Nat.lt_of_succ_lt lt⟩).data - = x₀::(swap ⟨x₁::xs⟩ ⟨i + 1, lt'⟩ ⟨i, Nat.lt_of_succ_lt lt'⟩).data := by - simp [swap_def, getElem_eq_data_getElem] - simp [this, ih] - -@[simp] theorem data_feraseIdx {l : Array α} (i : Fin l.size) : - (l.feraseIdx i).data = l.data.eraseIdx i := by - induction l, i using feraseIdx.induct with - | @case1 a i lt a' i' ih => - rw [feraseIdx] - simp [lt, ih, a', eraseIdx_data_swap i lt] - | case2 a i lt => - have : i + 1 ≥ a.size := Nat.ge_of_not_lt lt - have last : i + 1 = a.size := Nat.le_antisymm i.is_lt this - simp [feraseIdx, lt, List.dropLast_eq_eraseIdx last] - -@[simp] theorem data_erase [BEq α] (l : Array α) (a : α) : (l.erase a).data = l.data.erase a := by - match h : indexOf? l a with - | none => - simp only [erase, h] - apply Eq.symm - rw [List.erase_eq_self_iff_forall_bne, ←List.indexOf?_eq_none_iff, indexOf?_data, - h, Option.map_none'] - | some i => - simp only [erase, h] - rw [data_feraseIdx, ←List.eraseIdx_indexOf_eq_erase] - congr - rw [List.indexOf_eq_indexOf?, indexOf?_data] - simp [h] - -/-! ### shrink -/ - -theorem size_shrink_loop (a : Array α) (n) : (shrink.loop n a).size = a.size - n := by - induction n generalizing a with simp[shrink.loop] - | succ n ih => - simp[ih] - omega - -theorem size_shrink (a : Array α) (n) : (a.shrink n).size = min a.size n := by - simp [shrink, size_shrink_loop] - omega +@[simp] proof_wanted toList_erase [BEq α] {l : Array α} {a : α} : + (l.erase a).toList = l.toList.erase a + +@[simp] theorem eraseIdx!_eq_eraseIdx (a : Array α) (i : Nat) : + a.eraseIdx! i = a.eraseIdx i := rfl + +@[simp] theorem size_eraseIdx (a : Array α) (i : Nat) : + (a.eraseIdx i).size = if i < a.size then a.size-1 else a.size := by + simp only [eraseIdx]; split; simp; rfl /-! ### set -/ -theorem size_set! (a : Array α) (i v) : (a.set! i v).size = a.size := by - rw [set!_is_setD, size_setD] +theorem size_set! (a : Array α) (i v) : (a.set! i v).size = a.size := by simp /-! ### map -/ theorem mapM_empty [Monad m] (f : α → m β) : mapM f #[] = pure #[] := by rw [mapM, mapM.map]; rfl -@[simp] theorem map_empty (f : α → β) : map f #[] = #[] := mapM_empty .. +theorem map_empty (f : α → β) : map f #[] = #[] := mapM_empty f /-! ### mem -/ -alias not_mem_empty := not_mem_nil - theorem mem_singleton : a ∈ #[b] ↔ a = b := by simp /-! ### append -/ @@ -219,7 +156,7 @@ private theorem size_insertAt_loop (as : Array α) (i : Fin (as.size+1)) (j : Fi · rw [size_insertAt_loop, size_swap] · rfl -theorem size_insertAt (as : Array α) (i : Fin (as.size+1)) (v : α) : +@[simp] theorem size_insertAt (as : Array α) (i : Fin (as.size+1)) (v : α) : (as.insertAt i v).size = as.size + 1 := by rw [insertAt, size_insertAt_loop, size_push] @@ -230,7 +167,7 @@ private theorem get_insertAt_loop_lt (as : Array α) (i : Fin (as.size+1)) (j : split · have h1 : k ≠ j - 1 := by omega have h2 : k ≠ j := by omega - rw [get_insertAt_loop_lt, get_swap, if_neg h1, if_neg h2] + rw [get_insertAt_loop_lt, getElem_swap, if_neg h1, if_neg h2] exact h · rfl @@ -241,7 +178,7 @@ private theorem get_insertAt_loop_gt (as : Array α) (i : Fin (as.size+1)) (j : split · have h1 : k ≠ j - 1 := by omega have h2 : k ≠ j := by omega - rw [get_insertAt_loop_gt, get_swap, if_neg h1, if_neg h2] + rw [get_insertAt_loop_gt, getElem_swap, if_neg h1, if_neg h2] exact Nat.lt_of_le_of_lt (Nat.pred_le _) hgt · rfl @@ -251,8 +188,7 @@ private theorem get_insertAt_loop_eq (as : Array α) (i : Fin (as.size+1)) (j : unfold insertAt.loop split · next h => - rw [get_insertAt_loop_eq, Fin.getElem_fin, get_swap, if_pos rfl] - exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.is_lt + rw [get_insertAt_loop_eq, Fin.getElem_fin, getElem_swap, if_pos rfl] exact heq exact Nat.le_pred_of_lt h · congr; omega @@ -266,18 +202,17 @@ private theorem get_insertAt_loop_gt_le (as : Array α) (i : Fin (as.size+1)) (j if h0 : k = j then cases h0 have h1 : j.val ≠ j - 1 := by omega - rw [get_insertAt_loop_gt, get_swap, if_neg h1, if_pos rfl]; rfl - · exact j.is_lt - · exact Nat.pred_lt_of_lt hgt + rw [get_insertAt_loop_gt, getElem_swap, if_neg h1, if_pos rfl]; rfl + exact Nat.pred_lt_of_lt hgt else have h1 : k - 1 ≠ j - 1 := by omega have h2 : k - 1 ≠ j := by omega - rw [get_insertAt_loop_gt_le, get_swap, if_neg h1, if_neg h2] - exact hgt + rw [get_insertAt_loop_gt_le, getElem_swap, if_neg h1, if_neg h2] apply Nat.le_of_lt_add_one rw [Nat.sub_one_add_one] exact Nat.lt_of_le_of_ne hle h0 exact Nat.not_eq_zero_of_lt h + exact hgt · next h => absurd h exact Nat.lt_of_lt_of_le hgt hle @@ -286,14 +221,14 @@ theorem getElem_insertAt_lt (as : Array α) (i : Fin (as.size+1)) (v : α) (k) (hlt : k < i.val) {hk : k < (as.insertAt i v).size} {hk' : k < as.size} : (as.insertAt i v)[k] = as[k] := by simp only [insertAt] - rw [get_insertAt_loop_lt, get_push, dif_pos hk'] + rw [get_insertAt_loop_lt, getElem_push, dif_pos hk'] exact hlt theorem getElem_insertAt_gt (as : Array α) (i : Fin (as.size+1)) (v : α) (k) (hgt : k > i.val) {hk : k < (as.insertAt i v).size} {hk' : k - 1 < as.size} : (as.insertAt i v)[k] = as[k - 1] := by simp only [insertAt] - rw [get_insertAt_loop_gt_le, get_push, dif_pos hk'] + rw [get_insertAt_loop_gt_le, getElem_push, dif_pos hk'] exact hgt rw [size_insertAt] at hk exact Nat.le_of_lt_succ hk @@ -302,6 +237,6 @@ theorem getElem_insertAt_eq (as : Array α) (i : Fin (as.size+1)) (v : α) (k) (heq : i.val = k) {hk : k < (as.insertAt i v).size} : (as.insertAt i v)[k] = v := by simp only [insertAt] - rw [get_insertAt_loop_eq, Fin.getElem_fin, get_push_eq] + rw [get_insertAt_loop_eq, Fin.getElem_fin, getElem_push_eq] exact heq exact Nat.le_of_lt_succ i.is_lt diff --git a/Batteries/Data/Array/Match.lean b/Batteries/Data/Array/Match.lean index 46b2239f6f..b47ee90adc 100644 --- a/Batteries/Data/Array/Match.lean +++ b/Batteries/Data/Array/Match.lean @@ -52,7 +52,7 @@ termination_by k => k.val def PrefixTable.extend [BEq α] (t : PrefixTable α) (x : α) : PrefixTable α where toArray := t.toArray.push (x, t.step x ⟨t.size, Nat.lt_succ_self _⟩) valid _ := by - rw [Array.get_push] + rw [Array.getElem_push] split · exact t.valid .. · next h => exact Nat.le_trans (Nat.lt_succ.1 <| Fin.isLt ..) (Nat.not_lt.1 h) diff --git a/Batteries/Data/Array/Merge.lean b/Batteries/Data/Array/Merge.lean index aa83e0200b..70034111ad 100644 --- a/Batteries/Data/Array/Merge.lean +++ b/Batteries/Data/Array/Merge.lean @@ -26,11 +26,8 @@ where if lt x y then go (acc.push x) (i + 1) j else go (acc.push y) i (j + 1) termination_by xs.size + ys.size - (i + j) -set_option linter.unusedVariables false in -@[deprecated merge (since := "2024-04-24"), inherit_doc merge] -def mergeSortedPreservingDuplicates [ord : Ord α] (xs ys : Array α) : Array α := - merge (compare · · |>.isLT) xs ys - +-- We name `ord` so it can be provided as a named argument. +set_option linter.unusedVariables.funArgs false in /-- `O(|xs| + |ys|)`. Merge arrays `xs` and `ys`, which must be sorted according to `compare` and must not contain duplicates. Equal elements are merged using `merge`. If `merge` respects the order @@ -55,8 +52,6 @@ where | .eq => go (acc.push (merge x y)) (i + 1) (j + 1) termination_by xs.size + ys.size - (i + j) -@[deprecated (since := "2024-04-24")] alias mergeSortedMergingDuplicates := mergeDedupWith - /-- `O(|xs| + |ys|)`. Merge arrays `xs` and `ys`, which must be sorted according to `compare` and must not contain duplicates. If an element appears in both `xs` and `ys`, only one copy is kept. @@ -64,8 +59,6 @@ not contain duplicates. If an element appears in both `xs` and `ys`, only one co @[inline] def mergeDedup [ord : Ord α] (xs ys : Array α) : Array α := mergeDedupWith (ord := ord) xs ys fun x _ => x -@[deprecated (since := "2024-04-24")] alias mergeSortedDeduplicating := mergeDedup - set_option linter.unusedVariables false in /-- `O(|xs| * |ys|)`. Merge `xs` and `ys`, which do not need to be sorted. Elements which occur in @@ -83,8 +76,8 @@ where ys.foldl (init := xs) fun xs y => if xs.any (· == y) (stop := xsSize) then xs else xs.push y -@[deprecated (since := "2024-04-24")] alias mergeUnsortedDeduplicating := mergeUnsortedDedup - +-- We name `eq` so it can be provided as a named argument. +set_option linter.unusedVariables.funArgs false in /-- `O(|xs|)`. Replace each run `[x₁, ⋯, xₙ]` of equal elements in `xs` with `f ⋯ (f (f x₁ x₂) x₃) ⋯ xₙ`. @@ -101,8 +94,6 @@ where acc.push hd termination_by xs.size - i -@[deprecated (since := "2024-04-24")] alias mergeAdjacentDuplicates := mergeAdjacentDups - /-- `O(|xs|)`. Deduplicate a sorted array. The array must be sorted with to an order which agrees with `==`, i.e. whenever `x == y` then `compare x y == .eq`. @@ -110,13 +101,9 @@ where def dedupSorted [eq : BEq α] (xs : Array α) : Array α := xs.mergeAdjacentDups (eq := eq) fun x _ => x -@[deprecated (since := "2024-04-24")] alias deduplicateSorted := dedupSorted - /-- `O(|xs| log |xs|)`. Sort and deduplicate an array. -/ def sortDedup [ord : Ord α] (xs : Array α) : Array α := have := ord.toBEq dedupSorted <| xs.qsort (compare · · |>.isLT) -@[deprecated (since := "2024-04-24")] alias sortAndDeduplicate := sortDedup - end Array diff --git a/Batteries/Data/Array/Monadic.lean b/Batteries/Data/Array/Monadic.lean index 316813972a..934111e131 100644 --- a/Batteries/Data/Array/Monadic.lean +++ b/Batteries/Data/Array/Monadic.lean @@ -44,7 +44,7 @@ theorem SatisfiesM_mapM [Monad m] [LawfulMonad m] (as : Array α) (f : α → m · case s => intro ⟨i, hi⟩ arr ⟨ih₁, eq, ih₂⟩ refine (hs _ ih₁).map fun ⟨h₁, h₂⟩ => ⟨h₂, by simp [eq], fun j hj => ?_⟩ - simp [get_push] at hj ⊢; split; {apply ih₂} + simp [getElem_push] at hj ⊢; split; {apply ih₂} cases j; cases (Nat.le_or_eq_of_le_succ hj).resolve_left ‹_›; cases eq; exact h₁ theorem SatisfiesM_mapM' [Monad m] [LawfulMonad m] (as : Array α) (f : α → m β) @@ -125,27 +125,36 @@ theorem SatisfiesM_foldrM [Monad m] [LawfulMonad m] simp [foldrM]; split; {exact go _ h0} · next h => exact .pure (Nat.eq_zero_of_not_pos h ▸ h0) -theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as.size → α → m β) +theorem SatisfiesM_mapFinIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Fin as.size → α → m β) (motive : Nat → Prop) (h0 : motive 0) (p : Fin as.size → β → Prop) (hs : ∀ i, motive i.1 → SatisfiesM (p i · ∧ motive (i + 1)) (f i as[i])) : SatisfiesM (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) - (Array.mapIdxM as f) := by + (Array.mapFinIdxM as f) := by let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : ∀ i h h', p ⟨i, h⟩ bs[i]) (hm : motive j) : SatisfiesM (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) - (Array.mapIdxM.map as f i j h bs) := by - induction i generalizing j bs with simp [mapIdxM.map] + (Array.mapFinIdxM.map as f i j h bs) := by + induction i generalizing j bs with simp [mapFinIdxM.map] | zero => have := (Nat.zero_add _).symm.trans h exact .pure ⟨this ▸ hm, h₁ ▸ this, fun _ _ => h₂ ..⟩ | succ i ih => refine (hs _ (by exact hm)).bind fun b hb => ih (by simp [h₁]) (fun i hi hi' => ?_) hb.2 - simp at hi'; simp [get_push]; split + simp at hi'; simp [getElem_push]; split · next h => exact h₂ _ _ h · next h => cases h₁.symm ▸ (Nat.le_or_eq_of_le_succ hi').resolve_left h; exact hb.1 - simp [mapIdxM]; exact go rfl nofun h0 + simp [mapFinIdxM]; exact go rfl nofun h0 + +theorem SatisfiesM_mapIdxM [Monad m] [LawfulMonad m] (as : Array α) (f : Nat → α → m β) + (motive : Nat → Prop) (h0 : motive 0) + (p : Fin as.size → β → Prop) + (hs : ∀ i, motive i.1 → SatisfiesM (p i · ∧ motive (i + 1)) (f i as[i])) : + SatisfiesM + (fun arr => motive as.size ∧ ∃ eq : arr.size = as.size, ∀ i h, p ⟨i, h⟩ arr[i]) + (Array.mapIdxM as f) := + SatisfiesM_mapFinIdxM as (fun i => f i) motive h0 p hs theorem size_modifyM [Monad m] [LawfulMonad m] (a : Array α) (i : Nat) (f : α → m α) : SatisfiesM (·.size = a.size) (a.modifyM i f) := by diff --git a/Batteries/Data/Array/OfFn.lean b/Batteries/Data/Array/OfFn.lean index a5d3bc78bc..e02be7cba1 100644 --- a/Batteries/Data/Array/OfFn.lean +++ b/Batteries/Data/Array/OfFn.lean @@ -12,12 +12,7 @@ namespace Array /-! ### ofFn -/ @[simp] -theorem data_ofFn (f : Fin n → α) : (ofFn f).data = List.ofFn f := by - ext1 - simp only [getElem?_eq, data_length, size_ofFn, length_ofFn, getElem_ofFn] - split - · rw [← getElem_eq_data_getElem] - simp - · rfl +theorem toList_ofFn (f : Fin n → α) : (ofFn f).toList = List.ofFn f := by + apply ext_getElem <;> simp end Array diff --git a/Batteries/Data/Array/Pairwise.lean b/Batteries/Data/Array/Pairwise.lean index 84dff1f680..82ace9609f 100644 --- a/Batteries/Data/Array/Pairwise.lean +++ b/Batteries/Data/Array/Pairwise.lean @@ -17,15 +17,15 @@ larger indices. For example `as.Pairwise (· ≠ ·)` asserts that `as` has no duplicates, `as.Pairwise (· < ·)` asserts that `as` is strictly sorted and `as.Pairwise (· ≤ ·)` asserts that `as` is weakly sorted. -/ -def Pairwise (R : α → α → Prop) (as : Array α) : Prop := as.data.Pairwise R +def Pairwise (R : α → α → Prop) (as : Array α) : Prop := as.toList.Pairwise R theorem pairwise_iff_get {as : Array α} : as.Pairwise R ↔ ∀ (i j : Fin as.size), i < j → R (as.get i) (as.get j) := by - unfold Pairwise; simp [List.pairwise_iff_get, getElem_fin_eq_data_get]; rfl + unfold Pairwise; simp [List.pairwise_iff_get, getElem_fin_eq_getElem_toList] theorem pairwise_iff_getElem {as : Array α} : as.Pairwise R ↔ ∀ (i j : Nat) (_ : i < as.size) (_ : j < as.size), i < j → R as[i] as[j] := by - unfold Pairwise; simp [List.pairwise_iff_getElem, data_length]; rfl + unfold Pairwise; simp [List.pairwise_iff_getElem, length_toList] instance (R : α → α → Prop) [DecidableRel R] (as) : Decidable (Pairwise R as) := have : (∀ (j : Fin as.size) (i : Fin j.val), R as[i.val] (as[j.val])) ↔ Pairwise R as := by @@ -46,16 +46,17 @@ theorem pairwise_pair : #[a, b].Pairwise R ↔ R a b := by theorem pairwise_append {as bs : Array α} : (as ++ bs).Pairwise R ↔ as.Pairwise R ∧ bs.Pairwise R ∧ (∀ x ∈ as, ∀ y ∈ bs, R x y) := by - unfold Pairwise; simp [← mem_data, append_data, ← List.pairwise_append] + unfold Pairwise; simp [← mem_toList, toList_append, ← List.pairwise_append] theorem pairwise_push {as : Array α} : (as.push a).Pairwise R ↔ as.Pairwise R ∧ (∀ x ∈ as, R x a) := by unfold Pairwise - simp [← mem_data, push_data, List.pairwise_append, List.pairwise_singleton, List.mem_singleton] + simp [← mem_toList, push_toList, List.pairwise_append, List.pairwise_singleton, + List.mem_singleton] theorem pairwise_extract {as : Array α} (h : as.Pairwise R) (start stop) : (as.extract start stop).Pairwise R := by - simp only [pairwise_iff_getElem, get_extract, size_extract] at h ⊢ + simp only [pairwise_iff_getElem, getElem_extract, size_extract] at h ⊢ intro _ _ _ _ hlt apply h exact Nat.add_lt_add_left hlt start diff --git a/Batteries/Data/AssocList.lean b/Batteries/Data/AssocList.lean index 1492304efa..eba8927cef 100644 --- a/Batteries/Data/AssocList.lean +++ b/Batteries/Data/AssocList.lean @@ -78,7 +78,7 @@ def toListTR (as : AssocList α β) : List (α × β) := @[csimp] theorem toList_eq_toListTR : @toList = @toListTR := by funext α β as; simp [toListTR] - exact .symm <| (Array.foldl_data_eq_map (toList as) _ id).trans (List.map_id _) + exact .symm <| (Array.foldl_toList_eq_map (toList as) _ id).trans (List.map_id _) /-- `O(n)`. Run monadic function `f` on all elements in the list, from head to tail. -/ @[specialize] def forM [Monad m] (f : α → β → m PUnit) : AssocList α β → m PUnit @@ -244,8 +244,8 @@ instance : ForIn m (AssocList α β) (α × β) where @[simp] theorem forIn_eq [Monad m] (l : AssocList α β) (init : δ) (f : (α × β) → δ → m (ForInStep δ)) : forIn l init f = forIn l.toList init f := by - simp [forIn, List.forIn] - induction l generalizing init <;> simp [AssocList.forIn, List.forIn.loop] + simp only [forIn] + induction l generalizing init <;> simp [AssocList.forIn] congr; funext a; split <;> simp [*] /-- Split the list into head and tail, if possible. -/ diff --git a/Batteries/Data/BinaryHeap.lean b/Batteries/Data/BinaryHeap.lean index b36ed97fd3..29a273a9d0 100644 --- a/Batteries/Data/BinaryHeap.lean +++ b/Batteries/Data/BinaryHeap.lean @@ -1,78 +1,76 @@ /- Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro +Authors: Mario Carneiro, François G. Dorais -/ +import Batteries.Data.Vector.Basic + namespace Batteries /-- A max-heap data structure. -/ structure BinaryHeap (α) (lt : α → α → Bool) where - /-- Backing array for `BinaryHeap`. -/ + /-- `O(1)`. Get data array for a `BinaryHeap`. -/ arr : Array α namespace BinaryHeap -/-- Core operation for binary heaps, expressed directly on arrays. -Given an array which is a max-heap, push item `i` down to restore the max-heap property. -/ -def heapifyDown (lt : α → α → Bool) (a : Array α) (i : Fin a.size) : - {a' : Array α // a'.size = a.size} := +private def maxChild (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) : Option (Fin sz) := let left := 2 * i.1 + 1 let right := left + 1 - have left_le : i ≤ left := Nat.le_trans - (by rw [Nat.succ_mul, Nat.one_mul]; exact Nat.le_add_left i i) - (Nat.le_add_right ..) - have right_le : i ≤ right := Nat.le_trans left_le (Nat.le_add_right ..) - have i_le : i ≤ i := Nat.le_refl _ - have j : {j : Fin a.size // i ≤ j} := if h : left < a.size then - if lt (a.get i) (a.get ⟨left, h⟩) then ⟨⟨left, h⟩, left_le⟩ else ⟨i, i_le⟩ else ⟨i, i_le⟩ - have j := if h : right < a.size then - if lt (a.get j) (a.get ⟨right, h⟩) then ⟨⟨right, h⟩, right_le⟩ else j else j - if h : i.1 = j then ⟨a, rfl⟩ else - let a' := a.swap i j - let j' := ⟨j, by rw [a.size_swap i j]; exact j.1.2⟩ - have : a'.size - j < a.size - i := by - rw [a.size_swap i j]; exact Nat.sub_lt_sub_left i.2 <| Nat.lt_of_le_of_ne j.2 h - let ⟨a₂, h₂⟩ := heapifyDown lt a' j' - ⟨a₂, h₂.trans (a.size_swap i j)⟩ -termination_by a.size - i - -@[simp] theorem size_heapifyDown (lt : α → α → Bool) (a : Array α) (i : Fin a.size) : - (heapifyDown lt a i).1.size = a.size := (heapifyDown lt a i).2 + if hleft : left < sz then + if hright : right < sz then + if lt a[left] a[right] then + some ⟨right, hright⟩ + else + some ⟨left, hleft⟩ + else + some ⟨left, hleft⟩ + else none + +/-- Core operation for binary heaps, expressed directly on arrays. +Given an array which is a max-heap, push item `i` down to restore the max-heap property. -/ +def heapifyDown (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) : + Vector α sz := + match h : maxChild lt a i with + | none => a + | some j => + have : i < j := by + cases i; cases j + simp only [maxChild] at h + split at h + · split at h + · split at h <;> (cases h; simp_arith) + · cases h; simp_arith + · contradiction + if lt a[i] a[j] then + heapifyDown lt (a.swap i j) j + else a +termination_by sz - i /-- Core operation for binary heaps, expressed directly on arrays. Construct a heap from an unsorted array, by heapifying all the elements. -/ -def mkHeap (lt : α → α → Bool) (a : Array α) : {a' : Array α // a'.size = a.size} := - loop (a.size / 2) a (Nat.div_le_self ..) +def mkHeap (lt : α → α → Bool) (a : Vector α sz) : Vector α sz := + loop (sz / 2) a (Nat.div_le_self ..) where /-- Inner loop for `mkHeap`. -/ - loop : (i : Nat) → (a : Array α) → i ≤ a.size → {a' : Array α // a'.size = a.size} - | 0, a, _ => ⟨a, rfl⟩ + loop : (i : Nat) → (a : Vector α sz) → i ≤ sz → Vector α sz + | 0, a, _ => a | i+1, a, h => - let h := Nat.lt_of_succ_le h - let a' := heapifyDown lt a ⟨i, h⟩ - let ⟨a₂, h₂⟩ := loop i a' ((heapifyDown ..).2.symm ▸ Nat.le_of_lt h) - ⟨a₂, h₂.trans a'.2⟩ - -@[simp] theorem size_mkHeap (lt : α → α → Bool) (a : Array α) : - (mkHeap lt a).1.size = a.size := (mkHeap lt a).2 + let a' := heapifyDown lt a ⟨i, Nat.lt_of_succ_le h⟩ + loop i a' (Nat.le_trans (Nat.le_succ _) h) /-- Core operation for binary heaps, expressed directly on arrays. Given an array which is a max-heap, push item `i` up to restore the max-heap property. -/ -def heapifyUp (lt : α → α → Bool) (a : Array α) (i : Fin a.size) : - {a' : Array α // a'.size = a.size} := - if i0 : i.1 = 0 then ⟨a, rfl⟩ else - have : (i.1 - 1) / 2 < i := Nat.lt_of_le_of_lt (Nat.div_le_self ..) <| - Nat.sub_lt (Nat.pos_of_ne_zero i0) Nat.zero_lt_one - let j := ⟨(i.1 - 1) / 2, Nat.lt_trans this i.2⟩ - if lt (a.get j) (a.get i) then - let a' := a.swap i j - let ⟨a₂, h₂⟩ := heapifyUp lt a' ⟨j.1, by rw [a.size_swap i j]; exact j.2⟩ - ⟨a₂, h₂.trans (a.size_swap i j)⟩ - else ⟨a, rfl⟩ - -@[simp] theorem size_heapifyUp (lt : α → α → Bool) (a : Array α) (i : Fin a.size) : - (heapifyUp lt a i).1.size = a.size := (heapifyUp lt a i).2 +def heapifyUp (lt : α → α → Bool) (a : Vector α sz) (i : Fin sz) : + Vector α sz := + match i with + | ⟨0, _⟩ => a + | ⟨i'+1, hi⟩ => + let j := ⟨i'/2, by get_elem_tactic⟩ + if lt a[j] a[i] then + heapifyUp lt (a.swap i j) j + else a /-- `O(1)`. Build a new empty heap. -/ def empty (lt) : BinaryHeap α lt := ⟨#[]⟩ @@ -86,81 +84,91 @@ def singleton (lt) (x : α) : BinaryHeap α lt := ⟨#[x]⟩ /-- `O(1)`. Get the number of elements in a `BinaryHeap`. -/ def size (self : BinaryHeap α lt) : Nat := self.1.size +/-- `O(1)`. Get data vector of a `BinaryHeap`. -/ +def vector (self : BinaryHeap α lt) : Vector α self.size := ⟨self.1, rfl⟩ + /-- `O(1)`. Get an element in the heap by index. -/ def get (self : BinaryHeap α lt) (i : Fin self.size) : α := self.1.get i /-- `O(log n)`. Insert an element into a `BinaryHeap`, preserving the max-heap property. -/ def insert (self : BinaryHeap α lt) (x : α) : BinaryHeap α lt where - arr := let n := self.size; - heapifyUp lt (self.1.push x) ⟨n, by rw [Array.size_push]; apply Nat.lt_succ_self⟩ + arr := heapifyUp lt (self.vector.push x) ⟨_, Nat.lt_succ_self _⟩ |>.toArray @[simp] theorem size_insert (self : BinaryHeap α lt) (x : α) : (self.insert x).size = self.size + 1 := by - simp [insert, size, size_heapifyUp] + simp [size, insert] /-- `O(1)`. Get the maximum element in a `BinaryHeap`. -/ -def max (self : BinaryHeap α lt) : Option α := self.1.get? 0 - -/-- Auxiliary for `popMax`. -/ -def popMaxAux (self : BinaryHeap α lt) : {a' : BinaryHeap α lt // a'.size = self.size - 1} := - match e: self.1.size with - | 0 => ⟨self, by simp [size, e]⟩ - | n+1 => - have h0 := by rw [e]; apply Nat.succ_pos - have hn := by rw [e]; apply Nat.lt_succ_self - if hn0 : 0 < n then - let a := self.1.swap ⟨0, h0⟩ ⟨n, hn⟩ |>.pop - ⟨⟨heapifyDown lt a ⟨0, by rwa [Array.size_pop, Array.size_swap, e]⟩⟩, - by simp [size, a]⟩ - else - ⟨⟨self.1.pop⟩, by simp [size]⟩ +def max (self : BinaryHeap α lt) : Option α := self.1[0]? /-- `O(log n)`. Remove the maximum element from a `BinaryHeap`. Call `max` first to actually retrieve the maximum element. -/ -def popMax (self : BinaryHeap α lt) : BinaryHeap α lt := self.popMaxAux +def popMax (self : BinaryHeap α lt) : BinaryHeap α lt := + if h0 : self.size = 0 then self else + have hs : self.size - 1 < self.size := Nat.pred_lt h0 + have h0 : 0 < self.size := Nat.zero_lt_of_ne_zero h0 + let v := self.vector.swap ⟨_, h0⟩ ⟨_, hs⟩ |>.pop + if h : 0 < self.size - 1 then + ⟨heapifyDown lt v ⟨0, h⟩ |>.toArray⟩ + else + ⟨v.toArray⟩ @[simp] theorem size_popMax (self : BinaryHeap α lt) : - self.popMax.size = self.size - 1 := self.popMaxAux.2 + self.popMax.size = self.size - 1 := by + simp only [popMax, size] + split + · simp_arith [*] + · split <;> simp_arith [*] /-- `O(log n)`. Return and remove the maximum element from a `BinaryHeap`. -/ def extractMax (self : BinaryHeap α lt) : Option α × BinaryHeap α lt := (self.max, self.popMax) -theorem size_pos_of_max {self : BinaryHeap α lt} (e : self.max = some x) : 0 < self.size := - Decidable.of_not_not fun h : ¬ 0 < self.1.size => by simp [BinaryHeap.max, Array.get?, h] at e +theorem size_pos_of_max {self : BinaryHeap α lt} (h : self.max = some x) : 0 < self.size := by + simp only [max, getElem?_def] at h + split at h + · assumption + · contradiction /-- `O(log n)`. Equivalent to `extractMax (self.insert x)`, except that extraction cannot fail. -/ def insertExtractMax (self : BinaryHeap α lt) (x : α) : α × BinaryHeap α lt := - match e: self.max with + match e : self.max with | none => (x, self) | some m => if lt x m then - let a := self.1.set ⟨0, size_pos_of_max e⟩ x - (m, ⟨heapifyDown lt a ⟨0, by simp only [Array.size_set, a]; exact size_pos_of_max e⟩⟩) + let v := self.vector.set ⟨0, size_pos_of_max e⟩ x + (m, ⟨heapifyDown lt v ⟨0, size_pos_of_max e⟩ |>.toArray⟩) else (x, self) /-- `O(log n)`. Equivalent to `(self.max, self.popMax.insert x)`. -/ def replaceMax (self : BinaryHeap α lt) (x : α) : Option α × BinaryHeap α lt := - match e: self.max with - | none => (none, ⟨self.1.push x⟩) + match e : self.max with + | none => (none, ⟨self.vector.push x |>.toArray⟩) | some m => - let a := self.1.set ⟨0, size_pos_of_max e⟩ x - (some m, ⟨heapifyDown lt a ⟨0, by simp only [Array.size_set, a]; exact size_pos_of_max e⟩⟩) + let v := self.vector.set ⟨0, size_pos_of_max e⟩ x + (some m, ⟨heapifyDown lt v ⟨0, size_pos_of_max e⟩ |>.toArray⟩) /-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `x ≤ self.get i`. -/ def decreaseKey (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where - arr := heapifyDown lt (self.1.set i x) ⟨i, by rw [self.1.size_set]; exact i.2⟩ + arr := heapifyDown lt (self.vector.set i x) i |>.toArray /-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `self.get i ≤ x`. -/ def increaseKey (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where - arr := heapifyUp lt (self.1.set i x) ⟨i, by rw [self.1.size_set]; exact i.2⟩ + arr := heapifyUp lt (self.vector.set i x) i |>.toArray end Batteries.BinaryHeap +/-- `O(n)`. Convert an unsorted vector to a `BinaryHeap`. -/ +def Batteries.Vector.toBinaryHeap (lt : α → α → Bool) (v : Vector α n) : + Batteries.BinaryHeap α lt where + arr := BinaryHeap.mkHeap lt v |>.toArray + +open Batteries in /-- `O(n)`. Convert an unsorted array to a `BinaryHeap`. -/ def Array.toBinaryHeap (lt : α → α → Bool) (a : Array α) : Batteries.BinaryHeap α lt where - arr := Batteries.BinaryHeap.mkHeap lt a + arr := BinaryHeap.mkHeap lt ⟨a, rfl⟩ |>.toArray +open Batteries in /-- `O(n log n)`. Sort an array using a `BinaryHeap`. -/ @[specialize] def Array.heapSort (a : Array α) (lt : α → α → Bool) : Array α := loop (a.toBinaryHeap (flip lt)) #[] diff --git a/Batteries/Data/ByteArray.lean b/Batteries/Data/ByteArray.lean index ae4544fd21..6a95a241aa 100644 --- a/Batteries/Data/ByteArray.lean +++ b/Batteries/Data/ByteArray.lean @@ -36,11 +36,11 @@ theorem getElem_eq_data_getElem (a : ByteArray) (h : i < a.size) : a[i] = a.data Array.size_push .. @[simp] theorem get_push_eq (a : ByteArray) (x : UInt8) : (a.push x)[a.size] = x := - Array.get_push_eq .. + Array.getElem_push_eq .. theorem get_push_lt (a : ByteArray) (x : UInt8) (i : Nat) (h : i < a.size) : (a.push x)[i]'(size_push .. ▸ Nat.lt_succ_of_lt h) = a[i] := - Array.get_push_lt .. + Array.getElem_push_lt .. /-! ### set -/ @@ -85,12 +85,12 @@ theorem size_append (a b : ByteArray) : (a ++ b).size = a.size + b.size := by theorem get_append_left {a b : ByteArray} (hlt : i < a.size) (h : i < (a ++ b).size := size_append .. ▸ Nat.lt_of_lt_of_le hlt (Nat.le_add_right ..)) : (a ++ b)[i] = a[i] := by - simp [getElem_eq_data_getElem]; exact Array.get_append_left hlt + simp [getElem_eq_data_getElem]; exact Array.getElem_append_left hlt theorem get_append_right {a b : ByteArray} (hle : a.size ≤ i) (h : i < (a ++ b).size) (h' : i - a.size < b.size := Nat.sub_lt_left_of_lt_add hle (size_append .. ▸ h)) : (a ++ b)[i] = b[i - a.size] := by - simp [getElem_eq_data_getElem]; exact Array.get_append_right hle + simp [getElem_eq_data_getElem]; exact Array.getElem_append_right hle /-! ### extract -/ diff --git a/Batteries/Data/DList.lean b/Batteries/Data/DList.lean index 6a5450f0ba..00a2d9fadf 100644 --- a/Batteries/Data/DList.lean +++ b/Batteries/Data/DList.lean @@ -1,70 +1,2 @@ -/- -Copyright (c) 2018 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura --/ -namespace Batteries -/-- -A difference List is a Function that, given a List, returns the original -contents of the difference List prepended to the given List. -This structure supports `O(1)` `append` and `concat` operations on lists, making it -useful for append-heavy uses such as logging and pretty printing. --/ -structure DList (α : Type u) where - /-- "Run" a `DList` by appending it on the right by a `List α` to get another `List α`. -/ - apply : List α → List α - /-- The `apply` function of a `DList` is completely determined by the list `apply []`. -/ - invariant : ∀ l, apply l = apply [] ++ l - -namespace DList -variable {α : Type u} -open List - -/-- `O(1)` (`apply` is `O(|l|)`). Convert a `List α` into a `DList α`. -/ -def ofList (l : List α) : DList α := - ⟨(l ++ ·), fun t => by simp⟩ - -/-- `O(1)` (`apply` is `O(1)`). Return an empty `DList α`. -/ -def empty : DList α := - ⟨id, fun _ => rfl⟩ - -instance : EmptyCollection (DList α) := ⟨DList.empty⟩ - -/-- `O(apply())`. Convert a `DList α` into a `List α` by running the `apply` function. -/ -def toList : DList α → List α - | ⟨f, _⟩ => f [] - -/-- `O(1)` (`apply` is `O(1)`). A `DList α` corresponding to the list `[a]`. -/ -def singleton (a : α) : DList α where - apply := fun t => a :: t - invariant := fun _ => rfl - -/-- `O(1)` (`apply` is `O(1)`). Prepend `a` on a `DList α`. -/ -def cons : α → DList α → DList α - | a, ⟨f, h⟩ => { - apply := fun t => a :: f t - invariant := by intro t; simp; rw [h] - } - -/-- `O(1)` (`apply` is `O(1)`). Append two `DList α`. -/ -def append : DList α → DList α → DList α - | ⟨f, h₁⟩, ⟨g, h₂⟩ => { - apply := f ∘ g - invariant := by - intro t - show f (g t) = (f (g [])) ++ t - rw [h₁ (g t), h₂ t, ← append_assoc (f []) (g []) t, ← h₁ (g [])] - } - -/-- `O(1)` (`apply` is `O(1)`). Append an element at the end of a `DList α`. -/ -def push : DList α → α → DList α - | ⟨f, h⟩, a => { - apply := fun t => f (a :: t) - invariant := by - intro t - show f (a :: t) = f (a :: nil) ++ t - rw [h [a], h (a::t), append_assoc (f []) [a] t] - rfl - } - -instance : Append (DList α) := ⟨DList.append⟩ +import Batteries.Data.DList.Basic +import Batteries.Data.DList.Lemmas diff --git a/Batteries/Data/DList/Basic.lean b/Batteries/Data/DList/Basic.lean new file mode 100644 index 0000000000..b3eb0bbc97 --- /dev/null +++ b/Batteries/Data/DList/Basic.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2018 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Batteries.Tactic.Alias + +namespace Batteries +/-- +A difference List is a Function that, given a List, returns the original +contents of the difference List prepended to the given List. +This structure supports `O(1)` `append` and `push` operations on lists, making it +useful for append-heavy uses such as logging and pretty printing. +-/ +structure DList (α : Type u) where + /-- "Run" a `DList` by appending it on the right by a `List α` to get another `List α`. -/ + apply : List α → List α + /-- The `apply` function of a `DList` is completely determined by the list `apply []`. -/ + invariant : ∀ l, apply l = apply [] ++ l + +attribute [simp] DList.apply + +namespace DList +variable {α : Type u} +open List + +/-- `O(1)` (`apply` is `O(|l|)`). Convert a `List α` into a `DList α`. -/ +def ofList (l : List α) : DList α := + ⟨(l ++ ·), fun t => by simp⟩ + +/-- `O(1)` (`apply` is `O(1)`). Return an empty `DList α`. -/ +def empty : DList α := + ⟨id, fun _ => rfl⟩ + +instance : EmptyCollection (DList α) := ⟨DList.empty⟩ + +instance : Inhabited (DList α) := ⟨DList.empty⟩ + +/-- `O(apply())`. Convert a `DList α` into a `List α` by running the `apply` function. -/ +@[simp] def toList : DList α → List α + | ⟨f, _⟩ => f [] + +/-- `O(1)` (`apply` is `O(1)`). A `DList α` corresponding to the list `[a]`. -/ +def singleton (a : α) : DList α where + apply := fun t => a :: t + invariant := fun _ => rfl + +/-- `O(1)` (`apply` is `O(1)`). Prepend `a` on a `DList α`. -/ +def cons : α → DList α → DList α + | a, ⟨f, h⟩ => { + apply := fun t => a :: f t + invariant := by intro t; simp; rw [h] + } + +/-- `O(1)` (`apply` is `O(1)`). Append two `DList α`. -/ +def append : DList α → DList α → DList α + | ⟨f, h₁⟩, ⟨g, h₂⟩ => { + apply := f ∘ g + invariant := by + intro t + show f (g t) = (f (g [])) ++ t + rw [h₁ (g t), h₂ t, ← append_assoc (f []) (g []) t, ← h₁ (g [])] + } + +/-- `O(1)` (`apply` is `O(1)`). Append an element at the end of a `DList α`. -/ +def push : DList α → α → DList α + | ⟨f, h⟩, a => { + apply := fun t => f (a :: t) + invariant := by + intro t + show f (a :: t) = f (a :: nil) ++ t + rw [h [a], h (a::t), append_assoc (f []) [a] t] + rfl + } + +instance : Append (DList α) := ⟨DList.append⟩ + +/-- Convert a lazily-evaluated `List` to a `DList` -/ +def ofThunk (l : Thunk (List α)) : DList α := + ⟨fun xs => l.get ++ xs, fun t => by simp⟩ + +@[deprecated (since := "2024-10-16")] alias lazy_ofList := ofThunk + +/-- Concatenates a list of difference lists to form a single difference list. Similar to +`List.join`. -/ +def join {α : Type _} : List (DList α) → DList α + | [] => DList.empty + | x :: xs => x ++ DList.join xs diff --git a/Batteries/Data/DList/Lemmas.lean b/Batteries/Data/DList/Lemmas.lean new file mode 100644 index 0000000000..6c17e9e00a --- /dev/null +++ b/Batteries/Data/DList/Lemmas.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2017 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +import Batteries.Data.DList.Basic + +/-! +# Difference list + +This file provides a few results about `DList`. + +A difference list is a function that, given a list, returns the original content of the +difference list prepended to the given list. It is useful to represent elements of a given type +as `a₁ + ... + aₙ` where `+ : α → α → α` is any operation, without actually computing. + +This structure supports `O(1)` `append` and `push` operations on lists, making it +useful for append-heavy uses such as logging and pretty printing. +-/ + +namespace Batteries.DList + +open Function + +theorem toList_ofList (l : List α) : DList.toList (DList.ofList l) = l := by + cases l; rfl; simp [ofList] + +theorem ofList_toList (l : DList α) : DList.ofList (DList.toList l) = l := by + obtain ⟨app, inv⟩ := l + simp only [ofList, toList, mk.injEq] + funext x + rw [(inv x)] + +theorem toList_empty : toList (@empty α) = [] := by simp [empty] + +theorem toList_singleton (x : α) : toList (singleton x) = [x] := by simp [singleton] + +theorem toList_append (l₁ l₂ : DList α) : toList (l₁ ++ l₂) = toList l₁ ++ toList l₂ := by + simp only [toList, append, Function.comp]; rw [invariant] + +theorem toList_cons (x : α) (l : DList α) : toList (cons x l) = x :: toList l := by + cases l; simp [cons] + +theorem toList_push (x : α) (l : DList α) : toList (push l x) = toList l ++ [x] := by + simp only [toList, push]; rw [invariant] + +@[simp] +theorem singleton_eq_ofThunk {α : Type _} {a : α} : singleton a = ofThunk [a] := + rfl + +@[simp] +theorem ofThunk_coe {α : Type _} {l : List α} : ofThunk l = ofList l := + rfl + +@[deprecated (since := "2024-10-16")] alias DList_singleton := singleton_eq_ofThunk +@[deprecated (since := "2024-10-16")] alias DList_lazy := ofThunk_coe + +end Batteries.DList diff --git a/Batteries/Data/Fin/Basic.lean b/Batteries/Data/Fin/Basic.lean index 3632d4f254..b61481e33a 100644 --- a/Batteries/Data/Fin/Basic.lean +++ b/Batteries/Data/Fin/Basic.lean @@ -13,4 +13,58 @@ def clamp (n m : Nat) : Fin (m + 1) := ⟨min n m, Nat.lt_succ_of_le (Nat.min_le def enum (n) : Array (Fin n) := Array.ofFn id /-- `list n` is the list of all elements of `Fin n` in order -/ -def list (n) : List (Fin n) := (enum n).data +def list (n) : List (Fin n) := (enum n).toList + +/-- +Folds a monadic function over `Fin n` from left to right: +``` +Fin.foldlM n f x₀ = do + let x₁ ← f x₀ 0 + let x₂ ← f x₁ 1 + ... + let xₙ ← f xₙ₋₁ (n-1) + pure xₙ +``` +-/ +@[inline] def foldlM [Monad m] (n) (f : α → Fin n → m α) (init : α) : m α := loop init 0 where + /-- + Inner loop for `Fin.foldlM`. + ``` + Fin.foldlM.loop n f xᵢ i = do + let xᵢ₊₁ ← f xᵢ i + ... + let xₙ ← f xₙ₋₁ (n-1) + pure xₙ + ``` + -/ + loop (x : α) (i : Nat) : m α := do + if h : i < n then f x ⟨i, h⟩ >>= (loop · (i+1)) else pure x + termination_by n - i + +/-- +Folds a monadic function over `Fin n` from right to left: +``` +Fin.foldrM n f xₙ = do + let xₙ₋₁ ← f (n-1) xₙ + let xₙ₋₂ ← f (n-2) xₙ₋₁ + ... + let x₀ ← f 0 x₁ + pure x₀ +``` +-/ +@[inline] def foldrM [Monad m] (n) (f : Fin n → α → m α) (init : α) : m α := + loop ⟨n, Nat.le_refl n⟩ init where + /-- + Inner loop for `Fin.foldrM`. + ``` + Fin.foldrM.loop n f i xᵢ = do + let xᵢ₋₁ ← f (i-1) xᵢ + ... + let x₁ ← f 1 x₂ + let x₀ ← f 0 x₁ + pure x₀ + ``` + -/ + loop : {i // i ≤ n} → α → m α + | ⟨0, _⟩, x => pure x + | ⟨i+1, h⟩, x => f ⟨i, h⟩ x >>= loop ⟨i, Nat.le_of_lt h⟩ diff --git a/Batteries/Data/Fin/Lemmas.lean b/Batteries/Data/Fin/Lemmas.lean index 5ddde152de..5010e1310f 100644 --- a/Batteries/Data/Fin/Lemmas.lean +++ b/Batteries/Data/Fin/Lemmas.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Batteries.Data.Fin.Basic +import Batteries.Data.List.Lemmas namespace Fin @@ -26,7 +27,7 @@ attribute [norm_cast] val_last @[simp] theorem getElem_list (i : Nat) (h : i < (list n).length) : (list n)[i] = cast (length_list n) ⟨i, h⟩ := by - simp only [list]; rw [← Array.getElem_eq_data_getElem, getElem_enum, cast_mk] + simp only [list]; rw [← Array.getElem_eq_getElem_toList, getElem_enum, cast_mk] @[deprecated getElem_list (since := "2024-06-12")] theorem get_list (i : Fin (list n).length) : (list n).get i = i.cast (length_list n) := by @@ -40,41 +41,115 @@ theorem list_succ (n) : list (n+1) = 0 :: (list n).map Fin.succ := by theorem list_succ_last (n) : list (n+1) = (list n).map castSucc ++ [last n] := by rw [list_succ] induction n with - | zero => simp [last] + | zero => simp | succ n ih => rw [list_succ, List.map_cons castSucc, ih] simp [Function.comp_def, succ_castSucc] theorem list_reverse (n) : (list n).reverse = (list n).map rev := by induction n with - | zero => simp [last] + | zero => simp | succ n ih => conv => lhs; rw [list_succ_last] conv => rhs; rw [list_succ] simp [← List.map_reverse, ih, Function.comp_def, rev_succ] +/-! ### foldlM -/ + +theorem foldlM_loop_lt [Monad m] (f : α → Fin n → m α) (x) (h : i < n) : + foldlM.loop n f x i = f x ⟨i, h⟩ >>= (foldlM.loop n f . (i+1)) := by + rw [foldlM.loop, dif_pos h] + +theorem foldlM_loop_eq [Monad m] (f : α → Fin n → m α) (x) : foldlM.loop n f x n = pure x := by + rw [foldlM.loop, dif_neg (Nat.lt_irrefl _)] + +theorem foldlM_loop [Monad m] (f : α → Fin (n+1) → m α) (x) (h : i < n+1) : + foldlM.loop (n+1) f x i = f x ⟨i, h⟩ >>= (foldlM.loop n (fun x j => f x j.succ) . i) := by + if h' : i < n then + rw [foldlM_loop_lt _ _ h] + congr; funext + rw [foldlM_loop_lt _ _ h', foldlM_loop]; rfl + else + cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h') + rw [foldlM_loop_lt] + congr; funext + rw [foldlM_loop_eq, foldlM_loop_eq] +termination_by n - i + +@[simp] theorem foldlM_zero [Monad m] (f : α → Fin 0 → m α) (x) : foldlM 0 f x = pure x := + foldlM_loop_eq .. + +theorem foldlM_succ [Monad m] (f : α → Fin (n+1) → m α) (x) : + foldlM (n+1) f x = f x 0 >>= foldlM n (fun x j => f x j.succ) := foldlM_loop .. + +theorem foldlM_eq_foldlM_list [Monad m] (f : α → Fin n → m α) (x) : + foldlM n f x = (list n).foldlM f x := by + induction n generalizing x with + | zero => simp + | succ n ih => + rw [foldlM_succ, list_succ, List.foldlM_cons] + congr; funext + rw [List.foldlM_map, ih] + +/-! ### foldrM -/ + +theorem foldrM_loop_zero [Monad m] (f : Fin n → α → m α) (x) : + foldrM.loop n f ⟨0, Nat.zero_le _⟩ x = pure x := by + rw [foldrM.loop] + +theorem foldrM_loop_succ [Monad m] (f : Fin n → α → m α) (x) (h : i < n) : + foldrM.loop n f ⟨i+1, h⟩ x = f ⟨i, h⟩ x >>= foldrM.loop n f ⟨i, Nat.le_of_lt h⟩ := by + rw [foldrM.loop] + +theorem foldrM_loop [Monad m] [LawfulMonad m] (f : Fin (n+1) → α → m α) (x) (h : i+1 ≤ n+1) : + foldrM.loop (n+1) f ⟨i+1, h⟩ x = + foldrM.loop n (fun j => f j.succ) ⟨i, Nat.le_of_succ_le_succ h⟩ x >>= f 0 := by + induction i generalizing x with + | zero => + rw [foldrM_loop_zero, foldrM_loop_succ, pure_bind] + conv => rhs; rw [←bind_pure (f 0 x)] + congr; funext; exact foldrM_loop_zero .. + | succ i ih => + rw [foldrM_loop_succ, foldrM_loop_succ, bind_assoc] + congr; funext; exact ih .. + +@[simp] theorem foldrM_zero [Monad m] (f : Fin 0 → α → m α) (x) : foldrM 0 f x = pure x := + foldrM_loop_zero .. + +theorem foldrM_succ [Monad m] [LawfulMonad m] (f : Fin (n+1) → α → m α) (x) : + foldrM (n+1) f x = foldrM n (fun i => f i.succ) x >>= f 0 := foldrM_loop .. + +theorem foldrM_eq_foldrM_list [Monad m] [LawfulMonad m] (f : Fin n → α → m α) (x) : + foldrM n f x = (list n).foldrM f x := by + induction n with + | zero => simp + | succ n ih => rw [foldrM_succ, ih, list_succ, List.foldrM_cons, List.foldrM_map] + /-! ### foldl -/ -theorem foldl_loop_lt (f : α → Fin n → α) (x) (h : m < n) : - foldl.loop n f x m = foldl.loop n f (f x ⟨m, h⟩) (m+1) := by +theorem foldl_loop_lt (f : α → Fin n → α) (x) (h : i < n) : + foldl.loop n f x i = foldl.loop n f (f x ⟨i, h⟩) (i+1) := by rw [foldl.loop, dif_pos h] theorem foldl_loop_eq (f : α → Fin n → α) (x) : foldl.loop n f x n = x := by rw [foldl.loop, dif_neg (Nat.lt_irrefl _)] -theorem foldl_loop (f : α → Fin (n+1) → α) (x) (h : m < n+1) : - foldl.loop (n+1) f x m = foldl.loop n (fun x i => f x i.succ) (f x ⟨m, h⟩) m := by - if h' : m < n then - rw [foldl_loop_lt _ _ h, foldl_loop_lt _ _ h', foldl_loop]; rfl +theorem foldl_loop (f : α → Fin (n+1) → α) (x) (h : i < n+1) : + foldl.loop (n+1) f x i = foldl.loop n (fun x j => f x j.succ) (f x ⟨i, h⟩) i := by + if h' : i < n then + rw [foldl_loop_lt _ _ h] + rw [foldl_loop_lt _ _ h', foldl_loop]; rfl else cases Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.not_lt.1 h') - rw [foldl_loop_lt, foldl_loop_eq, foldl_loop_eq] -termination_by n - m + rw [foldl_loop_lt] + rw [foldl_loop_eq, foldl_loop_eq] -@[simp] theorem foldl_zero (f : α → Fin 0 → α) (x) : foldl 0 f x = x := by simp [foldl, foldl.loop] +@[simp] theorem foldl_zero (f : α → Fin 0 → α) (x) : foldl 0 f x = x := + foldl_loop_eq .. theorem foldl_succ (f : α → Fin (n+1) → α) (x) : - foldl (n+1) f x = foldl n (fun x i => f x i.succ) (f x 0) := foldl_loop .. + foldl (n+1) f x = foldl n (fun x i => f x i.succ) (f x 0) := + foldl_loop .. theorem foldl_succ_last (f : α → Fin (n+1) → α) (x) : foldl (n+1) f x = f (foldl n (f · ·.castSucc) x) (last n) := by @@ -83,6 +158,10 @@ theorem foldl_succ_last (f : α → Fin (n+1) → α) (x) : | zero => simp [foldl_succ, Fin.last] | succ n ih => rw [foldl_succ, ih (f · ·.succ), foldl_succ]; simp [succ_castSucc] +theorem foldl_eq_foldlM (f : α → Fin n → α) (x) : + foldl n f x = foldlM (m:=Id) n f x := by + induction n generalizing x <;> simp [foldl_succ, foldlM_succ, *] + theorem foldl_eq_foldl_list (f : α → Fin n → α) (x) : foldl n f x = (list n).foldl f x := by induction n generalizing x with | zero => rw [foldl_zero, list_zero, List.foldl_nil] @@ -90,24 +169,21 @@ theorem foldl_eq_foldl_list (f : α → Fin n → α) (x) : foldl n f x = (list /-! ### foldr -/ -unseal foldr.loop in -theorem foldr_loop_zero (f : Fin n → α → α) (x) : foldr.loop n f ⟨0, Nat.zero_le _⟩ x = x := - rfl +theorem foldr_loop_zero (f : Fin n → α → α) (x) : + foldr.loop n f ⟨0, Nat.zero_le _⟩ x = x := by + rw [foldr.loop] -unseal foldr.loop in -theorem foldr_loop_succ (f : Fin n → α → α) (x) (h : m < n) : - foldr.loop n f ⟨m+1, h⟩ x = foldr.loop n f ⟨m, Nat.le_of_lt h⟩ (f ⟨m, h⟩ x) := - rfl +theorem foldr_loop_succ (f : Fin n → α → α) (x) (h : i < n) : + foldr.loop n f ⟨i+1, h⟩ x = foldr.loop n f ⟨i, Nat.le_of_lt h⟩ (f ⟨i, h⟩ x) := by + rw [foldr.loop] -theorem foldr_loop (f : Fin (n+1) → α → α) (x) (h : m+1 ≤ n+1) : - foldr.loop (n+1) f ⟨m+1, h⟩ x = - f 0 (foldr.loop n (fun i => f i.succ) ⟨m, Nat.le_of_succ_le_succ h⟩ x) := by - induction m generalizing x with - | zero => simp [foldr_loop_zero, foldr_loop_succ] - | succ m ih => rw [foldr_loop_succ, ih, foldr_loop_succ, Fin.succ] +theorem foldr_loop (f : Fin (n+1) → α → α) (x) (h : i+1 ≤ n+1) : + foldr.loop (n+1) f ⟨i+1, h⟩ x = + f 0 (foldr.loop n (fun j => f j.succ) ⟨i, Nat.le_of_succ_le_succ h⟩ x) := by + induction i generalizing x <;> simp [foldr_loop_zero, foldr_loop_succ, *] -@[simp] theorem foldr_zero (f : Fin 0 → α → α) (x) : - foldr 0 f x = x := foldr_loop_zero .. +@[simp] theorem foldr_zero (f : Fin 0 → α → α) (x) : foldr 0 f x = x := + foldr_loop_zero .. theorem foldr_succ (f : Fin (n+1) → α → α) (x) : foldr (n+1) f x = f 0 (foldr n (fun i => f i.succ) x) := foldr_loop .. @@ -118,13 +194,15 @@ theorem foldr_succ_last (f : Fin (n+1) → α → α) (x) : | zero => simp [foldr_succ, Fin.last] | succ n ih => rw [foldr_succ, ih (f ·.succ), foldr_succ]; simp [succ_castSucc] +theorem foldr_eq_foldrM (f : Fin n → α → α) (x) : + foldr n f x = foldrM (m:=Id) n f x := by + induction n <;> simp [foldr_succ, foldrM_succ, *] + theorem foldr_eq_foldr_list (f : Fin n → α → α) (x) : foldr n f x = (list n).foldr f x := by induction n with | zero => rw [foldr_zero, list_zero, List.foldr_nil] | succ n ih => rw [foldr_succ, ih, list_succ, List.foldr_cons, List.foldr_map] -/-! ### foldl/foldr -/ - theorem foldl_rev (f : Fin n → α → α) (x) : foldl n (fun x i => f i.rev x) x = foldr n f x := by induction n generalizing x with diff --git a/Batteries/Data/HashMap/Basic.lean b/Batteries/Data/HashMap/Basic.lean index 3419ba35ab..de029c4276 100644 --- a/Batteries/Data/HashMap/Basic.lean +++ b/Batteries/Data/HashMap/Basic.lean @@ -37,7 +37,7 @@ def update (data : Buckets α β) (i : USize) The number of elements in the bucket array. Note: this is marked `noncomputable` because it is only intended for specification. -/ -noncomputable def size (data : Buckets α β) : Nat := .sum (data.1.data.map (·.toList.length)) +noncomputable def size (data : Buckets α β) : Nat := (data.1.toList.map (·.toList.length)).sum @[simp] theorem update_size (self : Buckets α β) (i d h) : (self.update i d h).1.size = self.1.size := Array.size_uset .. @@ -52,11 +52,11 @@ The well-formedness invariant for the bucket array says that every element hashe -/ structure WF [BEq α] [Hashable α] (buckets : Buckets α β) : Prop where /-- The elements of a bucket are all distinct according to the `BEq` relation. -/ - distinct [LawfulHashable α] [PartialEquivBEq α] : ∀ bucket ∈ buckets.1.data, + distinct [LawfulHashable α] [PartialEquivBEq α] : ∀ bucket ∈ buckets.1.toList, bucket.toList.Pairwise fun a b => ¬(a.1 == b.1) /-- Every element in a bucket should hash to its location. -/ hash_self (i : Nat) (h : i < buckets.1.size) : - buckets.1[i].All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i + buckets.1[i].All fun k _ => ((hash k).toUSize % USize.ofNat buckets.1.size).toNat = i end Buckets end Imp @@ -93,7 +93,7 @@ def empty (capacity := 0) : Imp α β := /-- Calculates the bucket index from a hash value `u`. -/ def mkIdx {n : Nat} (h : 0 < n) (u : USize) : {u : USize // u.toNat < n} := - ⟨u % n, USize.modn_lt _ h⟩ + ⟨u % USize.ofNat n, USize.toNat_mod_lt _ h⟩ /-- Inserts a key-value pair into the bucket array. This function assumes that the data is not @@ -202,7 +202,7 @@ Applies `f` to each key-value pair `a, b` in the map. If it returns `some c` the have : m'.1.size > 0 := by have := Array.size_mapM (m := StateT (ULift Nat) Id) (go .nil) m.buckets.1 simp [SatisfiesM_StateT_eq, SatisfiesM_Id_eq] at this - simp [this, Id.run, StateT.run, m.2.2, m'] + simp [this, Id.run, m.2.2, m'] ⟨m'.2.1, m'.1, this⟩ where /-- Inner loop of `filterMap`. Note that this reverses the bucket lists, @@ -237,7 +237,7 @@ inductive WF [BEq α] [Hashable α] : Imp α β → Prop where /-- Replacing an element in a well formed hash map yields a well formed hash map. -/ | modify : WF m → WF (modify m a f) -theorem WF.empty [BEq α] [Hashable α] : WF (empty n : Imp α β) := by unfold empty; apply empty' +theorem WF.empty [BEq α] [Hashable α] : WF (empty n : Imp α β) := empty' end Imp diff --git a/Batteries/Data/HashMap/Lemmas.lean b/Batteries/Data/HashMap/Lemmas.lean index 79107fc0bf..2e9df0770d 100644 --- a/Batteries/Data/HashMap/Lemmas.lean +++ b/Batteries/Data/HashMap/Lemmas.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Batteries.Data.HashMap.Basic diff --git a/Batteries/Data/HashMap/WF.lean b/Batteries/Data/HashMap/WF.lean index 258723a89b..aa33711633 100644 --- a/Batteries/Data/HashMap/WF.lean +++ b/Batteries/Data/HashMap/WF.lean @@ -15,26 +15,28 @@ attribute [-simp] Bool.not_eq_true namespace Buckets -@[ext] protected theorem ext : ∀ {b₁ b₂ : Buckets α β}, b₁.1.data = b₂.1.data → b₁ = b₂ +@[ext] protected theorem ext : ∀ {b₁ b₂ : Buckets α β}, b₁.1.toList = b₂.1.toList → b₁ = b₂ | ⟨⟨_⟩, _⟩, ⟨⟨_⟩, _⟩, rfl => rfl -theorem update_data (self : Buckets α β) (i d h) : - (self.update i d h).1.data = self.1.data.set i.toNat d := rfl +theorem toList_update (self : Buckets α β) (i d h) : + (self.update i d h).1.toList = self.1.toList.set i.toNat d := rfl + +@[deprecated (since := "2024-09-09")] alias update_data := toList_update theorem exists_of_update (self : Buckets α β) (i d h) : - ∃ l₁ l₂, self.1.data = l₁ ++ self.1[i] :: l₂ ∧ List.length l₁ = i.toNat ∧ - (self.update i d h).1.data = l₁ ++ d :: l₂ := by - simp only [Array.data_length, Array.ugetElem_eq_getElem, Array.getElem_eq_data_getElem] + ∃ l₁ l₂, self.1.toList = l₁ ++ self.1[i] :: l₂ ∧ List.length l₁ = i.toNat ∧ + (self.update i d h).1.toList = l₁ ++ d :: l₂ := by + simp only [Array.length_toList, Array.ugetElem_eq_getElem, Array.getElem_eq_getElem_toList] exact List.exists_of_set h theorem update_update (self : Buckets α β) (i d d' h h') : (self.update i d h).update i d' h' = self.update i d' h := by - simp only [update, Array.uset, Array.data_length] + simp only [update, Array.uset, Array.length_toList] congr 1 rw [Array.set_set] theorem size_eq (data : Buckets α β) : - size data = .sum (data.1.data.map (·.toList.length)) := rfl + size data = (data.1.toList.map (·.toList.length)).sum := rfl theorem mk_size (h) : (mk n h : Buckets α β).size = 0 := by simp only [mk, mkArray, size_eq]; clear h @@ -44,32 +46,32 @@ theorem WF.mk' [BEq α] [Hashable α] (h) : (Buckets.mk n h : Buckets α β).WF refine ⟨fun _ h => ?_, fun i h => ?_⟩ · simp only [Buckets.mk, mkArray, List.mem_replicate, ne_eq] at h simp [h, List.Pairwise.nil] - · simp [Buckets.mk, empty', mkArray, Array.getElem_eq_data_getElem, AssocList.All] + · simp [Buckets.mk, empty', mkArray, Array.getElem_eq_getElem_toList, AssocList.All] theorem WF.update [BEq α] [Hashable α] {buckets : Buckets α β} {i d h} (H : buckets.WF) (h₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], (buckets.1[i].toList.Pairwise fun a b => ¬(a.1 == b.1)) → d.toList.Pairwise fun a b => ¬(a.1 == b.1)) - (h₂ : (buckets.1[i].All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) → - d.All fun k _ => ((hash k).toUSize % buckets.1.size).toNat = i.toNat) : + (h₂ : (buckets.1[i].All fun k _ => ((hash k).toUSize % .ofNat buckets.1.size).toNat = i.toNat) → + d.All fun k _ => ((hash k).toUSize % USize.ofNat buckets.1.size).toNat = i.toNat) : (buckets.update i d h).WF := by refine ⟨fun l hl => ?_, fun i hi p hp => ?_⟩ · exact match List.mem_or_eq_of_mem_set hl with | .inl hl => H.1 _ hl - | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_data ..)) + | .inr rfl => h₁ (H.1 _ (Array.getElem_mem_toList ..)) · revert hp - simp only [Array.getElem_eq_data_getElem, update_data, List.getElem_set, Array.data_length, - update_size] + simp only [Array.getElem_eq_getElem_toList, toList_update, List.getElem_set, + Array.length_toList, update_size] split <;> intro hp · next eq => exact eq ▸ h₂ (H.2 _ _) _ hp - · simp only [update_size, Array.data_length] at hi + · simp only [update_size, Array.length_toList] at hi exact H.2 i hi _ hp end Buckets theorem reinsertAux_size [Hashable α] (data : Buckets α β) (a : α) (b : β) : (reinsertAux data a b).size = data.size.succ := by - simp only [reinsertAux, Array.data_length, Array.ugetElem_eq_getElem, Buckets.size_eq, + simp only [reinsertAux, Array.length_toList, Array.ugetElem_eq_getElem, Buckets.size_eq, Nat.succ_eq_add_one] refine have ⟨l₁, l₂, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h₁, Nat.succ_add]; rfl @@ -89,35 +91,35 @@ theorem expand_size [Hashable α] {buckets : Buckets α β} : · rw [Buckets.mk_size]; simp [Buckets.size] · nofun where - go (i source) (target : Buckets α β) (hs : ∀ j < i, source.data[j]?.getD .nil = .nil) : + go (i source) (target : Buckets α β) (hs : ∀ j < i, source.toList[j]?.getD .nil = .nil) : (expand.go i source target).size = - .sum (source.data.map (·.toList.length)) + target.size := by + (source.toList.map (·.toList.length)).sum + target.size := by unfold expand.go; split · next H => refine (go (i+1) _ _ fun j hj => ?a).trans ?b · case a => - simp only [Array.data_length, Array.data_set] + simp only [Array.length_toList, Array.toList_set] simp [List.getD_eq_getElem?_getD, List.getElem?_set, Option.map_eq_map]; split - · cases source.data[j]? <;> rfl + · cases source.toList[j]? <;> rfl · next H => exact hs _ (Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) (Ne.symm H)) · case b => - simp only [Array.data_length, Array.data_set, Array.get_eq_getElem, AssocList.foldl_eq] + simp only [Array.length_toList, Array.toList_set, Array.get_eq_getElem, AssocList.foldl_eq] refine have ⟨l₁, l₂, h₁, _, eq⟩ := List.exists_of_set H; eq ▸ ?_ rw [h₁] simp only [Buckets.size_eq, List.map_append, List.map_cons, AssocList.toList, - List.length_nil, Nat.sum_append, Nat.sum_cons, Nat.zero_add, Array.data_length] + List.length_nil, Nat.sum_append, List.sum_cons, Nat.zero_add, Array.length_toList] rw [Nat.add_assoc, Nat.add_assoc, Nat.add_assoc]; congr 1 (conv => rhs; rw [Nat.add_left_comm]); congr 1 - rw [← Array.getElem_eq_data_getElem] + rw [← Array.getElem_eq_getElem_toList] have := @reinsertAux_size α β _; simp [Buckets.size] at this induction source[i].toList generalizing target <;> simp [*, Nat.succ_add]; rfl · next H => - rw [(_ : Nat.sum _ = 0), Nat.zero_add] - rw [← (_ : source.data.map (fun _ => .nil) = source.data)] + rw [(_ : List.sum _ = 0), Nat.zero_add] + rw [← (_ : source.toList.map (fun _ => .nil) = source.toList)] · simp only [List.map_map] - induction source.data <;> simp [*] + induction source.toList <;> simp [*] refine List.ext_getElem (by simp) fun j h₁ h₂ => ?_ - simp only [List.getElem_map, Array.data_length] + simp only [List.getElem_map, Array.length_toList] have := (hs j (Nat.lt_of_lt_of_le h₂ (Nat.not_lt.1 H))).symm rwa [List.getElem?_eq_getElem] at this termination_by source.size - i @@ -126,21 +128,21 @@ theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α (hl₁ : ∀ [PartialEquivBEq α] [LawfulHashable α], l.Pairwise fun a b => ¬(a.1 == b.1)) (hl₂ : ∀ x ∈ l, rank x.1 = i) {target : Buckets α β} (ht₁ : target.WF) - (ht₂ : ∀ bucket ∈ target.1.data, + (ht₂ : ∀ bucket ∈ target.1.toList, bucket.All fun k _ => rank k ≤ i ∧ ∀ [PartialEquivBEq α] [LawfulHashable α], ∀ x ∈ l, ¬(x.1 == k)) : (l.foldl (fun d x => reinsertAux d x.1 x.2) target).WF ∧ - ∀ bucket ∈ (l.foldl (fun d x => reinsertAux d x.1 x.2) target).1.data, + ∀ bucket ∈ (l.foldl (fun d x => reinsertAux d x.1 x.2) target).1.toList, bucket.All fun k _ => rank k ≤ i := by induction l generalizing target with | nil => exact ⟨ht₁, fun _ h₁ _ h₂ => (ht₂ _ h₁ _ h₂).1⟩ | cons _ _ ih => simp only [List.pairwise_cons, List.mem_cons, forall_eq_or_imp] at hl₁ hl₂ ht₂ refine ih hl₁.2 hl₂.2 - (reinsertAux_WF ht₁ fun _ h => (ht₂ _ (Array.getElem_mem_data ..) _ h).2.1) + (reinsertAux_WF ht₁ fun _ h => (ht₂ _ (Array.getElem_mem_toList ..) _ h).2.1) (fun _ h => ?_) - simp only [reinsertAux, Buckets.update, Array.uset, Array.data_length, - Array.ugetElem_eq_getElem, Array.data_set] at h + simp only [reinsertAux, Buckets.update, Array.uset, Array.length_toList, + Array.ugetElem_eq_getElem, Array.toList_set] at h match List.mem_or_eq_of_mem_set h with | .inl h => intro _ hf @@ -150,7 +152,7 @@ theorem expand_WF.foldl [BEq α] [Hashable α] (rank : α → Nat) {l : List (α | _, .head .. => exact ⟨hl₂.1 ▸ Nat.le_refl _, fun _ h h' => hl₁.1 _ h (PartialEquivBEq.symm h')⟩ | _, .tail _ h => - have ⟨h₁, h₂⟩ := ht₂ _ (Array.getElem_mem_data ..) _ h + have ⟨h₁, h₂⟩ := ht₂ _ (Array.getElem_mem_toList ..) _ h exact ⟨h₁, h₂.2⟩ theorem expand_WF [BEq α] [Hashable α] {buckets : Buckets α β} (H : buckets.WF) : @@ -158,12 +160,12 @@ theorem expand_WF [BEq α] [Hashable α] {buckets : Buckets α β} (H : buckets. go _ H.1 H.2 ⟨.mk' _, fun _ _ _ _ => by simp_all [Buckets.mk, List.mem_replicate]⟩ where go (i) {source : Array (AssocList α β)} - (hs₁ : ∀ [LawfulHashable α] [PartialEquivBEq α], ∀ bucket ∈ source.data, + (hs₁ : ∀ [LawfulHashable α] [PartialEquivBEq α], ∀ bucket ∈ source.toList, bucket.toList.Pairwise fun a b => ¬(a.1 == b.1)) (hs₂ : ∀ (j : Nat) (h : j < source.size), - source[j].All fun k _ => ((hash k).toUSize % source.size).toNat = j) - {target : Buckets α β} (ht : target.WF ∧ ∀ bucket ∈ target.1.data, - bucket.All fun k _ => ((hash k).toUSize % source.size).toNat < i) : + source[j].All fun k _ => ((hash k).toUSize % USize.ofNat source.size).toNat = j) + {target : Buckets α β} (ht : target.WF ∧ ∀ bucket ∈ target.1.toList, + bucket.All fun k _ => ((hash k).toUSize % USize.ofNat source.size).toNat < i) : (expand.go i source target).WF := by unfold expand.go; split · next H => @@ -171,16 +173,16 @@ where · match List.mem_or_eq_of_mem_set hl with | .inl hl => exact hs₁ _ hl | .inr e => exact e ▸ .nil - · simp only [Array.data_length, Array.size_set, Array.getElem_eq_data_getElem, Array.data_set, - List.getElem_set] + · simp only [Array.length_toList, Array.size_set, Array.getElem_eq_getElem_toList, + Array.toList_set, List.getElem_set] split · nofun · exact hs₂ _ (by simp_all) - · let rank (k : α) := ((hash k).toUSize % source.size).toNat + · let rank (k : α) := ((hash k).toUSize % USize.ofNat source.size).toNat have := expand_WF.foldl rank ?_ (hs₂ _ H) ht.1 (fun _ h₁ _ h₂ => ?_) · simp only [Array.get_eq_getElem, AssocList.foldl_eq, Array.size_set] exact ⟨this.1, fun _ h₁ _ h₂ => Nat.lt_succ_of_le (this.2 _ h₁ _ h₂)⟩ - · exact hs₁ _ (Array.getElem_mem_data ..) + · exact hs₁ _ (Array.getElem_mem_toList ..) · have := ht.2 _ h₁ _ h₂ refine ⟨Nat.le_of_lt this, fun _ h h' => Nat.ne_of_lt this ?_⟩ exact LawfulHashable.hash_eq h' ▸ hs₂ _ H _ h @@ -198,7 +200,7 @@ theorem insert_size [BEq α] [Hashable α] {m : Imp α β} {k v} · unfold Buckets.size refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h, h₁, Buckets.size_eq, Nat.succ_add]; rfl - · rw [expand_size]; simp only [expand, h, Buckets.size, Array.data_length, Buckets.update_size] + · rw [expand_size]; simp only [expand, h, Buckets.size, Array.length_toList, Buckets.update_size] refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ simp [h₁, Buckets.size_eq, Nat.succ_add]; rfl @@ -264,8 +266,8 @@ theorem erase_size [BEq α] [Hashable α] {m : Imp α β} {k} · next H => simp only [h, Buckets.size] refine have ⟨_, _, h₁, _, eq⟩ := Buckets.exists_of_update ..; eq ▸ ?_ - simp only [h₁, Array.data_length, Array.ugetElem_eq_getElem, List.map_append, List.map_cons, - Nat.sum_append, Nat.sum_cons, AssocList.toList_erase] + simp only [h₁, Array.length_toList, Array.ugetElem_eq_getElem, List.map_append, List.map_cons, + Nat.sum_append, List.sum_cons, AssocList.toList_erase] rw [(_ : List.length _ = _ + 1), Nat.add_right_comm]; {rfl} clear h₁ eq simp only [AssocList.contains_eq, List.any_eq_true] at H @@ -317,8 +319,8 @@ theorem WF.mapVal {α β γ} {f : α → β → γ} [BEq α] [Hashable α] {m : Imp α β} (H : WF m) : WF (mapVal f m) := by have ⟨h₁, h₂⟩ := H.out simp only [Imp.mapVal, h₁, Buckets.mapVal, WF_iff]; refine ⟨?_, ?_, fun i h => ?_⟩ - · simp only [Buckets.size, Array.map_data, List.map_map]; congr; funext l; simp - · simp only [Array.map_data, List.forall_mem_map] + · simp only [Buckets.size, Array.toList_map, List.map_map]; congr; funext l; simp + · simp only [Array.toList_map, List.forall_mem_map] simp only [AssocList.toList_mapVal, List.pairwise_map] exact fun _ => h₂.1 _ · simp only [Array.size_map, AssocList.All, Array.getElem_map, AssocList.toList_mapVal, @@ -345,7 +347,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable let M := StateT (ULift Nat) Id have H2 (l : List (AssocList α β)) n : l.mapM (m := M) (filterMap.go f .nil) n = - (l.map g, ⟨n.1 + .sum ((l.map g).map (·.toList.length))⟩) := by + (l.map g, ⟨n.1 + ((l.map g).map (·.toList.length)).sum⟩) := by induction l generalizing n with | nil => rfl | cons l L IH => simp [bind, StateT.bind, IH, H1, Nat.add_assoc, g]; rfl @@ -361,7 +363,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable suffices ∀ bk sz (h : 0 < bk.length), m.buckets.val.mapM (m := M) (filterMap.go f .nil) ⟨0⟩ = (⟨bk⟩, ⟨sz⟩) → WF ⟨sz, ⟨bk⟩, h⟩ from this _ _ _ rfl - simp only [Array.mapM_eq_mapM_data, bind, StateT.bind, H2, List.map_map, Nat.zero_add, g] + simp only [Array.mapM_eq_mapM_toList, Functor.map, StateT.map, H2, List.map_map, Nat.zero_add, g] intro bk sz h e'; cases e' refine .mk (by simp [Buckets.size]) ⟨?_, fun i h => ?_⟩ · simp only [List.forall_mem_map, List.toList_toAssocList] @@ -369,7 +371,7 @@ theorem WF.filterMap {α β γ} {f : α → β → Option γ} [BEq α] [Hashable have := H.out.2.1 _ h rw [← List.pairwise_map (R := (¬ · == ·))] at this ⊢ exact this.sublist (H3 l.toList) - · simp only [Array.size_mk, List.length_map, Array.data_length, Array.getElem_eq_data_getElem, + · simp only [Array.size_mk, List.length_map, Array.length_toList, Array.getElem_eq_getElem_toList, List.getElem_map] at h ⊢ have := H.out.2.2 _ h simp only [AssocList.All, List.toList_toAssocList, List.mem_reverse, List.mem_filterMap, diff --git a/Batteries/Data/List.lean b/Batteries/Data/List.lean index f93f90a6c2..3429039dc9 100644 --- a/Batteries/Data/List.lean +++ b/Batteries/Data/List.lean @@ -3,6 +3,7 @@ import Batteries.Data.List.Count import Batteries.Data.List.EraseIdx import Batteries.Data.List.Init.Lemmas import Batteries.Data.List.Lemmas +import Batteries.Data.List.Monadic import Batteries.Data.List.OfFn import Batteries.Data.List.Pairwise import Batteries.Data.List.Perm diff --git a/Batteries/Data/List/Basic.lean b/Batteries/Data/List/Basic.lean index c2d76ed0e6..9c0ab14d46 100644 --- a/Batteries/Data/List/Basic.lean +++ b/Batteries/Data/List/Basic.lean @@ -32,17 +32,6 @@ open Option Nat | [] => none | a :: l => some (a, l) -/-- -Given a function `f : Nat → α → β` and `as : list α`, `as = [a₀, a₁, ...]`, returns the list -`[f 0 a₀, f 1 a₁, ...]`. --/ -@[inline] def mapIdx (f : Nat → α → β) (as : List α) : List β := go as #[] where - /-- Auxiliary for `mapIdx`: - `mapIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/ - @[specialize] go : List α → Array β → List β - | [], acc => acc.toList - | a :: as, acc => go as (acc.push (f acc.size a)) - /-- Monadic variant of `mapIdx`. -/ @[inline] def mapIdxM {m : Type v → Type w} [Monad m] (as : List α) (f : Nat → α → m β) : m (List β) := go as #[] where @@ -64,10 +53,6 @@ drop_while (· != 1) [0, 1, 2, 3] = [1, 2, 3] | [] => [] | x :: xs => bif p x then xs else after p xs -@[deprecated (since := "2024-05-06")] alias removeNth := eraseIdx -@[deprecated (since := "2024-05-06")] alias removeNthTR := eraseIdxTR -@[deprecated (since := "2024-05-06")] alias removeNth_eq_removeNthTR := eraseIdx_eq_eraseIdxTR - /-- Replaces the first element of the list for which `f` returns `some` with the returned value. -/ @[simp] def replaceF (f : α → Option α) : List α → List α | [] => [] @@ -86,7 +71,7 @@ drop_while (· != 1) [0, 1, 2, 3] = [1, 2, 3] @[csimp] theorem replaceF_eq_replaceFTR : @replaceF = @replaceFTR := by funext α p l; simp [replaceFTR] - let rec go (acc) : ∀ xs, replaceFTR.go p xs acc = acc.data ++ xs.replaceF p + let rec go (acc) : ∀ xs, replaceFTR.go p xs acc = acc.toList ++ xs.replaceF p | [] => by simp [replaceFTR.go, replaceF] | x::xs => by simp [replaceFTR.go, replaceF]; cases p x <;> simp @@ -149,8 +134,9 @@ def splitOnP (P : α → Bool) (l : List α) : List (List α) := go l [] where @[csimp] theorem splitOnP_eq_splitOnPTR : @splitOnP = @splitOnPTR := by funext α P l; simp [splitOnPTR] - suffices ∀ xs acc r, splitOnPTR.go P xs acc r = r.data ++ splitOnP.go P xs acc.data.reverse from - (this l #[] #[]).symm + suffices ∀ xs acc r, + splitOnPTR.go P xs acc r = r.toList ++ splitOnP.go P xs acc.toList.reverse from + (this l #[] #[]).symm intro xs acc r; induction xs generalizing acc r with simp [splitOnP.go, splitOnPTR.go] | cons x xs IH => cases P x <;> simp [*] @@ -162,47 +148,8 @@ Split a list at every occurrence of a separator element. The separators are not -/ @[inline] def splitOn [BEq α] (a : α) (as : List α) : List (List α) := as.splitOnP (· == a) -/-- -Apply a function to the nth tail of `l`. Returns the input without -using `f` if the index is larger than the length of the List. -``` -modifyNthTail f 2 [a, b, c] = [a, b] ++ f [c] -``` --/ -@[simp] def modifyNthTail (f : List α → List α) : Nat → List α → List α - | 0, l => f l - | _+1, [] => [] - | n+1, a :: l => a :: modifyNthTail f n l - -/-- Apply `f` to the head of the list, if it exists. -/ -@[inline] def modifyHead (f : α → α) : List α → List α - | [] => [] - | a :: l => f a :: l - -@[simp] theorem modifyHead_nil (f : α → α) : [].modifyHead f = [] := by rw [modifyHead] - -@[simp] theorem modifyHead_cons (a : α) (l : List α) (f : α → α) : - (a :: l).modifyHead f = f a :: l := by rw [modifyHead] - -/-- Apply `f` to the nth element of the list, if it exists. -/ -def modifyNth (f : α → α) : Nat → List α → List α := - modifyNthTail (modifyHead f) - -/-- Tail-recursive version of `modifyNth`. -/ -def modifyNthTR (f : α → α) (n : Nat) (l : List α) : List α := go l n #[] where - /-- Auxiliary for `modifyNthTR`: `modifyNthTR.go f l n acc = acc.toList ++ modifyNth f n l`. -/ - go : List α → Nat → Array α → List α - | [], _, acc => acc.toList - | a :: l, 0, acc => acc.toListAppend (f a :: l) - | a :: l, n+1, acc => go l n (acc.push a) - -theorem modifyNthTR_go_eq : ∀ l n, modifyNthTR.go f l n acc = acc.data ++ modifyNth f n l - | [], n => by cases n <;> simp [modifyNthTR.go, modifyNth] - | a :: l, 0 => by simp [modifyNthTR.go, modifyNth] - | a :: l, n+1 => by simp [modifyNthTR.go, modifyNth, modifyNthTR_go_eq l] - -@[csimp] theorem modifyNth_eq_modifyNthTR : @modifyNth = @modifyNthTR := by - funext α f n l; simp [modifyNthTR, modifyNthTR_go_eq] +@[deprecated (since := "2024-10-21")] alias modifyNthTail := modifyTailIdx +@[deprecated (since := "2024-10-21")] alias modifyNth := modify /-- Apply `f` to the last element of `l`, if it exists. -/ @[inline] def modifyLast (f : α → α) (l : List α) : List α := go l #[] where @@ -213,28 +160,30 @@ theorem modifyNthTR_go_eq : ∀ l n, modifyNthTR.go f l n acc = acc.data ++ modi | x :: xs, acc => go xs (acc.push x) /-- -`insertNth n a l` inserts `a` into the list `l` after the first `n` elements of `l` +`insertIdx n a l` inserts `a` into the list `l` after the first `n` elements of `l` ``` -insertNth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4] +insertIdx 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4] ``` -/ -def insertNth (n : Nat) (a : α) : List α → List α := - modifyNthTail (cons a) n +def insertIdx (n : Nat) (a : α) : List α → List α := + modifyTailIdx (cons a) n + +@[deprecated (since := "2024-10-21")] alias insertNth := insertIdx -/-- Tail-recursive version of `insertNth`. -/ -@[inline] def insertNthTR (n : Nat) (a : α) (l : List α) : List α := go n l #[] where - /-- Auxiliary for `insertNthTR`: `insertNthTR.go a n l acc = acc.toList ++ insertNth n a l`. -/ +/-- Tail-recursive version of `insertIdx`. -/ +@[inline] def insertIdxTR (n : Nat) (a : α) (l : List α) : List α := go n l #[] where + /-- Auxiliary for `insertIdxTR`: `insertIdxTR.go a n l acc = acc.toList ++ insertIdx n a l`. -/ go : Nat → List α → Array α → List α | 0, l, acc => acc.toListAppend (a :: l) | _, [], acc => acc.toList | n+1, a :: l, acc => go n l (acc.push a) -theorem insertNthTR_go_eq : ∀ n l, insertNthTR.go a n l acc = acc.data ++ insertNth n a l - | 0, l | _+1, [] => by simp [insertNthTR.go, insertNth] - | n+1, a :: l => by simp [insertNthTR.go, insertNth, insertNthTR_go_eq n l] +theorem insertIdxTR_go_eq : ∀ n l, insertIdxTR.go a n l acc = acc.toList ++ insertIdx n a l + | 0, l | _+1, [] => by simp [insertIdxTR.go, insertIdx] + | n+1, a :: l => by simp [insertIdxTR.go, insertIdx, insertIdxTR_go_eq n l] -@[csimp] theorem insertNth_eq_insertNthTR : @insertNth = @insertNthTR := by - funext α f n l; simp [insertNthTR, insertNthTR_go_eq] +@[csimp] theorem insertIdx_eq_insertIdxTR : @insertIdx = @insertIdxTR := by + funext α f n l; simp [insertIdxTR, insertIdxTR_go_eq] theorem headD_eq_head? (l) (a : α) : headD l a = (head? l).getD a := by cases l <;> rfl @@ -261,7 +210,7 @@ def takeDTR (n : Nat) (l : List α) (dflt : α) : List α := go n l #[] where | 0, _, acc => acc.toList | n, [], acc => acc.toListAppend (replicate n dflt) -theorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.data ++ takeD n l dflt +theorem takeDTR_go_eq : ∀ n l, takeDTR.go dflt n l acc = acc.toList ++ takeD n l dflt | 0, _ => by simp [takeDTR.go] | _+1, [] => by simp [takeDTR.go, replicate_succ] | _+1, _::l => by simp [takeDTR.go, takeDTR_go_eq _ l] @@ -286,7 +235,7 @@ scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6] | [], a, acc => acc.toListAppend [a] | b :: l, a, acc => go l (f a b) (acc.push a) -theorem scanlTR_go_eq : ∀ l, scanlTR.go f l a acc = acc.data ++ scanl f a l +theorem scanlTR_go_eq : ∀ l, scanlTR.go f l a acc = acc.toList ++ scanl f a l | [] => by simp [scanlTR.go, scanl] | a :: l => by simp [scanlTR.go, scanl, scanlTR_go_eq l] @@ -415,7 +364,7 @@ sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]] ``` -/ def sublists (l : List α) : List (List α) := - l.foldr (fun a acc => acc.bind fun x => [x, a :: x]) [[]] + l.foldr (fun a acc => acc.flatMap fun x => [x, a :: x]) [[]] /-- A version of `List.sublists` that has faster runtime performance but worse kernel performance -/ def sublistsFast (l : List α) : List (List α) := @@ -513,7 +462,7 @@ of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from -/ @[simp] def sections : List (List α) → List (List α) | [] => [[]] - | l :: L => (sections L).bind fun s => l.map fun a => a :: s + | l :: L => (sections L).flatMap fun s => l.map fun a => a :: s /-- Optimized version of `sections`. -/ def sectionsTR (L : List (List α)) : List (List α) := @@ -538,8 +487,8 @@ theorem sections_eq_nil_of_isEmpty : ∀ {L}, L.any isEmpty → @sections α L = cases e : L.any isEmpty <;> simp [sections_eq_nil_of_isEmpty, *] clear e; induction L with | nil => rfl | cons l L IH => ?_ simp [IH, sectionsTR.go] - rw [Array.foldl_eq_foldl_data, Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map + rw [Array.foldl_eq_foldl_toList, Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `extractP p l` returns a pair of an element `a` of `l` satisfying the predicate @@ -568,7 +517,7 @@ def revzip (l : List α) : List (α × α) := zip l l.reverse product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)] ``` -/ -def product (l₁ : List α) (l₂ : List β) : List (α × β) := l₁.bind fun a => l₂.map (Prod.mk a) +def product (l₁ : List α) (l₂ : List β) : List (α × β) := l₁.flatMap fun a => l₂.map (Prod.mk a) /-- Optimized version of `product`. -/ def productTR (l₁ : List α) (l₂ : List β) : List (α × β) := @@ -576,15 +525,15 @@ def productTR (l₁ : List α) (l₂ : List β) : List (α × β) := @[csimp] theorem product_eq_productTR : @product = @productTR := by funext α β l₁ l₂; simp [product, productTR] - rw [Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map + rw [Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`. ``` sigma [1, 2] (λ_, [(5 : Nat), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] ``` -/ protected def sigma {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) := - l₁.bind fun a => (l₂ a).map (Sigma.mk a) + l₁.flatMap fun a => (l₂ a).map (Sigma.mk a) /-- Optimized version of `sigma`. -/ def sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) := @@ -592,8 +541,8 @@ def sigmaTR {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : @[csimp] theorem sigma_eq_sigmaTR : @List.sigma = @sigmaTR := by funext α β l₁ l₂; simp [List.sigma, sigmaTR] - rw [Array.foldl_data_eq_bind]; rfl - intros; apply Array.foldl_data_eq_map + rw [Array.foldl_toList_eq_flatMap]; rfl + intros; apply Array.foldl_toList_eq_map /-- `ofFn f` with `f : fin n → α` returns the list whose ith element is `f i` @@ -758,15 +707,15 @@ where | x::xs, n+1, acc => go m xs n (acc.push x) theorem dropSlice_zero₂ : ∀ n l, @dropSlice α n 0 l = l - | 0, [] | 0, _::_ | n+1, [] => rfl + | 0, [] | 0, _::_ | _+1, [] => rfl | n+1, x::xs => by simp [dropSlice, dropSlice_zero₂] @[csimp] theorem dropSlice_eq_dropSliceTR : @dropSlice = @dropSliceTR := by funext α n m l; simp [dropSliceTR] split; { rw [dropSlice_zero₂] } rename_i m - let rec go (acc) : ∀ xs n, l = acc.data ++ xs → - dropSliceTR.go l m xs n acc = acc.data ++ xs.dropSlice n (m+1) + let rec go (acc) : ∀ xs n, l = acc.toList ++ xs → + dropSliceTR.go l m xs n acc = acc.toList ++ xs.dropSlice n (m+1) | [], n | _::xs, 0 => fun h => by simp [dropSliceTR.go, dropSlice, h] | x::xs, n+1 => by simp [dropSliceTR.go, dropSlice]; intro h; rw [go _ xs]; {simp}; simp [h] @@ -801,7 +750,7 @@ zipWithLeft' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b']) let rec go (acc) : ∀ as bs, zipWithLeft'TR.go f as bs acc = let (l, r) := as.zipWithLeft' f bs; (acc.toList ++ l, r) | [], bs => by simp [zipWithLeft'TR.go] - | _::_, [] => by simp [zipWithLeft'TR.go, Array.foldl_data_eq_map] + | _::_, [] => by simp [zipWithLeft'TR.go, Array.foldl_toList_eq_map] | a::as, b::bs => by simp [zipWithLeft'TR.go, go _ as bs] simp [zipWithLeft'TR, go] @@ -870,7 +819,7 @@ zipWithLeft f as bs = (zipWithLeft' f as bs).fst funext α β γ f as bs; simp [zipWithLeftTR] let rec go (acc) : ∀ as bs, zipWithLeftTR.go f as bs acc = acc.toList ++ as.zipWithLeft f bs | [], bs => by simp [zipWithLeftTR.go] - | _::_, [] => by simp [zipWithLeftTR.go, Array.foldl_data_eq_map] + | _::_, [] => by simp [zipWithLeftTR.go, Array.foldl_toList_eq_map] | a::as, b::bs => by simp [zipWithLeftTR.go, go _ as bs] simp [zipWithLeftTR, go] @@ -946,7 +895,7 @@ fillNones [none, some 1, none, none] [2, 3] = [2, 1, 3] @[csimp] theorem fillNones_eq_fillNonesTR : @fillNones = @fillNonesTR := by funext α as as'; simp [fillNonesTR] - let rec go (acc) : ∀ as as', @fillNonesTR.go α as as' acc = acc.data ++ as.fillNones as' + let rec go (acc) : ∀ as as', @fillNonesTR.go α as as' acc = acc.toList ++ as.fillNones as' | [], _ => by simp [fillNonesTR.go] | some a :: as, as' => by simp [fillNonesTR.go, go _ as as'] | none :: as, [] => by simp [fillNonesTR.go, reduceOption, filterMap_eq_filterMapTR.go] diff --git a/Batteries/Data/List/Lemmas.lean b/Batteries/Data/List/Lemmas.lean index ce439cffc5..c8fba52299 100644 --- a/Batteries/Data/List/Lemmas.lean +++ b/Batteries/Data/List/Lemmas.lean @@ -10,31 +10,11 @@ import Batteries.Tactic.Alias namespace List -open Nat - -/-! ### mem -/ - -@[simp] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by - simp [Array.mem_def] - /-! ### toArray-/ -@[simp] theorem size_toArrayAux (l : List α) (r : Array α) : - (l.toArrayAux r).size = r.size + l.length := by - induction l generalizing r with - | nil => simp [toArrayAux] - | cons a l ih => - simp [ih, List.toArrayAux] - omega - @[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl -@[simp] theorem getElem_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) : - l.toArray[i] = l[i]'(by simpa using h) := by - rw [Array.getElem_eq_data_getElem] - simp - /-! ### next? -/ @[simp] theorem next?_nil : @next? α [] = none := rfl @@ -56,167 +36,30 @@ theorem dropLast_eq_eraseIdx {xs : List α} {i : Nat} (last_idx : i + 1 = xs.len exact ih last_idx exact fun _ => nomatch xs -/-! ### get? -/ - -@[deprecated getElem_eq_iff (since := "2024-06-12")] -theorem get_eq_iff : List.get l n = x ↔ l.get? n.1 = some x := by - simp - -@[deprecated getElem?_inj (since := "2024-06-12")] -theorem get?_inj - (h₀ : i < xs.length) (h₁ : Nodup xs) (h₂ : xs.get? i = xs.get? j) : i = j := by - apply getElem?_inj h₀ h₁ - simp_all - -/-! ### modifyNth -/ - -@[simp] theorem modifyNth_nil (f : α → α) (n) : [].modifyNth f n = [] := by cases n <;> rfl - -@[simp] theorem modifyNth_zero_cons (f : α → α) (a : α) (l : List α) : - (a :: l).modifyNth f 0 = f a :: l := rfl - -@[simp] theorem modifyNth_succ_cons (f : α → α) (a : α) (l : List α) (n) : - (a :: l).modifyNth f (n + 1) = a :: l.modifyNth f n := by rfl - -theorem modifyNthTail_id : ∀ n (l : List α), l.modifyNthTail id n = l - | 0, _ => rfl - | _+1, [] => rfl - | n+1, a :: l => congrArg (cons a) (modifyNthTail_id n l) - -theorem eraseIdx_eq_modifyNthTail : ∀ n (l : List α), eraseIdx l n = modifyNthTail tail n l - | 0, l => by cases l <;> rfl - | n+1, [] => rfl - | n+1, a :: l => congrArg (cons _) (eraseIdx_eq_modifyNthTail _ _) - -@[deprecated (since := "2024-05-06")] alias removeNth_eq_nth_tail := eraseIdx_eq_modifyNthTail - -theorem getElem?_modifyNth (f : α → α) : - ∀ n (l : List α) m, (modifyNth f n l)[m]? = (fun a => if n = m then f a else a) <$> l[m]? - | n, l, 0 => by cases l <;> cases n <;> simp - | n, [], _+1 => by cases n <;> rfl - | 0, _ :: l, m+1 => by cases h : l[m]? <;> simp [h, modifyNth, m.succ_ne_zero.symm] - | n+1, a :: l, m+1 => by - simp only [modifyNth_succ_cons, getElem?_cons_succ, Nat.reduceEqDiff, Option.map_eq_map] - refine (getElem?_modifyNth f n l m).trans ?_ - cases h' : l[m]? <;> by_cases h : n = m <;> - simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h'] - -@[deprecated getElem?_modifyNth (since := "2024-06-12")] -theorem get?_modifyNth (f : α → α) (n) (l : List α) (m) : - (modifyNth f n l).get? m = (fun a => if n = m then f a else a) <$> l.get? m := by - simp [getElem?_modifyNth] - -theorem length_modifyNthTail (f : List α → List α) (H : ∀ l, length (f l) = length l) : - ∀ n l, length (modifyNthTail f n l) = length l - | 0, _ => H _ - | _+1, [] => rfl - | _+1, _ :: _ => congrArg (·+1) (length_modifyNthTail _ H _ _) - -@[deprecated (since := "2024-06-07")] alias modifyNthTail_length := length_modifyNthTail - -theorem modifyNthTail_add (f : List α → List α) (n) (l₁ l₂ : List α) : - modifyNthTail f (l₁.length + n) (l₁ ++ l₂) = l₁ ++ modifyNthTail f n l₂ := by - induction l₁ <;> simp [*, Nat.succ_add] - -theorem exists_of_modifyNthTail (f : List α → List α) {n} {l : List α} (h : n ≤ l.length) : - ∃ l₁ l₂, l = l₁ ++ l₂ ∧ l₁.length = n ∧ modifyNthTail f n l = l₁ ++ f l₂ := - have ⟨_, _, eq, hl⟩ : ∃ l₁ l₂, l = l₁ ++ l₂ ∧ l₁.length = n := - ⟨_, _, (take_append_drop n l).symm, length_take_of_le h⟩ - ⟨_, _, eq, hl, hl ▸ eq ▸ modifyNthTail_add (n := 0) ..⟩ - -@[simp] theorem length_modifyNth (f : α → α) : ∀ n l, length (modifyNth f n l) = length l := - length_modifyNthTail _ fun l => by cases l <;> rfl - -@[deprecated (since := "2024-06-07")] alias modify_get?_length := length_modifyNth - -@[simp] theorem getElem?_modifyNth_eq (f : α → α) (n) (l : List α) : - (modifyNth f n l)[n]? = f <$> l[n]? := by - simp only [getElem?_modifyNth, if_pos] - -@[deprecated getElem?_modifyNth_eq (since := "2024-06-12")] -theorem get?_modifyNth_eq (f : α → α) (n) (l : List α) : - (modifyNth f n l).get? n = f <$> l.get? n := by - simp [getElem?_modifyNth_eq] - -@[simp] theorem getElem?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : - (modifyNth f m l)[n]? = l[n]? := by - simp only [getElem?_modifyNth, if_neg h, id_map'] - -@[deprecated getElem?_modifyNth_ne (since := "2024-06-12")] -theorem get?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : - (modifyNth f m l).get? n = l.get? n := by - simp [h] - -theorem exists_of_modifyNth (f : α → α) {n} {l : List α} (h : n < l.length) : - ∃ l₁ a l₂, l = l₁ ++ a :: l₂ ∧ l₁.length = n ∧ modifyNth f n l = l₁ ++ f a :: l₂ := - match exists_of_modifyNthTail _ (Nat.le_of_lt h) with - | ⟨_, _::_, eq, hl, H⟩ => ⟨_, _, _, eq, hl, H⟩ - | ⟨_, [], eq, hl, _⟩ => nomatch Nat.ne_of_gt h (eq ▸ append_nil _ ▸ hl) - -theorem modifyNthTail_eq_take_drop (f : List α → List α) (H : f [] = []) : - ∀ n l, modifyNthTail f n l = take n l ++ f (drop n l) - | 0, _ => rfl - | _ + 1, [] => H.symm - | n + 1, b :: l => congrArg (cons b) (modifyNthTail_eq_take_drop f H n l) - -theorem modifyNth_eq_take_drop (f : α → α) : - ∀ n l, modifyNth f n l = take n l ++ modifyHead f (drop n l) := - modifyNthTail_eq_take_drop _ rfl - -theorem modifyNth_eq_take_cons_drop (f : α → α) {n l} (h : n < length l) : - modifyNth f n l = take n l ++ f l[n] :: drop (n + 1) l := by - rw [modifyNth_eq_take_drop, drop_eq_getElem_cons h]; rfl - /-! ### set -/ -theorem set_eq_modifyNth (a : α) : ∀ n (l : List α), set l n a = modifyNth (fun _ => a) n l +theorem set_eq_modify (a : α) : ∀ n (l : List α), set l n a = modify (fun _ => a) n l | 0, l => by cases l <;> rfl - | n+1, [] => rfl - | n+1, b :: l => congrArg (cons _) (set_eq_modifyNth _ _ _) + | _+1, [] => rfl + | _+1, _ :: _ => congrArg (cons _) (set_eq_modify _ _ _) theorem set_eq_take_cons_drop (a : α) {n l} (h : n < length l) : set l n a = take n l ++ a :: drop (n + 1) l := by - rw [set_eq_modifyNth, modifyNth_eq_take_cons_drop _ h] + rw [set_eq_modify, modify_eq_take_cons_drop h] -theorem modifyNth_eq_set_get? (f : α → α) : - ∀ n (l : List α), l.modifyNth f n = ((fun a => l.set n (f a)) <$> l.get? n).getD l +theorem modify_eq_set_get? (f : α → α) : + ∀ n (l : List α), l.modify f n = ((fun a => l.set n (f a)) <$> l.get? n).getD l | 0, l => by cases l <;> rfl - | n+1, [] => rfl + | _+1, [] => rfl | n+1, b :: l => - (congrArg (cons _) (modifyNth_eq_set_get? ..)).trans <| by cases h : l[n]? <;> simp [h] + (congrArg (cons _) (modify_eq_set_get? ..)).trans <| by cases h : l[n]? <;> simp [h] -theorem modifyNth_eq_set_get (f : α → α) {n} {l : List α} (h) : - l.modifyNth f n = l.set n (f (l.get ⟨n, h⟩)) := by - rw [modifyNth_eq_set_get?, get?_eq_get h]; rfl - --- The naming of `exists_of_set'` and `exists_of_set` have been swapped. --- If no one complains, we will remove this version later. -@[deprecated exists_of_set (since := "2024-07-04")] -theorem exists_of_set' {l : List α} (h : n < l.length) : - ∃ l₁ a l₂, l = l₁ ++ a :: l₂ ∧ l₁.length = n ∧ l.set n a' = l₁ ++ a' :: l₂ := by - rw [set_eq_modifyNth]; exact exists_of_modifyNth _ h - -@[deprecated getElem?_set_eq' (since := "2024-06-12")] -theorem get?_set_eq (a : α) (n) (l : List α) : (set l n a).get? n = (fun _ => a) <$> l.get? n := by - simp only [get?_eq_getElem?, getElem?_set_eq', Option.map_eq_map] - rfl +theorem modify_eq_set_get (f : α → α) {n} {l : List α} (h) : + l.modify f n = l.set n (f (l.get ⟨n, h⟩)) := by + rw [modify_eq_set_get?, get?_eq_get h]; rfl theorem getElem?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) : - (set l n a)[n]? = some a := by rw [getElem?_set_eq', getElem?_eq_getElem h]; rfl - -@[deprecated getElem?_set_eq_of_lt (since := "2024-06-12")] -theorem get?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) : - (set l n a).get? n = some a := by - rw [get?_eq_getElem?, getElem?_set_eq', getElem?_eq_getElem h]; rfl - -@[deprecated getElem?_set_ne (since := "2024-06-12")] -theorem get?_set_ne (a : α) {m n} (l : List α) (h : m ≠ n) : (set l m a).get? n = l.get? n := by - simp [h] - -@[deprecated getElem?_set (since := "2024-06-12")] -theorem get?_set (a : α) {m n} (l : List α) : - (set l m a).get? n = if m = n then (fun _ => a) <$> l.get? n else l.get? n := by - simp [getElem?_set'] + (set l n a)[n]? = some a := by rw [getElem?_set_self', getElem?_eq_getElem h]; rfl theorem get?_set_of_lt (a : α) {m n} (l : List α) (h : n < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by @@ -226,25 +69,17 @@ theorem get?_set_of_lt' (a : α) {m n} (l : List α) (h : m < length l) : (set l m a).get? n = if m = n then some a else l.get? n := by simp [getElem?_set]; split <;> subst_vars <;> simp [*, getElem?_eq_getElem h] -@[deprecated (since := "2024-05-06")] alias length_removeNth := length_eraseIdx - /-! ### tail -/ theorem length_tail_add_one (l : List α) (h : 0 < length l) : (length (tail l)) + 1 = length l := by simp [Nat.sub_add_cancel h] -@[simp] theorem getElem?_tail (l : List α) : l.tail[n]? = l[n + 1]? := by cases l <;> simp - -@[simp] theorem getElem_tail (l : List α) (h : n < l.tail.length) : - l.tail[n] = l[n + 1]'(by simp at h; omega) := by - cases l; contradiction; simp - /-! ### eraseP -/ @[simp] theorem extractP_eq_find?_eraseP (l : List α) : extractP p l = (find? p l, eraseP p l) := by - let rec go (acc) : ∀ xs, l = acc.data ++ xs → - extractP.go p l xs acc = (xs.find? p, acc.data ++ xs.eraseP p) + let rec go (acc) : ∀ xs, l = acc.toList ++ xs → + extractP.go p l xs acc = (xs.find? p, acc.toList ++ xs.eraseP p) | [] => fun h => by simp [extractP.go, find?, eraseP, h] | x::xs => by simp [extractP.go, find?, eraseP]; cases p x <;> simp @@ -253,8 +88,6 @@ theorem length_tail_add_one (l : List α) (h : 0 < length l) : (length (tail l)) /-! ### erase -/ -@[deprecated (since := "2024-04-22")] alias sublist.erase := Sublist.erase - theorem erase_eq_self_iff_forall_bne [BEq α] (a : α) (xs : List α) : xs.erase a = xs ↔ ∀ (x : α), x ∈ xs → ¬x == a := by rw [erase_eq_eraseP', eraseP_eq_self_iff] @@ -293,10 +126,10 @@ theorem replaceF_of_forall_none {l : List α} (h : ∀ a, a ∈ l → p a = none | nil => rfl | cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2] -theorem exists_of_replaceF : ∀ {l : List α} {a a'} (al : a ∈ l) (pa : p a = some a'), +theorem exists_of_replaceF : ∀ {l : List α} {a a'} (_ : a ∈ l) (_ : p a = some a'), ∃ a a' l₁ l₂, (∀ b ∈ l₁, p b = none) ∧ p a = some a' ∧ l = l₁ ++ a :: l₂ ∧ l.replaceF p = l₁ ++ a' :: l₂ - | b :: l, a, a', al, pa => + | b :: l, _, _, al, pa => match pb : p b with | some b' => ⟨b, b', [], l, forall_mem_nil _, pb, by simp [pb]⟩ | none => @@ -412,14 +245,14 @@ theorem inter_def [BEq α] (l₁ l₂ : List α) : l₁ ∩ l₂ = filter (elem theorem pair_mem_product {xs : List α} {ys : List β} {x : α} {y : β} : (x, y) ∈ product xs ys ↔ x ∈ xs ∧ y ∈ ys := by simp only [product, and_imp, mem_map, Prod.mk.injEq, - exists_eq_right_right, mem_bind, iff_self] + exists_eq_right_right, mem_flatMap, iff_self] /-! ### monadic operations -/ theorem forIn_eq_bindList [Monad m] [LawfulMonad m] (f : α → β → m (ForInStep β)) (l : List α) (init : β) : forIn l init f = ForInStep.run <$> (ForInStep.yield init).bindList f l := by - induction l generalizing init <;> simp [*, map_eq_pure_bind] + induction l generalizing init <;> simp [*] congr; ext (b | b) <;> simp /-! ### diff -/ @@ -489,7 +322,7 @@ theorem Sublist.diff_right : ∀ {l₁ l₂ l₃ : List α}, l₁ <+ l₂ → l theorem Sublist.erase_diff_erase_sublist {a : α} : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → (l₂.erase a).diff (l₁.erase a) <+ l₂.diff l₁ - | [], l₂, _ => erase_sublist _ _ + | [], _, _ => erase_sublist _ _ | b :: l₁, l₂, h => by if heq : b = a then simp [heq] @@ -675,43 +508,68 @@ theorem insertP_loop (a : α) (l r : List α) : induction l with simp [insertP, insertP.loop, cond] | cons _ _ ih => split <;> simp [insertP_loop, ih] -/-! ### merge -/ - -theorem cons_merge_cons (s : α → α → Bool) (a b l r) : - merge s (a::l) (b::r) = if s a b then a :: merge s l (b::r) else b :: merge s (a::l) r := by - simp only [merge] - -@[simp] theorem cons_merge_cons_pos (s : α → α → Bool) (l r) (h : s a b) : - merge s (a::l) (b::r) = a :: merge s l (b::r) := by - rw [cons_merge_cons, if_pos h] - -@[simp] theorem cons_merge_cons_neg (s : α → α → Bool) (l r) (h : ¬ s a b) : - merge s (a::l) (b::r) = b :: merge s (a::l) r := by - rw [cons_merge_cons, if_neg h] - -@[simp] theorem length_merge (s : α → α → Bool) (l r) : - (merge s l r).length = l.length + r.length := by - match l, r with - | [], r => simp - | l, [] => simp - | a::l, b::r => - rw [cons_merge_cons] - split - · simp_arith [length_merge s l (b::r)] - · simp_arith [length_merge s (a::l) r] +/-! ### deprecations -/ -theorem mem_merge_left (s : α → α → Bool) (h : x ∈ l) : x ∈ merge s l r := - mem_merge.2 <| .inl h - -theorem mem_merge_right (s : α → α → Bool) (h : x ∈ r) : x ∈ merge s l r := - mem_merge.2 <| .inr h - -/-! ### foldlM and foldrM -/ - -theorem foldlM_map [Monad m] (f : β₁ → β₂) (g : α → β₂ → m α) (l : List β₁) (init : α) : - (l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by - induction l generalizing g init <;> simp [*] - -theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ → β₂) (g : β₂ → α → m α) (l : List β₁) - (init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by - induction l generalizing g init <;> simp [*] +@[deprecated (since := "2024-08-15")] alias isEmpty_iff_eq_nil := isEmpty_iff +@[deprecated getElem_eq_iff (since := "2024-06-12")] +theorem get_eq_iff : List.get l n = x ↔ l.get? n.1 = some x := by + simp +@[deprecated getElem?_inj (since := "2024-06-12")] +theorem get?_inj + (h₀ : i < xs.length) (h₁ : Nodup xs) (h₂ : xs.get? i = xs.get? j) : i = j := by + apply getElem?_inj h₀ h₁ + simp_all +@[deprecated (since := "2024-10-21")] alias modifyNth_nil := modify_nil +@[deprecated (since := "2024-10-21")] alias modifyNth_zero_cons := modify_zero_cons +@[deprecated (since := "2024-10-21")] alias modifyNth_succ_cons := modify_succ_cons +@[deprecated (since := "2024-10-21")] alias modifyNthTail_id := modifyTailIdx_id +@[deprecated (since := "2024-10-21")] alias eraseIdx_eq_modifyNthTail := eraseIdx_eq_modifyTailIdx +@[deprecated (since := "2024-10-21")] alias getElem?_modifyNth := getElem?_modify +@[deprecated getElem?_modify (since := "2024-06-12")] +theorem get?_modifyNth (f : α → α) (n) (l : List α) (m) : + (modify f n l).get? m = (fun a => if n = m then f a else a) <$> l.get? m := by + simp [getElem?_modify] +@[deprecated (since := "2024-10-21")] alias length_modifyNthTail := length_modifyTailIdx +@[deprecated (since := "2024-06-07")] alias modifyNthTail_length := length_modifyTailIdx +@[deprecated (since := "2024-10-21")] alias modifyNthTail_add := modifyTailIdx_add +@[deprecated (since := "2024-10-21")] alias exists_of_modifyNthTail := exists_of_modifyTailIdx +@[deprecated (since := "2024-10-21")] alias length_modifyNth := length_modify +@[deprecated (since := "2024-06-07")] alias modifyNth_get?_length := length_modify +@[deprecated (since := "2024-10-21")] alias getElem?_modifyNth_eq := getElem?_modify_eq +@[deprecated getElem?_modify_eq (since := "2024-06-12")] +theorem get?_modifyNth_eq (f : α → α) (n) (l : List α) : + (modify f n l).get? n = f <$> l.get? n := by + simp [getElem?_modify_eq] +@[deprecated (since := "2024-06-12")] alias getElem?_modifyNth_ne := getElem?_modify_ne +@[deprecated getElem?_modify_ne (since := "2024-06-12")] +theorem get?_modifyNth_ne (f : α → α) {m n} (l : List α) (h : m ≠ n) : + (modify f m l).get? n = l.get? n := by + simp [h] +@[deprecated (since := "2024-10-21")] alias exists_of_modifyNth := exists_of_modify +@[deprecated (since := "2024-10-21")] alias modifyNthTail_eq_take_drop := modifyTailIdx_eq_take_drop +@[deprecated (since := "2024-10-21")] alias modifyNth_eq_take_drop := modify_eq_take_drop +@[deprecated (since := "2024-10-21")] alias modifyNth_eq_take_cons_drop := modify_eq_take_cons_drop +@[deprecated (since := "2024-10-21")] alias set_eq_modifyNth := set_eq_modify +@[deprecated (since := "2024-10-21")] alias modifyNth_eq_set_get? := modify_eq_set_get? +@[deprecated (since := "2024-10-21")] alias modifyNth_eq_set_get := modify_eq_set_get +-- The naming of `exists_of_set'` and `exists_of_set` have been swapped. +-- If no one complains, we will remove this version later. +@[deprecated exists_of_set (since := "2024-07-04")] +theorem exists_of_set' {l : List α} (h : n < l.length) : + ∃ l₁ a l₂, l = l₁ ++ a :: l₂ ∧ l₁.length = n ∧ l.set n a' = l₁ ++ a' :: l₂ := by + rw [set_eq_modify]; exact exists_of_modify _ h +@[deprecated getElem?_set_self' (since := "2024-06-12")] +theorem get?_set_eq (a : α) (n) (l : List α) : (set l n a).get? n = (fun _ => a) <$> l.get? n := by + simp only [get?_eq_getElem?, getElem?_set_self', Option.map_eq_map] + rfl +@[deprecated getElem?_set_eq_of_lt (since := "2024-06-12")] +theorem get?_set_eq_of_lt (a : α) {n} {l : List α} (h : n < length l) : + (set l n a).get? n = some a := by + rw [get?_eq_getElem?, getElem?_set_self', getElem?_eq_getElem h]; rfl +@[deprecated getElem?_set_ne (since := "2024-06-12")] +theorem get?_set_ne (a : α) {m n} (l : List α) (h : m ≠ n) : (set l m a).get? n = l.get? n := by + simp [h] +@[deprecated getElem?_set (since := "2024-06-12")] +theorem get?_set (a : α) {m n} (l : List α) : + (set l m a).get? n = if m = n then (fun _ => a) <$> l.get? n else l.get? n := by + simp [getElem?_set']; rfl diff --git a/Batteries/Data/List/Monadic.lean b/Batteries/Data/List/Monadic.lean new file mode 100644 index 0000000000..f0fa51e370 --- /dev/null +++ b/Batteries/Data/List/Monadic.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2024 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Batteries.Classes.SatisfiesM + +/-! +# Results about monadic operations on `List`, in terms of `SatisfiesM`. + +-/ + +namespace List + +theorem satisfiesM_foldlM [Monad m] [LawfulMonad m] {f : β → α → m β} (h₀ : motive b) + (h₁ : ∀ (b) (_ : motive b) (a : α) (_ : a ∈ l), SatisfiesM motive (f b a)) : + SatisfiesM motive (List.foldlM f b l) := by + induction l generalizing b with + | nil => exact SatisfiesM.pure h₀ + | cons hd tl ih => + simp only [foldlM_cons] + apply SatisfiesM.bind_pre + let ⟨q, qh⟩ := h₁ b h₀ hd (mem_cons_self hd tl) + exact ⟨(fun ⟨b, bh⟩ => ⟨b, ih bh (fun b bh a am => h₁ b bh a (mem_cons_of_mem hd am))⟩) <$> q, + by simpa using qh⟩ + +theorem satisfiesM_foldrM [Monad m] [LawfulMonad m] {f : α → β → m β} (h₀ : motive b) + (h₁ : ∀ (a : α) (_ : a ∈ l) (b) (_ : motive b), SatisfiesM motive (f a b)) : + SatisfiesM motive (List.foldrM f b l) := by + induction l with + | nil => exact SatisfiesM.pure h₀ + | cons hd tl ih => + simp only [foldrM_cons] + apply SatisfiesM.bind_pre + let ⟨q, qh⟩ := ih (fun a am b hb => h₁ a (mem_cons_of_mem hd am) b hb) + exact ⟨(fun ⟨b, bh⟩ => ⟨b, h₁ hd (mem_cons_self hd tl) b bh⟩) <$> q, + by simpa using qh⟩ + +end List diff --git a/Batteries/Data/List/Perm.lean b/Batteries/Data/List/Perm.lean index 42c4bbc9c2..6eb06d1d9e 100644 --- a/Batteries/Data/List/Perm.lean +++ b/Batteries/Data/List/Perm.lean @@ -25,7 +25,7 @@ open Perm (swap) section Subperm -theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩ +@[simp] theorem nil_subperm {l : List α} : [] <+~ l := ⟨[], Perm.nil, by simp⟩ theorem Perm.subperm_left {l l₁ l₂ : List α} (p : l₁ ~ l₂) : l <+~ l₁ ↔ l <+~ l₂ := suffices ∀ {l₁ l₂ : List α}, l₁ ~ l₂ → l <+~ l₁ → l <+~ l₂ from ⟨this p, this p.symm⟩ @@ -47,6 +47,8 @@ theorem Subperm.trans {l₁ l₂ l₃ : List α} (s₁₂ : l₁ <+~ l₂) (s₂ let ⟨l₁', p₁, s₁⟩ := p₂.subperm_left.2 s₁₂ ⟨l₁', p₁, s₁.trans s₂⟩ +theorem Subperm.cons_self : l <+~ a :: l := ⟨l, .refl _, sublist_cons_self ..⟩ + theorem Subperm.cons_right {α : Type _} {l l' : List α} (x : α) (h : l <+~ l') : l <+~ x :: l' := h.trans (sublist_cons_self x l').subperm @@ -67,6 +69,9 @@ theorem Subperm.filter (p : α → Bool) ⦃l l' : List α⦄ (h : l <+~ l') : let ⟨xs, hp, h⟩ := h exact ⟨_, hp.filter p, h.filter p⟩ +@[simp] theorem subperm_nil : l <+~ [] ↔ l = [] := + ⟨fun h => length_eq_zero.1 $ Nat.le_zero.1 h.length_le, by rintro rfl; rfl⟩ + @[simp] theorem singleton_subperm_iff {α} {l : List α} {a : α} : [a] <+~ l ↔ a ∈ l := by refine ⟨fun ⟨s, hla, h⟩ => ?_, fun h => ⟨[a], .rfl, singleton_sublist.mpr h⟩⟩ rwa [perm_singleton.mp hla, singleton_sublist] at h @@ -235,8 +240,8 @@ theorem subperm_append_diff_self_of_count_le {l₁ l₂ : List α} | nil => simp | cons hd tl IH => have : hd ∈ l₂ := by - rw [← count_pos_iff_mem] - exact Nat.lt_of_lt_of_le (count_pos_iff_mem.mpr (.head _)) (h hd (.head _)) + rw [← count_pos_iff] + exact Nat.lt_of_lt_of_le (count_pos_iff.mpr (.head _)) (h hd (.head _)) have := perm_cons_erase this refine Perm.trans ?_ this.symm rw [cons_append, diff_cons, perm_cons] @@ -270,8 +275,8 @@ theorem Subperm.cons_left {l₁ l₂ : List α} (h : l₁ <+~ l₂) (x : α) (hx refine h y ?_ simpa [hy'] using hy -theorem perm_insertNth {α} (x : α) (l : List α) {n} (h : n ≤ l.length) : - insertNth n x l ~ x :: l := by +theorem perm_insertIdx {α} (x : α) (l : List α) {n} (h : n ≤ l.length) : + insertIdx n x l ~ x :: l := by induction l generalizing n with | nil => cases n with @@ -279,11 +284,13 @@ theorem perm_insertNth {α} (x : α) (l : List α) {n} (h : n ≤ l.length) : | succ => cases h | cons _ _ ih => cases n with - | zero => simp [insertNth] + | zero => simp [insertIdx] | succ => - simp only [insertNth, modifyNthTail] + simp only [insertIdx, modifyTailIdx] refine .trans (.cons _ (ih (Nat.le_of_succ_le_succ h))) (.swap ..) +@[deprecated (since := "2024-10-21")] alias perm_insertNth := perm_insertIdx + theorem Perm.union_right {l₁ l₂ : List α} (t₁ : List α) (h : l₁ ~ l₂) : l₁ ∪ t₁ ~ l₂ ∪ t₁ := by induction h with | nil => rfl @@ -309,10 +316,12 @@ theorem Perm.inter {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : end DecidableEq -theorem Perm.join_congr : - ∀ {l₁ l₂ : List (List α)} (_ : List.Forall₂ (· ~ ·) l₁ l₂), l₁.join ~ l₂.join +theorem Perm.flatten_congr : + ∀ {l₁ l₂ : List (List α)} (_ : List.Forall₂ (· ~ ·) l₁ l₂), l₁.flatten ~ l₂.flatten | _, _, .nil => .rfl - | _ :: _, _ :: _, .cons h₁ h₂ => h₁.append (Perm.join_congr h₂) + | _ :: _, _ :: _, .cons h₁ h₂ => h₁.append (Perm.flatten_congr h₂) + +@[deprecated (since := "2024-10-15")] alias Perm.join_congr := Perm.flatten_congr theorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by induction l with simp [insertP, insertP.loop, cond] @@ -325,7 +334,7 @@ theorem perm_insertP (p : α → Bool) (a l) : insertP p a l ~ a :: l := by theorem Perm.insertP (p : α → Bool) (a) (h : l₁ ~ l₂) : insertP p a l₁ ~ insertP p a l₂ := Perm.trans (perm_insertP ..) <| Perm.trans (Perm.cons _ h) <| Perm.symm (perm_insertP ..) -theorem perm_merge (s : α → α → Bool) (l r) : merge s l r ~ l ++ r := by +theorem perm_merge (s : α → α → Bool) (l r) : merge l r s ~ l ++ r := by match l, r with | [], r => simp | l, [] => simp @@ -342,5 +351,5 @@ theorem perm_merge (s : α → α → Bool) (l r) : merge s l r ~ l ++ r := by exact Perm.rfl theorem Perm.merge (s₁ s₂ : α → α → Bool) (hl : l₁ ~ l₂) (hr : r₁ ~ r₂) : - merge s₁ l₁ r₁ ~ merge s₂ l₂ r₂ := + merge l₁ r₁ s₁ ~ merge l₂ r₂ s₂ := Perm.trans (perm_merge ..) <| Perm.trans (Perm.append hl hr) <| Perm.symm (perm_merge ..) diff --git a/Batteries/Data/MLList/Basic.lean b/Batteries/Data/MLList/Basic.lean index 8f58c11fb8..1ed6d7e256 100644 --- a/Batteries/Data/MLList/Basic.lean +++ b/Batteries/Data/MLList/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2018 Scott Morrison. All rights reserved. +Copyright (c) 2018 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Keeley Hoek, Simon Hudon, Scott Morrison +Authors: Mario Carneiro, Keeley Hoek, Simon Hudon, Kim Morrison -/ /-! # Monadic lazy lists. diff --git a/Batteries/Data/MLList/Heartbeats.lean b/Batteries/Data/MLList/Heartbeats.lean index d898bbdb30..21cb18dfa0 100644 --- a/Batteries/Data/MLList/Heartbeats.lean +++ b/Batteries/Data/MLList/Heartbeats.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2023 Scott Morrison. All rights reserved. +Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Batteries.Data.MLList.Basic import Lean.Util.Heartbeats diff --git a/Batteries/Data/MLList/IO.lean b/Batteries/Data/MLList/IO.lean index f230fa2184..1153e1fbc6 100644 --- a/Batteries/Data/MLList/IO.lean +++ b/Batteries/Data/MLList/IO.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2023 Scott Morrison. All rights reserved. +Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Batteries.Lean.System.IO import Batteries.Data.MLList.Basic diff --git a/Batteries/Data/Nat.lean b/Batteries/Data/Nat.lean index f1a6ddcca1..dbf3161213 100644 --- a/Batteries/Data/Nat.lean +++ b/Batteries/Data/Nat.lean @@ -1,3 +1,4 @@ import Batteries.Data.Nat.Basic +import Batteries.Data.Nat.Bisect import Batteries.Data.Nat.Gcd import Batteries.Data.Nat.Lemmas diff --git a/Batteries/Data/Nat/Bisect.lean b/Batteries/Data/Nat/Bisect.lean new file mode 100644 index 0000000000..f692675944 --- /dev/null +++ b/Batteries/Data/Nat/Bisect.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2024 François G. Dorais. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: François G. Dorais +-/ +import Batteries.Tactic.Basic +import Batteries.Data.Nat.Basic + +namespace Nat + +/-- Average of two natural numbers rounded toward zero. -/ +abbrev avg (a b : Nat) := (a + b) / 2 + +theorem avg_comm (a b : Nat) : avg a b = avg b a := by + rw [avg, Nat.add_comm] + +theorem avg_le_left (h : b ≤ a) : avg a b ≤ a := by + apply Nat.div_le_of_le_mul; simp_arith [*] + +theorem avg_le_right (h : a ≤ b) : avg a b ≤ b := by + apply Nat.div_le_of_le_mul; simp_arith [*] + +theorem avg_lt_left (h : b < a) : avg a b < a := by + apply Nat.div_lt_of_lt_mul; omega + +theorem avg_lt_right (h : a < b) : avg a b < b := by + apply Nat.div_lt_of_lt_mul; omega + +theorem le_avg_left (h : a ≤ b) : a ≤ avg a b := by + apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp_arith [*] + +theorem le_avg_right (h : b ≤ a) : b ≤ avg a b := by + apply (Nat.le_div_iff_mul_le Nat.zero_lt_two).mpr; simp_arith [*] + +theorem le_add_one_of_avg_eq_left (h : avg a b = a) : b ≤ a + 1 := by + cases Nat.lt_or_ge b (a+2) with + | inl hlt => exact Nat.le_of_lt_add_one hlt + | inr hge => + absurd Nat.lt_irrefl a + conv => rhs; rw [← h] + rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two] + omega + +theorem le_add_one_of_avg_eq_right (h : avg a b = b) : a ≤ b + 1 := by + cases Nat.lt_or_ge a (b+2) with + | inl hlt => exact Nat.le_of_lt_add_one hlt + | inr hge => + absurd Nat.lt_irrefl b + conv => rhs; rw [← h] + rw [← Nat.add_one_le_iff, Nat.le_div_iff_mul_le Nat.zero_lt_two] + omega + +/-- +Given natural numbers `a < b` such that `p a = true` and `p b = false`, `bisect` finds a natural +number `a ≤ c < b` such that `p c = true` and `p (c+1) = false`. +-/ +def bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true) (hstop : p stop = false) := + let mid := avg start stop + have hmidstop : mid < stop := by apply Nat.div_lt_of_lt_mul; omega + if hstartmid : start < mid then + match hmid : p mid with + | false => bisect hstartmid hstart hmid + | true => bisect hmidstop hmid hstop + else + mid +termination_by stop - start + +theorem bisect_lt_stop {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : bisect h hstart hstop < stop := by + unfold bisect + simp only; split + · split + · next h' _ => + have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_of_lt h' + · exact Nat.avg_lt_right h + apply Nat.lt_trans + · exact bisect_lt_stop .. + · exact avg_lt_right h + · exact bisect_lt_stop .. + · exact avg_lt_right h + +theorem start_le_bisect {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : start ≤ bisect h hstart hstop := by + unfold bisect + simp only; split + · split + · next h' _ => + have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_of_lt h' + · exact avg_lt_right h + exact start_le_bisect .. + · next h' _ => + apply Nat.le_trans + · exact Nat.le_of_lt h' + · exact start_le_bisect .. + · exact le_avg_left (Nat.le_of_lt h) + +theorem bisect_true {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : p (bisect h hstart hstop) = true := by + unfold bisect + simp only; split + · split + · have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_avg_left (Nat.le_of_lt h) + · exact Nat.avg_lt_right h + exact bisect_true .. + · exact bisect_true .. + · next h' => + rw [← hstart]; congr + apply Nat.le_antisymm + · exact Nat.le_of_not_gt h' + · exact Nat.le_avg_left (Nat.le_of_lt h) + +theorem bisect_add_one_false {p : Nat → Bool} (h : start < stop) (hstart : p start = true) + (hstop : p stop = false) : p (bisect h hstart hstop + 1) = false := by + unfold bisect + simp only; split + · split + · have : avg start stop - start < stop - start := by + apply Nat.sub_lt_sub_right + · exact Nat.le_avg_left (Nat.le_of_lt h) + · exact Nat.avg_lt_right h + exact bisect_add_one_false .. + · exact bisect_add_one_false .. + · next h' => + have heq : avg start stop = start := by + apply Nat.le_antisymm + · exact Nat.le_of_not_gt h' + · exact Nat.le_avg_left (Nat.le_of_lt h) + rw [← hstop, heq]; congr + apply Nat.le_antisymm + · exact Nat.succ_le_of_lt h + · exact Nat.le_add_one_of_avg_eq_left heq diff --git a/Batteries/Data/Nat/Gcd.lean b/Batteries/Data/Nat/Gcd.lean index 708585f5c3..6bc9f43129 100644 --- a/Batteries/Data/Nat/Gcd.lean +++ b/Batteries/Data/Nat/Gcd.lean @@ -19,7 +19,8 @@ See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.Coprime m /-- `m` and `n` are coprime, or relatively prime, if their `gcd` is 1. -/ @[reducible] def Coprime (m n : Nat) : Prop := gcd m n = 1 -instance (m n : Nat) : Decidable (Coprime m n) := inferInstanceAs (Decidable (_ = 1)) +-- if we don't inline this, then the compiler computes the GCD even if it already has it +@[inline] instance (m n : Nat) : Decidable (Coprime m n) := inferInstanceAs (Decidable (_ = 1)) theorem coprime_iff_gcd_eq_one : Coprime m n ↔ gcd m n = 1 := .rfl diff --git a/Batteries/Data/Nat/Lemmas.lean b/Batteries/Data/Nat/Lemmas.lean index 7fa93705f7..a97c558c44 100644 --- a/Batteries/Data/Nat/Lemmas.lean +++ b/Batteries/Data/Nat/Lemmas.lean @@ -159,5 +159,6 @@ protected def sum_trichotomy (a b : Nat) : a < b ⊕' a = b ⊕' b < a := /-! ### sum -/ -@[simp] theorem sum_append : Nat.sum (l₁ ++ l₂) = Nat.sum l₁ + Nat.sum l₂ := by + +@[simp] theorem sum_append {l₁ l₂ : List Nat}: (l₁ ++ l₂).sum = l₁.sum + l₂.sum := by induction l₁ <;> simp [*, Nat.add_assoc] diff --git a/Batteries/Data/RBMap/Alter.lean b/Batteries/Data/RBMap/Alter.lean index 1148221081..fd1e8f205a 100644 --- a/Batteries/Data/RBMap/Alter.lean +++ b/Batteries/Data/RBMap/Alter.lean @@ -204,16 +204,22 @@ theorem _root_.Batteries.RBNode.Ordered.zoom {t : RBNode α} theorem Ordered.ins : ∀ {path : Path α} {t : RBNode α}, t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.ins t).Ordered cmp - | .root, t, ht, _, _ => Ordered.setBlack.2 ht + | .root, _, ht, _, _ => Ordered.setBlack.2 ht | .left red parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold ins; have ⟨ax, ap⟩ := All_and.1 H; exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.ins + have ⟨ax, ap⟩ := All_and.1 H + exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .right red a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold ins; have ⟨xb, bp⟩ := All_and.1 H; exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.ins + have ⟨xb, bp⟩ := All_and.1 H + exact hp.ins ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .left black parent x b, a, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold ins; have ⟨ax, ap⟩ := All_and.1 H + unfold Path.ins + have ⟨ax, ap⟩ := All_and.1 H exact hp.ins (ha.balance1 ax xb hb) (balance1_All.2 ⟨xp, ap, bp⟩) | .right black a x parent, b, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold ins; have ⟨xb, bp⟩ := All_and.1 H + unfold Path.ins + have ⟨xb, bp⟩ := All_and.1 H exact hp.ins (ha.balance2 ax xb hb) (balance2_All.2 ⟨xp, ap, bp⟩) theorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.RootOrdered cmp v) : @@ -222,16 +228,22 @@ theorem Ordered.insertNew {path : Path α} (hp : path.Ordered cmp) (vp : path.Ro theorem Ordered.del : ∀ {path : Path α} {t : RBNode α} {c}, t.Ordered cmp → path.Ordered cmp → t.All (path.RootOrdered cmp) → (path.del t c).Ordered cmp - | .root, t, _, ht, _, _ => Ordered.setBlack.2 ht + | .root, _, _, ht, _, _ => Ordered.setBlack.2 ht | .left _ parent x b, a, red, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold del; have ⟨ax, ap⟩ := All_and.1 H; exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.del + have ⟨ax, ap⟩ := All_and.1 H + exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .right _ a x parent, b, red, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold del; have ⟨xb, bp⟩ := All_and.1 H; exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ + unfold Path.del + have ⟨xb, bp⟩ := All_and.1 H + exact hp.del ⟨ax, xb, ha, hb⟩ ⟨xp, ap, bp⟩ | .left _ parent x b, a, black, ha, ⟨hp, xb, xp, bp, hb⟩, H => by - unfold del; have ⟨ax, ap⟩ := All_and.1 H + unfold Path.del + have ⟨ax, ap⟩ := All_and.1 H exact hp.del (ha.balLeft ax xb hb) (ap.balLeft xp bp) | .right _ a x parent, b, black, hb, ⟨hp, ax, xp, ap, ha⟩, H => by - unfold del; have ⟨xb, bp⟩ := All_and.1 H + unfold Path.del + have ⟨xb, bp⟩ := All_and.1 H exact hp.del (ha.balRight ax xb hb) (ap.balRight xp bp) end Path diff --git a/Batteries/Data/RBMap/Basic.lean b/Batteries/Data/RBMap/Basic.lean index 8eb202591c..e2c9a32c5f 100644 --- a/Batteries/Data/RBMap/Basic.lean +++ b/Batteries/Data/RBMap/Basic.lean @@ -67,9 +67,6 @@ protected def max? : RBNode α → Option α | node _ _ v nil => some v | node _ _ _ r => r.max? -@[deprecated (since := "2024-04-17")] protected alias min := RBNode.min? -@[deprecated (since := "2024-04-17")] protected alias max := RBNode.max? - /-- Fold a function in tree order along the nodes. `v₀` is used at `nil` nodes and `f` is used to combine results at branching nodes. @@ -670,9 +667,6 @@ instance : ToStream (RBSet α cmp) (RBNode.Stream α) := ⟨fun x => x.1.toStrea /-- `O(log n)`. Returns the entry `a` such that `a ≥ k` for all keys in the RBSet. -/ @[inline] protected def max? (t : RBSet α cmp) : Option α := t.1.max? -@[deprecated (since := "2024-04-17")] protected alias min := RBSet.min? -@[deprecated (since := "2024-04-17")] protected alias max := RBSet.max? - instance [Repr α] : Repr (RBSet α cmp) where reprPrec m prec := Repr.addAppParen ("RBSet.ofList " ++ repr m.toList) prec @@ -1055,9 +1049,6 @@ instance : Stream (Values.Stream α β) β := ⟨Values.Stream.next?⟩ /-- `O(log n)`. Returns the key-value pair `(a, b)` such that `a ≥ k` for all keys in the RBMap. -/ @[inline] protected def max? : RBMap α β cmp → Option (α × β) := RBSet.max? -@[deprecated (since := "2024-04-17")] protected alias min := RBMap.min? -@[deprecated (since := "2024-04-17")] protected alias max := RBMap.max? - instance [Repr α] [Repr β] : Repr (RBMap α β cmp) where reprPrec m prec := Repr.addAppParen ("RBMap.ofList " ++ repr m.toList) prec diff --git a/Batteries/Data/RBMap/WF.lean b/Batteries/Data/RBMap/WF.lean index 6fbd669e6e..220852c0ab 100644 --- a/Batteries/Data/RBMap/WF.lean +++ b/Batteries/Data/RBMap/WF.lean @@ -261,7 +261,8 @@ so this is only suitable for use on the root of the tree.) -/ theorem Balanced.insert {t : RBNode α} (h : t.Balanced c n) : ∃ c' n', (insert cmp t v).Balanced c' n' := by - unfold insert; match ins cmp v t, h.ins cmp v with + unfold RBNode.insert + match ins cmp v t, h.ins cmp v with | _, .balanced h => split <;> [exact ⟨_, h.setBlack⟩; exact ⟨_, _, h⟩] | _, .redred _ ha hb => have .node red .. := t; exact ⟨_, _, .black ha hb⟩ diff --git a/Batteries/Data/Range/Lemmas.lean b/Batteries/Data/Range/Lemmas.lean index d71082848f..a075e0b6b4 100644 --- a/Batteries/Data/Range/Lemmas.lean +++ b/Batteries/Data/Range/Lemmas.lean @@ -69,7 +69,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) suffices ∀ fuel l i hle H, l ≤ fuel → (∀ j, stop ≤ i + step * j ↔ l ≤ j) → ∀ init, forIn'.loop start stop step f fuel i hle init = - List.forIn ((List.range' i l step).pmap Subtype.mk H) init f' by + forIn ((List.range' i l step).pmap Subtype.mk H) init f' by refine this _ _ _ _ _ ((numElems_le_iff hstep).2 (Nat.le_trans ?_ (Nat.le_add_left ..))) (fun _ => (numElems_le_iff hstep).symm) _ @@ -85,7 +85,7 @@ theorem forIn'_eq_forIn_range' [Monad m] (r : Std.Range) (List.forall_mem_cons.1 H).2 (Nat.le_of_succ_le_succ h1) fun i => by rw [Nat.add_right_comm, Nat.add_assoc, ← Nat.mul_succ, h2, Nat.succ_le_succ_iff] have := h2 0; simp at this - rw [forIn'.loop]; simp [List.forIn, this, ih]; rfl + rw [forIn'.loop]; simp [this, ih]; rfl else simp [List.range', h, numElems_stop_le_start ⟨start, stop, step⟩ (Nat.not_lt.1 h), L] cases stop <;> unfold forIn'.loop <;> simp [List.forIn', h] @@ -94,13 +94,6 @@ theorem forIn_eq_forIn_range' [Monad m] (r : Std.Range) (init : β) (f : Nat → β → m (ForInStep β)) : forIn r init f = forIn (List.range' r.start r.numElems r.step) init f := by refine Eq.trans ?_ <| (forIn'_eq_forIn_range' r init (fun x _ => f x)).trans ?_ - · simp [forIn, forIn', Range.forIn, Range.forIn'] - suffices ∀ fuel i hl b, forIn'.loop r.start r.stop r.step (fun x _ => f x) fuel i hl b = - forIn.loop f fuel i r.stop r.step b from (this _ ..).symm - intro fuel; induction fuel <;> intro i hl b <;> - unfold forIn.loop forIn'.loop <;> simp [*] - split - · simp [if_neg (Nat.not_le.2 ‹_›)] - · simp [if_pos (Nat.not_lt.1 ‹_›)] + · simp [forIn, forIn'] · suffices ∀ L H, forIn (List.pmap Subtype.mk L H) init (f ·.1) = forIn L init f from this _ .. intro L; induction L generalizing init <;> intro H <;> simp [*] diff --git a/Batteries/Data/Rat.lean b/Batteries/Data/Rat.lean index 686b74eed3..8045da7952 100644 --- a/Batteries/Data/Rat.lean +++ b/Batteries/Data/Rat.lean @@ -1,2 +1,3 @@ import Batteries.Data.Rat.Basic +import Batteries.Data.Rat.Float import Batteries.Data.Rat.Lemmas diff --git a/Batteries/Data/Rat/Basic.lean b/Batteries/Data/Rat/Basic.lean index f96651d34c..37951fbec6 100644 --- a/Batteries/Data/Rat/Basic.lean +++ b/Batteries/Data/Rat/Basic.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import Batteries.Data.Nat.Gcd -import Batteries.Lean.Float /-! # Basics for the Rational Numbers -/ @@ -45,23 +44,23 @@ Auxiliary definition for `Rat.normalize`. Constructs `num / den` as a rational n dividing both `num` and `den` by `g` (which is the gcd of the two) if it is not 1. -/ @[inline] def Rat.maybeNormalize (num : Int) (den g : Nat) - (den_nz : den / g ≠ 0) (reduced : (num.div g).natAbs.Coprime (den / g)) : Rat := + (den_nz : den / g ≠ 0) (reduced : (num.tdiv g).natAbs.Coprime (den / g)) : Rat := if hg : g = 1 then { num, den den_nz := by simp [hg] at den_nz; exact den_nz reduced := by simp [hg, Int.natAbs_ofNat] at reduced; exact reduced } - else { num := num.div g, den := den / g, den_nz, reduced } + else { num := num.tdiv g, den := den / g, den_nz, reduced } theorem Rat.normalize.den_nz {num : Int} {den g : Nat} (den_nz : den ≠ 0) (e : g = num.natAbs.gcd den) : den / g ≠ 0 := e ▸ Nat.ne_of_gt (Nat.div_gcd_pos_of_pos_right _ (Nat.pos_of_ne_zero den_nz)) theorem Rat.normalize.reduced {num : Int} {den g : Nat} (den_nz : den ≠ 0) - (e : g = num.natAbs.gcd den) : (num.div g).natAbs.Coprime (den / g) := - have : Int.natAbs (num.div ↑g) = num.natAbs / g := by + (e : g = num.natAbs.gcd den) : (num.tdiv g).natAbs.Coprime (den / g) := + have : Int.natAbs (num.tdiv ↑g) = num.natAbs / g := by match num, num.eq_nat_or_neg with | _, ⟨_, .inl rfl⟩ => rfl - | _, ⟨_, .inr rfl⟩ => rw [Int.neg_div, Int.natAbs_neg, Int.natAbs_neg]; rfl + | _, ⟨_, .inr rfl⟩ => rw [Int.neg_tdiv, Int.natAbs_neg, Int.natAbs_neg]; rfl this ▸ e ▸ Nat.coprime_div_gcd_div_gcd (Nat.gcd_pos_of_pos_right _ (Nat.pos_of_ne_zero den_nz)) /-- @@ -112,7 +111,8 @@ def divInt : Int → Int → Rat else (m * 10 ^ e : Nat) -instance : OfScientific Rat where ofScientific := Rat.ofScientific +instance : OfScientific Rat where + ofScientific m s e := Rat.ofScientific (OfNat.ofNat m) s (OfNat.ofNat e) /-- Rational number strictly less than relation, as a `Bool`. -/ protected def blt (a b : Rat) : Bool := @@ -141,12 +141,12 @@ want to unfold it. Use `Rat.mul_def` instead.) -/ @[irreducible] protected def mul (a b : Rat) : Rat := let g1 := Nat.gcd a.num.natAbs b.den let g2 := Nat.gcd b.num.natAbs a.den - { num := (a.num.div g1) * (b.num.div g2) + { num := (a.num.tdiv g1) * (b.num.tdiv g2) den := (a.den / g2) * (b.den / g1) den_nz := Nat.ne_of_gt <| Nat.mul_pos (Nat.div_gcd_pos_of_pos_right _ a.den_pos) (Nat.div_gcd_pos_of_pos_right _ b.den_pos) reduced := by - simp only [Int.natAbs_mul, Int.natAbs_div, Nat.coprime_mul_iff_left] + simp only [Int.natAbs_mul, Int.natAbs_tdiv, Nat.coprime_mul_iff_left] refine ⟨Nat.coprime_mul_iff_right.2 ⟨?_, ?_⟩, Nat.coprime_mul_iff_right.2 ⟨?_, ?_⟩⟩ · exact a.reduced.coprime_div_left (Nat.gcd_dvd_left ..) |>.coprime_div_right (Nat.gcd_dvd_right ..) @@ -277,18 +277,4 @@ protected def ceil (a : Rat) : Int := else a.num / a.den + 1 -/-- Convert this rational number to a `Float` value. -/ -protected def toFloat (a : Rat) : Float := a.num.divFloat a.den - -/-- Convert this floating point number to a rational value. -/ -protected def _root_.Float.toRat? (a : Float) : Option Rat := - a.toRatParts.map fun (v, exp) => - mkRat (v.sign * v.natAbs <<< exp.toNat) (1 <<< (-exp).toNat) - -/-- -Convert this floating point number to a rational value, -mapping non-finite values (`inf`, `-inf`, `nan`) to 0. --/ -protected def _root_.Float.toRat0 (a : Float) : Rat := a.toRat?.getD 0 - -instance : Coe Rat Float := ⟨Rat.toFloat⟩ +end Rat diff --git a/Batteries/Data/Rat/Float.lean b/Batteries/Data/Rat/Float.lean new file mode 100644 index 0000000000..271a6b40fb --- /dev/null +++ b/Batteries/Data/Rat/Float.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2022 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import Batteries.Data.Rat.Basic +import Batteries.Lean.Float + +/-! # Rational Numbers and Float -/ + +namespace Rat + +/-- Convert this rational number to a `Float` value. -/ +protected def toFloat (a : Rat) : Float := a.num.divFloat a.den + +/-- Convert this floating point number to a rational value. -/ +protected def _root_.Float.toRat? (a : Float) : Option Rat := + a.toRatParts.map fun (v, exp) => + mkRat (v.sign * v.natAbs <<< exp.toNat) (1 <<< (-exp).toNat) + +/-- +Convert this floating point number to a rational value, +mapping non-finite values (`inf`, `-inf`, `nan`) to 0. +-/ +protected def _root_.Float.toRat0 (a : Float) : Rat := a.toRat?.getD 0 + +instance : Coe Rat Float := ⟨Rat.toFloat⟩ + +end Rat diff --git a/Batteries/Data/Rat/Lemmas.lean b/Batteries/Data/Rat/Lemmas.lean index 77b911ec94..844dc7b552 100644 --- a/Batteries/Data/Rat/Lemmas.lean +++ b/Batteries/Data/Rat/Lemmas.lean @@ -23,14 +23,14 @@ theorem ext : {p q : Rat} → p.num = q.num → p.den = q.den → p = q @[simp] theorem maybeNormalize_eq {num den g} (den_nz reduced) : maybeNormalize num den g den_nz reduced = - { num := num.div g, den := den / g, den_nz, reduced } := by + { num := num.tdiv g, den := den / g, den_nz, reduced } := by unfold maybeNormalize; split · subst g; simp · rfl theorem normalize.reduced' {num : Int} {den g : Nat} (den_nz : den ≠ 0) (e : g = num.natAbs.gcd den) : (num / g).natAbs.Coprime (den / g) := by - rw [← Int.div_eq_ediv_of_dvd (e ▸ Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] + rw [← Int.tdiv_eq_ediv_of_dvd (e ▸ Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] exact normalize.reduced den_nz e theorem normalize_eq {num den} (den_nz) : normalize num den den_nz = @@ -39,10 +39,10 @@ theorem normalize_eq {num den} (den_nz) : normalize num den den_nz = den_nz := normalize.den_nz den_nz rfl reduced := normalize.reduced' den_nz rfl } := by simp only [normalize, maybeNormalize_eq, - Int.div_eq_ediv_of_dvd (Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] + Int.tdiv_eq_ediv_of_dvd (Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))] @[simp] theorem normalize_zero (nz) : normalize 0 d nz = 0 := by - simp [normalize, Int.zero_div, Int.natAbs_zero, Nat.div_self (Nat.pos_of_ne_zero nz)]; rfl + simp [normalize, Int.zero_tdiv, Int.natAbs_zero, Nat.div_self (Nat.pos_of_ne_zero nz)]; rfl theorem mk_eq_normalize (num den nz c) : ⟨num, den, nz, c⟩ = normalize num den nz := by simp [normalize_eq, c.gcd_eq_one] @@ -76,7 +76,7 @@ theorem normalize_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) : theorem maybeNormalize_eq_normalize {num : Int} {den g : Nat} (den_nz reduced) (hn : ↑g ∣ num) (hd : g ∣ den) : maybeNormalize num den g den_nz reduced = normalize num den (mt (by simp [·]) den_nz) := by - simp only [maybeNormalize_eq, mk_eq_normalize, Int.div_eq_ediv_of_dvd hn] + simp only [maybeNormalize_eq, mk_eq_normalize, Int.tdiv_eq_ediv_of_dvd hn] have : g ≠ 0 := mt (by simp [·]) den_nz rw [← normalize_mul_right _ this, Int.ediv_mul_cancel hn] congr 1; exact Nat.div_mul_cancel hd @@ -267,9 +267,9 @@ theorem mul_def (a b : Rat) : have H1 : a.num.natAbs.gcd b.den ≠ 0 := Nat.gcd_ne_zero_right b.den_nz have H2 : b.num.natAbs.gcd a.den ≠ 0 := Nat.gcd_ne_zero_right a.den_nz rw [mk_eq_normalize, ← normalize_mul_right _ (Nat.mul_ne_zero H1 H2)]; congr 1 - · rw [Int.ofNat_mul, ← Int.mul_assoc, Int.mul_right_comm (Int.div ..), - Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..), Int.mul_assoc, - Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)] + · rw [Int.ofNat_mul, ← Int.mul_assoc, Int.mul_right_comm (Int.tdiv ..), + Int.tdiv_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..), Int.mul_assoc, + Int.tdiv_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)] · rw [← Nat.mul_assoc, Nat.mul_right_comm, Nat.mul_right_comm (_/_), Nat.div_mul_cancel (Nat.gcd_dvd_right ..), Nat.mul_assoc, Nat.div_mul_cancel (Nat.gcd_dvd_right ..)] @@ -332,6 +332,12 @@ theorem ofScientific_def : Rat.ofScientific m s e = if s then mkRat m (10 ^ e) else (m * 10 ^ e : Nat) := by cases s; exact ofScientific_false_def; exact ofScientific_true_def +/-- `Rat.ofScientific` applied to numeric literals is the same as a scientific literal. -/ +@[simp] +theorem ofScientific_ofNat_ofNat : + Rat.ofScientific (no_index (OfNat.ofNat m)) s (no_index (OfNat.ofNat e)) + = OfScientific.ofScientific m s e := rfl + @[simp] theorem intCast_den (a : Int) : (a : Rat).den = 1 := rfl @[simp] theorem intCast_num (a : Int) : (a : Rat).num = a := rfl diff --git a/Batteries/Data/Stream.lean b/Batteries/Data/Stream.lean new file mode 100644 index 0000000000..fb9df787be --- /dev/null +++ b/Batteries/Data/Stream.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2024 François G. Dorais. All rights reserved. +Released under Apache 2. license as described in the file LICENSE. +Authors: François G. Dorais +-/ + +namespace Stream + +/-- Drop up to `n` values from the stream `s`. -/ +def drop [Stream σ α] (s : σ) : Nat → σ + | 0 => s + | n+1 => + match next? s with + | none => s + | some (_, s) => drop s n + +/-- Read up to `n` values from the stream `s` as a list from first to last. -/ +def take [Stream σ α] (s : σ) : Nat → List α × σ + | 0 => ([], s) + | n+1 => + match next? s with + | none => ([], s) + | some (a, s) => + match take s n with + | (as, s) => (a :: as, s) + +@[simp] theorem fst_take_zero [Stream σ α] (s : σ) : + (take s 0).fst = [] := rfl + +theorem fst_take_succ [Stream σ α] (s : σ) : + (take s (n+1)).fst = match next? s with + | none => [] + | some (a, s) => a :: (take s n).fst := by + simp only [take]; split <;> rfl + +@[simp] theorem snd_take_eq_drop [Stream σ α] (s : σ) (n : Nat) : + (take s n).snd = drop s n := by + induction n generalizing s with + | zero => rfl + | succ n ih => + simp only [take, drop] + split <;> simp [ih] + +/-- Tail recursive version of `Stream.take`. -/ +def takeTR [Stream σ α] (s : σ) (n : Nat) : List α × σ := + loop s [] n +where + /-- Inner loop for `Stream.takeTR`. -/ + loop (s : σ) (acc : List α) + | 0 => (acc.reverse, s) + | n+1 => match next? s with + | none => (acc.reverse, s) + | some (a, s) => loop s (a :: acc) n + +theorem fst_takeTR_loop [Stream σ α] (s : σ) (acc : List α) (n : Nat) : + (takeTR.loop s acc n).fst = acc.reverseAux (take s n).fst := by + induction n generalizing acc s with + | zero => rfl + | succ n ih => simp only [take, takeTR.loop]; split; rfl; simp [ih] + +theorem fst_takeTR [Stream σ α] (s : σ) (n : Nat) : (takeTR s n).fst = (take s n).fst := + fst_takeTR_loop .. + +theorem snd_takeTR_loop [Stream σ α] (s : σ) (acc : List α) (n : Nat) : + (takeTR.loop s acc n).snd = drop s n := by + induction n generalizing acc s with + | zero => rfl + | succ n ih => simp only [takeTR.loop, drop]; split; rfl; simp [ih] + +theorem snd_takeTR [Stream σ α] (s : σ) (n : Nat) : + (takeTR s n).snd = drop s n := snd_takeTR_loop .. + +@[csimp] theorem take_eq_takeTR : @take = @takeTR := by + funext; ext : 1; rw [fst_takeTR]; rw [snd_takeTR, snd_take_eq_drop] + +end Stream + +@[simp] theorem List.stream_drop_eq_drop (l : List α) : Stream.drop l n = l.drop n := by + induction n generalizing l with + | zero => rfl + | succ n ih => + match l with + | [] => rfl + | _::_ => simp [Stream.drop, List.drop_succ_cons, ih] + +@[simp] theorem List.stream_take_eq_take_drop (l : List α) : + Stream.take l n = (l.take n, l.drop n) := by + induction n generalizing l with + | zero => rfl + | succ n ih => + match l with + | [] => rfl + | _::_ => simp [Stream.take, ih] diff --git a/Batteries/Data/String/Basic.lean b/Batteries/Data/String/Basic.lean index 6ff6ac98bf..aad3484c05 100644 --- a/Batteries/Data/String/Basic.lean +++ b/Batteries/Data/String/Basic.lean @@ -8,99 +8,6 @@ instance : Coe String Substring := ⟨String.toSubstring⟩ namespace String -protected theorem Pos.ne_zero_of_lt : {a b : Pos} → a < b → b ≠ 0 - | _, _, hlt, rfl => Nat.not_lt_zero _ hlt - -end String - -namespace Substring - -/-- -Returns the longest common prefix of two substrings. -The returned substring will use the same underlying string as `s`. --/ -def commonPrefix (s t : Substring) : Substring := - { s with stopPos := loop s.startPos t.startPos } -where - /-- Returns the ending position of the common prefix, working up from `spos, tpos`. -/ - loop spos tpos := - if h : spos < s.stopPos ∧ tpos < t.stopPos then - if s.str.get spos == t.str.get tpos then - have := Nat.sub_lt_sub_left h.1 (s.str.lt_next spos) - loop (s.str.next spos) (t.str.next tpos) - else - spos - else - spos - termination_by s.stopPos.byteIdx - spos.byteIdx - -/-- -Returns the longest common suffix of two substrings. -The returned substring will use the same underlying string as `s`. --/ -def commonSuffix (s t : Substring) : Substring := - { s with startPos := loop s.stopPos t.stopPos } -where - /-- Returns the starting position of the common prefix, working down from `spos, tpos`. -/ - loop spos tpos := - if h : s.startPos < spos ∧ t.startPos < tpos then - let spos' := s.str.prev spos - let tpos' := t.str.prev tpos - if s.str.get spos' == t.str.get tpos' then - have : spos' < spos := s.str.prev_lt_of_pos spos (String.Pos.ne_zero_of_lt h.1) - loop spos' tpos' - else - spos - else - spos - termination_by spos.byteIdx - -/-- -If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`. --/ -def dropPrefix? (s : Substring) (pre : Substring) : Option Substring := - let t := s.commonPrefix pre - if t.bsize = pre.bsize then - some { s with startPos := t.stopPos } - else - none - -/-- -If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`. --/ -def dropSuffix? (s : Substring) (suff : Substring) : Option Substring := - let t := s.commonSuffix suff - if t.bsize = suff.bsize then - some { s with stopPos := t.startPos } - else - none - -end Substring - -namespace String - -/-- -If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`. --/ -def dropPrefix? (s : String) (pre : Substring) : Option Substring := - Substring.dropPrefix? s pre - -/-- -If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`. --/ -def dropSuffix? (s : String) (suff : Substring) : Option Substring := - Substring.dropSuffix? s suff - -/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there, -or otherwise return `s`. -/ -def stripPrefix (s : String) (pre : Substring) : String := - s.dropPrefix? pre |>.map Substring.toString |>.getD s - -/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there, -or otherwise return `s`. -/ -def stripSuffix (s : String) (suff : Substring) : String := - s.dropSuffix? suff |>.map Substring.toString |>.getD s - /-- Count the occurrences of a character in a string. -/ def count (s : String) (c : Char) : Nat := s.foldl (fun n d => if d = c then n + 1 else n) 0 diff --git a/Batteries/Data/String/Lemmas.lean b/Batteries/Data/String/Lemmas.lean index ddd43d32a4..431591ebc1 100644 --- a/Batteries/Data/String/Lemmas.lean +++ b/Batteries/Data/String/Lemmas.lean @@ -15,11 +15,11 @@ namespace String attribute [ext (iff := false)] ext theorem lt_trans {s₁ s₂ s₃ : String} : s₁ < s₂ → s₂ < s₃ → s₁ < s₃ := - List.lt_trans' (α := Char) Nat.lt_trans + List.lt_trans (α := Char) Nat.lt_trans (fun h1 h2 => Nat.not_lt.2 <| Nat.le_trans (Nat.not_lt.1 h2) (Nat.not_lt.1 h1)) theorem lt_antisymm {s₁ s₂ : String} (h₁ : ¬s₁ < s₂) (h₂ : ¬s₂ < s₁) : s₁ = s₂ := - ext <| List.lt_antisymm' (α := Char) + ext <| List.lt_antisymm (α := Char) (fun h1 h2 => Char.le_antisymm (Nat.not_lt.1 h2) (Nat.not_lt.1 h1)) h₁ h₂ instance : Batteries.TransOrd String := .compareOfLessAndEq @@ -64,7 +64,7 @@ theorem utf8Len_reverseAux (cs₁ cs₂) : @[simp] theorem utf8Len_reverse (cs) : utf8Len cs.reverse = utf8Len cs := utf8Len_reverseAux .. @[simp] theorem utf8Len_eq_zero : utf8Len l = 0 ↔ l = [] := by - cases l <;> simp [Nat.ne_of_gt add_utf8Size_pos] + cases l <;> simp [Nat.ne_zero_iff_zero_lt.mpr (Char.utf8Size_pos _)] section open List @@ -209,7 +209,7 @@ theorem next_of_valid (cs : List Char) (c : Char) (cs' : List Char) : next ⟨cs ++ c :: cs'⟩ ⟨utf8Len cs⟩ = ⟨utf8Len cs + c.utf8Size⟩ := next_of_valid' .. @[simp] theorem atEnd_iff (s : String) (p : Pos) : atEnd s p ↔ s.endPos ≤ p := - decide_eq_true_iff _ + decide_eq_true_iff theorem valid_next {p : Pos} (h : p.Valid s) (h₂ : p < s.endPos) : (next s p).Valid s := by match s, p, h with @@ -256,7 +256,7 @@ theorem back_eq (s : String) : back s = s.1.getLastD default := by theorem atEnd_of_valid (cs : List Char) (cs' : List Char) : atEnd ⟨cs ++ cs'⟩ ⟨utf8Len cs⟩ ↔ cs' = [] := by rw [atEnd_iff] - cases cs' <;> simp [Nat.lt_add_of_pos_right add_utf8Size_pos] + cases cs' <;> simp [add_utf8Size_pos] unseal posOfAux findAux in theorem posOfAux_eq (s c) : posOfAux s c = findAux s (· == c) := rfl @@ -447,12 +447,12 @@ theorem split_of_valid (s p) : split s p = (List.splitOnP p s.1).map mk := by attribute [simp] toSubstring' -theorem join_eq (ss : List String) : join ss = ⟨(ss.map data).join⟩ := go ss [] where - go : ∀ (ss : List String) cs, ss.foldl (· ++ ·) (mk cs) = ⟨cs ++ (ss.map data).join⟩ +theorem join_eq (ss : List String) : join ss = ⟨(ss.map data).flatten⟩ := go ss [] where + go : ∀ (ss : List String) cs, ss.foldl (· ++ ·) (mk cs) = ⟨cs ++ (ss.map data).flatten⟩ | [], _ => by simp | ⟨s⟩::ss, _ => (go ss _).trans (by simp) -@[simp] theorem data_join (ss : List String) : (join ss).data = (ss.map data).join := by +@[simp] theorem data_join (ss : List String) : (join ss).data = (ss.map data).flatten := by rw [join_eq] @[deprecated (since := "2024-06-06")] alias append_nil := append_empty diff --git a/Batteries/Data/Sum.lean b/Batteries/Data/Sum.lean deleted file mode 100644 index 51d4518942..0000000000 --- a/Batteries/Data/Sum.lean +++ /dev/null @@ -1,2 +0,0 @@ -import Batteries.Data.Sum.Basic -import Batteries.Data.Sum.Lemmas diff --git a/Batteries/Data/Sum/Basic.lean b/Batteries/Data/Sum/Basic.lean deleted file mode 100644 index 6740f19228..0000000000 --- a/Batteries/Data/Sum/Basic.lean +++ /dev/null @@ -1,164 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Yury G. Kudryashov --/ - -/-! -# Disjoint union of types - -This file defines basic operations on the the sum type `α ⊕ β`. - -`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*. - -## Main declarations - -* `Sum.isLeft`: Returns whether `x : α ⊕ β` comes from the left component or not. -* `Sum.isRight`: Returns whether `x : α ⊕ β` comes from the right component or not. -* `Sum.getLeft`: Retrieves the left content of a `x : α ⊕ β` that is known to come from the left. -* `Sum.getRight`: Retrieves the right content of `x : α ⊕ β` that is known to come from the right. -* `Sum.getLeft?`: Retrieves the left content of `x : α ⊕ β` as an option type or returns `none` - if it's coming from the right. -* `Sum.getRight?`: Retrieves the right content of `x : α ⊕ β` as an option type or returns `none` - if it's coming from the left. -* `Sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise. -* `Sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`. -* `Sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components. -* `Sum.LiftRel`: The disjoint union of two relations. -* `Sum.Lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`. - -## Further material - -See `Batteries.Data.Sum.Lemmas` for theorems about these definitions. - -## Notes - -The definition of `Sum` takes values in `Type _`. This effectively forbids `Prop`- valued sum types. -To this effect, we have `PSum`, which takes value in `Sort _` and carries a more complicated -universe signature in consequence. The `Prop` version is `Or`. --/ - -namespace Sum - -deriving instance DecidableEq for Sum -deriving instance BEq for Sum - -section get - -/-- Check if a sum is `inl`. -/ -def isLeft : α ⊕ β → Bool - | inl _ => true - | inr _ => false - -/-- Check if a sum is `inr`. -/ -def isRight : α ⊕ β → Bool - | inl _ => false - | inr _ => true - -/-- Retrieve the contents from a sum known to be `inl`.-/ -def getLeft : (ab : α ⊕ β) → ab.isLeft → α - | inl a, _ => a - -/-- Retrieve the contents from a sum known to be `inr`.-/ -def getRight : (ab : α ⊕ β) → ab.isRight → β - | inr b, _ => b - -@[simp] theorem isLeft_inl : (inl x : α ⊕ β).isLeft = true := rfl -@[simp] theorem isLeft_inr : (inr x : α ⊕ β).isLeft = false := rfl -@[simp] theorem isRight_inl : (inl x : α ⊕ β).isRight = false := rfl -@[simp] theorem isRight_inr : (inr x : α ⊕ β).isRight = true := rfl - -@[simp] theorem getLeft_inl (h : (inl x : α ⊕ β).isLeft) : (inl x).getLeft h = x := rfl -@[simp] theorem getRight_inr (h : (inr x : α ⊕ β).isRight) : (inr x).getRight h = x := rfl - -@[simp] theorem getLeft?_inl : (inl x : α ⊕ β).getLeft? = some x := rfl -@[simp] theorem getLeft?_inr : (inr x : α ⊕ β).getLeft? = none := rfl -@[simp] theorem getRight?_inl : (inl x : α ⊕ β).getRight? = none := rfl -@[simp] theorem getRight?_inr : (inr x : α ⊕ β).getRight? = some x := rfl - -end get - -/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/ -protected def elim {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ := - fun x => Sum.casesOn x f g - -@[simp] theorem elim_inl (f : α → γ) (g : β → γ) (x : α) : - Sum.elim f g (inl x) = f x := rfl - -@[simp] theorem elim_inr (f : α → γ) (g : β → γ) (x : β) : - Sum.elim f g (inr x) = g x := rfl - -/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/ -protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' := - Sum.elim (inl ∘ f) (inr ∘ g) - -@[simp] theorem map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl - -@[simp] theorem map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl - -/-- Swap the factors of a sum type -/ -def swap : α ⊕ β → β ⊕ α := Sum.elim inr inl - -@[simp] theorem swap_inl : swap (inl x : α ⊕ β) = inr x := rfl - -@[simp] theorem swap_inr : swap (inr x : α ⊕ β) = inl x := rfl - -section LiftRel - -/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between -`α ⊕ β` and `γ ⊕ δ`. -/ -inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop - /-- `inl a` and `inl c` are related via `LiftRel r s` if `a` and `c` are related via `r`. -/ - | protected inl {a c} : r a c → LiftRel r s (inl a) (inl c) - /-- `inr b` and `inr d` are related via `LiftRel r s` if `b` and `d` are related via `s`. -/ - | protected inr {b d} : s b d → LiftRel r s (inr b) (inr d) - -@[simp] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) ↔ r a c := - ⟨fun h => by cases h; assumption, LiftRel.inl⟩ - -@[simp] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun - -@[simp] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun - -@[simp] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) ↔ s b d := - ⟨fun h => by cases h; assumption, LiftRel.inr⟩ - -instance {r : α → γ → Prop} {s : β → δ → Prop} - [∀ a c, Decidable (r a c)] [∀ b d, Decidable (s b d)] : - ∀ (ab : α ⊕ β) (cd : γ ⊕ δ), Decidable (LiftRel r s ab cd) - | inl _, inl _ => decidable_of_iff' _ liftRel_inl_inl - | inl _, inr _ => Decidable.isFalse not_liftRel_inl_inr - | inr _, inl _ => Decidable.isFalse not_liftRel_inr_inl - | inr _, inr _ => decidable_of_iff' _ liftRel_inr_inr - -end LiftRel - -section Lex - -/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the -respective order on `α` or `β`. -/ -inductive Lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop - /-- `inl a₁` and `inl a₂` are related via `Lex r s` if `a₁` and `a₂` are related via `r`. -/ - | protected inl {a₁ a₂} (h : r a₁ a₂) : Lex r s (inl a₁) (inl a₂) - /-- `inr b₁` and `inr b₂` are related via `Lex r s` if `b₁` and `b₂` are related via `s`. -/ - | protected inr {b₁ b₂} (h : s b₁ b₂) : Lex r s (inr b₁) (inr b₂) - /-- `inl a` and `inr b` are always related via `Lex r s`. -/ - | sep (a b) : Lex r s (inl a) (inr b) - -attribute [simp] Lex.sep - -@[simp] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ := - ⟨fun h => by cases h; assumption, Lex.inl⟩ - -@[simp] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ := - ⟨fun h => by cases h; assumption, Lex.inr⟩ - -@[simp] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun - -instance instDecidableRelSumLex [DecidableRel r] [DecidableRel s] : DecidableRel (Lex r s) - | inl _, inl _ => decidable_of_iff' _ lex_inl_inl - | inl _, inr _ => Decidable.isTrue (Lex.sep _ _) - | inr _, inl _ => Decidable.isFalse lex_inr_inl - | inr _, inr _ => decidable_of_iff' _ lex_inr_inr - -end Lex diff --git a/Batteries/Data/Sum/Lemmas.lean b/Batteries/Data/Sum/Lemmas.lean deleted file mode 100644 index ffc24dcd76..0000000000 --- a/Batteries/Data/Sum/Lemmas.lean +++ /dev/null @@ -1,250 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Yury G. Kudryashov --/ - -import Batteries.Data.Sum.Basic -import Batteries.Logic - -/-! -# Disjoint union of types - -Theorems about the definitions introduced in `Batteries.Data.Sum.Basic`. --/ - -open Function - -namespace Sum - -@[simp] protected theorem «forall» {p : α ⊕ β → Prop} : - (∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) := - ⟨fun h => ⟨fun _ => h _, fun _ => h _⟩, fun ⟨h₁, h₂⟩ => Sum.rec h₁ h₂⟩ - -@[simp] protected theorem «exists» {p : α ⊕ β → Prop} : - (∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) := - ⟨ fun - | ⟨inl a, h⟩ => Or.inl ⟨a, h⟩ - | ⟨inr b, h⟩ => Or.inr ⟨b, h⟩, - fun - | Or.inl ⟨a, h⟩ => ⟨inl a, h⟩ - | Or.inr ⟨b, h⟩ => ⟨inr b, h⟩⟩ - -theorem forall_sum {γ : α ⊕ β → Sort _} (p : (∀ ab, γ ab) → Prop) : - (∀ fab, p fab) ↔ (∀ fa fb, p (Sum.rec fa fb)) := by - refine ⟨fun h fa fb => h _, fun h fab => ?_⟩ - have h1 : fab = Sum.rec (fun a => fab (Sum.inl a)) (fun b => fab (Sum.inr b)) := by - ext ab; cases ab <;> rfl - rw [h1]; exact h _ _ - -section get - -@[simp] theorem inl_getLeft : ∀ (x : α ⊕ β) (h : x.isLeft), inl (x.getLeft h) = x - | inl _, _ => rfl -@[simp] theorem inr_getRight : ∀ (x : α ⊕ β) (h : x.isRight), inr (x.getRight h) = x - | inr _, _ => rfl - -@[simp] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by - cases x <;> simp only [getLeft?, isRight, eq_self_iff_true, reduceCtorEq] - -@[simp] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by - cases x <;> simp only [getRight?, isLeft, eq_self_iff_true, reduceCtorEq] - -theorem eq_left_getLeft_of_isLeft : ∀ {x : α ⊕ β} (h : x.isLeft), x = inl (x.getLeft h) - | inl _, _ => rfl - -@[simp] theorem getLeft_eq_iff (h : x.isLeft) : x.getLeft h = a ↔ x = inl a := by - cases x <;> simp at h ⊢ - -theorem eq_right_getRight_of_isRight : ∀ {x : α ⊕ β} (h : x.isRight), x = inr (x.getRight h) - | inr _, _ => rfl - -@[simp] theorem getRight_eq_iff (h : x.isRight) : x.getRight h = b ↔ x = inr b := by - cases x <;> simp at h ⊢ - -@[simp] theorem getLeft?_eq_some_iff : x.getLeft? = some a ↔ x = inl a := by - cases x <;> simp only [getLeft?, Option.some.injEq, inl.injEq, reduceCtorEq] - -@[simp] theorem getRight?_eq_some_iff : x.getRight? = some b ↔ x = inr b := by - cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq, reduceCtorEq] - -@[simp] theorem bnot_isLeft (x : α ⊕ β) : !x.isLeft = x.isRight := by cases x <;> rfl - -@[simp] theorem isLeft_eq_false {x : α ⊕ β} : x.isLeft = false ↔ x.isRight := by cases x <;> simp - -theorem not_isLeft {x : α ⊕ β} : ¬x.isLeft ↔ x.isRight := by simp - -@[simp] theorem bnot_isRight (x : α ⊕ β) : !x.isRight = x.isLeft := by cases x <;> rfl - -@[simp] theorem isRight_eq_false {x : α ⊕ β} : x.isRight = false ↔ x.isLeft := by cases x <;> simp - -theorem not_isRight {x : α ⊕ β} : ¬x.isRight ↔ x.isLeft := by simp - -theorem isLeft_iff : x.isLeft ↔ ∃ y, x = Sum.inl y := by cases x <;> simp - -theorem isRight_iff : x.isRight ↔ ∃ y, x = Sum.inr y := by cases x <;> simp - -end get - -theorem inl.inj_iff : (inl a : α ⊕ β) = inl b ↔ a = b := ⟨inl.inj, congrArg _⟩ - -theorem inr.inj_iff : (inr a : α ⊕ β) = inr b ↔ a = b := ⟨inr.inj, congrArg _⟩ - -theorem inl_ne_inr : inl a ≠ inr b := nofun - -theorem inr_ne_inl : inr b ≠ inl a := nofun - -/-! ### `Sum.elim` -/ - -@[simp] theorem elim_comp_inl (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inl = f := - rfl - -@[simp] theorem elim_comp_inr (f : α → γ) (g : β → γ) : Sum.elim f g ∘ inr = g := - rfl - -@[simp] theorem elim_inl_inr : @Sum.elim α β _ inl inr = id := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -theorem comp_elim (f : γ → δ) (g : α → γ) (h : β → γ) : - f ∘ Sum.elim g h = Sum.elim (f ∘ g) (f ∘ h) := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -@[simp] theorem elim_comp_inl_inr (f : α ⊕ β → γ) : - Sum.elim (f ∘ inl) (f ∘ inr) = f := - funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl - -theorem elim_eq_iff {u u' : α → γ} {v v' : β → γ} : - Sum.elim u v = Sum.elim u' v' ↔ u = u' ∧ v = v' := by - simp [funext_iff] - -/-! ### `Sum.map` -/ - -@[simp] theorem map_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') : - ∀ x : Sum α β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g) - | inl _ => rfl - | inr _ => rfl - -@[simp] theorem map_comp_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') : - Sum.map f' g' ∘ Sum.map f g = Sum.map (f' ∘ f) (g' ∘ g) := - funext <| map_map f' g' f g - -@[simp] theorem map_id_id : Sum.map (@id α) (@id β) = id := - funext fun x => Sum.recOn x (fun _ => rfl) fun _ => rfl - -theorem elim_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} : - Sum.elim f₂ g₂ (Sum.map f₁ g₁ x) = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x := by - cases x <;> rfl - -theorem elim_comp_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} : - Sum.elim f₂ g₂ ∘ Sum.map f₁ g₁ = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) := - funext fun _ => elim_map - -@[simp] theorem isLeft_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - isLeft (x.map f g) = isLeft x := by - cases x <;> rfl - -@[simp] theorem isRight_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - isRight (x.map f g) = isRight x := by - cases x <;> rfl - -@[simp] theorem getLeft?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - (x.map f g).getLeft? = x.getLeft?.map f := by - cases x <;> rfl - -@[simp] theorem getRight?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) : - (x.map f g).getRight? = x.getRight?.map g := by cases x <;> rfl - -/-! ### `Sum.swap` -/ - -@[simp] theorem swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x <;> rfl - -@[simp] theorem swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext <| swap_swap - -@[simp] theorem isLeft_swap (x : α ⊕ β) : x.swap.isLeft = x.isRight := by cases x <;> rfl - -@[simp] theorem isRight_swap (x : α ⊕ β) : x.swap.isRight = x.isLeft := by cases x <;> rfl - -@[simp] theorem getLeft?_swap (x : α ⊕ β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl - -@[simp] theorem getRight?_swap (x : α ⊕ β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl - -section LiftRel - -theorem LiftRel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) - (h : LiftRel r₁ s₁ x y) : LiftRel r₂ s₂ x y := by - cases h - · exact LiftRel.inl (hr _ _ ‹_›) - · exact LiftRel.inr (hs _ _ ‹_›) - -theorem LiftRel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : LiftRel r₁ s x y) : - LiftRel r₂ s x y := - (h.mono hr) fun _ _ => id - -theorem LiftRel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : LiftRel r s₁ x y) : - LiftRel r s₂ x y := - h.mono (fun _ _ => id) hs - -protected theorem LiftRel.swap (h : LiftRel r s x y) : LiftRel s r x.swap y.swap := by - cases h - · exact LiftRel.inr ‹_› - · exact LiftRel.inl ‹_› - -@[simp] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap ↔ LiftRel r s x y := - ⟨fun h => by rw [← swap_swap x, ← swap_swap y]; exact h.swap, LiftRel.swap⟩ - -end LiftRel - -section Lex - -protected theorem LiftRel.lex {a b : α ⊕ β} (h : LiftRel r s a b) : Lex r s a b := by - cases h - · exact Lex.inl ‹_› - · exact Lex.inr ‹_› - -theorem liftRel_subrelation_lex : Subrelation (LiftRel r s) (Lex r s) := LiftRel.lex - -theorem Lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r₁ s₁ x y) : - Lex r₂ s₂ x y := by - cases h - · exact Lex.inl (hr _ _ ‹_›) - · exact Lex.inr (hs _ _ ‹_›) - · exact Lex.sep _ _ - -theorem Lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : Lex r₁ s x y) : Lex r₂ s x y := - (h.mono hr) fun _ _ => id - -theorem Lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : Lex r s₁ x y) : Lex r s₂ x y := - h.mono (fun _ _ => id) hs - -theorem lex_acc_inl (aca : Acc r a) : Acc (Lex r s) (inl a) := by - induction aca with - | intro _ _ IH => - constructor - intro y h - cases h with - | inl h' => exact IH _ h' - -theorem lex_acc_inr (aca : ∀ a, Acc (Lex r s) (inl a)) {b} (acb : Acc s b) : - Acc (Lex r s) (inr b) := by - induction acb with - | intro _ _ IH => - constructor - intro y h - cases h with - | inr h' => exact IH _ h' - | sep => exact aca _ - -theorem lex_wf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (Lex r s) := - have aca : ∀ a, Acc (Lex r s) (inl a) := fun a => lex_acc_inl (ha.apply a) - ⟨fun x => Sum.recOn x aca fun b => lex_acc_inr aca (hb.apply b)⟩ - -end Lex - -theorem elim_const_const (c : γ) : - Sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c := by - ext x - cases x <;> rfl - -@[simp] theorem elim_lam_const_lam_const (c : γ) : - Sum.elim (fun _ : α => c) (fun _ : β => c) = fun _ => c := - Sum.elim_const_const c diff --git a/Batteries/Data/UInt.lean b/Batteries/Data/UInt.lean index a7c2a4cbaa..3f9b495629 100644 --- a/Batteries/Data/UInt.lean +++ b/Batteries/Data/UInt.lean @@ -12,9 +12,6 @@ import Batteries.Classes.Order @[simp] theorem UInt8.val_val_eq_toNat (x : UInt8) : x.val.val = x.toNat := rfl -@[simp] theorem UInt8.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt8).val = OfNat.ofNat n := rfl - @[simp] theorem UInt8.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt8).toNat = n % UInt8.size := rfl @@ -49,9 +46,6 @@ instance : Batteries.LawfulOrd UInt8 := .compareOfLessAndEq @[simp] theorem UInt16.val_val_eq_toNat (x : UInt16) : x.val.val = x.toNat := rfl -@[simp] theorem UInt16.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt16).val = OfNat.ofNat n := rfl - @[simp] theorem UInt16.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt16).toNat = n % UInt16.size := rfl @@ -86,9 +80,6 @@ instance : Batteries.LawfulOrd UInt16 := .compareOfLessAndEq @[simp] theorem UInt32.val_val_eq_toNat (x : UInt32) : x.val.val = x.toNat := rfl -@[simp] theorem UInt32.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt32).val = OfNat.ofNat n := rfl - @[simp] theorem UInt32.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt32).toNat = n % UInt32.size := rfl @@ -123,9 +114,6 @@ instance : Batteries.LawfulOrd UInt32 := .compareOfLessAndEq @[simp] theorem UInt64.val_val_eq_toNat (x : UInt64) : x.val.val = x.toNat := rfl -@[simp] theorem UInt64.val_ofNat (n) : - (no_index (OfNat.ofNat n) : UInt64).val = OfNat.ofNat n := rfl - @[simp] theorem UInt64.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : UInt64).toNat = n % UInt64.size := rfl @@ -160,15 +148,11 @@ instance : Batteries.LawfulOrd UInt64 := .compareOfLessAndEq @[simp] theorem USize.val_val_eq_toNat (x : USize) : x.val.val = x.toNat := rfl -@[simp] theorem USize.val_ofNat (n) : - (no_index (OfNat.ofNat n) : USize).val = OfNat.ofNat n := rfl - @[simp] theorem USize.toNat_ofNat (n) : (no_index (OfNat.ofNat n) : USize).toNat = n % USize.size := rfl theorem USize.size_eq : USize.size = 2 ^ System.Platform.numBits := by - have : 1 ≤ 2 ^ System.Platform.numBits := Nat.succ_le_of_lt (Nat.two_pow_pos _) - rw [USize.size, Nat.sub_add_cancel this] + rw [USize.size] theorem USize.le_size : 2 ^ 32 ≤ USize.size := by rw [size_eq] diff --git a/Batteries/Data/UnionFind/Basic.lean b/Batteries/Data/UnionFind/Basic.lean index 549c9e1cde..c48bb5bda1 100644 --- a/Batteries/Data/UnionFind/Basic.lean +++ b/Batteries/Data/UnionFind/Basic.lean @@ -3,10 +3,15 @@ Copyright (c) 2021 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import Batteries.Tactic.Alias import Batteries.Tactic.Lint.Misc import Batteries.Tactic.SeqFocus +import Batteries.Util.Panic import Batteries.Data.Array.Lemmas +@[deprecated (since := "2024-10-05")] +protected alias Batteries.UnionFind.panicWith := Batteries.panicWith + namespace Batteries /-- Union-find node type -/ @@ -18,11 +23,6 @@ structure UFNode where namespace UnionFind -/-- Panic with return value -/ -def panicWith (v : α) (msg : String) : α := @panic α ⟨v⟩ msg - -@[simp] theorem panicWith_eq (v : α) (msg) : panicWith v msg = v := rfl - /-- Parent of a union-find node, defaults to self when the node is a root -/ def parentD (arr : Array UFNode) (i : Nat) : Nat := if h : i < arr.size then (arr.get ⟨i, h⟩).parent else i @@ -128,7 +128,7 @@ abbrev parent (self : UnionFind) (i : Nat) : Nat := parentD self.arr i theorem parent'_lt (self : UnionFind) (i : Fin self.size) : (self.arr.get i).parent < self.size := by - simp only [← parentD_eq, parentD_lt, Fin.is_lt, Array.data_length] + simp only [← parentD_eq, parentD_lt, Fin.is_lt, Array.length_toList] theorem parent_lt (self : UnionFind) (i : Nat) : self.parent i < self.size ↔ i < self.size := by simp only [parentD]; split <;> simp only [*, parent'_lt] @@ -151,8 +151,8 @@ theorem rank'_lt_rankMax (self : UnionFind) (i : Fin self.size) : let rec go : ∀ {l} {x : UFNode}, x ∈ l → x.rank ≤ List.foldr (max ·.rank) 0 l | a::l, _, List.Mem.head _ => by dsimp; apply Nat.le_max_left | a::l, _, .tail _ h => by dsimp; exact Nat.le_trans (go h) (Nat.le_max_right ..) - simp only [Array.get_eq_getElem, rankMax, Array.foldr_eq_foldr_data] - exact Nat.lt_succ.2 <| go (self.arr.data.get_mem i.1 i.2) + simp only [Array.get_eq_getElem, rankMax, Array.foldr_eq_foldr_toList] + exact Nat.lt_succ.2 <| go (self.arr.toList.get_mem i.1 i.2) theorem rankD_lt_rankMax (self : UnionFind) (i : Nat) : rankD self.arr i < self.rankMax := by @@ -161,11 +161,11 @@ theorem rankD_lt_rankMax (self : UnionFind) (i : Nat) : theorem lt_rankMax (self : UnionFind) (i : Nat) : self.rank i < self.rankMax := rankD_lt_rankMax .. theorem push_rankD (arr : Array UFNode) : rankD (arr.push ⟨arr.size, 0⟩) i = rankD arr i := by - simp only [rankD, Array.size_push, Array.get_eq_getElem, Array.get_push, dite_eq_ite] + simp only [rankD, Array.size_push, Array.get_eq_getElem, Array.getElem_push, dite_eq_ite] split <;> split <;> first | simp | cases ‹¬_› (Nat.lt_succ_of_lt ‹_›) theorem push_parentD (arr : Array UFNode) : parentD (arr.push ⟨arr.size, 0⟩) i = parentD arr i := by - simp only [parentD, Array.size_push, Array.get_eq_getElem, Array.get_push, dite_eq_ite] + simp only [parentD, Array.size_push, Array.get_eq_getElem, Array.getElem_push, dite_eq_ite] split <;> split <;> try simp · exact Nat.le_antisymm (Nat.ge_of_not_lt ‹_›) (Nat.le_of_lt_succ ‹_›) · cases ‹¬_› (Nat.lt_succ_of_lt ‹_›) @@ -217,7 +217,7 @@ theorem parent_rootD (self : UnionFind) (x : Nat) : @[nolint unusedHavesSuffices] theorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = self.rootD x := by - simp only [rootD, Array.data_length, parent_lt] + simp only [rootD, Array.length_toList, parent_lt] split · simp only [parentD, ↓reduceDIte, *] (conv => rhs; rw [root]); split @@ -226,7 +226,7 @@ theorem rootD_parent (self : UnionFind) (x : Nat) : self.rootD (self.parent x) = · simp only [not_false_eq_true, parentD_of_not_lt, *] theorem rootD_lt {self : UnionFind} {x : Nat} : self.rootD x < self.size ↔ x < self.size := by - simp only [rootD, Array.data_length]; split <;> simp [*] + simp only [rootD, Array.length_toList]; split <;> simp [*] @[nolint unusedHavesSuffices] theorem rootD_eq_self {self : UnionFind} {x : Nat} : self.rootD x = x ↔ self.parent x = x := by @@ -284,7 +284,7 @@ termination_by self.rankMax - self.rank x theorem findAux_root {self : UnionFind} {x : Fin self.size} : (findAux self x).root = self.root x := by rw [findAux, root] - simp only [Array.data_length, Array.get_eq_getElem, dite_eq_ite] + simp only [Array.length_toList, Array.get_eq_getElem, dite_eq_ite] split <;> simp only have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact findAux_root @@ -298,7 +298,7 @@ theorem findAux_s {self : UnionFind} {x : Fin self.size} : rw [show self.rootD _ = (self.findAux ⟨_, self.parent'_lt x⟩).root from _] · rw [findAux]; split <;> rfl · rw [← rootD_parent, parent, parentD_eq] - simp only [rootD, Array.get_eq_getElem, Array.data_length, findAux_root] + simp only [rootD, Array.get_eq_getElem, Array.length_toList, findAux_root] apply dif_pos exact parent'_lt .. @@ -309,8 +309,7 @@ theorem rankD_findAux {self : UnionFind} {x : Fin self.size} : rw [findAux_s]; split <;> [rfl; skip] have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) have := lt_of_parentD (by rwa [parentD_eq]) - rw [rankD_eq' (by simp [FindAux.size_eq, h])] - rw [Array.get_modify (by rwa [FindAux.size_eq])] + rw [rankD_eq' (by simp [FindAux.size_eq, h]), Array.get_modify] split <;> simp [← rankD_eq, rankD_findAux (x := ⟨_, self.parent'_lt x⟩), -Array.get_eq_getElem] else simp only [rankD, Array.data_length, Array.get_eq_getElem, rank] @@ -364,7 +363,7 @@ theorem parentD_findAux_or (self : UnionFind) (x : Fin self.size) (i) : · simp [*] · have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank'_lt _ ‹_›) exact (parentD_findAux_or self ⟨_, self.parent'_lt x⟩ i).imp_left <| .imp_right fun h => by - simp only [h, ← parentD_eq, rootD_parent, Array.data_length] + simp only [h, ← parentD_eq, rootD_parent, Array.length_toList] termination_by self.rankMax - self.rank x theorem lt_rankD_findAux {self : UnionFind} {x : Fin self.size} : @@ -386,7 +385,7 @@ def find (self : UnionFind) (x : Fin self.size) : { 1.arr := r.s 2.1.val := r.root 1.parentD_lt := fun h => by - simp only [Array.data_length, FindAux.size_eq] at * + simp only [Array.length_toList, FindAux.size_eq] at * exact parentD_findAux_lt h 1.rankD_lt := fun h => by rw [rankD_findAux, rankD_findAux]; exact lt_rankD_findAux h 2.1.isLt := show _ < r.s.size by rw [r.size_eq]; exact r.root.2 @@ -420,7 +419,7 @@ def findD (self : UnionFind) (x : Nat) : UnionFind × Nat := @[simp] theorem find_parent_1 (self : UnionFind) (x : Fin self.size) : (self.find x).1.parent x = self.rootD x := by - simp only [parent, Array.data_length, find] + simp only [parent, Array.length_toList, find] rw [parentD_findAux, if_pos rfl] theorem find_parent_or (self : UnionFind) (x : Fin self.size) (i) : @@ -500,7 +499,7 @@ theorem setParent_rankD_lt {arr : Array UFNode} {x y : Fin arr.size} def link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : UnionFind where arr := linkAux self.arr x y parentD_lt h := by - simp only [Array.data_length, linkAux_size] at * + simp only [Array.length_toList, linkAux_size] at * simp only [linkAux, Array.get_eq_getElem] split <;> [skip; split <;> [skip; split]] · exact self.parentD_lt h @@ -522,7 +521,7 @@ def link (self : UnionFind) (x y : Fin self.size) (yroot : self.parent y = y) : simp only [rankD_set, Fin.eta, Array.get_eq_getElem] split · simp_all - · simp_all only [Array.get_eq_getElem, Array.data_length, Nat.lt_irrefl, not_false_eq_true, + · simp_all only [Array.get_eq_getElem, Array.length_toList, Nat.lt_irrefl, not_false_eq_true, and_true, ite_false, ite_eq_right_iff] rintro rfl simp [rankD_eq, *] diff --git a/Batteries/Data/UnionFind/Lemmas.lean b/Batteries/Data/UnionFind/Lemmas.lean index a42ece4508..9a7b0dac58 100644 --- a/Batteries/Data/UnionFind/Lemmas.lean +++ b/Batteries/Data/UnionFind/Lemmas.lean @@ -16,7 +16,7 @@ namespace Batteries.UnionFind @[simp] theorem parentD_push {arr : Array UFNode} : parentD (arr.push ⟨arr.size, 0⟩) a = parentD arr a := by - simp [parentD]; split <;> split <;> try simp [Array.get_push, *] + simp [parentD]; split <;> split <;> try simp [Array.getElem_push, *] · next h1 h2 => simp [Nat.lt_succ] at h1 h2 exact Nat.le_antisymm h2 h1 @@ -26,7 +26,7 @@ namespace Batteries.UnionFind @[simp] theorem rankD_push {arr : Array UFNode} : rankD (arr.push ⟨arr.size, 0⟩) a = rankD arr a := by - simp [rankD]; split <;> split <;> try simp [Array.get_push, *] + simp [rankD]; split <;> split <;> try simp [Array.getElem_push, *] next h1 h2 => cases h1 (Nat.lt_succ_of_lt h2) @[simp] theorem rank_push {m : UnionFind} : m.push.rank a = m.rank a := by simp [rank] diff --git a/Batteries/Data/Vector/Basic.lean b/Batteries/Data/Vector/Basic.lean index 7726a5b9e5..0ae5871356 100644 --- a/Batteries/Data/Vector/Basic.lean +++ b/Batteries/Data/Vector/Basic.lean @@ -7,28 +7,29 @@ Authors: Shreyas Srinivas, François G. Dorais import Batteries.Data.Array import Batteries.Data.List.Basic import Batteries.Data.List.Lemmas +import Batteries.Tactic.Alias import Batteries.Tactic.Lint.Misc /-! -## Vectors -`Vector α n` is an array with a statically fixed size `n`. -It combines the benefits of Lean's special support for `Arrays` -that offer `O(1)` accesses and in-place mutations for arrays with no more than one reference, -with static guarantees about the size of the underlying array. +# Vectors + +`Vector α n` is a thin wrapper around `Array α` for arrays of fixed size `n`. -/ namespace Batteries -/-- `Vector α n` is an `Array α` whose size is statically fixed to `n` -/ -structure Vector (α : Type u) (n : Nat) where - /-- Internally, a vector is stored as an array for fast access -/ - toArray : Array α - /-- `size_eq` fixes the size of `toArray` statically -/ - size_eq : toArray.size = n +/-- `Vector α n` is an `Array α` with size `n`. -/ +structure Vector (α : Type u) (n : Nat) extends Array α where + /-- Array size. -/ + size_toArray : toArray.size = n deriving Repr, DecidableEq +attribute [simp] Vector.size_toArray + namespace Vector +@[deprecated (since := "2024-10-15")] alias size_eq := size_toArray + /-- Syntax for `Vector α n` -/ syntax "#v[" withoutPosition(sepBy(term, ", ")) "]" : term @@ -38,287 +39,271 @@ macro_rules /-- Custom eliminator for `Vector α n` through `Array α` -/ @[elab_as_elim] -def elimAsArray {motive : ∀ {n}, Vector α n → Sort u} (mk : ∀ a : Array α, motive ⟨a, rfl⟩) : - {n : Nat} → (v : Vector α n) → motive v - | _, ⟨a, rfl⟩ => mk a +def elimAsArray {motive : Vector α n → Sort u} + (mk : ∀ (a : Array α) (ha : a.size = n), motive ⟨a, ha⟩) : + (v : Vector α n) → motive v + | ⟨a, ha⟩ => mk a ha /-- Custom eliminator for `Vector α n` through `List α` -/ @[elab_as_elim] -def elimAsList {motive : ∀ {n}, Vector α n → Sort u} (mk : ∀ a : List α, motive ⟨⟨a⟩, rfl⟩) : - {n : Nat} → (v : Vector α n) → motive v - | _, ⟨⟨a⟩, rfl⟩ => mk a - -/-- `Vector.size` gives the size of a vector. -/ -@[nolint unusedArguments] -def size (_ : Vector α n) : Nat := n +def elimAsList {motive : Vector α n → Sort u} + (mk : ∀ (a : List α) (ha : a.length = n), motive ⟨⟨a⟩, ha⟩) : + (v : Vector α n) → motive v + | ⟨⟨a⟩, ha⟩ => mk a ha -/-- `Vector.empty` produces an empty vector -/ -def empty : Vector α 0 := ⟨Array.empty, rfl⟩ +/-- The empty vector. -/ +@[inline] def empty : Vector α 0 := ⟨.empty, rfl⟩ -/-- Make an empty vector with pre-allocated capacity-/ -def mkEmpty (capacity : Nat) : Vector α 0 := ⟨Array.mkEmpty capacity, rfl⟩ +/-- Make an empty vector with pre-allocated capacity. -/ +@[inline] def mkEmpty (capacity : Nat) : Vector α 0 := ⟨.mkEmpty capacity, rfl⟩ -/-- Makes a vector of size `n` with all cells containing `v` -/ -def mkVector (n : Nat) (v : α) : Vector α n := ⟨mkArray n v, Array.size_mkArray ..⟩ +/-- Makes a vector of size `n` with all cells containing `v`. -/ +@[inline] def mkVector (n) (v : α) : Vector α n := ⟨mkArray n v, by simp⟩ -/-- Returns a vector of size `1` with a single element `v` -/ -def singleton (v : α) : Vector α 1 := mkVector 1 v +/-- Returns a vector of size `1` with element `v`. -/ +@[inline] def singleton (v : α) : Vector α 1 := ⟨#[v], rfl⟩ -/-- -The Inhabited instance for `Vector α n` with `[Inhabited α]` produces a vector of size `n` -with all its elements equal to the `default` element of type `α` --/ instance [Inhabited α] : Inhabited (Vector α n) where default := mkVector n default -/-- The list obtained from a vector. -/ -def toList (v : Vector α n) : List α := v.toArray.toList - -/-- nth element of a vector, indexed by a `Fin` type. -/ -def get (v : Vector α n) (i : Fin n) : α := v.toArray.get <| i.cast v.size_eq.symm +/-- Get an element of a vector using a `Fin` index. -/ +@[inline] def get (v : Vector α n) (i : Fin n) : α := + v.toArray.get (i.cast v.size_toArray.symm) -/-- Vector lookup function that takes an index `i` of type `USize` -/ -def uget (v : Vector α n) (i : USize) (h : i.toNat < n) : α := v.toArray.uget i (v.size_eq.symm ▸ h) +/-- Get an element of a vector using a `USize` index and a proof that the index is within bounds. -/ +@[inline] def uget (v : Vector α n) (i : USize) (h : i.toNat < n) : α := + v.toArray.uget i (v.size_toArray.symm ▸ h) -/-- `Vector α n` instance for the `GetElem` typeclass. -/ instance : GetElem (Vector α n) Nat α fun _ i => i < n where - getElem := fun x i h => get x ⟨i, h⟩ + getElem x i h := get x ⟨i, h⟩ /-- -`getD v i v₀` gets the `iᵗʰ` element of v if valid. -Otherwise it returns `v₀` by default +Get an element of a vector using a `Nat` index. Returns the given default value if the index is out +of bounds. -/ -def getD (v : Vector α n) (i : Nat) (v₀ : α) : α := Array.getD v.toArray i v₀ +@[inline] def getD (v : Vector α n) (i : Nat) (default : α) : α := v.toArray.getD i default -/-- -`v.back! v` gets the last element of the vector. -panics if `v` is empty. --/ -abbrev back! [Inhabited α] (v : Vector α n) : α := v[n - 1]! +/-- The last element of a vector. Panics if the vector is empty. -/ +@[inline] def back! [Inhabited α] (v : Vector α n) : α := v.toArray.back! -/-- -`v.back?` gets the last element `x` of the array as `some x` -if it exists. Else the vector is empty and it returns `none` --/ -abbrev back? (v : Vector α n) : Option α := v[n - 1]? +/-- The last element of a vector, or `none` if the array is empty. -/ +@[inline] def back? (v : Vector α n) : Option α := v.toArray.back? -/-- Abbreviation for the last element of a non-empty `Vector`.-/ -abbrev back (v : Vector α (n + 1)) : α := v[n] +/-- The last element of a non-empty vector. -/ +@[inline] def back [NeZero n] (v : Vector α n) : α := + -- TODO: change to just `v[n]` + have : Inhabited α := ⟨v[0]'(Nat.pos_of_neZero n)⟩ + v.back! -/-- `Vector.head` produces the head of a vector -/ -abbrev head (v : Vector α (n+1)) := v[0] +/-- The first element of a non-empty vector. -/ +@[inline] def head [NeZero n] (v : Vector α n) := v[0]'(Nat.pos_of_neZero n) -/-- `push v x` pushes `x` to the end of vector `v` in O(1) time -/ -def push (x : α) (v : Vector α n) : Vector α (n + 1) := - ⟨v.toArray.push x, by simp [v.size_eq]⟩ +/-- Push an element `x` to the end of a vector. -/ +@[inline] def push (x : α) (v : Vector α n) : Vector α (n + 1) := + ⟨v.toArray.push x, by simp⟩ -/-- `pop v` returns the vector with the last element removed -/ -def pop (v : Vector α n) : Vector α (n - 1) := - ⟨Array.pop v.toArray, by simp [v.size_eq]⟩ +/-- Remove the last element of a vector. -/ +@[inline] def pop (v : Vector α n) : Vector α (n - 1) := + ⟨Array.pop v.toArray, by simp⟩ /-- -Sets an element in a vector using a Fin index. +Set an element in a vector using a `Fin` index. -This will perform the update destructively provided that a has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def set (v : Vector α n) (i : Fin n) (x : α) : Vector α n := - ⟨v.toArray.set (Fin.cast v.size_eq.symm i) x, by simp [v.size_eq]⟩ +@[inline] def set (v : Vector α n) (i : Fin n) (x : α) : Vector α n := + ⟨v.toArray.set (i.cast v.size_toArray.symm) x, by simp⟩ /-- -`setN v i h x` sets an element in a vector using a Nat index which is provably valid. -By default a proof by `get_elem_tactic` is provided. +Set an element in a vector using a `Nat` index. By default, the `get_elem_tactic` is used to +synthesize a proof that the index is within bounds. -This will perform the update destructively provided that a has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def setN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : Vector α n := - v.set ⟨i, h⟩ x +@[inline] def setN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : + Vector α n := ⟨v.toArray.setN i x (by simp_all), by simp⟩ /-- -Sets an element in a vector, or do nothing if the index is out of bounds. +Set an element in a vector using a `Nat` index. Returns the vector unchanged if the index is out of +bounds. -This will perform the update destructively provided that a has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def setD (v : Vector α n) (i : Nat) (x : α) : Vector α n := - ⟨v.toArray.setD i x, by simp [v.size_eq]⟩ +@[inline] def setD (v : Vector α n) (i : Nat) (x : α) : Vector α n := + ⟨v.toArray.setD i x, by simp⟩ /-- -Sets an element in an array, or panic if the index is out of bounds. +Set an element in a vector using a `Nat` index. Panics if the index is out of bounds. -This will perform the update destructively provided that a has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n := - ⟨v.toArray.set! i x, by simp [v.size_eq]⟩ +@[inline] def set! (v : Vector α n) (i : Nat) (x : α) : Vector α n := + ⟨v.toArray.set! i x, by simp⟩ -/-- Appends a vector to another. -/ -def append : Vector α n → Vector α m → Vector α (n + m) - | ⟨a₁, _⟩, ⟨a₂, _⟩ => ⟨a₁ ++ a₂, by simp [Array.size_append, *]⟩ +/-- Append two vectors. -/ +@[inline] def append (v : Vector α n) (w : Vector α m) : Vector α (n + m) := + ⟨v.toArray ++ w.toArray, by simp⟩ instance : HAppend (Vector α n) (Vector α m) (Vector α (n + m)) where hAppend := append /-- Creates a vector from another with a provably equal length. -/ -protected def cast {n m : Nat} (h : n = m) : Vector α n → Vector α m - | ⟨x, p⟩ => ⟨x, h ▸ p⟩ +@[inline] protected def cast (h : n = m) (v : Vector α n) : Vector α m := + ⟨v.toArray, by simp [*]⟩ /-- -`extract v start halt` Returns the slice of `v` from indices `start` to `stop` (exclusive). -If `start` is greater or equal to `stop`, the result is empty. -If `stop` is greater than the size of `v`, the size is used instead. +Extracts the slice of a vector from indices `start` to `stop` (exclusive). If `start ≥ stop`, the +result is empty. If `stop` is greater than the size of the vector, the size is used instead. -/ -def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) := - ⟨Array.extract v.toArray start stop, by simp [v.size_eq]⟩ +@[inline] def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) := + ⟨v.toArray.extract start stop, by simp⟩ -/-- Maps a vector under a function. -/ -def map (f : α → β) (v : Vector α n) : Vector β n := - ⟨v.toArray.map f, by simp [v.size_eq]⟩ +/-- Maps elements of a vector using the function `f`. -/ +@[inline] def map (f : α → β) (v : Vector α n) : Vector β n := + ⟨v.toArray.map f, by simp⟩ -/-- Maps two vectors under a curried function of two variables. -/ -def zipWith : (a : Vector α n) → (b : Vector β n) → (f : α → β → φ) → Vector φ n - | ⟨a, h₁⟩, ⟨b, h₂⟩, f => ⟨Array.zipWith a b f, by simp [Array.size_zipWith, h₁, h₂]⟩ +/-- Maps corresponding elements of two vectors of equal size using the function `f`. -/ +@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α → β → φ) : Vector φ n := + ⟨Array.zipWith a.toArray b.toArray f, by simp⟩ -/-- Returns a vector of length `n` from a function on `Fin n`. -/ -def ofFn (f : Fin n → α) : Vector α n := ⟨Array.ofFn f, Array.size_ofFn ..⟩ +/-- The vector of length `n` whose `i`-th element is `f i`. -/ +@[inline] def ofFn (f : Fin n → α) : Vector α n := + ⟨Array.ofFn f, by simp⟩ /-- -Swaps two entries in a Vector. +Swap two elements of a vector using `Fin` indices. -This will perform the update destructively provided that `v` has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def swap (v : Vector α n) (i j : Fin n) : Vector α n := - ⟨v.toArray.swap (Fin.cast v.size_eq.symm i) (Fin.cast v.size_eq.symm j), by simp [v.size_eq]⟩ +@[inline] def swap (v : Vector α n) (i j : Fin n) : Vector α n := + ⟨v.toArray.swap (Fin.cast v.size_toArray.symm i) (Fin.cast v.size_toArray.symm j), by simp⟩ /-- -`swapN v i j hi hj` swaps two `Nat` indexed entries in a `Vector α n`. -Uses `get_elem_tactic` to supply proofs `hi` and `hj` respectively -that the indices `i` and `j` are in range. +Swap two elements of a vector using `Nat` indices. By default, the `get_elem_tactic` is used to +synthesize proofs that the indices are within bounds. -This will perform the update destructively provided that `v` has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def swapN (v : Vector α n) (i j : Nat) +@[inline] def swapN (v : Vector α n) (i j : Nat) (hi : i < n := by get_elem_tactic) (hj : j < n := by get_elem_tactic) : Vector α n := - v.swap ⟨i, hi⟩ ⟨j, hj⟩ + ⟨v.toArray.swapN i j (by simp_all) (by simp_all), by simp⟩ /-- -Swaps two entries in a `Vector α n`, or panics if either index is out of bounds. +Swap two elements of a vector using `Nat` indices. Panics if either index is out of bounds. -This will perform the update destructively provided that `v` has a reference count of 1 when called. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def swap! (v : Vector α n) (i j : Nat) : Vector α n := - ⟨Array.swap! v.toArray i j, by simp [v.size_eq]⟩ +@[inline] def swap! (v : Vector α n) (i j : Nat) : Vector α n := + ⟨v.toArray.swap! i j, by simp⟩ /-- -Swaps the entry with index `i : Fin n` in the vector for a new entry. -The old entry is returned with the modified vector. +Swaps an element of a vector with a given value using a `Fin` index. The original value is returned +along with the updated vector. + +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def swapAt (v : Vector α n) (i : Fin n) (x : α) : α × Vector α n := - let res := v.toArray.swapAt (Fin.cast v.size_eq.symm i) x - (res.1, ⟨res.2, by simp [Array.swapAt_def, res, v.size_eq]⟩) +@[inline] def swapAt (v : Vector α n) (i : Fin n) (x : α) : α × Vector α n := + let a := v.toArray.swapAt (Fin.cast v.size_toArray.symm i) x + ⟨a.fst, a.snd, by simp [a]⟩ /-- -Swaps the entry with index `i : Nat` in the vector for a new entry `x`. -The old entry is returned alongwith the modified vector. +Swaps an element of a vector with a given value using a `Nat` index. By default, the +`get_elem_tactic` is used to synthesise a proof that the index is within bounds. The original value +is returned along with the updated vector. -Automatically generates a proof of `i < n` with `get_elem_tactic` where feasible. +This will perform the update destructively provided that the vector has a reference count of 1. -/ -def swapAtN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : α × Vector α n := - swapAt v ⟨i, h⟩ x +@[inline] def swapAtN (v : Vector α n) (i : Nat) (x : α) (h : i < n := by get_elem_tactic) : + α × Vector α n := + let a := v.toArray.swapAtN i x (by simp_all) + ⟨a.fst, a.snd, by simp [a]⟩ /-- -`swapAt! v i x` swaps out the entry at index `i : Nat` in the vector for `x`, if the index is valid. -Otherwise it panics The old entry is returned with the modified vector. +Swaps an element of a vector with a given value using a `Nat` index. Panics if the index is out of +bounds. The original value is returned along with the updated vector. + +This will perform the update destructively provided that the vector has a reference count of 1. -/ @[inline] def swapAt! (v : Vector α n) (i : Nat) (x : α) : α × Vector α n := - if h : i < n then - swapAt v ⟨i, h⟩ x - else - have : Inhabited α := ⟨x⟩ - panic! s!"Index {i} is out of bounds" + let a := v.toArray.swapAt! i x + ⟨a.fst, a.snd, by simp [a]⟩ -/-- `range n` returns the vector `#v[0,1,2,...,n-1]`. -/ -def range (n : Nat) : Vector Nat n := ⟨Array.range n, Array.size_range ..⟩ +/-- The vector `#v[0,1,2,...,n-1]`. -/ +@[inline] def range (n : Nat) : Vector Nat n := ⟨Array.range n, by simp⟩ /-- -`shrink v m` shrinks the vector to the first `m` elements if `m < n`. -Returns `v` unchanged if `m ≥ n`. +Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the +vector then the vector is returned unchanged. -/ -def shrink (v : Vector α n) (m : Nat) : Vector α (min n m) := - ⟨v.toArray.shrink m, by simp [Array.size_shrink, v.size_eq]⟩ +@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) := + ⟨v.toArray.take m, by simp⟩ -/-- -Drops the first (up to) `i` elements from a vector of length `n`. -If `m ≥ n`, the return value is empty. --/ -def drop (i : Nat) (v : Vector α n) : Vector α (n - i) := - have : min n n - i = n - i := by rw [Nat.min_self] - Vector.cast this (extract v i n) +@[deprecated (since := "2024-10-22")] alias shrink := take /-- -Takes the first (up to) `i` elements from a vector of length `n`. - +Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the +vector then the empty vector is returned. -/ -alias take := shrink +@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) := + ⟨v.toArray.extract m v.size, by simp⟩ /-- -`isEqv` takes a given boolean property `p`. It returns `true` -if and only if `p a[i] b[i]` holds true for all valid indices `i`. +Compares two vectors of the same size using a given boolean relation `r`. `isEqv v w r` returns +`true` if and only if `r v[i] w[i]` is true for all indices `i`. -/ -@[inline] def isEqv (a b : Vector α n) (p : α → α → Bool) : Bool := - Array.isEqvAux a.toArray b.toArray (a.size_eq.trans b.size_eq.symm) p 0 +@[inline] def isEqv (v w : Vector α n) (r : α → α → Bool) : Bool := + Array.isEqvAux v.toArray w.toArray (by simp) r 0 (by simp) -instance [BEq α] : BEq (Vector α n) := - ⟨fun a b => isEqv a b BEq.beq⟩ +instance [BEq α] : BEq (Vector α n) where + beq a b := isEqv a b (· == ·) -proof_wanted lawfulBEq [BEq α] [LawfulBEq α] : LawfulBEq (Vector α n) +proof_wanted instLawfulBEq (α n) [BEq α] [LawfulBEq α] : LawfulBEq (Vector α n) -/-- `reverse v` reverses the vector `v`. -/ -def reverse (v : Vector α n) : Vector α n := - ⟨v.toArray.reverse, by simp [v.size_eq]⟩ +/-- Reverse the elements of a vector. -/ +@[inline] def reverse (v : Vector α n) : Vector α n := + ⟨v.toArray.reverse, by simp⟩ -/-- `O(|v| - i)`. `feraseIdx v i` removes the element at position `i` in vector `v`. -/ -def feraseIdx (v : Vector α n) (i : Fin n) : Vector α (n-1) := - ⟨v.toArray.feraseIdx (Fin.cast v.size_eq.symm i), by simp [Array.size_feraseIdx, v.size_eq]⟩ +/-- Delete an element of a vector using a `Fin` index. -/ +@[inline] def feraseIdx (v : Vector α n) (i : Fin n) : Vector α (n-1) := + ⟨v.toArray.feraseIdx (Fin.cast v.size_toArray.symm i), by simp [Array.size_feraseIdx]⟩ -/-- `Vector.tail` produces the tail of the vector `v`. -/ -@[inline] def tail (v : Vector α n) : Vector α (n-1) := - match n with - | 0 => v - | _ + 1 => Vector.feraseIdx v 0 - -/-- -`O(|v| - i)`. `eraseIdx! v i` removes the element at position `i` from vector `v` of length `n`. -Panics if `i` is not less than `n`. --/ +/-- Delete an element of a vector using a `Nat` index. Panics if the index is out of bounds. -/ @[inline] def eraseIdx! (v : Vector α n) (i : Nat) : Vector α (n-1) := - if h : i < n then - feraseIdx v ⟨i,h⟩ + if _ : i < n then + ⟨v.toArray.eraseIdx i, by simp [*]⟩ else - have : Inhabited (Vector α (n-1)) := ⟨v.tail⟩ - panic! s!"Index {i} is out of bounds" + have : Inhabited (Vector α (n-1)) := ⟨v.pop⟩ + panic! "index out of bounds" -/-- -`eraseIdxN v i h` removes the element at position `i` from a vector of length `n`. -`h : i < n` has a default argument `by get_elem_tactic` which tries to supply a proof -that the index is valid. +/-- Delete the first element of a vector. Returns the empty vector if the input vector is empty. -/ +@[inline] def tail (v : Vector α n) : Vector α (n-1) := + if _ : 0 < n then + ⟨v.toArray.eraseIdx 0, by simp [*]⟩ + else + v.cast (by omega) -This function takes worst case O(n) time because it has to backshift all elements at positions -greater than i. +/-- +Delete an element of a vector using a `Nat` index. By default, the `get_elem_tactic` is used to +synthesise a proof that the index is within bounds. -/ -abbrev eraseIdxN (v : Vector α n) (i : Nat) (h : i < n := by get_elem_tactic) : Vector α (n - 1) := - v.feraseIdx ⟨i, h⟩ +@[inline] def eraseIdxN (v : Vector α n) (i : Nat) (h : i < n := by get_elem_tactic) : + Vector α (n - 1) := ⟨v.toArray.eraseIdxN i (by simp [*]), by simp⟩ /-- -If `x` is an element of vector `v` at index `j`, then `indexOf? v x` returns `some j`. -Otherwise it returns `none`. +Finds the first index of a given value in a vector using `==` for comparison. Returns `none` if the +no element of the index matches the given value. -/ -def indexOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) := - match Array.indexOf? v.toArray x with - | some res => some (Fin.cast v.size_eq res) +@[inline] def indexOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) := + match v.toArray.indexOf? x with + | some res => some (res.cast v.size_toArray) | none => none -/-- `isPrefixOf as bs` returns true iff vector `as` is a prefix of vector`bs` -/ -def isPrefixOf [BEq α] (as : Vector α m) (bs : Vector α n) : Bool := - Array.isPrefixOf as.toArray bs.toArray +/-- Returns `true` when `v` is a prefix of the vector `w`. -/ +@[inline] def isPrefixOf [BEq α] (v : Vector α m) (w : Vector α n) : Bool := + v.toArray.isPrefixOf w.toArray -/-- `allDiff as i` returns `true` when all elements of `v` are distinct from each other` -/ -def allDiff [BEq α] (as : Vector α n) : Bool := - Array.allDiff as.toArray +/-- +Returns `true` when all elements of the vector are pairwise distinct using `==` for comparison. +-/ +@[inline] def allDiff [BEq α] (as : Vector α n) : Bool := + as.toArray.allDiff diff --git a/Batteries/Data/Vector/Lemmas.lean b/Batteries/Data/Vector/Lemmas.lean index 0f8caa5c45..6271f39f02 100644 --- a/Batteries/Data/Vector/Lemmas.lean +++ b/Batteries/Data/Vector/Lemmas.lean @@ -19,6 +19,22 @@ namespace Batteries namespace Vector +theorem length_toList {α n} (xs : Vector α n) : xs.toList.length = n := by simp + +@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) : + (Vector.mk data size)[i] = data[i] := rfl + +@[simp] theorem getElem_toArray {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toArray.size) : + xs.toArray[i] = xs[i]'(by simpa using h) := by + cases xs + simp + +theorem getElem_toList {α n} (xs : Vector α n) (i : Nat) (h : i < xs.toList.length) : + xs.toList[i] = xs[i]'(by simpa using h) := by simp + +@[simp] theorem getElem_ofFn {α n} (f : Fin n → α) (i : Nat) (h : i < n) : + (Vector.ofFn f)[i] = f ⟨i, by simpa using h⟩ := by + simp [ofFn] /-- An `empty` vector maps to a `empty` vector. -/ @[simp] @@ -42,14 +58,11 @@ Vectors `a` and `b` are equal to each other if their elements are equal for each protected theorem ext {a b : Vector α n} (h : (i : Nat) → (_ : i < n) → a[i] = b[i]) : a = b := by apply Vector.toArray_injective apply Array.ext - · rw [a.size_eq, b.size_eq] + · rw [a.size_toArray, b.size_toArray] · intro i hi _ - rw [a.size_eq] at hi + rw [a.size_toArray] at hi exact h i hi -@[simp] theorem getElem_mk {data : Array α} {size : data.size = n} {i : Nat} (h : i < n) : - (Vector.mk data size)[i] = data[i] := rfl - @[simp] theorem push_mk {data : Array α} {size : data.size = n} {x : α} : (Vector.mk data size).push x = Vector.mk (data.push x) (by simp [size, Nat.succ_eq_add_one]) := rfl @@ -65,7 +78,7 @@ protected theorem ext {a b : Vector α n} (h : (i : Nat) → (_ : i < n) → a[i @[simp, nolint simpNF] theorem getElem_push_lt {v : Vector α n} {x : α} {i : Nat} (h : i < n) : (v.push x)[i] = v[i] := by rcases v with ⟨data, rfl⟩ - simp [Array.get_push_lt, h] + simp [Array.getElem_push_lt, h] @[simp] theorem getElem_pop {v : Vector α n} {i : Nat} (h : i < n - 1) : (v.pop)[i] = v[i] := by rcases v with ⟨data, rfl⟩ @@ -83,9 +96,9 @@ defeq issues in the implicit size argument. ext i by_cases h : i < n · simp [h] - · replace h : i = n := by omega + · replace h : i = v.size - 1 := by rw [size_toArray]; omega subst h - simp + simp [pop, back, back!, ← Array.eq_push_pop_back!_of_size_ne_zero] /-! ### Decidable quantifiers. -/ diff --git a/Batteries/Lean/Delaborator.lean b/Batteries/Lean/Delaborator.lean deleted file mode 100644 index e09f2198de..0000000000 --- a/Batteries/Lean/Delaborator.lean +++ /dev/null @@ -1,13 +0,0 @@ -/- -Copyright (c) 2022 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Kyle Miller --/ -import Lean.PrettyPrinter - -open Lean PrettyPrinter Delaborator SubExpr - -/-- Abbreviation for `Lean.MessageData.ofConst`. -/ -@[deprecated Lean.MessageData.ofConst (since := "2024-05-18")] -def Lean.ppConst (e : Expr) : MessageData := - Lean.MessageData.ofConst e diff --git a/Batteries/Lean/EStateM.lean b/Batteries/Lean/EStateM.lean new file mode 100644 index 0000000000..84049c3560 --- /dev/null +++ b/Batteries/Lean/EStateM.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2024 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ + +namespace EStateM + +namespace Result + +/-- Map a function over an `EStateM.Result`, preserving states and errors. -/ +def map {ε σ α β : Type u} (f : α → β) (x : Result ε σ α) : Result ε σ β := + match x with + | .ok a s' => .ok (f a) s' + | .error e s' => .error e s' + +@[simp] theorem map_ok {ε σ α β : Type u} (f : α → β) (a : α) (s : σ) : + (Result.ok a s : Result ε σ α).map f = .ok (f a) s := rfl + +@[simp] theorem map_error {ε σ α β : Type u} (f : α → β) (e : ε) (s : σ) : + (Result.error e s : Result ε σ α).map f = .error e s := rfl + +@[simp] theorem map_eq_ok {ε σ α β : Type u} (f : α → β) (x : Result ε σ α) (b : β) (s : σ) : + x.map f = .ok b s ↔ ∃ a, x = .ok a s ∧ b = f a := by + cases x <;> simp [and_assoc, and_comm, eq_comm] + +@[simp] theorem map_eq_error {ε σ α β : Type u} (f : α → β) (x : Result ε σ α) (e : ε) (s : σ) : + x.map f = .error e s ↔ x = .error e s := by + cases x <;> simp [eq_comm] + +end Result + +@[simp] theorem run_map (f : α → β) (x : EStateM ε σ α) : + (f <$> x).run s = (x.run s).map f := rfl + +@[ext] theorem ext {ε σ α : Type u} (x y : EStateM ε σ α) (h : ∀ s, x.run s = y.run s) : x = y := by + funext s + exact h s + +end EStateM diff --git a/Batteries/Lean/Except.lean b/Batteries/Lean/Except.lean index 802d6b5161..214ae74364 100644 --- a/Batteries/Lean/Except.lean +++ b/Batteries/Lean/Except.lean @@ -1,13 +1,62 @@ /- Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Lean.Util.Trace open Lean +namespace Except + /-- Visualize an `Except` using a checkmark or a cross. -/ -def Except.emoji : Except ε α → String +def emoji : Except ε α → String | .error _ => crossEmoji | .ok _ => checkEmoji + +@[simp] theorem map_error {ε : Type u} (f : α → β) (e : ε) : + f <$> (.error e : Except ε α) = .error e := rfl + +@[simp] theorem map_ok {ε : Type u} (f : α → β) (x : α) : + f <$> (.ok x : Except ε α) = .ok (f x) := rfl + +/-- Map a function over an `Except` value, using a proof that the value is `.ok`. -/ +def pmap {ε : Type u} {α β : Type v} (x : Except ε α) (f : (a : α) → x = .ok a → β) : Except ε β := + match x with + | .error e => .error e + | .ok a => .ok (f a rfl) + +@[simp] theorem pmap_error {ε : Type u} {α β : Type v} (e : ε) + (f : (a : α) → Except.error e = Except.ok a → β) : + Except.pmap (.error e) f = .error e := rfl + +@[simp] theorem pmap_ok {ε : Type u} {α β : Type v} (a : α) + (f : (a' : α) → (.ok a : Except ε α) = .ok a' → β) : + Except.pmap (.ok a) f = .ok (f a rfl) := rfl + +@[simp] theorem pmap_id {ε : Type u} {α : Type v} (x : Except ε α) : + x.pmap (fun a _ => a) = x := by cases x <;> simp + +@[simp] theorem map_pmap (g : β → γ) (x : Except ε α) (f : (a : α) → x = .ok a → β) : + g <$> x.pmap f = x.pmap fun a h => g (f a h) := by + cases x <;> simp + +end Except + +namespace ExceptT + +-- This will be redundant after nightly-2024-11-08. +attribute [ext] ExceptT.ext + +@[simp] theorem run_mk {m : Type u → Type v} (x : m (Except ε α)) : (ExceptT.mk x).run = x := rfl +@[simp] theorem mk_run (x : ExceptT ε m α) : ExceptT.mk (ExceptT.run x) = x := rfl + +@[simp] +theorem map_mk [Monad m] [LawfulMonad m] (f : α → β) (x : m (Except ε α)) : + f <$> ExceptT.mk x = ExceptT.mk ((f <$> · ) <$> x) := by + simp only [Functor.map, Except.map, ExceptT.map, map_eq_pure_bind] + congr + funext a + split <;> simp + +end ExceptT diff --git a/Batteries/Lean/Expr.lean b/Batteries/Lean/Expr.lean index 20338d3424..98781ab0aa 100644 --- a/Batteries/Lean/Expr.lean +++ b/Batteries/Lean/Expr.lean @@ -24,31 +24,11 @@ def toSyntax (e : Expr) : TermElabM Syntax.Term := withFreshMacroScope do mvar.mvarId!.assign e pure stx -/-- -Returns the number of leading `∀` binders of an expression. Ignores metadata. --/ -def forallArity : Expr → Nat - | mdata _ b => forallArity b - | forallE _ _ body _ => 1 + forallArity body - | _ => 0 +@[deprecated (since := "2024-10-16"), inherit_doc getNumHeadLambdas] +abbrev lambdaArity := @getNumHeadLambdas -/-- -Returns the number of leading `λ` binders of an expression. Ignores metadata. --/ -def lambdaArity : Expr → Nat - | mdata _ b => lambdaArity b - | lam _ _ b _ => 1 + lambdaArity b - | _ => 0 - -/-- Like `getAppNumArgs` but ignores metadata. -/ -def getAppNumArgs' (e : Expr) : Nat := - go e 0 -where - /-- Auxiliary definition for `getAppNumArgs'`. -/ - go : Expr → Nat → Nat - | mdata _ b, n => go b n - | app f _ , n => go f (n + 1) - | _ , n => n +@[deprecated (since := "2024-11-13"), inherit_doc getNumHeadForalls] +abbrev forallArity := @getNumHeadForalls /-- Like `withApp` but ignores metadata. -/ @[inline] diff --git a/Batteries/Lean/HashSet.lean b/Batteries/Lean/HashSet.lean index 4b6df398b3..d0afac657b 100644 --- a/Batteries/Lean/HashSet.lean +++ b/Batteries/Lean/HashSet.lean @@ -10,9 +10,6 @@ namespace Std.HashSet variable [BEq α] [Hashable α] -instance : Singleton α (HashSet α) := ⟨fun x => HashSet.empty.insert x⟩ -instance : Insert α (HashSet α) := ⟨fun a s => s.insert a⟩ - /-- `O(n)`. Returns `true` if `f` returns `true` for any element of the set. -/ @@ -23,13 +20,6 @@ def anyM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do return true return false -/-- -`O(n)`. Returns `true` if `f` returns `true` for any element of the set. --/ -@[inline] -def any (s : HashSet α) (f : α → Bool) : Bool := - Id.run <| s.anyM f - /-- `O(n)`. Returns `true` if `f` returns `true` for all elements of the set. -/ @@ -40,13 +30,6 @@ def allM [Monad m] (s : HashSet α) (f : α → m Bool) : m Bool := do return false return true -/-- -`O(n)`. Returns `true` if `f` returns `true` for all elements of the set. --/ -@[inline] -def all (s : HashSet α) (f : α → Bool) : Bool := - Id.run <| s.allM f - instance : BEq (HashSet α) where beq s t := s.all (t.contains ·) && t.all (s.contains ·) @@ -59,10 +42,3 @@ def insert' (s : HashSet α) (a : α) : HashSet α × Bool := let oldSize := s.size let s := s.insert a (s, s.size == oldSize) - -/-- -`O(n)`. Obtain a `HashSet` from an array. --/ -@[inline] -protected def ofArray [BEq α] [Hashable α] (as : Array α) : HashSet α := - HashSet.empty.insertMany as diff --git a/Batteries/Lean/IO/Process.lean b/Batteries/Lean/IO/Process.lean index f5eb335b7f..4c21582912 100644 --- a/Batteries/Lean/IO/Process.lean +++ b/Batteries/Lean/IO/Process.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2023 Scott Morrison. All rights reserved. +Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ /-! diff --git a/Batteries/Lean/LawfulMonad.lean b/Batteries/Lean/LawfulMonad.lean new file mode 100644 index 0000000000..03221f5c86 --- /dev/null +++ b/Batteries/Lean/LawfulMonad.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2024 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Lean.Elab.Command + +/-! +# Construct `LawfulMonad` instances for the Lean monad stack. +-/ + +open Lean Elab Term Tactic Command + +instance : LawfulMonad (EIO ε) := inferInstanceAs <| LawfulMonad (EStateM _ _) +instance : LawfulMonad BaseIO := inferInstanceAs <| LawfulMonad (EIO _) +instance : LawfulMonad IO := inferInstanceAs <| LawfulMonad (EIO _) + +instance : LawfulMonad (EST ε σ) := inferInstanceAs <| LawfulMonad (EStateM _ _) + +instance : LawfulMonad CoreM := + inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ (EIO Exception)) +instance : LawfulMonad MetaM := + inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ CoreM) +instance : LawfulMonad TermElabM := + inferInstanceAs <| LawfulMonad (ReaderT _ <| StateRefT' _ _ MetaM) +instance : LawfulMonad TacticM := + inferInstanceAs <| LawfulMonad (ReaderT _ $ StateRefT' _ _ $ TermElabM) +instance : LawfulMonad CommandElabM := + inferInstanceAs <| LawfulMonad (ReaderT _ $ StateRefT' _ _ $ EIO _) diff --git a/Batteries/Lean/Meta/AssertHypotheses.lean b/Batteries/Lean/Meta/AssertHypotheses.lean deleted file mode 100644 index 6275032063..0000000000 --- a/Batteries/Lean/Meta/AssertHypotheses.lean +++ /dev/null @@ -1,40 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -import Lean.Meta.Tactic.Assert - -open Lean Lean.Meta - -namespace Lean.Meta - -/-- -Description of a hypothesis for `Lean.MVarId.assertHypotheses'`. --/ -structure Hypothesis' extends Hypothesis where - /-- The hypothesis' `BinderInfo` -/ - binderInfo : BinderInfo - /-- The hypothesis' `LocalDeclKind` -/ - kind : LocalDeclKind - -/-- -Add the given hypotheses to the local context. This is a generalisation of -`Lean.MVarId.assertHypotheses` which lets you specify --/ -def _root_.Lean.MVarId.assertHypotheses' (mvarId : MVarId) - (hs : Array Hypothesis') : MetaM (Array FVarId × MVarId) := do - let (fvarIds, mvarId) ← mvarId.assertHypotheses $ hs.map (·.toHypothesis) - mvarId.modifyLCtx fun lctx => Id.run do - let mut lctx := lctx - for h : i in [:hs.size] do - let h := hs[i] - if h.kind != .default then - lctx := lctx.setKind fvarIds[i]! h.kind - if h.binderInfo != .default then - lctx := lctx.setBinderInfo fvarIds[i]! h.binderInfo - pure lctx - return (fvarIds, mvarId) - -end Lean.Meta diff --git a/Batteries/Lean/Meta/Clear.lean b/Batteries/Lean/Meta/Clear.lean deleted file mode 100644 index 66f38b7798..0000000000 --- a/Batteries/Lean/Meta/Clear.lean +++ /dev/null @@ -1,26 +0,0 @@ -/- -Copyright (c) 2022 Jannis Limperg. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg --/ - -import Batteries.Lean.Meta.Basic -import Lean.Meta.Tactic.Clear - -open Lean Lean.Meta - -/-- -Try to clear the given fvars from the local context. Returns the new goal and -the hypotheses that were cleared. Unlike `Lean.MVarId.tryClearMany`, this -function does not require the `hyps` to be given in the order in which they -appear in the local context. --/ -def Lean.MVarId.tryClearMany' (goal : MVarId) (hyps : Array FVarId) : - MetaM (MVarId × Array FVarId) := - goal.withContext do - let hyps ← sortFVarsByContextOrder hyps - hyps.foldrM (init := (goal, Array.mkEmpty hyps.size)) - fun h (goal, cleared) => do - let goal' ← goal.tryClear h - let cleared := if goal == goal' then cleared else cleared.push h - return (goal', cleared) diff --git a/Batteries/Lean/Meta/DiscrTree.lean b/Batteries/Lean/Meta/DiscrTree.lean index a7a49bd54e..ed86bce7ce 100644 --- a/Batteries/Lean/Meta/DiscrTree.lean +++ b/Batteries/Lean/Meta/DiscrTree.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2022 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jannis Limperg, Scott Morrison +Authors: Jannis Limperg, Kim Morrison -/ import Lean.Meta.DiscrTree diff --git a/Batteries/Lean/Meta/Simp.lean b/Batteries/Lean/Meta/Simp.lean index d968ae9328..7ea81e87fa 100644 --- a/Batteries/Lean/Meta/Simp.lean +++ b/Batteries/Lean/Meta/Simp.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2022 Scott Morrison. All rights reserved. +Copyright (c) 2022 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Gabriel Ebner, Floris van Doorn +Authors: Kim Morrison, Gabriel Ebner, Floris van Doorn -/ import Lean.Elab.Tactic.Simp import Batteries.Tactic.OpenPrivate diff --git a/Batteries/Lean/NameMap.lean b/Batteries/Lean/NameMap.lean index 7ca7e7acea..0c6d341925 100644 --- a/Batteries/Lean/NameMap.lean +++ b/Batteries/Lean/NameMap.lean @@ -13,9 +13,6 @@ We provide `NameMap.filter` and `NameMap.filterMap`. namespace Lean.NameMap -instance : ForIn m (NameMap β) (Name × β) := - inferInstanceAs <| ForIn m (RBMap Name β _) _ - /-- `filter f m` returns the `NameMap` consisting of all "`key`/`val`"-pairs in `m` where `f key val` returns `true`. diff --git a/Batteries/Lean/SatisfiesM.lean b/Batteries/Lean/SatisfiesM.lean new file mode 100644 index 0000000000..189e138091 --- /dev/null +++ b/Batteries/Lean/SatisfiesM.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2024 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kim Morrison +-/ +import Batteries.Classes.SatisfiesM +import Batteries.Lean.LawfulMonad +import Lean.Elab.Command + +/-! +# Construct `MonadSatisfying` instances for the Lean monad stack. +-/ + +open Lean Elab Term Tactic Command + +instance : MonadSatisfying (EIO ε) := inferInstanceAs <| MonadSatisfying (EStateM _ _) +instance : MonadSatisfying BaseIO := inferInstanceAs <| MonadSatisfying (EIO _) +instance : MonadSatisfying IO := inferInstanceAs <| MonadSatisfying (EIO _) + +instance : MonadSatisfying (EST ε σ) := inferInstanceAs <| MonadSatisfying (EStateM _ _) + +instance : MonadSatisfying CoreM := + inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ (EIO _)) + +instance : MonadSatisfying MetaM := + inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ CoreM) + +instance : MonadSatisfying TermElabM := + inferInstanceAs <| MonadSatisfying (ReaderT _ <| StateRefT' _ _ MetaM) + +instance : MonadSatisfying TacticM := + inferInstanceAs <| MonadSatisfying (ReaderT _ $ StateRefT' _ _ TermElabM) + +instance : MonadSatisfying CommandElabM := + inferInstanceAs <| MonadSatisfying (ReaderT _ $ StateRefT' _ _ (EIO _)) diff --git a/Batteries/Lean/System/IO.lean b/Batteries/Lean/System/IO.lean index 40dcda5365..d0848bf9cd 100644 --- a/Batteries/Lean/System/IO.lean +++ b/Batteries/Lean/System/IO.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2023 Scott Morrison. All rights reserved. +Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ /-! diff --git a/Batteries/Logic.lean b/Batteries/Logic.lean index 9d7d14a70d..0be01f3b28 100644 --- a/Batteries/Logic.lean +++ b/Batteries/Logic.lean @@ -8,8 +8,6 @@ import Batteries.Tactic.Alias instance {f : α → β} [DecidablePred p] : DecidablePred (p ∘ f) := inferInstanceAs <| DecidablePred fun x => p (f x) -@[deprecated (since := "2024-03-15")] alias proofIrrel := proof_irrel - /-! ## id -/ theorem Function.id_def : @id α = fun x => x := rfl @@ -31,7 +29,7 @@ end Classical theorem heq_iff_eq : HEq a b ↔ a = b := ⟨eq_of_heq, heq_of_eq⟩ @[simp] theorem eq_rec_constant {α : Sort _} {a a' : α} {β : Sort _} (y : β) (h : a = a') : - (@Eq.rec α a (fun α _ => β) y a' h) = y := by cases h; rfl + (@Eq.rec α a (fun _ _ => β) y a' h) = y := by cases h; rfl theorem congrArg₂ (f : α → β → γ) {x x' : α} {y y' : β} (hx : x = x') (hy : y = y') : f x y = f x' y' := by subst hx hy; rfl @@ -54,11 +52,9 @@ theorem funext₃ {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a {f g : ∀ a b c, δ a b c} (h : ∀ a b c, f a b c = g a b c) : f = g := funext fun _ => funext₂ <| h _ +@[deprecated (since := "2024-10-17")] protected alias Function.funext_iff := funext_iff -theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} : f x ≠ f y → x ≠ y := - mt <| congrArg _ - protected theorem Eq.congr (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) : x₁ = x₂ ↔ y₁ = y₂ := by subst h₁; subst h₂; rfl @@ -101,17 +97,6 @@ theorem heq_eqRec_iff_heq {α : Sort _} {a : α} {motive : (a' : α) → a = a' HEq y (@Eq.rec α a motive x a' e) ↔ HEq y x := by subst e; rfl -/-! ## membership -/ - -section Mem -variable [Membership α β] {s t : β} {a b : α} - -theorem ne_of_mem_of_not_mem (h : a ∈ s) : b ∉ s → a ≠ b := mt fun e => e ▸ h - -theorem ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt fun e => e ▸ h - -end Mem - /-! ## miscellaneous -/ @[simp] theorem not_nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim diff --git a/Batteries/StdDeprecations.lean b/Batteries/StdDeprecations.lean deleted file mode 100644 index cb49a3bdbf..0000000000 --- a/Batteries/StdDeprecations.lean +++ /dev/null @@ -1,63 +0,0 @@ -/- -Copyright (c) 2024 Kim Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kim Morrison --/ -import Batteries.Tactic.Alias -import Batteries.Data.DList -import Batteries.Data.PairingHeap -import Batteries.Data.BinomialHeap.Basic -import Batteries.Data.HashMap.Basic -import Batteries.Data.RBMap.Basic -import Batteries.Data.UnionFind.Basic - -/-! -# We set up deprecations for identifiers formerly in the `Std` namespace. - -Note that we have not moved anything in the `Std.CodeAction` or `Std.Linter` namespace. - -These deprecations do not cover `Std.Tactic`, the contents of which has been moved, -but it would be much harder to generate the deprecations. -Let's hope that people using the tactic implementations can work this out themselves. --/ - -@[deprecated (since := "2024-05-07")] alias Std.AssocList := Batteries.AssocList -@[deprecated (since := "2024-05-07")] alias Std.mkHashMap := Batteries.mkHashMap -@[deprecated (since := "2024-05-07")] alias Std.DList := Batteries.DList -@[deprecated (since := "2024-05-07")] alias Std.PairingHeapImp.Heap := Batteries.PairingHeapImp.Heap -@[deprecated (since := "2024-05-07")] alias Std.TotalBLE := Batteries.TotalBLE -@[deprecated (since := "2024-05-07")] alias Std.OrientedCmp := Batteries.OrientedCmp -@[deprecated (since := "2024-05-07")] alias Std.TransCmp := Batteries.TransCmp -@[deprecated (since := "2024-05-07")] alias Std.BEqCmp := Batteries.BEqCmp -@[deprecated (since := "2024-05-07")] alias Std.LTCmp := Batteries.LTCmp -@[deprecated (since := "2024-05-07")] alias Std.LECmp := Batteries.LECmp -@[deprecated (since := "2024-05-07")] alias Std.LawfulCmp := Batteries.LawfulCmp -@[deprecated (since := "2024-05-07")] alias Std.OrientedOrd := Batteries.OrientedOrd -@[deprecated (since := "2024-05-07")] alias Std.TransOrd := Batteries.TransOrd -@[deprecated (since := "2024-05-07")] alias Std.BEqOrd := Batteries.BEqOrd -@[deprecated (since := "2024-05-07")] alias Std.LTOrd := Batteries.LTOrd -@[deprecated (since := "2024-05-07")] alias Std.LEOrd := Batteries.LEOrd -@[deprecated (since := "2024-05-07")] alias Std.LawfulOrd := Batteries.LawfulOrd -@[deprecated (since := "2024-05-07")] -alias Std.compareOfLessAndEq_eq_lt := Batteries.compareOfLessAndEq_eq_lt -@[deprecated (since := "2024-05-07")] alias Std.RBColor := Batteries.RBColor -@[deprecated (since := "2024-05-07")] alias Std.RBNode := Batteries.RBNode -@[deprecated (since := "2024-05-07")] alias Std.RBSet := Batteries.RBSet -@[deprecated (since := "2024-05-07")] alias Std.mkRBSet := Batteries.mkRBSet -@[deprecated (since := "2024-05-07")] alias Std.RBMap := Batteries.RBMap -@[deprecated (since := "2024-05-07")] alias Std.mkRBMap := Batteries.mkRBMap -@[deprecated (since := "2024-05-07")] alias Std.BinomialHeap := Batteries.BinomialHeap -@[deprecated (since := "2024-05-07")] alias Std.mkBinomialHeap := Batteries.mkBinomialHeap -@[deprecated (since := "2024-05-07")] alias Std.UFNode := Batteries.UFNode -@[deprecated (since := "2024-05-07")] alias Std.UnionFind := Batteries.UnionFind - --- Check that these generate usable deprecated hints --- when referring to names inside these namespaces. -set_option warningAsError true in -/-- -error: `Std.UnionFind` has been deprecated, use `Batteries.UnionFind` instead ---- -error: unknown constant 'Std.UnionFind.find' --/ -#guard_msgs in -#eval Std.UnionFind.find diff --git a/Batteries/Tactic/Alias.lean b/Batteries/Tactic/Alias.lean index 471dfd883a..1f22940b0a 100644 --- a/Batteries/Tactic/Alias.lean +++ b/Batteries/Tactic/Alias.lean @@ -109,10 +109,7 @@ elab (name := alias) mods:declModifiers "alias " alias:ident " := " name:ident : addDecl decl else addAndCompile decl - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange alias - } + addDeclarationRangesFromSyntax declName (← getRef) alias Term.addTermInfo' alias (← mkConstWithLevelParams declName) (isBinder := true) addDocString' declName declMods.docString? Term.applyAttributes declName declMods.attrs @@ -174,16 +171,10 @@ elab (name := aliasLR) mods:declModifiers "alias " if let `(binderIdent| $idFwd:ident) := aliasFwd then let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idFwd.getId addSide true declName declMods thm - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange idFwd - } + addDeclarationRangesFromSyntax declName (← getRef) idFwd Term.addTermInfo' idFwd (← mkConstWithLevelParams declName) (isBinder := true) if let `(binderIdent| $idRev:ident) := aliasRev then let (declName, _) ← mkDeclName (← getCurrNamespace) declMods idRev.getId addSide false declName declMods thm - Lean.addDeclarationRanges declName { - range := ← getDeclarationRange (← getRef) - selectionRange := ← getDeclarationRange idRev - } + addDeclarationRangesFromSyntax declName (← getRef) idRev Term.addTermInfo' idRev (← mkConstWithLevelParams declName) (isBinder := true) diff --git a/Batteries/Tactic/Classical.lean b/Batteries/Tactic/Classical.lean deleted file mode 100644 index a3bc78b0a4..0000000000 --- a/Batteries/Tactic/Classical.lean +++ /dev/null @@ -1,41 +0,0 @@ -/- -Copyright (c) 2021 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import Lean.Elab.Tactic.Basic - -/-! # `classical` tactic -/ - -namespace Batteries.Tactic -open Lean Meta Elab.Tactic - -/-- -`classical t` runs `t` in a scope where `Classical.propDecidable` is a low priority -local instance. --/ -def classical [Monad m] [MonadEnv m] [MonadFinally m] [MonadLiftT MetaM m] (t : m α) : - m α := do - modifyEnv Meta.instanceExtension.pushScope - Meta.addInstance ``Classical.propDecidable .local 10 - try - t - finally - modifyEnv Meta.instanceExtension.popScope - -/-- `classical!` has been removed; use `classical` instead -/ --- Deprecated 2024-04-19 -elab "classical!" : tactic => do - throwError "`classical!` has been removed; use `classical` instead" - -/-- -`classical tacs` runs `tacs` in a scope where `Classical.propDecidable` is a low priority -local instance. - -Note that (unlike lean 3) `classical` is a scoping tactic - it adds the instance only within the -scope of the tactic. --/ --- FIXME: using ppDedent looks good in the common case, but produces the incorrect result when --- the `classical` does not scope over the rest of the block. -elab "classical" tacs:ppDedent(tacticSeq) : tactic => do - classical <| Elab.Tactic.evalTactic tacs diff --git a/Batteries/Tactic/HelpCmd.lean b/Batteries/Tactic/HelpCmd.lean new file mode 100644 index 0000000000..1d955310a0 --- /dev/null +++ b/Batteries/Tactic/HelpCmd.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2024 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Edward van de Meent +-/ +import Lean.Elab.Syntax +import Lean.DocString +import Batteries.Util.LibraryNote + +/-! + +# The `#help` command + +The `#help` command can be used to list all definitions in a variety of extensible aspects of lean. + +* `#help option` lists options (used in `set_option myOption`) +* `#help attr` lists attributes (used in `@[myAttr] def foo := ...`) +* `#help cats` lists syntax categories (like `term`, `tactic`, `stx` etc) +* `#help cat C` lists elements of syntax category C + * `#help term`, `#help tactic`, `#help conv`, `#help command` + are shorthand for `#help cat term` etc. + * `#help cat+ C` also shows `elab` and `macro` definitions associated to the syntaxes +* `#help note "some note"` lists library notes for which "some note" is a prefix of the label + +Most forms take an optional identifier to narrow the search; for example `#help option pp` shows +only `pp.*` options. However, `#help cat` makes the identifier mandatory, while `#help note` takes +a mandatory string literal, rather than an identifier. + +-/ + +namespace Batteries.Tactic +open Lean Meta Elab Tactic Command + +/-- +The command `#help option` shows all options that have been defined in the current environment. +Each option has a format like: +``` +option pp.all : Bool := false + (pretty printer) display coercions, implicit parameters, proof terms, fully qualified names, + universe, and disable beta reduction and notations during pretty printing +``` +This says that `pp.all` is an option which can be set to a `Bool` value, and the default value is +`false`. If an option has been modified from the default using e.g. `set_option pp.all true`, +it will appear as a `(currently: true)` note next to the option. + +The form `#help option id` will show only options that begin with `id`. +-/ +syntax withPosition("#help " colGt &"option" (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpOption (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + for (name, decl) in show Lean.RBMap .. from ← getOptionDecls do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name decl + let mut msg := Format.nil + let opts ← getOptions + if decls.isEmpty then + match id with + | some id => throwError "no options start with {id}" + | none => throwError "no options found (!)" + for (name, decl) in decls do + let mut msg1 := match decl.defValue with + | .ofString val => s!"String := {repr val}" + | .ofBool val => s!"Bool := {repr val}" + | .ofName val => s!"Name := {repr val}" + | .ofNat val => s!"Nat := {repr val}" + | .ofInt val => s!"Int := {repr val}" + | .ofSyntax val => s!"Syntax := {repr val}" + if let some val := opts.find (.mkSimple name) then + msg1 := s!"{msg1} (currently: {val})" + msg := msg ++ .nest 2 (f!"option {name} : {msg1}" ++ .line ++ decl.descr) ++ .line ++ .line + logInfo msg + +elab_rules : command | `(#help option $(id)?) => elabHelpOption id + +/-- +The command `#help attribute` (or the short form `#help attr`) shows all attributes that have been +defined in the current environment. +Each attribute has a format like: +``` +[inline]: mark definition to always be inlined +``` +This says that `inline` is an attribute that can be placed on definitions like +`@[inline] def foo := 1`. (Individual attributes may have restrictions on where they can be +applied; see the attribute's documentation for details.) Both the attribute's `descr` field as well +as the docstring will be displayed here. + +The form `#help attr id` will show only attributes that begin with `id`. +-/ +syntax withPosition("#help " colGt (&"attr" <|> &"attribute") + (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpAttr (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + /- + #adaptation_note + On nightly-2024-06-21, added the `.toList` here: + without it the requisite `ForIn` instance can't be found. + -/ + for (name, decl) in (← attributeMapRef.get).toList do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name decl + let mut msg := Format.nil + let env ← getEnv + if decls.isEmpty then + match id with + | some id => throwError "no attributes start with {id}" + | none => throwError "no attributes found (!)" + for (name, decl) in decls do + let mut msg1 := s!"[{name}]: {decl.descr}" + if let some doc ← findDocString? env decl.ref then + msg1 := s!"{msg1}\n{doc.trim}" + msg := msg ++ .nest 2 msg1 ++ .line ++ .line + logInfo msg + +elab_rules : command + | `(#help attr $(id)?) => elabHelpAttr id + | `(#help attribute $(id)?) => elabHelpAttr id + +/-- Gets the initial string token in a parser description. For example, for a declaration like +`syntax "bla" "baz" term : tactic`, it returns `some "bla"`. Returns `none` for syntax declarations +that don't start with a string constant. -/ +partial def getHeadTk (e : Expr) : Option String := + match e.getAppFnArgs with + | (``ParserDescr.node, #[_, _, p]) + | (``ParserDescr.trailingNode, #[_, _, _, p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "withPosition")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "atomic")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "ppRealGroup")), p]) + | (``ParserDescr.unary, #[.app _ (.lit (.strVal "ppRealFill")), p]) + | (``Parser.ppRealFill, #[p]) + | (``Parser.withAntiquot, #[_, p]) + | (``Parser.leadingNode, #[_, _, p]) + | (``Parser.trailingNode, #[_, _, _, p]) + | (``Parser.group, #[p]) + | (``Parser.withCache, #[_, p]) + | (``Parser.withResetCache, #[p]) + | (``Parser.withPosition, #[p]) + | (``Parser.withOpen, #[p]) + | (``Parser.withPositionAfterLinebreak, #[p]) + | (``Parser.suppressInsideQuot, #[p]) + | (``Parser.ppRealGroup, #[p]) + | (``Parser.ppIndent, #[p]) + | (``Parser.ppDedent, #[p]) + => getHeadTk p + | (``ParserDescr.binary, #[.app _ (.lit (.strVal "andthen")), p, q]) + | (``HAndThen.hAndThen, #[_, _, _, _, p, .lam _ _ q _]) + => getHeadTk p <|> getHeadTk q + | (``ParserDescr.nonReservedSymbol, #[.lit (.strVal tk), _]) + | (``ParserDescr.symbol, #[.lit (.strVal tk)]) + | (``Parser.nonReservedSymbol, #[.lit (.strVal tk), _]) + | (``Parser.symbol, #[.lit (.strVal tk)]) + | (``Parser.unicodeSymbol, #[.lit (.strVal tk), _]) + => pure tk + | _ => none + +/-- +The command `#help cats` shows all syntax categories that have been defined in the +current environment. +Each syntax has a format like: +``` +category command [Lean.Parser.initFn✝] +``` +The name of the syntax category in this case is `command`, and `Lean.Parser.initFn✝` is the +name of the declaration that introduced it. (It is often an anonymous declaration like this, +but you can click to go to the definition.) It also shows the doc string if available. + +The form `#help cats id` will show only syntax categories that begin with `id`. +-/ +syntax withPosition("#help " colGt &"cats" (colGt ppSpace Parser.rawIdent)?) : command + +private def elabHelpCats (id : Option Ident) : CommandElabM Unit := do + let id := id.map (·.raw.getId.toString false) + let mut decls : Lean.RBMap _ _ compare := {} + for (name, cat) in (Parser.parserExtension.getState (← getEnv)).categories do + let name := name.toString false + if let some id := id then + if !id.isPrefixOf name then + continue + decls := decls.insert name cat + let mut msg := MessageData.nil + let env ← getEnv + if decls.isEmpty then + match id with + | some id => throwError "no syntax categories start with {id}" + | none => throwError "no syntax categories found (!)" + for (name, cat) in decls do + let mut msg1 := m!"category {name} [{mkConst cat.declName}]" + if let some doc ← findDocString? env cat.declName then + msg1 := msg1 ++ Format.line ++ doc.trim + msg := msg ++ .nest 2 msg1 ++ (.line ++ .line : Format) + logInfo msg + +elab_rules : command | `(#help cats $(id)?) => elabHelpCats id + +/-- +The command `#help cat C` shows all syntaxes that have been defined in syntax category `C` in the +current environment. +Each syntax has a format like: +``` +syntax "first"... [Parser.tactic.first] + `first | tac | ...` runs each `tac` until one succeeds, or else fails. +``` +The quoted string is the leading token of the syntax, if applicable. It is followed by the full +name of the syntax (which you can also click to go to the definition), and the documentation. + +* The form `#help cat C id` will show only attributes that begin with `id`. +* The form `#help cat+ C` will also show information about any `macro`s and `elab`s + associated to the listed syntaxes. +-/ +syntax withPosition("#help " colGt &"cat" "+"? colGt ident + (colGt ppSpace (Parser.rawIdent <|> str))?) : command + +private def elabHelpCat (more : Option Syntax) (catStx : Ident) (id : Option String) : + CommandElabM Unit := do + let mut decls : Lean.RBMap _ _ compare := {} + let mut rest : Lean.RBMap _ _ compare := {} + let catName := catStx.getId.eraseMacroScopes + let some cat := (Parser.parserExtension.getState (← getEnv)).categories.find? catName + | throwErrorAt catStx "{catStx} is not a syntax category" + liftTermElabM <| Term.addCategoryInfo catStx catName + let env ← getEnv + for (k, _) in cat.kinds do + let mut used := false + if let some tk := do getHeadTk (← (← env.find? k).value?) then + let tk := tk.trim + if let some id := id then + if !id.isPrefixOf tk then + continue + used := true + decls := decls.insert tk ((decls.findD tk #[]).push k) + if !used && id.isNone then + rest := rest.insert (k.toString false) k + let mut msg := MessageData.nil + if decls.isEmpty && rest.isEmpty then + match id with + | some id => throwError "no {catName} declarations start with {id}" + | none => throwError "no {catName} declarations found" + let env ← getEnv + let addMsg (k : SyntaxNodeKind) (msg msg1 : MessageData) : CommandElabM MessageData := do + let mut msg1 := msg1 + if let some doc ← findDocString? env k then + msg1 := msg1 ++ Format.line ++ doc.trim + msg1 := .nest 2 msg1 + if more.isSome then + let addElabs {α} (type : String) (attr : KeyedDeclsAttribute α) + (msg : MessageData) : CommandElabM MessageData := do + let mut msg := msg + for e in attr.getEntries env k do + let x := e.declName + msg := msg ++ Format.line ++ m!"+ {type} {mkConst x}" + if let some doc ← findDocString? env x then + msg := msg ++ .nest 2 (Format.line ++ doc.trim) + pure msg + msg1 ← addElabs "macro" macroAttribute msg1 + match catName with + | `term => msg1 ← addElabs "term elab" Term.termElabAttribute msg1 + | `command => msg1 ← addElabs "command elab" commandElabAttribute msg1 + | `tactic | `conv => msg1 ← addElabs "tactic elab" tacticElabAttribute msg1 + | _ => pure () + return msg ++ msg1 ++ (.line ++ .line : Format) + for (name, ks) in decls do + for k in ks do + msg ← addMsg k msg m!"syntax {repr name}... [{mkConst k}]" + for (_, k) in rest do + msg ← addMsg k msg m!"syntax ... [{mkConst k}]" + logInfo msg + +elab_rules : command + | `(#help cat $[+%$more]? $cat) => elabHelpCat more cat none + | `(#help cat $[+%$more]? $cat $id:ident) => elabHelpCat more cat (id.getId.toString false) + | `(#help cat $[+%$more]? $cat $id:str) => elabHelpCat more cat id.getString + +/-- +format the string to be included in a single markdown bullet +-/ +def _root_.String.makeBullet (s:String) := "* " ++ ("\n ").intercalate (s.splitOn "\n") + +open Lean Parser Batteries.Util.LibraryNote in +/-- +`#help note "foo"` searches for all library notes whose +label starts with "foo", then displays those library notes sorted alphabetically by label, +grouped by label. +The command only displays the library notes that are declared in +imported files or in the same file above the line containing the command. +-/ +elab "#help " colGt &"note" colGt ppSpace name:strLit : command => do + let env ← getEnv + + -- get the library notes from both this and imported files + let local_entries := (libraryNoteExt.getEntries env).reverse + let imported_entries := (libraryNoteExt.toEnvExtension.getState env).importedEntries + + -- filter for the appropriate notes while casting to list + let label_prefix := name.getString + let imported_entries_filtered := imported_entries.flatten.toList.filterMap + fun x => if label_prefix.isPrefixOf x.fst then some x else none + let valid_entries := imported_entries_filtered ++ local_entries.filterMap + fun x => if label_prefix.isPrefixOf x.fst then some x else none + let grouped_valid_entries := valid_entries.mergeSort (·.fst ≤ ·.fst) + |>.splitBy (·.fst == ·.fst) + + -- display results in a readable style + if grouped_valid_entries.isEmpty then + logError "Note not found" + else + logInfo <| "\n\n".intercalate <| + grouped_valid_entries.map + fun l => "library_note \"" ++ l.head!.fst ++ "\"\n" ++ + "\n\n".intercalate (l.map (·.snd.trim.makeBullet)) + +/-- +The command `#help term` shows all term syntaxes that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"term" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help term%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `term) $(id)?) + +/-- +The command `#help tactic` shows all tactics that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"tactic" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help tactic%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `tactic) $(id)?) + +/-- +The command `#help conv` shows all tactics that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"conv" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help conv%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `conv) $(id)?) + +/-- +The command `#help command` shows all commands that have been defined in the current environment. +See `#help cat` for more information. +-/ +syntax withPosition("#help " colGt &"command" "+"? + (colGt ppSpace (Parser.rawIdent <|> str))?) : command +macro_rules + | `(#help command%$tk $[+%$more]? $(id)?) => + `(#help cat$[+%$more]? $(mkIdentFrom tk `command) $(id)?) diff --git a/Batteries/Tactic/OpenPrivate.lean b/Batteries/Tactic/OpenPrivate.lean index 7ade0b94d9..a7e126133f 100644 --- a/Batteries/Tactic/OpenPrivate.lean +++ b/Batteries/Tactic/OpenPrivate.lean @@ -99,7 +99,7 @@ name component. It is also possible to specify the module instead with `open private a b c from Other.Module`. -/ -syntax (name := openPrivate) "open private" (ppSpace ident)* +syntax (name := openPrivate) "open" ppSpace "private" (ppSpace ident)* (" in" (ppSpace ident)*)? (" from" (ppSpace ident)*)? : command /-- Elaborator for `open private`. -/ @@ -119,7 +119,7 @@ It will also open the newly created alias definition under the provided short na It is also possible to specify the module instead with `export private a b c from Other.Module`. -/ -syntax (name := exportPrivate) "export private" (ppSpace ident)* +syntax (name := exportPrivate) "export" ppSpace "private" (ppSpace ident)* (" in" (ppSpace ident)*)? (" from" (ppSpace ident)*)? : command /-- Elaborator for `export private`. -/ diff --git a/Batteries/Tactic/PrintPrefix.lean b/Batteries/Tactic/PrintPrefix.lean index b83e7b0ad8..42b879b9b7 100644 --- a/Batteries/Tactic/PrintPrefix.lean +++ b/Batteries/Tactic/PrintPrefix.lean @@ -27,7 +27,7 @@ structure PrintPrefixConfig where internals : Bool := false /-- Function elaborating `Config`. -/ -declare_config_elab elabPrintPrefixConfig PrintPrefixConfig +declare_command_config_elab elabPrintPrefixConfig PrintPrefixConfig /-- `reverseName name` reverses the components of a name. @@ -108,12 +108,13 @@ by setting `showTypes` to `false`: The complete set of flags can be seen in the documentation for `Lean.Elab.Command.PrintPrefixConfig`. -/ -elab (name := printPrefix) "#print" tk:"prefix" - cfg:(Lean.Parser.Tactic.config)? name:ident : command => liftTermElabM do - let nameId := name.getId - let opts ← elabPrintPrefixConfig (mkOptionalNode cfg) - let mut msgs ← matchingConstants opts nameId - if msgs.isEmpty then - if let [name] ← resolveGlobalConst name then - msgs ← matchingConstants opts name - logInfoAt tk (.joinSep msgs.toList "") +elab (name := printPrefix) tk:"#print " colGt "prefix" + cfg:Lean.Parser.Tactic.optConfig name:(ident)? : command => do + if let some name := name then + let opts ← elabPrintPrefixConfig cfg + liftTermElabM do + let mut msgs ← matchingConstants opts name.getId + if msgs.isEmpty then + if let [name] ← resolveGlobalConst name then + msgs ← matchingConstants opts name + logInfoAt tk (.joinSep msgs.toList "") diff --git a/Batteries/Tactic/Trans.lean b/Batteries/Tactic/Trans.lean new file mode 100644 index 0000000000..7070c843ac --- /dev/null +++ b/Batteries/Tactic/Trans.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2022 Siddhartha Gadgil. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Siddhartha Gadgil, Mario Carneiro +-/ +import Lean.Elab.Tactic.ElabTerm +import Batteries.Tactic.Alias + +/-! +# `trans` tactic + +This implements the `trans` tactic, which can apply transitivity theorems with an optional middle +variable argument. +-/ + +/-- Compose using transitivity, homogeneous case. -/ +def Trans.simple {r : α → α → Sort _} [Trans r r r] : r a b → r b c → r a c := trans + +@[deprecated (since := "2024-10-18")] +alias Trans.heq := Trans.trans + +namespace Batteries.Tactic +open Lean Meta Elab + +initialize registerTraceClass `Tactic.trans + +/-- Discrimation tree settings for the `trans` extension. -/ +def transExt.config : WhnfCoreConfig := {} + +/-- Environment extension storing transitivity lemmas -/ +initialize transExt : + SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ← + registerSimpleScopedEnvExtension { + addEntry := fun dt (n, ks) => dt.insertCore ks n + initial := {} + } + +initialize registerBuiltinAttribute { + name := `trans + descr := "transitive relation" + add := fun decl _ kind => MetaM.run' do + let declTy := (← getConstInfo decl).type + let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy + let fail := throwError + "@[trans] attribute only applies to lemmas proving + x ∼ y → y ∼ z → x ∼ z, got {indentExpr declTy} with target {indentExpr targetTy}" + let .app (.app rel _) _ := targetTy | fail + let some yzHyp := xs.back? | fail + let some xyHyp := xs.pop.back? | fail + let .app (.app _ _) _ ← inferType yzHyp | fail + let .app (.app _ _) _ ← inferType xyHyp | fail + let key ← withReducible <| DiscrTree.mkPath rel transExt.config + transExt.add (decl, key) kind +} + +open Lean.Elab.Tactic + +/-- solving `e ← mkAppM' f #[x]` -/ +def getExplicitFuncArg? (e : Expr) : MetaM (Option <| Expr × Expr) := do + match e with + | Expr.app f a => do + if ← isDefEq (← mkAppM' f #[a]) e then + return some (f, a) + else + getExplicitFuncArg? f + | _ => return none + +/-- solving `tgt ← mkAppM' rel #[x, z]` given `tgt = f z` -/ +def getExplicitRelArg? (tgt f z : Expr) : MetaM (Option <| Expr × Expr) := do + match f with + | Expr.app rel x => do + let check: Bool ← do + try + let folded ← mkAppM' rel #[x, z] + isDefEq folded tgt + catch _ => + pure false + if check then + return some (rel, x) + else + getExplicitRelArg? tgt rel z + | _ => return none + +/-- refining `tgt ← mkAppM' rel #[x, z]` dropping more arguments if possible -/ +def getExplicitRelArgCore (tgt rel x z : Expr) : MetaM (Expr × Expr) := do + match rel with + | Expr.app rel' _ => do + let check: Bool ← do + try + let folded ← mkAppM' rel' #[x, z] + isDefEq folded tgt + catch _ => + pure false + if !check then + return (rel, x) + else + getExplicitRelArgCore tgt rel' x z + | _ => return (rel ,x) + +/-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent +arrow. -/ +inductive TransRelation + /-- Expression for transitive relation. -/ + | app (rel : Expr) + /-- Constant name for transitive relation. -/ + | implies (name : Name) (bi : BinderInfo) + +/-- Finds an explicit binary relation in the argument, if possible. -/ +def getRel (tgt : Expr) : MetaM (Option (TransRelation × Expr × Expr)) := do + match tgt with + | .forallE name binderType body info => return .some (.implies name info, binderType, body) + | .app f z => + match (← getExplicitRelArg? tgt f z) with + | some (rel, x) => + let (rel, x) ← getExplicitRelArgCore tgt rel x z + return some (.app rel, x, z) + | none => + return none + | _ => return none + +/-- +`trans` applies to a goal whose target has the form `t ~ u` where `~` is a transitive relation, +that is, a relation which has a transitivity lemma tagged with the attribute [trans]. + +* `trans s` replaces the goal with the two subgoals `t ~ s` and `s ~ u`. +* If `s` is omitted, then a metavariable is used instead. + +Additionally, `trans` also applies to a goal whose target has the form `t → u`, +in which case it replaces the goal with `t → s` and `s → u`. +-/ +elab "trans" t?:(ppSpace colGt term)? : tactic => withMainContext do + let tgt := (← instantiateMVars (← (← getMainGoal).getType)).cleanupAnnotations + let .some (rel, x, z) ← getRel tgt | + throwError (m!"transitivity lemmas only apply to binary relations and " ++ + m!"non-dependent arrows, not {indentExpr tgt}") + match rel with + | .implies name info => + -- only consider non-dependent arrows + if z.hasLooseBVars then + throwError "`trans` is not implemented for dependent arrows{indentExpr tgt}" + -- parse the intermeditate term + let middleType ← mkFreshExprMVar none + let t'? ← t?.mapM (elabTermWithHoles · middleType (← getMainTag)) + let middle ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar middleType) + liftMetaTactic fun goal => do + -- create two new goals + let g₁ ← mkFreshExprMVar (some <| .forallE name x middle info) .synthetic + let g₂ ← mkFreshExprMVar (some <| .forallE name middle z info) .synthetic + -- close the original goal with `fun x => g₂ (g₁ x)` + goal.assign (.lam name x (.app g₂ (.app g₁ (.bvar 0))) .default) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [middle.mvarId!] + return + | .app rel => + trace[Tactic.trans]"goal decomposed" + trace[Tactic.trans]"rel: {indentExpr rel}" + trace[Tactic.trans]"x: {indentExpr x}" + trace[Tactic.trans]"z: {indentExpr z}" + -- first trying the homogeneous case + try + let ty ← inferType x + let t'? ← t?.mapM (elabTermWithHoles · ty (← getMainTag)) + let s ← saveState + trace[Tactic.trans]"trying homogeneous case" + let lemmas := + (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push ``Trans.simple + for lem in lemmas do + trace[Tactic.trans]"trying lemma {lem}" + try + liftMetaTactic fun g => do + let lemTy ← inferType (← mkConstWithLevelParams lem) + let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size + let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar ty) + let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic + let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic + g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂])) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ + if let some (_, gs') := t'? then gs' else [y.mvarId!] + return + catch _ => s.restore + pure () + catch _ => + trace[Tactic.trans]"trying heterogeneous case" + let t'? ← t?.mapM (elabTermWithHoles · none (← getMainTag)) + let s ← saveState + for lem in (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push + ``HEq.trans |>.push ``Trans.trans do + try + liftMetaTactic fun g => do + trace[Tactic.trans]"trying lemma {lem}" + let lemTy ← inferType (← mkConstWithLevelParams lem) + let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ => pure es.size + trace[Tactic.trans]"arity: {arity}" + trace[Tactic.trans]"lemma-type: {lemTy}" + let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar none) + trace[Tactic.trans]"obtained y: {y}" + trace[Tactic.trans]"rel: {indentExpr rel}" + trace[Tactic.trans]"x:{indentExpr x}" + trace[Tactic.trans]"z: {indentExpr z}" + let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic + trace[Tactic.trans]"obtained g₂: {g₂}" + let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic + trace[Tactic.trans]"obtained g₁: {g₁}" + g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂])) + pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [y.mvarId!] + return + catch e => + trace[Tactic.trans]"failed: {e.toMessageData}" + s.restore + throwError m!"no applicable transitivity lemma found for {indentExpr tgt}" + +/-- Synonym for `trans` tactic. -/ +syntax "transitivity" (ppSpace colGt term)? : tactic +set_option hygiene false in +macro_rules + | `(tactic| transitivity) => `(tactic| trans) + | `(tactic| transitivity $e) => `(tactic| trans $e) + +end Batteries.Tactic diff --git a/Batteries/Util/LibraryNote.lean b/Batteries/Util/LibraryNote.lean index 8c1d45f786..8268c757ca 100644 --- a/Batteries/Util/LibraryNote.lean +++ b/Batteries/Util/LibraryNote.lean @@ -15,12 +15,13 @@ open Lean /-- A library note consists of a (short) tag and a (long) note. -/ def LibraryNoteEntry := String × String +deriving Inhabited /-- Environment extension supporting `library_note`. -/ initialize libraryNoteExt : SimplePersistentEnvExtension LibraryNoteEntry (Array LibraryNoteEntry) ← registerSimplePersistentEnvExtension { addEntryFn := Array.push - addImportedFn := Array.concatMap id + addImportedFn := Array.flatMap id } open Lean Parser Command in @@ -35,6 +36,8 @@ creates a new "library note", which can then be cross-referenced using -- See note [some tag] ``` in doc-comments. +Use `#help note "some tag"` to display all notes with the tag `"some tag"` in the infoview. +This command can be imported from Batteries.Tactic.HelpCmd . -/ elab "library_note " title:strLit ppSpace text:docComment : command => do modifyEnv (libraryNoteExt.addEntry · (title.getString, text.getDocString)) diff --git a/Batteries/Util/Panic.lean b/Batteries/Util/Panic.lean new file mode 100644 index 0000000000..e6317bee71 --- /dev/null +++ b/Batteries/Util/Panic.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2024 François G. Dorais. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: François G. Dorais +-/ + +namespace Batteries + +/-- Panic with a specific default value `v`. -/ +def panicWith (v : α) (msg : String) : α := @panic α ⟨v⟩ msg + +@[simp] theorem panicWith_eq (v : α) (msg) : panicWith v msg = v := rfl diff --git a/Batteries/Util/ProofWanted.lean b/Batteries/Util/ProofWanted.lean index 97f1473f70..3a6fd90981 100644 --- a/Batteries/Util/ProofWanted.lean +++ b/Batteries/Util/ProofWanted.lean @@ -33,7 +33,10 @@ elaboration, but it's then removed from the environment. def elabProofWanted : CommandElab | `($mods:declModifiers proof_wanted $name $args* : $res) => withoutModifyingEnv do -- The helper axiom is used instead of `sorry` to avoid spurious warnings - elabCommand <| ← `(axiom helper (p : Prop) : p - $mods:declModifiers - theorem $name $args* : $res := helper _) + elabCommand <| ← `( + section + set_option linter.unusedVariables false + axiom helper {α : Sort _} : α + $mods:declModifiers theorem $name $args* : $res := helper + end) | _ => throwUnsupportedSyntax diff --git a/Batteries/WF.lean b/Batteries/WF.lean index 73428fe3bd..2c36dccebd 100644 --- a/Batteries/WF.lean +++ b/Batteries/WF.lean @@ -50,7 +50,7 @@ instance wfRel {r : α → α → Prop} : WellFoundedRelation { val // Acc r val (intro : (x : α) → (h : ∀ (y : α), r y x → Acc r y) → ((y : α) → (hr : r y x) → motive y (h y hr)) → motive x (intro x h)) {a : α} (t : Acc r a) : motive a t := - intro a (fun x h => t.inv h) (fun y hr => recC intro (t.inv hr)) + intro a (fun _ h => t.inv h) (fun _ hr => recC intro (t.inv hr)) termination_by Subtype.mk a t unseal recC diff --git a/Batteries/Test/Internal/DummyLabelAttr.lean b/BatteriesTest/Internal/DummyLabelAttr.lean similarity index 95% rename from Batteries/Test/Internal/DummyLabelAttr.lean rename to BatteriesTest/Internal/DummyLabelAttr.lean index 9cd76815cc..d996128a73 100644 --- a/Batteries/Test/Internal/DummyLabelAttr.lean +++ b/BatteriesTest/Internal/DummyLabelAttr.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2023 Lean FRO, LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Lean.LabelAttribute diff --git a/BatteriesTest/Internal/DummyLibraryNote.lean b/BatteriesTest/Internal/DummyLibraryNote.lean new file mode 100644 index 0000000000..f934823474 --- /dev/null +++ b/BatteriesTest/Internal/DummyLibraryNote.lean @@ -0,0 +1,14 @@ +import Batteries.Util.LibraryNote + +library_note "test" /-- +1: This is a testnote for testing the library note feature of batteries. +The `#help note` command should be able to find this note when imported. +-/ + +library_note "test" /-- +2: This is a second testnote for testing the library note feature of batteries. +-/ + +library_note "temporary note" /-- +1: This is a testnote whose label also starts with "te", but gets sorted before "test" +-/ diff --git a/BatteriesTest/Internal/DummyLibraryNote2.lean b/BatteriesTest/Internal/DummyLibraryNote2.lean new file mode 100644 index 0000000000..0676060219 --- /dev/null +++ b/BatteriesTest/Internal/DummyLibraryNote2.lean @@ -0,0 +1,15 @@ +import BatteriesTest.Internal.DummyLibraryNote + +library_note "test" /-- +3: this is a note in a different file importing the above testnotes, +but still imported by the actual testfile. +-/ + +library_note "Test" /-- +1: this is a testnote with a label starting with "Te" +-/ + +library_note "Other" /-- +1: this is a testnote with a label not starting with "te", +so it shouldn't appear when looking for notes with label starting with "te". +-/ diff --git a/test/MLList.lean b/BatteriesTest/MLList.lean similarity index 100% rename from test/MLList.lean rename to BatteriesTest/MLList.lean diff --git a/BatteriesTest/OpenPrivateDefs.lean b/BatteriesTest/OpenPrivateDefs.lean new file mode 100644 index 0000000000..f5d1a483e4 --- /dev/null +++ b/BatteriesTest/OpenPrivateDefs.lean @@ -0,0 +1,4 @@ +/-! +This file contains a private declaration. It's tested in `openPrivate.lean`. +-/ +private def secretNumber : Nat := 2 diff --git a/test/absurd.lean b/BatteriesTest/absurd.lean similarity index 100% rename from test/absurd.lean rename to BatteriesTest/absurd.lean diff --git a/test/alias.lean b/BatteriesTest/alias.lean similarity index 100% rename from test/alias.lean rename to BatteriesTest/alias.lean diff --git a/test/array.lean b/BatteriesTest/array.lean similarity index 90% rename from test/array.lean rename to BatteriesTest/array.lean index 2ba3a29577..89f784293e 100644 --- a/test/array.lean +++ b/BatteriesTest/array.lean @@ -10,7 +10,7 @@ variable (g : i < (a.set! i v).size) variable (j_lt : j < (a.set! i v).size) #check_simp (a.set! i v).get ⟨i, g⟩ ~> v -#check_simp (a.set! i v).get! i ~> if i < a.size then v else default +#check_simp (a.set! i v).get! i ~> (a.setD i v)[i]! #check_simp (a.set! i v).getD i d ~> if i < a.size then v else d #check_simp (a.set! i v)[i] ~> v diff --git a/test/by_contra.lean b/BatteriesTest/by_contra.lean similarity index 100% rename from test/by_contra.lean rename to BatteriesTest/by_contra.lean diff --git a/test/case.lean b/BatteriesTest/case.lean similarity index 93% rename from test/case.lean rename to BatteriesTest/case.lean index 4e7892d964..b8e3444d1d 100644 --- a/test/case.lean +++ b/BatteriesTest/case.lean @@ -182,16 +182,6 @@ example : True ∧ ∀ x : Nat, x = x := by rfl -- Test focusing by full match, suffix match, and prefix match -/-- -warning: unused variable `x` -note: this linter can be disabled with `set_option linter.unusedVariables false` ---- -warning: unused variable `y` -note: this linter can be disabled with `set_option linter.unusedVariables false` ---- -warning: unused variable `z` -note: this linter can be disabled with `set_option linter.unusedVariables false` --/ #guard_msgs in example : True := by have x : Bool := ?a diff --git a/test/congr.lean b/BatteriesTest/congr.lean similarity index 92% rename from test/congr.lean rename to BatteriesTest/congr.lean index 065a899f99..eee4c6dbac 100644 --- a/test/congr.lean +++ b/BatteriesTest/congr.lean @@ -38,11 +38,9 @@ section -- In order to preserve the test behaviour we locally remove the `ext` attribute. attribute [-ext] List.ext_getElem? -private opaque List.sum : List Nat → Nat - example {ls : List Nat} : - (ls.map fun x => (ls.map fun y => 1 + y).sum + 1) = - (ls.map fun x => (ls.map fun y => Nat.succ y).sum + 1) := by + (ls.map fun _ => (ls.map fun y => 1 + y).sum + 1) = + (ls.map fun _ => (ls.map fun y => Nat.succ y).sum + 1) := by rcongr (_x y) guard_target =ₐ 1 + y = y.succ rw [Nat.add_comm] diff --git a/test/conv_equals.lean b/BatteriesTest/conv_equals.lean similarity index 100% rename from test/conv_equals.lean rename to BatteriesTest/conv_equals.lean diff --git a/test/exfalso.lean b/BatteriesTest/exfalso.lean similarity index 100% rename from test/exfalso.lean rename to BatteriesTest/exfalso.lean diff --git a/test/float.lean b/BatteriesTest/float.lean similarity index 100% rename from test/float.lean rename to BatteriesTest/float.lean diff --git a/BatteriesTest/help_cmd.lean b/BatteriesTest/help_cmd.lean new file mode 100644 index 0000000000..23e3698b6d --- /dev/null +++ b/BatteriesTest/help_cmd.lean @@ -0,0 +1,428 @@ +import Batteries.Tactic.HelpCmd + +/-! The `#help` command + +The `#help` command family currently contains these subcommands: + +* `#help attr` / `#help attribute` +* `#help cat` +* `#help cats` +* `#help command` (abbrev for `#help cat command`) +* `#help conv` (abbrev for `#help cat conv`) +* `#help option` +* `#help tactic` (abbrev for `#help cat tactic`) +* `#help term` (abbrev for `#help cat term`) + +All forms take an optional identifier prefix to narrow the search. The `#help cat` command has a +variant `#help cat+` that displays additional information, similarly for commands derived from +`#help cat`. + +WARNING: Some of these tests will need occasional updates when new features are added and even when +some documentation is edited. This type of break will be unexpected but the fix will not be +unexpected! Just update the guard text to match the output after your addition. +-/ + +/-! `#help attr` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help attr + +/-- +error: no attributes start with foobarbaz +-/ +#guard_msgs in +#help attr foobarbaz + +/-- +info: +[inline]: mark definition to be inlined + +[inline_if_reduce]: mark definition to be inlined when resultant term after reduction is not a +`cases_on` application +-/ +#guard_msgs in +#help attr inl + +/-! `#help cat` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help cat term + +/-- +error: foobarbaz is not a syntax category +-/ +#guard_msgs in +#help cat foobarbaz + +/-- +info: +syntax "("... [«prec(_)»] + Parentheses are used for grouping precedence expressions. + +syntax "+"... [Lean.Parser.Syntax.addPrec] + Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`. + +syntax "-"... [Lean.Parser.Syntax.subPrec] + Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`. + +syntax "arg"... [precArg] + Precedence used for application arguments (`do`, `by`, ...). + +syntax "lead"... [precLead] + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). + +syntax "max"... [precMax] + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) + +syntax "min"... [precMin] + Minimum precedence used in term parsers. + +syntax "min1"... [precMin1] + `(min+1)` (we can only write `min+1` after `Meta.lean`) + +syntax ... [Lean.Parser.Syntax.numPrec] +-/ +#guard_msgs in +#help cat prec + +/-- +info: +syntax "("... [«prec(_)»] + Parentheses are used for grouping precedence expressions. ++ macro «_aux_Init_Notation___macroRules_prec(_)_1» + Parentheses are used for grouping precedence expressions. + +syntax "+"... [Lean.Parser.Syntax.addPrec] + Addition of precedences. This is normally used only for offsetting, e.g. `max + 1`. ++ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_addPrec_1 + +syntax "-"... [Lean.Parser.Syntax.subPrec] + Subtraction of precedences. This is normally used only for offsetting, e.g. `max - 1`. ++ macro Lean._aux_Init_Meta___macroRules_Lean_Parser_Syntax_subPrec_1 + +syntax "arg"... [precArg] + Precedence used for application arguments (`do`, `by`, ...). ++ macro _aux_Init_Notation___macroRules_precArg_1 + Precedence used for application arguments (`do`, `by`, ...). + +syntax "lead"... [precLead] + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). ++ macro _aux_Init_Notation___macroRules_precLead_1 + Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). + +syntax "max"... [precMax] + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) ++ macro _aux_Init_Notation___macroRules_precMax_1 + Maximum precedence used in term parsers, in particular for terms in + function position (`ident`, `paren`, ...) + +syntax "min"... [precMin] + Minimum precedence used in term parsers. ++ macro _aux_Init_Notation___macroRules_precMin_1 + Minimum precedence used in term parsers. + +syntax "min1"... [precMin1] + `(min+1)` (we can only write `min+1` after `Meta.lean`) ++ macro _aux_Init_Notation___macroRules_precMin1_1 + `(min+1)` (we can only write `min+1` after `Meta.lean`) + +syntax ... [Lean.Parser.Syntax.numPrec] +-/ +#guard_msgs in +#help cat+ prec + +/-! `#help cats` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help cats + +/-- +error: no syntax categories start with foobarbaz +-/ +#guard_msgs in +#help cats foobarbaz + +/-- +info: +category prec [Lean.Parser.Category.prec] + `prec` is a builtin syntax category for precedences. A precedence is a value + that expresses how tightly a piece of syntax binds: for example `1 + 2 * 3` is + parsed as `1 + (2 * 3)` because `*` has a higher pr0ecedence than `+`. + Higher numbers denote higher precedence. + In addition to literals like `37`, there are some special named priorities: + * `arg` for the precedence of function arguments + * `max` for the highest precedence used in term parsers (not actually the maximum possible value) + * `lead` for the precedence of terms not supposed to be used as arguments + and you can also add and subtract precedences. + +category prio [Lean.Parser.Category.prio] + `prio` is a builtin syntax category for priorities. + Priorities are used in many different attributes. + Higher numbers denote higher priority, and for example typeclass search will + try high priority instances before low priority. + In addition to literals like `37`, you can also use `low`, `mid`, `high`, as well as + add and subtract priorities. +-/ +#guard_msgs in +#help cats pr + +/-! `#help command` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help command + +/-- +error: no command declarations start with foobarbaz +-/ +#guard_msgs in +#help command foobarbaz + +/-- +info: syntax "#eval"... [Lean.Parser.Command.eval] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. + +syntax "#eval!"... [Lean.Parser.Command.evalBang] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. syntax "#exit"... [Lean.Parser.Command.exit] +-/ +#guard_msgs in +#help command "#e" + +/-- +info: syntax "#eval"... [Lean.Parser.Command.eval] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. ++ command elab Lean.Elab.Command.elabEval + +syntax "#eval!"... [Lean.Parser.Command.evalBang] + `#eval e` evaluates the expression `e` by compiling and evaluating it. + ⏎ + * The command attempts to use `ToExpr`, `Repr`, or `ToString` instances to print the result. + * If `e` is a monadic value of type `m ty`, then the command tries to adapt the monad `m` + to one of the monads that `#eval` supports, which include `IO`, `CoreM`, `MetaM`, `TermElabM`, and `CommandElabM`. + Users can define `MonadEval` instances to extend the list of supported monads. + ⏎ + The `#eval` command gracefully degrades in capability depending on what is imported. + Importing the `Lean.Elab.Command` module provides full capabilities. + ⏎ + Due to unsoundness, `#eval` refuses to evaluate expressions that depend on `sorry`, even indirectly, + since the presence of `sorry` can lead to runtime instability and crashes. + This check can be overridden with the `#eval! e` command. + ⏎ + Options: + * If `eval.pp` is true (default: true) then tries to use `ToExpr` instances to make use of the + usual pretty printer. Otherwise, only tries using `Repr` and `ToString` instances. + * If `eval.type` is true (default: false) then pretty prints the type of the evaluated value. + * If `eval.derive.repr` is true (default: true) then attempts to auto-derive a `Repr` instance + when there is no other way to print the result. + ⏎ + See also: `#reduce e` for evaluation by term reduction. ++ command elab Lean.Elab.Command.elabEvalBang + +syntax "#exit"... [Lean.Parser.Command.exit] ++ command elab Lean.Elab.Command.elabExit +-/ +#guard_msgs in +#help command+ "#e" + +/-! #help conv -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help conv + +/-- +error: no conv declarations start with foobarbaz +-/ +#guard_msgs in +#help conv foobarbaz + +/-- +info: +syntax "reduce"... [Lean.Parser.Tactic.Conv.reduce] + Puts term in normal form, this tactic is meant for debugging purposes only. + +syntax "repeat"... [Lean.Parser.Tactic.Conv.convRepeat_] + `repeat convs` runs the sequence `convs` repeatedly until it fails to apply. + +syntax "rewrite"... [Lean.Parser.Tactic.Conv.rewrite] + `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. +-/ +#guard_msgs in +#help conv "re" + +/-- +info: +syntax "reduce"... [Lean.Parser.Tactic.Conv.reduce] + Puts term in normal form, this tactic is meant for debugging purposes only. ++ tactic elab Lean.Elab.Tactic.Conv.evalReduce + +syntax "repeat"... [Lean.Parser.Tactic.Conv.convRepeat_] + `repeat convs` runs the sequence `convs` repeatedly until it fails to apply. ++ macro Lean.Parser.Tactic.Conv._aux_Init_Conv___macroRules_Lean_Parser_Tactic_Conv_convRepeat__1 + +syntax "rewrite"... [Lean.Parser.Tactic.Conv.rewrite] + `rw [thm]` rewrites the target using `thm`. See the `rw` tactic for more information. ++ tactic elab Lean.Elab.Tactic.Conv.evalRewrite +-/ +#guard_msgs in +#help conv+ "re" + +/-! `#help option` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help option + +/-- +error: no options start with foobarbaz +-/ +#guard_msgs in +#help option foobarbaz + +/-- +info: +option pp.instanceTypes : Bool := false + (pretty printer) when printing explicit applications, show the types of inst-implicit arguments + +option pp.instances : Bool := true + (pretty printer) if set to false, replace inst-implicit arguments to explicit applications with +placeholders + +option pp.instantiateMVars : Bool := true + (pretty printer) instantiate mvars before delaborating +-/ +#guard_msgs in +#help option pp.ins + +/-! `#help tactic` -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help tactic + +/-- +error: no tactic declarations start with foobarbaz +-/ +#guard_msgs in +#help tactic foobarbaz + +/-- +info: +syntax "by_cases"... [«tacticBy_cases_:_»] + `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. +-/ +#guard_msgs in +#help tactic by + +/-- +info: +syntax "by_cases"... [«tacticBy_cases_:_»] + `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. ++ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__2» ++ macro «_aux_Init_ByCases___macroRules_tacticBy_cases_:__1» +-/ +#guard_msgs in +#help tactic+ by + +/-! #help term -/ + +-- this is a long and constantly updated listing, we don't check the output +#guard_msgs(error, drop info) in +#help term + +/-- +error: no term declarations start with foobarbaz +-/ +#guard_msgs in +#help term foobarbaz + +/-- +info: +syntax "decl_name%"... [Lean.Parser.Term.declName] + A macro which evaluates to the name of the currently elaborating declaration. + +syntax "default_or_ofNonempty%"... [Lean.Parser.Term.defaultOrOfNonempty] +-/ +#guard_msgs in +#help term de + +/-- +info: +syntax "decl_name%"... [Lean.Parser.Term.declName] + A macro which evaluates to the name of the currently elaborating declaration. ++ term elab Lean.Elab.Term.elabDeclName + +syntax "default_or_ofNonempty%"... [Lean.Parser.Term.defaultOrOfNonempty] ++ term elab Lean.Elab.Term.Op.elabDefaultOrNonempty +-/ +#guard_msgs in +#help term+ de diff --git a/test/import_lean.lean b/BatteriesTest/import_lean.lean similarity index 100% rename from test/import_lean.lean rename to BatteriesTest/import_lean.lean diff --git a/test/instances.lean b/BatteriesTest/instances.lean similarity index 100% rename from test/instances.lean rename to BatteriesTest/instances.lean diff --git a/test/isIndependentOf.lean b/BatteriesTest/isIndependentOf.lean similarity index 100% rename from test/isIndependentOf.lean rename to BatteriesTest/isIndependentOf.lean diff --git a/test/kmp_matcher.lean b/BatteriesTest/kmp_matcher.lean similarity index 100% rename from test/kmp_matcher.lean rename to BatteriesTest/kmp_matcher.lean diff --git a/test/lemma_cmd.lean b/BatteriesTest/lemma_cmd.lean similarity index 100% rename from test/lemma_cmd.lean rename to BatteriesTest/lemma_cmd.lean diff --git a/BatteriesTest/library_note.lean b/BatteriesTest/library_note.lean new file mode 100644 index 0000000000..7eadf44a44 --- /dev/null +++ b/BatteriesTest/library_note.lean @@ -0,0 +1,47 @@ +import Batteries.Tactic.HelpCmd +import BatteriesTest.Internal.DummyLibraryNote2 + +/-- +error: Note not found +-/ +#guard_msgs in +#help note "no note" + +/-- +info: library_note "Other" +* 1: this is a testnote with a label not starting with "te", + so it shouldn't appear when looking for notes with label starting with "te". +-/ +#guard_msgs in +#help note "Other" + +library_note "test"/-- +4: This note was not imported, and therefore appears below the imported notes. +-/ + +library_note "test"/-- +5: This note was also not imported, and therefore appears below the imported notes, +and the previously added note. +-/ + + +/-- +info: library_note "temporary note" +* 1: This is a testnote whose label also starts with "te", but gets sorted before "test" + +library_note "test" +* 1: This is a testnote for testing the library note feature of batteries. + The `#help note` command should be able to find this note when imported. + +* 2: This is a second testnote for testing the library note feature of batteries. + +* 3: this is a note in a different file importing the above testnotes, + but still imported by the actual testfile. + +* 4: This note was not imported, and therefore appears below the imported notes. + +* 5: This note was also not imported, and therefore appears below the imported notes, + and the previously added note. +-/ +#guard_msgs in +#help note "te" diff --git a/test/lintTC.lean b/BatteriesTest/lintTC.lean similarity index 100% rename from test/lintTC.lean rename to BatteriesTest/lintTC.lean diff --git a/test/lint_docBlame.lean b/BatteriesTest/lint_docBlame.lean similarity index 100% rename from test/lint_docBlame.lean rename to BatteriesTest/lint_docBlame.lean diff --git a/test/lint_docBlameThm.lean b/BatteriesTest/lint_docBlameThm.lean similarity index 100% rename from test/lint_docBlameThm.lean rename to BatteriesTest/lint_docBlameThm.lean diff --git a/test/lint_dupNamespace.lean b/BatteriesTest/lint_dupNamespace.lean similarity index 100% rename from test/lint_dupNamespace.lean rename to BatteriesTest/lint_dupNamespace.lean diff --git a/test/lint_empty.lean b/BatteriesTest/lint_empty.lean similarity index 100% rename from test/lint_empty.lean rename to BatteriesTest/lint_empty.lean diff --git a/test/lint_lean.lean b/BatteriesTest/lint_lean.lean similarity index 87% rename from test/lint_lean.lean rename to BatteriesTest/lint_lean.lean index 46eb6591ff..f5657a5b96 100644 --- a/test/lint_lean.lean +++ b/BatteriesTest/lint_lean.lean @@ -15,14 +15,13 @@ but it is useful to run locally to see what the linters would catch. -- attribute [nolint dupNamespace] Lean.Elab.Tactic.Tactic -- attribute [nolint dupNamespace] Lean.Parser.Parser Lean.Parser.Parser.rec Lean.Parser.Parser.mk -- Lean.Parser.Parser.info Lean.Parser.Parser.fn +-- attribute [nolint explicitVarsOfIff] Iff.refl /-! Failing lints that need work. -/ --- #lint only explicitVarsOfIff in all -- Found 156 errors - --- Many fixed in https://github.com/leanprover/lean4/pull/4620 +-- Many fixed in https://github.com/leanprover/lean4/pull/4620 and subsequent PRs -- and should be checked again. --- #lint only simpNF in all -- Found 12 errors +-- #lint only simpNF in all -- Found 22 errors /-! Lints that fail, but that we're not intending to do anything about. -/ @@ -41,6 +40,7 @@ but it is useful to run locally to see what the linters would catch. /-! Lints that have succeeded in the past, and hopefully still do! -/ +-- #lint only explicitVarsOfIff in all -- Found 1 errors, `Iff.refl`, which could be nolinted. -- #lint only impossibleInstance in all -- Found 0 errors -- #lint only simpVarHead in all -- Found 0 error -- #lint only unusedHavesSuffices in all -- Found 0 errors diff --git a/test/lint_simpNF.lean b/BatteriesTest/lint_simpNF.lean similarity index 89% rename from test/lint_simpNF.lean rename to BatteriesTest/lint_simpNF.lean index e06e067d18..c9c8f9d307 100644 --- a/test/lint_simpNF.lean +++ b/BatteriesTest/lint_simpNF.lean @@ -2,9 +2,6 @@ import Batteries.Tactic.Lint set_option linter.missingDocs false -protected def Sum.elim {α β γ : Sort _} (f : α → γ) (g : β → γ) : Sum α β → γ := - fun x => Sum.casesOn x f g - structure Equiv (α : Sort _) (β : Sort _) where toFun : α → β invFun : β → α diff --git a/test/lint_unreachableTactic.lean b/BatteriesTest/lint_unreachableTactic.lean similarity index 100% rename from test/lint_unreachableTactic.lean rename to BatteriesTest/lint_unreachableTactic.lean diff --git a/test/lintsimp.lean b/BatteriesTest/lintsimp.lean similarity index 100% rename from test/lintsimp.lean rename to BatteriesTest/lintsimp.lean diff --git a/test/lintunused.lean b/BatteriesTest/lintunused.lean similarity index 100% rename from test/lintunused.lean rename to BatteriesTest/lintunused.lean diff --git a/test/list_sublists.lean b/BatteriesTest/list_sublists.lean similarity index 100% rename from test/list_sublists.lean rename to BatteriesTest/list_sublists.lean diff --git a/test/nondet.lean b/BatteriesTest/nondet.lean similarity index 100% rename from test/nondet.lean rename to BatteriesTest/nondet.lean diff --git a/test/norm_cast.lean b/BatteriesTest/norm_cast.lean similarity index 100% rename from test/norm_cast.lean rename to BatteriesTest/norm_cast.lean diff --git a/test/omega/benchmark.lean b/BatteriesTest/omega/benchmark.lean similarity index 99% rename from test/omega/benchmark.lean rename to BatteriesTest/omega/benchmark.lean index f3a5113dd1..c1e50b1a2a 100644 --- a/test/omega/benchmark.lean +++ b/BatteriesTest/omega/benchmark.lean @@ -4,7 +4,7 @@ As it's important that `omega` is fast, particularly when it has nothing to do, this file maintains a benchmark suite for `omega`. It is particularly low-tech, -and currently only reproducible on Scott Morrison's FRO machine; +and currently only reproducible on Kim Morrison's FRO machine; nevertheless it seems useful to keep the benchmark history in the repository. The benchmark file consists of the test suite from `omega`'s initial release, diff --git a/test/on_goal.lean b/BatteriesTest/on_goal.lean similarity index 100% rename from test/on_goal.lean rename to BatteriesTest/on_goal.lean diff --git a/BatteriesTest/openPrivate.lean b/BatteriesTest/openPrivate.lean new file mode 100644 index 0000000000..36f042c634 --- /dev/null +++ b/BatteriesTest/openPrivate.lean @@ -0,0 +1,37 @@ + +import Batteries.Tactic.OpenPrivate + +import BatteriesTest.OpenPrivateDefs + + + +/-- error: unknown identifier 'secretNumber' -/ +#guard_msgs in +#eval secretNumber + + +-- It works with one space between the tokens +/-- info: 2 -/ +#guard_msgs in +open private secretNumber from BatteriesTest.OpenPrivateDefs in +#eval secretNumber + + +-- It also works with other kinds of whitespace between the tokens + +/-- info: 2 -/ +#guard_msgs in +open private secretNumber from BatteriesTest.OpenPrivateDefs in +#eval secretNumber + + +/-- info: 2 -/ +#guard_msgs in +open + private secretNumber from BatteriesTest.OpenPrivateDefs in +#eval secretNumber + +/-- info: 2 -/ +#guard_msgs in +open /- Being sneaky! -/ private secretNumber from BatteriesTest.OpenPrivateDefs in +#eval secretNumber diff --git a/test/print_prefix.lean b/BatteriesTest/print_prefix.lean similarity index 79% rename from test/print_prefix.lean rename to BatteriesTest/print_prefix.lean index 77f89437c1..32467e4b37 100644 --- a/test/print_prefix.lean +++ b/BatteriesTest/print_prefix.lean @@ -14,7 +14,7 @@ TEmpty.recOn.{u} (motive : TEmpty → Sort u) (t : TEmpty) : motive t /-- info: -/ #guard_msgs in -#print prefix (config := {imported := false}) Empty +#print prefix -imported Empty namespace EmptyPrefixTest @@ -52,10 +52,10 @@ TestStruct.casesOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t TestStruct.foo (self : TestStruct) : Int TestStruct.mk (foo bar : Int) : TestStruct -TestStruct.mk.inj {foo bar : Int} : - ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 -TestStruct.mk.injEq (foo bar : Int) : - ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) +TestStruct.mk.inj {foo bar foo✝ bar✝ : Int} : + { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝ +TestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) : + ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar TestStruct.noConfusion.{u} {P : Sort u} {v1 v2 : TestStruct} (h12 : v1 = v2) : TestStruct.noConfusionType P v1 v2 TestStruct.noConfusionType.{u} (P : Sort u) (v1 v2 : TestStruct) : Sort u @@ -82,17 +82,17 @@ TestStruct.recOn.{u} {motive : TestStruct → Sort u} (t : TestStruct) (mk : (foo bar : Int) → motive { foo := foo, bar := bar }) : motive t -/ #guard_msgs in -#print prefix (config := {propositions := false}) TestStruct +#print prefix -propositions TestStruct /-- -info: TestStruct.mk.inj {foo bar : Int} : - ∀ {foo_1 bar_1 : Int}, { foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 } → foo = foo_1 ∧ bar = bar_1 -TestStruct.mk.injEq (foo bar : Int) : - ∀ (foo_1 bar_1 : Int), ({ foo := foo, bar := bar } = { foo := foo_1, bar := bar_1 }) = (foo = foo_1 ∧ bar = bar_1) +info: TestStruct.mk.inj {foo bar foo✝ bar✝ : Int} : + { foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ } → foo = foo✝ ∧ bar = bar✝ +TestStruct.mk.injEq (foo bar foo✝ bar✝ : Int) : + ({ foo := foo, bar := bar } = { foo := foo✝, bar := bar✝ }) = (foo = foo✝ ∧ bar = bar✝) TestStruct.mk.sizeOf_spec (foo bar : Int) : sizeOf { foo := foo, bar := bar } = 1 + sizeOf foo + sizeOf bar -/ #guard_msgs in -#print prefix (config := {propositionsOnly := true}) TestStruct +#print prefix +propositionsOnly TestStruct /-- info: TestStruct @@ -109,7 +109,7 @@ TestStruct.rec TestStruct.recOn -/ #guard_msgs in -#print prefix (config := {showTypes := false}) TestStruct +#print prefix -showTypes TestStruct /-- Artificial test function to show #print prefix filters out internals @@ -133,21 +133,17 @@ testMatchProof._cstage1 (n : Nat) : Fin n → Unit testMatchProof._cstage2 : _obj → _obj → _obj testMatchProof._sunfold (n : Nat) : Fin n → Unit testMatchProof._unsafe_rec (n : Nat) : Fin n → Unit -testMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : - (x : Nat) → - (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 -testMatchProof.match_1._cstage1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) : - (x : Nat) → - (x_1 : Fin x) → - ((n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) → - ((as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) → motive x x_1 +testMatchProof.match_1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) (x✝ : Nat) (x✝¹ : Fin x✝) + (h_1 : (n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) + (h_2 : (as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) : motive x✝ x✝¹ +testMatchProof.match_1._cstage1.{u_1} (motive : (x : Nat) → Fin x → Sort u_1) (x✝ : Nat) (x✝¹ : Fin x✝) + (h_1 : (n : Nat) → (isLt : 0 < n) → motive n ⟨0, isLt⟩) + (h_2 : (as i : Nat) → (h : i.succ < as.succ) → motive as.succ ⟨i.succ, h⟩) : motive x✝ x✝¹ testMatchProof.proof_1 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as testMatchProof.proof_2 (as i : Nat) (h : i.succ < as.succ) : i.succ ≤ as -/ #guard_msgs in -#print prefix (config := {internals := true}) testMatchProof +#print prefix +internals testMatchProof private inductive TestInd where | foo : TestInd @@ -171,3 +167,7 @@ TestInd.toCtorIdx : TestInd → Nat -/ #guard_msgs in #print prefix TestInd + +-- `#print prefix` does nothing if no identifier is provided +#guard_msgs in +#print prefix diff --git a/BatteriesTest/proof_wanted.lean b/BatteriesTest/proof_wanted.lean new file mode 100644 index 0000000000..38f5714eb3 --- /dev/null +++ b/BatteriesTest/proof_wanted.lean @@ -0,0 +1,15 @@ +import Batteries.Util.ProofWanted + +/-! +No unused variable warnings. +-/ +#guard_msgs in proof_wanted foo (x : Nat) : True + +/-! +When not a proposition, rely on `theorem` command failing. +-/ +/-- +error: type of theorem 'foo' is not a proposition + Nat → Nat +-/ +#guard_msgs in proof_wanted foo (x : Nat) : Nat diff --git a/test/register_label_attr.lean b/BatteriesTest/register_label_attr.lean similarity index 92% rename from test/register_label_attr.lean rename to BatteriesTest/register_label_attr.lean index 9add2305c6..d1928052e8 100644 --- a/test/register_label_attr.lean +++ b/BatteriesTest/register_label_attr.lean @@ -1,4 +1,4 @@ -import Batteries.Test.Internal.DummyLabelAttr +import BatteriesTest.Internal.DummyLabelAttr import Lean.LabelAttribute set_option linter.missingDocs false diff --git a/test/rfl.lean b/BatteriesTest/rfl.lean similarity index 100% rename from test/rfl.lean rename to BatteriesTest/rfl.lean diff --git a/BatteriesTest/satisfying.lean b/BatteriesTest/satisfying.lean new file mode 100644 index 0000000000..eadfbc6a66 --- /dev/null +++ b/BatteriesTest/satisfying.lean @@ -0,0 +1,8 @@ +import Batteries.Lean.SatisfiesM +import Batteries.Data.Array.Monadic + +open Lean Meta Array Elab Term Tactic Command + +example (xs : Array Expr) : MetaM { ts : Array Expr // ts.size = xs.size } := do + let r ← satisfying (xs.size_mapM inferType) + return r diff --git a/test/seq_focus.lean b/BatteriesTest/seq_focus.lean similarity index 100% rename from test/seq_focus.lean rename to BatteriesTest/seq_focus.lean diff --git a/test/show_term.lean b/BatteriesTest/show_term.lean similarity index 85% rename from test/show_term.lean rename to BatteriesTest/show_term.lean index 8557e8229b..7288c369e9 100644 --- a/test/show_term.lean +++ b/BatteriesTest/show_term.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2021 Scott Morrison. All rights reserved. +Copyright (c) 2021 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ /-- info: Try this: exact (n, 37) -/ diff --git a/test/show_unused.lean b/BatteriesTest/show_unused.lean similarity index 100% rename from test/show_unused.lean rename to BatteriesTest/show_unused.lean diff --git a/test/simp_trace.lean b/BatteriesTest/simp_trace.lean similarity index 100% rename from test/simp_trace.lean rename to BatteriesTest/simp_trace.lean diff --git a/test/simpa.lean b/BatteriesTest/simpa.lean similarity index 97% rename from test/simpa.lean rename to BatteriesTest/simpa.lean index 9528b26382..edbd58c161 100644 --- a/test/simpa.lean +++ b/BatteriesTest/simpa.lean @@ -70,7 +70,7 @@ end Prod theorem implicit_lambda (h : ∀ {x : Nat}, a = x) : a = 2 := by simpa using h -theorem implicit_lambda2 (h : a = 2) : ∀ {x : Nat}, a = 2 := by +theorem implicit_lambda2 (h : a = 2) : ∀ {_ : Nat}, a = 2 := by simpa using h theorem no_implicit_lambda (h : ∀ {x : Nat}, a = x) : ∀ {x : Nat}, a = x := by diff --git a/test/solve_by_elim.lean b/BatteriesTest/solve_by_elim.lean similarity index 92% rename from test/solve_by_elim.lean rename to BatteriesTest/solve_by_elim.lean index 94baf49ea7..cdad389de9 100644 --- a/test/solve_by_elim.lean +++ b/BatteriesTest/solve_by_elim.lean @@ -1,10 +1,10 @@ /- -Copyright (c) 2021 Scott Morrison. All rights reserved. +Copyright (c) 2021 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Kim Morrison -/ import Batteries.Tactic.PermuteGoals -import Batteries.Test.Internal.DummyLabelAttr +import BatteriesTest.Internal.DummyLabelAttr import Lean.Meta.Tactic.Constructor import Lean.Elab.SyntheticMVars import Lean.Elab.Tactic.SolveByElim -- FIXME we need to make SolveByElimConfig builtin diff --git a/BatteriesTest/trans.lean b/BatteriesTest/trans.lean new file mode 100644 index 0000000000..d05874399b --- /dev/null +++ b/BatteriesTest/trans.lean @@ -0,0 +1,107 @@ +import Batteries.Tactic.Trans + +-- testing that the attribute is recognized and used +def nleq (a b : Nat) : Prop := a ≤ b + +@[trans] def nleq_trans : nleq a b → nleq b c → nleq a c := Nat.le_trans + +example (a b c : Nat) : nleq a b → nleq b c → nleq a c := by + intro h₁ h₂ + trans b + assumption + assumption + +example (a b c : Nat) : nleq a b → nleq b c → nleq a c := by intros; trans <;> assumption + +-- using `Trans` typeclass +@[trans] def eq_trans {a b c : α} : a = b → b = c → a = c := by + intro h₁ h₂ + apply Eq.trans h₁ h₂ + +example (a b c : Nat) : a = b → b = c → a = c := by intros; trans <;> assumption + +example (a b c : Nat) : a = b → b = c → a = c := by + intro h₁ h₂ + trans b + assumption + assumption + +example : @Trans Nat Nat Nat (· ≤ ·) (· ≤ ·) (· ≤ ·) := inferInstance + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by + intros h₁ h₂ + trans ?b + case b => exact b + exact h₁ + exact h₂ + +example (a b c : α) (R : α → α → Prop) [Trans R R R] : R a b → R b c → R a c := by + intros h₁ h₂ + trans ?b + case b => exact b + exact h₁ + exact h₂ + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by + intros h₁ h₂ + trans + exact h₁ + exact h₂ + +example (a b c : Nat) : a ≤ b → b ≤ c → a ≤ c := by intros; trans <;> assumption + +example (a b c : Nat) : a < b → b < c → a < c := by + intro h₁ h₂ + trans b + assumption + assumption + +example (a b c : Nat) : a < b → b < c → a < c := by intros; trans <;> assumption + +example (x n p : Nat) (h₁ : n * Nat.succ p ≤ x) : n * p ≤ x := by + trans + · apply Nat.mul_le_mul_left; apply Nat.le_succ + · apply h₁ + +example (a : α) (c : γ) : ∀ b : β, HEq a b → HEq b c → HEq a c := by + intro b h₁ h₂ + trans b + assumption + assumption + +def MyLE (n m : Nat) := ∃ k, n + k = m + +@[trans] theorem MyLE.trans {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by + cases h1 + cases h2 + subst_vars + exact ⟨_, Eq.symm <| Nat.add_assoc _ _ _⟩ + +example {n m k : Nat} (h1 : MyLE n m) (h2 : MyLE m k) : MyLE n k := by + trans <;> assumption + +/-- `trans` for implications. -/ +example {A B C : Prop} (h : A → B) (g : B → C) : A → C := by + trans B + · guard_target =ₛ A → B -- ensure we have `B` and not a free metavariable. + exact h + · guard_target =ₛ B → C + exact g + +/-- `trans` for arrows between types. -/ +example {A B C : Type} (h : A → B) (g : B → C) : A → C := by + trans + rotate_right + · exact B + · exact h + · exact g + +universe u v w + +/-- `trans` for arrows between types. -/ +example {A : Type u} {B : Type v} {C : Type w} (h : A → B) (g : B → C) : A → C := by + trans + rotate_right + · exact B + · exact h + · exact g diff --git a/test/tryThis.lean b/BatteriesTest/tryThis.lean similarity index 100% rename from test/tryThis.lean rename to BatteriesTest/tryThis.lean diff --git a/test/vector.lean b/BatteriesTest/vector.lean similarity index 88% rename from test/vector.lean rename to BatteriesTest/vector.lean index 5a8b9e8587..7c93888528 100644 --- a/test/vector.lean +++ b/BatteriesTest/vector.lean @@ -17,7 +17,7 @@ def and : Gate 2 := .if (.if (.const true) (.const false)) (.if (.const false) ( def eval (g : Gate n) (v : Vector Bool n) : Bool := match g, v with | .const b, _ => b - | .if g₁ g₂, v => if v.1.back then eval g₁ v.pop else eval g₂ v.pop + | .if g₁ g₂, v => if v.1.back! then eval g₁ v.pop else eval g₂ v.pop example : ∀ v, and.eval v = (v[0] && v[1]) := by decide example : ∃ v, and.eval v = false := by decide diff --git a/test/where.lean b/BatteriesTest/where.lean similarity index 100% rename from test/where.lean rename to BatteriesTest/where.lean diff --git a/README.md b/README.md index ab8606d854..2873f65536 100644 --- a/README.md +++ b/README.md @@ -5,9 +5,15 @@ The "batteries included" extended library for Lean 4. This is a collection of da # Using `batteries` To use `batteries` in your project, add the following to your `lakefile.lean`: - ```lean -require batteries from git "https://github.com/leanprover-community/batteries" @ "main" +require "leanprover-community" / "batteries" @ "main" +``` +Or add the following to your `lakefile.toml`: +```toml +[[require]] +name = "batteries" +scope = "leanprover-community" +version = "main" ``` Additionally, 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. @@ -15,47 +21,32 @@ Additionally, please make sure that you're using the version of Lean that the cu # Build instructions * Get the newest version of `elan`. If you already have installed a version of Lean, you can run - ``` + ```sh elan self update ``` If the above command fails, or if you need to install `elan`, run - ``` + ```sh curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh ``` If this also fails, follow the instructions under `Regular install` [here](https://leanprover-community.github.io/get_started.html). * To build `batteries` run `lake build`. * To build and run all tests, run `lake test`. * To run the environment linter, run `lake lint`. -* If you added a new file, run the command `scripts/updateBatteries.sh` to update the - imports. +* If you added a new file, run the command `scripts/updateBatteries.sh` to update the imports. # Documentation -You can generate `batteries`' documentation with - -```text -# if you're generating documentation for the first time -> lake -R -Kdoc=on update -... -# actually generate the documentation -> lake -R -Kdoc=on build Batteries:docs -... -> ls build/doc/index.html -build/doc/index.html -``` - -After generating the docs, run `lake build -R` to reset the configuration. +You can generate `batteries` documentation with -The top-level HTML file will be located at `build/doc/Batteries.html`, though to actually expose the -documentation as a server you need to - -```text -> cd build/doc -> python3 -m http.server -Serving HTTP on :: port 8000 (http://[::]:8000/) ... +```sh +cd docs +lake build Batteries:docs ``` -Note that documentation for the latest nightly of `batteries` is available as part of [the Mathlib 4 +The top-level HTML file will be located at `docs/doc/index.html`, though to actually expose the +documentation you need to run a HTTP server (e.g. `python3 -m http.server`) in the `docs/doc` directory. + +Note that documentation for the latest nightly of `batteries` is also available as part of [the Mathlib 4 documentation][mathlib4 docs]. [mathlib4 docs]: https://leanprover-community.github.io/mathlib4_docs/Batteries.html diff --git a/docs/README.md b/docs/README.md new file mode 120000 index 0000000000..32d46ee883 --- /dev/null +++ b/docs/README.md @@ -0,0 +1 @@ +../README.md \ No newline at end of file diff --git a/docs/lake-manifest.json b/docs/lake-manifest.json new file mode 100644 index 0000000000..9c082aa9e8 --- /dev/null +++ b/docs/lake-manifest.json @@ -0,0 +1,62 @@ +{"version": "1.1.0", + "packagesDir": "../.lake/packages", + "packages": + [{"url": "https://github.com/acmepjz/md4lean", + "type": "git", + "subDir": null, + "scope": "", + "rev": "5e95f4776be5e048364f325c7e9d619bb56fb005", + "name": "MD4Lean", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/fgdorais/lean4-unicode-basic", + "type": "git", + "subDir": null, + "scope": "", + "rev": "b41bc9cec7f433d6e1d74ff3b59edaaf58ad2915", + "name": "UnicodeBasic", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/dupuisf/BibtexQuery", + "type": "git", + "subDir": null, + "scope": "", + "rev": "bdc2fc30b1e834b294759a5d391d83020a90058e", + "name": "BibtexQuery", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/mhuisi/lean4-cli", + "type": "git", + "subDir": null, + "scope": "", + "rev": "726b3c9ad13acca724d4651f14afc4804a7b0e4d", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover/doc-gen4", + "type": "git", + "subDir": null, + "scope": "", + "rev": "8add673e2ea4da0929103ad19dc824e1c0b7437d", + "name": "«doc-gen4»", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": false, + "configFile": "lakefile.lean"}, + {"type": "path", + "scope": "", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "./..", + "configFile": "lakefile.toml"}], + "name": "docs", + "lakeDir": ".lake"} diff --git a/docs/lakefile.toml b/docs/lakefile.toml new file mode 100644 index 0000000000..0726079709 --- /dev/null +++ b/docs/lakefile.toml @@ -0,0 +1,13 @@ +name = "docs" +reservoir = false +packagesDir = "../.lake/packages" +buildDir = "." + +[[require]] +scope = "leanprover" +name = "doc-gen4" +rev = "main" + +[[require]] +name = "batteries" +path = ".." diff --git a/lakefile.lean b/lakefile.lean deleted file mode 100644 index 7c287c4c95..0000000000 --- a/lakefile.lean +++ /dev/null @@ -1,18 +0,0 @@ -import Lake - -open Lake DSL - -package batteries where - leanOptions := #[⟨`linter.missingDocs, true⟩] - -@[default_target] -lean_lib Batteries - -@[default_target, lint_driver] -lean_exe runLinter where - srcDir := "scripts" - supportInterpreter := true - -@[test_driver] -lean_exe test where - srcDir := "scripts" diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000000..18abb8a007 --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,24 @@ +name = "batteries" +testDriver = "BatteriesTest" +lintDriver = "runLinter" +defaultTargets = ["Batteries", "runLinter"] + +[leanOptions] +linter.missingDocs = true + +[[lean_lib]] +name = "Batteries" + +[[lean_lib]] +name = "BatteriesTest" +globs = ["BatteriesTest.+"] +leanOptions = {linter.missingDocs = false} + +[[lean_exe]] +name = "runLinter" +srcDir = "scripts" +supportInterpreter = true + +[[lean_exe]] +name = "test" +srcDir = "scripts" diff --git a/lean-toolchain b/lean-toolchain index 89985206ac..0bef727630 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.12.0 +leanprover/lean4:v4.14.0-rc1 diff --git a/scripts/runLinter.lean b/scripts/runLinter.lean index 89976f0e47..2a88e18eb5 100644 --- a/scripts/runLinter.lean +++ b/scripts/runLinter.lean @@ -1,6 +1,7 @@ import Lean.Util.SearchPath import Batteries.Tactic.Lint import Batteries.Data.Array.Basic +import Lake.CLI.Main open Lean Core Elab Command Batteries.Tactic.Lint open System (FilePath) @@ -17,27 +18,66 @@ def readJsonFile (α) [FromJson α] (path : System.FilePath) : IO α := do def writeJsonFile [ToJson α] (path : System.FilePath) (a : α) : IO Unit := IO.FS.writeFile path <| toJson a |>.pretty.push '\n' +open Lake + +/-- Returns the root modules of `lean_exe` or `lean_lib` default targets in the Lake workspace. -/ +def resolveDefaultRootModules : IO (Array Name) := do + -- load the Lake workspace + let (elanInstall?, leanInstall?, lakeInstall?) ← findInstall? + let config ← MonadError.runEIO <| mkLoadConfig { elanInstall?, leanInstall?, lakeInstall? } + let some workspace ← loadWorkspace config |>.toBaseIO + | throw <| IO.userError "failed to load Lake workspace" + + -- resolve the default build specs from the Lake workspace (based on `lake build`) + let defaultBuildSpecs ← match resolveDefaultPackageTarget workspace workspace.root with + | Except.error e => IO.eprintln s!"Error getting default package target: {e}" *> IO.Process.exit 1 + | Except.ok targets => pure targets + + -- build an array of all root modules of `lean_exe` and `lean_lib` build targets + let defaultTargetModules := defaultBuildSpecs.flatMap <| + fun target => match target.info with + | BuildInfo.libraryFacet lib _ => lib.roots + | BuildInfo.leanExe exe => #[exe.config.root] + | _ => #[] + return defaultTargetModules + /-- -Usage: `runLinter [--update] [Batteries.Data.Nat.Basic]` +Parse args list for `runLinter` +and return a pair of the update and specified module arguments. -Runs the linters on all declarations in the given module (or `Batteries` by default). -If `--update` is set, the `nolints` file is updated to remove any declarations that no longer need -to be nolinted. --/ -unsafe def main (args : List String) : IO Unit := do - let (update, args) := +Throws an exception if unable to parse the arguments. +Returns `none` for the specified module if no module is specified.-/ +def parseLinterArgs (args: List String) : Except String (Bool × Option Name) := + let (update, moreArgs) := match args with | "--update" :: args => (true, args) | _ => (false, args) - let some module := - match args with - | [] => some `Batteries - | [mod] => match mod.toName with - | .anonymous => none - | name => some name - | _ => none - | IO.eprintln "Usage: runLinter [--update] [Batteries.Data.Nat.Basic]" *> IO.Process.exit 1 - searchPathRef.set compile_time_search_path% + match moreArgs with + | [] => Except.ok (update, none) + | [mod] => match mod.toName with + | .anonymous => Except.error "cannot convert module to Name" + | name => Except.ok (update, some name) + | _ => Except.error "cannot parse arguments" + +/-- +Return an array of the modules to lint. + +If `specifiedModule` is not `none` return an array containing only `specifiedModule`. +Otherwise, resolve the default root modules from the Lake workspace. -/ +def determineModulesToLint (specifiedModule : Option Name) : IO (Array Name) := do + match specifiedModule with + | some module => + println!"Running linter on specified module: {module}" + return #[module] + | none => + println!"Automatically detecting modules to lint" + let defaultModules ← resolveDefaultRootModules + println!"Default modules: {defaultModules}" + return defaultModules + +/-- Run the Batteries linter on a given module and update the linter if `update` is `true`. -/ +unsafe def runLinterOnModule (update : Bool) (module : Name): IO Unit := do + initSearchPath (← findSysroot) let mFile ← findOLean module unless (← mFile.pathExists) do -- run `lake build module` (and ignore result) if the file hasn't been built yet @@ -64,27 +104,49 @@ unsafe def main (args : List String) : IO Unit := do readJsonFile NoLints nolintsFile else pure #[] - withImportModules #[module, lintModule] {} (trustLevel := 1024) fun env => - let ctx := { fileName := "", fileMap := default } - let state := { env } - Prod.fst <$> (CoreM.toIO · ctx state) do - let decls ← getDeclsInPackage module.getRoot - let linters ← getChecks (slow := true) (runAlways := none) (runOnly := none) - let results ← lintCore decls linters - if update then - writeJsonFile (α := NoLints) nolintsFile <| - .qsort (lt := fun (a, b) (c, d) => a.lt c || (a == c && b.lt d)) <| - .flatten <| results.map fun (linter, decls) => - decls.fold (fun res decl _ => res.push (linter.name, decl)) #[] - let results := results.map fun (linter, decls) => - .mk linter <| nolints.foldl (init := decls) fun decls (linter', decl') => - if linter.name == linter' then decls.erase decl' else decls - let failed := results.any (!·.2.isEmpty) - if failed then - let fmtResults ← - formatLinterResults results decls (groupByFilename := true) (useErrorFormat := true) - s!"in {module}" (runSlowLinters := true) .medium linters.size - IO.print (← fmtResults.toString) - IO.Process.exit 1 - else - IO.println "-- Linting passed." + unsafe Lean.enableInitializersExecution + let env ← importModules #[module, lintModule] {} (trustLevel := 1024) + let ctx := { fileName := "", fileMap := default } + let state := { env } + Prod.fst <$> (CoreM.toIO · ctx state) do + let decls ← getDeclsInPackage module.getRoot + let linters ← getChecks (slow := true) (runAlways := none) (runOnly := none) + let results ← lintCore decls linters + if update then + writeJsonFile (α := NoLints) nolintsFile <| + .qsort (lt := fun (a, b) (c, d) => a.lt c || (a == c && b.lt d)) <| + .flatten <| results.map fun (linter, decls) => + decls.fold (fun res decl _ => res.push (linter.name, decl)) #[] + let results := results.map fun (linter, decls) => + .mk linter <| nolints.foldl (init := decls) fun decls (linter', decl') => + if linter.name == linter' then decls.erase decl' else decls + let failed := results.any (!·.2.isEmpty) + if failed then + let fmtResults ← + formatLinterResults results decls (groupByFilename := true) (useErrorFormat := true) + s!"in {module}" (runSlowLinters := true) .medium linters.size + IO.print (← fmtResults.toString) + IO.Process.exit 1 + else + IO.println s!"-- Linting passed for {module}." + +/-- +Usage: `runLinter [--update] [Batteries.Data.Nat.Basic]` + +Runs the linters on all declarations in the given module +(or all root modules of Lake `lean_lib` and `lean_exe` default targets if no module is specified). +If `--update` is set, the `nolints` file is updated to remove any declarations that no longer need +to be nolinted. +-/ +unsafe def main (args : List String) : IO Unit := do + let linterArgs := parseLinterArgs args + let (update, specifiedModule) ← match linterArgs with + | Except.ok args => pure args + | Except.error msg => do + IO.eprintln s!"Error parsing args: {msg}" + IO.eprintln "Usage: runLinter [--update] [Batteries.Data.Nat.Basic]" + IO.Process.exit 1 + + let modulesToLint ← determineModulesToLint specifiedModule + + modulesToLint.forM <| runLinterOnModule update diff --git a/test/classical.lean b/test/classical.lean deleted file mode 100644 index d2d460253c..0000000000 --- a/test/classical.lean +++ /dev/null @@ -1,23 +0,0 @@ -import Batteries.Tactic.Classical -import Batteries.Tactic.PermuteGoals - -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - classical - have := ∀ p, decide p -- uses the classical instance - guard_expr decide (0 < 1) = @decide (0 < 1) (Nat.decLt 0 1) - exact decide (0 < 1) -- will use the decidable instance - --- double check no leakage -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - exact decide (0 < 1) -- uses the decidable instance - --- check that classical respects tactic blocks -example : Bool := by - fail_if_success have := ∀ p, decide p -- no classical in scope - on_goal 1 => - classical - have := ∀ p, decide p -- uses the classical instance - fail_if_success have := ∀ p, decide p -- no classical in scope again - exact decide (0 < 1) -- will use the decidable instance